395 lines
14 KiB
Plaintext
395 lines
14 KiB
Plaintext
1010 *--------------------------------
|
|
1020 * TABLE OF COS(90*X/16 DEGREES)*$100 - 1
|
|
1030 * WITH ONE BYTE PRECISION, X=0 TO 16:
|
|
1040 *--------------------------------
|
|
1050 COSINE.TABLE
|
|
1060 .HS FFFEFAF4ECE1D4C5
|
|
1070 .HS B4A18D7861493118
|
|
1080 .HS FF
|
|
1090 *--------------------------------
|
|
1100 * HFIND -- CALCULATES CURRENT POSITION OF HI-RES CURSOR
|
|
1110 * (NOT CALLED BY ANY APPLESOFT ROUTINE)
|
|
1120 *
|
|
1130 * CALCULATE Y-COORD FROM GBASL,H
|
|
1140 * AND X-COORD FROM HORIZ AND HMASK
|
|
1150 *--------------------------------
|
|
1160 HFIND LDA MON.GBASL GBASL = EABAB000
|
|
1170 ASL E INTO CARRY
|
|
1180 LDA MON.GBASH GBASH = PPPFGHCD
|
|
1190 AND #3 000000CD
|
|
1200 ROL 00000CDE
|
|
1210 ORA MON.GBASL EABABCDE
|
|
1220 ASL ABABCDE0
|
|
1230 ASL BABCDE00
|
|
1240 ASL ABCDE000
|
|
1250 STA HGR.Y ALL BUT FGH
|
|
1260 LDA MON.GBASH PPPFGHCD
|
|
1270 LSR 0PPPFGHC
|
|
1280 LSR 00PPPFGH
|
|
1290 AND #7 00000FGH
|
|
1300 ORA HGR.Y ABCDEFGH
|
|
1310 STA HGR.Y THAT TAKES CARE OF Y-COORDINATE!
|
|
1320 LDA HGR.HORIZ X = 7*HORIZ + BIT POS. IN HMASK
|
|
1330 ASL MULTIPLY BY 7
|
|
1340 ADC HGR.HORIZ 3* SO FAR
|
|
1350 ASL 6*
|
|
1360 TAX SINCE 7* MIGHT NOT FIT IN 1 BYTE,
|
|
1370 * WAIT TILL LATER FOR LAST ADD
|
|
1380 DEX
|
|
1390 LDA MON.HMASK NOW FIND BIT POSITION IN HMASK
|
|
1400 AND #$7F ONLY LOOK AT LOW SEVEN
|
|
1410 .1 INX COUNT A SHIFT
|
|
1420 LSR
|
|
1430 BNE .1 STILL IN THERE
|
|
1440 STA HGR.X+1 ZERO TO HI-BYTE
|
|
1450 TXA 6*HORIZ+LOG2(HMASK)
|
|
1460 CLC ADD HORIZ ONE MORE TIME
|
|
1470 ADC HGR.HORIZ 7*HORIZ+LOG2(HMASK)
|
|
1480 BCC .2 UPPER BYTE = 0
|
|
1490 INC HGR.X+1 UPPER BYTE = 1
|
|
1500 .2 STA HGR.X STORE LOWER BYTE
|
|
1510 RTS.22 RTS
|
|
1520 *--------------------------------
|
|
1530 * DRAW A SHAPE
|
|
1540 *
|
|
1550 * (Y,X) = SHAPE STARTING ADDRESS
|
|
1560 * (A) = ROTATION (0-3F)
|
|
1570 *--------------------------------
|
|
1580 * APPLESOFT DOES NOT CALL DRAW0
|
|
1590 *--------------------------------
|
|
1600 DRAW0 STX HGR.SHAPE SAVE SHAPE ADDRESS
|
|
1610 STY HGR.SHAPE+1
|
|
1620 *--------------------------------
|
|
1630 * APPLESOFT ENTERS HERE
|
|
1640 *--------------------------------
|
|
1650 DRAW1 TAX SAVE ROTATION (0-$3F)
|
|
1660 LSR DIVIDE ROTATION BY 16 TO GET
|
|
1670 LSR QUADRANT (0=UP, 1=RT, 2=DWN, 3=LFT)
|
|
1680 LSR
|
|
1690 LSR
|
|
1700 STA HGR.QUADRANT
|
|
1710 TXA USE LOW 4 BITS OF ROTATION TO INDEX
|
|
1720 AND #$0F THE TRIG TABLE
|
|
1730 TAX
|
|
1740 LDY COSINE.TABLE,X SAVE COSINE IN HGR.DX
|
|
1750 STY HGR.DX
|
|
1760 EOR #$F AND SINE IN DY
|
|
1770 TAX
|
|
1780 LDY COSINE.TABLE+1,X
|
|
1790 INY
|
|
1800 STY HGR.DY
|
|
1810 LDY HGR.HORIZ INDEX FROM GBASL,H TO BYTE WE'RE IN
|
|
1820 LDX #0
|
|
1830 STX HGR.COLLISIONS CLEAR COLLISION COUNTER
|
|
1840 LDA (HGR.SHAPE,X) GET FIRST BYTE OF SHAPE DEFN
|
|
1850 .1 STA HGR.DX+1 KEEP SHAPE BYTE IN HGR.DX+1
|
|
1860 LDX #$80 INITIAL VALUES FOR FRACTIONAL VECTORS
|
|
1870 STX HGR.E .5 IN COSINE COMPONENT
|
|
1880 STX HGR.E+1 .5 IN SINE COMPONENT
|
|
1890 LDX HGR.SCALE SCALE FACTOR
|
|
1900 .2 LDA HGR.E ADD COSINE VALUE TO X-VALUE
|
|
1910 SEC IF >= 1, THEN DRAW
|
|
1920 ADC HGR.DX
|
|
1930 STA HGR.E ONLY SAVE FRACTIONAL PART
|
|
1940 BCC .3 NO INTEGRAL PART
|
|
1950 JSR LRUD1 TIME TO PLOT COSINE COMPONENT
|
|
1960 CLC
|
|
1970 .3 LDA HGR.E+1 ADD SINE VALUE TO Y-VALUE
|
|
1980 ADC HGR.DY IF >= 1, THEN DRAW
|
|
1990 STA HGR.E+1 ONLY SAVE FRACTIONAL PART
|
|
2000 BCC .4 NO INTEGRAL PART
|
|
2010 JSR LRUD2 TIME TO PLOT SINE COMPONENT
|
|
2020 .4 DEX LOOP ON SCALE FACTOR.
|
|
2030 BNE .2 STILL ON SAME SHAPE ITEM
|
|
2040 LDA HGR.DX+1 GET NEXT SHAPE ITEM
|
|
2050 LSR NEXT 3 BIT VECTOR
|
|
2060 LSR
|
|
2070 LSR
|
|
2080 BNE .1 MORE IN THIS SHAPE BYTE
|
|
2090 INC HGR.SHAPE GO TO NEXT SHAPE BYTE
|
|
2100 BNE .5
|
|
2110 INC HGR.SHAPE+1
|
|
2120 .5 LDA (HGR.SHAPE,X) NEXT BYTE OF SHAPE DEFINITION
|
|
2130 BNE .1 PROCESS IF NOT ZERO
|
|
2140 RTS FINISHED
|
|
2150 *--------------------------------
|
|
2160 * XDRAW A SHAPE (SAME AS DRAW, EXCEPT TOGGLES SCREEN)
|
|
2170 *
|
|
2180 * (Y,X) = SHAPE STARTING ADDRESS
|
|
2190 * (A) = ROTATION (0-3F)
|
|
2200 *--------------------------------
|
|
2210 * APPLESOFT DOES NOT CALL XDRAW0
|
|
2220 *--------------------------------
|
|
2230 XDRAW0 STX HGR.SHAPE SAVE SHAPE ADDRESS
|
|
2240 STY HGR.SHAPE+1
|
|
2250 *--------------------------------
|
|
2260 * APPLESOFT ENTERS HERE
|
|
2270 *--------------------------------
|
|
2280 XDRAW1 TAX SAVE ROTATION (0-$3F)
|
|
2290 LSR DIVIDE ROTATION BY 16 TO GET
|
|
2300 LSR QUADRANT (0=UP, 1=RT, 2=DWN, 3=LFT)
|
|
2310 LSR
|
|
2320 LSR
|
|
2330 STA HGR.QUADRANT
|
|
2340 TXA USE LOW 4 BITS OF ROTATION TO INDEX
|
|
2350 AND #$0F THE TRIG TABLE
|
|
2360 TAX
|
|
2370 LDY COSINE.TABLE,X SAVE COSINE IN HGR.DX
|
|
2380 STY HGR.DX
|
|
2390 EOR #$F AND SINE IN DY
|
|
2400 TAX
|
|
2410 LDY COSINE.TABLE+1,X
|
|
2420 INY
|
|
2430 STY HGR.DY
|
|
2440 LDY HGR.HORIZ INDEX FROM GBASL,H TO BYTE WE'RE IN
|
|
2450 LDX #0
|
|
2460 STX HGR.COLLISIONS CLEAR COLLISION COUNTER
|
|
2470 LDA (HGR.SHAPE,X) GET FIRST BYTE OF SHAPE DEFN
|
|
2480 .1 STA HGR.DX+1 KEEP SHAPE BYTE IN HGR.DX+1
|
|
2490 LDX #$80 INITIAL VALUES FOR FRACTIONAL VECTORS
|
|
2500 STX HGR.E .5 IN COSINE COMPONENT
|
|
2510 STX HGR.E+1 .5 IN SINE COMPONENT
|
|
2520 LDX HGR.SCALE SCALE FACTOR
|
|
2530 .2 LDA HGR.E ADD COSINE VALUE TO X-VALUE
|
|
2540 SEC IF >= 1, THEN DRAW
|
|
2550 ADC HGR.DX
|
|
2560 STA HGR.E ONLY SAVE FRACTIONAL PART
|
|
2570 BCC .3 NO INTEGRAL PART
|
|
2580 JSR LRUDX1 TIME TO PLOT COSINE COMPONENT
|
|
2590 CLC
|
|
2600 .3 LDA HGR.E+1 ADD SINE VALUE TO Y-VALUE
|
|
2610 ADC HGR.DY IF >= 1, THEN DRAW
|
|
2620 STA HGR.E+1 ONLY SAVE FRACTIONAL PART
|
|
2630 BCC .4 NO INTEGRAL PART
|
|
2640 JSR LRUDX2 TIME TO PLOT SINE COMPONENT
|
|
2650 .4 DEX LOOP ON SCALE FACTOR.
|
|
2660 BNE .2 STILL ON SAME SHAPE ITEM
|
|
2670 LDA HGR.DX+1 GET NEXT SHAPE ITEM
|
|
2680 LSR NEXT 3 BIT VECTOR
|
|
2690 LSR
|
|
2700 LSR
|
|
2710 BNE .1 MORE IN THIS SHAPE BYTE
|
|
2720 INC HGR.SHAPE GO TO NEXT SHAPE BYTE
|
|
2730 BNE .5
|
|
2740 INC HGR.SHAPE+1
|
|
2750 .5 LDA (HGR.SHAPE,X) NEXT BYTE OF SHAPE DEFINITION
|
|
2760 BNE .1 PROCESS IF NOT ZERO
|
|
2770 RTS FINISHED
|
|
2780 *--------------------------------
|
|
2790 * GET HI-RES PLOTTING COORDINATES (0-279,0-191) FROM
|
|
2800 * TXTPTR. LEAVE REGISTERS SET UP FOR HPOSN:
|
|
2810 * (Y,X)=X-COORD
|
|
2820 * (A) =Y-COORD
|
|
2830 *--------------------------------
|
|
2840 HFNS JSR FRMNUM EVALUATE EXPRESSION, MUST BE NUMERIC
|
|
2850 JSR GETADR CONVERT TO 2-BYTE INTEGER IN LINNUM
|
|
2860 LDY LINNUM+1 GET HORIZ COOR IN X,Y
|
|
2870 LDX LINNUM
|
|
2880 CPY /280 MAKE SURE IT IS < 280
|
|
2890 BCC .1 IN RANGE
|
|
2900 BNE GGERR
|
|
2910 CPX #280
|
|
2920 BCS GGERR
|
|
2930 .1 TXA SAVE HORIZ COOR ON STACK
|
|
2940 PHA
|
|
2950 TYA
|
|
2960 PHA
|
|
2970 LDA #',' REQUIRE A COMMA
|
|
2980 JSR SYNCHR
|
|
2990 JSR GETBYT EVAL EXP TO SINGLE BYTE IN X-REG
|
|
3000 CPX #192 CHECK FOR RANGE
|
|
3010 BCS GGERR TOO BIG
|
|
3020 STX FAC SAVE Y-COORD
|
|
3030 PLA RETRIEVE HORIZONTAL COORDINATE
|
|
3040 TAY
|
|
3050 PLA
|
|
3060 TAX
|
|
3070 LDA FAC AND VERTICAL COORDINATE
|
|
3080 RTS
|
|
3090 *--------------------------------
|
|
3100 GGERR JMP GOERR ILLEGAL QUANTITY ERROR
|
|
3110 *--------------------------------
|
|
3120 * "HCOLOR=" STATEMENT
|
|
3130 *--------------------------------
|
|
3140 HCOLOR JSR GETBYT EVAL EXP TO SINGLE BYTE IN X
|
|
3150 CPX #8 VALUE MUST BE 0-7
|
|
3160 BCS GGERR TOO BIG
|
|
3170 LDA COLORTBL,X GET COLOR PATTERN
|
|
3180 STA HGR.COLOR
|
|
3190 RTS.23 RTS
|
|
3200 *--------------------------------
|
|
3210 COLORTBL .HS 002A557F80AAD5FF
|
|
3220 *--------------------------------
|
|
3230 * "HPLOT" STATEMENT
|
|
3240 *
|
|
3250 * HPLOT X,Y
|
|
3260 * HPLOT TO X,Y
|
|
3270 * HPLOT X1,Y1 TO X2,Y2
|
|
3280 *--------------------------------
|
|
3290 HPLOT CMP #TOKEN.TO "PLOT TO" FORM?
|
|
3300 BEQ .2 YES, START FROM CURRENT LOCATION
|
|
3310 JSR HFNS NO, GET STARTING POINT OF LINE
|
|
3320 JSR HPLOT0 PLOT THE POINT, AND SET UP FOR
|
|
3330 * DRAWING A LINE FROM THAT POINT
|
|
3340 .1 JSR CHRGOT CHARACTER AT END OF EXPRESSION
|
|
3350 CMP #TOKEN.TO IS A LINE SPECIFIED?
|
|
3360 BNE RTS.23 NO, EXIT
|
|
3370 .2 JSR SYNCHR YES. ADV. TXTPTR (WHY NOT CHRGET)
|
|
3380 JSR HFNS GET COORDINATES OF LINE END
|
|
3390 STY DSCTMP SET UP FOR LINE
|
|
3400 TAY
|
|
3410 TXA
|
|
3420 LDX DSCTMP
|
|
3430 JSR HGLIN PLOT LINE
|
|
3440 JMP .1 LOOP TILL NO MORE "TO" PHRASES
|
|
3450 *--------------------------------
|
|
3460 * "ROT=" STATEMENT
|
|
3470 *--------------------------------
|
|
3480 ROT JSR GETBYT EVAL EXP TO A BYTE IN X-REG
|
|
3490 STX HGR.ROTATION
|
|
3500 RTS
|
|
3510 *--------------------------------
|
|
3520 * "SCALE=" STATEMENT
|
|
3530 *--------------------------------
|
|
3540 SCALE JSR GETBYT EVAL EXP TO A BYTE IN X-REG
|
|
3550 STX HGR.SCALE
|
|
3560 RTS
|
|
3570 *--------------------------------
|
|
3580 * SET UP FOR DRAW AND XDRAW
|
|
3590 *--------------------------------
|
|
3600 DRWPNT JSR GETBYT GET SHAPE NUMBER IN X-REG
|
|
3610 LDA HGR.SHAPE.PNTR SEARCH FOR THAT SHAPE
|
|
3620 STA HGR.SHAPE SET UP PNTR TO BEGINNING OF TABLE
|
|
3630 LDA HGR.SHAPE.PNTR+1
|
|
3640 STA HGR.SHAPE+1
|
|
3650 TXA
|
|
3660 LDX #0
|
|
3670 CMP (HGR.SHAPE,X) COMPARE TO # OF SHAPES IN TABLE
|
|
3680 BEQ .1 LAST SHAPE IN TABLE
|
|
3690 BCS GGERR SHAPE # TOO LARGE
|
|
3700 .1 ASL DOUBLE SHAPE# TO MAKE AN INDEX
|
|
3710 BCC .2 ADD 256 IF SHAPE # > 127
|
|
3720 INC HGR.SHAPE+1
|
|
3730 CLC
|
|
3740 .2 TAY USE INDEX TO LOOK UP OFFSET FOR SHAPE
|
|
3750 LDA (HGR.SHAPE),Y IN OFFSET TABLE
|
|
3760 ADC HGR.SHAPE
|
|
3770 TAX
|
|
3780 INY
|
|
3790 LDA (HGR.SHAPE),Y
|
|
3800 ADC HGR.SHAPE.PNTR+1
|
|
3810 STA HGR.SHAPE+1 SAVE ADDRESS OF SHAPE
|
|
3820 STX HGR.SHAPE
|
|
3830 JSR CHRGOT IS THERE ANY "AT" PHRASE?
|
|
3840 CMP #TOKEN.AT
|
|
3850 BNE .3 NO, DRAW RIGHT WHERE WE ARE
|
|
3860 JSR SYNCHR SCAN OVER "AT"
|
|
3870 JSR HFNS GET X- AND Y-COORDS TO START DRAWING AT
|
|
3880 JSR HPOSN SET UP CURSOR THERE
|
|
3890 .3 LDA HGR.ROTATION ROTATION VALUE
|
|
3900 RTS
|
|
3910 *--------------------------------
|
|
3920 * "DRAW" STATEMENT
|
|
3930 *--------------------------------
|
|
3940 DRAW JSR DRWPNT
|
|
3950 JMP DRAW1
|
|
3960 *--------------------------------
|
|
3970 * "XDRAW" STATEMENT
|
|
3980 *--------------------------------
|
|
3990 XDRAW JSR DRWPNT
|
|
4000 JMP XDRAW1
|
|
4010 *--------------------------------
|
|
4020 * "SHLOAD" STATEMENT
|
|
4030 *
|
|
4040 * READS A SHAPE TABLE FROM CASSETTE TAPE
|
|
4050 * TO A POSITION JUST BELOW HIMEM.
|
|
4060 * HIMEM IS THEN MOVED TO JUST BELOW THE TABLE
|
|
4070 *--------------------------------
|
|
4080 SHLOAD LDA /LINNUM SET UP TO READ TWO BYTES
|
|
4090 STA MON.A1H INTO LINNUM,LINNUM+1
|
|
4100 STA MON.A2H
|
|
4110 LDY #LINNUM
|
|
4120 STY MON.A1L
|
|
4130 INY LINNUM+1
|
|
4140 STY MON.A2L
|
|
4150 JSR MON.READ READ TAPE
|
|
4160 CLC SETUP TO READ (LINNUM) BYTES
|
|
4170 LDA MEMSIZ ENDING AT HIMEM-1
|
|
4180 TAX
|
|
4190 DEX FORMING HIMEM-1
|
|
4200 STX MON.A2L
|
|
4210 SBC LINNUM FORMING HIMEM-(LINNUM)
|
|
4220 PHA
|
|
4230 LDA MEMSIZ+1
|
|
4240 TAY
|
|
4250 INX SEE IF HIMEM LOW-BYTE WAS ZERO
|
|
4260 BNE .1 NO
|
|
4270 DEY YES, HAVE TO DECREMENT HIGH BYTE
|
|
4280 .1 STY MON.A2H
|
|
4290 SBC LINNUM+1
|
|
4300 CMP STREND+1 RUNNING INTO VARIABLES?
|
|
4310 BCC .2 YES, OUT OF MEMORY
|
|
4320 BNE .3 NO, STILL ROOM
|
|
4330 .2 JMP MEMERR MEM FULL ERR
|
|
4340 .3 STA MEMSIZ+1
|
|
4350 STA FRETOP+1 CLEAR STRING SPACE
|
|
4360 STA MON.A1H (BUT NAMES ARE STILL IN VARTBL!)
|
|
4370 STA HGR.SHAPE.PNTR+1
|
|
4380 PLA
|
|
4390 STA HGR.SHAPE.PNTR
|
|
4400 STA MEMSIZ
|
|
4410 STA FRETOP
|
|
4420 STA MON.A1L
|
|
4430 JSR MON.RD2BIT READ TO TAPE TRANSITIONS
|
|
4440 LDA #3 SHORT DELAY FOR INTERMEDIATE HEADER
|
|
4450 JMP MON.READ2 READ SHAPES
|
|
4460 *--------------------------------
|
|
4470 * CALLED FROM STORE AND RECALL
|
|
4480 *--------------------------------
|
|
4490 TAPEPNT
|
|
4500 CLC
|
|
4510 LDA LOWTR
|
|
4520 ADC LINNUM
|
|
4530 STA MON.A2L
|
|
4540 LDA LOWTR+1
|
|
4550 ADC LINNUM+1
|
|
4560 STA MON.A2H
|
|
4570 LDY #4
|
|
4580 LDA (LOWTR),Y
|
|
4590 JSR GETARY2
|
|
4600 LDA HIGHDS
|
|
4610 STA MON.A1L
|
|
4620 LDA HIGHDS+1
|
|
4630 STA MON.A1H
|
|
4640 RTS
|
|
4650 *--------------------------------
|
|
4660 * CALLED FROM STORE AND RECALL
|
|
4670 *--------------------------------
|
|
4680 GETARYPT
|
|
4681 LDA #$40
|
|
4690 STA SUBFLG
|
|
4700 JSR PTRGET
|
|
4710 LDA #0
|
|
4720 STA SUBFLG
|
|
4730 JMP VARTIO
|
|
4740 *--------------------------------
|
|
4750 * "HTAB" STATEMENT
|
|
4760 *
|
|
4770 * NOTE THAT IF WNDLEFT IS NOT 0, HTAB CAN PRINT
|
|
4780 * OUTSIDE THE SCREEN (EG., IN THE PROGRAM)
|
|
4790 *--------------------------------
|
|
4800 HTAB JSR GETBYT
|
|
4810 DEX
|
|
4820 TXA
|
|
4830 .1 CMP #40
|
|
4840 BCC .2
|
|
4850 SBC #40
|
|
4860 PHA
|
|
4870 JSR CRDO
|
|
4880 PLA
|
|
4890 JMP .1
|
|
4900 .2 STA MON.CH
|
|
4910 RTS
|
|
4920 *--------------------------------
|
|
4930 .AS -/KRW/ SOMEONE'S INITIALS?
|