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.

Offline 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$)
    Cls
Loop 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 Function


Function 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 If
End 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.



Offline 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, 30
Dim Shared Answer$ '  beginning phrase to be guessed    '   3 stages of the Puzzle
Dim Shared Coded$ '   hidden in code
Dim Shared Working$ ' decoded and solved when working$ becomes = ucase$(answer$)
Dim Shared Letters$(1 To 26) ' for coding and highlited letters
Dim Shared LCodes$(1 To 26) '  for code and decode by number 1 to 26
Dim Shared Guesses$(1 To 26) ' track all the guess to decode
Dim Shared HighLited ' cursor over letters to guess
Dim 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 For
Next
restart:
Answer$ = jokes$(Int(Rnd * jCount) + 1)
For i = 1 To 26: Guesses$(i) = "-": Next 'setup the display guesses array
For 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 number
Next
For i = 26 To 2 Step -1 ' shuffle the letters in LCode$()
    Swap LCodes$(i), LCodes$(Int(Rnd * i) + 1)
Next
Coded$ = "": Working$ = "" ' reset for next go around
For 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 If
Next
HighLited = 1 'setup done start game
Mode = 0
Do
    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 60
Loop Until Working$ = UCase$(Answer$)
DisplayScreen
Color 9, 8
cp 17, "You got it!    5 secs to next puzzle..."
_Delay 5: Cls
GoTo restart

do1: ' display answer
Working$ = UCase$(Answer$) ' show the answer$ guesses correct moves to next puzzle
DisplayScreen
Mode = 0
Return

do2: ' get decode letter for highlighted Letter
For i = 1 To 26
    If LCodes$(i) = Letters$(HighLited) Then c$ = Chr$(i + 64): Exit For
Next
Guesses$(HighLited) = c$ ' for screen updates
For i = 1 To Len(Working$)
    If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = c$
Next
Mode = 0
Return

do3: ' find a uncoded letter
Color 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 = 0
End If
Return

do4: ' clear guess letter from code letter
Guesses$(HighLited) = "-"
For i = 1 To Len(Working$)
    If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = "*" ' clear the letter
Next
Mode = 0
Return

'one liners
Data "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 If
End Sub

Sub cp (row, text$) ' center text on text screen
    Locate row, (_Width - Len(text$)) / 2: Print text$
End Sub

Function 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 Function

Function 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 If
End 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.




Offline 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) ' Orange
Dim Shared Answer$ '  beginning phrase to be guessed    '   3 stages of the Puzzle
Dim Shared Coded$ '   hidden in code
Dim Shared Working$ ' decoded and solved when working$ becomes = ucase$(answer$)
Dim Shared Letters$(1 To 26) ' for coding and highlited letters
Dim Shared LCodes$(1 To 26) '  for code and decode by number 1 to 26
Dim Shared Guesses$(1 To 26) ' track all the guess to decode
Dim Shared HighLited ' cursor over letters to guess
Dim 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 For
Next
restart:
Answer$ = jokes$(Int(Rnd * jCount) + 1)
For i = 1 To 26: Guesses$(i) = "-": Next 'setup the display guesses array
For 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 number
Next
For i = 26 To 2 Step -1 ' shuffle the letters in LCode$()
    Swap LCodes$(i), LCodes$(Int(Rnd * i) + 1)
Next
Coded$ = "": Working$ = "" ' reset for next go around
For 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 If
Next
HighLited = 1 'setup done start game
Mode = 0
Do
    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 60
Loop Until Working$ = UCase$(Answer$)
DisplayScreen
Color 12, 8
cp 19, "You got it!    5 secs to next puzzle..."
_Delay 5: Cls
GoTo restart

do1: ' display answer
Working$ = UCase$(Answer$) ' show the answer$ guesses correct moves to next puzzle
DisplayScreen
Mode = 0
Return

do2: ' get decode letter for highlighted Letter
For i = 1 To 26
    If LCodes$(i) = Letters$(HighLited) Then c$ = Chr$(i + 64): Exit For
Next
Guesses$(HighLited) = c$ ' for screen updates
For i = 1 To Len(Working$)
    If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = c$
Next
Mode = 0
Return

do3: ' find a uncoded letter
Color 15, 8: cp 24, "Select Letter to Find"
Locate 25, 1: Print Space$(_Width) ' clear out old line
d$ = 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
End If
Return

do4: ' clear guess letter from code letter
Guesses$(HighLited) = "-"
For i = 1 To Len(Working$)
    If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = "*" ' clear the letter
Next
Mode = 0
Return

'one liners
Data "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 If
End Sub

