home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / gwbasic / spiele / nim.bas < prev    next >
Encoding:
BASIC Source File  |  1991-05-15  |  9.9 KB  |  241 lines
  1. 10 REM Game of NIM. Author: J. E. Steitz 2-14-82
  2. 20 OPTION BASE 1
  3. 30 DEFINT P,I-N
  4. 40 DIM PILE(13)
  5. 50 CLS:LOCATE 5,1
  6. 60 PRINT"*******************************************************************************"
  7. 70 PRINT"*******************************************************************************"
  8. 80 PRINT"**                                                                           **"
  9. 90 PRINT"**                                                                           **"
  10. 100 PRINT"**                                                                           **"
  11. 110 PRINT"**                                                                           **"
  12. 120 PRINT"**            If you ";:COLOR 0,7:PRINT"DO";:COLOR 7,0
  13. 130 PRINT" want instructions, just hit RETURN (";CHR$(17);CHR$(196);CHR$(217);") key.        **"
  14. 140 PRINT"*******************************************************************************"
  15. 150 PRINT"*******************************************************************************"
  16. 160 LOCATE 8,27
  17. 170 PRINT"Welcome to the game of NIM."
  18. 180 LOCATE 10,15
  19. 190 INPUT"If you do NOT want instructions, type N or NO: ",A$
  20. 200 IF A$ = "N" OR A$ = "n" OR A$="NO" OR A$="no" THEN 350
  21. 210 CLS:PRINT"                 The Game of NIM -- By J. E. Steitz 2-16-82"
  22. 220 PRINT:PRINT"The game of NIM is an ancient game of skill and strategy.  The game is played"
  23. 230 PRINT"with any number of piles of objects.  The two players take turns removing any"
  24. 240 PRINT"number of objects from one of the piles.  You can take one object or the whole"
  25. 250 PRINT"pile, but you can't take objects from two piles."
  26. 260 PRINT:PRINT"As agreed upon before the start of the game, the winner is the one who"
  27. 270 PRINT"takes (or doesn't take) the last object from the last pile.":PRINT
  28. 280 PRINT"In this version of the game, you can elect to have up to 12 piles of objects,"
  29. 290 PRINT"with up to 15 objects in each pile.":PRINT
  30. 300 PRINT"From here on out, just respond to the questions as they come up.":PRINT
  31. 310 PRINT"Oh, by the way, if you want to concede a game, just enter 0,0 when it's your"
  32. 320 PRINT"move.  Your IBM Personal Computer gladly accepts forfeits."
  33. 330 PRINT:PRINT:PRINT"                           GOOD LUCK!":BEEP:BEEP:PRINT
  34. 340 INPUT"When you have finished reading this, just press the return key. ",A$
  35. 350 CLS:PRINT:INPUT"How many piles (1-12)";NPILES
  36. 360 IF NPILES => 1 AND NPILES =< 12 THEN 380
  37. 370 BEEP:PRINT"Come, now - enter a number between 1 and 12":GOTO 350
  38. 380 PRINT:PRINT"you may have from 1 to 15 items in each pile."
  39. 390 FOR PCT = 1 TO NPILES
  40. 400 PRINT USING"How many in pile ##";PCT;
  41. 410 INPUT PILE(PCT)
  42. 420 IF PILE(PCT) >= 1 AND PILE(PCT)<= 15 THEN 440
  43. 430 BEEP:PRINT"You must enter a number between 1 and 15":GOTO 400
  44. 440 NEXT PCT
  45. 450 PRINT:INPUT"Does taking the last item Win (W) or Lose (L) the game";A$
  46. 460 IF A$ = "L" OR A$ = "l" OR A$ = "w" OR A$ = "W" THEN 480
  47. 470 BEEP:PRINT"PLEASE answer with W or L.  Now try again":GOTO 450
  48. 480 WOPT$="take"
  49. 490 IF A$ = "L" OR A$ = "l" THEN WOPT$ = "notake"
  50. 500 PRINT:INPUT"Do you want to move first (Y,N)";A$
  51. 510 IF A$ = "y" OR A$ = "Y" OR A$ = "n" OR A$ = "N" THEN 530
  52. 520 BEEP:PRINT"You MUST answer Y for yes, or N for no.  Try again.":GOTO 500
  53. 530 FIRST$="IBMPC"
  54. 540 IF A$ = "Y" OR A$ = "y" THEN FIRST$ = "player"
  55. 550 WIN$ = "no"
  56. 560 GOSUB 1240
  57. 570 IF FIRST$ = "IBMPC" THEN 610
  58. 580 GOSUB 1100
  59. 590 IF WIN$="no" THEN GOSUB 710
  60. 600 GOTO 630
  61. 610 GOSUB 710
  62. 620 IF WIN$="no" THEN GOSUB 1100
  63. 630 IF WIN$="no" THEN 570
  64. 640 IF WIN$="player" THEN GOSUB 2090
  65. 650 IF WIN$="IBMPC" THEN PRINT:GOSUB 1520:PRINT"Ho, hum --- I win again...":PRINT
  66. 660 INPUT"Want to play another";A$
  67. 670 IF A$ = "y" OR A$ = "Y" OR A$ = "n" OR A$="N" THEN 690
  68. 680 GOSUB 1420:PRINT"Please, just a simple Y or N.  Try again.":GOTO 660
  69. 690 IF A$ = "Y" OR A$ = "y" THEN 350
  70. 700 END
  71. 710 REM IBMPC MOVE
  72. 720 PCTW=0
  73. 730 FOR PCT=1 TO NPILES
  74. 740 IF PILE(PCT)>0 THEN 790
  75. 750 NEXT PCT
  76. 760 WIN$="IBMPC"
  77. 770 IF WOPT$ = "take" THEN WIN$="player"
  78. 780 GOTO 1040
  79. 790 GOSUB 1690
  80. 800 PILEW=PILE(PFIRST)
  81. 810 PCTW=PFIRST
  82. 820 IF PNZ<>1 THEN 910
  83. 830 IF PILE(PFIRST)<> 1 THEN 880
  84. 840 PILE(PFIRST)=0
  85. 850 WIN$="player"
  86. 860 IF WOPT$="take" THEN WIN$="IBMPC"
  87. 870 GOTO 1040
  88. 880 IF WOPT$="take" THEN PILE(PFIRST)=0:WIN$="IBMPC":GOTO 1040
  89. 890 PILE(PFIRST)=1
  90. 900 GOTO 1040
  91. 910 IF PALLONE THEN PILE(PFIRST)=0:GOTO 1040
  92. 920 GOSUB 1830
  93. 930 IF PCTW<>0 THEN 1010
  94. 940 PCTW=RND*NPILES
  95. 950 IF PCTW=0 THEN 940
  96. 960 IF PILE(PCTW)=0 THEN 940
  97. 970 PILEW=PILE(PCTW)
  98. 980 TPILE!=RND*PILEW
  99. 990 PILE(PCTW)=FIX(TPILE!)
  100. 1000 GOTO 1040
  101. 1010 GOSUB 1560
  102. 1020 GOSUB 1690
  103. 1030 IF PALLONE THEN IF WOPT$<>"take" THEN PILE(PCTW)=0
  104. 1040 FOR I=1 TO 1000:NEXT I
  105. 1050 GOSUB 1240
  106. 1060 IF PCTW=0 THEN RETURN
  107. 1070 PRINT USING"I took ## from pile ";PILEW-PILE(PCTW);
  108. 1080 PRINT PCTW
  109. 1090 RETURN
  110. 1100 REM Player's move
  111. 1110 PRINT"Enter pile number and the number you want to remove, separated by a comma."
  112. 1120 PRINT"Enter 0,0 if you want to concede the game."
  113. 1130 INPUT"For example: 2,7 ==> ",PPN,PREM
  114. 1140 IF PPN+PREM=0 THEN 1220
  115. 1150 IF PPN>0 AND PPN<=NPILES THEN 1170
  116. 1160 BEEP:PRINT"That pile number doesn't exist. Try one we are playing with.":GOTO 1110
  117. 1170 IF PREM>0 AND PREM<=PILE(PPN) THEN 1190
  118. 1180 GOSUB 1420:BEEP:PRINT"You can't take zero items and you can't take more than the pile contains.":GOTO 1110
  119. 1190 PILE(PPN)=PILE(PPN)-PREM
  120. 1200 GOSUB 1240
  121. 1210 RETURN
  122. 1220 WIN$="IBMPC"
  123. 1230 GOSUB 1420:RETURN
  124. 1240 REM DISPLAY PILES ROUTINE
  125. 1250 CLS
  126. 1260 FOR PHT = 15 TO 1 STEP -1
  127. 1270 FOR PCT = 1 TO NPILES
  128. 1280 IF PILE(PCT)< PHT THEN PRINT "      ";
  129. 1290 IF PILE(PCT) >= PHT THEN PRINT "O-O   ";
  130. 1300 NEXT PCT
  131. 1310 PRINT
  132. 1320 NEXT PHT
  133. 1330 FOR PCT = 1 TO NPILES
  134. 1340 PRINT USING "##    ";PCT;
  135. 1350 NEXT PCT
  136. 1360 PRINT:PRINT
  137. 1370 FOR PCT = 1 TO NPILES
  138. 1380 PRINT USING "(##)  ";PILE(PCT);
  139. 1390 NEXT PCT
  140. 1400 PRINT
  141. 1410 RETURN
  142. 1420 REM RAZZBERRY ROUTINE
  143. 1430 SOUND 400,7
  144. 1440 FOR I = 1 TO 15
  145. 1450 SOUND 90,20
  146. 1460 FOR J=1 TO 15: NEXT J
  147. 1470 SOUND 40,0
  148. 1480 FOR J=1 TO 15: NEXT J
  149. 1490 NEXT I
  150. 1500 SOUND 40,0
  151. 1510 RETURN
  152. 1520 REM                          FANFARE ROUTINE
  153. 1530 PLAY"t140mbo2c8f8a8o3c8c16c16c8o2a8a16a16a8f8a8f8c"
  154. 1540 PLAY"mbo2c8f8a8o3c4o2a8o3c.."
  155. 1550 RETURN
  156. 1560 REM                    MAKE ALL BIT COLUMNS EVEN ROUTINE
  157. 1570 REM REQUIRES PCTW - THE 'WORKING' PILE NUMBER AND NPILES - PILE COUNT
  158. 1580 PILE(PCTW)=0
  159. 1590 MASK=8
  160. 1600 FOR I=1 TO 4
  161. 1610 PBC=0
  162. 1620 FOR PCT=1 TO NPILES
  163. 1630 IF PILE(PCT) AND MASK THEN PBC=PBC+1
  164. 1640 NEXT PCT
  165. 1650 IF PBC AND 1 THEN PILE(PCTW)=PILE(PCTW) OR MASK
  166. 1660 MASK=MASK/2
  167. 1670 NEXT I
  168. 1680 RETURN
  169. 1690 REM                          CHECK PILE STATUS ROUTINE
  170. 1700 REM If all piles contain one, sets pallone = 1
  171. 1710 REM If all piles are empty, pnz is set to zero, else it counts non-empties
  172. 1720 REM PFIRST is set to the pile number of the first non-empty pile.
  173. 1730 PNSAVE=0
  174. 1740 PNZ=0
  175. 1750 PALLONE=1
  176. 1760 FOR PCT=1 TO NPILES
  177. 1770 IF PILE(PCT)>1 THEN PALLONE=0
  178. 1780 IF PILE(PCT)<>0 AND PNSAVE=0 THEN PNSAVE=PCT
  179. 1790 IF PILE(PCT)<>0 THEN PNZ=PNZ+1
  180. 1800 NEXT PCT
  181. 1810 PFIRST=PNSAVE
  182. 1820 RETURN
  183. 1830 REM                             ANALYZE BIT COLUMNS ROUTINE
  184. 1840 REM IF any bit column is odd, sets PCTW to the pile number of the biggest
  185. 1850 REM pile having a bit in the odd column and sets PILEW to
  186. 1860 REM the number of items in that pile.
  187. 1870 REM IF ALL BIT COLUMNS ARE EVEN, SETS BOTH THE ABOVE VALUES TO ZERO.
  188. 1880 MASK = 8
  189. 1890 FOR I= 1 TO 4
  190. 1900 PBC=0
  191. 1910 PNSAVE=0
  192. 1920 PILESAVE=0
  193. 1930 FOR PCT=1 TO NPILES
  194. 1940 M= PILE(PCT) AND MASK
  195. 1950 IF M=0 THEN 1980
  196. 1960 PBC=PBC+1
  197. 1970 IF PILE(PCT) > PILESAVE THEN PILESAVE=PILE(PCT):PNSAVE=PCT
  198. 1980 NEXT PCT
  199. 1990 M=PBC AND 1
  200. 2000 IF M THEN 2060
  201. 2010 MASK=MASK/2
  202. 2020 NEXT I
  203. 2030 PILEW=0
  204. 2040 PCTW=0
  205. 2050 RETURN
  206. 2060 PILEW=PILESAVE
  207. 2070 PCTW=PNSAVE
  208. 2080 RETURN
  209. 2090 REM                       PLAYER WINS DISPLAY ROUTINE
  210. 2100 PLAY"mbt162o2c4e4e4g4g4o3c4c4e4e4c4c4o2g4g4e4e4"
  211. 2110 FOR I=1 TO 4
  212. 2120 COLOR 7,0
  213. 2130 CLS
  214. 2140 IF I AND 1 THEN COLOR 0,7
  215. 2150 IF I = 3 THEN PLAY"mbt162o3e8e-8d4o2b4b4g4g4f4f4o3d8e8c4c4c4c4c4."
  216. 2160 PRINT"*******************************************************************************"
  217. 2170 PRINT"*******************************************************************************"
  218. 2180 PRINT"********   *********   *******        *********   ********   ******************"
  219. 2190 PRINT"**********   *****   *******   ******   *******   ********   ******************"
  220. 2200 PRINT"************   *   *******   **********   *****   ********   ******************"
  221. 2210 PRINT"**************   *********   **********   *****   ********   ******************"
  222. 2220 PRINT"**************   *********   **********   *****   ********   ******************"
  223. 2230 PRINT"**************   ***********   ******   ********   ******   *******************"
  224. 2240 PRINT"**************   *************        ************        *********************"
  225. 2250 PRINT"*******************************************************************************"
  226. 2260 IF I=4 THEN COLOR 31,0
  227. 2270 PRINT"**********************************************************************   ******"
  228. 2280 PRINT"*********   ***************   ***     *****   *********   ***********   *******"
  229. 2290 PRINT"**********   *************   *****   ******     *******   **********   ********"
  230. 2300 PRINT"***********   ***********   ******   ******   *   *****   *********   *********"
  231. 2310 PRINT"************   ***   ***   *******   ******   ***   ***   ********   **********"
  232. 2320 PRINT"*************   *     *   ********   ******   *****   *   *******   ***********"
  233. 2330 PRINT"**************     *     *********   ******   *******     *********************"
  234. 2340 PRINT"***************   ***   *********     *****   *********   *****   *************"
  235. 2350 PRINT"*******************************************************************************"
  236. 2360 PRINT"*******************************************************************************"
  237. 2370 NEXT I
  238. 2380 COLOR 7,0
  239. 2390 PRINT
  240. 2400 RETURN
  241.