Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on October 04, 2021, 09:18:14 am

Title: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: bplus on October 04, 2021, 09:18:14 am
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.  
  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$
  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
  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.


Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: bplus on October 04, 2021, 09:57:17 am
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.  
  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
  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
  36. For i = 26 To 2 Step -1 ' shuffle the letters in LCode$()
  37.     Swap LCodes$(i), LCodes$(Int(Rnd * i) + 1)
  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
  50. HighLited = 1 'setup done start game
  51. Mode = 0
  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..."
  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
  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
  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$
  112. Mode = 0
  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
  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
  133. Mode = 0
  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
  253.  
  254. Sub cp (row, text$) ' center text on text screen
  255.     Locate row, (_Width - Len(text$)) / 2: Print text$
  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$
  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
  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.



Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: bplus on October 04, 2021, 05:00:27 pm
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.  
  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
  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
  40. For i = 26 To 2 Step -1 ' shuffle the letters in LCode$()
  41.     Swap LCodes$(i), LCodes$(Int(Rnd * i) + 1)
  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
  54. HighLited = 1 'setup done start game
  55. Mode = 0
  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..."
  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
  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
  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$
  116. Mode = 0
  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
  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
  138. Mode = 0
  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
  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$
  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
  289.  
  290.  

It's allot easier to play now! Thanks Steve
Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: SMcNeill on October 04, 2021, 05:09:47 pm
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!
Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: bplus on October 04, 2021, 06:44:10 pm
OK _KeyDown will replace InKey$ in next update. Seems to not get so carried away when holding down the Spacebar.

Thanks Steve!
Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: bplus on October 04, 2021, 06:46:57 pm
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
  24.  
Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: bplus on October 06, 2021, 11:53:12 am
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
  27.  

Much smoother scroll action, way way less over scroll that Inkey$ would have. I think I have it just right now.
Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: johnno56 on October 06, 2021, 03:39:20 pm
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?
Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: bplus on October 07, 2021, 11:21:33 am
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...
Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: SMcNeill on October 07, 2021, 11:57:48 am
@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
Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: bplus on October 07, 2021, 12:06:45 pm
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!
Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: bplus on October 07, 2021, 12:15:13 pm
Quote
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
Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: bplus on October 07, 2021, 09:45:03 pm
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?
  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
  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
  84. For i = 26 To 2 Step -1 ' shuffle the letters in LCode$()
  85.     Swap LCodes$(i), LCodes$(Int(Rnd * i) + 1)
  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
  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
  113.  
  114. DisplayInstructions '<< this part can be eaten by worms
  115. Update ' this part is critical to continue work on puzzle
  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
  159. Color Orange, Back
  160. cp 19, "You got it!    5 secs to next puzzle..."
  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
  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
  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$
  179. Update
  180. Mode = 0
  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
  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
  204. Mode = 0
  205. Update
  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
  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
  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$;
  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
  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
  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
  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
  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
  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
  508.  

Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: bplus on October 08, 2021, 07:14:51 am
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
  16.  

This just clears the exact text length that needed clearing, instead of the whole line.
Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: johnno56 on October 08, 2021, 10:10:38 am
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.

  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: Pete on October 08, 2021, 06:18:02 pm
Let's go Brandon!

I wonder what that would dcryptify to?

Okay, neat looking screen presentation and I have to admit, the "Demons are a ghoul's best friend made me chuckle. Hey, didn't Steve have some word game in the works for this challenge? What was it called again, The Alphabator? You keep pulling letters and... Never mind.

Hey Mark, you could marry that to POWERSHELL and get the computer to give the answer over the speaker. Text to Speech is a nice feature. Just a thought.

    t
Pe e
   ^ (Word bump this!)
Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: bplus on October 08, 2021, 09:51:37 pm
Quote
"Demons are a ghoul's best friend

@Pete oh ha! I thought you were talking about @johnno56 comments, that's a joke I haven't gotten to yet!
Nice idea of using speech to text, I can and have done that in for windows apps. I had an app, "Henny pecked", that told one-liners Henny Youngman style, actually allot of Steve Write jokes.

Yeah @johnno56 take a break on the sounds, letters and selections probably will get boring, I think I have some Halloween music and sound effects might be better. (PS those words were not so clear to me, letters and multiple words seemed better to me?)

When trying to add spiders to graphics effects I had a hell of a time with multiple timers basically wasted the morning.

2 steps forward one back, I rewrote Choice$ function again! This time to use the main Loop and no extracurricular excursions into indy loops. It is actually working really sweet making input go much smoother. Now with some adjustments I can add effects much easier without timers.

