RosettaCodeData/Task/Yin-and-yang/ZX-Spectrum-Basic/yin-and-yang.basic

73 lines
2.5 KiB
Plaintext

10 CLS
20 LET i=0
30 PRINT "Recommended size is a multiple of 4 between 40 and 80": REM smaller sizes don't render properly and larger ones don't fit
40 INPUT "Size? ";s
50 IF size>87 THEN GOTO 50: REM size check
60 INPUT "Position?";t
70 IF t<s OR t+s>254 THEN GOTO 60
80 INK i
90 CIRCLE t,s/2,s/2
100 CIRCLE t,s*1.5,s/2
110 CIRCLE t,s*1.5,s/4
120 CIRCLE t,s/2,s/4: REM we draw the big circle later
130 LET bxl=t-s/4: REM these four variables define the bounding box for the fill routine
140 LET bxr=t+s/4
150 LET byb=s*1.25+1
160 LET byt=s*1.75-1
170 GOSUB 9000: REM fill top small circle first
180 LET bxl=t-s/2
190 LET bxr=t+s/2
200 LET byb=1
210 LET byt=s-1
220 GOSUB 9000: REM lower ring
230 PLOT t,s*.75
240 DRAW OVER 1;s/2,0
250 PLOT t,s*.25
260 DRAW OVER 1;s/2,0: REM fix top and bottom edges of lower circle - the top and bottom of a ZX Basic circle are horizontal lines, which screws with the parity fill
270 CIRCLE t,s/2,s/4
280 CIRCLE t,s,s: REM now draw the big circle - it would have clashed with the ring bounding box earlier
290 LET bxl=t
300 LET bxr=t+s
310 LET byb=s+1
320 LET byt=s*1.25-1
330 GOSUB 9000: REM right half, top, lower quadrant - we have to fill it in three goes
340 LET bxl=t+s*.25+1
350 LET byb=byt+1
360 LET byt=s*1.75
370 GOSUB 9000: REM right half, top, right of spot - we move bxl to the right of the spot to make sure it doesn't clash
380 LET bxl=t
390 LET byb=byt+1
400 LET byt=s*2-2
410 GOSUB 9000: REM finish top right - bounding box stops two pixels short to prevent parity faults
420 LET byb=2
430 LET byt=s/4
440 GOSUB 9000: REM bottom of right side done in similar manner
450 LET bxl=t+s/4+1
460 LET byb=byt+1
470 LET byt=s*.75
480 GOSUB 9000
490 LET bxl=t
500 LET byb=byt+1
510 LET byt=s-1
520 GOSUB 9000
530 PLOT t,s
540 DRAW s-1,0: REM missing line in right side - would have messed up during the fill cycle
550 CIRCLE OVER 1;t,s*1.5,s/2: REM remove top wide circle to clear left loop
560 CIRCLE t,s,s: REM repair big circle, done!
570 INPUT "Again? ";a$
580 IF a$="y" THEN LET i=i+1: GO TO 40
590 INK 0
600 STOP
8999 REM area fill; checks along each pixel line and starts and stops PLOTting if it hits a boundary
9000 FOR y=byb TO byt
9010 LET p=0: REM parity
9020 FOR x=bxl TO bxr
9030 LET r1=POINT (x,y): REM POINT is 1 if the pixel at (x,y) is filled (INK), otherwise 0
9040 LET r2=POINT (x+1,y): REM test next point as well, in case of edges rendered as multiple pixels
9050 IF r1=1 AND r2=0 THEN LET p=p+1: IF p=2 THEN LET p=0: REM boundary check
9060 IF p=1 THEN PLOT x,y
9070 NEXT x
9080 NEXT y
9090 RETURN