07-27-2023, 02:41 AM
And here is one Bplus made back then. This shows 3 shapes that fade, etc.
Code: (Select All)
_Title "b+ dimmer switch raise and lower mouse"
Screen _NewImage(1024, 700, 32)
_Delay .25
_ScreenMove _Middle
Type vec2
x As Single
y As Single
End Type
ReDim vert(1 To 4024) As vec2
'First Box
For i = 50 To 350 Step 25
vi = vi + 1
vert(vi).x = 50
vert(vi).y = i
vi = vi + 1
vert(vi).x = 350
vert(vi).y = i
If i <> 50 And i <> 350 Then
vi = vi + 1
vert(vi).x = i
vert(vi).y = 50
vi = vi + 1
vert(vi).x = i
vert(vi).y = 350
End If
Next
'Second Box
For i = 250 To 650 Step 25
vi = vi + 1
vert(vi).x = 250
vert(vi).y = i
vi = vi + 1
vert(vi).x = 650
vert(vi).y = i
If i <> 250 And i <> 650 Then
vi = vi + 1
vert(vi).x = i
vert(vi).y = 250
vi = vi + 1
vert(vi).x = i
vert(vi).y = 650
End If
Next
For a = 0 To _Pi(2) - .01 Step _Pi(1 / 30)
vi = vi + 1
vert(vi).x = 750 + 200 * Cos(a)
vert(vi).y = 350 + 200 * Sin(a)
Next
Do
Cls
While _MouseInput: Wend
my = _MouseY / _Height * 12
For power = 1 To my
For i = 1 To vi
For r = 1 To 25
If vert(i).x = 0 And vert(i).y = 0 Then 'where is that coming from?
Locate 1, 1: Print i
Else
fcirc vert(i).x, vert(i).y, r, _RGBA32(240, 230, 255, 3)
End If
Next
Next
Next
_Display
_Limit 60
Loop Until _KeyDown(27)
'from Steve Gold standard
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