### Author Topic: Crypt-O-Gram Puzzle - Halloween Challenge  (Read 1333 times)

0 Members and 1 Guest are viewing this topic.

This topic contains a post which is marked as Best Answer. Press here if you would like to see it.

#### bplus

• Forum Resident
• Posts: 7449
• b = b + ...
##### Crypt-O-Gram Puzzle - Halloween Challenge
« 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]
`_Title "Binary Select test demo" 'b+ 2021-10-03  Aha!Do    test\$ = bChoice\$(10, 5, "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234")    Cls    Print "bChoice\$ returned > "; test\$    Do        Print: Print "Do you want to try another?"        test\$ = ""        test\$ = bChoice\$(CsrLin, 1, "YNM")    Loop Until Len(test\$)    ClsLoop Until test\$ <> "Y"Function bChoice\$ (row, col, select\$) ' this is a wrapper function for confirming the BinarySelect\$ choice since so easy to mess up    'this function needs 3 lines from screen, starting at row parameter.    'the first line, at row, is dedicated to the BinarySelect\$ function    'the next 2 lines confirm the select    ' All this makes it possible to continuous poll for a selection, if the user is away from computer for awhile    ' no problem because he wont be there to confirm the choice and so no progress is made in program using BinarySelect\$    'clear 3 dedicated lines    copySelect\$ = select\$    For i = 0 To 2 ' clear lines        Locate row + i, col: Print Space\$(_Width - col + 1);    Next    c\$ = BinarySelect\$(row, col, copySelect\$) ' the last choice is like a cancel    'Locate 20, 10: Print "debug print c\$: "; c\$;    Locate row + 1, col: Print "Confirming your choice > " + c\$;    check\$ = BinarySelect\$(row + 2, col, "YN")    If check\$ = "Y" Then bChoice\$ = c\$    Print "bChoice\$ = "; c\$End FunctionFunction BinarySelect\$ (row, col, select\$) ' this is recursive part of Binary Select Algo    ls = Len(select\$)    If ls = 0 Then Beep: Exit Function ' no choices    If ls = 1 Then BinarySelect\$ = select\$: Exit Function ' only one choice    hls = Int(ls / 2)    s1\$ = Mid\$(select\$, 1, hls): s2\$ = Mid\$(select\$, hls + 1)    Locate row, col: Print Space\$(_Width - col + 1);    Locate row, col: Print "Press key if you see your choice > " + s1\$;    t = Timer(.001)    _KeyClear    k\$ = InKey\$    While Len(k\$) = 0 And Timer(.001) - t < 3 + .25 * Len(s1\$)        k\$ = InKey\$        _Limit 60    Wend    If Len(k\$) Then        If Len(s1\$) = 1 Then BinarySelect\$ = s1\$ Else BinarySelect\$ = BinarySelect\$(row, col, s1\$)    Else        BinarySelect\$ = BinarySelect\$(row, col, s2\$)    End IfEnd Function`
It's still something that needs a little practice with but it is much easier to use than my first idea.

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

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

#### bplus

