100 REMark =========================
101 REMark QaLeidoscope
102 REMark 2 - 3 November 2021
104 REMark =========================
105 REMark Based on a ZX81 listing
106 REMark by Matthew Calveley
107 REMark in Sinclair Programs
108 REMark Jan-Feb 1983 - page 24
109 REMark =========================
200 screen_setup
210 palette_setup
220 title_screen
230 select_colours

300 REP mainloop
310   kaleidoscope
320   PAUSE
330   REM maybe put M to return to menu or S to save screen

390 END REP mainloop


999 STOP


1000 REMark ========================
1001 DEFine PROCedure plot(x%,y%,k%)
1002 REMark ========================
1003 REMark Max range of ZX81 PLOT:
1004 REMark x = 0 to 63, y = 0 to 41
1010 LOC px%,py%
1020 px%=8*x%
1030 py%=246-6*y%
1040 BLOCK 8,6,px%,py%,k%
1090 END DEFine plot

2000 REMark ========================
2001 DEFine PROCedure title_screen
2002 REMark ========================
2005 LOC n
2010 CLS #3
2020 FOR n=0 TO 7: BLOCK #2,448-4*n,200-2*n,n*2,n,7-6*(n MOD 2 = 1): NEXT n
2030 FOR n=0 TO 6: BLOCK #2,448-4*n,40-2*n,n*2,n,7-6*(n MOD 2 = 1): NEXT n
2040 BLOCK #2,420,26,14,7,3
2050 CSIZE #2,2,1: OVER #2,1
2060 INK #2,1: CURSOR #2,86,12: PRINT #2,"Q A L E I D O S C O P E"
2070 INK #2,7: CURSOR #2,84,10: PRINT #2,"Q A L E I D O S C O P E"
2080 OVER #2,0: CSIZE #2,2,0
2090 AT #2,5,5: PRINT #2,"Select colour set:"
2100 AT #2,7,2: PRINT #2,"0: Black on white (original ZX81)"
2110 AT #2,8,2: PRINT #2,"1: White on black (inverse ZX81)"
2120 AT #2,9,2: PRINT #2,"2: QL MODE 8"
2130 AT #2,10,2: PRINT #2,"3: QL MODE 4"
2140 AT #2,11,2: PRINT #2,"4: ZX Spectrum logo"
2150 AT #2,12,2: PRINT #2,"5: Special Relationship"
2160 AT #2,13,2: PRINT #2,"6: Four-colour Bic biro"
2170 AT #2,14,2: PRINT #2,"7: Dragon 32, PMODE 1, SCREEN 1,0"
2180 AT #2,15,2: PRINT #2,"8: Custom colours"
2190 AT #2,16,2: PRINT #2,"9: Random mix of 0-7"
2195 END DEFine title_screen

2300 REMark ========================
2301 DEFine PROCedure select_colours
2302 REMark ========================
2305 LOC n,inq$,inq%
2310 REP inqloop1
2320   inq$=INKEY$(-1): cc%=CODE(inq$)-48
2330   IF cc%>=0 AND cc%<=9
2340     EXIT inqloop1
2350     ELSE
2360     BEEP 5000,99
2370 END IF
2380 END REP inqloop1
2390 IF cc%<=7 or cc%=9 THEN BEEP 2500,16: FOR n=0 TO 255: END FOR n: RETURN
2400 IF cc%=8 THEN custom_colours
2490 END DEFine select_colours

3000 REMark ========================
3001 DEFine PROCedure custom_colours
3002 REMark ========================
3005 LOC n,inq$,ic%
3010 FOR n=15 TO 7 STEP -1
3020   AT #2,n,2: PRINT #2,"8: Custom colours";FILL$(" ",16)
3030   AT #2,n+1,2: PRINT #2,FILL$(" ",33)
3040 END FOR n
3050 AT #2,9,5: PRINT #2,"BG  COLOURS"
3060 FOR n=0 TO 7
3070   BLOCK #2,28,24,58+48*n,108,255
3080 END FOR n
3090 AT #2,18,2: PRINT #2,"Background colour? (0-7)"
3100 REP inqloop2
3110   inq$=INKEY$(-1): ic%=CODE(inq$)-48
3120   IF ic%>=0 AND ic%<=7
3130     EXIT inqloop2
3140     ELSE
3150     BEEP 5000,99
3160   END IF
3170 END REP inqloop2
3180 p%(8,0)=ic%: BLOCK #2,24,20,60,110,p%(8,0): AT #2,18,2: PRINT #2,FILL$(" ",33)
3190 AT #2,18,2: PRINT #2,"How many colours? (1-7)"
3200 REP inqloop3
3210   inq$=INKEY$(-1): ic%=CODE(inq$)-48
3220   IF ic%>=1 AND ic%<=7
3230     EXIT inqloop3
3240     ELSE
3250     BEEP 5000,99
3260   END IF
3270 END REP inqloop3
3280 p%(8,8)=ic%
3290 FOR n=1 TO 7-p%(8,8): BLOCK #2,28,24,442-48*n,108,1: END FOR n
3300 AT #2,18,2: PRINT #2,FILL$(" ",33)
3310 FOR n=1 TO p%(8,8)
3320   AT #2,18,2: PRINT #2,"Colour #";n;"? (0-7)"
3330   REP inqloop4
3340     inq$=INKEY$(-1): ic%=CODE(inq$)-48
3350     IF ic%>=0 AND ic%<=7
3360       EXIT inqloop4
3370       ELSE
3380       BEEP 5000,99
3390     END IF
3400   END REP inqloop4
3410   p%(8,n)=ic%: BLOCK #2,24,20,60+48*n,110,p%(8,n): AT #2,18,2: PRINT #2,FILL$(" ",33)
3420 END FOR n
3430 BEEP 2500,16
3440 FOR n=0 TO 255: END FOR n
3990 END DEFine custom_colours

