Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Summer LASER Challenge
#31
(07-21-2023, 04:46 PM)grymmjack Wrote: Does QB64 support blending modes like photoshop, gimp, etc. ?

Normal, Overlay, Multiply, etc.

The one I think that would make the most sense for this effect would be "color dodge" or "linear dodge"

https://developer.mozilla.org/en-US/docs...blend-mode

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?

Colors will blend in alpha transparencies by default if I recall.
b = b + ...
Reply
#32
There is also the old _GL SUB from many years ago. Here is a neon line drawer I made. But I'm not sure if GL can work with regular graphics on the same screen. Not sure if I ever achieved that. 

Code: (Select All)
_Title "NEON PEN"
Screen _NewImage(800, 600, 32)

Type vec2
    x As Single
    y As Single
End Type

ReDim Shared vert(200024) As vec2, max_v_index
Dim Shared rFactor!, gFactor!, bFactor!
rFactor! = 0.5: gFactor! = 2.5: bFactor! = 0.5
Do
    'CLS
    Locate 1, 1: Print "VRAM Usage : "; vram; "KB"
    Locate 2, 1: Print "Vertices Used : "; max_v_index; "/"; UBound(vert)
    vram = (UBound(vert) * 4) / 1024
    a$ = InKey$
    If a$ = Chr$(27) Then End
    If a$ = " " Then
        Line (0, 0)-(800, 600), _RGB32(0, 0, 0), BF
        vert = 0
    End If


    While _MouseInput: Wend
    m = _MouseButton(1)
    If m = -1 Then
        t = t + 1
        px = mx: py = my
        mx = _MouseX: my = _MouseY
        If t < 2 Then GoTo notthistime:
        'px = mx: py = my
        While m = -1 And max_v_index < UBound(vert)
            While _MouseInput: Wend
            mx = _MouseX: my = _MouseY
            If Abs(px - mx) >= Abs(py - my) Then
                If mx >= px Then s = 1 Else s = -1
                For i = px To mx Step s
                    vert(max_v_index).x = i
                    vert(max_v_index).y = map(i, px, mx, py, my)
                    max_v_index = max_v_index + 1
                    'IF max_v_index > UBOUND(vert) THEN REDIM _PRESERVE vert(max_v_index * 2) AS vec2
                Next
            Else
                If my >= py Then s = 1 Else s = -1
                For i = py To my Step s
                    vert(max_v_index).x = map(i, py, my, px, mx)
                    vert(max_v_index).y = i
                    max_v_index = max_v_index + 1
                    'IF max_v_index > UBOUND(vert) THEN REDIM _PRESERVE vert(max_v_index * 2) AS vec2
                Next
            End If
            'px = mx: py = my
            notthistime:
            m = 0
        Wend
    End If
    _Limit 200
Loop

'This sub was changed from points to lines.
Sub _GL ()
    Static glInit
    If glInit = 0 Then
        glInit = 1

    End If
    _glViewport 0, 0, _Width, _Height
    'set the gl screen so that it can work normal screen coordinates
    _glTranslatef -1, 1, 0
    _glScalef 1 / 400, -1 / 300, 1

    _glEnable _GL_BLEND
    _glBlendFunc _GL_SRC_ALPHA, _GL_ONE
    _glEnableClientState _GL_VERTEX_ARRAY
    _glVertexPointer 2, _GL_FLOAT, 0, _Offset(vert())
    For j = 1 To 30
        'For j=1 to 15
        '_glColor4f rFactor!, gFactor!, bFactor!, 0.015
        _glColor4f rFactor!, gFactor!, bFactor!, 0.06
        _glPointSize j
        '_glDrawArrays _GL_POINTS, 10, max_v_index
        _glLineWidth 10
        _glDrawArrays _GL_LINE_STRIP, 0, max_v_index
    Next
    _glFlush
End Sub

Function map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
End Function
Reply
#33
And here is one Bplus made back then. This shows 3 shapes that fade, etc. 

Code: (Select All)
_Title "b+ dimmer switch raise and lower mouse"
Screen _NewImage(1024, 700, 32)
_Delay .25
_ScreenMove _Middle

Type vec2
    x As Single
    y As Single
End Type

ReDim vert(1 To 4024) As vec2

'First Box
For i = 50 To 350 Step 25
    vi = vi + 1
    vert(vi).x = 50
    vert(vi).y = i
    vi = vi + 1
    vert(vi).x = 350
    vert(vi).y = i
    If i <> 50 And i <> 350 Then
        vi = vi + 1
        vert(vi).x = i
        vert(vi).y = 50
        vi = vi + 1
        vert(vi).x = i
        vert(vi).y = 350
    End If
Next
'Second Box
For i = 250 To 650 Step 25
    vi = vi + 1
    vert(vi).x = 250
    vert(vi).y = i
    vi = vi + 1
    vert(vi).x = 650
    vert(vi).y = i
    If i <> 250 And i <> 650 Then
        vi = vi + 1
        vert(vi).x = i
        vert(vi).y = 250
        vi = vi + 1
        vert(vi).x = i
        vert(vi).y = 650
    End If
Next
For a = 0 To _Pi(2) - .01 Step _Pi(1 / 30)
    vi = vi + 1
    vert(vi).x = 750 + 200 * Cos(a)
    vert(vi).y = 350 + 200 * Sin(a)
Next


Do
    Cls
    While _MouseInput: Wend
    my = _MouseY / _Height * 12
    For power = 1 To my
        For i = 1 To vi
            For r = 1 To 25
                If vert(i).x = 0 And vert(i).y = 0 Then 'where is that coming from?
                    Locate 1, 1: Print i
                Else
                    fcirc vert(i).x, vert(i).y, r, _RGBA32(240, 230, 255, 3)
                End If
            Next
        Next
    Next
    _Display
    _Limit 60
Loop Until _KeyDown(27)


'from Steve Gold standard
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
Reply
#34
(07-27-2023, 02:38 AM)SierraKen Wrote: There is also the old _GL SUB from many years ago. Here is a neon line drawer I made. But I'm not sure if GL can work with regular graphics on the same screen. Not sure if I ever achieved that. 

Code: (Select All)
_Title "NEON PEN"
Screen _NewImage(800, 600, 32)

Type vec2
    x As Single
    y As Single
End Type

ReDim Shared vert(200024) As vec2, max_v_index
Dim Shared rFactor!, gFactor!, bFactor!
rFactor! = 0.5: gFactor! = 2.5: bFactor! = 0.5
Do
    'CLS
    Locate 1, 1: Print "VRAM Usage : "; vram; "KB"
    Locate 2, 1: Print "Vertices Used : "; max_v_index; "/"; UBound(vert)
    vram = (UBound(vert) * 4) / 1024
    a$ = InKey$
    If a$ = Chr$(27) Then End
    If a$ = " " Then
        Line (0, 0)-(800, 600), _RGB32(0, 0, 0), BF
        vert = 0
    End If


    While _MouseInput: Wend
    m = _MouseButton(1)
    If m = -1 Then
        t = t + 1
        px = mx: py = my
        mx = _MouseX: my = _MouseY
        If t < 2 Then GoTo notthistime:
        'px = mx: py = my
        While m = -1 And max_v_index < UBound(vert)
            While _MouseInput: Wend
            mx = _MouseX: my = _MouseY
            If Abs(px - mx) >= Abs(py - my) Then
                If mx >= px Then s = 1 Else s = -1
                For i = px To mx Step s
                    vert(max_v_index).x = i
                    vert(max_v_index).y = map(i, px, mx, py, my)
                    max_v_index = max_v_index + 1
                    'IF max_v_index > UBOUND(vert) THEN REDIM _PRESERVE vert(max_v_index * 2) AS vec2
                Next
            Else
                If my >= py Then s = 1 Else s = -1
                For i = py To my Step s
                    vert(max_v_index).x = map(i, py, my, px, mx)
                    vert(max_v_index).y = i
                    max_v_index = max_v_index + 1
                    'IF max_v_index > UBOUND(vert) THEN REDIM _PRESERVE vert(max_v_index * 2) AS vec2
                Next
            End If
            'px = mx: py = my
            notthistime:
            m = 0
        Wend
    End If
    _Limit 200
