home *** CD-ROM | disk | FTP | other *** search
/ Avalon 2 / Avalon_02_1995-06_Avalon_Side_A.d64 / wordsearch (.txt) < prev   
Commodore BASIC  |  2023-02-26  |  5KB  |  156 lines
  1. 10 rem ***************************
  2. 11 rem *                         *
  3. 12 rem * wordsearch puzzle maker *
  4. 13 rem *                         *
  5. 14 rem *      converted by       *
  6. 15 rem *                         *
  7. 16 rem * j.hammett for the cbm64 *
  8. 17 rem *                         *
  9. 18 rem *     --- may 1984 ---    *
  10. 19 rem *                         *
  11. 20 rem ***************************
  12. 40 restore:forn=1to8:readuc(n),ud(n):next
  13. 50 dimar$(20),wd$(250):s$="****************************************************"
  14. 70 sp$="                                       ":q$=chr$(34)
  15. 80 sl$=""
  16. 90 poke53280,0:poke53281,0:print"[159]":gosub11000:gosub13000
  17. 100 bx=ac:by=d
  18. 110 gosub14000:forn=1tod:printleft$(sl$,oy+n)spc(ox)ar$(n):next
  19. 130 w%=w%+1:gosub16000:ifky$="_"then1000
  20. 140 gosub3000:goto110
  21. 170 gosub14000:forn=1tod:printleft$(sl$,oy+n)spc(ox)ar$(n):next
  22. 175 printsl$sp$sp$sl$"[211]elect your option [211][146]ave, [208][146]rint or [209][146]uit"
  23. 180 gosub12040:ifa$="q"ora$="[209]"thenprint"[147]":end
  24. 184 ifa$="s"ora$="[211]"then4000
  25. 185 ifa$="p"ora$="[208]"then6000
  26. 190 goto180
  27. 200 rem *** delay loop (about 1 second)
  28. 210 forw=1to1000:next:return
  29. 1000 rem *** end of input?
  30. 1010 printsl$sp$sp$sl$"[193]re you sure that's all the words? ([217]/[206])";
  31. 1020 geta$:ifa$="n"ora$="[206]"thenw%=w%-1:goto130
  32. 1030 ifa$<>"y"anda$<>"[217]"then1020
  33. 1035 printsl$sp$sp$sl$"   [208]lease wait - filling in spaces."
  34. 1040 rem *** fill in spaces
  35. 1050 fory=1tod:ar$(y)=" "+ar$(y)+" ":forx=2toac+1
  36. 1060 ifmid$(ar$(y),x,1)="*"thengosub2000
  37. 1070 next:ar$(y)=mid$(ar$(y),2,ac):next
  38. 1080 forn=1tod:printleft$(sl$,oy+n)spc(ox)ar$(n):next:goto170
  39. 2000 rem *** fill space
  40. 2010 ar$(y)=left$(ar$(y),x-1)+chr$((rnd(1)*26)+193)+mid$(ar$(y),x+1):return
  41. 3000 rem *** actually hide word
  42. 3010 zz=0:printsl$sp$sp$sl$spc(5)"[200]iding "q$ky$q$;:wd$(w%)=ky$
  43. 3020 zz=zz+1:z=0:x=int(rnd(1)*ac)+1:y=int(rnd(1)*d)+1:ifzz>ac+dthen3200
  44. 3025 z=z+1:ifz>15then3020
  45. 3030 z=z+1:ifz>15then3020
  46. 3035 di=int(rnd(1)*8)+1:iflen(ky$)>acanddi<>5anddi<>1then3035
  47. 3036 iflen(ky$)>danddi<>7anddi<>3then3035
  48. 3040 xx=x:yy=y:f%=0:l=1
  49. 3050 a$=mid$(ar$(yy),xx,1):b$=mid$(ky$,l,1)
  50. 3060 ifa$<>"*"anda$<>b$thenf%=1
  51. 3070 xx=xx+uc(di):yy=yy+ud(di)
  52. 3080 ifxx<1orxx>acthenf%=1
  53. 3090 ifyy<1oryy>dthenf%=1
  54. 3100 l=l+1:ifl<=len(ky$)andf%=0then3050
  55. 3110 iff%=1then3030
  56. 3120 forl=1tolen(ky$):ar$(y)=" "+ar$(y)+" "
  57. 3130 ar$(y)=left$(ar$(y),x)+mid$(ky$,l,1)+mid$(ar$(y),x+2)
  58. 3140 ar$(y)=mid$(ar$(y),2,ac)
  59. 3150 x=x+uc(di):y=y+ud(di):next:return
  60. 3200 rem *** cannot hide word!!
  61. 3210 printsl$sp$sp$sl$"[201]'m sorry, but [201] cannot find anywhere tohide ";:w%=w%-1
  62. 3220 printq$ky$q$sl$;:goto200
  63. 4000 rem *** save puzzle
  64. 4010 printsl$sp$sp$sp$sl$"  [211]ave to [212][146]ape, [196][146]isk drive or [210][146]eturn";
  65. 4020 gosub12040:ifa$="t"ora$="[212]"thendn=1:sa=1:goto4100
  66. 4030 ifa$="d"ora$="[196]"thendn=8:sa=8:goto4100
  67. 4040 ifa$="r"ora$="[210]"then170
  68. 4050 goto4020
  69. 4100 rem *** save
  70. 4110 gosub12000:print"  [208]lease [197]nter filename to save":t=d:d=16:gosub16005
  71. 4115 ifdn=8thenky$=ky$+",s,w":open1,8,15,"i0":gosub5000:ifer<>0then4150
  72. 4120 d=t:open8,dn,sa,ky$:gosub5000:ifer<>0then4150
  73. 4130 print#8,d;chr$(13);ac;chr$(13);:gosub5000:ifer<>0then4150
  74. 4140 forn=1tod:print#8,ar$(n);chr$(13);:gosub5000:ifer<>0then4150
  75. 4145 next
  76. 4150 close8:ifdn=8thenclose1
  77. 4160 gosub12000:goto170
  78. 5000 rem *** disk-error check
  79. 5010 ifdn<>8thenreturn
  80. 5020 input#1,er,er$,et,es
  81. 5030 ifer=0thenreturn
  82. 5040 printsl$sp$sl$er$" -  [207]peration aborted":gosub200
  83. 5050 return
  84. 6000 rem *** printer output
  85. 6010 w%=w%-1:printsl$sp$sp$sl$"[208]lease ensure your printer is connected";
  86. 6020 printspc(7)"[208][210][197][211][211] '[211][208][193][195][197]' [212][207] [195][207][206][212][201][206][213][197]."sl$;
  87. 6030 geta$:ifa$<>" "then6030
  88. 6040 printsl$sp$sp$sl$"[208]rinting - [208]ress '[193]' if you want to stop"
  89. 6050 open4,4:forn=0to2:print#4:next
  90. 6060 print#4,left$(s$,ac+2)
  91. 6070 fory=1tod:print#4,"*";:forx=1toac:print#4,chr$(asc(mid$(ar$(y),x,1))and127);
  92. 6075 geta$:ifa$="a"ora$="[193]"then6110
  93. 6080 next:print#4,"*":next
  94. 6081 print#4,left$(s$,ac+2):print#4:print#4
  95. 6085 ifw%<1thenw%=1:f%=1:wd$(1)="[212][200][197][210][197] [193][210][197] [206][207] [215][207][210][196][211] [212][207] [198][201][206][196]":goto6090
  96. 6086 print#4,"try and find these words."chr$(10)
  97. 6090 forn=1tow%:forx=1tolen(wd$(n))
  98. 6095 geta$:ifa$="a"ora$="[193]"then6110
  99. 6100 print#4,chr$(asc(mid$(wd$(n),x,1))and127);:nextx:print#4:nextn:print#4
  100. 6110 w%=w%+1:iff%=1thenw%=1
  101. 6120 close4:goto170
  102. 11000 rem *** instructions
  103. 11010 gosub12000
  104. 11020 print"   [212]he idea of this program is to make"
  105. 11030 print"up [215][207][210][196][211][197][193][210][195][200] puzzles. [217]ou give the"
  106. 11040 print"computer the words that you want to hide";
  107. 11050 print"in the puzzle, and it will fit them in"
  108. 11060 print"wherever possible. [201]f a word cannot be"
  109. 11070 print"successfully hidden, then the program"
  110. 11080 print"will tell you."
  111. 11090 print"[150]   [193]fter you have entered all the words"
  112. 11100 print"you want in the puzzle, any remaining"
  113. 11110 print"spaces in the grid will be filled with"
  114. 11120 print"random letters, to complete the puzzle."
  115. 11130 print"[159]   [207]nce this has been done, you can"
  116. 11140 print"save the puzzle on tape or disk, or"
  117. 11150 print"print it out on your printer."
  118. 11160 gosub12020
  119. 12000 rem *** title
  120. 12010 print"[147]"sp$"    [160]      [215] [207] [210] [196] - [211] [209] [213] [193] [210] [197]         "sp$" [146]":return
  121. 12020 rem *** wait for any keypress
  122. 12030 printsl$sp$sl$spc(7)"[208][210][197][211][211] [193][206][217] [203][197][217] [212][207] [195][207][206][212][201][206][213][197].";
  123. 12040 wait198,15:geta$:return
  124. 13000 rem *** input dimensions routine
  125. 13010 print"  [208]lease enter the size of the puzzle":printspc(11)"you want to make."
  126. 13020 input"[200]ow many letters [193][195][210][207][211][211] [157] ";ac
  127. 13030 ifac>30thenprint"[212]hat's too big!!![145][145][145][145]":goto13020
  128. 13035 ifac<4thenprint"[212]hat's too small!![145][145][145][145]":goto13020
  129. 13040 input"[200]ow many letters [196][207][215][206]  [157] ";d
  130. 13050 ifd>17thenprint"[212]hat's too big!!![145][145][145][145]":goto13040
  131. 13055 ifd<4thenprint"[212]hat's too small!!![145][145][145][145]":goto13040
  132. 13060 bx=ac:by=d:fory=1tod:ar$(y)=left$(s$,ac):next
  133. 13070 printsl$sp$sp$sp$sl$;:return
  134. 14000 rem *** box drawing routine
  135. 14010 gosub12000:printleft$(sl$,(25-by)/2)spc((38-bx)/2)"[172]";
  136. 14020 forz=1tobx:print"[162]";:next:print"[187]"
  137. 14030 forz=1toby:printspc((38-bx)/2)"[161][146]"left$(s$,bx)"[161]":next
  138. 14040 printspc((38-bx)/2)"[188]";
  139. 14050 forz=1tobx:print"[162][146]";:next:print"[190]":ox=int((40-bx)/2):oy=int((25-by)/2)
  140. 14060 return
  141. 15000 rem *** data for directions
  142. 15010 data0,-1,1,-1,1,0,1,1,0,1,-1,1,-1,0,-1,-1
  143. 16000 rem *** input routine
  144. 16002 printsl$sp$sp$sl$"[208]lease [197]nter a [215]ord to hide or _ to end"
  145. 16005 n=0:c$(0)=" ":c$(1)=" [146]"
  146. 16010 ky$=""
  147. 16020 geta$:ifa$=""thena$=chr$(0)
  148. 16021 ifa$="_"thenky$=a$:printsl$sp$sp$sl$;:return
  149. 16025 a=asc(a$)or128
  150. 16030 ifa>192anda<219and(len(ky$)<acorlen(ky$)<d)thenky$=ky$+chr$(a)
  151. 16040 ifa$=chr$(20)andky$>""thenky$=left$(ky$,len(ky$)-1)
  152. 16050 ifa=141thenreturn
  153. 16060 n=abs(n-1):printsl$""ky$c$(n)" ";
  154. 16070 goto16020
  155. 60000 open1,8,15,"s0:wordsearch":close1:save"0:wordsearch",8:verify"0:wordsearch",8
  156.