home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / misc / teaser.lbr / TEASER.BZS / TEASER.BAS
Encoding:
BASIC Source File  |  1993-10-25  |  12.9 KB  |  273 lines
  1. 10 '    *******************************************************
  2.  
  3.     *****        WORD  TEASER      Version 2.3      *****
  4.  
  5.     *****         by Richard Altman   --   1/25/90      *****
  6. 15 '    *****        P.O. Box 4388              *****
  7.  
  8.     *****        Clearlake, CA 95422          *****
  9.  
  10.     *******************************************************
  11.  
  12.  
  13. 20 '
  14. 21 '     USER SUPPORTED
  15. 22 '
  16. 23 '     This program is user-supported software.  It is copyrighted and cannot
  17. 24 ' be sold for profit (without the author's express written permission),  but
  18. 25 ' it may be copied and distributed for free.
  19. 26 '
  20. 27 '     The  SHAREWARE  concept is a  distribution method  that dispenses with
  21. 28 ' heavy  marketing/advertising costs and gives the user the  opportunity  to
  22. 29 ' try a software program before buying.   Its continued existence depends on
  23. 30 ' each user paying for what he does, in fact, use.
  24. 31 '
  25. 32 '     If you find this program [TEASER.BAS] useful,  please send the $18 (or
  26. 33 ' more) registration fee directly to the author:
  27. 34 '
  28. 35 '        Richard S. Altman -- P.O. Box 4388 -- Clearlake, CA 95422
  29. 36 '
  30. 37 '      Upon registration,  you will receive a floppy diskette containing the
  31. 38 ' latest version of this program,  as well as a printed manual detailing its
  32. 39 ' uses and specifications.   You will also receive a FREE  calendar printing
  33. 40 ' program and other programs by the same author.
  34. 41 '
  35. 42 '      WHEN ORDERING,  please be sure to indicate  single or double  density
  36. 43 ' disk drive,  and the name of the program  [TEASER.BAS].   Comments on pro-
  37. 44 ' grams are also most welcome!
  38. 45 '
  39. 46 '      Due to  possible unforeseen circumstances, the above offer is subject
  40. 47 ' to change without notice.
  41. 48 '
  42. 49 ' **************************************************************************
  43. 50 '    Set Up Variables
  44.  
  45.  
  46. 51 '    String:   A$-F$, I$
  47.  
  48.     Integer:  G-H, J-M, T-Z
  49.  
  50.     Single Precision:   N-S
  51.  
  52.  
  53. 52 DEFINT G-M,T-Z:DEFSTR A-F,I:DIM F(24),A(30),D(31),LC(31),W(302),W$(302)
  54. 53 CLS=CHR$(26):CLR=CHR$(24):CX=CHR$(23):PRINT CLS:ESC$=CHR$(27):FE=ESC+"="
  55. 54 FOR X=1 TO 24:F(X)=FE+CHR$(X+31)+" ":NEXT:GOSUB 5020:C7=CHR$(7):WIDTH 255
  56. 55 DEF FNF(X,Y)=FE+CHR$(X+31)+CHR$(Y+31):DEF FNRN(X)=INT(RND*X)+1:B=CHR$(191)
  57. 56 DEF FNTITLE$(X,M$)=FNF(X,1)+STRING$((80-LEN(M$))/2,12)+M$:C4=CHR$(34)
  58. 57 DD=STRING$(65,45):EG="GUESS/# of MATCHES    ":F=CHR$(148):GOSUB 7000
  59. 58 I0%=7:DIM WZ$(20):FOR X=1 TO 300:READ W$(X):W(X)=0:NEXT
  60. 59 '
  61. 60 PRINT F(5)AH;AH:PRINT CLR:FOR X=7 TO 16
  62. 65 PRINT F(X)AG;FNF(X,55)AG:NEXT:PRINT CLR;:GOTO 8000
  63. 70 PRINT FNF(23,20)"Press <ANY KEY> to continue.   ";:GOTO 6000
  64. 75 FOR TX=1 TO 5:PRINT CLS;AZ;FNF(8,24)"<<<   TOO  MANY  GUESSES  !!   >>>   "
  65. 80 PRINT F(14) AZ:FOR T=1 TO 500:NEXT T,TX:IF G<0 THEN G=0:RETURN ELSE RETURN
  66. 85 GOSUB 5025:PRINT FNF(23,5);:FOR X=1 TO 13:PRINT CHR$(64+X)A(X)"   ";:NEXT
  67. 90 PRINT FNF(24,5);:FOR X=14 TO 26:PRINT CHR$(64+X)A(X)"   ";:NEXT:GOTO 5020
  68. 95 '
  69. 100 '    Start Game
  70.  
  71.  
  72. 110 PRINT CLS:WC=WC+1:T=0
  73. 120 IF WC=301 THEN WC=0:FOR X=1 TO 300:W(X)=0:NEXT:GOTO 100
  74. 130 X=FNRN(300):T=T+1:IF W(X)=0 THEN 150 ELSE IF T<10 THEN 130
  75. 140 FOR X=1 TO 300:IF W(X)=1 THEN NEXT
  76. 150 W(X)=1:W=X:WZ$(J1+Q7+I0%+HC)=W$(X)
  77. 160 FOR X=1 TO 5:WW$(X)=MID$(WZ$(J1+Q7+I0%+HC),X,1):NEXT
  78. 170 G=0:GN=GN+1:FOR X=1 TO 30:D(X)="GG":A(X)=" ":NEXT
  79. 180 '
  80. 200 '    Guess the Word
  81.  
  82.  
  83. 205 G=G+1
  84. 210 PRINT ESC"L" CHR$(32)CHR$(32)CHR$(32)CHR$(166)
  85. 215 PRINT ESC"L" CHR$(32)CHR$(32)CHR$(89)CHR$(32)
  86. 220 PRINT ESC"L" CHR$(32)CHR$(34)CHR$(89)CHR$(34)
  87. 225 PRINT ESC"L" CHR$(89)CHR$(32)CHR$(89)CHR$(166)
  88. 230 IF G=1 THEN L$=WT$:GOSUB 5050:PRINT C7
  89. 235 IF G>1 THEN PRINT FNF(2,4)EG;
  90. 240 IF G>11 THEN PRINT EG;
  91. 245 IF G>21 THEN PRINT EG;
  92. 250 PRINT FNF(3,3)DD:GOSUB 5025
  93. 255 IF G<12 THEN FOR X=1 TO 10:IF D(X)<>"GG" THEN PRINT FNF(X+3,6)D(X)" ---- "LC(X);:NEXT
  94. 260 IF G<22 THEN FOR X=11 TO 20:IF D(X)<>"GG" THEN PRINT FNF(X-7,28)D(X)" ---- "LC(X);:NEXT
  95. 265 IF G>21 THEN FOR X=21 TO 30:IF D(X)<>"GG" THEN PRINT FNF(X-17,50)D(X)" ---- "LC(X);:NEXT
  96. 270 D="":GOSUB 5020
  97. 275 PRINT FNF(18,5)"Input your guess -- ?"CLR:PRINT CLR:IF G=1 THEN 285
  98. 280 PRINT FNF(21,5)"Press <RETURN> to change the Used Letter Board."
  99. 285 GOSUB 85:PRINT FNF(18,25)CLR;:INPUT D
  100. 290 IF D="" THEN 1000 ELSE PRINT F(18)CLR:PRINT CLR
  101. 295 '
  102. 300 '    Check the Guesses
  103.  
  104.  
  105. 305 IF LEN(D)<>5 THEN 270
  106. 310 D(G)="":FOR X=1 TO 5:C(X)=MID$(D,X,1):E=C(X)
  107. 315 IF ASC(E)>90 THEN C(X)=CHR$(ASC(E)-32)
  108. 320 D(G)=D(G)+C(X):NEXT:D=D(G)
  109. 325 IF D=WZ$(J1+Q7+I0%+HC) THEN 500
  110. 330 IF G=31 THEN GOSUB 75:GOTO 500
  111. 335 FOR X=1 TO 5:E=C(X):K=ASC(E)-64:IF K<0 THEN 270
  112. 340 IF A(K)=" " THEN A(K)="/"
  113. 345 NEXT:LC=0:'    Letter Count
  114. 350 FOR X=1 TO 5:FOR Y=1 TO 5
  115. 355 IF C(X)=WW$(Y) THEN LC=LC+1
  116. 360 NEXT Y,X:LC(G)=LC:GOTO 205
  117. 365 '
  118. 500 '    Display Totals
  119.  
  120.  
  121. 505 PRINT CLS:GOSUB 5025
  122. 510 PRINT ESC"L" CHR$(34)CHR$(32)CHR$(34)CHR$(178)
  123. 515 PRINT ESC"L" CHR$(34)CHR$(32)CHR$(113)CHR$(32)
  124. 520 PRINT ESC"L" CHR$(34)CHR$(34)CHR$(113)CHR$(34)
  125. 525 PRINT ESC"L" CHR$(34)CHR$(176)CHR$(113)CHR$(176)
  126. 530 PRINT ESC"L" CHR$(34)CHR$(178)CHR$(113)CHR$(178)
  127. 535 PRINT ESC"L" CHR$(113)CHR$(32)CHR$(113)CHR$(178)
  128. 540 IF G>30 THEN G=30
  129. 545 L$=FNF(3,25)+"   "+T$+"   ":GOSUB 5065
  130. 550 PRINT FNF(6,28)"The word was:  "C4;WZ$(J1+Q7+I0%+HC);C4
  131. 555 PRINT FNF(8,28)"You took"G"guesses."C7
  132. 560 GT=GT+G:IF G>GH THEN GH=G
  133. 565 IF G<=GL THEN GL=G
  134. 570 IF GN=1 THEN GL=G
  135. 575 GOSUB 5025:PRINT FNF(10,15)STRING$(46,34)
  136. 580 PRINT FNF(12,25)">>>  Games played = ";:PRINT USING"###";GN
  137. 585 PRINT FNF(14,25)">>>     Best game = ";:PRINT USING"###";GL
  138. 590 PRINT FNF(16,25)">>>     High game = ";:PRINT USING"###";GH
  139. 595 PRINT FNF(18,25)">>>     Avg. game = ";:PRINT USING"###.##";GT/GN
  140. 600 GOSUB 5020:IF EQ="END" THEN RETURN
  141. 605 PRINT FNF(22,13)"Press <S> to STOP."
  142. 610 PRINT FNF(22,40)"Press <ANY> to CONTINUE.   ";
  143. 615 GOSUB 6000:IF AK="S" THEN 625
  144. 620 FOR T=1 TO 750:NEXT:PRINT CLS:GOTO 100
  145. 625 L$="stop":PRINT FNF(22,13)CX"Do you really want to ";:GOSUB 5050
  146. 630 PRINT" this great game?   (Y/N)   "C7;
  147. 635 GOSUB 6000:PRINT F(22)CX;:IF AK="Y" THEN 760 ELSE 620
  148. 640 '
  149. 750 '    End of Game
  150. 760 PRINT FNF(6,20)AF;FNF(8,25)AF;
  151. 770 L$=FNF(8,25)+"  <<<  FINAL  TOTALS  >>>  ":GOSUB 5065:EQ="END"
  152. 780 GOSUB 575:EQ="":PRINT F(21);:END:GOTO 100
  153. 1000 '    Change Used Letter Board
  154. 1005 IF G=1 THEN 270 ELSE FOR X=16 TO 21:PRINT F(X)CLR;:NEXT
  155. 1010 PRINT FNF(17,5)"Press "C4"1"C4" plus <ANY LETTER> to  MARK"F;
  156. 1015 PRINT"  that particular letter."
  157. 1020 PRINT FNF(18,5)"Press <ANY LETTER> to  MARK*  that letter  (as ";
  158. 1025 L$="NOT":GOSUB 5050:PRINT" in the word)."
  159. 1030 PRINT FNF(20,5)"Repeat either MARKING process a second time to CANCEL."
  160. 1035 PRINT FNF(21,5)"Press <";:L$=" RETURN ":GOSUB 5065:PRINT"> to end.    ";
  161. 1040 PRINT"    Press <";:L$=" + ":GOSUB 5065:PRINT"> to CANCEL ALL.   ";
  162. 1045 FX="0":GOSUB 6000:K=ASC(AK)
  163. 1050 IF AK="+" THEN 1105
  164. 1055 IF AK=CHR$(13) THEN L$=WT$+CX:GOSUB 5050:GOTO 270
  165. 1060 IF AK<>"1" THEN 1070
  166. 1065 FX="1":GOSUB 6000:K=ASC(AK)
  167. 1070 IF K<65 OR K>90 THEN 1045
  168. 1075 J=K-64:IF A(J)=" " THEN 1045
  169. 1080 IF FX="1" THEN 1095
  170. 1085 IF A(J)="*" THEN A(J)="/" ELSE A(J)="*"
  171. 1090 GOTO 1100
  172. 1095 IF A(J)=F THEN A(J)="/" ELSE A(J)=F
  173. 1100 GOSUB 85:GOTO 1035
  174. 1105 FOR X=1 TO 26:IF A(X)=" " THEN 1115
  175. 1110 A(X)="/"
  176. 1115 NEXT:GOTO 1100
  177. 1120 '
  178. 5000 '    *****    Misc. Subroutines
  179. 5005 '
  180. 5010 PRINT ESC"B0";:RETURN:'    Inverse Video ON/OFF
  181. 5015 PRINT ESC"C0";:RETURN:
  182. 5020 PRINT ESC"B4";:RETURN:'    Turn Cursor ON/OFF
  183. 5025 PRINT ESC"C4";:RETURN:
  184. 5030 PRINT ESC"B1";:RETURN:'    Reduced Intensity ON/OFF
  185. 5035 PRINT ESC"C1";:RETURN:
  186. 5040 PRINT ESC"B3";:RETURN:'    Underline ON/OFF
  187. 5045 PRINT ESC"C3";:RETURN:
  188. 5050 GOSUB 5040:PRINT L$;:GOTO 5045:'    Underline L$
  189. 5055 '
  190. 5060 GOSUB 5010:GOSUB 5030:PRINT L$;:GOSUB 5015:GOTO 5035:'    Revrs. Video L$
  191. 5065 GOSUB 5010:PRINT L$;:GOTO 5015:'                BRIGHT Video L$
  192. 5070 '
  193. 6000 '    *****     INKEY$ Subroutines
  194. 6010 K$=INKEY$:AK=""
  195. 6020 AK=INKEY$:IF AK="" THEN 6020
  196. 6030 IF ASC(AK)>96 THEN AK=CHR$(ASC(AK)-32)
  197. 6040 RETURN
  198. 6050 K$=INKEY$:BK=""
  199. 6060 BK=INKEY$:IF BK<>CHR$(13) THEN 6060 ELSE RETURN
  200. 6070 '
  201. 7000 '    Opening Screen
  202.  
  203.  
  204. 7010 AA=B+STRING$(2,131):AB=AA+AA:AC=AB+AB:AD=AC+AC: AE=AD+AD+AD+AA+B
  205. 7020 AF=STRING$(38,32):AG=STRING$(23,32):AH=STRING$(38,131):J1=1
  206. 7030 T$="W O R D   T E A S E R":WT$=FNF(16,5)+T$:Q7=2:AZ=STRING$(160,133)
  207. 7040 FOR X=1 TO 21:PRINT F(X)AE;:NEXT:PRINT F(22)AH;AH
  208. 7050 FOR X=16 TO 6 STEP-1:PRINT FNF(X,20)AF;:NEXT
  209. 7060 PRINT FNF(6,20)AH;FNF(10,28)T$
  210. 7070 PRINT FNF(12,27)"KAYPRO 10 CP/M Computer"
  211. 7080 PRINT FNF(23,6)"Copyright (c) 1990 by Richard S. Altman.   ";
  212. 7090 PRINT"All Rights Reserved.   ";:HC=6:RETURN
  213. 7100 '
  214. 8000 '    Instructions ??
  215.  
  216.  
  217. 8010 PRINT FNF(15,22)"Do you want instructions  (Y/N) ? "C7;:FK="":I=INKEY$
  218. 8020 FK=INKEY$:IF FK<>"" THEN 8040
  219. 8030 NX=NX+1:IF NX>32222 THEN NX=100:GOTO 8020 ELSE 8020
  220. 8040 RANDOMIZE NX:IF ASC(FK)>96 THEN FK=CHR$(ASC(FK)-32)
  221. 8050 IF NOT (FK="Y" OR FK="N" OR FK=CHR$(13)) THEN 8020
  222. 8060 IF FK="Y" THEN 8500 ELSE 100
  223. 8070 '
  224. 8500 '    Display Instructions
  225.  
  226.  
  227. 8505 PRINT CLS:L$=FNTITLE$(2,"  <<<  I N S T R U C T I O N S  >>>  ")
  228. 8510 C1="     ":GOSUB 5065:PRINT FNF(6,15);C4"WORD TEASER"C4" is a game ";
  229. 8515 C=C1+C1:PRINT"for one player.  Five-letter words"
  230. 8520 PRINT C"are selected at random for you to guess using the fewest tries."
  231. 8525 PRINT FNF(9,15)"When asked for your input,  enter any 5-LETTER WORD."
  232. 8530 PRINT FNF(11,10)DD;FNF(13,15)"Your guesses may contain double or triple ";
  233. 8535 PRINT"letters, although ":PRINT C"the ";:L$="hidden word":GOSUB 5050
  234. 8540 PRINT" will not contain any doubles."FNF(16,15)"After each of your ";
  235. 8545 PRINT"guesses, you will see a number (from 1-5)":PRINT C"that follows.";
  236. 8550 PRINT"  This tells you the exact number of letters in your"
  237. 8555 PRINT C"word that match the letters in the ";:GOSUB 5050:PRINT"."
  238. 8560 PRINT FNF(23,15)"Press <ANY KEY> to continue.   ";:GOSUB 6000
  239. 8565 PRINT F(6)CX:PRINT TAB(5)" ***  E X A M P L E  ***"F(11)C1"Your Guess:"
  240. 8570 PRINT FNF(11,24)"Computer's Clues:    (( Hidden Word = "C4;:L$=" PRINT "
  241. 8575 GOSUB 5065:PRINT C4" ))":PRINT C1;STRING$(11,45)"  "STRING$(55,45)
  242. 8580 PRINT FNF(13,8)"LIGHT"FNF(13,24)"2    (The I and the T match.)":GOSUB 70
  243. 8585 PRINT FNF(14,8)"TRITE"FNF(14,24)"4    (The R and I match and the T ";
  244. 8590 PRINT"matches twice!)":GOSUB 70
  245. 8595 PRINT FNF(15,8)"ERROR"FNF(15,24)"3    (The three R's match.  E and O ";
  246. 8600 PRINT"are out!)"
  247. 8605 PRINT FNF(16,8)">>>  Because the E and O are out, the T, R, and I are ";
  248. 8610 PRINT"in.  (TRITE)":GOSUB 70
  249. 8615 PRINT FNF(18,8)"TRIPS"FNF(18,24)"4    (Either the P or the S is in!)"
  250. 8620 GOSUB 70:PRINT FNF(19,8)"SONGS"FNF(19,24);: L$=FNF(20,29)+" B I N G O !! "
  251. 8625 PRINT"1    (The N matches!  The G was out from `LIGHT'.)":GOSUB 70
  252. 8630 PRINT FNF(20,8)"PRINT"FNF(20,24)"5    ";CX;C7;:GOSUB 5025
  253. 8635 FOR X=1 TO 12:GOSUB 5065:FOR T=1 TO 95:NEXT:PRINT FNF(20,29)CLR
  254. 8640 FOR T=1 TO 75:NEXT T,X:GOSUB 5065:GOSUB 5020
  255. 8645 PRINT FNF(24,19)STRING$(55,45);FNF(23,24)"Press <RETURN> to start.   ";
  256. 8650 GOSUB 6050:PRINT CLS:GOTO 100
  257. 8655 '
  258. 9000 '    Word List
  259.  
  260.  
  261. 9005 DATA HANDY,STALK,BAKED,FEUDS,WITCH,ABOVE,GROVE,POLKA,MATCH,HEARD,STORM
  262. 9010 DATA DANCE,WHINE,WHIST,WHIRL,VIEWS,WAXEN,WHALE,SQUID,QUICK,MARSH,SPOIL
  263. 9015 DATA BURNT,TOWER,SMILE,CHART,TRAIN,BLINK,YOUNG,SWORD,FOXES,STORY,CIGAR
  264. 9020 DATA THUMB,SCENT,ENTRY,STUDY,WRIST,HOUSE,ARSON,BLAZE,BLAME,BLIMP,LUNCH
  265. 9025 DATA SAUCE,BASTE,CHILD,BLANK,PLANK,SOUTH,LARGE,GIRLS,SPENT,SPEND,LAMBS
  266. 9030 DATA CLIMB,ASKED,WOMEN,BROAD,FIRST,ACTOR,MAKER,RIGHT,SHIFT,BLOND,COULD
  267. 9035 DATA BLACK,CROWN,DITCH,DUMPS,GLAND,MOUTH,SPEAK,PROVE,PRICE,QUIRE,DOUBT
  268. 9040 DATA TACKS,STOCK,LODGE,SPARK,VIOLA,TODAY,HORSE,LIFTS,THIRD,MUSIC,CAGED
  269. 9045 DATA WHITE,CRASH,SHIRT,METAL,PLACE,DIVER,BLADE,BARGE,CHAIR,RELAX,AXLES
  270. 9050 DATA MULCH,WHIPS,ROCKS,ADEPT,WAXED,GAUZE,DUNCE,EXTRA,VALUE,ROUGE,FIRED
  271. 9055 DATA TOUCH,TRIBE,BRUSH,PRISM,BRISK,HARPS,ROYAL,OPERA,DECOY,ROBIN,PACED
  272. 9060 DATA ZONED,BOILS,FAINT,STEAK,HONED,SHINE,FLOCK,BUMPS,SUPER,PIOUS,QUIPS
  273. 9065 DATA PRUNE,ACORN,DIETS,PUNTS,SPUNK,PSALM,BRIDE,BLEAK,BROKE,PRANK,TONER
  274. 9070 DATA FACTS,STRAW,RAVEN,PAWNS,FALSE,PACKS,GUEST,PUCKS,SHOCK,AGILE,WATER
  275. 9075 DATA OTHER,THONG,SAWED,FOUND,BEARD,WAVED,JACKS,GLARE,BRAND,DRINK,RABID
  276. 9080 DATA SLANT,STUNG,FLASK,CLASP,PHONE,CLONE,SINGE,STRIP,SLOPE,AXIOM,FLANK
  277. 9085 DATA CLANK,WORLD,BARED,LUCKY,RAPID,PUDGY,WIDTH,CAROB,PAGES,STICK,SPOUT
  278. 9090 DATA BOXER,TRICK,LOWER,WOMAN,WOULD,GROUP,COAST,CABLE,EARTH,LOCKS,PETAL
  279. 9095 DATA MAIZE,BROWN,DRUMS,SHUNT,SHARK,QUART,EQUAL,BLOCK,WORST,SOLID,SINCE
  280. 9100 DATA SCRAP,CROWS,WRECK,JUDGE,SLICK,STUCK,QUITS,MARCH,CROWD,LIVER,COUNT
  281. 9105 DATA BATHE,FORCE,SHORT,MONEY,PLANT,AZURE,FIGHT,WINDY,CANDY,FINDS,MISTY
  282. 9110 DATA KNIFE,COURT,PITCH,PRICK,STAKE,BADGE,RIDGE,CRIME,HIVES,WASTE,VAULT
  283. 9115 DATA SHAVE,DRIVE,MONTH,DOING,GRAND,TRACK,SPIED,SMART,STACK,TENOR,DEBUT
  284. 9120 DATA BRASH,FAULT,BEACH,TRUCK,STRAP,EMPTY,SPORT,PROUD,ROAST,GLAZE,FLUTE
  285. 9125 DATA FARCE,WAIST,PRIDE,YEARN,SHIRK,CHOIR,MEDAL,PACTS,NAKED,PEDAL,FLASH
  286. 9130 DATA DWELT,DUSTY,AUDIO,CURSE,CARGO,CATER,PECKS,SPECK,PLATE,LATER,LYMPH
  287. 9135 DATA LUNAR,NYMPH,SPACE,HABIT,MYTHS,BRAIN,SCALE,FRAME,JOINS,JUICY,OCEAN
  288. 9140 DATA PERKY,BASIC,QUOTA
  289. K,PLATE,LATER,LYMPH
  290. 9135 DATA LUNAR,NYMPH,SPACE,HABIT,MYTHS,BR