10 ' N O T E       N O T E       N O T E       N O T E
20 '
30 ' See important comments at the end of this program.
40 '
50 KEY OFF
60 DIM SCRN%(8,4)
70 SCREEN 0,0
80 LOCATE 1,1,0
90 GOSUB 1080      'INITIALIZE ARRAY
100 GOSUB 760      'PRINT MENU ON SCREEN
110 GOSUB 1390     'GO ASK USER WHAT HE WANTS TO DO
120 GOSUB 1790     'GO SEE WHAT HE SAID TO DO
130 GOSUB 1580     'SWITCH TO COLOR DISPLAY
140 GOSUB 670
150 IF SCRN%(7,2)>1 THEN SCREEN 1,1 ELSE SCREEN 1,0
160 IF SCRN%(5,2)>1 THEN COLOR 0,CINT(RND) ELSE COLOR CINT(RND * 15),CINT(RND)
170 CLS
180 '
190 '
200 X1=(RND * 50)+1
210 X2=(RND * 50)+1
220 Y1=RND * X1
230 Y2=RND * X2
240 GOTO 360
250 '
260 IF INT(RND * 11) = 5 THEN GOSUB 670
270 CC$=INKEY$
280 IF LEN(CC$)=0 THEN 310
290 IF CC$=CHR$(27) THEN GOSUB 1680: GOTO 100
300 IF CC$=" " THEN 160
310 IF INT(RND * 250) = 125 THEN 160
320 X1=(X1+XX) MOD 110
330 Y1=(Y1+YX) MOD 110
340 X2=(X2+XY) MOD 110
350 Y2=(Y2+YY) MOD 110
360 Y1=-Y1
370 Y2=-Y2
380 GOSUB 510
390 X1=-X1
400 X2=-X2
410 GOSUB 510
420 Y1=-Y1
430 Y2=-Y2
440 GOSUB 510
450 X1=-X1
460 X2=-X2
470 GOSUB 510
480 GOTO 260
490 '
500 '
510 ON I% GOTO 520,560,590,630
520 LINE((X1+100)*35/24,Y1+100)-((X2+100)*35/24,Y2+100),CO
530 LINE((Y1+100)*35/24,X1+100)-((Y2+100)*35/24,X2+100),CO
540 RETURN
550 '
560 LINE((X1+100)*35/24,Y1+100)-((X2+100)*35/24,Y2+100),CO,B
570 RETURN
580 '
590 LINE((X1+100)*35/24,Y1+100)-((X2+100)*35/24,Y2+100),CO
600 LINE((Y1+100)*35/24,X1+100)-((Y2+100)*35/24,X2+100),CO,B
610 RETURN
620 '
630 CIRCLE (X1+150,Y1+100),ABS(X2),CO
640 RETURN
650 '
660 '
670 XX=(RND * 11)-5
680 XY=(RND * 11)-5
690 YX=(RND * 11)-5
700 YY=(RND * 11)-5
710 CO=CINT(RND *3)
720 RANDOMIZE(VAL(RIGHT$(TIME$,2)))
730 RETURN
740 '
750 '
760 VL$=CHR$(179)
770 HL$=CHR$(196)
780 UR$=CHR$(191)
790 LR$=CHR$(217)
800 UL$=CHR$(218)
810 LL$=CHR$(192)
820 CLS
830 LOCATE ,,0
840 PRINT TAB(15) "KALEIDOSCOPE"
850 LOCATE 4
860 PRINT "Foreground" TAB(15) UL$ "Lines" TAB(35) UR$
870 PRINT TAB(15) VL$ "Boxes" TAB(35) VL$
880 PRINT TAB(15) VL$ "Lines and Boxes" TAB(35) VL$
890 PRINT TAB(15) LL$ "Circles" TAB(35) LR$
900 LOCATE 10
910 PRINT "Background" TAB(15) UL$ "Random Color" TAB(32) UR$
920 PRINT TAB(15) LL$ "Black" TAB(32) LR$
930 LOCATE 14
940 PRINT "Mode" TAB(15) UL$ "Color" TAB(33) UR$
950 PRINT TAB(15) LL$ "Black & White" TAB(33) LR$
960 LOCATE 18
970 PRINT "Select one from each group"
980 PRINT "Move cursor with RETURN key"
990 PRINT "Press SPACE to execute KALEIDOSCOPE"
1000 PRINT "Press ESC to EXIT"
1010 LOCATE 24,1
1020 PRINT "While running, SPACE bar will restart";
1030 LOCATE 25,1
1040 PRINT "ESC will return to this menu";
1050 RETURN
1060 '?
1070 '
1080 FOR I%=0 TO 3
1090 FOR J%=0 TO 7
1100 READ SCRN%(J%,I%)
1110 NEXT J%,I%
1120 RETURN
1130 '
1140 '
1150 FOR I%=0 TO 7
1160 LOCATE SCRN%(I%,0),SCRN%(I%,1)
1170 IF SCRN%(I%,2)=0 THEN PRINT " "
1180 IF SCRN%(I%,2)=1 THEN COLOR 0,7: PRINT " ": COLOR 7,0
1190 IF SCRN%(I%,2)=2 THEN COLOR 0,7: PRINT "X": COLOR 7,0
1200 IF SCRN%(I%,2)=3 THEN PRINT "X"
1210 NEXT I%
1220 RETURN
1230 '
1240 '
1250 IF SCRN%(CURS%,2)=1 THEN SCRN%(CURS%,2)=0 ELSE SCRN%(CURS%,2)=3
1260 CURS%=CURS%+1
1270 IF CURS%=8 THEN CURS%=0
1280 IF SCRN%(CURS%,2)=0 THEN SCRN%(CURS%,2)=1 ELSE SCRN%(CURS%,2)=2
1290 RETURN
1300 '
1310 '
1320 FOR I%=0 TO 7
1330 IF SCRN%(I%,3)=SCRN%(CURS%,3) THEN SCRN%(I%,2)=0
1340 NEXT I%
1350 SCRN%(CURS%,2)=2
1360 RETURN
1370 '
1380 '
1390 GOSUB 1150
1400 CC$=""
1410 WHILE LEN(CC$)<>1
1420 CC$=INKEY$
1430 WEND
1440 IF CC$=CHR$(13) THEN GOSUB 1250: GOSUB 1150
1450 IF (CC$="x") OR (CC$="X") THEN GOSUB 1320: GOSUB 1150
1460 'IF NO MONOCHROME DISPLAY, activate 1471 & comment 1470            *****
1470 'IF CC$=CHR$(27) THEN GOSUB 1680: KEY ON: LOCATE ,,1,12,13: CLS: END
1471 IF CC$=CHR$(27) THEN GOSUB 1680: LOCATE ,,1,7: CLS: RUN"BASMENU
1480 IF CC$=" " THEN RETURN
1490 GOTO 1390
1500 '
1510 '
1520 DATA 4,5,6,7,10,11,14,15
1530 DATA 22,22,32,24,29,22,22,30
1540 DATA 2,0,0,0,3,0,3,0
1550 DATA 1,1,1,1,2,2,3,3
1560 '
1570 '
1580  RETURN  'ACTIVATE THIS STATEMENT IF NO MONOCHROME DISPLAY
1590 DEF SEG=&H41
1600 POKE 0,(PEEK(0) AND &HCF) OR &H20
1610 DEF SEG
1620 SCREEN 0
1630 WIDTH 40
1640 SCREEN 1,0
1650 RETURN
1660 '
1670 '
1680  SCREEN 0,0  'ACTIVATE THIS STATEMENT IF NO MONOCHROME DISPLAT
1690  RETURN 'ACTIVATE THIS STATEMENT IF NO MONOCHROME DISPLAY
1700 DEF SEG=&H41
1710 POKE 0,(PEEK(0) OR &H30)
1720 DEF SEG
1730 SCREEN 0
1740 WIDTH 80
1750 LOCATE 1,1,0
1760 RETURN
1770 '
1780 '
1790 IF SCRN%(0,2)>1 THEN I%=1
1800 IF SCRN%(1,2)>1 THEN I%=2
1810 IF SCRN%(2,2)>1 THEN I%=3
1820 IF SCRN%(3,2)>1 THEN I%=4
1830 RETURN
1840 '         N O T E        N O T E
1850 'Activate/deactivate statements commented above depending on whether
1860 'or not you have a monochrome display. The statement numbers are
1870 'listed below in an ON statement incase someone renumbers this thing.
1880 ON I% GOTO 1460,1580,1680,1690
1890 '
1900 'If from time to time it appears that the program is not working, it may b
1910 'that it is painting with the same color as the background.
1920 '
1930 'Feel free to copy this program and pass it on to a friend, lover, etc.,
1940 'but lets see how many hands this program passes through. Before you
1950 'copy it, please add your name to the bottom of the list below.
1960 'This program written for the IBM PC by
1970 ' Bill Decker  4 Sherwood Dr. Endicott, N. Y. 13760
1980 ' Barry Shiffrin 2309 Acorn Dr. Vestal, NY  13850
1990 ' Bob Vollmer for STL PC-Club library 8-543-4866