06-16-2024, 01:39 PM
faster? better light for sure
Code: (Select All)
_Title "text over search light, move mouse wheel" 'started 2019-04-21 B+
Const xmax = 800
Const ymax = 600
Screen _NewImage(xmax, ymax, 32)
_ScreenMove _Middle
Dim txt(1 To 37) As String, v(1 To 37)
For i = 1 To 37
b$ = ""
For j = 1 To 100
b$ = b$ + Chr$(Int(Rnd * 96) + 32)
Next
txt(i) = b$: v(i) = Int(Rnd * 3) + 1
Next
r = 100
Color _RGB32(40, 20, 10), _RGBA32(0, 0, 0, 40)
While _KeyDown(27) = 0
Cls
Do While _MouseInput
r = r + _MouseWheel
Loop
mx = _MouseX: my = _MouseY
For i = r To 0 Step -1
fcirc mx, my, i, _RGB((r - i) ^ 1.2 / r * 255, (r - i) / r * 255, (r - i) / r * 255)
Next
For i = 1 To 37
txt(i) = Mid$(txt(i), v(i)) + Mid$(txt(i), 1, v(i) - 1)
Locate i, 1: Print Mid$(txt(i), 1, 100);
Next
_Display
_Limit 5
Wend
Sub fcirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
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
b = b + ...