<div id='wikitext'>
<pre><b> File: PXPLOT.SB of Tape: Sources/Other/new-14</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
/ SABR SUBROUTINE PACKAGE TO HELP PLOT PROGRAMS
/
/ PACKAGE ASSUMES A PLOT AREA OF 128 COLS BY 128 LINES
/ SPLIT INTO 384 BLOCKS (16 BLOCKS IN X-DIRECTION, 24 IN Y-DIRECTION)
/ EACH BLOCK IS (4 WORDS=8 CHARS=48 BITS) TIMES (64 LINES)
/
/ THE WHOLE PLOT AREA IS HELD IN SWAP FILE SYS:PLOT.IM
/ 12 DIFFERENT MOST RECENTLY USED BLOCKS ARE IN CORE
/
/
/ CALL PLOTO	INITIALISES PLOTTING ROUTINES.
/
/ CALL PLOTC	CLOSES THE PLOT AND CHAINS TO CCLDEV:PXPB.SV
/		TO SEND PLOT TO LPT:
/
/ CALL PLOT(IF,IX,IY)	DOES THE ACTUAL PLOTTING. IF IS A FUNCTION CODE
/		DEFINING WHAT PLOTTING FUNCTION IS TO BE INVOKED.
/
/		IF=0	ESTABLISH ORIGIN AT ABSOLUTE COORDINATES IX,IY.
/			ANY FUTURE (X,Y) POINT WILL BE RELATIVE TO THE
/			ORIGIN RATHER THAN (0,0) (THE DEFAULT).
/
/		IF=1	ESTABLISH ORIGIN AT RELATIVE COORDINATES IX,IY.
/			THE ORIGIN IS MOVED TO POINT (IX,IY) RELATIVE TO
/			ITS OLD POSITION.
/
/		IF=2	START DRAWING AT POINT (IX,IY).  THIS COMMAND
/			ESTABLISHES THE START OF A NEW LINE,
/			BUT DOES NOT DO ANY PLOTTING.
/
/		IF=3	DRAW TO POINT (IX,IY).  A STRAIGHT LINE IS DRAWN
/			FROM THE CURRENT POSITION TO THE GIVEN POINT.
/			THE NEW CURRENT POSITION IS AT THE FINAL POINT,
/			&amp; ANOTHER &quot;DRAW TO&quot; COMMAND WILL DRAW FROM THE
/			END OF THE FIRST LINE.  THE CURRENT POSITION IS
/			UNDEFINED AFTER AN ORIGIN COMMAND, OR AT THE
/			START OF PLOTTING, AND A &quot;DRAW TO&quot; COMMAND AT
/			THIS TIME WILL GIVE A NON-FATAL &quot;PLTI&quot; ERROR.
/
/ ALL COORDINATES SPECIFIED FOR PLOTTING MUST LIE WITHIN THE PLOT,
/  OTHERWISE &quot;PLTI&quot; ERRORS WILL RESULT.
\JPLOT,	COMMN 3000	/ RESERVE COMMON FOR PLOT IMAGE (12 BLOCKS)
\JEXTR,	COMMN 2600	/ *KLUDGE* \JPLOT REALLY STARTS AT 10000
\JCHRS,	COMMN 1400	/ CHARACTER PICTURES (START AT 16000)
\ICOMM,	COMMN 1		/ WILL BE AT 17400
\FNAME,	COMMN 3
\IGREC,	COMMN 1
\IGCHR,	COMMN 1
\IDUDS,	COMMN 33
\IDASH,	COMMN 1
\IDSHC,	COMMN 1
\IDSHP,	COMMN 1
\X0,	COMMN 3
\Y0,	COMMN 3			/ONLY COMMON IN FIELD 1 !!!!!
\FAKTX,	COMMN 3
\FAKTY,	COMMN 3
\IFONT,	COMMN 1
\DXW,	COMMN 3
\DYW,	COMMN 3
\DXH,	COMMN 3
\DYH,	COMMN 3

	OPDEF ANDI 0400
	OPDEF TADI 1400
	OPDEF ISZI 2400
	OPDEF DCAI 3400
	OPDEF JMSI 4400
	OPDEF JMPI 5400

	ENTRY PLOTO
	ENTRY PLOTC
	ENTRY PLOT

	LAP