Sub 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 Sub

Function 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~&
    Return
End Function


It's allot easier to play now! Thanks Steve

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3662
    • Steve’s QB64 Archive Forum
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!

Offline 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!

Offline 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~&
    Return
End Function

Offline 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~&
    Return
End Function

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

Offline 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.

Offline 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...

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3662
    • Steve’s QB64 Archive Forum
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!

Offline 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!

Offline 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

Offline 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 background
Const Orange = &HFFFF8800 ' 12 d
Const White = &HFFFFFFFF ' 15 d
Const Back = &HFF302010 ' 8 ? d
Const Red = &HFFFF2222 ' print under title
Const Yellow = &HFFFFFF00 ' 14 d
Const Blue = &HFF0000FF ' 9 light blue
Const BB = &HFF33BB33 ' 6 blue brown ?
Const Xmax = 120 * 8 ' started with text screen _width 120, 30
Const Ymax = 30 * 16

'for Graphic effects
Const nWorms = 30

'for graphics effects
Type 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 Type

Screen _NewImage(Xmax, Ymax, 32)
Randomize Timer ': Width 120, 30

Dim Shared Answer$ '  beginning phrase to be guessed    '   3 stages of the Puzzle
Dim Shared Coded$ '   hidden in code
Dim Shared Working$ ' decoded and solved when working$ becomes = ucase$(answer$)
Dim Shared Letters$(1 To 26) ' for coding and highlited letters
Dim Shared LCodes$(1 To 26) '  for code and decode by number 1 to 26
Dim Shared Guesses$(1 To 26) ' track all the guess to decode
Dim Shared HighLited ' cursor over letters to guess
Dim Shared Mode

' adding graphics effects
Dim Shared Worms(1 To nWorms) As Object
Dim 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 program
For i = 1 To 100
    Read r$
    If r$ <> "EOD" Then jokes$(i) = r$: jCount = jCount + 1 Else Exit For
Next

restart:

'setup Puzzle and code it
Answer$ = jokes$(Int(Rnd * jCount) + 1)
For i = 1 To 26: Guesses$(i) = "-": Next 'setup the display guesses array
For 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 number
Next
For i = 26 To 2 Step -1 ' shuffle the letters in LCode$()
    Swap LCodes$(i), LCodes$(Int(Rnd * i) + 1)
Next
Coded$ = "": Working$ = "" ' reset for next go around
For 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 If
Next

HighLited = 1 'setup done start game
Mode = 0

'select a grahics effect  on timer
GE = 1 ' <<< convert to pick at random from N effects
nTimer% = _FreeTimer
If 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 On
End If

DisplayInstructions '<< this part can be eaten by worms
Update ' this part is critical to continue work on puzzle
Do
    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 60
Loop Until Working$ = UCase$(Answer$)
Update
Timer Off
Color Orange, Back
cp 19, "You got it!    5 secs to next puzzle..."
_Display
_Delay 5: Cls
GoTo restart

do1: ' display answer
Working$ = UCase$(Answer$) ' show the answer$ guesses correct moves to next puzzle
Mode = 0
Update
Return

do2: ' get decode letter for highlighted Letter
For i = 1 To 26
    If LCodes$(i) = Letters$(HighLited) Then c$ = Chr$(i + 64): Exit For
Next
Guesses$(HighLited) = c$ ' for screen updates
For i = 1 To Len(Working$)
    If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = c$
Next
Update
Mode = 0
Return

do3: ' find a uncoded letter
Color White, Back
cp 24, "     Select Letter to Find     "
Locate 25, 1: Print Space$(100); ' clear out old line
d$ = 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
    Update
End If
Return

do4: ' clear guess letter from code letter
Guesses$(HighLited) = "-"
For i = 1 To Len(Working$)
    If Letters$(HighLited) = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = "*" ' clear the letter
Next
Mode = 0
Update
Return

'one liners
Data "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
    _Display
End Sub

Sub 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."
    _Display
End Sub

Sub 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 Sub

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~&
    Return
End Function

Sub 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
    _Display
End Sub

Sub NewWormYard (x, y, w, h)
    WormYard.X = x: WormYard.Y = y: WormYard.W = w: WormYard.H = h
    For i = 1 To nWorms
        NewWorm i
    Next
End Sub

Sub 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 If
End Sub

Sub 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
    Wend
End Sub

Sub 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)
    Next
End Sub


Offline 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 letter
Color White, Back
cp 24, "     Select Letter to Find     "
Locate 25, 44: Print Space$(31); ' clear out old line
d$ = 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
    Update
End If
Return

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

Offline 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.