Simple drawing that fades to background.

[bplus]

Yeah, Fellippe taught us that trick with fireworks and stars at warp speed.

It is nice for allot of things.

Code: (Select All)

_Title "Starfield Simulation"

Dim Shared Width As Integer
Dim Shared Height As Integer
Dim Shared CenterX As Integer
Dim Shared CenterY As Integer

CreateCanvas 600, 600
Window (-Width, -Height)-(Width, Height)

' Translate the Star Class into a UDT (User Defined Type)
Type newStar
    x As Single
    y As Single

    z As Single
    pz As Single
End Type

' Define how many Stars
Dim Shared starCount As Integer
starCount = 800

' Setup the Stars
Dim Shared Stars(starCount) As newStar

For i = 1 To starCount
    Stars(i).x = p5random(-Width, Width)
    Stars(i).y = p5random(-Height, Height)

    Stars(i).z = p5random(0, Width)
    Stars(i).pz = Stars(i).z
Next

Dim Shared Speed As Integer
Speed = 5

Do
    _Limit 60

    Line (-_Width, -_Height)-(Width - 1, Height - 1), _RGBA32(0, 0, 0, 30), BF

    For i = 1 To starCount
        Stars(i).z = Stars(i).z - Speed

        If Stars(i).z < 1 Then
            Stars(i).x = p5random(-Width, Width)
            Stars(i).y = p5random(-Width, Height)

            Stars(i).z = Width
            Stars(i).pz = Stars(i).z
        End If

        sx = map(Stars(i).x / Stars(i).z, 0, 1, 0, Width)
        sy = map(Stars(i).y / Stars(i).z, 0, 1, 0, Height)
        Circle (sx, sy), map(Stars(i).z, 0, Width, 2, 0)

        px = map(Stars(i).x / Stars(i).pz, 0, 1, 0, Width)
        py = map(Stars(i).y / Stars(i).pz, 0, 1, 0, Height)
        Stars(i).pz = Stars(i).z
        Line (px, py)-(sx, sy)
    Next

    _Display
Loop Until Done

' p5.js Functions
Function map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
End Function

Function p5random! (mn!, mx!)
    If mn! > mx! Then
        Swap mn!, mx!
    End If

    p5random! = Rnd * (mx! - mn!) + mn!
End Function

Sub CreateCanvas (x As Integer, y As Integer)
    ' Define the screen
    Width = x
    Height = y

    ' Center of the screen
    CenterX = x \ 2
    CenterY = y \ 2

    ' Create the screen
    Screen _NewImage(Width, Height, 32)
End Sub

Here's a mod with Ken:

Code: (Select All)

Option _Explicit
'Thanks to Ken for inspiring mod fun!
'Thanks to Bplus on the QB64.org forum for the trail code.
'Made on Aug. 30, 2019 by Ken G. mod by B+

'        GLOBALS
Const glow = &H08FFFFFF, nFlies = 20
Type flyType
    cx As Single
    cy As Single
    r As Integer
    c As _Unsigned Long
End Type

'     LOCALS for main code which is all this is!
Dim i, seconds, s, x, y

_Title "Fireflies that glow"
Screen _NewImage(800, 600, 32)
Randomize Timer

'setup flies
Dim f(1 To nFlies) As flyType
For i = 1 To nFlies
    f(i).cx = Rnd * 170 + 10
    f(i).cy = Rnd * 170 + 10
    f(i).r = Int(Rnd * 5) + 1
    f(i).c = _RGB32(Rnd * 190 + 60, Rnd * 190 + 60, Rnd * 190 + 60)
Next

Do
    Line (0, 0)-(_Width, _Height), _RGBA32(0, 0, 0, 50), BF ' trails a little less to show off glow
    For i = 1 To nFlies
        seconds = seconds + .005 'slow down a tad
        s = (60 - seconds) * 6 + 180 '???????????????? but it works!!
        x = Int(Sin(s / f(i).cx * 3.141592) * 3 * f(i).cx) + 400 ' the * 3 and * 2 below spread flies over screen better
        y = Int(Cos(s / f(i).cy * 3.141592) * 2 * f(i).cy) + 300
        fcirc x, y, f(i).r * 5, glow
        fcirc x, y, f(i).r, f(i).c
    Next
    If InKey$ = Chr$(27) Then End
    _Limit 100
    _Display
Loop

'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