goapple2/source/applesoft/S.F5BA
2014-05-09 17:59:16 -07:00

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?