Had some time to play with QB64PE today. Just for fun I put together a few routines previously made and this drawing thing is the result. Used the dust/particle system I made in the ballshoot game (changed it to use balls here), and a simple plasma pattern for the canvas image, and used the 'fc' filled circle SUB to draw the balls fast.
Use the mouse right button to draw lines of balls on the screen. SPACE clears screen, ESC quits.
It a simple program, just having a little QB64PE creative coding fun (been a long while....). I always seem to start with balls when I get back into coding for some reason.
- Dav
Use the mouse right button to draw lines of balls on the screen. SPACE clears screen, ESC quits.
It a simple program, just having a little QB64PE creative coding fun (been a long while....). I always seem to start with balls when I get back into coding for some reason.
- Dav
Code: (Select All)
'============
'BallDraw.bas
'============
'Coded by Dav, NOV/2025
'Simple ball drawing program, draws colored balls.
'SPACE clears screen, ESC quits.
Randomize Timer
Screen _NewImage(_DesktopHeight, Int(_DesktopHeight * .75), 32)
canvas& = _NewImage(_DesktopHeight, Int(_DesktopHeight * .75), 32)
_Title "BALLDRAW: Use Mouse to draw, SPACE clears, ESC ends"
MaxBalls = 1000
BallCount = 0
gravity = .1
strength = 4
Dim Ballx(MaxBalls), Bally(MaxBalls)
Dim BallXvel(MaxBalls), BallYvel(MaxBalls), BallRadius(MaxBalls)
Dim BallRed(MaxBalls), BallBlue(MaxBalls), BallGreen(MaxBalls), BallAlpha(MaxBalls)
'=========
startover:
'=========
'Draw pretty background on canvas image
_Dest canvas&
For y = 0 To _Height Step 3
For x = 0 To _Width Step 3
r = Int(128 + 127 * Sin(x / 15) + 127 * Cos(y / 15))
g = Int(128 + 127 * Sin(x / 25 * 1.5) + 127 * Cos(y / 25 * 1.5))
b = Int(128 + 127 * Sin(x / 35 * 2) + 127 * Cos(y / 35 * 2))
Line (x, y)-Step(2, 2), _RGBA(r / 3, g / 3, b / 3, 100), BF
Next
Next
'back to main screen, do main loop
_Dest 0
Do
_PutImage (0, 0), canvas& 'put canvas image on main screen first
While _MouseInput: Wend
If _MouseButton(1) Then
'draw a ball on canvas image
_Dest canvas&
fc _MouseX, _MouseY, 8 + (Rnd * 7), _RGBA(Rnd * 255, Rnd * 255, Rnd * 255, 255), 1
_Dest 0
For i = 1 To strength
If BallCount < MaxBalls Then
BallCount = BallCount + 1
Ballx(BallCount) = _MouseX
Bally(BallCount) = _MouseY
BallXvel(BallCount) = Rnd * 5 - 2.5
BallYvel(BallCount) = Rnd * 5 - 2.5
BallRadius(BallCount) = 15
BallRed(BallCount) = Rnd * 255
BallGreen(BallCount) = Rnd * 255
BallBlue(BallCount) = Rnd * 255
BallAlpha(BallCount) = 255
End If
Next
End If
'draw balls
For i = 1 To BallCount
BallYvel(i) = BallYvel(i) + gravity
Ballx(i) = Ballx(i) + BallXvel(i)
Bally(i) = Bally(i) + BallYvel(i)
If BallAlpha(i) > 0 Then
fc Ballx(i), Bally(i), BallRadius(i), _RGBA(BallRed(i), BallGreen(i), BallBlue(i), BallAlpha(i)), 0
BallRadius(i) = BallRadius(i) * .96 'radius shrink rate
BallAlpha(i) = BallAlpha(i) - 2
End If
Next
'clean out balls fully faded out or too small
For i = BallCount To 1 Step -1
If BallAlpha(i) <= 0 Or BallRadius(i) < 1 Then
BallCount = BallCount - 1
For j = i To BallCount
Ballx(j) = Ballx(j + 1)
Bally(j) = Bally(j + 1)
BallXvel(j) = BallXvel(j + 1)
BallYvel(j) = BallYvel(j + 1)
BallRadius(j) = BallRadius(j + 1)
BallRed(j) = BallRed(j + 1)
BallGreen(j) = BallGreen(j + 1)
BallBlue(j) = BallBlue(j + 1)
BallAlpha(j) = BallAlpha(j + 1)
Next
End If
Next
k$ = InKey$
If k$ = " " Then
_Dest canvas&: Cls: _Dest 0: Cls
GoTo startover
End If
If k$ = Chr$(27) Then Exit Do
_Display
_Limit 30
Loop
Sub fc (cx As Integer, cy As Integer, radius As Integer, clr~&, grad)
If radius = 0 Then Exit Sub ' safety bail
If grad = 1 Then
red = _Red32(clr~&)
grn = _Green32(clr~&)
blu = _Blue32(clr~&)
alpha = _Alpha32(clr~&)
End If
r2 = radius * radius
For y = -radius To radius
x = Abs(Sqr(r2 - y * y))
If grad = 1 Then
For i = -x To x
dis = Sqr(i * i + y * y) / radius
red2 = red * (1 - dis) + (red / 2) * dis
grn2 = grn * (1 - dis) + (grn / 2) * dis
blu2 = blu * (1 - dis) + (blu / 2) * dis
clr2~& = _RGBA(red2, grn2, blu2, alpha)
Line (cx + i, cy + y)-(cx + i, cy + y), clr2~&, BF
Next
Else
Line (cx - x, cy + y)-(cx + x, cy + y), clr~&, BF
End If
Next
End Sub