Jason Aller Floppy Collection

home *** CD-ROM | disk | FTP | other *** search

/ Jason Aller Floppy Collection / IBM PS2 Educational Programs / IBM PS2 Education Programs.img / MADNESS.BAS (.txt) < prev next >

Wrap

GW-BASIC | 1987-08-04 | 33.0 KB | 1,100 lines

8 DEF SEG=0:PROTECTION=PEEK(&H9C)+(PEEK(&H9D)*256):POKE &H4FF,&HCF:POKE &H6C,&HFF:POKE &H6D,4:POKE &H6E,0:POKE &H6F,0 9 DEF SEG=PEEK(&H9E)+(PEEK(&H9F)*256):CALL PROTECTION 1000 'Matrix Madness - A pattern recognition exercise 1010 '(C) Copyright IBM Corporation 1984 1020 'Version 1 July 15, 1984 1030 CLEAR ,,1024 1040 KEY OFF 1050 FOR I%=1 TO 10:KEY I%,"":NEXT 1060 DEFINT A-Q,S-Z 1065 GOSUB 3750:'Graphics setup 1070 GOSUB 4400:'Title Screen 1080 GOSUB 3848:'Initialization 1090 GOSUB 13220:'Read hall of fame 1100 ' 1200 SEED = VAL(MID$(TIME$,4,2))+60*VAL(MID$(TIME$,7,2)) 1210 RANDOMIZE(SEED) 1220 ' 1230 GOSUB 4490:'Introduction screen 1240 'Ask for demo or play; Wait 30 seconds, start demo 1250 PAUSE=2:'Enable pause 1260 SEC=60:GOSUB 2800:IF SEC = 0 THEN GOSUB 1910:IF A$=ESC$ THEN GOTO 1230:'F2 is only other Return, start drill 1300 'Start the drill 1310 '********** Main Routine ********** 1320 GOSUB 4860:'Ask for playing level 1330 IF A$=ESC$ THEN GOTO 1230 1340 PAUSE=0:'Disable pause 1350 TPTS = 0:TOT=0 1360 IR=IPL:GOSUB 6000:IR=INT(50*RND):FOR I=1 TO IPL:PRB(I)=N(I)+IR:NEXT:'combos to use 1370 FOR IP= 1 TO IPL 1380 CLRU = CLR:'Use color setting for this problem 1390 CLS:GOSUB 7630:'Clear and make noise 1400 GOSUB 5200:'Generate problem and alternatives 1410 GOSUB 6100:'Display problem and alternatives 1420 GOSUB 6500:'Display answer request, init pts and time 1430 GOSUB 6620:'Write PTS 1440 WHILE PTS>0 1450 A$=INKEY$:'See if key pressed 1460 'None, check time; else, see if answer and handle. 1470 IF LEN(A$)>0 THEN GOSUB 6800:A$=INKEY$:A$=INKEY$ 1480 IF PTS>0 THEN GOSUB 3700 1490 WEND 1500 GOSUB 7800:'Show Answer (Fill in, also mark alternative) 1510 GOSUB 8000:'Await to continue 1520 NEXT IP 1530 GOSUB 7200:'Write game ended panel 1540 GOTO 1250:'Go wait and either start demo or this again. 1550 IF SL=1 THEN COLOR 15,0:ELSE IF SL=2 THEN COLOR 11,0:ELSE COLOR 13,0 1560 IF SL=1 THEN PRINT"Level 1 (Beginner)" 1570 IF SL=2 THEN PRINT"Level 2 (Intermediate)" 1580 IF SL=3 THEN PRINT"Level 3 (Advanced)" 1590 COLOR 7,0 1600 RETURN:'Go wait and either start demo or this again. 1610 CT=-1:SCREEN 0,1:COLOR 7,0:CLS:LOCATE 1,15:COLOR 11,0:PRINT"Matrix Madness":RETURN 1620 '******** End of main routine ******** 1700 ' 1710 ' Used for Renumbering 1720 ON I GOSUB 1200,1300,1700,1900,2800,3300,3400,3500,3700,4400,5200 1730 ON I GOSUB 5600,6000,6100,6500,6600,6700,6800,7100,7200,7400,7800,8000,8200 1740 ON I GOSUB 8300,8400,8500,8600,8700,8800,10800,11800,11900,12000,12300 1750 ON I GOSUB 12700,13200,13400,13800,14000,14200,14300,14400 1760 ON I GOSUB 14440,14590,14660,14760 1770 ' Reference items for renumbering purposes 1780 GOSUB 8500:' Routine to mark x over bad quess. 1790 GOSUB 8800:' routine used for making box contents 1800 GOSUB 11800:' data points for square centers 1810 GOSUB 11900:' data points used for how screen looks 1820 GOSUB 12300:' Variable descriptions 1830 ' 1900 '********** DEMONSTRATION ********** 1910 'Run the demo until ESC key is pressed. 1920 PAUSE = 1 1930 FOR SL=1 TO 3 1940 TPTS = 0:TOT=0 1950 IR=IPL:GOSUB 6000:IR=INT(50*RND):FOR I=1 TO IPL:PRB(I)=N(I)+IR:NEXT:'combos to use 1960 FOR IP=1 TO IPL 1970 CLRU = CLR:'Use color setting for this problem 1980 GOSUB 5200:'Generate Problem 1990 GOSUB 6100:'Display problem 2000 'Generate order answers will be tried 2010 IR=AT:GOSUB 6000:'Make random order 2020 IA=0:'Answer being worked on 2030 LOCATE 1,1:PRINT"Demonstration";:I=1:J=1:NC=13:GOSUB 2590 2040 LOCATE 23,1:PRINT" Just watch! ";:I=1:J=23:NC=13:GOSUB 2590 2050 LOCATE 25,1:PRINT"Press Esc to exit, F10 to pause.";:I=1:J=25:NC=39:GOSUB 2590 2060 GOSUB 6500:'Display answer request, set pts. 2070 LOCATE 23,24:PRINT" What: Looking";:I=24:J=23:NC=15 :GOSUB 2590 2080 SEC=3+SS*2:'Override time 2090 IF PTS<3+SEC THEN SEC=PTS 2100 WHILE SEC>0 2110 GOSUB 3400:'Wait 1 Second 2120 IF A$=ESC$ THEN RETURN 2130 GOSUB 6600:'Update display 2140 IF PTS=0 THEN GOSUB 7100:GOTO 2390 2150 WEND 2160 LOCATE 23,24:PRINT" Selected one ";:I=24:J=23:NC=15 :GOSUB 2590 2170 IF SEC=0 THEN IA=IA+1:G$=MID$(ANS$,N(IA),1):'Make an answer 2180 LOCATE 22,34:PRINT G$; 2190 SEC=2 2200 WHILE SEC>0 2210 GOSUB 3400:IF A$=ESC$ THEN RETURN 2220 I=34:J=22:NC=1:GOSUB 2590 2230 IF G$<>C$ THEN GOSUB 6600:'Update display 2240 WEND 2250 SEC=2 2260 WHILE SEC>0 2270 GOSUB 3400:IF A$=ESC$ THEN RETURN 2280 IF G$<>C$ THEN GOSUB 6600:'Update display 2290 WEND 2300 A$=G$ 2310 GOSUB 6800:'Check answer, update display. 2320 SEC=2 2330 WHILE SEC>0 2340 GOSUB 3400:IF A$=ESC$ THEN RETURN 2350 IF PTS>0 THEN GOSUB 6600:'Update display 2360 WEND 2370 IF PTS>0 THEN GOTO 2070:'If bad, try again 2380 ' 2390 GOSUB 7800:'Display answer 2400 SEC=10:GOSUB 7910:'Prepare to blink answer 2410 WHILE SEC>0 2420 GOSUB 7950:'Wait 1 Second and blink answer 2430 IF A$=ESC$ THEN RETURN 2440 IF A$=F10$ THEN GOSUB 3130 2450 WEND 2460 NEXT IP 2470 ' Pause for a moment between levels 2480 GOSUB 7400:'Write demo set ended, with score. 2490 SEC=10 2500 PAUSE=2 2510 GOSUB 2800 2520 IF SEC>0 THEN RETURN 2530 PAUSE=1 2540 NEXT SL 2550 GOTO 1930:'Loop till forced out 2560 '********** End of Demo Routine ********** 2570 ' 2580 ' 2590 'Inverse video an area, do max of 40 characters 2600 GOSUB 8400:'get x and y given row i, column j 2610 GET(X,Y)-(X+NC*8-1,Y+7),IVA 2620 PUT (X,Y),IVA,PRESET 2630 RETURN 2640 'Save contents of an area, max of 80 characters 2650 I=1:J=25:NC=40:GOSUB 8400:'get x and y given row i, column j 2660 GET (X,Y)-(X+NC*8-1,Y+7),IVB 2670 RETURN 2680 'Restore contents of an area 2690 GOSUB 8400:'get x and y given row i, column j 2700 PUT (X,Y),IVB,PSET 2710 RETURN 2800 'Delay for intro & between demo's 2810 ' 2820 IF CT=0 THEN GOTO 2900 2830 'Text 1 Case 2840 COLOR 0,13 2850 LOCATE 24,1:PRINT" Press F1 to demo. Press F2 to play. "; 2860 LOCATE 25,1:PRINT" Press F9 to quit. Press F10 to pause."; 2870 COLOR 7,0 2880 GOTO 2920 2890 'Graphics case 2900 LOCATE 24,1:PRINT" Press F1 to demo. Press F2 to play.";:I=1:J=24:NC=39:GOSUB 2590 2910 LOCATE 25,1:PRINT" Press F9 to quit. Press F10 to pause.";:I=1:J=25:NC=39:GOSUB 2590 2920 WHILE SEC>0 2930 GOSUB 3400:'Wait one second 2940 IF A$=F2$ THEN A$="":RETURN 2950 IF A$=F1$ THEN SEC=0:RETURN 2960 IF LEN(A$)>0 THEN RETURN 2970 'LOCATE 22,3:PRINT SEC;" "; 2980 WEND 2990 RETURN 3000 'Pause routine, any key exits it 3010 ' 3020 IF CT=0 THEN GOSUB 2640:LOCATE 25,1:PRINT" Pausing. Press Enter to resume. ";:I=1:J=25:NC=39:GOSUB 2590 3030 IF CT THEN LOCATE 25,1:COLOR 0,13:PRINT" Pausing. Press Enter to resume. ";:COLOR 7,0 3040 A$=INKEY$ 3050 IF A$=ENT$ THEN GOTO 3080 3060 IF PAUSE=2 AND (A$=F1$ OR A$=F2$) THEN GOTO 3080 3070 GOTO 3040 3080 IF CT=0 THEN I=1:J=25:GOSUB 2680:RETURN:'Restore old message,return 3090 COLOR 0,13 3100 IF PAUSE=1 THEN LOCATE 25,1:PRINT" Press Esc to exit, F10 to pause. "; 3110 IF PAUSE=2 THEN LOCATE 25,1:PRINT" Press F9 to quit. Press F10 to pause."; 3120 RETURN 3130 'Pause routine, blink demo answer any key exits it 3140 GOSUB 2640:'Save old message 3150 LOCATE 25,1:PRINT" Pausing. Press Enter to resume. ";:I=1:J=25:NC=39:GOSUB 2590 3160 GOSUB 7950:'Blink answer, perhaps get a key returned instead. 3170 IF A$=ENT$ THEN GOTO 3190 3180 GOTO 3160 3190 GOSUB 2680:'Restore old message 3200 RETURN 3300 'Pure delay of one second, no keyboard check 3310 P$=RIGHT$(TIME$,2):IF P$=PP$ THEN 3310 ELSE PP$=P$:SEC=SEC-1:RETURN 3400 'Delay of one second, check pauses and sound 3410 GOSUB 3500:'Go wait a second or till a key is pressed. 3420 IF PAUSE=2 AND A$=F9$ THEN GOSUB 13800:SYSTEM 3430 IF PAUSE>0 AND A$=F10$ THEN GOSUB 3000 3440 IF PAUSE=2 AND (A$=F1$ OR A$=F2$) THEN RETURN 3450 IF A$=F4$ THEN CLR=NOT CLR:GOSUB 7540:GOTO 3410 3460 IF A$=ESC$ THEN RETURN 3470 IF LEN(A$)>0 THEN GOTO 3410:'Ignore other items, go wait again. 3480 RETURN 3500 'Delay of one second or till a key is pressed 3510 A$=INKEY$:IF LEN(A$)>0 THEN 3550 3520 P$=RIGHT$(TIME$,2) 3530 IF P$=PP$ THEN 3510 3540 PP$=P$:SEC=SEC-1:RETURN 3550 IF A$=F3$ THEN SND=NOT SND:GOSUB 7720:IF PANEL=2 THEN GOSUB 5040:GOTO 3510: ELSE GOTO 3510 3560 IF A$=F4$ THEN CLR=NOT CLR:GOSUB 7690:IF PANEL=2 THEN GOSUB 5040:GOTO 3510: ELSE GOTO 3510 3570 GOSUB 7540:RETURN:'Return all other key strokes 3580 'See if reasonable answer 3590 FOR I=1 TO AT:IF MID$(ANS$,I,1)=A$ THEN RETURN 3600 NEXT I 3610 I=0:RETURN 3700 'Check elapsed time timer, adjust pts if needed. 3710 ETIME! = FNT! 3720 WHILE ETIME!>STIME!+1:PTS = PTS-1:STIME!=STIME!+1:LOCATE 24,34:IF PTS>0 THEN PRINT PTS;:WEND 3730 IF PTS=0 THEN LOCATE 24,27:PRINT" ";:GOSUB 7100:'Time out 3740 RETURN 3750 'Check to see if running with color adapter 3760 DEF SEG=0:PRINT" "; 3770 IF (PEEK(&H410) AND (&H30))<>&H30 THEN GOTO 3830:'Equip flag says we have it.<UNK! {FF00}>TAB(+COLOR36666'Now see if have it with monochrome. 3780 DEF SEG=&HB800:POKE 0,254:IF PEEK(0)=254 THEN GOTO 3830:'Yes, have it with monochrome, go switch. 3790 LOCATE 10,1:PRINT"Matrix Madness cannot run." 3800 PRINT:PRINT"The color adapter card is not available." 3820 PRINT:DEF SEG:SYSTEM 3830 'Set flag on for using only color 3840 DEF SEG=0:POKE &H410,(PEEK(&H410) AND &HCF) OR &H20:DEF SEG 3842 'TOP 3843 SCREEN 1,1,0,0 3844 WIDTH 40:LOCATE ,,1,6,7 3846 RETURN 3848 'Initialization 3850 X=0:Y=0:C=0:SX=0:CLRB=0:CLRB2=0:XW=0:YW=0:I=0:J=0 3860 DIM SS(3),J,M,LST(3,32),N(32),R(32) 3870 RESTORE 11800 3875 PLAY "MBO2 L4C L8ECEP8 L4C L8EGEP8 L4E L8GEGP8 L4ECE 3880 FOR I=1 TO 5:READ CI(I):NEXT 3890 FOR J=1 TO 3:READ CJ(J):NEXT 3900 RESTORE 11900 3910 '*** read patter layouts 3920 READ NL:DIM SP(NL,3,3),NG(NL) 3930 FOR I=1 TO NL 3940 READ SP(I,0,0):READ NG(I) 3950 FOR K=1 TO 3:FOR M=1 TO 3:READ SP(I,K,M):NEXT:NEXT 3960 NEXT I 3970 '*** Read valid combinations of icons 3980 RESTORE 12020 3990 DIM DV(6),DS(6):'Read number of each kind 4000 DA = 1 4010 FOR I=1 TO 6 4020 DS(I)=DA 4030 READ DV(I) 4040 DA=DA+DV(I) 4050 NEXT 4060 DIM NV(DA-1,3):'Read icon comb. 4070 RESTORE 12060 4080 FOR I=1 TO DA-1 4090 FOR J=1 TO 3 4100 READ NV(I,J) 4110 NEXT J 4120 NEXT I 4130 DIM IVA(324),IVB(324),IVC(324):'For inverse video generation, 644 bytes 4140 IPL=10:'Number of problems per series 4150 DIM PRB(IPL):'Randomly choose combos 4160 ESC$=CHR$(27) 4170 ENT$=CHR$(13) 4180 F1$=CHR$(0)+CHR$(59):F2$=CHR$(0)+CHR$(60) 4190 F3$=CHR$(0)+CHR$(61) 4200 F4$=CHR$(0)+CHR$(62) 4210 F5$=CHR$(0)+CHR$(63) 4220 F9$=CHR$(0)+CHR$(67):F10$=CHR$(0)+CHR$(68) 4230 ANS$="123456":'Answer labels and possible answers 4240 SND=-1:'Sound switch defaults on 4250 CLR= -1:'Color switch defaults on 4270 DEF FNT!=3600*VAL(LEFT$(TIME$,2))+60*VAL(MID$(TIME$,4,2))+VAL(RIGHT$(TIME$,2)) 4280 'Read in bit patterns for symbols 4300 RETURN 4400 'Title 4410 PANEL=0:CT=-1:CLS:SCREEN 0,1:COLOR 11,0:WIDTH 40:LOCATE 12,14:PRINT"Matrix Madness" 4420 LOCATE 18,4,0: PRINT"(C) Copyright IBM Corporation 1984" 4430 SEC=0:'Init takes 4 seconds, no wait 4440 WHILE SEC>0 4450 GOSUB 3300 4460 WEND 4470 RETURN 4480 'Introduction 4490 PANEL=1:CT=0:CLS:SCREEN 1,0 4495 LOCATE 1,15:POKE &H4E,1:PRINT"Matrix Madness";:POKE &H4E,3 4500 LOCATE 3,1 4510 PRINT"The Challenge: " 4520 PRINT" Make a choice to complete the"; 4530 PRINT" pattern as quickly as you can." 4540 PRINT" Correct choices win points." 4550 PRINT" Ten Problems per set. "; 4560 PRINT" " 4570 LOCATE 13,1:PRINT"Sample" 4580 LOCATE 14,1:PRINT"Problem: Choices: "; 4590 LOCATE 11,31:PRINT MID$(ANS$,1,1); 4600 LOCATE 14,31:PRINT MID$(ANS$,2,1); 4610 LOCATE 17,31:PRINT MID$(ANS$,3,1); 4620 RESTORE 11830 4630 FOR I=1 TO 5:READ CI(I):NEXT 4640 FOR J=1 TO 3:READ CJ(J):NEXT 4650 XW=CI(2)-CI(1):X=CI(1)-XW/2:YW=CJ(2)-CJ(1):Y=CJ(1)-YW/2 4660 FOR I=0 TO 3 4670 LINE (X+I*XW,Y)-(X+I*XW,Y+YW*3) 4680 LINE (X+I*XW,Y)-(X+I*XW+1,Y+YW*3),,B 4690 LINE (X,Y+I*YW)-(X+3*XW,Y+YW*I) 4700 NEXT 4710 FOR I=1 TO 4:FOR J=1 TO 3:IF (I<>3) OR (J<>2) THEN C=J:X=CI(I):Y=CJ(J):GOSUB 4820 4720 NEXT:NEXT 4730 LOCATE 19,37:PRINT"The"; 4740 LOCATE 20,35:PRINT"Answer"; 4750 LOCATE 14,35:PRINT"<"; 4760 LINE (300,107)-(301,140),,B 4770 LINE (272,107)-(300,107) 4780 RESTORE 11800 4790 FOR I=1 TO 5:READ CI(I):NEXT 4800 FOR J=1 TO 3:READ CJ(J):NEXT 4810 RETURN 4820 IF C=1 THEN LINE (X-3,Y)-(X+4,Y+1),2,B 4830 IF C=2 THEN LINE (X,Y-3)-(X+1,Y+4),2,B 4840 IF C=3 THEN LINE (X,Y-3)-(X+1,Y+4),2,B:LINE(X-3,Y)-(X+4,Y+1),2,B 4850 RETURN 4860 'Select playing level. 4870 PANEL=2:GOSUB 1610:'Write heading 4880 COLOR 7,0:GOSUB 5040:'Display color/sound status 4890 COLOR 7,0:LOCATE 11,1:PRINT"Choose:" 4900 FOR SL=1 TO 3 4910 LOCATE 11+SL,9:GOSUB 1550 4920 NEXT 4930 LOCATE 16,11:COLOR 7,0:PRINT "Type 1, 2, or 3: "; 4940 LOCATE 25,1:COLOR 0,13:PRINT" Press Esc to exit "; 4950 COLOR 7,0:LOCATE 16,29,1::SEC=30:GOSUB 3500:'Try for the key 4960 IF LEN(A$)=0 THEN 4950 4970 IF A$=ESC$ THEN RETURN 4980 SL=VAL(A$) 4990 IF SL=0 THEN A$ = "?" 5000 LOCATE 16,29,0:COLOR 13,0:PRINT A$;" "; 5010 IF SL=0 THEN GOTO 4950 5020 COLOR 7,0:LOCATE 18,1:PRINT"You are playing at ";:GOSUB 1550:SEC=3:WHILE SEC>0:GOSUB 3500:WEND:RETURN 5030 RETURN 5040 'Display Color status 5050 LOCATE 4,1,0 5060 COLOR 7,0:PRINT"Sound:";:LOCATE ,16:PRINT"Press F3 to Change";:LOCATE ,9 5070 IF SND = -1 THEN COLOR 11,0:PRINT"ON "; 5080 IF SND = 0 THEN COLOR 13,0:PRINT"OFF"; 5090 PRINT:PRINT 5100 COLOR 7,0:PRINT"Color:";:LOCATE ,16:PRINT"Press F4 to Change";:LOCATE ,9 5110 IF CLR = -1 THEN COLOR 11,0:PRINT"ON "; 5120 IF CLR = 0 THEN COLOR 13,0:PRINT"OFF"; 5130 COLOR 7,0:LOCATE 15,13 5140 RETURN 5200 'Generate a problem 5210 TOT = TOT + 1 5220 IF CLRU=0 THEN NUMVAL=DS(SL)+PRB(IP) MOD DV(SL):ELSE NUMVAL=DS(SL+3)+PRB(IP) MOD DV(SL+3) 5230 FOR I = 1 TO 3:SS(I)=NV(NUMVAL,I):NEXT 5240 'Select what distribution and which subpatterns 5250 P(1)=1+INT(RND*NL):P(2)=P(1):P(3)=P(1):IF SL=1 OR SL=4 THEN 5290 5260 WHILE NG(P(1))=NG(P(2)):P(2)=1+INT(RND*NL):WEND 5270 IF SL=2 OR SL=5 THEN 5290 5280 WHILE NG(P(1))=NG(P(3)) OR NG(P(2))=NG(P(3)):P(3)=1+INT(RND*NL):WEND 5290 FOR SS=1 TO SL 5300 NN(SS)=SP(P(SS),0,0) 5310 IR=NN(SS):GOSUB 6000:'Generate a random order 5320 FOR I=1 TO 3:FOR J=1 TO 3 5330 SQ(SS,I,J)=N(SP(P(SS),I,J)) 5340 NEXT:SQ(SS,I,0)=N(I):NEXT 5350 NEXT SS 5360 'Need to eliminate any duplicates 5370 QI=1+INT(3*RND):QJ=1+INT(3*RND):'Square to guess 5380 'Avoid center square on patterns where it is confusing. 5390 IF QI=2 AND QJ=2 THEN FOR I=1 TO SL:IF NG(P(I))>5 THEN 5370:ELSE:NEXT 5400 GOSUB 5600:'Generate possible answers 5410 IF AT>6 THEN AT=6 5420 IR=AT:GOSUB 6000:'Generate a random list 5430 K=0:'Put solutions onto board 5440 FOR I=4 TO 5:FOR J=1 TO 3 5450 IF K>=AT THEN 5480:ELSE K=K+1 5460 FOR SS=1 TO SL:SQ(SS,I,J)=LST(SS,N(K)):NEXT 5470 IF N(K)=1 THEN IX=I:JX=J 5480 NEXT J:NEXT I 5490 C$=MID$(ANS$,JX+3*(IX-3)-3,1) 5500 CLRB=1+INT(2*RND) 5510 IF CLRB=1 THEN CLRB2=2:ELSE CLRB2=1 5520 RETURN 5600 'Generate solutions (up to 31 different ones) 5610 AT=1 5620 FOR SS=1 TO SL:LST(SS,1)=SQ(SS,QI,QJ):NEXT 5630 'First do those that have only one difference 5640 FOR SS=1 TO SL 5650 WORK=LST(SS,1) 5660 FOR NN=1 TO NN(SS)-1 5670 AT = AT + 1:IF AT>32 THEN AT=32 5680 FOR I=1 TO SL 5690 LST(I,AT)=LST(I,1) 5700 NEXT 5710 WORK = WORK +1:IF WORK>NN(SS) THEN WORK=1 5720 LST(SS,AT)=WORK 5730 NEXT NN 5740 NEXT SS 5750 'If have enough, or can't do more, exit 5760 IF AT>=6 THEN RETURN 5770 IF SL=1 THEN RETURN 5780 'Now do the those that have two values different 5790 FOR SS=1 TO SL-1 5800 FOR ST=SS+1 TO SL 5810 WORK1=LST(SS,1) 5820 FOR NN=1 TO NN(SS)-1 5830 WORK2=LST(ST,1) 5840 WORK1 = WORK1+1:IF WORK1>NN(SS) THEN WORK1=1 5850 FOR NT=1 TO NN(ST)-1 5860 AT = AT + 1:IF AT>32 THEN AT=32 5870 FOR I=1 TO SL 5880 LST(I,AT)=LST(I,1) 5890 NEXT 5900 WORK2 = WORK2+1:IF WORK2>NN(ST) THEN WORK2=1 5910 LST(SS,AT)=WORK1:LST(ST,AT)=WORK2 5920 NEXT NT 5930 NEXT NN 5940 NEXT ST 5950 NEXT SS 5960 'Should have enough for six solutions 5970 RETURN 6000 'Generate a permutation on 1 to ir 6010 FOR I=1 TO IR:N(I)=I:R(I)=RND:NEXT 6020 K=0 6030 FOR I=2 TO IR 6040 IF R(I)<R(I-1) THEN SWAP R(I),R(I-1):SWAP N(I),N(I-1):K=1 6050 NEXT:IF K>0 THEN GOTO 6020 6060 RETURN 6100 'Generate board 6110 PANEL=3:CT=0:CLS 6120 IF CLRU THEN SCREEN 1,0:ELSE SCREEN 1,1 6130 LOCATE 1,15:POKE &H4E,1:PRINT"Matrix Madness";:POKE &H4E,3 6140 IF SL=2 THEN POKE &H4E,1:ELSE IF SL=3 THEN POKE &H4E,2 6142 LOCATE 1,34:PRINT"Level ";MID$(ANS$,SL,1);:POKE &H4E,3 6150 X=CI(1)-30:XW=CI(2)-CI(1):Y=CJ(1)-25:YW=CJ(2)-CJ(1) 6160 FOR I=0 TO 3 6170 LINE (X+I*XW,Y)-(X+I*XW,Y+YW*3) 6180 IF CLRU THEN LINE (X+I*XW+1,Y)-(X+I*XW+1,Y+YW*3) 6190 LINE (X,Y+I*YW)-(X+3*XW,Y+YW*I) 6200 NEXT 6210 K=0 6220 FOR I=4 TO 5:FOR J=1 TO 3:IF K>=AT THEN 6250 6230 K=K+1:M$=MID$(ANS$,K,1) 6240 GOSUB 8300:LOCATE QR,QC:PRINT M$; 6250 NEXT:NEXT 6260 POKE &H4E,1:LOCATE 24,1:PRINT"Score:";:LOCATE 24,27:PRINT"Points:"; 6270 POKE &H4E,2:LOCATE 24,14:PRINT"Question:";:POKE &H4E,3 6275 LOCATE 24,7:PRINT TPTS;:LOCATE 24,23:PRINT;TOT; 6280 GOSUB 8200:'convert coords 6290 K=0 6300 FOR I=1 TO 5 6310 FOR J=1 TO 3 6320 IF I>3 THEN IF K>=AT THEN 6380:ELSE K=K+1 6330 IF I=QI AND J=QJ THEN GOTO 6380 6340 FOR SS=1 TO SL 6350 C=SQ(SS,I,J) 6360 GOSUB 8800 6370 NEXT SS 6380 NEXT 6390 NEXT 6400 RETURN 6500 'Display answer request, set up pts and time. 6510 LOCATE 22,1 6520 PRINT" Choice:"; 6530 SEC=101:PTS=100:STIME!=FNT! 6540 RETURN 6600 'Update display information 6610 PTS = PTS-1:IF PTS<0 THEN PTS=0 6620 LOCATE 24,27:IF PTS>0 THEN LOCATE 24,34:PRINT PTS;:ELSE PRINT" "; 6630 RETURN 6700 'Check keyboard input, PANEL=3, only 6710 IF A$=F3$ THEN SND=NOT SND:GOSUB 7720:RETURN 6720 IF A$=F4$ THEN CLR=NOT CLR:GOSUB 7690:RETURN 6730 GOSUB 6800:'Handle a possible answer request. 6740 RETURN 6750 'Common code for demo and play 6800 'See if valid answer 6810 IF PTS=0 THEN GOTO 7100:'Time out 6820 IF LEN(A$)=0 THEN RETURN:'No answer yet, go back to wait 6830 GOSUB 3580:'Validate the character 6840 IF I>0 THEN GOTO 6930 6850 LOCATE 22,1 6860 GOSUB 7570:'Beep bad request 6870 IF AT=2 THEN PRINT " Choices are 1 or 2:" 6880 IF AT=3 THEN PRINT " Choices are 1, 2, or 3:" 6890 IF AT=4 THEN PRINT " Choices are 1, 2, 3, or 4:" 6900 IF AT=5 THEN PRINT " Choices are 1, 2, 3, 4, or 5:" 6910 IF AT=6 THEN PRINT "Choices are 1, 2, 3, 4, 5, or 6:" 6920 RETURN 6930 LOCATE 22,34:PRINT A$; 6940 IF A$<>C$ THEN PTS=(1+PTS)\2:GOSUB 7570:GOSUB 8500:LOCATE 24,34:PRINT PTS;:RETURN 6950 LOCATE 22,1:PRINT TAB(21);" ";A$;" is correct! "; 6960 'I=3:J=22:NC=1:GOSUB 2390:'Invert it. 6970 OK=OK+1:TPTS=TPTS+PTS:PTS=0 6980 GOSUB 7600:'Beep 6990 LOCATE 24,7:PRINT TPTS; 7000 RETURN 7100 LOCATE 22,1:GOSUB 7660:PRINT"Time ran out. The answer is ";C$". "; 7110 RETURN 7200 'write scores to screen 7210 PANEL=4:GOSUB 1610:'Write heading 7220 LOCATE 3,12:COLOR 7,0:PRINT"Your final score:";TPTS 7230 LOCATE 5,12:PRINT ; 7240 GOSUB 1550:'Write level 7250 LOCATE 7,9:COLOR 0,13:PRINT" H a l l o f F a m e "; 7260 LOCATE 9,1:COLOR 0,7:PRINT"Score";:LOCATE 9,8:COLOR 0,7:PRINT" Name "; 7270 IF TPTS>=SCR(SL,10) THEN GOSUB 13400:'Better score? If so make room. 7280 FOR I=1 TO 10 7290 LOCATE 10+I,1:IF I=AVAIL THEN COLOR 0,13:ELSE COLOR 7,0 7300 PRINT USING "#### ";SCR(SL,I); 7310 COLOR 7,0 7320 PRINT " ";SNM$(SL,I); 7330 NEXT 7340 IF TPTS>=SCR(SL,10) THEN GOSUB 13530:'Now ask for name 7350 RETURN 7400 'Write demo score to screen and h of f. 7410 PANEL=6:GOSUB 1610:'Write heading 7420 LOCATE 3,10,0:COLOR 7,0:PRINT"Demonstration score:";TPTS 7430 LOCATE 5,12:PRINT ; 7440 GOSUB 1550:'Write level 7450 LOCATE 7,9:COLOR 0,13:PRINT" H a l l o f F a m e "; 7460 LOCATE 9,1:COLOR 0,7:PRINT"Score";:LOCATE 9,8:COLOR 0,7:PRINT" Name "; 7470 FOR I=1 TO 10 7480 LOCATE 10+I,1:COLOR 7,0 7490 PRINT USING "#### ";SCR(SL,I); 7500 COLOR 7,0 7510 PRINT " ";SNM$(SL,I); 7520 NEXT 7530 RETURN 7540 'Key Beep 7550 IF SND THEN PLAY "MBMLO4L48C" 7560 RETURN 7570 'Correct answer beep 7580 IF SND THEN PLAY "MBO2L8GC" 7590 RETURN 7600 'Wrong answer beep 7610 IF SND THEN PLAY "MBO3L16CEL8G" 7620 RETURN 7630 'Beep for screen build 7640 IF SND THEN PLAY "MBO2L8P2EP6EP8EP10E" 7650 RETURN 7660 'Beep for time out 7670 IF SND THEN PLAY "MBO2L16G" 7680 RETURN 7690 'Beep for color change 7700 IF SND THEN IF CLR THEN PLAY "MBMLO5L24C":ELSE PLAY "MBMLO3L16C" 7710 RETURN 7720 'Beep for Sound Change 7730 IF SND THEN PLAY "MBMLO5L24C":ELSE PLAY "MBMLO3L16C" 7740 RETURN 7800 'Fill in answer and mark it also 7810 I=QI:J=QJ 7820 FOR SS=1 TO SL 7830 C = SQ(SS,I,J) 7840 GOSUB 8800 7850 NEXT SS 7860 X=CI(IX):XW=(CI(2)-CI(1))\2-4 7870 Y=CJ(JX):YW=(CJ(2)-CJ(1))\2-4 7880 LINE (X-XW,Y-YW)-(X+XW,Y+YW),,B 7890 IF CLRU THEN LINE (X-XW+1,Y-YW)-(X+XW+1,Y+YW),,B 7900 RETURN 7910 'Store info to be able to flip answer 7920 X=CI(QI):Y=CJ(QJ) 7930 GET (X-XW,Y-YW)-(X+XW,Y+YW),IVC 7940 RETURN 7950 'Wait a second and flip 7960 GOSUB 3500 7970 X=CI(QI):Y=CJ(QJ) 7980 PUT (X-XW,Y-YW),IVC,XOR 7990 RETURN 8000 'Wait to continue 8010 LOCATE 25,1 8020 IF IP=IPL THEN PRINT" Press Enter for final score. "; 8030 IF IP<>IPL THEN PRINT" Press Enter for next problem. "; 8040 I=4:J=25:NC=31:GOSUB 2590:'Video invert msg. 8050 GOSUB 7910:'Set up to flash answer on and off 8060 A$="" 8070 WHILE A$<>ENT$ 8080 SEC=1:GOSUB 7950:'Wait a second and flip it. 8090 WEND 8100 RETURN 8200 'figure out coord for text given qi and qj 8210 QR=5:IF QJ=2 THEN QR=11:ELSE IF QJ=3 THEN QR=17 8220 QC=4:IF QI=2 THEN QC=12:ELSE IF QI = 3 THEN QC=20 8230 RETURN 8300 'figure out coord for text given i and j 8310 QR=8:IF J=2 THEN QR=14:ELSE IF J=3 THEN QR=20 8320 QC=I*8-6 8330 RETURN 8400 'Calc x and y given i and j 8410 X=I*8-8:Y=J*8-8 8420 RETURN 8500 'Mark Bad guess 8510 IF A$=MID$(ANS$,1,1) THEN I=4:J=1:GOSUB 8600 8520 IF A$=MID$(ANS$,2,1) THEN I=4:J=2:GOSUB 8600 8530 IF A$=MID$(ANS$,3,1) THEN I=4:J=3:GOSUB 8600 8540 IF A$=MID$(ANS$,4,1) THEN I=5:J=1:GOSUB 8600 8550 IF A$=MID$(ANS$,5,1) THEN I=5:J=2:GOSUB 8600 8560 IF A$=MID$(ANS$,6,1) THEN I=5:J=3:GOSUB 8600 8570 LOCATE 22,1:PRINT" ";A$;" is wrong. Choose again: "; 8580 I=7:J=22:NC=1:GOSUB 2590:'Invert it. 8590 RETURN 8600 'Make the X 8610 X=CI(I):Y=CJ(J) 8620 LINE (X-20,Y-20)-(X+20,Y+20) 8630 LINE (X-20,Y+20)-(X+20,Y-20) 8640 RETURN 8700 'Delay routine 8710 FOR KK=1 TO 3000:NEXT 8720 RETURN 8800 'Select what to put on screen on number of choices. 8810 X=CI(I):Y=CJ(J) 8820 SX=SS(SS) 8830 IF SX<9 THEN ON SX GOTO 8930,9050,9170,9280,9330,9400,9400,9400 8840 IF SX<17 THEN ON SX-8 GOTO 9460,9590,9610,9640,9710,9740,9780,9860 8850 IF SX<25 THEN ON SX-16 GOTO 10000,10080,10120,10160,10200,10240,10280,10350 8860 IF SX<33 THEN ON SX-24 GOTO 10440,10480,10520,10660,10690,10720,10750 8870 IF SX<40 THEN RETURN 8880 IF SX<49 THEN ON SX-40 GOTO 10800,10850,10900,10960,11010,11050,11110,11170 8890 IF SX<59 THEN ON SX-48 GOTO 11210,11290,11310,11330 8900 IF SX<67 THEN ON SX-59 GOTO 11360,11400,11440,11480,11530,11590,11650 8910 RETURN:'Return normally not used here, pattern routines return. 8920 'Routines to draw something in a box 8930 '1: Vertical Lines 8940 XW=10 8950 ON C GOTO 8960,8980,9010 8960 LINE (X,Y-XW)-(X+1,Y+XW+1),CLRB,B 8970 RETURN 8980 LINE (X-4,Y-XW)-(X-3,Y+XW+1),CLRB,B 8990 LINE (X+4,Y-XW)-(X+5,Y+XW+1),CLRB,B 9000 RETURN 9010 LINE (X-8,Y-XW)-(X-7,Y+XW+1),CLRB,B 9020 LINE (X+8,Y-XW)-(X+9,Y+XW+1),CLRB,B 9030 LINE (X ,Y-XW)-(X+1,Y+XW+1),CLRB,B 9040 RETURN 9050 '2: Horizontal Lines 9060 XW=10 9070 ON C GOTO 9080,9100,9130 9080 LINE (X+XW,Y)-(X-XW+1,Y+1),CLRB,B 9090 RETURN 9100 LINE (X+XW+1,Y-4)-(X-XW,Y-3),CLRB,B 9110 LINE (X+XW+1,Y+4)-(X-XW,Y+5),CLRB,B 9120 RETURN 9130 LINE (X+XW,Y+8)-(X-XW+1,Y+9),CLRB,B 9140 LINE (X+XW,Y-8)-(X-XW+1,Y-7),CLRB,B 9150 LINE (X+XW,Y )-(X-XW+1,Y+1),CLRB,B 9160 RETURN 9170 ON C GOTO 9190,9210,9240 9180 '3: Circles 9190 CIRCLE (X,Y),8,CLRB:PAINT (X,Y),CLRB,CLRB 9200 RETURN 9210 CIRCLE (X-6,Y-6),8,CLRB:PAINT (X-6,Y-6),CLRB,CLRB 9220 CIRCLE (X+6,Y+6),8,CLRB:PAINT (X+6,Y+6),CLRB,CLRB 9230 RETURN 9240 CIRCLE (X-9,Y-8),8,CLRB:PAINT (X-9,Y-8),CLRB,CLRB 9250 CIRCLE (X+9,Y-8),8,CLRB:PAINT (X+9,Y-8),CLRB,CLRB 9260 CIRCLE (X,Y+6),8,CLRB:PAINT (X,Y+6),CLRB,CLRB 9270 RETURN 9280 ' 9290 '4: Vertica, Horz, Both 9300 IF C<3 THEN LINE (X+1,Y+9)-(X,Y-8),CLRB,B 9310 IF C>1 THEN LINE (X+9,Y+1)-(X-8,Y),CLRB,B 9320 RETURN 9330 ' 9340 '5: Lines with Various Orientatins 9350 IF C=1 THEN LINE (X+8,Y)-(X-8,Y) 9360 IF C=2 THEN LINE (X+4,Y+7)-(X-4,Y-7) 9370 IF C=3 THEN LINE (X+4,Y-7)-(X-4,Y+7) 9380 RETURN 9390 RETURN 9400 'Cases 6,7,8 Little Circles 9410 XW=8*(SX-7):YW=8*(C-2) 9420 CIRCLE (X-XW,Y-YW),3,CLRB 9430 PAINT (X-XW,Y-YW),CLRB,CLRB 9440 LINE (X-XW,Y-11)-(X-XW,Y+11),CLRB 9450 RETURN 9460 'Cases 9: Face with variable mouth 9470 XW=1:YW=1 9480 CIRCLE (X,Y),16,,,,1:PAINT (X,Y) 9490 IF C=1 THEN LINE (X-5,Y+10)-(X+5,Y+10),0 9500 IF C=2 THEN LINE (X-5,Y+11)-(X,Y+10),0:LINE (X+5,Y+11)-(X,Y+10),0 9510 IF C=3 THEN LINE (X-5,Y+10)-(X,Y+12),0:LINE (X+5,Y+10)-(X,Y+12),0 9520 IF XW=1 THEN LINE (X-2,Y+6)-(X+2,Y+6),0 9530 IF XW=2 THEN LINE (X,Y+7)-(X,Y+3),0 9540 IF XW=3 THEN CIRCLE (X,Y+6),2,0:PAINT (X,Y+6),0,0 9550 IF YW=1 THEN LINE (X-7,Y)-(X-3,Y),0:LINE (X+7,Y)-(X+3,Y),0 9560 IF YW=2 THEN LINE (X-8,Y-2)-(X-5,Y),0,BF:LINE (X+8,Y-2)-(X+5,Y),0,BF 9570 IF YW=3 THEN CIRCLE (X-5,Y),2,0:CIRCLE (X+5,Y),2,0 9580 RETURN 9590 'Case 10: Face with variable eyes and mouth 9600 SS=SS+1:YW=SQ(SS,I,J):XW=1:GOTO 9480 9610 'Case 11: Face with variable eyes and mouth 9620 SS=SS+1:YW=SQ(SS,I,J):SS=SS+1:XW=SQ(SS,I,J):GOTO 9480 9630 RETURN 9640 'Cases 12:Boxes with a division. 9650 XW=8:YW=8 9660 IF C<3 THEN LINE (X-XW,Y+YW)-(X,Y-YW),,BF 9670 IF C=3 THEN LINE (X-XW,Y+YW)-(X,Y-YW),,B 9680 IF C>1 THEN LINE (X+XW,Y+YW)-(X,Y-YW),,BF 9690 IF C=1 THEN LINE (X+XW,Y+YW)-(X,Y-YW),,B 9700 RETURN 9710 'Case 13:Double case, change size of boxes 9720 SS=SS+1:XW=2^(SQ(SS,I,J)+1):YW=8 9730 GOTO 9660 9740 'Case 14:Triple case, change size of boxes 9750 SS=SS+1:XW=2^(SQ(SS,I,J)+1) 9760 SS=SS+1:YW=(SQ(SS,I,J)^2)+1 9770 GOTO 9660 9780 'Cases 15: Triangle, Box, Or Square 9790 IF C=1 THEN CIRCLE (X,Y),10:PAINT (X,Y):RETURN 9800 IF C=2 THEN LINE (X+8,Y+8)-(X-8,Y-8),,BF:RETURN 9810 LINE (X+12,Y+9)-(X-12,Y+9) 9820 LINE (X+12,Y+9)-(X,Y-11) 9830 LINE (X-12,Y+9)-(X,Y-11) 9840 PAINT (X,Y) 9850 RETURN 9860 'Cases 16: Double: Triangle, Box, Or Square on Line 9870 XW=0 9880 YW=8*(C-2):SS=SS+1:C=SQ(SS,I,J) 9890 LINE (X+XW,Y-11)-(X+XW,Y+11),CLRB2 9900 GOSUB 9930 9910 RETURN 9920 'Routine for little tri,box,cir. 9930 IF C=1 THEN CIRCLE (X+XW,Y+YW),4,CLRB:PAINT (X+XW,Y+YW),CLRB,CLRB:RETURN 9940 IF C=2 THEN LINE (X+XW+3,Y+YW+3)-(X+XW-3,Y+YW-3),CLRB,BF:RETURN 9950 LINE (X+XW+4,Y+YW+3)-(X+XW-4,Y+YW+3),CLRB 9960 LINE (X+XW+4,Y+YW+3)-(X+XW,Y+YW-4),CLRB 9970 LINE (X+XW-4,Y+YW+3)-(X+XW,Y+YW-4),CLRB 9980 PAINT (X+XW,Y+YW),CLRB 9990 RETURN 10000 'Case 17: Triple: Same as 16, but show item 1,2 or 3 times 10010 ON C GOTO 10020,10040,10060 10020 XW=0:SS=SS+1:C=SQ(SS,I,J):GOSUB 9880 10030 RETURN 10040 XW=4:SS=SS+1:C=SQ(SS,I,J):GOSUB 9880:XW=-4:GOSUB 9890 10050 RETURN 10060 XW=8:SS=SS+1:C=SQ(SS,I,J):GOSUB 9880:XW=0:GOSUB 9890:XW=-8:GOSUB 9890 10070 RETURN 10080 'Case 18: Lines of varying length 10090 XW=2^(C+1):'4 8 16 10100 LINE (X-XW,Y-1)-(X+XW+1,Y+2),CLRB,BF 10110 RETURN 10120 'Case 19: Lines of varying length 10130 YW=2^(C+1):'4 8 16 10140 LINE (X-1,Y-YW)-(X+2,Y+YW+1),CLRB,BF 10150 RETURN 10160 'Case 20: 9 different items 10170 GOSUB 8300:QR=QR-1:QC=QC+2 10180 LOCATE QR,QC:PRINT MID$("ABC",C,1); 10190 RETURN 10200 'Case 21: A line vertical 10210 XW=8*(C-2) 10220 LINE (X+XW,Y-8)-(X+XW,Y+8) 10230 RETURN 10240 'Case 22: A line horizontal 10250 YW=8*(C-2) 10260 LINE (X-8,Y+YW)-(X+8,Y+YW) 10270 RETURN 10280 'Case 23: Overlapping Circles 10290 XW=C*4 10300 CIRCLE (X-XW,Y),8,CLRB 10310 PAINT (X-XW,Y),CLRB,CLRB 10320 CIRCLE (X+XW,Y),8,CLRB2 10330 PAINT (X+XW+2,Y),CLRB2,CLRB2 10340 RETURN 10350 'Case 24: Overlapping Triangles 10360 XW=C*4 10370 LINE (X+XW+8,Y+6)-(X+XW-8,Y+6) 10380 LINE (X+XW+8,Y+6)-(X+XW,Y-8) 10390 LINE (X+XW-8,Y+6)-(X+XW,Y-8) 10400 LINE (X-XW+8,Y+6)-(X-XW-8,Y+6) 10410 LINE (X-XW+8,Y+6)-(X-XW,Y-8) 10420 LINE (X-XW-8,Y+6)-(X-XW,Y-8) 10430 RETURN 10440 'Case 25: Part of a line 10450 IF C=1 THEN LINE (X,Y-8)-(X,Y) 10460 IF C=2 THEN LINE (X,Y+8)-(X,Y) 10470 RETURN 10480 'Case 26: Filled circle 10490 YW=8*(C-2) 10500 CIRCLE (X,YW),3:PAINT (X,YW) 10510 RETURN 10520 'Case 27:Four section item 10530 XW=1:YW=1 10540 RPI=3.14159 10550 'CIRCLE (X,Y),12,,0,RPI/2,1:CIRCLE (X,Y),12,,RPI,RPI*1.5,1 10560 LINE (X+12,Y)-(X-12,Y),3:LINE (X,Y+12)-(X,Y-12),3 10570 IF XW=1 THEN CIRCLE (X,Y),12,3,RPI*0.5,RPI,1 10580 IF XW=2 THEN LINE (X-12,Y-12)-(X,Y),3,B 10590 IF XW=3 THEN LINE (X-12,Y)-(X,Y-12),3 10600 IF YW=1 THEN CIRCLE (X,Y),12,3,RPI*1.5,RPI*2,1 10610 IF YW=2 THEN LINE (X+12,Y+12)-(X,Y),3,B 10620 IF YW=3 THEN LINE (X+12,Y)-(X,Y+12),3 10630 IF C=1 THEN PAINT (X-3,Y-3):ELSE IF CLRU THEN PAINT (X-3,Y-3),CLRB,3 10640 IF C=2 THEN PAINT (X+3,Y+3):ELSE IF CLRU THEN PAINT (X+3,Y+3),CLRB,3 10650 RETURN 10660 'case 28:double, round or square corners 10670 XW=C:SS=SS+1:YW=SQ(SS,I,J):C=3 10680 GOTO 10540 10690 'case 29:triple, like 28, but shade em. 10700 SS=SS+1:YW=SQ(SS,I,J):SS=SS+1:XW=SQ(SS,I,J) 10710 GOTO 10540 10720 'case 30:double, multple vertical lines, long med short 10730 XW=2^(C+1):SS=SS+1:C=SQ(SS,I,J) 10740 GOTO 8950:'Now do as a case 1 10750 'case 31:double, multple horiz. lines, long med short 10760 XW=2^(C+1):SS=SS+1:C=SQ(SS,I,J) 10770 GOTO 9070:'Now do as a case 1 10800 'Case 41: 'Color line up down 10810 LINE (X-3,Y-8)-(X-3,Y+8),0 10820 LINE (X+3,Y-8)-(X+3,Y+8),0 10830 LINE (X-2,Y-8)-(X+2,Y+8),C,BF 10840 RETURN 10850 'Case 42: 'Color line across 10860 LINE (X+8,Y-3)-(X-8,Y-3),0 10870 LINE (X+8,Y+3)-(X-8,Y+3),0 10880 LINE (X+8,Y-2)-(X-8,Y+2),C,BF 10890 RETURN 10900 'Case 43: 'Circle in one of several colors 10910 CIRCLE (X,Y),10,0 10920 CIRCLE (X,Y),9,C 10930 CIRCLE (X,Y),6,C 10940 PAINT (X-8,Y),C,C 10950 RETURN 10960 'Case 44: 'Solid color circle 10970 CIRCLE (X,Y),9,0 10980 CIRCLE (X,Y),8,C 10990 PAINT (X,Y),C,C 11000 RETURN 11010 'Case 45: 'Solid color box 11020 LINE (X+9,Y+9)-(X-9,Y-9),0,B 11030 LINE (X+8,Y+8)-(X-8,Y-8),C,BF 11040 RETURN 11050 'Case 46: 'Solid color triangle 11060 LINE (X+12,Y+8)-(X-12,Y+8),C 11070 LINE (X+12,Y+8)-(X,Y-12),C 11080 LINE (X-12,Y+8)-(X,Y-12),C 11090 PAINT (X,Y),C,C 11100 RETURN 11110 'Case 47: 'Triange for top of square 11120 LINE (X-12,Y-10)-(X+12,Y-10),C 11130 LINE (X+12,Y-10)-(X,Y-16),C 11140 LINE (X-12,Y-10)-(X,Y-16),C 11150 PAINT (X,Y-14),C,C 11160 RETURN 11170 'Case 48: 'Door for square 11180 IF C=1 THEN LINE (X-4,Y+8)-(X,Y),0,BF:RETURN 11190 IF C=2 THEN LINE (X,Y)-(X+4,Y+8),0,BF:RETURN 11200 RETURN 11210 'Case 49: 'Small null triangle for door 11220 IF C=2 THEN RETURN:ELSE XW=(C-2)*4 11230 LINE (X+4+XW ,Y+8)-(X-4+XW,Y+8),0 11240 LINE (X+4+XW,Y+8)-(X+XW,Y+2),0 11250 LINE (X-4+XW,Y+8)-(X+XW,Y+2),0 11260 DATA 50,50,50, 60,60,60 11270 PAINT (X+XW,Y+4),0,0 11280 RETURN 11290 'Case 50: V Lines, Colored, Uses 30 & 1 11300 CLRB=C:SS=SS+1:C=SQ(SS,I,J):GOTO 10720 11310 'Case 51: H Lines, Colored, Uses 31 & 2 11320 CLRB=C:SS=SS+1:C=SQ(SS,I,J):GOTO 10750 11330 'Case 52: 'Solid color triangle 11340 LINE (X+15,Y+8)-(X-15,Y+8),C:LINE (X+15,Y+8)-(X,Y-15),C:LINE (X-15,Y+8)-(X,Y-15),C 11350 PAINT (X,Y),C,C:RETURN 11360 'Case 60: Paired with null 60. Level 2 or 3 use only 11370 SS = SS + 1:' Get next ones icon 11380 ON SQ(SS,I,J) GOSUB 10960,11010,11050 11390 RETURN:'Was circle square triangle usage 11400 'Case 61: Paired with null 60. Level 2 or 3 use only 11410 SS = SS + 1:' Get next ones icon 11420 ON SQ(SS,I,J) GOSUB 8930,9050,9170 11430 RETURN:'Lines in various directions 11440 'Case 62: A Double, Level 2 or 3 use only 11450 YW=2^(C+1):SS=SS+1:XW=2^(SQ(SS,I,J)+1) 11460 LINE (X-XW,Y-YW)-(X+XW,Y+YW),,BF 11470 RETURN 11480 'Case 63: Triple, Level 3,Color 11490 YW=2^(C+1):SS=SS+1:XW=2^(SQ(SS,I,J)+1) 11500 SS=SS+1:C=SQ(SS,I,J) 11510 LINE (X-XW,Y-YW)-(X+XW,Y+YW),C,BF 11520 RETURN 11530 'Case 64: Double, Level 2 11540 YW=8*(C-2):SS=SS+1:XW=SQ(SS,I,J) 11550 CIRCLE (X,Y-YW),3,,,,XW 11560 PAINT (X,Y-YW) 11570 LINE (X,Y-11)-(X,Y+11) 11580 RETURN 11590 'Case 65: Triple, Level 3, Color 11600 XW=2^(C+1):SS=SS+1:YW=(SQ(SS,I,J)-2)*8 11610 SS=SS+1:C=SQ(SS,I,J) 11620 LINE (X-XW,Y+YW-2)-(X+XW,Y+YW+2),C,BF 11630 LINE (X-2,Y-8)-(X+2,Y+8),C,BF 11640 RETURN 11650 'Case 66: Dual, Mono 11660 XW=12 11670 IF C>1 THEN LINE (X-XW,Y-XW)-(X+XW+1,Y-XW+1),CLRB,BF 11680 IF C>1 THEN LINE (X-XW,Y+XW)-(X+XW+1,Y+XW+1),CLRB,BF 11690 IF C<3 THEN LINE (X-XW,Y-XW)-(X-XW+1,Y+XW+1),CLRB,BF 11700 IF C<3 THEN LINE (X+XW,Y-XW)-(X+XW+1,Y+XW+1),CLRB,BF 11710 SS=SS+1 11720 C=SQ(SS,I,J) 11730 IF C<3 THEN LINE (X,Y-XW)-(X+1,Y+XW+1),CLRB,BF 11740 IF C>1 THEN LINE (X-XW,Y)-(X+XW+1,Y+1),CLRB,BF 11750 RETURN 11800 'Coordinates for center of squares 11810 DATA 30,90,150, 220,284:'Across 11820 DATA 44,92,140 :' Down 11830 'Coordinates for center of tiny sqs 11840 DATA 090,118,146,254,292:'Across 11850 DATA 80,104,128 :' Down 11900 DATA 7 :'Different layouts of sub-patterns 11910 ' NN, NG, L(3x3) 11920 DATA 3,1, 1,1,1,2,2,2,3,3,3 11930 DATA 3,2, 1,2,3,1,2,3,1,2,3 11940 DATA 3,3, 1,2,3,2,3,1,3,1,2 11950 DATA 3,4, 1,2,3,3,1,2,2,3,1 11960 DATA 2,5, 2,1,1,1,2,1,1,1,2 11970 DATA 2,6, 1,1,2,1,2,1,2,1,1 11980 DATA 2,7, 2,1,2,1,2,1,2,1,2 12000 'Valid combinations of patterns 12010 'Number of different m1 m2 m3 color1 color2 color3 icons to use 12020 DATA 12,12,5,10,10,10 :'DV: Number of different valid ones 12030 'Format: 1, 2 , or 3 icon combinations that work together, id of 'em. 12040 ' NV(DV,1) to NV(DV,3) 12050 'Mono: Beginner items (12) 12060 DATA 2,0,0, 3,0,0, 4,0,0, 5,0,0, 7,0,0 12070 DATA 9,0,0, 12,0,0, 15,0,0, 18,0,0, 19,0,0 12080 DATA 23,0,0, 24,0,0 12090 'Mono: Intermediate (11) 12100 DATA 1,2,0, 6,8,0, 10,10,0, 13,13,0 12110 DATA 64,64,0, 16,16,0, 18,19,0, 61,61,0 12120 DATA 30,30,0, 31,31,0, 21,22,0 12130 DATA 66,66,0 12140 'Mono: Advanced (5) 12150 DATA 6,7,8, 14,14,14, 17,17,17 ,11,11,11, 29,29,29 12160 'Color: Beginner items (10) 12170 DATA 41,0,0, 42,0,0, 43,0,0, 44,0,0, 45,0,0 12180 DATA 2,0,0, 7,0,0, 4,0,0, 46,0,0, 23,0,0 12190 'Color: Intermediate (10) 12200 DATA 41,42,0, 43, 7,0, 46,47,0 12210 DATA 52,45,0, 66,66,0, 18,19,0, 16,16,0 12220 DATA 46,48,0, 60,60,0, 61,61,0 12230 'Color: Advanced (10) 12240 DATA 45,41,42, 45,47,48, 60,60,47 12250 DATA 63,63,63, 65,65,65, 17,17,17, 11,11,11, 29,29,29 12260 DATA 50,50,50, 51,51,51 12300 'Variable descriptions 12310 'IPL = ... Number of problems to ask. 12320 'IP = 1 TO 10 Number of problem being asked. 12330 'ANS$ = Characters used for answers and answer labels 12340 'NN (0) Number of unique ICONS used in a pattern. 12350 'NN = Number of unique ICONS used in a pattern. 12360 'L(3X3) = Sub-pattern being used. 12370 'SS(0) = Number of patterns displayed simultaneously. 12380 ' 1-3 = ICON Set to be used for the pattern(s) 12390 'SP(NL,3,3) = Storage for all patterns 12400 'SP(NL,0,0) = Has number of icons in this pattern 12410 'NG(NL) = Has pattern category, used to avoid conflicts 12420 'SQ(SS,6,3) = For patterns and answers to be used for a problem. 12430 'LST(SS,32) = Possible solutions, up to six will be shown. 12440 'N(32) = Used to scramble choices 12450 'R(32) = Uused to scramble choices 12460 'IR = Number of choices to be scrambled 12470 'IL = 4 if to show 3 answers, 5 if to show 6 answers 12480 'QI, QJ indicates the square on the 3x3 to be blank 12490 'P(3)=Patterns selected for use 12500 'PAUSE 0=Disabled, 1=Enabled with 1 msg line, 2=Enabled with 2 msg lines 12510 'CI(), CJ() Center of squares for 3x3 problem + 2x3 Answers 12520 GOTO 12040:'<--- See for NV description. 12530 'SND = -1 Sound on , =0 Sound off 12540 'CLR = -1 Color on , =0 Color off 12550 'CLRU= Whether color is in use on current problem. 12560 'CT = -1 Color text mode, 0 Graphics mode 12570 '--- Where the panels are---------- 12580 ' -T- Text mode, -G- Graphics mode 12590 GOSUB 4400:'Panel 0 -T- Title Panel 12600 GOSUB 4490:'Panel 1 -G- Introduction 12610 GOSUB 4860:'Panel 2 -T- Select Playing Level 12620 ' Play: 12630 GOSUB 6100:'Panel 3 -G- Display Problem 12640 GOSUB 1530:'Panel 4 -T- Final Score 12650 ' Demo 12660 GOSUB 1990:'Panel 3 -G- Uses panel 3 for demo 12670 GOSUB 2470:'Panel 6 -T- Demo Score 12680 RETURN 12700 'Display an Icon 12710 'Routine used to test icon combinations. 12720 CLS:LOCATE 21,1:PRINT"Symbol display."; 12730 LOCATE 23,1:PRINT"One moment, setting up."; 12740 KEY OFF 12750 GOSUB 3750 12760 LOCATE 23,1 12770 INPUT "Select Level (1, 2, 3)";SL 12780 IF SL=0 THEN GOTO 1090 12790 INPUT "Color (Y or N)";A$:IF A$="Y" OR A$="y" THEN CLRU=-1:ELSE CLRU=0 12800 IF CLRU THEN SCREEN 1,0:ELSE SCREEN 1,1 12810 WSL=SL:IF CLRU THEN WSL = WSL + 3 12820 FOR NUMVAL=DS(WSL) TO DS(WSL)+DV(WSL)-1 12830 FOR I=1 TO 3:SS(I)=NV(NUMVAL,I):NEXT I 12840 CLRB=1:CLRB2=2 12850 P(1)=1:P(2)=2:P(3)=4 12860 FOR I=1 TO 3:FOR J=1 TO 3 12870 SQ(1,I,J)=SP(P(1),I,J) 12880 SQ(2,I,J)=SP(P(2),I,J) 12890 SQ(3,I,J)=SP(P(3),I,J) 12900 NEXT:NEXT 12910 CLS:WIDTH 40 12920 LOCATE 1,1:PRINT"Level";SL; 12930 IF CLRU THEN PRINT" Color: ON ";:ELSE PRINT" Color: OFF"; 12940 PRINT TAB(30);NUMVAL-DS(WSL)+1;"of";DV(WSL):I=30:J=1:NC=10:GOSUB 2590 12950 LOCATE 4,28:PRINT"Symbols:":LOCATE 6,27 12960 FOR I=1 TO SL:PRINT SS(I);:NEXT 12970 LOCATE 10,28:PRINT"Pattern: ":LOCATE 12,27 12980 FOR I=1 TO SL:PRINT P(I);:NEXT:PRINT: 12990 X=CI(1)-30:XW=CI(2)-CI(1):Y=CJ(1)-25:YW=CJ(2)-CJ(1) 13000 FOR I=0 TO 3 13010 LINE (X+I*XW,Y)-(X+I*XW,Y+YW*3) 13020 IF CLRU THEN LINE (X+I*XW+1,Y)-(X+I*XW+1,Y+YW*3) 13030 LINE (X,Y+I*YW)-(X+3*XW,Y+YW*I) 13040 NEXT 13050 FOR I=1 TO 3:FOR J=1 TO 3 13060 FOR SS=1 TO SL:C=SQ(SS,I,J) 13070 GOSUB 8800 13080 NEXT SS 13090 NEXT J 13100 NEXT I 13110 LOCATE 23,1:PRINT"Press Enter For Next";:INPUT A$ 13120 NEXT NUMVAL 13130 CLS:GOTO 12760 13200 ON I GOSUB 13220,13400,13800 13210 'READ, show (and ask), write 13220 'read scores 13230 ON ERROR GOTO 13310 13240 OPEN "madness.log" FOR INPUT AS #1 13250 FOR SL=1 TO 3:FOR I=1 TO 10 13260 INPUT #1,SCR(SL,I),SNM$(SL,I) 13270 NEXT I:NEXT SL 13280 CLOSE 13290 ON ERROR GOTO 0 13300 RETURN 13310 'no info 13320 FOR SL=1 TO 3:FOR I=1 TO 10 13330 SCR(SL,I)=0:SNM$(SL,I)=" - " 13340 NEXT I:NEXT SL 13350 SCR(1,1)=950:SNM$(1,1)="Good Player" 13360 SCR(2,1)=800:SNM$(2,1)="Good Player" 13370 SCR(3,1)=700:SNM$(3,1)="Good Player" 13380 RESUME 13280 13400 'Update score, maybe ask for name. 13410 ' 13420 IF SND THEN PLAY "MBL8CCL16EP8L8CCL16E 13430 INS=0:FOR I=1 TO 10:IF TPTS>=SCR(SL,I) THEN INS=I:GOTO 13450 13440 NEXT 13450 AVAIL = 10 13460 WHILE AVAIL>INS 13470 SCR(SL,AVAIL)=SCR(SL,AVAIL-1) 13480 SNM$(SL,AVAIL)=SNM$(SL,AVAIL-1) 13490 AVAIL = AVAIL - 1 13500 WEND 13510 SCR(SL,AVAIL) = TPTS:SNM$(SL,AVAIL)="" 13520 RETURN 13530 'Get the name of the player 13540 LOCATE 22,3:COLOR 7,0:PRINT"Enter your name in the Hall of Fame"; 13550 LOCATE 10+AVAIL,8,1 13560 P$ = "" 13570 I=0:WHILE I<32 13580 A$="":WHILE A$="":A$=INKEY$:WEND 13590 IF A$=ENT$ THEN GOTO 13690 13600 IF A$=CHR$(8) THEN IF I>0 THEN I=I-1:P$=LEFT$(P$,I):GOTO 13660 13610 IF LEN(A$)>1 THEN 13580 13620 IF A$<" " OR A$=CHR$(34) THEN GOTO 13580 13630 IF LEN(P$)=0 THEN IF A$>="a" AND A$<="z" THEN A$=CHR$(ASC(A$)-32) 13640 P$=P$+A$:I=I+1 13650 IF I=31 THEN GOSUB 7540 13660 LOCATE 10+AVAIL,8,1:COLOR 5,0:PRINT P$; 13670 WEND 13680 LOCATE ,,0 13690 SNM$(SL,AVAIL)=P$ 13700 LOCATE ,,0 13710 LOCATE 10+AVAIL,7:PRINT" "; 13720 LOCATE 22,3:PRINT SPC(35); 13730 RETURN 13800 'Write information to disk. 13810 ON ERROR GOTO 13890 13820 OPEN "madness.log" FOR OUTPUT AS #1 13830 FOR SL=1 TO 3:FOR I=1 TO 10 13840 PRINT #1,SCR(SL,I);",";CHR$(34);SNM$(SL,I);CHR$(34) 13850 NEXT I:NEXT SL 13860 CLOSE 13870 ON ERROR GOTO 0 13880 RETURN 13890 SCREEN 0,1 13900 PRINT"Unable to record scores on disk. (";ERR;")" 13910 GOSUB 7600:SEC=5:WHILE SEC>0:GOSUB 3300:WEND:'Pause, then exit. 13920 RESUME 13860