4000 REMark ========================
4001 DEFine PROCedure kaleidoscope
4002 REMark ========================
4005 LOC n,reps%,v%,h%,rv%,rh%,c%
4010 reps%=RND(200 TO 450)
4020 IF cc%=9
4030   col%=RND(1 TO 8)-1
4040   ELSE
4050   col%=cc%
4060 END IF
4070 PAPER p%(col%,0): CLS
4080 FOR n=1 TO reps%
4090   v%=RND(0 TO 20)
4100   h%=RND(0 TO 31)
4110   rv%=20+(21-v%)
4120   rh%=31+(32-h%)
4130   c%=RND(1 TO p%(col%,8))
4140   plot h%,v%,p%(col%,c%)
4150   plot rh%,v%,p%(col%,c%)
4160   plot rh%,rv%,p%(col%,c%)
4170   plot h%,rv%,p%(col%,c%)
4180 END FOR n
4190 BEEP 2500,16
4290 END DEFine kaleidoscope

8000 REMark ========================
8001 DEFine PROCedure palette_setup
8002 REMark ========================
8005 LOC n,m
8010 RESTORE 8080
8020 DIM p%(8,8)
8021 rem p%(x,0) = background colour
8022 rem p%(x,8) = number of available colours
8023 REM p%(8,y) = custom colours
8030 FOR n=0 TO 7
8040   FOR m=0 TO 8
8050     READ p%(n,m)
8060   END FOR m
8070 END FOR n
8080 DATA 7,0,9,9,9,9,9,9,1: REM regular ZX81
8081 DATA 0,7,9,9,9,9,9,9,1: REM inverse ZX81
8082 DATA 0,1,2,3,4,5,6,7,7: REM QL Mode 8
8083 DATA 0,2,4,7,9,9,9,9,3: REM QL Mode 4
8084 DATA 0,2,6,4,5,9,9,9,4: REM Speccy
8085 DATA 0,1,2,7,9,9,9,9,3: REM 'MURICA
8086 DATA 7,0,1,2,4,9,9,9,4: REM 4-colour biro
8087 DATA 4,1,2,6,9,9,9,9,3: REM Dragon 32
8090 END DEFine palette_setup

9000 REMark ========================
9001 DEFine PROCedure screen_setup
9002 REMark ========================
9010 MODE 8
9020 OPEN #3,scr_512x256a0x0: PAPER #3,0: CLS #3: REM clear entire screen
9030 WINDOW #1,512,252,0,2: PAPER 0: INK 7: CLS: REM actual required screen dimensions
9040 WINDOW #2,448,200,32,16: PAPER #2,1: INK #2,7: REM TV-size window 2
9090 END DEFine screen_setup

10000 REMark ========================
10001 DEFine PROCedure mon
10002 REMark ========================
10003 REMark Standard monitor screen
10010 MODE 4
10020 WINDOW #2,256,202,0,0
10030 BORDER #2,1,255: PAPER #2,7: INK #2,2
10040 WINDOW #1,256,202,256,0
10050 BORDER #1,1,255: PAPER #1,2: INK #1,7
10060 WINDOW #0,512,54,0,202
10070 PAPER #0,0: INK #0,4
10080 CLS #0: CLS #1: CLS #2
10090 END DEFine mon
11000 REMark ========================
11001 DEFine PROCedure tv
11002 REMark ========================
11003 REMark Standard TV screen
11005 MODE 8
11010 WINDOW #0,512,256,0,0
11015 PAPER #0,0: CLS #0
11020 WINDOW #2,448,200,32,16
11030 PAPER #2,1: INK #2,7
11040 WINDOW #1,448,200,32,16
11050 PAPER #1,2: INK #1,7
11060 WINDOW #0,448,40,32,216
11070 PAPER #0,0: INK #0,7
11080 CLS #0: CLS #1: CLS #2
11090 END DEFine tv
