Posts: 728
Threads: 119
Joined: Apr 2022
Reputation:
106
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
Posts: 1,586
Threads: 59
Joined: Jul 2022
Reputation:
52
11-04-2022, 10:37 PM
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...
Posts: 2,171
Threads: 222
Joined: Apr 2022
Reputation:
103
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
Posts: 728
Threads: 119
Joined: Apr 2022
Reputation:
106
11-05-2022, 01:00 AM
(This post was last modified: 11-05-2022, 01:07 AM by Dav.)
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
Posts: 728
Threads: 119
Joined: Apr 2022
Reputation:
106
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
Posts: 3,965
Threads: 176
Joined: Apr 2022
Reputation:
219
11-05-2022, 04:31 AM
(This post was last modified: 11-05-2022, 05:19 AM by 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
b = b + ...
Posts: 2,171
Threads: 222
Joined: Apr 2022
Reputation:
103
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
Posts: 2,696
Threads: 327
Joined: Apr 2022
Reputation:
217
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!"
Posts: 2,171
Threads: 222
Joined: Apr 2022
Reputation:
103
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.
Pete
Faded memories come with age. I find a 50 year old Scotch whiskey to be about the right age to make that happen.
|