Thread Rating:
  • 1 Vote(s) - 2 Average
  • 1
  • 2
  • 3
  • 4
  • 5
color wheel animation / screensaver
#2
Here's a simpler version using HSL color. Still not seeing enough oranges/purples/yellows!
I think timing is the key. 
Code: (Select All)
_Title "Color wheel" ' madscijr 2025-04-19

Const fps = 120
Const cShowValues = _FALSE

Type PointType
    x As Long
    y As Long
    d As Integer
End Type

Dim xmin, ymin As Integer
Dim xmax, ymax As Integer
Dim dx, dy As Integer
Dim OldMouseX, OldMouseY As Integer
Dim arr(1 To 2) As PointType
Dim i As Integer
Dim count As Integer
Dim m$
Dim hue#
Dim dhue#
Dim sat#
Dim dsat#
Dim c~&

Randomize Timer
xmin = 0: ymin = 0: xmax = 640: ymax = 480
'xmax = _DesktopWidth - 1: ymax = _DesktopHeight - 1

Screen _NewImage(xmax, ymax, 32)
_FullScreen

_Delay 2 ' wait a couple seconds before getting mouse coords
While _MouseInput: Wend: OldMouseX = _MouseX: OldMouseY = _MouseY ' initial mouse placement

arr(1).x = 0: arr(1).y = 0: arr(1).d = 1
arr(2).x = xmax: arr(2).y = ymax: arr(2).d = 3
dx = 1: dy = 1
count = 0
hue# = 0
dhue# = 1
sat# = 0
dsat# = -.25

While _KeyDown(27) = 0
    ''color32value~& = _HSBA32(hue#, saturation#, brightness#, alpha#)
    c~& = _HSBA32(hue#, sat#, 100, 100)
    Line (arr(1).x, arr(1).y)-(arr(2).x, arr(2).y), c~&

    For i = 1 To 2
        Select Case arr(i).d
            Case 1:
                arr(i).x = arr(i).x + dx
                If arr(i).x >= xmax Then arr(i).x = xmax: arr(i).d = 2
            Case 2:
                arr(i).y = arr(i).y + dy
                If arr(i).y >= ymax Then arr(i).y = ymax: arr(i).d = 3
            Case 3:
                arr(i).x = arr(i).x - dx
                If arr(i).x <= xmin Then arr(i).x = xmin: arr(i).d = 4
            Case 4:
                arr(i).y = arr(i).y - dy
                If arr(i).y <= ymin Then arr(i).y = ymin: arr(i).d = 1: 'count = count + 1
        End Select
    Next i

    hue# = hue# + dhue#
    If hue# > 359 Then
        hue# = 0
    End If

    sat# = sat# + dsat#
    If sat# <= 0 Then
        sat# = 0: dsat# = -dsat#
    ElseIf dsat# >= 100 Then
        dsat# = 100: dsat# = -dsat#
    End If

    ' If user moves mouse, quit
    While _MouseInput: Wend: If _MouseX <> OldMouseX Or _MouseY <> OldMouseY Then Exit While

    _Display
    '_Limit fps
Wend

'_AutoDisplay
'Sleep

System
Reply


Messages In This Thread
color wheel animation / screensaver - by madscijr - 04-19-2025, 10:42 PM
RE: color wheel animation / screensaver - by madscijr - 04-20-2025, 12:00 AM

Possibly Related Threads…
Thread Author Replies Views Last Post
  Wireframe animation SquirrelMonkey 4 700 08-10-2025, 10:12 PM
Last Post: TempodiBasic
  Pringle-like Shape Animation SierraKen 0 484 05-24-2025, 12:38 AM
Last Post: SierraKen
  computing color gradients / color transitions demo madscijr 2 784 04-30-2025, 04:17 AM
Last Post: madscijr
  Ball Screensaver SMcNeill 5 1,308 09-20-2024, 07:15 PM
Last Post: Pete
  Spining spiral wheel Dav 4 1,355 09-25-2023, 01:15 AM
Last Post: CharlieJV

Forum Jump:


Users browsing this thread: 1 Guest(s)