home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib28b.dsk / FIND.EM.bas < prev    next >
BASIC Source File  |  2023-02-26  |  11KB  |  296 lines
  1. 10  REM  **********************
  2. 20  REM  *      FIND.EM       *
  3. 30  REM  *  BY DAVID GRIGGS   *
  4. 40  REM  * COPYRIGHT (C) 1986 *
  5. 50  REM  * BY MICROSPARC, INC *
  6. 60  REM  * CONCORD, MA  01742 *
  7. 70  REM  **********************
  8. 80  ONERR  GOTO 1190
  9. 90  DEF  FN MD(X) = X -((X >SN) *SN) +((X < = 0) *SN)
  10. 100  FOR I = 768 TO 777: READ A: POKE I,A: NEXT 
  11. 110  DATA   104,168,104,166,223,154,72,152,72,96
  12. 120  GOSUB 2580
  13. 130  GOSUB 2860
  14. 140  GOTO 740
  15. 150  HTAB (21 - LEN(Q$)/2): PRINT Q$: NORMAL : RETURN 
  16. 160  INVERSE : GOTO 150
  17. 170  FLASH : GOTO 150
  18. 180  VTAB 22: PRINT "PRESS <RETURN> TO CONTINUE";: GET A$: PRINT A$: RETURN 
  19. 190  IF  LEN(M$)/2 < > INT( LEN(M$)/2)  THEN M$ = M$ +" "
  20. 200  FOR X = 1 TO  LEN(M$)/2:MP$ =  LEFT$(M$,X) + RIGHT$(M$,X): VTAB VP: HTAB 21 -X:Q =  PEEK(SOUND) + PEEK(SOUND): PRINT MP$: NEXT : RETURN 
  21. 210  REM  START OF MENU
  22. 220 NL = 3 +(SN >10)
  23. 230  INVERSE : VTAB VP +NL: PRINT BK$;
  24. 240  VTAB VP +NL: HTAB (20 - LEN(BS$)/2): PRINT BS$;
  25. 250 ZZ$ = SN$(U)
  26. 260  INVERSE : HTAB 1: VTAB VP: PRINT ZZ$
  27. 270  NORMAL : VTAB VP +1: PRINT DE$
  28. 280 SP = U *8 -7 -(U >5) *40 -(U >10) *40
  29. 290  VTAB VP +1: IF U >5  THEN  VTAB VP +2
  30. 300  IF U >10  THEN  VTAB VP +3
  31. 310  HTAB SP: INVERSE : PRINT  MID$ (DE$,(U >5) *40 +(U >10) *40 +SP,8);
  32. 320 A =  PEEK(KB): IF A <128  THEN X =  RND(X): GOTO 320
  33. 330  POKE KS,0:A = A -128: IF A = 21  THEN 420
  34. 340  IF A = 8  THEN 410
  35. 350  IF A = 32  OR A = 10  THEN 440
  36. 360  IF A = 11  THEN 430
  37. 370  IF A = 13  THEN 470
  38. 380  FOR Q = U +1 TO U +SN -1:Z =  FN MD(Q): IF A =  ASC( LEFT$(SN$(Z),1))  THEN U = Z: GOTO 250
  39. 390  NEXT Q
  40. 400  GOTO 320
  41. 410 U = U -1:U =  FN MD(U): GOTO 250
  42. 420 U = U +1:U =  FN MD(U): GOTO 250
  43. 430 U = U -5: GOTO 450
  44. 440 U = U +5: IF U >SN  THEN U = U -15
  45. 450  IF U < = 0  THEN U = U +5: GOTO 450
  46. 460  GOTO 250
  47. 470  REM  EXIT
  48. 480 NN = U: NORMAL 
  49. 490  RETURN 
  50. 500  REM  PROCESS KEY PRESS
  51. 510 A =  PEEK(KB): POKE KS,0
  52. 520  IF A = 141  THEN 610: REM END OF WORD
  53. 530  IF A = 136  THEN  GOSUB 570: RETURN 
  54. 540 A$ =  CHR$(A -128)
  55. 550  IF A$ <"A"  OR A$ >"Z"  THEN  RETURN 
  56. 560 LE = LE +1:B$ = B$ +A$: GOTO 600
  57. 570 LE = LE -1
  58. 580  IF LE < = 0  THEN LE = 1:B$ = "": GOTO 600
  59. 590 B$ =  LEFT$(B$,LE)
  60. 600  VTAB 20: HTAB 1: CALL  -868: PRINT B$;: RETURN 
  61. 610  REM   END OF WORD
  62. 620 CT = CT +1:WD$(CT,PN) = B$:WD$(0,PN) =  STR$(CT): VTAB PV +1: HTAB 1: PRINT B$:B$ = "":LE = 0:PV =  PEEK(37)
  63. 630  VTAB 20: HTAB 1: CALL  -868
  64. 640  IF CT = 100  THEN  TEXT : VTAB 20: PRINT G$;"WORD LIMIT REACHED": GOSUB 180: POP : RETURN 
  65. 650  RETURN 
  66. 660  REM  GET WORDS
  67. 670 PV = 0:LE = 0:B$ = "":CT = 0: REM WORD CT
  68. 680  FOR DE = 1 TO NS
  69. 690  IF  PEEK(KB) >127  THEN  GOSUB 500
  70. 700  IF DE >NS -450  THEN YY =  PEEK(SOUND)
  71. 710  NEXT DE
  72. 720  TEXT : VTAB 20: PRINT G$;"TIME LIMIT REACHED": GOSUB 180
  73. 730  RETURN 
  74. 740  REM  START OF MAIN MENU
  75. 750 U = 1
  76. 760  TEXT : HOME :VP = 19: GOSUB 210
  77. 770  IF NN = SN  THEN 800
  78. 780  ON NN GOSUB 1260,1430,2150,2290
  79. 790  GOTO 760
  80. 800  TEXT : HOME :Q$ = "QUIT THE PROGRAM": GOSUB 160
  81. 810  VTAB 5: PRINT "DO YOU REALLY WISH TO QUIT (Y/N) N"; CHR$(8);: INPUT "";AN$
  82. 820  IF  LEFT$(AN$,1) = "Y"  THEN  HOME : PRINT "THANK YOU FOR PLAYING FIND'EM !!": END 
  83. 830  GOTO 760
  84. 840  REM DISPLAY BOARD
  85. 850  INVERSE 
  86. 860  VTAB 4: HTAB 10: PRINT "                     ": REM 21 SPACES
  87. 870  FOR I = 0 TO 4
  88. 880  VTAB 6 +I *2: HTAB 10: PRINT "                     ": REM 21 SPACES
  89. 890  VTAB 5 +I *2: HTAB 10
  90. 900 IN = I +1
  91. 910  PRINT "  ";L$(IN,1);"   ";L$(IN,2);"   ";L$(IN,3);"   ";L$(IN,4);"   ";L$(IN,5);"  "
  92. 920  NEXT I
  93. 930  PRINT : NORMAL 
  94. 940  RETURN 
  95. 950  REM  SORT WORDS
  96. 960  FOR I = 1 TO NP
  97. 970 LI =  VAL(WD$(0,I))
  98. 980  FOR K = 1 TO LI -1:CH = 0
  99. 990  FOR J = 1 TO LI -K
  100. 1000  IF WD$(J,I) >WD$(J +1,I)  THEN T$ = WD$(J,I):WD$(J,I) = WD$(J +1,I):WD$(J +1,I) = T$:CH = 1
  101. 1010  NEXT J
  102. 1020  IF CH = 0  THEN K = LI
  103. 1030  NEXT K
  104. 1040  NEXT I
  105. 1050  RETURN 
  106. 1060  REM  RESET "0" COUNTS
  107. 1070  FOR I = 1 TO NP
  108. 1080  FOR J = 1 TO  VAL(WD$(0,I))
  109. 1090  IF WD$(J,I) = "^^^"  THEN WD$(0,I) =  STR$(J -1): GOTO 1110
  110. 1100  NEXT J
  111. 1110  NEXT I
  112. 1120  RETURN 
  113. 1130  REM   PICK RANDOM NUMBERS & LETTERS
  114. 1140  FOR I = 1 TO 5: FOR J = 1 TO 5
  115. 1150 X =  INT( RND(1) *6) +1
  116. 1160 L$(I,J) =  MID$ (CC$(I,J),X,1)
  117. 1170  NEXT J,I
  118. 1180  RETURN 
  119. 1190  REM ERROR END
  120. 1200  CALL 768: REM  ON ERR CLEAR
  121. 1210 LI =  PEEK(218) + PEEK(219) *256
  122. 1220 ER =  PEEK(222)
  123. 1230  POKE 216,0
  124. 1240  PRINT "AN ERROR #";ER;" HAS OCCURRED IN LINE ";LI
  125. 1250  END 
  126. 1260  REM **********************
  127. 1270  REM ENTER PLAYERS
  128. 1280  REM **********************
  129. 1290  TEXT : HOME 
  130. 1300 Q$ = "ENTER PLAYERS' NAMES": GOSUB 160
  131. 1310  VTAB 4: PRINT "    (RETURN EXITS)"
  132. 1320  VTAB 3: INPUT "HOW MANY PLAYERS (1-4)? ";A$
  133. 1330  IF A$ = ""  THEN  RETURN 
  134. 1340  IF A$ <"1"  OR A$ >"4"  THEN  PRINT G$;: GOTO 1290
  135. 1350 NP =  VAL(A$)
  136. 1360  FOR I = 1 TO NP
  137. 1370  VTAB 5 +I: PRINT "PLAYER "I"'S (10 CHARS): ";: INPUT "";PL$(I): IF  LEN(PL$(I)) >10  THEN PL$(I) =  LEFT$(PL$(I),10)
  138. 1380 SC(I) = 0
  139. 1390  NEXT I
  140. 1400  VTAB 20: CALL  -958: PRINT "IS THE ABOVE OK (Y/N) Y"; CHR$(8);: INPUT "";A$
  141. 1410  IF A$ = "N"  THEN 1290
  142. 1420 U = 2: RETURN 
  143. 1430  REM **********************
  144. 1440  REM PLAY THE GAME
  145. 1450  REM **********************
  146. 1460 NS = 11000: REM  TIME LIMIT = 3 MINUTES
  147. 1470  GOSUB 1130: REM GENERATE LETTERS
  148. 1480  IF NP = 0  THEN NP = 1
  149. 1490 PC = 0
  150. 1500  HOME 
  151. 1510  FOR PN = 1 TO NP
  152. 1520  TEXT : HOME : PRINT "PLEASE HAVE ";: INVERSE : PRINT PL$(PN);: NORMAL : PRINT " SIT IN FRONT": PRINT "OF THE APPLE NOW -- ALL OTHER PLAYERS   PLEASE DON'T WATCH!!!"
  153. 1530  PRINT : PRINT "PRESS RETURN TO CONTINUE": INPUT "";A$
  154. 1540  HOME 
  155. 1550 Q$ = "ENTER WORDS NOW" + CHR$(7): GOSUB 170
  156. 1560  GOSUB 840: REM  DISPLAY BOARD
  157. 1570  POKE 33,9: POKE 35,19
  158. 1580  GOSUB 660: REM  GET WORDS
  159. 1590  NEXT PN
  160. 1600  REM SCORE THE GAME
  161. 1610  TEXT : HOME 
  162. 1620 Q$ = "SCORE THE GAME": GOSUB 160
  163. 1630  VTAB 6:Q$ = "ELIMINATING DUPLICATE WORDS": GOSUB 150
  164. 1640  GOSUB 950: VTAB 6: CALL  -868
  165. 1650  VTAB 8: PRINT "              WORDS        WORDS": REM 14/8 SPACES
  166. 1660  PRINT "PLAYER       ENTERED  --  UNIQUE": REM 7 SPACES
  167. 1670  PRINT "---------    -------      ------": REM 9 -'S/4 SPACES/7 -'S/6 SPACES/6 -'S
  168. 1680  FOR I = 1 TO NP:LI(I) =  VAL(WD$(0,I))
  169. 1690  VTAB 10 +I: PRINT PL$(I);: HTAB 17: PRINT LI(I)
  170. 1700  NEXT I
  171. 1710  FOR I = 1 TO NP
  172. 1720  FOR L = 1 TO LI(I)
  173. 1730 FL = 0:A$ = WD$(L,I)
  174. 1740  IF  LEN(A$) <3  THEN FL = 1: GOTO 1810
  175. 1750  FOR J = I TO NP
  176. 1760  FOR K = 1 TO LI(J)
  177. 1770  IF J = I  AND K < = L  THEN 1790
  178. 1780  IF A$ = WD$(K,J)  THEN WD$(K,J) = "^^^":FL = (J < >I)
  179. 1790  NEXT K
  180. 1800  NEXT J
  181. 1810  IF FL = 1  THEN WD$(L,I) = "^^^"
  182. 1820  NEXT L
  183. 1830  NEXT I
  184. 1840  GOSUB 950: REM  SORT
  185. 1850  GOSUB 1060: REM RESET WORD COUNTS
  186. 1860  FOR I = 1 TO NP: VTAB 10 +I
  187. 1870  HTAB 29: PRINT WD$(0,I)
  188. 1880  NEXT 
  189. 1890  GOSUB 180
  190. 1900  REM  VERIFY WORDS
  191. 1910  TEXT : HOME 
  192. 1920 Q$ = "VERIFY WORDS": GOSUB 160
  193. 1930  GOSUB 840
  194. 1940  VTAB 16: PRINT "IF THE SPELLING IS CORRECT, PRESS 'Y'.  PRESS 'N' IF INCORRECT."
  195. 1950  POKE 34,17
  196. 1960  HOME 
  197. 1970  FOR I = 1 TO NP
  198. 1980 LI =  VAL(WD$(0,I))
  199. 1990  IF LI = 0  THEN 2100
  200. 2000  FOR J = 1 TO LI
  201. 2010 W$ = WD$(J,I)
  202. 2020  GOSUB 2360
  203. 2030  VTAB 20: CALL  -958: PRINT "THE WORD: ";: INVERSE : PRINT W$: NORMAL 
  204. 2040  IF OK = 0  THEN WD$(J,I) = "^^^": VTAB 20: HTAB 24: PRINT "IS NOT FOUND!!": GOSUB 180: GOTO 2090
  205. 2050  VTAB 20: HTAB 24: PRINT "CORRECT (Y/N) ";: GET A$: PRINT A$
  206. 2060  IF A$ = "Y"  THEN 2090
  207. 2070  IF A$ = "N"  THEN WD$(J,I) = "^^^": GOTO 2090
  208. 2080  GOTO 2050
  209. 2090  NEXT J
  210. 2100  NEXT I
  211. 2110  GOSUB 950: GOSUB 1060
  212. 2120  REM  POST SCORES
  213. 2130  FOR I = 1 TO NP:SC(I) = SC(I) + VAL(WD$(0,I)): NEXT 
  214. 2140 U = 3: RETURN 
  215. 2150  REM **********************
  216. 2160  REM DISPLAY THE STANDINGS
  217. 2170  REM **********************
  218. 2180  TEXT : HOME 
  219. 2190 Q$ = "DISPLAY THE SCORES": GOSUB 160
  220. 2200  VTAB 4: PRINT "               NAME         SCORE": REM 15/9 SPACES
  221. 2210  PRINT "           -------------   -----": REM 11 SPACES/13 -'S/3 SPACES/5 -'S
  222. 2220  IF NP = 0  THEN  VTAB 7: PRINT G$;"    ..... NO PLAYERS ENTERED .....": GOTO 2270
  223. 2230  FOR I = 1 TO NP
  224. 2240  VTAB 5 +I: PRINT "PLAYER "I" - ";PL$(I);:
  225. 2250  HTAB 31: PRINT SC(I)
  226. 2260  NEXT 
  227. 2270  GOSUB 180
  228. 2280 U = 2: RETURN 
  229. 2290  REM **********************
  230. 2300  REM CLEAR THE GAME
  231. 2310  REM *********************
  232. 2320  TEXT : HOME :Q$ = "CLEAR MEMORY": GOSUB 160
  233. 2330  VTAB 5: PRINT "DO YOU REALLY WISH TO DO THIS (Y/N) N"; CHR$(8);: INPUT "";A$
  234. 2340  IF  LEFT$(A$,1) = "Y"  THEN  POP : RUN 
  235. 2350  RETURN 
  236. 2360  REM CHECK THE WORDS
  237. 2370 LI =  LEN(W$):OK = 0
  238. 2380  FOR II = 1 TO 5: FOR JJ = 1 TO 5:C(II,JJ) = 0:P1 = II +(JJ -1) *5: FOR P = 1 TO 3:A(P1,P) = 0: NEXT P,JJ,II
  239. 2390  FOR Q = 1 TO 5: FOR Z = 1 TO 5
  240. 2400  IF L$(Q,Z) < > LEFT$(W$,1)  THEN 2550
  241. 2410 A(1,1) = Q:A(1,2) = Z:C(Q,Z) = 1:P = 2:A(2,3) = 0
  242. 2420  IF (P -1) = LI  THEN OK = 1: RETURN 
  243. 2430 A$ =  MID$ (W$,P,1)
  244. 2440 A(P,3) = A(P,3) +1
  245. 2450  IF A(P,3) <9  THEN 2500
  246. 2460  FOR X = 1 TO 3:A(P,X) = 0: NEXT X:P = P -1
  247. 2470 C(A(P,1),A(P,2)) = 0
  248. 2480  IF P = 1  THEN 2550
  249. 2490  GOTO 2430
  250. 2500 A(P,1) = A(P -1,1) +DX(A(P,3))
  251. 2510 A(P,2) = A(P -1,2) +DY(A(P,3))
  252. 2520  IF A(P,1) <1  OR A(P,1) >5  OR A(P,2) <1  OR A(P,2) >5  THEN 2440: REM OFF BOARD
  253. 2530  IF A$ = L$(A(P,1),A(P,2))  AND C(A(P,1),A(P,2)) = 0  THEN C(A(P,1),A(P,2)) = 1:P = P +1: REM   CORRECT LETTER
  254. 2540  GOTO 2420
  255. 2550  NEXT Z,Q
  256. 2560 OK = 0
  257. 2570  RETURN 
  258. 2580  REM   START OF DATA INITIALIZATION SECTION
  259. 2590 T$ = ""
  260. 2600  DIM SN$(5),CC$(5,5),L$(5,5),WD$(100,4),A(25,3),C(5,5)
  261. 2610 G$ =  CHR$(7):D$ =  CHR$(4):NE = 0
  262. 2620 SOUND =  -16336:KB =  -16384:KS =  -16368
  263. 2630 BS$ = "FIND 'EM !!"
  264. 2640 BK$ = "                                        ": REM   40 BLANKS
  265. 2650 SN = 5
  266. 2660 SN$(1) = " ENTER PLAYERS' NAMES"
  267. 2670 SN$(2) = "  PLAY THE GAME"
  268. 2680 SN$(3) = "DISPLAY STANDINGS"
  269. 2690 SN$(4) = " CLEAR MEMORY AND RESTART PROGRAM"
  270. 2700 SN$(5) = "  QUIT THIS PROGRAM"
  271. 2710 DE$ = ""
  272. 2720  FOR I = 1 TO SN:DE$ = DE$ + LEFT$(SN$(I),7) +" "
  273. 2730  IF  LEFT$(SN$(I),1) = " "  THEN SN$(I) =  MID$ (SN$(I),2): GOTO 2730
  274. 2740 SN$(I) =  LEFT$(SN$(I) +BK$,40): NEXT :DE$ =  LEFT$(DE$ +BK$ +BK$,80 +(SN >10) *40)
  275. 2750 T$(1) = "FIND'EM! BY DAVID GRIGGS":T$(2) = "   COPYRIGHT (C) 1986   ":T$(3) = "   BY MICROSPARC, INC   ":T$(4) = "   CONCORD, MA  01742   "
  276. 2760  REM DATA FOR THE CUBES
  277. 2770  DATA "WYCSBA","ORMTIS","GDETOC","BDHCFA","MLNIEK"
  278. 2780  DATA "EDASRI","NKSOQH","NRTPUA","FEOTNI","KLGCIJ"
  279. 2790  DATA "ELXYAG","HIENRO","LOMPIG","AWXOBE","AEZYDT"
  280. 2800  DATA "TMARID","ASHRTL","NIFDSG","EATNIJ","YWTNAU"
  281. 2810  DATA "SGFBTU","VREAGU","XOLAVR","SLOCTR","PTEAIN"
  282. 2820  FOR I = 1 TO 5: FOR J = 1 TO 5: READ CC$(I,J): NEXT J,I
  283. 2830  FOR I = 1 TO 8: READ DX(I),DY(I): NEXT 
  284. 2840  DATA  1,0,1,1,0,1,-1,1,-1,0,-1,-1,0,-1,1,-1
  285. 2850  RETURN 
  286. 2860  HOME 
  287. 2870 CH$ = "*"
  288. 2880 C = 1:H = 20:L = 40
  289. 2890  VTAB C: HTAB C: FOR I = C TO L: PRINT CH$;: NEXT 
  290. 2900  FOR I = C TO H: VTAB I: HTAB L: PRINT CH$;: NEXT 
  291. 2910  FOR I = L TO C  STEP  -1: VTAB H: HTAB I: PRINT CH$;: NEXT 
  292. 2920  FOR I = H TO C  STEP  -1: VTAB I: HTAB C: PRINT CH$;: NEXT 
  293. 2930 C = C +1:L = L -1:H = H -1
  294. 2940  IF C = 11  AND CH$ = " "  THEN  RETURN 
  295. 2950  IF C = 9  AND CH$ = "*"  THEN CH$ = " ": INVERSE : FOR Y = 1 TO 4:VP = 8 +Y:M$ = T$(Y): GOSUB 190: NEXT Y: GOSUB 180: NORMAL : GOTO 2880
  296. 2960  GOTO 2890