home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Transactor
/
Transactor_21_1988_Transactor_Publishing.d64
/
polygon.pal
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2023-02-26
|
4KB
|
229 lines
100 rem 'hires' circle - polygon
110 rem source file by anthony bryant
120 sys 700
130 .opt n
140 ;
150 ;
160 ;"hires" variables by g.kiziak
170 x1 = $c027 ;current position
180 y1 = $c029
190 x2 = $c02b ;new position
200 y2 = $c02d
210 xc = $c02f ;circ centre (also box)
220 yc = $c031
230 hm = $c035 ;hires/multi flag
240 ;
250 ;
260 ;"hires" internal subroutines
270 igeti =$c17c ;internal get integer
280 ieget =$c187 ;internal eat & get x,y
290 move =$c26e ;'move' rtn
300 imov =$c271 ;internal moveto x1,y1
310 iplt =$c375 ;internal plot
320 idrw =$c42b ;internal drawto
330 ;
340 ;zero page labels
350 theta = $57 ;the angle (0-90deg)
360 ysign = $58 ;dependent on quadrant
370 xsign = $59 ; " "
380 ;
390 *=$8000 ;423 bytes
400 ;
410 xr .wor 0 ;x radius
420 yr .wor 0 ;y radius
430 arcst .wor 0 ;arc start (deg)
440 arcend .wor 360;arc end angl (deg)
450 delta .byt 5 ;poly(NULL)n incr (deg)
460 ;
470 ;subroutine get angle (deg) integer
480 ;accuracy to 1 deg (hex 5a=90deg)
490 getan pha ;save acc
500 jsr $0079
510 beq nomore
520 jsr $aefd ;eat ","
530 cmp #","
540 beq nomore ;another "," !
550 pla ;throw away acc
560 jmp igeti ;get integer to .a & .x
570 nomore pla
580 rts ;result in .a & .x
590 ;
600 ;subroutine moveto xc,yc
610 movc ldx #3
620 lda x2,x
630 sta xc,x
640 dex
650 bpl movc+2
660 rts
670 ;
680 ;subroutine moveto xr,yr
690 movr ldx #3
700 lda x2,x
710 sta xr,x
720 dex
730 bpl movr+2
740 rts
750 ;
760 ;sys circle,xc,yc,xr,yr[,sa,ea,inc]
770 circle = *
780 jsr ieget
790 jsr movc ;moveto xc,yc
800 jsr ieget
810 jsr movr ;moveto xr,yr
820 lda #0
830 ldx #0 ;default arcst
840 jsr getan ;get sa (degrees)
850 sta arcst
860 stx arcst+1
870 lda #<360
880 ldx #>360;default arcend
890 jsr getan ;get ea (degrees)
900 sta arcend
910 stx arcend+1
920 lda #5 ;default delta
930 jsr getan ;get inc (degrees)
940 tax
950 bne crc1
960 lda #1 ;minimum
970 crc1 sta delta
980 lda #0
990 sta $5b
1000 sta $5c
1010 loop lda arcst
1020 ldx arcst+1
1030 ldy #$ff
1040 ;find quadrant and angle theta
1050 lp2 iny
1060 sec
1070 sbc #$5a
1080 bcs lp2
1090 dex
1100 bpl lp2 ;.y=quadn (0-3)
1110 adc #$5a
1120 sta theta ;(0-90deg)
1130 tya
1140 lsr
1150 bcc lp3
1160 lda #$5a
1170 sec
1180 sbc theta
1190 sta theta
1200 lp3 tya
1210 lsr
1220 lsr
1230 ror
1240 sta ysign
1250 tya
1260 and #3
1270 beq lp4
1280 sec
1290 sbc #3
1300 lp4 sta xsign
1310 ;do yr*sin(theta)
1320 lda yr
1330 ldx yr+1
1340 jsr calcsin
1350 ldy ysign
1360 jsr absv ;check y sign
1370 clc
1380 adc yc
1390 sta y2
1400 txa
1410 adc yc+1
1420 sta y2+1
1430 ;do xr*cos(theta)
1440 lda xr
1450 ldx xr+1
1460 jsr calccos
1470 ldy xsign
1480 jsr absv ;check x sign
1490 clc
1500 adc xc
1510 sta x2
1520 txa
1530 adc xc+1
1540 sta x2+1
1550 ldx $5b
1560 beq lp5 ;flag a moveto
1570 jsr idrw ;drawto
1580 ldx $5c
1590 beq lp6
1600 rts
1610 lp5 dec $5b ;cancel flag
1620 jsr imov ;moveto
1630 lp6 lda delta
1640 clc
1650 adc arcst
1660 sta arcst
1670 bcc lp7
1680 inc arcst+1
1690 lp7 lda arcst
1700 cmp arcend
1710 lda arcst+1
1720 sbc arcend+1
1730 bcc lp8
1740 dec $5c ;cancel flag
1750 lp8 jmp loop
1760 ;
1770 ;subroutine absolute value
1780 absv bpl abok
1790 clc
1800 eor #$ff
1810 adc #1
1820 pha
1830 txa
1840 eor #$ff
1850 adc #0
1860 tax
1870 pla
1880 abok rts ;result in .a & .x
1890 ;
1900 ;subroutine calculate sine func
1910 calccos pha
1920 lda #$5a
1930 sec
1940 sbc theta ;(90-theta)
1950 tay
1960 pla
1970 .byt $2c
1980 calcsin ldy theta
1990 stx $15 ;hibyt
2000 ldx sine,y
2010 calc stx $22
2020 sta $14 ;lobyt
2030 lda #0
2040 sta $23
2050 ldx #8 ;16bit*fract
2060 cal2 lsr $22
2070 bcc cal3
2080 clc
2090 adc $14
2100 pha
2110 lda $23
2120 adc $15
2130 sta $23
2140 pla
2150 cal3 lsr $23
2160 ror
2170 dex
2180 bne cal2
2190 sta $22 ;reslo in .a
2200 ldx $23
2210 rts ;reshi in .x
2220 ;
2230 sine = * ;table of sines (0-90 deg)
2240 .byt $00,$04,$09,$0d,$12,$16,$1b,$1f
2250 .byt $24,$28,$2c,$31,$35,$3a,$3e,$42
2260 .byt $47,$4b,$4f,$53,$58,$5c,$60,$64
2270 .byt $68,$6c,$70,$74,$78,$7c,$80,$84
2280 .byt $88,$8b,$8f,$93,$96,$9a,$9e,$a1
2290 .byt $a5,$a8,$ab,$af,$b2,$b5,$b8,$bb
2300 .byt $be,$c1,$c4,$c7,$ca,$cc,$cf,$d2
2310 .byt $d4,$d7,$d9,$db,$de,$e0,$e2,$e4
2320 .byt $e6,$e8,$ea,$ec,$ed,$ef,$f1,$f2
2330 .byt $f3,$f5,$f6,$f7,$f8,$f9,$fa,$fb
2340 .byt $fc,$fd,$fe,$fe,$ff,$ff,$ff,$ff
2350 .byt $ff,$ff,$ff
2360 ;
2370 .end