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

Pete · « **Reply #15 on:** October 08, 2021, 06:18:02 pm »

Let's go Brandon!

I wonder what that would dcryptify to?

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

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

t
Pe e
^ (Word bump this!)

bplus · « **Reply #16 on:** October 08, 2021, 09:51:37 pm »

Quote

"Demons are a ghoul's best friend

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

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

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

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

Here is spiders added to worms with new Choice$ and allot of other rework.
v2021-10-08

Code: QB64: [Select]

Option _Explicit
_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.
 
' v 2021-10-08: fix do3, blanking whole line or nearly, it disturbs worm trails.
' Add a spider screen for overlaying spiders wo changing the background.
' Man this is so screwed up... I'm taking another approach.
' ... rewrites and tests
' Now do3 completely rewritten as mode 3 along with Choice$ function
' Much better!! rewrote the way Choice works, no time consuming loops outside main loop,
' so no delaysin graphics effects so no need for timers. Only one side screen needed
' for tracking Worm Trails. Had to slow worms and Spider dowm for a _Limit 30 for everything.
 
 
'Fall letters and background
Const Orange = &HFFFF8800 ' 12 d
Const Back = &HFF302010 ' 8 ? d
Const Red = &HFFFF2222 ' print under title
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
Const nSpiders = 15
 
'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
Dim Shared As _Unsigned Long White, Yellow
White = _RGB32(255, 255, 255): Yellow = _RGB32(255, 255, 0) ' I give up, yellow and white aren't stopping the worms
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 ' what are we getting a coded letter =0, a guess for that letter =1, a letter to find and decode=3
Dim Shared KeyTimer
Dim Shared Place
Dim Shared As Long WS
 
' adding graphics effects
ReDim Shared Worms(1 To nWorms) As Object
Dim Shared WormYard As Object
ReDim Shared S(1 To nSpiders) As Object ' Spider 0 is a spinner?
Dim Shared WT As Long ' worm screen to track Worm Trails
 
' main declares
Dim jokes$(1 To 100) ' load jokes one time from data statements in program
Dim As Integer i, resetWorms, si, jCount, a, lc, test
Dim r$, k$, c$
 
Screen _NewImage(Xmax, Ymax, 32)
Randomize Timer ': Width 120, 30 converted to graphics screen
_FullScreen 'I guess it does make it easier to tell E from F...
 
WS = _NewImage(Xmax, Ymax, 32)
For i = 1 To 100 'ready jokes
    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
If WT Then _FreeImage WT ' clear WormTrails for new game
WT = _NewImage(Xmax, Ymax, 32)
ReDim Worms(1 To nWorms) As Object ' clear old arrays
NewWormYard 0, 0, Xmax, Ymax
resetWorms = -1
ReDim S(1 To nSpiders) As Object
si = 0: lc = 0
HighLited = 1 'setup done start game
Mode = 0
 
KeyTimer = Timer
Do
    Color , Back: Cls
    DisplayInstructions '<< this part can be eaten by worms very bottom of drawing
    _PutImage , WT, 0 ' the worm trails
    Update ' need yellow and white to slow worms
    DrawWorms resetWorms ' yellow and white not working???
    lc = lc + 1
    If lc Mod 300 = 299 Then 'drawSpiders
        If si < nSpiders Then si = si + 1: newSpinner si
    End If
    For i = 1 To si
        drawSpinner S(i).X, S(i).Y, S(i).Sz, _Atan2(S(i).DY, S(i).DX), S(i).C1
        S(i).X = S(i).X + S(i).DX: S(i).Y = S(i).Y + S(i).DY
        If S(i).X < -100 Or S(i).X > Xmax + 100 Or S(i).Y < -100 Or S(i).Y > Ymax + 100 Then newSpinner i
    Next
    'Update ' on top of every thing sets color to mode
    If Mode = 3 Then
        k$ = choice$(25, 33, " A B C D E F G H I J K L M N O P Q R S T U V W X Y Z ")
    Else
        k$ = choice$(25, 29, " 1 2 3 4 A B C D E F G H I J K L M N O P Q R S T U V W X Y Z ")
    End If
    If k$ <> "" And 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: Mode = 3
                        Case 4: GoSub do4
                    End Select
                Else
                    Mode = 0
                End If
            End If
        ElseIf Mode = 1 Then
            Select Case k$
                Case "1": GoSub do1
                Case "2": GoSub do2
                Case "3": Mode = 3
                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
        ElseIf Mode = 3 Then
            Locate 25, 44: Print Space$(31); ' clear out old line
            c$ = LCodes$(Asc(k$) - 64)
            Guesses$(Asc(c$) - 64) = k$
            For i = 1 To Len(Working$)
                If c$ = Mid$(Coded$, i, 1) Then Mid$(Working$, i, 1) = k$
            Next
            Mode = 0
        End If
    End If
    _Limit 30
    _Display
