TITLE TOLP - Routine to read *.PLT files SUBTTL Joe Smith, CSM, 28-Jun-83 ; Subroutine TOLP is the reverse of subroutine PLOT. TOLP reads a .PLT ;file from the disk, and translates it to calls to PLOT, NEWPEN, OPRTXT, ;TITLE, and PAUSEP. Subroutine TOLP is used by both the FORTRAN program ;TEK and the GLXLIB program SPROUT for interpreting compressed plot files. ;Written 2-Mar-83 for the Colorado School of Mines. ;Revised 28-Jun-83 ; Table of Contents for TOLP - Reverse PLOT ; ; ; Section Page ; ; 1. Calling sequence ; 1.1 MACRO programs (such as SPROUT) . . . . . . . 2 ; 1.2 FORTRAN programs (such as TEK) . . . . . . . . 3 ; 2. Definitions . . . . . . . . . . . . . . . . . . . . . 4 ; 3. Entry to TOLP(READER,ICHAR,ITEXT) . . . . . . . . . . 5 ; 4. Verify that the plot file starts correctly . . . . . . 6 ; 5. Exit from TOLP ; 5.1 ERROR and DONE routines . . . . . . . . . . . 7 ; 5.2 Error messages . . . . . . . . . . . . . . . . 8 ; 6. Input routines, GETWRD and GETHLF . . . . . . . . . . 9 ; 7. Interface to external subroutines . . . . . . . . . . 10 ; 8. Format of a .PLT file . . . . . . . . . . . . . . . . 11 ; 9. Main input loop . . . . . . . . . . . . . . . . . . . 12 ; 10. Process halfwords . . . . . . . . . . . . . . . . . . 13 ; 11. Opcode dispatch and handlers . . . . . . . . . . . . . 13 ; 12. Data area . . . . . . . . . . . . . . . . . . . . . . 15 SUBTTL Calling sequence -- MACRO programs (such as SPROUT) COMMENT ~ For SPROUT: (S1=1,S2=2,T1=3,T2=4,T3=5,T4=6,P=17) EXTERN TOLP. ;Routine to reverse PLOT INTERN PLOT ;Routine to move the pen INTERN NEWPEN,OPRTXT,PAUSEP,TITLE ;Other routines called by TOLP MOVEI S1,READIT ;Input routine MOVEI S2,3 (or MOVEI S2,0) ;3 for internal header and trailer MOVE T1,J$XPOS(J) ;Current X position MOVE T2,J$YPOS(J) ;Current Y position PUSHJ P,TOLP.## ;Call MACRO entry point MOVEI S1,[ITEXT (<^T/0(S2)/ ^F/@J$DFDA(J)/>)] ;S2 points to ASCIZ SKIPE S2 ;If errors were detected, copy string PUSHJ P,PUTERR ; and file name to error buffer JRST PLTLP0 ;File is at EOF, finish up ;Routine to read a word from the input file, returns -1 for EOF, -2 on abort READIT: $CALL INPBYT ;Get a word MOVE S1,C ;Copy to expected AC JUMPT .POPJ ;Use it if OK MOVNI S1,-1 ; else -1 for EOF TXNE S,RQB+ABORT ;EOF caused by REQUE? MOVNI S1,-2 ;Yes, signify as such POPJ P, ;Continue back in TOLP ;End of CSM edit to SPROUT SUBTTL Calling sequence -- FORTRAN programs (such as TEK) CALL TOLP (READER,ICHAR,ITEXT) READER = (input) The name of the subroutine that will read one word from the .PLT file. This name must be declared in an EXTERNAL statement. IFLAG = (input) Flag for doing header and trailer. 0 = Don't do either, 1 = Header, 2 = Trailer, 3 = Both 4400 = Plot wraps around at 11 inches, 4803 = 12 inches + headers (output) Returned as 0 if no errors, word count if error occured. ITEXT = (output) The text of the error message, up to 80 characters stored in a (16A5) format. This array is not modified if IFLAG is returned as zero. ITEXT can be a CHARACTER*80 variable. FORTRAN example: DIMENSION ITEXT(16) !80 characters EXTERNAL READER !Subroutine to do input EXTERNAL PLOT,NEWPEN,OPRTXT,PAUSEP,TITLE !Required routines from FORLIB TYPE 10 10 FORMAT(' Name of PLT file: ',$) ACCEPT 20, ITEXT !Get name from user 20 FORMAT(16A5) OPEN(UNIT=1,DIALOG=ITEXT,ACCESS='SEQIN',MODE='IMAGE') CALL PLOTS(IERR,'TTY') !Initialize the graphics terminal IF(IERR.NE.0) STOP 'Cannot start plotting' D CALL FACTOR(0.7) !Optional, reduce size to fit on TEK screen IFLAG = 4400 !Make large plots wrap around CALL TOLP(READER,IFLAG,ITEXT) CALL PLOT(X,Y,999) !Proper end to the plot IF(IFLAG.EQ.0) STOP 'Plot is done' TYPE 30, (ITEXT(I),I=1,IFLAG) !Type the returned error message 30 FORMAT(' ?Error in plot - ',16A5) END CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC SUBROUTINE READER(IWORD) !Called from inside TOLP READ(1,ERR=40) IWORD !Read 1 binary word from .PLT file RETURN !OK 40 IWORD = -1 !Minus one means End-of-File RETURN END ~ ;End of COMMENT SUBTTL Definitions SEARCH MACTEN ;Get TXNE and PJRST definitions SALL ;AC definitions TF=0 ;Scratch AC S1=1 ;GLXLIB AC definitions S2=2 ;(S1 and S2 are super-temp) T1=3 ;T1-T4 usually preserved T2=4 T3=5 T4=6 F=7 ;Flag bits (alias P1 in GLXLIB) L=16 ;Link to FORTRAN argument list P=17 ;PDL pointer .XCREF S1,S2,T1,T2,T3,T4,F,P ;CREF only L and TF ;Flag bits in F F.GLX== 1B0 ;Called from GLXLIB (must be the sign bit) F.V11== 1B1 ;File came from PLOT version 11 F.LONG==1B2 ;Long mode, 2 halfwords per move F.DOWN==1B3 ;Pen is down F.HEAD==1B4 ;Processing the header F.PLOT==1B5 ;Processing the plot F.TRAL==1B6 ;Processing the trailer F.EOP== 1B7 ;EOP opcode was seen F.MOVE==1B8 ;At least one move made with the pen down F.DOHD==1B9 ;Do plot the header F.DOTR==1B10 ;Do plot the trailer ;Function codes for subroutine PLOT PEN.DN==2 ;Move with the pen down PEN.UP==3 ;Move with the pen up INCS=400.0 ;Increments per inch in floating point ;Version 11 fudge factors STARTX==-^D400 ;Starting X value (-1.0 inch) STARTY==^D4400 ;Starting Y value (11.0 inches) PENSEP==^D300 ;Pen separation (0.75 inches) PAGE ;Argument types for FORTRAN-7 calling conventions OPDEF XMOVEI [SETMI] ;For extended addressing OPDEF IFIW [1B0] ;Instruction Format Indirect Word .NODDT IFIW OPDEF LOGICAL [IFIW 01,0] ;36 bit Boolean OPDEF INTEGER [IFIW 02,0] ;Fixed point argument OPDEF REAL [IFIW 04,0] ;Floating point argument OPDEF OCTAL [IFIW 06,0] ;12 digit octal (1 word) OPDEF PROC [IFIW 07,0] ;Subroutine label OPDEF DREAL [IFIW 10,0] ;Double precision floating point OPDEF DCOMP [IFIW 11,0] ;2 word COMP (COBOL only) OPDEF DOCTAL [IFIW 12,0] ;24 digit octal (2 words) OPDEF GFLOAT [IFIW 13,0] ;G-floating double precision OPDEF COMPLEX [IFIW 14,0] ;Real + imaginary OPDEF CHARACT [IFIW 15,0] ;Byte string descriptor to CHAR variables OPDEF STRING [IFIW 17,0] ;ASCIZ string ACFLD== ;Argument type is in the AC field ACPNTR==POINT 4,0,12 ;P and S of a byte pointer to the AC field DEFINE ACTYPE(TYPE),<_-^D23> ;For compare immediate SUBTTL Entry to TOLP(READER,ICHAR,ITEXT) ENTRY TOLP,TOLP. ;Names of this routine EXTERN PLOT ;Routine to drive the plotter EXTERN NEWPEN ;Routine to change pen colors EXTERN OPRTXT ;Routine to send a message to the OPR EXTERN PAUSEP ;Routine to pause the plotter EXTERN TITLE ;Routine to use hardware text capabilities TWOSEG RELOC 400000 ;A good plot file starts with the following 4 words, the first 2 are mandatory GOODPL: 400000,,000001 ;1B0 + 1B35 "PLOT" ;4 ASCII characters right justified ..==BYTE (3)0(9)12(6)0(18)514 ;Version 12(514) or version 11C(436) ..== PD.FLG,,400000 ;Flag bits, set short mode pen up ;Entry to TOLP from FORTRAN, L points to the arg list SIXBIT /TOLP/ ;For subroutine TRACE. TOLP: XMOVEI S1,@0(L) ;Addr of reader subroutine MOVE S2,@1(L) ;Get IFLAG SETZB T1,T2 ;Current position is [0,0] MOVEM L,SAVEL ;Store for returning arguments TDZA TF,TF ;Clear GLXLIB flag for FORTRAN entry ;Entry to TOLP from SPROUT, S1 thru T2 have args, TF is scratch ;Accumulator F (alias P1) is preserved TOLP.: MOVX TF,F.GLX ;Set the GLXLIB flag MOVEM F,SAVEF ;Save F (alias P1) MOVE F,TF ;Use it for flag bits MOVEM S1,INPRTN ;Save address of input routine TROE S2,1 ;Do the header? TXO F,F.DOHD ;Yes TROE S2,2 ;Trailer? TXO F,F.DOTR ;Yes CAIG S2,^D<7*400> ;Want a reasonable wraparound value? MOVX S2,1B17 ;No, set to no wrap ;MAXINC applies to TEK, and is ignored for SPROUT ;XORIG applies to SPROUT, and is ignored for TEK MOVEM S2,MAXINC ;Increments will be modulo this number DMOVEM T1,XORIG ;Set current X and Y positions SETZM INDATA ;Force GETHLF to read a word SUBTTL Verify that the plot file starts correctly VERIFY: PUSHJ P,GETWRD ;Get first word from the file JSP S1,ILLFMT ;EOF on first word, bad plot CAME T1,GOODPL+0 ;First word match? JSP S1,ILLFMT ;Could be ASCII text or a .REL file PUSHJ P,GETWRD ;Get second word JSP S1,ILLFMT CAME T1,GOODPL+1 ;2nd word match with "PLOT"? JSP S1,ILLFMT PUSHJ P,GETWRD ;Get version number of PLOT.REL JSP S1,ILLFMT ; from 3rd word LDB T2,[POINT 9,T1,11];Get the major version number CAIG T2,11 ;After version 11? TXO F,F.V11 ;No, must use kludges ;Initialize incremental pen position SETZB T1,X ;Simulate CALL PLOT(0.0,0.0,3) SETZB T2,Y ; to lift pen at current position MOVEI T3,PEN.UP MOVEM T3,PLOTI PUSHJ P,EXPLOT ;Call external PLOT routine ;Set up kludges for version 11 of PLOT.REL HRREI T1,STARTX ;Get X starting value HRREI T2,STARTY ;Get Y starting value TXNN F,F.V11 ;Use them if version 11 SETZB T1,T2 ; since version 12 is fixed TXNE F,F.DOHD ;Is the header wanted? MOVEI T1,0 ;Yes, put it on the screen MOVEM T1,X ;Set X and MOVEM T2,Y ; Y positions MOVEI T1,1 ;Current pen is #1 MOVEM T1,PENSAV ;(another V11 kludge) ;Skip over optional flag bytes in the PLT file GET1ST: PUSHJ P,GETHLF ;Get next byte JSP S1,ILLFMT ;Premature EOF TRNE T1,PD.OPC ;Opcode? JRST SOH ;Yes, start of header ANDI T1,PD.FLG ;No, keep only the defined flag bits MOVEM T1,INFLAG ;Save input file flags (not used yet) JRST GET1ST ;Go for opcode SOH: TXO F,F.HEAD ;Yes, now in start of header JRST PLTME1 ;Jump into main loop SUBTTL Exit from TOLP -- ERROR and DONE routines ;Exit from TOLP DONE0: MOVEI S2,0 ;No errors detected ;Raise the pen when done ERROR: PUSH P,S2 ;Save error flag MOVEI T3,PEN.UP ;Raise the pen MOVEM T3,PLOTI PUSHJ P,EXPLOT ;At current position POP P,S2 .CREF F.GLX ;Cref this use of the sign bit JUMPL F,DONE2 ;That is all if called from SPROUT MOVE L,SAVEL ;Restore FORTRAN arg pointer SETZM @1(L) ;Clear error flag JUMPE S2,DONE2 ;Leave ITEXT unchanged if no error ;Copy ASCIZ error message to user's FORTRAN array XMOVEI T1,@2(L) ;Get addr of array or descriptor LDB T2,[ACPNTR 2(L)] ;Get type of argument CAIE T2,ACTYPE(CHARACT) ;CHARACTER expression? JRST NUMARY ;No, numeric array DMOVE T1,0(T1) ;Get byte pointer and count JRST COPYM0 ;(FORTRAN-77 works on KL-10's only) NUMARY: HRLI T1,(POINT 7,) ;Point to the INTEGER array MOVEI T2,^D80 ;80 bytes COPYM0: MOVE T3,T2 ;Save original byte count HRLI S2,(POINT 7,) ;Source byte pointer COPYMS: ILDB S1,S2 ;Get a byte JUMPE S1,COPYDN ;Loop till after null at end of ASCIZ IDPB S1,T1 ;Store in ITEXT array SOJG T2,COPYMS ;Count chars and loop COPYDN: SUB T3,T2 ;Number of bytes transferred IDIVI T3,5 ;Make into word count MOVEM T3,@1(L) ;Nonzero for error flag MOVEI S1," " ;Blank out rest of array JUMPLE T2,DONE2 COPYD1: IDPB S1,T1 ;Store blanks at end of ITEXT SOJG T2,COPYD1 ;Exit with error flag in S2 DONE2: MOVE F,SAVEF ;Restore F (alias P1) POPJ P, ;Return from TOLP SUBTTL Exit from TOLP -- Error messages .DIRECTIVE FLBLST ;List only first line of ASCIZ NOEOP: JSP S2,ERROR ;Set S2 nonzero and return ASCIZ /Incomplete, PLOT(X,Y,999) not called / EMPTY: JSP S2,ERROR ASCIZ /Plot file was empty / ILLFMT: SUBI S1,2 ;For DDT, S1 points to PUSHJ or compare instr JSP S2,ERROR ASCIZ /Illegal format for PLOT file / EOHYER: JSP S2,ERROR ASCIZ ~Y position not zero at EOH/SOT ~ OPRABT: JSP S2,ERROR ASCIZ /Plot aborted by OPR / SUBTTL Input routines, GETWRD and GETHLF ;Routine to get a 36 bit word from 2 consecutive halfwords. ;Note: The 2 halfwords might not be in the same fullword in the file GETWRD: PUSHJ P,GETHLF ;Get first half POPJ P, ;Error, T1 has -1 or -2 HRLM T1,(P) ;Save on stack PUSHJ P,GETHLF ;Get 2nd half POPJ P, ;Error HLL T1,(P) ;Combine the 2 halves CPOPJ1: AOS (P) ;Make for skip return CPOPJ: POPJ P, ;Routine to get an 18 bit halfword from the input file ;CALL: PUSHJ P,GETHLF ; JRST ATEOF or JRST BADEOF ; *good return* Data in T1 GETHLF: SKIPL INDATA ;Is the sign bit set? JRST READWD ;No, call external routine to read a word HRRZS T1,INDATA ;Yes, clear sign bit and return halfword in T1 JRST CPOPJ1 ;Give skip return ;Interface for subroutine READER(INDATA) -1,,0 ;1 arg for subroutine READER LREADR: INTEGER INDATA ;Argument is an integer variable READWD: MOVEM 0,SAVEAC+0 ;Save all ACs MOVE 0,[1,,SAVEAC+1] BLT 0,SAVEAC+16 TXNN F,F.GLX ;If called from a FORTRAN program, XMOVEI L,LREADR ;Set up arg pointer PUSHJ P,@INPRTN ;Read one word into INDATA .CREF F.GLX ;Cref this use of the sign bit SKIPGE SAVEAC+F ;If called from SPROUT, MOVEM S1,INDATA ; store data in right place MOVSI 16,SAVEAC+0 ;Restore ACs BLT 16,16 MOVE T1,INDATA ;Get the word read in CAME T1,[-1] ;Did READER return EOF marker? CAMN T1,[-2] ; or ABORT marker? POPJ P, ;Yes, give error return HRROM T1,INDATA ;Set sign bit for next time HLRZS T1 ;Put halfword in RH JRST CPOPJ1 ;Give skip return SUBTTL Interface to external subroutines ;Interface to subroutine PLOT(XPOS,YPOS,IC) -3,,0 ;3 args for subroutine PLOT LPLOT: REAL PLOTX ;X coord in floating point REAL PLOTY ;Y coord in F.P. INTEGER PLOTI ;Function code (2 or 3) in integer .CREF F.GLX ;Cref this use of the sign bit EXPLOT: JUMPL F,GPLOT ;Jump if F.GLX is set for GLXLIB MOVE T1,X ;Get X increments IDIV T1,MAXINC ;Wraparound on the TEK screen FSC T2,233 ;Convert to FP increments FDVR T2,[INCS] ;Convert to FP inches MOVEM T2,PLOTX SKIPE T1 ;If X was clipped, CLIPX: CAM T1,PLOTX ; put a DDT breakpoint here MOVE T1,Y ;Same for Y IDIV T1,MAXINC ;Wraparound on the TEK screen FSC T2,233 FDVR T2,[INCS] MOVEM T2,PLOTY SKIPE T1 CLIPY: CAM T1,PLOTY MOVEM F,SAVEF ;Save flag AC XMOVEI L,LPLOT ;Point to FORTRAN args PUSHJ P,PLOT## ;Call routine from FORLIB MOVE F,SAVEF ;Restore AC POPJ P, ;Call to SPROUT. It preserves the flags in F (alias P1) GPLOT: DMOVE T1,XORIG ;Get SPROUT's offsets ADD T1,X ;Position in increments ADD T2,Y MOVE T3,PLOTI ;Pen up/down code PJRST PLOT## ;Call routine in SPROUT PAGE ;Interface to subroutine NEWPEN(IPEN) -1,,0 ;1 arg for subroutine NEWPEN LNEWPN: INTEGER ICOUNT ;Pen number, integer 1 to 4 NEWPN: MOVEM S1,ICOUNT ;Store pen number MOVEM F,SAVEF ;Save flags TXNN F,F.GLX ;If called from a FORTRAN program, XMOVEI L,LNEWPN ; point to arg list PUSHJ P,NEWPEN## ;Call external subroutine MOVE F,SAVEF ;Restore flags POPJ P, ;Interface to subroutine OPRTXT(MESAGE,NCHAR) -2,,0 ;2 args for OPRTXT LOPRTX: STRING MESAGE ;ASCIZ string (not a CHARACTER variable) INTEGER ICOUNT ;Number of characters in MESAGE OPRTX: MOVE S1,ICOUNT ;Get number of characters in message MOVEI S2,MESAGE ;Address of string MOVEM F,SAVEF ;Save flags TXNN F,F.GLX ;If called from a FORTRAN program, XMOVEI L,LOPRTX ; point to arg list PUSHJ P,OPRTXT## ;Call external subroutine MOVE F,SAVEF ;Restore flags POPJ P, PAGE ;Interface to subroutine PAUSEP(ISEC) -1,,0 ;1 arg for subroutine PAUSEP LPAUSE: INTEGER ICOUNT ;Number of seconds PAUSE: MOVE S1,T1 ;Put seconds in right AC MOVEM S1,ICOUNT ;Store number of seconds (0=until OPR responds) MOVEM F,SAVEF ;Save flags TXNN F,F.GLX ;If called from a FORTRAN program, XMOVEI L,LPAUSE ; point to arg list PUSHJ P,PAUSEP## ;Call external subroutine MOVE F,SAVEF ;Restore flags POPJ P, ;Interface to subroutine TITLE(X,Y,HEIGHT,MESAGE,ANGLE,ICOUNT) -6,,0 ;6 args for subroutine TITLE LTITLE: REAL PLOTX ;Use current position REAL PLOTY REAL HEIGHT ;Size of characters (T1) INTEGER MESAGE ;Text (T2) REAL ANGLE ;Direction (T3) INTEGER ICOUNT ;Byte count (T4) TITLEX: MOVE T1,HEIGHT ;Get args XMOVEI T2,MESAGE MOVE T3,ANGLE MOVE T4,ICOUNT .CREF F.GLX ;Cref use of sign bit JUMPL F,TITLE## ;Args in T1-T4 for SPROUT FSC T1,233 ;Convert height to increments floating point FDVR T1,[INCS] ;Convert to inches MOVEM T1,HEIGHT FSC T3,233 ;Convert degrees to floating point MOVEM T3,ANGLE MOVEM F,SAVEF ;Save flags XMOVEI L,LTITLE ;Point to args PUSHJ P,TITLE## ;Call routine from FORLIB MOVE F,SAVEF ;Restore flags POPJ P, SUBTTL Format of a .PLT file ; !===============================================================! ; ! PLOTTER MODE -- 18 BIT ! ; ! ! ; ! In 18 bit mode, each halfword from the disk has 9 bits of ! ; ! delta Y and 9 bits of delta X movement. If the delta Y part ! ; ! is negative zero, then the X part is an op-code (such as to ! ; ! raise or lower the pen). The only exception is in LONG mode, ! ; ! where the deltas come in halfword pairs. The first of the ! ; ! pair is 16 bits of delta Y with 1 bit pen-down information ! ; ! (the OPCODE bit always zero), and the second byte is 18 bits ! ; ! of delta X. At 400 steps per inch, max X is 327 inches, and ! ; ! max Y is 81 inches (27 by 6.75 feet) ! ; ! ! ; !===============================================================! ; ; ! SGNY ! ABS(Delta Y) ! SGNX ! ABS(Delta X) ! ;SHORT mode ; !=1B18=!=====377B26=====!=1B27=!====377B35====! ; ; ! 1 ! 0 ! Operation code ! ;OPCODE ; !=1B18=!=====377B26=====!=======777B35========! ; ; ! 0 ! PEN ! SGNY ! ABS(Delta Y) ! ;1st LONG byte (Y) ; !=1B18=!=1B19=!=1B20=!========77777B35========! ; ; ! SGNX ! ABS(Delta X) ! ;2nd LONG byte (X) ; !=1B18=!=====================377777B35========! ;Definitions for Plot Data (PD.xxx) PD.SYS==400000 ;Short mode Y sign PD.SYM==377000 ;Short mode Y magnitude PD.SXS== 400 ;Short mode X sign PD.SXM== 377 ;Short mode Y magnitude PD1000= 1000 ;IDIVI by this to separate DY and DX PD.LSH== -9 ;After IDIVI, Y is shifted this much PD.OPC==400000 ;OPCODE if PD.SYM is zero PD.LPD==200000 ;Long mode pen down (in 1st word) PD.LYS==100000 ;Long mode Y sign (in 1st word) PD.LYM== 77777 ;Long mode Y magnitude (in 1st word) PD.LXS==400000 ;Long mode X sign (in 2nd word) PD.LXM==377777 ;Long mode X magnitude (in 2nd word) ;Bits from optional Plot Flag byte (PF.xxx) PF.400==200000 ;Plot flag - using 400 increments per inch PF.PEN==100000 ;Plot flag - using more than one pen PF.OPR== 40000 ;Plot flag - OPRTXT routine present PF.HDR== 20000 ;Plot flag - header/trailer in ASCIZ PD.FLG==PF.400!PF.PEN!PF.OPR!PF.HDR ;All defined flags %D400=^D400 ;400 increments per inch SUBTTL Main input loop ;Here to interpret each new halfword from the input file PLTME: PUSHJ P,GETHLF ;Go get a half word JRST ATEOF ;End of file PLTME1: TRNN T1,PD.SYM ;Does Y look like -infinity? TRZN T1,PD.OPC ;Yes, was the OPCODE bit set? JRST PLT ;No, plot the line segment and loop to PLTME CAIL T1,PLTMAX ;Skip if the function is valid JSP S1,ILLFMT ;Illegal opcode, go die PUSHJ P,@PLTFNC(T1) ;Go do the right thing JRST PLTME ;And go for more ;End of file processing ATEOF: CAMN T1,[-2] ;Abort? JRST OPRABT ;Yes, OPR aborted plot TXNN F,F.MOVE ;Any movements with the pen down? JRST EMPTY ;Error, plot file was empty TXNN F,F.EOP ;End-Of-Plot opcode seen? JRST NOEOP ;No, complain JRST DONE0 ;Yes, plot finished normally (S2=0) SUBTTL Process halfwords PLT: TXNE F,F.LONG ;Long mode? JRST PLT0 ;Yes, 2 halfwords per move ;Short mode - each halfword is 9 bits of Y and 9 bits of X IDIVI T1,PD1000 ;Put DY into T1, DX into T2 TRZE T1,PD.SYS_PD.LSH;If the Y sign bit is on, MOVNS T1 ; negate the magnitude TRZE T2,PD.SXS ;If the X sign bit is on, MOVNS T2 ; negate the magnitude JRST PLT1 ;Go update X & Y ;Long mode - Y is in this halfword, X is in the next PLT0: TRZE T1,PD.LPD ;If the pen is to be down, TXOA F,F.DOWN ; set the pen down flag, TXZ F,F.DOWN ; else clear it MOVE T2,T1 ;Save DY PUSHJ P,GETHLF ;Get next byte JRST ATEOF ;Should not get EOF here EXCH T1,T2 ;Get DX & DY in the right place TRZE T1,PD.LYS ;If the Y sign bit is on, MOVNS T1 ; use the negative TRZE T2,PD.LXS ;Same for X MOVNS T2 ; ... MOVM S1,T2 ;Get ABS(X) MOVM S2,T1 ;Get ABS(Y) CAMG S1,MAXINC ;Very large delta X? CAMLE S2,MAXINC ; or delta Y? PUSHJ P,TOOBIG ;Yes, trigger DDT breakpoint ;Calculate new position based on delta-X and delta-Y PLT1: ADDM T2,X ;Add incremental to X position ADDM T1,Y ;Make new Y ;Conditionally ignore the header stored in the PLT file TXNE F,F.HEAD ;In the header? TXNE F,F.DOHD ;And header is wanted? TRNA ;Continue JRST PLTME ;Do not plot the header TXNE F,F.TRAL ;In the trailer? TXNE F,F.DOTR ;And trailer wanted? TRNA ;Continue JRST PLTME ;Do not plot the trailer PAGE ;Continued on next page ;Set the pen up/down code based on F.DOWN MOVEI T1,PEN.UP ;Assume movement with the pen up TXNN F,F.DOWN ;OK? JRST PLT2 ;Yes MOVEI T1,PEN.DN ;No, pen down this move TXNE F,F.PLOT ;In the body of the plot? TXO F,F.MOVE ;Yes, at least 1 move with the pen down PLT2: MOVEM T1,PLOTI ;Store function code PUSHJ P,EXPLOT ;Move the pen ;Pen-up lasts for 1 move in short mode, and is recalculated in long mode TXNN F,F.V11 ;Version 11? TXO F,F.DOWN ;SHORT-UP lasts for 1 move in version 12 JRST PLTME ;Loop back for more data ;Here when long-mode has an unreasonable movement ;This routine is here only for using DDT on the TEK program TOOBIG: MOVE S1,T2 ;Get X (with sign) FSC S1,233 ;To f.p. FDVR S1,[INCS] MOVE S2,T1 ;Get Y (with sign) FSC S2,233 FDVR S2,[INCS] CLIPIT::CAM S1,S2 ;Put a DDT breakpoint here POPJ P, ;This command string works for DDT version 41 or later $FS1S2: ASCIZ ~F S1/ S2/~ ;Use $FS1S2>CLIPIT$B SUBTTL Opcode dispatch and handlers PLTFNC: SHTUP ; 0 - short mode - pen up SHTDWN ; 1 - short mode - pen down LNGUP ; 2 - long mode - pen up LNGDWN ; 3 - long mode - pen down EOP ; 4 - end-of-plot EOH ; 5 - end-of-header (or start-of-trailer) MSGOPR ; 6 - message to the operater PLTPAS ; 7 - pause output the plotter (no-op in TEK) PEN1 ;10 - use pen #1 PEN2 ;11 - use pen #2 PEN3 ;12 - use pen #3 PEN4 ;13 - use pen #4 PEN5 ;14 - use pen #5 PEN6 ;15 - use pen #6 PEN7 ;16 - use pen #7 PEN8 ;17 - use pen #8 TEXT ;20 - use hardware text generator DELAY ;21 - pause graphics terminal for a few seconds REPEAT 0,< COLOR ;22 - RGB color specifier > ;End of REPEAT 0 PLTMAX==.-PLTFNC ;Highest value + 1 ;400000 Short mode, pen up ;400001 Short mode, pen down SHTUP: TXZA F,F.DOWN ;Clear pen down flag SHTDWN: TXO F,F.DOWN ;Set the pen down flag TXZ F,F.LONG ;Clear long mode flag POPJ P, ;400002 Long mode, pen up ;400003 Long mode, pen down LNGUP: ;Use PD.LPD in next byte for pen up/down status LNGDWN: TXO F,F.LONG ;Set long mode flag POPJ P, ;Go get somemore data ;400004 End of plot EOP: TXO F,F.EOP ;End of plot seen POPJ P, PAGE ;400005 End of header, or start of trailer EOH: TXZN F,F.HEAD ;During the header? JRST SOT ;No, start of trailer TXO F,F.PLOT ;Yes, end of header, start of plot TXNN F,F.DOHD ;If header was plotted TXNE F,F.V11 ; or version 11 POPJ P, ;Keep X and Y the same SETZM X ;Version 12, reset X position to start plot SKIPN Y ;Y position should be zero POPJ P, JSP S1,EOHYER ;End of header Y error SOT: MOVEI T1,PEN.UP ;Raise pen, but stay PUSHJ P,EXPLOT ; at current position TXO F,F.TRAL ;Start of trailer TXZ F,F.PLOT ;End of body of plot TXNN F,F.V11 ;Version 11? SKIPN Y ;Or Y position zero? POPJ P, ;OK JSP S1,EOHYER ;Start of Trailer Y error ;400006 Message for the OPR MSGOPR: PUSHJ P,GETHLF ;Go get the word count of the message JRST BADEOF ;Bad plot file MOVE T2,T1 ;Copy word count IMULI T1,5 ;Convert to a byte count MOVEM T1,ICOUNT ;Save for a while MOVEI T3,0 ;Set index pointer MSGOP0: PUSHJ P,GETWRD ;Go get a word JRST BADEOF ;Bad plot file CAIGE T3,MSGMAX ;More than we can handle? MOVEM T1,MESAGE(T3) ;No, store it ADDI T3,1 ;Point to next word in MESAGE SOSG T2,MSGOP0 ;If more words left go get'm PJRST OPRTX ;Send message via OPRTXT ;Unexpected EOF BADEOF: POP P,(P) ;Dump the return for PUSHJ P,@PLTFNC(T1) JRST ATEOF ;Ignore this OPCODE, finish up ;400007 Pause, wait for OPR intervention PLTPAS: MOVEI T1,0 ;Zero seconds means indefinately PJRST PAUSE ;Pause the plotter PAGE ;400010-400017 Set pen number, 1 to 8 PEN1: PEN2: PEN3: PEN4: PEN5: PEN6: PEN7: PEN8: SUBI T1,7 ;Get pen number, 1 to 8 EXCH T1,PENSAV ;Save the new pen number SUB T1,PENSAV ;Find how many pens over to move IMULI T1,PENSEP ;Find how many plot increments that is TXNE F,F.V11 ;If version 11 (which has only pens 1-3), ADDM T1,Y ; cancel the next 0.75 inch Y offset MOVE S1,PENSAV ;New pen number in S1 PJRST NEWPN ;Change pen ;400020 Use hardware character generator ;1st HW BYTE(9)DIR,CNT ;DIR = 0 to 359 degrees, CNT = 1 to 511 bytes ;2nd HW BYTE(18)HITE ;HITE = Size in increments ;rest BYTE(7)TEXT ;TEXT = Up to 102 words of text TEXT: PUSHJ P,GETHLF ;Get direction and number of chars JRST BADEOF IDIVI T1,1000 ;Separate direction from count MOVEM T1,ANGLE ;Store integer degrees MOVEM T2,ICOUNT ;Store byte count ADDI T2,4 ;Round up IDIVI T2,5 ;Make into word count PUSHJ P,GETHLF ;Get size JRST BADEOF MOVEM T1,HEIGHT ;Save size in increments (integer) MOVEI T4,MESAGE ;Point to message area TEXT1: PUSHJ P,GETWRD ;Get next word JRST BADEOF CAIGE T4,MESAGE+MSGMAX;If not too much, MOVEM T1,(T4) ; store word of text ADDI T4,1 ;Point to next word in message area SOJG T2,TEXT1 ;Get all PJRST TITLEX ;Call external subroutine ;400021 Delay if going to graphics terminal DELAY: PUSHJ P,GETHLF ;Get number of seconds JRST BADEOF ;Error-end of file PJRST PAUSE ;T1 has number of seconds to delay REPEAT 0,< ;400022 Get 18 bits of RGB data COLOR: PUSHJ P,GETHLF ;Get next halfword JRST BADEOF ;T1 gets BYTE(6)RED,GREEN,BLUE POPJ P, ;Ignore it for now > ;End of REPEAT 0 SUBTTL Data area RELOC ;From calling program INPRTN: BLOCK 1 ;Addr of input routine SAVEL: BLOCK 1 ;Accumulator L SAVEF: BLOCK 1 ;Flags MAXINC: BLOCK 1 ;Maximum size before wraparound ;For subroutine PLOT PLOTX: BLOCK 1 ;X coordinate in inches (floating point) PLOTY: BLOCK 1 ;Y coord PLOTI: BLOCK 1 ;Function code to PLOT, 2 or 3 ;Current pen status X: BLOCK 1 ;Current X position (integer increments) Y: BLOCK 1 XORIG: BLOCK 2 ;Offset provided by SPROUT YORIG=XORIG+1 PENSAV: BLOCK 1 ;Current pen number ;For GETWRD SAVEAC: BLOCK 1+16 ;ACs 0-16 INDATA: BLOCK 1 ;Word read from input file MSGMAX=^D300/5 ;Max chars in message to OPRTXT MESAGE: BLOCK MSGMAX ICOUNT: BLOCK 1 ;Temporary integer ANGLE: BLOCK 1 ;Direction for TITLE HEIGHT: BLOCK 1 ;Size for TITLE INFLAG: BLOCK 1 ;Input file flag bits RELOC LITS: END