I was just now adding a simple blur to see what it would look like. Not optimized or nothing, just wanted to see if any blur in realtime would work. Kept it all in one area, had to DIM variables there.
EDIT: Came on THIS post on freebasic forum. Has some simple steps on one of the posts.
- Dav
EDIT: Came on THIS post on freebasic forum. Has some simple steps on one of the posts.
- Dav
Code: (Select All)
Option _Explicit
Const SWIDTH = 1280
Const SHEIGHT = 720
Type TYPE_VECTOR
x As Single ' x vector/coordinate
y As Single ' y vector/coordinate
End Type
Type TYPE_LINE
Start As TYPE_VECTOR ' start coordinate of laser beam line
Finish As TYPE_VECTOR ' end coordinate of laser beam line
'Center AS TYPE_VECTOR ' center coordinate of laser beam line
End Type
Type TYPE_LASER
Origin As TYPE_VECTOR
Head As TYPE_LINE ' overall rectangle
Tail As TYPE_LINE
Beam As TYPE_LINE ' center beam
HeadSpeed As Single
TailSpeed As Single
MaxSpeed As Single
Vector As TYPE_VECTOR ' vector direction of laser
Degree As Integer ' degree direction of laser
Speed As Single ' speed of laser
LaserColor As _Unsigned Long
GlowColor As _Unsigned Long
Active As Integer ' laser is active (t/f)
End Type
ReDim Laser(0) As TYPE_LASER
Dim Vec(359) As TYPE_VECTOR
'DIM i AS INTEGER
Dim Degree As Integer
Dim Origin As TYPE_VECTOR
Dim Colour As Integer
Dim Speed As Single
Dim RapidFire As Integer
'DIM Size AS SINGLE
Degree = 0 ' precalculate degree vectors
Do
Vec(Degree).x = Sin(_D2R(Degree))
Vec(Degree).y = -Cos(_D2R(Degree))
Degree = Degree + 1
Loop Until Degree = 360
Screen _NewImage(SWIDTH, SHEIGHT, 32)
Cls
Origin.x = 100
Origin.y = 359
Degree = 90
Colour = 4
Speed = 15
'Size = 1
Do
_Limit 60
Cls
If _KeyDown(32) And RapidFire = 0 Then
SHOOT_LASER Origin, Degree, Speed, Colour
Degree = FIX_DEGREE(Degree + 2)
RapidFire = 10
Else
If RapidFire Then RapidFire = RapidFire - 1
End If
UPDATE_LASER
_Display
Loop Until _KeyDown(27)
Sub SHOOT_LASER (Origin As TYPE_VECTOR, Degree As Integer, Speed As Single, Colour As Integer)
Shared Laser() As TYPE_LASER
Shared Vec() As TYPE_VECTOR
Dim Index As Integer
Index = -1 ' reset index counter
Do ' begin free index search
Index = Index + 1 ' increment index counter
If Laser(Index).Active = 0 Then Exit Do ' is this index free?
Loop Until Index = UBound(Laser) ' leave when all indexes checked
If Laser(Index).Active Then ' were all indexes checked?
Index = Index + 1 ' yes, no free indexes, increment index
ReDim _Preserve Laser(Index) As TYPE_LASER ' create a new index in array
End If
Degree = FIX_DEGREE(Degree)
Laser(Index).Active = -1
Laser(Index).Origin = Origin
Laser(Index).Vector = Vec(Degree)
Laser(Index).Degree = Degree
Laser(Index).HeadSpeed = Speed
Laser(Index).TailSpeed = Speed * .5
Laser(Index).Speed = Speed
Laser(Index).LaserColor = _RGB32((Colour And 4) * 64, (Colour And 2) * 128, (Colour And 1) * 256)
Laser(Index).Beam.Start = Origin
Laser(Index).Beam.Finish = Origin
Laser(Index).Head.Start.x = Origin.x - 2
Laser(Index).Head.Start.y = Origin.y
Laser(Index).Head.Finish.x = Origin.x + 2
Laser(Index).Head.Finish.y = Origin.y
Rotate Laser(Index).Head.Start, Degree, Origin ' rotate line
Rotate Laser(Index).Head.Finish, Degree, Origin
Laser(Index).Tail = Laser(Index).Head
Select Case Colour
Case 4
Laser(Index).GlowColor = _RGB32(255, 211, 80)
Case 7
Laser(Index).GlowColor = _RGB32(0, 128, 255)
End Select
End Sub
Sub UPDATE_LASER ()
Shared Laser() As TYPE_LASER
Dim Index As Integer
Dim NoActive As Integer
NoActive = -1
Index = -1
Do
Index = Index + 1
If Laser(Index).Active Then
NoActive = 0
Laser(Index).Head.Start.x = Laser(Index).Head.Start.x + Laser(Index).Vector.x * Laser(Index).HeadSpeed
Laser(Index).Head.Start.y = Laser(Index).Head.Start.y + Laser(Index).Vector.y * Laser(Index).HeadSpeed
Laser(Index).Head.Finish.x = Laser(Index).Head.Finish.x + Laser(Index).Vector.x * Laser(Index).HeadSpeed
Laser(Index).Head.Finish.y = Laser(Index).Head.Finish.y + Laser(Index).Vector.y * Laser(Index).HeadSpeed
Laser(Index).Tail.Start.x = Laser(Index).Tail.Start.x + Laser(Index).Vector.x * Laser(Index).TailSpeed
Laser(Index).Tail.Start.y = Laser(Index).Tail.Start.y + Laser(Index).Vector.y * Laser(Index).TailSpeed
Laser(Index).Tail.Finish.x = Laser(Index).Tail.Finish.x + Laser(Index).Vector.x * Laser(Index).TailSpeed
Laser(Index).Tail.Finish.y = Laser(Index).Tail.Finish.y + Laser(Index).Vector.y * Laser(Index).TailSpeed
Laser(Index).Beam.Start.x = Laser(Index).Beam.Start.x + Laser(Index).Vector.x * Laser(Index).HeadSpeed
Laser(Index).Beam.Start.y = Laser(Index).Beam.Start.y + Laser(Index).Vector.y * Laser(Index).HeadSpeed
Laser(Index).Beam.Finish.x = Laser(Index).Beam.Finish.x + Laser(Index).Vector.x * Laser(Index).TailSpeed
Laser(Index).Beam.Finish.y = Laser(Index).Beam.Finish.y + Laser(Index).Vector.y * Laser(Index).TailSpeed
Laser(Index).HeadSpeed = Laser(Index).HeadSpeed * 1.04
Laser(Index).TailSpeed = Laser(Index).TailSpeed * 1.07
Line (Laser(Index).Tail.Start.x, Laser(Index).Tail.Start.y)-(Laser(Index).Tail.Finish.x, Laser(Index).Tail.Finish.y), Laser(Index).LaserColor
Line -(Laser(Index).Head.Finish.x, Laser(Index).Head.Finish.y), Laser(Index).LaserColor
Line -(Laser(Index).Head.Start.x, Laser(Index).Head.Start.y), Laser(Index).LaserColor
Line -(Laser(Index).Tail.Start.x, Laser(Index).Tail.Start.y), Laser(Index).LaserColor
Paint (Laser(Index).Beam.Finish.x + Laser(Index).Vector.x * 2, Laser(Index).Beam.Finish.y + Laser(Index).Vector.y), Laser(Index).LaserColor, Laser(Index).LaserColor
Line (Laser(Index).Tail.Start.x, Laser(Index).Tail.Start.y)-(Laser(Index).Tail.Finish.x, Laser(Index).Tail.Finish.y), Laser(Index).GlowColor
Line -(Laser(Index).Head.Finish.x, Laser(Index).Head.Finish.y), Laser(Index).GlowColor
Line -(Laser(Index).Head.Start.x, Laser(Index).Head.Start.y), Laser(Index).GlowColor
Line -(Laser(Index).Tail.Start.x, Laser(Index).Tail.Start.y), Laser(Index).GlowColor
'LINE (Laser(Index).Beam.Start.x, Laser(Index).Beam.Start.y)-(Laser(Index).Beam.Finish.x, Laser(Index).Beam.Finish.y), Laser(Index).LaserColor
'====================================================
Dim u As Integer, xx As Integer, yy As Integer
Dim p1 As Long, p2 As Long, p3 As Long, p4 As Long, p5 As Long, p6 As Long, p7 As Long, p8 As Long, p9 As Long
Dim rr As Long, gg As Long, bb As Long
For u = 1 To 5 'do it 5 times for more glow
For xx = Laser(Index).Tail.Start.x - 5 To Laser(Index).Head.Start.x + 5
For yy = Laser(Index).Tail.Start.y - 5 To Laser(Index).Head.Start.y + 5
p1 = Point(xx, yy)
p2 = Point(xx + 1, yy)
p3 = Point(xx, yy + 1)
p4 = Point(xx + 1, yy + 1)
p5 = Point(xx - 1, yy)
p6 = Point(xx, yy - 1)
p7 = Point(xx - 1, yy - 1)
p8 = Point(xx - 1, yy + 1)
p9 = Point(xx + 1, yy - 1)
rr = _Red32(p1) + _Red32(p2) + _Red32(p3) + _Red32(p4) + _Red32(p5) + _Red32(p6) + _Red32(p7) + _Red32(p8) + _Red32(p9)
gg = _Green32(p1) + _Green32(p2) + _Green32(p3) + _Green32(p4) + _Green32(p5) + _Green32(p6) + _Green32(p7) + _Green32(p8) + _Green32(p9)
bb = _Blue32(p1) + _Blue32(p2) + _Blue32(p3) + _Blue32(p4) + _Blue32(p5) + _Blue32(p6) + _Blue32(p7) + _Blue32(p8) + _Blue32(p9)
PSet (xx, yy), _RGB(rr / 8, gg / 8, bb / 8) 'do /8 instead or /9, makes it glow more
Next
Next
Next
'===========================================
If Laser(Index).Tail.Start.x < 0 Or Laser(Index).Tail.Start.x > SWIDTH Then Laser(Index).Active = 0
If Laser(Index).Tail.Start.y < 0 Or Laser(Index).Tail.Start.y > SHEIGHT Then Laser(Index).Active = 0
End If
Loop Until Index = UBound(Laser)
If NoActive And UBound(Laser) > 0 Then ReDim Laser(0) As TYPE_LASER: Beep
End Sub
Sub Rotate (vec As TYPE_VECTOR, angleDeg As Single, origin As TYPE_VECTOR)
' Rotate a point around an origin using linear transformations.
Dim x As Single
Dim y As Single
Dim __cos As Single
Dim __sin As Single
Dim xPrime As Single
Dim yPrime As Single
x = vec.x - origin.x ' move rotation vector origin to 0
y = vec.y - origin.y
__cos = Cos(_D2R(angleDeg)) ' get cosine and sine of angle
__sin = Sin(_D2R(angleDeg))
xPrime = (x * __cos) - (y * __sin) ' calculate rotated location of vector
yPrime = (x * __sin) + (y * __cos)
xPrime = xPrime + origin.x ' move back to original origin
yPrime = yPrime + origin.y
vec.x = xPrime ' pass back rotated vector
vec.y = yPrime
End Sub
' ______________________________________________________________________________________________________________________________________________
'/ \
Function FIX_DEGREE (Degree As Integer) ' __FIX_DEGREE |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Normalizes degree to between 0 and 359. |
'| |
'| Degree = FIX_DEGREE(-270) |
'\_______________________________________________________________________________________________________________________________________________/
Dim Deg As Integer ' degree value passed in
Deg = Degree ' get passed in degree value
If Deg < 0 Or Degree > 359 Then ' degree out of range?
Deg = Deg Mod 360 ' yes, get remainder of modulus 360
If Deg < 0 Then Deg = Deg + 360 ' add 360 if less than 0
End If
FIX_DEGREE = Deg ' return degree
End Function