Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Courage, Luck, or Strategy
#1
How much money can you win??

Code: (Select All)
_Title "Courage, Luck, or Strategy?"
Screen _NewImage(1280, 720, 32)
$Color:32
Randomize Timer

Dim Shared As Long font(12 To 64), LockLevel, Chances, Betlevel
Dim Shared cash(11) As String
cash(0) = "$0": cash(1) = "$1,000": cash(2) = "$2,000"
cash(3) = "$4,000": cash(4) = "$8,000": cash(5) = "$16K"
cash(6) = "$32K": cash(7) = "$64K": cash(8) = "$128K"
cash(9) = "$256K": cash(10) = "$512K": cash(11) = "$1000000"



For i = 12 To 64
    font(i) = _LoadFont("courbd.ttf", i, "monospace")
Next

LockLevel = 0 'but you could lose it all!  Arrrghh!
Chances = 3 'but you have 3 chances to turn your fate around!
Betlevel = 1 'and you haven't made any bets with your winnings so far!

Do
    Cls , 0
    DrawProgress
    ProcessInput
    If Chances < 0 Then Quit
    _Display
    _Limit 30
Loop

Sub Quit
    Cls
    Color White, 0
    Print "You have won:"; cash(Betlevel)
End Sub

Sub ProcessInput
    Static OldMB
    While _MouseInput: Wend
    mx = _MouseX: my = _MouseY
    mb = _MouseButton(1)
    If mb And Not OldMB Then
        If my >= 500 And my <= 600 Then 'down in the control column
            Select Case mx
                Case 150 To 350 'bet
                    r = Int(Rnd * 100) + 1
                    If r < 50 Then
                        Betlevel = Betlevel + 1
                    Else
                        Betlevel = LockLevel
                        LockLevel = 0
                        Chances = Chances - 1
                    End If
                Case 400 To 600 'lock
                    If Chances > 0 And Betlevel <> LockLevel Then
                        LockLevel = Betlevel
                        Chances = Chances - 1
                    End If
                Case 650 To 850 'quit
                    Chances = -1
            End Select
        End If
    End If
    OldMB = mb
End Sub





Sub DrawProgress
    _Font font(32)
    Color Black, 0
    For y = 0 To 1
        For i = 0 To 5
            xc = i * 200 + 100: yc = 120 + 240 * y
            If y * 6 + i <= LockLevel Then
                CircleFill xc, yc, 90, Gold
            ElseIf y * 6 + i <= Betlevel Then
                CircleFill xc, yc, 90, Green
            Else
                CircleFill xc, yc, 90, Red

            End If
            _UPrintString (xc - _UPrintWidth(cash(y * 6 + i)) / 2, yc - _UFontHeight / 2), cash(y * 6 + i)
        Next
    Next
    Line (150, 500)-Step(200, 100), Red, BF
    _UPrintString (220, 534), "Bet"
    Line (400, 500)-Step(200, 100), Gold, BF
    _PrintString (420, 534), "Lock:" + Str$(Chances)
    Line (650, 500)-Step(200, 100), Green, BF
    _PrintString (710, 534), "Quit"
End Sub

Sub CircleFill (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
    ' CX = center x coordinate
    ' CY = center y coordinate
    ' R = radius
    ' C = fill color
    Dim Radius As Integer, RadiusError As Integer
    Dim X As Integer, Y As Integer
    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 Pause (time As _Float, exclude_code As Long)
    'exclude_code is the binary value of things we don't want to allow to break Pause
    '1 = Window lost focus
    '2= No Mouse breaking pause
    '4 - No Keyboard breaking pause
    '8 - No Keyup events break pause
    '16 - No modifier keys breaking pause (Shift/Ctrl/Alt)
    t# = Timer + time
    Do
        If time <> 0 And Timer > t# Then Exit Do
        If k <> 0 Then Exit Do
        _Limit 10 'we're a pause. We don't need to do a bunch of crap per second.
        If (exclude_code And 1) Then 'don't unpause until window has focus or time has ran out
            If _WindowHasFocus = 0 Then _Continue
        End If
        If (exclude_code And 2) = 0 Then 'mouse clicks break pause
            While _MouseInput: Wend
            If _MouseButton(1) Or _MouseButton(2) Then Exit Do
        End If
        If (exclude_code And 4) = 0 Then 'we allow keyboard input (of some sort) to break pause
            k = _KeyHit
            If (exclude_code And 8) Then If k < 0 Then k = 0 'but we don't allow keyup events to do it
            If (exclude_code And 16) Then 'here we don't allow modifier keys to do it
                Select Case k
                    Case 100304, 100303, -100304, -100303 'shift up/down
                        k = 0
                    Case 100306, 100305, -100306, -100305 'ctrl up/down
                        k = 0
                    Case 100308, 100307, -100308, -100307 'alt up/down
                        k = 0
                End Select
            End If
        End If
    Loop
End Sub

A little gambling game here, where you have a few basic options to try and sort out how to get the most reward out of your luck.

For starters, you start with $1000, which is yours to keep -- if you walk away right at this moment!

OR....

You can gamble on it, with 50/50 odds on whether you increase your pot, or not -- up to a maximum of $100000!

To add a strategy element to this little game, you can LOCK in your winnings, up to 3 times!   But the problem here is that once you bet and lose, that lock disappears, meaning you'll have to use another lock again if you want to keep your winnings safe -- and you only have a total of 3 locks in the game.

You can play as long as you have locks left, and money to bet.  Each time you bet and lose, you lose one of your locks, so you're only allowed a few failures in each game!

Now the question is:  How much money can you win?  How good is your luck, courage, and strategy??

(For the record, I suck at this type thing.  My highest winning so far has been $16,000 -- I can't even get down to the second line with my luck!  And most times, I end up winning $0.)  Big Grin
Reply


Messages In This Thread
Courage, Luck, or Strategy - by SMcNeill - 03-28-2024, 05:46 AM



Users browsing this thread: 1 Guest(s)