• Forum Resident
• Posts: 7449
• b = b + ...
##### Re: Crypt-O-Gram Puzzle - Halloween Challenge
« Reply #1 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]
`_Title "Halloween Challenge: Crypt-O-Gram Puzzle" ' b+  started One Key Challenge 2021-09-25' from One Key Challenge - Cryptogram Puzzle   2021-10-02' 2021-09-07 Jokes are intended for QB64 home programming entertainment use only.' Thank you CountryLiving 1-33' https://www.countryliving.com/entertaining/a32963261/halloween-jokes/' Thank you GoodHousekeeping 34-72' https://www.goodhousekeeping.com/holidays/halloween-ideas/a32998753/halloween-jokes/' 2021-10-03 install new set of jokes and new Binary Select Input Algorithm' Redo Mode system to fix differences of input methods.' Recolor green background has me seeing Red!Randomize Timer: Width 120, 30Dim Shared Answer\$ '  beginning phrase to be guessed    '   3 stages of the PuzzleDim Shared Coded\$ '   hidden in codeDim Shared Working\$ ' decoded and solved when working\$ becomes = ucase\$(answer\$)Dim Shared Letters\$(1 To 26) ' for coding and highlited lettersDim Shared LCodes\$(1 To 26) '  for code and decode by number 1 to 26Dim Shared Guesses\$(1 To 26) ' track all the guess to decodeDim Shared HighLited ' cursor over letters to guessDim Shared Mode_FullScreen 'I guess it does make it easier to tell E from F...Dim jokes\$(1 To 100)For i = 1 To 100    Read r\$    If r\$ <> "EOD" Then jokes\$(i) = r\$: jCount = jCount + 1 Else Exit ForNextrestart:Answer\$ = jokes\$(Int(Rnd * jCount) + 1)For i = 1 To 26: Guesses\$(i) = "-": Next 'setup the display guesses arrayFor i = 1 To 26 ' use letters for display of letters to pick second and to create a code    Letters\$(i) = Chr\$(i + 64)    LCodes\$(i) = Letters\$(i) ' these will convert between each other by index numberNextFor i = 26 To 2 Step -1 ' shuffle the letters in LCode\$()    Swap LCodes\$(i), LCodes\$(Int(Rnd * i) + 1)NextCoded\$ = "": Working\$ = "" ' reset for next go aroundFor i = 1 To Len(Answer\$) 'third: put the phrase in coded\$ and hide it in working\$    a = Asc(UCase\$(Answer\$), i)    If a >= 65 And a <= 90 Then        Coded\$ = Coded\$ + LCodes\$(a - 64)        Working\$ = Working\$ + "*"    Else        Coded\$ = Coded\$ + Mid\$(Answer\$, i, 1)        Working\$ = Working\$ + Mid\$(Answer\$, i, 1)    End IfNextHighLited = 1 'setup done start gameMode = 0Do    DisplayScreen    k\$ = bChoice\$(23, 33, "1234ABCDEFGHIJKLMNOPQRSTUVWXYZ")    If k\$ <> "" Then        If Mode = 0 Then ' highlight a letter            'm replaces arrows and mouse select of highlited 1 to 26 for letters            test = InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", k\$)            If test > 0 Then                HighLited = test                Mode = 1            Else                test = InStr("1234", k\$)                If test > 0 Then                    Select Case test                        Case 1: GoSub do1                        Case 2: GoSub do2                        Case 3: GoSub do3                        Case 4: GoSub do4                    End Select                Else                    Mode = 0                End If            End If        Else            Select Case k\$                Case "1": GoSub do1                Case "2": GoSub do2                Case "3": GoSub do3                Case "4": GoSub do4                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"                    Guesses\$(HighLited) = k\$ ' for screen updates                    For i = 1 To Len(Working\$)                        If Letters\$(HighLited) = Mid\$(Coded\$, i, 1) Then Mid\$(Working\$, i, 1) = k\$                    Next                    Mode = 0            End Select        End If    End If    _Limit 60Loop Until Working\$ = UCase\$(Answer\$)DisplayScreenColor 9, 8cp 17, "You got it!    5 secs to next puzzle..."_Delay 5: ClsGoTo restartdo1: ' display answerWorking\$ = UCase\$(Answer\$) ' show the answer\$ guesses correct moves to next puzzleDisplayScreenMode = 0Returndo2: ' get decode letter for highlighted LetterFor i = 1 To 26    If LCodes\$(i) = Letters\$(HighLited) Then c\$ = Chr\$(i + 64): Exit ForNextGuesses\$(HighLited) = c\$ ' for screen updatesFor i = 1 To Len(Working\$)    If Letters\$(HighLited) = Mid\$(Coded\$, i, 1) Then Mid\$(Working\$, i, 1) = c\$NextMode = 0Returndo3: ' find a uncoded letterColor 15, 8: Locate 24, 40: Print "Select Find Letter"d\$ = bChoice\$(23, 33, "ABCDEFGHIJKLMNOPQRSTUVWXYZ")If d\$ <> "" Then    c\$ = LCodes\$(Asc(d\$) - 64)    Guesses\$(Asc(c\$) - 64) = d\$    For i = 1 To Len(Working\$)        If c\$ = Mid\$(Coded\$, i, 1) Then Mid\$(Working\$, i, 1) = d\$    Next    Mode = 0End IfReturndo4: ' clear guess letter from code letterGuesses\$(HighLited) = "-"For i = 1 To Len(Working\$)    If Letters\$(HighLited) = Mid\$(Coded\$, i, 1) Then Mid\$(Working\$, i, 1) = "*" ' clear the letterNextMode = 0Return'one linersData "Why do ghosts go on diets? So they can keep their ghoulish figures"Data "Where does a ghost go on vacation? Mali-boo."Data "Why did the ghost go into the bar? For the Boos."Data "What is in a ghost's nose? Boo-gers."Data "Why did the policeman ticket the ghost on Halloween? It didn't have a haunting license."Data "Why do demons and ghouls hang out together? Because demons are a ghoul's best friend!"Data "Why did the ghost starch his sheet? He wanted everyone scared stiff."Data "What does a panda ghost eat? Bam-BOO!"Data "What's a ghost's favorite dessert? I-Scream!"Data "Where do ghosts buy their food? At the ghost-ery store!"Data "How do you know when a ghost is sad? He starts boo hooing."Data "Why don't mummies take time off? They're afraid to unwind."Data "Why did the headless horseman go into business? He wanted to get ahead in life."Data "What kind of music do mummies like listening to on Halloween? Wrap music."Data "Why don't mummies have friends? Because they're too wrapped up in themselves."Data "Why did the vampire read the newspaper? He heard it had great circulation."Data "How do vampires get around on Halloween? On blood vessels."Data "What's it like to be kissed by a vampire? It's a pain in the neck."Data "What's it called when a vampire has trouble with his house? A grave problem."Data "How can you tell when a vampire has been in a bakery? All the jelly has been sucked out of the jelly doughnuts."Data "What do you get when you cross a vampire and a snowman? Frostbite."Data "Why do skeletons have low self-esteem? They have no body to love."Data "Know why skeletons are so calm? Because nothing gets under their skin."Data "What do you call a cleaning skeleton? The grim sweeper."Data "What do skeletons order at a restaurant? Spare ribs."Data "What do you call a witch's garage? A broom closet."Data "What kind of food would you find on a haunted beach? A sand-witch!"Data "What was the witch's favorite subject in school? Spelling."Data "What do you call two witches who live together? Broom-mates!"Data "What's a witch's favorite makeup? Ma-scare-a."Data "Who helps the little pumpkins cross the road safely? The crossing gourd."Data "What treat do eye doctors give out on Halloween? Candy corneas."Data "What type of plants do well on all Hallow's Eve? Bam-BOO!"Data "What do birds say on Halloween? Trick or tweet!"Data "Why don't skeletons ever go trick or treating? Because they have no-body to go with."Data "Where do ghosts buy their Halloween candy? At the ghost-ery store!"Data "What do owls say when they go trick or treating? 'Happy Owl-ween!'"Data "What do ghosts give out to trick or treaters? Booberries!"Data "Who did Frankenstein go trick or treating with? His ghoul friend."Data "What Halloween candy is never on time for the party? Choco-LATE!"Data "What do witches put on to go trick or treating? Mas-scare-a."Data "What does Bigfoot say when he asks for candy?  'Trick-or-feet!'"Data "Which type of pants do ghosts wear to trick or treat? Boo jeans."Data "What makes trick or treating with twin witches so challenging? You never know which witch is which!"Data "What happens when a vampire goes in the snow? Frost bite!"Data "What do you call two witches living together? Broommates"Data "What position does a ghost play in hockey? Ghoulie."Data "What do mummies listen to on Halloween? Wrap music."Data "How do you make a skeleton laugh? You tickle his funny bone!"Data "Which Halloween monster is good at math? Count Dracula!"Data "Why did the Cyclops give up teaching? He only had one pupil!"Data "Why didn't the skeleton go to see a scary movie? He didn't have the guts."Data "What did the boy ghost say to the girl ghost? 'You sure are boo-tiful!'"Data "Where does Dracula keep his money? In a blood bank."Data "Why are ghosts terrible liars? You can see right through them!"Data "Why don't mummies take vacations? They're afraid to unwind."Data "What is a vampire's favorite holiday, besides Halloween? Fangs-giving!"Data "Where do fashionable ghosts shop? Bootiques!"Data "What's a monster's favorite play? Romeo and Ghouliet!"Data "What room does a ghost not need? A living room."Data "What monster plays tricks on Halloween? Prank-enstein!"Data "What's a ghost's favorite dessert? I scream."Data "What does the skeleton chef say when he serves you a meal? 'Bone Appetit!'"Data "What is a vampire's favorite fruit? A neck-tarine!"Data "What do witches put on their bagels? Scream cheese."Data "What do ghosts eat for dinner? Spook-ghetti!"Data "What do skeletons order at restaurants? Spare ribs."Data "What does a panda ghost eat? Bam-BOO!"Data "What tops off a mummy's ice cream sundae? Whipped scream."Data "What's a ghost's favorite yogurt flavor? Boo-berry!"Data "What's a vampire's least favorite meal? A steak!"Data "Why was the candy corn booed off the stage? All of his jokes were too corny!"Data "EOD"Sub DisplayScreen    Color 9, 8: Cls    cp 2, "*** Halloween Challenge - Cryptogram Puzzle ***"    Color 6    cp 4, "Solve puzzle by selecting a Code letter then selecting a Guess letter for it."    cp 5, "All selections are made by pressing spacebar when you see your letter or digit."    cp 6, "You will need to verify your selection by pressing spacebar again when see Y for Yes."    cp 7, "Use the escape key to quit immediately (an X box in top right is not accessible)."    cp 9, "To get the answer and move onto next puzzle, select 1."    cp 10, "To decode current highlighted letter, select 2."    cp 11, "To solve a letter, select 3 and then select letter to find."    cp 12, "To clear a guess at highlighted Code letter, select 4."    Color 14    Locate 15, (120 - Len(Answer\$)) / 2: Print Coded\$    Color 15    Locate 16, (120 - Len(Answer\$)) / 2    For i = 1 To Len(Answer\$)        w\$ = Mid\$(Working\$, i, 1): c\$ = Mid\$(Coded\$, i, 1)        a\$ = Mid\$(Answer\$, i, 1): h\$ = Letters\$(HighLited)        If w\$ = "*" Then            pc\$ = "*": If h\$ = c\$ Then Color 15, 9 Else Color 15, 8        Else            Color 15, 8: If w\$ = UCase\$(a\$) Then pc\$ = a\$ Else pc\$ = w\$        End If        Print pc\$;    Next    spaces = 9    For i = 1 To 26 'blue background highlighter        If i = HighLited Then Color 14, 9 Else Color 14, 8        Locate 19, spaces: Print Letters\$(i)        If i = HighLited Then Color 14, 9 Else Color 15, 8        Locate 20, spaces: Print Guesses\$(i)        spaces = spaces + 4    Next    If Mode = 1 Then        Color 15, 8        cp 22, "Guess Solve Letter or Menu #"    Else        Color 14, 8        cp 22, "Select Code Letter or Menu #"    End IfEnd SubSub cp (row, text\$) ' center text on text screen    Locate row, (_Width - Len(text\$)) / 2: Print text\$End SubFunction bChoice\$ (row, col, select\$) ' this is a wrapper function for confirming the BinarySelect\$ choice since so easy to mess up    ' This will return "" if user never confirms a choice, otherwise some letter in Select\$ is returned.    ' 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    ' The first line, at row, is dedicated to the BinarySelect\$ function    ' the next 2 lines confirm the select using another YN for Yes No Bianary Select.    ' All this makes it possible to continuous poll for a selection, if the user is away from computer for awhile    ' no problem because he wont be there to confirm the choice and so no progress is made in program using BinarySelect\$.    'clear 3 dedicated lines for Row, Col to end of line    copySelect\$ = select\$    For i = 0 To 2 ' clear lines        Locate row + i, col: Print Space\$(_Width - col + 1);    Next    c\$ = BinarySelect\$(row, col, copySelect\$) ' the last choice is like a cancel    Locate row + 1, col: Print "Confirming your choice > " + c\$;    check\$ = BinarySelect\$(row + 2, col, "YN")    If check\$ = "Y" Then bChoice\$ = c\$End FunctionFunction BinarySelect\$ (row, col, select\$) ' this is recursive part of Binary Select Algo    ls = Len(select\$)    If ls = 0 Then Beep: Exit Function ' no choices    If ls = 1 Then BinarySelect\$ = select\$: Exit Function ' only one choice    hls = Int(ls / 2)    s1\$ = Mid\$(select\$, 1, hls): s2\$ = Mid\$(select\$, hls + 1)    Locate row, col: Print Space\$(_Width - col + 1);    Locate row, col: Print "Press spacebar if you see your choice > " + s1\$;    t = Timer(.001)    _KeyClear    k\$ = InKey\$    While k\$ <> " " And Timer(.001) - t < 3 + .25 * Len(s1\$) 'modified for just spacebar        If _KeyDown(27) Then System ' quit        k\$ = InKey\$        _Limit 60    Wend    If Len(k\$) Then        If Len(s1\$) = 1 Then BinarySelect\$ = s1\$ Else BinarySelect\$ = BinarySelect\$(row, col, s1\$)    Else        BinarySelect\$ = BinarySelect\$(row, col, s2\$)    End IfEnd Function`
Some hints for playing:
* These are all one liner Halloween jokes, so most start with W for What, When, Where, Why sometimes H for How.

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

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

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

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

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

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

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

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

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

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

