' ****** START INCLUDE Rgba Core:::RgbaBox(x1%, y1%, x2%, y2%, c&, a%b) ******
DIM r0%, g0%, b0%, a0%, r1%, g1%, b1%, a1%
SUB SetRgb0(x%,y%)
DIM c$
c$ = RIGHT$("000000" + HEX$(POINT(x%,y%)), 6)
r0% = VAL("0x" + LEFT$(c$,2))
g0% = VAL("0x" + MID$(c$,3,2))
b0% = VAL("0x" + RIGHT$(c$,2))
END SUB
SUB SetRgb1(c&,a%b)
DIM c$
c$ = RIGHT$("000000" + HEX$(c&), 6)
r1% = VAL("0x" + LEFT$(c$,2))
g1% = VAL("0x" + MID$(c$,3,2))
b1% = VAL("0x" + RIGHT$(c$,2))
a0% = 255 - a%b
a1% = a%b
END SUB
SUB RgbaCorePset(x%,y%)
PSET(x%,y%), _RGB( [{ (r0%*a0%)+(r1%*a1%) }/255], [{ (g0%*a0%)+(g1%*a1%) }/255], [{ (b0%*a0%)+(b1%*a1%) }/255] )
END SUB
Sub RgbaBox (x1%, y1%, x2%, y2%, c&, a%b)
xd% = ABS(x2% - x1%)
yd% = ABS(y2% - y1%)
SetRgb1(c&, a%b)
IF xd% = 0 THEN
FOR i = MIN(y1%,y2%) to MAX(y1%,y2%): SetRgb0(x1%,i) : RgbaCorePset(x1%,i) : NEXT i
ELSEIF yd% = 0 THEN
FOR i = MIN(y1%,y2%) to MAX(y1%,y2%): SetRgb0(x1%,i) : RgbaCorePset(x1%,i) : NEXT i
ELSE
FOR x% = MIN(x1%,x2%) to MAX(x1%,x2%)
FOR y% = MIN(y1%,y2%) to MAX(y1%,y2%)
SetRgb0(x%,y%) : RgbaCorePset(x%,y%)
NEXT y%
NEXT x%
END IF
End Sub
' ****** END INCLUDE Rgba Core:::RgbaBox(x1%, y1%, x2%, y2%, c&, a%b) ******
' A QB64 program found at https://qb64.com/samples/rockets/
' BAM port by Charlie Veniot
' created with the development version of BAM
' This program exported from BASIC Anywhere Machine (Version [5.2.3].[2023.08.29.21.34]) on 2023.09.12 at 04:43 (Coordinated Universal Time)
'$NoPrefix
'Option Explicit
'Option ExplicitArray
'$Resize:Smooth
DefLng A-Z
Type vector
x As Single
y As Single
End Type
Type Particle
pos As vector
vel As vector
fade As Single
active As Byte
b As Single
End Type
Type rocket
x As Single
y As Single
xs As Single
ys As Single
dead As Byte
End Type
Const MaxExplosion = 60
UpperBoundRockets = 5
Dim rockets(5) As rocket
UpperBoundParticles = UpperBoundRockets * MaxExplosion * 100
Dim particles(UpperBoundParticles) As Particle
Dim As Long i, n, v, k
Randomize Timer
Screen _NewImage(400, 200, 32)
' FullScreen SquarePixels , Smooth
For i = 1 To UpperBoundParticles
particles(i).vel.x = Rnd * 2
particles(i).vel.y = Rnd * 2
particles(i).fade = Rnd * 3 + 1
particles(i).b = 255
If Rnd * 2 > 1 Then particles(i).vel.x = -particles(i).vel.x
If Rnd * 2 > 1 Then particles(i).vel.y = -particles(i).vel.y
Next
For i = 1 To UpperBoundRockets
rockets(i).y = _Height
rockets(i).x = Rnd * _Width
rockets(i).dead = -1
rockets(i).xs = Rnd * 4
rockets(i).ys = Rnd * 4
Next
Do
' Line (0, 0)-(_Width, _Height), _RGBA(0, 0, 0, 50), BF
CALL RgbaBox(0, 0, _Width-1, _Height-1, _RGB(0, 0, 0), 50)
For i = 1 To UpperBoundRockets
If rockets(i).dead Then
rockets(i).dead = 0
rockets(i).x = Rnd * _Width
rockets(i).y = _Height
rockets(i).xs = Rnd * 4
rockets(i).ys = Rnd * 4
Else
n = 0
bExitWhile = FALSE
While n < MaxExplosion AND bExitWhile = FALSE
v = v + 1
If v > UpperBoundParticles Then
v = 0: bExitWhile = TRUE
ElseIf Not particles(v).active Then
particles(v).pos.x = rockets(i).x: particles(v).pos.y = rockets(i).y: particles(v).active = -1: n = n + 1
end if
Wend
rockets(i).x = rockets(i).x + rockets(i).xs
rockets(i).y = rockets(i).y - rockets(i).ys
rockets(i).ys = rockets(i).ys + .1
rockets(i).xs = rockets(i).xs - .05
PSet (rockets(i).x, rockets(i).y)
If rockets(i).y < 0 Then rockets(i).dead = -1: k = k + 1
End If
Next
For i = 1 To UpperBoundParticles
If particles(i).active Then
PSet (particles(i).pos.x, particles(i).pos.y), _RGB(particles(i).b, particles(i).b, 0)
particles(i).pos.x = particles(i).pos.x + particles(i).vel.x
particles(i).pos.y = particles(i).pos.y + particles(i).vel.y
particles(i).vel.y = particles(i).vel.y + .05
If particles(i).b > 0 Then particles(i).b = particles(i).b - particles(i).fade
End If
If particles(i).b < 0 Then
particles(i).active = 0
particles(i).vel.x = Rnd * 2
particles(i).vel.y = Rnd * 2
particles(i).b = 255
If Rnd * 2 > 1 Then particles(i).vel.x = -particles(i).vel.x
If Rnd * 2 > 1 Then particles(i).vel.y = -particles(i).vel.y
End If
Next
_Display
Loop
End