C C CMS Generation: 1 C C 1/20/89 SMD Modified ln03 (the escape commands) command at C beginning of file save to work with MDRAW C C REWRITE MADE 9/26/86 BY JEFF STRICKLAND MARTIN MARIETTA CORP. C KENNEDY SPACE CENTER, FLA. C C VAX/VMS Fortran 77 is required to compile this program. C C This program will read a VT125(MAYBE) or VT240/VT241's graphic screen C and dump the information back to the computer into a file name C specified by the user. The file will be in a SIXEL format C that can then be spooled of to a LN03. There should not be a printer C hooked up, or the redirection may not work. C C Note : After the startup of this program the keyboard is locked until C it is finished, due to the fact that any keyboard activity C during the dump would corrupt the file. It will take anywhere C from 1 to 3 minutes depending on the load on your system. Implicit Integer *4 (A-Z) Include '($IODEF)' Include '($TTDEF)' Character*2 GOFF,GON,BUF Character*3 Device,move,prompt_erase Character*4 To_Computer,To_Printer,Hard_Copy Character*40 File_Name Character*5 portrait Character*4 escape Character*8 enlarge Integer*4 Terminal_Mode(2) Integer*2 CHANNEL,IOSB(4) Byte Done(2),SIXEL(50000),WCHAR Byte Carriage_Return,File_Byte(40),Delete 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'/ DATA Hard_Copy /'S(H)'/ DATA up /'[1A'/ DATA move /'[2C'/ DATA prompt_erase /'[1K'/ Index = 0 Carriage_Return = 13 C ************************************************************************ C Get the terminal's channel number for the QIO. Call Sys$Assign (Device,Channel,,) C Re-direct I/O from printer port to the communications port. Write (*,100) ESC,To_Computer 100 Format ('+',A1,A4,$) C Enter ReGIS graphic mode on the terminal. Write (*,101) ESC,GON 101 Format ('+',A1,A2,$) C Get the terminal's current mode of operation. status = Sys$QIOW (,%VAL(Channel), %VAL(IO$_SENSEMODE), 1 %REF(IOSB),,,%REF(Terminal_Mode(1)),%VAL(8),,,,) If (.not. status) Call SYS$EXIT(%VAL(status)) C Set the Host Sync flag in the terminal Characteristics word. Terminal_Mode(2) = IOR (Terminal_Mode(2),TT$M_HOSTSYNC) C Temporarily set the terminal to host sync mode to eliminate C any overrun which may occur because of the lack of XON-XOFF. status = Sys$QIOW (,%VAL(Channel),%VAL(IO$_SETMODE),%REF(IOSB),,, 1 %REF(Terminal_Mode(1)),%VAL(8),,,,) If (.not.status) Call SYS$EXIT(%VAL(status)) C ********************************************************************** C This is for erasing the dollar prompt which shows up after such C operations as a directory. This can easily be adjusted by changing C the UP,MOVE,and the PROMPT_ERASE "$" under the Data statements. C Do not use this if you DUMP within an application program. C Can also be used in conjunction with FMS to print the screen. C MOVE UP (1) AND OVER LEFT(2) AND ... C Write (*,103) ESC,up,ESC,move C 103 format ('+',A1,A3,A1,A3,$) C ...ERASE THE DOLLAR PROMPT. C Write (*,7) ESC,PROMPT_ERASE C 7 Format ('+',A1,A3,$) C ************************************************************************ C >>> There is no need to change the code from >>> to <<<. C Enter ReGIS graphic mode on the terminal. 111 Write (*,8) ESC,GON 8 Format ('+',A1,A2,$) C Issue the SIXEL dump command to the terminal for hardcopy. Write (*,200) Hard_Copy 200 Format ('+',A4,$) C Get the initial data sent, synchronize on the first \ 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(WChar), %VAL(1), , , , ) If(.not. status) Call SYS$EXIT(%VAL(status)) SIXEL(1) = SIXEL(2) SIXEL(2) = WChar End Do C Now get some real data (SIXEL bit map data and terminate on \ Index = 2 300 Status = Sys$QIOW (,%VAL(Channel),%VAL(IO$_READVBLK+IO$M_NOECHO), 1 IOSB, , , %REF(WChar), %VAL(1), , , , ) If(.not. status) Call SYS$EXIT(%VAL(status)) Index = Index + 1 SIXEL(Index) = WChar If (SIXEL(Index-1).EQ.Done(1) .and. SIXEL(Index).EQ.Done(2)) Goto 400 Goto 300 C Exit ReGIS graphics mode on the terminal. 400 Write (*,401) ESC,GOFF 401 Format ('+',A1,A2,$) C Reset hardcopy to the printer port. Write (*,402) ESC,To_Printer 402 Format ('+',A1,A4,$) C <<< *********************************************************************** C Check if file name is a null and if so exit the program. If (Index.LE.1) Goto 900 C Open the file for001.dat.The filename will be changed C by the accompaning comfile which calls this program. Open (Unit=1, Status='NEW', Access='Direct', 1 Recordsize=20, FORM='Unformatted') C ************************************************************************ C Write out the SIXEL data to the file. Use a random access file. C Here is where I put the escape sequences to place the sixel C dump in portrait mode and enlarge it to fill the page. C !! IMPORTANT !! you must have extra RAM cartridge for the ln03. C If you do not, comment out the portrait and enlarge statements below. C Your print will then come out smaller than the actual size on the screen. C File_Rec = 1 C portrait = char(27)//char(91)//char(48)//char(32)//char(74) C Write (1'File_Rec) portrait C File_Rec = File_Rec + 1 C enlarge = char(155)//char(48)//char(59)//char(50) C + //char(59)//char(50)//char(113)//char(50) C Write (1'File_Rec) enlarge C Do loop for writing out the file. I found the first 8 characters of C the file are not necessary if the previous sequences are used. If they C are NOT used, I suggest you then use the next statement to put the ln03 C into the graphics mode. Do not change the DO statement. File_Rec = 1 escape = char(27)//char(80)//char(49)//char(113) Write (1'File_Rec) escape File_Rec = File_Rec + 1 enlarge = char(144)//char(48)//char(59)//char(50) + //char(59)//char(50)//char(113)//char(50) Write (1'File_Rec) enlarge C Sixel(16) = char(50) Do 600 J = 17,index+3,80 File_Rec=File_Rec+1 IF (J .GE. INDEX+1) GOTO 900 600 Write (1'File_Rec) (SIXEL(I),I=J,J+79) 900 Call Exit END