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