#### bplus

• Forum Resident
• Posts: 7449
• b = b + ...
##### Re: Crypt-O-Gram Puzzle - Halloween Challenge
« Reply #2 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]
`_Title "Halloween Challenge: Crypt-O-Gram Puzzle" ' b+  started One Key Challenge 2021-09-25' from One Key Challenge - Cryptogram Puzzle   2021-10-02' 2021-09-07 Jokes are intended for QB64 home programming entertainment use only.' Thank you CountryLiving 1-33' https://www.countryliving.com/entertaining/a32963261/halloween-jokes/' Thank you GoodHousekeeping 34-72' https://www.goodhousekeeping.com/holidays/halloween-ideas/a32998753/halloween-jokes/' 2021-10-03 install new set of jokes and new Binary Select Input Algorithm' Redo Mode system to fix differences of input methods.' Recolor green background has me seeing Red!' 2021-10-04 Steve McNeill came up with an easier to understand and use input system.' Installing new Function and updating Game. Steve also told me how to change color palette,' now we have some real Orange! for #12 meant for high red.Randomize Timer: Width 120, 30_PaletteColor 12, _RGB32(255, 128, 0) ' OrangeDim Shared Answer\$ '  beginning phrase to be guessed    '   3 stages of the PuzzleDim Shared Coded\$ '   hidden in codeDim Shared Working\$ ' decoded and solved when working\$ becomes = ucase\$(answer\$)Dim Shared Letters\$(1 To 26) ' for coding and highlited lettersDim Shared LCodes\$(1 To 26) '  for code and decode by number 1 to 26Dim Shared Guesses\$(1 To 26) ' track all the guess to decodeDim Shared HighLited ' cursor over letters to guessDim Shared Mode_FullScreen 'I guess it does make it easier to tell E from F...Dim jokes\$(1 To 100)For i = 1 To 100    Read r\$    If r\$ <> "EOD" Then jokes\$(i) = r\$: jCount = jCount + 1 Else Exit ForNextrestart:Answer\$ = jokes\$(Int(Rnd * jCount) + 1)For i = 1 To 26: Guesses\$(i) = "-": Next 'setup the display guesses arrayFor i = 1 To 26 ' use letters for display of letters to pick second and to create a code    Letters\$(i) = Chr\$(i + 64)    LCodes\$(i) = Letters\$(i) ' these will convert between each other by index numberNextFor i = 26 To 2 Step -1 ' shuffle the letters in LCode\$()    Swap LCodes\$(i), LCodes\$(Int(Rnd * i) + 1)NextCoded\$ = "": Working\$ = "" ' reset for next go aroundFor i = 1 To Len(Answer\$) 'third: put the phrase in coded\$ and hide it in working\$    a = Asc(UCase\$(Answer\$), i)    If a >= 65 And a <= 90 Then        Coded\$ = Coded\$ + LCodes\$(a - 64)        Working\$ = Working\$ + "*"    Else        Coded\$ = Coded\$ + Mid\$(Answer\$, i, 1)        Working\$ = Working\$ + Mid\$(Answer\$, i, 1)    End IfNextHighLited = 1 'setup done start gameMode = 0Do    DisplayScreen    k\$ = choice\$(25, 44, " 1234ABCDEFGHIJKLMNOPQRSTUVWXYZ")    If k\$ <> " " Then        If Mode = 0 Then ' highlight a letter            'm replaces arrows and mouse select of highlited 1 to 26 for letters            test = InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", k\$)            If test > 0 Then                HighLited = test                Mode = 1            Else                test = InStr("1234", k\$)                If test > 0 Then                    Select Case test                        Case 1: GoSub do1                        Case 2: GoSub do2                        Case 3: GoSub do3                        Case 4: GoSub do4                    End Select                Else                    Mode = 0                End If            End If        Else            Select Case k\$                Case "1": GoSub do1                Case "2": GoSub do2                Case "3": GoSub do3                Case "4": GoSub do4                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"                    Guesses\$(HighLited) = k\$ ' for screen updates                    For i = 1 To Len(Working\$)                        If Letters\$(HighLited) = Mid\$(Coded\$, i, 1) Then Mid\$(Working\$, i, 1) = k\$                    Next                    Mode = 0            End Select        End If    End If    _Limit 60Loop Until Working\$ = UCase\$(Answer\$)DisplayScreenColor 12, 8cp 19, "You got it!    5 secs to next puzzle..."_Delay 5: ClsGoTo restartdo1: ' display answerWorking\$ = UCase\$(Answer\$) ' show the answer\$ guesses correct moves to next puzzleDisplayScreenMode = 0Returndo2: ' get decode letter for highlighted LetterFor i = 1 To 26    If LCodes\$(i) = Letters\$(HighLited) Then c\$ = Chr\$(i + 64): Exit ForNextGuesses\$(HighLited) = c\$ ' for screen updatesFor i = 1 To Len(Working\$)    If Letters\$(HighLited) = Mid\$(Coded\$, i, 1) Then Mid\$(Working\$, i, 1) = c\$NextMode = 0Returndo3: ' find a uncoded letterColor 15, 8: cp 24, "Select Letter to Find"Locate 25, 1: Print Space\$(_Width) ' clear out old lined\$ = choice\$(25, 46, " ABCDEFGHIJKLMNOPQRSTUVWXYZ")If d\$ <> " " Then    c\$ = LCodes\$(Asc(d\$) - 64)    Guesses\$(Asc(c\$) - 64) = d\$    For i = 1 To Len(Working\$)        If c\$ = Mid\$(Coded\$, i, 1) Then Mid\$(Working\$, i, 1) = d\$    Next    Mode = 0End IfReturndo4: ' clear guess letter from code letterGuesses\$(HighLited) = "-"For i = 1 To Len(Working\$)    If Letters\$(HighLited) = Mid\$(Coded\$, i, 1) Then Mid\$(Working\$, i, 1) = "*" ' clear the letterNextMode = 0Return'one linersData "Why do ghosts go on diets? So they can keep their ghoulish figures"Data "Where does a ghost go on vacation? Mali-boo."Data "Why did the ghost go into the bar? For the Boos."Data "What is in a ghost's nose? Boo-gers."Data "Why did the policeman ticket the ghost on Halloween? It didn't have a haunting license."Data "Why do demons and ghouls hang out together? Because demons are a ghoul's best friend!"Data "Why did the ghost starch his sheet? He wanted everyone scared stiff."Data "What does a panda ghost eat? Bam-BOO!"Data "What's a ghost's favorite dessert? I-Scream!"Data "Where do ghosts buy their food? At the ghost-ery store!"Data "How do you know when a ghost is sad? He starts boo hooing."Data "Why don't mummies take time off? They're afraid to unwind."Data "Why did the headless horseman go into business? He wanted to get ahead in life."Data "What kind of music do mummies like listening to on Halloween? Wrap music."Data "Why don't mummies have friends? Because they're too wrapped up in themselves."Data "Why did the vampire read the newspaper? He heard it had great circulation."Data "How do vampires get around on Halloween? On blood vessels."Data "What's it like to be kissed by a vampire? It's a pain in the neck."Data "What's it called when a vampire has trouble with his house? A grave problem."Data "How can you tell when a vampire has been in a bakery? All the jelly has been sucked out of the jelly doughnuts."Data "What do you get when you cross a vampire and a snowman? Frostbite."Data "Why do skeletons have low self-esteem? They have no body to love."Data "Know why skeletons are so calm? Because nothing gets under their skin."Data "What do you call a cleaning skeleton? The grim sweeper."Data "What do skeletons order at a restaurant? Spare ribs."Data "What do you call a witch's garage? A broom closet."Data "What kind of food would you find on a haunted beach? A sand-witch!"Data "What was the witch's favorite subject in school? Spelling."Data "What do you call two witches who live together? Broom-mates!"Data "What's a witch's favorite makeup? Ma-scare-a."Data "Who helps the little pumpkins cross the road safely? The crossing gourd."Data "What treat do eye doctors give out on Halloween? Candy corneas."Data "What type of plants do well on all Hallow's Eve? Bam-BOO!"Data "What do birds say on Halloween? Trick or tweet!"Data "Why don't skeletons ever go trick or treating? Because they have no-body to go with."Data "Where do ghosts buy their Halloween candy? At the ghost-ery store!"Data "What do owls say when they go trick or treating? 'Happy Owl-ween!'"Data "What do ghosts give out to trick or treaters? Booberries!"Data "Who did Frankenstein go trick or treating with? His ghoul friend."Data "What Halloween candy is never on time for the party? Choco-LATE!"Data "What do witches put on to go trick or treating? Mas-scare-a."Data "What does Bigfoot say when he asks for candy?  'Trick-or-feet!'"Data "Which type of pants do ghosts wear to trick or treat? Boo jeans."Data "What makes trick or treating with twin witches so challenging? You never know which witch is which!"Data "What happens when a vampire goes in the snow? Frost bite!"Data "What do you call two witches living together? Broommates"Data "What position does a ghost play in hockey? Ghoulie."Data "What do mummies listen to on Halloween? Wrap music."Data "How do you make a skeleton laugh? You tickle his funny bone!"Data "Which Halloween monster is good at math? Count Dracula!"Data "Why did the Cyclops give up teaching? He only had one pupil!"Data "Why didn't the skeleton go to see a scary movie? He didn't have the guts."Data "What did the boy ghost say to the girl ghost? 'You sure are boo-tiful!'"Data "Where does Dracula keep his money? In a blood bank."Data "Why are ghosts terrible liars? You can see right through them!"Data "Why don't mummies take vacations? They're afraid to unwind."Data "What is a vampire's favorite holiday, besides Halloween? Fangs-giving!"Data "Where do fashionable ghosts shop? Bootiques!"Data "What's a monster's favorite play? Romeo and Ghouliet!"Data "What room does a ghost not need? A living room."Data "What monster plays tricks on Halloween? Prank-enstein!"Data "What's a ghost's favorite dessert? I scream."Data "What does the skeleton chef say when he serves you a meal? 'Bone Appetit!'"Data "What is a vampire's favorite fruit? A neck-tarine!"Data "What do witches put on their bagels? Scream cheese."Data "What do ghosts eat for dinner? Spook-ghetti!"Data "What do skeletons order at restaurants? Spare ribs."Data "What does a panda ghost eat? Bam-BOO!"Data "What tops off a mummy's ice cream sundae? Whipped scream."Data "What's a ghost's favorite yogurt flavor? Boo-berry!"Data "What's a vampire's least favorite meal? A steak!"Data "Why was the candy corn booed off the stage? All of his jokes were too corny!"Data "EOD"Sub DisplayScreen    Color 12, 8: Cls    cp 4, "*** Halloween Challenge - Cryptogram Puzzle ***"    Color 6    cp 6, "Solve puzzle by selecting a Code letter then selecting a Guess letter for it."    cp 7, "All selections are made by pressing spacebar when you see your letter or digit."    cp 8, "You will need to verify your selection by pressing spacebar again when see Y for Yes."    cp 9, "Use the escape key to quit immediately (an X box in top right is not accessible)."    Color 12    cp 11, "To get the answer and move onto next puzzle, select 1."    cp 12, "To decode current highlighted letter, select 2."    cp 13, "To solve a letter, select 3 and then select letter to find."    cp 14, "To clear a guess at highlighted Code letter, select 4."    Color 14    Locate 17, (120 - Len(Answer\$)) / 2: Print Coded\$    Color 15    Locate 18, (120 - Len(Answer\$)) / 2    For i = 1 To Len(Answer\$)        w\$ = Mid\$(Working\$, i, 1): c\$ = Mid\$(Coded\$, i, 1)        a\$ = Mid\$(Answer\$, i, 1): h\$ = Letters\$(HighLited)        If w\$ = "*" Then            pc\$ = "*": If h\$ = c\$ Then Color 15, 9 Else Color 15, 8        Else            Color 15, 8: If w\$ = UCase\$(a\$) Then pc\$ = a\$ Else pc\$ = w\$        End If        Print pc\$;    Next    spaces = 9    For i = 1 To 26 'blue background highlighter        If i = HighLited Then Color 14, 9 Else Color 14, 8        Locate 21, spaces: Print Letters\$(i)        If i = HighLited Then Color 14, 9 Else Color 15, 8        Locate 22, spaces: Print Guesses\$(i)        spaces = spaces + 4    Next    If Mode = 1 Then        Color 15, 8        cp 24, "Guess Solve Letter or Menu #"    Else        Color 14, 8        cp 24, "Select Code Letter or Menu #"    End IfEnd SubSub cp (row, text\$) ' center text on text screen    Locate row, 1: Print Space\$(_Width) ' clear out old line in case the next is shorter    Locate row, (_Width - Len(text\$)) / 2: Print text\$End SubFunction choice\$ (row, col, selection\$)    fg~& = _DefaultColor: bg~& = _BackgroundColor    saveRow = CsrLin: saveCol = Pos(0): t = Timer    GoSub show    Do        k\$ = InKey\$        If k\$ = Chr\$(27) Then System ' emergency exit        GoSub show:        If k\$ = " " Then            t = Timer: place = (place + 1) Mod Len(selection\$)        Else ' watch out for midnight!            If Timer - t > 4 Then choice\$ = Mid\$(selection\$, place + 1, 1): Locate saveRow, saveCol: Exit Function        End If        _Limit 7 'so can hold down spacebar, nice    Loop    show:    Locate row, col    For i = 1 To Len(selection\$)        If i = place + 1 Then Color bg~&, fg~& Else Color fg~&, bg~&        Locate row, col - 1 + i: Print Mid\$(selection\$, i, 1);    Next    Color fg~&, bg~&    ReturnEnd Function`
It's allot easier to play now! Thanks Steve

