Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-12 - 43,50547/pltlib/tek/tolp.mac
There is 1 other file named tolp.mac in the archive. Click here to see a list.
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== <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,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