Post by bplus on Jan 22, 2023 21:42:48 GMT
Goofing around today on another forum came up with a version of this. Tried in "QBJS" but a few objections...
Anyway for dobox
Anyway for dobox
'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("dbox")) / 2, (200 - _FontHeight(d)) / 2 + 10), "dbox"
_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
Ha! couldn't do bplus and did another one first at Aurel's forum, but why not share the fun here with someone this forum should know!