This seems vastly improved with speed control ie input pixels per frame you want the laser pulse to transverse each loop in main code.
Code: (Select All)
Option_Explicit _Title"Bolt 2: click mouse around screen"' b+ 2023-07-15 started as Bloom.bas ' 2023-07-16 rename to Bolt from Bloom and comment better and make more generic ' 2023-07-17 Bolts 2: move the bolt down the BoltLine by speed like a bullet.
' BoltLine: Imagine a line with a thickness at one end and a different thickness at then other. ' Colored like I imagine a Laser beam yellowish white core with bluish tinge around the edges. ' Now draw sections of that BoltLine according to the frames of display in main loop. ' This is a demo of that!
Const NBolts = 20' max number of Bolt slots available, just like bullet science Const PulseLength = 100' length of light pulses as they travel down BoltLine
Type BoltType 'see NewBolt for description of these variables AsSingle x1, y1, r1, dx, dy, dr, d, frames, frame, active, speedX, speedY End Type
DimShared Bolts(1To NBolts) As BoltType Dim mx, my, i, lpc, back
SubNewBolt (x1, y1, r1, x2, y2, r2, ppfSpeed) ' sets up for the DrawBolt Sub 'x1, y1, r1 = location and radius at start of beam 'x2, y2, r2 = target location and radius at beam end 'ppfSpeed = how many pixels per frame in main loop to transverse Dim i, ang For i = 1To NBolts If Bolts(i).active = 0Then
Bolts(i).x1 = x1 ' start x, y, radius
Bolts(i).y1 = y1
Bolts(i).r1 = r1
Bolts(i).active = 1' bolt is activated
Bolts(i).dx = x2 - x1 ' drawing the bolt line and thickness
Bolts(i).dy = y2 - y1 ' as it changes from x1, y1, r1 to x2, y2, r2
Bolts(i).dr = r2 - r1
Bolts(i).d = _Hypot(Bolts(i).dx, Bolts(i).dy) ' distance of the bolt line
Bolts(i).frames = Int(Bolts(i).d / ppfSpeed) + 1' divide that distance by pulse = PulseLength
Bolts(i).frame = 1' set the frame you are on to locate the pulse in drawing
ang = _Atan2(y2 - y1, x2 - x1)
Bolts(i).speedX = ppfSpeed * Cos(ang)
Bolts(i).speedY = ppfSpeed * Sin(ang) Exit Sub End If Next End Sub
SubDrawBolt (idx) ' needs FCirc (Fill Circle) routine ' This sub draw a pulse of light on the BoltLine from .x1, .y1 on the way to .x2, .y2 ' The start radius is .r1 and the end radius is .r2 and the pulse is thinned or thickened ' as it proceeds down the boltLine.
'All this is setup in the NewBolt Sub and uses DIM Shared Bolts() as BoltType and Constants ' NBolts = max amount of activated Bolt "slots" available and PulseLength the length of ' BoltLine sections to draw in each frame.
' new lead position
x = Bolts(idx).x1 + Bolts(idx).speedX * Bolts(idx).frame
y = Bolts(idx).y1 + Bolts(idx).speedY * Bolts(idx).frame
d = _Hypot(Bolts(idx).x1 - x, Bolts(idx).y1 - y)
For i = d - PulseLength To d If i >= 0Then FCirc Bolts(idx).x1 + i * Bolts(idx).dx / Bolts(idx).d, Bolts(idx).y1 + i * Bolts(idx).dy _
/ Bolts(idx).d, Bolts(idx).r1 + i * Bolts(idx).dr / Bolts(idx).d, &H10DDDDFF FCirc Bolts(idx).x1 + i * Bolts(idx).dx / Bolts(idx).d, Bolts(idx).y1 + i * Bolts(idx).dy _
/ Bolts(idx).d, .35 * Bolts(idx).r1 + i * .4 * Bolts(idx).dr / Bolts(idx).d, &HaaFFFFAA End If Next
Bolts(idx).frame = Bolts(idx).frame + 1' update frame number If Bolts(idx).frame > Bolts(idx).frames Then Bolts(idx).active = 0' job done! End Sub
SubDrawShip (x, y, colr As_UnsignedLong) 'needs FCirc and FEllipse subs Static ls ' tracks the last light position in string of lights Dim light AsLong, r AsLong, g AsLong, b AsLong
r = _Red32(colr): g = _Green32(colr): b = _Blue32(colr) FEllipse x, y, 6, 15, _RGB32(r, g - PulseLength, b - 100) FEllipse x, y, 18, 11, _RGB32(r, g - 60, b - 50) FEllipse x, y, 30, 7, _RGB32(r, g, b) For light = 0To5 FCirc x - 30 + 11 * light + ls, y, 1, _RGB32(ls * 50, ls * 50, ls * 50) Next
ls = ls + 1 If ls > 5Then ls = 0 End Sub
07-18-2023, 02:58 PM (This post was last modified: 07-18-2023, 03:03 PM by bplus.)
Quote:' But Mark how do we detect hits from lasers, OK added x, y, r to track the current location
' and radius of the laser bolt.
Bolts 2 tweaks:
Code: (Select All)
Option _Explicit
_Title "Bolt 2 tweaks: click mouse around screen" ' b+ 2023-07-15 started as Bloom.bas
' 2023-07-16 rename to Bolt from Bloom and comment better and make more generic
' 2023-07-17 Bolts 2: move the bolt down the BoltLine by speed like a bullet.
' 2023-07-18 Bolts 2 tweaks: tweak numbers for more transparency and then more solid little rays.
' But Mark how do we detect hits from lasers, OK added x, y, r to track the current location
' and radius of the laser bolt.
' BoltLine: Imagine a line with a thickness at one end and a different thickness at then other.
' Colored like I imagine a Laser beam yellowish white core with bluish tinge around the edges.
' Now draw sections of that BoltLine according to the frames of display in main loop.
' This is a demo of that!
Const NBolts = 50 ' max number of Bolt slots available, just like bullet science
Const PulseLength = 100 ' length of light pulses as they travel down BoltLine
Type BoltType 'see NewBolt for description of these variables
As Single x1, y1, r1, dx, dy, dr, d, frames, frame, active, speedX, speedY, x, y, r
End Type
Dim Shared Bolts(1 To NBolts) As BoltType
Dim mx, my, i, lpc, back, r
Randomize Timer
Screen _NewImage(1200, 700, 32)
_ScreenMove 50, 20
back = _NewImage(_Width, _Height, 32)
For i = 1 To 150
Line (Rnd * _Width, Rnd * _Height)-Step(Rnd * 100, Rnd * 70), _RGB32(Rnd * 100, Rnd * 100, Rnd * 100), BF
Next i
_PutImage , 0, back
Do
Cls
_PutImage , back, 0
DrawShip 600, 350, &HFF00CC66 ' bplus signature space ship, for rent :)
' fire off some more bolts at the ship from the screen corners!
If lpc = 0 Then
If Rnd < .7 Then NewBolt 0, 0, 1, 600, 350, 10, 3
ElseIf lpc = 30 Then
If Rnd < .7 Then NewBolt _Width - 1, 0, 1, 600, 350, 20, 2
ElseIf lpc = 60 Then
If Rnd < .7 Then NewBolt _Width - 1, _Height - 1, 1, 600, 350, 30, 3
ElseIf lpc = 90 Then
If Rnd < .7 Then NewBolt 0, _Height - 1, 1, 600, 350, 50, 2
End If
lpc = (lpc + 1) Mod 120 ' loopscounter every 30 shoot from a corner
For i = 1 To NBolts
If Bolts(i).active Then DrawBolt (i) ' draws the bolts still active
Next ' according to what frame they are on
' collision detection blow up when ship is hit
For i = 1 To NBolts
If Bolts(i).active Then
If _Hypot(Bolts(i).x - 600, Bolts(i).y - 350) < 20 + Bolts(i).r Then
If Bolts(i).x1 <> 600 And Bolts(i).y1 <> 350 Then ' oops watch out for friendly fire!!!
For r = 1 To 50
FCirc 600, 350, r, _RGB32((50 - r) * 255, (50 - r) * 255, 0)
_Display
_Limit 400
Next
Bolts(i).active = 0
End If
End If
End If
Next
While _MouseInput: Wend
mx = _MouseX: my = _MouseY
If _MouseButton(1) Then
NewBolt 600, 340, 1, mx, my, 15, 10
_Delay .1 ' wait a little for mouse release so 2 bolts aren't draw from 1 click
End If
_Display
_Limit 60
Loop Until _KeyDown(27)
Sub NewBolt (x1, y1, r1, x2, y2, r2, ppfSpeed) ' sets up for the DrawBolt Sub
'x1, y1, r1 = location and radius at start of beam
'x2, y2, r2 = target location and radius at beam end
'ppfSpeed = how many pixels per frame in main loop to transverse
Dim i, ang
For i = 1 To NBolts
If Bolts(i).active = 0 Then
Bolts(i).x1 = x1 ' start x, y, radius
Bolts(i).y1 = y1
Bolts(i).r1 = r1
Bolts(i).active = 1 ' bolt is activated
Bolts(i).dx = x2 - x1 ' drawing the bolt line and thickness
Bolts(i).dy = y2 - y1 ' as it changes from x1, y1, r1 to x2, y2, r2
Bolts(i).dr = r2 - r1
Bolts(i).d = _Hypot(Bolts(i).dx, Bolts(i).dy) ' distance of the bolt line
Bolts(i).frames = Int(Bolts(i).d / ppfSpeed) + 1 ' divide that distance by pulse = PulseLength
Bolts(i).frame = 1 ' set the frame you are on to locate the pulse in drawing
ang = _Atan2(y2 - y1, x2 - x1)
Bolts(i).speedX = ppfSpeed * Cos(ang)
Bolts(i).speedY = ppfSpeed * Sin(ang)
Bolts(i).x = x1 ' track leading x, y, r of current bolt for collision detection
Bolts(i).y = y1
Bolts(i).r = r1
Exit Sub
End If
Next
End Sub
Sub DrawBolt (idx) ' needs FCirc (Fill Circle) routine
' This sub draw a pulse of light on the BoltLine from .x1, .y1 on the way to .x2, .y2
' The start radius is .r1 and the end radius is .r2 and the pulse is thinned or thickened
' as it proceeds down the boltLine.
'All this is setup in the NewBolt Sub and uses DIM Shared Bolts() as BoltType and Constants
' NBolts = max amount of activated Bolt "slots" available and PulseLength the length of
' BoltLine sections to draw in each frame.
Dim i, d, stepper
' new lead position for tracking location for collision detection
Bolts(idx).x = Bolts(idx).x1 + Bolts(idx).speedX * Bolts(idx).frame
Bolts(idx).y = Bolts(idx).y1 + Bolts(idx).speedY * Bolts(idx).frame
d = _Hypot(Bolts(idx).x1 - Bolts(idx).x, Bolts(idx).y1 - Bolts(idx).y)
If Abs(Bolts(idx).dr / PulseLength) < .2 Then stepper = .5 Else stepper = 2
Bolts(idx).r = Bolts(idx).r1 + d * Bolts(idx).dr / Bolts(idx).d
For i = d - PulseLength To d Step stepper
If i >= 0 Then
FCirc Bolts(idx).x1 + i * Bolts(idx).dx / Bolts(idx).d, Bolts(idx).y1 + i * Bolts(idx).dy _
/ Bolts(idx).d, Bolts(idx).r1 + i * Bolts(idx).dr / Bolts(idx).d, &H05DDDDFF
FCirc Bolts(idx).x1 + i * Bolts(idx).dx / Bolts(idx).d, Bolts(idx).y1 + i * Bolts(idx).dy _
/ Bolts(idx).d, .65 * Bolts(idx).r1 + i * .65 * Bolts(idx).dr / Bolts(idx).d, &H16FFFFAA
End If
Next
Bolts(idx).frame = Bolts(idx).frame + 1 ' update frame number
If Bolts(idx).frame > Bolts(idx).frames Then Bolts(idx).active = 0 ' job done!
End Sub
Sub FCirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
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
Sub DrawShip (x, y, colr As _Unsigned Long) 'needs FCirc and FEllipse subs
Static ls ' tracks the last light position in string of lights
Dim light As Long, r As Long, g As Long, b As Long
r = _Red32(colr): g = _Green32(colr): b = _Blue32(colr)
FEllipse x, y, 6, 15, _RGB32(r, g - PulseLength, b - 100)
FEllipse x, y, 18, 11, _RGB32(r, g - 60, b - 50)
FEllipse x, y, 30, 7, _RGB32(r, g, b)
For light = 0 To 5
FCirc x - 30 + 11 * light + ls, y, 1, _RGB32(ls * 50, ls * 50, ls * 50)
Next
ls = ls + 1
If ls > 5 Then ls = 0
End Sub
Sub FEllipse (CX As Long, CY As Long, xr As Long, yr As Long, C As _Unsigned Long)
If xr = 0 Or yr = 0 Then Exit Sub
Dim h2 As _Integer64, w2 As _Integer64, h2w2 As _Integer64
Dim x As Long, y As Long
w2 = xr * xr: h2 = yr * yr: h2w2 = h2 * w2
Line (CX - xr, CY)-(CX + xr, CY), C, BF
Do While y < yr
y = y + 1
x = Sqr((h2w2 - y * y * w2) \ h2)
Line (CX - x, CY + y)-(CX + x, CY + y), C, BF
Line (CX - x, CY - y)-(CX + x, CY - y), C, BF
Loop
End Sub
New bolt transparencies:
Hits are not easy to show screenshot of but here is one instance:
07-19-2023, 01:14 AM (This post was last modified: 07-19-2023, 12:56 PM by bplus.
Edit Reason: Edited the coloring of ship blasts
)
Bolts 3 Colorized, now with Plasma Lasers
Code: (Select All)
Option _Explicit
_Title "Bolt 3 Colorized: click mouse around screen" ' b+ 2023-07-15 started as Bloom.bas
' 2023-07-16 rename to Bolt from Bloom and comment better and make more generic
' 2023-07-17 Bolts 2: move the bolt down the BoltLine by speed like a bullet.
' 2023-07-18 Bolts 2 tweaks: tweak numbers for more transparency and then more solid little rays.
' But Mark how do we detect hits from lasers, OK added x, y, r to track the current location
' and radius of the laser bolt.
' BoltLine: Imagine a line with a thickness at one end and a different thickness at then other.
' Colored like I imagine a Laser beam yellowish white core with bluish tinge around the edges.
' Now draw sections of that BoltLine according to the frames of display in main loop.
' This is a demo of that!
Const NBolts = 50 ' max number of Bolt slots available, just like bullet science
Const PulseLength = 100 ' length of light pulses as they travel down BoltLine
Type BoltType 'see NewBolt for description of these variables
As Single x1, y1, r1, dx, dy, dr, d, frames, frame, active, speedX, speedY, x, y, r, red, grn, blu
End Type
Dim Shared Bolts(1 To NBolts) As BoltType
Dim mx, my, i, lpc, back, r, blastedShip
Randomize Timer
Screen _NewImage(1200, 700, 32)
_ScreenMove 50, 20
back = _NewImage(_Width, _Height, 32)
For i = 1 To 150
Line (Rnd * _Width, Rnd * _Height)-Step(Rnd * 100, Rnd * 70), _RGB32(Rnd * 100, Rnd * 100, Rnd * 100), BF
Next i
_PutImage , 0, back
Do
Cls
_PutImage , back, 0
If blastedShip Then
DrawShip 600, 350, &HFF00CC66
For r = blastedShip To 1 Step -2
FCirc 600, 350, r, _RGB32(5 * (50 - r), 5 * (50 - r), 0, 20)
Next
blastedShip = blastedShip + 2
If blastedShip > 50 Then blastedShip = 0
Else
DrawShip 600, 350, &HFF00CC66 ' bplus signature space ship, for rent :)
End If
' fire off some more bolts at the ship from the screen corners!
If lpc = 0 Then
If Rnd < .7 Then NewBolt 0, 0, 1, 600, 350, 10, 5
ElseIf lpc = 30 Then
If Rnd < .7 Then NewBolt _Width - 1, 0, 1, 600, 350, 20, 4
ElseIf lpc = 60 Then
If Rnd < .7 Then NewBolt _Width - 1, _Height - 1, 1, 600, 350, 30, 3
ElseIf lpc = 90 Then
If Rnd < .7 Then NewBolt 0, _Height - 1, 1, 600, 350, 50, 2
End If
lpc = (lpc + 1) Mod 120 ' loopscounter every 30 shoot from a corner
For i = 1 To NBolts
If Bolts(i).active Then DrawBolt (i) ' draws the bolts still active
Next ' according to what frame they are on
' collision detection blow up when ship is hit
For i = 1 To NBolts
If Bolts(i).active Then
If _Hypot(Bolts(i).x - 600, Bolts(i).y - 350) < 20 + Bolts(i).r Then
If Bolts(i).x1 <> 600 And Bolts(i).y1 <> 350 Then ' oops watch out for friendly fire!!!
If blastedShip = 0 Then blastedShip = 1
Bolts(i).active = 0
End If
End If
End If
Next
While _MouseInput: Wend
mx = _MouseX: my = _MouseY
If _MouseButton(1) Then
NewBolt 600, 340, 1, mx, my, 15, 10
_Delay .1 ' wait a little for mouse release so 2 bolts aren't draw from 1 click
End If
_Display
_Limit 60
Loop Until _KeyDown(27)
Sub NewBolt (x1, y1, r1, x2, y2, r2, ppfSpeed) ' sets up for the DrawBolt Sub
'x1, y1, r1 = location and radius at start of beam
'x2, y2, r2 = target location and radius at beam end
'ppfSpeed = how many pixels per frame in main loop to transverse
Dim i, ang
For i = 1 To NBolts
If Bolts(i).active = 0 Then
Bolts(i).x1 = x1 ' start x, y, radius
Bolts(i).y1 = y1
Bolts(i).r1 = r1
Bolts(i).active = 1 ' bolt is activated
Bolts(i).dx = x2 - x1 ' drawing the bolt line and thickness
Bolts(i).dy = y2 - y1 ' as it changes from x1, y1, r1 to x2, y2, r2
Bolts(i).dr = r2 - r1
Bolts(i).d = _Hypot(Bolts(i).dx, Bolts(i).dy) ' distance of the bolt line
Bolts(i).frames = Int(Bolts(i).d / ppfSpeed) + 1 ' divide that distance by pulse = PulseLength
Bolts(i).frame = 1 ' set the frame you are on to locate the pulse in drawing
ang = _Atan2(y2 - y1, x2 - x1)
Bolts(i).speedX = ppfSpeed * Cos(ang)
Bolts(i).speedY = ppfSpeed * Sin(ang)
Bolts(i).x = x1 ' track leading x, y, r of current bolt for collision detection
Bolts(i).y = y1
Bolts(i).r = r1
Bolts(i).red = Rnd ^ 2
Bolts(i).grn = Rnd ^ 2
Bolts(i).blu = Rnd ^ 2
Exit Sub
End If
Next
End Sub
Sub DrawBolt (idx) ' needs FCirc (Fill Circle) routine
' This sub draw a pulse of light on the BoltLine from .x1, .y1 on the way to .x2, .y2
' The start radius is .r1 and the end radius is .r2 and the pulse is thinned or thickened
' as it proceeds down the boltLine.
'All this is setup in the NewBolt Sub and uses DIM Shared Bolts() as BoltType and Constants
' NBolts = max amount of activated Bolt "slots" available and PulseLength the length of
' BoltLine sections to draw in each frame.
Dim i, d, stepper
' new lead position for tracking location for collision detection
Bolts(idx).x = Bolts(idx).x1 + Bolts(idx).speedX * Bolts(idx).frame
Bolts(idx).y = Bolts(idx).y1 + Bolts(idx).speedY * Bolts(idx).frame
d = _Hypot(Bolts(idx).x1 - Bolts(idx).x, Bolts(idx).y1 - Bolts(idx).y)
If Abs(Bolts(idx).dr / PulseLength) < .2 Then stepper = .5 Else stepper = 2
Bolts(idx).r = Bolts(idx).r1 + d * Bolts(idx).dr / Bolts(idx).d
For i = d - PulseLength To d Step stepper
If i >= 0 Then
FCirc Bolts(idx).x1 + i * Bolts(idx).dx / Bolts(idx).d, Bolts(idx).y1 + i * Bolts(idx).dy _
/ Bolts(idx).d, Bolts(idx).r1 + i * Bolts(idx).dr / Bolts(idx).d, &H05DDDDFF
FCirc Bolts(idx).x1 + i * Bolts(idx).dx / Bolts(idx).d, Bolts(idx).y1 + i * Bolts(idx).dy _
/ Bolts(idx).d, .65 * Bolts(idx).r1 + i * .65 * Bolts(idx).dr / Bolts(idx).d, _
Plasma~&(Bolts(idx).red, Bolts(idx).grn, Bolts(idx).blu, i)
End If
Next
Bolts(idx).frame = Bolts(idx).frame + 1 ' update frame number
If Bolts(idx).frame > Bolts(idx).frames Then Bolts(idx).active = 0 ' job done!
End Sub
Function Plasma~& (r, g, b, cN)
Plasma~& = _RGB32(127 + 127 * Sin(r * cN), 127 + 127 * Sin(g * cN), 127 + 127 * Sin(b * cN), 20)
End Function
Sub FCirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
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
Sub DrawShip (x, y, colr As _Unsigned Long) 'needs FCirc and FEllipse subs
Static ls ' tracks the last light position in string of lights
Dim light As Long, r As Long, g As Long, b As Long
r = _Red32(colr): g = _Green32(colr): b = _Blue32(colr)
FEllipse x, y, 6, 15, _RGB32(r, g - PulseLength, b - 100)
FEllipse x, y, 18, 11, _RGB32(r, g - 60, b - 50)
FEllipse x, y, 30, 7, _RGB32(r, g, b)
For light = 0 To 5
FCirc x - 30 + 11 * light + ls, y, 1, _RGB32(ls * 50, ls * 50, ls * 50)
Next
ls = ls + 1
If ls > 5 Then ls = 0
End Sub
Sub FEllipse (CX As Long, CY As Long, xr As Long, yr As Long, C As _Unsigned Long)
If xr = 0 Or yr = 0 Then Exit Sub
Dim h2 As _Integer64, w2 As _Integer64, h2w2 As _Integer64
Dim x As Long, y As Long
w2 = xr * xr: h2 = yr * yr: h2w2 = h2 * w2
Line (CX - xr, CY)-(CX + xr, CY), C, BF
Do While y < yr
y = y + 1
x = Sqr((h2w2 - y * y * w2) \ h2)
Line (CX - x, CY + y)-(CX + x, CY + y), C, BF
Line (CX - x, CY - y)-(CX + x, CY - y), C, BF
Loop
End Sub
I didn't look at any of the other programs so far and this is what I whipped up for a laser zap demo. From what i just scrolled past some above look similar and more sophisticated. But what the heck... here's another shot at the task.
Code: (Select All)
'laser zap demo
Screen _NewImage(800, 500, 32)
Dim zapa(30), zapx(30), zapy(30), zapds(30), zapde(30), zapl(30)
Dim zapk(30) As _Unsigned Long
Dim starx(100), stary(100)
Cls
_Blend
Do
rays = 5 + Int(1 + Rnd * 25)
xx = 400 - Int(Rnd * 200) + Int(Rnd * 200)
yy = 250 - Int(Rnd * 100) + Int(Rnd * 100)
For a = 1 To rays
zapa(a) = Int(Rnd * 360)
zapx(a) = xx
zapy(a) = yy
zapds(a) = Int(1 + Rnd * 6)
zapde(a) = Int(zapds(a) + Rnd * (2 * (zapds(a))))
zapl(a) = Int(3 + Rnd * 6) * 50
zapk(a) = _RGBA32(220 + Int(Rnd * 30) - Rnd * (30), 230 - Int(Rnd * 12) + Int(Rnd * 12), 0, 22)
Next a
For c = 1 To 100
starx(c) = Int(Rnd * _Width)
stary(c) = Int(Rnd * _Height)
Next c
lr = Int(2 + Rnd * 10) * 15
For z = 1 To 30
_Limit lr
Cls
For c = 1 To 100
PSet (starx(c), stary(c)), _RGBA32(252 + Int(Rnd * 3), 252 + Int(Rnd * 3), 252 + Int(Rnd * 3), 200 + Int(Rnd * 50))
Next c
For n = 1 To rays
zz = Int(z + Rnd(31 - z))
zzz = 30 - Int(Rnd * 3)
zap_line zapx(n), zapy(n), zapl(n), zapa(n), zapds(n), zapde(n), zz, zzz, zapk(n)
Next n
_Display
Next z
Cls
For c = 1 To 100
PSet (starx(c), stary(c)), _RGBA32(252 + Int(Rnd * 3), 252 + Int(Rnd * 3), 252 + Int(Rnd * 3), 200 + Int(Rnd * 50))
Next c
Print "Press any key for more zaps, <esc> to quit"
_Display
Do
_Limit 60
kk$ = InKey$
Loop Until kk$ <> ""
Cls
_Display
Loop Until kk$ = Chr$(27)
Sub zap_line (x, y, Lnth, ang, thks, thke, ss, es, klr As _Unsigned Long)
Dim zseg(30, 2)
Dim thk(30)
thk(1) = thks
tc = (thke - thks) / 30
zseg(1, 1) = x: zseg(1, 2) = y
st = ss: If st = 1 Then st = 2
For s = 2 To 30
zseg(s, 1) = zseg(s - 1, 1) + (Lnth / 30) * Cos(0.01745329 * ang)
zseg(s, 2) = zseg(s - 1, 2) + (Lnth / 30) * Sin(0.01745329 * ang)
thk(s) = thk(s - 1) + tc
Next s
For s = st To es
If Int(Rnd * 10) < 7 Then fatline zseg(s - 1, 1), zseg(s - 1, 2), zseg(s, 1), zseg(s, 2), thk(s) + thk(2) / 5, klr
If Int(Rnd * 10) < 8 Then fatline zseg(s - 1, 1), zseg(s - 1, 2), zseg(s, 1), zseg(s, 2), thk(s), klr
Next s
End Sub
Sub angle_line (x, y, Lnth, ang, thk, klr As _Unsigned Long)
'draw a line from x,y lnth units long (from center of line) at angle ang of radial thickness thk in color klr
ox = x: oy = y
nx = ox + Lnth * Cos(0.01745329 * ang)
ny = oy + Lnth * Sin(0.01745329 * ang)
fatline ox, oy, nx, ny, thk, klr
End Sub
Sub fcirc (CX As Long, CY As Long, R, klr As _Unsigned Long)
'draw a filled circle with the quickest filled circle routine in qb64, not my development
Dim subRadius As Long, RadiusError As Long
Dim X As Long, Y As Long
subRadius = Abs(R)
RadiusError = -subRadius
X = subRadius
Y = 0
If subRadius = 0 Then PSet (CX, CY): Exit Sub
Line (CX - X, CY)-(CX + X, CY), klr, 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), klr, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), klr, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), klr, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), klr, BF
Wend
End Sub
Sub fatline (x0, y0, x1, y1, r, klr As _Unsigned Long)
'draw a line with dots with a radial thickness of r from x0,y0 to x1,y1 in color klr
If r > 0.5 Then
If Abs(y1 - y0) < Abs(x1 - x0) Then
If x0 > x1 Then
lineLow x1, y1, x0, y0, r, klr
Else
lineLow x0, y0, x1, y1, r, klr
End If
Else
If y0 > y1 Then
lineHigh x1, y1, x0, y0, r, klr
Else
lineHigh x0, y0, x1, y1, r, klr
End If
End If
Else
Line (x0, y0)-(x1, y1), klr 'line with r of <= 0.5 don't render properly so we force them to be 1 pixel wide on screen
End If
End Sub
Sub lineLow (x0, y0, x1, y1, r, klr As _Unsigned Long)
dx = x1 - x0
dy = y1 - y0
yi = 1
If dy < 0 Then
yi = -1
dy = -dy
End If
d = (dy + dy) - dx
y = y0
For x = x0 To x1
fcirc x, y, r, klr
If d > 0 Then
y = y + yi
d = d + ((dy - dx) + (dy - dx))
Else
d = d + dy + dy
End If
Next x
End Sub
Sub lineHigh (x0, y0, x1, y1, r, klr As _Unsigned Long)
dx = x1 - x0
dy = y1 - y0
xi = 1
If dx < 0 Then
xi = -1
dx = -dx
End If
D = (dx + dx) - dy
x = x0
For y = y0 To y1
fcirc x, y, r, klr
If D > 0 Then
x = x + xi
D = D + ((dx - dy) + (dx - dy))
Else
D = D + dx + dx
End If
Next y
End Sub
Sub Replace (text$, old$, new$)
'modiifed routine from WIKI shown in LEFT$ entry
Do
find = InStr(start + 1, text$, old$)
If find Then
count = count + 1
first$ = Left$(text$, find - 1)
last$ = Right$(text$, Len(text$) - (find + Len(old$) - 1))
text$ = first$ + new$ + last$
End If
start = find
Loop While find
End Sub
07-20-2023, 12:44 PM (This post was last modified: 07-20-2023, 12:50 PM by bplus.
Edit Reason: Edit: remove excess code and put back lower alpha
)
Sure let's blow the dust off your CPU!
Bolts Star Burst!
Code: (Select All)
Option _Explicit
_Title "Bolts Star Burst" ' b+ 2023-07-15 started as Bloom.bas
' 2023-07-16 rename to Bolt from Bloom and comment better and make more generic
' 2023-07-17 Bolts 2: move the bolt down the BoltLine by speed like a bullet.
' 2023-07-18 Bolts 2 tweaks: tweak numbers for more transparency and then more solid little rays.
' But Mark how do we detect hits from lasers, OK added x, y, r to track the current location
' and radius of the laser bolt.
' BoltLine: Imagine a line with a thickness at one end and a different thickness at then other.
' Colored like I imagine a Laser beam yellowish white core with bluish tinge around the edges.
' Now draw sections of that BoltLine according to the frames of display in main loop.
' This is a demo of that!
' Bolts 3 Colorized
' 2023-07-20 Bolts Star Burst
Const NBolts = 200 ' max number of Bolt slots available, just like bullet science
Const PulseLength = 80 ' length of light pulses as they travel down BoltLine
Type BoltType 'see NewBolt for description of these variables
As Single x1, y1, r1, dx, dy, dr, d, frames, frame, active, speedX, speedY, x, y, r, red, grn, blu
End Type
Dim Shared Bolts(1 To NBolts) As BoltType
Dim i, back, minR, d, cx, cy, ang
Randomize Timer
Screen _NewImage(1200, 700, 32)
_ScreenMove 50, 20
back = _NewImage(_Width, _Height, 32)
For i = 1 To 150
Line (Rnd * _Width, Rnd * _Height)-Step(Rnd * 100, Rnd * 70), _RGB32(Rnd * 100, Rnd * 100, Rnd * 100), BF
Next i
_PutImage , 0, back
cx = .5 * _Width: cy = .5 * _Height ' center
minR = _Hypot(cx, cy)
Do
Cls
_PutImage , back, 0
For i = 1 To NBolts
If Bolts(i).active Then
DrawBolt (i) ' draws the bolts still active
Else
d = Rnd * minR + 10: ang = Rnd * _Pi(2)
NewBolt cx, cy, 30, cx + d * Cos(ang), cy + d * Sin(ang), 1, 30
End If
Next ' according to what frame they are on
_Display
_Limit 60
Loop Until _KeyDown(27)
Sub NewBolt (x1, y1, r1, x2, y2, r2, ppfSpeed) ' sets up for the DrawBolt Sub
'x1, y1, r1 = location and radius at start of beam
'x2, y2, r2 = target location and radius at beam end
'ppfSpeed = how many pixels per frame in main loop to transverse
Dim i, ang
For i = 1 To NBolts
If Bolts(i).active = 0 Then
Bolts(i).x1 = x1 ' start x, y, radius
Bolts(i).y1 = y1
Bolts(i).r1 = r1
Bolts(i).active = 1 ' bolt is activated
Bolts(i).dx = x2 - x1 ' drawing the bolt line and thickness
Bolts(i).dy = y2 - y1 ' as it changes from x1, y1, r1 to x2, y2, r2
Bolts(i).dr = r2 - r1
Bolts(i).d = _Hypot(Bolts(i).dx, Bolts(i).dy) ' distance of the bolt line
Bolts(i).frames = Int(Bolts(i).d / ppfSpeed) + 1 ' divide that distance by pulse = PulseLength
Bolts(i).frame = 1 ' set the frame you are on to locate the pulse in drawing
ang = _Atan2(y2 - y1, x2 - x1)
Bolts(i).speedX = ppfSpeed * Cos(ang)
Bolts(i).speedY = ppfSpeed * Sin(ang)
Bolts(i).x = x1 ' track leading x, y, r of current bolt for collision detection
Bolts(i).y = y1
Bolts(i).r = r1
Bolts(i).red = Rnd ^ 2
Bolts(i).grn = Rnd ^ 2
Bolts(i).blu = Rnd ^ 2
Exit Sub
End If
Next
End Sub
Sub DrawBolt (idx) ' needs FCirc (Fill Circle) routine
' This sub draw a pulse of light on the BoltLine from .x1, .y1 on the way to .x2, .y2
' The start radius is .r1 and the end radius is .r2 and the pulse is thinned or thickened
' as it proceeds down the boltLine.
'All this is setup in the NewBolt Sub and uses DIM Shared Bolts() as BoltType and Constants
' NBolts = max amount of activated Bolt "slots" available and PulseLength the length of
' BoltLine sections to draw in each frame.
Dim i, d, stepper
' new lead position for tracking location for collision detection
Bolts(idx).x = Bolts(idx).x1 + Bolts(idx).speedX * Bolts(idx).frame
Bolts(idx).y = Bolts(idx).y1 + Bolts(idx).speedY * Bolts(idx).frame
d = _Hypot(Bolts(idx).x1 - Bolts(idx).x, Bolts(idx).y1 - Bolts(idx).y)
If Abs(Bolts(idx).dr / PulseLength) < .2 Then stepper = .5 Else stepper = 2
Bolts(idx).r = Bolts(idx).r1 + d * Bolts(idx).dr / Bolts(idx).d
For i = d - PulseLength To d Step stepper
If i >= 0 Then
FCirc Bolts(idx).x1 + i * Bolts(idx).dx / Bolts(idx).d, Bolts(idx).y1 + i * Bolts(idx).dy _
/ Bolts(idx).d, Bolts(idx).r1 + i * Bolts(idx).dr / Bolts(idx).d, &H05DDDDFF
FCirc Bolts(idx).x1 + i * Bolts(idx).dx / Bolts(idx).d, Bolts(idx).y1 + i * Bolts(idx).dy _
/ Bolts(idx).d, .65 * Bolts(idx).r1 + i * .65 * Bolts(idx).dr / Bolts(idx).d, _
Plasma~&(Bolts(idx).red, Bolts(idx).grn, Bolts(idx).blu, i)
End If
Next
Bolts(idx).frame = Bolts(idx).frame + 1 ' update frame number
If Bolts(idx).frame > Bolts(idx).frames Then Bolts(idx).active = 0 ' job done!
End Sub
Sub FCirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
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
(07-21-2023, 03:00 AM)Dav Wrote: @bplus, you coding always amazes me. Great stuff.
That image library by @RhoSigma is incredible! Packed with filters.
- Dav
Thanks Dav
This should be more star like, though less colorful:
Code: (Select All)
Option _Explicit
_Title "Bolts Star Burst 2" ' b+ 2023-07-15 started as Bloom.bas
' 2023-07-16 rename to Bolt from Bloom and comment better and make more generic
' 2023-07-17 Bolts 2: move the bolt down the BoltLine by speed like a bullet.
' 2023-07-18 Bolts 2 tweaks: tweak numbers for more transparency and then more solid little rays.
' But Mark how do we detect hits from lasers, OK added x, y, r to track the current location
' and radius of the laser bolt.
' BoltLine: Imagine a line with a thickness at one end and a different thickness at then other.
' Colored like I imagine a Laser beam yellowish white core with bluish tinge around the edges.
' Now draw sections of that BoltLine according to the frames of display in main loop.
' This is a demo of that!
' Bolts 3 Colorized
' 2023-07-20 Bolts Star Burst
' 2023-07-21 Bolts - Star Burst 2 with more appropriate coloring and background
Const NBolts = 200 ' max number of Bolt slots available, just like bullet science
Const PulseLength = 140 ' length of light pulses as they travel down BoltLine
Type BoltType 'see NewBolt for description of these variables
As Single x1, y1, r1, dx, dy, dr, d, frames, frame, active, speedX, speedY, x, y, r, red, grn, blu
End Type
Dim Shared Bolts(1 To NBolts) As BoltType
Dim Shared As Long bk, xmax, ymax
Dim i, minR, d, cx, cy, ang
cx = .5 * _Width: cy = .5 * _Height ' center
minR = _Hypot(cx, cy)
Do
Cls
_PutImage , bk, 0
For i = 1 To NBolts
If Bolts(i).active Then
DrawBolt (i) ' draws the bolts still active
Else
d = Rnd * minR + 10: ang = Rnd * _Pi(2)
NewBolt cx, cy, 30, cx + d * Cos(ang), cy + d * Sin(ang), 1, 30
End If
Next ' according to what frame they are on
_Display
_Limit 60
Loop Until _KeyDown(27)
Sub NewBolt (x1, y1, r1, x2, y2, r2, ppfSpeed) ' sets up for the DrawBolt Sub
'x1, y1, r1 = location and radius at start of beam
'x2, y2, r2 = target location and radius at beam end
'ppfSpeed = how many pixels per frame in main loop to transverse
Dim i, ang
For i = 1 To NBolts
If Bolts(i).active = 0 Then
Bolts(i).x1 = x1 ' start x, y, radius
Bolts(i).y1 = y1
Bolts(i).r1 = r1
Bolts(i).active = 1 ' bolt is activated
Bolts(i).dx = x2 - x1 ' drawing the bolt line and thickness
Bolts(i).dy = y2 - y1 ' as it changes from x1, y1, r1 to x2, y2, r2
Bolts(i).dr = r2 - r1
Bolts(i).d = _Hypot(Bolts(i).dx, Bolts(i).dy) ' distance of the bolt line
Bolts(i).frames = Int(Bolts(i).d / ppfSpeed) + 1 ' divide that distance by pulse = PulseLength
Bolts(i).frame = 1 ' set the frame you are on to locate the pulse in drawing
ang = _Atan2(y2 - y1, x2 - x1)
Bolts(i).speedX = ppfSpeed * Cos(ang)
Bolts(i).speedY = ppfSpeed * Sin(ang)
Bolts(i).x = x1 ' track leading x, y, r of current bolt for collision detection
Bolts(i).y = y1
Bolts(i).r = r1
Bolts(i).red = Rnd ^ 2
Bolts(i).grn = Rnd ^ 2
Bolts(i).blu = Rnd ^ 2
Exit Sub
End If
Next
End Sub
Sub DrawBolt (idx) ' needs FCirc (Fill Circle) routine
' This sub draw a pulse of light on the BoltLine from .x1, .y1 on the way to .x2, .y2
' The start radius is .r1 and the end radius is .r2 and the pulse is thinned or thickened
' as it proceeds down the boltLine.
'All this is setup in the NewBolt Sub and uses DIM Shared Bolts() as BoltType and Constants
' NBolts = max amount of activated Bolt "slots" available and PulseLength the length of
' BoltLine sections to draw in each frame.
Dim i, d, stepper
' new lead position for tracking location for collision detection
Bolts(idx).x = Bolts(idx).x1 + Bolts(idx).speedX * Bolts(idx).frame
Bolts(idx).y = Bolts(idx).y1 + Bolts(idx).speedY * Bolts(idx).frame
d = _Hypot(Bolts(idx).x1 - Bolts(idx).x, Bolts(idx).y1 - Bolts(idx).y)
If Abs(Bolts(idx).dr / PulseLength) < .2 Then stepper = .5 Else stepper = 2
Bolts(idx).r = Bolts(idx).r1 + d * Bolts(idx).dr / Bolts(idx).d
For i = d - PulseLength To d Step stepper
If i >= 0 Then
FCirc Bolts(idx).x1 + i * Bolts(idx).dx / Bolts(idx).d, Bolts(idx).y1 + i * Bolts(idx).dy _
/ Bolts(idx).d, Bolts(idx).r1 + i * Bolts(idx).dr / Bolts(idx).d, &H05DDDDFF
FCirc Bolts(idx).x1 + i * Bolts(idx).dx / Bolts(idx).d, Bolts(idx).y1 + i * Bolts(idx).dy _
/ Bolts(idx).d, .65 * Bolts(idx).r1 + i * .65 * Bolts(idx).dr / Bolts(idx).d, _
Plasma~&(Bolts(idx).red, Bolts(idx).grn, Bolts(idx).blu, i)
End If
Next
Bolts(idx).frame = Bolts(idx).frame + 1 ' update frame number
If Bolts(idx).frame > Bolts(idx).frames Then Bolts(idx).active = 0 ' job done!
End Sub
Function Plasma~& (r, g, b, cN)
Plasma~& = _RGB32(223 + 32 * Sin(r * cN), 223 + 32 * Sin(g * cN), 190, 20)
End Function
Sub makeBackground
bk = _NewImage(xmax, ymax, 32)
_Dest bk
Dim As Long i, stars, horizon
For i = 0 To ymax
Line (0, i)-(xmax, i), _RGB32(70, 60, i / ymax * 160)
Next
stars = xmax * ymax * 10 ^ -4
For i = 1 To stars 'stars in sky
PSet (Rnd * xmax, Rnd * ymax), _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
Next
stars = stars / 2
For i = 1 To stars
FCirc Rnd * xmax, Rnd * ymax, 1, _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
Next
stars = stars / 2
For i = 1 To stars
FCirc Rnd * xmax, Rnd * horizon, 2, _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
Next
_PutImage , 0, bk
_Dest 0
End Sub
Sub FCirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
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
Check out the above example. The reason I shared the CSS one is because you could just test in browser immediately (and you don't need to futz with gimp, etc).
If it isn't supported natively by QB64 we might be able to make it into a library or something?
