home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / gwbasic / spiele / othello.bas < prev    next >
Encoding:
BASIC Source File  |  1991-05-15  |  10.5 KB  |  286 lines
  1. 0 GOTO 65000
  2. 1 '
  3. 1000 REM  OTHELLO -- PET VERSION -- MODIFIED BY PATRICK   LEABO
  4. 1010 REM                                        TUCSON, ARIZONA
  5. 1020 REM                                             3-82
  6. 1025 REM NOT DONE YET BUT HAVE FUN -- PLEASE ADD A GOOD ALGORITHM TO IT
  7. 1026 REM 09/13/82 Added color and 40 char layout mods. Bob Vollmer, San Jose
  8. 1030 SCREEN 0,0:COLOR 7,1:WIDTH 80:KEY OFF
  9. 1040 E$=STRING$(38," ")
  10. 1050 D$= CHR$ (11)
  11. 1060 FOR I= 1 TO 21:D$= D$+ CHR$ (10):NEXT:D$=D$+" "
  12. 1070 XL= 3:XH= 6:YL= 3:YH= 6:C(1)=1:C(2)=4
  13. 1080 DIM A(9,9),I4(7),J4(7),D$(2),P$(2):Z0= 0
  14. 1090 CLS:LOCATE 1,20:PRINT "GREETINGS FROM OTHELLO"
  15. 1100 PRINT :PRINT "OTHELLO  IS PLAYED ON AN 8 X 8 BOARD, ROWS NUMBERED"
  16. 1110 PRINT "1 TO 8  AND COLUMNS A TO H.   THE INITIAL CONFIGURATION IS"
  17. 1120 PRINT "ALL BLANK EXCEPT FOR THE CENTER FOUR SQUARES, TRY TO PLACE"
  18. 1130 PRINT "YOUR PIECE SO THAT IT OUTFLANKS YOUR  OPPONENT, CREATING "
  19. 1140 PRINT "HORIZONTAL, VERTICAL, OR DIAGONAL RUN OF OPPOSING PIECES,"
  20. 1150 PRINT "TURNING THEM INTO YOURS."
  21. 1160 PRINT
  22. 1170 PRINT:PRINT
  23. 1180 PRINT "EXAMPLE: RED OUTFLANKS BLUE, CAPTURING FOUR BLUE PIECES."
  24. 1190 PRINT "2MAKE YOUR MOVE BY ENTERING A NUMBER FOR THE ROW AND A LETTER"
  25. 1200 PRINT "FOR THE COLUMN.  "
  26. 1210 PRINT "NOTE: YOU MUST CAPTURE AT LEAST ONE OF MY PIECES IN THIS WAY "
  27. 1220 PRINT "IF IT IS POSSIBLE.  IF IT IS NOT POSSIBLE, YOU FORFEIT YOUR"
  28. 1230 PRINT "MOVE BY ENTERING 0 A FOR YOUR MOVE."
  29. 1240 PRINT :PRINT "HOW MANY PLAYERS (1 OR 2)? ";:GOSUB 3220:IF VAL (X$)= 0 OR VAL (X$)> 2 THEN 1240
  30. 1250 PRINT X$:NP= VAL (X$):PRINT 
  31. 1260 IF NP= 2 THEN PRINT "PLAYER #1 GOES FIRST WHEN THE PLAY STARTS"
  32. 1270 SOUND 3000,2:INPUT "ENTER PLAYER 1,S NAME! ";P$(1):P$(1)= P$(1)+" "
  33. 1280 SOUND 3000,2:IF NP= 2 THEN INPUT "ENTER PLAYER 2'S NAME! ";P$(2):P$(2)= P$(2)+" "
  34. 1290 IF NP= 2 THEN 1350
  35. 1300 PRINT :PRINT "SHOULD I PLAY MY BEST?";
  36. 1310 S2= 0:S4= 0:S5= 0:P$(2)= "PERCY"
  37. 1320 GOSUB 3220:IF X$= "N" THEN PRINT "NO":GOTO 1350
  38. 1330 PRINT "YES"
  39. 1340 S2= 2:S4= 1:S5= - 2
  40. 1350 B= - 1:W= 1:PT= 0
  41. 1360 D$(B+ 1)= "RED":N$(B+ 1)= "RED "
  42. 1370 D$(0+ 1)= "BLANK"
  43. 1380 D$(W+ 1)= "BLUE":N$(W+ 1)= "BLUE"
  44. 1390 FOR K= 0 TO 7
  45. 1400 READ I4(K),J4(K)
  46. 1410 NEXT
  47. 1420 FOR I= 0 TO 9:FOR J= 0 TO 9
  48. 1430 A(I,J)= 0
  49. 1440 NEXT J,I
  50. 1450 A(4,4)= B:A(5,5)= B
  51. 1460 A(4,5)= W:A(5,4)= W
  52. 1470 SC(1)= 2:SC(2)= 2:N1= 4:Z= 0
  53. 1480 C= W:H= B
  54. 1490 FOR NN= 1 TO 3000:NEXT :CLS
  55. 1500 GOSUB 3300
  56. 1510 IF NP= 2 THEN 2020
  57. 1520 PRINT D$"DO YOU WANT TO GO FIRST ? ";:LOCATE ,,1,0,7
  58. 1530 PT= 1:GOSUB 3220:IF X$= "Y"THEN PRINT "YES":PT= 0:GOTO 2020
  59. 1540 PT= 1:PRINT "NO":PRINT D$E$D$"OK, I AM THINKING!"
  60. 1550 REM  COMPUTERS MOVE
  61. 1560 IF NP= 1 THEN LOCATE 23,2,0:COLOR FFF+16:PRINT "I'm Thinking";:COLOR FFF:GOTO 1600
  62. 1570 IF PT= 2 THEN B1= - 1:I3= 0:J3= 0:T1= C:T2= H
  63. 1580 IF PT= 1 THEN B1= - 1:I3= 0:J3= 0:T1= H:T2= C
  64. 1590 GOTO 2030
  65. 1600 PT= PT+ 1:IF PT> 2 THEN PT= 1
  66. 1610 B1= - 1:I3= 0:J3= 0:T1= C:T2= H
  67. 1620 FOR I= YL TO YH:FOR J= XL TO XH
  68. 1630 IF A(I,J)< > 0 THEN 1790
  69. 1640 GOSUB 2740
  70. 1650 IF F1= Z0 THEN 1790
  71. 1660 U= - 1
  72. 1670 GOSUB 2780
  73. 1680 IF S1= Z0 THEN 1790
  74. 1690 IF (I= 1)OR (I= 8)THEN S1= S1+ S2
  75. 1700 IF (J= 1)OR (J= 8)THEN S1= S1+ S2
  76. 1710 IF (I= 2)OR (I= 7)THEN S1= S1+ S5
  77. 1720 IF (J= 2)OR (J= 7)THEN S1= S1+ S5
  78. 1730 IF (I= 3)OR (I= 6)THEN S1= S1+ S4
  79. 1740 IF (J= 3)OR (J= 6)THEN S1= S1+ S4
  80. 1750 IF S1< B1 THEN 1790
  81. 1760 IF S1> B1 THEN 1780
  82. 1770 IF RND (1)> .5 THEN 1790
  83. 1780 B1= S1:I3= I:J3= J
  84. 1790 NEXT J,I
  85. 1795 LOCATE 23,2,0:PRINT "            "
  86. 1800 IF B1> 0 THEN 1880
  87. 1810 IF S5= 0 THEN 1840
  88. 1820 IF NP= 1 THEN S5= 0:GOTO 1610
  89. 1830 S5= 0:GOTO 1550
  90. 1840 S5= 0:PRINT D$ E$ D$"I HAVE TO FORFEIT MY MOVE"
  91. 1850 IF Z= 1 THEN 2430
  92. 1860 Z= 1
  93. 1870 GOTO 2020
  94. 1880 Z= 0
  95. 1890 PRINT D$E$D$"I WILL MOVE TO ";RIGHT$ (STR$ (I3),1)" "CHR$ (J3+ 64)
  96. 1900 GOSUB 3090 REM 5
  97. 1910 I= I3:J= J3:U= 1
  98. 1920 GOSUB 2780
  99. 1930 SC(PT)= SC(PT)+ S1+ 1
  100. 1940 OP= PT+ 1:IF OP= 3 THEN OP= 1
  101. 1950 SC(OP)= SC(OP)- S1
  102. 1960 N1= N1+ 1
  103. 1970 PRINT D$E$D$"THAT GIVES ME ";
  104. 1980 PRINT S1;
  105. 1990 PRINT " OF YOUR PIECES"
  106. 2000 GOSUB 3390
  107. 2010 IF SC(OP)= 0 OR N1= 64 THEN 2430
  108. 2020 T1= H:T2= C
  109. 2030 PT= PT+ 1:IF PT> 2 THEN PT= 1
  110. 2040 IF PT= 2 THEN B1= - 1:I3= 0:J3= 0:T1= C:T2= H
  111. 2050 IF PT= 1 THEN B1= - 1:I3= 0:J3= 0:T1= H:T2= C
  112. 2060 BEEP
  113. 2070 PRINT D$;E$D$;:GOSUB 5000:PRINT ", INPUT YOUR MOVE ! ";:LOCATE ,,1,0,7:GOSUB 3020
  114. 2080 IF (I< 0)OR (J< 0)OR (J> 8)OR (I> 8)THEN 2040
  115. 2090 IF I< > 0 THEN 2160
  116. 2100 PRINT D$;E$D$;"ARE YOU FORFEITING YOUR TURN ? ";
  117. 2110 GOSUB 3220:IF X$< > "Y"THEN PRINT "NO":GOTO 2040
  118. 2120 PRINT "YES"
  119. 2130 IF Z= 1 THEN 2430
  120. 2140 Z1= 1
  121. 2150 GOTO 1550
  122. 2160 IF A(I,J)= 0 THEN 2190
  123. 2170 PRINT D$"SORRY,SQUARE OCCUPIED; TRY AGAIN"
  124. 2180 GOTO 2270
  125. 2190 GOSUB 2740
  126. 2200 IF F1= 1 THEN 2230
  127. 2210 PRINT D$""E$D$"SORRY,NOT NEXT TO MY PIECES; TRY AGAIN"
  128. 2220 GOTO 2270
  129. 2230 U= - 1
  130. 2240 GOSUB 2780
  131. 2250 IF S1> 0 THEN 2290
  132. 2260 PRINT D$""E$D$"SORRY,DOESN'T FLANK A ROW; TRY AGAIN"
  133. 2270 PRINT E$D$:BEEP:FOR N=1 TO 2000:NEXT
  134. 2280 GOTO 2040
  135. 2290 Z= 0:GOSUB 3150
  136. 2300 PRINT D$""E$D$""P$(PT)" THAT GIVES YOU ";
  137. 2310 PRINT S1;
  138. 2320 PRINT " PIECE";:IF S1> 1 THEN PRINT "S";
  139. 2330 PRINT :PRINT E$D$
  140. 2340 U= 1
  141. 2350 GOSUB 2780
  142. 2360 SC(PT)= SC(PT)+ S1+ 1
  143. 2370 OP= PT+ 1:IF OP= 3 THEN OP= 1
  144. 2380 SC(OP)= SC(OP)- S1
  145. 2390 N1= N1+ 1
  146. 2400 GOSUB 3390
  147. 2410 IF SC(OP)= 0 OR N1= 64 THEN 2430
  148. 2420 GOTO 1550
  149. 2430 PRINT D$;E$:PRINT E$:PRINT E$
  150. 2440 PRINT D$;E$D$;P$(1)"  HAS "SC(1)" PIECES   ";
  151. 2450 PRINT P$(2)" HAS "SC(2)" PIECES"
  152. 2460 IF SC(1)= SC(2)THEN 2510
  153. 2470 IF NP= 2 THEN 2540
  154. 2480 IF SC(1)> SC(2)THEN 2530
  155. 2490 PRINT "SORRY, I WON THAT ONE.";
  156. 2500 GOTO 2540
  157. 2510 PRINT "ITS A TIE !!";
  158. 2520 GOTO 2680
  159. 2530 PRINT "YOU WON!!!!!!";
  160. 2540 C1= SC(1)- SC(2)
  161. 2550 IF C1> 0 THEN 2570
  162. 2560 C1= - C1
  163. 2570 C1= (64* C1)/ N1
  164. 2580 PRINT "THAT WAS A ";
  165. 2590 IF C1< 11 THEN 2670
  166. 2600 IF C1< 25 THEN 2660
  167. 2610 IF C1< 39 THEN 2650
  168. 2620 IF C1< 53 THEN 2640
  169. 2630 PRINT "PERFECT GAME":GOTO 2680
  170. 2640 PRINT "WALKAWAY":GOTO 2680
  171. 2650 PRINT "FIGHT":GOTO 2680
  172. 2660 PRINT "HOT GAME":GOTO 2680
  173. 2670 PRINT "SQUEAKER"
  174. 2680 PRINT 
  175. 2690 PRINT "DO YOU WANT TO PLAY ANOTHER GAME ? ";:BEEP
  176. 2700 GOSUB 3220:IF X$= "Y"THEN PRINT "YES";:RUN 1040
  177. 2710 PRINT "NO"
  178. 2720 PRINT "THANKS FOR PLAYING."
  179. 2730 RUN   "MENU.BAS"
  180. 2740 F1= Z0:FOR I1= - 1 TO 1:FOR J1= - 1 TO 1:IF A(I+ I1,J1+ J)= T2 THEN 2760
  181. 2750 NEXT J1,I1:RETURN 
  182. 2760 F1= 1:RETURN 
  183. 2770 REM  CHECK FOR COUNT & FLANKING PIECES
  184. 2780 S1= Z0:FOR K= 0 TO 7
  185. 2790 S3= Z0:I5= I4(K):J5= J4(K):I6= I+ I5:J6= J+ J5
  186. 2800 IF A(I6,J6)< > T2 THEN 2910
  187. 2810 S3= S3+ 1:I6= I6+ I5:J6= J6+ J5
  188. 2820 IF A(I6,J6)= T1 THEN 2850
  189. 2830 IF A(I6,J6)= Z0 THEN 2910
  190. 2840 GOTO 2810
  191. 2850 S1= S1+ S3
  192. 2860 IF U< > 1 THEN 2910
  193. 2870 I6= I:J6= J
  194. 2880 FOR K1= 0 TO S3
  195. 2890 A(I6,J6)= T1:I6= I6+ I5:J6= J6+ J5
  196. 2900 NEXT K1
  197. 2910 NEXT K
  198. 2920 RETURN 
  199. 2930 REM  3SET SEARCH LIMITS FOR COMPUTER MOVE5
  200. 2940 IF I= YL THEN YL= YL- 1:IF YL< 1 THEN YL= 1
  201. 2950 IF I= YH THEN YH= YH+ 1:IF YH> 8 THEN YH= 8
  202. 2960 IF J= XL THEN XL= XL- 1:IF XL< 1 THEN XL= 1
  203. 2970 IF J= XH THEN XH= XH+ 1:IF XH> 8 THEN XH= 8
  204. 2980 LOCATE 1,2
  205. 2990 RETURN 
  206. 3000 REM  INPUT SUBROUTINE5"
  207. 3010 PRINT D$E$"BAD MOVE; TRY AGAIN."
  208. 3020 I= - 1:J= - 1
  209. 3030 FOR K= 1 TO 2
  210. 3040 GOSUB 3220
  211. 3050 G= ASC (X$)
  212. 3060 IF 47< G AND G< 58 THEN I= G- 48:PRINT ""X$"  ";
  213. 3070 IF 64< G AND G< 74 THEN J= G- 64:PRINT ""X$"  ";
  214. 3075 IF 96< G AND G<106 THEN J= G- 96:PRINT ""X$"  ";
  215. 3080 NEXT :PRINT :LOCATE ,,0:RETURN
  216. 3090 REM BLINK COMPUTERS MOVE5
  217. 3100 LOCATE 2* J3+ 3,4* I3+ 1,0:COLOR 20,7:PRINT CHR$(2):COLOR FFF,BBB
  218. 3110 I= I3:J= J3
  219. 3120 GOSUB 2940
  220. 3130 FOR NN= 1 TO 1000:NEXT 
  221. 3140 RETURN 
  222. 3150 REM BLINK PLAYERS MOVE5
  223. 3160 IF PT= 2 THEN CC= 0
  224. 3170 IF PT= 1 THEN CC= 2
  225. 3180 LOCATE 2* J+ 3,4* I+ 1:COLOR C(PT)+16,7:PRINT CHR$(PT):COLOR FFF,BBB
  226. 3190 GOSUB 2940
  227. 3200 FOR NN= 1 TO 500:NEXT 
  228. 3210 RETURN 
  229. 3220 REM INPUT STATEMENTS
  230. 3230 SOUND 3000,2
  231. 3240 X$=INKEY$:IF X$="" THEN 3240 ELSE IF X$=CHR$(27) THEN RUN "B:MENU" ELSE IF X$<"a" THEN RETURN:ELSE X$=CHR$(ASC(X$) AND &HDF):RETURN
  232. 3250 REM  PRINT SCORE
  233. 3260 LOCATE 5,36:COLOR 1,7:PRINT CHR$(1);:COLOR FFF,BBB:PRINT RIGHT$ ("  "+ STR$ (SC(1)),3);" ":LOCATE 19,36:COLOR 4,7:PRINT CHR$(2);:COLOR FFF,BBB:PRINT RIGHT$ ("  "+ STR$ (SC(2)),3);" ";:LOCATE 2,1
  234. 3270 RETURN
  235. 3280 REM BOARD DATA
  236. 3290 DATA 0,1,-1,1,-1,0,-1,-1,0,-1,1,-1,1,0,1,1
  237. 3300 FFF= 7:BBB=3:WIDTH 40:COLOR FFF,BBB,1
  238. 3310 CLS:COLOR 5,1:PRINT STRING$(40," "):LOCATE 1,13,0:COLOR 14,1:PRINT "O T H E L L O"
  239. 3320 COLOR 0,5:LOCATE 3,2:PRINT"   1   2   3   4   5   6   7   8  "
  240. 3330 FOR N=4 TO 20:LOCATE N,2:PRINT " ";:NEXT N:FOR N=1 TO 8:LOCATE 3+2*N,2:PRINT CHR$(N+64);:NEXT
  241. 3335 COLOR   6,7
  242. 3340 LOCATE 4,3  :PRINT"╔═══╦═══╦═══╦═══╦═══╦═══╦═══╦═══╗":FOR N=1 TO 13 STEP 2
  243. 3350 LOCATE 4+N,3:PRINT"║   ║   ║   ║   ║   ║   ║   ║   ║"
  244. 3360 LOCATE 5+N,3:PRINT"╠═══╬═══╬═══╬═══╬═══╬═══╬═══╬═══╣":NEXT
  245. 3370 LOCATE 4+N,3:PRINT"║   ║   ║   ║   ║   ║   ║   ║   ║"
  246. 3380 LOCATE 5+N,3:PRINT"╚═══╩═══╩═══╩═══╩═══╩═══╩═══╩═══╝"
  247. 3390 FOR I= 1 TO 8
  248. 3400 COLOR,7:FOR J= 1 TO 8:LOCATE 2* J+ 3,4* I+ 1,0:FACE= (A(I,J)+ 3)/2:IF FACE=1 THEN    COLOR 1 ELSE COLOR 4
  249. 3410 IF FACE = 1.5 THEN COLOR BBB:PRINT" " ELSE PRINT CHR$(FACE)
  250. 3420 NEXT J,I
  251. 3430 COLOR FFF,BBB:GOSUB 3250
  252. 3440 RETURN
  253. 3450 END 
  254. 5000 PRINT P$(PT);:COLOR C(PT):PRINT CHR$(PT);:COLOR FFF:RETURN
  255. 5010 X$=INKEY$:IF X$="" THEN 5010 ELSE Y=VAL(X$):RETURN
  256. 6000 LOCATE 1,1
  257. 6010 PRINT"1";
  258. 6020 PRINT"2";
  259. 65000 '
  260. 65020 KEY(2) ON:ON KEY(2) GOSUB 65200
  261. 65030 KEY OFF:SCREEN 0,1:COLOR 15,3,1:WIDTH 40:CLS:LOCATE 5,18:PRINT " IBM "
  262. 65040 LOCATE 7,12,0:PRINT "Personal Computer"
  263. 65050 COLOR 10,0:LOCATE 10,8,0:PRINT CHR$(213)+STRING$(23,205)+CHR$(184)
  264. 65060 LOCATE 11,8,0:PRINT CHR$(179)+"  -*-   OTHELLO   -*-  "+CHR$(179)
  265. 65070 LOCATE 12,8,0:PRINT CHR$(179)+STRING$(23,32)+CHR$(179)
  266. 65075 LOCATE 13,8,0:PRINT CHR$(179)+"     Author: Unknown   "+CHR$(179)
  267. 65080 LOCATE 14,8,0:PRINT CHR$(179)+" Adapted by: P. Leabo  "+CHR$(179)
  268. 65085 LOCATE 15,8,0:PRINT CHR$(179)+"Enhanced by: R. Vollmer"+CHR$(179)
  269. 65090 LOCATE 16,8,0:PRINT CHR$(212)+STRING$(23,205)+CHR$(190)
  270. 65100 COLOR  8,0:LOCATE 20,5,0:PRINT "Orig. written for: PET computer"
  271. 65105 COLOR  8,0:LOCATE 21,5,0:PRINT "     Last update: 09/14/82     "
  272. 65110 COLOR 14,0:LOCATE 23,7,0:PRINT "Press space bar to continue";CHR$(7);
  273. 65120 COLOR 30:LOCATE 23,5,0:PRINT CHR$(15);:LOCATE 23,35,0:PRINT CHR$(15);
  274. 65130 COLOR 14
  275. 65140 POKE 106,0 'CLEAR KYBD BUFFER
  276. 65150 CMD$ = INKEY$
  277. 65160 IF CMD$="" THEN GOTO 65150
  278. 65170 IF CMD$ = CHR$(27) THEN GOTO 65200
  279. 65180 IF CMD$ = " " THEN GOTO 1
  280. 65190 GOTO 65140
  281. 65200 ON ERROR GOTO 65240:RUN"BASMENU
  282. 65210 IF E<>71 THEN RUN"control
  283. 65220 RUN"A:TRANSFER
  284. 65230 SYSTEM
  285. 65240 E=ERR:RESUME NEXT
  286.