Some more old undocumented code, but I think it was quite good 35 years ago ;-)
L.
10*K.10O.|MREN.|M*FX12 3|ML.|M
20MODE 7:PRINTTAB(0,10)RND(-TIME)
30
40DIM code &800
50P%=&70:[OPT0
60
70.ldat EQUD &7777FFFF
80 EQUD &11113333
90.rdat EQUD &CCCC8888
100 EQUD &FFFFEEEE
110.pat EQUD &00000000 :\EOR
120 EQUD &00000000 :\FF
130.scr EQUW &6000
140.raw EQUB 0
150.ord EQUB 0
160.yp EQUB 0
170.xpl EQUB 0
180.xpr EQUB 0
190.bot EQUB 0
200.ansl EQUB 0
210.ans EQUB 0
220.flo1:.x3 EQUB 0
230.flo2:.y3 EQUB 0
240.flo3:.x2 EQUB 0
250.fhi1:.y2 EQUB 0
260.fhi2:.x1 EQUB 0
270.fhi3:.y1 EQUB 0
280.llo EQUB 0
290.rlo EQUB 0
300.lhi EQUB 0
310.rhi EQUB 0
320.xflp:.allo EQUB 0
330.yflp:.arlo EQUB 0
340.alhi EQUB 0
350.arhi EQUB 0
360
370]:IF P%>&A0 THEN STOP
380aosl=&F8
390aosr=&F9
400FOR ps=0 TO 3 STEP 2
410
420P%=code:[OPT ps:.Demo
430
440.Triangle
450
460 lda y2:cmp y3:bcc if1:ldx y3:sta y3:txa:ldx x3:ldy x2:stx x2:sty x3
470.if1:cmp y1:bcs if2:ldx y1:sta y1:txa:ldx x1:ldy x2:stx x2:sty x1:cmp y3:bcc if2:ldx y3:sta y3:txa:ldx x3:ldy x2:stx x2:sty x3
480.if2:sta y2
490
500.all
510 lda y1
520 sta yp
530 lda y3
540 sec
550 sbc y1
560 bne n1
570
580 jmp single
590
600.n1
610 sta bot
620 lda #0
630 sta ansl
640 lda #128
650 sta llo
660 sta rlo
670 lda x1
680 sta xpl
690 sta lhi
700 sta xpr
710 sta rhi
720 lda x3
730 sbc x1
740 sta ans
750 bne sm5
760
770 lsr aosl
771 lsr aosr
780 jmp sm6
790
800.sm5
810 ror A
811 sta aosl
812 sta aosr
813 rol A
820 jsr dset
830
840 lda ans
850.sm6
860 sta alhi
870 sta arhi
880 lda ansl
890 sta allo
900 sta arlo
910
920.top
930 sec
940 lda y2
950 sbc y1
960 bne sm1
970 lda x2
980 cmp x1
990 bcc sm2
1000
1010 sta xpr
1020 sta rhi
1030 lda #1
1040 jmp sm3
1050
1060.sm2
1070 sta xpl
1080 sta lhi
1090 lda #0
1100.sm3
1110 sta x1
1120 eor #1
1130 sta x1
1140 jsr line
1150
1160 jmp btm
1170
1180.sm1
1190 sta bot
1200 lda #0
1210 sta ansl
1220 lda x2
1230 sbc x1
1240 sta ans
1250 beq sm4
1260
1261 ror A
1270 sta aosr
1271 rol A
1280 jsr dset
1290
1300 lda aosl
1310 eor aosr
1320 bpl ts1
1330
1340 bit aosl
1350 bmi tsl
1360
1370 jmp tsr
1380
1390.ts1
1400 lda ans
1410 cmp alhi
1420 beq ts2
1430
1440 ror A
1450 eor aosl
1460 bmi tsl
1470
1480 jmp tsr
1490
1500.ts2
1510 lda ansl
1520 cmp allo
1530 ror A
1540 eor aosl
1550 bmi tsl
1560
1570.tsr:lda ansl:sta arlo:lda ans:sta arhi:lda #0:jmp sm4
1580
1590.tsl:asl aosl:rol A:asl aosr:ror aosl:ror A:ror aosr:lda ansl:sta allo:lda ans:sta alhi:lda #1
1600
1610.sm4
1620 sta x1
1630 eor #1
1640 sta x1
1650 lsr alhi:ror allo:ror x2
1660 lsr arhi:ror arlo:ror y2
1670 jsr adds
1680
1690 jsr line
1700
1710 inc yp
1720 dec bot
1730 beq tend
1740
1750 asl y2:rol arlo:rol arhi
1760 asl x2:rol allo:rol alhi
1770
1780.toop
1790 jsr adds
1800
1810 jsr line
1820
1830 inc yp
1840 dec bot
1850 bne toop
1860
1870 lsr alhi:ror allo:ror x2
1880 lsr arhi:ror arlo:ror y2
1890.tend
1900 jsr adds
1910
1920 jsr line
1930
1940.btm
1950 ldx x1
1960 lda #0
1970 sta ansl
1980 lda #128
1990 sta llo,X
2000 sec
2010 lda y3
2020 sbc yp
2030 beq triend
2040
2050 sta bot
2060 lda x3
2070 sbc lhi,X
2080 sta ans
2090 beq bndiv
2100
2101 ror A
2110 sta aosl,X
2111 rol A
2120 jsr dset
2130
2140.bndiv
2150 lda ans
2160 lsr A
2170 sta alhi,X
2180 lda ansl
2190 ror A
2200 sta allo,X
2210 ror x2,X
2220 jsr adds
2230
2240 inc yp
2250 dec bot
2260 beq trilst
2270
2280 asl x2:rol allo:rol alhi
2290 asl y2:rol arlo:rol arhi
2300.boop
2310 jsr adds
2320
2330 jsr tline
2340
2350 inc yp
2360 dec bot
2370 bne boop
2380
2390 lsr alhi:ror allo
2400 lsr arhi:ror arlo
2410.trilst
2420 jsr adds
2430
2440 jsr tline
2450
2460.triend
2470 rts
2480
2490.adds
2500 ldx #0
2510 jsr adsu
2520
2530 inx
2540.adsu
2550 lda aosl,X
2560 bpl subs
2570
2580 clc:lda llo,X:adc allo,X:sta llo,X:lda lhi,X:adc alhi,X:sta lhi,X:sta xpl,X:rts
2590
2600.subs:sec:lda llo,X:sbc allo,X:sta llo,X:lda lhi,X:sbc alhi,X:sta lhi,X:sta xpl,X:rts
2610
2620.dset
2630 bcs Divide
2640
2650.negd
2660 eor #&FF
2670 sta ans
2680 inc ans
2690.Divide:bit bot:bpl div:lsr bot:php:jsr div:lsr ans:ror ansl:plp:rol bot:rts
2700.div:lda #0:ldy #8:.loop:rol ans:rol A:cmp bot:bcc next:sbc bot:.next:dey:bne loop:rol ans:ldy #8:.loop2:asl A:cmp bot:bcc next2:sbc bot:.next2:rol ansl:dey:bne loop2:rts
2710
2720.single
2730 lda x3
2740 cmp x2
2750 bcc t1
2760
2770 lda x2
2780.t1
2790 cmp x1
2800 bcc t2
2810
2820 lda x1
2830.t2
2840 sta xpl
2850 lda x3
2860 cmp x2
2870 bcs t3
2880 lda x2
2890.t3
2900 cmp x1
2910 bcs t4
2920
2930 lda x1
2940.t4
2950 sta xpr
2960
2970 jmp line
2980.tline
2990 LDA xpr
3000 CMP xpl
3010 BCS line
3020
3030 LDY xpl
3040 STA xpl
3050 STY xpr
3060.line
3070 LDA yp
3080 LSR A
3090 LSR A
3100 LSR A
3110 ORA #&60
3120 STA scr+1
3130 LDA yp
3140 AND #7
3150 TAY
3160 LDA xpr
3170 AND #&07
3180 TAX
3190 EOR xpr
3200 STA scr
3210 EOR xpl
3220 AND #&F8
3230 BEQ one
3240
3250 LDA rdat,X
3260 STAraw:ORA(scr),Y:STAord:LDAraw:ANDpat,Y:EORord
3270 STA (scr),Y
3280 LDA scr
3290 SEC
3300 SBC #8
3310 STA scr
3320 CMP xpl
3330 BCC lfsd
3340 BEQ lfsd
3350 LDA pat,Y
3360 EOR #&FF
3370 TAX
3380.mid
3390 TXA
3400 STA (scr),Y
3410 LDA scr
3420 SBC #8
3430 STA scr
3440 CMP xpl
3450 BEQ lfsd
3460 BCS mid
3470.lfsd
3480 LDA xpl
3490 AND #7
3500 TAX
3510 LDA ldat,X
3520 STAraw:ORA(scr),Y:STAord:LDAraw:ANDpat,Y:EORord
3530 STA (scr),Y
3540 RTS
3550
3560.one
3570 LDA xpl
3580 AND #7
3590 TAX
3600 LDA ldat,X
3610 PHA
3620 LDA xpr
3630 AND #7
3640 TAX
3650 PLA
3660 AND rdat,X
3670 STAraw:ORA(scr),Y:STAord:LDAraw:ANDpat,Y:EORord
3680 STA (scr),Y
3690 RTS
3700.Rotate
3710
3720 lda xhi,X:sta xflp:bpl nxf:eor #&FF:sta xhi,X:lda xlo,X:eor #&FF:sta xlo,X:inc xlo,X:bne nxf:inc xhi,X:.nxf
3730 lda yhi,X:sta yflp:bpl nyf:eor #&FF:sta yhi,X:lda ylo,X:eor #&FF:sta ylo,X:inc ylo,X:bne nyf:inc yhi,X:.nyf
3740
3750 lda xlo,X:asl A:lda xhi,X:rol A:sec:sta flo2:lda xlo,X:sbc flo2:sta flo2:lda xhi,X:sbc #0:sta fhi2
3760 lda xflp:bpl nxcf:lda flo2:eor #&FF:sta flo2:lda fhi2:eor #&FF:sta fhi2:inc flo2:bne nxcf:inc fhi2:.nxcf
3770
3780 lda ylo,X:sta flo1:lda yhi,X:lsr A:ror flo1:lsr A:ror flo1:lsr A:ror flo1:sta fhi1
3790 lda yflp:eor r_l:bpl nysf:lda flo1:eor #&FF:sta flo1:lda fhi1:eor #&FF:sta fhi1:inc flo1:bne nysf:inc fhi1:.nysf
3800
3810 clc:lda flo1:adc flo2:sta flo1:lda fhi1:adc fhi2:sta fhi1
3820
3830 lda ylo,X:asl A:lda yhi,X:rol A:sec:sta flo2:lda ylo,X:sbc flo2:sta flo2:lda yhi,X:sbc #0:sta fhi2
3840 lda yflp:bpl nycf:lda flo2:eor #&FF:sta flo2:lda fhi2:eor #&FF:sta fhi2:inc flo2:bne nycf:inc fhi2:.nycf
3850
3860 lda xlo,X:sta flo3:lda xhi,X:lsr A:ror flo3:lsr A:ror flo3:lsr A:ror flo3:sta fhi3
3870 lda xflp:eor r_l:bpl nxsf:lda flo3:eor #&FF:sta flo3:lda fhi3:eor #&FF:sta fhi3:inc flo3:bne nxsf:inc fhi3:.nxsf
3880
3890 sec:lda flo2:sbc flo3:sta flo2:lda fhi2:sbc fhi3:sta fhi2:rts
3900
3910.Rotateing
3920 ldx #2
3930.looping
3940 jsr Rotate
3950 lda flo1:sta xlo,X
3960 lda fhi1:sta xhi,X
3970 lda flo2:sta ylo,X
3980 lda fhi2:sta yhi,X
3990 dex
4000 bpl looping
4010
4020.draw
4030 ldx #2
4040
4050 lda xhi,X:eor #128:sta x1:lda yhi,X:eor #127:sta y1:dex
4060 lda xhi,X:eor #128:sta x2:lda yhi,X:eor #127:sta y2:dex
4070 lda xhi,X:eor #128:sta x3:lda yhi,X:eor #127:sta y3:dex
4080
4090 jsr Triangle
4100 rts
4110
4120.xlo:EQUD 0:.xhi:EQUD 0
4130.ylo:EQUD 0:.yhi:EQUD 0
4140.r_l:EQUB 0
4150
4160]:NEXT
4170MODE5:PRINTTAB(0,11)"code &"STR$~(P%-code)
4180VDU 28,0,31,19,6
4190
4200FOR X%=0 TO 15
4210READ Y%:X%?xlo=Y%
4220NEXT
4230
4240?&FE00=1 :?&FE01=32
4250?&FE00=12:?&FE01=12
4260?&FE00=13:?&FE01=0
4270
4280PROCds
4290CALL draw
4300
4310?r_l=RND AND &FF
4320IF ?r_l =0 THEN GOTO 4310
4330CLS:REPEAT
4340!pat=0:pat!4=0:CALL Rotateing
4341!pat=-1:pat!4=-1:CALL draw
4350?r_l=?r_l-(?r_l>128)*2-1:UNTIL ?r_l=0
4360GOTO 4310
4370DEFPROCds
4380FOR X%=0 TO 2:PRINTTAB(8-X%*4,8+X%)FNR(X%?xhi);" ";FNR(X%?yhi):NEXT
4390ENDPROC
4400DEFFNR(Z%)
4410=STR$((Z% EOR 128)-128)
4420DATA 0,0,0,0
4430DATA 192,64,0,0
4440DATA 0,0,0,0
4450DATA 192,192,64,0
>
| Attachments: |
File comment: Rotation, line drawing and triangle mode 5 demo
tri_demo.zip [3.51 KiB]
Downloaded 16 times |
).