Here is spiders added to worms with new Choice$ and allot of other rework.
v2021-10-08
Code: QB64: [Select]
  2. _Title "Halloween Challenge: Crypt-O-Gram Puzzle" ' b+  started One Key Challenge 2021-09-25
  3. ' from One Key Challenge - Cryptogram Puzzle   2021-10-02
  4.  
  5. ' 2021-09-07 Jokes are intended for QB64 home programming entertainment use only.
  6. ' Thank you CountryLiving 1-33
  7. ' https://www.countryliving.com/entertaining/a32963261/halloween-jokes/
  8. ' Thank you GoodHousekeeping 34-72
  9. ' https://www.goodhousekeeping.com/holidays/halloween-ideas/a32998753/halloween-jokes/
  10.  
  11. ' 2021-10-03 install new set of jokes and new Binary Select Input Algorithm
  12. ' Redo Mode system to fix differences of input methods.
  13. ' Recolor green background has me seeing Red!
  14.  
  15. ' 2021-10-04 Steve McNeill came up with an easier to understand and use input system.
  16. ' Installing new Function and updating Game. Steve also told me how to change color palette,
  17. ' now we have some real Orange! for #12 meant for high red.
  18.  
  19. ' Next version: Follow Steve's advice to use _KeyDown in stead of InKey$
  20. ' Improved Choice to reduce no response to keypress or double jumping.
  21. ' v 2021-10-07 install DrawWorms subroutines and get working.
  22.  
  23. ' v 2021-10-08: fix do3, blanking whole line or nearly, it disturbs worm trails.
  24. ' Add a spider screen for overlaying spiders wo changing the background.
  25. ' Man this is so screwed up... I'm taking another approach.
  26. ' ... rewrites and tests
  27. ' Now do3 completely rewritten as mode 3 along with Choice$ function
  28. ' Much better!! rewrote the way Choice works, no time consuming loops outside main loop,
  29. ' so no delaysin graphics effects so no need for timers. Only one side screen needed
  30. ' for tracking Worm Trails. Had to slow worms and Spider dowm for a _Limit 30 for everything.
  31.  
  32.  
  33. 'Fall letters and background
  34. Const Orange = &HFFFF8800 ' 12 d
  35. Const Back = &HFF302010 ' 8 ? d
  36. Const Red = &HFFFF2222 ' print under title
  37. Const Blue = &HFF0000FF ' 9 light blue
  38. Const BB = &HFF33BB33 ' 6 blue brown ?
  39. Const Xmax = 120 * 8 ' started with text screen _width 120, 30
  40. Const Ymax = 30 * 16
  41.  
  42. 'for Graphic effects
  43. Const nWorms = 30
  44. Const nSpiders = 15
  45.  
  46. 'for graphics effects
  47. Type Object
  48.     X As Single ' usu top left corner   could be center depending on object
  49.     Y As Single ' ditto
  50.     W As Single ' width   or maybe radius
  51.     H As Single ' height
  52.     DX As Single ' moving opjects
  53.     DY As Single ' ditto
  54.     DIR As Single ' short for direction or heading usu a radian angle
  55.     Sz As Single ' perhaps a scaling factor
  56.     Act As Integer ' lives countdown or just plain ACTive TF
  57.     C1 As _Unsigned Long ' a foreground color
  58.     C2 As _Unsigned Long ' a background or 2nd color     OR C1 to c2 Range?
  60. Dim Shared As _Unsigned Long White, Yellow
  61. White = _RGB32(255, 255, 255): Yellow = _RGB32(255, 255, 0) ' I give up, yellow and white aren't stopping the worms
  62. Dim Shared Answer$ '  beginning phrase to be guessed    '   3 stages of the Puzzle
  63. Dim Shared Coded$ '   hidden in code
  64. Dim Shared Working$ ' decoded and solved when working$ becomes = ucase$(answer$)
  65. Dim Shared Letters$(1 To 26) ' for coding and highlited letters
  66. Dim Shared LCodes$(1 To 26) '  for code and decode by number 1 to 26
  67. Dim Shared Guesses$(1 To 26) ' track all the guess to decode
  68. Dim Shared HighLited ' cursor over letters to guess
  69. Dim Shared Mode ' what are we getting a coded letter =0, a guess for that letter =1, a letter to find and decode=3
  70. Dim Shared KeyTimer
  71. Dim Shared Place
  73.  
  74. ' adding graphics effects
  75. ReDim Shared Worms(1 To nWorms) As Object
  76. Dim Shared WormYard As Object
  77. ReDim Shared S(1 To nSpiders) As Object ' Spider 0 is a spinner?
  78. Dim Shared WT As Long ' worm screen to track Worm Trails
  79.  
  80. ' main declares
  81. Dim jokes$(1 To 100) ' load jokes one time from data statements in program
  82. Dim As Integer i, resetWorms, si, jCount, a, lc, test
  83. Dim r$, k$, c$
  84.  
  85. Screen _NewImage(Xmax, Ymax, 32)
  86. Randomize Timer ': Width 120, 30 converted to graphics screen
  87. _FullScreen 'I guess it does make it easier to tell E from F...
  88.  
  89. WS = _NewImage(Xmax, Ymax, 32)
  90. For i = 1 To 100 'ready jokes
  91.     Read r$
  92.     If r$ <> "EOD" Then jokes$(i) = r$: jCount = jCount + 1 Else Exit For
  94. restart:
  95.  
  96. 'setup Puzzle and code it
  97. Answer$ = jokes$(Int(Rnd * jCount) + 1)
  98. For i = 1 To 26: Guesses$(i) = "-": Next 'setup the display guesses array
  99. For i = 1 To 26 ' use letters for display of letters to pick second and to create a code
  100.     Letters$(i) = Chr$(i + 64)
  101.     LCodes$(i) = Letters$(i) ' these will convert between each other by index number
  103. For i = 26 To 2 Step -1 ' shuffle the letters in LCode$()
  104.     Swap LCodes$(i), LCodes$(Int(Rnd * i) + 1)
  106. Coded$ = "": Working$ = "" ' reset for next go around
  107. For i = 1 To Len(Answer$) 'third: put the phrase in coded$ and hide it in working$
  108.     a = Asc(UCase$(Answer$), i)
  109.     If a >= 65 And a <= 90 Then
  110.         Coded$ = Coded$ + LCodes$(a - 64)
  111.         Working$ = Working$ + "*"
  112.     Else
  113.         Coded$ = Coded$ + Mid$(Answer$, i, 1)
  114.         Working$ = Working$ + Mid$(Answer$, i, 1)
  115.     End If
  117. If WT Then _FreeImage WT ' clear WormTrails for new game
  118. WT = _NewImage(Xmax, Ymax, 32)
  119. ReDim Worms(1 To nWorms) As Object ' clear old arrays
  120. NewWormYard 0, 0, Xmax, Ymax
  121. resetWorms = -1
  122. ReDim S(1 To nSpiders) As Object
  123. si = 0: lc = 0
  124. HighLited = 1 'setup done start game
  125. Mode = 0
  126.  
  127. KeyTimer = Timer
  129.     Color , Back: Cls
  130.     DisplayInstructions '<< this part can be eaten by worms very bottom of drawing
  131.     _PutImage , WT, 0 ' the worm trails
  132.     Update ' need yellow and white to slow worms
  133.     DrawWorms resetWorms ' yellow and white not working???
  134.     lc = lc + 1
  135.     If lc Mod 300 = 299 Then 'drawSpiders
  136.         If si < nSpiders Then si = si + 1: newSpinner si
  137.     End If
  138.     For i = 1 To si
  139.         drawSpinner S(i).X, S(i).Y, S(i).Sz, _Atan2(S(i).DY, S(i).DX), S(i).C1
  140.         S(i).X = S(i).X + S(i).DX: S(i).Y = S(i).Y + S(i).DY
  141.         If S(i).X < -100 Or S(i).X > Xmax + 100 Or S(i).Y < -100 Or S(i).Y > Ymax + 100 Then newSpinner i
  142.     Next
  143.     'Update ' on top of every thing sets color to mode
  144.     If Mode = 3 Then
  145.         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 ")
  146.     Else
  147.         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 ")
  148.     End If
  149.     If k$ <> "" And k$ <> " " Then
  150.         If Mode = 0 Then ' highlight a letter
  151.             'm replaces arrows and mouse select of highlited 1 to 26 for letters
  152.             test = InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", k$)
  153.             If test > 0 Then
  154.                 HighLited = test
  155.                 Mode = 1
  156.             Else
  157.                 test = InStr("1234", k$)
  158.                 If test > 0 Then
  159.                     Select Case test
  160.                         Case 1: GoSub do1
  161.                         Case 2: GoSub do2
  162.                         Case 3: Mode = 3
  163.                         Case 4: GoSub do4
  164.                     End Select
  165.                 Else
  166.                     Mode = 0
  167.                 End If
  168.             End If
  169.         ElseIf Mode = 1 Then
  170.             Select Case k$
  171.                 Case "1": GoSub do1
  172.                 Case "2": GoSub do2
  173.                 Case "3": Mode = 3
  174.                 Case "4": GoSub do4
  175.                 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"
  176.                     Guesses$(HighLited) = k$ ' for screen updates
  177.                     For i = 1 To Len(Working$)
  178.                         If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = k$
  179.                     Next
  180.                     Mode = 0
  181.             End Select
  182.         ElseIf Mode = 3 Then
  183.             Locate 25, 44: Print Space$(31); ' clear out old line
  184.             c$ = LCodes$(Asc(k$) - 64)
  185.             Guesses$(Asc(c$) - 64) = k$
  186.             For i = 1 To Len(Working$)
  187.                 If c$ = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = k$
  188.             Next
  189.             Mode = 0
  190.         End If
  191.     End If
  192.     _Limit 30
  193.     _Display
  194. Loop Until Working$ = UCase$(Answer$)
  195. Update
  196. Color Orange, Back
  197. cp 19, "You got it!    5 secs to next puzzle..."
  200. GoTo restart
  201.  
  202. do1: ' display answer
  203. Working$ = UCase$(Answer$) ' show the answer$ guesses correct moves to next puzzle
  204. Mode = 0
  206.  
  207. do2: ' get decode letter for highlighted Letter
  208. For i = 1 To 26
  209.     If LCodes$(i) = Letters$(HighLited) Then c$ = Chr$(i + 64): Exit For
  211. Guesses$(HighLited) = c$ ' for screen updates
  212. For i = 1 To Len(Working$)
  213.     If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = c$
  215. Mode = 0
  217.  
  218. do4: ' clear guess letter from code letter
  219. Guesses$(HighLited) = "-"
  220. For i = 1 To Len(Working$)
  221.     If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = "*" ' clear the letter
  223. Mode = 0
  224. Update
  226.  
  227. 'one liners
  228. Data "Why do ghosts go on diets? So they can keep their ghoulish figures"
  229. Data "Where does a ghost go on vacation? Mali-boo."
  230. Data "Why did the ghost go into the bar? For the Boos."
  231. Data "What is in a ghost's nose? Boo-gers."
  232. Data "Why did the policeman ticket the ghost on Halloween? It didn't have a haunting license."
  233. Data "Why do demons and ghouls hang out together? Because demons are a ghoul's best friend!"
  234. Data "Why did the ghost starch his sheet? He wanted everyone scared stiff."
  235. Data "What does a panda ghost eat? Bam-BOO!"
  236. Data "What's a ghost's favorite dessert? I-Scream!"
  237. Data "Where do ghosts buy their food? At the ghost-ery store!"
  238. Data "How do you know when a ghost is sad? He starts boo hooing."
  239. Data "Why don't mummies take time off? They're afraid to unwind."
  240. Data "Why did the headless horseman go into business? He wanted to get ahead in life."
  241. Data "What kind of music do mummies like listening to on Halloween? Wrap music."
  242. Data "Why don't mummies have friends? Because they're too wrapped up in themselves."
  243. Data "Why did the vampire read the newspaper? He heard it had great circulation."
  244. Data "How do vampires get around on Halloween? On blood vessels."
  245. Data "What's it like to be kissed by a vampire? It's a pain in the neck."
  246. Data "What's it called when a vampire has trouble with his house? A grave problem."
  247. Data "How can you tell when a vampire has been in a bakery? All the jelly has been sucked out of the jelly doughnuts."
  248. Data "What do you get when you cross a vampire and a snowman? Frostbite."
  249. Data "Why do skeletons have low self-esteem? They have no body to love."
  250. Data "Know why skeletons are so calm? Because nothing gets under their skin."
  251. Data "What do you call a cleaning skeleton? The grim sweeper."
  252. Data "What do skeletons order at a restaurant? Spare ribs."
  253. Data "What do you call a witch's garage? A broom closet."
  254. Data "What kind of food would you find on a haunted beach? A sand-witch!"
  255. Data "What was the witch's favorite subject in school? Spelling."
  256. Data "What do you call two witches who live together? Broom-mates!"
  257. Data "What's a witch's favorite makeup? Ma-scare-a."
  258. Data "Who helps the little pumpkins cross the road safely? The crossing gourd."
  259. Data "What treat do eye doctors give out on Halloween? Candy corneas."
  260. Data "What type of plants do well on all Hallow's Eve? Bam-BOO!"
  261. Data "What do birds say on Halloween? Trick or tweet!"
  262. Data "Why don't skeletons ever go trick or treating? Because they have no-body to go with."
  263. Data "Where do ghosts buy their Halloween candy? At the ghost-ery store!"
  264. Data "What do owls say when they go trick or treating? 'Happy Owl-ween!'"
  265. Data "What do ghosts give out to trick or treaters? Booberries!"
  266. Data "Who did Frankenstein go trick or treating with? His ghoul friend."
  267. Data "What Halloween candy is never on time for the party? Choco-LATE!"
  268. Data "What do witches put on to go trick or treating? Mas-scare-a."
  269. Data "What does Bigfoot say when he asks for candy?  'Trick-or-feet!'"
  270. Data "Which type of pants do ghosts wear to trick or treat? Boo jeans."
  271. Data "What makes trick or treating with twin witches so challenging? You never know which witch is which!"
  272. Data "What happens when a vampire goes in the snow? Frost bite!"
  273. Data "What do you call two witches living together? Broommates"
  274. Data "What position does a ghost play in hockey? Ghoulie."
  275. Data "What do mummies listen to on Halloween? Wrap music."
  276. Data "How do you make a skeleton laugh? You tickle his funny bone!"
  277. Data "Which Halloween monster is good at math? Count Dracula!"
  278. Data "Why did the Cyclops give up teaching? He only had one pupil!"
  279. Data "Why didn't the skeleton go to see a scary movie? He didn't have the guts."
  280. Data "What did the boy ghost say to the girl ghost? 'You sure are boo-tiful!'"
  281. Data "Where does Dracula keep his money? In a blood bank."
  282. Data "Why are ghosts terrible liars? You can see right through them!"
  283. Data "Why don't mummies take vacations? They're afraid to unwind."
  284. Data "What is a vampire's favorite holiday, besides Halloween? Fangs-giving!"
  285. Data "Where do fashionable ghosts shop? Bootiques!"
  286. Data "What's a monster's favorite play? Romeo and Ghouliet!"
  287. Data "What room does a ghost not need? A living room."
  288. Data "What monster plays tricks on Halloween? Prank-enstein!"
  289. Data "What's a ghost's favorite dessert? I scream."
  290. Data "What does the skeleton chef say when he serves you a meal? 'Bone Appetit!'"
  291. Data "What is a vampire's favorite fruit? A neck-tarine!"
  292. Data "What do witches put on their bagels? Scream cheese."
  293. Data "What do ghosts eat for dinner? Spook-ghetti!"
  294. Data "What do skeletons order at restaurants? Spare ribs."
  295. Data "What does a panda ghost eat? Bam-BOO!"
  296. Data "What tops off a mummy's ice cream sundae? Whipped scream."
  297. Data "What's a ghost's favorite yogurt flavor? Boo-berry!"
  298. Data "What's a vampire's least favorite meal? A steak!"
  299. Data "Why was the candy corn booed off the stage? All of his jokes were too corny!"
  300. Data "EOD"
  301.  
  302. Sub Update ' preserve from ravages of graphics effects ;-))
  303.     Dim As Integer i, spaces
  304.     Dim w$, c$, a$, h$, pc$
  305.     Color Yellow, Back
  306.     Locate 17, (120 - Len(Answer$)) / 2: Print Coded$;
  307.     Color White, Back
  308.     Locate 18, (120 - Len(Answer$)) / 2
  309.     For i = 1 To Len(Answer$)
  310.         w$ = Mid$(Working$, i, 1): c$ = Mid$(Coded$, i, 1)
  311.         a$ = Mid$(Answer$, i, 1): h$ = Letters$(HighLited)
  312.         If w$ = "*" Then
  313.             pc$ = "*": If h$ = c$ Then Color White, Blue Else Color White, Back
  314.         Else
  315.             Color White, Back: If w$ = UCase$(a$) Then pc$ = a$ Else pc$ = w$
  316.         End If
  317.         Print pc$;
  318.     Next
  319.     spaces = 9
  320.     For i = 1 To 26 'blue background highlighter
  321.         If i = HighLited Then Color Yellow, Blue Else Color Yellow, Back
  322.         Locate 21, spaces: Print Letters$(i);
  323.         If i = HighLited Then Color Yellow, Blue Else Color White, Back
  324.         Locate 22, spaces: Print Guesses$(i);
  325.         spaces = spaces + 4
  326.     Next
  327.     If Mode = 1 Then
  328.         Color White, Back
  329.         cp 24, "  Guess Solve Letter or Menu # "
  330.         cp 25, String$(31, "W") ' for worm poison (the fore color)
  331.     ElseIf Mode = 0 Then
  332.         Color Yellow, Back
  333.         cp 24, "  Select Code Letter or Menu # "
  334.         cp 25, String$(31, "W") ' for worm poison (the fore color)
  335.     ElseIf Mode = 3 Then
  336.         Color White, Back
  337.         cp 24, "     Select Letter to Find     "
  338.         cp 25, String$(31, "W") ' for worm poison (the fore color)
  339.     End If
  341.  
  342. Sub DisplayInstructions ' only once let worms eat them up as game goes on
  343.     Color Orange, Back: Cls
  344.     cp 4, "*** Halloween Challenge - Crypt-O-Gram Puzzle ***"
  345.     Color Red
  346.     cp 6, "Solve puzzle by selecting a Code letter then selecting a Guess letter for it."
  347.     cp 7, "All selections are made by pressing spacebar when you see your letter or digit."
  348.     cp 8, "You will need to verify your selection by pressing spacebar again when see Y for Yes."
  349.     cp 9, "Use the escape key to quit immediately (an X box in top right is not accessible)."
  350.     Color BB
  351.     cp 11, "To get the answer and move onto next puzzle, select 1."
  352.     cp 12, "To decode current highlighted letter, select 2."
  353.     cp 13, "To solve a letter, select 3 and then select letter to find."
  354.     cp 14, "To clear a guess at highlighted Code letter, select 4."
  356.  
  357. Sub cp (row, text$) ' center text on text screen
  358.     'Locate row, 1: Print Space$(_Width) ' clear out old line in case the next is shorter
  359.     'Locate row, 1: Print Space$(Xmax / 8);  'text screen
  360.     ' clear old line was interferring with worm trails
  361.     Locate row, (Xmax / 8 - Len(text$)) / 2: Print text$;
  363.  
  364. Function choice$ (row, col, selection$) ' replace InKey$ with _KeyDown()
  365.     Dim As _Unsigned Long fg, bg
  366.     Dim As Integer saveRow, saveCol, i
  367.     Dim k$
  368.     fg~& = _DefaultColor: bg~& = _BackgroundColor
  369.     saveRow = CsrLin: saveCol = Pos(0)
  370.     If _KeyDown(27) Then System ' emergency exit
  371.     GoSub show:
  372.     k$ = InKey$
  373.     If _KeyDown(27) Then System ' emergency exit
  374.     If k$ = " " Then KeyTimer = Timer: Place = (Place + 1) Mod Len(selection$)
  375.     If Timer - KeyTimer >= 4 Then choice$ = Mid$(selection$, Place + 1, 1): Place = 0
  376.     Locate saveRow, saveCol: Exit Function
  377.  
  378.     show:
  379.     Locate row, col
  380.     For i = 1 To Len(selection$)
  381.         If i = Place + 1 Then Color bg~&, fg~& Else Color fg~&, bg~&
  382.         Locate row, col - 1 + i: Print Mid$(selection$, i, 1);
  383.     Next
  384.     '_Display
  385.     Color fg~&, bg~&
  386.     Return
  388.  
  389. Sub DrawWorms (DrawReset As Integer) ' one frame in main loop
  390.     Static x(1 To nWorms, 1 To 20), y(1 To nWorms, 1 To 20)
  391.     Dim M As _MEM
  392.     Dim As Integer i, j, good
  393.     Dim As Single x, y, xx, yy
  394.     _Source 0
  395.     If DrawReset Then
  396.         'M = _Mem(x())
  397.         '_MemFill M, M.OFFSET, M.SIZE, 0 As _BYTE 'reset the array, Thanks Steve
  398.         'M = _Mem(y())
  399.         '_MemFill M, M.OFFSET, M.SIZE, 0 As _BYTE 'reset the array, eh didn't work
  400.         For i = 1 To nWorms
  401.             NewWorm i
  402.             For j = 1 To 20
  403.                 x(i, j) = 0: y(i, j) = 0
  404.             Next
  405.         Next
  406.         DrawReset = 0
  407.     End If
  408.     For i = 1 To nWorms
  409.         _Dest WT
  410.         Fcirc Worms(i).X, Worms(i).Y, 6, &HFF000000
  411.         _Dest 0
  412.         If _KeyDown(27) Then Exit Sub
  413.         For j = 1 To Worms(i).Sz ' blackout old segments
  414.             If x(i, j) And y(i, j) Then Fcirc x(i, j), y(i, j), 8, &HFF000000
  415.         Next
  416.  
  417.         If Rnd < .15 Then 'move the worm  (gots to slow down the worms)
  418.             tryAgain:
  419.             If _KeyDown(27) Then Exit Sub
  420.             If Rnd < .3 Then Worms(i).DX = Worms(i).DX + .8 * Rnd - .4 Else Worms(i).DY = Worms(i).DY + .8 * Rnd - .4
  421.             If Worms(i).DX ^ 2 + Worms(i).DY ^ 2 > 2 Then
  422.                 Worms(i).DX = Worms(i).DX * .5: Worms(i).DY = Worms(i).DY * .5
  423.             End If
  424.             x = Worms(i).X + Worms(i).DX * 2.0: y = Worms(i).Y + Worms(i).DY * 2.0
  425.             good = -1
  426.             If x >= WormYard.X + 6 And x <= WormYard.X + WormYard.W - 6 Then
  427.                 If y >= WormYard.Y + 6 And y <= WormYard.Y + WormYard.H - 6 Then
  428.                     For yy = y - 6 To y + 6
  429.                         For xx = x - 6 To x + 6
  430.                             If Point(xx, yy) = White Or Point(xx, yy) = Yellow Then good = 0: Exit For
  431.                         Next
  432.                         If good = 0 Then Exit For
  433.                     Next
  434.                 Else
  435.                     good = 0
  436.                 End If
  437.             Else
  438.                 good = 0
  439.             End If
  440.             If good = 0 Then 'turn the worm
  441.                 If Rnd > .5 Then 'change dx
  442.                     If Worms(i).DX Then
  443.                         Worms(i).DX = -Worms(i).DX
  444.                     Else
  445.                         If Rnd > .5 Then Worms(i).DX = 1 Else Worms(i).DX = -1
  446.                     End If
  447.                 Else
  448.                     If Worms(i).DY Then
  449.                         Worms(i).DY = -Worms(i).DY
  450.                     Else
  451.                         If Rnd > .5 Then Worms(i).DY = 1 Else Worms(i).DY = -1
  452.                     End If
  453.                 End If
  454.                 GoTo tryAgain
  455.             End If
  456.  
  457.             For j = Worms(i).Sz To 2 Step -1
  458.                 x(i, j) = x(i, j - 1): y(i, j) = y(i, j - 1)
  459.                 If x(i, j) And y(i, j) Then DrawBall x(i, j), y(i, j), 6, Worms(i).C1
  460.             Next
  461.             x(i, 1) = x: y(i, 1) = y
  462.             DrawBall x(i, 1), y(i, 1), 6, Worms(i).C1
  463.             Worms(i).X = x: Worms(i).Y = y
  464.         Else
  465.             For j = Worms(i).Sz To 2 Step -1
  466.                 If x(i, j) And y(i, j) Then DrawBall x(i, j), y(i, j), 6, Worms(i).C1
  467.             Next
  468.             DrawBall x(i, 1), y(i, 1), 6, Worms(i).C1
  469.         End If
  470.     Next i 'worm index
  472.  
  473. Sub NewWormYard (x, y, w, h)
  474.     WormYard.X = x: WormYard.Y = y: WormYard.W = w: WormYard.H = h
  476.  
  477. Sub NewWorm (i)
  478.     Dim As Integer side, lev
  479.     'pick which side to enter, for dx, dy generally headed towards inner screen
  480.     side = Int(Rnd * 4)
  481.     Select Case side
  482.         Case 0 ' left side
  483.             Worms(i).X = WormYard.X + 6
  484.             Worms(i).Y = WormYard.Y + 6 + (WormYard.H - 12) * Rnd
  485.             Worms(i).DX = 1
  486.             Worms(i).DY = 0
  487.         Case 1 'right side
  488.             Worms(i).X = WormYard.X + WormYard.W - 6
  489.             Worms(i).Y = WormYard.Y + 6 + (WormYard.H - 12) * Rnd
  490.             Worms(i).DX = -1
  491.             Worms(i).DY = 0
  492.         Case 2 ' top
  493.             Worms(i).Y = WormYard.Y + 6
  494.             Worms(i).X = WormYard.X + 6 + (WormYard.W - 12) * Rnd
  495.             Worms(i).DX = 0
  496.             Worms(i).DY = 1
  497.         Case 3 'bottom
  498.             Worms(i).Y = WormYard.Y + WormYard.H - 6
  499.             Worms(i).X = WormYard.X + 6 + (WormYard.W - 12) * Rnd
  500.             Worms(i).DX = 0
  501.             Worms(i).DY = -1
  502.     End Select
  503.     Worms(i).Sz = Int(Rnd * 11) + 10
  504.     side = Int(Rnd * 4): lev = Int(Rnd * 10)
  505.     If side = 0 Then
  506.         Worms(i).C1 = _RGB32(255 - 20 * lev + 50, 180 - 15 * lev, 180 - 15 * lev)
  507.     ElseIf side = 1 Then
  508.         Worms(i).C1 = _RGB32(255 - 20 * lev, 180 - 15 * lev + 50, 180 - 15 * lev)
  509.     ElseIf side = 2 Then
  510.         Worms(i).C1 = _RGB32(255 - 20 * lev, 180 - 15 * lev, 180 - 15 * lev + 20)
  511.     ElseIf side = 3 Then
  512.         Worms(i).C1 = _RGB32(255 - 20 * lev, 180 - 15 * lev, 180 - 15 * lev)
  513.     End If
  515.  
  516. Sub newSpinner (i As Integer) 'set Spinners dimensions start angles, color?
  517.     Dim r As Integer
  518.     S(i).Sz = Rnd * .2 + .4
  519.     If Rnd < .5 Then r = -1 Else r = 1
  520.     S(i).DX = (S(i).Sz * Rnd * 2 + 2) * r * 1.25: S(i).DY = (S(i).Sz * Rnd * 2 + 2) * r * 1.25
  521.     r = Int(Rnd * 4)
  522.     Select Case r
  523.         Case 0: S(i).X = Rnd * (Xmax - 120) + 60: S(i).Y = 0: If S(i).DY < 0 Then S(i).DY = -S(i).DY
  524.         Case 1: S(i).X = Rnd * (Xmax - 120) + 60: S(i).Y = Ymax: If S(i).DY > 0 Then S(i).DY = -S(i).DY
  525.         Case 2: S(i).X = 0: S(i).Y = Rnd * (Ymax - 120) + 60: If S(i).DX < 0 Then S(i).DX = -S(i).DX
  526.         Case 3: S(i).X = Xmax: S(i).Y = Rnd * (Ymax - 120) + 60: If S(i).DX > 0 Then S(i).DX = -S(i).DX
  527.     End Select
  528.     r = Rnd * 90 + 30
  529.     S(i).C1 = _RGB32(r, Rnd * .5 * r, Rnd * .25 * r) 'red ghost spiders???
  531.  
  532. Sub drawSpinner (x As Integer, y As Integer, scale As Single, heading As Single, c As _Unsigned Long)
  533.     Dim x1, x2, x3, x4, y1, y2, y3, y4, r, a, a1, a2, lg, d, rd
  534.     Dim rred, bblue, ggreen
  535.     Static switch As Integer
  536.     switch = switch + 2
  537.     switch = switch Mod 16 + 1
  538.     rred = _Red32(c): ggreen = _Green32(c): bblue = _Blue32(c)
  539.     r = 10 * scale
  540.     x1 = x + r * Cos(heading): y1 = y + r * Sin(heading)
  541.     r = 2 * r 'lg lengths
  542.     For lg = 1 To 8
  543.         If lg < 5 Then
  544.             a = heading + .9 * lg * _Pi(1 / 5) + (lg = switch) * _Pi(1 / 10)
  545.         Else
  546.             a = heading - .9 * (lg - 4) * _Pi(1 / 5) - (lg = switch) * _Pi(1 / 10)
  547.         End If
  548.         x2 = x1 + r * Cos(a): y2 = y1 + r * Sin(a)
  549.         drawLink x1, y1, 3 * scale, x2, y2, 2 * scale, _RGB32(rred + 20, ggreen + 10, bblue + 5)
  550.         If lg = 1 Or lg = 2 Or lg = 7 Or lg = 8 Then d = -1 Else d = 1
  551.         a1 = a + d * _Pi(1 / 12)
  552.         x3 = x2 + r * 1.5 * Cos(a1): y3 = y2 + r * 1.5 * Sin(a1)
  553.         drawLink x2, y2, 2 * scale, x3, y3, scale, _RGB32(rred + 35, ggreen + 17, bblue + 8)
  554.         rd = Int(Rnd * 8) + 1
  555.         a2 = a1 + d * _Pi(1 / 8) * rd / 8
  556.         x4 = x3 + r * 1.5 * Cos(a2): y4 = y3 + r * 1.5 * Sin(a2)
  557.         drawLink x3, y3, scale, x4, y4, scale, _RGB32(rred + 50, ggreen + 25, bblue + 12)
  558.     Next
  559.     r = r * .5
  560.     Fcirc x1, y1, r, _RGB32(rred - 20, ggreen - 10, bblue - 5)
  561.     x2 = x1 + (r + 1) * Cos(heading - _Pi(1 / 12)): y2 = y1 + (r + 1) * Sin(heading - _Pi(1 / 12))
  562.     Fcirc x2, y2, r * .2, &HFF000000
  563.     x2 = x1 + (r + 1) * Cos(heading + _Pi(1 / 12)): y2 = y1 + (r + 1) * Sin(heading + _Pi(1 / 12))
  564.     Fcirc x2, y2, r * .2, &HFF000000
  565.     r = r * 2
  566.     x1 = x + r * .9 * Cos(heading + _Pi): y1 = y + r * .9 * Sin(heading + _Pi)
  567.     TiltedEllipseFill 0, x1, y1, r, .7 * r, heading + _Pi, _RGB32(rred, ggreen, bblue)
  569.  
  570. Sub drawLink (x1, y1, r1, x2, y2, r2, c As _Unsigned Long)
  571.     Dim a, a1, a2, x3, x4, x5, x6, y3, y4, y5, y6
  572.     a = _Atan2(y2 - y1, x2 - x1)
  573.     a1 = a + _Pi(1 / 2)
  574.     a2 = a - _Pi(1 / 2)
  575.     x3 = x1 + r1 * Cos(a1): y3 = y1 + r1 * Sin(a1)
  576.     x4 = x1 + r1 * Cos(a2): y4 = y1 + r1 * Sin(a2)
  577.     x5 = x2 + r2 * Cos(a1): y5 = y2 + r2 * Sin(a1)
  578.     x6 = x2 + r2 * Cos(a2): y6 = y2 + r2 * Sin(a2)
  579.     fquad x3, y3, x4, y4, x5, y5, x6, y6, c
  580.     Fcirc x1, y1, r1, c
  581.     Fcirc x2, y2, r2, c
  583.  
  584. 'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
  585. Sub fquad (x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, x3 As Integer, y3 As Integer, x4 As Integer, y4 As Integer, c As _Unsigned Long)
  586.     ftri x1, y1, x2, y2, x4, y4, c
  587.     ftri x3, y3, x4, y4, x1, y1, c
  589.  
  590. Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
  591.     Dim a&
  592.     a& = _NewImage(1, 1, 32)
  593.     _Dest a&
  594.     PSet (0, 0), K
  595.     _Dest 0
  596.     _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
  597.     _FreeImage a& '<<< this is important!
  599.  
  600. Sub TiltedEllipseFill (destHandle&, x0, y0, a, b, ang, c As _Unsigned Long)
  601.     Dim max As Integer, mx2 As Integer, i As Integer, j As Integer, k As Single, lasti As Single, lastj As Single
  602.     Dim prc As _Unsigned Long, tef As Long
  603.     prc = _RGB32(255, 255, 255, 255)
  604.     If a > b Then max = a + 1 Else max = b + 1
  605.     mx2 = max + max
  606.     tef = _NewImage(mx2, mx2)
  607.     _Dest tef
  608.     _Source tef 'point wont read without this!
  609.     For k = 0 To 6.2832 + .05 Step .1
  610.         i = max + a * Cos(k) * Cos(ang) + b * Sin(k) * Sin(ang)
  611.         j = max + a * Cos(k) * Sin(ang) - b * Sin(k) * Cos(ang)
  612.         If k <> 0 Then
  613.             Line (lasti, lastj)-(i, j), prc
  614.         Else
  615.             PSet (i, j), prc
  616.         End If
  617.         lasti = i: lastj = j
  618.     Next
  619.     Dim xleft(mx2) As Integer, xright(mx2) As Integer, x As Integer, y As Integer
  620.     For y = 0 To mx2
  621.         x = 0
  622.         While Point(x, y) <> prc And x < mx2
  623.             x = x + 1
  624.         Wend
  625.         xleft(y) = x
  626.         While Point(x, y) = prc And x < mx2
  627.             x = x + 1
  628.         Wend
  629.         While Point(x, y) <> prc And x < mx2
  630.             x = x + 1
  631.         Wend
  632.         If x = mx2 Then xright(y) = xleft(y) Else xright(y) = x
  633.     Next
  634.     _Dest destHandle&
  635.     For y = 0 To mx2
  636.         If xleft(y) <> mx2 Then Line (xleft(y) + x0 - max, y + y0 - max)-(xright(y) + x0 - max, y + y0 - max), c, BF
  637.     Next
  638.     _FreeImage tef
  640.  
  641. Sub Fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
  642.     Dim Radius As Long, RadiusError As Long
  643.     Dim X As Long, Y As Long
  644.     Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
  645.     If Radius = 0 Then PSet (CX, CY), C: Exit Sub
  646.     Line (CX - X, CY)-(CX + X, CY), C, BF
  647.     While X > Y
  648.         RadiusError = RadiusError + Y * 2 + 1
  649.         If RadiusError >= 0 Then
  650.             If X <> Y + 1 Then
  651.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  652.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  653.             End If
  654.             X = X - 1
  655.             RadiusError = RadiusError - X * 2
  656.         End If
  657.         Y = Y + 1
  658.         Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  659.         Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  660.     Wend
  662.  
  663. Sub DrawBall (x, y, r, c As _Unsigned Long)
  664.     Dim rred As Long, grn As Long, blu As Long, rr As Long, f
  665.     rred = _Red32(c): grn = _Green32(c): blu = _Blue32(c)
  666.     For rr = r To 0 Step -1
  667.         f = 1.25 - rr / r
  668.         Fcirc x, y, rr, _RGB32(rred * f, grn * f, blu * f)
  669.     Next
  671.  
Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: johnno56 on October 09, 2021, 12:59:28 am
Break suggested? Advice taken. Let me know if you need anything else?
Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: bplus on October 09, 2021, 08:20:26 am
Quote from: johnno56 on October 09, 2021, 12:59:28 am
Break suggested? Advice taken. Let me know if you need anything else?

