home *** CD-ROM | disk | FTP | other *** search
/ Explore the World of Soft…ids, Adults, Educational / RocelcoInc-ExploreTheWorldOfSoftware-KidsAdultsEducational-Vol2-Shareware.iso / educate / disk116 / nim.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1982-09-01  |  8.6 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.