Loop Until Working$ = UCase$(Answer$)
Update
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
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
 
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 ;-))
    Dim As Integer i, spaces
    Dim w$, c$, a$, h$, pc$
    Color Yellow, Back
    Locate 17, (120 - Len(Answer$)) / 2: Print Coded$;
    Color White, Back
    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 # "
        cp 25, String$(31, "W") ' for worm poison (the fore color)
    ElseIf Mode = 0 Then
        Color Yellow, Back
        cp 24, "  Select Code Letter or Menu # "
        cp 25, String$(31, "W") ' for worm poison (the fore color)
    ElseIf Mode = 3 Then
        Color White, Back
        cp 24, "     Select Letter to Find     "
        cp 25, String$(31, "W") ' for worm poison (the fore color)
    End If
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."
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()
    Dim As _Unsigned Long fg, bg
    Dim As Integer saveRow, saveCol, i
    Dim k$
    fg~& = _DefaultColor: bg~& = _BackgroundColor
    saveRow = CsrLin: saveCol = Pos(0)
    If _KeyDown(27) Then System ' emergency exit
    GoSub show:
    k$ = InKey$
    If _KeyDown(27) Then System ' emergency exit
    If k$ = " " Then KeyTimer = Timer: Place = (Place + 1) Mod Len(selection$)
    If Timer - KeyTimer >= 4 Then choice$ = Mid$(selection$, Place + 1, 1): Place = 0
    Locate saveRow, saveCol: Exit Function
 
    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)
    Dim M As _MEM
    Dim As Integer i, j, good
    Dim As Single x, y, xx, yy
    _Source 0
    If DrawReset Then
        'M = _Mem(x())
        '_MemFill M, M.OFFSET, M.SIZE, 0 As _BYTE 'reset the array, Thanks Steve
        'M = _Mem(y())
        '_MemFill M, M.OFFSET, M.SIZE, 0 As _BYTE 'reset the array, eh didn't work
        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
        _Dest WT
        Fcirc Worms(i).X, Worms(i).Y, 6, &HFF000000
        _Dest 0
        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
 
        If Rnd < .15 Then 'move the worm  (gots to slow down the worms)
            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 Worms(i).DX ^ 2 + Worms(i).DY ^ 2 > 2 Then
                Worms(i).DX = Worms(i).DX * .5: Worms(i).DY = Worms(i).DY * .5
            End If
            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) = White Or Point(xx, yy) = Yellow 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
                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
        Else
            For j = Worms(i).Sz To 2 Step -1
                If x(i, j) And y(i, j) Then DrawBall x(i, j), y(i, j), 6, Worms(i).C1
            Next
            DrawBall x(i, 1), y(i, 1), 6, Worms(i).C1
        End If
    Next i 'worm index
End Sub
 
Sub NewWormYard (x, y, w, h)
    WormYard.X = x: WormYard.Y = y: WormYard.W = w: WormYard.H = h
End Sub
 
Sub NewWorm (i)
    Dim As Integer side, lev
    '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 newSpinner (i As Integer) 'set Spinners dimensions start angles, color?
    Dim r As Integer
    S(i).Sz = Rnd * .2 + .4
    If Rnd < .5 Then r = -1 Else r = 1
    S(i).DX = (S(i).Sz * Rnd * 2 + 2) * r * 1.25: S(i).DY = (S(i).Sz * Rnd * 2 + 2) * r * 1.25
    r = Int(Rnd * 4)
    Select Case r
        Case 0: S(i).X = Rnd * (Xmax - 120) + 60: S(i).Y = 0: If S(i).DY < 0 Then S(i).DY = -S(i).DY
        Case 1: S(i).X = Rnd * (Xmax - 120) + 60: S(i).Y = Ymax: If S(i).DY > 0 Then S(i).DY = -S(i).DY
        Case 2: S(i).X = 0: S(i).Y = Rnd * (Ymax - 120) + 60: If S(i).DX < 0 Then S(i).DX = -S(i).DX
        Case 3: S(i).X = Xmax: S(i).Y = Rnd * (Ymax - 120) + 60: If S(i).DX > 0 Then S(i).DX = -S(i).DX
    End Select
    r = Rnd * 90 + 30
    S(i).C1 = _RGB32(r, Rnd * .5 * r, Rnd * .25 * r) 'red ghost spiders???
End Sub
 
