OK I have 1 error about a curlie bracket that I don't even use in the program:
This is it in QB64pe:
Code: (Select All)
Import G2D From "lib/graphics/2d.bas"
Const PVELOCITY = 10
Screen _NewImage(800, 550, 32)
Type Photon
x As Integer
y As Integer
active As Integer
direction As Integer
End Type
' setup for explosions in main
Type particle
As Long life, death
As Single x, y, dx, dy, r
As _Unsigned Long c
End Type
Dim Shared nDots
nDots = 2000
ReDim Shared dots(nDots) As particle
Dim Shared photons(50) As Photon
Dim Shared firing As Integer
Dim Shared psound(10) As Long
Dim Shared nextPSound As Integer
Dim Shared nose As Long
Dim p As Integer
For p = 1 To UBound(psound)
psound(p) = _SndOpen("https://opengameart.org/sites/default/files/laser7.wav")
Next p
Dim key As Integer '<< QB64 has problem with this line?
Do
If _KeyDown(70) Or _KeyDown(102) Then
If Not firing Then
firing = -1
FirePhotons
End If
Else
firing = 0
End If
Cls
MovePhotons
DrawPhotons
dumbface
DrawDots
' Draw the HUD last so it appears on top of everything else
DrawHUD
_Limit 60
Loop
Sub DrawHUD
' Draw the heads up display
Dim hcolor As _Unsigned Long
hcolor = _RGBA(200, 255, 200, 200)
Line (30, 30)-(70, 30), hcolor
Line (30, 30)-(30, 70), hcolor
Line (770, 30)-(730, 30), hcolor
Line (770, 30)-(770, 70), hcolor
Line (30, 520)-(70, 520), hcolor
Line (30, 520)-(30, 480), hcolor
Line (770, 520)-(730, 520), hcolor
Line (770, 520)-(770, 480), hcolor
G2D.LineWidth 1
Circle (400, 275), 15, hcolor
Line (400, 245)-(400, 305), hcolor
Line (370, 275)-(430, 275), hcolor
End Sub
Sub DrawPhotons
Dim As Integer i, j
For i = 1 To UBound(photons)
If photons(i).active Then
Dim a As Integer
a = 255
For j = 0 To 50 Step 2
'FCirc photons(i).x - j * 2 * photons(i).direction, photons(i).y + j * 1.35, 6, _RGBA(255, 100, 100, a)
G2D.FillCircle photons(i).x - j * 2 * photons(i).direction, photons(i).y + j * 1.35, 6, _RGBA(255, 100, 100, a)
a = a - 20
Next j
End If
Next i
End Sub
Sub MovePhotons
Dim i As Integer
For i = 1 To UBound(photons)
If photons(i).active Then
photons(i).x = photons(i).x + 2 * PVELOCITY * photons(i).direction
photons(i).y = photons(i).y - 1.35 * PVELOCITY
If (photons(i).direction > 0 And photons(i).x > _Width / 2) Or _
(photons(i).direction < 0 And photons(i).x < _Width / 2) Then
If nose < 150 Then
nose = nose + 5
Else
If nose = 150 Then Explode 400, 275, 350, 215, 0, 0
nose = 200
End If
photons(i).active = 0
End If
End If
Next i
End Sub
Sub FirePhotons
Dim i As Integer
i = NextPhoton
If i > 0 Then
photons(i).x = 0
photons(i).y = _Height
photons(i).active = -1
photons(i).direction = 1
End If
i = NextPhoton
If i > 0 Then
photons(i).x = _Width
photons(i).y = _Height
photons(i).active = -1
photons(i).direction = -1
nextPSound = nextPSound + 1
If nextPSound > UBound(psound) Then nextPSound = 1
_SndPlay psound(nextPSound)
End If
End Sub
Function NextPhoton
Dim i As Integer
For i = 1 To UBound(photons)
If Not photons(i).active Then
NextPhoton = i
Exit Function
End If
Next i
NextPhoton = 0
End Function
Sub dumbface
If nose < 200 Then
Dim wd As Integer, ht As Integer, htradius As Single, ccolor As Long
Dim ww As Integer
wd = _Width \ 3
ht = _Height \ 2
htradius = ht - (_Height \ 5)
ccolor = _RGBA(255, 32, 128, 128)
ww = _Width \ 2
'FCirc 400, 275, nose, &HFFFF0000
g2d.fillcircle 400, 275, nose, &HFFFF0000
ht = ht - (_Height \ 8)
ww = ww - (_Width \ 8)
Circle (ww, ht), 20, ccolor
ww = (_Width \ 2) + (_Width \ 8)
Circle (ww, ht), 20, ccolor
ww = (_Width \ 2) - (_Width \ 8)
ht = (_Height \ 2) + (_Height \ 7)
PSet (ww, ht), ccolor
ww = (_Width \ 2) + (_Width \ 8)
Line -(ww, ht), ccolor
ww = _Width \ 2
'Ellipse ww, ht, 100, 30, ccolor
' 0 was rotation cool!
G2D.Ellipse ww, ht, 100, 30, 0, ccolor
End If
End Sub
' explode sets up old dead particles for display for a life
' This sub sets up Dots to display with DrawDots
' this sub uses rndCW
Sub Explode (x, y, spread, cr, cg, cb)
' x, y explosion origin
' spread is diameter of area to cover from it number of dots, number of frames and speed are calculated
' setup for explosions in main
'Type particle
' As Long life, death
' As Single x, y, dx, dy, r
' As _Unsigned Long c
'End Type
'Dim Shared nDots
'nDots = 2000
'ReDim Shared dots(nDots) As particle
Dim As Long i, dotCount, newDots
Dim angle, speed, rd, rAve, frames
newDots = spread / 2 ' quota
frames = spread / 2
speed = spread / frames ' 0 to spread in frames
rAve = .5 * spread / Sqr(newDots)
For i = 1 To nDots ' find next available dot
If dots(i).life = 0 Then
dots(i).life = 1 ' turn on display
dots(i).death = frames
angle = _Pi(2 * Rnd)
dots(i).x = x: dots(i).y = y ' origin
rd = Rnd
dots(i).dx = rd * speed * Cos(angle) ' moving
dots(i).dy = rd * speed * Sin(angle)
dots(i).r = RndCW(rAve, rAve) ' radius
dots(i).c = _RGB32(cr + Rnd * 40 - 20, cg + Rnd * 40 - 20, cb + Rnd * 40 - 20) 'color
dotCount = dotCount + 1
If dotCount >= newDots Then Exit Sub
End If
Next
End Sub
Sub DrawDots ' this sub needs fcirc to Fill Circles and Sub Explode sets up the Dots to draw.
' setup in main for explosions
'Type particle
' As Long life, death
' As Single x, y, dx, dy, r
' As _Unsigned Long c
'End Type
'Dim Shared nDots
'nDots = 2000
'ReDim Shared dots(nDots) As particle
Dim As Long i
For i = 1 To nDots ' display of living particles
If dots(i).life Then
'FCirc dots(i).x, dots(i).y, dots(i).r, dots(i).c
g2d.fillcircle dots(i).x, dots(i).y, dots(i).r, dots(i).c
' update dot
If dots(i).life + 1 >= dots(i).death Then
dots(i).life = 0
Else
dots(i).life = dots(i).life + 1
' might want air resistence or gravity added to dx or dy
dots(i).x = dots(i).x + dots(i).dx
dots(i).y = dots(i).y + dots(i).dy
If dots(i).x < 0 Or dots(i).x > _Width Then dots(i).life = 0
If dots(i).y < 0 Or dots(i).y > _Height Then dots(i).life = 0
dots(i).r = dots(i).r * 1 - (dots(i).life / dots(i).death) ' puff!
If dots(i).r <= 0 Then dots(i).life = 0
End If
End If
Next
End Sub
Function RndCW (C As Single, range As Single) 'center +/-range weights to center
RndCW = C + Rnd * range - Rnd * range
End FunctionThis is it in QB64pe:
Code: (Select All)
'Import G2D From "lib/graphics/2d.bas"
Const PVELOCITY = 10
Screen _NewImage(800, 550, 32)
Type Photon
x As Integer
y As Integer
active As Integer
direction As Integer
End Type
' setup for explosions in main
Type particle
As Long life, death
As Single x, y, dx, dy, r
As _Unsigned Long c
End Type
Dim Shared nDots
nDots = 2000
ReDim Shared dots(nDots) As particle
Dim Shared photons(50) As Photon
Dim Shared firing As Integer
Dim Shared psound(10) As Long
Dim Shared nextPSound As Integer
Dim Shared nose As Long
Dim p As Integer
For p = 1 To UBound(psound)
psound(p) = _SndOpen("https://opengameart.org/sites/default/files/laser7.wav")
Next p
'Dim key As Integer '<< QB64 has problem with this line?
Do
If _KeyDown(70) Or _KeyDown(102) Then
If Not firing Then
firing = -1
FirePhotons
End If
Else
firing = 0
End If
Cls
MovePhotons
DrawPhotons
dumbface
DrawDots
' Draw the HUD last so it appears on top of everything else
DrawHUD
_Display
_Limit 60
Loop
Sub DrawHUD
' Draw the heads up display
Dim hcolor As _Unsigned Long
hcolor = _RGBA(200, 255, 200, 200)
Line (30, 30)-(70, 30), hcolor
Line (30, 30)-(30, 70), hcolor
Line (770, 30)-(730, 30), hcolor
Line (770, 30)-(770, 70), hcolor
Line (30, 520)-(70, 520), hcolor
Line (30, 520)-(30, 480), hcolor
Line (770, 520)-(730, 520), hcolor
Line (770, 520)-(770, 480), hcolor
'G2D.LineWidth 1
Circle (400, 275), 15, hcolor
Line (400, 245)-(400, 305), hcolor
Line (370, 275)-(430, 275), hcolor
End Sub
Sub DrawPhotons
Dim As Integer i, j
For i = 1 To UBound(photons)
If photons(i).active Then
Dim a As Integer
a = 255
For j = 0 To 50 Step 2
FCirc photons(i).x - j * 2 * photons(i).direction, photons(i).y + j * 1.35, 6, _RGBA(255, 100, 100, a)
'G2D.FillCircle photons(i).x - j * 2 * photons(i).direction, photons(i).y + j * 1.35, 6, _RGBA(255, 100, 100, a)
a = a - 20
Next j
End If
Next i
End Sub
Sub MovePhotons
Dim i As Integer
For i = 1 To UBound(photons)
If photons(i).active Then
photons(i).x = photons(i).x + 2 * PVELOCITY * photons(i).direction
photons(i).y = photons(i).y - 1.35 * PVELOCITY
If (photons(i).direction > 0 And photons(i).x > _Width / 2) Or _
(photons(i).direction < 0 And photons(i).x < _Width / 2) Then
If nose < 150 Then
nose = nose + 5
Else
If nose = 150 Then Explode 400, 275, 350, 215, 0, 0
nose = 200
End If
photons(i).active = 0
End If
End If
Next i
End Sub
Sub FirePhotons
Dim i As Integer
i = NextPhoton
If i > 0 Then
photons(i).x = 0
photons(i).y = _Height
photons(i).active = -1
photons(i).direction = 1
End If
i = NextPhoton
If i > 0 Then
photons(i).x = _Width
photons(i).y = _Height
photons(i).active = -1
photons(i).direction = -1
nextPSound = nextPSound + 1
If nextPSound > UBound(psound) Then nextPSound = 1
_SndPlay psound(nextPSound)
End If
End Sub
Function NextPhoton
Dim i As Integer
For i = 1 To UBound(photons)
If Not photons(i).active Then
NextPhoton = i
Exit Function
End If
Next i
NextPhoton = 0
End Function
Sub dumbface
If nose < 200 Then
Dim wd As Integer, ht As Integer, htradius As Single, ccolor As Long
Dim ww As Integer
wd = _Width \ 3
ht = _Height \ 2
htradius = ht - (_Height \ 5)
ccolor = _RGBA(255, 32, 128, 128)
ww = _Width \ 2
FCirc 400, 275, nose, &HFFFF0000
'g2d.fillcircle 400, 275, nose, &HFFFF0000
ht = ht - (_Height \ 8)
ww = ww - (_Width \ 8)
Circle (ww, ht), 20, ccolor
ww = (_Width \ 2) + (_Width \ 8)
Circle (ww, ht), 20, ccolor
ww = (_Width \ 2) - (_Width \ 8)
ht = (_Height \ 2) + (_Height \ 7)
PSet (ww, ht), ccolor
ww = (_Width \ 2) + (_Width \ 8)
Line -(ww, ht), ccolor
ww = _Width \ 2
Ellipse ww, ht, 100, 30, ccolor
' 0 was rotation cool!
'G2D.Ellipse ww, ht, 100, 30, 0, ccolor
End If
End Sub
' explode sets up old dead particles for display for a life
' This sub sets up Dots to display with DrawDots
' this sub uses rndCW
Sub Explode (x, y, spread, cr, cg, cb)
' x, y explosion origin
' spread is diameter of area to cover from it number of dots, number of frames and speed are calculated
' setup for explosions in main
'Type particle
' As Long life, death
' As Single x, y, dx, dy, r
' As _Unsigned Long c
'End Type
'Dim Shared nDots
'nDots = 2000
'ReDim Shared dots(nDots) As particle
Dim As Long i, dotCount, newDots
Dim angle, speed, rd, rAve, frames
newDots = spread / 2 ' quota
frames = spread / 2
speed = spread / frames ' 0 to spread in frames
rAve = .5 * spread / Sqr(newDots)
For i = 1 To nDots ' find next available dot
If dots(i).life = 0 Then
dots(i).life = 1 ' turn on display
dots(i).death = frames
angle = _Pi(2 * Rnd)
dots(i).x = x: dots(i).y = y ' origin
rd = Rnd
dots(i).dx = rd * speed * Cos(angle) ' moving
dots(i).dy = rd * speed * Sin(angle)
dots(i).r = RndCW(rAve, rAve) ' radius
dots(i).c = _RGB32(cr + Rnd * 40 - 20, cg + Rnd * 40 - 20, cb + Rnd * 40 - 20) 'color
dotCount = dotCount + 1
If dotCount >= newDots Then Exit Sub
End If
Next
End Sub
Sub DrawDots ' this sub needs fcirc to Fill Circles and Sub Explode sets up the Dots to draw.
' setup in main for explosions
'Type particle
' As Long life, death
' As Single x, y, dx, dy, r
' As _Unsigned Long c
'End Type
'Dim Shared nDots
'nDots = 2000
'ReDim Shared dots(nDots) As particle
Dim As Long i
For i = 1 To nDots ' display of living particles
If dots(i).life Then
FCirc dots(i).x, dots(i).y, dots(i).r, dots(i).c
'g2d.fillcircle dots(i).x, dots(i).y, dots(i).r, dots(i).c
' update dot
If dots(i).life + 1 >= dots(i).death Then
dots(i).life = 0
Else
dots(i).life = dots(i).life + 1
' might want air resistence or gravity added to dx or dy
dots(i).x = dots(i).x + dots(i).dx
dots(i).y = dots(i).y + dots(i).dy
If dots(i).x < 0 Or dots(i).x > _Width Then dots(i).life = 0
If dots(i).y < 0 Or dots(i).y > _Height Then dots(i).life = 0
dots(i).r = dots(i).r * 1 - (dots(i).life / dots(i).death) ' puff!
If dots(i).r <= 0 Then dots(i).life = 0
End If
End If
Next
End Sub
Function RndCW (C As Single, range As Single) 'center +/-range weights to center
RndCW = C + Rnd * range - Rnd * range
End Function
Sub FCirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
Dim Radius As Long, RadiusError As Long
Dim X As Long, Y As Long
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
'there is a better way so there is no guessing the stepper size
Sub Ellipse (CX, CY, xRadius As Long, yRadius As Long, C As _Unsigned Long)
' CX = center x coordinate
' CY = center y coordinate
' xRadius = x axis radius
' yRadius = y axis radius
' C = fill color
Dim a, x, y, sq, delta, lastDelta
If xRadius = 0 And yRadius = 0 Then Exit Sub
If xRadius = 0 Then
Line (CX, CY + yRadius)-(CX, CY - yRadius), C
ElseIf yRadius = 0 Then
Line (CX + xRadius, CY)-(CX - xRadius, CY), C
Else
If xRadius >= yRadius Then
a = yRadius / xRadius: sq = xRadius * xRadius
For x = 0 To xRadius
If x = 0 Then
lastDelta = Sqr(sq - x * x) * a
Else
delta = Sqr(sq - x * x) * a
Line (CX + (x - 1), CY + lastDelta)-(CX + x, CY + delta), C
Line (CX + (x - 1), CY - lastDelta)-(CX + x, CY - delta), C
Line (CX - (x - 1), CY + lastDelta)-(CX - x, CY + delta), C
Line (CX - (x - 1), CY - lastDelta)-(CX - x, CY - delta), C
lastDelta = delta
End If
Next
Else
a = xRadius / yRadius: sq = yRadius * yRadius
For y = 0 To yRadius
If y = 0 Then
lastDelta = Sqr(sq - y * y) * a
Else
delta = Sqr(sq - y * y) * a
Line (CX + lastDelta, CY + (y - 1))-(CX + delta, CY + y), C
Line (CX - lastDelta, CY + (y - 1))-(CX - delta, CY + y), C
Line (CX + lastDelta, CY - (y - 1))-(CX + delta, CY - y), C
Line (CX - lastDelta, CY - (y - 1))-(CX - delta, CY - y), C
lastDelta = delta
End If
Next
End If
End If
End Sub
b = b + ...