home *** CD-ROM | disk | FTP | other *** search
/ Ahoy 1986 February / Ahoy_Magazine_86-02_1986_Double_L.d64 / elmac (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  7KB  |  252 lines
  1. 0 rem << rr26-1 >>
  2. 10 rem
  3. 15 rem  rupert report #26
  4. 20 rem   elmac plays nim
  5. 25 rem
  6. 30 print chr$(147);
  7. 40 :rem - - - - - - - -
  8. 50 :rem   initialize
  9. 55 :rem - - - - - - - -
  10. 60 dim a(3,4,5,12),m(6,3)
  11. 70 false=0 : true=not false
  12. 80 bk$="[157][157][157][157][157][157][157][157][157][157]"
  13. 90 sp$="                                      "
  14. 100 l$="======================================"
  15. 105 poke53280,0:poke53281,6
  16. 110 print "elmac <the elementary learning machine>"tab(53)"plays nim" : print
  17. 120 open 15,8,15 :rem disk error channel
  18. 125 :rem - - - - - - - - - - - -
  19. 130 rem - - begin new game - -
  20. 140 :rem - - - - - - - - - - - -
  21. 150 :rem  read keyboard
  22. 160 gosub 2110
  23. 170 :rem  player chosen yet?
  24. 180 if pl=0 then 160
  25. 190 :rem  move array filled yet?
  26. 200 if f0=1 then 230
  27. 210 :rem  fill move array initially
  28. 220 print : print "thinking ..." : gosub 1580 : f0=1
  29. 230 if not mdchg then 300
  30. 240 :rem  new game in new mode
  31. 250 print chr$(147); : ll=5 : gosub 2400 : mdchg=false
  32. 260 :rem
  33. 270 :rem <><><> main game loop <><><><>
  34. 280 :rem
  35. 290 :rem  new game in previous mode
  36. 300 x=3 : y=4 : z=5 : mn=0
  37. 310 :rem  does elmac go first?
  38. 320 if rnd(0)<.5 then 380
  39. 330 :rem  other player's move
  40. 340 on pl gosub 810,1790
  41. 350 :rem  did other player win?
  42. 360 if x+y+z=0 then win=false :goto 460
  43. 370 :rem  elmac's turn
  44. 380 gosub 530
  45. 390 :rem  did elmac lose?
  46. 400 if tm=0 then win=false : goto 460
  47. 410 :rem  did elmac make last move?
  48. 420 if x+y+z=0 then win=true : goto 460
  49. 430 :rem  ready for next move
  50. 440 goto 340
  51. 450 :rem  go to game over routine
  52. 460 gosub 970
  53. 470 :rem  has any key been pressed?
  54. 480 get r$ : if r$<>"" then 160
  55. 490 :rem  start next game, same mode
  56. 500 goto 300
  57. 510 :rem <><><> end of game loop <><><>
  58. 520 :rem - - - - - - - - - -
  59. 530 rem    elmac's move
  60. 540 :rem - - - - - - - - - -
  61. 550 :rem  how many valid moves?
  62. 560 tm=a(x,y,z,0)
  63. 570 :rem return if no valid moves; elmac lost
  64. 580 if tm=0 then 790
  65. 590 :rem  select next move
  66. 600 rn=int(rnd(0)*tm)+1
  67. 610 :rem  step thru the choices to find           the selected move
  68. 620 ct=0 : for p=1 to 12
  69. 630 ct=ct+a(x,y,z,p) : mv=p
  70. 640 :rem  found move value (mv=1 to 12)
  71. 650 if ct>=rn then p=12
  72. 660 next p
  73. 670 :rem  record the move
  74. 680 mn=mn+1 : m(mn,0)=mv : m(mn,1)=x
  75. 690 m(mn,2)=y : m(mn,3)=z
  76. 700 :rem  save the board
  77. 710 x0=x : y0=y : z0=z
  78. 720 :rem  mv stores the selected move
  79. 730 if mv<4 then x=x-mv : goto 770
  80. 740 if mv<8 then y=y-mv+3 : goto 770
  81. 750 z=z-mv+7
  82. 760 :rem  show board after move
  83. 770 print "elmac: ";x;y;z
  84. 780 :rem  next move
  85. 790 return
  86. 800 :rem - - - - - - - - - - -
  87. 810 rem      random player
  88. 820 :rem - - - - - - - - - - -
  89. 830 :rem  pick random move
  90. 840 row=int(rnd(0)*3)+1
  91. 850 if row=1 then max=x
  92. 860 if row=2 then max=y
  93. 870 if row=3 then max=z
  94. 880 :rem if row empty, try again
  95. 890 if max=0 then 840
  96. 900 num=int(rnd(0)*max)+1
  97. 910 if row=1 then x=x-num
  98. 920 if row=2 then y=y-num
  99. 930 if row=3 then z=z-num
  100. 940 print "random:";x;y;z
  101. 950 return
  102. 960 :rem - - - - - - - - - -
  103. 970 rem      game over
  104. 980 :rem - - - - - - - - - -
  105. 990 :rem  increment number of games
  106. 1000 ng=ng+1
  107. 1010 if win=true then 1110
  108. 1020 :rem  > > elmac lost! < <
  109. 1030 :rem  punish the last move
  110. 1040 last=a(x0,y0,z0,mv)
  111. 1050 a(x0,y0,z0,mv)=0
  112. 1060 a(x0,y0,z0,0)=a(x0,y0,z0,0)-last
  113. 1070 :rem  increment number of losses
  114. 1080 nl=nl+1
  115. 1090 :rem  update screen
  116. 1100 goto 1220
  117. 1110 :rem > > elmac won! < <
  118. 1120 :rem  increment number of wins
  119. 1130 nw=nw+1
  120. 1140 :rem  reward all winning moves
  121. 1150 for j=1 to mn
  122. 1160 x1=m(j,1) : y1=m(j,2) : z1=m(j,3)
  123. 1170 m1=m(j,0)
  124. 1180 a(x1,y1,z1,m1)=a(x1,y1,z1,m1)+1
  125. 1190 a(x1,y1,z1,0)=a(x1,y1,z1,0)+1
  126. 1200 next j
  127. 1210 :rem  update screen
  128. 1220 if pl=1 then 1260
  129. 1230 if win then print "elmac won. press any key."
  130. 1240 if not win then print "you won. press any key."
  131. 1250 get r$ : if r$="" then 1250
  132. 1260 for j=1 to 8 : print sp$ : next j :ll=1 : gosub 2400
  133. 1270 wstrk=wstrk+1
  134. 1280 if not win then wstrk=0
  135. 1290 if wstrk>wmax then wmax=wstrk
  136. 1300 print "# games, wins, losses    % win"
  137. 1310 print tab(2)ng;tab(9)nw;tab(16)nl;tab(25)left$(str$(100*nw/ng)+"    ",7)
  138. 1320 print "current/longest win streak          ";bk$;wstrk;"/";wmax : print l$
  139. 1330 :rem  ready for new game
  140. 1340 return
  141. 1350 :rem - - - - - - - - - - - - - - -
  142. 1360 rem  display & save move array
  143. 1370 :rem - - - - - - - - - - - - - - -
  144. 1375 :rem  display move array
  145. 1380 print chr$(147)
  146. 1390 for i=0 to 3 : for j=0 to 4
  147. 1400 for k=0 to 5 : print "";i;j;k;"[146]"
  148. 1410 for p=0 to 12 : print a(i,j,k,p); : next p
  149. 1420 print :get r$ :if r$<>"" then i=3 :j=4 : k=5
  150. 1430 next k : next j : next i
  151. 1440 :rem  save move array to disk
  152. 1450 input "save this array (y/n)";a$
  153. 1460 if a$<>"y" then 1560
  154. 1470 input "what filename";f$
  155. 1480 :rem  create move array if it's not already loaded
  156. 1490 if f0=0 then print "one moment ..." : gosub 1580 : f0=1
  157. 1500 open 1,8,8,f$+",s,w" : gosub 2500
  158. 1510 for i=0 to 3 : for j=0 to 4
  159. 1520 for k=0 to 5 : for p=0 to 12
  160. 1530 print#1,a(i,j,k,p)
  161. 1540 next p,k,j,i
  162. 1550 print#1 : close 1
  163. 1560 return
  164. 1570 :rem - - - - - - - - - - - - - - -
  165. 1580 rem  fill move array initially
  166. 1590 :rem - - - - - - - - - - - - - - -
  167. 1600 for x=0 to 3 : for y=0 to 4
  168. 1610 for z=0 to 5
  169. 1620 a(x,y,z,0)=x+y+z
  170. 1630 if x<>0 then for p=1 to x : a(x,y,z,p)=1 : next p
  171. 1640 if y<>0 then for p=4 to y+3:a(x,y,z,p)=1:next p
  172. 1650 if z<>0 then for p=8 to z+7:a(x,y,z,p)=1:next p
  173. 1660 next z,y,x
  174. 1670 return
  175. 1680 :rem - - - - - - - - - - - - - - -
  176. 1690 rem  fill move array from file
  177. 1700 :rem - - - - - - - - - - - - - - -
  178. 1710 input"load from what file";f$
  179. 1720 open 1,8,8,f$+",s,r" : gosub 2500
  180. 1730 for i=0 to 3 : for j=0 to 4
  181. 1740 for k=0 to 5 : for p=0 to 12
  182. 1750 input#1,a(i,j,k,p)
  183. 1760 next p,k,j,i : close 1
  184. 1770 return
  185. 1780 :rem - - - - - - - -
  186. 1790 rem    user plays
  187. 1800 :rem - - - - - - - -
  188. 1810 b(1)=x : b(2)=y : b(3)=z
  189. 1820 for j=1 to 5 : print sp$ :next j
  190. 1830 ll=10 : gosub 2400
  191. 1840 print "row 1 =";x
  192. 1850 print "row 2 =";y
  193. 1860 print "row 3 =";z
  194. 1870 print "   <press m to go to menu>"
  195. 1880 print ""sp$"[145]"
  196. 1890 input "pick from which row";rw$
  197. 1900 :rem  m = back to menu & restart
  198. 1910 if rw$="m" then 160
  199. 1920 rw=val(rw$)
  200. 1930 if rw<1 or rw>3 then 1820
  201. 1940 :rem  0 = empty row
  202. 1950 if b(rw)=0 then 1820
  203. 1960 ll=17 : gosub 2400
  204. 1970 print sp$"[145]"
  205. 1980 print "take how many from row";rw;
  206. 1990 input tk$ : if tk$="m" then 160
  207. 2000 tk=val(tk$)
  208. 2010 :rem  take too many?
  209. 2020 if tk>b(rw) then 1960
  210. 2030 :rem  choose a different row
  211. 2040 if tk<1 then 1820
  212. 2050 b(rw)=b(rw)-tk
  213. 2060 x=b(1) : y=b(2) : z=b(3)
  214. 2070 ll=5 : gosub 2400
  215. 2080 print "user:  ";x;y;z
  216. 2090 return
  217. 2100 :rem - - - - - - - - - -
  218. 2110 rem   read keyboard
  219. 2120 :rem - - - - - - - - - -
  220. 2130 print : print sp$,sp$ : print l$
  221. 2140 print "press <c> for random computer to play               against elmac"
  222. 2150 print"press <p> to play against elmac                           "
  223. 2160 print "press <l> to load the move array from               disk"
  224. 2170 print "press <d> to display the move array                      "
  225. 2180 print "press <s> to save the move array to disk" : print : print
  226. 2190 get r$ : if r$="" then 2190
  227. 2200 print r$
  228. 2205 :rem  mode change
  229. 2210 mdchg=true
  230. 2220 :rem  random computer plays
  231. 2230 if r$="c" then pl=1 : return
  232. 2240 :rem  user plays
  233. 2250 if r$="p" then pl=2 : return
  234. 2255 :rem  display the move array
  235. 2260 if r$<>"d" then 2290
  236. 2270 if f0=0 then print "thinking..." : gosub 1580 : f0=1
  237. 2280 gosub 1360 : return
  238. 2285 :rem  save the move array
  239. 2290 if r$="s" then gosub 1450 :return
  240. 2300 :rem  load the move array
  241. 2310 if r$="l" then gosub 1690 : f0=1 : return
  242. 2320 goto 2130 :rem  bad key
  243. 2400 rem  locate cursor at column one of line ll (ll=1 to 24)
  244. 2410 poke 214,ll-1 : print
  245. 2420 return
  246. 2500 rem  check disk error status
  247. 2510 input#15,en,em$,et,es
  248. 2520 if en<20 then 2550
  249. 2530 print en;em$;et;es : close 15 : close 1 : goto 120
  250. 2540 :rem  no error
  251. 2550 return
  252.