Sub drawSpinner (x As Integer, y As Integer, scale As Single, heading As Single, c As _Unsigned Long)
    Dim x1, x2, x3, x4, y1, y2, y3, y4, r, a, a1, a2, lg, d, rd
    Dim rred, bblue, ggreen
    Static switch As Integer
    switch = switch + 2
    switch = switch Mod 16 + 1
    rred = _Red32(c): ggreen = _Green32(c): bblue = _Blue32(c)
    r = 10 * scale
    x1 = x + r * Cos(heading): y1 = y + r * Sin(heading)
    r = 2 * r 'lg lengths
    For lg = 1 To 8
        If lg < 5 Then
            a = heading + .9 * lg * _Pi(1 / 5) + (lg = switch) * _Pi(1 / 10)
        Else
            a = heading - .9 * (lg - 4) * _Pi(1 / 5) - (lg = switch) * _Pi(1 / 10)
        End If
        x2 = x1 + r * Cos(a): y2 = y1 + r * Sin(a)
        drawLink x1, y1, 3 * scale, x2, y2, 2 * scale, _RGB32(rred + 20, ggreen + 10, bblue + 5)
        If lg = 1 Or lg = 2 Or lg = 7 Or lg = 8 Then d = -1 Else d = 1
        a1 = a + d * _Pi(1 / 12)
        x3 = x2 + r * 1.5 * Cos(a1): y3 = y2 + r * 1.5 * Sin(a1)
        drawLink x2, y2, 2 * scale, x3, y3, scale, _RGB32(rred + 35, ggreen + 17, bblue + 8)
        rd = Int(Rnd * 8) + 1
        a2 = a1 + d * _Pi(1 / 8) * rd / 8
        x4 = x3 + r * 1.5 * Cos(a2): y4 = y3 + r * 1.5 * Sin(a2)
        drawLink x3, y3, scale, x4, y4, scale, _RGB32(rred + 50, ggreen + 25, bblue + 12)
    Next
    r = r * .5
    Fcirc x1, y1, r, _RGB32(rred - 20, ggreen - 10, bblue - 5)
    x2 = x1 + (r + 1) * Cos(heading - _Pi(1 / 12)): y2 = y1 + (r + 1) * Sin(heading - _Pi(1 / 12))
    Fcirc x2, y2, r * .2, &HFF000000
    x2 = x1 + (r + 1) * Cos(heading + _Pi(1 / 12)): y2 = y1 + (r + 1) * Sin(heading + _Pi(1 / 12))
    Fcirc x2, y2, r * .2, &HFF000000
    r = r * 2
    x1 = x + r * .9 * Cos(heading + _Pi): y1 = y + r * .9 * Sin(heading + _Pi)
    TiltedEllipseFill 0, x1, y1, r, .7 * r, heading + _Pi, _RGB32(rred, ggreen, bblue)
End Sub
 
Sub drawLink (x1, y1, r1, x2, y2, r2, c As _Unsigned Long)
    Dim a, a1, a2, x3, x4, x5, x6, y3, y4, y5, y6
    a = _Atan2(y2 - y1, x2 - x1)
    a1 = a + _Pi(1 / 2)
    a2 = a - _Pi(1 / 2)
    x3 = x1 + r1 * Cos(a1): y3 = y1 + r1 * Sin(a1)
    x4 = x1 + r1 * Cos(a2): y4 = y1 + r1 * Sin(a2)
    x5 = x2 + r2 * Cos(a1): y5 = y2 + r2 * Sin(a1)
    x6 = x2 + r2 * Cos(a2): y6 = y2 + r2 * Sin(a2)
    fquad x3, y3, x4, y4, x5, y5, x6, y6, c
    Fcirc x1, y1, r1, c
    Fcirc x2, y2, r2, c
End Sub
 
'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
Sub fquad (x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, x3 As Integer, y3 As Integer, x4 As Integer, y4 As Integer, c As _Unsigned Long)
    ftri x1, y1, x2, y2, x4, y4, c
    ftri x3, y3, x4, y4, x1, y1, c
End Sub
 
Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
    Dim a&
    a& = _NewImage(1, 1, 32)
    _Dest a&
    PSet (0, 0), K
    _Dest 0
    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
    _FreeImage a& '<<< this is important!
End Sub
 
