PCjs Machines
Home of the original IBM PC emulator for browsers.
PC-SIG Diskette Library (Disk #72)
[PCjs Machine "ibm5150"]
Waiting for machine "ibm5150" to load....
Information about “GAME SERIES NO 11”
A mind-boggling collection of programs. If you're confused, you can
discuss your problems with Eliza or the Doctor. If you like puzzles,
enter the world of the atom and try the Black Box. And, if games of
chance are your field, how about a game of Blackjack? It's guaranteed
to be safer for your wallet than a trip to Reno.
System Requirements: BASIC.
How to start: Consult your DOS manual for starting BASIC programs.
File Descriptions:
DOCTOR BAS IPCO Talk your problems out with the doctor
TICTACTO BAS IPCO Tic-tac-toe
ROADRALY BAS IPCO Roadrally - Q&A type game
BLACKBOX BAS IPCO Discover position of atoms by projecting rays
BLCKJACK BAS IPCO Blackjack - no color
FIFTEEN BAS IPCO Puzzle game
ELIZA BAS The psychoanalyst
SPELLER BAS BASIC game
MEMORY BAS BASIC game
RUBIK BAS BASIC game
OTHELLO BAS Othello game
BLACKBOX.BAS
10 KEY OFF:CLS
20 SCREEN 0
30 WIDTH 40
40 PRINT"░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░"
50 PRINT"░┌───────────────────────────────────┐░"
60 PRINT"░│ │░"
70 PRINT"░│ 2057-A.BAS │░"
80 PRINT"░│ BLACK BOX │░"
90 PRINT"░│ │░"
100 PRINT"░│ │░"
110 PRINT"░│ BROUGHT TO YOU BY THE MEMBERS OF │░"
120 PRINT"░│ ▄▄▄▄▄ ▄▄▄▄▄ ▄▄▄▄▄ ▄▄▄▄▄ │░"
130 PRINT"░│ █ █ █ █ █ █ │░"
140 PRINT"░│ █ █▄▄▄█ █ █ █ │░"
150 PRINT"░│ █ █ █ █ █ │░"
160 PRINT"░│ ▄▄█▄▄ █ █▄▄▄▄ █▄▄▄█ │░"
170 PRINT"░│ │░"
180 PRINT"░│ International PC Owners │░"
190 PRINT"░│ │░"
200 PRINT"░│P.O. Box 10426, Pittsburgh PA 15234│░"
210 PRINT"░│ │░"
220 PRINT"░└───────────────────────────────────┘░"
230 PRINT"░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░"
240 PRINT
250 PRINT " PRESS ANY KEY TO CONTINUE
260 A$=INKEY$: IF A$="" THEN 260
270 WIDTH 80
280 CLS
1000 ' THE BLACK BOX GAME
1010 ' FOR ALGORITHM SEE SOLUTION BY JEFF KENTON, CREATIVE COMPUTING MAY,1978
1020 '
1030 ' THIS IBM-PC ADDAPTATION WITH GRAPHICS AND SCORING BY:
1040 '
1050 ' CHUCK HARRINGTON
1060 ' THE ATHENS AREA IBM-PC USERS CLUB
1070 ' CUTLER HALL
1080 ' ATHENS, OHIO 45701
1090 '
1100 CLS:RANDOMIZE
1110 DIM USE%(32)
1120 CLS:KEY OFF
1130 SCORE=0: FOR I=1 TO 32: USE%(I)=0:NEXT I
1140 FOR J=0 TO 9:FOR I=0 TO 9:B(I,J)=0: NEXT I,J
1150 GOOD%=0
1160 LOCATE 12,25: INPUT;"DO YOU WANT INSTRUCTIONS (Y OR N)?",ANS$
1170 IF ANS$ = "Y" OR ANS$ = "y" THEN GOSUB 2230
1180 CLS
1190 LOCATE 3,14:PRINT "|";
1200 FOR I=1 TO 8: PRINT "-";33-I;"-|";:NEXT I
1210 K=24: M=1:LOCATE 4,12:PRINT "--";:FOR I=1 TO 8:PRINT "|------";:NEXT I:PRINT "|--"
1220 FOR I=1 TO 16 STEP 2
1230 LOCATE I+4,13: PRINT M: LOCATE I+4,69: PRINT K
1240 LOCATE I+4+1,12: PRINT "--| ": LOCATE I+4+1,69:PRINT " |--"
1250 K=K-1: M=M+1
1260 NEXT I
1270 LOCATE 21,14: PRINT "| ";
1280 FOR I=1 TO 8: PRINT "-";I+8;"-|";:NEXT I
1290 LOCATE 20,14:FOR I=1 TO 8: PRINT "|------";:NEXT I:PRINT "|--"
1300 COLOR 0,7:LOCATE 2,10
1310 FOR I=1 TO 65: PRINT " ";:NEXT I
1320 FOR I=1 TO 20
1330 LOCATE I+1,10: PRINT " ": LOCATE I+1,73: PRINT " "
1340 NEXT I
1350 LOCATE 22,10:FOR I=1 TO 65: PRINT " ";:NEXT I
1360 COLOR 7,0
1370 DEF FNR(Z)=INT(8*RND(1)+1)
1380 LOCATE 1,10:PRINT "THE BLACK BOX GAME";
1390 LOCATE 1,57: INPUT "NUMBER OF ATOMS? ",N
1400 FOR I=1 TO N
1410 X=FNR(1):Y=FNR(1): IF B(X,Y)<>0 THEN 1410
1420 B(X,Y)=1: NEXT I
1430 LOCATE 25,5:INPUT;"ENTER RAY. ",R:GOSUB 2190:LOCATE 25,30:PRINT STRING$(45," ");:IF R<1 THEN 1730
1440 IF GOOD% > 0 THEN LOCATE 25,35:PRINT "USED ALREADY! AGAIN.";:GOTO 1430
1450 ON INT((R-1)/8+1) GOSUB 2020,2030,2040,2050
1460 ON INT((R-1)/8+1) GOTO 1480,1490,1500,1510
1470 BEEP:LOCATE 25,10:COLOR 0,7:PRINT "INPUT ERROR. RE-DO.":GOTO 1430
1480 X=0: Y=R: U=1: V=0: GOTO 1520
1490 X=R-8: Y=9: U=0: V=-1: GOTO 1520
1500 X=9:Y=25-R: U=-1: V=0: GOTO 1520
1510 X=33-R: Y=0: U=0: V=1
1520 X1=X+U: Y1=Y+V
1530 IF U=0 THEN X2=X1-1: X3=X1+1: Y2=Y1: Y3=Y1: GOTO 1550
1540 Y2=Y1-1: Y3=Y1+1: X2=X1: X3=X1
1550 ON INT(8*B(X1,Y1)+B(X2,Y2)+2*B(X3,Y3)+1) GOTO 1570,1580,1590,1580
1560 LOCATE 25,65: BEEP:PRINT "ABSORBED! ";:SCORE=SCORE + 3:LOCATE 25,35:PRINT "SCORE:";SCORE;: GOTO 1430
1570 X=X1:Y=Y1: GOTO 1620
1580 Z=1:GOTO 1600
1590 Z=-1
1600 IF U=0 THEN U=Z: V=0: GOTO 1620
1610 U=0:V=Z
1620 ON INT((X+15)/8) GOTO 1660,1640,1670
1630 STOP 'SHOULD NEVER GET HERE
1640 ON INT((Y+15)/8) GOTO 1680,1520,1690
1650 STOP 'SHOULD NEVER GET HERE
1660 Z=Y: GOTO 1700
1670 Z=25-Y: GOTO 1700
1680 Z=33-X: GOTO 1700
1690 Z=8+X
1700 IF Z=R THEN LOCATE 25,65:BEEP:PRINT "REFLECTED! ";:SCORE=SCORE + 2:LOCATE 25,35:PRINT "SCORE :";SCORE;:GOTO 1430
1710 ON INT ((Z-1)/8+1) GOSUB 2060,2070,2080,2090
1720 GOTO 1430
1730 LOCATE 25,35:INPUT;"GUESS OR PEEK (G/P)?",ANS$
1740 IF ANS$="g" OR ANS$="G" THEN 1770
1750 IF ANS$="p" OR ANS$="P" THEN 1890
1760 GOTO 1730
1770 LOCATE 25,35:INPUT;"GUESS FOR ROW (1-8)? ",L$
1780 LF=VAL(L$): IF LF > 0 AND RT <9 THEN 1800
1790 LOCATE 25,35:INPUT;"BAD ROW #. RE-DO.";L$:GOTO 1780
1800 LOCATE 25,35:INPUT;"GUESS COLUMN (9-16)? ",L$
1810 RT=VAL(L$):IF RT >9 AND RT<17 THEN RT=RT-8:GOTO 1830
1820 LOCATE 25,35:INPUT;"BAD COL #. RE-DO. ",L$:GOTO 1800
1830 IF B(LF,RT) = 0 THEN SCORE=SCORE -5:POUT$="G" ELSE GOTO 1860
1840 LOCATE 25,35:PRINT "WRONG. SCORE: ";SCORE;" ";
1850 GOSUB 2140:GOTO 1430
1860 POUT$=CHR$(2):SCORE=SCORE+10
1870 LOCATE 25,35:PRINT "RIGHT. SCORE: ";SCORE;" ";
1880 GOSUB 2140: GOTO 1430
1890 K=1
1900 FOR J=1 TO 16 STEP 2
1910 LOCATE J+4,15
1920 FOR I=1 TO 8
1930 IF B(I,K)=0 THEN PRINT "---+--"; ELSE PRINT "---";:COLOR 23,0:PRINT CHR$(15);:COLOR 7,0:PRINT "--";
1940 IF I < 8 THEN PRINT "|";
1950 NEXT I
1960 K=K+1
1970 NEXT J
1980 LOCATE 25,35: INPUT;"ANOTHER GAME? ",ANS$
1990 IF ANS$="y" OR ANS$ ="Y" THEN 1120
2000 CLS: LOCATE 12,38: PRINT "BYE"
2010 END
2020 LOCATE R*2+3,13:COLOR 0,7:PRINT " ";CHR$(26);:COLOR 7,0:RETURN
2030 LOCATE 21,((R-8)*7)+9: COLOR 0,7:PRINT " ";CHR$(24);:COLOR 7,0:RETURN
2040 LOCATE (25-R)*2+3,70:COLOR 0,7:PRINT " ";CHR$(27);:COLOR 7,0:RETURN
2050 LOCATE 3,((25-R)*7)+66:COLOR 0,7:PRINT " ";CHR$(25);:COLOR 7,0:RETURN
2060 LOCATE Z*2+3,10:PRINT " ";CHR$(27);:GOTO 2100
2070 LOCATE 22,((Z-8)*7)+9:PRINT " ";CHR$(25);:GOTO 2100
2080 LOCATE (25-Z)*2+3,72:PRINT " ";CHR$(26);:GOTO 2100
2090 LOCATE 2,((25-Z)*7)+66:PRINT " ";CHR$(24);:GOTO 2100
2100 SCORE = SCORE - 1
2110 LOCATE 25,35
2120 PRINT "SCORE: ";SCORE;
2130 RETURN
2140 COLOR 23,0
2150 LOCATE 3+LF*2,15+RT*7-4
2160 PRINT POUT$;
2170 COLOR 7,0
2180 RETURN
2190 IF R < 1 THEN GOOD%=0: GOTO 2220
2200 IF USE%(R) = 1 THEN GOOD%=1: GOTO 2220
2210 GOOD%=0: USE%(R)=1
2220 RETURN
2230 CLS
2240 PRINT " THE BLACK BOX GAME IS AN 8X8 SQUARE IN WHICH SEVERAL ATOMS ARE HIDDEN. THE"
2250 PRINT "OBJECT OF THE GAME IS TO DISCOVER THE POSITION OF THE ATOMS BY PROJECTING"
2260 PRINT "RAYS AT THEM FROM THE SIDES OF THE BOX AND NOTICING HOW RAYS ARE DEFLECTED,"
2270 PRINT "REFLECTED OR ABSORBED. RAYS ENTER THE BOX ACROSS ONE OF FOUR EDGES & TRAVEL"
2280 PRINT "HORIZONTALLY OR VERTICALLY. THE PATH OF THE RAYS IS GOVERNED BY THESE RULES:"
2290 PRINT
2300 PRINT " 1. RAYS THAT STRIKE AN ATOM DIRECTLY ARE ABSORBED."
2310 PRINT " 2. RAYS THAT COME WITHIN ONE SQUARE OF AN ATOM IN A DIAGONAL DIRECTION"
2320 PRINT " ARE DEFLECTED 90 DEGREES."
2330 PRINT " 3. RAYS AIMED BETWEEN TWO ATOMS ONE SQUARE APART ARE REFLECTED."
2340 PRINT " 4. RAYS THAT ENTER ON EITHER SIDE OF AN ATOM ON THE EDGE OF THE BOX"
2350 PRINT " ARE REFLECTED."
2360 PRINT " 5. RAYS OTHERWISE TRAVEL IN A STRAIGHT LINE."
2370 PRINT
2380 PRINT " THE GAME IS QUITE INTERESTING WITH 4 OR 5 ATOMS BUT SOON GETS OUT OF HAND"
2390 PRINT "WHEN MORE THAN THAT ARE USED."
2400 PRINT
2410 INPUT;"PRESS ANY KEY TO CONTINUE.",ANS$
2420 CLS
2430 PRINT " TO MAKE THE GAME MORE INTERESTING AND TO MINIMIZE RANDOM QUESSING A SCORING"
2440 PRINT "SYSTEM HAS BEEN DEVISED THAT AWARDS POINTS AS FOLLOWS:"
2450 PRINT
2460 PRINT " 1. A RAY ENTERED WHICH EMERGES IS SCORED -1 (MINIMIZES GUESSING)."
2470 PRINT " 2. RAYS REFLECTED SCORE +2.
2480 PRINT " 3. RAYS ABSORBED SCORE +3.
2490 PRINT
2500 PRINT " BY ENTERING A RAY OF 0 YOU ARE ALLOWED TO:"
2510 PRINT
2520 PRINT " A. GUESS AT THE LOCATION OF AN ATOM (USE LEFT AND BOTTOM SCALES"
2530 PRINT " FOR COORDINATES)."
2540 PRINT
2550 PRINT " WRONG GUESS SCORES -5."
2560 PRINT " CORRECT GUESS SCORES +10."
2570 PRINT
2580 PRINT " B. END THE GAME AND PEEK AT THE LOCATION OF THE ATOMS."
2590 PRINT
2600 PRINT "ENJOY."
2610 PRINT
2620 INPUT;"PRESS ANY KEY TO CONTINUE.",ANS$
2630 CLS
2640 RETURN
BLCKJACK.BAS
10 KEY OFF:CLS
20 SCREEN 0
30 WIDTH 40
40 PRINT"░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░"
50 PRINT"░┌───────────────────────────────────┐░"
60 PRINT"░│ │░"
70 PRINT"░│ 2056-A.BAS │░"
80 PRINT"░│ BLACKJACK │░"
90 PRINT"░│ │░"
100 PRINT"░│ │░"
110 PRINT"░│ BROUGHT TO YOU BY THE MEMBERS OF │░"
120 PRINT"░│ ▄▄▄▄▄ ▄▄▄▄▄ ▄▄▄▄▄ ▄▄▄▄▄ │░"
130 PRINT"░│ █ █ █ █ █ █ │░"
140 PRINT"░│ █ █▄▄▄█ █ █ █ │░"
150 PRINT"░│ █ █ █ █ █ │░"
160 PRINT"░│ ▄▄█▄▄ █ █▄▄▄▄ █▄▄▄█ │░"
170 PRINT"░│ │░"
180 PRINT"░│ International PC Owners │░"
190 PRINT"░│ │░"
200 PRINT"░│P.O. Box 10426, Pittsburgh PA 15234│░"
210 PRINT"░│ │░"
220 PRINT"░└───────────────────────────────────┘░"
230 PRINT"░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░"
240 PRINT
250 PRINT " PRESS ANY KEY TO CONTINUE
260 A$=INKEY$: IF A$="" THEN 260
270 WIDTH 80
280 CLS
1000 REM ** CCII BLACKJACK - JAN 3,78 - JESSEN **
1010 REM ADAPTED TO PC BY PATRICK LEABO--TUCSON
1015 REM
1020 SCREEN 0:COLOR 7,0:WIDTH 80:KEY OFF:LOCATE ,,0
1025 SND = 1:KEY 10,"":ON KEY (10) GOSUB 3800 :KEY (10) ON
1030 COMMON MENU:RANDOMIZE VAL(RIGHT$(TIME$,2))
1040 CLS:GOSUB 3440:Z7= RND (1):GOSUB 3250:Y= 1:COLOR 7,0
1050 LOCATE 7,7:PRINT "WELCOME TO...";:PRINT "BLACKJACK!"
1060 K= 0:W1= 0:R= RND (1):N= INT (1945* RND (1)+ 1):X= INT (10* RND (1))
1070 DIM D(52),E(5),V(5),T(5),W(5),T$(34),Q(52)
1080 FOR A= 1 TO 52:D(A)= 0:NEXT
1090 FOR A= 0 TO 39 STEP 13:FOR C= 1 TO 13:Q(A+ C)= C:NEXT C,A
1100 K= K+ 1:FOR P= 1 TO 5:E(P)= 0:V(P)= 0:T(P)= 0:NEXT :V(3)= 1
1110 LOCATE 9,2:GOSUB 3580
1120 LOCATE 23,54:PRINT STRING$(26," ")
1130 LOCATE 21,54:PRINT STRING$(26," ")
1140 LOCATE 9,3:PRINT STRING$(50," ")
1150 LOCATE 21,54:IF W1= 0 THEN GOSUB 3110
1160 IF W1> 0 THEN GOSUB 3090
1170 IF W1< 0 THEN GOSUB 3100
1180 GOSUB 3640:LOCATE 22,55:PRINT"WAGER $ "
1190 LOCATE 22,62:LINE INPUT W$:P=1
1200 IF W$= "END" OR W$="end" THEN CHAIN "MENU",1000
1210 W= VAL (W$):LOCATE 1,1
1220 IF W< = 500 THEN 1240:REM
1230 LOCATE 23,55:PRINT "HOUSE LIMIT IS $500";:GOSUB 3610:GOTO 1110
1240 IF W> 0 THEN 1260
1250 LOCATE 23,58:PRINT "BE SERIOUS";:GOSUB 3220:GOTO 1110
1260 IF W< 1 THEN 1290
1270 HP= HP+ 1
1280 GOTO 1320
1290 LOCATE 23,58
1300 PRINT "CHEAPSKATE";
1310 GOSUB 3610:GOTO 1110
1320 Q3= W
1330 IF Q3< 250 THEN 1350
1340 Q3= INT (Q3/ 10)
1350 FOR A4= 1 TO Q3:X= RND (1):NEXT :W(2)= W:W(3)= W:GOTO 1380
1360 TE= 0:NT= 0:LOCATE 9,14:PRINT "*I AM RESHUFFLING*":GOSUB 3220:GOTO 1110
1370 LOCATE 9,2:PRINT "HOUSE LIMIT IS $500":GOSUB 3610:GOTO 1110
1380 E(5)= 1:GOSUB 3510:GOSUB 2090:IF E(1)= 0 THEN 1400
1390 V(4)= 1
1400 V(5)= 1:E(5)= 2:GOSUB 3510:GOSUB 2090:M= X:P= 3:V(3)= 1
1410 GOSUB 3510:GOSUB 2090:G= X
1420 GOSUB 3690
1430 V(3)= V(3)+ 1
1440 GOSUB 3510:GOSUB 2090:IF V(2)> 0 THEN 1670
1450 S= X
1460 IF V(3)> 2 THEN 1670
1470 IF T(P)< 21 THEN 1570
1480 IF E(P)< 2 THEN 1500
1490 E(P)= E(P)- 1:T(P)= T(P)- 10:GOTO 1570
1500 LOCATE (Y9+ 2),(X9+ 8):PRINT "*BLACKJACK*"
1510 LOCATE 9,10:PRINT "I DEALT WRONG AGAIN!"
1520 E(5)= 2:P= 1:X9= 8:Y9= 3:X= M:GOSUB 2280
1530 IF V(3)< 5 THEN 1550
1540 W1= W1+ 2* W:GOTO 1560
1550 W1= W1+ 1.5* W
1560 GOTO 3000
1570 IF V(4)= 0 THEN 1670
1580 LOCATE 9,15:PRINT SPC( 22);""
1590 LOCATE 9,15:GOSUB 3640:PRINT "INSURANCE ";:COLOR 31,0:PRINT"?";:COLOR 7,0:GOSUB 3660:PRINT
1600 LOCATE 9,3:PRINT STRING$(50," ")
1610 KS$=LEFT$ (I$,1):IF KS$< > "Y" AND KS$<>"y" THEN 1670
1620 IF T(1)< 21 THEN 1650
1630 W1= W1+ W:PRINT
1640 LOCATE 9,8:PRINT "YOU WIN $";W/ 2;" ON INSURANCE":GOTO 1670
1650 W1= W1- W/ 2:PRINT
1660 LOCATE 9,8:PRINT "YOU LOST $";W/ 2;" ON INSURANCE"
1670 IF T(1)< 21 THEN 1720
1680 IF E(1)< 2 THEN 1700
1690 E(1)= E(1)- 1:T(1)= T(1)- 10:GOTO 1720
1700 LOCATE 9,22:PRINT "**I HAVE BLACKJACK**"
1710 X9= 8:Y9= 3:E(5)= 2:P= 1:X= M:GOSUB 2280:P= 3:GOTO 2910
1720 IF T(P)< = 21 THEN 1780
1730 IF E(P)> 0 THEN 1770
1740 LOCATE 9,16:PRINT "**YOU BUST**"
1750 GOSUB 3560:C1= T(P)- 5* (INT (T(P)/ 5)):IF V(2)= 1 THEN 1990
1760 GOTO 2690
1770 E(P)= E(P)- 1:T(P)= T(P)- 10
1780 IF V(1)= 2 THEN 1750
1790 IF V(3)> 4 THEN 1810
1800 GOTO 1820
1810 IF T(P)< 21 THEN 3230
1820 LOCATE (Y9+ 2),(X9+ 8):GOSUB 3640:COLOR 31,0:PRINT "PLAY ";:COLOR 7,0:GOSUB 3660
1830 V(1)= 0
1840 KS$= LEFT$ (I$,1):IF KS$= "H" OR KS$="h" THEN V(1)= 1:GOTO 1870
1850 IF KS$= "D" OR KS$="d" THEN V(1)= 2:GOTO 1870
1860 IF KS$= "S" OR KS$="s" THEN V(1)= 3:GOTO 1870
1865 IF KS$ <> "0" THEN BEEP :GOTO 1820
1870 LOCATE (Y9+ 2),(X9+ 8):PRINT " "
1880 IF V(1)< 3 THEN 2030
1890 IF V(2)> 0 THEN 2020
1900 IF V(3)> 2 THEN 2020
1910 IF Q(G)= Q(S)THEN 1940
1920 LOCATE 9,22:PRINT "THAT'S NO PAIR":GOSUB 3610
1930 LOCATE 9,22:PRINT " ":GOTO 1820
1940 V(2)= 1:IF Q(G)< 1 THEN 1960
1950 V(1)= 0
1960 T(3)= 0:T(2)= 0:P= 2:X9= 2:Y9= 19:GOSUB 3550
1970 X= S:GOSUB 2280:GOSUB 1980:P= 3:W(3)= W:X= G:GOSUB 1980:GOTO 1440
1980 GOSUB 2230:V(3)= 2:T(P)= C:RETURN
1990 P= 2:V(2)= 2:V(3)= 2:IF Q(G)< 1 THEN 2010
2000 V(1)= 0
2010 GOTO 1440
2020 LOCATE 9,22:PRINT "NO SPLITS NOW ":GOSUB 3610:LOCATE 9,22:PRINT" ":GOTO 1820
2030 IF V(1)< 2 THEN 2070
2040 IF V(3)= 2 THEN 2060
2050 LOCATE 9,22:PRINT "TOO LATE TO DOUBLE":GOSUB 3610:LOCATE 9,22:PRINT" ":GOTO 1820
2060 W(P)= 2* W(P)
2070 IF V(1)> 0 THEN 1430
2080 GOTO 1750
2090 GOSUB 2120:T(P)= T(P)+ C:IF V(5)= 0 THEN 2110
2100 V(5)= 0:RETURN
2110 GOSUB 2280:RETURN
2120 IF R> = 50 THEN 2170
2130 X= INT (53* RND (Y))
2140 IF X= 0 THEN 2130
2150 IF D(X)= 0 THEN 2210
2160 R= R+ 1:IF R< 50 THEN 2120
2170 FOR A= 1 TO 52:IF D(A)= K THEN 2190
2180 D(A)= 0
2190 NEXT
2200 TE= 0:NT= 0:R= 0:LOCATE 9,18:PRINT "*I RESHUFFLED*":GOSUB 3610:LOCATE 9,18:PRINT" ":GOTO 2120
2210 R= 0
2220 D(X)= K
2230 IF Q(X)> 1 THEN 2250
2240 C= 11:E(P)= E(P)+ 1:RETURN
2250 IF Q(X)> 10 THEN 2270
2260 C= Q(X):RETURN
2270 C= 10:RETURN
2280 GOSUB 2290:RETURN
2290 FOR I= 0 TO 34:T$(I)= " ":NEXT
2300 IF X> 39 THEN U$=CHR$ (5):GOTO 2340
2310 IF X> 26 THEN U$= CHR$ (3):GOTO 2340
2320 IF X> 13 THEN U$= CHR$(4):GOTO 2340
2330 U$= CHR$ (6)
2340 COLOR 0,7
2350 ON Q(X) GOTO 2540,2530,2520,2510,2490,2470,2460,2450,2440,2420,2380,2370
2360 T$(17)= "K":GOTO 2390
2370 T$(17)= "Q":GOTO 2390
2380 T$(17)= "J"
2390 T$(8)= U$:T$(7)= U$:T$(6)= U$:T$(11)= U$:T$(16)= U$
2400 T$(21)= U$:T$(26)= U$:T$(27)= U$:T$(28)= U$:T$(23)= U$
2410 T$(18)= U$:T$(13)= U$:GOTO 2550
2420 T$(6)= U$:T$(8)= U$:T$(16)= U$:T$(18)= U$:T$(26)= U$
2430 T$(28)= U$:GOTO 2510
2440 T$(7)= U$:T$(27)= U$:GOTO 2460
2450 T$(12)= U$:T$(22)= U$:GOTO 2470
2460 T$(17)= U$
2470 T$(6)= U$:T$(8)= U$:T$(16)= U$:T$(18)= U$:T$(26)= U$
2480 T$(28)= U$:GOTO 2550
2490 T$(6)= U$:T$(8)= U$:T$(17)= U$:T$(26)= U$:T$(28)= U$
2500 GOTO 2550
2510 T$(11)= U$:T$(13)= U$:T$(21)= U$:T$(23)= U$:GOTO 2550
2520 T$(7)= U$:T$(17)= U$:T$(27)= U$:GOTO 2550
2530 T$(12)= U$:T$(22)= U$:GOTO 2550
2540 T$(17)= U$
2550 IF Q(X)> 1 AND Q(X)< 11 THEN T$= RIGHT$ (STR$ (Q(X)),1)
2560 IF Q(X)= 11 THEN T$= "J"
2570 IF Q(X)= 12 THEN T$= "Q"
2580 IF Q(X)= 13 THEN T$= "K"
2590 IF Q(X)= 1 THEN T$= "A"
2600 IF X> 13 AND X< 40 THEN T$= T$
2610 IF Q(X)< > 10 GOTO 2640
2620 T$= LEFT$(U$,1):M$= RIGHT$ (STR$ (0),1):N$= RIGHT$ (STR$ (1),1)
2630 T$(0)= N$:T$(1)= M$:T$(33)= T$(0):T$(34)= T$(1):GOTO 2650
2640 T$(0)= T$:T$(34)= T$
2650 Z9= Y9+ 5:X1= X9:Y1= Y9:REM GOSUB 64000:GOSUB 3000
2660 NT= NT+ 1:IF Q(X)> 9 THEN TE= TE+ 1
2670 FOR I= 0 TO 30 STEP 5:LOCATE Z9-I/5,X9+2:FOR J= 0 TO 4:PRINT T$(I+ J);:NEXT J
2680 NEXT I:COLOR 7,0:RETURN
2690 P= 3:X= M:X9= 8:Y9= 3:GOSUB 2290
2700 IF T(3)< 22 THEN 2730
2710 IF V(2)= 0 THEN 2910
2720 GOTO 2910
2730 P= 1
2740 IF T(1)< 17 THEN 3020
2750 IF T(1)> 17 THEN 2770
2760 IF E(1)> 0 THEN 3020
2770 IF T(1)> 21 THEN 3030
2780 P= 3
2790 LOCATE 5,(X9+ 7):PRINT "TOTAL":LOCATE 7,(X9+ 7):PRINT T(1);
2800 IF T(P)> 21 THEN 2840
2810 IF T(1)> 21 THEN 2840
2820 IF T(1)> T(P)THEN 2910
2830 IF T(1)= T(P)THEN 2980
2840 W1= W1+ W(P):PRINT :LOCATE 9,2
2850 FOR J= 1 TO 50:PRINT " ";:NEXT :PRINT :LOCATE 9,12
2860 IF C1> 3 THEN 3120
2870 IF C1> 2 THEN 3130
2880 IF C1> 1 THEN 3140
2890 IF C1> 0 THEN 3150
2900 GOTO 3160
2910 W1= W1- W(P):PRINT :LOCATE 9,2
2920 FOR J= 1 TO 50:PRINT " ";:NEXT :PRINT :LOCATE 9,12
2930 IF C1> 3 THEN 3170
2940 IF C1> 2 THEN 3180
2950 IF C1> 1 THEN 3190
2960 IF C1> 0 THEN 3200
2970 GOTO 3210
2980 LOCATE 9,24:PRINT "WE PUSH"
2990 IF V(2)> 0 THEN 3010
3000 GOSUB 3060:GOSUB 3610:GOTO 1100
3010 P= 3:V(2)= 0:GOTO 2800
3020 E(5)= E(5)+ 1:P= 1:GOSUB 3510:GOSUB 2090:GOTO 2730
3030 IF E(1)= 0 THEN 3050
3040 E(1)= E(1)- 1:T(1)= T(1)- 10:GOTO 2730
3050 LOCATE 6,(X9+ 13):PRINT "*I BUST*":GOTO 2780
3060 LOCATE 9,25:RETURN
3070 IF W1< 0 THEN 3100
3080 IF W1= 0 THEN 3110
3090 PRINT "YOU'RE AHEAD $";W1;:RETURN
3100 PRINT "YOU'RE BEHIND $";- W1;:RETURN
3110 PRINT "YOU'RE EVEN ";:RETURN
3120 PRINT "I MUST HAVE DEALT WRONG":GOTO 2990
3130 PRINT "YOU'RE LUCKY AGAIN":GOTO 2990
3140 PRINT "YOU MUST HAVE BEEN PEEKING":GOTO 2990
3150 PRINT "I COULD LOSE MY JOB THIS WAY":GOTO 2990
3160 PRINT "THE CARDS HAVE TURNED AGAINST ME":GOTO 2990
3170 PRINT "*THE BOTTOM OF THE DECK STRIKES AGAIN*":GOTO 2990
3180 PRINT "A VICTORY FOR US GOOD GUYS":GOTO 2990
3190 PRINT "YOU CAN'T BEAT SKILL":GOTO 2990
3200 PRINT "YOU CAN'T WIN THEM ALL":GOTO 2990
3210 PRINT "THANKS!":GOTO 2990
3220 FOR M9= 1 TO 52:D(M9)= 0:NEXT :R= 0:RETURN
3230 LOCATE 9,12:PRINT "*YOU WIN WITH 5 CARDS*":PRINT :GOTO 1520
3240 REM DRAW INSTRUCTIONS
3250 COLOR 0,7
3260 FOR N=2 TO 18:LOCATE N,54:PRINT STRING$(26," "):NEXT
3270 LOCATE 2,58:PRINT "IBM PC BLACKJACK";
3280 LOCATE 3,60:PRINT"************"
3290 LOCATE 4,55:PRINT"FOLLOW ALL BETS WITH"
3300 LOCATE 5,60:PRINT"RETURN KEY"
3310 LOCATE 7,55:PRINT"RESPONSES:"
3320 LOCATE 8,57:PRINT"<CR> = STAND":LOCATE 9,60:PRINT"H = HIT"
3330 LOCATE 10,60:PRINT"D = DOUBLE DOWN":LOCATE 11,60:PRINT"S = SPLIT PAIR"
3340 LOCATE 12,58:PRINT"INSURANCE:"
3350 LOCATE 13,60:PRINT"N = NO":LOCATE 14,60:PRINT"Y = YES"
3360 LOCATE 15,63:PRINT"RULES:"
3370 LOCATE 16,54:PRINT"HOUSE LIMIT IS $500.00"
3380 LOCATE 17,54:PRINT"BLACKJACK PAYS 1.5 TO 1"
3390 LOCATE 18,54:PRINT;"BET END TO QUIT";:COLOR 7,0
3400 ME$="HOUSE":FOR YP=1 TO YP+LEN(ME$):LOCATE YP+1,2:PRINT MID$(ME$,YP,1):NEXT
3410 ME$="PLAYER":FOR YP=1 TO YP+LEN(ME$):LOCATE YP+9,2:PRINT MID$(ME$,YP,1):NEXT
3420 RETURN
3430 REM DRAW FIELD
3440 LOCATE 1,1:PRINT"╒";STRING$(51,"═");"╤";STRING$(26,"═");"╕";
3450 LOCATE 2,1:FOR N=1 TO 22:PRINT"│"TAB(53);"│";TAB(80);"│";:NEXT
3460 LOCATE 24,1:PRINT"│";:LOCATE 24,53:PRINT"│";
3470 LOCATE 25,1:PRINT"╘";STRING$(51,"═");"╧";STRING$(26,"═");
3480 DEF SEG=&HB000:POKE 3998,190:POKE 3838,179:DEF SEG
3490 LOCATE 19,53:PRINT"╞══════════════════════════╡"
3500 LOCATE 1,1:RETURN
3510 ON P GOTO 3520,3530,3540
3520 X9= INT (2+ E(5)* 6- 6):Y9= 3:GOTO 3550
3530 X9= INT (2+ V(3)* 6- 6):Y9= 19:GOTO 3550
3540 X9= INT (2+ V(3)* 6- 6):Y9= 11
3550 RETURN
3560 LOCATE (Y9+ 0),(X9+ 7):PRINT "TOTAL";
3570 LOCATE (Y9+ 3),(X9+ 7):PRINT T(P);:RETURN
3580 FOR N=1 TO 7:LOCATE N+1,3:PRINT STRING$(50," "):NEXT
3590 FOR N=0 TO 15:LOCATE N+9,3:PRINT STRING$(50," ");:NEXT
3600 RETURN
3610 FOR P1= 1 TO 1000:NEXT P1:RETURN
3620 REM PLINK
3630 IF SND = 1 THEN PLAY "L64T200N46":REM PLINK
3635 RETURN
3640 REM PLONK
3650 IF SND = 1 THEN PLAY "L64T200N70":REM PLONK
3655 RETURN
3660 REM KEYSTROKE
3670 I$=INKEY$:IF I$=""THEN 3670 ELSE IF I$= CHR$(13) THEN I$= "0":RETURN
3680 RETURN
3690 REM BACK OF CARD
3700 COLOR 0,7:CB$= "╬╬╬╬╬"
3710 GOSUB 3620
3720 X1= 10:Y1= 1:FOR NN= 7 TO 1 STEP - 1
3730 LOCATE Y1+NN,X1:PRINT CB$:NEXT :COLOR 7,0:RETURN
3800 REM toggle sound on or off with F10
3810 IF SND = 1 THEN SND = 0 ELSE SND=1
3820 RETURN
CRC.TXT
PC-SIG Disk No. #72, version v1
The following is a list of the file checksums which should be produced by
the CRCK4 program on disk #9 (and others). If the CRC numbers do not match
you may have a bad file. To use type: CRCK4 <filespec>
CRCK4 output for this disk:
CRCK ver 4.2B (MS DOS VERSION )
CTL-S pauses, CTL-C aborts
--> FILE: TICTACTO.BAS CRC = 38 7C
--> FILE: OTHELLO .BAS CRC = 21 B1
--> FILE: RUBIK .BAS CRC = B0 3B
--> FILE: DOCTOR .BAS CRC = 91 4C
--> FILE: MEMORY .BAS CRC = ED 48
--> FILE: ROADRALY.BAS CRC = 23 EA
--> FILE: BLCKJACK.BAS CRC = 65 4A
--> FILE: BLACKBOX.BAS CRC = DE 0D
--> FILE: FIFTEEN .BAS CRC = C3 29
--> FILE: ELIZA .BAS CRC = C3 2F
--> FILE: SPELLER .BAS CRC = 1A A3
---------------------> SUM OF CRCS = 91 38
DONE
These and other Public Domain and user-supported programs from:
PC Software Interest Group
1125 Stewart Ct Suite G
Sunnyvale, CA 94086
(408) 730-9291
DOCTOR.BAS
100 ' DOCTOR, Version PC2.1
110 CLEAR 1000: KEY OFF
120 ' Written by Joseph Weizenbaum - as described in the book "EXPERIMENTS
130 ' IN ARTIFICAL INTELLIGENCE FOR SMALL COMPUTERS" by John Krutch
140 ' Library of Congress catalog card number: 80-53270
150 ' Program has been modified by Jeff Sussman in the following ways:
160 ' 1) To work using IBM PERSONAL COMPUTER BASIC
170 ' 2) To use INSTR function to greatly decrease execution time
180 ' 3) To convert all input to uppercase
190 ' 4) To allow input of non-punctuated or punctuated sentences
200 DEF FNUP$(A$)=CHR$(ASC(A$+" ")+ABS(A$>="a" AND A$<="z")*(ASC("A")-ASC("a")))
210 ' Supervisor
220 GOSUB 290 ' Initialization
230 GOSUB 360 ' Input (and associated functions)
240 GOSUB 480 ' Swap word for opposite form
250 GOSUB 640 ' Keyword processing
260 GOSUB 1140 ' Marker remover
270 GOSUB 1200 ' Doctor's reply
280 GOTO 230
290 ' Initialization
300 NM = 28
310 NU = 82
320 RANDOMIZE 100*VAL(MID$(TIME$,1,2))+VAL(MID$(TIME$,4,2))
330 CLS: PRINT: PRINT
340 PRINT "PLEASE STATE YOUR PROBLEM."
350 RETURN
360 ' Input (and associated functions)
370 RESTORE
380 X = 0 : PA$= ""
390 CSRSAVE=CSRLIN:LOCATE 25,1: PRINT " ";: LOCATE CSRSAVE,1
400 LINE INPUT ":";PA$: IF INSTR(".?!",RIGHT$(PA$,1)) = 0 THEN PA$ = PA$ + "."
410 CSRSAVE=CSRLIN:LOCATE 25,1:COLOR 31: PRINT "ANALYZING";: LOCATE CSRSAVE,1: COLOR 7
420 FOR Z=1 TO LEN(PA$):MID$(PA$,Z,1)=FNUP$(MID$(PA$,Z,1)):NEXT Z:
430 IF PA$ = "" THEN PRINT "DO YOU HAVE A PROBLEM?": X = 1: GOTO 470
440 IF PA$ = PR$ THEN PRINT "PLEASE DON'T REPEAT YOURSELF!": X = 1: GOTO 470
450 PR$ = PA$
460 PA$ = " " + LEFT$(PA$, LEN(PA$) - 1) + " "
470 RETURN
480 ' Swap word for opposite form
490 IF X = 1 THEN 630
500 FOR I = 1 TO NM/2
510 READ TE$, TN$
520 PS=INSTR(PA$, TE$)
530 IF PS <> 0 THEN PA$ = LEFT$(PA$, PS -1) + TN$ + MID$(PA$, PS + LEN(TE$))
540 DATA " MOM "," MOTHER "," DAD "," FATHER "
550 DATA " DREAMS "," DREAM "
560 DATA " I "," YOU@ "," YOU "," I "," ME "," YOU "
570 DATA " MY "," YOUR* "
580 DATA " YOUR "," MY "," MYSELF "," YOURSELF* "
590 DATA " YOURSELF "," MYSELF "
600 DATA " I'M "," YOU'RE* "," YOU'RE "," I'M "," AM "," ARE@ "
610 DATA " WERE "," WAS "
620 NEXT I
630 RETURN
640 ' Keyword processing
650 ' A. Checking for keywords
660 IF X = 1 THEN 1130
670 FOR I = 1 TO NU
680 READ KE$, JU
690 PS=INSTR(PA$, KE$)
700 IF PS <> 0 THEN DR$ = MID$(PA$, PS + LEN(KE$)): IF DR$ <> "" THEN 730 ELSE 1130
710 NEXT I
720 GOTO 1020
730 DR$ = LEFT$(DR$, LEN(DR$) - 1): GOTO 1130
740 DATA "COMPUTER",1,"MACHINE",1
750 DATA " NAME ",2,"ALIKE",3," LIKE ",3," SAME ",3
760 DATA "YOU@ REMEMBER",4,"DO I REMEMBER",5,"YOU@ DREAMED",6
770 DATA " DREAM ",7," IF ",8,"EVERYBODY",9,"EVERYONE",9
780 DATA "NOBODY",9,"NO ONE",9,"WAS YOU@",10,"YOU@ WAS",11
790 DATA "WAS I",12,"YOUR* MOTHER",13,"YOUR* FATHER",13
800 DATA "YOUR* SISTER",13,"YOU* BROTHER",13,"YOUR* WIFE",13
810 DATA "YOUR* HUSBAND",13,"YOUR* CHILDREN",13,"YOUR*",14
820 DATA "ALWAYS",15,"ARE I",16,"ARE@ YOU",18," HOW ",25
830 DATA "BECAUSE",19,"CAN I",20,"CAN YOU@",21,"CERTAINLY",22
840 DATA "DEUTSCH",23,"ESPANOL",23,"FRANCAIS",23,"HELLO",24
850 DATA "I REMIND YOU OF",3,"I ARE",26,"I'M",26
860 DATA "ITALIANO",23,"MAYBE",28," MY ",29," NO ",30
870 DATA "PERHAPS",28,"SORRY",31,"WHAT ",25,"WHEN ",25
880 DATA "WHY DON'T I",32,"WHY CAN'T YOU@",33,"YES",22
890 DATA "YOU@ WANT",34,"YOU@ NEED",34," ARE ",17," I ",27
900 DATA "YOU@ ARE@ SAD",35,"YOU'RE* SAD",35
910 DATA "YOU@ ARE@ UNHAPPY",35,"YOU'RE* UNHAPPY",35
920 DATA "YOU@ ARE@ DEPRESSED",35,"YOU'RE* DEPRESSED",35
930 DATA "YOU@ ARE@ SICK",35,"YOU'RE* SICK",35
940 DATA "YOU@ ARE@ HAPPY",36,"YOU'RE* HAPPY",36
950 DATA "YOU@ ARE@ ELATED",36,"YOU'RE* ELATED",36
960 DATA "YOU@ ARE@ GLAD",36,"YOU'RE* GLAD",36
970 DATA "YOU@ ARE@ BETTER",36,"YOU'RE* BETTER",36
980 DATA "YOU@ FEEL YOU@",37,"YOU@ THINK YOU@",37
990 DATA "YOU@ BELIEVE YOU@",37,"YOU@ WISH YOU@",37
1000 DATA " YOU@ ARE@",38,"YOU'RE*",38,"YOU@ CAN'T",39
1010 DATA "YOU@ CANNOT",39,"YOU@ DON'T",40,"YOU@ FEEL",41
1020 ' B. No keywords found
1030 IF YO$ = "" THEN 1040 ELSE RAN = INT(RND*5+1): ON RAN GOTO 1040, 1040, 1040, 1090, 1090
1040 RAN = INT(RND*4+1): ON RAN GOTO 1050, 1060, 1070, 1080
1050 PRINT "I AM NOT SURE I UNDERSTAND YOU FULLY.": X = 1: GOTO 1130
1060 PRINT "PLEASE GO ON.": X = 1: GOTO 1130
1070 PRINT "WHAT DOES THAT SUGGEST TO YOU?": X = 1: GOTO 1130
1080 PRINT "DO YOU FEEL STRONGLY ABOUT DISCUSSING SUCH THINGS?":X = 1:GOTO 1130
1090 RAN = INT(RND*3+1): ON RAN GOTO 1100, 1110, 1120
1100 PRINT "LET'S DISCUSS FURTHER WHY YOUR" + YO$ + ".": X = 1: GOTO 1130
1110 PRINT "EARLIER YOU SAID YOUR" + YO$ + ".": X = 1: GOTO 1130
1120 PRINT "DOES THAT HAVE ANYTHING TO DO WITH THE FACT THAT YOUR" + YO$ + "?": X = 1: GOTO 1130
1130 RETURN
1140 ' Marker remover
1150 IF X = 1 THEN 1190
1160 FOR PS = 1 TO LEN(DR$)
1170 IF MID$(DR$, PS, 1) = "@" OR MID$(DR$, PS, 1) = "*" THEN DR$ = LEFT$(DR$, PS - 1) + MID$(DR$, PS + 1)
1180 NEXT PS
1190 RETURN
1200 ' Doctor's reply
1210 ' A. Line to jump to
1220 IF X = 1 THEN 1700
1230 ON JU GOTO 1250,1260,1270,1280,1290,1300,1310,1320,1330,1340,1350,1360, 1370,1380,1390,1400,1410,1420,1430,1440,1450,1460,1470,1480,1490,1500,1510, 1520,1530,1540,1550,1600,1610,1620,1630,1640,1650,1660,1670,1680,1690
1240 ' B. Replies
1250 PRINT "DO COMPUTERS WORRY YOU?": GOTO 1700
1260 PRINT "I AM NOT INTERESTED IN NAMES.": GOTO 1700
1270 PRINT "IN WHAT WAY?": GOTO 1700
1280 PRINT "DO YOU OFTEN THINK OF" + DR$ + "?": GOTO 1700
1290 PRINT "DID YOU THINK I WOULD FORGET" + DR$ + "?": GOTO 1700
1300 PRINT "REALLY, " + DR$ + "?": GOTO 1700
1310 PRINT "WHAT DOES THAT DREAM SUGGEST TO YOU?": GOTO 1700
1320 PRINT "DO YOU THINK ITS LIKELY THAT IF " + DR$ + "?": GOTO 1700
1330 PRINT "REALLY, " + KE$ + "?": GOTO 1700
1340 PRINT "WHAT IF YOU WERE" + DR$ + "?": GOTO 1700
1350 PRINT "WERE YOU REALLY?": GOTO 1700
1360 PRINT "WOULD YOU BELIEVE I WAS" + DR$ + "?": GOTO 1700
1370 PRINT "TELL ME MORE ABOUT YOUR FAMILY.": GOTO 1700
1380 PRINT "YOUR" + DR$ + ".": GOSUB 1710: GOTO 1700
1390 PRINT "CAN YOU THINK OF A SPECIFIC EXAMPLE?": GOTO 1700
1400 PRINT "WHY ARE YOU INTERESTED IN WHETHER I AM" + DR$ + " OR NOT?": GOTO 1700
1410 PRINT "DID YOU THINK THEY MIGHT NOT BE " + DR$ + "?": GOTO 1700
1420 PRINT "DO YOU BELIEVE YOU ARE" + DR$ + "?": GOTO 1700
1430 PRINT "IS THAT THE REAL REASON?": GOTO 1700
1440 PRINT "YOU BELIEVE I CAN" + DR$ + ", DON'T YOU?": GOTO 1700
1450 PRINT "WHETHER OR NOT YOU CAN" + DR$ + "DEPENDS ON MORE THAN ME.": GOTO 1700
1460 PRINT "YOU SEEM QUITE POSITIVE.": GOTO 1700
1470 PRINT "I AM SORRY, I SPEAK ONLY ENGLISH.": GOTO 1700
1480 PRINT "HOW DO YOU DO.": GOTO 1700
1490 PRINT "WHY DO YOU ASK?": GOTO 1700
1500 PRINT "WHAT MAKES YOU THINK I AM" + DR$ + "?": GOTO 1700
1510 PRINT "WE WERE DISCUSSING YOU, NOT ME.": GOTO 1700
1520 PRINT "YOU DON'T SEEM QUITE CERTAIN.": GOTO 1700
1530 PRINT "WHY ARE YOU CONCERNED OVER MY " + DR$ + "?": GOTO 1700
1540 PRINT "ARE YOU SAYING 'NO' JUST TO BE NEGATIVE?": GOTO 1700
1550 RAN = INT(RND*4+1): ON RAN GOTO 1560, 1570, 1580, 1590
1560 PRINT "PLEASE DON'T APOLOGIZE.": GOTO 1700
1570 PRINT "APOLOGIES ARE NOT NECESSARY.": GOTO 1700
1580 PRINT "WHAT FEELINGS DO YOU HAVE WHEN YOU APOLOGIZE?": GOTO 1700
1590 PRINT "YOU NEEDN'T FEEL THAT YOU HAVE TO APOLOGIZE.": GOTO 1700
1600 PRINT "DO YOU BELIEVE I DON'T" + DR$ + "?": GOTO 1700
1610 PRINT "DO YOU THINK YOU SHOULD BE ABLE TO" + DR$ + "?": GOTO 1700
1620 PRINT "WHAT WOULD IT MEAN TO YOU IF YOU GOT" + DR$ + "?": GOTO 1700
1630 GOSUB 1740: GOSUB 1770: PRINT "I AM SORRY TO HEAR YOU ARE" + DR$ + ".": GOTO 1700
1640 GOSUB 1740: GOSUB 1770: PRINT "HOW HAVE I HELPED YOU TO BE" + DR$ + "?": GOTO 1700
1650 PRINT "DO YOU REALLY THINK SO?": GOTO 1700
1660 PRINT "IS IT BECAUSE YOU ARE" + DR$ + " THAT YOU CAME TO ME?": GOTO 1700
1670 PRINT "HOW DO YOU KNOW YOU CAN'T" + DR$ + "?": GOTO 1700
1680 PRINT "DON'T YOU REALLY" + DR$ +"?": GOTO 1700
1690 PRINT "TELL ME MORE ABOUT SUCH FEELINGS.": GOTO 1700
1700 RETURN
1710 ' Special processing if keyword is MY
1720 IF LEN(DR$) > 11 THEN YO$ = DR$
1730 RETURN
1740 ' Remove "@" marker from key phrase if present
1750 IF MID$(KE$, 4, 1) = "@" THEN DR$ = RIGHT$(KE$, LEN(KE$) - 9)
1760 RETURN
1770 ' Remove "*" marker from key phrase if present
1780 IF MID$(KE$, 7, 1) = "*" THEN DR$ = RIGHT$(KE$, LEN(KE$) - 7)
1790 RETURN
ELIZA.BAS
10 REM
20 REM
30 REM
40 REM
50 REM
60 REM
70 REM
80 REM
90 REM
100 REM
110 REM
120 REM
130 REM
140 REM
150 REM
160 REM
170 REM
180 REM
190 REM
200 REM
210 PRINT " ______ "
220 PRINT " / /\ "
230 PRINT " / / \ "
240 PRINT " / / \ "
250 PRINT " / /\ \ "
260 PRINT " / / \ \ "
270 PRINT " INFOTRAN TELERESOURCE "
280 PRINT " / / \ \ "
290 PRINT " / / \ \ "
300 PRINT " / /_ _ _ _ _ \ \ "
310 PRINT " \ / \ / "
320 PRINT " \ / \ / "
330 PRINT " \/_ _ _ _ _ _ _ _ \/ "
340 PRINT " "
350 PRINT " A DIVISION OF INFOTRAN CORP."
360 PRINT " HOUSTON, TEXAS"
370 PRINT ""
380 PRINT " COPYRIGHT (C) INFOTRAN CORP. 1983"
390 FOR I = 1 TO 5 : PRINT : NEXT I
400 FOR I = 1 TO 2000
410 NEXT I
420 FOR I = 1 TO 24
430 PRINT
440 NEXT I
450 PRINT " *** NOW on THE SOURCE ***"
460 PRINT ""
470 PRINT " GREAT PROGRAMS YOU CAN DOWNLOAD "
480 PRINT " INTO YOUR COMPUTER ... IMMEDIATELY"
490 PRINT ""
500 PRINT " ****************************************"
510 PRINT " ADVENTURES --- GAMES --- BUSINESS"
520 PRINT " EDUCATION --- SCIENCE --- MATH"
530 PRINT ""
540 PRINT " SOFTWARE AVAILABLE FOR MOST COMPUTERS"
550 PRINT " ****************************************"
560 PRINT ""
570 PRINT " DON'T LEAVE HOME..."
580 PRINT " SAVE ON GREAT SOFTWARE..."
590 PRINT " USE TELERESOURCE ..."
600 PRINT ""
610 PRINT " TO ACCESS TELERESOURCE:"
620 PRINT " AT COMMAND LEVEL ON THE SOURCE,"
630 PRINT " -------------------------------"
640 PRINT " TYPE: CO SFILES>ST3899>SOFTWARE"
650 PRINT " -------------------------------"
660 PRINT ""
670 PRINT " CONTINUE - PRESS RETURN";
680 INPUT Q$
690 FOR I = 1 TO 24
700 PRINT
710 NEXT I
720 ' ELIZA/DOCTOR
730 ' CREATED BY JOESEPH WEIZENBAUM
740 ' THIS VERSION BY JEFF SHRAGER
750 ' EDITED AND MODIFIED FOR IBM-PC BASICA A BY WILBUR STREETT
760 ' 1806 PITNEY STREET, OCEAN, NJ, 07712, 531-3790
770 '
780 ' ----------INITIALAZATION-----------
790 DIM C$(72),I$(72),K$(72),F$(72),S$(72),R$(72),P$(72),Z$(72)
800 DIM S(36),R(36),N(36)
810 N1=36:N2=12:N3=112
820 FOR X=1 TO N1+N2+N3:READ Z$:NEXT X:REM SAME AS RESTORE
830 FOR X=1 TO N1
840 READ S(X),L:R(X)=S(X):N(X)=S(X)+L-1
850 NEXT X
860 PRINT "HI! I'M ELIZA. WHAT'S YOUR PROBLEM?"
870 REM
880 REM ------- USER INPUT SECTION----------
890 REM
900 LINE INPUT I$
910 I$=" "+I$+" " ' GET RID OF APOSTROPHES
920 FOR L=1 TO LEN(I$)
930 IF MID$(I$,L,1)="'" THEN I$=LEFT$(I$,L-1)+RIGHT$(I$,LEN(I$)-L):GOTO 930
940 IF L+4<=LEN(I$) THEN IF MID$(I$,L,4)="SHUT" THEN PRINT "SHUT UP....":END
950 NEXT L
960 IF I$=P$ THEN PRINT "PLEASE DON'T REPEAT YOURSELF!":GOTO 870
970 REM
980 REM --------FIND KEYWORD IN I$-----
990 REM
1000 RESTORE
1010 S=0
1020 FOR K=1 TO N1
1030 READ K$
1040 IF S>0 THEN 1080
1050 FOR L=1 TO LEN(I$)-LEN(K$)+1
1060 IF MID$(I$,L,LEN(K$))=K$ THEN S=K:T=L:F$=K$
1070 NEXT L
1080 NEXT K:IF S>0 THEN K=S:L=T:GOTO 1110
1090 K=36:GOTO 1310:REM WE DIDN'T FIND ANY KEYWORDS
1100 REM
1110 REM TAKE RIGHT PART OF STRING AND CONJUGATE IT
1120 REM USING THE LIST OF STRINGS TO BE SWAPPED
1130 REM
1140 RESTORE:FOR X=1 TO N1:READ Z$:NEXT X:REM SKIP OVER KEYWORDS
1150 C$=" "+RIGHT$(I$,LEN(I$)-LEN(F$)-L+1)
1160 FOR X=1 TO N2/2
1170 READ S$,R$
1180 FOR L=1 TO LEN(C$)
1190 IF L+LEN(S$)=LEN(C$) THEN 1240
1200 IF MID$(C$,L,LEN(S$))<>S$ THEN 1240
1210 C$=LEFT$(C$,L-1)+R$+RIGHT$(C$,LEN(C$)-L-LEN(S$)+1)
1220 L=L+LEN(R$)
1230 GOTO 1270
1240 IF L+LEN(R$)>LEN(C$) THEN 1270
1250 IF MID$(C$,L,LEN(R$))<>R$ THEN 1270
1260 C$=LEFT$(C$,L-1)+S$+RIGHT$(C$,LEN(C$)-L-LEN(R$)+1)
1270 NEXT L
1280 NEXT X
1290 IF MID$(C$,2,1)=" " THEN C$=RIGHT$(C$,LEN(C$)-1):REM ONLY 1 SPACE
1300 REM
1310 REM NOW USING THE KEYWORD NUMBER (K) GET REPLY
1320 REM
1330 RESTORE:FOR X=1 TO N1+N2:READ Z$:NEXT X
1340 FOR X=1 TO R(K):READ F$:NEXT X:REM READ RIGHT REPLY
1350 R(K)=R(K)+1:IF R(K)>N(K) THEN R(K)=S(K)
1360 IF RIGHT$(F$,1)<>"*" THEN PRINT F$:P$=I$:GOTO 870
1370 PRINT LEFT$(F$,LEN(F$)-1);C$
1380 P$=I$:GOTO 870
1390 REM
1400 REM ---------PROGRAM DATA FOLLOWS----------
1410 REM
1420 REM KEYWORDS
1430 REM
1440 DATA "CAN YOU","CAN I","YOU ARE","YOURE","I DONT","I FEEL"
1450 DATA "WHY DONT YOU","WHY CANT I","ARE YOU","I CANT","I AM","IM "
1460 DATA "YOU ","I WANT","WHAT","HOW","WHO","WHERE","WHEN","WHY"
1470 DATA "NAME","CAUSE","SORRY","DREAM","HELLO","HI ","MAYBE"
1480 DATA "NO ","YOUR","ALWAYS","THINK","ALIKE","YES","FRIEND"
1490 DATA "COMPUTER","NOKEYFOUND"
1500 REM
1510 REM STRING DATA FOR CONJUGATIONS
1520 REM
1530 DATA " ARE "," AM ","WERE ","WAS "," YOU "," I "," YOUR ","MY "
1540 DATA " IVE "," YOURVE "," IM "," YOURE "
1550 REM
1560 REM REPLIES
1570 REM
1580 DATA "DON'T YOU BELIEVE THAT I CAN*"
1590 DATA "PERHAPS YOU WOULD LIKE TO BE ABLE TO*"
1600 DATA "YOU WANT ME TO BE ABLE TO*"
1610 DATA "PERHAPS YOU DON'T WANT TO*"
1620 DATA "DO YOU WANT TO BE ABLE TO*"
1630 DATA "WHAT MAKES YOU THINK I AM*"
1640 DATA "DOES IT PLEASE YOU TO BELIEVE I AM*"
1650 DATA "PERHAPS YOU WOULD LIKE TO BE*"
1660 DATA "DO YOU SOMETIMES WISH YOU WERE*"
1670 DATA "DON'T YOU REALLY*"
1680 DATA "WHY DON'T YOU*"
1690 DATA "DO YOU WISH TO BE ABLE TO*"
1700 DATA "DOES THAT TROUBLE YOU?"
1710 DATA "TELL ME MORE ABOUT SUCH FELLINGS."
1720 DATA "DO YOU OFTEN FEEL*"
1730 DATA "DO YOU ENJOY FEELING*"
1740 DATA "DO YOU REALLY BELIEVE I DON'T*"
1750 DATA "PERHAPS IN GOOD TIME I WILL*"
1760 DATA "DO YOU WANT ME TO*"
1770 DATA "DO YOU THINK YOU SHOULD BE ABLE TO*'
1780 DATA "WHY CAN'T YOU*"
1790 DATA "WHY ARE YOU INTERESTED IN WHETER OR NOT I AM*"
1800 DATA "WOULD YOU PREFER IF I WERE NOT*"
1810 DATA "PERHAPS IN YOUR FANTASIES I AM*"
1820 DATA "HOW DO YOU KNOW YOU CAN'T*"
1830 DATA "HAVE YOU TRIED?"
1840 DATA "PERHAPS YOU CAN NOW*"
1850 DATA "DID YOU COME TO ME BECAUSE YOU ARE*"
1860 DATA "HOW LONG HAVE YOU BEEN*"
1870 DATA "DO YOU BELIEVE IT IS NORMAL TO BE*"
1880 DATA "DO YOU ENJOY BEING*"
1890 DATA "WE WERE DISCUSSING YOU-- NOT ME."
1900 DATA "OH, I*"
1910 DATA "YOU'RE NOT REALLY TALKING ABOUT ME, ARE YOU?"
1920 DATA "WHAT WOULD IT MEAN TO YOU IF I GOT*"
1930 DATA "WHY DO YOU WANT*"
1940 DATA "SUPPOSE YOU SOON GOT*"
1950 DATA "WHAT IF YOU NEVER GOT*"
1960 DATA "I SOMETIMES ALSO WANT*"
1970 DATA "WHY DO YOU ASK?"
1980 DATA "DOES THAT QUESTION INTEREST YOU?"
1990 DATA "WHAT ANSWER WOULD PLEASE YOU THE MOST?"
2000 DATA "WHAT DO YOU THINK?"
2010 DATA "ARE SUCH QUESTIONS ON YOUR MIND OFTEN?"
2020 DATA "WHAT IS IT THAT YOU REALLY WHAT TO KNOW?"
2030 DATA "HAVE YOU ASKED ANYONE ELSE?"
2040 DATA "HAVE YOU ASKED SUCH QUESTIONS BEFORE?"
2050 DATA "WHAT ELSE COMES TO MIND WHEN YOU ASK THAT?"
2060 DATA "NAMES DON'T INTEREST ME."
2070 DATA "I DON'T CARE ABOUT NAMES-- PLEASE GO ON."
2080 DATA "IS THAT THE REAL REASON?"
2090 DATA "DON'T ANY OTHER REASONS COME TO MIND?"
2100 DATA "DOES THAT REASON EXPLAIN ANYTHING ELSE?"
2110 DATA "WHAT OTHER REASONS MIGHT THERE BE?"
2120 DATA "PLEASE DON'T APOLOGIZE!"
2130 DATA "APOLOGIES ARE NOT NECESSARY."
2140 DATA "WHAT FEELING DO YOU HAVE WHEN YOU APOLOGIZE?"
2150 DATA "DON'T BE SO DEFENSIVE!"
2160 DATA "WHAT DOES THAT DREAM SUGGEST TO YOU?"
2170 DATA "DO YOU DREAM OFTEN?"
2180 DATA "WHAT PERSONS APPEAR IN YOUR DREAMS?"
2190 DATA "ARE YOU DISTURBED BY YOUR DREAMS?"
2200 DATA "HOW DO YOU DO .... PLEASE STATE YOUR PROBLEM."
2210 DATA "YOU DON'T SEEM QUITE CERTAIN."
2220 DATA "WHY THE UNCERTAIN TONE?"
2230 DATA "CAN'T YOU BE MORE POSITIVE?"
2240 DATA "YOU AREN'T SURE?"
2250 DATA "DON'T YOU KNOW?"
2260 DATA "ARE YOU SAYING NO JUST TO BE NEGATIVE?"
2270 DATA "YOU ARE BEING A BIT NEGATIVE."
2280 DATA "WHY NOT?"
2290 DATA "ARE YOU SURE?"
2300 DATA "WHY NO?"
2310 DATA "WHY ARE YOU CONCERNED ABOUT MY*"
2320 DATA "WHAT ABOUT YOUR OWN*"
2330 DATA "CAN YOU THINK OF A SPECIFIC EXAMPLE?"
2340 DATA "WHEN?"
2350 DATA "WHAT ARE YOU THINKING OF?"
2360 DATA "REALLY, ALWAYS?"
2370 DATA "DO YOU REALLY THINK SO?"
2380 DATA "BUT YOU ARE NOT SURE YOU*"
2390 DATA "DO YOU DOUBT YOU*"
2400 DATA "IN WHAT WAY?"
2410 DATA "WHAT RESEMBLANCE DO YOU SEE?"
2420 DATA "WHAT DOES THE SIMILARITY SUGGEST TO YOU?"
2430 DATA "WHAT OTHER CONNECTIONS DO YOU SEE?"
2440 DATA "COULD THER REALLY BE SOME CONNECTION?"
2450 DATA "HOW?"
2460 DATA "YOU SEEM QUITE POSITIVE."
2470 DATA "ARE YOU SURE?"
2480 DATA "I SEE."
2490 DATA "I UNDERSTAND."
2500 DATA "WHY DO YOU BRING UP THE TOPIC OF FRIENDS?"
2510 DATA "DO YOUR FRIENDS WORRY YOU?"
2520 DATA "DO YOUR FRIENDS PICK ON YOU?"
2530 DATA "ARE YOU SURE YOU HAVE ANY FRIENDS?"
2540 DATA "DO YOU IMPOSE ON YOUR FRIENDS?"
2550 DATA "PERHAPS YOUR LOVE FOR FRIENDS WORRIES YOU."
2560 DATA "DO COMPUTERS WORRY YOU?"
2570 DATA "ARE YOU TALKING ABOUT ME IN PARTICULAR?"
2580 DATA "ARE YOU FRIGHTENED BY MACHINES?"
2590 DATA "WHY DO YOU MENTION COMPUTERS?"
2600 DATA "WHAT DO YOU THINK MACHINES HAVE TO DO WITH YOUR PROBLEM?"
2610 DATA "DON'T YOU THINK COMPUTERS CAN HELP PEOPLE?"
2620 DATA "WHAT IS IT ABOUT COMPUTER THAT WORRIES YOU?"
2630 DATA "SAY, DO YOU HAVE ANY PSYCHOLOGICAL PROBLEMS?"
2640 DATA "WHAT DOES THAT SUGGEST TO YOU?"
2650 DATA "I SEE."
2660 DATA "I'M NOT SURE I UNDERSTAND YOU FULLY."
2670 DATA "COME, COME, ELUCIDATE YOUR THOUGHTS."
2680 DATA "CAN YOU ELABORATE ON THAT?"
2690 DATA "THAT IS QUITE INTERESTING."
2700 REM
2710 REM DATA FOR FINDING RIGHT REPLIES
2720 REM
2730 DATA 1,3,4,2,6,4,6,4,10,4,14,3,17,3,20,2,22,3,25,3
2740 DATA 28,4,28,4,32,3,35,5,40,9,40,9,40,9,40,9,40,9,40,9
2750 DATA 49,2,51,4,55,4,59,4,63,1,63,1,64,5,69,5,74,2,76,4
2760 DATA 80,3,83,7,90,3,93,6,99,7,106,6
2770 END
32000 END
32001 TRANSMISSION COMPLETED
32002 THE FILENAME OF THE PROGRAM YOU
32003 JUST DOWNLOADED IS: ELIZA.BAS
32004 PRESS <RETURN> TO RETURN TO THE MAIN
32005 MENU.
*** MAIN MENU ***
1 - A
FIFTEEN.BAS
10 KEY OFF:CLS
20 SCREEN 0
30 WIDTH 40
40 PRINT"░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░"
50 PRINT"░┌───────────────────────────────────┐░"
60 PRINT"░│ │░"
70 PRINT"░│ 2059-A.BAS │░"
80 PRINT"░│ FIFTEEN PUZZLE │░"
90 PRINT"░│ │░"
100 PRINT"░│ │░"
110 PRINT"░│ BROUGHT TO YOU BY THE MEMBERS OF │░"
120 PRINT"░│ ▄▄▄▄▄ ▄▄▄▄▄ ▄▄▄▄▄ ▄▄▄▄▄ │░"
130 PRINT"░│ █ █ █ █ █ █ │░"
140 PRINT"░│ █ █▄▄▄█ █ █ █ │░"
150 PRINT"░│ █ █ █ █ █ │░"
160 PRINT"░│ ▄▄█▄▄ █ █▄▄▄▄ █▄▄▄█ │░"
170 PRINT"░│ │░"
180 PRINT"░│ International PC Owners │░"
190 PRINT"░│ │░"
200 PRINT"░│P.O. Box 10426, Pittsburgh PA 15234│░"
210 PRINT"░│ │░"
220 PRINT"░└───────────────────────────────────┘░"
230 PRINT"░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░"
240 PRINT
250 PRINT " PRESS ANY KEY TO CONTINUE
260 A$=INKEY$: IF A$="" THEN 260
270 WIDTH 80
280 CLS
1000 KEY OFF
1010 'THE FIFTEEN PUZZLE
1020 '
1030 'W.L. COLSHER
1040 '
1050 'MICROCOMPUTING - FEBRUARY 1981, P. 114.
1060 '
1070 'EXTENSIVELY MODIFIED FOR THE IBM-PC
1080 'PC BY CHUCK HARRINGTON - ATHENS AREA IBM-PC CLUB.
1090 '
1100 CLS: INPUT "DO YOU NEED INSTRUCTIONS (Y=1; N=2)";A:IF A=1 THEN GOSUB 1950
1110 CLS:M=0: PRINT "GENERATING THE PUZZLE TAKES A WHILE. PLEASE WAIT."
1120 DIM A(16)
1130 FOR I=1 TO 16: A(I)=0: NEXT I
1140 FOR I=1 TO 16
1150 R=INT(RND*(16+1))
1160 IF R=0 THEN 1150
1170 IF A(R) <> 0 THEN 1150
1180 A(R)=I
1190 NEXT I
1200 GOSUB 1390
1210 IF F=1 THEN 1130
1220 GOSUB 1550
1230 PRINT
1240 PRINT TAB(29);" ";: INPUT "YOUR MOVE";X
1250 GOSUB 1330
1260 GOSUB 1740
1270 IF F<>0 THEN 1290
1280 PRINT "ILLEGAL MOVE, RE-ENTER":FOR I=1 TO 500:NEXT I: GOTO 1220
1290 A(X+F)=A(X): A(X)=16
1300 GOTO 1850
1310 M=M+1: GOTO 1220
1320 END
1330 'CONVERT NUMBER TO LOCATION IN ARRAY
1340 FOR I=1 TO 16
1350 IF A(I)=X THEN 1370
1360 NEXT I
1370 X=I
1380 RETURN
1390 'VERIFY SOLUTION POSSIBLE.
1400 F=1
1410 S=0
1420 FOR I=1 TO 15
1430 FOR J=I+1 TO 16
1440 IF A(I)>A(J) THEN S=S+1
1450 NEXT J: NEXT I
1460 FOR I=1 TO 8
1470 READ X
1480 IF A(X)=0 THEN S=S+1
1490 NEXT I
1500 RESET
1510 A=INT(S/2)
1520 IF A*2=S THEN F=0
1530 RETURN
1540 DATA 2,4,5,7,10,12,13,15
1550 'DISPLAY GAME BOARD
1560 CLS
1570 PRINT TAB(30);"THE 15 PUZZLE GAME"
1580 PRINT
1590 PRINT TAB(35);"MOVE ";M
1600 PRINT TAB(25) STRING$(25,"_")
1610 FOR I=1 TO 4
1620 PRINT TAB(25);"|";TAB(31);"|";TAB(37);"|";TAB(43);"|";TAB(49);"|"
1630 PRINT TAB(25);"|";
1640 FOR J=1 TO 4
1650 N=A((I-1)*4+J)
1660 IF N=16 THEN N=0
1670 IF N<10 THEN PRINT " ";N;" +";:GOTO 1690
1680 PRINT N;" +";
1690 NEXT J
1700 PRINT TAB(25);"|";TAB(31);"|";TAB(37);"|";TAB(43);"|";TAB(49);"|"
1710 PRINT TAB(25);STRING$(25,"_")
1720 NEXT I
1730 RETURN
1740 'CHECK FOR LEGAL MOVE.
1750 F=0
1760 IF X+1>15 THEN 1780
1770 IF A(X+1)=16 THEN F=1
1780 IF X-1<=0 THEN 1800
1790 IF A(X-1)=16 THEN F=-1
1800 IF X+4>16 THEN 1820
1810 IF A(X+4)=16 THEN F=4
1820 IF X-4 < 0 THEN 1840
1830 IF A(X-4)=16 THEN F=-4
1840 RETURN
1850 'CHECK FOR WIN
1860 FOR I=1 TO 16
1870 IF A(I) <> I THEN 1310
1880 NEXT I
1890 GOSUB 1550
1900 PRINT: PRINT
1910 PRINT "CONGRATULATIONS!!! YOU DID IT IN ONLY ':M;" MOVES!!"
1920 PRINT: INPUT "PLAY AGAIN? (Y OR N)";A$
1930 IF A$= "Y" OR A$ = "y" THEN 1010
1940 END
1950 'INSTRUCTIONS.
1960 CLS: PRINT "F I F T E E N P U Z Z L E"
1970 PRINT
1980 PRINT "THE OBJECT OF THE FIFTEEN PUZZLE IS TO MOVE THE"
1990 PRINT "NUMBERS AROUND SO THAT THEY ARE IN ORDER FROM 1 TO 15."
2000 PRINT "A MOVE IS MADE BY TYPING IN THE NUMBER (WHICH MUST BE "
2010 PRINT "ADJACENT TO THE ZERO) YOU WISH TO MOVE. THAT NUMBER "
2020 PRINT "IS THEN EXCHANGED WITH THE ZERO. YOU WIN WHEN THE "
2030 PRINT "BOARD LOOKS LIKE THIS:"
2040 PRINT:PRINT
2050 PRINT " 1 2 3 4"
2060 PRINT
2070 PRINT " 5 6 7 8"
2080 PRINT
2090 PRINT " 9 10 11 12"
2100 PRINT
2110 PRINT "13 14 15 0"
2120 PRINT
2130 INPUT "PRESS <ENTER = TO PLAY.";A$
2140 RETURN
MEMORY.BAS
10 KEY OFF:CLS
20 SCREEN 0
30 WIDTH 40
40 PRINT"░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░"
50 PRINT"░┌───────────────────────────────────┐░"
60 PRINT"░│ │░"
70 PRINT"░│ 5011-A.BAS │░"
80 PRINT"░│ MEMORY │░"
90 PRINT"░│ │░"
100 PRINT"░│ │░"
110 PRINT"░│ BROUGHT TO YOU BY THE MEMBERS OF │░"
120 PRINT"░│ ▄▄▄▄▄ ▄▄▄▄▄ ▄▄▄▄▄ ▄▄▄▄▄ │░"
130 PRINT"░│ █ █ █ █ █ █ │░"
140 PRINT"░│ █ █▄▄▄█ █ █ █ │░"
150 PRINT"░│ █ █ █ █ █ │░"
160 PRINT"░│ ▄▄█▄▄ █ █▄▄▄▄ █▄▄▄█ │░"
170 PRINT"░│ │░"
180 PRINT"░│ International PC Owners │░"
190 PRINT"░│ │░"
200 PRINT"░│P.O. Box 10426, Pittsburgh PA 15234│░"
210 PRINT"░│ │░"
220 PRINT"░└───────────────────────────────────┘░"
230 PRINT"░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░"
240 PRINT
250 PRINT " PRESS ANY KEY TO CONTINUE
260 A$=INKEY$: IF A$="" THEN 260
270 WIDTH 80
280 CLS
1000 REM --- MEMORY -- WITH BLOCK LETTER CHARACTERS FOR TITLE
1010 DEFINT A-Z
1020 DIM COLMASK(8)
1030 FOR I = 1 TO 8
1040 COLMASK(I) = 2^(8-I)
1050 NEXT I
1060 DOTCHAR = 219
1070 DOT$ = STRING$(1,DOTCHAR)
1080 DEF SEG = &HF000
1090 BASEADR = &HFA6E
1100 KEY OFF
1110 REM --- MAIN LOOP
1120 CLS
1130 A$ = "MEMORY"
1140 CLS
1150 FOR I = 1 TO 6
1160 CHAR$ = MID$(A$,I,1)
1170 CODE = ASC(CHAR$)
1180 IF CODE >= 128 THEN BEEP : GOTO 1110
1190 ADR = BASEADR + CODE*8
1200 REM --- SUBROUTINE TO DISPLAY CHARACTER
1210 FOR ROW = 1 TO 8
1220 ROWVAL = PEEK(ADR + (ROW-1))
1230 FOR COL = 1 TO 8
1240 COLMASK = COLMASK(COL)
1250 IF (ROWVAL AND COLMASK) = 0 THEN 1290
1260 REM --- LOCATE TO BIT POSITION AND DISPLAY GIANT PIXEL
1270 LOCATE (ROW+8), 1 + (COL-1) + (I-1)*8
1280 PRINT DOT$;
1290 NEXT COL
1300 NEXT ROW
1310 NEXT I
1320 LOCATE 18,1
1330 PRINT "WHICH GAME DO YOU WANT TO PLAY"
1340 PRINT " 1) MEMORY USING NUMBERS"
1350 PRINT " 2) MEMORY USING SYMBOLS"
1360 A$ = INPUT$(1)
1370 IF A$ = "1" THEN 1400
1380 IF A$ = "2" THEN 1420
1390 GOTO 1360
1400 FIRST = 1
1410 GOTO 1430
1420 FIRST = 2
1430 DIM TUBE(5,8), SET(40)
1440 CLS
1450 REM --- DRAW OUTSIDE EDGE
1460 H = 20
1470 W = 79
1480 R = 1
1490 C = 1
1500 GOSUB 1860 ''' TOP SIDE
1510 GOSUB 2000 ''' RIGHT SIDE
1520 GOSUB 2080 ''' BOTTOM SIDE
1530 GOSUB 2160 ''' LEFT SIDE
1540 LOCATE R,C
1550 PRINT CHR$(201)
1560 R = 5
1570 GOSUB 1910 ''' ACROSS
1580 R = 9
1590 GOSUB 1910 ''' ACROSS
1600 R = 13
1610 GOSUB 1910 ''' ACROSS
1620 R = 17
1630 GOSUB 1910 ''' ACROSS
1640 R = 1
1650 C = 10
1660 GOSUB 2200 ''' UP
1670 C = 20
1680 GOSUB 2200 ''' UP
1690 C = 30
1700 GOSUB 2200 ''' UP
1710 C = 40
1720 GOSUB 2200 ''' UP
1730 C = 50
1740 GOSUB 2200 ''' UP
1750 C = 60
1760 GOSUB 2200 ''' UP
1770 C = 70
1780 GOSUB 2200 ''' UP
1790 FOR R = 5 TO 17 STEP 4
1800 FOR C = 10 TO 70 STEP 10
1810 LOCATE R,C
1820 PRINT CHR$(206)
1830 NEXT C
1840 NEXT R
1850 GOTO 2300
1860 REM *** START OF SUBROUTINE
1870 REM *** ROUTINE FOR TOP SIDE
1880 LOCATE R,C :REM print top left hand corner
1890 PRINT CHR$(201)
1900 GOTO 1930
1910 LOCATE R,C
1920 PRINT CHR$(204)
1930 FOR I = C+1 TO W
1940 LOCATE R,I :REM print top side
1950 PRINT CHR$(205)
1960 NEXT I
1970 LOCATE R,W+1
1980 PRINT CHR$(185)
1990 RETURN
2000 REM *** ROUTINE FOR RIGHT HAND SIDE
2010 LOCATE R,C+W :REM print top right hand corner
2020 PRINT CHR$(187)
2030 FOR I = R+1 TO R+H
2040 LOCATE I,C+W :REM print right hand side
2050 PRINT CHR$(186)
2060 NEXT I
2070 RETURN
2080 REM *** ROUTINE FOR BOTTOM SIDE
2090 LOCATE R+H,C+W :REM print bottom right corner
2100 PRINT CHR$(188)
2110 FOR I = C+W-1 TO C+1 STEP -1
2120 LOCATE R+H,I :REM print bottom side
2130 PRINT CHR$(205)
2140 NEXT I
2150 RETURN
2160 REM *** ROUTINE FOR LEFT HAND SIDE
2170 LOCATE R+H,C :REM print bottom left corner
2180 PRINT CHR$(200)
2190 GOTO 2220
2200 LOCATE R+H, C
2210 PRINT CHR$(202)
2220 FOR I = R+H-1 TO R+1 STEP -1
2230 LOCATE I,C :REM print left hand side
2240 PRINT CHR$(186)
2250 NEXT I
2260 LOCATE R,C
2270 PRINT CHR$(203)
2280 RETURN
2290 END
2300 REM --- START ROUTINE FOR RANDOM IMAGES
2310 NUM = CVI(RIGHT$(TIME$,2))
2320 RANDOMIZE NUM
2330 REM --- DETERMINE DEGREE OF EXPERTISE
2340 LOCATE 22,1
2350 PRINT "ENTER DESIRED WAIT TIME: 1, 2, 3, OR 4 SECONDS"
2360 A$ = INKEY$
2370 IF A$ = "" THEN 2360
2380 DIF = VAL(A$)
2390 IF DIF < 1 THEN 2360
2400 IF DIF > 4 THEN 2360
2410 LOCATE 23,40
2420 PRINT " DELAY TIME WILL BE "; DIF; " SECONDS"
2430 REM --- SET UP INITIAL VALUES
2440 FOR I = 1 TO 20
2450 SET(I) = I
2460 SET(20+I) = I
2470 NEXT I
2480 REM --- TRANSFER INITIAL VALUES TO RANDOM VALUES ON SCREEN
2490 FOR I = 1 TO 5
2500 FOR J = 1 TO 8
2510 NUM = INT(40*RND(NUM) + 1)
2520 IF SET(NUM) = 0 THEN 2510
2530 TUBE(I,J) = SET(NUM)
2540 SET(NUM) = 0
2550 NEXT J
2560 NEXT I
2570 REM --- PRINT OUT VALUES
2580 FOR I = 1 TO 5
2590 FOR J = 1 TO 8
2600 LOCATE I*4-1, (J-1)*10+3
2610 IF FIRST = 1 THEN 2640
2620 GOSUB 3960
2630 GOTO 2650
2640 PRINT TUBE(I,J)
2650 NEXT J
2660 NEXT I
2670 REM --- NUMBER THE SCREEN
2680 FOR I = 1 TO 5
2690 FOR J = 1 TO 8
2700 LOCATE I*4-1, (J-1)*10+3
2710 PRINT I; J
2720 NEXT J
2730 NEXT I
2740 REM -- START GUESSING PROCESS
2750 LOCATE 22,1
2760 PRINT "ROW = COLUMN = AND ROW = COLUMN = "
2770 A$ = INKEY$
2780 IF A$ = "" THEN 2770
2790 I = VAL(A$)
2800 IF I <> 0 THEN 2840
2810 IF LEN(A$) = 1 THEN 2770
2820 BEEP
2830 GOTO 3770
2840 LOCATE 22,7
2850 PRINT A$
2860 A$ = INKEY$
2870 IF A$ = "" THEN 2860
2880 J = VAL(A$)
2890 IF J <> 0 THEN 2930
2900 IF LEN(A$) = 1 THEN 2860
2910 BEEP
2920 GOTO 3770
2930 LOCATE 22,21
2940 PRINT A$
2950 A$ = INKEY$
2960 IF A$ = "" THEN 2950
2970 L = VAL(A$)
2980 IF L <> 0 THEN 3020
2990 IF LEN(A$) = 1 THEN 2950
3000 BEEP
3010 GOTO 3770
3020 LOCATE 22,41
3030 PRINT A$
3040 A$ = INKEY$
3050 IF A$ = "" THEN 3040
3060 M = VAL(A$)
3070 IF M <> 0 THEN 3110
3080 IF LEN(A$) = 1 THEN 3040
3090 BEEP
3100 GOTO 3770
3110 LOCATE 22,55
3120 PRINT A$
3130 REM --- CHECK TO SEE IF SAME SPOT
3140 IF I <> L THEN 3200
3150 IF J <> M THEN 3200
3160 BEEP
3170 LOCATE 23,1
3180 PRINT "SAME SQUARE, GO AGAIN "
3190 GOTO 2740
3200 REM --- CHECK TO SEE IF VALID SUBSCRIPT
3210 IF I < 6 THEN 3260
3220 BEEP
3230 LOCATE 23,1
3240 PRINT "INVALID NUMBER........"
3250 GOTO 2740
3260 IF J > 8 THEN 3220
3270 IF L > 5 THEN 3220
3280 IF M > 8 THEN 3220
3290 REM --- CHECK TO SEE IF VALID SUBSCRIPT
3300 IF TUBE(I,J) = 0 THEN 3330
3310 IF TUBE(L,M) = 0 THEN 3330
3320 GOTO 3370
3330 LOCATE 23,1
3340 BEEP
3350 PRINT "KNOWN SQUARE, GO AGAIN"
3360 GOTO 2740
3370 REM --- DISPLAY VALUES
3380 COUNT = COUNT + 1
3390 LOCATE I*4-1, (J-1)*10+3
3400 PRINT " "
3410 LOCATE I*4-1, (J-1)*10+3
3420 IF FIRST = 1 THEN 3450
3430 GOSUB 3960
3440 GOTO 3460
3450 PRINT TUBE(I,J)
3460 LOCATE L*4-1, (M-1)*10+3
3470 PRINT " "
3480 LOCATE L*4-1, (M-1)*10+3
3490 IF FIRST = 1 THEN 3520
3500 GOSUB 3990
3510 GOTO 3530
3520 PRINT TUBE(L,M)
3530 REM --- CHECK FOR MATCHES
3540 IF TUBE(I,J) = TUBE(L,M) THEN 3650
3550 LOCATE 23,1
3560 PRINT "THEY DO NOT MATCH "
3570 T1 = VAL(RIGHT$(TIME$,2))
3580 T2 = VAL(RIGHT$(TIME$,2))
3590 IF ABS(T1-T2) < DIF THEN 3580
3600 LOCATE I*4-1, (J-1)*10+3
3610 PRINT I; J
3620 LOCATE L*4-1, (M-1)*10+3
3630 PRINT L; M
3640 GOTO 2740
3650 REM --- THE SQUARES MATCH
3660 BEEP
3670 LOCATE 23,1
3680 PRINT "THEY MATCH............"
3690 LOCATE I*4-1, (J-1)*10+3
3700 PRINT CHR$(17); CHR$(219); CHR$(219); CHR$(16)
3710 LOCATE L*4-1, (M-1)*10+3
3720 PRINT CHR$(17); CHR$(219); CHR$(219); CHR$(16)
3730 TUBE(I,J) = 0
3740 TUBE(L,M) = 0
3750 MATCH = MATCH + 1
3760 IF MATCH < 20 THEN 2740
3770 REM --- TIME TO MOVE ON
3780 LOCATE 23,1
3790 BEEP
3800 PRINT "THIS GAME IS OVER ---- "
3810 BEEP
3820 LOCATE 23,23
3830 PRINT "IT TOOK YOU "; COUNT; "TURNS "
3840 IF FIRST = 2 THEN 3920
3850 LOCATE 23,47
3860 PRINT " PRESS ANY KEY FOR GAME 2 "
3870 A$ = INKEY$
3880 IF A$ = "" THEN 3870
3890 FIRST = 2
3900 CLS
3910 GOTO 1450
3920 LOCATE 23,47
3930 PRINT " "
3940 LOCATE 23,1
3950 END
3960 REM --- ROUTINE TO PRINT OUT CHR$
3970 CHAR = TUBE(I,J)
3980 GOTO 4000
3990 CHAR = TUBE(L,M)
4000 ON CHAR GOTO 4010,4030,4050,4070,4090,4110,4130,4150,4170,4190,4210,4230,4250,4270,4290,4310,4330,4350,4370,4390
4010 PRINT CHR$(17); CHR$(219); CHR$(219) CHR$(16) '' 1
4020 RETURN
4030 PRINT CHR$(221); CHR$(220); CHR$(223) CHR$(222) '' 2
4040 RETURN
4050 PRINT CHR$(204); CHR$(205); CHR$(205) CHR$(185) '' 3
4060 RETURN
4070 PRINT CHR$(204); CHR$(206); CHR$(206) CHR$(185) '' 4
4080 RETURN
4090 PRINT CHR$(219); CHR$(16); CHR$(17) CHR$(219) '' 5
4100 RETURN
4110 PRINT CHR$(17); CHR$(16); CHR$(17) CHR$(16) '' 6
4120 RETURN
4130 PRINT CHR$(211); CHR$(210); CHR$(210) CHR$(189) '' 7
4140 RETURN
4150 PRINT CHR$(204); CHR$(188); CHR$(200) CHR$(185) '' 8
4160 RETURN
4170 PRINT CHR$(26); CHR$(24); CHR$(25) CHR$(27) '' 9
4180 RETURN
4190 PRINT CHR$(1); CHR$(2); CHR$(2) CHR$(1) '' 10
4200 RETURN
4210 PRINT CHR$(220); CHR$(223); CHR$(223) CHR$(220) '' 1/2
4220 RETURN
4230 PRINT CHR$(220); CHR$(223); CHR$(220) CHR$(223) '' 2/2
4240 RETURN
4250 PRINT CHR$(214); CHR$(215); CHR$(215) CHR$(183) '' 3/2
4260 RETURN
4270 PRINT CHR$(17); CHR$(205); CHR$(205) CHR$(16) '' 4/2
4280 RETURN
4290 PRINT CHR$(14); CHR$(14); CHR$(14) CHR$(14) '' 5/2
4300 RETURN
4310 PRINT CHR$(19); CHR$(19); CHR$(19) CHR$(19) '' 6/2
4320 RETURN
4330 PRINT CHR$(178); CHR$(176); CHR$(176) CHR$(178) '' 7/2
4340 RETURN
4350 PRINT CHR$(201); CHR$(203); CHR$(203) CHR$(187)
4360 RETURN
4370 PRINT CHR$(200); CHR$(239); CHR$(239) CHR$(188)
4380 RETURN
4390 PRINT CHR$(21); CHR$(15); CHR$(15) CHR$(21)
4400 RETURN
OTHELLO.BAS
1000 REM OTHELLO -- PET VERSION -- MODIFIED BY PATRICK LEABO
1010 REM TUCSON, ARIZONA
1020 REM 3-82
1025 REM NOT DONE YET BUT HAVE FUN -- PLEASE ADD A GOOD ALGORITHM TO IT
1026 REM
1030 SCREEN 0,0:COLOR 7,0:WIDTH 80:KEY OFF
1040 E$="":FOR I= 1 TO 39:E$= E$+ " ":NEXT
1050 D$= CHR$ (11)
1060 FOR I= 1 TO 20:D$= D$+ CHR$ (10):NEXT
1070 XL= 3:XH= 6:YL= 3:YH= 6
1080 DIM A(9,9),I4(7),J4(7),D$(2),P$(2):Z0= 0
1090 CLS:LOCATE 1,20:PRINT "GREETINGS FROM OTHELLO"
1100 PRINT :PRINT "OTHELLO IS PLAYED ON AN 8 X 8 BOARD, ROWS NUMBERED"
1110 PRINT "1 TO 8 AND COLUMNS A TO H. THE INITIAL CONFIGURATION IS"
1120 PRINT "ALL BLANK EXCEPT FOR THE CENTER FOUR SQUARES, TRY TO PLACE"
1130 PRINT "YOUR PIECE SO THAT IT OUTFLANKS YOUR OPPONENT, CREATING "
1140 PRINT "HORIZONTAL, VERTICAL, OR DIAGONAL RUN OF OPPOSING PIECES,"
1150 PRINT "TURNING THEM INTO YOURS."
1160 PRINT
1170 PRINT:PRINT
1180 PRINT "EXAMPLE: RED OUTFLANKS BLUE, CAPTURING FOUR BLUE PIECES."
1190 PRINT "2MAKE YOUR MOVE BY ENTERING A NUMBER FOR THE ROW AND A LETTER"
1200 PRINT "FOR THE COLUMN. "
1210 PRINT "NOTE: YOU MUST CAPTURE AT LEAST ONE OF MY PIECES IN THIS WAY "
1220 PRINT "IF IT IS POSSIBLE. IF IT IS NOT POSSIBLE, YOU FORFEIT YOUR"
1230 PRINT "MOVE BY ENTERING 0 A FOR YOUR MOVE."
1240 PRINT :PRINT "HOW MANY PLAYERS (1 OR 2)? ";:GOSUB 3220:IF VAL (X$)= 0 OR VAL (X$)> 2 THEN 1240
1250 PRINT X$:NP= VAL (X$):PRINT
1260 IF NP= 2 THEN PRINT "PLAYER #1 GOES FIRST WHEN THE PLAY STARTS"
1270 SOUND 3000,2:INPUT "ENTER PLAYER 1,S NAME! ";P$(1):P$(1)= P$(1)+" "+ CHR$(2)
1280 SOUND 3000,2:IF NP= 2 THEN INPUT "ENTER PLAYER 2'S NAME! ";P$(2):P$(2)= P$(2)+" "+CHR$(1)
1290 IF NP= 2 THEN 1350
1300 PRINT :PRINT "SHOULD I PLAY MY BEST?";
1310 S2= 0:S4= 0:S5= 0:P$(2)= "IBM PC"
1320 GOSUB 3220:IF X$= "N"THEN PRINT "NO":GOTO 1350
1330 PRINT "YES"
1340 S2= 2:S4= 1:S5= - 2
1350 B= - 1:W= 1:PT= 0
1360 D$(B+ 1)= "RED":N$(B+ 1)= "RED "
1370 D$(0+ 1)= "BLANK"
1380 D$(W+ 1)= "BLUE":N$(W+ 1)= "BLUE"
1390 FOR K= 0 TO 7
1400 READ I4(K),J4(K)
1410 NEXT
1420 FOR I= 0 TO 9:FOR J= 0 TO 9
1430 A(I,J)= 0
1440 NEXT J,I
1450 A(4,4)= W:A(5,5)= W
1460 A(4,5)= B:A(5,4)= B
1470 SC(1)= 2:SC(2)= 2:N1= 4:Z= 0
1480 C= B:H= W
1490 FOR NN= 1 TO 3000:NEXT :CLS
1500 GOSUB 3300
1510 IF NP= 2 THEN 2020
1520 PRINT D$"DO YOU WANT TO GO FIRST ? ";
1530 PT= 1:GOSUB 3220:IF X$= "Y"THEN PRINT "YES":PT= 0:GOTO 2020
1540 PT= 1:PRINT "NO":PRINT D$E$D$"OK, I AM THINKING!"
1550 REM COMPUTERS MOVE
1560 IF NP= 1 THEN TIME$="0:0:0":GOTO 1600
1570 IF PT= 2 THEN B1= - 1:I3= 0:J3= 0:T1= C:T2= H
1580 IF PT= 1 THEN B1= - 1:I3= 0:J3= 0:T1= H:T2= C
1590 GOTO 2030
1600 PT= PT+ 1:IF PT> 2 THEN PT= 1
1610 B1= - 1:I3= 0:J3= 0:T1= C:T2= H
1620 FOR I= YL TO YH:FOR J= XL TO XH
1630 IF A(I,J)< > 0 THEN 1790
1640 GOSUB 2740
1650 IF F1= Z0 THEN 1790
1660 U= - 1
1670 GOSUB 2780
1680 IF S1= Z0 THEN 1790
1690 IF (I= 1)OR (I= 8)THEN S1= S1+ S2
1700 IF (J= 1)OR (J= 8)THEN S1= S1+ S2
1710 IF (I= 2)OR (I= 7)THEN S1= S1+ S5
1720 IF (J= 2)OR (J= 7)THEN S1= S1+ S5
1730 IF (I= 3)OR (I= 6)THEN S1= S1+ S4
1740 IF (J= 3)OR (J= 6)THEN S1= S1+ S4
1750 IF S1< B1 THEN 1790
1760 IF S1> B1 THEN 1780
1770 IF RND (1)> .5 THEN 1790
1780 B1= S1:I3= I:J3= J
1790 NEXT J,I
1800 IF B1> 0 THEN 1880
1810 IF S5= 0 THEN 1840
1820 IF NP= 1 THEN S5= 0:GOTO 1610
1830 S5= 0:GOTO 1550
1840 S5= 0:PRINT D$ E$ D$"I HAVE TO FORFEIT MY MOVE"
1850 IF Z= 1 THEN 2430
1860 Z= 1
1870 GOTO 2020
1880 Z= 0
1890 PRINT D$E$D$"I WILL MOVE TO ";RIGHT$ (STR$ (I3),1)" "CHR$ (J3+ 64)
1900 GOSUB 3090 REM 5
1910 I= I3:J= J3:U= 1
1920 GOSUB 2780
1930 SC(PT)= SC(PT)+ S1+ 1
1940 OP= PT+ 1:IF OP= 3 THEN OP= 1
1950 SC(OP)= SC(OP)- S1
1960 N1= N1+ 1
1970 PRINT D$E$D$"THAT GIVES ME ";
1980 PRINT S1;
1990 PRINT " OF YOUR PIECES"
2000 GOSUB 3390
2010 IF SC(OP)= 0 OR N1= 64 THEN 2430
2020 T1= H:T2= C
2030 PT= PT+ 1:IF PT> 2 THEN PT= 1
2040 IF PT= 2 THEN B1= - 1:I3= 0:J3= 0:T1= C:T2= H
2050 IF PT= 1 THEN B1= - 1:I3= 0:J3= 0:T1= H:T2= C
2060 BEEP
2070 TIME$="0:0:0":PRINT D$;E$D$;P$(PT)", INPUT YOUR MOVE ! ";:GOSUB 3020
2080 IF (I< 0)OR (J< 0)OR (J> 8)OR (I> 8)THEN 2040
2090 IF I< > 0 THEN 2160
2100 PRINT D$;E$D$;"ARE YOU FORFEITING YOUR TURN ? ";
2110 GOSUB 3220:IF X$< > "Y"THEN PRINT "NO":GOTO 2040
2120 PRINT "YES"
2130 IF Z= 1 THEN 2430
2140 Z1= 1
2150 GOTO 1550
2160 IF A(I,J)= 0 THEN 2190
2170 PRINT D$"SORRY,SQUARE OCCUPIED; TRY AGAIN"
2180 GOTO 2270
2190 GOSUB 2740
2200 IF F1= 1 THEN 2230
2210 PRINT D$""E$D$"SORRY,NOT NEXT TO MY PIECES; TRY AGAIN"
2220 GOTO 2270
2230 U= - 1
2240 GOSUB 2780
2250 IF S1> 0 THEN 2290
2260 PRINT D$""E$D$"SORRY,DOESN'T FLANK A ROW; TRY AGAIN"
2270 PRINT E$D$:BEEP:FOR N=1 TO 2000:NEXT
2280 GOTO 2040
2290 Z= 0:GOSUB 3150
2300 PRINT D$""E$D$""P$(PT)" THAT GIVES YOU ";
2310 PRINT S1;
2320 PRINT " PIECE";:IF S1> 1 THEN PRINT "S";
2330 PRINT :PRINT E$D$
2340 U= 1
2350 GOSUB 2780
2360 SC(PT)= SC(PT)+ S1+ 1
2370 OP= PT+ 1:IF OP= 3 THEN OP= 1
2380 SC(OP)= SC(OP)- S1
2390 N1= N1+ 1
2400 GOSUB 3390
2410 IF SC(OP)= 0 OR N1= 64 THEN 2430
2420 GOTO 1550
2430 PRINT D$;E$:PRINT E$:PRINT E$
2440 PRINT D$;E$D$;P$(1)" HAS "SC(1)" PIECES ";
2450 PRINT P$(2)" HAS "SC(2)" PIECES"
2460 IF SC(1)= SC(2)THEN 2510
2470 IF NP= 2 THEN 2540
2480 IF SC(1)> SC(2)THEN 2530
2490 PRINT "SORRY, I WON THAT ONE.";
2500 GOTO 2540
2510 PRINT "ITS A TIE !!";
2520 GOTO 2680
2530 PRINT "YOU WON!!!!!!";
2540 C1= SC(1)- SC(2)
2550 IF C1> 0 THEN 2570
2560 C1= - C1
2570 C1= (64* C1)/ N1
2580 PRINT "THAT WAS A ";
2590 IF C1< 11 THEN 2670
2600 IF C1< 25 THEN 2660
2610 IF C1< 39 THEN 2650
2620 IF C1< 53 THEN 2640
2630 PRINT "PERFECT GAME":GOTO 2680
2640 PRINT "WALKAWAY":GOTO 2680
2650 PRINT "FIGHT":GOTO 2680
2660 PRINT "HOT GAME":GOTO 2680
2670 PRINT "SQUEAKER"
2680 PRINT
2690 PRINT "DO YOU WANT TO PLAY ANOTHER GAME ? ";:BEEP
2700 GOSUB 3220:IF X$= "Y"THEN PRINT "YES";:RUN 1040
2710 PRINT "NO"
2720 PRINT "THANKS FOR PLAYING."
2730 CHAIN "MENU.BAS",1000
2740 F1= Z0:FOR I1= - 1 TO 1:FOR J1= - 1 TO 1:IF A(I+ I1,J1+ J)= T2 THEN 2760
2750 NEXT J1,I1:RETURN
2760 F1= 1:RETURN
2770 REM CHECK FOR COUNT & FLANKING PIECES
2780 S1= Z0:FOR K= 0 TO 7
2790 S3= Z0:I5= I4(K):J5= J4(K):I6= I+ I5:J6= J+ J5
2800 IF A(I6,J6)< > T2 THEN 2910
2810 S3= S3+ 1:I6= I6+ I5:J6= J6+ J5
2820 IF A(I6,J6)= T1 THEN 2850
2830 IF A(I6,J6)= Z0 THEN 2910
2840 GOTO 2810
2850 S1= S1+ S3
2860 IF U< > 1 THEN 2910
2870 I6= I:J6= J
2880 FOR K1= 0 TO S3
2890 A(I6,J6)= T1:I6= I6+ I5:J6= J6+ J5
2900 NEXT K1
2910 NEXT K
2920 RETURN
2930 REM 3SET SEARCH LIMITS FOR COMPUTER MOVE5
2940 IF I= YL THEN YL= YL- 1:IF YL< 1 THEN YL= 1
2950 IF I= YH THEN YH= YH+ 1:IF YH> 8 THEN YH= 8
2960 IF J= XL THEN XL= XL- 1:IF XL< 1 THEN XL= 1
2970 IF J= XH THEN XH= XH+ 1:IF XH> 8 THEN XH= 8
2980 LOCATE 1,1:PRINT TI$;" "
2990 RETURN
3000 REM INPUT SUBROUTINE5"
3010 PRINT D$E$"BAD MOVE; TRY AGAIN."
3020 I= - 1:J= - 1
3030 FOR K= 1 TO 2
3040 GOSUB 3220
3050 G= ASC (X$)
3060 IF 47< G AND G< 58 THEN I= G- 48:PRINT ""X$" ";
3070 IF 64< G AND G< 74 THEN J= G- 64:PRINT ""X$" ";
3080 NEXT :PRINT :RETURN
3090 REM BLINK COMPUTERS MOVE5
3100 LOCATE 2* J3+ 3,4* I3+ 1:COLOR 26,0:PRINT CHR$(1):COLOR 7,0
3110 I= I3:J= J3
3120 GOSUB 2940
3130 FOR NN= 1 TO 1000:NEXT
3140 RETURN
3150 REM BLINK PLAYERS MOVE5
3160 IF PT= 2 THEN CC= 0
3170 IF PT= 1 THEN CC= 2
3180 LOCATE 2* J+ 3,4* I+ 1:COLOR 26,0:PRINT CHR$(2):COLOR 7,0
3190 GOSUB 2940
3200 FOR NN= 1 TO 500:NEXT
3210 RETURN
3220 REM INPUT STATEMENTS
3230 SOUND 3000,2
3240 X$=INKEY$:IF X$="" THEN 3240 ELSE IF X$=CHR$(27) THEN CHAIN "MENU",1000 ELSE RETURN
3250 REM PRINT SCORE
3260 LOCATE 5,36:PRINT CHR$(2);RIGHT$ (" "+ STR$ (SC(1)),3);" ":LOCATE 19,36:PRINT CHR$(1);RIGHT$ (" "+ STR$ (SC(2)),3);" ";:LOCATE 1,1
3270 RETURN
3280 REM BOARD DATA
3290 DATA 0,1,-1,1,-1,0,-1,-1,0,-1,1,-1,1,0,1,1
3300 REM 5 OTHER OTHELLO BOARD
3310 CLS:LOCATE 1,10:PRINT "O T H E L L O"
3320 LOCATE 3,5:PRINT"1 2 3 4 5 6 7 8"
3330 FOR N=1 TO 8:LOCATE 3+2*N,1:PRINT CHR$(N+64):NEXT
3340 LOCATE 4,3 :PRINT"╔═══╦═══╦═══╦═══╦═══╦═══╦═══╦═══╗":FOR N=1 TO 13 STEP 2
3350 LOCATE 4+N,3:PRINT"║ ║ ║ ║ ║ ║ ║ ║ ║"
3360 LOCATE 5+N,3:PRINT"╠═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╣":NEXT
3370 LOCATE 4+N,3:PRINT"║ ║ ║ ║ ║ ║ ║ ║ ║"
3380 LOCATE 5+N,3:PRINT"╚═══╩═══╩═══╩═══╩═══╩═══╩═══╩═══╝"
3390 FOR I= 1 TO 8
3400 FOR J= 1 TO 8:LOCATE 2* J+ 3,4* I+ 1:FACE= (A(I,J)+ 3)/2
3410 IF FACE = 1.5 THEN PRINT" " ELSE PRINT CHR$(FACE)
3420 NEXT J,I
3430 GOSUB 3250
3440 RETURN
3450 END
ROADRALY.BAS
10 KEY OFF:CLS
20 SCREEN 0
30 WIDTH 40
40 PRINT"░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░"
50 PRINT"░┌───────────────────────────────────┐░"
60 PRINT"░│ │░"
70 PRINT"░│ 2052-A.BAS │░"
80 PRINT"░│ ROAD RALLY │░"
90 PRINT"░│ │░"
100 PRINT"░│ │░"
110 PRINT"░│ BROUGHT TO YOU BY THE MEMBERS OF │░"
120 PRINT"░│ ▄▄▄▄▄ ▄▄▄▄▄ ▄▄▄▄▄ ▄▄▄▄▄ │░"
130 PRINT"░│ █ █ █ █ █ █ │░"
140 PRINT"░│ █ █▄▄▄█ █ █ █ │░"
150 PRINT"░│ █ █ █ █ █ │░"
160 PRINT"░│ ▄▄█▄▄ █ █▄▄▄▄ █▄▄▄█ │░"
170 PRINT"░│ │░"
180 PRINT"░│ International PC Owners │░"
190 PRINT"░│ │░"
200 PRINT"░│P.O. Box 10426, Pittsburgh PA 15234│░"
210 PRINT"░│ │░"
220 PRINT"░└───────────────────────────────────┘░"
230 PRINT"░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░"
240 PRINT
250 PRINT " PRESS ANY KEY TO CONTINUE
260 A$=INKEY$: IF A$="" THEN 260
270 WIDTH 80
280 CLS
1000 CLS
1010 NUM = CVI(RIGHT$(TIME$,2))
1020 RANDOMIZE NUM
1030 LOCATE 5,10
1040 PRINT "THIS IS THE ROAD RALLY GAME"
1050 LOCATE 7,1
1060 PRINT "YOUR TASK IS TO DRIVE YOUR CAR FROM YOUR HOUSE "
1070 PRINT "TO THE OLD MILL STREAM. YOU HAVE YOUR CHOICE OF"
1080 PRINT "THE FOLLOWING CARS TO DRIVE:"
1090 PRINT " 1. VOLKSWAGEN"
1100 PRINT " 2. CHEVY (OR FORD)"
1110 PRINT " 3. MADZA RX-7"
1120 PRINT " 4. FERRARI"
1130 PRINT
1140 PRINT "PICK YOUR CAR BY THE NUMBER IN FRONT. REMEMBER THAT THE FASTER"
1150 PRINT "THE CAR THE MORE GAS YOU USE AND YOU DO HAVE A LIMITED SUPPLY OF GAS"
1160 PRINT
1170 PRINT "WHAT CAR DO YOU WANT TO DRIVE?"
1180 INPUT C1
1190 C1 = INT(C1)
1200 IF C1 < 1 THEN 1220
1210 IF C1 < 5 THEN 1240
1220 PRINT "INVALID CAR NUMBER, PLEASE PICK A NUMBER BETWEEN 1 AND 4"
1230 GOTO 1160
1240 PRINT "OK, I KNOW WHAT CAR YOU ARE DRIVING. NOW I NEED TO KNOW
1250 PRINT "WHAT COURSE YOU WANT TO TAKE. THERE ARE 5 WAYS TO THE OLD
1260 PRINT "MILL STREAM. COURSE # 1 IS THE STRAIGHTEST. EACH COURSE HAS"
1270 PRINT "MORE CURVES THAN THE PREVIOUS UNTIL COURSE # 5 WHICH IS THE HARDEST.
1280 PRINT
1290 PRINT "WHAT COURSE DO YOU WANT TO DRIVE?"
1300 INPUT C2
1310 C2 = INT(C2)
1320 IF C2 < 1 THEN 1340
1330 IF C2 < 6 THEN 1360
1340 PRINT "INVALID COURSE, PLEASE PICK A COURSE BETWEEN 1 AND 5"
1350 GOTO 1280
1360 PRINT "NOW THAT I KNOW WHICH CAR AND WHICH COURSE YOU WILL DRIVE,"
1370 PRINT "HERE ARE THE RULES OF THE ROAD:"
1380 PRINT
1390 PRINT " --- YOU NEED TO COVER 5 MILES WITH 1/2 GALLON OF GAS"
1400 PRINT " --- YOUR STATUS WILL BE SHOWN EVERY 10 SECONDS OF DRIVE TIME"
1410 PRINT " --- AFTER EACH SUCH STATUS CHECK, YOU WILL BE ASKED FOR A "
1420 PRINT " SPEED CHECK."
1430 PRINT " *** A +10 ENTRY IS HARD ACCELERATION"
1440 PRINT " *** A -10 ENTRY IS HARD BRAKING"
1450 PRINT " *** ANYTHING BETWEEN THE TWO IS AN ACCEPTABLE ENTRY"
1460 PRINT "
1470 PRINT "GOOD LUCK, REMEMBER SAFETY, DON'T CRASH AND DON'T RUN OUT OF GAS"
1480 PRINT
1490 A$ = INKEY$
1500 PRINT "^^^^^ PRESS ANY KEY TO START RALLY ^^^^^"
1510 FOR I = 1 TO C1
1520 READ B, M, S
1530 B = B/10
1540 NEXT I
1550 A1 = .5
1560 M1 = 0
1570 C1 = C1/2
1580 V = 0
1590 PRINT
1600 R1 = 0
1610 T = 0
1620 D = 0
1630 Q1 = 0
1640 PRINT "PRESENT VELOCITY = "; V; "# GALLONS = "; A1
1650 PRINT "# MILES = "; M1; "TIME PASSED = "; T; "SECONDS"
1660 IF M1 >= 5 THEN 2490
1670 PRINT "WHAT IS YOUR NEW RATE OF GAS?";
1680 INPUT G
1690 IF G < -10 THEN 1720
1700 IF G > 10 THEN 1720
1710 GOTO 1740
1720 PRINT "INVALID GAS RATE, PICK A RATE BETWEEN -10 AND 10"
1730 GOTO 1670
1740 IF G < 9 THEN 1810
1750 Z = Z + 1
1760 IF Z > 4 THEN 1780
1770 GOTO 1820
1780 PRINT
1790 PRINT "YOUR ENGINE HAS BLOWN, IT HAS BEEN OVER TAXED"
1800 GOTO 2300
1810 Z = 0
1820 V = INT(B*G-M*V+V)
1830 T = T + 10
1840 PRINT
1850 PRINT "ROAD CONDITIONS - ";
1860 IF V > 0 THEN 1880
1870 V = 0
1880 M1 = M1 + V/460
1890 IF G < 0 THEN 1920
1900 A1 = A1 - (G*S)/5000
1910 IF A1 < 0 THEN 2410
1920 IF R1 = 1 THEN 2080
1930 IF Q1 = 1 THEN 2010
1940 Q = INT((C2 + 1)*RND(NUM))
1950 R = INT((3.75-C2)*RND(NUM))
1960 IF R > 0 THEN 2320
1970 IF Q > 0 THEN 2370
1980 PRINT "CLEAR AND STRAIGHT"
1990 PRINT
2000 GOTO 1640
2010 H = INT(15+35*RND(NUM))
2020 H = H + 5 * C1
2030 IF V > H THEN 2530
2040 PRINT "THROUGH CURVE"
2050 PRINT
2060 LET Q1 = 0
2070 GOTO 1640
2080 E = E-(V-D)*3
2090 IF E < 0 THEN 2130
2100 PRINT "VEHICLE "; E; " FEET AHEAD"
2110 PRINT
2120 GOTO 1640
2130 IF V - D < 5 THEN 2210
2140 PRINT " VEHICLE PASSED BY ";
2150 D = V - D
2160 PRINT D;
2170 PRINT " MPH"
2180 PRINT
2190 R1 = 0
2200 GOTO 1640
2210 PRINT "VEHICLE BEING PASSED"
2220 D = INT(25+40*RND(NUM))
2230 PRINT "GREYHOUND BUS IN OTHER LANE";
2240 PRINT " DOING";
2250 PRINT D;
2260 PRINT " MPH"
2270 D = D + V
2280 PRINT "CRASH VELOCITY = ";
2290 PRINT D
2300 PRINT "YOUR RELATIVES TASK NOW IS TO PICK THE BURAL SITE"
2310 GOTO 2590
2320 PRINT "VEHICLE AHEAD 1000 FEET"
2330 PRINT
2340 D = INT(25+35*RND(NUM))
2350 R1 = 1
2360 GOTO 1640
2370 PRINT "WARNING - CURVE AHEAD"
2380 Q1 = 1
2390 PRINT
2400 GOTO 1640
2410 PRINT "EXCELLENT, BUT THERE IS MORE TO COME..."
2420 PRINT
2430 PRINT "YOU JUST RAN OUT OF GAS"
2440 GOTO 2580
2450 PRINT "BUT SOMEHOW YOU MADE IT"
2460 PRINT
2470 R1 = 0
2480 GOTO 1640
2490 PRINT
2500 PRINT
2510 PRINT "YOU MADE IT!!!"
2520 GOTO 2590
2530 PRINT "ARE TERRIBLE"
2540 H = H-5*C1
2550 PRINT H; " WAS THE SAFE SPEED THROUGH THE CURVE"
2560 PRINT V; " WAS YOUR SPEED. BY THE WAY, "
2570 GOTO 2300
2580 PRINT "YOU LEAD FOOTED KLUTZ"
2590 PRINT
2600 PRINT "^^^^^ PRESS THE SPACE BAR TO RALLY AGAIN ^^^^^"
2610 A$ = INKEY$
2620 IF A$ = "" THEN 2610
2630 IF A$ <> " " THEN 2700
2640 RESTORE
2650 GOTO 1000
2660 DATA 45, .53, 7
2670 DATA 60, .5, 9
2680 DATA 70, .41, 12
2690 DATA 80, .39, 15
2700 END
RUBIK.BAS
10 KEY OFF:CLS
20 PRINT"░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░"
30 PRINT"░┌───────────────────────────────────┐░"
40 PRINT"░│ │░"
50 PRINT"░│ 2032-A.BAS │░"
60 PRINT"░│ RUBIK'S CUBE │░"
70 PRINT"░│ │░"
80 PRINT"░│ │░"
90 PRINT"░│ BROUGHT TO YOU BY THE MEMBERS OF │░"
100 PRINT"░│ ▄▄▄▄▄ ▄▄▄▄▄ ▄▄▄▄▄ ▄▄▄▄▄ │░"
110 PRINT"░│ █ █ █ █ █ █ │░"
120 PRINT"░│ █ █▄▄▄█ █ █ █ │░"
130 PRINT"░│ █ █ █ █ █ │░"
140 PRINT"░│ ▄▄█▄▄ █ █▄▄▄▄ █▄▄▄█ │░"
150 PRINT"░│ │░"
160 PRINT"░│ International PC Owners │░"
170 PRINT"░│ │░"
180 PRINT"░│P.O. Box 10426, Pittsburgh PA 15234│░"
190 PRINT"░│ │░"
200 PRINT"░└───────────────────────────────────┘░"
210 PRINT"░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░"
220 PRINT
230 PRINT " PRESS ANY KEY TO CONTINUE
240 A$=INKEY$: IF A$="" THEN 240
250 CLS
1000 ' ***********************************
1010 ' *** RUBIK'S CUBE SIMULATOR *** Compliments of
1020 ' *** PC MAGAZINE *** UTAH BLUE CHIPS
1030 ' *** March. 1982 *** IBM PC Users Group
1040 ' *** Karl Koessel ***
1050 ' *** *** December 1982
1060 ' ***********************************
1070 SCREEN 0,1,0,0' Text mode,color on,active page,visual page
1080 COLOR 7,0,1' Print white on black.Border on color monitor
1090 CLS' Clear screen
1100 KEY OFF' Turn off soft keys display on line 25
1110 CLEAR,,2000' Clear some work space
1120 DEFINT A-Z' Variables are all integers
1130 DIM HOLD(20)' This array has subscripts greater than 10
1140 GOSUB 4260' Read constants
1150 GOSUB 4680' Initialize variables
1160 GOSUB 4740' Display title page
1170 GOSUB 4830' Input color of faces
1180 GOSUB 1620' Get a new cube
1190 '******************** INPUT ROUTINES *****************************
1200 '************ First input, requests a twist or command
1210 GOSUB 3780' Find proper location
1220 COLOR 23' Blink ...
1230 PRINT "Enter ";' ... beginning of input prompt
1240 COLOR 7' Normal foreground
1250 INPUT "a twist or command: ";TWIST$' Finish prompt, no question mark
1260 IF TWIST$="" THEN 1210' Operator silent? let's ask again
1270 GOSUB 2880' Input received clear input lines
1280 REQ$=TWIST$' Copy input for testing routines
1290 GOSUB 1840' Check for a valid command, if so
1300 IF D THEN 1210' it's done-go back to first input
1310 GOSUB 1930' Else check for a valid twist
1320 GOTO 1210' Loop back for next twist/command
1330 '************ Second input request ok to proceed
1340 GOSUB 3780' Find proper location
1350 PRINT "Press [RETURN] to twist the ";' Begin second input promt
1360 IF CLRMON THEN COLOR BR(F) ELSE COLOR 1' Emphasize the ...
1370 PRINT PLACE$(1,F);' ... name of the chosen face
1380 COLOR 7' Normal foreground
1390 PRINT " face ";' Middle of second input prompt
1400 IF CLRMON THEN COLOR BR(F) ELSE COLOR 1' Emphasize the ...
1410 PRINT DIRECTION$(OSO)' ... direction of the twist
1420 COLOR 7' Normal foreground
1430 IF CLRMON AND BIG THEN 1450' Skip spacing?
1440 PRINT SPC(13)' Print spaces on WIDTH 80 display
1450 PRINT "or enter a new twist or command: ";'Finish second input prompt.
1460 INPUT "",GO$' Comma instead of semicolon suppresses question mark!
1470 GOSUB 2880' Input received-clear input lines
1480 IF GO$="" THEN 1550' If blank, go finish twist, else
1490 REQ$=GO$' Copy input for testing routines
1500 GOSUB 1840' Check for a command, if so do it
1510 ON D GOTO 1340,1340,1340,1340,1530,1340,1340,1340,1550' and continue accordingly
1520 GOSUB 1930' else check for a valid twist
1530 RETURN' Invalid 2nd input, return to 1st
1540 '********* If GO$="" then finish the twist !
1550 GOSUB 3380' Finish turning outer circle
1560 GOSUB 3540' Finish turning chosen face
1570 GOSUB 2920' Turn off highlight flags
1580 GOSUB 3020' Update "twists so far'
1590 GOSUB 2610' Print new cube
1600 RETURN' Return to first input
1610 '*************** NEW-ING AND HELP SEQUENCES *************************
1620 GOSUB 2920' Turn off any highlights
1630 IF CLRMON THEN WIDTH 40:BIG=-1' Set to WIDTH 40.Set big flag on
1640 IF NOT BIG AND D=8 THEN RETURN' HELP is already on the screen
1650 GOSUB 3810' Clear screen, print instructions
1660 IF D<>8 THEN GOSUB 3630' If not HELP, reinitialize cubies
1670 IF NOT BIG THEN 1710' WIDTH 80 display skips waiting
1680 GOSUB 4040' Wait routine for WIDTH 40
1690 CLS' Clear screen
1700 GOSUB 4060' Print title on line 25
1710 GOSUB 2310' Reprint display
1720 RETURN' If NEW, return to 1st input. If HELP, return to what you were doing
1730 '******************* TURN INPUT INTO UPPER CASE **********************
1740 RQ$=""' Blank new (upper case) string
1750 FOR K=1 TO LEN(REQ$)' For each character of input
1760 RK$=MID$(REQ$,K,1)' Set a character
1770 IF RK$="'" THEN 1790' If prime, skip character change
1780 RK$=CHR$((ASC(RK$) AND 95))' Change to upper case character
1790 RQ$=RQ$+RK$' Add character to new string
1800 NEXT
1810 REQ$=RQ$' Set old string to a new string
1820 RETURN' All uppercase, ready to check
1830 '*************** TO CHECK FOR VALID COMMAND *************************
1840 GOSUB 1740' Convert input to upper case
1850 D=0' Valid command flag set to 'no'
1860 FOR DMI=1 TO 9' Check for valid command. if so,
1870 IF LEFT$(REQ$,LEN(DM$(DMI)))=DM$(DMI) THEN D=DMI' ...set flag to 'yes'
1880 NEXT
1890 IF D>0 AND D<4 THEN DM=D-1' If display type, set type flag
1900 ON D GOSUB 2610,2610,2610,2400,1620,2230,3060,1630,2370' Do it ...
1910 RETURN' ... and/or return
1920 '******************* TO CHECK FOR VALID TWIST ***********************
1930 GOSUB 2920' First turn off highlights that may be on
1940 '******** Then check if 2nd character valid and input length =2 or less
1950 IF MID$(REQ$,2,1)="" OR MID$(REQ$,2,1)="'" AND LEN(REQ$)<3 THEN 1980
1960 GOTO 2040' Invalid input
1970 '******** Check first character of input for a valid twist
1980 F=0' Deselect face
1990 FOR W=1 TO LEN(T$)' If twist is valid, set F to face number...
2000 IF LEFT$(REQ$,1)=MID$(T$,W,1) THEN F=W:TWIST$=REQ$' ...and reset TWIST$
2010 NEXT
2020 IF F THEN 2120' If face valid, go to prepare for 2nd input
2030 '********* Invalid input
2040 GOSUB 3780' Locate prompt line, print message
2050 PRINT "Input ";:COLOR 23:PRINT "NOT";:COLOR 7:PRINT " recognized"
2060 PRINT " One moment please..."
2070 GOSUB 2610' Reprint display without highlights
2080 GOSUB 2880' Clear input prompt lines Use Skip to resume/
2090 RETURN' Restart input
2100 '******************* PREPARE THE SELECTED TWIST ************************
2110 '********* Find direction, set offsets for inner & outer circular arrays
2120 IF MID$(REQ$,2,1)="'" THEN OSO=2:OSI=1 ELSE OSO=0:OSI=5
2130 '********* Then, for the outer circle ...
2140 GOSUB 3220' Decode array pointers
2150 GOSUB 3280' Set holding cells, turn highlight flags on
2160 '********** Then for the chosen face
2170 GOSUB 3480' Set holding cells, turn highlight flags on
2180 '********** Preparation done ...
2190 IF SKIP THEN 1550' If SKIP, no 2nd input, go finish twist now
2200 GOSUB 2610' Reprint display with highlights
2210 GOTO 1340' Go to second input
2220 '******************* THOSE USING COLOR CAN CHANGE WIDTH **************
2230 IF NOT CLRMON THEN 2350' This routine is for color monitors only
2240 BIG=NOT BIG' Reverse big flag. -1=WIDTH 40, 0=WIDTH 80
2250 IF BIG THEN WIDTH 40:GOTO 2280'Make the change to WIDTH 40, skip to 1260
2260 WIDTH 80' Make the change to WIDTH 80
2270 GOSUB 3810' For WIDTH 80, print instructions
2280 GOSUB 2310' Display reprinting routine
2290 RETURN' Go to second input
2300 '******************* DISPLAY REPRINTING ROUTINE **********************
2310 IF BIG THEN GOSUB 4080' Input list for WIDTH 40 display
2320 GOSUB 2410' Reprint labels or blanks without changing flag
2330 GOSUB 2610' Reprint the cube in the new width
2340 IF NOT BIG THEN GOSUB 3060'Reprint twists so far without adding a twist
2350 RETURN' Return to input
2360 '******************* REVERSE SKIP FLAG *******************************
2370 SKIP=NOT SKIP' -1=SKIP ON, 0=SKIP OFF. WHEN ON, PROGRAM SKIPS
2380 RETURN' second input (request to proceed)
2390 '******************* LABELS ON/OFF ROUTINE ***************************
2400 LABEL = NOT LABEL' Reverse label flag. -1=LABELS ON, 0=LABELS OFF
2410 FOR FA=1 TO 6' For each face
2420 IF BIG THEN LOCATE XBL(FA),YBL(FA):GOTO 2440' Locate for WIDTH 40 or
2430 LOCATE X(FA)+2,Y(FA)-1' Locate under each face &
2440 IF NOT LABEL GOTO 2480' If labels are wanted off
2450 IF CLRMON THEN COLOR BR(FA) ELSE COLOR 1' Emphasize (face's color)
2460 PRINT PLACE$(1,FA);' Print name of face
2470 GOTO 2490' Otherwise...
2480 PRINT SPC(5);' Print blanks over label
2490 NEXT
2500 IF NOT BIG THEN 2590' WIDTH 80 display is done
2510 FOR XBL=1 TO 2' `Front' face has pointer
2520 LOCATE XBL+4,19-XBL' between face and label
2530 IF NOT LABEL THEN GOTO 2560' If labels are wanted off
2540 COLOR BR(3)' Color of front face
2550 PRINT "/";' Make pointer of slashes
2560 PRINT " "' or blank out the slashes
2570 NEXT
2580 COLOR 7' Normal foreground
2590 RETURN' To what you were doing
2600 '******************* CUBE PRINTING TOURTINE **************************
2610 DB=1:DUB=0' Initialize display formatting variables
2620 IF BIG THEN BD=2' Double this variable for WIDTH 40
2630 FOR FA=1 TO 6' For each face
2640 FOR PP=0 TO 8 : P=XOP(PP)' For each cubie on this face
2650 IF BIG THEN FOR DUB=0 TO 1' To square cubie WIDTH 40 prints 2 lines
2660 LOCATE X(FA)+XOF(P)*DB+DUB-REL(FA)*BIG,Y(FA)+YOF(P)+RELY(FA)*BIG'Where
2670 BR=BR(FIX(CUBIE(FA,P,1)\10))' Set background color
2680 IF BR THEN COLOR CUBIE(FA,P,2)*-16,BR:GOTO 2700' Blink foreground?
2690 IF CUBIE(FA,P,2) THEN COLOR 0,7 ELSE COLOR 7,0' Turn on highlights?
2700 IF DUB THEN PRINT " ";:GOTO 2730' Bottom half of cubie
2710 IF DM THEN PRINT USING "\\"; CUBIE$(FA,P,DM); ELSE PRINT USING "##"; CUBIE(FA,P,1);' Print proper type cubie
2720 '************* These lines tidy diplay as colors/highlights change
2730 ON P+1 GOTO 2750,2740,2740,2820,2820,2820,2760,2760,2750' Nine cubies
2740 ND=1:GOTO 2780' Set the `NextDoor' variable for
2750 ND=4:GOTO 2780' six of them so following line
2760 ND=-1:GOTO 2780' can compare neighboring cubies
2770 ' Find proper colors for each side of spaces between cubies
2780 IF BR THEN COLOR BR,BR(FIX(CUBIE(FA,(P+ND) MOD 12,1)\10)) ELSE 2800
2790 PRINT CHR$(221);:GOTO 2820' Left half one color, right half another
2800 IF CUBIE(FA,P,2)=CUBIE(FA,(P+ND) MOD 12,2) THEN 2810 ELSE COLOR 7,0
2810 PRINT " ";' Single space lit or not, for monochrome
2820 IF BIG THEN NEXT ' WIDTH 40 prints 2 lines to square cubie
2830 NEXT
2840 NEXT
2850 COLOR 7,0' NormalizeFOREGROUND, BACKGROUND/
2860 RETURN
2870 '******************* CLEAR PROMPT/INPUT LINES ************************
2880 GOSUB 3780' Find proper location (differs on WIDTH 40)
2890 PRINT "One moment, please..."SPC(79)SPC(39)SPC(21)' Clears lines 15 & 16
2900 RETURN' If WIDTH 40 clears lines 19, 20 & 21
2910 '******************* TURN OFF HIGHLIGHT FLAGS ************************
2920 FOR J=1 TO 4' Four faces touch the chosen face and have ...
2930 FOR K=1 TO 3' Three consecutive cubies touching chosen face
2940 CUBIE(FACE(J),((POSITION(J)+K-2) MOD 8)+1,2)=0' Turn highlight...
2950 NEXT' ...flags `off'
2960 NEXT
2970 FOR P=1 TO 8' All cubies on chosen face except the center
2980 CUBIE(F,P,2)=0' Turn highlight flags `off'
2990 NEXT
3000 RETURN
3010 '******************* KEEP TRACK OF TWISTS ****************************
3020 TWISTSSOFAR$(AT)=TWISTSSOFAR$(AT)+TWIST$+" "' Add valid twist to records
3030 IF LEN(TWISTSSOFAR$(AT))>36 THEN AT=AT+1' Keeps 2 letter twists on 1 line
3040 IF BIG THEN RETURN' WIDTH 40 doesn't print new list
3050 '******************* PRINT LIST OF TWISTS SO FAR *********************
3060 LOCATE 18,1' Begin at bottom third of screen
3070 IF BIG THEN PRINT ' Down 1 more line for WIDTH 40
3080 COLOR 1' Enphasize list of twists header
3090 PRINT TWISTSSOFAR$(0);' Print header
3100 COLOR 7' Normal foreground
3110 PRINT SPC(13)' Put space between header & list
3120 FOR K=1 TO AT' For each half line of twists
3130 PRINT TWISTSSOFAR$(K);' Print 1st half line. If not big
3140 IF NOT BIG THEN PRINT TWISTSSOFAR$(K+1);:K=K+1' Print 2nd half line
3150 PRINT' Linefeed before end of WIDTH
3160 NEXT
3170 IF NOT BIG THEN RETURN' If WIDTH 80, all done, return
3180 GOSUB 4040' For WIDTH 40, wait to continue,
3190 GOSUB 2880' clear input rpompt lines,
3200 RETURN' then return
3210 '******************* DECODE ARRAY POINTERS FOR OUTER CIRCLE **********
3220 FOR J=1 TO 4' Four faces touch any chosen face
3230 FACE(J)=VAL(MID$(OC$(F),J*2-1,1))' Which four? Also, from each, the
3240 POSITION(J)=VAL(MID$(OC$(F),J*2,1))' first of the three consecutive
3250 NEXT ' cubies closest to a chosen face
3260 RETURN
3270 '******************* PREPARE TO TURN OUTER CIRCLE ********************
3280 FOR J=1 TO 4' Four faces touch chosen face...
3290 FOR K=1 TO 3' ...with three consecutive cubies
3300 ' Set cubie value in holding cell
3310 HOLD((J-1)*3+K)=CUBIE(FACE(J),((POSITION(J)+K-2) MOD 8)+1,1)
3320 ' Turn highlight flags `on'
3330 CUBIE(FACE(J),((POSITION(J)+K-2) MOD 8)+1,2)=-1
3340 NEXT
3350 NEXT
3360 RETURN
3370 '******************* FINISH TURNING OUTER CIRCLE *********************
3380 FOR J=1 TO 4' Four faces touch chosen face...
3390 FOR K=1 TO 3' ...with three consecutive cubies
3400 CUBIE(FACE(((J+OSO) MOD 4)+1),((POSITION(((J+OSO) MOD 4)+1)+K-2) MOD 8)+1,1)=HOLD((J-1)*3+K)' New value of each cubie
3410 FOR DMI=1 TO 2' Associated names follow
3420 CUBIE$(FACE(((J+OSO) MOD 4)+1),((POSITION(((J+OSO) MOD 4)+1) +K-2) MOD 8)+1,DMI)=PLACE$(DMI,FIX((HOLD((J-1)*3+K)\10)))
3430 NEXT
3440 NEXT
3450 NEXT
3460 RETURN
3470 '******************* PREPARE TO TURN CHOSEN FACE *********************
3480 FOR P=1 TO 8' All cubies on chosen face except the center
3490 HOLD(12+P)=CUBIE(F,P,1)' Put cubie value in holding cell
3500 CUBIE(F,P,2)=-1' Turn highlight flags `on'
3510 NEXT
3520 RETURN
3530 '******************* FINISH TURNING THE CHOSEN FACE ******************
3540 FOR P=1 TO 8' All cubies on chosen face except the center
3550 CUBIE(F,P,1)=HOLD(13+((P+OSI) MOD 8))' New value of each cubi
3560 FOR DMI=1 TO 2' Associated names follow
3570 CUBIE$(F,P,DMI)=PLACE$(DMI,FIX(CUBIE(F,P,1)\10))
3580 NEXT
3590 NEXT
3600 RETURN
3610 '******************* SET UP FRESH CUBE *******************************
3620 'Initialize cubie array to starting values
3630 FOR F=1 TO 6' Six faces on the cube
3640 FOR P=0 TO 9' Nine cubies per face
3650 CUBIE(F,P,1)=F*10+P' Two digit code
3660 FOR DMI=1 TO 2' Associated face ond color
3670 CUBIE$(F,P,DMI)=LEFT$(PLACE$(DMI,F),2)
3680 NEXT
3690 NEXT
3700 NEXT
3710 'Erase accumulated `twists so far'
3720 FOR K=1 TO AT
3730 TWISTSSOFAR$(K)=""' Erase each line
3740 NEXT
3750 AT=1' Begin line index at 1
3760 RETURN
3770 '******************* WIDTH 40 PROMPT LINE RELOCATER ******************
3780 IF BIG THEN LOCATE 19,1 ELSE LOCATE 15,1' Location of input prompt
3790 RETURN
3800 '******************* CLEAR SCREEN, PRINT INSTRUCTIONS ****************
3810 IF BIG THEN COLOR ,4:BG=3 ELSE BG=43' Set background color, offsets
3820 CLS' Clear screen
3830 LOCATE 1,1+BG:COLOR 1:PRINT TITLES$' Use emphasis where needed
3840 LOCATE 3,3+BG:COLOR 7:PRINT "Each twist is called by the first"
3850 LOCATE 4,BG:PRINT "letter of the face you wish to twist:"
3860 LOCATE 5,BG:COLOR 1:PRINT "U";:COLOR 7:PRINT " for the upper face, "; :COLOR 1:PRINT "L";:COLOR 7:PRINT " for the left"
3870 LOCATE 6,BG:PRINT "face, ";:COLOR 1:PRINT "F";:COLOR 7: :PRINT " for the front face, ";:COLOR 1:PRINT "R";:COLOR 7:PRINT" for the"
3880 LOCATE 7,BG:PRINT "right face, ";:COLOR 1:PRINT "B";:COLOR 7 :PRINT " for the back face and ";:COLOR 1:PRINT "D":COLOR 7
3890 LOCATE 8,BG:PRINT "for the downward face. The twists will"
3900 LOCATE 9,BG:PRINT "be clockwise. To make a counterclock-"
3910 LOCATE 10,BG:PRINT "wise twist, the letter is followed by"
3920 LOCATE 11,BG:PRINT "a ";:COLOR 1:PRINT "'";:COLOR 7:PRINT " (e.g. "; :COLOR 1:PRINT "L'";:COLOR 7:PRINT " ). To change the display,"
3930 LOCATE 12,BG:PRINT "enter either the word ";:COLOR 1:PRINT "Labels"; :COLOR 7:PRINT " or ";:COLOR 1:PRINT "Colors";:COLOR 7
3940 IF CLRMON THEN LOCATE 12,BG:PRINT "enter the word ";:COLOR 1:PRINT "Big";: COLOR 7:PRINT" or ";'Additional commands for color monitors
3950 LOCATE 13,BG:PRINT "or ";:COLOR 1:PRINT "Faces";:COLOR 7:PRINT " or "; :COLOR 1:PRINT"Codes";:COLOR 7:PRINT". Use ";:COLOR 1:PRINT "Skip";:COLOR 7 :PRINT " to resume/"
3960 LOCATE 14,BG:PRINT "skip verification. Use ";:COLOR 1:PRINT "New";:COLOR 7 :PRINT " to restart."
3970 IF NOT BIG THEN RETURN' The following commands are for WIDTH 40
3980 LOCATE 15,3:PRINT "To accommodate those using television ";
3990 PRINT " sets (i.e. confined to WIDTH 40), the ";
4000 PRINT " commands ";:COLOR 1:PRINT "List";:COLOR 7:PRINT " & ";:COLOR 1
4010 PRINT "Help";:COLOR 7:PRINT " have been added."
4020 RETURN
4030 '******************* WAIT TO CONTINUE ********************************
4040 LOCATE 25,9:PRINT "Press the spacebar to continue";
4050 IF INKEY$<>" " THEN 4050
4060 LOCATE 25,3:COLOR 1,4:PRINT TITLE$;:COLOR 7,0:RETURN
4070 '******************* WIDTH 40 INPUT LIST *****************************
4080 LOCATE 1,19:COLOR BR(2),,BR(4):PRINT "Twists: ";
4090 FOR LI=1 TO 2:LOCATE LI,25+LI
4100 FOR TI=1 TO 3
4110 FOR DI=0 TO 1
4120 COLOR BR((LI-1)*3+TI)
4130 IF DI THEN PU$="!' " ELSE PU$="! "
4140 PRINT USING PU$;MID$(T$,(LI-1)*3+TI);
4150 NEXT
4160 NEXT
4170 NEXT
4180 LOCATE 4,31:COLOR BR(6):PRINT "Commands:";
4190 FOR CM=1 TO 9
4200 LOCATE 5+CM,35
4210 COLOR BR(CM MOD 6+1)
4220 PRINT DM$(CM)
4230 NEXT
4240 COLOR 7:RETURN
4250 '******************* READ CONSTANTS **********************************
4260 FOR FACE=1 TO 6' Six faces
4270 READ PLACE$(1,FACE)' Name and number each face
4280 NEXT
4290 DATA "upper","left","front","right","back","down"
4300 FOR FACE=1 TO 6' If you have a cube that's used frequently,
4310 READ YOURS$(FACE)' put the six names of its colors as data on
4320 NEXT ' line 3310 in proper (see line 3270) order. See REMark on line 4160
4330 DATA "white","orange","blue","red","green","yellow"
4340 FOR P=1 TO 8' Eight cubies surround the center cubie
4350 READ XOF(P),YOF(P)' Offsets to locations of middle cubies for
4360 NEXT ' each neighboring cubie on the same face
4370 DATA -1,-3,-1,0,-1,3,0,3,1,3,1,0,1,-3,0,-3
4380 FOR P=0 TO 8' Modify order of printing cubies of each
4390 READ XOP(P)' face so that none of the lettered face
4400 NEXT ' labels are overwritten. See line 1615.
4410 DATA 1,2,3,8,0,4,7,6,5
4420 FOR FA=1 TO 6' Six faces
4430 READ XBL(FA),YBL(FA)' Locations of labels in WIDTH 40 mode
4440 NEXT
4450 DATA 2,4,13,3,4,19,13,19,13,27,17,17
4460 FOR FA=1 TO 6' Six faces
4470 READ REL(FA),RELY(FA)' Offsets from old to new locations of the
4480 NEXT ' middle cubies of each face
4490 DATA 1,2,3,0,3,2,3,4,3,6,5,2
4500 FOR F=1 TO 6' Six faces
4510 READ X(F),Y(F)' Locations of middle cubies for each face
4520 NEXT
4530 DATA 2,14,6,4,6,14,6,24,6,34,10,14
4540 FOR F=1 TO 6' Six faces
4550 READ OC$(F)' Codes with array indexes to outer circle around each face
4560 NEXT
4570 DATA "21514131","17376753","15476123","13576333","11276543","25354555"
4580 FOR DMI=1 TO 9' Nine recognized commands
4590 READ DM$(DMI)' Valid display types and other commands
4600 NEXT
4610 DATA CODE,FACE,COLOR,LABEL,NEW,BIG,LIST,HELP,SKIP
4620 DIRECTION$(0)="clockwise":DIRECTION$(2)="counterclockwise"
4630 T$="ULFRBD"' Valid twist requests
4640 TWISTSSOFAR$(0)="The list of twists so far :"
4650 TITLE$=SPACE$(7)+"RUBIK'S CUBE SIMULATOR"+SPACE$(7)
4660 RETURN
4670 '******************* INITIALIZE VARIABLES ****************************
4680 DEF SEG=0' Is color monitor present?
4690 IF (PEEK(&H410) AND &H30)<>&H30 THEN CLRMON=-1' If so, set clrmon flag on
4700 DM=1' Set display type for faces
4710 LABEL=-1' Turn label flag on
4720 RETURN
4730 '******************* TITLE PAGE **************************************
4740 IF CLRMON THEN COLOR 1,4:WIDTH 40:K=1 ELSE WIDTH 80:K=21
4750 CLS:LOCATE 3,2+K:PRINT TITLE$
4760 LOCATE 6,15+K:PRINT "PC MAGAZINE"
4770 LOCATE ,15+K:COLOR 7:PRINT "March, 1982"
4780 LOCATE 24,19+K:PRINT "press the space bar";
4790 IF INKEY$<>" " THEN 4790
4800 COLOR 7,0
4810 RETURN
4820 '******************* INPUT A COLOR FOR EACH FACE *********************
4830 CLS
4840 LOCATE 2,7+K
4850 K$="*** COLORING THE CUBE ***"
4860 'Is color monitor present?
4870 IF CLRMON THEN 4940
4880 'For those using a monochrome monitor
4890 PRINT K$
4900 LOCATE 9,K+6
4910 PRINT "(The name of each color":PRINT SPC(11+K)"should begin with a":
4920 PRINT SPC(16+K)"different letter.)":GOTO 5140
4930 'For those using a color monitor
4940 FOR L=1 TO 25
4950 COLOR (L MOD 7)+1
4960 PRINT MID$(K$,L,1);
4970 NEXT
4980 LOCATE 4,4
4990 FOR C=1 TO 7' Print a block of color and it's assigned number
5000 COLOR ,C
5010 PRINT " ";
5020 COLOR C,0
5030 PRINT "---";C;
5040 PRINT SPC(10)
5050 NEXT
5060 LOCATE 9,1' Print coloring directions
5070 COLOR 1,4
5080 PRINT "Choose each face's color by entering the";
5090 PRINT "appropiate number from the list above, ";
5100 COLOR 0,2
5110 PRINT "or just press [RETURN] for each face and";
5120 PRINT "the computer will choose the colors. "
5130 ' For everybody
5140 LOCATE 15,K
5150 COLOR 23,0:PRINT "Enter";
5160 COLOR 7:PRINT " a color for each face:"
5170 PRINT
5180 FOR FACE=1 TO 6
5190 LOCATE FACE+16,15+K:COLOR 0,7:PRINT USING " \ \";PLACE$(1,FACE);
5200 COLOR 7,0:INPUT ;" ";PLACE$(2,FACE)' Semicolon before input promt...
5210 IF CLRMON THEN 5250' ...suppresses the usual linefeed
5220 IF PLACE$(2,FACE)="" THEN PLACE$(2,FACE)=YOURS$(FACE)'See REMarks from lines 3280-3300 to name colors by default (null input) for frequently used cube
5230 GOTO 5300
5240 'Again for those using color
5250 IF PLACE$(2,FACE)="" THEN BR(FACE)=FACE:GOTO 5280 ELSE BR(FACE)=VAL(PLACE$(2,FACE))
5260 IF BR(FACE)<1 OR BR(FACE)>7 THEN LOCATE ,26:PRINT SPC(14):GOTO 5190
5270 IF ASC(PLACE$(2,FACE))<56 THEN PLACE$(2,FACE)=MID$(PLACE$(2,FACE),2)
5280 COLOR 7,0:LOCATE ,24:PRINT "= ";' Print `=' over question mark
5290 COLOR 0,BR(FACE):PRINT PLACE$(2,FACE)+" " 'Print name and block of
5300 NEXT ' selected color
5310 'And finally, again for everybody
5320 COLOR 7,0' Normalize color and
5330 LOCATE 15,K:PRINT "*Chosen ";' Write over blinking prompt
5340 LOCATE 9,K' This writes over coloring directions front ?
5350 COLOR 1,4
5360 PRINT " Check each face and its chosen color. ";
5370 COLOR 7,0
5380 PRINT SPC(79)" ";
5390 LOCATE 11,K
5400 COLOR 5,2
5410 PRINT "Press the spacebar to start over... or,";
5420 COLOR ,0
5430 PRINT SPC(79)" ";
5440 LOCATE 13,K
5450 COLOR 4,6
5460 PRINT "if everything is oaky press the `g' key."
5470 COLOR 7,0
5480 G$=INKEY$
5490 IF G$=" "THEN 4830
5500 IF G$<>"G" AND G$<>"g" THEN 5480
5510 RETURN
5520 END
SPELLER.BAS
10 CLS
20 A$=STRING$(80,205)
30 PRINT A$
40 PRINT TAB(28)"5006-A.BAS SPELLER-1"
50 COLOR 23,0,0
60 PRINT :PRINT :PRINT TAB(38)"IPCO"
70 COLOR 7,0,0
80 PRINT :PRINT :PRINT TAB(29)"INTERNATIONAL PC OWNERS"
90 PRINT :PRINT :PRINT TAB(17)"p.o. box 10426, pittsburgh, pennsylvania 15234"
100 PRINT A$
110 PRINT :PRINT :PRINT :PRINT :PRINT
120 PRINT TAB(28)"PRESS ANY KEY TO CONTINUE"
130 A$=INKEY$:IF A$="" THEN 130
140 CLS
1000 REM *** SPELLING PROGRAM ****
1010 REM *** PROGRAM WRITTEN BY RAYMOND H. SCHILLING ***
1020 REM 6065 REDFORD ROAD N.W.
1030 REM NORTH CANTON, OHIO 44720
1040 REM (216) 494-3289
1050 REM *** DATE WRITTEN 03/01/82 ***
1060 REM ************************************************************************
1070 REM ---- THIS PROGRAM ALLOWS YOU TO ENTER A LIST OF SPELLING WORDS
1080 REM AND THEN DISPLAYS EACH WORD FOR 2 SECONDS
1090 REM AND THEN THE STUDENT MUST TYPE THE WORD CORRECTLY ----
1100 REM ---- THE PROGRAM KEEPS TRACK OF THE NUMBER OF WORDS ANSWERED CORRECTLY
1110 REM AND REPEATS THE WORDS MISSED FOR THE STUDENT TO REDO ----
1120 REM ************************************************************************
1130 CLS
1140 KEY OFF
1150 DIM WORDS$(100)
1160 LET I=1
1170 PRINT "ENTER YOUR LIST OF SPELLING WORDS -- ONE WORD AFTER EACH QUESTION MARK"
1180 PRINT "ENTER THE WORD 'done' WHEN YOU HAVE FINISHED ENTERING ALL YOUR SPELLING WORDS"
1190 PRINT
1200 INPUT WORDS$(I)
1210 IF WORDS$(I)="DONE" THEN 1250
1220 IF WORDS$(I)="done" THEN 1250
1230 I=I+1
1240 GOTO 1200
1250 CLS
1260 PRINT
1270 PRINT "HIT ANY KEY WHEN YOU ARE READY TO BEGIN."
1280 A$=INKEY$
1290 IF A$="" THEN 1280
1300 I=I-1
1310 J=0:K=0
1320 CLS
1330 J=J+1
1340 TIME$="00:00:00"
1350 WHILE TIME$<"00:00:02"
1360 COLOR 15,0
1370 LOCATE 10,(39-LEN(WORDS$(J))/2)
1380 PRINT WORDS$(J)
1390 WEND
1400 CLS
1410 LOCATE 11,31
1420 FOR M=1 TO 18:PRINT CHR$(223);:NEXT M
1430 LOCATE 11,30:PRINT CHR$(221):LOCATE 11,50:PRINT CHR$(221)
1440 LOCATE 12,30:PRINT CHR$(221):LOCATE 12,50:PRINT CHR$(221)
1450 LOCATE 14,30:PRINT CHR$(221):LOCATE 14,50:PRINT CHR$(221)
1460 LOCATE 15,30:PRINT CHR$(221):LOCATE 15,50:PRINT CHR$(221)
1470 LOCATE 15,31
1480 FOR M=1 TO 18:PRINT CHR$(220);:NEXT M
1490 COLOR 15,0
1500 LOCATE 13,31
1510 INPUT R$
1520 COLOR 7,0
1530 IF R$=WORDS$(J) THEN C=C+1:GOTO 1560
1540 K=K+1
1550 LET WRONG$(K)=WORDS$(J)
1560 IF J<>I THEN 1320
1570 CLS
1580 BEEP:BEEP:BEEP
1590 PRINT "YOU SPELLED ";C;" WORDS CORRECTLY OUT OF A LIST OF ";I;" WORDS."
1600 PRINT
1610 IF C=I THEN 1790
1620 PRINT "HERE ARE THE WORDS YOU MISSED."
1630 PRINT "TYPE THE WORD CORRECTLY AFTER THE QUESTION MARK!"
1640 PRINT
1650 LET J=0
1660 LET J=J+1
1670 PRINT WRONG$(J)
1680 PRINT
1690 INPUT R$
1700 IF R$=WRONG$(J) THEN 1720
1710 PRINT "WRONG! TRY AGAIN.":GOTO 1680
1720 BEEP
1730 PRINT "GOOD! THAT'S CORRECT."
1740 PRINT
1750 IF K=J THEN 1810
1760 PRINT "HERE'S THE NEXT WORD."
1770 PRINT
1780 GOTO 1660
1790 PRINT
1800 BEEP:PRINT "CONGRATULATIONS! YOU SPELLED THEM ALL CORRECTLY"
1810 PRINT
1820 BEEP
1830 PRINT "THAT'S ALL FOR NOW!"
1840 KEY ON
TICTACTO.BAS
100 CLS
110 A$=STRING$(80,205)
120 PRINT A$
130 PRINT TAB(29)"TIC TAC TOE 2010-A.BAS "
140 COLOR 23,0,0
150 PRINT :PRINT :PRINT TAB(38)"IPCO"
160 COLOR 7,0,0
170 PRINT :PRINT :PRINT TAB(29)"INTERNATIONAL PC OWNERS"
180 PRINT :PRINT :PRINT TAB(17)"p.o. box 10426, pittsburgh, pennsylvania 15234"
190 PRINT A$
200 PRINT :PRINT :PRINT :PRINT :PRINT
210 PRINT TAB(28)"PRESS ANY KEY TO CONTINUE"
220 A$=INKEY$:IF A$="" THEN 220
230 CLS
240 REM **************************************************
250 REM * Name - Tic Tac Toe *
260 REM * Author - David R Quiggin *
270 REM * Remarks - If you like this game, I am selling *
280 REM * a package of 10 games and programs on disk *
290 REM * for $19.95 plus 2.00 shipping and handling. *
300 REM * To order or request more information send to: *
310 REM * Pittsburgh Computer Exchange *
320 REM * 112 Marble Drive *
330 REM * Bridgeville, Pa, 15017 *
340 REM **************************************************
350 SCREEN 0,0,0:KEY OFF: CLS: WIDTH 80
360 DIM SQ(9) 'store whether positon used
370 GOSUB 5950 'seed random nbr
380 CLS
390 GOSUB 3670 'initialize
400 LOCATE 5,47,0:PRINT "Choose which game you want"
410 LOCATE 7,47,0:PRINT " 1 - 2 persons play"
420 LOCATE 9,47,0:PRINT " 2 - Basic game against the"
430 LOCATE 10,47,0:PRINT " computer"
440 LOCATE 12,47,0:PRINT " 3 - More difficult game"
450 LOCATE 13,47,0:PRINT " against the computer"
460 LOCATE 15,47,0:PRINT " 4 - Most difficult game"
470 LOCATE 16,47,0:PRINT " against the computer"
480 LOCATE 18,47,0:PRINT " 5 - Instructions"
490 LOCATE 20,50,0:PRINT "Which do you want?"
500 LOCATE 21,50,0:PRINT " Enter the number __"
510 CH$=INKEY$:IF CH$="" THEN GOTO 510 'loop to sense input
520 IF CH$=CHR$(27) THEN GOTO 710 'ESC to end
530 IF CH$="1" OR CH$="2" OR CH$="3" OR CH$="4" OR CH$="5" THEN GOTO 560
540 LOCATE 22,50,0:PRINT "Error, please reenter"
550 GOTO 490
560 IF CH$="1" THEN GOSUB 1390 ' 2 player game
570 IF CH$="2" THEN GOSUB 710 ' Basic game against computer
580 IF CH$="3" THEN GOSUB 710 ' more difficult game against computer
590 IF CH$="4" THEN GOSUB 5110 ' Most difficult game against computer
600 IF CH$="5" THEN GOSUB 4070:GOTO 400 ' give instructions
610 LOCATE 20,47,0:PRINT " Play again (Y or N)"
620 YN$=INKEY$
630 IF YN$="" THEN GOTO 620
640 IF YN$="Y" OR YN$="y" THEN GOTO 380
650 IF YN$="1" OR YN$="2" OR YN$="3" OR YN$="4" THEN GOTO 660 ELSE GOTO 690
660 CH$=YN$
670 CLS:GOSUB 3670 'initialize
680 GOTO 560 'start the appropriate game (without having to go thru menu)
690 CHAIN "@GAMES"
700 END '******
710 REM -- Games 2 and 3 against the Computer Subroutine ---
720 FOR I=1 TO 9 'initialize array for storing moves
730 SQ(I)=0
740 NEXT I
750 GOSUB 4230 'erase box
760 REM X First move
770 GOSUB 1920 'ask for and make X move
780 REM O Second move Computer move
790 I=INT((RND*8)+1) 'pick random computer move
800 IF SQ(I) <> 0 THEN GOTO 790 'if square filled pick another
810 MOVE=I
820 GOSUB 3360 'load coordinates for move
830 GOSUB 3560 'draw move
840 REM X Third move
850 GOSUB 1920 'ask for and make X move
860 REM O Fourth move, Computer move
870 IF CH$="2" THEN GOTO 900 'easier game
880 MOVE=0:GOSUB 4280 'check for 2 in row, win and stop opponent
890 IF MOVE=0 THEN GOTO 900 ELSE GOTO 930 'if not 2 in row do random
900 I=INT((RND*8)+1) 'pick random computer move
910 IF SQ(I) <> 0 THEN GOTO 900 'if square filled pick another
920 MOVE=I
930 GOSUB 3360:GOSUB 3560 'make move
940 REM X Fifth move
950 GOSUB 1920 'ask for and make X move
960 WINSW=0:GOSUB 2270 'check for win
970 IF WINSW=4 THEN GOTO 1340 'X wins
980 REM O Sixth move, Computer move
990 IF CH$="2" THEN GOTO 1020 'easier game
1000 MOVE=0:GOSUB 4280 'check for 2 in row, win and stop opponent
1010 IF MOVE=0 THEN GOTO 1020 ELSE GOTO 1050 'if not 2 in row do random
1020 I=INT((RND*8)+1) 'pick random computer move
1030 IF SQ(I) <> 0 THEN GOTO 1020 'if square filled pick another
1040 MOVE=I
1050 GOSUB 3360:GOSUB 3560 'make move
1060 WINSW=0:GOSUB 2270 'check for win
1070 IF WINSW=1 THEN GOTO 1300 'Computer wins
1080 REM X Seventh move
1090 GOSUB 1920 'ask for and make X move
1100 WINSW=0:GOSUB 2270 'check for win
1110 IF WINSW=4 THEN GOTO 1340 'X wins
1120 REM O Eighth move, Computer move
1130 IF CH$="2" THEN GOTO 1160 'easier game
1140 MOVE=0:GOSUB 4280 'check for 2 in row, win and stop opponent
1150 IF MOVE=0 THEN GOTO 1160 ELSE GOTO 1190 'if not 2 in row do random
1160 I=INT((RND*8)+1) 'pick random computer move
1170 IF SQ(I) <> 0 THEN GOTO 1160 'if square filled pick another
1180 MOVE=I
1190 GOSUB 3360:GOSUB 3560 'make move
1200 WINSW=0:GOSUB 2270 'check for win
1210 IF WINSW=1 THEN GOTO 1300 'Computer wins
1220 REM X Nineth move
1230 GOSUB 1920 'ask for and make X move
1240 WINSW=0:GOSUB 2270 'check for win
1250 IF WINSW=4 THEN GOTO 1340 'X wins
1260 REM -- TIE --
1270 BEEP
1280 LOCATE 12,55,0:PRINT " TIE "
1290 GOTO 1370
1300 REM -- O WINS --
1310 BEEP
1320 LOCATE 12,55,0:PRINT " O - WINS"
1330 GOTO 1370
1340 REM -- X WINS --
1350 BEEP
1360 LOCATE 12,55,0:PRINT " X - WINS"
1370 COLOR 7,0 'Turn of blinking
1380 RETURN '----
1390 REM -- 2 player game Subroutine --
1400 FOR I=1 TO 9 'initialize array
1410 SQ(I)=0
1420 NEXT I
1430 MOVECNTR=0
1440 XOSW=4 'set to x move first
1450 GOSUB 4230 'erase box
1460 REM X First move
1470 GOSUB 1920 'ask for and make X move
1480 WINSW=0:GOSUB 2270 'check for win
1490 IF WINSW=4 THEN GOTO 1880 'X wins
1500 REM O Second move
1510 GOSUB 2090 'ask for and make O move
1520 WINSW=0:GOSUB 2270 'check for win
1530 IF WINSW=1 THEN GOTO 1850 'O wins
1540 REM X Third move
1550 GOSUB 1920 'ask for and make X move
1560 WINSW=0:GOSUB 2270 'check for win
1570 IF WINSW=4 THEN GOTO 1880 'X wins
1580 REM O Fourth move
1590 GOSUB 2090 'ask for and make O move
1600 WINSW=0:GOSUB 2270 'check for win
1610 IF WINSW=1 THEN GOTO 1850 'O wins
1620 REM X Fifth move
1630 GOSUB 1920 'ask for and make X move
1640 WINSW=0:GOSUB 2270 'check for win
1650 IF WINSW=4 THEN GOTO 1880 'X wins
1660 REM O Sixth move
1670 GOSUB 2090 'ask for and make O move
1680 WINSW=0:GOSUB 2270 'check for win
1690 IF WINSW=1 THEN GOTO 1850 'O wins
1700 REM X Seventh move
1710 GOSUB 1920 'ask for and make X move
1720 WINSW=0:GOSUB 2270 'check for win
1730 IF WINSW=4 THEN GOTO 1880 'X wins
1740 REM O Eighth move
1750 GOSUB 2090 'ask for and make O move
1760 WINSW=0:GOSUB 2270 'check for win
1770 IF WINSW=1 THEN GOTO 1850 'O wins
1780 REM X Nineth move
1790 GOSUB 1920 'ask for and make X move
1800 WINSW=0:GOSUB 2270 'check for win
1810 IF WINSW=4 THEN GOTO 1880 'X wins
1820 REM
1830 BEEP:LOCATE 12,55,0:PRINT " TIE ":BEEP
1840 GOTO 1900
1850 LOCATE 12,55,0:PRINT " O - WINS"
1860 BEEP
1870 GOTO 1900
1880 LOCATE 12,55,0:PRINT " X - WINS"
1890 BEEP
1900 COLOR 7,0 'return to default color, ie. end flashing
1910 RETURN '----
1920 REM --- Do X move subroutine ---
1930 LOCATE 7,46,0:PRINT ERASE1$
1940 LOCATE 8,46,0:PRINT ERASE1$
1950 LOCATE 9,46,0:PRINT ERASE1$
1960 LOCATE 7,47,0:PRINT "Enter move for X player"
1970 IN1$=INKEY$
1980 IF IN1$="" GOTO 1970
1990 IF ASC(IN1$) < 49 THEN GOTO 1970 'insure number 1-9
2000 IF ASC(IN1$) > 57 THEN GOTO 1970
2010 MOVE=VAL(IN1$) 'convert to number
2020 IN1$="" 'clear out
2030 SW=0 'set valid move switch
2040 GOSUB 3360 'load coordinates for move
2050 IF SW=1 THEN GOSUB 3470:GOTO 2080
2060 LOCATE 8,47,0:PRINT "That square filled, reenter"
2070 GOTO 1960
2080 RETURN '----
2090 REM --- Do O move Subroutine ---
2100 LOCATE 7,46,0:PRINT ERASE1$
2110 LOCATE 8,46,0:PRINT ERASE1$
2120 LOCATE 9,46,0:PRINT ERASE1$
2130 LOCATE 7,47,0:PRINT "Enter move for O player"
2140 IN1$=INKEY$
2150 IF IN1$="" GOTO 2140
2160 IF ASC(IN1$) < 49 THEN GOTO 2140 'insure number 1-9
2170 IF ASC(IN1$) > 57 THEN GOTO 2140
2180 MOVE=VAL(IN1$) 'convert to number
2190 IN1$="" 'clear out
2200 SW=0 'set valid move switch
2210 GOSUB 3360 'load coordinates for move
2220 IF SW=1 THEN GOSUB 3560:GOTO 2260
2230 LOCATE 8,47,0:PRINT "That square filled, reenter"
2240 LOCATE 7,46,0:PRINT ERASE1$ 'erase any err messages
2250 GOTO 2130
2260 RETURN '----
2270 REM --- Scan for a win ---
2280 IF SQ(1)=1 AND SQ(5)=1 AND SQ(9)=1 THEN GOTO 2290 ELSE GOTO 2350 'O wins
2290 WINSW=1
2300 COLOR 23
2310 R=2:C=14:GOSUB 3560 'draw flashing O in sq 1
2320 R=10:C=22:GOSUB 3560 'O in sq 5
2330 R=18:C=30:GOSUB 3560 'O in sq 9
2340 GOTO 3350
2350 IF SQ(7)=1 AND SQ(5)=1 AND SQ(3)=1 THEN GOTO 2360 ELSE GOTO 2420
2360 WINSW=1
2370 COLOR 23
2380 R=18:C=14:GOSUB 3560 'draw flashing O in sq 7
2390 R=10:C=22:GOSUB 3560 'sq 5
2400 R=2:C=30:GOSUB 3560 'sq 3
2410 GOTO 3350
2420 IF SQ(1)=1 AND SQ(2)=1 AND SQ(3)=1 THEN GOTO 2430 ELSE GOTO 2490
2430 WINSW=1
2440 COLOR 23
2450 R=2:C=14:GOSUB 3560 'draw flashing O in sq 1
2460 R=2:C=22:GOSUB 3560 'sq 2
2470 R=2:C=30:GOSUB 3560 'sq 3
2480 GOTO 3350
2490 IF SQ(4)=1 AND SQ(5)=1 AND SQ(6)=1 THEN GOTO 2500 ELSE GOTO 2560
2500 WINSW=1
2510 COLOR 23
2520 R=10:C=14:GOSUB 3560 'draw flashing O in sq 4
2530 R=10:C=22:GOSUB 3560 'sq 5
2540 R=10:C=30:GOSUB 3560 'sq 6
2550 GOTO 3350
2560 IF SQ(7)=1 AND SQ(8)=1 AND SQ(9)=1 THEN GOTO 2570 ELSE GOTO 2630
2570 WINSW=1
2580 COLOR 23
2590 R=18:C=14:GOSUB 3560 'draw flashing O in sq 7
2600 R=18:C=22:GOSUB 3560 'sq 8
2610 R=18:C=30:GOSUB 3560 'sq 9
2620 GOTO 3350
2630 IF SQ(1)=1 AND SQ(4)=1 AND SQ(7)=1 THEN GOTO 2640 ELSE GOTO 2700
2640 WINSW=1
2650 COLOR 23
2660 R=2:C=14:GOSUB 3560 'flashing O in sq 1
2670 R=10:C=14:GOSUB 3560 'sq 4
2680 R=18:C=14:GOSUB 3560 'sq 7
2690 GOTO 3350
2700 IF SQ(2)=1 AND SQ(5)=1 AND SQ(8)=1 THEN GOTO 2710 ELSE GOTO 2770
2710 WINSW=1
2720 COLOR 23
2730 R=2:C=22:GOSUB 3560 'flashing O in sq 2
2740 R=10:C=22:GOSUB 3560 'sq 5
2750 R=18:C=22:GOSUB 3560 'sq 8
2760 GOTO 3350
2770 IF SQ(3)=1 AND SQ(6)=1 AND SQ(9)=1 THEN GOTO 2780 ELSE GOTO 2840
2780 WINSW=1
2790 COLOR 23
2800 R=2:C=30:GOSUB 3560 'flashing O in sq 3
2810 R=10:C=30:GOSUB 3560 'sq 6
2820 R=18:C=30:GOSUB 3560 'sq 9
2830 GOTO 3350
2840 REM
2850 IF SQ(1)=4 AND SQ(5)=4 AND SQ(9)=4 THEN GOTO 2860 ELSE GOTO 2920 'X wins
2860 WINSW=4
2870 COLOR 23
2880 R=2:C=14:GOSUB 3470 'flashing X in sq 1
2890 R=10:C=22:GOSUB 3470 'sq 5
2900 R=18:C=30:GOSUB 3470 'sq 9
2910 GOTO 3350
2920 IF SQ(7)=4 AND SQ(5)=4 AND SQ(3)=4 THEN GOTO 2930 ELSE GOTO 2990
2930 WINSW=4
2940 COLOR 23
2950 R=18:C=14:GOSUB 3470 'flashing X in sq 7
2960 R=10:C=22:GOSUB 3470 'sq 5
2970 R=2:C=30:GOSUB 3470 'sq 3
2980 GOTO 3350
2990 IF SQ(1)=4 AND SQ(2)=4 AND SQ(3)=4 THEN GOTO 3000 ELSE GOTO 3060
3000 WINSW=4
3010 COLOR 23
3020 R=2:C=14:GOSUB 3470 'flashing X in sq 1
3030 R=2:C=22:GOSUB 3470 'sq 2
3040 R=2:C=30:GOSUB 3470 'sq 3
3050 GOTO 3350
3060 IF SQ(4)=4 AND SQ(5)=4 AND SQ(6)=4 THEN GOTO 3070 ELSE GOTO 3120
3070 WINSW=4:COLOR 23
3080 R=10:C=14:GOSUB 3470 'flashing X in sq 4
3090 R=10:C=22:GOSUB 3470 'sq 5
3100 R=10:C=30:GOSUB 3470 'sq 6
3110 GOTO 3350
3120 IF SQ(7)=4 AND SQ(8)=4 AND SQ(9)=4 THEN GOTO 3130 ELSE GOTO 3180
3130 WINSW=4:COLOR 23
3140 R=18:C=14:GOSUB 3470 'flashing X in sq 7
3150 R=18:C=22:GOSUB 3470 'sq 8
3160 R=18:C=30:GOSUB 3470 'sq 9
3170 GOTO 3350
3180 IF SQ(1)=4 AND SQ(4)=4 AND SQ(7)=4 THEN GOTO 3190 ELSE GOTO 3240
3190 WINSW=4:COLOR 23
3200 R=2:C=14:GOSUB 3470 'flashing X in sq 1
3210 R=10:C=14:GOSUB 3470 'sq 4
3220 R=18:C=14:GOSUB 3470 'sq 7
3230 GOTO 3350
3240 IF SQ(2)=4 AND SQ(5)=4 AND SQ(8)=4 THEN GOTO 3250 ELSE GOTO 3300
3250 WINSW=4:COLOR 23
3260 R=2:C=22:GOSUB 3470 'flashing X in sq 2
3270 R=10:C=22:GOSUB 3470 'sq 5
3280 R=18:C=22:GOSUB 3470 'sq 8
3290 GOTO 3350
3300 IF SQ(3)=4 AND SQ(6)=4 AND SQ(9)=4 THEN GOTO 3310 ELSE GOTO 3350
3310 WINSW=4:COLOR 23
3320 R=2:C=30:GOSUB 3470 'draw flashing X in sq 3
3330 R=10:C=30:GOSUB 3470 'sq 6
3340 R=18:C=30:GOSUB 3470 'sq 9
3350 RETURN '----
3360 REM --- Load coordinates for move ---
3370 IF MOVE=1 AND SQ(1)=0 THEN R=2:C=14:SW=1:GOTO 3460
3380 IF MOVE=2 AND SQ(2)=0 THEN R=2:C=22:SW=1:GOTO 3460
3390 IF MOVE=3 AND SQ(3)=0 THEN R=2:C=30:SW=1:GOTO 3460
3400 IF MOVE=4 AND SQ(4)=0 THEN R=10:C=14:SW=1:GOTO 3460
3410 IF MOVE=5 AND SQ(5)=0 THEN R=10:C=22:SW=1:GOTO 3460
3420 IF MOVE=6 AND SQ(6)=0 THEN R=10:C=30:SW=1:GOTO 3460
3430 IF MOVE=7 AND SQ(7)=0 THEN R=18:C=14:SW=1:GOTO 3460
3440 IF MOVE=8 AND SQ(8)=0 THEN R=18:C=22:SW=1:GOTO 3460
3450 IF MOVE=9 AND SQ(9)=0 THEN R=18:C=30:SW=1:GOTO 3460
3460 RETURN '----
3470 REM --- Draw X Subroutine ---
3480 FOR I=0 TO 4
3490 LOCATE R+I,C+I,0:PRINT CHR$(D)
3500 LOCATE R+I,C+4-I,0:PRINT CHR$(D)
3510 NEXT I
3520 SQ(MOVE)=4 '4 represents X, 1 represents O and 0 means empty
3530 XOSW=1 'set next move to be Os
3540 MOVECNTR=MOVECNTR+1
3550 RETURN '----
3560 REM --- Draw O Subroutine ---
3570 FOR I=0 TO 4
3580 LOCATE R,C+I,0:PRINT CHR$(D)
3590 LOCATE R+I,C+4,0:PRINT CHR$(D)
3600 LOCATE R+4,C+4-I,0:PRINT CHR$(D)
3610 LOCATE R+4-I,C,0:PRINT CHR$(D)
3620 NEXT I
3630 SQ(MOVE)=1 '4 represents X, 1 represents O and 0 means empty
3640 XOSW=1 'set next move to be Os
3650 MOVECNTR=MOVECNTR+1
3660 RETURN '----
3670 REM -- Subroutine to draw lines and initialize ---
3680 D=219 'density of Xs and Os
3690 R=10
3700 C=22
3710 FILLED=0
3720 ERASE1$=" " 'used to erase box
3730 FOR I=0 TO 9
3740 SQ(I)=0
3750 NEXT I
3760 FOR I=13 TO 35
3770 LOCATE 8,I,0:PRINT CHR$(219)
3780 LOCATE 16,I,0:PRINT CHR$(219)
3790 NEXT I
3800 FOR I=1 TO 23
3810 LOCATE I,20,0:PRINT CHR$(219)
3820 LOCATE I,28,0:PRINT CHR$(219)
3830 NEXT I
3840 LOCATE 7,16,0:PRINT "1"
3850 LOCATE 7,24,0:PRINT "2"
3860 LOCATE 7,32,0:PRINT "3"
3870 LOCATE 15,16,0:PRINT "4"
3880 LOCATE 15,24,0:PRINT "5"
3890 LOCATE 15,32,0:PRINT "6"
3900 LOCATE 23,16,0:PRINT "7"
3910 LOCATE 23,24,0:PRINT "8"
3920 LOCATE 23,32,0:PRINT "9"
3930 FOR I=2 TO 22
3940 LOCATE I,45,0:PRINT CHR$(186)
3950 LOCATE I,75,0:PRINT CHR$(186)
3960 NEXT I
3970 LOCATE 1,45,0:PRINT CHR$(201)
3980 LOCATE 1,75,0:PRINT CHR$(187)
3990 LOCATE 23,45,0:PRINT CHR$(200)
4000 LOCATE 23,75,0:PRINT CHR$(188)
4010 FOR I=46 TO 74
4020 LOCATE 1,I,0:PRINT CHR$(205)
4030 LOCATE 23,I,0:PRINT CHR$(205)
4040 NEXT I
4050 LOCATE 3,55,0:PRINT "TIC TAC TOE"
4060 RETURN '----
4070 REM --- Print instructions subroutine ---
4080 GOSUB 4230 'erase box
4090 LOCATE 5,47,0:PRINT "WIN - by placing three X or"
4100 LOCATE 6,47,0:PRINT " O in a straight line"
4110 LOCATE 7,47,0:PRINT " (vertical, horizontal"
4120 LOCATE 8,47,0:PRINT " or diagonal)"
4130 LOCATE 10,47,0:PRINT "Move by entering the number"
4140 LOCATE 11,47,0:PRINT " of the square you want to"
4150 LOCATE 12,47,0:PRINT " move to."
4160 LOCATE 14,47,0:PRINT "You cannot move to a square"
4170 LOCATE 15,47,0:PRINT " that is filled."
4180 LOCATE 18,47,0:PRINT "Press any key to continue."
4190 DEL$=INKEY$:IF DEL$="" THEN GOTO 4190 'sense input - delay only
4200 GOSUB 4230 'erase box
4210 RETURN '----
4220 REM
4230 REM --- Erase box Subroutine ---
4240 FOR I=4 TO 22
4250 LOCATE I,46,0:PRINT ERASE1$
4260 NEXT I
4270 RETURN '----
4280 REM --- Check for Win move for O ---
4290 IF SQ(1)+SQ(2)+SQ(3)=2 GOTO 4300 ELSE GOTO 4340
4300 IF SQ(1)=0 THEN MOVE=1
4310 IF SQ(2)=0 THEN MOVE=2
4320 IF SQ(3)=0 THEN MOVE=3
4330 GOTO 5100 ' out of subroutine
4340 IF SQ(4)+SQ(5)+SQ(6)=2 GOTO 4350 ELSE GOTO 4390
4350 IF SQ(4)=0 THEN MOVE=4
4360 IF SQ(5)=0 THEN MOVE=5
4370 IF SQ(6)=0 THEN MOVE=6
4380 GOTO 5100 ' out
4390 IF SQ(7)+SQ(8)+SQ(9)=2 GOTO 4400 ELSE GOTO 4440
4400 IF SQ(7)=0 THEN MOVE=7
4410 IF SQ(8)=0 THEN MOVE=8
4420 IF SQ(9)=0 THEN MOVE=9
4430 GOTO 5100 ' out
4440 IF SQ(1)+SQ(4)+SQ(7)=2 GOTO 4450 ELSE GOTO 4490
4450 IF SQ(1)=0 THEN MOVE=1
4460 IF SQ(4)=0 THEN MOVE=4
4470 IF SQ(7)=0 THEN MOVE=7
4480 GOTO 5100 ' out
4490 IF SQ(2)+SQ(5)+SQ(8)=2 GOTO 4500 ELSE GOTO 4540
4500 IF SQ(2)=0 THEN MOVE=2
4510 IF SQ(5)=0 THEN MOVE=5
4520 IF SQ(8)=0 THEN MOVE=8
4530 GOTO 5100 ' out
4540 IF SQ(3)+SQ(6)+SQ(9)=2 GOTO 4550 ELSE GOTO 4590
4550 IF SQ(3)=0 THEN MOVE=3
4560 IF SQ(6)=0 THEN MOVE=6
4570 IF SQ(9)=0 THEN MOVE=9
4580 GOTO 5100 ' out
4590 IF SQ(1)+SQ(5)+SQ(9)=2 GOTO 4600 ELSE GOTO 4640
4600 IF SQ(1)=0 THEN MOVE=1
4610 IF SQ(5)=0 THEN MOVE=5
4620 IF SQ(9)=0 THEN MOVE=9
4630 GOTO 5100 ' out
4640 IF SQ(3)+SQ(5)+SQ(7)=2 GOTO 4650 ELSE GOTO 4710
4650 IF SQ(3)=0 THEN MOVE=3
4660 IF SQ(5)=0 THEN MOVE=5
4670 IF SQ(7)=0 THEN MOVE=7
4680 GOTO 5100 ' out of subroutine
4690 REM
4700 REM -- Following checks to stop 2 Xs in a row --
4710 IF SQ(1)+SQ(2)+SQ(3)=8 GOTO 4720 ELSE GOTO 4760
4720 IF SQ(1)=0 THEN MOVE=1
4730 IF SQ(2)=0 THEN MOVE=2
4740 IF SQ(3)=0 THEN MOVE=3
4750 GOTO 5100 ' out of subroutine
4760 IF SQ(4)+SQ(5)+SQ(6)=8 GOTO 4770 ELSE GOTO 4810
4770 IF SQ(4)=0 THEN MOVE=4
4780 IF SQ(5)=0 THEN MOVE=5
4790 IF SQ(6)=0 THEN MOVE=6
4800 GOTO 5100 ' out
4810 IF SQ(7)+SQ(8)+SQ(9)=8 GOTO 4820 ELSE GOTO 4860
4820 IF SQ(7)=0 THEN MOVE=7
4830 IF SQ(8)=0 THEN MOVE=8
4840 IF SQ(9)=0 THEN MOVE=9
4850 GOTO 5100 ' out
4860 IF SQ(1)+SQ(4)+SQ(7)=8 GOTO 4870 ELSE GOTO 4910
4870 IF SQ(1)=0 THEN MOVE=1
4880 IF SQ(4)=0 THEN MOVE=4
4890 IF SQ(7)=0 THEN MOVE=7
4900 GOTO 5100 ' out
4910 IF SQ(2)+SQ(5)+SQ(8)=8 GOTO 4920 ELSE GOTO 4960
4920 IF SQ(2)=0 THEN MOVE=2
4930 IF SQ(5)=0 THEN MOVE=5
4940 IF SQ(8)=0 THEN MOVE=8
4950 GOTO 5100 ' out
4960 IF SQ(3)+SQ(6)+SQ(9)=8 GOTO 4970 ELSE GOTO 5010
4970 IF SQ(3)=0 THEN MOVE=3
4980 IF SQ(6)=0 THEN MOVE=6
4990 IF SQ(9)=0 THEN MOVE=9
5000 GOTO 5100 ' out
5010 IF SQ(1)+SQ(5)+SQ(9)=8 GOTO 5020 ELSE GOTO 5060
5020 IF SQ(1)=0 THEN MOVE=1
5030 IF SQ(5)=0 THEN MOVE=5
5040 IF SQ(9)=0 THEN MOVE=9
5050 GOTO 5100 ' out
5060 IF SQ(3)+SQ(5)+SQ(7)=8 GOTO 5070 ELSE GOTO 5100
5070 IF SQ(3)=0 THEN MOVE=3
5080 IF SQ(5)=0 THEN MOVE=5
5090 IF SQ(7)=0 THEN MOVE=7
5100 RETURN '----
5110 REM --- Most difficult game against the Computer 4 ---
5120 FOR I=1 TO 9 'initialize array that indicates empty squares
5130 SQ(I)=0
5140 NEXT I
5150 GOSUB 4230 'erase box
5160 REM X First move
5170 GOSUB 1920 'ask for and make X move
5180 REM O Second move Computer move
5190 IF SQ(5)=0 THEN MOVE=5:GOTO 5250 ELSE GOTO 5200
5200 I=INT((RND*3)+1) 'pick one of 4 corners randomly
5210 IF I=1 THEN MOVE=1
5220 IF I=2 THEN MOVE=3
5230 IF I=3 THEN MOVE=7
5240 IF I=4 THEN MOVE=9
5250 GOSUB 3360 'load coordinates for move
5260 GOSUB 3560 'draw move
5270 REM X Third move
5280 GOSUB 1920 'ask for and make X move
5290 REM O Fourth move, Computer move
5300 MOVE=0:GOSUB 4280 'check for 2 in row, win and stop opponent
5310 IF MOVE=0 THEN GOTO 5320 ELSE GOTO 5440 'if not 2 in row continue
5320 IF SQ(1)=4 AND SQ(9)=4 THEN GOTO 5350
5330 IF SQ(3)=4 AND SQ(7)=4 THEN GOTO 5350
5340 GOTO 5410 'pick a random move
5350 I=INT((RND*3)+1) 'pick one of 4 sides randomly
5360 IF I=1 THEN MOVE=2
5370 IF I=2 THEN MOVE=4
5380 IF I=3 THEN MOVE=6
5390 IF I=4 THEN MOVE=8
5400 GOTO 5440 'make move
5410 I=INT((RND*8)+1) 'pick random computer move
5420 IF SQ(I) <> 0 THEN GOTO 5350 'if square filled pick another
5430 MOVE=I
5440 GOSUB 3360:GOSUB 3560 'make move
5450 REM X Fifth move
5460 GOSUB 1920 'ask for and make X move
5470 WINSW=0:GOSUB 2270 'check for win
5480 IF WINSW=4 THEN GOTO 5830 'X wins
5490 REM O Sixth move, Computer move
5500 MOVE=0:GOSUB 4280 'check for 2 in row, win and stop opponent
5510 IF MOVE=0 THEN GOTO 5520 ELSE GOTO 5550 'if not 2 in row do random
5520 I=INT((RND*8)+1) 'pick random computer move
5530 IF SQ(I) <> 0 THEN GOTO 5520 'if square filled pick another
5540 MOVE=I
5550 GOSUB 3360:GOSUB 3560 'make move
5560 WINSW=0:GOSUB 2270 'check for win
5570 IF WINSW=1 THEN GOTO 5790 'Computer wins
5580 REM X Seventh move
5590 GOSUB 1920 'ask for and make X move
5600 WINSW=0:GOSUB 2270 'check for win
5610 IF WINSW=4 THEN GOTO 5830 'X wins
5620 REM O Eighth move, Computer move
5630 MOVE=0:GOSUB 4280 'check for 2 in row, win and stop opponent
5640 IF MOVE=0 THEN GOTO 5650 ELSE GOTO 5680 'if not 2 in row do random
5650 I=INT((RND*8)+1) 'pick random computer move
5660 IF SQ(I) <> 0 THEN GOTO 5650 'if square filled pick another
5670 MOVE=I
5680 GOSUB 3360:GOSUB 3560 'make move
5690 WINSW=0:GOSUB 2270 'check for win
5700 IF WINSW=1 THEN GOTO 5790 'Computer wins
5710 REM X Nineth move
5720 GOSUB 1920 'ask for and make X move
5730 WINSW=0:GOSUB 2270 'check for win
5740 IF WINSW=4 THEN GOTO 5830 'X wins
5750 REM -- TIE --
5760 BEEP
5770 LOCATE 12,55,0:PRINT " TIE "
5780 GOTO 5860
5790 REM -- O WINS --
5800 BEEP
5810 LOCATE 12,55,0:PRINT " O - WINS"
5820 GOTO 5860
5830 REM -- X WINS --
5840 BEEP
5850 LOCATE 12,55,0:PRINT " X - WINS"
5860 COLOR 7,0 'Turn off blinking
5870 RETURN '---
5880 REM ---- Randomize Subroutine ---
5890 REM This subroutine substitutes for the randomize command. It picks off
5900 REM 4 digits from the time field and uses this to seed the random nbr.
5910 A$=TIME$
5920 B$=MID$(A$,4,2)+RIGHT$(A$,2)
5930 TIME=VAL(B$)
5940 RANDOMIZE TIME 'seed random nbr generator
5950 RETURN '---
Directory of PC-SIG Library Disk #0072
Volume in drive A has no label
Directory of A:\
BLACKBOX BAS 8192 4-23-83 3:08p
BLCKJACK BAS 12288 4-23-83 2:14p
CRC TXT 1075 11-09-84 11:35a
CRCK4 COM 1536 10-21-82 7:54p
DOCTOR BAS 8832 11-05-82 12:01a
ELIZA BAS 10752 7-19-83 10:34p
FIFTEEN BAS 4352 4-23-83 3:50p
MEMORY BAS 10496 4-02-83 5:44p
OTHELLO BAS 8832 1-01-80 12:41a
ROADRALY BAS 6272 4-02-83 6:55p
RUBIK BAS 28928 1-10-83 8:50p
SPELLER BAS 3328 11-21-82 12:12a
TICTACTO BAS 22528 8-21-82 3:00p
13 file(s) 127411 bytes
30208 bytes free