Loop

'This sub was changed from points to lines.
Sub _GL ()
    Static glInit
    If glInit = 0 Then
        glInit = 1

    End If
    _glViewport 0, 0, _Width, _Height
    'set the gl screen so that it can work normal screen coordinates
    _glTranslatef -1, 1, 0
    _glScalef 1 / 400, -1 / 300, 1

    _glEnable _GL_BLEND
    _glBlendFunc _GL_SRC_ALPHA, _GL_ONE
    _glEnableClientState _GL_VERTEX_ARRAY
    _glVertexPointer 2, _GL_FLOAT, 0, _Offset(vert())
    For j = 1 To 30
        'For j=1 to 15
        '_glColor4f rFactor!, gFactor!, bFactor!, 0.015
        _glColor4f rFactor!, gFactor!, bFactor!, 0.06
        _glPointSize j
        '_glDrawArrays _GL_POINTS, 10, max_v_index
        _glLineWidth 10
        _glDrawArrays _GL_LINE_STRIP, 0, max_v_index
    Next
    _glFlush
End Sub

Function map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
End Function

Yeah I think Ashish had a glowing thing worked out with _GL stuff. This one seems to be drawing thick lines as rectangles like my Laser Blades, no glow though that I see in this demo.
b = b + ...
Reply
#35
Ok, I finally got a chance to sit down for the past few days and continue working on this.

This is my first attempt at using a Gaussian blur to add bloom to the lasers and using an image based process to draw the lasers. Most of the math has been precalculated for speed as well as the images being pre-drawn, so the routines are very fast even though the laser is being redrawn over and over during the growing cycle. The Gaussian blur is done prior to any lasers being fired, so it's not even part of the drawing process. This speed things up considerably as well.

You'll also need the image of the ship below ( sb_ship_top_small.png ).

RIGHT / LEFT arrow keys to rotate ship, SPACEBAR to fire.

My next attempt will be to draw the lasers without using an image like Bplus has done in his examples.

Code: (Select All)

OPTION _EXPLICIT

CONST SCREENWIDTH = 1600
CONST SCREENHEIGHT = 900
'                              +-------------------------------+
TYPE TYPE_VECTOR '              |      VECTOR DEFINITION      |
    '                          +-------------------------------+
    x AS SINGLE '              x cordinate/vector
    y AS SINGLE '              y coordinate/vector
END TYPE
'                              +-------------------------------+
TYPE TYPE_RECTLINE '            |  RECTANGLE/LINE DEFINITION  |
    '                          +-------------------------------+
    s AS TYPE_VECTOR '          start of line (x,y)
    e AS TYPE_VECTOR '          end of line  (x,y)
END TYPE
'                              +-------------------------------+
TYPE TYPE_CIRCLE '              |      CIRCLE DEFINITION      |
    '                          +-------------------------------+
    Center AS TYPE_VECTOR '    center of circle (x,y)
    Radius AS SINGLE '          radius of circle
END TYPE
'                              +-------------------------------+
TYPE TYPE_LASER '              |      LASER DEFINITION        |
    '                          +-------------------------------+
    Active AS INTEGER '        laser currently active (t/f)
    Position AS TYPE_VECTOR '  laser coordinates (x,y)
    Cline AS TYPE_RECTLINE '    collision line    (x,y)-(x,y)
    Degree AS INTEGER '        degree of laser
    Vector AS TYPE_VECTOR '    laser travel vectors
    Length AS INTEGER '        laser length (height)
    Width AS INTEGER '          laser width
    Image AS INTEGER '          laser image canvas
    Speed AS SINGLE '          laser travel speed
    Grow AS INTEGER '          current laser growth value
    Tip AS LONG '              laser tip image canvas
    Body AS LONG '              laser body image canvas
    Owner AS INTEGER '          originator of laser (based on LaserImage() handle name)
END TYPE
'                              +-------------------------------+
TYPE TYPE_SHIP '                |        SHIP DEFINITION        |
    '                          +-------------------------------+
    TopImage AS LONG '          top down image of ship
    SideImage AS LONG '        side view image of ship (future use)
    Gun1 AS TYPE_VECTOR '      top/side image laser origin point
    Gun2 AS TYPE_VECTOR '      top image laser origin point 2
    TopWidth AS INTEGER '      width of top down image (future use)
    TopHeight AS INTEGER '      height of top down image (future use)
    SideWidth AS INTEGER '      width of side view image (future use)
    SideHeight AS INTEGER '    height of side view image (future use)
    TopCenter AS TYPE_VECTOR '  top down image center point (x,y)
    SideCenter AS TYPE_VECTOR ' side view image center point (x,y) (future use)
END TYPE
'                              +-------------------------------+
'                              |      DECLARED VARIABLES      |
'                              +-------------------------------+
REDIM Laser(0) AS TYPE_LASER '  laser array
REDIM LaserImage(0) AS LONG '  corner image of each laser created
DIM Vec(359) AS TYPE_VECTOR '  precalculated degree to vector values
DIM Ship(359) AS TYPE_SHIP '    prerotated ship images
DIM ShipLoc AS TYPE_VECTOR '    location of ship
DIM Temp AS LONG '              temporary processing image
DIM Degree AS INTEGER '        degree angle of ship
DIM BlueLaser AS INTEGER '      laser image pointers
DIM RedLaser AS INTEGER
DIM GreenLaser AS INTEGER
DIM Origin AS TYPE_VECTOR '    origin point for totation
DIM RapidFire AS INTEGER '      rapid fire laser delay
DIM LeftLaser AS TYPE_VECTOR '  left laser origin point
DIM RightLaser AS TYPE_VECTOR ' right laser origin point

'+-------------------------------------------------------------------------+
'| Create ship images, precalculate degree vectors and laser origin points |
'+-------------------------------------------------------------------------+

Temp = _LOADIMAGE("sb_ship_top_small.png", 32) '            load the top down ship image
Origin.x = 0 '                                                origin point for laser tip rotation
Origin.y = 0
Degree = 0
DO
    Vec(Degree).x = SIN(_D2R(Degree)) '                        precalculate degree vectors
    Vec(Degree).y = -COS(_D2R(Degree))
    Ship(Degree).TopImage = _COPYIMAGE(Temp) '                initial top down image of ship
    Ship(Degree).Gun1.x = -17 '                                initial left laser origin
    Ship(Degree).Gun1.y = -19
    Ship(Degree).Gun2.x = 17 '                                initial right laser origin
    Ship(Degree).Gun2.y = -19
    IF Degree > 0 THEN
        RotoZoomImage Ship(Degree).TopImage, Degree, 1 '      rotated top down image of ship
        RotatePoint Ship(Degree).Gun1, Degree, Origin '        rotated left laser origin
        RotatePoint Ship(Degree).Gun2, Degree, Origin '        rotated right laser origin
    END IF
    Ship(Degree).TopWidth = _WIDTH(Ship(Degree).TopImage) '    record width of each top down image  (future use)
    Ship(Degree).TopHeight = _HEIGHT(Ship(Degree).TopImage) '  record height of each top down image (future use)
    Ship(Degree).TopCenter.x = Ship(Degree).TopWidth * .5 '    calculate center point of each top down image
    Ship(Degree).TopCenter.y = Ship(Degree).TopHeight * .5
    Degree = Degree + 1 '                                      increment degree
