+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: Summer LASER Challenge (/showthread.php?tid=1847)
RE: Summer LASER Challenge - bplus - 07-21-2023
(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/Web/CSS/mix-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.
RE: Summer LASER Challenge - SierraKen - 07-27-2023
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 FunctionRE: Summer LASER Challenge - SierraKen - 07-27-2023
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 SubRE: Summer LASER Challenge - bplus - 07-27-2023
(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.
RE: Summer LASER Challenge - TerryRitchie - 07-27-2023
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://staging.qb64phoenix.com/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'
RE: Summer LASER Challenge - Dav - 07-28-2023
Looking good, Terry. Works like a charm here.
- Dav
RE: Summer LASER Challenge - bplus - 07-28-2023
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.
RE: Summer LASER Challenge - dbox - 07-28-2023
@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:
RE: Summer LASER Challenge - bplus - 07-28-2023
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.
RE: Summer LASER Challenge - SierraKen - 07-29-2023
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.
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. 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