home *** CD-ROM | disk | FTP | other *** search
/ Transactor / Transactor_21_1988_Transactor_Publishing.d64 / polygon.pal (.txt) < prev    next >
Commodore BASIC  |  2023-02-26  |  4KB  |  229 lines
  1. 100 rem  'hires'  circle - polygon
  2. 110 rem  source file by anthony bryant
  3. 120 sys 700
  4. 130 .opt n
  5. 140 ;
  6. 150 ;
  7. 160 ;"hires" variables by g.kiziak
  8. 170 x1   = $c027 ;current position
  9. 180 y1   = $c029
  10. 190 x2   = $c02b ;new position
  11. 200 y2   = $c02d
  12. 210 xc   = $c02f ;circ centre (also box)
  13. 220 yc   = $c031
  14. 230 hm   = $c035 ;hires/multi flag
  15. 240 ;
  16. 250 ;
  17. 260 ;"hires" internal subroutines
  18. 270 igeti =$c17c ;internal get integer
  19. 280 ieget =$c187 ;internal eat & get x,y
  20. 290 move  =$c26e ;'move' rtn
  21. 300 imov  =$c271 ;internal moveto x1,y1
  22. 310 iplt  =$c375 ;internal plot
  23. 320 idrw  =$c42b ;internal drawto
  24. 330 ;
  25. 340 ;zero page labels
  26. 350 theta = $57  ;the angle (0-90deg)
  27. 360 ysign = $58  ;dependent on quadrant
  28. 370 xsign = $59  ;    "          "
  29. 380 ;
  30. 390 *=$8000      ;423 bytes
  31. 400 ;
  32. 410 xr     .wor 0  ;x radius
  33. 420 yr     .wor 0  ;y radius
  34. 430 arcst  .wor 0  ;arc start (deg)
  35. 440 arcend .wor 360;arc end angl (deg)
  36. 450 delta  .byt 5  ;poly(NULL)n incr (deg)
  37. 460 ;
  38. 470 ;subroutine get angle (deg) integer
  39. 480 ;accuracy to 1 deg   (hex 5a=90deg)
  40. 490 getan pha  ;save acc
  41. 500 jsr $0079
  42. 510 beq nomore
  43. 520 jsr $aefd  ;eat ","
  44. 530 cmp #","
  45. 540 beq nomore ;another "," !
  46. 550 pla        ;throw away acc
  47. 560 jmp igeti  ;get integer to .a & .x
  48. 570 nomore pla
  49. 580 rts ;result in .a & .x
  50. 590 ;
  51. 600 ;subroutine moveto xc,yc
  52. 610 movc ldx #3
  53. 620 lda x2,x
  54. 630 sta xc,x
  55. 640 dex
  56. 650 bpl movc+2
  57. 660 rts
  58. 670 ;
  59. 680 ;subroutine moveto xr,yr
  60. 690 movr ldx #3
  61. 700 lda x2,x
  62. 710 sta xr,x
  63. 720 dex
  64. 730 bpl movr+2
  65. 740 rts
  66. 750 ;
  67. 760 ;sys circle,xc,yc,xr,yr[,sa,ea,inc]
  68. 770 circle = *
  69. 780 jsr ieget
  70. 790 jsr movc   ;moveto xc,yc
  71. 800 jsr ieget
  72. 810 jsr movr   ;moveto xr,yr
  73. 820 lda #0
  74. 830 ldx #0     ;default arcst
  75. 840 jsr getan  ;get sa (degrees)
  76. 850 sta arcst
  77. 860 stx arcst+1
  78. 870 lda #<360
  79. 880 ldx #>360;default arcend
  80. 890 jsr getan  ;get ea (degrees)
  81. 900 sta arcend
  82. 910 stx arcend+1
  83. 920 lda #5             ;default delta
  84. 930 jsr getan  ;get inc (degrees)
  85. 940 tax
  86. 950 bne crc1
  87. 960 lda #1    ;minimum
  88. 970 crc1 sta delta
  89. 980 lda #0
  90. 990 sta $5b
  91. 1000 sta $5c
  92. 1010 loop lda arcst
  93. 1020 ldx arcst+1
  94. 1030 ldy #$ff
  95. 1040 ;find quadrant and angle theta
  96. 1050 lp2 iny
  97. 1060 sec
  98. 1070 sbc #$5a
  99. 1080 bcs lp2
  100. 1090 dex
  101. 1100 bpl lp2  ;.y=quadn (0-3)
  102. 1110 adc #$5a
  103. 1120 sta theta  ;(0-90deg)
  104. 1130 tya
  105. 1140 lsr
  106. 1150 bcc lp3
  107. 1160 lda #$5a
  108. 1170 sec
  109. 1180 sbc theta
  110. 1190 sta theta
  111. 1200 lp3 tya
  112. 1210 lsr
  113. 1220 lsr
  114. 1230 ror
  115. 1240 sta ysign
  116. 1250 tya
  117. 1260 and #3
  118. 1270 beq lp4
  119. 1280 sec
  120. 1290 sbc #3
  121. 1300 lp4 sta xsign
  122. 1310 ;do yr*sin(theta)
  123. 1320 lda yr
  124. 1330 ldx yr+1
  125. 1340 jsr calcsin
  126. 1350 ldy ysign
  127. 1360 jsr absv ;check y sign
  128. 1370 clc
  129. 1380 adc yc
  130. 1390 sta y2
  131. 1400 txa
  132. 1410 adc yc+1
  133. 1420 sta y2+1
  134. 1430 ;do xr*cos(theta)
  135. 1440 lda xr
  136. 1450 ldx xr+1
  137. 1460 jsr calccos
  138. 1470 ldy xsign
  139. 1480 jsr absv ;check x sign
  140. 1490 clc
  141. 1500 adc xc
  142. 1510 sta x2
  143. 1520 txa
  144. 1530 adc xc+1
  145. 1540 sta x2+1
  146. 1550 ldx $5b
  147. 1560 beq lp5    ;flag a moveto
  148. 1570 jsr idrw   ;drawto
  149. 1580 ldx $5c
  150. 1590 beq lp6
  151. 1600 rts
  152. 1610 lp5 dec $5b  ;cancel flag
  153. 1620 jsr imov     ;moveto
  154. 1630 lp6 lda delta
  155. 1640 clc
  156. 1650 adc arcst
  157. 1660 sta arcst
  158. 1670 bcc lp7
  159. 1680 inc arcst+1
  160. 1690 lp7 lda arcst
  161. 1700 cmp arcend
  162. 1710 lda arcst+1
  163. 1720 sbc arcend+1
  164. 1730 bcc lp8
  165. 1740 dec $5c  ;cancel flag
  166. 1750 lp8 jmp loop
  167. 1760 ;
  168. 1770 ;subroutine absolute value
  169. 1780 absv bpl abok
  170. 1790 clc
  171. 1800 eor #$ff
  172. 1810 adc #1
  173. 1820 pha
  174. 1830 txa
  175. 1840 eor #$ff
  176. 1850 adc #0
  177. 1860 tax
  178. 1870 pla
  179. 1880 abok rts ;result in .a & .x
  180. 1890 ;
  181. 1900 ;subroutine calculate sine func
  182. 1910 calccos pha
  183. 1920 lda #$5a
  184. 1930 sec
  185. 1940 sbc theta ;(90-theta)
  186. 1950 tay
  187. 1960 pla
  188. 1970 .byt $2c
  189. 1980 calcsin ldy theta
  190. 1990 stx $15 ;hibyt
  191. 2000 ldx sine,y
  192. 2010 calc stx $22
  193. 2020 sta $14 ;lobyt
  194. 2030 lda #0
  195. 2040 sta $23
  196. 2050 ldx #8 ;16bit*fract
  197. 2060 cal2 lsr $22
  198. 2070 bcc cal3
  199. 2080 clc
  200. 2090 adc $14
  201. 2100 pha
  202. 2110 lda $23
  203. 2120 adc $15
  204. 2130 sta $23
  205. 2140 pla
  206. 2150 cal3 lsr $23
  207. 2160 ror
  208. 2170 dex
  209. 2180 bne cal2
  210. 2190 sta $22 ;reslo in .a
  211. 2200 ldx $23
  212. 2210 rts ;reshi in .x
  213. 2220 ;
  214. 2230 sine = * ;table of sines (0-90 deg)
  215. 2240 .byt $00,$04,$09,$0d,$12,$16,$1b,$1f
  216. 2250 .byt $24,$28,$2c,$31,$35,$3a,$3e,$42
  217. 2260 .byt $47,$4b,$4f,$53,$58,$5c,$60,$64
  218. 2270 .byt $68,$6c,$70,$74,$78,$7c,$80,$84
  219. 2280 .byt $88,$8b,$8f,$93,$96,$9a,$9e,$a1
  220. 2290 .byt $a5,$a8,$ab,$af,$b2,$b5,$b8,$bb
  221. 2300 .byt $be,$c1,$c4,$c7,$ca,$cc,$cf,$d2
  222. 2310 .byt $d4,$d7,$d9,$db,$de,$e0,$e2,$e4
  223. 2320 .byt $e6,$e8,$ea,$ec,$ed,$ef,$f1,$f2
  224. 2330 .byt $f3,$f5,$f6,$f7,$f8,$f9,$fa,$fb
  225. 2340 .byt $fc,$fd,$fe,$fe,$ff,$ff,$ff,$ff
  226. 2350 .byt $ff,$ff,$ff
  227. 2360 ;
  228. 2370 .end
  229.