Sub TiltedEllipseFill (destHandle&, x0, y0, a, b, ang, c As _Unsigned Long)
    Dim max As Integer, mx2 As Integer, i As Integer, j As Integer, k As Single, lasti As Single, lastj As Single
    Dim prc As _Unsigned Long, tef As Long
    prc = _RGB32(255, 255, 255, 255)
    If a > b Then max = a + 1 Else max = b + 1
    mx2 = max + max
    tef = _NewImage(mx2, mx2)
    _Dest tef
    _Source tef 'point wont read without this!
    For k = 0 To 6.2832 + .05 Step .1
        i = max + a * Cos(k) * Cos(ang) + b * Sin(k) * Sin(ang)
        j = max + a * Cos(k) * Sin(ang) - b * Sin(k) * Cos(ang)
        If k <> 0 Then
            Line (lasti, lastj)-(i, j), prc
        Else
            PSet (i, j), prc
        End If
        lasti = i: lastj = j
    Next
    Dim xleft(mx2) As Integer, xright(mx2) As Integer, x As Integer, y As Integer
    For y = 0 To mx2
        x = 0
        While Point(x, y) <> prc And x < mx2
            x = x + 1
        Wend
        xleft(y) = x
        While Point(x, y) = prc And x < mx2
            x = x + 1
        Wend
        While Point(x, y) <> prc And x < mx2
            x = x + 1
        Wend
        If x = mx2 Then xright(y) = xleft(y) Else xright(y) = x
    Next
    _Dest destHandle&
    For y = 0 To mx2
        If xleft(y) <> mx2 Then Line (xleft(y) + x0 - max, y + y0 - max)-(xright(y) + x0 - max, y + y0 - max), c, BF
    Next
    _FreeImage tef
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
 

johnno56 · « **Reply #17 on:** October 09, 2021, 12:59:28 am »

Break suggested? Advice taken. Let me know if you need anything else?

bplus · « **Reply #18 on:** October 09, 2021, 08:20:26 am »

Quote from: johnno56 on October 09, 2021, 12:59:28 am

Break suggested? Advice taken. Let me know if you need anything else?

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

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

Oh wait... we could do those (jokes other than ones in puzzle) in sound (oh maybe those jokes too that would be a nice trick or treat read the answer amongst the many told verbally while user is trying to concentrate on puzzle).

@johnno56 I prefer your sound files that are cross platform than using Windows only speech synthesis.

Maybe jokes not needed, just some haunting torment for the user while he attempts to decode a dead joke, moo ha ha. Make the user think he's died and gone to bad joke hell, AKA Pete's heaven.

johnno56 · « **Reply #19 on:** October 09, 2021, 09:02:19 am »

Regardless of whether the synthesis is Windows-based or not, how can the 'results' be classified as 'non cross platform'? I can output the audio format to many types. I use 'ogg' because the compression is higher than 'wav' and 'mp3'... I am confused... (not even a chuckle... lol)

bplus · « **Reply #20 on:** October 09, 2021, 09:05:24 am »

Windows speech synthesis, I think, can only be used in... wait for it.

Windows!

I mean it seems logical to me.

bplus · « **Reply #21 on:** October 09, 2021, 09:07:43 am »

@johnno56 if you give me sound stuff that works for you, and I test it and it works for me too, then I know 2 OS's at least that they will work. 2 is good enough for me to say cross platform.

bplus · « **Reply #22 on:** October 10, 2021, 02:37:47 am »

Well I try again, here is version 2021-10-10 of Crypto-O-Gram with 3 background sound and graphics effects. Had a last minute change of music files because the one I had was too big for forum post.

bplus · « **Reply #23 on:** October 11, 2021, 11:41:41 am »

Ha! my bad timing to post above with all this new stuff with QB64 happening ;(

Then mpgcan stuff, wow!

Well I thought pretty good graphics and sound added, b+ at least, Moo ha ha.

bplus · « **Reply #24 on:** October 11, 2021, 12:18:10 pm »

Some screen shots from what may be my last Graphics version for Halloween Challenge (I think I have some ideas for Screen 0 extra credit version).

bplus · « **Reply #25 on:** October 11, 2021, 12:37:47 pm »

PS everything in this Crypt-0-gram Puzzle program is working fine in QB64 v2.0.

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

News:

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

Pete

Re: Crypt-O-Gram Puzzle - Halloween Challenge

bplus

Re: Crypt-O-Gram Puzzle - Halloween Challenge

johnno56

Re: Crypt-O-Gram Puzzle - Halloween Challenge

bplus

Re: Crypt-O-Gram Puzzle - Halloween Challenge

johnno56

Re: Crypt-O-Gram Puzzle - Halloween Challenge

bplus

Re: Crypt-O-Gram Puzzle - Halloween Challenge

bplus

Re: Crypt-O-Gram Puzzle - Halloween Challenge

bplus

Re: Crypt-O-Gram Puzzle - Halloween Challenge

bplus

Re: Crypt-O-Gram Puzzle - Halloween Challenge

bplus

Re: Crypt-O-Gram Puzzle - Halloween Challenge

bplus

Re: Crypt-O-Gram Puzzle - Halloween Challenge