Creepy Crypt Sound effects? (I like Pete's thunderstorm stuff, TheBob's pumpkin is great too but I have my own pumpkin I want to use.)

Oh hey, I need a ghost writer to get better jokes than what's in the Data section ;-))

Oh wait... we could do those (jokes other than ones in puzzle) in sound (oh maybe those jokes too that would be a nice trick or treat read the answer amongst the many told verbally while user is trying to concentrate on puzzle).
 
@johnno56 I prefer your sound files that are cross platform than using Windows only speech synthesis.

Maybe jokes not needed, just some haunting torment for the user while he attempts to decode a dead joke, moo ha ha. Make the user think he's died and gone to bad joke hell, AKA Pete's heaven.
Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: johnno56 on October 09, 2021, 09:02:19 am
Regardless of whether the synthesis is Windows-based or not, how can the 'results' be classified as 'non cross platform'? I can output the audio format to many types. I use 'ogg' because the compression is higher than 'wav' and 'mp3'...  I am confused... (not even a chuckle... lol)
Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: bplus on October 09, 2021, 09:05:24 am
Windows speech synthesis, I think, can only be used in... wait for it.

Windows!

I mean it seems logical to me.
Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: bplus on October 09, 2021, 09:07:43 am
@johnno56 if you give me sound stuff that works for you, and I test it and it works for me too, then I know 2 OS's at least that they will work. 2 is good enough for me to say cross platform.
Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: bplus on October 10, 2021, 02:37:47 am
Well I try again, here is version 2021-10-10 of Crypto-O-Gram with 3 background sound and graphics effects. Had a last minute change of music files because the one I had was too big for forum post.
Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: bplus on October 11, 2021, 11:41:41 am
Ha! my bad timing to post above with all this new stuff with QB64 happening ;(

Then mpgcan stuff, wow!

Well I thought pretty good graphics and sound added, b+ at least, Moo ha ha.
Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: bplus on October 11, 2021, 12:18:10 pm
Some screen shots from what may be my last Graphics version for Halloween Challenge (I think I have some ideas for Screen 0 extra credit version).

Title: Re: Crypt-O-Gram Puzzle - Halloween Challenge
Post by: bplus on October 11, 2021, 12:37:47 pm
PS everything in this Crypt-0-gram Puzzle program is working fine in QB64 v2.0.

I did have to update all my Handy Functions that used the Function Name to build$ the string I was going to return with the Function call ;-(  actually wasn't hard to fix. Ironically the first program I tested QB64 v2.0 was Text Fetch and that was hard to figure out what was going on because the program was complex and I of course didn't remember what variable did what! Had me stumped for awhile but after figuring that I needed a build$ variable instead of Function name, all went sooth! This was before I watched Fellippe's video on $Debug but I don't think that would have helped with Function$ fixes.
Text Only | Text with Attachments