Where's Pete? - Printable Version

Code: (Select All)
'Option _Explicit

_Title "Signal" 'b+ 2023-01-23

Randomize Timer

Screen _NewImage(800, 600, 32)

Dim As Long d, spot, back, i, x, y, w, h, r, mx, my

Dim dx, dy

d = _LoadFont("ARIALBD.ttf", 64) ' <<<<  easy for Windows probably no one else sorry



spot = _NewImage(200, 200, 32)

_Dest spot

_Font d

_PrintMode _KeepBackground

Color _RGB32(0, 0, 0, 60)

_PrintString ((200 - _PrintWidth("Pete")) / 2, (200 - _FontHeight(d)) / 2 + 10), "Pete"

_Dest 0



back = _NewImage(800, 600, 32)

_Dest back

For y = 0 To 600

    Line (0, y)-(800, y), _RGB32(50, 0, y / 600 * 128)

Next

For i = 1 To 20

    w = Rnd * 100 + 30: y = Rnd * 200 + 400: x = Rnd * (800 - w)

    Line (x, y)-(x + w, 600), &HFF000000, BF

Next

Line (0, 550)-(800, 600), &HFF000000, BF

_Dest 0

r = 100

Do

    _PutImage , back, 0

    10 If _MouseInput Then GoTo 10

    mx = _MouseX: my = _MouseY

    For i = r To 0 Step -1

        fcirc mx, my, i, _RGB32(255, 255, 255, 1)

    Next

    h = ((mx + 10) ^ 2 + (my - 550) ^ 2) ^ .5

    dx = (mx + 10) / h: dy = (my - 550) / h

    For i = 0 To h Step 2

        fcirc -10 + i * dx, 550 + i * dy, i / h * 100, _RGB32(255, 255, 255, 1)

    Next

    _PutImage (mx - 100, my - 100), spot, 0

    _Display

    _Limit 30

Loop Until _KeyDown(27)



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

    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

                Line (CX - Y, CY + X)-(CX + Y, CY + X), C

            End If

            X = X - 1

            RadiusError = RadiusError - X * 2

        End If

        Y = Y + 1

        Line (CX - X, CY - Y)-(CX + X, CY - Y), C

        Line (CX - X, CY + Y)-(CX + X, CY + Y), C

    Wend

End Sub