.STITL DISPLAY AND TURTLE
	VERN==VERN+%FNAM2

;A  BRIEF DESCRIPTION OF WHAT IS LEFT TO BE DONE TO THIS PROGRAM.


;2)	GARBAGE COLLECTION.  COLLAPSING ADDS AND NOPS IN THE STATIC AREA.
;3)	ERROR RECOVERY.
;4)	DECIDING WHAT SNAP AND WIPE REALLY ARE GOING TO DO.
;AT THIS TIME, SNAP OUTPUTS THE ENTIRE SCREEN
;AND WIPE ERASES ONLY TOP LEVEL OCCURRENCES OF THE SNAP
;6)	RUNNING THE DISPLAY ON INTERRUPT LEVEL.






;CHOOSE BETWEEN DISPLAY AND REAL TURTLE
;	THE ARGUMENT IS WHERE TO JUMP IF DISPLAY.
.MACR WHICHTUR DADD
	BITB	#TURTF,DFLAGS
	BNE	.+6
	JMP	DADD
.ENDM

;MOVE THE REAL TURTLE
;	THE ARG IS THE CHARACTER CODE TO CAUSE 1-STEP OF MOTION
.MACR MOVTUR CHAR
	MOV	#" 'CHAR,-(P)
	JMP	TURMOV
.ENDM

;SEND OUT SOME CONTROL COMMAND TO REAL TURTLE
;	ARGUMENT IS THE CHARACTER FOR THE COMMAND
.MACR CONTUR CHAR
	MOV	#" 'CHAR,A
	JMP	TURCON
.ENDM

;CONVERT ADDRESS TO DISPLAY PUSHJ
;	ARGUMENT IS AC
.MACR	MAKEPJ	F
	SUB	#DISREL,F
	ASR	F
	BIS	#DPUSHJ,F
.ENDM

;CONVERT DISPLAY CONTROLLER ADDRESSES TO REAL WORLD ADDRESSES
;	ARG IS AC
.MACR	MAKEAD	F
	ASL	F
	ADD	#DISREL,F
.ENDM

;START UP DISPLAY--FOR SIMULATOR ONLY
.MACR	DISGO
	BISB	DISBIT,NGCSR
.ENDM
;DISPLAY AND TURTLE COMMANDS THAT HAVE TO CHOOSE BETWEEN
;THE TWO GO THROUGH HERE

FORWAR:	JSR	PC,G1NARG
	WHICHTUR DFD
	MOVTUR C
BACK:	JSR	PC,G1NARG
	WHICHTUR DBK
	MOVTUR @
RIGHT:	JSR	PC,G1NARG
	WHICHTUR DRT
	MOVTUR B
LEFT:	JSR	PC,G1NARG
	WHICHTUR DLT
	MOVTUR A
PENUP:	WHICHTUR DPU
	CONTUR 8
PENDOW:	WHICHTUR DPD
	CONTUR 0


;REST OF REAL TURTLE COMMANDS
LAMPON:	BITB	#TURTF,DFLAGS
	BNE LMPON1
	ERROR+YNT	;YOU DON'T HAVE THE TURTLE
LMPON1:	CONTUR "
LAMPOFF:	BITB	#TURTF,DFLAGS
	BNE	LMPOF1
	ERROR+YNT	;YOU DON'T HAVE THE TURTLE
LMPOF1:	CONTUR !

TOOT:	BITB	#TURTF,DFLAGS
	BNE TOOT.0
	ERROR+YNT	;YOU DON'T HAVE THE TURTLE
TOOT.0:	JSR	PC,G1NARG	;GET NUMERIC ARG
	MOV	#" (,A
	BR	TOOT.9

TOOT.1:	MOV	#1,E
	JSR	PC,TUROUT	;A IS OUTPUT CHARACTER, E IS COUNT
	SWAB	A	;PUT SPACE AS BOTTOM CHARACTER OF A.
	MOV	#5,E
	JSR	PC,TUROUT	;THERE NEED TO BE 5 SPACES BETWEEN TOOTS.
TOOT.9:	DEC	B	;NUMBER OF TOOTS
	BGE	TOOT.1
	JMP	NORT	;RETURN

;TURTLE  MOVER
;	OUTUT THE APPROPRIATE CHARACTERS TO CAUSE THE REAL TURTLE
;	TO MOVE.
;	CALL WITH NUMBER OF STEPS IN B
;	CALL WITH CHARACTER FOR 1-STEP ON STACK
;
;	IT IS NECESSARY TO ACCELERATE AND DECELERATE THE TURTLE
;	MUCH OF THE ROUTINE BELOW IS TO DO THIS.
TURMOV:	JSR	PC,TURON	;TURN ON THE TURTLE
	MOV	(P),A	;THE CHARACTER FOR ONE STEP
	MOV	#10,F	;AN OFT USED CONSTANT
	CMP	B,4	;COMPARE # OF STEPS TO 4
	BLT	TM.8	;THERE IS NO CHANCE FOR MORE THAN 1-STEPS
	CMP	B,12.
	BLT	TM.3	;NO CHANCE FOR MORE THAN 2-STEPS

	MOV	#MQ,C	;START TO DIVIDE.
	MOV	B,(C)	;THE DIVIDEND
	CLR	-(C)	;CLEAR THE TOP PART OF DIVIDEND.
	MOV	#4,-(C)	;THE DIVISOR.
	TST	(C)+
	MOV	(C)+,D	;THE REMAINDER.
	MOV	(C),C	;THE QUOTIENT.
	CLR	B
	ASR	D	;DIVIDE BY 2
	ROL	B	;PUT REMAINDER IN B
	TST	(D)+	;ADD 2 TO D
	TST	(B)+	;ADD 2 TO B
;NOW A=#OF 1-STEPS TO DECELERATE, B=# OF 2-STEPS TO DECELERATE
;AND D= # OF 4-STEPS ALTOGETHER
	MOV	#2,E
	JSR	PC,TUROUT	;OUTPUT TO TURTLE. A=THE CHAR. E=COUNT
	ADD	F,A	;TURN A INTO CHAR FOR 2-STEP
	MOV	#2,E
	JSR	PC,TUROUT
	ADD	F,A	;TURN A INTO CHARACTER FOR 4-STEP
	MOV	D,E	;NUMBER OF 4-STEPS
	JSR	PC,TUROUT
	SUB	F,A	;TURN A INTO CHARACTER FOR 2-STEP
	BR	TM.5

;THERE ARE LESS THAN 12. STEPS.
;	SO THERE IS NO CHANCE FOR ANY 4-STEPS
TM.3:	SUB	#4,B	;YOU LOSE AT LEAST 4 STEPS IN ACCELERATION AND DECEL.
	MOV	B,D
	CLR	B
	ASR	D	;DIVIDE BY 2
	ROL	B	;PUT REMAINDER IN B
	TST	(B)+	;ADD 2 TO B
	MOV	#2,E
	JSR	PC,TUROUT	;ACCELERATE
	ADD	F,A	;TURN A INTO CHAR FOR 2-STEP
;OUTPUT THE NUMBER OF 2-STEPS
TM.5:	MOV	D,E	;NUMBER OF STEPS
	JSR	PC,TUROUT
	SUB	F,A	;TURN A INTO CHAR FOR 1-STEP
;OUTPUT THE 1-STEPS
TM.8:	MOV	B,E	;NUMBER OF 1-STEPS
	JSR	PC,TUROUT
	JSR	PC,TUROFF	;TURN OFF THE TURTLE
	JMP	NORT


;TURTLE OUTPUT
;	CALL WITH A=CHARACTER TO OUTPUT
;	E=NUMBER OF TIMES TO OUTPUT IT
;	NOTE: JSR TO TUROUT NOT TO TO.1
TO.1:	JSR	PC,.IOT	;NOT THE ENTRY POINT!!
;ENTER HERE
TUROUT:	DEC	E
	BGE	TO.1	;THERE'S MORE TO OUTPUT
	RTS	PC

;.IOT
;	OUTPUT CAHRACTER IN A TO TELETYPE
.IOT:	BIT	#200,TPS	;TEST READY
	BEQ	.IOT
	MOV	A,TPB	;OUTPUT THE CHARACTER
	RTS	PC



;TURN THE TURTLE ON
;	OUTPUT CHARACTERS TO TURN OFF THE PRINTER AND TURN ON THE TURTLE
TURON:	MOV	#143,A
	JSR	PC,.IOT
	MOV	#151,A
	JSR	PC,.IOT
	RTS	PC

;TURN OFF THE TURTLE
;	AND TURN THE PRINTER BACK ON
TUROFF:	MOV	#150,A
	JSR	PC,.IOT
	MOV	#142,A
	JSR	PC,.IOT
	RTS	PC


