Crypt-O-Gram Puzzle - Halloween Challenge

[bplus]

The Cryptogram Puzzle I presented in Discussion Board was really sadistic in the way you had to input letters. I came up with a better algorithm yesterday morning, I call it "Binary Select".

Here is the test code you can play with to get familiar with inputting letters. It's like the computer is playing a little guessing game showing you a group of letters and you press spacebar (or any key in test demo) if your letter is in the group... just wait if it's not your letter in group, repeat... until computer knows your letter. The computer then displays letter on next line and on next line you must confirm YN (another little guessing game pressing spacebar (or any key) on the Y display to confirm, indeed, that is the intended letter or not ie, you did not confirm the Y display.

So here is the main engine for getting user input for the game:

Code: QB64: [Select]

1. _Title "Binary Select test demo" 'b+ 2021-10-03  Aha!
2.  
3. Do
4.     test$ = bChoice$(10, 5, "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234")
5.     Cls
6.     Print "bChoice$ returned > "; test$
7.     Do
8.         Print: Print "Do you want to try another?"
9.         test$ = ""
10.         test$ = bChoice$(CsrLin, 1, "YNM")
11.     Loop Until Len(test$)
12.     Cls
13. Loop Until test$ <> "Y"
14.  
15. Function bChoice$ (row, col, select$) ' this is a wrapper function for confirming the BinarySelect$ choice since so easy to mess up
16.     'this function needs 3 lines from screen, starting at row parameter.
17.     'the first line, at row, is dedicated to the BinarySelect$ function
18.     'the next 2 lines confirm the select
19.     ' All this makes it possible to continuous poll for a selection, if the user is away from computer for awhile
20.     ' no problem because he wont be there to confirm the choice and so no progress is made in program using BinarySelect$
21.  
22.     'clear 3 dedicated lines
23.     copySelect$ = select$
24.     For i = 0 To 2 ' clear lines
25.         Locate row + i, col: Print Space$(_Width - col + 1);
26.     Next
27.     c$ = BinarySelect$(row, col, copySelect$) ' the last choice is like a cancel
28.     'Locate 20, 10: Print "debug print c$: "; c$;
29.     Locate row + 1, col: Print "Confirming your choice > " + c$;
30.     check$ = BinarySelect$(row + 2, col, "YN")
31.     If check$ = "Y" Then bChoice$ = c$
32.     Print "bChoice$ = "; c$
33. End Function
34.  
35.  
36. Function BinarySelect$ (row, col, select$) ' this is recursive part of Binary Select Algo
37.     ls = Len(select$)
38.     If ls = 0 Then Beep: Exit Function ' no choices
39.     If ls = 1 Then BinarySelect$ = select$: Exit Function ' only one choice
40.     hls = Int(ls / 2)
41.     s1$ = Mid$(select$, 1, hls): s2$ = Mid$(select$, hls + 1)
42.     Locate row, col: Print Space$(_Width - col + 1);
43.     Locate row, col: Print "Press key if you see your choice > " + s1$;
44.     t = Timer(.001)
45.     _KeyClear
46.     k$ = InKey$
47.     While Len(k$) = 0 And Timer(.001) - t < 3 + .25 * Len(s1$)
48.         k$ = InKey$
49.         _Limit 60
50.     Wend
51.     If Len(k$) Then
52.         If Len(s1$) = 1 Then BinarySelect$ = s1$ Else BinarySelect$ = BinarySelect$(row, col, s1$)
53.     Else
54.         BinarySelect$ = BinarySelect$(row, col, s2$)
55.     End If
56. End Function
57.  
58.  

It's still something that needs a little practice with but it is much easier to use than my first idea.

On the confirmation for trying again, it still catches me by surprise the first Y for confirming to try again.
No worries, if there is no confirmation for any letter, it will cycle around and offer the groups over and over again.

For the Game, I put an Ecs keypress in there to quit game as it was in Full Screen mode with no top right window X to close.

[bplus]

And here is the first version of the Game that I submit for our Challenge here with Screen 0 and hope to work in graphics for Syntax Competition maybe. Credits for jokes are listed right under Title at beginning. The whole thing is under 300 LOC.

Code: QB64: [Select]

1. _Title "Halloween Challenge: Crypt-O-Gram Puzzle" ' b+  started One Key Challenge 2021-09-25
2. ' from One Key Challenge - Cryptogram Puzzle   2021-10-02
3.  
4. ' 2021-09-07 Jokes are intended for QB64 home programming entertainment use only.
5. ' Thank you CountryLiving 1-33
6. ' https://www.countryliving.com/entertaining/a32963261/halloween-jokes/
7. ' Thank you GoodHousekeeping 34-72
8. ' https://www.goodhousekeeping.com/holidays/halloween-ideas/a32998753/halloween-jokes/
9.  
10. ' 2021-10-03 install new set of jokes and new Binary Select Input Algorithm
11. ' Redo Mode system to fix differences of input methods.
12. ' Recolor green background has me seeing Red!
13.  
14. Randomize Timer: Width 120, 30
15. Dim Shared Answer$ '  beginning phrase to be guessed    '   3 stages of the Puzzle
16. Dim Shared Coded$ '   hidden in code
17. Dim Shared Working$ ' decoded and solved when working$ becomes = ucase$(answer$)
18. Dim Shared Letters$(1 To 26) ' for coding and highlited letters
19. Dim Shared LCodes$(1 To 26) '  for code and decode by number 1 to 26
20. Dim Shared Guesses$(1 To 26) ' track all the guess to decode
21. Dim Shared HighLited ' cursor over letters to guess
22. Dim Shared Mode
23. _FullScreen 'I guess it does make it easier to tell E from F...
24. Dim jokes$(1 To 100)
25. For i = 1 To 100
26.     Read r$
27.     If r$ <> "EOD" Then jokes$(i) = r$: jCount = jCount + 1 Else Exit For
28. Next
29. restart:
30. Answer$ = jokes$(Int(Rnd * jCount) + 1)
31. For i = 1 To 26: Guesses$(i) = "-": Next 'setup the display guesses array
32. For i = 1 To 26 ' use letters for display of letters to pick second and to create a code
33.     Letters$(i) = Chr$(i + 64)
34.     LCodes$(i) = Letters$(i) ' these will convert between each other by index number
35. Next
36. For i = 26 To 2 Step -1 ' shuffle the letters in LCode$()
37.     Swap LCodes$(i), LCodes$(Int(Rnd * i) + 1)
38. Next
39. Coded$ = "": Working$ = "" ' reset for next go around
40. For i = 1 To Len(Answer$) 'third: put the phrase in coded$ and hide it in working$
41.     a = Asc(UCase$(Answer$), i)
42.     If a >= 65 And a <= 90 Then
43.         Coded$ = Coded$ + LCodes$(a - 64)
44.         Working$ = Working$ + "*"
45.     Else
46.         Coded$ = Coded$ + Mid$(Answer$, i, 1)
47.         Working$ = Working$ + Mid$(Answer$, i, 1)
48.     End If
49. Next
50. HighLited = 1 'setup done start game
51. Mode = 0
52. Do
53.     DisplayScreen
54.     k$ = bChoice$(23, 33, "1234ABCDEFGHIJKLMNOPQRSTUVWXYZ")
55.     If k$ <> "" Then
56.         If Mode = 0 Then ' highlight a letter
57.             'm replaces arrows and mouse select of highlited 1 to 26 for letters
58.             test = InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", k$)
59.             If test > 0 Then
60.                 HighLited = test
61.                 Mode = 1
62.             Else
63.                 test = InStr("1234", k$)
64.                 If test > 0 Then
65.                     Select Case test
66.                         Case 1: GoSub do1
67.                         Case 2: GoSub do2
68.                         Case 3: GoSub do3
69.                         Case 4: GoSub do4
70.                     End Select
71.                 Else
72.                     Mode = 0
73.                 End If
74.             End If
75.         Else
76.             Select Case k$
77.                 Case "1": GoSub do1
78.                 Case "2": GoSub do2
79.                 Case "3": GoSub do3
80.                 Case "4": GoSub do4
81.                 Case "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"
82.                     Guesses$(HighLited) = k$ ' for screen updates
83.                     For i = 1 To Len(Working$)
84.                         If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = k$
85.                     Next
86.                     Mode = 0
87.             End Select
88.         End If
89.     End If
90.     _Limit 60
91. Loop Until Working$ = UCase$(Answer$)
92. DisplayScreen
93. Color 9, 8
94. cp 17, "You got it!    5 secs to next puzzle..."
95. _Delay 5: Cls
96. GoTo restart
97.  
98. do1: ' display answer
99. Working$ = UCase$(Answer$) ' show the answer$ guesses correct moves to next puzzle
100. DisplayScreen
101. Mode = 0
102. Return
103.  
104. do2: ' get decode letter for highlighted Letter
105. For i = 1 To 26
106.     If LCodes$(i) = Letters$(HighLited) Then c$ = Chr$(i + 64): Exit For
107. Next
108. Guesses$(HighLited) = c$ ' for screen updates
109. For i = 1 To Len(Working$)
110.     If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = c$
111. Next
112. Mode = 0
113. Return
114.  
115. do3: ' find a uncoded letter
116. Color 15, 8: Locate 24, 40: Print "Select Find Letter"
117. d$ = bChoice$(23, 33, "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
118. If d$ <> "" Then
119.     c$ = LCodes$(Asc(d$) - 64)
120.     Guesses$(Asc(c$) - 64) = d$
121.     For i = 1 To Len(Working$)
122.         If c$ = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = d$
123.     Next
124.     Mode = 0
125. End If
126. Return
127.  
128. do4: ' clear guess letter from code letter
129. Guesses$(HighLited) = "-"
130. For i = 1 To Len(Working$)
131.     If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = "*" ' clear the letter
132. Next
133. Mode = 0
134. Return
135.  
136. 'one liners
137. Data "Why do ghosts go on diets? So they can keep their ghoulish figures"
138. Data "Where does a ghost go on vacation? Mali-boo."
139. Data "Why did the ghost go into the bar? For the Boos."
140. Data "What is in a ghost's nose? Boo-gers."
141. Data "Why did the policeman ticket the ghost on Halloween? It didn't have a haunting license."
142. Data "Why do demons and ghouls hang out together? Because demons are a ghoul's best friend!"
143. Data "Why did the ghost starch his sheet? He wanted everyone scared stiff."
144. Data "What does a panda ghost eat? Bam-BOO!"
145. Data "What's a ghost's favorite dessert? I-Scream!"
146. Data "Where do ghosts buy their food? At the ghost-ery store!"
147. Data "How do you know when a ghost is sad? He starts boo hooing."
148. Data "Why don't mummies take time off? They're afraid to unwind."
149. Data "Why did the headless horseman go into business? He wanted to get ahead in life."
150. Data "What kind of music do mummies like listening to on Halloween? Wrap music."
151. Data "Why don't mummies have friends? Because they're too wrapped up in themselves."
152. Data "Why did the vampire read the newspaper? He heard it had great circulation."
153. Data "How do vampires get around on Halloween? On blood vessels."
154. Data "What's it like to be kissed by a vampire? It's a pain in the neck."
155. Data "What's it called when a vampire has trouble with his house? A grave problem."
156. Data "How can you tell when a vampire has been in a bakery? All the jelly has been sucked out of the jelly doughnuts."
157. Data "What do you get when you cross a vampire and a snowman? Frostbite."
158. Data "Why do skeletons have low self-esteem? They have no body to love."
159. Data "Know why skeletons are so calm? Because nothing gets under their skin."
160. Data "What do you call a cleaning skeleton? The grim sweeper."
161. Data "What do skeletons order at a restaurant? Spare ribs."
162. Data "What do you call a witch's garage? A broom closet."
163. Data "What kind of food would you find on a haunted beach? A sand-witch!"
164. Data "What was the witch's favorite subject in school? Spelling."
165. Data "What do you call two witches who live together? Broom-mates!"
166. Data "What's a witch's favorite makeup? Ma-scare-a."
167. Data "Who helps the little pumpkins cross the road safely? The crossing gourd."
168. Data "What treat do eye doctors give out on Halloween? Candy corneas."
169. Data "What type of plants do well on all Hallow's Eve? Bam-BOO!"
170. Data "What do birds say on Halloween? Trick or tweet!"
171. Data "Why don't skeletons ever go trick or treating? Because they have no-body to go with."
172. Data "Where do ghosts buy their Halloween candy? At the ghost-ery store!"
173. Data "What do owls say when they go trick or treating? 'Happy Owl-ween!'"
174. Data "What do ghosts give out to trick or treaters? Booberries!"
175. Data "Who did Frankenstein go trick or treating with? His ghoul friend."
176. Data "What Halloween candy is never on time for the party? Choco-LATE!"
177. Data "What do witches put on to go trick or treating? Mas-scare-a."
178. Data "What does Bigfoot say when he asks for candy?  'Trick-or-feet!'"
179. Data "Which type of pants do ghosts wear to trick or treat? Boo jeans."
180. Data "What makes trick or treating with twin witches so challenging? You never know which witch is which!"
181. Data "What happens when a vampire goes in the snow? Frost bite!"
182. Data "What do you call two witches living together? Broommates"
183. Data "What position does a ghost play in hockey? Ghoulie."
184. Data "What do mummies listen to on Halloween? Wrap music."
185. Data "How do you make a skeleton laugh? You tickle his funny bone!"
186. Data "Which Halloween monster is good at math? Count Dracula!"
187. Data "Why did the Cyclops give up teaching? He only had one pupil!"
188. Data "Why didn't the skeleton go to see a scary movie? He didn't have the guts."
189. Data "What did the boy ghost say to the girl ghost? 'You sure are boo-tiful!'"
190. Data "Where does Dracula keep his money? In a blood bank."
191. Data "Why are ghosts terrible liars? You can see right through them!"
192. Data "Why don't mummies take vacations? They're afraid to unwind."
193. Data "What is a vampire's favorite holiday, besides Halloween? Fangs-giving!"
194. Data "Where do fashionable ghosts shop? Bootiques!"
195. Data "What's a monster's favorite play? Romeo and Ghouliet!"
196. Data "What room does a ghost not need? A living room."
197. Data "What monster plays tricks on Halloween? Prank-enstein!"
198. Data "What's a ghost's favorite dessert? I scream."
199. Data "What does the skeleton chef say when he serves you a meal? 'Bone Appetit!'"
200. Data "What is a vampire's favorite fruit? A neck-tarine!"
201. Data "What do witches put on their bagels? Scream cheese."
202. Data "What do ghosts eat for dinner? Spook-ghetti!"
203. Data "What do skeletons order at restaurants? Spare ribs."
204. Data "What does a panda ghost eat? Bam-BOO!"
205. Data "What tops off a mummy's ice cream sundae? Whipped scream."
206. Data "What's a ghost's favorite yogurt flavor? Boo-berry!"
207. Data "What's a vampire's least favorite meal? A steak!"
208. Data "Why was the candy corn booed off the stage? All of his jokes were too corny!"
209. Data "EOD"
210.  
211. Sub DisplayScreen
212.     Color 9, 8: Cls
213.     cp 2, "*** Halloween Challenge - Cryptogram Puzzle ***"
214.     Color 6
215.     cp 4, "Solve puzzle by selecting a Code letter then selecting a Guess letter for it."
216.     cp 5, "All selections are made by pressing spacebar when you see your letter or digit."
217.     cp 6, "You will need to verify your selection by pressing spacebar again when see Y for Yes."
218.     cp 7, "Use the escape key to quit immediately (an X box in top right is not accessible)."
219.     cp 9, "To get the answer and move onto next puzzle, select 1."
220.     cp 10, "To decode current highlighted letter, select 2."
221.     cp 11, "To solve a letter, select 3 and then select letter to find."
222.     cp 12, "To clear a guess at highlighted Code letter, select 4."
223.     Color 14
224.     Locate 15, (120 - Len(Answer$)) / 2: Print Coded$
225.     Color 15
226.     Locate 16, (120 - Len(Answer$)) / 2
227.     For i = 1 To Len(Answer$)
228.         w$ = Mid$(Working$, i, 1): c$ = Mid$(Coded$, i, 1)
229.         a$ = Mid$(Answer$, i, 1): h$ = Letters$(HighLited)
230.         If w$ = "*" Then
231.             pc$ = "*": If h$ = c$ Then Color 15, 9 Else Color 15, 8
232.         Else
233.             Color 15, 8: If w$ = UCase$(a$) Then pc$ = a$ Else pc$ = w$
234.         End If
235.         Print pc$;
236.     Next
237.     spaces = 9
238.     For i = 1 To 26 'blue background highlighter
239.         If i = HighLited Then Color 14, 9 Else Color 14, 8
240.         Locate 19, spaces: Print Letters$(i)
241.         If i = HighLited Then Color 14, 9 Else Color 15, 8
242.         Locate 20, spaces: Print Guesses$(i)
243.         spaces = spaces + 4
244.     Next
245.     If Mode = 1 Then
246.         Color 15, 8
247.         cp 22, "Guess Solve Letter or Menu #"
248.     Else
249.         Color 14, 8
250.         cp 22, "Select Code Letter or Menu #"
251.     End If
252. End Sub
253.  
254. Sub cp (row, text$) ' center text on text screen
255.     Locate row, (_Width - Len(text$)) / 2: Print text$
256. End Sub
257.  
258. Function bChoice$ (row, col, select$) ' this is a wrapper function for confirming the BinarySelect$ choice since so easy to mess up
259.     ' This will return "" if user never confirms a choice, otherwise some letter in Select$ is returned.
260.     ' Row and Col setup for Locate that works on any screen not like x, y for _PrintString when want to work in graphics or screen 0
261.     ' The first line, at row, is dedicated to the BinarySelect$ function
262.     ' the next 2 lines confirm the select using another YN for Yes No Bianary Select.
263.     ' All this makes it possible to continuous poll for a selection, if the user is away from computer for awhile
264.     ' no problem because he wont be there to confirm the choice and so no progress is made in program using BinarySelect$.
265.  
266.     'clear 3 dedicated lines for Row, Col to end of line
267.     copySelect$ = select$
268.     For i = 0 To 2 ' clear lines
269.         Locate row + i, col: Print Space$(_Width - col + 1);
270.     Next
271.     c$ = BinarySelect$(row, col, copySelect$) ' the last choice is like a cancel
272.     Locate row + 1, col: Print "Confirming your choice > " + c$;
273.     check$ = BinarySelect$(row + 2, col, "YN")
274.     If check$ = "Y" Then bChoice$ = c$
275. End Function
276.  
277. Function BinarySelect$ (row, col, select$) ' this is recursive part of Binary Select Algo
278.     ls = Len(select$)
279.     If ls = 0 Then Beep: Exit Function ' no choices
280.     If ls = 1 Then BinarySelect$ = select$: Exit Function ' only one choice
281.     hls = Int(ls / 2)
282.     s1$ = Mid$(select$, 1, hls): s2$ = Mid$(select$, hls + 1)
283.     Locate row, col: Print Space$(_Width - col + 1);
284.     Locate row, col: Print "Press spacebar if you see your choice > " + s1$;
285.     t = Timer(.001)
286.     _KeyClear
287.     k$ = InKey$
288.     While k$ <> " " And Timer(.001) - t < 3 + .25 * Len(s1$) 'modified for just spacebar
289.         If _KeyDown(27) Then System ' quit
290.         k$ = InKey$
291.         _Limit 60
292.     Wend
293.     If Len(k$) Then
294.         If Len(s1$) = 1 Then BinarySelect$ = s1$ Else BinarySelect$ = BinarySelect$(row, col, s1$)
295.     Else
296.         BinarySelect$ = BinarySelect$(row, col, s2$)
297.     End If
298. End Function
299.  

Some hints for playing:
* These are all one liner Halloween jokes, so most start with W for What, When, Where, Why sometimes H for How.

Think of them as walking through a cemetery reading grave stones and learning, "The pun that knocked 'em dead"

* When your decode letter is correct, it will show in lower case in the joke unless starts a sentence or is Proper Name, a bad guess will leave the letter capitalized.

* How many one letter words are there? How many 2?

* Frequent double letters are ee ll in Halloween, oo in Boo.

* Frequent words and subjects of the one liners: ghost, witch, skeleton, mummy, monsters.

* If you want the current coded highlighted letter solved without guessing, select (menu item) 2.

* If you have to have an E, S, T, R...  then select (menu item) 3, you will be prompted for the letter in the guessing game way like all the other letters.

* If you want to just clear the highlighted letter guess that is clearly wrong, select (menu item) 4.

* If you totally give up and want to see the solution, select (menu item) 1.

* Coded Letters and prompts are color coded Yellow. Guess-to-Solve letters and prompts are color coded White.

[bplus]

OK here is v2021-10-04 with mod of Steve's user input system plus real orange color:

Code: QB64: [Select]

1. _Title "Halloween Challenge: Crypt-O-Gram Puzzle" ' b+  started One Key Challenge 2021-09-25
2. ' from One Key Challenge - Cryptogram Puzzle   2021-10-02
3.  
4. ' 2021-09-07 Jokes are intended for QB64 home programming entertainment use only.
5. ' Thank you CountryLiving 1-33
6. ' https://www.countryliving.com/entertaining/a32963261/halloween-jokes/
7. ' Thank you GoodHousekeeping 34-72
8. ' https://www.goodhousekeeping.com/holidays/halloween-ideas/a32998753/halloween-jokes/
9.  
10. ' 2021-10-03 install new set of jokes and new Binary Select Input Algorithm
11. ' Redo Mode system to fix differences of input methods.
12. ' Recolor green background has me seeing Red!
13. ' 2021-10-04 Steve McNeill came up with an easier to understand and use input system.
14. ' Installing new Function and updating Game. Steve also told me how to change color palette,
15. ' now we have some real Orange! for #12 meant for high red.
16.  
17. Randomize Timer: Width 120, 30
18. _PaletteColor 12, _RGB32(255, 128, 0) ' Orange
19. Dim Shared Answer$ '  beginning phrase to be guessed    '   3 stages of the Puzzle
20. Dim Shared Coded$ '   hidden in code
21. Dim Shared Working$ ' decoded and solved when working$ becomes = ucase$(answer$)
22. Dim Shared Letters$(1 To 26) ' for coding and highlited letters
23. Dim Shared LCodes$(1 To 26) '  for code and decode by number 1 to 26
24. Dim Shared Guesses$(1 To 26) ' track all the guess to decode
25. Dim Shared HighLited ' cursor over letters to guess
26. Dim Shared Mode
27. _FullScreen 'I guess it does make it easier to tell E from F...
28. Dim jokes$(1 To 100)
29. For i = 1 To 100
30.     Read r$
31.     If r$ <> "EOD" Then jokes$(i) = r$: jCount = jCount + 1 Else Exit For
32. Next
33. restart:
34. Answer$ = jokes$(Int(Rnd * jCount) + 1)
35. For i = 1 To 26: Guesses$(i) = "-": Next 'setup the display guesses array
36. For i = 1 To 26 ' use letters for display of letters to pick second and to create a code
37.     Letters$(i) = Chr$(i + 64)
38.     LCodes$(i) = Letters$(i) ' these will convert between each other by index number
39. Next
40. For i = 26 To 2 Step -1 ' shuffle the letters in LCode$()
41.     Swap LCodes$(i), LCodes$(Int(Rnd * i) + 1)
42. Next
43. Coded$ = "": Working$ = "" ' reset for next go around
44. For i = 1 To Len(Answer$) 'third: put the phrase in coded$ and hide it in working$
45.     a = Asc(UCase$(Answer$), i)
46.     If a >= 65 And a <= 90 Then
47.         Coded$ = Coded$ + LCodes$(a - 64)
48.         Working$ = Working$ + "*"
49.     Else
50.         Coded$ = Coded$ + Mid$(Answer$, i, 1)
51.         Working$ = Working$ + Mid$(Answer$, i, 1)
52.     End If
53. Next
54. HighLited = 1 'setup done start game
55. Mode = 0
56. Do
57.     DisplayScreen
58.     k$ = choice$(25, 44, " 1234ABCDEFGHIJKLMNOPQRSTUVWXYZ")
59.     If k$ <> " " Then
60.         If Mode = 0 Then ' highlight a letter
61.             'm replaces arrows and mouse select of highlited 1 to 26 for letters
62.             test = InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", k$)
63.             If test > 0 Then
64.                 HighLited = test
65.                 Mode = 1
66.             Else
67.                 test = InStr("1234", k$)
68.                 If test > 0 Then
69.                     Select Case test
70.                         Case 1: GoSub do1
71.                         Case 2: GoSub do2
72.                         Case 3: GoSub do3
73.                         Case 4: GoSub do4
74.                     End Select
75.                 Else
76.                     Mode = 0
77.                 End If
78.             End If
79.         Else
80.             Select Case k$
81.                 Case "1": GoSub do1
82.                 Case "2": GoSub do2
83.                 Case "3": GoSub do3
84.                 Case "4": GoSub do4
85.                 Case "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"
86.                     Guesses$(HighLited) = k$ ' for screen updates
87.                     For i = 1 To Len(Working$)
88.                         If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = k$
89.                     Next
90.                     Mode = 0
91.             End Select
92.         End If
93.     End If
94.     _Limit 60
95. Loop Until Working$ = UCase$(Answer$)
96. DisplayScreen
97. Color 12, 8
98. cp 19, "You got it!    5 secs to next puzzle..."
99. _Delay 5: Cls
100. GoTo restart
101.  
102. do1: ' display answer
103. Working$ = UCase$(Answer$) ' show the answer$ guesses correct moves to next puzzle
104. DisplayScreen
105. Mode = 0
106. Return
107.  
108. do2: ' get decode letter for highlighted Letter
109. For i = 1 To 26
110.     If LCodes$(i) = Letters$(HighLited) Then c$ = Chr$(i + 64): Exit For
111. Next
112. Guesses$(HighLited) = c$ ' for screen updates
113. For i = 1 To Len(Working$)
114.     If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = c$
115. Next
116. Mode = 0
117. Return
118.  
119. do3: ' find a uncoded letter
120. Color 15, 8: cp 24, "Select Letter to Find"
121. Locate 25, 1: Print Space$(_Width) ' clear out old line
122. d$ = choice$(25, 46, " ABCDEFGHIJKLMNOPQRSTUVWXYZ")
123. If d$ <> " " Then
124.     c$ = LCodes$(Asc(d$) - 64)
125.     Guesses$(Asc(c$) - 64) = d$
126.     For i = 1 To Len(Working$)
127.         If c$ = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = d$
128.     Next
129.     Mode = 0
130. End If
131. Return
132.  
133. do4: ' clear guess letter from code letter
134. Guesses$(HighLited) = "-"
135. For i = 1 To Len(Working$)
136.     If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = "*" ' clear the letter
137. Next
138. Mode = 0
139. Return
140.  
141. 'one liners
142. Data "Why do ghosts go on diets? So they can keep their ghoulish figures"
143. Data "Where does a ghost go on vacation? Mali-boo."
144. Data "Why did the ghost go into the bar? For the Boos."
145. Data "What is in a ghost's nose? Boo-gers."
146. Data "Why did the policeman ticket the ghost on Halloween? It didn't have a haunting license."
147. Data "Why do demons and ghouls hang out together? Because demons are a ghoul's best friend!"
148. Data "Why did the ghost starch his sheet? He wanted everyone scared stiff."
149. Data "What does a panda ghost eat? Bam-BOO!"
150. Data "What's a ghost's favorite dessert? I-Scream!"
151. Data "Where do ghosts buy their food? At the ghost-ery store!"
152. Data "How do you know when a ghost is sad? He starts boo hooing."
153. Data "Why don't mummies take time off? They're afraid to unwind."
154. Data "Why did the headless horseman go into business? He wanted to get ahead in life."
155. Data "What kind of music do mummies like listening to on Halloween? Wrap music."
156. Data "Why don't mummies have friends? Because they're too wrapped up in themselves."
157. Data "Why did the vampire read the newspaper? He heard it had great circulation."
158. Data "How do vampires get around on Halloween? On blood vessels."
159. Data "What's it like to be kissed by a vampire? It's a pain in the neck."
160. Data "What's it called when a vampire has trouble with his house? A grave problem."
161. Data "How can you tell when a vampire has been in a bakery? All the jelly has been sucked out of the jelly doughnuts."
162. Data "What do you get when you cross a vampire and a snowman? Frostbite."
163. Data "Why do skeletons have low self-esteem? They have no body to love."
164. Data "Know why skeletons are so calm? Because nothing gets under their skin."
165. Data "What do you call a cleaning skeleton? The grim sweeper."
166. Data "What do skeletons order at a restaurant? Spare ribs."
167. Data "What do you call a witch's garage? A broom closet."
168. Data "What kind of food would you find on a haunted beach? A sand-witch!"
169. Data "What was the witch's favorite subject in school? Spelling."
170. Data "What do you call two witches who live together? Broom-mates!"
171. Data "What's a witch's favorite makeup? Ma-scare-a."
172. Data "Who helps the little pumpkins cross the road safely? The crossing gourd."
173. Data "What treat do eye doctors give out on Halloween? Candy corneas."
174. Data "What type of plants do well on all Hallow's Eve? Bam-BOO!"
175. Data "What do birds say on Halloween? Trick or tweet!"
176. Data "Why don't skeletons ever go trick or treating? Because they have no-body to go with."
177. Data "Where do ghosts buy their Halloween candy? At the ghost-ery store!"
178. Data "What do owls say when they go trick or treating? 'Happy Owl-ween!'"
179. Data "What do ghosts give out to trick or treaters? Booberries!"
180. Data "Who did Frankenstein go trick or treating with? His ghoul friend."
181. Data "What Halloween candy is never on time for the party? Choco-LATE!"
182. Data "What do witches put on to go trick or treating? Mas-scare-a."
183. Data "What does Bigfoot say when he asks for candy?  'Trick-or-feet!'"
184. Data "Which type of pants do ghosts wear to trick or treat? Boo jeans."
185. Data "What makes trick or treating with twin witches so challenging? You never know which witch is which!"
186. Data "What happens when a vampire goes in the snow? Frost bite!"
187. Data "What do you call two witches living together? Broommates"
188. Data "What position does a ghost play in hockey? Ghoulie."
189. Data "What do mummies listen to on Halloween? Wrap music."
190. Data "How do you make a skeleton laugh? You tickle his funny bone!"
191. Data "Which Halloween monster is good at math? Count Dracula!"
192. Data "Why did the Cyclops give up teaching? He only had one pupil!"
193. Data "Why didn't the skeleton go to see a scary movie? He didn't have the guts."
194. Data "What did the boy ghost say to the girl ghost? 'You sure are boo-tiful!'"
195. Data "Where does Dracula keep his money? In a blood bank."
196. Data "Why are ghosts terrible liars? You can see right through them!"
197. Data "Why don't mummies take vacations? They're afraid to unwind."
198. Data "What is a vampire's favorite holiday, besides Halloween? Fangs-giving!"
199. Data "Where do fashionable ghosts shop? Bootiques!"
200. Data "What's a monster's favorite play? Romeo and Ghouliet!"
201. Data "What room does a ghost not need? A living room."
202. Data "What monster plays tricks on Halloween? Prank-enstein!"
203. Data "What's a ghost's favorite dessert? I scream."
204. Data "What does the skeleton chef say when he serves you a meal? 'Bone Appetit!'"
205. Data "What is a vampire's favorite fruit? A neck-tarine!"
206. Data "What do witches put on their bagels? Scream cheese."
207. Data "What do ghosts eat for dinner? Spook-ghetti!"
208. Data "What do skeletons order at restaurants? Spare ribs."
209. Data "What does a panda ghost eat? Bam-BOO!"
210. Data "What tops off a mummy's ice cream sundae? Whipped scream."
211. Data "What's a ghost's favorite yogurt flavor? Boo-berry!"
212. Data "What's a vampire's least favorite meal? A steak!"
213. Data "Why was the candy corn booed off the stage? All of his jokes were too corny!"
214. Data "EOD"
215.  
216. Sub DisplayScreen
217.     Color 12, 8: Cls
218.     cp 4, "*** Halloween Challenge - Cryptogram Puzzle ***"
219.     Color 6
220.     cp 6, "Solve puzzle by selecting a Code letter then selecting a Guess letter for it."
221.     cp 7, "All selections are made by pressing spacebar when you see your letter or digit."
222.     cp 8, "You will need to verify your selection by pressing spacebar again when see Y for Yes."
223.     cp 9, "Use the escape key to quit immediately (an X box in top right is not accessible)."
224.     Color 12
225.     cp 11, "To get the answer and move onto next puzzle, select 1."
226.     cp 12, "To decode current highlighted letter, select 2."
227.     cp 13, "To solve a letter, select 3 and then select letter to find."
228.     cp 14, "To clear a guess at highlighted Code letter, select 4."
229.     Color 14
230.     Locate 17, (120 - Len(Answer$)) / 2: Print Coded$
231.     Color 15
232.     Locate 18, (120 - Len(Answer$)) / 2
233.     For i = 1 To Len(Answer$)
234.         w$ = Mid$(Working$, i, 1): c$ = Mid$(Coded$, i, 1)
235.         a$ = Mid$(Answer$, i, 1): h$ = Letters$(HighLited)
236.         If w$ = "*" Then
237.             pc$ = "*": If h$ = c$ Then Color 15, 9 Else Color 15, 8
238.         Else
239.             Color 15, 8: If w$ = UCase$(a$) Then pc$ = a$ Else pc$ = w$
240.         End If
241.         Print pc$;
242.     Next
243.     spaces = 9
244.     For i = 1 To 26 'blue background highlighter
245.         If i = HighLited Then Color 14, 9 Else Color 14, 8
246.         Locate 21, spaces: Print Letters$(i)
247.         If i = HighLited Then Color 14, 9 Else Color 15, 8
248.         Locate 22, spaces: Print Guesses$(i)
249.         spaces = spaces + 4
250.     Next
251.     If Mode = 1 Then
252.         Color 15, 8
253.         cp 24, "Guess Solve Letter or Menu #"
254.     Else
255.         Color 14, 8
256.         cp 24, "Select Code Letter or Menu #"
257.     End If
258. End Sub
259.  
260. Sub cp (row, text$) ' center text on text screen
261.     Locate row, 1: Print Space$(_Width) ' clear out old line in case the next is shorter
262.     Locate row, (_Width - Len(text$)) / 2: Print text$
263. End Sub
264.  
265. Function choice$ (row, col, selection$)
266.     fg~& = _DefaultColor: bg~& = _BackgroundColor
267.     saveRow = CsrLin: saveCol = Pos(0): t = Timer
268.     GoSub show
269.     Do
270.         k$ = InKey$
271.         If k$ = Chr$(27) Then System ' emergency exit
272.         GoSub show:
273.         If k$ = " " Then
274.             t = Timer: place = (place + 1) Mod Len(selection$)
275.         Else ' watch out for midnight!
276.             If Timer - t > 4 Then choice$ = Mid$(selection$, place + 1, 1): Locate saveRow, saveCol: Exit Function
277.         End If
278.         _Limit 7 'so can hold down spacebar, nice
279.     Loop
280.     show:
281.     Locate row, col
282.     For i = 1 To Len(selection$)
283.         If i = place + 1 Then Color bg~&, fg~& Else Color fg~&, bg~&
284.         Locate row, col - 1 + i: Print Mid$(selection$, i, 1);
285.     Next
286.     Color fg~&, bg~&
287.     Return
288. End Function
289.  
290.  

It's allot easier to play now! Thanks Steve

[SMcNeill]

I’d use _KEYDOWN or INP, over the other input methods like INKEY$, INPUT$, or _KEYHIT.  Reason being?  You don't need to worry over any keyboard buffers screwing things up with those!

[bplus]

OK _KeyDown will replace InKey$ in next update. Seems to not get so carried away when holding down the Spacebar.

Thanks Steve!

[bplus]

Here is the replacement Function in case anyone can't wait to try out:

Code: QB64: [Select]

1. Function choice$ (row, col, selection$) ' replace InKey$ with _KeyDown()
2.     fg~& = _DefaultColor: bg~& = _BackgroundColor
3.     saveRow = CsrLin: saveCol = Pos(0): t = Timer
4.     GoSub show
5.     Do
6.         If _KeyDown(27) Then System ' emergency exit
7.         GoSub show:
8.         If _KeyDown(32) Then
9.             t = Timer: place = (place + 1) Mod Len(selection$)
10.         Else ' watch out for midnight!
11.             If Timer - t > 4 Then choice$ = Mid$(selection$, place + 1, 1): Locate saveRow, saveCol: Exit Function
12.         End If
13.         _Limit 7 'so can hold down spacebar, nice
14.     Loop
15.     show:
16.     Locate row, col
17.     For i = 1 To Len(selection$)
18.         If i = place + 1 Then Color bg~&, fg~& Else Color fg~&, bg~&
19.         Locate row, col - 1 + i: Print Mid$(selection$, i, 1);
20.     Next
21.     Color fg~&, bg~&
22.     Return
23. End Function
24.  

[bplus]

I had real problem using _Keydown(32) for detecting the spacebar press. Sometimes it would not move at all on a press and sometimes it would jump 2 letters on a press.

I slept on problem and came up with theory: the polling for keypress at 5 times a sec (_Limit 5) is too course a polling, causing the misses or the 2 jumps. So I added an inner loop for polling with _Limit 200 and that seems to remove the erratic behavior and smooth out scrolling down a line of letters.

Here is the updated function:

Code: QB64: [Select]

1. Function choice$ (row, col, selection$) ' replace InKey$ with _KeyDown()
2.     fg~& = _DefaultColor: bg~& = _BackgroundColor
3.     saveRow = CsrLin: saveCol = Pos(0): t = Timer
4.     GoSub show
5.     Do
6.         If _KeyDown(27) Then System ' emergency exit
7.         GoSub show:
8.         ' 2021-10-06 fix for polling erratic behavior: misses or jumps, check for spacebar way more often
9.         While Timer - t < 4 ' smooth out the jumpiness sometimes no response, sometimes jumps 2x' on one press????
10.             If _KeyDown(27) Then System ' emergency exit
11.             If _KeyDown(32) Then t = Timer: place = (place + 1) Mod Len(selection$): Exit While
12.             _Limit 200 '<<<< fine tune the polling for spacebar!!!
13.         Wend
14.         If Timer - t >= 4 Then choice$ = Mid$(selection$, place + 1, 1): Locate saveRow, saveCol: Exit Function
15.         _Limit 5 'so can hold down spacebar, nice
16.     Loop
17.     show:
18.     Locate row, col
19.     For i = 1 To Len(selection$)
20.         If i = place + 1 Then Color bg~&, fg~& Else Color fg~&, bg~&
21.         Locate row, col - 1 + i: Print Mid$(selection$, i, 1);
22.     Next
23.     _Display
24.     Color fg~&, bg~&
25.     Return
26. End Function
27.  

Much smoother scroll action, way way less over scroll that Inkey$ would have. I think I have it just right now.

[johnno56]

Very cool... Selection, as you rightly stated, requires a little practice... But still a cool game. Well done!

So... The xmas version... Will it be shades of red, white and green? Hmm...

You could start a series! There are SO many holidays!

Do you do requests? How about a version dedicated to the Hairy-nosed Wombat? Oh. What about the Emu or Red-backed Spider or the Platypus?

If you are "really" desperate for ideas, you can always fall back on, famous quotes; trivia etc... But seriously.... How can you turn down a Wombat?

[bplus]

Thanks @johnno56

Still have ways to go with graphics, how are the sounds coming?

I have worms almost done, ran into a some odd problems, a couple solved very late last night one stubborn one remains.
1. Using colors to poison worms, Point recognizes colors set by _RGB32 but apparently not &HFF.... ?

2. Blunder on my part where I clear WormYard (screen section worms are allowed) whenever I send Reset signal with default back color but later want to use image as background so clearing WormYard wipes out image. I see now that could be solved with two different values for reset as opposed to just Yes/No, T/F.

3. I switch to Full Screen Mode in second part of test and demo code and the worms insist on coming in at the old screen size. I think it is some sort of racing problem getting _Width and _Height reset when I run a WorkYard update. Something, it was so late with blurry eyes and mind...

[SMcNeill]

@bplus there shouldn't be any issues with &HFF... colors.   Can you share some simplified code highlighting the issue you're speaking of?

The only issue I know you might run into with point and &HFF is of unspecified variable type incompatibility.

Red = &HFFFF0000.   Right??

Maybe not!   Is that value signed or unsigned?  Integer, or Single?  If Red is SINGLE, I doubt it'll match POINT values of _RGB32(255,0,0) as the variable value loses precision.  If RED is LONG, it's not going to match a _RGB32(255,0,0) POINT, as it'll be a negative value and the POINT is positive.

Try this, for instance:

SCREEN _NEWIMAGE(640,480,32)
PSET (0,0), -1&
PRINT -1&, POINT(0,0)

The -1& is a long value color.  The POINT is an unsigned long.  In hex, both would be &HFFFFFFFF, but in decimal mode they're -1 and (some big number).

If you're going to use POINT, make certain all colors are unsigned, or you may get issues in your code.

This includes using &HFFFFFFFF~& instead of just &HFFFFFFFF.   ;D

[bplus]

Hi Steve,

I posted the code I was testing last night with another change that might solve racing problem with a delay before I call NewWormYard to get _Width and _Height updated ? (might be misdiagnosed problem but the extra delay seems to fix the last big bug I had last night.
see https://www.qb64.org/forum/index.php?topic=4266.msg136529#msg136529

As far as color and point goes, fixed when switched to _RGB32 instead og &HFF.... for colors ie,
Set poison boxes with &HFFFFFFFF or &HFFFFFF00 White and Yellow then compared POINT(x,y) to same &HFFFFFFFF or &HFFFFFF00 and no worky. Changed to _RGB32 both setting the boxes and then comparing Point returns to _RGB32 success!

[bplus]

This includes using &HFFFFFFFF~& instead of just &HFFFFFFFF.   ;D

Oh!! that's probably it then! I never think of the &H numbers as negative, where is the sign?! ;-))

Well there's an important practical lesson, thanks! @SMcNeill

[bplus]

OK DrawWorms installed into Crypt-O-Gram Puzzle, how good are you working with distractions? Moo ha ha

v2021-10-07

Code: QB64: [Select]

1. _Title "Halloween Challenge: Crypt-O-Gram Puzzle" ' b+  started One Key Challenge 2021-09-25
2. ' from One Key Challenge - Cryptogram Puzzle   2021-10-02
3.  
4. ' 2021-09-07 Jokes are intended for QB64 home programming entertainment use only.
5. ' Thank you CountryLiving 1-33
6. ' https://www.countryliving.com/entertaining/a32963261/halloween-jokes/
7. ' Thank you GoodHousekeeping 34-72
8. ' https://www.goodhousekeeping.com/holidays/halloween-ideas/a32998753/halloween-jokes/
9.  
10. ' 2021-10-03 install new set of jokes and new Binary Select Input Algorithm
11. ' Redo Mode system to fix differences of input methods.
12. ' Recolor green background has me seeing Red!
13.  
14. ' 2021-10-04 Steve McNeill came up with an easier to understand and use input system.
15. ' Installing new Function and updating Game. Steve also told me how to change color palette,
16. ' now we have some real Orange! for #12 meant for high red.
17.  
18. ' Next version: Follow Steve's advice to use _KeyDown in stead of InKey$
19. ' Improved Choice to reduce no response to keypress or double jumping.
20. ' v 2021-10-07 install DrawWorms subroutines and get working.
21.  
22. 'Fall letters and background
23. Const Orange = &HFFFF8800 ' 12 d
24. Const White = &HFFFFFFFF ' 15 d
25. Const Back = &HFF302010 ' 8 ? d
26. Const Red = &HFFFF2222 ' print under title
27. Const Yellow = &HFFFFFF00 ' 14 d
28. Const Blue = &HFF0000FF ' 9 light blue
29. Const BB = &HFF33BB33 ' 6 blue brown ?
30. Const Xmax = 120 * 8 ' started with text screen _width 120, 30
31. Const Ymax = 30 * 16
32.  
33. 'for Graphic effects
34. Const nWorms = 30
35.  
36. 'for graphics effects
37. Type Object
38.     X As Single ' usu top left corner   could be center depending on object
39.     Y As Single ' ditto
40.     W As Single ' width   or maybe radius
41.     H As Single ' height
42.     DX As Single ' moving opjects
43.     DY As Single ' ditto
44.     DIR As Single ' short for direction or heading usu a radian angle
45.     Sz As Single ' perhaps a scaling factor
46.     Act As Integer ' lives countdown or just plain ACTive TF
47.     C1 As _Unsigned Long ' a foreground color
48.     C2 As _Unsigned Long ' a background or 2nd color     OR C1 to c2 Range?
49. End Type
50.  
51. Screen _NewImage(Xmax, Ymax, 32)
52. Randomize Timer ': Width 120, 30
53.  
54. Dim Shared Answer$ '  beginning phrase to be guessed    '   3 stages of the Puzzle
55. Dim Shared Coded$ '   hidden in code
56. Dim Shared Working$ ' decoded and solved when working$ becomes = ucase$(answer$)
57. Dim Shared Letters$(1 To 26) ' for coding and highlited letters
58. Dim Shared LCodes$(1 To 26) '  for code and decode by number 1 to 26
59. Dim Shared Guesses$(1 To 26) ' track all the guess to decode
60. Dim Shared HighLited ' cursor over letters to guess
61. Dim Shared Mode
62.  
63. ' adding graphics effects
64. Dim Shared Worms(1 To nWorms) As Object
65. Dim Shared WormYard As Object
66.  
67. _FullScreen 'I guess it does make it easier to tell E from F...
68.  
69. Dim jokes$(1 To 100) ' load jokes one time from data statements in program
70. For i = 1 To 100
71.     Read r$
72.     If r$ <> "EOD" Then jokes$(i) = r$: jCount = jCount + 1 Else Exit For
73. Next
74.  
75. restart:
76.  
77. 'setup Puzzle and code it
78. Answer$ = jokes$(Int(Rnd * jCount) + 1)
79. For i = 1 To 26: Guesses$(i) = "-": Next 'setup the display guesses array
80. For i = 1 To 26 ' use letters for display of letters to pick second and to create a code
81.     Letters$(i) = Chr$(i + 64)
82.     LCodes$(i) = Letters$(i) ' these will convert between each other by index number
83. Next
84. For i = 26 To 2 Step -1 ' shuffle the letters in LCode$()
85.     Swap LCodes$(i), LCodes$(Int(Rnd * i) + 1)
86. Next
87. Coded$ = "": Working$ = "" ' reset for next go around
88. For i = 1 To Len(Answer$) 'third: put the phrase in coded$ and hide it in working$
89.     a = Asc(UCase$(Answer$), i)
90.     If a >= 65 And a <= 90 Then
91.         Coded$ = Coded$ + LCodes$(a - 64)
92.         Working$ = Working$ + "*"
93.     Else
94.         Coded$ = Coded$ + Mid$(Answer$, i, 1)
95.         Working$ = Working$ + Mid$(Answer$, i, 1)
96.     End If
97. Next
98.  
99. HighLited = 1 'setup done start game
100. Mode = 0
101.  
102. 'select a grahics effect  on timer
103. GE = 1 ' <<< convert to pick at random from N effects
104. nTimer% = _FreeTimer
105. If GE = 1 Then
106.     NewWormYard 0, 0, _Width, _Height
107.     resetWorms% = -1
108.     DrawWorms resetWorms% ' get draw worms started on a new set o worms
109.     resetWorms% = 0 ' dont reset while running on timer
110.     On Timer(0.5) DrawWorms resetWorms%
111.     Timer On
112. End If
113.  
114. DisplayInstructions '<< this part can be eaten by worms
115. Update ' this part is critical to continue work on puzzle
116. Do
117.     DrawWorms resetWorms
118.     k$ = choice$(25, 44, " 1234ABCDEFGHIJKLMNOPQRSTUVWXYZ")
119.     If k$ <> " " Then
120.         If Mode = 0 Then ' highlight a letter
121.             'm replaces arrows and mouse select of highlited 1 to 26 for letters
122.             test = InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", k$)
123.             If test > 0 Then
124.                 HighLited = test
125.                 Mode = 1
126.             Else
127.                 test = InStr("1234", k$)
128.                 If test > 0 Then
129.                     Select Case test
130.                         Case 1: GoSub do1
131.                         Case 2: GoSub do2
132.                         Case 3: GoSub do3
133.                         Case 4: GoSub do4
134.                     End Select
135.                 Else
136.                     Mode = 0
137.                 End If
138.             End If
139.         Else
140.             Select Case k$
141.                 Case "1": GoSub do1
142.                 Case "2": GoSub do2
143.                 Case "3": GoSub do3
144.                 Case "4": GoSub do4
145.                 Case "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"
146.                     Guesses$(HighLited) = k$ ' for screen updates
147.                     For i = 1 To Len(Working$)
148.                         If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = k$
149.                     Next
150.                     Mode = 0
151.             End Select
152.         End If
153.     End If
154.     Update
155.     _Limit 60
156. Loop Until Working$ = UCase$(Answer$)
157. Update
158. Timer Off
159. Color Orange, Back
160. cp 19, "You got it!    5 secs to next puzzle..."
161. _Display
162. _Delay 5: Cls
163. GoTo restart
164.  
165. do1: ' display answer
166. Working$ = UCase$(Answer$) ' show the answer$ guesses correct moves to next puzzle
167. Mode = 0
168. Update
169. Return
170.  
171. do2: ' get decode letter for highlighted Letter
172. For i = 1 To 26
173.     If LCodes$(i) = Letters$(HighLited) Then c$ = Chr$(i + 64): Exit For
174. Next
175. Guesses$(HighLited) = c$ ' for screen updates
176. For i = 1 To Len(Working$)
177.     If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = c$
178. Next
179. Update
180. Mode = 0
181. Return
182.  
183. do3: ' find a uncoded letter
184. Color White, Back
185. cp 24, "     Select Letter to Find     "
186. Locate 25, 1: Print Space$(100); ' clear out old line
187. d$ = choice$(25, 46, " ABCDEFGHIJKLMNOPQRSTUVWXYZ")
188. If d$ <> " " Then
189.     c$ = LCodes$(Asc(d$) - 64)
190.     Guesses$(Asc(c$) - 64) = d$
191.     For i = 1 To Len(Working$)
192.         If c$ = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = d$
193.     Next
194.     Mode = 0
195.     Update
196. End If
197. Return
198.  
199. do4: ' clear guess letter from code letter
200. Guesses$(HighLited) = "-"
201. For i = 1 To Len(Working$)
202.     If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = "*" ' clear the letter
203. Next
204. Mode = 0
205. Update
206. Return
207.  
208. 'one liners
209. Data "Why do ghosts go on diets? So they can keep their ghoulish figures"
210. Data "Where does a ghost go on vacation? Mali-boo."
211. Data "Why did the ghost go into the bar? For the Boos."
212. Data "What is in a ghost's nose? Boo-gers."
213. Data "Why did the policeman ticket the ghost on Halloween? It didn't have a haunting license."
214. Data "Why do demons and ghouls hang out together? Because demons are a ghoul's best friend!"
215. Data "Why did the ghost starch his sheet? He wanted everyone scared stiff."
216. Data "What does a panda ghost eat? Bam-BOO!"
217. Data "What's a ghost's favorite dessert? I-Scream!"
218. Data "Where do ghosts buy their food? At the ghost-ery store!"
219. Data "How do you know when a ghost is sad? He starts boo hooing."
220. Data "Why don't mummies take time off? They're afraid to unwind."
221. Data "Why did the headless horseman go into business? He wanted to get ahead in life."
222. Data "What kind of music do mummies like listening to on Halloween? Wrap music."
223. Data "Why don't mummies have friends? Because they're too wrapped up in themselves."
224. Data "Why did the vampire read the newspaper? He heard it had great circulation."
225. Data "How do vampires get around on Halloween? On blood vessels."
226. Data "What's it like to be kissed by a vampire? It's a pain in the neck."
227. Data "What's it called when a vampire has trouble with his house? A grave problem."
228. Data "How can you tell when a vampire has been in a bakery? All the jelly has been sucked out of the jelly doughnuts."
229. Data "What do you get when you cross a vampire and a snowman? Frostbite."
230. Data "Why do skeletons have low self-esteem? They have no body to love."
231. Data "Know why skeletons are so calm? Because nothing gets under their skin."
232. Data "What do you call a cleaning skeleton? The grim sweeper."
233. Data "What do skeletons order at a restaurant? Spare ribs."
234. Data "What do you call a witch's garage? A broom closet."
235. Data "What kind of food would you find on a haunted beach? A sand-witch!"
236. Data "What was the witch's favorite subject in school? Spelling."
237. Data "What do you call two witches who live together? Broom-mates!"
238. Data "What's a witch's favorite makeup? Ma-scare-a."
239. Data "Who helps the little pumpkins cross the road safely? The crossing gourd."
240. Data "What treat do eye doctors give out on Halloween? Candy corneas."
241. Data "What type of plants do well on all Hallow's Eve? Bam-BOO!"
242. Data "What do birds say on Halloween? Trick or tweet!"
243. Data "Why don't skeletons ever go trick or treating? Because they have no-body to go with."
244. Data "Where do ghosts buy their Halloween candy? At the ghost-ery store!"
245. Data "What do owls say when they go trick or treating? 'Happy Owl-ween!'"
246. Data "What do ghosts give out to trick or treaters? Booberries!"
247. Data "Who did Frankenstein go trick or treating with? His ghoul friend."
248. Data "What Halloween candy is never on time for the party? Choco-LATE!"
249. Data "What do witches put on to go trick or treating? Mas-scare-a."
250. Data "What does Bigfoot say when he asks for candy?  'Trick-or-feet!'"
251. Data "Which type of pants do ghosts wear to trick or treat? Boo jeans."
252. Data "What makes trick or treating with twin witches so challenging? You never know which witch is which!"
253. Data "What happens when a vampire goes in the snow? Frost bite!"
254. Data "What do you call two witches living together? Broommates"
255. Data "What position does a ghost play in hockey? Ghoulie."
256. Data "What do mummies listen to on Halloween? Wrap music."
257. Data "How do you make a skeleton laugh? You tickle his funny bone!"
258. Data "Which Halloween monster is good at math? Count Dracula!"
259. Data "Why did the Cyclops give up teaching? He only had one pupil!"
260. Data "Why didn't the skeleton go to see a scary movie? He didn't have the guts."
261. Data "What did the boy ghost say to the girl ghost? 'You sure are boo-tiful!'"
262. Data "Where does Dracula keep his money? In a blood bank."
263. Data "Why are ghosts terrible liars? You can see right through them!"
264. Data "Why don't mummies take vacations? They're afraid to unwind."
265. Data "What is a vampire's favorite holiday, besides Halloween? Fangs-giving!"
266. Data "Where do fashionable ghosts shop? Bootiques!"
267. Data "What's a monster's favorite play? Romeo and Ghouliet!"
268. Data "What room does a ghost not need? A living room."
269. Data "What monster plays tricks on Halloween? Prank-enstein!"
270. Data "What's a ghost's favorite dessert? I scream."
271. Data "What does the skeleton chef say when he serves you a meal? 'Bone Appetit!'"
272. Data "What is a vampire's favorite fruit? A neck-tarine!"
273. Data "What do witches put on their bagels? Scream cheese."
274. Data "What do ghosts eat for dinner? Spook-ghetti!"
275. Data "What do skeletons order at restaurants? Spare ribs."
276. Data "What does a panda ghost eat? Bam-BOO!"
277. Data "What tops off a mummy's ice cream sundae? Whipped scream."
278. Data "What's a ghost's favorite yogurt flavor? Boo-berry!"
279. Data "What's a vampire's least favorite meal? A steak!"
280. Data "Why was the candy corn booed off the stage? All of his jokes were too corny!"
281. Data "EOD"
282.  
283. Sub Update ' preserve from ravages of graphics effects ;-))
284.     Color Yellow
285.     Locate 17, (120 - Len(Answer$)) / 2: Print Coded$;
286.     Color White
287.     Locate 18, (120 - Len(Answer$)) / 2
288.     For i = 1 To Len(Answer$)
289.         w$ = Mid$(Working$, i, 1): c$ = Mid$(Coded$, i, 1)
290.         a$ = Mid$(Answer$, i, 1): h$ = Letters$(HighLited)
291.         If w$ = "*" Then
292.             pc$ = "*": If h$ = c$ Then Color White, Blue Else Color White, Back
293.         Else
294.             Color White, Back: If w$ = UCase$(a$) Then pc$ = a$ Else pc$ = w$
295.         End If
296.         Print pc$;
297.     Next
298.     spaces = 9
299.     For i = 1 To 26 'blue background highlighter
300.         If i = HighLited Then Color Yellow, Blue Else Color Yellow, Back
301.         Locate 21, spaces: Print Letters$(i);
302.         If i = HighLited Then Color Yellow, Blue Else Color White, Back
303.         Locate 22, spaces: Print Guesses$(i);
304.         spaces = spaces + 4
305.     Next
306.     If Mode = 1 Then
307.         Color White, Back
308.         cp 24, "  Guess Solve Letter or Menu # "
309.     Else
310.         Color Yellow, Back
311.         cp 24, "  Select Code Letter or Menu # "
312.     End If
313.     _Display
314. End Sub
315.  
316. Sub DisplayInstructions ' only once let worms eat them up as game goes on
317.     Color Orange, Back: Cls
318.     cp 4, "*** Halloween Challenge - Crypt-O-Gram Puzzle ***"
319.     Color Red
320.     cp 6, "Solve puzzle by selecting a Code letter then selecting a Guess letter for it."
321.     cp 7, "All selections are made by pressing spacebar when you see your letter or digit."
322.     cp 8, "You will need to verify your selection by pressing spacebar again when see Y for Yes."
323.     cp 9, "Use the escape key to quit immediately (an X box in top right is not accessible)."
324.     Color BB
325.     cp 11, "To get the answer and move onto next puzzle, select 1."
326.     cp 12, "To decode current highlighted letter, select 2."
327.     cp 13, "To solve a letter, select 3 and then select letter to find."
328.     cp 14, "To clear a guess at highlighted Code letter, select 4."
329.     _Display
330. End Sub
331.  
332. Sub cp (row, text$) ' center text on text screen
333.     'Locate row, 1: Print Space$(_Width) ' clear out old line in case the next is shorter
334.     'Locate row, 1: Print Space$(Xmax / 8);  'text screen
335.     ' clear old line was interferring with worm trails
336.     Locate row, (Xmax / 8 - Len(text$)) / 2: Print text$;
337. End Sub
338.  
339. Function choice$ (row, col, selection$) ' replace InKey$ with _KeyDown()
340.     fg~& = _DefaultColor: bg~& = _BackgroundColor
341.     saveRow = CsrLin: saveCol = Pos(0): t = Timer
342.     GoSub show
343.     Do
344.         If _KeyDown(27) Then System ' emergency exit
345.         GoSub show:
346.         ' 2021-10-06 fix for polling erratic behavior: misses or jumps, check for spacebar way more often
347.         While Timer - t < 4 ' smooth out the jumpiness sometimes no response, sometimes jumps 2x' on one press????
348.             If _KeyDown(27) Then System ' emergency exit
349.             If _KeyDown(32) Then t = Timer: place = (place + 1) Mod Len(selection$): Exit While
350.             _Limit 200 '<<<< fine tune the polling for spacebar!!!
351.         Wend
352.         If Timer - t >= 4 Then choice$ = Mid$(selection$, place + 1, 1): Locate saveRow, saveCol: Exit Function
353.         _Limit 5 'so can hold down spacebar, nice
354.     Loop
355.     show:
356.     Locate row, col
357.     For i = 1 To Len(selection$)
358.         If i = place + 1 Then Color bg~&, fg~& Else Color fg~&, bg~&
359.         Locate row, col - 1 + i: Print Mid$(selection$, i, 1);
360.     Next
361.     _Display
362.     Color fg~&, bg~&
363.     Return
364. End Function
365.  
366. Sub DrawWorms (DrawReset As Integer) ' one frame in main loop
367.     Static x(1 To nWorms, 1 To 20), y(1 To nWorms, 1 To 20)
368.     If DrawReset Then
369.         For i = 1 To nWorms
370.             NewWorm i
371.             For j = 1 To 20
372.                 x(i, j) = 0: y(i, j) = 0
373.             Next
374.         Next
375.         DrawReset = 0
376.     End If
377.     For i = 1 To nWorms
378.         Fcirc Worms(i).X, Worms(i).Y, 8, &HFF000000 ' fix 2021-10-07 to prevent program hangs
379.         If _KeyDown(27) Then Exit Sub
380.         For j = 1 To Worms(i).Sz ' blackout old segments
381.             If x(i, j) And y(i, j) Then Fcirc x(i, j), y(i, j), 8, &HFF000000
382.         Next
383.         tryAgain:
384.         If _KeyDown(27) Then Exit Sub
385.         If Rnd < .3 Then Worms(i).DX = Worms(i).DX + .8 * Rnd - .4 Else Worms(i).DY = Worms(i).DY + .8 * Rnd - .4
386.         If Abs(Worms(i).DX) > 2 Then Worms(i).DX = Worms(i).DX * .5
387.         If Abs(Worms(i).DY) > 2 Then Worms(i).DY = Worms(i).DY * .5
388.         x = Worms(i).X + Worms(i).DX * 2.0: y = Worms(i).Y + Worms(i).DY * 2.0
389.         good = -1
390.         If x >= WormYard.X + 6 And x <= WormYard.X + WormYard.W - 6 Then
391.             If y >= WormYard.Y + 6 And y <= WormYard.Y + WormYard.H - 6 Then
392.                 For yy = y - 6 To y + 6
393.                     For xx = x - 6 To x + 6
394.                         If Point(xx, yy) = _RGB32(255, 255, 255) Or Point(xx, yy) = _RGB32(255, 255, 0) Then good = 0: Exit For
395.                     Next
396.                     If good = 0 Then Exit For
397.                 Next
398.             Else
399.                 good = 0
400.             End If
401.         Else
402.             good = 0
403.         End If
404.         If good = 0 Then 'turn the worm
405.             'Beep: Locate 1, 1: Print x, y
406.             'Input "enter >", w$
407.             If Rnd > .5 Then 'change dx
408.                 If Worms(i).DX Then
409.                     Worms(i).DX = -Worms(i).DX
410.                 Else
411.                     If Rnd > .5 Then Worms(i).DX = 1 Else Worms(i).DX = -1
412.                 End If
413.             Else
414.                 If Worms(i).DY Then
415.                     Worms(i).DY = -Worms(i).DY
416.                 Else
417.                     If Rnd > .5 Then Worms(i).DY = 1 Else Worms(i).DY = -1
418.                 End If
419.             End If
420.             GoTo tryAgain
421.         End If
422.         For j = Worms(i).Sz To 2 Step -1
423.             x(i, j) = x(i, j - 1): y(i, j) = y(i, j - 1)
424.             If x(i, j) And y(i, j) Then DrawBall x(i, j), y(i, j), 6, Worms(i).C1
425.         Next
426.         x(i, 1) = x: y(i, 1) = y
427.         DrawBall x(i, 1), y(i, 1), 6, Worms(i).C1
428.         Worms(i).X = x: Worms(i).Y = y
429.     Next i 'worm index
430.     _Display
431. End Sub
432.  
433. Sub NewWormYard (x, y, w, h)
434.     WormYard.X = x: WormYard.Y = y: WormYard.W = w: WormYard.H = h
435.     For i = 1 To nWorms
436.         NewWorm i
437.     Next
438. End Sub
439.  
440. Sub NewWorm (i)
441.     'pick which side to enter, for dx, dy generally headed towards inner screen
442.     side = Int(Rnd * 4)
443.     Select Case side
444.         Case 0 ' left side
445.             Worms(i).X = WormYard.X + 6
446.             Worms(i).Y = WormYard.Y + 6 + (WormYard.H - 12) * Rnd
447.             Worms(i).DX = 1
448.             Worms(i).DY = 0
449.         Case 1 'right side
450.             Worms(i).X = WormYard.X + WormYard.W - 6
451.             Worms(i).Y = WormYard.Y + 6 + (WormYard.H - 12) * Rnd
452.             Worms(i).DX = -1
453.             Worms(i).DY = 0
454.         Case 2 ' top
455.             Worms(i).Y = WormYard.Y + 6
456.             Worms(i).X = WormYard.X + 6 + (WormYard.W - 12) * Rnd
457.             Worms(i).DX = 0
458.             Worms(i).DY = 1
459.         Case 3 'bottom
460.             Worms(i).Y = WormYard.Y + WormYard.H - 6
461.             Worms(i).X = WormYard.X + 6 + (WormYard.W - 12) * Rnd
462.             Worms(i).DX = 0
463.             Worms(i).DY = -1
464.     End Select
465.     Worms(i).Sz = Int(Rnd * 11) + 10
466.     side = Int(Rnd * 4): lev = Int(Rnd * 10)
467.     If side = 0 Then
468.         Worms(i).C1 = _RGB32(255 - 20 * lev + 50, 180 - 15 * lev, 180 - 15 * lev)
469.     ElseIf side = 1 Then
470.         Worms(i).C1 = _RGB32(255 - 20 * lev, 180 - 15 * lev + 50, 180 - 15 * lev)
471.     ElseIf side = 2 Then
472.         Worms(i).C1 = _RGB32(255 - 20 * lev, 180 - 15 * lev, 180 - 15 * lev + 20)
473.     ElseIf side = 3 Then
474.         Worms(i).C1 = _RGB32(255 - 20 * lev, 180 - 15 * lev, 180 - 15 * lev)
475.     End If
476. End Sub
477.  
478. Sub Fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
479.     Dim Radius As Long, RadiusError As Long
480.     Dim X As Long, Y As Long
481.     Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
482.     If Radius = 0 Then PSet (CX, CY), C: Exit Sub
483.     Line (CX - X, CY)-(CX + X, CY), C, BF
484.     While X > Y
485.         RadiusError = RadiusError + Y * 2 + 1
486.         If RadiusError >= 0 Then
487.             If X <> Y + 1 Then
488.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
489.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
490.             End If
491.             X = X - 1
492.             RadiusError = RadiusError - X * 2
493.         End If
494.         Y = Y + 1
495.         Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
496.         Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
497.     Wend
498. End Sub
499.  
500. Sub DrawBall (x, y, r, c As _Unsigned Long)
501.     Dim rred As Long, grn As Long, blu As Long, rr As Long, f
502.     rred = _Red32(c): grn = _Green32(c): blu = _Blue32(c)
503.     For rr = r To 0 Step -1
504.         f = 1.25 - rr / r
505.         Fcirc x, y, rr, _RGB32(rred * f, grn * f, blu * f)
506.     Next
507. End Sub
508.  

[bplus]

The GoSub routine do3: was clearing a line across the screen which cut into the worm trails looking funky. Here is the fix for do3:

Code: QB64: [Select]

1. do3: ' find a uncoded letter
2. Color White, Back
3. cp 24, "     Select Letter to Find     "
4. Locate 25, 44: Print Space$(31); ' clear out old line
5. d$ = choice$(25, 46, " ABCDEFGHIJKLMNOPQRSTUVWXYZ")
6. If d$ <> " " Then
7.     c$ = LCodes$(Asc(d$) - 64)
8.     Guesses$(Asc(c$) - 64) = d$
9.     For i = 1 To Len(Working$)
10.         If c$ = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = d$
11.     Next
12.     Mode = 0
13.     Update
14. End If
15. Return
16.  

This just clears the exact text length that needed clearing, instead of the whole line.

[johnno56]

I am testing single word comments. Seems to be a little easier to understand. Give them a try.... If you can think of any others just let me know.

 

comments3.zip