LOOP UNTIL Degree = 360
_FREEIMAGE Temp '                                              remove temporary image from RAM

'+---------------+
'| Set up screen |
'+---------------+

_TITLE "LaserTest1"
SCREEN _NEWIMAGE(SCREENWIDTH, SCREENHEIGHT, 32)

'+---------------+
'| Define lasers |
'+---------------+

BlueLaser = MakeLaser(_RGB32(255, 255, 255), _RGB32(0, 255, 255), _RGB32(67, 123, 255))
RedLaser = MakeLaser(_RGB32(255, 255, 251), _RGB32(255, 155, 67), _RGB32(221, 79, 43))
GreenLaser = MakeLaser(_RGB32(0, 255, 0), _RGB32(63, 255, 0), _RGB32(255, 255, 0)) '    looks horrible, need to rework

'+----------------------------------+
'| Rotate ship and fire lasers test |  RIGHT / LEFT KEYS TO ROTATE SHIP, SPACEBAR TO FIRE LASERS <<-----------------------------
'+----------------------------------+

Degree = 90 '                                                  initial ship rotation degree
ShipLoc.x = 100 'SCREENWIDTH / 2                              initial ship location
ShipLoc.y = SCREENHEIGHT / 2
DO
    _LIMIT 60 '                                                60 frames per second
    CLS
    LOCATE 2, 2
    PRINT "--------- RIGHT / LEFT ARROW KEYS TO ROTATE SHIP --------- SPACEBAR TO FIRE LASERS ---------"
    IF _KEYDOWN(19200) THEN Degree = (FixDegree(Degree - 3)) ' left arrow pressed
    IF _KEYDOWN(19712) THEN Degree = (FixDegree(Degree + 3)) ' right arrow pressed
    _PUTIMAGE (ShipLoc.x - Ship(Degree).TopCenter.x, ShipLoc.y - Ship(Degree).TopCenter.y), Ship(Degree).TopImage ' draw ship
    IF _KEYDOWN(32) AND RapidFire = 0 THEN '                  space bar pressed
        LeftLaser.x = ShipLoc.x + Ship(Degree).Gun1.x '        calculate laser origin points
        LeftLaser.y = ShipLoc.y + Ship(Degree).Gun1.y
        RightLaser.x = ShipLoc.x + Ship(Degree).Gun2.x
        RightLaser.y = ShipLoc.y + Ship(Degree).Gun2.y
        ShootLaser RedLaser, LeftLaser, Degree, 15, 80, 3 '  laser type, laser origin, degree angle, speed, max length to grow, width
        ShootLaser BlueLaser, RightLaser, Degree, 15, 80, 3 '  shoot lasers (red = colonial viper, blue = cylon raider)
        RapidFire = 10 '                                      set delay timer
    ELSE
        IF RapidFire THEN RapidFire = RapidFire - 1 '          decrement delay timer if needed
    END IF
    UpdateLaser '                                              draw active lasers to screen
    _DISPLAY '                                                update screen with changes
LOOP UNTIL _KEYDOWN(27) '                                      leave when ESC key pressed
END

' ______________________________________________________________________________________________________________________________________________
'/                                                                                                                                              \
SUB UpdateLaser () '                                                                                                                UpdateLaser |
    ' __________________________________________________________________________________________________________________________________________|____
    '/                                                                                                                                              \
    '| Draw and update all active lasers to the screen.                                                                                              |
    '|                                                                                                                                              |
    '| UpdateLaser                                                                                                                                  |
    '\_______________________________________________________________________________________________________________________________________________/

    SHARED Laser() AS TYPE_LASER ' need access to laser array
    DIM Index AS INTEGER '        laser array index counter
    DIM Lw AS INTEGER '            width of laser image
    DIM Lh AS INTEGER '            height of laser image
    DIM NoActive AS INTEGER '      active lasers in array (t/f)
    DIM vx AS SINGLE '            collision line x offset
    DIM vy AS SINGLE '            collision line y offset

    Index = -1 '                                                                                            reset array index counter
    NoActive = -1 '                                                                                          assume no lasers active (TRUE)
    DO '                                                                                                    begin laser array check
        Index = Index + 1 '                                                                                  increment array index counter
        IF Laser(Index).Active THEN '                                                                        is this laser active?
            NoActive = 0 '                                                                                  yes, remember lasers active (FALSE)
            IF Laser(Index).Grow < Laser(Index).Length THEN '                                                laser at maximum length?

                '+---------------------------------------+
                '| Rebuild laser if it has grown in size |
                '+---------------------------------------+

                _FREEIMAGE Laser(Index).Image '                                                              no, remove previous image from RAM
                Laser(Index).Speed = Laser(Index).Speed * 1.015 '                                            increase speed of laser while it's growing
                Laser(Index).Grow = Laser(Index).Grow + 2 '                                                  increase length of laser (by 2 so always odd)
                IF Laser(Index).Grow >= Laser(Index).Length THEN Laser(Index).Grow = Laser(Index).Length '  stop at maximum length
                Lw = Laser(Index).Width '                                                                    set width and height of laser image
                Lh = Laser(Index).Grow + 16
                Laser(Index).Image = _NEWIMAGE(Lw, Lh, 32) '                                                create laser image canvas

                '+--------------------------+
                '| Draw updated laser image |
                '+--------------------------+

                _PUTIMAGE (0, 0), Laser(Index).Tip, Laser(Index).Image '                                    head of laser
                _PUTIMAGE (Lw - 1, Lh - 1)-(0, Lh - 8), Laser(Index).Tip, Laser(Index).Image '              tail of laser
                _PUTIMAGE (0, 8)-(Lw - 1, 7 + Laser(Index).Grow), Laser(Index).Body, Laser(Index).Image '    place twice for now to brighten up
                _PUTIMAGE (0, 8)-(Lw - 1, 7 + Laser(Index).Grow), Laser(Index).Body, Laser(Index).Image '    need to figure out why body is always dimmer?

                '+--------------+
                '| Rotate laser |
                '+--------------+

                IF Laser(Index).Degree THEN RotoZoomImage Laser(Index).Image, Laser(Index).Degree, 1 '      rotate laser if needed
            END IF

            '+------------+
            '| Draw laser |
            '+------------+

            Lw = _WIDTH(Laser(Index).Image) * .5 '                                                          calculate 1/2 width of rotated image
            Lh = _HEIGHT(Laser(Index).Image) * .5 '                                                          calculate 1/2 height of rotated image

            _PUTIMAGE (Laser(Index).Position.x - Lw, Laser(Index).Position.y - Lh), Laser(Index).Image '    draw laser

            'CIRCLE (Laser(Index).Head.x, Laser(Index).Head.y), 10 '                                          temp to highlight collision line
            'CIRCLE (Laser(Index).Tail.x, Laser(Index).Tail.y), 10

            '+------------------------------------------------------+
            '| Update position of laser and internal collision line |
            '+------------------------------------------------------+

            Laser(Index).Speed = Laser(Index).Speed * 1.025 '                                                increase speed of laser over time
            vx = Laser(Index).Vector.x * (Laser(Index).Grow + 8) * .5 '                                      calculate collision line offsets
            vy = Laser(Index).Vector.y * (Laser(Index).Grow + 8) * .5
            Laser(Index).Position.x = Laser(Index).Position.x + Laser(Index).Vector.x * Laser(Index).Speed ' update position of laser
            Laser(Index).Position.y = Laser(Index).Position.y + Laser(Index).Vector.y * Laser(Index).Speed
            Laser(Index).Cline.s.x = Laser(Index).Position.x + vx '                                          calculate collision line coordinates
            Laser(Index).Cline.s.y = Laser(Index).Position.y + vy
            Laser(Index).Cline.e.x = Laser(Index).Position.x - vx
            Laser(Index).Cline.e.y = Laser(Index).Position.y - vy

            '+---------------------------------------------------------+
            '| Deactiveate laser if collision line has left the screen |
            '+---------------------------------------------------------+

            IF Laser(Index).Cline.e.x < 0 OR Laser(Index).Cline.e.x > SCREENWIDTH OR Laser(Index).Cline.e.y < 0 OR Laser(Index).Cline.e.y > SCREENHEIGHT THEN ' left screen?
                Laser(Index).Active = 0 '                                                                    yes, deactive laser (FALSE)
                _FREEIMAGE Laser(Index).Image '                                                              remove images from RAM
                _FREEIMAGE Laser(Index).Tip
                _FREEIMAGE Laser(Index).Body
            END IF
        END IF
    LOOP UNTIL Index = UBOUND(Laser) '                                                                      leave when entire array checked
    IF NoActive AND UBOUND(Laser) > 0 THEN REDIM Laser(0) AS TYPE_LASER '                                    clear array if none active