;OUTPUT A CONTROLLING CHARACTER TTO TURTLE
;	CALL WITH B=CHARACTER
TURCON:	JSR	PC,TURON
	MOV	#1,E
	MOV	B,A
	JSR	PC,TUROUT	;A HAS CHAR, E HAS COUNT
	JSR	PC,TUROFF
	JMP	NORT	;RETURN.
;HERE IS WHERE THE DISPLAY PRIMITIVES START.

;STARTDISPLAY
;	INITIALIZE EVERYTHING
;	ALLOCATE DISPLAY BUFFERS
STARTDISPLAY:
	MOVB	DISBIT,A	;HAS A BIT SET IF USER ALREADY HAS A DISPLAY
	BEQ	STRTD1	;USER DOESN'T HAVE A DISPLAY YET
	JSR	PC,KILLD2	;KILL HIS PREVIOUS DISPLAY FIRST

STRTD1:	MOV	USER,MQ	;FIND USER'S DISPLAY CONSOLE NUMBER
	MOV	#L,DIVIDE	;LENGTH OF USER BLOCK
	MOV	MQ,A	;USER NUMBER
	MOVB	DCONS(A),A
	BGE	.+4
	ERROR+NDU	;NOT A DISPLAY USER

	MOV	#DORBEG,C	;ZERO VARIOUS USER DISPLAY VARS
	MOV	#DOREND,B	;LAST WORD
SDLOOP:	CLR	(C)+	;ZERO WORD
	CMP	C,B
	BLE	SDLOOP

	MOVB	SDISBT(A),B	;DISBIT
	MOVB	B,DISBIT

	ASL	A	;MAKE INTO WORD INDEX
	MOV	STLIST(A),C	;THIS USERS TURTLE DISPLAY AREA
	MOV	C,TUB	;TURTLE BOTTOM
	MAKEPJ	C
	MOV	C,PUSHJT	;PUSHJ TO TURTLE

	MOV	DISREL(A),D	;PUSHJ TO START OF DLIST
	MAKEAD	D
	MOV	#DRSTXY!DPOP,(D)+	;FIRST WORD OF DLIST
	MOV	C,(D)	;PUSHJT IN 2ND WORD

;SET UP BUFFER VARIABLES
	MOV	D,STB	;STATIC AREA BOTTOM
	MOV	D,STT	;STATIC AREA TOP
	TST	-(D)	;POINT D BACK TO FIRST WORD
	ADD	#DLEN,D
	CLR	-(D)	;SET UP DUMMY FREE AREA
	MOV	D,DYT	;(DYNAMIC AREA TOP)
	CLR	-(D)	;AT THE TOP OF DYNAMIC AREA
	MOV	D,DYB	;DYNAMIC AREA BOTTOM
	MOV	D,DYR	;DYNAMIC AREA ROVING POINTER

	MOV	SDPDLP(A),DPDLP(A)	;SET DISPLAY PDL POINTER

	JSR	PC,ANGCRP	;GET DIREC, SINA, COSA
	JSR	PC,DR.TUR	;DRAW THE TURTLE
	JSR	PC,NEWSN2	;SET UP FOR NEW SNAP

	MOV	#DISREL,NGREL	;SET THE RELOCATION, JUST IN CASE
	BISB	DISBIT,NGCSR	;AND START UP THIS GUYS DISPLAY
	JMP	NORT	;RETURN

;KILLDISPLAY
;	USER WANTS TO GIVE UP HIS DISPLAY
KILLDISPLAY:
	MOV	#NORT,-(SP)	;ENTER HERE FROM EVAL
KILLD1:	MOVB	DISBIT,A	;HAS A BIT SET IF USER HAS DISPLAY
	BEQ	KILLDR	;USER DOESN'T HAVE DISPLAY
KILLD2:	BIC	A,NGCSR	;STOP HIS DISPLAY (ENTER HERE FROM STARTDISPLAY)
	CLR	SNLIST	;CLEAR  SNAPS
	CLRB	DISBIT
	JSR	PC,.GCOLL

KILLDR:	RTS	PC

DBK:	NEG	B

;DISPLAY FORWARD AND BACK
DFD:	MOV	DIREC,-(SP)	;SAVE DIREC SINCE DRAW
;		WANTS TO USE IT FOR ITS OWN DEVIOUS PURPOSES
	MOV	B,A
	BPL	DFD.0	;FIGURE THIS ONE OUT FOR HOMEWORK
	SUB	#40,DIREC
	BIC	#177707,DIREC
DFD.0:	JSR	PC,MULSIN	;PUTS DX IN B,,C
	MOV	B,-(SP)
	MOV	C,-(SP)
	ADD	CURX,B	;INTEGER PARTS
	ADD	CURX+2,C	;FRACTION PARTS
	ADC	B	;IF FRACTIONS > 1, ADD 1 TO INT
DFD.1:	MOV	B,NEWX
	MOV	C,NEWX+2
	JSR	PC,FIX	;B HAS THE INTEGER PART OF B,,C
	JSR	PC,CHKBND	;ERROR IF B IS OFF SCREEN

;DO  DELTA Y NOW
	JSR	PC,MULCOS	;DY IS IN B,,C
	MOV	B,-(SP)
	MOV	C,-(SP)
	ADD	CURY,B	;THE INTEGER PARTS.
	ADD	CURY+2,C	;THE FRACTION PARTS
	ADC	B	;IF FRACTIONS > 1, ADD 1 TO INT
DFD.2:	MOV	B,NEWY
	MOV	C,NEWY+2
	JSR	PC,FIX	;B HAS THE INTEGER PART OF B,,C
	JSR	PC,CHKBND	;ERROR IF B IS OFF SCREEN.

;FALLS THROUGH

;FALLS IN

	
;WHEN WE ACTUALLY DRAW THE LINE, DX AND DY ARE OF INTEREST.
;THE STUFF IN REGISTERS NOW IS CURX+DX, ETC.
	MOV	(SP)+,C	;FRACTION PART OF DY
	MOV	(SP)+,B	;THE INTEGER PART OF DY
	JSR	PC,FIX
	MOV	B,E	;THIS IS DY.

	MOV	(SP)+,C	;THE FRACTION PART OF DX
	MOV	(SP)+,B	;THE INTEGER PART OF DX.
	JSR	PC,FIX
	MOV	B,D	;THIS IS DX.

	MOV	#<MTO.P2-MTO.P1>,B	;A SORT OF FLAG FOR MOVETO
	JSR	PC,MOVETO	;DRAW A LINE OR PUT ADDXY INTO DLIST
	MOV	(SP)+,DIREC	;RESTORE DIREC

	DISGO
	JMP	NORT


;SETX
;	IF THE PEN IS UP, SIMPLY SET THE CURRENT X TO THE ARG.
;	IF THE PEN IS DOWN, DRAW A LINE.
SETX:	MOV	#CURX,A
	MOV	#NEWX,F
	JSR	PC,SET.A	;RETURNS DX IN B AND SET CURX
	MOV	(A)+,(F)+	;SET NEWY TO CURY
	MOV	(A),(F)	;SET FRACTION OF NEWY TO FRACTION OF CURY
	MOV	B,D	;DX
	CLR	E	;DY
	BR	SETMOV


;SETY
;	SIMILAR TO SETX
SETY:	MOV	#CURX,A
	MOV	#NEWX,F
	MOV	(A)+,(F)+	;SET NEWX TO CURX
	MOV	(A)+,(F)+	;SET FRACTION OF NEWY TO FRACTION OF CURY
	JSR	PC,SET.A	;RETURNS DY IN B.
	CLR	D	;DX
	MOV	B,E	;DY
	BR	SETMOV


;SETXY
;	CALLED WITH TWO ARGS. AND DOES THE OBVIOUS THING.
SETXY:	JSR	PC,G2NARG	;B=X, A=Y
	MOV	A,E
	MOV	B,D
	JSR	PC,SXY.S	;GETS DX AND DY
SETMOV:	MOV	DIREC,-(SP)
	CLR	B	;A FLAG THAT CAUSES DIREC TO BE CALCULATED IN MOVETO
	JSR	PC,MOVETO	;DRAW LINE OR DO ADDXY
	MOV	(SP)+,DIREC	;BUT RESTORE GLOBAL DIREC

	DISGO
	JMP	NORT


;SETTURTLE
;	ARGUMENT IS A LIST OF 3 NUMBERS
;	SETXY TO FIRST TWO SNUMS, AND SETHEADING TO THE THIRD
SETTURTLE:
	MOV	@S,C	;ARGUMENT
	JSR	PC,LD3NUM	;GET 3 NUMBERS IN D,E,F
	MOV	F,-(SP)	;SAVE ANGLE FOR SETHEADING LATER
	JSR	PC,SPOPT	;AND POP S	
	JSR	PC,SXY.S	;GETS DX AND DY
	CLR	B	;A FLAG THAT CAUSES DIREC TO BE CALCULATED IN MOVETO
	JSR	PC,MOVETO	;DRAW LINE OR DO ADDXY
	MOV	(SP)+,B	;PUT THE ANGLE INTO B

	JMP	DRT.HD	;AND JUMP TO SETHEADING PROGRAM

