07-24-2023, 10:49 PM
An alternate way to draw Laser Bolts:
Code: (Select All)
Option _Explicit
_Title "Laser Blades" 'b+ 2023-07-24 another way to do laser beams
Const NBolts = 50 ' max number of Bolt slots available, just like bullet science
Const PulseLength = 150 ' 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, ang, frames, frame, active, speedX, speedY, x, y, r
As _Unsigned Long k
End Type
Dim Shared Bolts(1 To NBolts) As BoltType
Dim Shared bk
Dim As Long mx, my, i, lpc, blastedShip, r
Randomize Timer
Screen _NewImage(1200, 700, 32)
_ScreenMove 50, 20
makeBackground
Do
Cls
_PutImage , bk, 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, 20, 3, &HCCFF0000
ElseIf lpc = 30 Then
If Rnd < .7 Then NewBolt _Width - 1, 0, 1, 600, 350, 25, 2, &HCC007700
ElseIf lpc = 60 Then
If Rnd < .7 Then NewBolt _Width - 1, _Height - 1, 1, 600, 350, 30, 3, &HCCFF00FF
ElseIf lpc = 90 Then
If Rnd < .7 Then NewBolt 0, _Height - 1, 1, 600, 350, 35, 2, &HCC008888
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, 25, 10, _RGB32(255, 255, 0, 180)
_Delay .25
End If
_Display
_Limit 60
Loop Until _KeyDown(27)
Sub NewBolt (x1, y1, r1, x2, y2, r2, ppfSpeed, k~&) ' 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
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
Bolts(i).ang = _Atan2(y2 - y1, x2 - x1)
Bolts(i).speedX = ppfSpeed * Cos(Bolts(i).ang)
Bolts(i).speedY = ppfSpeed * Sin(Bolts(i).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).k = k~&
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 d, d2, stepper, oldX, oldY, r2
' 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
If d < PulseLength Then
Blade Bolts(idx).x1, Bolts(idx).y1, Bolts(idx).r1 + d2 * Bolts(idx).dr / Bolts(idx).d, Bolts(idx).x, Bolts(idx).y, Bolts(idx).r, Bolts(idx).k
Blade Bolts(idx).x1, Bolts(idx).y1, .4 * Bolts(idx).r1 + d2 * Bolts(idx).dr / Bolts(idx).d, Bolts(idx).x, Bolts(idx).y, .4 * Bolts(idx).r, &H80FFFFFF
Else
oldX = Bolts(idx).x + PulseLength * Cos(Bolts(idx).ang - _Pi)
oldY = Bolts(idx).y + PulseLength * Sin(Bolts(idx).ang - _Pi)
d2 = _Hypot(Bolts(idx).x1 - oldX, Bolts(idx).y1 - oldY)
r2 = Bolts(idx).r1 + d2 * Bolts(idx).dr / Bolts(idx).d
Blade oldX, oldY, r2, Bolts(idx).x, Bolts(idx).y, Bolts(idx).r, Bolts(idx).k
Blade oldX, oldY, .4 * r2, Bolts(idx).x, Bolts(idx).y, .4 * Bolts(idx).r, &H80FFFFFF
End If
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 Blade (x1, y1, r1, x2, y2, r2, K As _Unsigned Long)
Dim PD2 As Double
Dim As Single a, x3, y3, x4, y4, x5, y5, x6, y6, r1d2, r2d2
PD2 = 1.570796326794897 ' pi/2
a = _Atan2(y2 - y1, x2 - x1)
r1d2 = r1 / 2: r2d2 = r2 / 2
x3 = x1 + r1d2 * Cos(a + PD2)
y3 = y1 + r1d2 * Sin(a + PD2)
x4 = x1 + r1d2 * Cos(a - PD2)
y4 = y1 + r1d2 * Sin(a - PD2)
x5 = x2 + r2d2 * Cos(a + PD2)
y5 = y2 + r2d2 * Sin(a + PD2)
x6 = x2 + r2d2 * Cos(a - PD2)
y6 = y2 + r2d2 * Sin(a - PD2)
ftri x6, y6, x4, y4, x3, y3, K
ftri x3, y3, x5, y5, x6, y6, K
End Sub
'2019-12-16 fix by Steve saves some time with STATIC and saves and restores last dest
Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
Dim D As Long
Static a&
D = _Dest
If a& = 0 Then a& = _NewImage(1, 1, 32)
_Dest a&
_DontBlend a& ' '<<<< new 2019-12-16 fix
PSet (0, 0), K
_Blend a& '<<<< new 2019-12-16 fix
_Dest D
_MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
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 - 120, 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
Sub makeBackground
bk = _NewImage(_Width, _Height, 32)
_Dest bk
Dim As Long i, stars, horizon
For i = 0 To _Height
Line (0, i)-(_Width, i), _RGB32(70, 60, i / _Height * 160)
Next
stars = _Width * _Height * 10 ^ -4
For i = 1 To stars 'stars in sky
PSet (Rnd * _Width, Rnd * _Height), _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
Next
stars = stars / 2
For i = 1 To stars
FCirc Rnd * _Width, Rnd * _Height, 1, _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
Next
stars = stars / 2
For i = 1 To stars
FCirc Rnd * _Width, Rnd * horizon, 2, _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
Next
_PutImage , 0, bk
_Dest 0
End Sub
b = b + ...
This is a cool idea. If I ever get some idea fresh in my mind I might start programming again. I just thought I would pop in and say Hello.
