QB64 Phoenix Edition
Simple drawing that fades to background. - Printable Version

+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: Simple drawing that fades to background. (/showthread.php?tid=1041)



Simple drawing that fades to background. - Dav - 11-04-2022

Started playing with a smooth drawing routine and a screen fading method.  Curious as to what could become of using this method.  

- Dav

Code: (Select All)
'Simple drawing that fades to background.
'Coded by Dav, NOV/2022

SCREEN _NEWIMAGE(1000, 800, 32)

DO
    WHILE _MOUSEINPUT: WEND
    mx = _MOUSEX: my = _MOUSEY
    mb1 = _MOUSEBUTTON(1)
    IF mb1 THEN
        IF stilldown = 1 THEN
            stepx = lastmx - mx
            stepy = lastmy - my
            length = INT((stepx ^ 2 + stepy ^ 2) ^ .5)
            dx = stepx / length
            dy = stepy / length
            FOR i = 0 TO length
                FOR d = 1 TO size%
                    CIRCLE (mx + dx * i, my + dy * i), d, clr&
                NEXT
            NEXT
        ELSE
            size% = RND * 20 + 5                         '<=== brush size
            clr& = _RGB(RND * 255, RND * 255, RND * 255) '<=== brush color
            FOR d = 1 TO size% STEP .2
                CIRCLE (mx, my), d, clr&
            NEXT
        END IF
        lastmx = mx: lastmy = my
        stilldown = 1
    ELSE
        stilldown = 0
    END IF
    LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA(32, 32, 32, 32), BF
    _DISPLAY
    _LIMIT 30
LOOP



RE: Simple drawing that fades to background. - mnrvovrfc - 11-04-2022

This is pretty cool. It doesn't fade to whole-black. There are artifacts left which could be barely seen. That could be put to good use...


RE: Simple drawing that fades to background. - Pete - 11-05-2022

Dav,

I don't see any set delay. The fade is very smooth on my clunky CPU laptop, but I wonder on a much faster machine if there would be a difference, or is the _LIMIT 30 enough to keep the results consistent regardless of the for/loop speed?

Pete


RE: Simple drawing that fades to background. - Dav - 11-05-2022

Pete: Can’t say for sure since all my laptops I can test on are slow clunkers too, but I think it should be the same on a faster machine. The _LIMIT 30 should keep it under control.  Perhaps someone with a screamer machine can give it a whirl.

mnrvovfc: yeah I was thinking of making it a burning effect maybe. When I get back home I’m going to use this fade out LINE thing on some of my screensavers and see they will turn into.

- Dav


RE: Simple drawing that fades to background. - Dav - 11-05-2022

When used just right I think the LINE box screen fading can add a new twist to some otherwise boring screen savers.  Adds a nice fading tail on bouncing objects, a blurry effect.  Some more playing around below.  Just some short graphics fun...

- Dav

Code: (Select All)
SCREEN _NEWIMAGE(800, 600, 32)

DO
    v = RND * 100 + 5
    FOR t = 1 TO (_WIDTH / 2) STEP v
        x1 = (COS(t) * z) + (_WIDTH / 2)
        y1 = (SIN(t) * z) + (_HEIGHT / 2)
        c = _RGB(r, g, b)
        CIRCLE (x1, y1), z / v, c
        PAINT (x1, y1), c
        z = z + 1: IF z > (_WIDTH / 2) * 1.1 THEN z = 1
        r = r + 1: IF r > 255 THEN r = RND * 255
        g = g + 1: IF g > 255 THEN g = RND * 255
        b = b + 1: IF b > 255 THEN b = RND * 255
    NEXT
    LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA(0, 0, 0, 15), BF
    _DISPLAY
    _LIMIT 30
LOOP



RE: Simple drawing that fades to background. - bplus - 11-05-2022

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



RE: Simple drawing that fades to background. - Pete - 11-05-2022

The first one reminds me a little bit of Star master. The second, reproduction. That's not a video game, but if it was a video game, it would require a fully functioning joystick to play. What's that Steve? Report to H.R. Oh not again!

Pete


RE: Simple drawing that fades to background. - SMcNeill - 11-05-2022

Here's how I tend to do a simple little screen fade routine:

Code: (Select All)
Screen _NewImage(1024, 720, 32)

Color -1 'white

Do
    While _MouseInput: Wend
    mx = _MouseX: my = _MouseY
    If _MouseButton(1) Then
        If oldx = 0 And oldy = 0 Then
            PSet (mx, my)
        Else
            Line (oldx, oldy)-(mx, my)
        End If
        oldx = mx: oldy = my
    End If
    Line (0, 0)-(_Width, _Height), &H20000000, BF 'low alpha black
    _Limit 10
Loop Until _MouseButton(2) Or _KeyHit

Use the mouse, press the button, and move the pointer. You'll scribble lines on the screen which will slowly fade off into oblivion behind you as you go.

I call this demo "Scribble Fade!"


RE: Simple drawing that fades to background. - Pete - 11-05-2022

Works as advertised. I scribbled "Steve is awesome!" and it faded way before anyone else could see it. Once again another shining example of art imitating life. Big Grin

Pete

Faded memories come with age. I find a 50 year old Scotch whiskey to be about the right age to make that happen.