;THIS PAGE IS VARIOUS SUBROUTINES USED BY THE SET COMMANDS.

;SET.A
;	CALL WITH A POINTING TO EITHER CURX OR CURY
;	CALL WITH F POINTING TO EITHER NEWX OR NEWY
;	TAKES AN ARGUMENT OFF OF THE S PDL.  PUTS THE ARG IN NEW
;	PUTS ARG - CURRENT IN B
SET.A:	JSR	PC,G1NARG	;NUMERIC ARGUMENT IN B.

;ENTER HERE IF ARGUMENT IS ALREADY IN B
SET.A1:	JSR	PC,CHKBND	;IS NUMBER IN BOUNDS?
	MOV	B,(F)+	;PUT IN NEW
	CLR	(F)+	;CLEAR THE FRACTION PART OF NEW.
	JSR	PC,SUBXY	;RETURNS INTEGER OF B-CURRENT IN B.
	RTS	PC


;SXY.S
;	CALL WITH D = NEW X
;	CALL WITH E = NEW Y
;	GET DX AND DY
SXY.S:	MOV	#CURX,A
	MOV	#NEWX,F
	MOV	D,B	;X
	JSR	PC,SET.A1	;RETURN DX IN B
	MOV	B,D
	MOV	E,B	;Y
	JSR	PC,SET.A1	;RETURN DY IN B
	MOV	B,E
	RTS	PC


;MOVE TO


;ENTER HERE WITH D = DX, AND E = DY
;IF THE PEN IS DOWN, DRAW A LINE
;IF THE PEN IS UP, INSERT ADDX AND ADDY COMMANDS

MOVETO:	TST	D	;IS DX=0
	BNE	MTO.1	;NO
	TST	E	;IS DY=0, TOO
	BEQ	MTO.R	;RETURN

MTO.1:	BITB	#PENUF,DFLAGS	;IS THE PEN UP?
	BNE	MTO.PU	;YES
;THE PEN IS DOWN.  DRAW A LINE
MTO.PD:	ADD	B,PC	;B WAS SET SUCH THAT
;			IF MOVETO CALLED FROM SETXY, ETC. , THERE IS NO SKIP
;			BUT IF MOVETO CALLED FROM FORWARD THERE IS A SKIP
MTO.P1:	JSR	PC,XYDIR
MTO.P2:	JSR	PC,DR.LIN	;DRAW THE LINE

;AT THIS POINT, WE HAVE SUCCESSFULLY DONE THE COMMAND.
;THEREFORE SET CURX AND CURY TO THEIR NEW VALUES, AND EXIT
MTO.XY:	MOV	#CURX,A	;POINT A TO CURX
	MOV	#NEWX,F	;POINT F TO NEWX
	MOV	(F)+,(A)+	;MOVE NEWX TO CURX
	MOV	(F)+,(A)+	;MOVE FRACTION OF NEWX TO F. OF CURX
	MOV	(F)+,(A)+	;MOVE NEWY TO CURY
	MOV	(F),(A)	;MOVE FRACTION OF NEWY TO F. OF CURY
MTO.R:	RTS	PC



;THE PEN IS UP
;PUT ADDX AND ADDY COMMANDS INTO DISPLAY LIST
MTO.PU:	SPUSH	#MTO.XY	;SO THAT THE RTS BELOW WILL WORK
	MOV	STT,A	;TOP OF STATIC DISPLAY AREA.
MTO.:	ADD	#4,A	;WHERE NEW TOP WILL BE
	CMP	A,DYB	;PROVIDING THERE'S ROOM.
	BLT	MTO.RM	;THERE'S ROOM
	ERROR+TML	;TOO MANY LINES

MTO.RM:	MOV	A,STT
	MOV	PUSHJT,(A)	;DISPLAY JUMP TO TURTLE
	BIC	#176000,D	;IN CASE EITHER DX OR DY WERE NEGATIVE
	BIC	#176000,E	;CLEAR THE TOP 6 BITS
	BIS	#ADDY,E	;TURN E INTO ADDY COMMAND
	MOV	E,-(A)	;STORE IN DLIST
	BIS	#ADDX,D	;TURN D INTO ADDX COMMAND
	MOV	D,-(A)	;STORE IN DLIST
	BICB	#HOOKF,DFLAGS	;FOR LINE DRAWER
	RTS	PC

DLT:	NEG	B

;DISPLAY RIGHT AND LEFT

DRT:	ADD	CURA,B
DRT.HD:	JSR	PC,MOD360	;SET B=B MOD 360
	MOV	B,CURA
	JSR	PC,ANGCRP	;DO ALL THE ANGLE CRAP.
;			CALCULATE DIREC, SIN, AND COS.
	BITB	#HIDETF,DFLAGS	;IS THE TURTLE BEING HIDDEN ?
	BNE	DRTRET	;YES. SO RETURN

;THE TURTLE IS BEING SHOWN. SO DRAW THE TURTLE
	JSR	PC,DR.TUR

DRTRET:	DISGO
	JMP	NORT


;SETHEAD
;	LIKE RIGHT, EXCEPT SET CURA TO ARGUMENT
SETHEAD:	JSR	PC,G1NARG	;NUMERIC ARGUMENT IN B
	BR	DRT.HD	;JUMP INTO RIGHT


;HERE
;	OUTPUT A SENTENCE OF CURX,CURY,CURA
HERE:	MOV	#CURX,D
	JSR	PC,PSHINT	;PUSH INTEGER OF CURX ONTO S-PDL
	JSR	PC,PSHINT	;PUSH INTEGER OF CURY
	MOV	(D),B	;CURRENT ANGLE
HERE.1:	JSR	PC,PSHNUM	;PUSH CURRENT ANGLE
HERE.2:	SPUSH	#3	;PUSH 3 ONTO P-PDL
	JMP	SENTENCE

;HOME
;	OUTPUT A SENTENCE OF 0 0 0
HOME:	CLR	B
	JSR	PC,PSHNUM
	SPUSHS	B	;AND PUSH IT AGAIN
	SPUSHS	B	;AND AGAIN
	BR	HERE.2


;XCOR
;	OUTPUT THE X COORDINATE
XCOR:	MOV	#CURX,D
	BR	.+6
;YCOR
;	OUTPUT THE Y COORDINATE
YCOR:	MOV	#CURY,D
	JMP	R1INT	;RETURN INTEGER


;HEADING
;	RETURN THE CURRENT ANGLE
HEADING:	MOV	CURA,B
	JMP	R1NARG


;	HIDETURTLE
HIDETURTLE:
	BISB	#HIDETF,DFLAGS	;SET THE HIDETURTLE FLAG
	MOV	#DPOP!DSTOP,@TUB	;DISPLAY POP AND STOP
	DISGO
	JMP	NORT


;	SHOWTURTLE
SHOWTURTLE:
	BITB	#HIDETF,DFLAGS	;IS TURTLE HIDDEN NOW ?
	BEQ	SHOWT9	;NO, IT'S ALREADY BEING SHOWN
;HAVE TO DRAW THE TURTLE
	BICB	#HIDETF,DFLAGS	;CLEAR THE FLAG FIRST
	JSR	PC,DR.TUR
SHOWT9:	DISGO
	JMP	NORT


;	DISPLAY PENUP
DPU:	BISB	#PENUF,DFLAGS
	JMP	NORT


;	DISPLAY PENDOWN
DPD:	BICB	#PENUF,DFLAGS
	JMP	NORT


;SNAP
;	OUTPUTS STUFF ON THE SCREEN
;	TRANSFER D. CODE STARTING AT STB+2 AND GOING ALL THE WAY TO STT
;	INTO THE DYNAMIC AREA.
;	RETURNS A LIST OF CURX, CURY AND POINTER TO SNAP
SNAP:	MOV	SNABOT,D	;BOTTOM OF STUFF TO BE SNAPPED
	JSR	PC,DYXFR	;TRANSFER THE DCODE.
;			SET D = POINTER TO DCODE
	TST	D	;IF 0
	BEQ	SNAP.3	;NO CODE MOVED

;NOW PUT THIS SNAP ON THE SNAP LIST
SNAP.1:	MOV	SNLIST,C	;POINTER TO SNAP LIST
	BNE	SNAP.2
	MOV	#SNUM,A	;FIRST SNAP
	CLR	B	;CREATE SNAP LIST. FIRST NODE IS A DUMMY
	JSR	PC,GRBAD
	MOV	C,SNLIST