#### SMcNeill

• QB64 Developer
• Forum Resident
• Posts: 3662
##### Re: Crypt-O-Gram Puzzle - Halloween Challenge
« Reply #3 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!
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

#### bplus

• Forum Resident
• Posts: 7449
• b = b + ...
##### Re: Crypt-O-Gram Puzzle - Halloween Challenge
« Reply #4 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!

#### bplus

• Forum Resident
• Posts: 7449
• b = b + ...
##### Re: Crypt-O-Gram Puzzle - Halloween Challenge
« Reply #5 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]
`Function choice\$ (row, col, selection\$) ' replace InKey\$ with _KeyDown()    fg~& = _DefaultColor: bg~& = _BackgroundColor    saveRow = CsrLin: saveCol = Pos(0): t = Timer    GoSub show    Do        If _KeyDown(27) Then System ' emergency exit        GoSub show:        If _KeyDown(32) Then            t = Timer: place = (place + 1) Mod Len(selection\$)        Else ' watch out for midnight!            If Timer - t > 4 Then choice\$ = Mid\$(selection\$, place + 1, 1): Locate saveRow, saveCol: Exit Function        End If        _Limit 7 'so can hold down spacebar, nice    Loop    show:    Locate row, col    For i = 1 To Len(selection\$)        If i = place + 1 Then Color bg~&, fg~& Else Color fg~&, bg~&        Locate row, col - 1 + i: Print Mid\$(selection\$, i, 1);    Next    Color fg~&, bg~&    ReturnEnd Function`

