The Sinclair QL Forum

Code: Select all

100 REMark A circle routine using only
110 REMark integer arithmetic.
120 REMark Converted some time ago from
130 REMark a ZX Spectrum Z80 m/c routine
140 REMark I wrote once.
150 REMark -Mark Swift-
200 MODE 4
210 OPEN#3;scr_512x256a0x0
220 CLS#3
230 LET XC=188: LET YC=128
240 LET RX=140: LET RY=95
250 LET WidX=14:LET WidY=10
260 GO SUB 500
270 PAUSE
280 CLOSE#3
290 STOP
500 REMark ELIPSE XC,YC,RX,RY,WidX,WidY
510 DIM S(18)
550 LET XR=INT (RX-INT(WidX/2)): LET YR=INT (RY-INT(WidY/2)): LET Index=1: GO SUB 1000
560 LET XR=INT (RX+INT((WidX+1)/2)): LET YR=INT (RY+INT((WidY+1)/2)): LET Index=10: GO SUB 1000
570 LET Xf=S(1): LET Xt=S(10): LET Y=0: GO SUB 710
580 LET Index=1
590 IF S(Index)=0 THEN  GO TO 610
600 GO SUB 1100: IF YI=0 THEN  GO TO 600
610 LET Index=1
620 LET Xf=S(Index): IF S(Index)=0 THEN  GO TO 640
630 GO SUB 1100: IF YI=0 THEN  GO TO 620
640 LET Index=10
650 IF S(Index)=0 THEN RETurn 
660 GO SUB 1100: IF YI=0 THEN  GO TO 650
670 LET Xt=S(10): LET Y=S(11): GO SUB 690
680 GO TO 610
690 REMark 
700 GO SUB 710: LET Y=-Y: GO SUB 710: RETurn 
710 REMark 
720 IF Xf<=0 THEN  GO TO 770
730 BLOCK#3;(Xt-Xf+1),1,(XC+Xf),YC+Y,7
740 BLOCK#3;(Xt-Xf+1),1,(XC-Xt),YC+Y,7
750 BLOCK#3;(Xf+Xf-1),1,(XC-Xf+1),YC+Y,2
760 RETurn 
770 BLOCK#3;(Xt+Xt+1),1,(XC-Xt),YC+Y,7
780 RETurn 
1000 REMark Initialisation routine
1010 REMark for elipse procedure.
1020 LET S(Index)=XR: LET S(Index+1)=0
1030 LET S(Index+2)=YR*YR: LET S(Index+3)=XR*XR
1040 LET S(Index+4)=S(Index+2)*XR: LET S(Index+5)=2*S(Index+4)
1050 LET S(Index+6)=0: LET S(Index+7)=S(Index+5)
1060 LET S(Index+8)=0
1070 RETurn 
1100 REMark 
1110 LET AX=ABS(S(Index+6)): LET AY=ABS(S(Index+7)): LET E1=S(Index+8)
1120 IF AY>AX+AX THEN  GO TO 1150
1130 IF S(Index+6)>0 THEN  LET P1=1: LET E1=E1-S(Index+7)-S(Index+2): GO TO 1160
1140 IF S(Index+6)<0 THEN  LET P1=-1: LET E1=E1+S(Index+7)-S(Index+2): GO TO 1160
1150 LET P1=0
1160 IF AX>AY+AY THEN  GO TO 1190
1170 IF S(Index+7)>0 THEN  LET Q1=1: LET E1=E1+S(Index+6)-S(Index+3): GO TO 1200
1180 IF S(Index+7)<0 THEN  LET Q1=-1: LET E1=E1-S(Index+6)-S(Index+3): GO TO 1200
1190 LET Q1=0
1200 LET AX=ABS(S(Index+4)): LET AY=ABS(S(Index+5)): LET E2=S(Index+8)
1210 IF AY>AX+AX THEN  GO TO 1240
1220 IF S(Index+4)>0 THEN  LET P2=1: LET E2=E2-S(Index+7)-S(Index+2): GO TO 1250
1230 IF S(Index+4)<0 THEN  LET P2=-1: LET E2=E2+S(Index+7)-S(Index+2): GO TO 1250
1240 LET P2=0
1250 IF AX>AY+AY THEN  GO TO 1280
1260 IF S(Index+5)>0 THEN  LET Q2=1: LET E2=E2+S(Index+6)-S(Index+3): GO TO 1290
1270 IF S(Index+5)<0 THEN  LET Q2=-1: LET E2=E2-S(Index+6)-S(Index+3): GO TO 1290
1280 LET Q2=0
1290 IF ABS(E1)<=ABS(E2) THEN  LET XI=P1: LET YI=Q1: LET S(Index+8)=E1: GO TO 1310
1300 LET XI=P2: LET YI=Q2: LET S(Index+8)=E2
1310 IF YI<0 THEN  GO TO 1340
1320 IF YI=0 THEN  GO TO 1350
1330 LET S(Index+1)=S(Index+1)+1: LET S(Index+6)=S(Index+6)-2*S(Index+3): GO TO 1350
1340 LET S(Index+1)=S(Index+1)-1: LET S(Index+6)=S(Index+6)+2*S(Index+3)
1350 IF XI<0 THEN  GO TO 1380
1360 IF XI=0 THEN  GO TO 1390
1370 LET S(Index)=S(Index)+1: LET S(Index+7)=S(Index+7)+2*S(Index+2): GO TO 1390
1380 LET S(Index)=S(Index)-1: LET S(Index+7)=S(Index+7)-2*S(Index+2)
1390 IF S(Index+8)<0 THEN  GO TO 1410
1400 LET S(Index+4)=S(Index+6)+S(Index+7)/2: LET S(Index+5)=S(Index+7)-S(Index+6)/2: GO TO 1420
1410 LET S(Index+4)=S(Index+6)-S(Index+7)/2: LET S(Index+5)=S(Index+7)+S(Index+6)/2
1420 RETurn 