SNAP.2:	JSR	PC,.LDP1	;POINTER TO REST OF SNAP LIST
	MOV	D,B	;PUT PTR TO SNAP IN B
	JSR	PC,GRBAD1	;:KILINK NODE IN A,B TO NODE IN (C)

;CHECK THAT THIS SNAP WON'T CAUSE DISPLAY PDL OVERFLOW
	TST	-(D)	;POINTER TO SNAP
	CMP	-(D),#<DPDLL/2>	;DEPTH COUNTER
	BLE	.+4
	ERROR+STD	;SNAP TOO DEEP
;NOW SET UP THE 3 NODE SNAP STRUCTURE ITSELF
	JSR	PC,PSHNUM	;PUSH THE POINTER ONTO S-PDL
	MOV	#CURX,D
	JSR	PC,GETINT	;INTEGER OF CURX IN B
	SUB	OLDX,B	;TO GET DELTA X
	JSR	PC,PSHNUM	;PUSH ON S-PDL
	JSR	PC,GETINT	;INTEGER OF CURY
	SUB	OLDY,B	;TO GET DELTA-Y
	JSR	PC,PSHNUM
	MOV	#SNP,-(SP)	;TYPE OF LIST SENTENCE WILL CREATE
	MOV	#3,D	;NUMBER OF ARGS TO SENTENCE
	JMP	SNPSEN	;JUMP INTO SENTENCE

;SINCE NO DISPLAY CODE WAS MOVED, RETURN EMPTY SNAP
SNAP.3:	MOV	#SNP,A
	JMP	ORTA



;NEWSNAP
;SET UP FOR NEXT SNAP TO START HERE
NEWSNAP:	MOV	#NORT,-(SP)	;ENTER HERE FROM LOGO
NEWSN1:	MOV	#CURX,D	;ENTER HERE AS SUBROUTINE
	JSR	PC,GETINT	;GET INTEGER OF CURX IN B
	MOV	B,OLDX
	JSR	PC,GETINT	;GET INTEGER OF CURY IN B
	MOV	B,OLDY
NEWSN2:	MOV	STT,SNABOT	;RESET SNAP BOTTOM TO TOP OF DISPLAY
	BICB	#HOOKF,DFLAGS	;TELL LINE DRAWER THAT LAST WORD OF DLIST ISN'T INCREMENTS
	RTS	PC	;EITHER RETURN FROM SUBROUTINE , OR JMP NORT

;DISPLAY A SINGLE SNAP

DISPLAY:
	JSR	PC,G1SNAP	;LOAD D,E,F WITH PTR TO SNAP,CURX,CURY
	BR	D.RET	;RETURNS HERE IF ARG IS EMPTY
	MOV	E,B
	ADD	CURX,B
	JSR	PC,CHKBND	;IS NEW X COR IN BOUNDS?
	MOV	F,B
	ADD	CURY,B
	JSR	PC,CHKBND	;IS NEW Y COR IN BOUNDS?

;NOW SEE IF THERE'S ENOUGH ROOM IN THE DISPLAY AREA
	MOV	STT,A	;TOP OF THE STATIC AREA
	ADD	#4,A	;RAISE IT 4 BYTES
	CMP	A,DYB	;COMPARE TO BOTTOM OF DYNAMIC AREA
	BLT	DISRM
	ERROR+TML	;TOO MANY LINES

;FINALLY, WE CAN PLACE THE PUSHJ TO THE SNAP INTO THE DISPLAY LIST
DISRM:	INC	-2(D)	;INCREMENT THE REF COUNTER OF THE SNAP
	MOV	A,STT	;SET STATIC TOP TO HERE IN DLIST
	MOV	PUSHJT,(A)	;PUT PUSHJ TO TURTLE AT TOP OF DLIST
	MAKEPJ D
	MOV	D,-(A)	;PUT IN THE PUSHJ
	CLR	-(A)	;PRECEDE BY A NOP

;NOW, SET CURX AND CURY
	ADD	E,CURX	;E HAD DX OF THE SNAP
	ADD	F,CURY	;F HAS DY OF THE SNAP

	BICB	#HOOKF,DFLAGS	;TELL LINE DRAWER THAT LAST DWORD NOT INCREMENTS
D.RET:	DISGO
	JSR	PC,SPOPT	;POP S
	JMP	NORT	;RETURN

;WIPE A SNAP

WIPE:	JSR	PC,G1SNAP	;LOAD D,E,F WITH PTR TO SNAP, X,  Y

	BR	D.RET	;RETURNS HERE IF ARG IS EMPTY
	BIC	#176000,E	;CLEAR TOP 6 BITS
	BIS	#ADDX,E	;AND TURN INTO ADDX COMMAND
	BIC	#176000,F	;CLEAR TOP 6 BITS
	BIS	#ADDY,F	;TURN INTO ADDY

	MOV	D,B
	TST	-(D)	;POINT D TO SNAP'S REF COUNTER
	MAKEPJ B	;MAKE B INTO DPUSHJ TO SNAP
	MOV	STT,A	;POINTER TO TOP OF DISPLAY LIST
	MOV	STB,C	;POINTER TO BOTTOM OF DLIST

WIPE.L:	CMP	A,C	;ARE WE AT THE BOTTOM YET?
	BLT	D.RET	;YES, SO WE ARE DONE
	CMP	B,-(A)	;IS THE NEXT WORD A PUSHJ?
	BNE	WIPE.L	;NO.  LOOP BACK AND TRY ANOTHER
;YES!  IT IS A PUSHJ
;PUT ADDX AND ADDY COMMANDS INTO DLIST
	MOV	F,(A)
	MOV	E,-(A)

	DEC	(D)	;DECREMENT REF COUNTER
	BR	WIPE.L	;AND THEN LOOP BACK TO SEE IF THERE'S ANOTHER
;			PUSHJ TO THIS SNAP


;WIPE THE ENTIRE DISPLAY

WIPECLEAN:
	MOV	STB,A	;POINTER TO BOTTOM OF DISPLAY LIST
	MOV	STT,B	;POINTER TO TOP OF DLIST

	MOV	#100000,E	;SMALLEST DPUSHJ
	MOV	#140000,F	;SMALLEST COMMAND BIGGER THAN PUSHJ

WC.LP:	CMP	B,A	;ARE WE AT BOTTOM YET?
	BLT	WC.DUN	;YES, WE ARE DONE
	CMP	-(B),E	;IS NEXT WORD DOWN A PUSHJ?
	BLO	WC.LP	;NO, IT'S TOO SMALL
	CMP	(B),F
	BHIS	WC.LP	;NO, IT'S TOO BIG
;THIS WORD IS A PUSHJ
	MOV	(B),D	;MOVE	THE PUSHJ COMMAND INTO D
	MAKEAD D	;TURN INTO PDP-11 ADDRESS
	DEC	-(D)	;DECREMENT SNAP'S REF COUNTER
	BR	WC.LP	;LOOP BACK TO LOOK FOR MORE PUSHJ'S

;NOW PLACE ADDX AND ADDY COMMANDS IN THE DISPLAY LIST
;SO THAT THE TURTLE WILL STAY AT THE SAME PLACE IT WAS BEFORE THE WIPE
WC.DUN:	MOV	#CURX,D
	JSR	PC,GETINT	;GET INTEGER OF  CURX IN B
	SPUSH	B	;SAVE DX
	JSR	PC,GETINT	;GET INTEGER OF CURY IN B
	MOV	B,E	;PUT DY IN E
	SPOP	D	;PUT DX IN B
	JSR	PC,MTO.	;PUTS THE ADD COMMANDS INTO THE DLIST, STARTING AT A
	JSR	PC,NEWSN1	;SO THAT SNAPS WILL START HERE

	DISGO
	JMP	NORT	;RETURN
.STITL DISPLAY UTILITY ROUTINES


;SUBXY
;	CALL WITH AN INTEGER IN B
;	CALL WITH A POINTER TO CURX OR CURY IN A
;	RETURNS THE INTEGER OF B-CURRENT X OR Y IN B
;	ALSO LEAVES A POINTING TO WORD AFTER THE FRACTION PART
SUBXY:	SUB	(A)+,B	;B-CUR
	TST	(A)+	;TEST THE FRACTION PART
	BGE	SUBXY9	;BRANCH IF THE HIGH BIT IS OFF
	DEC	B	;ROUND THE ANSWER DOWN
SUBXY9:	RTS	PC


;CHKBND
;	CHECK BOUNDS.  ERROR IF B IS OFF SCREEN
CHKBND:	CMP	B,#100.
	BGT	ERROOB
	CMP	B,#-100.
	BLT	ERROOB
	RTS	PC
