Smallish Games

[bplus]

Circle Flip Game

Like calling heads or tails call red or green side:

Code: (Select All)

_Title "Circle Flip Game" 'b+ 2024-09-12
Randomize Timer
Screen _NewImage(800, 600, 32)
_ScreenMove 250, 60
imgRed& = _NewImage(103, 103, 32)
_Dest imgRed&
FC3 51, 51, 50, &HFFFF0000
imgGrn& = _NewImage(103, 103, 32)
_Dest imgGrn&
FC3 51, 51, 50, &HFF008800
_Dest 0
While _KeyDown(27) = 0
    Locate 18, 20
    Print "Your score"; score; "in"; flips; "flips."
    Locate 20, 20
    Input "Enter r for red, g for green any else quits "; rg$
    If rg$ <> "r" And rg$ <> "g" Then End
    If Rnd < .5 Then img& = imgRed& Else img& = imgGrn&
    If img& = imgGrn& And rg$ = "g" Then score = score + 1
    If img& = imgRed& And rg$ = "r" Then score = score + 1
    flips = flips + 1
    start = 1: fini = 0: stepper = -.02
    cx = 180: cy = _Height - 50: dcy = -3
    Do
        For i = start To fini Step stepper
            Cls
            a = a + 1
            cx = cx + .8
            dcy = dcy + .009
            cy = cy + dcy
            If dcy = 0 Then dcy = -dcy
            RotoZoom23d cx, cy, img&, i, 1, a
            _Limit 240
            _Display
        Next
        If start = 1 Then
            start = 0: fini = 1: stepper = .02
            If img& = imgRed& Then img& = imgGrn& Else img& = imgRed& '  flip colors on odd cycles
        Else
            start = 1: fini = 0: stepper = -.02
        End If
    Loop Until dcy > 2.50
    _Delay 2
Wend

Sub RotoZoom23d (centerX As Long, centerY As Long, Image As Long, xScale As Single, yScale As Single, DRotation As Single)
    Dim As Single px(3), py(3), sinr, cosr ' thanks to James D Jarvis who fixed this on 2023/01/18
    Dim As Long IW, IH, i, x2, y2
    IW& = _Width(Image&): IH& = _Height(Image&)
    px(0) = -IW& / 2 * xScale: py(0) = -IH& / 2 * yScale: px(1) = -IW& / 2 * xScale: py(1) = IH& / 2 * yScale
    px(2) = IW& / 2 * xScale: py(2) = IH& / 2 * yScale: px(3) = IW& / 2 * xScale: py(3) = -IH& / 2 * yScale
    sinr! = Sin(-0.01745329 * DRotation): cosr! = Cos(-0.01745329 * DRotation)
    For i& = 0 To 3
        ' x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + centerX: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + centerY
        x2& = (px(i&) * cosr! + sinr! * py(i&)) + centerX: y2& = (py(i&) * cosr! - px(i&) * sinr!) + centerY
        px(i&) = x2&: py(i&) = y2&
    Next
    ' might not need Seamless?
    _MapTriangle _Seamless(0, 0)-(0, IH& - 1)-(IW& - 1, IH& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
    _MapTriangle _Seamless(0, 0)-(IW& - 1, 0)-(IW& - 1, IH& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
End Sub

Sub FC3 (cx, cy, r, clr~&) ' no suffix punctuation use the Global Default Type as Long or Single or Double
    Dim r2, x, y ' for Option _Explicit
    If r < 1 Then Exit Sub
    Line (cx - r, cy)-(cx + r, cy), clr~&, BF
    r2 = r * r
    Do
        y = y + 1
        x = Sqr(r2 - y * y)
        Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
        Line (cx - x, cy - y)-(cx + x, cy - y), clr~&, BF
    Loop Until y = r
End Sub