Paint droplet splatter generator for QB64 (qb64.org)

paintdrops.bas

Type DropDef
	Active As Integer
	XPos As Single
	YPos As Single
	ZPos As Single
	XVel As Single
	YVel As Single
	ZVel As Single
	Radius As Single
	Color As Long
End Type

Pi = 4 * Atn(1)
ScreenX = 1366
ScreenY = 768
FPS = 1
DropCount = 1
DropMax = 50000
Dim Droplets(DropMax) As DropDef

Randomize Timer
Screen _NewImage(ScreenX, ScreenY, 32)


'Initialize 1 droplet randomly
Droplets(1).Active = 1
Droplets(1).XPos = (ScreenX / 2)
Droplets(1).YPos = (ScreenY / 2)
Droplets(1).ZPos = 5
Droplets(1).XVel = 0 '(10 * RND) - 5
Droplets(1).YVel = 0 '(10 * RND) - 5
Droplets(1).ZVel = -1
Droplets(1).Radius = (2 * Rnd) + 2
Droplets(1).Color = _RGB32(128 * Rnd + 128, 128 * Rnd + 128, 128 * Rnd + 128)

Do
	'_LIMIT FPS
	AnyProcessed = 0

	For CurrentDrop = 1 To DropMax
		If Droplets(CurrentDrop).Active = 1 Then
			AnyProcessed = 1
			Droplets(CurrentDrop).XPos = Droplets(CurrentDrop).XPos + (Droplets(CurrentDrop).XVel / FPS)
			Droplets(CurrentDrop).YPos = Droplets(CurrentDrop).YPos + (Droplets(CurrentDrop).YVel / FPS)
			Droplets(CurrentDrop).ZPos = Droplets(CurrentDrop).ZPos + (Droplets(CurrentDrop).ZVel / FPS)
			Droplets(CurrentDrop).ZVel = Droplets(CurrentDrop).ZVel - (1 / FPS)
			'LOCATE 1, 1: PRINT DropCount

			If Droplets(CurrentDrop).ZPos <= 0 Then
				SplatRad = (4 / 3) * Pi * (Droplets(CurrentDrop).Radius ^ 3) * .25
				For r = 0 To SplatRad Step .25
					Circle (Droplets(CurrentDrop).XPos, Droplets(CurrentDrop).YPos), r, Droplets(CurrentDrop).Color
				Next
				Droplets(CurrentDrop).Active = 0

				If Droplets(CurrentDrop).Radius > 1 Then
					NewDropCount = DropCount + CInt((Droplets(CurrentDrop).Radius * 2) * Rnd + (Droplets(CurrentDrop).Radius * 3))
					For NewDrop = DropCount + 1 To NewDropCount
						If NewDrop > DropMax Then Exit For
						GoSub InitDrop
					Next
					DropCount = NewDropCount
				End If

			Else
				'PSET (Droplets(CurrentDrop).XPos, Droplets(CurrentDrop).YPos), Droplets(CurrentDrop).Color
			End If
		End If
	Next

Loop Until AnyProcessed = 0

Print "Another? [y/N]"
Do: k$ = InKey$: Loop Until k$ <> ""
If UCase$(k$) = "Y" Then Run Else End
End

InitDrop:
Droplets(NewDrop).Active = 1
Droplets(NewDrop).XPos = Droplets(CurrentDrop).XPos
Droplets(NewDrop).YPos = Droplets(CurrentDrop).YPos
Droplets(NewDrop).ZPos = 1
Droplets(NewDrop).XVel = ((10 * Rnd) - 5) + (Droplets(CurrentDrop).XVel * .75)
Droplets(NewDrop).YVel = ((10 * Rnd) - 5) + (Droplets(CurrentDrop).YVel * .75)
Droplets(NewDrop).ZVel = 1 + Rnd * Droplets(CurrentDrop).Radius
Droplets(NewDrop).Radius = Droplets(CurrentDrop).Radius * ((Rnd + .75) * .5)
Droplets(NewDrop).Color = Droplets(CurrentDrop).Color
Return