' ****** 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