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