C+
C  Program Name: GET_PIC.FOR
C  Author: Patrick Smits
C-
      IMPLICIT INTEGER*4 (A-Z)

      INCLUDE '($IODEF)'
      INCLUDE '($TTDEF)'

      CHARACTER*2       GON,GOFF
      CHARACTER*3       DEVICE
      CHARACTER*4       TO_COMPUTER,TO_PRINTER
      CHARACTER*13      HARD_COPY
      CHARACTER*40      FILE_NAME
      BYTE              DONE(2),SIXEL(50000)
      BYTE              CARRIAGE_RETURN,FILE_BYTE(40),DELETE
      INTEGER*4         CHAR,TERMINAL_MODE(2)

      DATA DEVICE       /'TT:'/
      DATA DONE         /27,92/
      DATA GON          /'Pp'/
      DATA GOFF         /'\'/
      DATA ESC          /27/
      DATA DELETE       /127/
      DATA TO_COMPUTER  /'[?2i'/
      DATA TO_PRINTER   /'[?0i'/

C*****
CUse this line for VT125's:
C      DATA HARD_COPY    /'S(H(P[0,0])H)'/

CUse this line for VT240/VT241's:
      DATA HARD_COPY    /'S(H(P[0,0]))'/
C*****

      INDEX           = 0
      CARRIAGE_RETURN = 13
C+
C  Get the terminal's channel number for the QIO.
C-
      CALL SYS$ASSIGN (DEVICE,CHANNEL,,)
C+
C  Re-direct I/O from printer port to the communication port.
C-
      WRITE(*,100) ESC,TO_COMPUTER
100   FORMAT('+',A1,A4,$)
C+
C  Enter ReGIS graphic mode on the terminal.
C-
      WRITE(*,101) ESC,GON
101   FORMAT('+',A1,A2,$)
C+
C  Get  the  terminal's  current  mode  of  operation.
C-
      STATUS = SYS$QIOW (,%VAL(CHANNEL),  %VAL(IO$_SENSEMODE),
     1     IOSB,,,%REF(TERMINAL_MODE(1)),%VAL(8),,,,)
      IF(.NOT. STATUS) CALL SYS$EXIT(%VAL(STATUS))
C+
C  Set the Host Sync flag in the terminal characteristics word.
C-
      TERMINAL_MODE(2) = IOR (TERMINAL_MODE(2),TT$M_HOSTSYNC)
C+
C  Temporarily set the terminal to host sync mode to eliminate
C  any overrun which may occur because of the lack of XON-XOFF.
C-
      STATUS = SYS$QIOW (,%VAL(CHANNEL),%VAL(IO$_SETMODE),IOSB,,,
     1     %REF(TERMINAL_MODE(1)),%VAL(8),,,,)
      IF(.NOT. STATUS) CALL SYS$EXIT(%VAL(STATUS))
C+
C  Get the name of the file to put the SIXEL dump.
C-
      WRITE(*,102)
102   FORMAT('+','P[1,460]W(C,I1)t(S1,I0,A0)
     1     T"Enter output file name : "',$)
C+
C  Get the File name and echo it in graphics mode to the terminal.
C-
      DO WHILE (CHAR .NE. CARRIAGE_RETURN)
      STATUS = SYS$QIOW (,%VAL(CHANNEL),
     1     %VAL(IO$_READVBLK+IO$M_NOECHO+IO$M_NOFILTR),
     2     IOSB,  ,  ,  %REF(CHAR),  %VAL(1), , , , )
      IF(.NOT. STATUS) CALL SYS$EXIT(%VAL(STATUS))

      IF(CHAR.NE.DELETE) GOTO 104
      IF(INDEX.EQ.0) GOTO 106
      WRITE(*,103) FILE_BYTE(INDEX)
103   FORMAT('+','P[-9,460]T"',A1,'"P[-9,460]',$)
      INDEX=INDEX-1
      GOTO 106

104   INDEX=INDEX+1
      FILE_BYTE(INDEX)=CHAR
      IF(FILE_BYTE(1) .EQ. CARRIAGE_RETURN) WRITE(*,102)
      IF(FILE_BYTE(1) .EQ. CARRIAGE_RETURN) GOTO 400
      WRITE(*,105) FILE_BYTE(INDEX)
105   FORMAT('+','P[,460]T"',A1,'";',$)
106   CONTINUE

      END DO
C+
C  Convert the byte file name to a character file name and also
C  eliminate  the  carriage  return  from  the  data  stream.
C-
      INDEX=INDEX-1
      WRITE(FILE_NAME,107) (FILE_BYTE(I),I=1,INDEX)
107   FORMAT(40A1)
C+
C  Rewrite the file name in complement mode to "ERASE" it.
C-
      WRITE(*,108) FILE_NAME
108   FORMAT('+','P[1,460]W(C,I1)t(S1,A0)T"Enter output file name : ',
     1     A40,'"',$)
C+
C  Issue the SIXEL dump command to the terminal for hardcopy.
C-
      WRITE(*,200) HARD_COPY
200   FORMAT('+',A13,$)
C+
C  Get the initial data sent, synchronize on the first <ESC> \
C-
      DO WHILE (.NOT. (SIXEL(1).EQ.DONE(1) .AND. SIXEL(2).EQ.DONE(2)))
      STATUS = SYS$QIOW (,%VAL(CHANNEL),%VAL(IO$_READVBLK+IO$M_NOECHO),
     1     IOSB,  ,  ,  %REF(CHAR),  %VAL(1), , , , )
      IF(.NOT. STATUS) CALL SYS$EXIT(%VAL(STATUS))
      SIXEL(1)=SIXEL(2)
      SIXEL(2)=CHAR
      END DO
C+
C  Now get some real data (SIXEL bit map data and terminate on <ESC> \ )
C-
      INDEX=2
300   STATUS = SYS$QIOW (,%VAL(CHANNEL),%VAL(IO$_READVBLK+IO$M_NOECHO),
     1     IOSB,  ,  ,  %REF(CHAR),  %VAL(1), , , , )
      IF(.NOT. STATUS) CALL SYS$EXIT(%VAL(STATUS))
      INDEX=INDEX+1
      SIXEL(INDEX)=CHAR
      IF (SIXEL(INDEX-1).EQ.DONE(1) .AND.
     1     SIXEL(INDEX).EQ.DONE(2)) GOTO 400
      GOTO 300
C+
C  Exit ReGIS graphics mode on the terminal.
C-
400   WRITE(*,401) ESC,GOFF
401   FORMAT('+',A1,A1,$)
C+
C  Reset hardcopy to the printer port.
C-
      WRITE(*,402) ESC,TO_PRINTER
402   FORMAT('+',A1,A4,$)
C+
C  Check if file name is a null and if so exit the program.
C-
      IF(INDEX.LE.1) GOTO 900
C+
C  Clear out random characters in last record written to file.
C-
      DO 500 I=INDEX+1,INDEX+4
500   SIXEL(I)=CARRIAGE_RETURN

      OPEN (UNIT=1, FILE=FILE_NAME, STATUS='NEW', ACCESS='DIRECT',
     1     RECORDSIZE=1, FORM='UNFORMATTED')
C+
C  Write out the SIXEL data to the file. Use random access file.
C-
      FILE_REC=0
      DO 600 J=1,INDEX+3,4
      FILE_REC=FILE_REC+1
600   WRITE(1'FILE_REC) (SIXEL(I),I=J,J+3)

900   CALL EXIT
      END
