home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 1: Collection A / 17Bit_Collection_A.iso / files / 35.dms / 35.adf / gomoku.bas < prev    next >
Encoding:
BASIC Source File  |  1988-05-22  |  5.2 KB  |  162 lines
  1. 100   REM - Oriental Game of Gomoko - Version 1.0 - ABasiC
  2. 200   REM - By Gary D. Walborn
  3. 300   REM - November 2, 1985
  4. 400   REM - You may freely use and distribute this program without profit.
  5. 500   REM - Please do not remove these heading lines
  6. 1000  screen 1,3
  7. 1010  player%=1:computer%=2:empty%=0
  8. 1020  dim a%(10,10)
  9. 1030  size%=10:zero%=0:one%=1
  10. 1100  for r=0 to 8:read reg%(r):next r
  11. 1200  window 2,10,10,500,80,"Instructions"
  12. 1300  cmd #2
  13. 1400  print "    This game is played on a 10 x 10 grid.  During the"
  14. 1500  print "play, you may cover one grid intersection with a marker"
  15. 1600  print "The object of the game is to place 5 markers in a row --"
  16. 1700  print "5 adjacent markers in a row -- horizontally, vertically, "
  17. 1800  print "horizontally, vertically, or along either diagonal."
  18. 1850  print "Place the cursor and click the mouse to move."
  19. 1900  print "If I prevent you from placing 5 markers in a row, I win!"
  20. 2000  cmd #0
  21. 2100  a$="Read the instruction. Then press enter":gosub 11500
  22. 2200  input a$
  23. 2300  gosub 6800:gosub 7200
  24. 2600  for i%=one% to size%:for j%=one% to size%:a%(i%,j%)=empty%:next j%:next i%
  25. 2700  a$="We alter nate moves. You go first!":gosub 11500
  26. 2800  a$="Your move":gosub 11500
  27. 2900  gosub 10700
  28. 3000  if i%=-1 then 6500
  29. 3100  x%=i%:y%=j%:gosub 5600:if l%=player% then 3400
  30. 3200  a$="That is not a leegal move. Try again!":gosub 11500
  31. 3300  goto 2800
  32. 3400  if a%(i%,j%)=empty% then 3700
  33. 3500  a$="That square is occupied. Try again!":gosub 11500
  34. 3600  goto 2900
  35. 3700  a%(i%,j%)=player%:gosub 9600
  36. 3800  p%=player%:gosub 11900:if win%=one% then 6200
  37. 3900  Rem *** Computer tries intelligent move ***
  38. 4000  For e%=-1 to 1:for f%=-1 to 1: if e%+f%-e%*f%=0 then 4400
  39. 4100  x%=i%+e%:y%=j%+f%:gosub 5600
  40. 4200  if l%=empty% then 4400
  41. 4300  if a%(x%,y%)=player% then 5200
  42. 4400  next f%:next e%
  43. 4500  Rem ***Computer tries random move***
  44. 4600  x%=int(size%*rnd(1))+1:y%=int(size%*rnd(1))+1:gosub 5600:if l%=0 then 4600
  45. 4700  if a%(x%,y%)<>empty% then 4600
  46. 4800  a%(x%,y%)=computer%:i%=x%:j%=y%:gosub 9600
  47. 4900  p%=computer%:gosub 11900:if win%=one% then 6400
  48. 5000  gosub 15700:if win%=one% then 6400
  49. 5100  goto 2800
  50. 5200  x%=i%-e%:y%=j%-f%:gosub 5600
  51. 5300  if l%=zero% then 4600
  52. 5400  goto 4700
  53. 5500  Rem See if move is legal
  54. 5600  l%=one%:if x%<player% then 6100
  55. 5700  if x%>size% then 6100
  56. 5800  if y%<one% then 6100
  57. 5900  if y%>size% then 6100
  58. 6000  return
  59. 6100  l%=zero%:return
  60. 6200  a$="You win! That was a nice move!":gosub 11500
  61. 6300  goto 6500
  62. 6400  a$="I win! Better luck next time!":gosub 11500
  63. 6500  a$="Thank you for the game!":gosub 11500
  64. 6600  a$="Please click the mouse to continue.":gosub 11500
  65. 6650  gosub 10700
  66. 6700  close 1:close 2:end
  67. 6800  window 1,10,10,400,150,"Gomoko by Gary D. Walborn"
  68. 6900  cmd #1:ask window savew%,saveh%
  69. 7000  cmd #0
  70. 7100  return
  71. 7200  cmd #1:a$="Just a moment.":gosub 11500
  72. 7300  ask window width%,height%
  73. 7400  savew%=width%:saveh%=height%
  74. 7500  pena 2
  75. 7600  box (0,0;width%,height%),1
  76. 7700  pena 5
  77. 7800  dx=width%/12
  78. 7900  dy=height%/12
  79. 8000  for x=dx+dx/2 to 11*dx step dx
  80. 8100  draw (x,0 to x,height%)
  81. 8200  next x
  82. 8300  for y=dy+dy/2 to 11*dy step dy
  83. 8400  draw (0,y to width%,y)
  84. 8500  next y
  85. 8600  for i%=one% to size%:for j%=one% to size%
  86. 8700  tx%=i%*dx+dx/2:ty%=j%*dy+dy/2
  87. 8800  peno 1
  88. 8900  if a%(i%,j%)<>empty% then circle (tx%,ty%),dx/8
  89. 9000  if a%(i%,j%)=player% then pena 0
  90. 9100  if a%(i%,j%)=computer% then pena 3
  91. 9200  if a%(i%,j%)<>empty% then paint (tx%,ty%)
  92. 9300  next j%:next i%
  93. 9400  cmd #0
  94. 9500  return
  95. 9600  cmd #1
  96. 9700  ask window width%,height%
  97. 9800  if height%<>saveh% or width%<>savew% goto 7200
  98. 9900  tx%=i%*dx+dx/2:ty%=j%*dy+dy/2
  99. 10000 peno 1
  100. 10100 circle (tx%,ty%),dx/8
  101. 10200 if a%(i%,j%)=player% then pena 0
  102. 10300 if a%(i%,j%)=computer% then pena 3
  103. 10400 paint (tx%,ty%)
  104. 10500 cmd #0
  105. 10600 return
  106. 10700 cmd #1:ask mouse mx%,my%,mb%
  107. 10800 ask window width%,height%
  108. 10900 if width%<>savew% or height%<>saveh% then gosub 7200
  109. 11000 if mb%=empty% then 10700
  110. 11100 if mx%>width% or my%>height% then 10700
  111. 11200 i%=int(mx%/dx):j%=int(my%/dy)
  112. 11300 cmd #0
  113. 11400 return
  114. 11500 b$=translate$(a$)
  115. 11600 b%=narrate(b$,reg%())
  116. 11700 return
  117. 11800 data 130,0,150,0,22200,64,10,1,0
  118. 11900 win%=0
  119. 12000 for ty%=1 to size%
  120. 12100 c%=empty%
  121. 12200 for tx%=1 to size%
  122. 12300 if a%(tx%,ty%)=p% then c%=c%+one% else c%=0
  123. 12400 if c%=5 then win%=one%
  124. 12500 next tx%:next ty%
  125. 12600 for tx%=one% to size%
  126. 12700 c%=zero%
  127. 12800 for ty%=one% to size%
  128. 12900 if a%(tx%,ty%)=p% then c%=c%+one% else c%=zero%
  129. 13000 if c%=5 then win%=one%
  130. 13100 next ty%:next tx%
  131. 13200 for tx%=1 to 5
  132. 13300 for ty%=1 to 5
  133. 13400 d%=size%-tx%
  134. 13500 maxd%=size%-ty%
  135. 13600 if d%<maxd% then maxd%=d%
  136. 13700 maxd%=maxd%-one%
  137. 13800 c%=zero%
  138. 13900 if a%(tx%,ty%)<>p% then 14400
  139. 14000 for d%=zero% to maxd%
  140. 14100 if a%(tx%+d%,ty%+d%)=p% then c%=c%+one% else c%=zero%
  141. 14200 if c%=5 then win%=one%
  142. 14300 next d%
  143. 14400 next ty%:next tx%
  144. 14500 for tx%=5 to 10
  145. 14600 for ty%=0 to 5
  146. 14700 if tx%<10-ty% then maxd%=tx% else maxd%=10-ty%
  147. 14800 maxd%=maxd%-one%
  148. 14900 c%=zero%
  149. 15000 if a%(tx%,ty%)<>p% then 15500
  150. 15100 for d%=zero% to maxd%
  151. 15200 if a%(tx%-d%,ty%+d%)=p% then c%=c%+one% else c%=zero%
  152. 15300 if c%=5 then win% = one%
  153. 15400 next d%
  154. 15500 next ty%:next tx%
  155. 15600 return
  156. 15700 win%=one%
  157. 15800 for tx%=one% to size%
  158. 15900 for ty%=one% to size%
  159. 16000 if a%(tx%,ty%)=empty% then win%=zero%
  160. 16100 next ty%:next tx%
  161. 16200 return
  162.