home *** CD-ROM | disk | FTP | other *** search
/ The CIA World Factbook 1992 / k3bimage.iso / sel / 01 / 0197 / ttt.bas (.txt) < prev   
Encoding:
GW-BASIC  |  1991-12-02  |  10.8 KB  |  402 lines
  1. 10   '********************************************
  2. 20   '*                                          *
  3. 30   '*           3D TIC-TAC-TOE                 *
  4. 40   '*                                          *
  5. 50   '*       (C) 1982 Reza Beheshti             *
  6. 60   '*                                          *
  7. 70   '*  3504 Pence Ct.                          *
  8. 80   '*  Annandale, VA.  22003                   *
  9. 90   '*  (703) 560-4821                          *
  10. 100  '*                                          *
  11. 110  '********************************************
  12. 120  '
  13. 130  ' System requirments:
  14. 140  '
  15. 150  ' IBM PC 64K MEM. Min.
  16. 160  ' 1 Disk drive
  17. 170  ' Color/Graphic Board
  18. 180  ' 80 Column monitor (RGB Recommanded)
  19. 190  ' Run under "BASICA"
  20. 200  '
  21. 210  ' ------ ENJOY IT -----
  22. 220  '
  23. 230  '
  24. 240  '
  25. 250  '
  26. 260  SCREEN 1,0:KEY OFF
  27. 270  ON ERROR GOTO 3720
  28. 280  CLS:RANDOMIZE 12
  29. 290  DEFINT A-Y:DEFDBL Z:DIM AA(3000),A(514),NAM$(11),LOS(11),WIN(11),SCR(11)
  30. 300  COLOR 0,0:Y=1:N=0:T=0:W=0:X=0:INSTFL=0:DIFFL=0:WELFL=0
  31. 310  IF DIFFL<> 0 THEN 700
  32. 320  DIFFL=1
  33. 330  GOSUB 3700
  34. 340  DRAW "c1bl90bu30r30f3d20g3f3d25g3l30"
  35. 350  DRAW "u5r24e3u21l25u5r25u20l27u3"
  36. 360  DRAW "br60bd30r40u4l40d4"
  37. 370  DRAW "bu4br60nu25d28r30e4u45h4l30"
  38. 380  DRAW "bu4r32f7d47g7l36u61r4"
  39. 390  DRAW "c2bl120bd2e15r25f3d32g3f3d19g9"
  40. 400  DRAW"u24h3e3u20h4l29"
  41. 410  DRAW "br59bd26e15r36d9g10u4l40" '- shade
  42. 420  DRAW "bu29br55e15r34f7d60g11l8e7u49h7l35" ' d shade
  43. 430  PAINT(110,100),2 '3 shade
  44. 440  PAINT(100,110),1 ' 3 itself
  45. 450  PAINT(150,99),1  '- itself
  46. 460  PAINT(150,82),2  ' - shade
  47. 470  PAINT(187,82),1 ' d shade
  48. 480  PAINT(230,70),2  ' d itself
  49. 490  LOCATE 22,12,0:PRINT" TIC - TAC - TOE"
  50. 500  Y1=5:Y2=Y1+32:FL=1:GOSUB 980
  51. 510  GET(65,45)-(250,133),AA
  52. 520  FOR I=1 TO 800:NEXT
  53. 530  GOSUB 3700
  54. 540  PUT (65,45),AA,XOR
  55. 550  XX=65:YY=65
  56. 560  FOR KI=1 TO 3
  57. 570  FOR K=1 TO 3
  58. 580  PUT (XX,YY),AA:XX=XX+15:YY=YY-15:NEXT K
  59. 590  FOR I=1 TO 700:NEXT
  60. 600  XX=XX-15:YY=YY+15
  61. 610  GOSUB 3700
  62. 620  FOR K=1 TO 2
  63. 630  PUT (XX,YY),AA,XOR:XX=XX-15:YY=YY+15:NEXT K
  64. 640  NEXT KI
  65. 650  DIFFL=1
  66. 660  GOSUB 3700
  67. 670  CLS:LOCATE 12,7,0:PRINT"WELCOM TO 3D TIC-TAC-TOE"
  68. 680  LOCATE 24,3,0:PRINT "(C) 1982  Reza Beheshti"
  69. 690  FOR I=1 TO 2500:NEXT I
  70. 700  FOR I=1 TO 514:A(I)=0:NEXT I
  71. 710  GOSUB 1310
  72. 720  SCREEN 1,0,0:CLS
  73. 730  GOSUB 790
  74. 740  REM do human's move
  75. 750  REM see if tie game though
  76. 760  YZ=YZ+1:IF (YZ=9)*(V=1)+(YZ=33)*(V>1) THEN 3260
  77. 770  GOSUB 1660
  78. 780  GOTO 1750
  79. 790  COLOR 1,0
  80. 800  Y1=10:Y2=Y1+32:FL=1
  81. 810  GOSUB 980
  82. 820  Y1=50:Y2=Y1+32:FL=1
  83. 830  GOSUB 980
  84. 840  Y1=90:Y2=Y1+32:FL=1
  85. 850  GOSUB 980
  86. 860  Y1=130:Y2=Y1+32:FL=1
  87. 870  GOSUB 980
  88. 880  LOCATE 1,22,0:PRINT"1   2   3   4"
  89. 890  LOCATE 2,18,0:PRINT"1"
  90. 900  LOCATE 3,16:PRINT"2"
  91. 910  LOCATE 4,14:PRINT"3"
  92. 920  LOCATE 5,12:PRINT"4"
  93. 930  LOCATE 3,37:PRINT"(1)"
  94. 940  LOCATE 8,37:PRINT"(2)"
  95. 950  LOCATE 13,37:PRINT"(3)"
  96. 960  LOCATE 18,37:PRINT"(4)"
  97. 970  RETURN
  98. 980  LINE (160,Y1)-(272,Y1)
  99. 990  LINE -(205,Y2)
  100. 1000  LINE -(95,Y2)
  101. 1010  LINE -(160,Y1)
  102. 1020  IF FL=1 THEN PAINT (161,Y1+1),2,3
  103. 1030  LINE (188,Y1)-(123,Y2),3
  104. 1040  LINE (216,Y1)-(151,Y2),3
  105. 1050  LINE (244,Y1)-(179,Y2),3
  106. 1060  LINE (143,Y1+8)-(255,Y1+8),3
  107. 1070  LINE (126,Y1+16)-(238,Y1+16)
  108. 1080  LINE (110,Y1+24)-(222,Y1+24)
  109. 1090  RETURN
  110. 1100  END
  111. 1110  ' display X or O subroutine
  112. 1120  ULX=160                    'upper left coord. of board
  113. 1130  ULY=(BORD-1)*40+10            '
  114. 1140  ULY=ULY+(ROW-1)*8            'upper left coord. of box
  115. 1150  ULX=ULX+(COL-1)*28-(ROW-1)*16  '
  116. 1160  IF FG=0 GOTO 1220
  117. 1170  IF FG=2 GOTO 1270
  118. 1180  ' print an X
  119. 1190  LINE (ULX,ULY)-(ULX+11,ULY+8),3   ' ul-lr line
  120. 1200  LINE (ULX-16,ULY+8)-(ULX+27,ULY),3 ' ll-ur line
  121. 1210  RETURN
  122. 1220  ' Print an ellipse
  123. 1230  FOR P=1 TO 15
  124. 1240  COLOR  ,0:CIRCLE (ULX+5,ULY+4),8,1,,,0.36
  125. 1250  CIRCLE (ULX+5,ULY+4),8,0,,,0.36:NEXT P
  126. 1260  RETURN
  127. 1270  ' print the winning marks on screnn
  128. 1280  GOSUB 3700
  129. 1290  COLOR ,1:CIRCLE (ULX+5,ULY+4),8,0,,,0.2
  130. 1300  RETURN
  131. 1310  SCREEN 0,0,0:COLOR 0,4,0
  132. 1320  WIDTH 80:CLS
  133. 1330  LOCATE 3,15,0:PRINT"WELCOME TO ":COLOR 1 :LOCATE 3,28
  134. 1340  PRINT"T I C  -  T A C  -  T O E"
  135. 1350  IF INSTFL<>0 THEN 1540
  136. 1360  COLOR 2:INSTFL=1
  137. 1370  PRINT:PRINT TAB(5)"My name is ";:COLOR 1:PRINT"WIZY ";
  138. 1380  COLOR 2:PRINT"and I will be your opponent"
  139. 1390  PRINT:INPUT"What is your name";NA$
  140. 1400  LOCATE 7,5,0:PRINT:PRINT"Do you need instructions ";NA$
  141. 1410  INPUT K$:K$=LEFT$(K$,1)
  142. 1420  IF K$="y" OR K$="n" OR K$="Y" OR K$="N" THEN 1460
  143. 1430  BEEP:PRINT "Please answer with a YES or NO":FOR I=1 TO 950:NEXT
  144. 1440  FOR J=8 TO 10:LOCATE J,1,0:PRINT"                                      ":NEXT J
  145. 1450  GOTO 1400
  146. 1460  IF K$="n" OR K$="N" THEN 1540
  147. 1470  PRINT:PRINT TAB(3)"3-D TIC-TAC-TOE is played on four boards. You must get 4 in"
  148. 1480  PRINT TAB(3)"a row to win. (Horizonal, Vertical, or Diagonally)"
  149. 1490  PRINT TAB(3)"There are 4 rows and 4 columns on each board, you enter your choice of"
  150. 1500  PRINT TAB(3)"box by a three digit number indicating the row, column, and board number"
  151. 1510  PRINT TAB(3)" i.e. [231] is row 2, column 3, on board 1"
  152. 1520  PRINT TAB(3)"You will play the 'X' and I will take 'O' and I let you play first"
  153. 1530  INSTFL=1
  154. 1540  LOCATE 18,3,0:PRINT"There are 2 versions available as follows:"
  155. 1550  PRINT TAB(5)"1) Moderately hard to beat"
  156. 1560  PRINT TAB(5)"2) Hardest to beat"
  157. 1570  LOCATE 21,3,0:PRINT NA$;" Which one would you like";:INPUT V
  158. 1580  IF V>0 AND V<3 THEN 1620
  159. 1590  BEEP:PRINT"Please chose 1 or 2 only":FOR I=1 TO 999:NEXT
  160. 1600  FOR K=21 TO 24:LOCATE K,1:PRINT"                                    ":NEXT
  161. 1610  GOTO 1570
  162. 1620  LOCATE 25,3,0:PRINT"One moment.."
  163. 1630  GOSUB 3360
  164. 1640  V=V+1:LOCATE 25,2,0:PRINT"Hit [ENTER] to start";:BEEP:INPUT XXX
  165. 1650  SCREEN 1,0,0:RETURN
  166. 1660  REM Input query starts here.
  167. 1670  CODE=0:LOCATE 23,3,0:INPUT"Which box [RCB]";BOX$
  168. 1680  GOSUB 1790   ' to subroutine for valid input check
  169. 1690  IF CODE=1 THEN 1670
  170. 1700  GOSUB 1980
  171. 1710  IF A(D)<>0 THEN 3600
  172. 1720  A(D)=1:FG=1:GOSUB 1110
  173. 1730  LOCATE 23,1,0:PRINT" I'm thinking .......       ":FOR I=1 TO 1500:NEXT I
  174. 1740  RETURN
  175. 1750  REM evaluate all moves
  176. 1760  GOSUB 2620
  177. 1770  GOSUB 2090                  ' do computers move
  178. 1780  GOTO 750                    ' to -> see if tie game though
  179. 1790  ' Subroutine to check VALID input from the player.
  180. 1800  LN=LEN(BOX$):IF LN=3 THEN 1840
  181. 1810  BEEP:LOCATE 23,24,0:BEEP:PRINT"Bad Input":FOR I=1 TO 1500:NEXT
  182. 1820  LOCATE 23,15,0:PRINT"                    "
  183. 1830  CODE=1:RETURN
  184. 1840  R$=MID$(BOX$,1,1):ROW=VAL(R$)
  185. 1850  C$=MID$(BOX$,2,1):COL=VAL(C$)
  186. 1860  B$=MID$(BOX$,3,1):BORD=VAL(B$)
  187. 1870  RER$=" ":CER$=" ":BER$=" "
  188. 1880  IF ROW<1 OR ROW>4 THEN RER$=" ROW   "
  189. 1890  IF COL<1 OR COL>4 THEN CER$=" COLUMN"
  190. 1900  IF BORD<1 OR BORD>4 THEN BER$=" BOARD "
  191. 1910  IF RER$=" " AND CER$=" " AND BER$=" " THEN RETURN
  192. 1920  CODE=1
  193. 1930  LOCATE 23,1,0
  194. 1940  BEEP:PRINT"Invalid  "+RER$+CER$+BER$+"    "
  195. 1950  FOR I=1 TO 2000:NEXT:LOCATE 24,1,0
  196. 1960  LOCATE 23,1,0:PRINT"                                 ":RETURN
  197. 1970  ' **** Subroutine to convert to RCB input
  198. 1980  CON1=(BORD-1)*16
  199. 1990  CON2=(COL-1)*4
  200. 2000  D=CON1+CON2+ROW
  201. 2010  RETURN
  202. 2020  ' ******* Subroutine to convert from RCB
  203. 2030  ZUM1=D/16:BORD=INT(ZUM1+0.99)
  204. 2040  B1=BORD-1:B2=B1*16:B3=D-B2:ZUM1=B3/4:COL=INT(ZUM1+0.99)
  205. 2050  B5=COL-1:B6=B5*4:ROW=B3-B6
  206. 2060  RETURN
  207. 2070  REM
  208. 2080  REM---main logic subroutines---
  209. 2090  REM make computer move.
  210. 2100  REM
  211. 2110  REM see if we have a must block condition
  212. 2120  IF (YZ<3)*(V>1)+(YZ=1) THEN 2560
  213. 2130  IF Q=0 THEN 2200
  214. 2140  FOR G=0 TO 3
  215. 2150  E=A(65+G+(Q-1)*4)
  216. 2160  REM find empty box to block with
  217. 2170  IF A(E)=0 THEN K=E : G=4
  218. 2180  NEXT G
  219. 2190  GOTO 2590
  220. 2200  REM clear box value array
  221. 2210  FOR I=1 TO 64 : A(450+I)=0:NEXT I
  222. 2220  REM if u=0 then cats game
  223. 2230  U=0
  224. 2240  REM compute value for each box as it appears in the win array
  225. 2250  FOR I=1 TO (-10*(V=1)-76*(V<>1)) STEP (1-3*(V=2))
  226. 2260  B=A(370+I)
  227. 2270  REM if value of win combo is zero then forget it
  228. 2280  IF B=0 THEN U=1:GOTO 2460
  229. 2290  REM get strategy value of this win combo in f
  230. 2300  F=0
  231. 2310  IF (B=1) + (B=5) THEN F=1
  232. 2320  IF B=2 THEN F=4
  233. 2330  IF B=3 THEN STOP
  234. 2340  IF B=10 THEN F=2
  235. 2350  IF F=0 THEN 2460
  236. 2360  U=1
  237. 2370  REM increment each box in win combo by win value
  238. 2380  E=(I-1)*4+65
  239. 2390  FOR G=0 TO 3
  240. 2400  REM get box number in c
  241. 2410  C=A(E+G)
  242. 2420  REM see if this box is used
  243. 2430  IF A(C) <> 0 THEN 2450
  244. 2440  A(450+C)=A(450+C)+F
  245. 2450  NEXT G
  246. 2460  NEXT I
  247. 2470  REM see if cats game
  248. 2480  IF (U=0)*(V<>2) THEN 3260
  249. 2490  REM get best box now
  250. 2500  L=0
  251. 2510  FOR I=1 TO 64
  252. 2520  IF A(450+I)>L THEN L=A(450+I):K=I
  253. 2530  NEXT I
  254. 2540  REM see if any move found. if not do a random move
  255. 2550  IF L>0 THEN 2590
  256. 2560  GOSUB 3660
  257. 2570  IF A(I)=0 THEN K=I:GOTO 2590
  258. 2580  GOTO 2560
  259. 2590  REM do computer move in k
  260. 2600  GOSUB 2970
  261. 2610  RETURN
  262. 2620  REM
  263. 2630  REM evaluate all moves
  264. 2640  REM
  265. 2650  Q=0:R=0
  266. 2660  REM skip first move on version 1
  267. 2670  IF (YZ<3)*(V>1) THEN 2870
  268. 2680  K1LL=0 'if set then we are to get out of do loop
  269. 2690  FOR I=1 TO (V<>1)*-76+(V=1)*-10
  270. 2700  IF K1LL=1 THEN 2840  'human won, we done! if wizy won .                        keep checking to make sure human didn't win first.
  271. 2710  E=(I-1)*4+65
  272. 2720  F=370+I
  273. 2730  C=0
  274. 2740  FOR J=0 TO 3
  275. 2750  C=C+A(A(J+E))
  276. 2760  NEXT J
  277. 2770  REM see if wizy lost
  278. 2780  A(F)=C
  279. 2790  IF C=4 THEN R=I:K1LL=1:GOTO 2840
  280. 2800  REM must block if human has three in a row
  281. 2810  IF C=3 THEN Q=I
  282. 2820  REM see if comy won
  283. 2830  IF C=15 THEN R=I:K1LL=2:GOTO 2840
  284. 2840  NEXT I
  285. 2850  IF K1LL=1 THEN 3230
  286. 2860  IF K1LL=2 THEN 2890
  287. 2870  RETURN
  288. 2880  REM wizy won. find empty box!
  289. 2890  FOR H=0 TO 3
  290. 2900  C=A(65+H+(R-1)*4)
  291. 2910  IF A(C)=0 THEN K=C:H=4
  292. 2920  NEXT H
  293. 2930  REM do wizy move
  294. 2940  GOSUB 2970
  295. 2950  REM wizy won.
  296. 2960  GOTO 3050
  297. 2970  REM
  298. 2980  REM do wizy move specify in k
  299. 2990  REM
  300. 3000  D=K:A(D)=5
  301. 3010  GOSUB 2020
  302. 3020  FG=0:GOSUB 1110
  303. 3030  LOCATE 23,1,0:PRINT"COMPY takes box ";ROW;COL;BORD:FOR I=1 TO 4000:NEXT
  304. 3040  GOSUB 3630:RETURN
  305. 3050  REM
  306. 3060  REM wizy won/lost
  307. 3070  REM
  308. 3080  FG=2:GOSUB 3300    ' subroutine to mark thru winning boxes
  309. 3090  LOCATE 23,1,0:PRINT"HURRAH I WON !!!";:X=X+1:FOR I=1 TO 9000:NEXT
  310. 3100  CLS:LOCATE 4,1,0:PRINT"Wins: ";W;" Losses: ";X;" Ties: ";T
  311. 3110  LOCATE 7,2,0:PRINT"Do you want to play again ";NA$
  312. 3120  INPUT AN$:AN$=LEFT$(AN$,1)
  313. 3130  IF AN$="y" OR AN$="Y" THEN 310
  314. 3140  IF AN$="n" OR AN$="N" THEN 3180
  315. 3150  BEEP:LOCATE 10,3,0:PRINT"Yes/No please":FOR I=1 TO 1500:NEXT
  316. 3160  LOCATE 10,3,0:PRINT"               "
  317. 3170  GOTO 3110
  318. 3180  CLS:LOCATE 9,1,0:PRINT"I liked playing with you..."
  319. 3190  PRINT:PRINT"See you soon!"
  320. 3200  LOCATE 23,1,0
  321. 3210  CLS:RUN "MENU.PGM"
  322. 3220  REM wizy lost
  323. 3230  FG=2:GOSUB 3300  ' *********  mark the winning boxes
  324. 3240  LOCATE 23,1,0:PRINT"BOO-HOO I LOST .....":W=W+1:FOR I=1 TO 9000:NEXT I
  325. 3250  GOTO 3100
  326. 3260  LOCATE 23,1,0:PRINT"Tie game ...":FOR I=1 TO 9000:NEXT I
  327. 3270  GOSUB 3630
  328. 3280  GOTO 3100
  329. 3290  REM
  330. 3300  REM mark thru wins
  331. 3310  REM
  332. 3320  FOR H=0 TO 3:D=A(65+H+(R-1)*4)
  333. 3330  GOSUB 2020  ' convert d to rcb
  334. 3340  F=2:GOSUB 1110  ' mark thru wins
  335. 3350  NEXT H:RETURN
  336. 3360  REM
  337. 3370  REM setup win array
  338. 3380  REM
  339. 3390  RESTORE
  340. 3400  FOR I=1 TO 10:FOR C=0 TO 3:READ A(65+C+(I-1)*4):NEXT C:NEXT I
  341. 3410  FOR I=57 TO 76:FOR C=0 TO 3
  342. 3420  READ A(65+C+(I-1)*4)
  343. 3430  NEXT C:NEXT I
  344. 3440  FOR I=1 TO 3:FOR C=1 TO 10:FOR E=0 TO 3
  345. 3450  A(E+65+(C+I*10-1)*4)=A(E+65+(C-1)*4)+16*I
  346. 3460  NEXT E:NEXT C:NEXT I
  347. 3470  FOR I=41 TO 56:FOR C=0 TO 3
  348. 3480  A(65+C+(I-1)*4)=C*16+I-40:NEXT C:NEXT I
  349. 3490  RETURN
  350. 3500  DATA 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,1,5,9,13,2
  351. 3510  DATA 6,10,14
  352. 3520  DATA 3,7,11,15,4,8,12,16,1,6,11,16,4,7,10,13,1,22,43,64
  353. 3530  DATA 5,22,39,56,9,26,43,60,13,26,39,52,2,22,42,62,14,26
  354. 3540  DATA 38,50
  355. 3550  DATA 3,23,43,63,15,27,39,51,4,23,42,61,8,23,38,53,12,27
  356. 3560  DATA 42,57,16,27,38,49
  357. 3570  DATA 1,21,41,61,1,18,35,52,4,19,34,49,4,24,44,64
  358. 3580  DATA 13,25,37,49,13,30,47,64,16,31,46,61,16,28,40,52
  359. 3590  REM
  360. 3600  LOCATE 23,1,0:BEEP:PRINT"Box already taken!":FOR I=1 TO 1500:NEXT I
  361. 3610  GOSUB 3630
  362. 3620  GOTO 1670
  363. 3630  ' subroutine to clean up line 23 on screen
  364. 3640  LOCATE 23,1,0:PRINT"                              "
  365. 3650  RETURN
  366. 3660  Z1=(RND*100)
  367. 3670  I=INT(Z1):IF I<1 OR I>64 THEN 3660
  368. 3680  RETURN
  369. 3690  REM Subroutine to play the music
  370. 3700  PLAY "MBL12T128O3CDEFGABFEDCBADO4C"
  371. 3710  RETURN
  372. 3720  REM error handling routine
  373. 3730  CLS
  374. 3740  IF ERR=53 THEN 3830
  375. 3750  IF ERR=61 THEN 3860
  376. 3760  IF ERR=70 THEN 3910
  377. 3770  IF ERR=71 THEN 3940
  378. 3780  IF ERR=73 THEN 3970
  379. 3790  XX=ERR
  380. 3800  PRINT:PRINT"UNEXPECTED error number [";XX;"]"
  381. 3810  PRINT:PRINT"Please look it up in your basic manual"
  382. 3820  PRINT" in Appendix A.":END
  383. 3830  PRINT" Seems like you have the wrong disk in drive 'A`"
  384. 3840  PRINT "Please double check it."
  385. 3850  GOTO 3990
  386. 3860  PRINT"Opps... Your disk space is full, please make "
  387. 3870  PRINT" sure you have the right diskette in drive 'A`"
  388. 3880  PRINT" or you have to erase some data from the diskette"
  389. 3890  PRINT" in drive 'A` before you could save any more data on it."
  390. 3900  GOTO 3990
  391. 3910  PRINT" Diskette write protection notch is covered and I can "
  392. 3920  PRINT"not record your score unless you remove it."
  393. 3930  GOTO 3990
  394. 3940  PRINT" Drive 'A` is not ready, please insert the right "
  395. 3950  PRINT "diskette in, or make sure the drive door is closed."
  396. 3960  GOTO 3990
  397. 3970  PRINT" Advanced BASIC is required. Please load BASICA and rerun"
  398. 3980  END
  399. 3990  PRINT:PRINT
  400. 4000  CLS:SYSTEM
  401. 4010  RETURN
  402.