;THE NUMBER IS OUT OF BOUNDS
ERROOB:	MOV	#PUSHJT,@STT	;A VERY SIMPLE ERROR RECOVERY 
	ERROR+OOB


;	CALL WITH D POINTING TO CURX OR CURY.
;	RETURN THE INTEGER OF CURX OR CURY IN B
GETINT:	MOV	(D)+,B
	MOV	(D)+,C
;FIX
;	CALL WITH INTEGER IN B AND FRACTION IN C
;	RETURNS INTEGER ROUNDED CORRECTLY IN B
FIX:	ROL	C	;PUT TOP BIT OF C INTO CARRY
	ADC	B	;SO THAT B IS ROUNDED UP IFF TOP BIT OF C SET
	RTS	PC


;MOD360
;	OUTPUT B MOD 360 IN B.
;	ALWAYS OUTPUTS A POSITIVE NUMBER
MOD360:	MOV	#360.,C
	MOV	#AC,A
	MOV	B,2(A)	;MOVE NUMBER TO LOW PART OF DIVIDEND
	BGE	M360A
M360A:	MOV	C,-(A)	;360 TO DIVISOR
	MOV	2(A),B	;REMAINDER
	BGE	M360R
	ADD	C,B	;IF REMAINDER WAS NEGATIVE, ADD 360 TO IT

M360R:	RTS	PC



;MULCOS
;	RETURN A*COSINE OF CURA IN B,,C
MULCOS:	MOV	COSA,B
	BR	MULCS2
;MULSIN
;	RETURN A*SINE OF CURA IN B,,C
MULSIN:	MOV	SINA,B
MULCS2:	MOV	D,-(SP)	;GUESS WHY
	CLR	D	;USE D AS FLAG
	TST	B
	BPL	MULCS3
	DEC	D	;TO MARK THAT B WAS NEGATIVE
	BIC	#100000,B	;WHEN TRIG THINGS ARE SUPPOSED TO BE NEG.
;			THEY ARE INSTEAD STORED POSITIVE, BUT WITH TOP BIT SET
MULCS3:	MOV	#MQ,F
	MOV	B,(F)+	;MULTIPLICAND
	MOV	A,(F)	;MULTIPLIER
	MOV	-(F),C	;LOW ORDER PRODUCT = FRACTION
	MOV	-(F),B	;HIGH ORDER PRODUCT = INTEGER
	ASL	C	;MULTIPLY FRACTION AND
	ROL	B	;INTEGER BY 2.
	TST	D	;WAS THE TRIG THING NEGATIVE?
	BGE	MULCS9
	NEG	C	;SINCE THE TRIG FUNCTION WAS NEGATIVE, NEGATE FRACTION
	ADC	B	;INCREMENT INTEGER UNLESS, FRACTION WAS 0
	NEG	B	;AND NEGATE THE INTEGER.
MULCS9:	MOV	(SP)+,D	;RESTORE D
	RTS	PC


;ANGCRP
;	CALCULATE ANGLE CRAP.
;	CALCULATE DIREC, SINA, COSA
ANGCRP:	MOV	CURA,A	;THE CURRENT ANGLE
	MOV	#90.,E
	MOV	#MQ,F
	MOV	A,(F)	;THE DIVIDEND
	CLR	-(F)
	MOV	E,-(F)	;THE DIVISOR = 90.
	TST	(F)+
	MOV	(F)+,A	;THE REMAINDER
	MOV	(F),F	;THE QUOTIENT
	MOV	A,C	;SAVE THE REMAINDER
	SUB	A,E	;NOW E = 90.- REMAINDER
	JSR	PC,SINGET	;D_SIN (A)
	MOV	D,B
	MOV	E,A
	JSR	PC,SINGET
	MOV	#100000,E	;BIS THIS GUY WHEN TRIG THINGS ARE SUPPOSED TO BE NEGATIVE
	ASL	F	;F = 0,1,2,3
	ADD	F,PC	;JUMP THROUGH THIS DISPATCH TABLE
	BR	ACR.D
	BR	ACRII	;QUADRANT II
	BR	ACRIII	;QUADRANT III
;FOURTH QUADRANT
	MOV	B,A	;SIN (A)
	MOV	D,B	;SIN (90-A)
	BIS	E,B	;SINA=-SIN(90-A) IN 4TH QUADRANT
	MOV	A,D	;AND COSA=SIN(A) IN 4TH QUADRANT
	BR	ACR.D

;THE THIRD QUADRANT
ACRIII:	BIS	E,B	;SINA = -SIN (A) IN 3RD QUADRANT
	BIS	E,D	;COSA = - SIN (90-A) IN 3RD QUADRANT
	BR	ACR.D

;SECOND QUADRANT
ACRII:	MOV	B,A	;SIN (A)
	MOV	D,B	;SINA = SIN (90-A) IN 2ND QUADRANT
	MOV	A,D
	BIS	E,D	;COSA = -SIN (A) IN 2ND QUADRANT

;IN THE FIRST QUADRANT
;SINA = SIN (A) AND
;COSA = SIN (90-A)
ACR.D:	MOV	B,SINA
	MOV	D,COSA


;NOW GET DIREC.  DIREC IS THE DIRECTION CODE FOR THE DISPLAY CODE
	CMP	#45.,C	;IS THE REMAINDER MORE THAN 45?
	ADC	F	;CARRY WAS SET IF C<45
	ASL	F
	ASL	F
	ASL	F
	MOV	F,DIREC

	RTS	PC

;GET SIN (A) INTO D.
;THE SINE TABLE HAS ONLY EVEN ANGLES.  INTERPOLATE ODD ANGLES.
SINGET:	BIT	#1,A	;ODD OR EVEN
	BEQ	AEVEN
	ADD	#<SIN+1>,A	;POINT TO ANGLE AFTER IT
	MOV	(A),D	;SIN (A+1)
	ADD	-(A),D	;PLUS SIN (A-1)
	ASR	D	;DIVIDED BY 2
	RTS	PC
AEVEN:	MOV	SIN(A),D
	RTS	PC


;BEAUTIFUL SINE TABLE IN WHOOPIE FORMAT


SIN:

	0	;0 DEGREES
	2167	;2 DEGREES
	4355	;4 DEGREES
	6541	;6 DEGREES
	10720	;8 DEGREES
	13072	;10 DEGREES
	15234	;12 DEGREES
	17367	;14 DEGREES
	21510	;16 DEGREES
	23615	;18 DEGREES
	25707	;20 DEGREES
	27763	;22 DEGREES
	32017	;24 DEGREES
	34034	;26 DEGREES
	36027	;28 DEGREES
	40000	;30 DEGREES
	41724	;32 DEGREES
	43623	;34 DEGREES
	45474	;36 DEGREES
	47315	;38 DEGREES
	51106	;40 DEGREES
	52646	;42 DEGREES
	54352	;44 DEGREES
	56023	;46 DEGREES
	57437	;48 DEGREES
	61015	;50 DEGREES
	62335	;52 DEGREES
	63615	;54 DEGREES
	65035	;56 DEGREES
	66214	;58 DEGREES
	67331	;60 DEGREES
	70404	;62 DEGREES
	71413	;64 DEGREES
	72357	;66 DEGREES
	73255	;68 DEGREES
	74107	;70 DEGREES
	74674	;72 DEGREES
	75412	;74 DEGREES
	76062	;76 DEGREES
	76463	;78 DEGREES
	77016	;80 DEGREES
	77301	;82 DEGREES
	77514	;84 DEGREES
	77660	;86 DEGREES
	77754	;88 DEGREES
	77777	;90 DEGREES

;XYDIR
;	CALL WITH D=DX, E=DY
;	CALCULATE DIREC BASED ON DX AND DY
XYDIR:	CLR	A	;BUILD INDEX IN A
	TST	D	;IS DX POSITIVE
	BGE	XYDIR1
	NEG	D	;ABSOLUTE VALUE OF DX
	TST	(A)+	;PUT 2 INTO A
XYDIR1:	TST	E	;IS DY POSITIVE
	BGE	XYDIR2
	NEG	E	;ABSOLUTE VALUE OF DY
	INC	A	;INCREMENT INDEX
XYDIR2:	CMP	D,E	;WILL GENERATE CARRY IF D<E
	ROL	A	;PUT CARRY INTO BOTTOM BIT OF INDEX.  AND MULTIPLY REST BY 2
	MOVB	DREC(A),DIREC	;NOW MOVE THE RIGHT THING INTO DIREC
	RTS	PC
DREC:	.BYTE 10
	.BYTE 0
	.BYTE 20
	.BYTE 30
	.BYTE 60
	.BYTE 70
	.BYTE 50
	.BYTE 40
	.EVEN


