home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Compute! Gazette 1989 October
/
1989-10.d64
/
triplesearch
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-09-20
|
4KB
|
130 lines
10 rem copyright 1989 compute! publications inc., all rights reserved
20 data169,160,133,252,169,222,133,254,169,0,133,251,133,253,160,0,177
30 data251,145,251,177,253,145,253,136,208,245,230,252,230,254,208,237,96
40 fort=49152to49185:reada:poket,a:next
50 sys49152:poke59639,7:poke1,peek(1)and253
60 poke53280,11:poke53281,0:poke646,3:print"[147]"tab(9)"[206][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][205]"
70 printtab(6)"[192][192][192][192][192][207][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][208][192][192][192][192][192]"
80 printtab(3)"[192][192][192][192][192][192][192][192][165] triplesearch [167][192][192][192][192][192][192][192][192]"
90 printtab(6)"[192][192][192][192][192][204][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][186][192][192][192][192][192]"
100 printtab(9)"[205][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][206]"
110 print""tab(3)"copyright 1989 compute! publ., inc."
120 printtab(11)"all rights reserved"
130 print"what kind of search do you wish to create?"
140 print"1) word-search":print"2) number-search":print"3) pictogram-search"
150 print"choice: ";
160 getk$:ifk$<"1"ork$>"3"then160
170 printk$""tab(12)" ":c=val(k$)
180 ifc=1thenk1$="word-search":k2$="words"
190 ifc=2thenk1$="number-search":k2$="numbers"
200 ifc=3thenk1$="pictogram-search":k2$="pictograms"
210 print""tab(20-len(k1$)/2)k1$""
220 wd=80:ln=66:print"how large is your puzzle (10 -"int(wd/2)"[157])";:inputs
230 ifs<10ors>int(wd/2)then220
240 print"how many "k2$" would you like to":input"enter";nw:ifnw>2*sthen240
250 diml$(nw):ifc=1then290
260 print"would you like me to generate your "k2$" randomly? ";
270 getk$:ifk$<>"y"andk$<>"n"then270
280 printk$:ifk$="y"then340
290 print"enter your "k2$" one at a time.":print"they must be less than"s;
300 print"characters":print"long."
310 forz=1tonw:poke631,157:poke632,157:poke633,32:poke634,34:poke198,4
320 printz;:inputl$(z):l=len(l$(z)):ifl>=sthen310
330 nextz:goto400
340 print"how many characters do you want in each "k2$"[157] (1 -"s-1"[157])";:inputl
350 ifl<1orl>=sthen340
360 print"making list. please wait..."
370 ifc=2thendd=10:d=48
380 ifc=3thendd=63:d=192
390 fori=1tonw:forx=1tol:l$(i)=l$(i)+chr$(int(dd*rnd(1))+d):nextx,i
400 print"would you like the "k2$" printed":print"below the puzzle? ";
410 getk$:ifk$<>"y"andk$<>"n"then410
420 printk$:ifk$="y"thenly=1
430 print"would you like them to be sorted? ";
440 getk$:ifk$<>"y"andk$<>"n"then440
450 printk$:ifk$="y"thena=1
460 print"how do you want your "k2$:print"placed in the puzzle?"
470 print"1) vertically":print"2) horizontally"
480 print"3) diagonally":print"4) horizontally & vertically"
490 print"5) all directions":print"your choice: ";
500 getk$:ifk$<"1"ork$>"5"then500
510 printk$:d=val(k$):ifd=1thendd=2:goto560
520 ifd=2thendd=2:d=3:goto560
530 ifd=3thendd=4:d=5:goto560
540 ifd=4thendd=4:d=1:goto560
550 dd=8:d=1
560 print"enter the title for your puzzle":poke631,34:poke198,1:inputtl$
570 iflen(tl$)>wdthen560
580 print"enter the message to print below the puzzle."
590 poke631,34:poke198,1:inputm$:iflen(m$)>wdthen580
600 dimwf$(s,s):print"please wait...":gp=nw
610 gp=int(gp/2):ifgp=0then670
620 f=0
630 form=1to(nw-gp):iflen(l$(m))>=len(l$(m+gp))then650
640 sw$=l$(m):l$(m)=l$(m+gp):l$(m+gp)=sw$:f=1
650 nextm:iffthen620
660 goto610
670 print"placing:"
680 fori=1tonw:printl$(i):pl=int(dd*rnd(1))+d
690 ifpl=1theno2=-1:gosub790
700 ifpl=2theno2=1:gosub790
710 ifpl=3theno1=-1:gosub850
720 ifpl=4theno1=1:gosub850
730 ifpl=5theno1=-1ando2=-1:gosub910
740 ifpl=6theno1=1ando2=1:gosub910
750 ifpl=7theno1=1ando2=-1:gosub910
760 ifpl=8theno1=-1ando2=1:gosub910
770 ifi=nwthen980
780 nexti
790 l=len(l$(i))
800 p1=int(s*rnd(1))+1:p2=int(s*rnd(1))+1:ifp2+l*o2<0orp2+l*o2>sthen800
810 forx=0tol-1
820 t$=mid$(l$(i),x+1,1):ifwf$(p1,p2+x*o2)<>""andt$<>wf$(p1,p2+x*o2)then800
830 nextx:forx=0tol-1:ifmid$(l$(i),x+1,1)=" "thennextx
840 wf$(p1,p2+x*o2)=mid$(l$(i),x+1,1):nextx:return
850 l=len(l$(i))
860 p1=int(s*rnd(1))+1:p2=int(s*rnd(1))+1:ifp1+l*o1<0orp1+l*o1>sthen860
870 forx=0tol-1
880 t$=mid$(l$(i),x+1,1):ifwf$(p1+x*o1,p2)<>""andt$<>wf$(p1+x*o1,p2)then860
890 nextx:forx=0tol-1:ifmid$(l$(i),x+1,1)=" "thennextx
900 wf$(p1+x*o1,p2)=mid$(l$(i),x+1,1):nextx:return
910 l=len(l$(i))
920 p1=int(s*rnd(1))+1:p2=int(s*rnd(1))+1
930 ifp1+l*o1<0orp1+l*o1>sorp2+l*o2<0orp2+l*o2>sthen920
940 forx=0tol-1:t$=mid$(l$(i),x+1,1)
950 ifwf$(p1+x*o1,p2+x*o2)<>""andt$<>wf$(p1+x*o1,p2+x*o2)then920
960 nextx:forx=0tol-1:ifmid$(l$(i),x+1,1)=" "thennextx
970 wf$(p1+x*o1,p2+x*o2)=mid$(l$(i),x+1,1):nextx:return
980 print"printing the answer key...":open1,4:ta=int((wd-2*s)/2)
990 print#1,spc(int((wd-len(tl$)-2)/2))tl$" key"chr$(13)
1000 forp2=1tos:print#1,spc(ta);:forp1=1tos
1010 ifwf$(p1,p2)=""thenprint#1,"*";chr$(32);:goto1030
1020 print#1,wf$(p1,p2);chr$(32);
1030 nextp1:print#1:nextp2
1040 forx=1toln-s:print#1:next:ifa<>1then1120
1050 print"sorting. please wait...":gp=nw
1060 gp=int(gp/2):ifgp=0then1120
1070 f=0
1080 form=1to(nw-gp):ifl$(m)<=l$(m+gp)then1100
1090 sw$=l$(m):l$(m)=l$(m+gp):l$(m+gp)=sw$:f=1
1100 nextm:iffthen1070
1110 goto1060
1120 print"printing your "k1$"..."
1130 ifc=1thendd=26:d=65
1140 ifc=2thendd=10:d=48
1150 ifc=3thendd=63:d=192
1160 print#1,spc(int((wd-len(tl$))/2))tl$chr$(13)
1170 forp2=1tos:print#1,spc(ta);:forp1=1tos
1180 ifwf$(p1,p2)=""thenprint#1,chr$(int(dd*rnd(1))+d)chr$(32);:goto1200
1190 print#1,wf$(p1,p2)chr$(32);
1200 nextp1:print#1:nextp2
1210 print#1,chr$(13)spc(int((wd-len(m$))/2))m$chr$(13):ifly<>1then1260
1220 x=0
1230 x=x+1:print#1,spc(int(ta/2))l$(x)spc(int(wd/2)-len(l$(x))+int(ta/2));
1240 ifx=nwthenprint#1:goto1260
1250 x=x+1:print#1,l$(x):ifx<>nwthen1230
1260 close1:print"create another puzzle? ";
1270 getk$:ifk$<>"y"andk$<>"n"then1270
1280 ifk$="y"thenrun
1290 print"[147]":end