Where's Pete?

[bplus]

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