home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 213 / 213.d81 / word345.bas (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  10KB  |  379 lines
  1. 1 rem "word345.bas" 2002.03.05
  2. 2 poke55,0:poke56,56:clr
  3. 3 gosub3002:goto5
  4. 4 gosub12:onq%goto4002
  5. 5 q%=3:gosub102:ifp%=0thengosub12:onq%goto4002,5,5,6,4
  6. 6 gosub192:onq%goto4002,5,5,5,4
  7. 10 :
  8. 12 : rem input
  9. 14 :
  10. 16 poke53287,1
  11. 18 sysml+9:ifrg%=25thenifcc%=c%(4)thenifl%>2thenifr2%=1then28
  12. 20 i%=cr%:ifi%=0thensysml+60,"phq":ifi%=0then18
  13. 22 ifi%<6thenoni%gosub502,546,564,470,480:onq%goto30,30:goto18
  14. 24 ifq%=5then18
  15. 26 ifi%<25thengosub138:goto18
  16. 28 gosub160:iff%=0then18
  17. 30 poke53287,7
  18. 32 return
  19. 100 :
  20. 102 : rem init move
  21. 104 :
  22. 106 cc%=c%(0):gosub114
  23. 108 k%=-1:l%=0:p%=1-p%:cc%=c%(4+p%):gosub114:gosub122:f%(10)=f%(10)ande%(1-p%)
  24. 110 return
  25. 112 :
  26. 114 : rem player indicator
  27. 116 :
  28. 118 sysml+36,25+p%,255,cc%:return
  29. 120 :
  30. 122 : rem init word
  31. 124 :
  32. 126 sysml+30,p%(1,p%),p%(1,p%)+4,5,5,32,c%(4+p%):return
  33. 128 :
  34. 130 : rem init grid / paint grid
  35. 132 :
  36. 134 sysml+30,16,23,2,9,sc%,cc%:return
  37. 136 :
  38. 138 : rem check human letter
  39. 140 :
  40. 142 ifl%=0then152:rem 1st
  41. 144 f%=(cc%=c%(4)):rem cancel
  42. 146 iff%thenk%=-1:l%=0:sc%=255:cc%=c%(3):gosub130:gosub122:gosub186:goto156
  43. 148 ifl%=5then156:rem max
  44. 150 ifcc%<>c%(3)then156:rem invalid
  45. 152 sysml+36,i%,255,c%(4):k%=k%+1:f%(k%)=i%:gosub376:gosub444
  46. 154 pokea(0)+12,i%:pokea(0)+20,k%:pokea(0)+22,l%:sysgl+12
  47. 156 return
  48. 158 :
  49. 160 : rem check human word
  50. 162 :
  51. 164 ifl%=0thenf%=1:gosub460:goto174:rem pass
  52. 166 ifl%<3thenf%=0:goto174
  53. 168 gosub388:iff%=0thenf$="[196]uplicate":gosub178:goto174
  54. 170 m%=l%-1:ifr2%=0thengosub396:iff%=0thenf$="[215]ords[215]orth":gosub178:goto174
  55. 172 gosub186:gosub408:sc%=255:cc%=c%(3):gosub130
  56. 174 return
  57. 176 :
  58. 178 : rem message
  59. 180 :
  60. 182 sysml+30,2,13,9,9,32,c%(1):sysml+12,8-len(f$)/2,9,f$:return
  61. 184 :
  62. 186 : rem erase message
  63. 188 :
  64. 190 sysml+30,2,13,9,9,160,c%(0):return
  65. 192 :
  66. 194 : rem find computer word
  67. 196 :
  68. 198 f%=0:iff%(5)=7then338
  69. 200 rem --- 5 letter
  70. 202 m%=4:iffnf1(5)then256
  71. 204 fori=6to24:iffng1(i)=0then250
  72. 206 iffnf1(i)then250
  73. 208 f%(0)=i:k%=0:l%=0:gosub376
  74. 210 l%(0)=l%
  75. 212 forj1=0to7:f%(1)=f%(0)+fng2(j1):iffng1(f%(1))=0then246
  76. 214 k%=1:l%=l%(0):gosub354:iff%=0then246
  77. 216 l%(1)=l%
  78. 218 forj2=0to7:f%(2)=f%(1)+fng2(j2):iffng1(f%(2))=0then244
  79. 220 k%=2:gosub346:iff%=0then244
  80. 222 l%=l%(1):gosub354:iff%=0then244
  81. 224 l%(2)=l%
  82. 226 forj3=0to7:f%(3)=f%(2)+fng2(j3):iffng1(f%(3))=0then242
  83. 228 k%=3:gosub346:iff%=0then242
  84. 230 l%=l%(2):gosub354:iff%=0then242
  85. 232 ifl%=5thengosub366:goto242
  86. 234 forj4=0to7:f%(4)=f%(3)+fng2(j4):iffng1(f%(4))=0then240
  87. 236 iffng1(f%(4))=81then240:rem "qu"
  88. 238 k%=4:gosub346:iff%thenl%=4:gosub354:iff%thengosub366
  89. 240 next
  90. 242 next
  91. 244 next
  92. 246 next
  93. 248 iff%=0thengosub452
  94. 250 next
  95. 252 iff%then342
  96. 254 i=5:gosub452
  97. 256 rem --- 4 letter
  98. 258 m%=3:iffnf1(5)then302
  99. 260 fori=6to24:iffng1(i)=0then296
  100. 262 iffnf1(i)then296
  101. 264 f%(0)=i:k%=0:l%=0:gosub376
  102. 266 l%(0)=l%
  103. 268 forj1=0to7:f%(1)=f%(0)+fng2(j1):iffng1(f%(1))=0then292
  104. 270 k%=1:l%=l%(0):gosub354:iff%=0then292
  105. 272 l%(1)=l%
  106. 274 forj2=0to7:f%(2)=f%(1)+fng2(j2):iffng1(f%(2))=0then290
  107. 276 k%=2:gosub346:iff%=0then290
  108. 278 l%=l%(1):gosub354:iff%=0then290
  109. 280 ifl%=4thengosub366:goto290
  110. 282 forj3=0to7:f%(3)=f%(2)+fng2(j3):iffng1(f%(3))=0then288
  111. 284 iffng1(f%(3))=81then288:rem "qu"
  112. 286 k%=3:gosub346:iff%thenl%=3:gosub354:iff%thengosub366
  113. 288 next
  114. 290 next
  115. 292 next
  116. 294 iff%=0thengosub452
  117. 296 next
  118. 298 iff%then342
  119. 300 i=5:gosub452
  120. 302 rem --- 3 letter
  121. 304 m%=2:iffnf1(5)then338
  122. 306 fori=6to24:iffng1(i)=0then332
  123. 308 iffnf1(i)then332
  124. 310 f%(0)=i:k%=0:l%=0:gosub376
  125. 312 l%(0)=l%
  126. 314 forj1=0to7:f%(1)=f%(0)+fng2(j1):iffng1(f%(1))=0then328
  127. 316 k%=1:l%=l%(0):gosub354:iff%=0then328
  128. 318 ifl%=3thengosub366:goto328
  129. 320 forj2=0to7:f%(2)=f%(1)+fng2(j2):iffng1(f%(2))=0then326
  130. 322 iffng1(f%(2))=81then326:rem "qu"
  131. 324 k%=2:gosub346:iff%thenl%=2:gosub354:iff%thengosub366
  132. 326 next
  133. 328 next
  134. 330 iff%=0thengosub452
  135. 332 next
  136. 334 iff%then342
  137. 336 i=5:gosub452
  138. 338 rem --- pass
  139. 340 sysml+24,10:gosub460
  140. 342 return
  141. 344 :
  142. 346 : rem possible letter?                        no(f%=0) yes(f%=1)
  143. 348 :
  144. 350 j%=k%-1:forj=0toj%:f%=(f%(k%)=f%(j)):j=j+(j-j%)*f%:next:f%=1+f%:return
  145. 352 :
  146. 354 : rem possible word?                          no(f%=0) yes(f%=1)
  147. 356 :
  148. 358 gosub376:ifl%<=m%thenforj=a(4)+l%toa(4)+m%:pokej,63:next
  149. 360 gosub396
  150. 362 return
  151. 364 :
  152. 366 : rem word ok?                                no(f%=0) yes(f%=1)
  153. 368 :
  154. 370 gosub388:iff%thengosub444:gosub408:i=24:j1=7:j2=7:j3=7:j4=7
  155. 372 return
  156. 374 :
  157. 376 : rem update word
  158. 378 :
  159. 380 pokea(4)+l%,peek(a(1)+f%(k%)):l%=l%+1
  160. 382 iffng1(f%(k%))=81thenpokea(4)+l%,85:l%=l%+1:rem "qu"
  161. 384 return
  162. 386 :
  163. 388 : rem check list for word                     match(f%=0)
  164. 390 :
  165. 392 pokea(0)+22,l%:sysgl+3:f%=fng0(10):return
  166. 394 :
  167. 396 : rem lookup word in wordsworth
  168. 398 :
  169. 400 pokeaa,m%+1:sysml+129,a(4),a(4)+m%+1,peek(aa+1)+peek(aa+2)*e%(8)
  170. 402 sysww+3,a$
  171. 404 return
  172. 406 :
  173. 408 : rem results
  174. 410 :
  175. 412 p%(0,p%)=p%(0,p%)+e%(m%-2)
  176. 414 poke646,cc%:sysml+12,p%(2,p%),7,right$(" "+str$(p%(0,p%)),3):poke646,c%(2)
  177. 416 sysgl+6:c%=fng0(4):n%=fng0(26):ifc%<w%(0)thenw%(0)=c%:goto420
  178. 418 c%=c%-5:ifc%>w%(0)thenw%(0)=c%
  179. 420 gosub490
  180. 422 c%=(n%-1)/14:c%=c%-5:ifc%>w%(1)thenw%(1)=c%
  181. 424 ifn%=182thengosub430
  182. 426 return
  183. 428 :
  184. 430 : rem game over
  185. 432 :
  186. 434 cc%=c%(0):gosub114:ifp%(0,0)=p%(0,1)then438:rem tie
  187. 436 p%=1+(p%(0,0)>p%(0,1)):cc%=c%(4+p%):gosub114
  188. 438 q%=5:f$="[199]ame [207]ver":gosub178
  189. 440 return
  190. 442 :
  191. 444 : rem display word
  192. 446 :
  193. 448 sysml+129,a(4),a(4)+l%,1224+p%(1,p%):return
  194. 450 :
  195. 452 : rem word 1st letter flag                    f%(5) - all words
  196. 454 :
  197. 456 f%(i)=f%(i)ore%(m%-2):return
  198. 458 :
  199. 460 : rem pass flag
  200. 462 :
  201. 464 f%(10)=f%(10)ore%(p%):iff%(10)=3thengosub430
  202. 466 return
  203. 468 :
  204. 470 : rem pan left
  205. 472 :
  206. 474 ifw%(0)>0thenw%(0)=w%(0)-1:gosub490
  207. 476 return
  208. 478 :
  209. 480 : rem pan right
  210. 482 :
  211. 484 ifw%(0)<w%(1)thenw%(0)=w%(0)+1:gosub490
  212. 486 return
  213. 488 :
  214. 490 : rem update window
  215. 492 :
  216. 494 pokea(0)+44,w%(0):sysgl+9:return
  217. 500 :
  218. 502 : rem play new game
  219. 504 :
  220. 506 fori=0to1
  221. 508 p%=i:cc%=c%(0):gosub114:gosub122
  222. 510 sysml+30,p%(2,i),p%(2,i)+2,7,7,32,c%(4+i)
  223. 512 next
  224. 514 sc%=32:cc%=c%(1):gosub130:gosub186
  225. 516 w%(0)=0:w%(1)=0:sysgl:gosub490
  226. 518 poke178,16:sysrl:j=0:x=peek(mv+1)*e%(8)+16:pokea(0)+32,0:f%(5)=0:f%(10)=0
  227. 520 fori=6to24:x=x+4:iffng1(i)=0then532
  228. 522 f%(i)=0:i%=rnd(0)*6:j%=peek(rv+j)-1:j=j+1:pokea(1)+i,d%(i%,j%)
  229. 524 cx%=peek(x):cy%=peek(x+2)
  230. 526 sysml+126,cx%,cx%+1,cy%,cy%,d%(i%,j%)+64,d%(i%,j%)+128,cc%,cc%
  231. 528 sysml+126,cx%,cx%+1,cy%+1,cy%+1,d%(i%,j%)+160,d%(i%,j%)+96,cc%,cc%
  232. 530 ifd%(i%,j%)=81thenpokea(0)+32,i
  233. 532 next
  234. 534 sc%=255:cc%=c%(3):gosub130
  235. 536 p%(0,0)=0:p%(0,1)=0
  236. 538 pokea(0)+26,0
  237. 540 q%=2
  238. 542 return
  239. 544 :
  240. 546 : rem help                                    hh%=screen pg; hh%+4=font pg
  241. 548 :
  242. 550 poke53265,11:sysml+39,hg%:sysml+231,hh%,hh%+4:pokemv,lh%:pokemv+2,6
  243. 552 sysml+30,0,39,1,24,160,c%(0):sysml+30,0,39,0,0,255,c%(1)
  244. 553 poke646,c%(3):sysml+12,1,0,"[[200][207][205][197]]  [ [213][208] ]  [[196][207][215][206]]  [[209]]uit":poke646,c%(2)
  245. 554 sysml+30,0,39,2,23,160,c%(3)+16:poke53265,27
  246. 556 sysml+210,1+128,38,3,22,0,0,c%(3),2,0,"","":rem highlight red
  247. 558 poke53265,11:sysml+231,4,56:sysml+42,hg%:pokemv,lg%:pokemv+2,25:poke53265,27
  248. 560 return
  249. 562 :
  250. 564 : rem quit
  251. 566 :
  252. 568 q%=1:return
  253. 3000 :
  254. 3002 : rem init
  255. 3004 :
  256. 3006 dim c%,cc%,cr%,cx%,cy%,f%,i%,j%,k%,hg%,hh%
  257. 3008 dim l%,l1%,l2%,lg%,lh%,m%,n%,p%,pp%,px%,py%,q%,r1%,r2%,rg%,sc%,sl%
  258. 3010 dim aa,dv,gl,i,j,j1,j2,j3,j4,ml,mm,mv,rl,rv,vl,ww,x
  259. 3012 dim a$,f$,w$
  260. 3014 dim c%(5),d%(5,15),e%(8),f%(24),l%(2),p%(2,1),w%(1)
  261. 3016 dim a(6)
  262. 3018 rem ---
  263. 3020 dv=peek(186):vl=53248
  264. 3022 deffnf1(x)=((f%(x)ande%(m%-2))>0)
  265. 3024 deffng0(x)=peek(a(0)+x)
  266. 3026 deffng1(x)=peek(a(1)+x)
  267. 3028 deffng2(x)=peek(a(2)+x)-6
  268. 3030 rem --- 2^
  269. 3032 e%(0)=1:forj=1to8:i=j-1:e%(j)=e%(i)+e%(i):next
  270. 3034 rem --- mouse
  271. 3036 ml=64*e%(8):mv=ml+309:pokemv+1,93:fori=42to49:readx:pokemv+i,x:next
  272. 3037 sysml+204,120*e%(8)
  273. 3038 hg%=100:hh%=108:lg%=0:lh%=lg%+25*4
  274. 3040 mm=92*e%(8):pokemm+9,0
  275. 3042 rem --- random 2-254
  276. 3044 rl=94*e%(8):rv=rl+95:poke176,0:poke177,94
  277. 3046 rem --- word345.zml
  278. 3048 x=148*e%(8):sysx:gl=x+188
  279. 3050 a(0)=rv  +  16:rem var a-z
  280. 3052 a(1)=a(0)+  52:rem grid
  281. 3054 a(2)=a(1)+  31:rem grid steps
  282. 3056 a(3)=a(2)+   8:rem grid pointers
  283. 3058 a(4)=a(3)+   5:rem word
  284. 3060 a(5)=a(4)+   5:rem list
  285. 3062 a(6)=a(5)+1078:rem end+1 (n.r.)
  286. 3064 rem --- words.ml (wordsworth)
  287. 3