END SUB

' ______________________________________________________________________________________________________________________________________________
'/                                                                                                                                              \
SUB ShootLaser (Image AS INTEGER, Origin AS TYPE_VECTOR, Degree AS INTEGER, Speed AS SINGLE, Length AS INTEGER, Lwidth AS INTEGER) ' ShootLaser |
    ' __________________________________________________________________________________________________________________________________________|____
    '/                                                                                                                                              \
    '| Initiates a laser pulse.                                                                                                                      |
    '|                                                                                                                                              |
    '| ShootLaser BlueLaser, Origin, 45, 15, 40, 1                                                                                                  |
    '|                                                                                                                                              |
    '| Image  - laser to initiate previously created by MakeLaser()                                                                                  |
    '| Origin - (x,y) origin point of laser                                                                                                          |
    '| Degree - degree angle of laser pulse (0 to 359)                                                                                              |
    '| Speed  - initial speed of laser pulse                                                                                                        |
    '| Length - maximum length that laser pulse will grow to                                                                                        |
    '| Lwidth - width of laser pulse (internal beam width, does not include halo and glow pixels)                                                    |
    '\_______________________________________________________________________________________________________________________________________________/

    SHARED Laser() AS TYPE_LASER ' need access to laser array
    SHARED LaserImage() AS LONG '  need access to laser build images
    SHARED Vec() AS TYPE_VECTOR '  need access to predefined vectors
    DIM Index AS INTEGER '        array index counter

    '+---------------------------------------+
    '| Get free index in array to hold laser |
    '+---------------------------------------+

    Index = -1 '                                        reset index counter
    DO '                                                begin free index search
        Index = Index + 1 '                            increment index counter
        IF Laser(Index).Active = 0 THEN EXIT DO '      leave loop if index free
    LOOP UNTIL Index = UBOUND(Laser) '                  leave loop when all indexes checked
    IF Laser(Index).Active THEN '                      were all indexes checked?
        Index = Index + 1 '                            yes, none were free, increment index
        REDIM _PRESERVE Laser(Index) AS TYPE_LASER '    create a new array index
    END IF

    '+---------------------------------------------+
    '| Correct laser width and height if necessary |
    '+---------------------------------------------+

    IF Lwidth < 1 THEN Lwidth = 1 '                    laser must be at least width of 1
    IF Length < 1 THEN Length = 1 '                    laser must be at least length of 1
    IF Lwidth MOD 2 = 0 THEN Lwidth = Lwidth + 1 '      laser width must be an odd number
    IF Length MOD 2 = 0 THEN Length = Length + 1 '      laser length must be an odd number

    '+----------------------+
    '| Set laser attributes |
    '+----------------------+

    Laser(Index).Active = -1 '                          laser is now active (TRUE)
    Laser(Index).Position = Origin '                    laser origination point
    Laser(Index).Cline.s = Origin '                    collision line start coordinates (x,y)
    Laser(Index).Cline.e = Origin '                    collision line end coordinates (x,y)
    Laser(Index).Degree = FixDegree(Degree) '          laser beam degree
    Laser(Index).Vector = Vec(Laser(Index).Degree) '    laser beam vector
    Laser(Index).Speed = Speed '                        laser beam speed
    Laser(Index).Length = Length '                      laser beam length (height)
    Laser(Index).Width = Lwidth + 12 '                  laser beam width
    Laser(Index).Grow = -1 '                            laser beam growth (-1 to ensure odd numbers when growing)
    Laser(Index).Image = _NEWIMAGE(1, 1, 32) '          laser beam full image canvas (just a dummy image for now as a seed)
    Laser(Index).Tip = _NEWIMAGE(Lwidth + 12, 8, 32) '  laser beam tip image canvas
    Laser(Index).Body = _NEWIMAGE(Lwidth + 12, 1, 32) ' laser beam body image canvas
    Laser(Index).Owner = Image '                        record laser image color

    '+-----------------------------------+
    '| Draw tip and body images of laser |
    '+-----------------------------------+

    _PUTIMAGE (0, 0)-(5, 7), LaserImage(Image), Laser(Index).Tip, (0, 0)-(5, 7) '                                                      left corner
    _PUTIMAGE (_WIDTH(Laser(Index).Tip) - 1, 0)-(_WIDTH(Laser(Index).Tip) - 6, 7), LaserImage(Image), Laser(Index).Tip, (0, 0)-(5, 7) ' right corner
    _PUTIMAGE (6, 0)-(5 + Lwidth, 7), LaserImage(Image), Laser(Index).Tip, (6, 0)-(6, 7) '                                              in between corners
    _PUTIMAGE (0, 0)-(_WIDTH(Laser(Index).Tip) - 1, 0), Laser(Index).Tip, Laser(Index).Body, (0, 7)-(_WIDTH(Laser(Index).Tip) - 1, 7) ' body of laser

END SUB

