One Key Screen 0 Halloween Crypt-O-Gram

[bplus]

Better get this posted before I forget I have it done. This is pure Screen 0, one key, Halloween Theme Crypt-O-Gram Puzzles, no graphics. The Crypto-O-grams are all one liner Halloween jokes. While you solve the puzzle, 2 witches play Infinite Pong with a pumpkin in ASCII Art. Nice music included in zip with other sound effects and ASCII txt files.

.bas Source

Code: QB64: [Select]

1. Option _Explicit
2. _Title "One Key Screen 0 Halloween Crypt-O-Gram" ' b+  2021-10-21
3.  
4. Const Xmax = 120 ' AKA _Width to allow jokes upto 120 chars long, longest is 110 so far.
5. Const Ymax = 30 ' AKA _Height some
6.  
7. Const Orange = 12
8. Const White = 15
9. Const Yellow = 14
10. Const Back = 8
11. Const Red = 4
12. Const Blue = 9
13. Const Green = 10
14. Const BB = 6
15.  
16. ' for Cryptogram game
17. Dim Shared Answer$ '  beginning phrase to be guessed    '   3 stages of the Puzzle
18. Dim Shared Coded$ '   hidden in code
19. Dim Shared Working$ ' decoded and solved when working$ becomes = ucase$(answer$)
20. Dim Shared Letters$(1 To 26) ' for coding and highlited letters
21. Dim Shared LCodes$(1 To 26) '  for code and decode by number 1 to 26
22. Dim Shared Guesses$(1 To 26) ' track all the guess to decode
23. Dim Shared HighLited ' cursor over letters to guess
24. Dim Shared Mode ' what are we getting a coded letter =0, a guess for that letter =1, a letter to find and decode=3
25. Dim Shared KeyTimer ' setup for Choice$ calls
26. Dim Shared Place ' ditto tracks highlight location from selections
27.  
28. 'txt image
29. Dim Shared WitchE(1 To 7) As String * 12
30. Dim Shared WitchW(1 To 7) As String * 12
31. LoadWitches
32.  
33. ' main declares
34. Dim jokes$(1 To 100) ' load jokes one time from data statements in program
35. Dim As Integer i, jCount, a, test, nSplash
36. Dim r$, k$, c$
37. Dim HH&, SW&, WH&, ZB& ' sound and font
38. Dim As Integer pl, pr, pt, pb, px, py, pdx, pdy, weCol, wwCol ' the pumkin as a ball
39. Dim loopcnt As _Unsigned _Integer64
40.  
41. ' load sounds
42. HH& = _SndOpen("happy-halloween-scary-creepy-music-1382.mp3")
43. SW& = _SndOpen("smich.wav")
44. WH& = _SndOpen("Wolves Howling.wav")
45. ZB& = _SndOpen("Zen Bell.wav")
46.  
47. Randomize Timer
48. Width Xmax, Ymax
49. _FullScreen 'I guess it does make it easier to tell E from F...
50. _PaletteColor 12, _RGB32(255, 128, 0) ' Orange
51. _PaletteColor 13, _RGB32(180, 90, 45) ' for rColors
52. For i = 1 To 100 'ready jokes
53.     Read r$
54.     If r$ <> "EOD" Then jokes$(i) = r$: jCount = jCount + 1 Else Exit For
55. Next
56.  
57. 'set pumpkin as ball boundaries
58. pl = 19: pr = _Width - 18: pt = 1: pb = 16
59. Splash nSplash
60.  
61. restart:
62. px = 19: py = 8: weCol = 5: wwCol = _Width - 15: pdx = 1: pdy = -1
63.  
64. 'setup Puzzle and code it
65. Answer$ = jokes$(Int(Rnd * jCount) + 1)
66. For i = 1 To 26: Guesses$(i) = "-": Next 'setup the display guesses array
67. For i = 1 To 26 ' use letters for display of letters to pick second and to create a code
68.     Letters$(i) = Chr$(i + 64)
69.     LCodes$(i) = Letters$(i) ' these will convert between each other by index number
70. Next
71. For i = 26 To 2 Step -1 ' shuffle the letters in LCode$()
72.     Swap LCodes$(i), LCodes$(Int(Rnd * i) + 1)
73. Next
74. Coded$ = "": Working$ = "" ' reset for next go around
75. For i = 1 To Len(Answer$) 'third: put the phrase in coded$ and hide it in working$
76.     a = Asc(UCase$(Answer$), i)
77.     If a >= 65 And a <= 90 Then
78.         Coded$ = Coded$ + LCodes$(a - 64)
79.         Working$ = Working$ + "*"
80.     Else
81.         Coded$ = Coded$ + Mid$(Answer$, i, 1)
82.         Working$ = Working$ + Mid$(Answer$, i, 1)
83.     End If
84. Next
85.  
86. HighLited = 1: Mode = 0: KeyTimer = Timer
87. _SndLoop HH& '          setup done start game
88. loopcnt = 0
89. Do
90.     Color Orange, Back: Cls
91.     DisplayInstructions
92.     Update
93.     If Rnd < .0005 Then _SndPlay WH&
94.     If Rnd < .0005 Then _SndPlay SW&
95.     If Mode = 3 Then
96.         k$ = Choice$(25, 33, " A B C D E F G H I J K L M N O P Q R S T U V W X Y Z ")
97.     Else
98.         k$ = Choice$(25, 29, " 1 2 3 4 A B C D E F G H I J K L M N O P Q R S T U V W X Y Z ")
99.     End If
100.     If k$ <> "" And k$ <> " " Then
101.         If Mode = 0 Then ' highlight a letter
102.             'm replaces arrows and mouse select of highlited 1 to 26 for letters
103.             test = InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", k$)
104.             If test > 0 Then
105.                 HighLited = test
106.                 Mode = 1
107.             Else
108.                 test = InStr("1234", k$)
109.                 If test > 0 Then
110.                     Select Case test
111.                         Case 1: GoSub do1
112.                         Case 2: GoSub do2
113.                         Case 3: Mode = 3
114.                         Case 4: GoSub do4
115.                     End Select
116.                 Else
117.                     Mode = 0
118.                 End If
119.             End If
120.         ElseIf Mode = 1 Then
121.             Select Case Asc(k$)
122.                 Case 49: GoSub do1
123.                 Case 50: GoSub do2
124.                 Case 51: Mode = 3
125.                 Case 52: GoSub do4
126.                 Case 65 TO 90
127.                     Guesses$(HighLited) = k$ ' for screen updates
128.                     For i = 1 To Len(Working$)
129.                         If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = k$
130.                     Next
131.                     Mode = 0
132.             End Select
133.         ElseIf Mode = 3 Then
134.             Locate 25, 44: Print Space$(31); ' clear out old line
135.             c$ = LCodes$(Asc(k$) - 64)
136.             Guesses$(Asc(c$) - 64) = k$
137.             For i = 1 To Len(Working$)
138.                 If c$ = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = k$
139.             Next
140.             Mode = 0
141.         End If
142.     End If
143.     loopcnt = loopcnt + 1
144.     If loopcnt Mod 5 = 0 Then ' move pumpkin
145.         If px + pdx >= pl And px + pdx <= pr Then
146.             px = px + pdx
147.         Else
148.             pdx = -pdx
149.             px = px + pdx
150.         End If
151.         If py + pdy >= pt And py + pdy <= pb Then
152.             py = py + pdy
153.         Else
154.             pdy = -pdy
155.             py = py + pdy
156.         End If
157.     End If
158.     DrawWitch "e", py - 4, weCol
159.     DrawWitch "w", py - 4, wwCol
160.     DrawPumpkin py, px
161.     _Limit 30
162.     _Display
163. Loop Until Working$ = UCase$(Answer$)
164. _SndStop HH&
165. _SndPlay ZB&
166. Update
167. Color Orange, Back
168. CP 19, "You got it!    5 secs to next puzzle..."
169. _Display
170. _Delay 5: Cls
171. nSplash = nSplash + 1
172. If nSplash > 10 Then nSplash = 0
173. Splash nSplash
174. GoTo restart
175.  
176. do1: ' display answer
177. Working$ = UCase$(Answer$) ' show the answer$ guesses correct moves to next puzzle
178. Mode = 0
179. Return
180.  
181. do2: ' get decode letter for highlighted Letter
182. For i = 1 To 26
183.     If LCodes$(i) = Letters$(HighLited) Then c$ = Chr$(i + 64): Exit For
184. Next
185. Guesses$(HighLited) = c$ ' for screen updates
186. For i = 1 To Len(Working$)
187.     If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = c$
188. Next
189. Mode = 0
190. Return
191.  
192. do4: ' clear guess letter from code letter
193. Guesses$(HighLited) = "-"
194. For i = 1 To Len(Working$)
195.     If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = "*" ' clear the letter
196. Next
197. Mode = 0
198. Return
199.  
200. 'one liners
201. Data "Why do ghosts go on diets? So they can keep their ghoulish figures"
202. Data "Where does a ghost go on vacation? Mali-boo."
203. Data "Why did the ghost go into the bar? For the Boos."
204. Data "What is in a ghost's nose? Boo-gers."
205. Data "Why did the policeman ticket the ghost on Halloween? It didn't have a haunting license."
206. Data "Why do demons and ghouls hang out together? Because demons are a ghoul's best friend!"
207. Data "Why did the ghost starch his sheet? He wanted everyone scared stiff."
208. Data "What does a panda ghost eat? Bam-BOO!"
209. Data "What's a ghost's favorite dessert? I-Scream!"
210. Data "Where do ghosts buy their food? At the ghost-ery store!"
211. Data "How do you know when a ghost is sad? He starts boo hooing."
212. Data "Why don't mummies take time off? They're afraid to unwind."
213. Data "Why did the headless horseman go into business? He wanted to get ahead in life."
214. Data "What kind of music do mummies like listening to on Halloween? Wrap music."
215. Data "Why don't mummies have friends? Because they're too wrapped up in themselves."
216. Data "Why did the vampire read the newspaper? He heard it had great circulation."
217. Data "How do vampires get around on Halloween? On blood vessels."
218. Data "What's it like to be kissed by a vampire? It's a pain in the neck."
219. Data "What's it called when a vampire has trouble with his house? A grave problem."
220. Data "How can you tell when a vampire has been in a bakery? All the jelly has been sucked out of the jelly doughnuts."
221. Data "What do you get when you cross a vampire and a snowman? Frostbite."
222. Data "Why do skeletons have low self-esteem? They have no body to love."
223. Data "Know why skeletons are so calm? Because nothing gets under their skin."
224. Data "What do you call a cleaning skeleton? The grim sweeper."
225. Data "What do skeletons order at a restaurant? Spare ribs."
226. Data "What do you call a witch's garage? A broom closet."
227. Data "What kind of food would you find on a haunted beach? A sand-witch!"
228. Data "What was the witch's favorite subject in school? Spelling."
229. Data "What do you call two witches who live together? Broom-mates!"
230. Data "What's a witch's favorite makeup? Ma-scare-a."
231. Data "Who helps the little pumpkins cross the road safely? The crossing gourd."
232. Data "What treat do eye doctors give out on Halloween? Candy corneas."
233. Data "What type of plants do well on all Hallow's Eve? Bam-BOO!"
234. Data "What do birds say on Halloween? Trick or tweet!"
235. Data "Why don't skeletons ever go trick or treating? Because they have no-body to go with."
236. Data "Where do ghosts buy their Halloween candy? At the ghost-ery store!"
237. Data "What do owls say when they go trick or treating? 'Happy Owl-ween!'"
238. Data "What do ghosts give out to trick or treaters? Booberries!"
239. Data "Who did Frankenstein go trick or treating with? His ghoul friend."
240. Data "What Halloween candy is never on time for the party? Choco-LATE!"
241. Data "What do witches put on to go trick or treating? Mas-scare-a."
242. Data "What does Bigfoot say when he asks for candy?  'Trick-or-feet!'"
243. Data "Which type of pants do ghosts wear to trick or treat? Boo jeans."
244. Data "What makes trick or treating with twin witches so challenging? You never know which witch is which!"
245. Data "What happens when a vampire goes in the snow? Frost bite!"
246. Data "What do you call two witches living together? Broommates"
247. Data "What position does a ghost play in hockey? Ghoulie."
248. Data "What do mummies listen to on Halloween? Wrap music."
249. Data "How do you make a skeleton laugh? You tickle his funny bone!"
250. Data "Which Halloween monster is good at math? Count Dracula!"
251. Data "Why did the Cyclops give up teaching? He only had one pupil!"
252. Data "Why didn't the skeleton go to see a scary movie? He didn't have the guts."
253. Data "What did the boy ghost say to the girl ghost? 'You sure are boo-tiful!'"
254. Data "Where does Dracula keep his money? In a blood bank."
255. Data "Why are ghosts terrible liars? You can see right through them!"
256. Data "Why don't mummies take vacations? They're afraid to unwind."
257. Data "What is a vampire's favorite holiday, besides Halloween? Fangs-giving!"
258. Data "Where do fashionable ghosts shop? Bootiques!"
259. Data "What's a monster's favorite play? Romeo and Ghouliet!"
260. Data "What room does a ghost not need? A living room."
261. Data "What monster plays tricks on Halloween? Prank-enstein!"
262. Data "What's a ghost's favorite dessert? I scream."
263. Data "What does the skeleton chef say when he serves you a meal? 'Bone Appetit!'"
264. Data "What is a vampire's favorite fruit? A neck-tarine!"
265. Data "What do witches put on their bagels? Scream cheese."
266. Data "What do ghosts eat for dinner? Spook-ghetti!"
267. Data "What do skeletons order at restaurants? Spare ribs."
268. Data "What does a panda ghost eat? Bam-BOO!"
269. Data "What tops off a mummy's ice cream sundae? Whipped scream."
270. Data "What's a ghost's favorite yogurt flavor? Boo-berry!"
271. Data "What's a vampire's least favorite meal? A steak!"
272. Data "Why was the candy corn booed off the stage? All of his jokes were too corny!"
273. Data "What happened to the cannibal who showed up late to Halloween dinner? They gave him the cold shoulder."
274. Data "What happens if you combine a vampire and a snowman? You get frostbite."
275. Data "Do zombies eat popcorn with their fingers? No, they like to eat the fingers separately."
276. Data "What happened to the man who got behind on payments to his exorcist? He got repossessed."
277. Data "Where do most ghouls and goblins live in 2019? In North and South Scarolina."
278. Data "Why did the team of witches lose the softball game? Their bats kept flying away."
279. Data "What do you call six witches in a jacuzzi? A self cleaning coven."
280. Data "Why was the vampire in a bad mood? Too much B negative."
281. Data "What did the parent say to the baby ghost? Don't spook until your spoken too."
282. Data "What is a vampire's favorite flavor of ice cream? Veinilla."
283. Data "What are two freshly married spiders called? Newly-webbed."
284. Data "Why hasn't anyone ever seen ghost poop? Because it's invisible."
285. Data "You know it's bad luck to be followed by a black cat… if you are a mouse."
286. Data "Where do most most werewolves live in 2019? Howlywood California."
287. Data "Why don't witches have babies? Their husbands have crystal balls."
288. Data "Why can't the ghost have any children? He has a Halloweenie."
289. Data "EOD"
290.  
291. Sub Update ' preserve from ravages of graphics effects ;-))
292.     Dim As Integer i, spaces
293.     Dim w$, c$, a$, h$, pc$
294.     Color Yellow, Back
295.     Locate 17, (120 - Len(Answer$)) / 2: Print Coded$;
296.     Color White, Back
297.     Locate 18, (120 - Len(Answer$)) / 2
298.     For i = 1 To Len(Answer$)
299.         w$ = Mid$(Working$, i, 1): c$ = Mid$(Coded$, i, 1)
300.         a$ = Mid$(Answer$, i, 1): h$ = Letters$(HighLited)
301.         If w$ = "*" Then
302.             pc$ = "*": If h$ = c$ Then Color White, Green Else Color White, Back
303.         Else
304.             Color White, Back
305.             If w$ = UCase$(a$) Then pc$ = a$ Else pc$ = w$
306.         End If
307.         Print pc$;
308.     Next
309.     spaces = 9
310.     For i = 1 To 26 'blue background highlighter
311.         If i = HighLited Then
312.             Color Yellow, Green
313.         Else
314.             Color Yellow, Back
315.         End If
316.         Locate 21, spaces: Print Letters$(i);
317.         If i = HighLited Then
318.             Color Yellow, Green
319.         Else
320.             Color White, Back
321.         End If
322.         Locate 22, spaces: Print Guesses$(i);
323.         spaces = spaces + 4
324.     Next
325.     If Mode = 1 Then
326.         Color White, Back
327.         CP 24, "  Guess Solve Letter or Menu # "
328.     ElseIf Mode = 0 Then
329.         Color Yellow, Back
330.         CP 24, "  Select Code Letter or Menu # "
331.     ElseIf Mode = 3 Then
332.         Color White, Back
333.         CP 24, "     Select Letter to Find     "
334.     End If
335. End Sub
336.  
337. Sub DisplayInstructions
338.     Dim c As Integer
339.     Color Orange, Back
340.     CP 4, "*** Halloween Challenge - Crypt-O-Gram Puzzle ***"
341.     'Color Red
342.     CPRC 7, "Solve puzzle by selecting a Code letter then selecting a Guess letter for it."
343.     CPRC 8, "All selections are made by pressing the spacebar until you are on your choice."
344.     CPRC 9, "Use the escape key to quit immediately."
345.     'Color 2
346.     c = 34
347.     LPRC 11, c, "Select 1 to get the answer and move onto next puzzle."
348.     LPRC 12, c, "Select 2 to decode current highlighted letter."
349.     LPRC 13, c, "Select 3 to solve a letter, then select letter to find."
350.     LPRC 14, c, "Select 4 to clear a guess at highlighted Code letter."
351. End Sub
352.  
353.  
354. Sub CP (row, s$) ' center text on text screen
355.     Locate row, (_Width - Len(s$)) / 2: Print s$;
356. End Sub
357.  
358. Sub CPRC (row, s$) ' center text on text screen and print in random colors
359.     Dim As Integer i, col
360.     col = (_Width - Len(s$)) / 2
361.     For i = 1 To Len(s$)
362.         Color rColor, Back
363.         Locate row, col + i - 1: Print Mid$(s$, i, 1);
364.     Next
365. End Sub
366.  
367. Sub LP (row, col, s$) ' Locate and Print
368.     Locate row, col: Print s$;
369. End Sub
370.  
371. Sub LPRC (row, col, s$) ' Locate and print with Random colors
372.     Dim i As Integer
373.     For i = 1 To Len(s$)
374.         Color rColor, Back
375.         Locate row, col + i - 1: Print Mid$(s$, i, 1);
376.     Next
377. End Sub
378.  
379. Function Choice$ (row, col, selection$)
380.     Dim As _Unsigned Long fg, bg
381.     Dim As Integer saveRow, saveCol, i
382.     Dim k&
383.     fg~& = _DefaultColor: bg~& = _BackgroundColor
384.     saveRow = CsrLin: saveCol = Pos(0)
385.     If _KeyDown(27) Then System ' emergency exit
386.     GoSub show:
387.     k& = _KeyHit
388.     If k& = 32 Then KeyTimer = Timer: Place = (Place + 1) Mod Len(selection$)
389.     If Timer - KeyTimer >= 3 Then Choice$ = Mid$(selection$, Place + 1, 1): Place = 0
390.     Locate saveRow, saveCol: Exit Function
391.  
392.     show:
393.     Locate row, col
394.     For i = 1 To Len(selection$)
395.         If i = Place + 1 Then Color bg~&, fg~& Else Color fg~&, bg~&
396.         Locate row, col - 1 + i: Print Mid$(selection$, i, 1);
397.     Next
398.     '_Display will take place in loop that called Choice$
399.     Color fg~&, bg~&
400.     Return
401. End Function
402.  
403. Function rColor%
404.     Dim rc
405.     rc = Rnd
406.     If rc > .66 Then
407.         rColor% = 4
408.     ElseIf rc > .33 Then
409.         rColor% = 13
410.     ElseIf rc > .16 Then
411.         rColor% = 2
412.     ElseIf rc > .08 Then
413.         rColor% = 6
414.     Else
415.         rColor% = 12
416.     End If
417. End Function
418.  
419. Sub Splash (n As Integer)
420.     Dim As Integer i, first, last, nlines, startRow
421.     Dim s$
422.     Color 12, Back: Cls
423.  
424.     If n = 0 Then
425.         Open "ASCII by snd.txt" For Input As #1
426.         For i = 1 To 20
427.             Line Input #1, s$
428.             LP i + 5, 41, RTrim$(s$)
429.         Next
430.         Close #1
431.     ElseIf n > 0 Then
432.         Open "10 Halloweens.txt" For Input As #1
433.         If n = 1 Then
434.             first = 11: last = 32: GoSub getText
435.         ElseIf n = 2 Then
436.             first = 32: last = 46: GoSub getText
437.         ElseIf n = 3 Then
438.             first = 46: last = 57: GoSub getText
439.         ElseIf n = 4 Then
440.             first = 57: last = 75: GoSub getText
441.         ElseIf n = 5 Then
442.             first = 75: last = 100: GoSub getText
443.         ElseIf n = 6 Then
444.             first = 100: last = 111: GoSub getText
445.         ElseIf n = 7 Then
446.             first = 111: last = 130: GoSub getText
447.         ElseIf n = 8 Then
448.             first = 131: last = 159: GoSub getText
449.         ElseIf n = 9 Then
450.             first = 159: last = 180: GoSub getText
451.         ElseIf n = 10 Then
452.             first = 180: last = 193: GoSub getText
453.         End If
454.     End If
455.     CP 29, "... Spacebar Only! ..."
456.     _Display
457.     _KeyClear
458.     While _KeyHit <> 32: Wend
459.     Exit Sub
460.  
461.     getText:
462.     nlines = last - first
463.     startRow = Int((30 - nlines) / 2)
464.     For i = 1 To 193
465.         Line Input #1, s$
466.         If i >= first And i <= last Then LP i - first + startRow + 1, 25, RTrim$(s$)
467.         If i > last Then Exit For
468.     Next
469.     Close #1
470.     Return
471. End Sub
472.  
473. Sub LoadWitches
474.     Dim w, i, s$
475.     For w = 1 To 2
476.         If w = 1 Then Open "witchE.txt" For Input As #1 Else Open "witchW.txt" For Input As #1
477.         For i = 1 To 7
478.             Line Input #1, s$
479.             If w = 1 Then WitchE(i) = s$ Else WitchW(i) = s$
480.         Next
481.         Close #1
482.     Next
483. End Sub
484.  
485. Sub DrawWitch (WhichWitch$, row, col) ' 7 lines 12 cols  set color
486.     Dim r, c
487.     Color 5, Back
488.     For r = 1 To 7
489.         If row + r - 1 > 0 And row + r - 1 <= _Height Then
490.             For c = 1 To 12
491.                 If col + c - 1 > 0 And col + c - 1 <= _Width Then
492.                     If UCase$(WhichWitch$) = "E" Then
493.                         If Mid$(WitchE(r), c, 1) <> " " Then LP row + r - 1, col + c - 1, Mid$(WitchE(r), c, 1)
494.                     Else
495.                         Color 7
496.                         If Mid$(WitchW(r), c, 1) <> " " Then LP row + r - 1, col + c - 1, Mid$(WitchW(r), c, 1)
497.                     End If
498.                 End If
499.             Next
500.         End If
501.     Next
502. End Sub
503.  
504. Sub DrawPumpkin (row, col) ' mid pumkin
505.     Dim p$, r, c
506.     Color 12, Back
507.     p$ = "((|))"
508.     For r = -1 To 0
509.         If row + r > 0 And row + r <= _Height Then
510.             For c = -2 To 2
511.                 If col + c > 0 And col + c <= _Width Then
512.                     If r = -1 And c = 0 Then
513.                         LP row + r, col, ","
514.                     ElseIf r = 0 Then
515.                         LP row + r, col + c, Mid$(p$, c + 3, 1)
516.                     End If
517.                 End If
518.             Next
519.         End If
520.     Next
521. End Sub
522.  

 

[Pete]

Yeah, it's nice, but who the hell wants to be stuck in SCREEN 0? Oops, forget I said that. It was my evil twin, Steve.

Anonymous