;DYXFR
;	TRANSFER FROM STATIC AREA TO DYNAMIC AREA
;	THE CODE BEING TRANSFERRED STARTS AT D AND GOES UP TO STT
;	ON RETURN, D POINTS TO THE TRANSFERRED DCODE
;	IF NO CODE WAS TRANSFERRED, THEN D = 0.
DYXFR:	MOV	STT,E
	SUB	D,E	;LENGTH OF DCODE TO BE MOVED
	BLE	DYRET	;NOTHING TO BE MOVED
;ALLOCATE STORAGE
;LENGTH OF BLOCK TO BE ALLOCATED IS IN E
DYAL:	ADD	#6,E	;INCREASE LENGTH TO ALLOW FOR REF CNTR, DEPTH CNTR, AND POPJ
	MOV	DYR,B	;INITIALIZE POINTER
	MOV	#1,C	;INITIALIZE FLAG
DYAL1:	MOV	2(B),A	;POINTER TO NEXT FREE BLOCK
	BNE	DYAL2
	DEC	C	;NO NEXT FREE BLOCK--TEST AND SET FLAG
	BNE	DYAL7	;NO MORE ROOM--GO TO EXPAND DY AREA
	MOV	DYB,B	;START AGAIN AT BOTTOM OF LIST
	BR	DYAL1
DYAL2:	MOV	(A),F	;FREE BLOCK FOUND--CHECK LENGTH
	SUB	E,F
	BPL	DYAL4
DYAL3:	MOV	A,B	;BLOCK TOO SHORT--MOVE TO NEXT BLOCK
	BR	DYAL1
DYAL4:	BNE	DYAL5	;BLOCK LONG ENOUGH--IF FILLED EXACTLY
	MOV	2(A),2(B)	;REMOVE BLOCK FROM LIST BY CHANGING POINTERS
DYAL5:	CMP	F,2	;DONT LEAVE A BLOCK OF LENGTH 2 BYTES
	BEQ	DYAL3
	MOV	F,(A)	;NEW LENGTH OF FREE BLOCK
	MOV	2(B),C	;RESET ROVING POINTER
	BNE	DYAL6	;DONT SET IT TO O
	MOV	DYB,C
DYAL6:	MOV	C,DYR	
	ADD	F,A	;START STORING AT THIS ADDRESS
	BR	DYAL9
DYAL7:	MOV	DYB,A	;ADD NEW BLOCK TO BOTTOM OF LIST
	MOV	2(A),F	;POINTER TO 2ND FREE BLOCK
	SUB	E,A
	CMP	A,STT
	BGT	DYAL8	;THERE IS ENOUGH ROOM IN THE DY AREA
	ERROR+TML
DYAL8:	MOV	A,DYB	;NEW BOTTOM OF DY
	MOV	A,DYR	;FIX ROVING POINTER
	MOV	DYB,C	;SET UP NEW LIST BOTTOM
	CLR	(A)+
	MOV	F,(A)+
DYAL9:	SUB	#6,E	;RESTORE LENGTH


;NOW A CONTAINS ADDRESS OF FREE BLOCK
;E CONTAINS NUMBER OF BYTES TO BE TRANSFERRED
;NOW FINALLY YOU GET TO DO THE TRANSFER
;WHILE YOU DO IT, INCREMENT THE REF COUNTER OF ANY PUSHJ'S
DYXFR1:	MOV	#100000,C	;THE CODE FOR DISPLAY PUSHJ
	MOV	#140000,B	;NEXT HIGHER DISPLAY COMMAND
	SPUSH	A	;SAVE POINTER TO DEPTH COUNTER
	CLR	(A)+	;DEPTH_0
	CLR	(A)+	;SET REFERENCE COUNTER TO ZERO
	ASR	E	;E/2 = NUMBER OF WORDS TO BE TRANSFERRED
;PICK UP A WORD.  SEE IF ITS A PUSHJ. AND TRANSFER IT
DYXFR2:	DEC	E	;NUMBER OF WORDS TO BE XFRED
	BLT	DYXFR3
	MOV	(D)+,F	;WORD OF DCODE IN F
	MOV	F,(A)+	;PUT THIS WORD IN ITS NEW PLACE
	CMP	F,C
	BLO	DYXFR2	;NOT A PUSHJ
	CMP	F,B
	BHIS	DYXFR2	;NOT A PUSHJ
;IT IS A PUSHJ
	MAKEAD	F
	INC	-(F)	;INCREMENT THE REF COUNTER
	CMP	-(F),@(SP)	;DEPTH _ MAX (DEPTH OF SUB SNAPS)
	BLE	DYXFR2
	MOV	(F),@(SP)	;DEPTH OF SUB SNAP BIGGEST YET
	BR	DYXFR2	;LOOP BACK

;ALL TRANSFERRING DONE.  END THE BLOCK WITH A POPJ
DYXFR3:	MOV	#DPOPJ,(A)
	SPOP	D	;POINTER TO DEPTH COUNTER
	INC	(D)+
	TST	(D)+	;POINTER TO FIRST D.WORD OF SNAP
	RTS	PC	;AND RETURN

;THERE WAS NOTHING TO BE MOVED
DYRET:	CLR	D	;TO SIGNAL THIS FACT
	RTS	PC

;DYFREE
;	CALLED DURING GARBAGE COLLECTIONS
;	CALL WITH D POINTING TO REF COUNTER (WORD BEFORE SNAP)
;	FREES THE BLOCK!!
DYFREE:	PUSH	A	;SAVE REGISTERS
	SPUSH	B
	SPUSH	C
	SPUSH	D
	SPUSH	E
	SPUSH	F

	MOV	#100000,A
	MOV	#140000,B
	MOV	#DPOPJ,C
	JSR	PC,DYF1	;DOES THE FREEING
	JMP	RETF	;RESTORE AC'S AND RETURN TO OUT OF DYFREE

;REAL WORK OF FREEING STARTS HERE.
DYF1:	MOV	D,-(SP)	;SAVE PTR TO 2ND WORD OF BLOCK
	TST	(D)+	;POINT D TO FIRST WORD

;PICK UP EACH WORD OF BLOCK.  IF IT IS A PUSHJ, FREE THAT BLOCK
;CONTINUE UNTIL A POPJ IS REACHED
DYF11:	MOV	(D)+,F	;NEXT WORD
	CMP	F,A
	BLO	DYF11	;NOT PUSHJ OR POPJ
	CMP	F,B
	BHIS	DYF2	;NOT PUSHJ, BUT MAY BE POPJ

;	ITS A PUSHJ
	MAKEAD	F
	DEC	-(F)	;REF COUNTER
	BNE	DYF11	;SNAP BEING DISPLAYED, OR EXISTS IN LOGO
	SPUSH	D	;SAVE WHERE YOU ARE IN THIS BLOCK
	MOV	F,D	;POINTER TO NEW BLOCK TO BE FREED
	JSR	PC,DYF1	;RECURSE (GOD DAMN IT AGAIN)
	SPOP	D	;RESTORE PLACE IN THIS BLOCK
	BR	DYF11	;LOOK AT NEXT WORD

;IS THE WORD A POPJ
DYF2:	CMP	F,C	;C CONTAINS A POPJ
	BNE	DYF11	;NOT A POPJ.  LOOK AT NEXT WORD
	SPOP	C	;POINTER TO 2ND WORD OF BLOCK
	TST	-(C)	;NOW IT POINTS TO BOTTOM WORD
	SUB	C,D	;LENGTH OF BLOCK
	MOV	D,F


;NOW LINK BLOCK BACK TO FREE CORE
;C/ADDRESS OF BLOCK TO BE LIBERATED
;F CONTAINS LENGTH OF BLOCK

DYLIB:	MOV	DYB,B	;INITIALIZE POINTER TO BOTTOM OF LIST
DYLIB1:	MOV	2(B),A	;NEXT FREE BLOCK
	BEQ	DYLIB3	;AT END OF LIST
	CMP	A,C
	BGT	DYLIB2	;PASSED BLOCK TO BE FREED
	MOV	A,B	;TRY NEXT FREE BLOCK
	BR	DYLIB1
DYLIB2:	MOV	F,D	;CHECK UPPER BOUND
	ADD	C,D	;DO WE COLLAPSE NEW BLOCK WITH NEXT ONE?
	CMP	D,A
	BNE	DYLIB3	;NO
	ADD	(A),F	;YES--NEW LENGTH
	MOV	2(A),2(C)	;NEW POINTER
	CMP	A,DYR	;DID WE JUST SCREW ROVING POINTER?
	BNE	DYLIB4
	MOV	DYB,DYR	;YES--RESET IT