' ______________________________________________________________________________________________________________________________________________
'/                                                                                                                                              \
FUNCTION MakeLaser (BeamColor AS _UNSIGNED LONG, HaloColor AS _UNSIGNED LONG, GlowColor AS _UNSIGNED LONG) '                          MakeLaser |
    ' __________________________________________________________________________________________________________________________________________|____
    '/                                                                                                                                              \
    '| Creates the initial graphic images to build a laser pulse.                                                                                    |
    '|                                                                                                                                              |
    '| BlueLaser = MakeLaser(_RGB32(255, 255, 255), _RGB32(0, 255, 255), _RGB32(67, 123, 255))                                                      |
    '|                                                                                                                                              |
    '| BeamColor - the color of the laser pulse                                                                                                      |
    '| HaloColor - the color of the halo surrounding the beam color                                                                                  |
    '| GlowColor - the color of the afterglow surrounding the halo color                                                                            |
    '|                                                                                                                                              |
    '| An integer handle value is passed back pointing to the newly created laser image within the LaserImage() array.                              |
    '\_______________________________________________________________________________________________________________________________________________/

    SHARED LaserImage() AS LONG ' need access to laser build images
    DIM TempLaser AS LONG '      temporary processing image
    DIM Corner AS LONG '          temporary processing image
    DIM Pix AS STRING '          string of pixels that define laser corner image
    DIM PixPos AS INTEGER '      pointer within pix string
    DIM x AS INTEGER '            generic counter
    DIM y AS INTEGER '            generic counter
    DIM Odest AS LONG '          calling destination
    DIM Osource AS LONG '        calling source
    DIM Alpha AS INTEGER '        alpha level of pixels
    DIM p AS _UNSIGNED LONG '    pixel colors
    DIM Red AS INTEGER '          pixel color red component
    DIM Green AS INTEGER '        pixel color green component
    DIM Blue AS INTEGER '        pixel color blue component

    '+------------------------------------------------------------+
    '| Make room in array for new laser and create process images |
    '+------------------------------------------------------------+

    IF LaserImage(UBOUND(LaserImage)) THEN '                                  is the last index in use?
        REDIM _PRESERVE LaserImage(UBOUND(LaserImage) + 1) AS LONG '          yes, increase array size
    END IF
    LaserImage(UBOUND(LaserImage)) = _NEWIMAGE(7, 8, 32) '                    the final image
    TempLaser = _NEWIMAGE(13, 20, 32) '                                      temporary laser image to apply bloom to
    Corner = _NEWIMAGE(7, 10, 32) '                                          raw corner image of laser

    '+---------------------------------------+
    '| Draw upper left corner image of laser |
    '+---------------------------------------+

    'Pix = "0000000000043300043220043221043221104322110432211433211143321114332111" ' original
    'Pix = "0000000000043300043220043222043222104322210432221433221143322114332211" ' a number of different style attempts
    'Pix = "0000000000043300043320043322043322104332220433222433322143332214333221"
    Pix = "0000000000043300043320043322043322204332210433211433321143332114333211"

    '0000000  Original numbers showing a side profile of the upper left corner of the laser image.
    '0000433  This image is used to draw the entire laser beam of any length.
    '0004322  These numbers define where the beam, halo, and glow colors are contained within the image.
    '0043221
    '0432211
    '0432211
    '0432211
    '4332111
    '4332111
    '4332111

    PixPos = 0 '                                                              reset pixel counter
    Odest = _DEST '                                                          remember calling destination
    Osource = _SOURCE '                                                      remember calling source
    _DEST Corner '                                                            draw on corner image
    y = -1 '                                                                  reset vertical coordinate
    DO '                                                                      cycle vertically through image
        y = y + 1 '                                                          increment vertical coordinate
        x = -1 '                                                              reset horizontal coordinate
        DO '                                                                  cycle horizontally through image
            x = x + 1 '                                                      increment horizontal coordinate
            PixPos = PixPos + 1 '                                            increment pixel counter
            SELECT CASE MID$(Pix, PixPos, 1) '                                which pixel to draw?
                CASE "1" '                                                    beam pixel
                    PSET (x, y), BeamColor '                                  draw pixel
                CASE "2" '                                                    halo pixel
                    PSET (x, y), HaloColor '                                  draw pixel
                CASE "3" '                                                    glow pixel
                    PSET (x, y), GlowColor '                                  draw pixel
                CASE "4" '                                                    blending pixel
                    PSET (x, y), _RGB32(1, 1, 1) '                            draw black background blending pixel
            END SELECT
        LOOP UNTIL x = 6 '                                                    exit loop when all horizontal pixels processed
    LOOP UNTIL y = 9 '                                                        exit loop when all vertical pixels processed

    '+--------------------------------------------------------------+
    '| Apply alpha levels and mirror right side to temp laser image |
    '+--------------------------------------------------------------+

    _DEST TempLaser '                                                        draw on temp laser image
    _SOURCE Corner '                                                          get pixels from corner image
    y = -1 '                                                                  reset vertical coordinate
    DO '                                                                      cycle vertically through temp laser image

        '+------------------------------------------+
        '| Draw center vertical strip with no alpha |
        '+------------------------------------------+

        y = y + 1 '                                                          increment vertical coordinate
        Alpha = 255 '                                                        reset alpha value
        p = POINT(6, y) '                                                    get center point color at y location
        Red = _RED32(p) '                                                    get color components of point
        Green = _GREEN32(p)
        Blue = _BLUE32(p)
        IF Red OR Green OR Blue THEN '                                        is point color (0,0,0)?
            PSET (6, y), _RGB32(Red, Green, Blue, Alpha) '                    no, apply point to center
        END IF
        x = 6 '                                                              reset horizontal coordinate
        DO '                                                                  cycle horizontally left of center through temp laser image

            '+------------------------------------------------------------------------+
            '| Draw vertical strips to right and left of center with decreasing alpha |
            '+------------------------------------------------------------------------+

            x = x - 1 '                                                      decrement horizontal coordinate
            p = POINT(x, y) '                                                get point color at current location
            Red = _RED32(p) '                                                get color components of point
            Green = _GREEN32(p)
            Blue = _BLUE32(p)
            IF Red OR Green OR Blue THEN '                                    is point color (0,0,0)?
                PSET (x, y), _RGB32(Red, Green, Blue, Alpha) '                no, apply point to left of center
                PSET (12 - x, y), _RGB32(Red, Green, Blue, Alpha) '          apply point to right of center
            END IF
            Alpha = Alpha - 15 '                                              decrement alpha level
        LOOP UNTIL x = 0 '                                                    exit loop when all pixels left of center processed
    LOOP UNTIL y = 9 '                                                        exit loop when all vertical pixels processed
    _DEST Odest '                                                            restore calling destination
    _DEST Osource '                                                          restore calling source

    '+----------------------------------------------------------------+
    '| Apply bloom to temp laser image then copy to final array image |
    '+----------------------------------------------------------------+

    'TempLaser = ApplyFilter&(TempLaser, "gauss8", 0, 0, -1, -1, -1, -1, -1) ' add Gaussian blur to temp laser image (bloom) (the original library call)

    TempLaser = ApplyGauss&(TempLaser) '                                      add Gaussian blur to temp laser image (bloom)
    _PUTIMAGE (0, -1), TempLaser, LaserImage(UBOUND(LaserImage)) '            copy completed corner of laser into array
    _FREEIMAGE TempLaser '                                                    remove temporary images from RAM
    _FREEIMAGE Corner
    MakeLaser = UBOUND(LaserImage) '                                          pass back handle to finished corner image

END FUNCTION