PLOTO,	BLOCK 2		/ OPEN PLOT
	TAD ^FN#
	DCA PSB
	IAC		/ SYS:
	6212		/ CIF 10
	JMS I ^7700	/ LOOKUP SYS:PLOT.IM
	2
PSB,	^PLOT		/ BECOMES START BLOCK
	0		/ BECOMES - LENGTH
	JMP ERR
	TAD PSB#	/ CHECK LENGTH (MUST BE 384 BLOCKS)
	TAD (600
	SZA CLA
	JMP ERR
	TAD (-6000	/ CLEAR PLOT FILE
	DCA PSB#
	CLA CMA		/ STARTS AT 0 !
	DCA 17
	6211
CLR,	DCAI 17
	ISZ PSB#
	JMP CLR

	TAD (-40
	DCA PSB#
	TAD PSB
	DCA CLRBL
CLRPF,	6202		/ CIF 0
	JMS I ^SYSH
	7010		/ WRITE 12 BLOCKS F1
	0000
CLRBL,	0
	JMP ERR
	TAD (14
	TAD CLRBL
	DCA CLRBL
	ISZ PSB#
	JMP CLRPF
	DCA AORGY	/ SET ORIGIN AT TOP LH CORNER (0,0)
	DCA AORGX
	DCA UNDEF	/ &amp; POSITION UNDEFINED
	RETRN PLOTO

PFW,	210		/ 1 BLOCK FIELD 1
^SYSH,	7607		/ ADDR OF SYS: HANDLER

SYSIO,	0		/ READ/WRITE (RELATIVE) BLOCK
	TAD PSB
	DCA BL		/ SAVE ABS BLOCK NO
	RAR		/ LINK = 1 FOR WRITE, 0 FOR READ
	TAD PFW		/ ADD &quot;1 BLOCK, FIELD 1&quot;
	DCA FW
	6202		/ CIF 0
	JMS I ^SYSH	/ CALL SYS HANDLER
FW,	0		/ READ/WRITE 1 BLOCK
XBASE,	0000		/ CURRENT BLOCK BASE
BL,	0		/ BLOCK ON DISK
	JMP ERR
	JMPI SYSIO

/ CLOSE PLOT
PLOTC,	BLOCK 2
	JMS SFAC	/ RESTORE &#039;FAC&#039; LOCATIONS
	TAD (-14	/ 12 BLOCKS TO SAVE
	DCA PSB#
	TAD ^ADD0	/ FIRST BLOCK (ANY ORDER)
	DCA PLOTO
PLCLP,	TADI PLOTO	/ GET BLOCK #
	DCA BL		/ TEMP
	INC PLOTO
	INC PLOTO	/ AT BASE
	TADI PLOTO
	DCA XBASE
	INC PLOTO
	INC PLOTO
	CLL CML
	TAD BL
	JMS SYSIO	/ WRITE ONE BLOCK
	ISZ PSB#	/ MORE ?
	JMP PLCLP
	TAD PSB		/ CHAIN ; SET UP CD TABLES
	6211
	DCAI (7620
	TAD (4001	/ 384 LENGTH MOD 256 = 128
	DCAI (7617	/ INPUT FROM PLOT FILE
	6201		/ CDF 0
	TADI (7776	/ GET CCL DEVNO
XX1,	6212		/ CIF 10
	JMS I ^7700	/ USR
	2		/ LOOKUP
PBBLK,	^PXPB		/ FILE PXPB.SV
	0
	JMP ERR		/ FATAL
	TAD PBBLK
	DCA PBCHN
	6201		/ CDF 0
	TADI (7756	/ CCL ENTRY POINT
	6212		/ CIF 10
	JMS I ^7700
	6		/ CHAIN
PBCHN,	0
/------------------------------
^7700,	7700
^ADD0,	ADD0
	PAGE
GPAR,	0		/ GET PARAMETER
CCDF,	NOP		/ CDF TO CALLING FIELD
	TADI PLOT#
	INC PLOT#
	DCA PCDF
	TADI PLOT#
	INC PLOT#
PCDF,	NOP		/ CDF TO PARAMETER FIELD
	DCA PCDF
	TADI PCDF	/ GET PARAMETER
	JMP I GPAR

PLOT,	BLOCK 2		/ MAIN PLOTTING ROUTINE
	TAD PLOT
	DCA CCDF
	JMS GPAR
	DCA MTEM
	JMS GPAR
	DCA NEWX
	JMS GPAR
	DCA NEWY
	TAD MTEM	/ WHAT OPERATION ?
	AND (7774
	SZA CLA
	JMP PLIER	/ OUTSIDE VALID RANGE
	TAD MTEM
	TAD ^SWTAB
	DCA MTEM
	TADI MTEM
	DCA MTEM
	JMPI MTEM	/ SWITCH TO APPROPRIATE ROUTINE
MTEM,	0

^SWTAB,	SWTAB

SWTAB,	AORG		/ SWITCH TABLE FOR PLOT CODES
	ORGN
	STRT
	TO

XIT,	CLA CLL CML RTL	/ 2; / EXIT FROM PLOT ROUTINES
	TAD CCDF
	DCA RCDI
	CALL 0,CLEAR	/ MESSY FAC
RCDI,	NOP		/ BECOMES CDF CIF RETURN FIELD
	JMPI PLOT#	/ RETURN


CKX,	0		/ SUBROUTINE TO CHECK X WITHIN BOUNDS
	SPA
	JMP PLIER	/ TOO SMALL
	TAD (-3000	/ 1536 DEC
	SMA
	JMP PLIER	/ TOO BIG
	TAD (3000
	JMPI CKX

STRT,	CLA IAC		/ START AT POINT
	DCA UNDEF	/ POSITION NOW DEFINED
	TAD NEWY
	TAD AORGY
	JMS CKY		/ CHECK Y WITHIN RANGE
	DCA THISY
	TAD AORGX
	TAD NEWX
	JMS CKX		/ CHECK X WITHIN RANGE
	DCA THISX

	TAD THISX	/ SET UP FOR OPTIMISED ARRAY ACCESS
	CALL 1,DIV
	ARG (100
	CLL RTL
	RTL
	DCA NBLK	/ REQUIRED BLOCK LINE
	CALL 1,IREM
	ARG 0
	DCA XBIT	/ LINE WITHIN BLOCK
	TAD XBIT
	CLL RTL
	DCA XPLOT	/ WORD LINE IN BLOCK
	TAD THISY
	CALL 1,DIV
	ARG (60
	TAD NBLK
	DCA NBLK	/ REQUIRED BLOCK
	CALL 1,IREM
	ARG 0
LL,	TAD (-14
	SPA
	JMP LE
	INC XPLOT	/ WORD IN LINE
	JMP LL
LE,	TAD (14
	DCA YBIT	/ BIT WITHIN WORD
	JMP XIT

	PAGE
AORGY,	0		/ SOME STORAGE HERE
AORGX,	0
THISY,	0
THISX,	0
NEWY,	0
NEWX,	0
UNDEF,	0
TOTEM,	0		/ TEMP STORE

AORG,	DCA AORGX	/ SET ABSOLUTE ORIGIN
	DCA AORGY

ORGN,	TAD AORGY	/ SET RELATIVE ORIGIN
	TAD NEWY
	DCA AORGY
	TAD AORGX
	TAD NEWX
	DCA AORGX
	DCA UNDEF	/ POSITION UNKNOWN
	JMP XIT

TO,	TAD UNDEF	/ DRAW TO POINT
	SNA CLA
	JMP STRT	/ START IF POSITION UNKNOWN
	TAD \IDASH	/ DASH LINE DEFINED ?
	SZA CLA
	JMP DSPEC	/ YES
	DCA \IDSHC	/ MAKE SURE
OLDSH,	DCA DPENDN	/ DASH PEN DOWN
	TAD THISY
	CIA
	DCA TOTEM
	TAD AORGY
	TAD NEWY
	JMS CKY		/ CHECK NEW Y WITHIN RANGE
	DCA THISY	/ UPDATE THISY PREMATURELY
	TAD THISY
	TAD TOTEM
	CLL CML
	SPA
	CLL CIA
	DCA YSTEP	/ MAKE +
	SNL
	CMA RAL
	IAC
	DCA YSIGN	/ 1 OR -1
	TAD THISX
	CIA 
	DCA TOTEM
	TAD AORGX
	TAD NEWX
	JMS CKX		/ CHECK NEW X WITHIN RANGE
	DCA THISX	/ UPDATE THISX PREMATURELY
	TAD THISX
	TAD TOTEM
	CLL CML
	SPA
	CLL CIA
	DCA XSTEP	/ MAKE +
	SNL
	CMA RAL
	IAC
	DCA XSIGN
	TAD XSTEP
	TAD YSTEP
	CMA
	DCA STEPS
	TAD YSTEP
	CIA 
	TAD XSTEP
	DCA XSIDE
	TAD XSTEP
	CLL RAL
	DCA XSTEP
	TAD YSTEP
	CLL RAL
	CIA 
	DCA YSTEP
	JMS SFAC	/ RESTORE &#039;FAC&#039; LOCATIONS
	JMP BLKCHK	/ NEW BLOCK ?

CKY,	0		/ SUBROUTINE TO CHECK Y WITHIN BOUNDS
	SPA
	JMP PLIER	/ TOO SMALL
	TAD (-1400	/ 768 DEC
	SMA
	JMP PLIER	/ TOO BIG
	TAD (1400
	JMPI CKY
	PAGE
XSIDE,	0		/ STORAGE HERE TO SAVE TIME &amp; SPACE
XSTEP,	0
YSTEP,	0
YBIT,	0
YSIGN,	0
XBIT,	0
XSIGN,	0
STEPS,	0
OBLK,	0		/BLOCK 0 INITIALLY IN CORE AND FIRST
NBLK,	0
XPLOT,	0

STLOOP,	TAD XSIDE	/ DO NEXT STEP
	SMA SZA
	JMP STEPX

	TAD XSTEP	/ STEP Y
	DCA XSIDE
	TAD YBIT
	TAD YSIGN
	SPA
	JMP YLEFT	/ MOVE LEFT 1 WORD
	TAD (-14
	SMA
	JMP YRITE	/ MOVE RIGHT 1 WORD
	TAD (14
	DCA YBIT	/ SAME WORD
	JMP TRYX

YLEFT,	TAD (14		/ MOVE LEFT 1 WORD
	DCA YBIT
	CLL CML IAC RAL	/ 3
	AND XPLOT
	SZA CLA
	JMP YEND	/ SAME Y BLOCK
	CMA
	TAD NBLK	/ 1 BLOCK LEFT
	DCA NBLK
	CLL IAC RTL	/ 4
	JMP YEND

YRITE,	DCA YBIT	/ MOVE RIGHT 1 WORD
	CLA IAC
	TAD XPLOT
	AND (3
	SZA CLA
	JMP YEND	/ SAME Y BLOCK
	INC NBLK	/ 1 BLOCK RIGHT
	TAD (-4
YEND,	TAD YSIGN
	TAD XPLOT
	DCA XPLOT

TRYX,	TAD XSIDE	/ STEP X AS WELL ?
	SPC 
	JMP BLKCHK
	INC STEPS
	TAD XSIDE

STEPX,	TAD YSTEP	/ STEP X  ( IA IN AC )
	DCA XSIDE
	TAD XBIT
	TAD XSIGN
	SPA
	JMP XUP
	TAD (-100
	SMA
	JMP XDWN
	TAD (100
	DCA XBIT
	TAD XSIGN
	CLL RAL
	CLL RAL
	TAD XPLOT
	DCA XPLOT
	JMP BLKCHK

XUP,	TAD (100	/ MOVE UP 1 BLOCK X-DIR
	DCA XBIT
	TAD (-20
	TAD NBLK
	DCA NBLK
	TAD (374
	JMP XEND

XDWN,	DCA XBIT	/ MOVE DOWN 1 BLOCK X-DIR
	TAD (20
	TAD NBLK
	DCA NBLK
	TAD (-374
XEND,	TAD XPLOT
	DCA XPLOT

BLKCHK,	TAD OBLK	/ SWAP BLOCKS IF NECESSARY
	CIA
	TAD NBLK	/ SAME BLOCK ?
	SNA CLA
	JMP PAINT	/ YES
	JMP ALLOC	/ NO, ALLOCATE BLOCK
	PAGE
^JPLOT,	0000		/ POINTER INTO JPLOT ARRAY
[TM,	0		/ TEMP STORE
^INS,	STEPS
^IDUD,	\IDUDS
DPENDN,	0
DSHPNT,	0
			/ SET APPROPRIATE BIT IN JPLOT
PAINT,	TAD DPENDN	/ PEN UP IN DASH PATTERN ?
	SZA CLA
	JMP NPAINT	/ YES, DON&#039;T PAINT
	TAD XPLOT	/ REL . ADDRESS
	TAD XBASE	/ + BASE
	DCA ^JPLOT	/ = ABS
	TAD YBIT
	CLL CML CMA RAR
	DCA [TM
	SNL
	IAC
	RAR
PNLOOP,	RTL
	ISZ [TM
	JMP PNLOOP
	DCA [TM
	TAD [TM
	CMA
	6211		/ CDF TO COMMON
	ANDI ^JPLOT
	TAD [TM
	DCAI ^JPLOT
NPAINT,	ISZ \IDSHC
	SKP
	JMP DSHEND	/ END OF DASH SEGMENT
DSHCNT,	ISZ I ^INS	/ FORCE CDF HERE
	JMP STLOOP	/ ROUND AGAIN
	JMS CFAC
	JMP XIT

DSPEC,	TAD \IDSHP	/ POINTER UNDEFINED = NEW DASH
	SZA CLA
	JMP DSPEN
	TAD (-1
	TAD \IDASH
	CLL RTL
	RAL
	TAD (-1
	TAD \IDASH	/ * 9
	TAD ^IDUD
	DCA \IDSHP	/ POINTER TO DASH-PAIRS
	TAD \IDSHP
	DCA DSHPNT	/ SET DYNAMIC POINTER
	TADI DSHPNT	/ GET FIRST SEGMENT LENGTH
	CIA
	SNA
	CMA		/ ZERO NOT ALLOWED
	DCA \IDSHC
	DCA DPENDN	/ PEN DOWN
DSPEN,	TAD DPENDN	/ TRICK FOR CDF
	JMP OLDSH

DSHEND,	INC DSHPNT	/ NEXT SEGMENT
	TADI DSHPNT
	SMA CLA
	JMP DSHMOR	/ MORE SEGMENTS
	TAD \IDSHP	/ RESET POINTER
	DCA DSHPNT
	CMA
	SKP		/ PEN DOWN FOR NEW SERIES
DSHMOR,	TAD DPENDN
	CMA
	DCA DPENDN	/ PEN INVERT
	TADI DSHPNT
	CIA
	SNA
	CMA		/ ZERO NOT ALLOWED
	DCA \IDSHC
	JMP DSHCNT

SFAC,	0
	TAD SACH
	DCA ACH
	TAD SACM
	DCA ACM
	TAD SACL
	DCA ACL
	AND [TM		/*K*
	JMP I SFAC

CFAC,	0
	TAD ACH
	DCA SACH
	TAD ACM
	DCA SACM
	TAD ACL
	DCA SACL
	AND [TM		/*K*
	JMP I CFAC

SACH,	0
SACM,	0
SACL,	0		/ FAC PRESERVATIVE
	PAGE
			/LINKED BLOCK LIST
ADD0,	0		/INITIALLY BLOCK 0
	ADD1		/FORWARD LINK
	0000		/BUFFER ADDRESS (FIXED IN LIST)
	0		/NO BACKLINK (FIRST)
ADD1,	1
	ADD2
	0400
	ADD0
ADD2,	2
	ADD3
	1000
	ADD1
ADD3,	3
	ADD4
	1400
	ADD2
ADD4,	4
	ADD5
	2000
	ADD3
ADD5,	5
	ADD6
	2400
	ADD4
ADD6,	6
	ADD7
	3000
	ADD5
ADD7,	7
	ADD10
	3400
	ADD6
ADD10,	10
	ADD11
	4000
	ADD7
ADD11,	11
	ADD12
	4400
	ADD10
ADD12,	12
	ADD13
	5000
	ADD11
ADD13,	13
	0000		/NO FORWARD LINK (LAST BLOCK)
	5400
	ADD12
ERR,	CALL 1,ERROR	/ FATAL ERROR
^FN,	ARG ^PLOT

^PLOT,	TEXT /PLOT@@IM/
^PXPB,	TEXT /PXPB@@SV/

PLIER,	CLA		/ NON-FATAL ERROR
	DCA UNDEF	/ POSITION UNKNOWN
	CALL 1,ERROR
	ARG PLE2

PLE2,	TEXT /PLTI/
	PAGE
FIRST,	ADD0
ATEM,	0
APNT,	0
ANF,	0

ALLOC,	TAD FIRST	/ HERE WITH OBLK.NE.NBLK
	DCA APNT	/ POINT TO FIRST BLOCK
	TADI APNT	/ GET BLOCK
	INC APNT	/ POINT TO FLINK
	DCA OBLK	/ OLD &#039;OBLK&#039; UNIMPORTANT
	TAD OBLK
	CIA
	TAD NBLK	/ BLOCK ALREADY RESIDENT ?
	SZA CLA
	TADI APNT	/ NOT THIS ONE, GET LINK
	SZA		/ EITHER GOT BLOCK OR END ?
	JMP ALLOC#	/ NO, LOOP
	TADI APNT	/ OK, SAVE FLINK OR (0 IF END)
	DCA ATEM
	TAD FIRST
	DCAI APNT	/ FLINK GETS OLD FIRST
	CMA		/ INCED ONCE
	TAD APNT
	DCA ANF		/ THIS IS NEW FIRST
	INC APNT	/ GO TO BUFFER ADD
	TADI APNT
	DCA XBASE	/ OUR NEW BLOCK BASE
	INC APNT	/ GO TO BACKLINK
	IAC
	TADI APNT	/ GET BACKBLOCK+1=FLINK
	DCA APNT	/ IN BACKBLOCK
	TAD ATEM	/ GET OLD FLINK OR 0
	DCAI APNT
	TAD ATEM	/ GET LINKAGE
	SNA		/ END ?
	JMP ANBCK	/ YES, EASY
	TAD (3		/ POINT TO BACKLINK OF NEXT
	DCA ATEM	/ ATEM STAYS NON-ZERO
	CMA
	TAD APNT	/ ADD OF BACKBLOCK
	DCAI ATEM	/ LINK OLD FORWBL TO OLD BACKBL
ANBCK,	TAD (3
	TAD FIRST	/ POINT TO BACKLINK OF OLD FIRST
	DCA APNT
	TAD ANF		/ 
	DCAI APNT	/ OLD FIRST BACKBL OF NEW
	TAD ANF
	DCA FIRST	/ SET NEW FIRST NOW !!!
	TAD ATEM	/ DO WE HAVE TO SWAP ?
	SZA CLA		/ HAVE TO SWAP IF LAST BLOCK (OLDEST)
	JMP ANSWP
	TAD OBLK	/ CONTAINS LAST BLOCK BLOCK
	CLL CML		/ WRITE
	JMS SYSIO	/ SYSIO USES XBASE ADDRESS
	TAD NBLK
	CLL		/ READ
	JMS SYSIO
ANSWP,	TAD NBLK	/ GET NEW BLOCK
	DCAI FIRST	/ TO FIRST BLOCK
	TAD NBLK
	DCA OBLK	/ OBLK=NBLK FOR COMPARE
	JMP PAINT

END 
</pre>
<hr/>
</div>