DYLIB3:	MOV	A,2(C)	;POINTER TO NEXT FREE BLOCK--NO COLLAPSE ON TOP
DYLIB4:	MOV	(B),D	;CHECK LOWER BOUND
	ADD	B,D
	CMP	D,C	;DO WE COLLAPSE WITH BLOCK ON BOTTOM?
	BNE	DYLIB5	;NO
	ADD	F,(B)	;NEW LENGTH OF PREVIOUS BLOCK
	MOV	2(C),2(B)	;NEW POINTER
	BR	DYLIB6
DYLIB5:	MOV	C,2(B)	;POINTER IN PREVIOUS BLOCK--NO COLLAPSE
	MOV	F,(C)	;LENGTH OF BLOCK JUST FREED
DYLIB6:	MOV	C,A	;DID WE JUST FREE BOTTOM BLOCK IN DY?
	SUB	#4,A
	CMP	A,DYB	;NOTE THAT IF CURRENT BLOCK = DYB+4
			;THEN PREVIOUS BLOCK (ADDR IN B) MUST BE DYB
	BNE	DYLIB7	;NO
	ADD	(C),B	;YES--COLLAPSE DY AREA
	CLR	(B)
	MOV	2(C),2(B)	;NEW BOTTOM BLOCK
	MOV	B,DYB
	MOV	B,DYR	;FIX POINTERS
DYLIB7:	RTS	PC


;DSGCF
;	CALLED BY LOGO GARBAGE COLLECTOR WHEN ITS ALL DONE
;	SEE IF EACH SNAP ON THE SNAP LIST WAS MARKED.
;	AND DYFREE THE SNAP IF NOT MARKED AND IT'S REFERENCE COUNTER IS 0

DSGCF:	CLR	F
	BR	DSGC1

DSGC4:	TST	F	;0 IF FIRST TIME THROUGH
	BEQ	.+4
DSGC9:	RTS	PC
	MOV	#<DSGC6-DSGCF1>,F	;NOW CLEAR MARKED BITS
DSGC1:	MOV	SNLIST,C	;POINTER TO SNAP LIST
	BEQ	DSGC9	;OBVIOUSLY DOESN'T HAVE SNAPS

	JSR	PC,.LOADC	;FIRST NODE OF LIST IS DUMMY
DSGC2:	MOV	C,E	;SAVE POINTER TO NODE
DSGC3:	BIT	#7777,A	;LEAVE ADDRESS ONLY
	BEQ	DSGC4	;END OF LIST
	MOV	A,C	;POINTER TO NEXT NODE
	JSR	PC,.LOADC
	ADD	F,PC	;CHOOSE BETWEEN FREEING AND CLEARING

;TRY TO FREE THE SNAP
DSGCF1:	TST	-(B)	;WAS SNAP MARKED?  (B POINTS TO REF COUNT)
	BNE	DSGC2	;EITHER DISPLAYED OR MARKED

;NOT MARKED, AND NOT DISPLAYED ANYWHERE!!
;FREE THIS SNAP
	JSR	PC,.FREE	;CLEAN UP SNLIST
	MOV	E,C	;POINTER TO PREVIOUS NODE OF SNLIST
	JSR	PC,.STP1	;STORE A AS TOP WORD OF PREVIOUS NODE
	MOV	B,D	;POINTER TO SNAP DCODE
	JSR	PC,DYFREE
	BR	DSGC3

DSGC6:	BIC	#100000,-(B)	;CLEAR MARKED BIT
	BR	DSGC3


;MKDC
;	CALLED BY LOGO GARBAGE COLLECTOR DURING MARKING PHASE
;	CALLED WITH B POINTING TO SNAP NODE
MKDC:	TST	SNLIST	;CALLED TO KILL THE DISPLAY?
	BEQ	MKDC.K	;YES
	BIT	#7777,B
	BEQ	DSGC9	;EMPTY SNAP
;MARK THE SNAP
	PUSH	A
	SPUSH	B
	JSR	PC,.LOAD
	MOV	#SNUM,A
	JSR	PC,CONVERT	;GET SNAP ADDRESS INTO B
	BR	MKDC.R	;IF DOESN'T SKIP, THEN BAD NODE!!!!!!!!!!!!!!!
	BIS	#100000,-(B)	;MARK THE REF COUNTER
MKDC.R:	JMP	RETB	;RESTORE A AND B

;CALLED BY KILLDISPLAY
;TURN SNAP INTO EMPTY SNAP
MKDC.K:	MOV	#SNP,B	;EMPTY SNAP
	JSR	PC,.STP2
	RTS	PC



;HERE START THE LINE AND TURTLE DRAWING PROGRAMS

;DR.LIN
;	DRAW A LINE. D=DX, E=DY, OR VICE VERSA.
;	THE DIRECTION CODE FOR THE LINE IS IN DIREC
DR.LIN:	BICB	#TEMF,DFLAGS	;GOING TO USE TEMF SO CLEAR IT
	MOV	BYCNT,C
	MOVB	OLDIR,-(SP)	;IN CASE OF ERROR BOMB OUT

	CMPB	DIREC,(SP)	;OLDIR IS THE DIREC LAST TIME DR.LIN CALLED
	BEQ	DR.LAN	;THEY ARE THE SAME
	MOV	#1,C	;NOT SAME.
	MOVB	DIREC,(SP)	;SET OLDIR

DR.LAN:	BITB	#HOOKF,DFLAGS	;CAN NEW D.LIST BE HOOKED TO PREVIOUS ONE?
	BNE	DR.LBN	;YES.
	MOV	#1,C	;NO.
DR.LBN:	JSR	PC,DR.SC	;SET A=CON, B=AC.
	JSR	PC,DR.NEP	;CALCULATE NEW END POINT OF DLIST
	MOV	C,-(SP)	;SAVE THE NEW BYCNT
	ADD	STT,D	;D = HOW MANY MORE WORDS IN DLIST
	CMP	D,DYB	;COMPARE TO DY BOTTOM
	BLT	DR.L1	;THERE'S ROOM
	ERROR+TML	;TOO MANY LINES

;OKAY, THERE WAS ROOM FOR THE LINE
DR.L1:	MOV	D,STT	;SET STT TO NEW STATIC TOP
	MOV	PUSHJT,(D)	;PUT PUSHJ TURTLE AT TOP
	JSR	PC,DR.ASC	;ASSEMBLE THE DISPLAY CODE
	MOV	(SP)+,BYCNT	;THE NEW BYCNT
	MOVB	(SP)+,OLDIR	;NEW OLDIR
	BISB	#HOOKF,DFLAGS	;FOR NEXT TIME
	RTS	PC	;RETURN


;DRAW THE TURTLE
DR.TUR:	MOV	DIREC,-(SP)	;USED LOCALLY BY DR.TUR
	MOV	#TURSIZ,A	;TURTLE SIZE
	JSR	PC,MULSIN	;B,,C = SIZE * SINA
	JSR	PC,FIX
	MOV	B,E	;NOW E HAS INTEGER OF SIZE * SINA
	JSR	PC,MULCOS	;B,,C = SIZE * COSA
	JSR	PC,FIX
	MOV	B,D	;NOW D HAS INTEGER OF SIZE * COSA

	MOV	B,-(SP)
	SUB	E,(SP)	;NOW SIZE * (COSA - SINA) IS ON STACK
	ADD	E,B
	MOV	B,-(SP)	;SIZE * (COSA + SINA) IS NOW ON STACK

	MOV	TUB,TUT	;TUT WILL BE POINTER TO TOP OF TURTLE DLIST SO FAR

;SIDE 1
	ADD	#20,DIREC	;SIDE 1 IS 2*45 DEGREES LEFT OF CURRENT DIRECTION
	JSR	PC,DR.TSD	;DRAW THE SIDE

;SIDE 2
	SUB	#30,DIREC	;SIDE 2 IS 3*45 DEGREES RIGHT OF SIDE 1
	MOV	(SP)+,D	;DX IS SIZE * (COSA + SINA)
	MOV	(SP)+,E	;DY IS SIZE * (COSA - SINA)
	JSR	PC,DR.TSD	;DRAW THE SIDE

;SIDE 3 HAS THE SAME INCREMENTS AS SIDE 2.
;JUST THE DIRECTION IS DIFFERENT
	MOV	DIREC,B
	SUB	#20,B	;SIDE 3 IS 2*45 DEGREES RIGHT
	BIC	#177707,B	;LEAVE ONLY THE 3 BITS
	SWAB	B	;PUT THE DIREC BITS IN TOP BYTE
	MOV	TUT,C	;POINTS TO WORD ABOVE LAST ONE OF TURTLE DLIST
	MOV	C,A
	SUB	D,C	;SINCE D POINTS TO BOTTOM WORD OF SIDE 2
			;C-D IS NUMBER OF BYTES IN SIDE 2'S DLIST
	ASR	C	;C/2 = NUMBER OF WORDS