' ______________________________________________________________________________________________________________________________________________
'/                                                                                                                                              \
SUB RotoZoomImage (InImg AS LONG, Deg AS INTEGER, Zoom AS SINGLE) '                                                              RotoZoomImage |
    ' __________________________________________________________________________________________________________________________________________|____
    '/                                                                                                                                              \
    '| Rotates and zooms an input image by the amounts specified.                                                                                    |
    '|                                                                                                                                              |
    '| RotoZoomImage MyImage, 180                                                                                                                    |
    '|                                                                                                                                              |
    '| InImg  - image to rotate and zoom. ImImg is modified to contain the updated rotated and zoomed image.                                        |
    '| Deg    - amount of image rotation (0 to 359)                                                                                                  |
    '| Zoom  - amount to zoom image (.5 = 50%, 1 = 100%, 1.5 = 150%, etc..)                                                                        |
    '|                                                                                                                                              |
    '| This subroutine based on code provided by Rob (Galleon) on the QB64.NET website in 2009.                                                      |
    '| Special thanks to Luke for explaining the matrix rotation formula used in this routine.                                                      |
    '\_______________________________________________________________________________________________________________________________________________/

    SHARED Vec() AS TYPE_VECTOR ' need access to precalculated vectors
    DIM px(3) AS INTEGER '        x vector values of four corners of image
    DIM py(3) AS INTEGER '        y vector values of four corners of image
    DIM Left AS INTEGER '        left-most value seen when calculating rotated image size
    DIM Right AS INTEGER '        right-most value seen when calculating rotated image size
    DIM Top AS INTEGER '          top-most value seen when calculating rotated image size
    DIM Bottom AS INTEGER '      bottom-most value seen when calculating rotated image size
    DIM WOutImg AS INTEGER '      width of rotated image
    DIM HOutImg AS INTEGER '      height of rotated image
    DIM WInImg AS INTEGER '      width of original image
    DIM HInImg AS INTEGER '      height of original image
    DIM CenterX AS INTEGER '      offsets used to move (0,0) back to upper left corner of image
    DIM CenterY AS INTEGER
    DIM x AS SINGLE '            new x vector of rotated point
    DIM y AS SINGLE '            new y vector of rotated point
    DIM v AS INTEGER '            vector counter
    DIM Degree AS INTEGER '      corrected input degree
    DIM OrigImg AS LONG '        temporary copy of input image

    '+-----------------------+
    '| Rotate and zoom image |
    '+-----------------------+

    OrigImg = _COPYIMAGE(InImg) '                                copy input image
    Degree = FixDegree(Deg) '                                    keep degree within 0 to 359
    WInImg = _WIDTH(InImg) '                                      width of input image
    HInImg = _HEIGHT(InImg) '                                    height of input image
    _FREEIMAGE InImg '                                            free input image from RAM

    '+----------------------------------+
    '| Make 0,0 the center of the image |
    '+----------------------------------+

    px(0) = -WInImg / 2 * Zoom ' -x,-y ----------------- x,-y
    py(0) = -HInImg / 2 * Zoom ' py(0),|              | px(3)    Create points around (0,0)
    px(1) = px(0) '              px(0) |              | py(3)    that match the size of the
    py(1) = HInImg / 2 * Zoom '        |      .      |          original image. This
    px(2) = WInImg / 2 * Zoom '        |    (0,0)    |          creates fouor vector
    py(2) = py(1) '              px(1),|              | px(2),  quantities to work with.
    px(3) = px(2) '              py(1) |              | py(2)
    py(3) = py(0) '              -x,y ----------------- x,y

    '+--------------------------------------------------------+
    '| Perform matrix rotation on all four corner coordinates |
    '+--------------------------------------------------------+

    DO '                                                          cycle through vectors
        x = px(v) * -Vec(Degree).y + -Vec(Degree).x * py(v) '    perform 2D rotation matrix on vector
        y = py(v) * -Vec(Degree).y - px(v) * -Vec(Degree).x '    https://en.wikipedia.org/wiki/Rotation_matrix
        px(v) = x '                                              save new x vector
        py(v) = y '                                              save new y vector

        '+--------------------------------------------------------------------------------+
        '| Image size changes when rotated so remember lowest and highest x,y values seen |
        '+--------------------------------------------------------------------------------+

        IF px(v) < Left THEN Left = px(v) '                      lowest x coordinate seen
        IF px(v) > Right THEN Right = px(v) '                    highest x coordinate seen
        IF py(v) < Top THEN Top = py(v) '                        lowest y coordinate seen
        IF py(v) > Bottom THEN Bottom = py(v) '                  highest y coordinate seen
        v = v + 1 '                                              increment vector counter
    LOOP UNTIL v = 4 '                                            leave when all vectors processed (0 through 3)

    '+------------------------------------+
    '| Make 0,0 the top left of the image |
    '+------------------------------------+

    WOutImg = Right - Left + 1 '                                  calculate width of rotated image
    HOutImg = Bottom - Top + 1 '                                  calculate height of rotated image
    CenterX = WOutImg \ 2 '                                      place (0,0) in upper left corner of rotated image
    CenterY = HOutImg \ 2
    v = 0 '                                                      reset vector counter
    DO '                                                          cycle through rotated image coordinates
        px(v) = px(v) + CenterX '                                move image coordinates so (0,0) at upper left corner
        py(v) = py(v) + CenterY '                                and (width-1,height-1) at lower right
        v = v + 1 '                                              increment corner counter
    LOOP UNTIL v = 4 '                                            leave when all four vectors of image moved
    InImg = _NEWIMAGE(WOutImg, HOutImg, 32) '                    create new rotated image canvas

    '+-------------------------------------+
    '| Map triangles onto new image canvas |
    '+-------------------------------------+

    _MAPTRIANGLE (0, 0)-(0, HInImg - 1)-(WInImg - 1, HInImg - 1), OrigImg TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2)), InImg
    _MAPTRIANGLE (0, 0)-(WInImg - 1, 0)-(WInImg - 1, HInImg - 1), OrigImg TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2)), InImg
    _FREEIMAGE OrigImg '                                          free original image from RAM

END SUB

' ______________________________________________________________________________________________________________________________________________
'/                                                                                                                                              \
FUNCTION FixDegree (Degree AS INTEGER) '                                                                                              FixDegree |
    ' __________________________________________________________________________________________________________________________________________|____
    '/                                                                                                                                              \
    '| Normalizes degree to between 0 and 359.                                                                                                      |
    '|                                                                                                                                              |
    '| Degree = FixDegree(-270)                                                                                                                      |
    '|                                                                                                                                              |
    '| Degree - the input degree to normalize                                                                                                        |
    '\_______________________________________________________________________________________________________________________________________________/

    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
    FixDegree = Deg '                    return degree

END FUNCTION

' ______________________________________________________________________________________________________________________________________________
'/                                                                                                                                              \
SUB RectGetMin (Rect AS TYPE_RECTLINE, Min AS TYPE_VECTOR) '                                                                        RectGetMin |
    ' __________________________________________________________________________________________________________________________________________|____
    '/                                                                                                                                              \
    '| Retrieves the minimum (x,y) coordinates from a rectangle.                                                                                    |
    '|                                                                                                                                              |
    '| RectMin MyRectangle, Min                                                                                                                      |
    '|                                                                                                                                              |
    '| Rect - the rectangle struture                                                                                                                |
    '| Min  - the minimum coordinates returned                                                                                                      |
    '|                                                                                                                                              |
    '| NOTE: Min is modified as a return value                                                                                                      |
    '\_______________________________________________________________________________________________________________________________________________/

    IF Rect.s.x < Rect.e.x THEN Min.x = Rect.s.x ELSE Min.x = Rect.e.x ' get minimum x value
    IF Rect.s.y < Rect.e.y THEN Min.y = Rect.s.y ELSE Min.y = Rect.e.y ' get minimum y value

END SUB

' ______________________________________________________________________________________________________________________________________________
'/                                                                                                                                              \
SUB RectGetMax (Rect AS TYPE_RECTLINE, Max AS TYPE_VECTOR) '                                                                        RectGetMax |
    ' __________________________________________________________________________________________________________________________________________|____
    '/                                                                                                                                              \
    '| Retrieves the maximum (x,y) coordinates from a rectangle.                                                                                    |
    '|                                                                                                                                              |
    '| RectMax MyRectangle, Max                                                                                                                      |
    '|                                                                                                                                              |
    '| Rect - the rectangle struture                                                                                                                |
    '| Max  - the maximum coordinates returned                                                                                                      |
    '|                                                                                                                                              |
    '| NOTE: Max is modified as a return value                                                                                                      |
    '\_______________________________________________________________________________________________________________________________________________/

    IF Rect.s.x > Rect.e.x THEN Max.x = Rect.s.x ELSE Max.x = Rect.e.x ' get maximum x value
    IF Rect.s.y > Rect.e.y THEN Max.y = Rect.s.y ELSE Max.y = Rect.e.y ' get maximum y value

