Posts: 272
Threads: 24
Joined: Apr 2022
Reputation:
59
(06-07-2023, 11:58 PM)bplus Wrote: That's what I tried, are we very case sensitive? Shouldn't be. I just tried this and it works too:
Code: (Select All)
g2d.fillcircle 400, 275, nose, &HFFFF0000
Posts: 3,965
Threads: 176
Joined: Apr 2022
Reputation:
219
06-08-2023, 01:17 AM
(This post was last modified: 06-08-2023, 01:21 AM by bplus.)
OK I have 1 error about a curlie bracket that I don't even use in the program:
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 Function
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
_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 + ...
Posts: 3,965
Threads: 176
Joined: Apr 2022
Reputation:
219
BTW I was probably putting (x, y) in the parenthesis for G2D.Fillcircle, which would explain why it didn't work.
b = b + ...
Posts: 272
Threads: 24
Joined: Apr 2022
Reputation:
59
Found the issue @bplus. We're not supporting the new "As Long x, y, z" way of defining variables in custom types yet. I'll add it to the list for the next release.
Nice update!
Posts: 272
Threads: 24
Joined: Apr 2022
Reputation:
59
Minor mod to add a sound effect to your latest update @bplus:
Posts: 1,586
Threads: 59
Joined: Jul 2022
Reputation:
52
The face might have been a bit out of order.
The thing is, the program could be modified so the "dumbface" subprogram is controlled by an "IF" statement with a flag. Maybe put some enemies on the screen and they have to be shot at. If not the face could be shown for a moment taunting the player. "Hey shoot at the enemy!" or "Stop wasting photons like that!" or "Having fun yet?" Messages like that, no insults.
It was going to be my next modification.
Posts: 3,965
Threads: 176
Joined: Apr 2022
Reputation:
219
06-08-2023, 01:21 PM
(This post was last modified: 06-08-2023, 01:35 PM by bplus.)
@mnrvovrfc I like an evil clown face to shoot at! LOL
So maybe make it more clownish, also the nose needs to be drawn last in face sub PLUS drawBall instead of flat filled circles.
A little mod of this:
Code: (Select All)
Sub drawBall (x, y, r, c As _Unsigned Long)
Dim rred As Long, grn As Long, blu As Long, rr As Long, f
rred = _Red32(c): grn = _Green32(c): blu = _Blue32(c)
For rr = r To 0 Step -1
f = 1 - Sin(rr / r) ' thank OldMoses for Sin ;-))
FCirc x, y, rr, _RGB32(rred * f, grn * f, blu * f)
Next
End Sub
https://www.chelsidermy.com/blog/Scary-p...-of-clowns
Like I said I will draw in a spaceship that will be more challenging to shoot at. In fact I have an idea for reverse space Invaders ie ships double in number when hit. I have no idea where that might go... "to go where no man has gone before."
Thankyou @dbox for finding and reporting the problem promptly, I haven't tested yet but I bet you added an explosion sound which goes good with photon firing. Update: Perfect!
Oh hey, maybe the DrawBall code could be improved with shaddowing! Bonus points for the lighter part too!
b = b + ...
Posts: 3,965
Threads: 176
Joined: Apr 2022
Reputation:
219
06-08-2023, 06:11 PM
(This post was last modified: 06-08-2023, 06:12 PM by bplus.)
OK here are some improvement on nose position and more ball like:
Hmm... I wonder if I can snatch that image from Internet?
b = b + ...
Posts: 3,965
Threads: 176
Joined: Apr 2022
Reputation:
219
06-08-2023, 06:42 PM
(This post was last modified: 06-08-2023, 07:07 PM by bplus.)
Clowning around LOL,
F or f to fire photons
b = b + ...
Posts: 1,586
Threads: 59
Joined: Jul 2022
Reputation:
52
06-09-2023, 05:52 AM
(This post was last modified: 06-09-2023, 12:33 PM by mnrvovrfc.)
This site is becoming unusable to me lately. Some of you have to think about the persons less fortunate than you, while you enjoy your 1000-Mega Internet. I'm using Firefox and have to allow it to finish downloading that large horrible clown face. If not, the "Rate" button and nothing else works on this page. Another thing is that while entering a reply the text suddenly disappears sometimes while I'm typing. This is just horrible. A good deal of the text I was typing in here right now disappeared at its pleasure, thank you Mozilla!
From now on I am forced to compose a reply in a text editor, then copy and paste from there into this forum. Impossible to reply quickly that way.
The latest program has an interesting result but it looks weird with the photons going "behind" the face, and then seeing the "nose" inflating.
EDIT: To be able to load this page tolerably, I had to use Ublock Origin on the clown face pictures because Internet is becoming less tolerable than ever, that and the forum banner since the contests for that banner.
|
