+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Balls rain from the top, some bouce then sink away. (/showthread.php?tid=2058)
Balls rain from the top, some bouce then sink away. - Dav - 10-03-2023
I'm sure making this kind of thing is a piece of cake to a lot of you, but it was a learning experience for me. Had a little help on it.
Balls rain from the top, some bounce with gravity, then sink away.
- Dav
Code: (Select All)
'============
'BALLRAIN.BAS
'============
'Balls rain from the top, some drop, some bounce then sink away.
'For QB64 by Dav, SEP/2023
SCREEN _NEWIMAGE(1000, 600, 32)
balls = 200 'number of balls on screen, 200 is my laptop's comfort zone
DIM ballx(balls), bally(balls), ballxvel(balls), ballyvel(balls), ballsize(balls)
DIM ballred(balls), ballgrn(balls), ballblu(balls)
'make random ball values
FOR b = 1 TO balls
ballx(b) = RND * (_WIDTH) 'x position
bally(b) = RND * -(_HEIGHT) 'y position
ballxvel(b) = INT(RND * 7) 'x speed
ballyvel(b) = INT(RND * 3) 'y speed
ballsize(b) = RND * 15 + 10 'ball size
ballred(b) = RND * 255 'red color
ballgrn(b) = RND * 255 'green color
ballblu(b) = RND * 255 'blue color
NEXT
DO
CLS
FOR b = 1 TO balls
IF bally(b) < _HEIGHT - ballsize(b) THEN
ballx(b) = ballx(b) + ballxvel(b)
bally(b) = bally(b) + ballyvel(b)
IF ballx(b) < ballsize(b) OR ballx(b) > _WIDTH - ballsize(b) THEN
ballxvel(b) = -ballxvel(b)
END IF
IF bally(b) < ballsize(b) OR bally(b) > _HEIGHT - (ballsize(b) * 2) THEN
ballyvel(b) = -ballyvel(b)
END IF
ballyvel(b) = ballyvel(b) + 3 'gravity value
'ballxvel(b) = ballxvel(b) + (Rnd * 1.2 - Rnd * 1.2) 'x shake
'draw gradient ball
FOR y2 = bally(b) - ballsize(b) TO bally(b) + ballsize(b)
FOR x2 = ballx(b) - ballsize(b) TO ballx(b) + ballsize(b)
clr = (ballsize(b) - (SQR((x2 - ballx(b)) * (x2 - ballx(b)) + (y2 - bally(b)) * (y2 - bally(b))))) / ballsize(b)
IF clr > 0 THEN PSET (x2, y2), _RGB(clr * ballred(b), clr * ballgrn(b), clr * ballblu(b))
NEXT
NEXT
END IF
NEXT
'see if balls done
onscreen = 0
FOR b = 1 TO balls
IF bally(b) < _HEIGHT - ballsize(b) THEN onscreen = 1
NEXT
IF onscreen = 0 THEN EXIT DO
_DISPLAY
_LIMIT 24
LOOP
RE: Balls rain from the top, some bouce then sink away. - Dav - 10-03-2023
A lot faster using Hardware images!
- Dav
Code: (Select All)
'=============
'BALLRAIN2.BAS - v2 uses hardware images for speed
'=============
'Balls rain from the top, some drop, some bounce then sink away.
'For QB64 by Dav, SEP/2023
Screen _NewImage(1000, 600, 32)
balls = 500 'number of balls on screen, 200 is my laptop's comfort zone
Dim ballx(balls), bally(balls), ballxvel(balls), ballyvel(balls), ballsize(balls)
Dim ballred(balls), ballgrn(balls), ballblu(balls)
Dim ballImage&(balls)
'make random ball values
For b = 1 To balls
ballx(b) = Rnd * (_Width) 'x position
bally(b) = Rnd * -(_Height) 'y position
ballxvel(b) = Int(Rnd * 7) 'x speed
ballyvel(b) = Int(Rnd * 3) 'y speed
ballsize(b) = Rnd * 35 + 10 'ball size
ballred(b) = Rnd * 255 'red color
ballgrn(b) = Rnd * 255 'green color
ballblu(b) = Rnd * 255 'blue color
Next
'make ball hardware images
For b = 1 To balls
temp& = _NewImage(ballsize(b) * 2, ballsize(b) * 2, 32)
_Dest temp&
'draw gradient ball
x = _Width(temp&) / 2: y = _Height(temp&) / 2
For y2 = y - ballsize(b) To y + ballsize(b)
For x2 = x - ballsize(b) To x + ballsize(b)
clr = (ballsize(b) - (Sqr((x2 - x) * (x2 - x) + (y2 - y) * (y2 - y)))) / ballsize(b)
If clr > 0 Then PSet (x2, y2), _RGB(clr * ballred(b), clr * ballgrn(b), clr * ballblu(b))
Next
Next
ballImage&(b) = _CopyImage(temp&, 33)
_FreeImage temp&
Next
_Dest 0
Do
Cls
For b = 1 To balls
If bally(b) < _Height - ballsize(b) Then
ballx(b) = ballx(b) + ballxvel(b)
bally(b) = bally(b) + ballyvel(b)
If ballx(b) < ballsize(b) Or ballx(b) > _Width - ballsize(b) Then
ballxvel(b) = -ballxvel(b)
End If
If bally(b) < ballsize(b) Or bally(b) > _Height - (ballsize(b) * 2) Then
ballyvel(b) = -ballyvel(b)
End If
ballyvel(b) = ballyvel(b) + 3 'gravity value
'ballxvel(b) = ballxvel(b) + (Rnd * 1.2 - Rnd * 1.2) 'x shake
_PutImage (ballx(b), bally(b)), ballImage&(b)
End If
Next
'see if balls done
onscreen = 0
For b = 1 To balls
If bally(b) < _Height - ballsize(b) Then onscreen = 1
Next
If onscreen = 0 Then Exit Do
_Display
_Limit 24
Loop
RE: Balls rain from the top, some bouce then sink away. - CharlieJV - 10-04-2023
(10-03-2023, 01:05 PM)Dav Wrote: I'm sure making this kind of thing is a piece of cake to a lot of you, but it was a learning experience for me. Had a little help on it.
Balls rain from the top, some bounce with gravity, then sink away.
- Dav
Code: (Select All)'============
'BALLRAIN.BAS
'============
'Balls rain from the top, some drop, some bounce then sink away.
'For QB64 by Dav, SEP/2023
SCREEN _NEWIMAGE(1000, 600, 32)
balls = 200 'number of balls on screen, 200 is my laptop's comfort zone
DIM ballx(balls), bally(balls), ballxvel(balls), ballyvel(balls), ballsize(balls)
DIM ballred(balls), ballgrn(balls), ballblu(balls)
'make random ball values
FOR b = 1 TO balls
ballx(b) = RND * (_WIDTH) 'x position
bally(b) = RND * -(_HEIGHT) 'y position
ballxvel(b) = INT(RND * 7) 'x speed
ballyvel(b) = INT(RND * 3) 'y speed
ballsize(b) = RND * 15 + 10 'ball size
ballred(b) = RND * 255 'red color
ballgrn(b) = RND * 255 'green color
ballblu(b) = RND * 255 'blue color
NEXT
DO
CLS
FOR b = 1 TO balls
IF bally(b) < _HEIGHT - ballsize(b) THEN
ballx(b) = ballx(b) + ballxvel(b)
bally(b) = bally(b) + ballyvel(b)
IF ballx(b) < ballsize(b) OR ballx(b) > _WIDTH - ballsize(b) THEN
ballxvel(b) = -ballxvel(b)
END IF
IF bally(b) < ballsize(b) OR bally(b) > _HEIGHT - (ballsize(b) * 2) THEN
ballyvel(b) = -ballyvel(b)
END IF
ballyvel(b) = ballyvel(b) + 3 'gravity value
'ballxvel(b) = ballxvel(b) + (Rnd * 1.2 - Rnd * 1.2) 'x shake
'draw gradient ball
FOR y2 = bally(b) - ballsize(b) TO bally(b) + ballsize(b)
FOR x2 = ballx(b) - ballsize(b) TO ballx(b) + ballsize(b)
clr = (ballsize(b) - (SQR((x2 - ballx(b)) * (x2 - ballx(b)) + (y2 - bally(b)) * (y2 - bally(b))))) / ballsize(b)
IF clr > 0 THEN PSET (x2, y2), _RGB(clr * ballred(b), clr * ballgrn(b), clr * ballblu(b))
NEXT
NEXT
END IF
NEXT
'see if balls done
onscreen = 0
FOR b = 1 TO balls
IF bally(b) < _HEIGHT - ballsize(b) THEN onscreen = 1
NEXT
IF onscreen = 0 THEN EXIT DO
_DISPLAY
_LIMIT 24
LOOP
That's a great little proggie, Dav.
Ported to BAM:
- https://basicanywheremachine.neocities.org/sample_programs/Raining%20Balls.prod.run
- https://basicanywheremachine.neocities.org/sample_programs/Raining%20Balls.prod.bas
RE: Balls rain from the top, some bouce then sink away. - johnno56 - 10-04-2023
Dav,
Either version is SO cool. Good job!!
Charlie,
Well done porting to BAM!!
J
RE: Balls rain from the top, some bouce then sink away. - Dav - 10-04-2023
Thanks, @CharlieJV. Good port! You may use anything I post for your great BAM project!
Thanks, @Johnno56! Amazing how much faster the hardware balls go on my laptop than the drawing ones.
- Dav
RE: Balls rain from the top, some bouce then sink away. - CharlieJV - 10-05-2023
(10-04-2023, 11:50 PM)Dav Wrote: Thanks, @CharlieJV. Good port! You may use anything I post for your great BAM project!
Thanks, @Johnno56! Amazing how much faster the hardware balls go on my laptop than the drawing ones.
- Dav
Man, negligible effort at best, and I did not mind the zero challenge one bit. No fuss no muss get straight to the enjoyment.
An outer loop added to your code, I'm embarrassed to call that a mod. Admittedly, I do like the "please sir, may I have some more" automagic that just keeps on going while I sit back in a state of awe. That is right zen stuff, Dav.
RE: Balls rain from the top, some bouce then sink away. - CharlieJV - 10-05-2023
(10-04-2023, 07:16 PM)johnno56 Wrote: Dav,
Either version is SO cool. Good job!!
Charlie,
Well done porting to BAM!!
J
That is a nice little proggie by Dav, eh?
Me, I'd like to say I'm standing tall on Dav's shoulders, but I barely did enough there to say I have my arms wrapped around his ankles.