DR.TS3:	MOV	(D)+,E	;NEXT WORD OF SIDE 2'S DLIST
	BIC	#34000,E	;CLEAR THE DIRECTION BITS THEREIN
	BIS	B,E	;AND SET THEM FROM THE NEW DIREC IN B
	MOV	E,(A)+	;STORE IN DLIST
	DEC	C	;NUMBER OF WORDS IN SIDE 2'S DLIST
	BGT	DR.TS3	;THERE ARE MORE WORDS

;SIDE 4 IS IDENTICAL TO SIDE 1
;FURTHERMORE, SIDE 1 IS MADE UP OF ONLY ONE WORD
	MOV	@TUB,(A)+	;PUT THE FIRST WORD OF TURTLE INTO TOP WORD
	MOV	#DPOP!DSTOP,(A)	;DISPLAY POP AND STOP.

;RESTORE DIREC, THEN RETURN
	MOV	(SP)+,DIREC
	RTS	PC


;DRAW TURTLE SIDE
;	DRAW ONE SIDE OF THE TURTLE
;	DIREC CONTAINS THE DIRECTION
;	TUT POINTS TO TOP OF TURTLE DISPLAY LIST SO FAR
;	C,D = + OR - DX OR DY
DR.TSD:	BIC	#177707,DIREC	;BITS MAY HAVE BEEN SET BY THE SUBTRACTING
	JSR	PC,DR.SC
	MOV	#1,C	;BYCNT
	JSR	PC,DR.NE1
	ADD	TUT,D	;D = NEW TOP OF TURTLE
	MOV	D,TUT
	JMP	DR.ASC	;ACTUALLY CREAT THE DISPLAY LIST


;SET UP CON AND AC
;	CALL WITH D,E = + OR - DX OR DY
;	RETURNS A=CON, B = AC
DR.SC:	TST	D
	BGE	DR.TE	;TEST E
	NEG	D	;MAKE D POSITIVE
;MAKE SURE E IS POSITIVE
DR.TE:	TST	E
	BGE	DR.BIG	;NEXT WE'LL SEE WHICH IS BIGGER
	NEG	E	;MAKE D POSITIVE

;WHICH IS BIGGER
DR.BIG:	MOV	#MQ,A
	CLR	(A)	;START TO SET UP DIVISION
	CMP	D,E
	BGT	DR.DBG	;D IS BIGGER
	BEQ	DR.EQ	;THEY ARE THE SAME SIZE

;OTHERWISE, E IS BIGGER
	MOV	D,-(A)	;HIGH ORDER DIVIDEND
	MOV	E,-(A)	;AND E IS THE DIVISOR
	MOV	E,F	;WHICHEVER IS BIGGER IS THE NUMBER OF INCS
	BR	DR.SC4

;THEY ARE THE SAME SIZE
DR.EQ:	MOV	#-1,A	;SET CON = .777...
	MOV	E,F	;NUMBER OF INCS
	BR	DR.SC5

;D IS BIGGER
DR.DBG:	MOV	E,-(A)	;HIGH ORDER DIVIDEND
	MOV	D,-(A)	;AND D IS THE DIVISOR
	MOV	D,F	;NUMBER OF INCS

;NOW PICK UP THE QUOTIENT
DR.SC4:	ADD	#4,A	;POINT A TO QUOTIENT
	MOV	(A),A	;SET CON TO THE QUOTIENT

;NOW SET AC = .1000 = 1/2 IN THIS REPRESENTATION
DR.SC5:	MOV	#100000,B
	RTS	PC


;CALCULATE THE NEW END POINT OF THE DLIST
;	CALL WITH F = THE NUMBER OF INCS
;	RETURNS D = NUMBER OF MORE WORDS IN DLIST
;	C = PLACE WHERE FIRST INCREMENT CAN GO IN LAST DWORD
DR.NEP:	CMP	C,#1
	BNE	DR.NE2

DR.NE1:	BISB	#TEMF,DFLAGS	;TEMF IS SET WHEN YOU CAN'T HOOK
DR.NE2:	MOV	A,-(SP)	;SAVE A REGISTER
	MOV	#MQ,D
	MOV	F,(D)	;DIVIDEND=NUMBER OF INCS
	CLR	-(D)
	MOV	#8.,-(D)	;DIVISOR.
	TST	(D)+
	MOV	(D)+,A	;PUT REMAINDER IN A
	MOV	(D),D	;PUT QUOTIENT INTO D
DR.N1:	DEC	A	;THE REMAINDER
	BLT	DR.N25	;FINISHED SHIFTING, BUT BYCNT DIDNT FALL OFF
	ASR	C	;SHIFT BYCNT RIGHT
	BCC	DR.N1

;SINCE CARRY SET, BYCNT FELL OFF RIGHT END OF REGISTER
	RORB	C	;STICK A ONE IN THE HIGH BIT OF C
	INC	D	;INCREMENT THE QUOTIENT
	MOV	#100,E	;INCREMENT MODE MARKER
DR.N2:	INC	E	;COUNTER IN LAST DWORD
	DEC	A	;THE REMAINDER
	BLT	DR.N3
	ASR	C	;SHIFT BYCNT RIGHT
	BR	DR.N2

;C IS SET CORRECTLY, BUT HAVE TO GET COUNT IN E
DR.N25:	MOV	C,-(SP)	;SAVE FOR A WHILE
	MOV	#111,E	;INCREMENT-MODE MARKER + 9
DR.N26:	DEC	E	;DEC THE COUNT
	ASR	C	;SHIFT  BYCNT
	BCC	DR.N26	;DIDN'T FALL OFF.  DEC COUNT AGAIN
	MOV	(SP)+,C	;E IS SET NOW.  RESTORE C.

DR.N3:	BIC	#10,E	;STRAY BIT THAT MIGHT BE ON
	BIS	DIREC,E	;OR IN THE DIRECTION
	ASL	D	;NUMBER OF WORDS IS 2*QUOTIENT
	MOV	(SP)+,A	;RESTORE A
	RTS	PC


;ACTUALLY ASSEMBLE THE NEW DISPLAY LIST
;	CALL WITH A=CON, B=AC, C=BYCNT, D=POINTER  TO FIRST WORD OF DLIST
;	E=TOP HALF OF THE INC MODE INSTRUCTION, F=NUMBER OF INCS
DR.ASC:	SWAB	E	;STUFF IN E WAS IN WRONG HALF
DR.AS0:	ADD	A,B	;CON+AC
	BCC	DR.AS1
	ADD	C,E	;CARRY, SO PUT A 1 INTO DCODE
DR.AS1:	DEC	F	;NUMBER OF INCS
	BLE	DR.ALW	;THIS WAS THE LAST WORD
	ASLB	C	;SHIFT BYCNT
	BCC	DR.AS0	;CONTINUE WITH THIS WORD

;THIS WORD DONE
	MOV	E,-(D)	;STORE IN DLIST
	BIC	#3777,E	;0 THE COUNT AND BOTTOM BYTE
	INC	C	;SET C TO 1
	BR	DR.AS0

;ALL THAT'S LEFT TO DO IS STORE THE BOTTOM WORD OF NEW DLIST
DR.ALW:	BITB	#TEMF,DFLAGS	;IS BOTTOM WORD OF NEW SAME AS TOP WORD OF OLD?
	BNE	DR.AS9	;NO.
	BISB	-2(D),E	;SET THE BITS IN BOTTOM WORD THAT WERE ALREADY SET IN DLIST
DR.AS9:	MOV	E,-(D)	;STORE BOTTOM WORD

	RTS	PC

.STITL DISPLAY BUFFERS

.IF2
	PAD ^\START OF BUFFERS\,\.
.ENDC

	DISREL=.	;DISPLAY RELOCATION

;FIRST WORD OF EACH DISPLAY IS HERE
	REPT1 3,<DLIST+<.RPCNT*DLEN>-DISREL>/2!DPUSHJ
	REPT1 5,DSTOP

;THE DISPLAY PDL POINTERS FOLLOW
	DPDLP=.
	REPT1 10,-1

;THE DISPLAY PDL'S GO HERE
	DPDL=.
	.=.+SDPDLL	;SAVE A BLOCK OF CORE FOR PDL'S

;THE BODY OF THE DISPLAY LISTS GO HERE
	DLIST=.
	.=.+SDLEN	;SAVE A BLOCK OF CORE FOR DISPLAY LISTS

;THE TURTLE DISPLAY LISTS GO HERE
	TLIST=.
	.=.+STLEN	;SAVE A BLOCK OF CORE FOR THE TURTLES

;AND THAT IS THE END OF THE DISPLAY LIST BUFFERS
	DLTOP=.-1