QB64 Phoenix Edition › QB64 Rising › Code and Stuff › Programs v
Laser Lovers

Threaded Mode
Laser Lovers
bplus Offline
Mini-Mod
***
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation: 134
#1
07-29-2023, 07:35 PM
Here is yet another version, Cloud variation:
Code: (Select All)
_Title "Cloud" ' b+ 2023-07-29
Option _Explicit
' from Laser Blades replace Blade drawing with cloud drawing

Const NBolts = 50 ' max number of Bolt slots available, just like bullet science
Const PulseLength = 120 ' 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

'test cloud first
'Cloud 600, 200, 50, 600, 500, 20, &H88FFFFFF ' OK
'Cls
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, 5, 15, &HFFFF4444
    ElseIf lpc = 30 Then
        If Rnd < .7 Then NewBolt _Width - 1, 0, 1, 600, 350, 13, 10, &HFF447744
    ElseIf lpc = 60 Then
        If Rnd < .7 Then NewBolt _Width - 1, _Height - 1, 1, 600, 350, 15, 7, &HFFFF44FF
    ElseIf lpc = 90 Then
        If Rnd < .7 Then NewBolt 0, _Height - 1, 1, 600, 350, 18, 5, &HFF448888
    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, 30, 10, _RGB32(200, 200, 255, 100)
        While _MouseInput Or _MouseButton(1): Wend
    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
        Cloud 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
    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
        Cloud oldX, oldY, r2, Bolts(idx).x, Bolts(idx).y, Bolts(idx).r, Bolts(idx).k
    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


Sub Cloud (xx1, yy1, rr1, xx2, yy2, rr2, c~&) ' another attempt at a Laser Pulse or Bolt
    ' scatter pixels over area from p1 to p2 with the radius spec
    Dim x1, y1, r1, x2, y2, r2
    If xx1 > xx2 Then ' orientate
        x1 = xx2: x2 = xx1
        y1 = yy2: y2 = yy1
        r1 = rr2: r2 = rr1
    Else
        x1 = xx1: x2 = xx2
        y1 = yy1: y2 = yy2
        r1 = rr1: r2 = rr2
    End If
    Dim ang, dx, dy, dr, d, pd2, p2, a, stepper, n, r, i, x, y, r3
    pd2 = _Pi / 2
    p2 = _Pi * 2
    ang = _Atan2(y2 - y1, x1 - x2)
    dx = x2 - x1
    dy = y2 - y1
    dr = r2 - r1
    d = _Hypot(dx, dy)

    ' one end
    stepper = 2 / (p2 * r1)
    For a = -ang To -ang + pd2 Step stepper
        For n = 1 To .1 * r1
            r = randWeight(0, r1, 1)
            PSet (x1 + r * Cos(a), y1 + r * Sin(a)), c~&
        Next
    Next
    For a = -ang To -ang - pd2 Step -stepper
        For n = 1 To .1 * r1
            r = randWeight(0, r1, 1)
            PSet (x1 + r * Cos(a), y1 + r * Sin(a)), c~&
        Next
    Next
    ' the other end
    stepper = 2 / (p2 * r2)
    For a = ang To ang + pd2 Step stepper
        For n = 1 To .1 * r2
            r = -randWeight(0, r2, 1)
            PSet (x2 + r * Cos(-a), y2 + r * Sin(-a)), c~&
        Next
    Next
    For a = ang To ang - pd2 Step -stepper
        For n = 1 To .1 * r1
            r = -randWeight(0, r2, 1)
            PSet (x2 + r * Cos(-a), y2 + r * Sin(-a)), c~&
        Next
    Next
    ' down the line   for some reason I have to jiggle the minus signs for x's ???
    dy = dy / d
    dx = dx / d
    dr = dr / d
    For i = 0 To d
        x = x1 + i * dx: y = y1 + i * dy: r = r1 + i * dr
        'PSet (x - r * Cos(ang + pd2), y + r * Sin(ang + pd2)), c~&
        'PSet (x - r * Cos(ang - pd2), y + r * Sin(ang - pd2)), c~&
        For n = 1 To 1 * r
            r3 = randWeight(0, r, 4)
            PSet (x - r3 * Cos(ang + pd2), y + r3 * Sin(ang + pd2)), c~&
            r3 = randWeight(0, r, 4)
            PSet (x - r3 * Cos(ang - pd2), y + r3 * Sin(ang - pd2)), c~&
        Next
    Next

End Sub

Function randWeight (manyValue, fewValue, power)
    randWeight = manyValue + Rnd ^ power * (fewValue - manyValue)
End Function

   
b = b + ...
Find
Reply
bplus Offline
Mini-Mod
***
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation: 134
#2
07-29-2023, 07:38 PM
Star Burst with Cloud:
Code: (Select All)
Option _Explicit
_Title "Bolts Star Burst Cloud" ' b+ 2023-07-29  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 = 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, 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 As Long bk, xmax, ymax
Dim i, minR, d, cx, cy, ang