#### bplus

• Forum Resident
• Posts: 7449
• b = b + ...
##### Re: Crypt-O-Gram Puzzle - Halloween Challenge
« Reply #6 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]
`Function choice\$ (row, col, selection\$) ' replace InKey\$ with _KeyDown()    fg~& = _DefaultColor: bg~& = _BackgroundColor    saveRow = CsrLin: saveCol = Pos(0): t = Timer    GoSub show    Do        If _KeyDown(27) Then System ' emergency exit        GoSub show:        ' 2021-10-06 fix for polling erratic behavior: misses or jumps, check for spacebar way more often        While Timer - t < 4 ' smooth out the jumpiness sometimes no response, sometimes jumps 2x' on one press????            If _KeyDown(27) Then System ' emergency exit            If _KeyDown(32) Then t = Timer: place = (place + 1) Mod Len(selection\$): Exit While            _Limit 200 '<<<< fine tune the polling for spacebar!!!        Wend        If Timer - t >= 4 Then choice\$ = Mid\$(selection\$, place + 1, 1): Locate saveRow, saveCol: Exit Function        _Limit 5 'so can hold down spacebar, nice    Loop    show:    Locate row, col    For i = 1 To Len(selection\$)        If i = place + 1 Then Color bg~&, fg~& Else Color fg~&, bg~&        Locate row, col - 1 + i: Print Mid\$(selection\$, i, 1);    Next    _Display    Color fg~&, bg~&    ReturnEnd Function`
Much smoother scroll action, way way less over scroll that Inkey\$ would have. I think I have it just right now.

#### johnno56

• Forum Resident
• Posts: 1166
• Live long and prosper.
##### Re: Crypt-O-Gram Puzzle - Halloween Challenge
« Reply #7 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?
Logic is the beginning of wisdom.

#### bplus

• Forum Resident
• Posts: 7449
• b = b + ...
##### Re: Crypt-O-Gram Puzzle - Halloween Challenge
« Reply #8 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...

#### SMcNeill

• QB64 Developer
• Forum Resident
• Posts: 3662
##### Re: Crypt-O-Gram Puzzle - Halloween Challenge
« Reply #9 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
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

#### bplus

• Forum Resident
• Posts: 7449
• b = b + ...
##### Re: Crypt-O-Gram Puzzle - Halloween Challenge
« Reply #10 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!

#### bplus

• Forum Resident
• Posts: 7449
• b = b + ...
##### Re: Crypt-O-Gram Puzzle - Halloween Challenge
« Reply #11 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

#### bplus

