Loadstar 213/213.d81/word345.bas

Commodore BASIC | 2002-01-01 | 9.4 KB | 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)
3066 ww=40000:sysww,f%,w$
3068 a$=str$(peek(71)+peek(72)*e%(8)):aa=val(a$)
3070 rem --- colors
3072 fori=0to5:readc%(i):next
3074 rem --- word dice                               screen codes(65-90)
3076 fori=0to15:readf$:forj=0to5:d%(j,i)=asc(mid$(f$,j+1,1)):next:next
3078 rem --- grid
3080 fori=0to7:readi%:pokea(2)+i,i%+6:next
3082 fori=0to5:pokea(1)+i,0:next:fori=25to30:pokea(1)+i,0:next
3084 fori=6to24:pokea(1)+i,32:next:fori=10to20step5:pokea(1)+i,0:next
3086 rem ---
3088 poke53265,11
3090 poke53280,c%(0):poke53281,c%(1)
3092 rem --- help
3094 sysml+231,hh%,hh%+4
3096 pokemv,lh%
3100 cx%=0:fori=1to4:sysml+15,i,cx%,cx%+7,0,0:cx%=cx%+8:next
3102 sysml+231,4,56
3104 rem --- game
3105 pokemv,lg%
3106 sysml+30,0,39,0,24,160,c%(0):sysml+30,0,38,0,0,255,c%(1)
3107 poke646,c%(3):sysml+12,1,0,"[[208]]lay  [[200]]elp  [[209]]uit"
3108 cx%=0:fori=1to3:sysml+15,i,cx%,cx%+7,0,0:cx%=cx%+8:next
3114 poke199,1:sysml+12,0,17,"][221]":sysml+12,0,18,"=[189]":sysml+15,4,0,1,17,18
3116 sysml+12,37,17,"[[219]":sysml+12,37,18,";[187]":sysml+15,5,37,38,17,18:poke199,0
3118 cx%=16:cy%=2:fori=6to24:iffng1(i)=0thencx%=16:cy%=cy%+2:goto3122
3120 sysml+15,i,cx%,cx%+1,cy%,cy%+1:cx%=cx%+2
3122 next
3124 fori=10to20step5:sysml+15,i,255,255,255,255:next:rem n/a
3125 sysml+15,25,6,8,2,3:sysml+15,26,30,32,2,3
3126 poke646,c%(2):sysml+12,28,0,"[215]ord 3-4-5":sysml+30,2,36,11,24,32,c%(2)
3132 p%(1,0)=5:p%(2,0)=6
3134 p%(1,1)=29:p%(2,1)=30
3136 gosub502:sysml+39,hg%
3138 rem --- title
3140 poke53280,0:poke53281,0
3142 fori=0to23step2:j=i+1
3144 sysml+126,0,39,i,i,159,223,11,11:sysml+126,0,39,j,j,255,191,12,12:next
3146 sysml+30,4,35,6,15,160,15+16:sysml+30,0,39,24,24,160,0
3148 poke646,1
3150 sysml+27,8,"[161][162][163][164][165][166][167][168]  [169][170][189][171][172][189][173][174]"
3152 sysml+27,9,"[175][176][177][178][179][180][181][182][160][160][183][184] [185][186] [187][188]"
3156 poke646,14:sysml+27,11,"[190][191] 2002 [202] & [198] [208]ublishing, [201]nc."
3158 poke646,13:sysml+27,13,"by [204]ance [195]. [212]homas"
3160 poke646,10:sysml+27,24,"[208]ress a key to play."
3161 poke646,c%(2)
3162 rem --- start
3164 poke53265,27:poke198,0:wait198,15:poke198,0
3166 poke53265,11:sysml+42,hg%:pokemv,lg%:pokemv+2,25:sysmm:sysml:poke53265,27
3168 sysml+6,704:sysml+18,0,38,0,22
3170 sysml+129,704,704+64,25536:rem help screen sprite
3172 x=hh%*e%(8)+1016:pokex,143:pokex+1,143:rem help screen pointer (spr 0-1)
3176 return
4000 :
4002 : rem exit
4004 :
4006 poke53269,0:sysml+3:sysmm+3:goto40000
9000 :
9002 : rem data
9004 :
9006 data 158,190,222,254,156,220,188,252:rem box
9100 data 12,15,11,0,6,2:rem colors
9200 data dsyitt
9201 data ttoaow
9202 data weghne
9303 data thrvwe
9304 data aeange
9305 data evlrdy
9306 data ensieu
9307 data cpohsa
9308 data znrnlh
9309 data kafpsf
9310 data edlxir
9311 data ajboob
9312 data tseiso
9313 data rytlet
9314 data ctuimo
9315 data hiunmq
9400 data 1,-1, 5,-5, 4,-4, 6,-6:rem grid steps
9998 :
10000 a$="word345.bas":dv=peek(186):ifdv<8ordv>28thendv=8
10010 open15,dv,15,"s0:"+a$:close15:savea$,dv:end
40000 fori=8to29:poke820+i,i:next:ifdv>8anddv<30thenpoke828,dv:poke820+dv,8
40010 a$="presenter":gosub40030:a$="hello connect":gosub40030
40020 print"[147]":poke53272,23:poke53280,11:poke53281,0:poke646,13:end
40030 forj=8to29:i=peek(820+j):ifi=14thennext
40040 close2:open2,i,2:close2:ifstthen40060
40050 close15:open15,i,15,"r0:"+a$+"="+a$:input#15,er:close15:ifer=63then40070
40060 next:return
40070 a$="hello connect":q$=chr$(34):poke646,peek(53281):print"[147]":poke53272,23
40080 print"[147]p[207]2048,0:p[207]44,8:p[207]43,1:p[207]56,160:p[207]55,0:clr:l[207]"q$a$q$","i
40090 print"run:":poke631,13:poke632,13:poke198,2:end