Randomize Timer
Screen _NewImage(1200, 700, 32)
_ScreenMove 50, 20
xmax = _Width: ymax = _Height
makeBackground
'_PutImage , bk, 0
'End


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 + 2 * PulseLength: ang = Rnd * _Pi(2)
            NewBolt cx, cy, 30, cx + d * Cos(ang), cy + d * Sin(ang), 1, 10, _RGB32(Rnd * 55 + 200, Rnd * 100 + 100, 0, Rnd * 50 + 100)
        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, 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
        Cloud 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
    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
        Cloud oldX, oldY, r2, Bolts(idx).x, Bolts(idx).y, Bolts(idx).r, Bolts(idx).k
    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

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

Sub Cloud (xx1, yy1, rr1, xx2, yy2, rr2, c~&) ' another attempt at a Laser Pulse or Bolt
    ' scatter pixels over area from p1 to p2 with the radius spec
    Dim x1, y1, r1, x2, y2, r2
    If xx1 > xx2 Then ' orientate
        x1 = xx2: x2 = xx1
        y1 = yy2: y2 = yy1
        r1 = rr2: r2 = rr1
    Else
        x1 = xx1: x2 = xx2
        y1 = yy1: y2 = yy2
        r1 = rr1: r2 = rr2
    End If
    Dim ang, dx, dy, dr, d, pd2, p2, a, stepper, n, r, i, x, y, r3
    pd2 = _Pi / 2
    p2 = _Pi * 2
    ang = _Atan2(y2 - y1, x1 - x2)
    dx = x2 - x1
    dy = y2 - y1
    dr = r2 - r1
    d = _Hypot(dx, dy)

    ' one end
    stepper = 2 / (p2 * r1)
    For a = -ang To -ang + pd2 Step stepper
        For n = 1 To .1 * r1
            r = randWeight(0, r1, 1)
            PSet (x1 + r * Cos(a), y1 + r * Sin(a)), c~&
        Next
    Next
    For a = -ang To -ang - pd2 Step -stepper
        For n = 1 To .1 * r1
            r = randWeight(0, r1, 1)
            PSet (x1 + r * Cos(a), y1 + r * Sin(a)), c~&
        Next
    Next
    ' the other end
    stepper = 2 / (p2 * r2)
    For a = ang To ang + pd2 Step stepper
        For n = 1 To .1 * r2
            r = -randWeight(0, r2, 1)
            PSet (x2 + r * Cos(-a), y2 + r * Sin(-a)), c~&
        Next
    Next
    For a = ang To ang - pd2 Step -stepper
        For n = 1 To .1 * r1
            r = -randWeight(0, r2, 1)
            PSet (x2 + r * Cos(-a), y2 + r * Sin(-a)), c~&
        Next
    Next
    ' down the line   for some reason I have to jiggle the minus signs for x's ???
    dy = dy / d
    dx = dx / d
    dr = dr / d
    For i = 0 To d
        x = x1 + i * dx: y = y1 + i * dy: r = r1 + i * dr
        'PSet (x - r * Cos(ang + pd2), y + r * Sin(ang + pd2)), c~&
        'PSet (x - r * Cos(ang - pd2), y + r * Sin(ang - pd2)), c~&
        For n = 1 To 1 * r
            r3 = randWeight(0, r, 4)
            PSet (x - r3 * Cos(ang + pd2), y + r3 * Sin(ang + pd2)), c~&
            r3 = randWeight(0, r, 4)
            PSet (x - r3 * Cos(ang - pd2), y + r3 * Sin(ang - pd2)), c~&
        Next
    Next

End Sub

Function randWeight (manyValue, fewValue, power)
    randWeight = manyValue + Rnd ^ power * (fewValue - manyValue)
End Function

   
b = b + ...
Find
Reply
johnno56 Offline
Member
***
Posts: 144
Threads: 10
Joined: Apr 2022
Reputation: 5
#3
07-31-2023, 08:09 PM
Awww.... That poor defenseless alien....

Cool effects!
May your journey be free of incident. Live long and prosper.
Find
Reply
mnrvovrfc Away
Posting Freak
*****
Posts: 1,510
Threads: 53
Joined: Jul 2022
Reputation: 47
#4
Star  07-31-2023, 10:26 PM
The screenshots in these two pages would have had someone else drooling to give a contract for an arcade game in the 1980's...

Some people might not like the "haze" but solid-color effects could be boring and tire the eyes after a while. If it's a fast-moving projectile it doesn't have to be solid, does it? A bullet cannot be seen coming out of a gun, it just lands somewhere, hopefully not inside a person. Also outer space is not like the earth contained in an atmosphere which greatly slows everything down. Including all the alien-tech LOL.

Many years ago I saw a movie of aliens attacking. Toward the end, they suddenly stopped because supposedly bacteria and viruses affected them. It was sort of a sham but I had nothing else better to do that day. Blush
Find
Reply
bplus Offline
Mini-Mod
***
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation: 134
#5
07-31-2023, 10:45 PM (This post was last modified: 07-31-2023, 10:53 PM by bplus.)
Thanks johnno and mnrvovrfc your encouragement has me resolved to explore this with images as I had replied in Summer LASER Challenge after OldMoses go.

@mnrvovrfc you could be referring to War of the Worlds first broadcast on radio and caused a panic in New Jersey because they thought it was real. Some broadcasting rules were made after that! HG Wells classic made into movies at least twice. https://en.wikipedia.org/wiki/The_War_of...was%20real.
b = b + ...
Find
Reply




Users browsing this thread: 2 Guest(s)