• Forum Resident
• Posts: 7449
• b = b + ...
##### Re: Crypt-O-Gram Puzzle - Halloween Challenge
« Reply #12 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]
`_Title "Halloween Challenge: Crypt-O-Gram Puzzle" ' b+  started One Key Challenge 2021-09-25' from One Key Challenge - Cryptogram Puzzle   2021-10-02' 2021-09-07 Jokes are intended for QB64 home programming entertainment use only.' Thank you CountryLiving 1-33' https://www.countryliving.com/entertaining/a32963261/halloween-jokes/' Thank you GoodHousekeeping 34-72' https://www.goodhousekeeping.com/holidays/halloween-ideas/a32998753/halloween-jokes/' 2021-10-03 install new set of jokes and new Binary Select Input Algorithm' Redo Mode system to fix differences of input methods.' Recolor green background has me seeing Red!' 2021-10-04 Steve McNeill came up with an easier to understand and use input system.' Installing new Function and updating Game. Steve also told me how to change color palette,' now we have some real Orange! for #12 meant for high red.' Next version: Follow Steve's advice to use _KeyDown in stead of InKey\$' Improved Choice to reduce no response to keypress or double jumping.' v 2021-10-07 install DrawWorms subroutines and get working.'Fall letters and backgroundConst Orange = &HFFFF8800 ' 12 dConst White = &HFFFFFFFF ' 15 dConst Back = &HFF302010 ' 8 ? dConst Red = &HFFFF2222 ' print under titleConst Yellow = &HFFFFFF00 ' 14 dConst Blue = &HFF0000FF ' 9 light blueConst BB = &HFF33BB33 ' 6 blue brown ?Const Xmax = 120 * 8 ' started with text screen _width 120, 30Const Ymax = 30 * 16'for Graphic effectsConst nWorms = 30'for graphics effectsType Object    X As Single ' usu top left corner   could be center depending on object    Y As Single ' ditto    W As Single ' width   or maybe radius    H As Single ' height    DX As Single ' moving opjects    DY As Single ' ditto    DIR As Single ' short for direction or heading usu a radian angle    Sz As Single ' perhaps a scaling factor    Act As Integer ' lives countdown or just plain ACTive TF    C1 As _Unsigned Long ' a foreground color    C2 As _Unsigned Long ' a background or 2nd color     OR C1 to c2 Range?End TypeScreen _NewImage(Xmax, Ymax, 32)Randomize Timer ': Width 120, 30Dim Shared Answer\$ '  beginning phrase to be guessed    '   3 stages of the PuzzleDim Shared Coded\$ '   hidden in codeDim Shared Working\$ ' decoded and solved when working\$ becomes = ucase\$(answer\$)Dim Shared Letters\$(1 To 26) ' for coding and highlited lettersDim Shared LCodes\$(1 To 26) '  for code and decode by number 1 to 26Dim Shared Guesses\$(1 To 26) ' track all the guess to decodeDim Shared HighLited ' cursor over letters to guessDim Shared Mode' adding graphics effectsDim Shared Worms(1 To nWorms) As ObjectDim Shared WormYard As Object_FullScreen 'I guess it does make it easier to tell E from F...Dim jokes\$(1 To 100) ' load jokes one time from data statements in programFor i = 1 To 100    Read r\$    If r\$ <> "EOD" Then jokes\$(i) = r\$: jCount = jCount + 1 Else Exit ForNextrestart:'setup Puzzle and code itAnswer\$ = jokes\$(Int(Rnd * jCount) + 1)For i = 1 To 26: Guesses\$(i) = "-": Next 'setup the display guesses arrayFor i = 1 To 26 ' use letters for display of letters to pick second and to create a code    Letters\$(i) = Chr\$(i + 64)    LCodes\$(i) = Letters\$(i) ' these will convert between each other by index numberNextFor i = 26 To 2 Step -1 ' shuffle the letters in LCode\$()    Swap LCodes\$(i), LCodes\$(Int(Rnd * i) + 1)NextCoded\$ = "": Working\$ = "" ' reset for next go aroundFor i = 1 To Len(Answer\$) 'third: put the phrase in coded\$ and hide it in working\$    a = Asc(UCase\$(Answer\$), i)    If a >= 65 And a <= 90 Then        Coded\$ = Coded\$ + LCodes\$(a - 64)        Working\$ = Working\$ + "*"    Else        Coded\$ = Coded\$ + Mid\$(Answer\$, i, 1)        Working\$ = Working\$ + Mid\$(Answer\$, i, 1)    End IfNextHighLited = 1 'setup done start gameMode = 0'select a grahics effect  on timerGE = 1 ' <<< convert to pick at random from N effectsnTimer% = _FreeTimerIf GE = 1 Then    NewWormYard 0, 0, _Width, _Height    resetWorms% = -1    DrawWorms resetWorms% ' get draw worms started on a new set o worms    resetWorms% = 0 ' dont reset while running on timer    On Timer(0.5) DrawWorms resetWorms%    Timer OnEnd IfDisplayInstructions '<< this part can be eaten by wormsUpdate ' this part is critical to continue work on puzzleDo    DrawWorms resetWorms    k\$ = choice\$(25, 44, " 1234ABCDEFGHIJKLMNOPQRSTUVWXYZ")    If k\$ <> " " Then        If Mode = 0 Then ' highlight a letter            'm replaces arrows and mouse select of highlited 1 to 26 for letters            test = InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", k\$)            If test > 0 Then                HighLited = test                Mode = 1            Else                test = InStr("1234", k\$)                If test > 0 Then                    Select Case test                        Case 1: GoSub do1                        Case 2: GoSub do2                        Case 3: GoSub do3                        Case 4: GoSub do4                    End Select                Else                    Mode = 0                End If            End If        Else            Select Case k\$                Case "1": GoSub do1                Case "2": GoSub do2                Case "3": GoSub do3                Case "4": GoSub do4                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"                    Guesses\$(HighLited) = k\$ ' for screen updates                    For i = 1 To Len(Working\$)                        If Letters\$(HighLited) = Mid\$(Coded\$, i, 1) Then Mid\$(Working\$, i, 1) = k\$                    Next                    Mode = 0            End Select        End If    End If    Update    _Limit 60Loop Until Working\$ = UCase\$(Answer\$)UpdateTimer OffColor Orange, Backcp 19, "You got it!    5 secs to next puzzle..."_Display_Delay 5: ClsGoTo restartdo1: ' display answerWorking\$ = UCase\$(Answer\$) ' show the answer\$ guesses correct moves to next puzzleMode = 0UpdateReturndo2: ' get decode letter for highlighted LetterFor i = 1 To 26    If LCodes\$(i) = Letters\$(HighLited) Then c\$ = Chr\$(i + 64): Exit ForNextGuesses\$(HighLited) = c\$ ' for screen updatesFor i = 1 To Len(Working\$)    If Letters\$(HighLited) = Mid\$(Coded\$, i, 1) Then Mid\$(Working\$, i, 1) = c\$NextUpdateMode = 0Returndo3: ' find a uncoded letterColor White, Backcp 24, "     Select Letter to Find     "Locate 25, 1: Print Space\$(100); ' clear out old lined\$ = choice\$(25, 46, " ABCDEFGHIJKLMNOPQRSTUVWXYZ")If d\$ <> " " Then    c\$ = LCodes\$(Asc(d\$) - 64)    Guesses\$(Asc(c\$) - 64) = d\$    For i = 1 To Len(Working\$)        If c\$ = Mid\$(Coded\$, i, 1) Then Mid\$(Working\$, i, 1) = d\$    Next    Mode = 0    UpdateEnd IfReturndo4: ' clear guess letter from code letterGuesses\$(HighLited) = "-"For i = 1 To Len(Working\$)    If Letters\$(HighLited) = Mid\$(Coded\$, i, 1) Then Mid\$(Working\$, i, 1) = "*" ' clear the letterNextMode = 0UpdateReturn'one linersData "Why do ghosts go on diets? So they can keep their ghoulish figures"Data "Where does a ghost go on vacation? Mali-boo."Data "Why did the ghost go into the bar? For the Boos."Data "What is in a ghost's nose? Boo-gers."Data "Why did the policeman ticket the ghost on Halloween? It didn't have a haunting license."Data "Why do demons and ghouls hang out together? Because demons are a ghoul's best friend!"Data "Why did the ghost starch his sheet? He wanted everyone scared stiff."Data "What does a panda ghost eat? Bam-BOO!"Data "What's a ghost's favorite dessert? I-Scream!"Data "Where do ghosts buy their food? At the ghost-ery store!"Data "How do you know when a ghost is sad? He starts boo hooing."Data "Why don't mummies take time off? They're afraid to unwind."Data "Why did the headless horseman go into business? He wanted to get ahead in life."Data "What kind of music do mummies like listening to on Halloween? Wrap music."Data "Why don't mummies have friends? Because they're too wrapped up in themselves."Data "Why did the vampire read the newspaper? He heard it had great circulation."Data "How do vampires get around on Halloween? On blood vessels."Data "What's it like to be kissed by a vampire? It's a pain in the neck."Data "What's it called when a vampire has trouble with his house? A grave problem."Data "How can you tell when a vampire has been in a bakery? All the jelly has been sucked out of the jelly doughnuts."Data "What do you get when you cross a vampire and a snowman? Frostbite."Data "Why do skeletons have low self-esteem? They have no body to love."Data "Know why skeletons are so calm? Because nothing gets under their skin."Data "What do you call a cleaning skeleton? The grim sweeper."Data "What do skeletons order at a restaurant? Spare ribs."Data "What do you call a witch's garage? A broom closet."Data "What kind of food would you find on a haunted beach? A sand-witch!"Data "What was the witch's favorite subject in school? Spelling."Data "What do you call two witches who live together? Broom-mates!"Data "What's a witch's favorite makeup? Ma-scare-a."Data "Who helps the little pumpkins cross the road safely? The crossing gourd."Data "What treat do eye doctors give out on Halloween? Candy corneas."Data "What type of plants do well on all Hallow's Eve? Bam-BOO!"Data "What do birds say on Halloween? Trick or tweet!"Data "Why don't skeletons ever go trick or treating? Because they have no-body to go with."Data "Where do ghosts buy their Halloween candy? At the ghost-ery store!"Data "What do owls say when they go trick or treating? 'Happy Owl-ween!'"Data "What do ghosts give out to trick or treaters? Booberries!"Data "Who did Frankenstein go trick or treating with? His ghoul friend."Data "What Halloween candy is never on time for the party? Choco-LATE!"Data "What do witches put on to go trick or treating? Mas-scare-a."Data "What does Bigfoot say when he asks for candy?  'Trick-or-feet!'"Data "Which type of pants do ghosts wear to trick or treat? Boo jeans."Data "What makes trick or treating with twin witches so challenging? You never know which witch is which!"Data "What happens when a vampire goes in the snow? Frost bite!"Data "What do you call two witches living together? Broommates"Data "What position does a ghost play in hockey? Ghoulie."Data "What do mummies listen to on Halloween? Wrap music."Data "How do you make a skeleton laugh? You tickle his funny bone!"Data "Which Halloween monster is good at math? Count Dracula!"Data "Why did the Cyclops give up teaching? He only had one pupil!"Data "Why didn't the skeleton go to see a scary movie? He didn't have the guts."Data "What did the boy ghost say to the girl ghost? 'You sure are boo-tiful!'"Data "Where does Dracula keep his money? In a blood bank."Data "Why are ghosts terrible liars? You can see right through them!"Data "Why don't mummies take vacations? They're afraid to unwind."Data "What is a vampire's favorite holiday, besides Halloween? Fangs-giving!"Data "Where do fashionable ghosts shop? Bootiques!"Data "What's a monster's favorite play? Romeo and Ghouliet!"Data "What room does a ghost not need? A living room."Data "What monster plays tricks on Halloween? Prank-enstein!"Data "What's a ghost's favorite dessert? I scream."Data "What does the skeleton chef say when he serves you a meal? 'Bone Appetit!'"Data "What is a vampire's favorite fruit? A neck-tarine!"Data "What do witches put on their bagels? Scream cheese."Data "What do ghosts eat for dinner? Spook-ghetti!"Data "What do skeletons order at restaurants? Spare ribs."Data "What does a panda ghost eat? Bam-BOO!"Data "What tops off a mummy's ice cream sundae? Whipped scream."Data "What's a ghost's favorite yogurt flavor? Boo-berry!"Data "What's a vampire's least favorite meal? A steak!"Data "Why was the candy corn booed off the stage? All of his jokes were too corny!"Data "EOD"Sub Update ' preserve from ravages of graphics effects ;-))    Color Yellow    Locate 17, (120 - Len(Answer\$)) / 2: Print Coded\$;    Color White    Locate 18, (120 - Len(Answer\$)) / 2    For i = 1 To Len(Answer\$)        w\$ = Mid\$(Working\$, i, 1): c\$ = Mid\$(Coded\$, i, 1)        a\$ = Mid\$(Answer\$, i, 1): h\$ = Letters\$(HighLited)        If w\$ = "*" Then            pc\$ = "*": If h\$ = c\$ Then Color White, Blue Else Color White, Back        Else            Color White, Back: If w\$ = UCase\$(a\$) Then pc\$ = a\$ Else pc\$ = w\$        End If        Print pc\$;    Next    spaces = 9    For i = 1 To 26 'blue background highlighter        If i = HighLited Then Color Yellow, Blue Else Color Yellow, Back        Locate 21, spaces: Print Letters\$(i);        If i = HighLited Then Color Yellow, Blue Else Color White, Back        Locate 22, spaces: Print Guesses\$(i);        spaces = spaces + 4    Next    If Mode = 1 Then        Color White, Back        cp 24, "  Guess Solve Letter or Menu # "    Else        Color Yellow, Back        cp 24, "  Select Code Letter or Menu # "    End If    _DisplayEnd SubSub DisplayInstructions ' only once let worms eat them up as game goes on    Color Orange, Back: Cls    cp 4, "*** Halloween Challenge - Crypt-O-Gram Puzzle ***"    Color Red    cp 6, "Solve puzzle by selecting a Code letter then selecting a Guess letter for it."    cp 7, "All selections are made by pressing spacebar when you see your letter or digit."    cp 8, "You will need to verify your selection by pressing spacebar again when see Y for Yes."    cp 9, "Use the escape key to quit immediately (an X box in top right is not accessible)."    Color BB    cp 11, "To get the answer and move onto next puzzle, select 1."    cp 12, "To decode current highlighted letter, select 2."    cp 13, "To solve a letter, select 3 and then select letter to find."    cp 14, "To clear a guess at highlighted Code letter, select 4."    _DisplayEnd SubSub cp (row, text\$) ' center text on text screen    'Locate row, 1: Print Space\$(_Width) ' clear out old line in case the next is shorter    'Locate row, 1: Print Space\$(Xmax / 8);  'text screen    ' clear old line was interferring with worm trails    Locate row, (Xmax / 8 - Len(text\$)) / 2: Print text\$;End SubFunction choice\$ (row, col, selection\$) ' replace InKey\$ with _KeyDown()    fg~& = _DefaultColor: bg~& = _BackgroundColor    saveRow = CsrLin: saveCol = Pos(0): t = Timer    GoSub show    Do        If _KeyDown(27) Then System ' emergency exit        GoSub show:        ' 2021-10-06 fix for polling erratic behavior: misses or jumps, check for spacebar way more often        While Timer - t < 4 ' smooth out the jumpiness sometimes no response, sometimes jumps 2x' on one press????            If _KeyDown(27) Then System ' emergency exit            If _KeyDown(32) Then t = Timer: place = (place + 1) Mod Len(selection\$): Exit While            _Limit 200 '<<<< fine tune the polling for spacebar!!!        Wend        If Timer - t >= 4 Then choice\$ = Mid\$(selection\$, place + 1, 1): Locate saveRow, saveCol: Exit Function        _Limit 5 'so can hold down spacebar, nice    Loop    show:    Locate row, col    For i = 1 To Len(selection\$)        If i = place + 1 Then Color bg~&, fg~& Else Color fg~&, bg~&        Locate row, col - 1 + i: Print Mid\$(selection\$, i, 1);    Next    _Display    Color fg~&, bg~&    ReturnEnd FunctionSub DrawWorms (DrawReset As Integer) ' one frame in main loop    Static x(1 To nWorms, 1 To 20), y(1 To nWorms, 1 To 20)    If DrawReset Then        For i = 1 To nWorms            NewWorm i            For j = 1 To 20                x(i, j) = 0: y(i, j) = 0            Next        Next        DrawReset = 0    End If    For i = 1 To nWorms        Fcirc Worms(i).X, Worms(i).Y, 8, &HFF000000 ' fix 2021-10-07 to prevent program hangs        If _KeyDown(27) Then Exit Sub        For j = 1 To Worms(i).Sz ' blackout old segments            If x(i, j) And y(i, j) Then Fcirc x(i, j), y(i, j), 8, &HFF000000        Next        tryAgain:        If _KeyDown(27) Then Exit Sub        If Rnd < .3 Then Worms(i).DX = Worms(i).DX + .8 * Rnd - .4 Else Worms(i).DY = Worms(i).DY + .8 * Rnd - .4        If Abs(Worms(i).DX) > 2 Then Worms(i).DX = Worms(i).DX * .5        If Abs(Worms(i).DY) > 2 Then Worms(i).DY = Worms(i).DY * .5        x = Worms(i).X + Worms(i).DX * 2.0: y = Worms(i).Y + Worms(i).DY * 2.0        good = -1        If x >= WormYard.X + 6 And x <= WormYard.X + WormYard.W - 6 Then            If y >= WormYard.Y + 6 And y <= WormYard.Y + WormYard.H - 6 Then                For yy = y - 6 To y + 6                    For xx = x - 6 To x + 6                        If Point(xx, yy) = _RGB32(255, 255, 255) Or Point(xx, yy) = _RGB32(255, 255, 0) Then good = 0: Exit For                    Next                    If good = 0 Then Exit For                Next            Else                good = 0            End If        Else            good = 0        End If        If good = 0 Then 'turn the worm            'Beep: Locate 1, 1: Print x, y            'Input "enter >", w\$            If Rnd > .5 Then 'change dx                If Worms(i).DX Then                    Worms(i).DX = -Worms(i).DX                Else                    If Rnd > .5 Then Worms(i).DX = 1 Else Worms(i).DX = -1                End If            Else                If Worms(i).DY Then                    Worms(i).DY = -Worms(i).DY                Else                    If Rnd > .5 Then Worms(i).DY = 1 Else Worms(i).DY = -1                End If            End If            GoTo tryAgain        End If        For j = Worms(i).Sz To 2 Step -1            x(i, j) = x(i, j - 1): y(i, j) = y(i, j - 1)            If x(i, j) And y(i, j) Then DrawBall x(i, j), y(i, j), 6, Worms(i).C1        Next        x(i, 1) = x: y(i, 1) = y        DrawBall x(i, 1), y(i, 1), 6, Worms(i).C1        Worms(i).X = x: Worms(i).Y = y    Next i 'worm index    _DisplayEnd SubSub NewWormYard (x, y, w, h)    WormYard.X = x: WormYard.Y = y: WormYard.W = w: WormYard.H = h    For i = 1 To nWorms        NewWorm i    NextEnd SubSub NewWorm (i)    'pick which side to enter, for dx, dy generally headed towards inner screen    side = Int(Rnd * 4)    Select Case side        Case 0 ' left side            Worms(i).X = WormYard.X + 6            Worms(i).Y = WormYard.Y + 6 + (WormYard.H - 12) * Rnd            Worms(i).DX = 1            Worms(i).DY = 0        Case 1 'right side            Worms(i).X = WormYard.X + WormYard.W - 6            Worms(i).Y = WormYard.Y + 6 + (WormYard.H - 12) * Rnd            Worms(i).DX = -1            Worms(i).DY = 0        Case 2 ' top            Worms(i).Y = WormYard.Y + 6            Worms(i).X = WormYard.X + 6 + (WormYard.W - 12) * Rnd            Worms(i).DX = 0            Worms(i).DY = 1        Case 3 'bottom            Worms(i).Y = WormYard.Y + WormYard.H - 6            Worms(i).X = WormYard.X + 6 + (WormYard.W - 12) * Rnd            Worms(i).DX = 0            Worms(i).DY = -1    End Select    Worms(i).Sz = Int(Rnd * 11) + 10    side = Int(Rnd * 4): lev = Int(Rnd * 10)    If side = 0 Then        Worms(i).C1 = _RGB32(255 - 20 * lev + 50, 180 - 15 * lev, 180 - 15 * lev)    ElseIf side = 1 Then        Worms(i).C1 = _RGB32(255 - 20 * lev, 180 - 15 * lev + 50, 180 - 15 * lev)    ElseIf side = 2 Then        Worms(i).C1 = _RGB32(255 - 20 * lev, 180 - 15 * lev, 180 - 15 * lev + 20)    ElseIf side = 3 Then        Worms(i).C1 = _RGB32(255 - 20 * lev, 180 - 15 * lev, 180 - 15 * lev)    End IfEnd SubSub Fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)    Dim Radius As Long, RadiusError As Long    Dim X As Long, Y As Long    Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0    If Radius = 0 Then PSet (CX, CY), C: Exit Sub    Line (CX - X, CY)-(CX + X, CY), C, BF    While X > Y        RadiusError = RadiusError + Y * 2 + 1        If RadiusError >= 0 Then            If X <> Y + 1 Then                Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF                Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF            End If            X = X - 1            RadiusError = RadiusError - X * 2        End If        Y = Y + 1        Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF        Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF    WendEnd SubSub DrawBall (x, y, r, c As _Unsigned Long)    Dim rred As Long, grn As Long, blu As Long, rr As Long, f    rred = _Red32(c): grn = _Green32(c): blu = _Blue32(c)    For rr = r To 0 Step -1        f = 1.25 - rr / r        Fcirc x, y, rr, _RGB32(rred * f, grn * f, blu * f)    NextEnd Sub`

#### bplus

• Forum Resident
• Posts: 7449
• b = b + ...
##### Re: Crypt-O-Gram Puzzle - Halloween Challenge
« Reply #13 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]
`do3: ' find a uncoded letterColor White, Backcp 24, "     Select Letter to Find     "Locate 25, 44: Print Space\$(31); ' clear out old lined\$ = choice\$(25, 46, " ABCDEFGHIJKLMNOPQRSTUVWXYZ")If d\$ <> " " Then    c\$ = LCodes\$(Asc(d\$) - 64)    Guesses\$(Asc(c\$) - 64) = d\$    For i = 1 To Len(Working\$)        If c\$ = Mid\$(Coded\$, i, 1) Then Mid\$(Working\$, i, 1) = d\$    Next    Mode = 0    UpdateEnd IfReturn`
This just clears the exact text length that needed clearing, instead of the whole line.

#### johnno56

• Forum Resident
• Posts: 1166
• Live long and prosper.
##### Re: Crypt-O-Gram Puzzle - Halloween Challenge
« Reply #14 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.

Logic is the beginning of wisdom.