Code: Select all

1 rem RUN in standard 3-screen console
5 :
10 CLS
12 Circ#1; 128,100, 98, 1, 1, 1:   rem QPC
14 Circ#1; 128,101,100, .75, 4, 1: rem QL
16 :
100 rem + ------------------------------------------------------------------------ +
102 rem |<                                 Circle                                 >|
104 rem + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +
106 rem |           Draw filled or empty ellipse using pixel coordinates           |
108 rem |                                                                          |
110 rem |    ch%    = channel number                                               |
112 rem |    x%, y% = centre coordinates                                           |
114 rem |    r%     = radius                                                       |
116 rem |    s      = "squash". Round QPC2 etc: 1, QL etc: 0.75                    |
118 rem |    c      = colour                                                       |
120 rem |    f      = fill; 1 => fill, 0 => empty                                  |
122 rem + ------------------------------------------------------------------------ +
124 rem | V0.04, pjw, Jun 2003, Screen coordinates (BLOCK)                         |
126 rem | V0.06, pjw, Jan 2018, optimised density, added squash                    |
128 rem | V0.06, pjw, 2022 Nov 13, Tidied and added header                         |
130 rem + ------------------------------------------------------------------------ +
132 :
134 DEFine PROCedure Circ(ch%, x%, y%, r%, s, c, f)
136 LOCal i, tx%, ty%, n%
138 n% = 1
140 BLOCK#ch%; n%, n%, x%, y%, c
142 IF f THEN
144  FOR i = 0 TO PI / 2 STEP 5 / (2 * PI * r%)
146   tx% = COS(i) * r%: ty% = SIN(i) * r% * s
148   BLOCK#ch%; tx% + tx%, n%, x% - tx%, y% + ty%, c
150   BLOCK#ch%; tx% + tx%, n%, x% - tx%, y% - ty%, c
152  END FOR i
154 ELSE
156  FOR i = 0 TO PI / 2 STEP 16 / (2 * PI * r%)
158   tx% = COS(i) * r%: ty% = SIN(i) * r% * s
160   BLOCK#ch%; n%, n%, x% + tx%, y% + ty%, c
162   BLOCK#ch%; n%, n%, x% - tx%, y% + ty%, c
164   BLOCK#ch%; n%, n%, x% - tx%, y% - ty%, c
166   BLOCK#ch%; n%, n%, x% + tx%, y% - ty%, c
168  END FOR i
170 END IF
172 END DEFine
174 :