Summer LASER Challenge
#33
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
Reply


Messages In This Thread
Summer LASER Challenge - by TerryRitchie - 07-15-2023, 07:32 PM
RE: Summer LASER Challenge - by bplus - 07-15-2023, 08:10 PM
RE: Summer LASER Challenge - by TerryRitchie - 07-15-2023, 09:48 PM
RE: Summer LASER Challenge - by justsomeguy - 07-15-2023, 09:27 PM
RE: Summer LASER Challenge - by TerryRitchie - 07-15-2023, 09:49 PM
RE: Summer LASER Challenge - by Dav - 07-15-2023, 11:44 PM
RE: Summer LASER Challenge - by TerryRitchie - 07-16-2023, 01:34 AM
RE: Summer LASER Challenge - by GareBear - 07-15-2023, 11:54 PM
RE: Summer LASER Challenge - by Dav - 07-16-2023, 01:42 AM
RE: Summer LASER Challenge - by TerryRitchie - 07-16-2023, 01:58 AM
RE: Summer LASER Challenge - by bplus - 07-16-2023, 02:34 AM
RE: Summer LASER Challenge - by mnrvovrfc - 07-16-2023, 03:35 AM
RE: Summer LASER Challenge - by bplus - 07-16-2023, 02:21 PM
RE: Summer LASER Challenge - by TerryRitchie - 07-17-2023, 02:12 AM
RE: Summer LASER Challenge - by bplus - 07-17-2023, 02:47 PM
RE: Summer LASER Challenge - by TerryRitchie - 07-17-2023, 02:58 PM
RE: Summer LASER Challenge - by SpriggsySpriggs - 07-17-2023, 03:29 PM
RE: Summer LASER Challenge - by TerryRitchie - 07-17-2023, 04:51 PM
RE: Summer LASER Challenge - by bplus - 07-17-2023, 04:22 PM
RE: Summer LASER Challenge - by TerryRitchie - 07-17-2023, 04:34 PM
RE: Summer LASER Challenge - by bplus - 07-17-2023, 05:00 PM
RE: Summer LASER Challenge - by bplus - 07-17-2023, 06:38 PM
RE: Summer LASER Challenge - by bplus - 07-17-2023, 06:43 PM
RE: Summer LASER Challenge - by bplus - 07-18-2023, 02:58 PM
RE: Summer LASER Challenge - by bplus - 07-19-2023, 01:14 AM
RE: Summer LASER Challenge - by James D Jarvis - 07-20-2023, 02:28 AM
RE: Summer LASER Challenge - by bplus - 07-20-2023, 12:44 PM
RE: Summer LASER Challenge - by Dav - 07-21-2023, 03:00 AM
RE: Summer LASER Challenge - by bplus - 07-21-2023, 03:56 PM
RE: Summer LASER Challenge - by grymmjack - 07-21-2023, 04:46 PM
RE: Summer LASER Challenge - by bplus - 07-21-2023, 04:59 PM
RE: Summer LASER Challenge - by SierraKen - 07-27-2023, 02:38 AM
RE: Summer LASER Challenge - by bplus - 07-27-2023, 01:49 PM
RE: Summer LASER Challenge - by SierraKen - 07-27-2023, 02:41 AM
RE: Summer LASER Challenge - by TerryRitchie - 07-27-2023, 11:56 PM
RE: Summer LASER Challenge - by Dav - 07-28-2023, 12:48 AM
RE: Summer LASER Challenge - by bplus - 07-28-2023, 01:20 PM
RE: Summer LASER Challenge - by dbox - 07-28-2023, 06:56 PM
RE: Summer LASER Challenge - by bplus - 07-28-2023, 09:23 PM
RE: Summer LASER Challenge - by SierraKen - 07-29-2023, 10:13 PM
RE: Summer LASER Challenge - by OldMoses - 07-30-2023, 01:02 PM
RE: Summer LASER Challenge - by bplus - 07-30-2023, 02:28 PM
RE: Summer LASER Challenge - by bplus - 07-30-2023, 06:57 PM



Users browsing this thread: 13 Guest(s)