Trailing-Edge
-
PDP-10 Archives
-
decuslib10-12
-
43,50547/pltlib/sprout/tolps.mac
There is 1 other file named tolps.mac in the archive. Click here to see a list.
TITLE TOLP - Routine to read *.PLT files
SUBTTL Joe Smith, CSM, 13-Mar-84
; 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. Changed to index all variables using J, 13-Mar-84.
; Table of Contents for TOLP - Reverse PLOT
;
;
; Section Page
;
; 1. Calling sequence
; 1.1 MACRO programs (such as SPROUT) . . . . . . . 2
; 2. Definitions . . . . . . . . . . . . . . . . . . . . . 3
; 3. Entry to TOLP(READER,ICHAR,ITEXT) . . . . . . . . . . 4
; 4. Verify that the plot file starts correctly . . . . . . 5
; 5. Exit from TOLP
; 5.1 ERROR and DONE routines . . . . . . . . . . . 6
; 5.2 Error messages . . . . . . . . . . . . . . . . 7
; 6. Input routines, GETWRD and GETHLF . . . . . . . . . . 8
; 7. Interface to external subroutines . . . . . . . . . . 9
; 8. Format of a .PLT file . . . . . . . . . . . . . . . . 10
; 9. Main input loop . . . . . . . . . . . . . . . . . . . 11
; 10. Process halfwords . . . . . . . . . . . . . . . . . . 12
; 11. Opcode dispatch and handlers . . . . . . . . . . . . . 12
; 12. Data area . . . . . . . . . . . . . . . . . . . . . . 14
SUBTTL Calling sequence -- MACRO programs (such as SPROUT)
COMMENT ~
For SPROUT: (S1=1,S2=2,T1=3,T2=4,T3=5,T4=6,J=14,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,READ36 ;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 routine to process PLOT file
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
READ36: $CALL INPBYT ;Get a word
MOVE T1,C ;Copy to expected AC
JUMPT .POPJ ;Use it if OK
MOVNI T1,-1 ; else -1 for EOF
TXNE S,RQB+ABORT ;EOF caused by REQUE?
MOVNI T1,-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
P1=7 ;Flag bits
J=14 ;Pointer to data page
L=16 ;Link to FORTRAN arguments
P=17 ;PDL pointer
.XCREF S1,S2,T1,T2,T3,T4,P1,P ;CREF only J and TF
;Flag bits in F
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)
;Feature test switches
ND FORTRA,0 ;0=SPROUT calling sequence, -1=FORTRAN calls
IF2,<IFN FORTRA,<PRINTX [TOLP using FORTRAN calling conventions]>>
IF2,<IFE FORTRA,<PRINTX [TOLP for SPROUT]>>
PAGE
;Argument types for FORTRAN-77 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== <Z 17,0> ;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),<<TYPE&ACFLD>_-^D23> ;For compare immediate
SUBTTL Entry to TOLP(READER,ICHAR,ITEXT)
ENTRY TOLP ;Name 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
;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
IFN FORTRA,<
; CALL TOLP(READER,IFLAG,ITEXT)
; READER = routine
; IFLAG = header flag bits
; ITEXT = message returned there
SIXBIT /TOLP/
TOLP: MOVEM L,SAVEL ;Save link to args
MOVEI S1,@0(L) ;Addr of reader routine
MOVE S2,@1(L) ;Flag bits
SETZB T1,T2 ;No offset
MOVEI J,J$DATA## ;Point to data area
> ;End of IFN FORTRA
IFE FORTRA,< TOLP.::
;Entry to TOLP from SPROUT, TF is scratch
;S1/ addr of input routine
;S2/ 0 if /NOHEADER, 3 if /HEADER
;T1/ J$XPOS(J) T2/ J$YPOS(J)
TOLP:> ;End of IFE FORTRA
MOVEM P1,SAVEP1(J) ;Preserve P1
MOVEI P1,0 ;Clear flags
MOVEM S1,INPRTN(J) ;Save address of input routine
TROE S2,1 ;Do the header?
TXO P1,F.DOHD ;Yes
TROE S2,2 ;Trailer?
TXO P1,F.DOTR ;Yes
CAIG S2,^D<7*400> ;Want a reasonable wraparound value?
MOVX S2,1B17 ;No, set to no wrap
MOVEM S2,MAXINC(J) ;Increments will be modulo this number
DMOVEM T1,XORIG(J) ;Set current X and Y positions
SETZM INDATA(J) ;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 P1,F.V11 ;No, must use kludges
;Initialize incremental pen position
SETZB T1,CUR.X(J) ;Simulate CALL PLOT(0.0,0.0,3)
SETZB T2,CUR.Y(J) ; to lift pen at current position
MOVEI T3,PEN.UP
MOVEM T3,PLOTI(J)
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 P1,F.V11 ;Use them if version 11
SETZB T1,T2 ; since version 12 is fixed
TXNE P1,F.DOHD ;Is the header wanted?
MOVEI T1,0 ;Yes, put it on the screen
MOVEM T1,CUR.X(J) ;Set X and
MOVEM T2,CUR.Y(J) ; Y positions
MOVEI T1,1 ;Current pen is #1
MOVEM T1,PENSAV(J) ;(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(J) ;Save input file flags (not used yet)
JRST GET1ST ;Go for opcode
SOH: TXO P1,F.HEAD ;Now in start of header
JRST PLTME1 ;Jump into main loop
SUBTTL Exit from TOLP -- ERROR and DONE routines
.DIRECTIVE FLBLST ;List only first line of ASCIZ
ILLFMT: SUBI S1,2 ;For DDT, S1 points to PUSHJ or compare instr
JSP S2,ERROR ;S2 points to error message
ASCIZ /Illegal format for PLOT file /
NOEOP: JSP S2,ERROR
ASCIZ /Incomplete, PLOT(X,Y,999) not called /
EMPTY: JSP S2,ERROR
ASCIZ /Plot file was empty /
OPRABT: JSP S2,ERROR
ASCIZ /Plot aborted by OPR /
;Exit from TOLP
DONE0: MOVEI S2,0 ;No errors detected
ERROR: PUSH P,S2 ;Save error flag
MOVEI T3,PEN.UP ;Raise the pen
MOVEM T3,PLOTI(J)
PUSHJ P,EXPLOT ;At current position
POP P,S2
IFN FORTRA,<
MOVE L,SAVEL ;Restore FORTRAN arg pointer
SETZM @1(L) ;Clear error flag
DONE1: 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
> ;End of IFN FORTRA
;Exit with error flag in S2
DONE2: MOVE P1,SAVEP1(J) ;Restore P1
POPJ P, ;Return from TOLP
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.0 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 P1,F.MOVE ;Any movements with the pen down?
JRST EMPTY ;Error, plot file was empty
TXNN P1,F.EOP ;End-Of-Plot opcode seen?
JRST NOEOP ;No, complain
JRST DONE0 ;Yes, plot finished normally (S2=0)
SUBTTL Process halfwords
PLT: TXNE P1,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 P1,F.DOWN ; set the pen down flag,
TXZ P1,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(J) ;Very large delta X?
CAMLE S2,MAXINC(J) ; or delta Y?
PUSHJ P,TOOBIG ;Yes, trigger DDT breakpoint
;Calculate new position based on delta-X and delta-Y
PLT1: ADDM T2,CUR.X(J) ;Add incremental to X position
ADDM T1,CUR.Y(J) ;Make new Y
;Conditionally ignore the header stored in the PLT file
TXNE P1,F.HEAD ;In the header?
TXNE P1,F.DOHD ;And header is wanted?
TRNA ;Continue
JRST PLTME ;Do not plot the header
TXNE P1,F.TRAL ;In the trailer?
TXNE P1,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 P1,F.DOWN ;OK?
JRST PLT2 ;Yes
MOVEI T1,PEN.DN ;No, pen down this move
TXNE P1,F.PLOT ;In the body of the plot?
TXO P1,F.MOVE ;Yes, at least 1 move with the pen down
PLT2: MOVEM T1,PLOTI(J) ;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 P1,F.V11 ;Version 11?
TXO P1,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 P1,F.DOWN ;Clear pen down flag
SHTDWN: TXO P1,F.DOWN ;Set the pen down flag
TXZ P1,F.LONG ;Clear long mode flag
POPJ P, ;Return from PUSHJ P,@PLTFNC(T1)
;400002 Long mode, pen up
;400003 Long mode, pen down
LNGUP: ;Use PD.LPD in next byte for pen up/down status
LNGDWN: TXO P1,F.LONG ;Set long mode flag
POPJ P, ;Return from PUSHJ P,@PLTFNC(T1)
;400004 End of plot
EOP: TXO P1,F.EOP ;End of plot seen
POPJ P, ;Return from PUSHJ P,@PLTFNC(T1)
PAGE
;400005 End of header, or start of trailer
EOH: TXZN P1,F.HEAD ;During the header?
JRST SOT ;No, start of trailer
TXO P1,F.PLOT ;Yes, end of header, start of plot
TXNN P1,F.DOHD ;If header was plotted
TXNE P1,F.V11 ; or version 11
POPJ P, ;Keep X and Y the same
SETZM CUR.X(J) ;Version 12, reset X position to start plot
SKIPE S1,CUR.Y(J) ;Y position should be zero
EOHYER: JFCL S1 ;End of header Y error
POPJ P, ;Return from PUSHJ P,@PLTFNC(T1)
SOT: MOVEI T1,PEN.UP ;Raise pen, but stay
PUSHJ P,EXPLOT ; at current position
TXO P1,F.TRAL ;Start of trailer
TXZ P1,F.PLOT ;End of body of plot
TXNE P1,F.V11 ;Version 11?
POPJ P, ;Yes, position is unpredictable
SKIPE S1,CUR.Y(J) ;Or Y position zero?
SOTYER: JFCL S1 ;Start of Trailer Y error
POPJ P, ;Return from PUSHJ P,@PLTFNC(T1)
;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(J) ;Save for a while
MOVEI T3,MESAGE(J) ;Set index pointer
HRLI T3,-MSGMAX ;AOBJN pointer
MSGOP0: PUSHJ P,GETWRD ;Go get a word
JRST BADEOF ;Bad plot file
SKIPGE T3 ;More than we can handle?
MOVEM T1,(T3) ;No, store it
AOBJN T3,.+1 ;Increment pointer
SOSG T2,MSGOP0 ;Get rest of message
PUSHJ P,OPRTX ;Send message via OPRTXT
POPJ P, ;Return from PUSHJ P,@PLTFNC(T1)
;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
PUSHJ P,PAUSE ;Pause the plotter
POPJ P, ;Return from PUSHJ P,@PLTFNC(T1)
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(J) ;Save the new pen number
SUB T1,PENSAV(J) ;Find how many pens over to move
IMULI T1,PENSEP ;Find how many plot increments that is
TXNE P1,F.V11 ;If version 11 (which has only pens 1-3),
ADDM T1,CUR.Y(J) ; cancel the next 0.75 inch Y offset
PUSHJ P,NEWPN ;Change pen
POPJ P, ;Return from PUSHJ P,@PLTFNC(T1)
;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(J) ;Store integer degrees
MOVEM T2,ICOUNT(J) ;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(J) ;Save size in increments (integer)
MOVEI T4,MESAGE(J) ;Point to message area
HRLI T4,-MSGMAX ;AOBJN pointer
TEXT1: PUSHJ P,GETWRD ;Get next word
JRST BADEOF
SKIPGE T4 ;If not too much,
MOVEM T1,(T4) ; store word of text
AOBJN T4,.+1 ;Point to next word in message area
SOJG T2,TEXT1 ;Get all
PUSHJ P,TITLEX ;Call external subroutine
POPJ P, ;Return from PUSHJ P,@PLTFNC(T1)
;400021 Delay if going to graphics terminal
DELAY: PUSHJ P,GETHLF ;Get number of seconds
JRST BADEOF ;Error-end of file
PUSHJ P,PAUSE ;T1 has number of seconds to delay
POPJ P, ;Return from PUSHJ P,@PLTFNC(T1)
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 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(J) ;Is the sign bit set?
JRST READWD ;No, call external routine to read a word
HRRZS T1,INDATA(J) ;Yes, clear sign bit and return halfword in T1
JRST CPOPJ1 ;Give skip return
;Interface for subroutine READER(INDATA)
IFN FORTRA,<
-1,,0
LREADR: INTEGER TEMP1 ;Word as 36-bit integer
READWD: MOVEI L,LREADR
> ;End of IFN FORTRA
IFE FORTRA,< READWD: >
MOVEM P1,FLAGS(J)
MOVE P1,SAVEP1(J)
PUSH P,J
PUSHJ P,@INPRTN(J) ;Read one word into T1
POP P,J
MOVEM P1,SAVEP1(J)
MOVE P1,FLAGS(J)
IFN FORTRA,<MOVE T1,TEMP1>
MOVEM T1,INDATA(J) ;Store it
CAME T1,[-1] ;Did READER return EOF marker?
CAMN T1,[-2] ; or ABORT marker?
POPJ P, ;Yes, give error return
HRROM T1,INDATA(J) ;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)
IFN FORTRA,<
-3,,0
LPLOT: REAL TEMP1 ;XPOS
REAL TEMP2 ;YPOS
INTEGER TEMP3 ;IC
EXPLOT: MOVE T1,CUR.X(J) ;Get X increments
IDIV T1,MAXINC(J) ;Wraparound on the TEK screen
FSC T2,233 ;Convert to FP increments
FDVR T2,[INCS] ;Convert to FP inches
MOVEM T2,TEMP1
SKIPE T1 ;If X was clipped,
CLIPX: CAM T1,TEMP1 ; put a DDT breakpoint here
MOVE T1,CUR.Y(J) ;Same for Y
IDIV T1,MAXINC(J) ;Wraparound on the TEK screen
FSC T2,233
FDVR T2,[INCS]
MOVEM T2,TEMP2
SKIPE T1
CLIPY: CAM T1,TEMP2
MOVE T1,PLOTI(J)
MOVEM T1,TEMP3
XMOVEI L,LPLOT ;Point to FORTRAN args
> ;End of FORTRA
IFE FORTRA,<
EXPLOT: DMOVE T1,XORIG(J) ;Get SPROUT's offsets
ADD T1,CUR.X(J) ;Position in increments
ADD T2,CUR.Y(J)
MOVE T3,PLOTI(J) ;Pen up/down code
> ;End of IFE FORTRA
MOVEM P1,FLAGS(J)
MOVE P1,SAVEP1(J)
PUSH P,J
PUSHJ P,PLOT##
POP P,J
MOVEM P1,SAVEP1(J)
MOVE P1,FLAGS(J)
POPJ P,
;Interface to subroutine NEWPEN(IPEN,IERR)
IFN FORTRA,<
-2,,0
LNEWPN: INTEGER TEMP1 ;IPEN
INTEGER TEMP2 ;IERR
> ;End of IFN FORTRA
NEWPN: MOVE S1,PENSAV(J) ;Get new pen number
IFN FORTRA,<
MOVEM S1,TEMP1
MOVEI L,LNEWPN
> ;End of IFN FORTRA
MOVEM P1,FLAGS(J)
MOVE P1,SAVEP1(J)
PUSH P,J
PUSHJ P,NEWPEN##
POP P,J
MOVEM P1,SAVEP1(J)
MOVE P1,FLAGS(J)
POPJ P,
;Interface to subroutine OPRTXT(MESAGE,NCHAR)
OPRTX: MOVE S1,ICOUNT(J) ;Get number of characters in message
MOVEI S2,MESAGE(J) ;Address of string
MOVEM P1,FLAGS(J)
MOVE P1,SAVEP1(J)
PUSH P,J
PUSHJ P,OPRTXT##
POP P,J
MOVEM P1,SAVEP1(J)
MOVE P1,FLAGS(J)
POPJ P,
;Interface to subroutine PAUSEP(ISEC)
PAUSE: MOVE S1,T1 ;Put seconds in right AC
MOVEM P1,FLAGS(J)
MOVE P1,SAVEP1(J)
PUSH P,J
PUSHJ P,PAUSEP##
POP P,J
MOVEM P1,SAVEP1(J)
MOVE P1,FLAGS(J)
POPJ P,
;Interface to subroutine TITLE(XSTART,YSTART,HEIGHT,MESAGE,ANGLE,ICOUNT)
TITLEX: MOVE T1,HEIGHT(J) ;Get args
MOVEI T2,MESAGE(J)
MOVE T3,ANGLE(J)
MOVE T4,ICOUNT(J)
MOVEM P1,FLAGS(J)
MOVE P1,SAVEP1(J)
PUSH P,J
PUSHJ P,TITLE##
POP P,J
MOVEM P1,SAVEP1(J)
MOVE P1,FLAGS(J)
POPJ P,
SUBTTL Data area
EXTERN TOLPBF,J$$END ;For .ASSIGN
DEFINE LP(NAME,SIZE),< NAME=TOLPBF+<..=J$$.>
J$$.==J$$.+SIZE
..==..>
J$$.==0
;From calling program
LP SAVEP1, 1 ;Preserve P1
LP FLAGS, 1 ;Flags (in P1)
LP INPRTN, 1 ;Addr of input routine
LP MAXINC, 1 ;Maximum size before wraparound
;For subroutine PLOT
LP PLOTX, 1 ;X coordinate in inches (floating point)
LP PLOTY, 1 ;Y coord
LP PLOTI, 1 ;Function code to PLOT, 2 or 3
;Current pen status
LP CUR.X, 1 ;Current X position (integer increments)
LP CUR.Y, 1
LP XORIG, 2 ;Offset provided by SPROUT
YORIG=XORIG+1
LP PENSAV, 1 ;Current pen number
;For GETWRD
LP INDATA, 1 ;Word read from input file
LP INFLAG, 1 ;Input file flag bits
;For TITLE and OPRTXT
MSGMAX=^D300/5 ;Max chars in message to OPRTXT
LP ICOUNT, 1 ;Temporary integer
LP ANGLE, 1 ;Direction for TITLE
LP HEIGHT, 1 ;Size for TITLE
LP MESAGE, MSGMAX
..==J$$.
.ASSIGN TOLPBF,J$$END,J$$. ;TOLPBF=J$$END, J$$END=J$$END+J$$.
TOLP..=:J$$END-1 ;Last data loc used by this routine
PURGE ..
IFN FORTRA,<
SAVEL: BLOCK 1
TEMP1: BLOCK 1
TEMP2: BLOCK 1
TEMP3: BLOCK 1
TEMP4: BLOCK 1
>
LITS: END