END SUB

' ______________________________________________________________________________________________________________________________________________
'/                                                                                                                                              \
FUNCTION PointInRectangle (TestPoint AS TYPE_VECTOR, Rect AS TYPE_RECTLINE) '                                                  PointInRectangle |
    ' __________________________________________________________________________________________________________________________________________|____
    '/                                                                                                                                              \
    '| Returns -1 (TRUE) if a point is located within a rectangle, 0 (FALSE) otherwise.                                                              |
    '|                                                                                                                                              |
    '| Collision = PointInRectangle(MyPoint, MyRectangle)                                                                                            |
    '|                                                                                                                                              |
    '| TestPoint - (x,y) coordinate of point being checked                                                                                          |
    '| Rect      - rectangular area to check                                                                                                        |
    '\_______________________________________________________________________________________________________________________________________________/

    DIM Min AS TYPE_VECTOR ' minimum x and y values in rectangle
    DIM Max AS TYPE_VECTOR ' maximum x and y values in rectangle

    RectGetMin Rect, Min '                    get upper left coordinate
    RectGetMax Rect, Max '                    get lower right coordinate
    IF TestPoint.x <= Max.x THEN '            perform the four perimeter checks
        IF Min.x <= TestPoint.x THEN
            IF TestPoint.y <= Max.y THEN
                IF Min.y <= TestPoint.y THEN
                    PointInRectangle = -1 '    if all true report point within (TRUE)
                END IF
            END IF
        END IF
    END IF

END FUNCTION

' ______________________________________________________________________________________________________________________________________________
'/                                                                                                                                              \
FUNCTION PointInCircle (TestPoint AS TYPE_VECTOR, Circ AS TYPE_CIRCLE) '                                                          PointInCircle |
    ' __________________________________________________________________________________________________________________________________________|____
    '/                                                                                                                                              \
    '| Returns -1 (TRUE) if a point is located within a circle, 0 (FALSE) otherwise.                                                                |
    '|                                                                                                                                              |
    '| Collision = PointInCircle(MyPoint, MyCircle)                                                                                                  |
    '|                                                                                                                                              |
    '| TestPoint - (x,y) coordinate of point being checked                                                                                          |
    '| Circ      - circular area to check                                                                                                            |
    '\_______________________________________________________________________________________________________________________________________________/

    DIM CenterToPoint AS TYPE_VECTOR ' side lengths

    CenterToPoint.x = TestPoint.x - Circ.Center.x ' get adjacent side length
    CenterToPoint.y = TestPoint.y - Circ.Center.y ' get opposite side length

    '+---------------------------------------------------------------------------+
    '| If hypotenuse is less than or equal to radius then point is inside circle |
    '+---------------------------------------------------------------------------+

    IF CenterToPoint.x * CenterToPoint.x + CenterToPoint.y * CenterToPoint.y <= Circ.Radius * Circ.Radius THEN PointInCircle = -1

END FUNCTION

' ______________________________________________________________________________________________________________________________________________
'/                                                                                                                                              \
SUB RotatePoint (Rpoint AS TYPE_VECTOR, Degree AS INTEGER, Origin AS TYPE_VECTOR) '                                                RotatePoint |
    ' __________________________________________________________________________________________________________________________________________|____
    '/                                                                                                                                              \
    '| Rotates a point around an origin point by the degree specified.                                                                              |
    '|                                                                                                                                              |
    '| RotatePoint MyPoint, 90, OriginPoint                                                                                                          |
    '|                                                                                                                                              |
    '| Rpoint - the point to rotate (x,y)                                                                                                            |
    '| Degree - the number of degrees to rotate the point (NOTE: not "to" the degree)                                                                |
    '| Origin - the origin point to rotate around (x,y)                                                                                              |
    '|                                                                                                                                              |
    '| Rpoint is modified and returned.                                                                                                              |
    '\_______________________________________________________________________________________________________________________________________________/

    SHARED Vec() AS TYPE_VECTOR ' need access to precalculated vectors
    DIM x AS INTEGER '            location of point's x with origin at 0
    DIM y AS INTEGER '            location of point's y with origin at 0

    x = Rpoint.x - Origin.x '                                          move rotation origin to 0,0
    y = Rpoint.y - Origin.y
    Rpoint.x = (x * -Vec(Degree).y) - (y * Vec(Degree).x) + Origin.x ' calculate and return rotated location of point
    Rpoint.y = (x * Vec(Degree).x) + (y * -Vec(Degree).y) + Origin.y

END SUB

