Advanced Graphics Techniques in BBC BASIC

advgraf.bas

10 REM Advanced Graphics Techniques--Part II by Bob Boothe
20 REM 80 Microcomputing Magazine, May 1981, Page 119-142
30 REM https: //archive.org/details/80-microcomputing-magazine-1981-05/page/n121/mode/2up
40 REM Converted to BBC BASIC by J.B. Langston, January 2024
50 REM Tested on BBC BASIC SDL and AgonLight
60 :
70 XC = 512: YC = 512: SC = YC
80 PROC_DEMO: END
90 :
100 DEF PROC_DEMO
110     CLS: CLG
120     PROC_POLY(SC, 18): PROC_WAIT: REM Figure 1: Regular Polygon
130     PROC_EYE: PROC_WAIT: REM Figure 2: "The Eye"
140     PROC_MOIRE: PROC_WAIT: REM Figure 3: Moire pattern
150     PROC_TUNNEL: PROC_WAIT: REM Figure 4: "The Tunnel"
160     PROC_DISK: PROC_WAIT: REM Figure 5: Simple disk
170     PROC_SPIRAL: PROC_WAIT: REM Figure 6: Overlapping spiral
180     PROC_ROSE(76,3,2): PROC_WAIT: REM Figure 7: Four leaf rose
190     PROC_ROSE(60,2,2): PROC_WAIT: REM Figure 8: Square rose
200     PROC_ROSE(60,4,4): PROC_WAIT: REM Figure 9: Eight leaf rose
210     PROC_TRISPIRAL: PROC_WAIT: REM Figure 10: Triangle spiral
220     PROC_SCALEDTRI: PROC_WAIT: REM Figure 11: Scaled triangles
230 ENDPROC
240 :
250 DEF PROC_EYE
260     SZ = SC * 2: XO = XC - SZ / 2: YO = YC - SZ / 2
270     FOR Q = 0 TO SZ STEP 32
280         MOVE XO,YO + Q: DRAW XO + Q,YO + SZ
290         MOVE XO + Q,YO: DRAW XO + SZ,YO + Q
300     NEXT
310     PROC_POLY(SC/3, 11)
320 ENDPROC
330 :
340 DEF PROC_MOIRE
350     R1 = SC / 2: R2 = SC * 2: XO = XC - R2 / 2: YO = YC - R2 / 2
360     FOR T = 0 TO PI / 2 STEP PI / 180
370         X1 = INT(COS(T) * R1): Y1 = SIN(T) * R1
380         X2 = INT(COS(T) * R2): Y2 = SIN(T) * R2
390         MOVE XO + X1,YO + Y1: DRAW XO + X2,YO + Y2
400         MOVE XO + R2 - X1,YO + R2 - Y1: DRAW XO + R2 - X2,YO + R2 - Y2
410     NEXT
420 ENDPROC
430 :
440 DEF PROC_TUNNEL
450     X1 = XC * 1.08: Y1 = YC * 1.15
460     FOR Q = 1 TO SC / 2.63
470         X2 = X1 + 5 * Q + 2: Y2 = Y1: MOVE X1,Y1: DRAW X2,Y2
480         X1 = X2: Y1 = Y2 + 5 * Q + 3: MOVE X1,Y1: DRAW X2,Y2
490         X2 = X1 - 5 * Q - 5: Y2 = Y1: MOVE X1,Y1: DRAW X2,Y2
500         X1 = X2: Y1 = Y2 - 5 * Q - 6: MOVE X1,Y1: DRAW X2,Y2
510     NEXT
520 ENDPROC
530 :
540 DEF PROC_DISK
550     FOR T1 = 0 TO 2 * PI STEP PI / 50
560         T2 = T1 + 3 * PI / 4
570         PROC_POLAR(T1, SC, T2, SC)
580     NEXT
590 ENDPROC
600 :
610 DEF PROC_SPIRAL
620     SF = SC / 32.75:
630     FOR T1 = 0 TO 10 * PI STEP PI / 20
640         R1 = SF * T1
650         T2 = T1 + 2 * PI / 3
660         R2 = SF * T2
670         PROC_POLAR(T1, R1, T2, R2)
680     NEXT
690 ENDPROC
700 :
710 REM Draw a rose figure
720 DEF PROC_ROSE(SD, TD, TM)
730     FOR T1 = 0 TO 2 * PI STEP PI / SD
740         R1 = COS(TM * T1) * SC
750         T2 = T1 + PI / TD
760         R2 = COS(TM * T2) * SC
770         PROC_POLAR(T1, R1, T2, R2)
780     NEXT
790 ENDPROC
800 :
810 DEF PROC_TRISPIRAL
820     FOR T = 0 TO 2 * PI STEP PI / 30
830         PROC_TRIANGLE(T, T * 75)
840     NEXT
850 ENDPROC
860 :
870 DEF PROC_SCALEDTRI
880     R = 5
890     FOR T = 0 TO 3.24 STEP PI / 30
900         R = R * 1.16
910         PROC_TRIANGLE(T, R)
920     NEXT
930 ENDPROC
940 :
950 REM Draw a regular polygon with R radius and V vertices
960 DEF PROC_POLY(R, V)
970     H = 2 * PI - .001
980     S = 2 * PI / V
990     FOR T1 = 0 TO H STEP S
1000        FOR T2 = T1 + S TO H STEP S
1010            PROC_POLAR(T1, R, T2, R)
1020        NEXT
1030    NEXT
1040 ENDPROC
1050 :
1060 REM Draw an equilateral triangle starting at angle T1 with radius R
1070 DEF PROC_TRIANGLE(T1, R)
1080    T2 = T1 + 2 * PI / 3
1090    T3 = T1 + 4 * PI / 3
1100    PROC_POLAR(T1, R, T2, R)
1110    PROC_POLAR(T3, R, T2, R)
1120    PROC_POLAR(T3, R, T1, R)
1130 ENDPROC
1140 :
1150 REM Plot a line between polar coords T1,R1 and T2,R2
1160 DEF PROC_POLAR(T1, R1, T2, R2)
1170    X1 = INT(COS(T1) * R1 + XC): Y1 = INT(SIN(T1) * R1 + YC)
1180    X2 = INT(COS(T2) * R2 + XC): Y2 = INT(SIN(T2) * R2 + YC)
1190    MOVE X1,Y1: DRAW X2,Y2
1200 ENDPROC
1210 :
1220 REM Wait for user to press a key, then clear the screen
1230 DEF PROC_WAIT
1240    K$=GET$: CLG
1250 ENDPROC