home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.tar / ftp.whtech.com / club100 / gam / hidden.ba < prev    next >
Text File  |  2006-10-19  |  4KB  |  137 lines
  1. 0 'Club 100 Library - 415/939-1246 BBS     937-5039 NEWSLETTER, 932-8856 VOICE
  2. 2 'Hidden word puzzle generator, from Popular Computing Mag; M100 version, print option by Russ Hall.  Codes are for 3/4 LF on DMP-105.
  3. 3 'Step out and make a sandwich when this one runs!...
  4. 5 GOTO2000
  5. 10 CLEAR 500
  6. 20 DEFINT A-Z
  7. 30 MR=12:MC=12:NC=MR*MC
  8. 40 SP$="-":MK$="*":DC$="+":NW=0
  9. 50 READ WD$
  10. 60 IF WD$<>"/"THEN NW=NW+1:GOTO 50
  11. 70 DIM M$(MR,MC),WD$(NW),D(8,2),SQ(NC),WU(NW),WQ(NW)
  12. 80 RESTORE:FOR I=1 TO NW:READ WD$(I):NEXT I
  13. 90 READ WD$
  14. 100 DATA EAGLE,OSTRICH,ANTELOPE,BOBCAT,COYOTE,HYHENA
  15. 110 DATA SNAKE,ALLIGATOR,PIRAHANA,DEER
  16. 115 DATA ELEPHANT,MONKEY,KANGAROO,FISH,SHARK,MAHIMAHI
  17. 120 DATA LION,TIGER,BEAR,GIRAFFE,ZEBRA,HORSE,GAZELLE,/
  18. 130 FOR I=1 TO 8:READ D(I,1),D(I,2):NEXT I
  19. 140 DATA 0,1,1,1,1,0,1,-1,0,-1,-1,-1,-1,0,-1,1
  20. 150 PRINT"HIDDEN-WORD PUZZLE GENERATOR"
  21. 160 PRINT"GRID SIZE IS"MR"BY"MC
  22. 170 PRINT"VOCABULARY CONTAINS"NW"WORDS"
  23. 180 PRINT:PRINT"SETTING UP THE GRID. PLEASE WAIT."
  24. 190 FOR I=1 TO MR:FOR J=1 TO MC:M$(I,J)=SP$:NEXT J:NEXT I
  25. 200 FOR I=1 TO NC:SQ(I)=0:NEXT I
  26. 210 FOR I=1 TO NC
  27. 220 Q=INT(RND(1)*NC)+1:IF SQ(Q)<>0 THEN 220
  28. 230 SQ(Q)=I
  29. 240 NEXT I
  30. 250 FOR I=1 TO NW:WQ(I)=0:WU(I)=0:NEXT I
  31. 260 FOR I=1 TO NW
  32. 270 Q=INT(RND(1)*NW)+1: IF WQ(Q)<>0 THEN 270
  33. 280 WQ(Q)=I
  34. 290 NEXT I
  35. 300 MF=0:WA=NW:FU=0:DI=1
  36. 310 PRINT"STARTING TO FILL IN THE GRID..."
  37. 320 FOR QP=1 TO NC
  38. 330 CP=SQ(QP)
  39. 340 CR=INT((CP-1)/MC)+1:CC=CP-(CR-1)*MC
  40. 350 IF M$(CR,CC)<>SP$ THEN 960
  41. 360 IF WA=0 THEN MF=0:GOTO 950
  42. 370 M$(CR,CC)=MK$
  43. 380 DK=1
  44. 390 IR=D(DI,1):IC=D(DI,2)
  45. 400 RT=1:IF IR<0 THEN RT=MR
  46. 410 IF IR=0 THEN RT=CR
  47. 420 CT=1:IF IC<0 THEN CT=MC
  48. 430 IF IC=0 THEN CT=CC
  49. 440 BR=CR:BC=CC
  50. 450 IF(BR=RT AND IR<>0)OR(BC=CT AND IC<>0)THEN 490
  51. 460 BR=BR-IR
  52. 470 BC=BC-IC
  53. 480 GOTO 450
  54. 490 RT=1:IF IR>0 THEN RT=MR
  55. 500 IF IR=0 THEN RT=CR
  56. 510 CT=1:IF IC>0 THEN CT=MC
  57. 520 IF IC=0 THEN CT=CC
  58. 530 ER=CR:EC=CC
  59. 540 IF(ER=RT AND IR<>0)OR(EC=CT AND IC<>0)THEN 580
  60. 550 ER=ER+IR
  61. 560 EC=EC+IC
  62. 570 GOTO 540
  63. 580 UR=ER:IF BR>ER THEN UR=BR
  64. 590 LR=BR:IF ER<BR THEN LR=ER
  65. 600 UC=EC:IF BC>EC THEN UC=BC
  66. 610 LC=BC:IF EC<BC THEN LC=EC
  67. 620 PR=BR:PC=BC:P$=""
  68. 630 P$=P$+M$(PR,PC)
  69. 640 PR=PR+IR:PC=PC+IC:IF PR>=LR AND PR<=UR AND PC>=LC AND PC<=UC THEN 630
  70. 650 PL=LEN(P$):SP=INSTR(1,P$,MK$)
  71. 660 FOR LS=1 TO SP:FOR RS=PL TO SP STEP -1
  72. 670 CP$=MID$(P$,LS,RS-LS+1):CL=LEN(CP$)
  73. 680 Q=1
  74. 690 W=WQ(Q)
  75. 700 IF LEN(WD$(W))<>CL THEN MF=0:GOTO 910
  76. 710 MF=1
  77. 720 FOR C=1 TO CL
  78. 730 IF MID$(CP$,C,1)=SP$ OR MID$(CP$,C,1)=MK$ THEN 750
  79. 740 IF MID$(CP$,C,1)<>MID$(WD$(W),C,1) THEN C=CL:MF=0
  80. 750 NEXT C
  81. 760 IF MF=0 THEN 910
  82. 770 FW$=WD$(W)
  83. 780 IF LS>1 THEN FW$=DC$+FW$:LS=LS-1:GOTO 780
  84. 790 IF RS<PL THEN FW$=FW$+DC$:RS=RS+1:GOTO 790
  85. 800 PR=1:R=BR:C=BC
  86. 810 RC$=MID$(FW$,PR,1):IF RC$=DC$ THEN 830
  87. 820 M$(R,C)=RC$
  88. 830 IF (R=ER AND IR<>0)OR(C=EC AND IC<>0)THEN 850
  89. 840 C=C+IC:R=R+IR:PR=PR+1:GOTO 810
  90. 850 IF Q=WA THEN 870
  91. 860 FOR I=Q TO WA-1:WQ(I)=WQ(I+1):NEXT I
  92. 870 WA=WA-1
  93. 880 WU(W)=1
  94. 890 RS=SP:LS=SP:DK=8
  95. 900 PRINT"USED A WORD.":GOTO 920
  96. 910 Q=Q+1:IF Q<=WA THEN 690
  97. 920 NEXT RS:NEXT LS
  98. 930 DI=DI+1:DK=DK+1:IF DI>8 THEN DI=1
  99. 940 IF DK<=8 THEN 390
  100. 950 IF MF=0 THEN M$(CR,CC)=CHR$(INT(RND(1)*26)+65):FU=FU+1:PRINT"USED A FILL CHARACTER."
  101. 960 PRINT NC-QP"CELLS NOT EXAMINED YET."
  102. 970 NEXT QP
  103. 980 PRINT"PUZZLE COMPLETED.":PRINT:GOSUB 1045
  104. 1000 PRINT:PRINT"THE HIDDEN WORDS ARE:"
  105. 1010 FOR I=1 TO NW
  106. 1020 IF WU(I)<>0 THEN PRINT #1,WD$(I)
  107. 1030 NEXT I
  108. 1040 END
  109. 1045 OPEN "RAM:WORKS.DO" FOR APPEND AS #1
  110. 1050 FOR TR=1 TO MR:FOR TC=1 TO MC:PRINT #1,M$(TR,TC)"  ";:NEXT TC:PRINT #1,:NEXT TR
  111. 1060 RETURN
  112. 2000 CLS:PRINT:PRINT"Press for:"
  113. 2010 PRINT:PRINT"   <H>idden puzzle generator"
  114. 2020   PRINT"   <P>uzzle printer"
  115. 2025   PRINT"   <Q>uit
  116. 2030 K$=INKEY$:IFK$=""THEN2030
  117. 2040 IFK$="H"ORK$="h"THENGOTO10
  118. 2050 IFK$="P"ORK$="p"THENGOTO3000
  119. 2055 IFK$="Q"ORK$="q"THENLPRINTCHR$(27);CHR$(54):MENU
  120. 2060 GOTO2030
  121. 3000 S$=STRING$(15,32)
  122. 3005 CLS:PRINT:PRINT"Is the printer turned on?"
  123. 3007 PRINT:LINEINPUT"Name of document to print:";F$
  124. 3010 LPRINTCHR$(27);CHR$(56):E=0:F=0
  125. 3020 OPENF$FORINPUTAS1
  126. 3030 IFEOF(1)THEN3200
  127. 3040 LINEINPUT#1,A$
  128. 3050 IFMID$(A$,2,1)<>" "THEN3150
  129. 3060 LPRINTS$;A$:LPRINT
  130. 3070 GOTO3030
  131. 3150 IFE=0THENLPRINT:LPRINT
  132. 3155 B$=B$+A$+" ":E=1:F=F+1
  133. 3160 IFF=5THENF=0:LPRINTS$;B$:B$=""
  134. 3180 GOTO3030
  135. 3200 LPRINTS$;B$:B$="":LPRINT:LPRINT:LPRINT
  136. 3210 CLOSE:GOTO2000
  137.