' ______________________________________________________________________________________________________________________________________________
'/                                                                                                                                              \
FUNCTION ApplyGauss& (SourceHandle AS LONG) '                                                                                      ApplyGauss& |
    ' __________________________________________________________________________________________________________________________________________|____
    '/                                                                                                                                              \
    '| Applies a Gaussian blur to the image passed in.                                                                                              |
    '|                                                                                                                                              |
    '| BlurredImage = ApplyGauss&(OriginalImage)                                                                                                    |
    '|                                                                                                                                              |
    '| SourceHandle - the image to be blurred                                                                                                        |
    '|                                                                                                                                              |
    '| An image handle of -2 or less passed back indicates a successful image blur. A handle of -1 indicates that the function failed to perform.    |
    '|                                                                                                                                              |
    '| NOTE: This function is a modified version of RhoSigma's Image Processing Library's ApplyFilter& function found in imageprocess.bm.            |
    '|      The function has been modified to only support the "gauss8" method of blurring with no optional parameters available.                  |
    '|      RhoSigma's unedited library can be obtained here: https://qb64phoenix.com/forum/showthread.php?tid=1033                                |
    '|      Thanks to RhoSigma for offering this library.                                                                                          |
    '\_______________________________________________________________________________________________________________________________________________/

    DIM AS INTEGER SourceWidth, SourceHeight, FilterY, FilterX, SourceY, SourceX, NewAlpha, FilterWeight, NewRed, NewGreen, NewBlue
    DIM AS LONG NewHandle, SumRed, SumGreen, SumBlue
    DIM AS _UNSIGNED LONG OriginalRGB, NewRGB
    DIM AS _OFFSET PixelOffset, FilterOffset
    DIM AS _MEM SourceBuffer, NewBuffer
    STATIC AS INTEGER Size, Add, Div, Weight(0 TO 6, 0 TO 6)

    '+---------------------+
    '| Apply filter values |
    '+---------------------+

    IF Weight(2, 2) = 0 THEN '                                                                        First time run?
        Size = 3 '                                                                                    yes, set filter values for "gauss8"
        Add = 0
        Div = 16 '                                                                              Note: Adjusting any of these values affects the way
        Weight(2, 2) = 1: Weight(2, 3) = 2: Weight(2, 4) = 1 '                                        in which the filter behaves. See RhoSigma's
        Weight(3, 2) = 2: Weight(3, 3) = 4: Weight(3, 4) = 2 '                                        original documentation for valid filter values
        Weight(4, 2) = 1: Weight(4, 3) = 2: Weight(4, 4) = 1 '                                        and their expected outcome.
        Size = Size \ 2
    END IF

    ApplyGauss& = -1 '                                                                                assume handle is invalid
    IF SourceHandle < -1 OR SourceHandle = 0 THEN '                                                  valid source image handle?
        IF _PIXELSIZE(SourceHandle) = 4 THEN '                                                        yes, 32bit image?

            '+-----------------------+
            '| Copy the source image |
            '+-----------------------+

            NewHandle = _COPYIMAGE(SourceHandle) '                                                    yes, copy source image
            SourceWidth = _WIDTH(SourceHandle) '                                                      get source image dimensions
            SourceHeight = _HEIGHT(SourceHandle)

            '+----------------------+
            '| Process copied image |
            '+----------------------+

            $CHECKING:OFF
            IF NewHandle < -1 THEN '                                                                  is handle valid?

                '+------------------------------------+
                '| Use direct memory access for speed |
                '+------------------------------------+

                SourceBuffer = _MEMIMAGE(SourceHandle) '                                              get image memory locations
                NewBuffer = _MEMIMAGE(NewHandle)

                '+-------------------------------------+
                '| Iterate through source image pixels |
                '+-------------------------------------+

                SourceY = -1 '                                                                        set y location
                DO '                                                                                  iterate vertically through source image
                    SourceY = SourceY + 1 '                                                          increment y location
                    PixelOffset = (SourceY * SourceWidth * 4) '                                      calculate pixel offset
                    SourceX = -1 '                                                                    set x location
                    DO '                                                                              iterate horizontally through source image
                        SourceX = SourceX + 1 '                                                      increment x location
                        _MEMGET SourceBuffer, SourceBuffer.OFFSET + PixelOffset, OriginalRGB '        get source image pixel
                        NewAlpha = _ALPHA32(OriginalRGB) '                                            record pixel's alpha value
                        SumRed = 0 '                                                                  clear previous summed pixel weight values
                        SumGreen = 0
                        SumBlue = 0

                        '+-------------------------------------------------------+
                        '| Iterate through neigboring pixels using filter matrix |
                        '+-------------------------------------------------------+

                        FilterY = SourceY - Size - 1 '                                                calculate filter vertical start point
                        DO '                                                                          iterate vertically through filter matrix
                            FilterY = FilterY + 1 '                                                  increment y location
                            FilterOffset = (FilterY * SourceWidth * 4) + ((SourceX - Size) * 4) '    calculate filter offset
                            FilterX = SourceX - Size - 1 '                                            calculate filter horizontal start point
                            DO '                                                                      iterate horizontally through filter matrix
                                FilterX = FilterX + 1 '                                              increment x location
                                IF FilterY >= 0 AND FilterY < SourceHeight AND FilterX >= 0 AND FilterX < SourceWidth THEN ' is position outside image?
                                    _MEMGET SourceBuffer, SourceBuffer.OFFSET + FilterOffset, OriginalRGB ' no, get source image pixel
                                ELSE
                                    _MEMGET SourceBuffer, SourceBuffer.OFFSET + PixelOffset, OriginalRGB '  yes, get center source image pixel
                                END IF

                                '+----------------------+
                                '| Sum up pixel weights |
                                '+----------------------+

                                FilterWeight = Weight(FilterY - SourceY + 3, FilterX - SourceX + 3) ' get weight value from filter array
                                SumRed = SumRed + (_RED32(OriginalRGB) * FilterWeight) '              apply weight value to RGB colors
                                SumGreen = SumGreen + (_GREEN32(OriginalRGB) * FilterWeight)
                                SumBlue = SumBlue + (_BLUE32(OriginalRGB) * FilterWeight)
                                FilterOffset = FilterOffset + 4 '                                    increment to next filter offset
                            LOOP UNTIL FilterX = SourceX + Size
                        LOOP UNTIL FilterY = SourceY + Size
                        NewRed = CINT(SumRed / Div) + Add '                                          calculate new pixel channel colors
                        NewGreen = CINT(SumGreen / Div) + Add
                        NewBlue = CINT(SumBlue / Div) + Add
                        NewRGB = _RGBA32(NewRed, NewGreen, NewBlue, NewAlpha) '                      calculate new pixel color
                        _MEMPUT NewBuffer, NewBuffer.OFFSET + PixelOffset, NewRGB '                  place new pixel color onto new image
                        PixelOffset = PixelOffset + 4 '                                              increment to next pixel offset
                    LOOP UNTIL SourceX = SourceWidth - 1
                LOOP UNTIL SourceY = SourceHeight - 1

                '+-----------------------------+
                '| Free RAM then return result |
                '+-----------------------------+

                _MEMFREE NewBuffer '                                                                  remove image buffers from RAM
                _MEMFREE SourceBuffer
                ApplyGauss& = NewHandle '                                                            return new image
            END IF
            $CHECKING:ON
        END IF
    END IF

END FUNCTION

'Enable the following line to compare original library to modified Guassian routine
'$ INCLUDE:'imageprocess.bm'


Attached Files Image(s)
   
New to QB64pe? Visit the QB64 tutorial to get started.
QB64 Tutorial
Reply
#36
Looking good, Terry.  Works like a charm here. 

- Dav

Find my programs here in Dav's QB64 Corner
Reply
#37
I don't know, they are great if I didn't see the still shots that Terry posted at the start of this thread.
The thing that impressed me most from those are the different sized ends that the rounded quadrilaterals had and the elliptical aura that the glow was casting.

There is still plenty of room for improvement but can the math be calculated fast enough in real time?
Tiltled ellipses are bad calc time-wise and rounding corners of the quads... eeeh?

Right now Terry's looks like a tight string of glow balls, which is how I was drawing mine at first only changing the size as we go down the line and much tighter packing.
b = b + ...
Reply
#38
@bplus, your comments about tilted ellipses made me curious if a similar effect could be done in QBJS with the new ellipse and shadow methods:

Reply
#39
Thumbs Up 
Yes! @dbox I was actually thinking of going back to that egg shape code to draw one side with one radius and the other side pointed to target. But yours has the edges get thinner, more transparent? The glow effect is important, be nice if it cast white over objects or lights them up as it passes.
b = b + ...
Reply
#40
Here is my attempt to do glowing lasers. It's possible my video card makes the glowing affect, I have no idea why it does it besides constantly re-tracing the circles over and over. Smile I left-in that weird random effect it makes before it erases the screen and starts over as well. As most of you know, I am still a novice. Smile 

Code: (Select All)
Screen _NewImage(800, 600, 32)
Dim x(10000), y(10000)
For t = 1 To 5000
    x(t) = (Rnd * 800)
    y(t) = (Rnd * 600)
Next t
Do
    keepgoing:
    _Limit 150
    r = Int(Rnd * 100) + 150
    g = Int(Rnd * 100) + 150
    b = Int(Rnd * 100) + 150
    For t = 1 To 500
        If t > 1 And y(t) < y(t - 1) Then y(t) = y(t) + 1
        If t > 1 And y(t) > y(t - 1) Then y(t) = y(t) - 1

        If t > 1 And x(t) < x(t - 1) Then x(t) = x(t) + 1
        If t > 1 And x(t) > x(t - 1) Then x(t) = x(t) - 1

        If y(t) > 600 Then
            y(t) = 0
            x(t) = (Rnd * 800)
        End If
        For sz = .5 To 5 Step .2
            Circle (x(t), y(t)), sz, _RGB32(r, g, b, 255)
        Next sz
    Next t
    _Display
    tt = tt + 1
    If tt > 25 Then
        ttt = ttt + 1
        If ttt < 30 Then tt = 0: GoTo keepgoing:
        ttt = 0
        tt = 0: Cls
        GoSub more:
    End If
Loop

more:
For t = 1 To 5000
    x(t) = (Rnd * 800)
    y(t) = (Rnd * 600)
Next t
Return
Reply




Users browsing this thread: 6 Guest(s)