Thankyou mnrvovrfc
I have renamed named things; mainly Bloom is now Bolt because I don't want to create impression this is anything like a 3D Bloom that would take 1000's of LOC, just a simple 2D job that tries to simulate laser beams in pulses (sections of Bolt Line displayed in frames). I set 2 constants NBolts and PulseLength and lots more comments for easier mods and portability.
Yikes! They are shooting back at my ship... watch out for lower left corner specially ;-))
Sorry for all the edits, trying to make this clear and simple and correct as possible.
I have renamed named things; mainly Bloom is now Bolt because I don't want to create impression this is anything like a 3D Bloom that would take 1000's of LOC, just a simple 2D job that tries to simulate laser beams in pulses (sections of Bolt Line displayed in frames). I set 2 constants NBolts and PulseLength and lots more comments for easier mods and portability.
Yikes! They are shooting back at my ship... watch out for lower left corner specially ;-))
Code: (Select All)
Option _Explicit
_Title "Bolt: 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
' 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
As Single x1, y1, dx, dy, dr, d, r1, x2, y2, r2, frames, frame, active
End Type
Dim Shared Bolts(1 To NBolts) As BoltType
Dim mx, my, i, lpc
Randomize Timer
Screen _NewImage(1200, 700, 32)
_ScreenMove 50, 20
Do
Cls
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 < .2 Then NewBolt 0, 0, 1, 600, 350, 10
ElseIf lpc = 30 Then
If Rnd < .2 Then NewBolt _Width - 1, 0, 1, 600, 350, 20
ElseIf lpc = 60 Then
If Rnd < .2 Then NewBolt _Width - 1, _Height - 1, 1, 600, 350, 30
ElseIf lpc = 90 Then
If Rnd < .2 Then NewBolt 0, _Height - 1, 1, 600, 350, 50
End If
lpc = (lpc + 1) Mod 120 ' loopscounter every 30 shoot from a corner
While _MouseInput: Wend
mx = _MouseX: my = _MouseY
If _MouseButton(1) Then
NewBolt 600, 340, 1, mx, my, 15
_Delay .1 ' wait a little for mouse release so 2 bolts aren't draw from 1 click
End If
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
_Display
_Limit 60
Loop Until _KeyDown(27)
Sub NewBolt (x1, y1, r1, x2, y2, r2) ' sets up for the DrawBolt Sub
Dim i
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).x2 = x2 ' target x, y, radius (not precisely where bolt ends)
Bolts(i).y2 = y2
Bolts(i).r2 = r2
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 / PulseLength) + 1 ' divide that distance by pulse = PulseLength
Bolts(i).frame = 1 ' set the frame you are on to locate the pulse in drawing
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 '
For i = (Bolts(idx).frame - 1) * PulseLength To Bolts(idx).frame * (PulseLength - 1) Step 2
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
Next
_Display
_Delay .001
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
Sorry for all the edits, trying to make this clear and simple and correct as possible.
b = b + ...