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.
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
'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
07-27-2023, 01:49 PM (This post was last modified: 07-27-2023, 01:49 PM by bplus.)
(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.
07-27-2023, 11:56 PM (This post was last modified: 07-28-2023, 12:00 AM by TerryRitchie.)
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.
CONST SCREENWIDTH = 1600 CONST SCREENHEIGHT = 900 ' +-------------------------------+ TYPE TYPE_VECTOR ' | VECTOR DEFINITION | ' +-------------------------------+
x ASSINGLE' x cordinate/vector
y ASSINGLE' 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 ASSINGLE' radius of circle END TYPE ' +-------------------------------+ TYPE TYPE_LASER ' | LASER DEFINITION | ' +-------------------------------+
Active ASINTEGER' laser currently active (t/f)
Position AS TYPE_VECTOR ' laser coordinates (x,y)
Cline AS TYPE_RECTLINE ' collision line (x,y)-(x,y)
Degree ASINTEGER' degree of laser
Vector AS TYPE_VECTOR ' laser travel vectors
Length ASINTEGER' laser length (height) WidthASINTEGER' laser width
Image ASINTEGER' laser image canvas
Speed ASSINGLE' laser travel speed
Grow ASINTEGER' current laser growth value
Tip ASLONG' laser tip image canvas
Body ASLONG' laser body image canvas
Owner ASINTEGER' originator of laser (based on LaserImage() handle name) END TYPE ' +-------------------------------+ TYPE TYPE_SHIP ' | SHIP DEFINITION | ' +-------------------------------+
TopImage ASLONG' top down image of ship
SideImage ASLONG' 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 ASINTEGER' width of top down image (future use)
TopHeight ASINTEGER' height of top down image (future use)
SideWidth ASINTEGER' width of side view image (future use)
SideHeight ASINTEGER' 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) ASLONG' 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 ASLONG' temporary processing image DIM Degree ASINTEGER' degree angle of ship DIM BlueLaser ASINTEGER' laser image pointers DIM RedLaser ASINTEGER DIM GreenLaser ASINTEGER DIM Origin AS TYPE_VECTOR ' origin point for totation DIM RapidFire ASINTEGER' rapid fire laser delay DIM LeftLaser AS TYPE_VECTOR ' left laser origin point DIM RightLaser AS TYPE_VECTOR ' right laser origin point
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 > 0THEN 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 | '+---------------+
'+----------------------------------+ '| 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 _LIMIT60' 60 frames per second CLS LOCATE2, 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 = 0THEN' 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
' ______________________________________________________________________________________________________________________________________________ '/ \ SUBUpdateLaser () ' UpdateLaser | ' __________________________________________________________________________________________________________________________________________|____ '/ \ '| Draw and update all active lasers to the screen. | '| | '| UpdateLaser | '\_______________________________________________________________________________________________________________________________________________/
SHARED Laser() AS TYPE_LASER ' need access to laser array DIM Index ASINTEGER' laser array index counter DIM Lw ASINTEGER' width of laser image DIM Lh ASINTEGER' height of laser image DIM NoActive ASINTEGER' active lasers in array (t/f) DIM vx ASSINGLE' collision line x offset DIM vy ASSINGLE' 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
_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?
'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 | '+------------------------------------------------------+
'+---------------------------------------------------------+ '| Deactiveate laser if collision line has left the screen | '+---------------------------------------------------------+
IF Laser(Index).Cline.e.x < 0OR Laser(Index).Cline.e.x > SCREENWIDTH OR Laser(Index).Cline.e.y < 0OR 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 ANDUBOUND(Laser) > 0THENREDIM Laser(0) AS TYPE_LASER ' clear array if none active
' ______________________________________________________________________________________________________________________________________________ '/ \ SUBShootLaser (Image ASINTEGER, Origin AS TYPE_VECTOR, Degree ASINTEGER, Speed ASSINGLE, Length ASINTEGER, Lwidth ASINTEGER) ' 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() ASLONG' need access to laser build images SHARED Vec() AS TYPE_VECTOR ' need access to predefined vectors DIM Index ASINTEGER' 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 = 0THENEXIT 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 < 1THEN Lwidth = 1' laser must be at least width of 1 IF Length < 1THEN Length = 1' laser must be at least length of 1 IF Lwidth MOD2 = 0THEN Lwidth = Lwidth + 1' laser width must be an odd number IF Length MOD2 = 0THEN 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
' ______________________________________________________________________________________________________________________________________________ '/ \ FUNCTIONMakeLaser (BeamColor AS_UNSIGNEDLONG, HaloColor AS_UNSIGNEDLONG, GlowColor AS_UNSIGNEDLONG) ' 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. | '\_______________________________________________________________________________________________________________________________________________/
'+------------------------------------------------------------+ '| 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) ASLONG' 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 CASEMID$(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
' ______________________________________________________________________________________________________________________________________________ '/ \ SUBRotoZoomImage (InImg ASLONG, Deg ASINTEGER, Zoom ASSINGLE) ' 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) ASINTEGER' x vector values of four corners of image DIM py(3) ASINTEGER' y vector values of four corners of image DIM Left ASINTEGER' left-most value seen when calculating rotated image size DIM Right ASINTEGER' right-most value seen when calculating rotated image size DIM Top ASINTEGER' top-most value seen when calculating rotated image size DIM Bottom ASINTEGER' bottom-most value seen when calculating rotated image size DIM WOutImg ASINTEGER' width of rotated image DIM HOutImg ASINTEGER' height of rotated image DIM WInImg ASINTEGER' width of original image DIM HInImg ASINTEGER' height of original image DIM CenterX ASINTEGER' offsets used to move (0,0) back to upper left corner of image DIM CenterY ASINTEGER DIM x ASSINGLE' new x vector of rotated point DIM y ASSINGLE' new y vector of rotated point DIM v ASINTEGER' vector counter DIM Degree ASINTEGER' corrected input degree DIM OrigImg ASLONG' 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 | '+-------------------------------------+
Deg = Degree ' get passed in degree value IF Deg < 0OR Degree > 359THEN' degree out of range?
Deg = Deg MOD360' yes, get remainder of modulus 360 IF Deg < 0THEN Deg = Deg + 360' add 360 if less than 0 END IF FixDegree = Deg ' return degree
' ______________________________________________________________________________________________________________________________________________ '/ \ SUBRectGetMin (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
' ______________________________________________________________________________________________________________________________________________ '/ \ SUBRectGetMax (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
' ______________________________________________________________________________________________________________________________________________ '/ \ FUNCTIONPointInRectangle (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
' ______________________________________________________________________________________________________________________________________________ '/ \ FUNCTIONPointInCircle (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 | '\_______________________________________________________________________________________________________________________________________________/
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 | '+---------------------------------------------------------------------------+
' ______________________________________________________________________________________________________________________________________________ '/ \ SUBRotatePoint (Rpoint AS TYPE_VECTOR, Degree ASINTEGER, 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 ASINTEGER' location of point's x with origin at 0 DIM y ASINTEGER' 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
' ______________________________________________________________________________________________________________________________________________ '/ \ FUNCTIONApplyGauss& (SourceHandle ASLONG) ' 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. | '\_______________________________________________________________________________________________________________________________________________/
IF Weight(2, 2) = 0THEN' 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
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.
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.
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
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.