simh-testsetgenerator/PDP11/11logo/turtle.62

1457 lines
No EOL
36 KiB
Text
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

.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