+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Morphing Stained Glass (/showthread.php?tid=3031)
Pages:
1
2
RE: Morphing Stained Glass - SMcNeill - 09-13-2024
First thing I'd advise to speed it up is to remove as much math as possible from the process. For example:
Code: (Select All)
_MEMPUT mImage, mImage.OFFSET + (y * sWidth + x) * 4, Points(Nearest).cmImage.OFFSET + (y * sWidth + x) * 4 <-- this right here can be simplified by a ton with just a little logic.
First, distribute the 4 to outside the loop:
x = x + 4 (instead of x = x + 1) and then multiply by 4.
y = y + 4 (instead of the y = y + 1 that it currently is. This would save one calculation per cyctle (mImge.OFFSET + (y * sWidth + x) without that * 4 being needed.)
....
but then that can be simplified down even more:
x = x + 4 <-- this would move x position by 4 bytes, or one pixel at a time
y = y + (sWidth * 4) <--- seems to me that this should increase y by the whole row of pixels in one go.
now that internal math looks like: (mImage.OFFSET + y + x)
And, if you start y somewhere with the offset as the starting point:
y = mImage.OFFSET
Then you can make that whole _MEMPUT statement simplify down to:
Code: (Select All)
_MEMPUT mImage, y + x, Points(Nearest).c^That'll shave off several internal processing cycles from your routine.
So basically the flow would be:
y = mImage.OFFSET
DO
DO
_MEMPUT mImage, y + x, Points(Nearest).c
x = x + 4
LOOP
y = y + sWidth * 4
LOOP until y + x >= m.SIZE
Anytime you can strip math out of a main loop like that, you can speed things up considerably.
RE: Morphing Stained Glass - DSMan195276 - 09-14-2024
(09-13-2024, 10:42 PM)TerryRitchie Wrote: Ok, I found that thread on the old site: https://qb64forum.alephc.xyz/index.php?PHPSESSID=e32ae740c9fe2fdec91b8415ee78706a&topic=3813.0I _think_ the idea is that if you look at the drawing as a series of horizontal (or vertical) lines, any particular point cannot have more than one segment of it's color on the line. IE. If you have a green point and a blue point, you'll never get a sequence of 'green-blue-green' pixels in a line, it will always have a single segment of green and a single segment of blue (assuming both colors appear on the line).
This code is fast! I'm picking it apart to make sense of it.
You can use that fact to throw out many of the points without calculating their distance - if you find that pixel Y=49 is colored by a point but Y=50 is too far away (because there's already another point that is closer), then you don't need to look at the pixels past Y=50. None of those pixels can be colored by your current point because you already finished its segment in the line, the color will never appear again until you start the next line.
There's probably some extra logic you can add to make it even faster - if you have lots of points, most lines are probably only colored by a small portion of them. You could process the points by Y distance to the line (when using horizontal lines) and stop looking at points if every pixel on the line is already colored by a closer point than any of the points left (the Y direction to the line is the absolute minimum distance a point can have to the line).
That said I believe my shader approach is still faster
it's the same approach you did, but the GPU can parallelize the process so much that it doesn't matter.
RE: Morphing Stained Glass - bplus - 09-14-2024
Stained Glass Blowing in the Wind:
Code: (Select All)
_Title "Moving Voronoi Diagram" ' b+ mod Andy Amaya 2024-09-13
'=====================================================================
' Changes number of points and screen size here
'=====================================================================
Const pnt = 100
Const px = 800
Const py = 600
Dim As Long i, x, y, adjct, sy, ly
'=====================================================================
Screen _NewImage(px, py, 32)
_ScreenMove 250, 60
Randomize Timer
Dim Shared As Long pax(pnt), pay(pnt), indx(px, py), dx(pnt), dy(pnt)
Dim Shared As Long dSqr(px, py)
Dim Shared As _Unsigned Long col(pnt)
For i = 1 To pnt
pax(i) = Int(Rnd * px)
pay(i) = Int(Rnd * py)
col(i) = _RGB32(Rnd * 180, (Rnd < .5) * -255, Rnd * 150, Rnd * 255)
dx(i) = Int(Rnd * 15) + 3
dy(i) = Int(Rnd * 11) - 5
Next
While _KeyDown(27) = 0
For x = 0 To px - 1
For y = 0 To py - 1
dSqr(x, y) = (pax(1) - x) * (pax(1) - x) + (pay(1) - y) * (pay(1) - y)
indx(x, y) = 1
Next
Next
For i = 2 To pnt
ly = py - 1
For x = pax(i) To 0 Step -1
If (scan(i, x, ly)) = 0 Then Exit For
Next x
For x = pax(i) + 1 To px - 1
If (scan(i, x, ly)) = 0 Then Exit For
Next
Next
For x = 0 To px - 1
For y = 0 To py - 1
sy = y
adjct = indx(x, y)
For y = y + 1 To py
If indx(x, y) <> adjct Then y = y - 1: Exit For
Next
Line (x, sy)-(x, y + 1), col(adjct) ' BF ' bplus added BF
Next
Next
For i = 1 To pnt
pax(i) = pax(i) + dx(i)
If pax(i) < 0 Then pax(i) = 0: dx(i) = -dx(i)
If pax(i) > px - 1 Then newPnt i
pay(i) = pay(i) + dy(i)
If pay(i) < 0 Then pay(i) = 0: dy(i) = -dy(i)
If pay(i) > py - 1 Then pay(i) = py - 1: dy(i) = -dy(i)
Next
Wend
Sub newPnt (i)
pax(i) = 0
pay(i) = Int(Rnd * py)
col(i) = _RGB32(Rnd * 180, (Rnd < .5) * -255, Rnd * 150, Rnd * 255)
dx(i) = Int(Rnd * 15) + 3
dy(i) = Int(Rnd * 11) - 5
End Sub
Function scan (site As Integer, x As Integer, ly As Integer)
Dim As Integer ty
Dim As Long delt2, dsq
delt2 = (pax(site) - x) * (pax(site) - x)
For ty = 0 To ly
dsq = (pay(site) - ty) * (pay(site) - ty) + delt2
If dsq <= dSqr(x, ty) Then
dSqr(x, ty) = dsq
indx(x, ty) = site
scan = 1
End If
Next
End FunctionRE: Morphing Stained Glass - TerryRitchie - 09-14-2024
(09-13-2024, 11:28 PM)SMcNeill Wrote: First thing I'd advise to speed it up is to remove as much math as possible from the process. For example:You are so much better at refactoring than I am. Thank you for the suggestions. They are so obvious to me now.
Code: (Select All)_MEMPUT mImage, mImage.OFFSET + (y * sWidth + x) * 4, Points(Nearest).c
mImage.OFFSET + (y * sWidth + x) * 4 <-- this right here can be simplified by a ton with just a little logic.
First, distribute the 4 to outside the loop:
x = x + 4 (instead of x = x + 1) and then multiply by 4.
y = y + 4 (instead of the y = y + 1 that it currently is. This would save one calculation per cyctle (mImge.OFFSET + (y * sWidth + x) without that * 4 being needed.)
....
but then that can be simplified down even more:
x = x + 4 <-- this would move x position by 4 bytes, or one pixel at a time
y = y + (sWidth * 4) <--- seems to me that this should increase y by the whole row of pixels in one go.
now that internal math looks like: (mImage.OFFSET + y + x)
And, if you start y somewhere with the offset as the starting point:
y = mImage.OFFSET
Then you can make that whole _MEMPUT statement simplify down to:
Code: (Select All)_MEMPUT mImage, y + x, Points(Nearest).c
^That'll shave off several internal processing cycles from your routine.
So basically the flow would be:
y = mImage.OFFSET
DO
DO
_MEMPUT mImage, y + x, Points(Nearest).c
x = x + 4
LOOP
y = y + sWidth * 4
LOOP until y + x >= m.SIZE
Anytime you can strip math out of a main loop like that, you can speed things up considerably.
(09-13-2024, 10:42 PM)DSMan195276 Wrote: Something a bit different, I changed your rendering code into a shader. The code is a mess but it does work for me and I can get 500 points rendering at 60FPS. YMMV, I pass the points in as a uniform and that limits how many you can use, you should be able to do at least 100 though. There are better ways to do it that could support more points but this was the easiest way since I was reusing some code I already had.Wow! Very, very interesting. I'll play around with this. Thank you!
The code is below, and it requires a header file to be placed next to it so it can access some functions:
Code: (Select All)Option _Explicit
Const TOTAL = 100
Type vec2
x As Single
y As Single
End Type
Dim Shared points(TOTAL) As vec2
Dim Shared cols(TOTAL) As vec3
Dim Shared vectors(TOTAL) As vec2
Randomize Timer ' seed RND generator
Dim p As Long
For p = 0 To TOTAL - 1 ' cycle through pane center points
points(p).x = Rnd * 1 ' random x location
points(p).y = Rnd * 1 ' random y location
cols(p).x = Rnd * .5 + .5
cols(p).y = Rnd * .5 + .5
cols(p).z = Rnd * .5 + .5
'cols(p) = _RGB32(Rnd * 128 + 128, Rnd * 128 + 128, Rnd * 128 + 128) ' random color above 128, 128, 128 vectors(p).x = (Rnd - Rnd) * .005 ' random x velocity
vectors(p).y = (Rnd - Rnd) * .005 ' random y velocity
Next p
Type vec3
x As Single
y As Single
z As Single
End Type
Type tri
p1 As vec3
p2 As vec3
p3 As vec3
End Type
Type model
bufId As _Unsigned Long
vertArrId As _Unsigned Long
pointsId As _Unsigned Long
colorsId As _Unsigned Long
prog As _Unsigned Long
tris As _MEM
triCount As _Unsigned Long
End Type
Declare Library
Function glCreateProgram& ()
Function glCreateShader& (ByVal flags As _Unsigned Long)
Sub glCompileShader (ByVal shader As _Unsigned Long)
Sub glAttachShader (ByVal prog As _Unsigned Long, Byval shader As _Unsigned Long)
Sub glLinkProgram (ByVal prog As _Unsigned Long)
Sub glUseProgram (ByVal prog As _Unsigned Long)
' Sub glGenBuffers (ByVal size As _Unsigned Long, Byval buffers As _Offset)
Sub glBindBuffer (ByVal target As _Unsigned Long, Byval buffer As _Unsigned Long)
' Sub glGenVertexArrays (ByVal size As _Unsigned Long, Byval buffers As _Offset)
Sub glBindVertexArray (ByVal array As _Unsigned Long)
Sub glEnableVertexAttribArray (ByVal index As _Unsigned Long)
Sub glVertexAttribPointer (ByVal index As _Unsigned Long, _
Byval size As _Unsigned Long, _
Byval typ As _Unsigned Long, _
Byval normal As _Unsigned _Byte, _
Byval stride As _Unsigned Long, _
Byval pointer As _Offset)
Function glGetUniformLocation& (ByVal prog As _Unsigned Long, nam As String)
Sub glEnable (ByVal cap As _Unsigned Long)
Sub glDisable (ByVal cap As _Unsigned Long)
Sub glDepthFunc (ByVal cap As _Unsigned Long)
End Declare
Declare Library "stained_glass_help"
Sub glShaderSource Alias "myShaderSource" (ByVal shader As _Unsigned Long, Byval count As _Unsigned Long, Byval text As _Offset, Byval length As _Offset)
Sub glGenBuffers Alias "myGenBuffers" (ByVal size As _Unsigned Long, Byval buffers As _Offset)
Sub glGenVertexArrays Alias "myGenVertexArrays" (ByVal size As _Unsigned Long, Byval buffers As _Offset)
Sub glBufferData ALIAS "myBufferData" (byval target As _Unsigned Long, _
byval size As _offset, _
byval dat As _Offset, _
byval usage As _Unsigned Long)
Sub glDrawArrays Alias "myDrawArrays" (ByVal mode As _Unsigned Long, Byval first As _Unsigned Long, Byval count As _Unsigned Long)
Sub glUniformMatrix4fv ALIAS "myUniformMatrix4fv" (ByVal location As _Unsigned Long, _
ByVal count As _Unsigned Long, _
ByVal transpose As _Unsigned _Byte, _
ByVal floats As _Offset)
sub glUniform2fv ALIAS "myUniform2fv" (BYVal location As _unsigned long, _
byval count as _unsigned long, _
byval floats as _Offset)
sub glUniform3fv ALIAS "myUniform3fv" (BYVal location As _unsigned long, _
byval count as _unsigned long, _
byval ints as _Offset)
End Declare
Const GL_TRUE~& = 1
Const GL_FALSE~& = 0
Const GL_LESS~& = 513
Const GL_DEPTH_TEST~& = 2929
Const GL_FLOAT~& = 5126
Const GL_ARRAY_BUFFER~& = 34962
Const GL_STATIC_DRAW~& = 35044
Const GL_FRAGMENT_SHADER~& = 35632
Const GL_VERTEX_SHADER~& = 35633
Const GL_TRIANGLES~& = 4
Const GL_CULL_FACE = 2884
Dim Shared v As String, f As String
v$ = "#version 150" + Chr$(10)
v$ = v$ + "in vec3 vp;" + Chr$(10)
v$ = v$ + "out vec2 uv;" + Chr$(10)
v$ = v$ + "void main() {" + Chr$(10)
v$ = v$ + " uv = vp.xy;" + Chr$(10)
v$ = v$ + " gl_Position = vec4(vp.x * 2 - 1, vp.y * 2 - 1, 0, 1.0);" + Chr$(10)
v$ = v$ + "}" + Chr$(0)
f$ = "#version 150" + Chr$(10)
f$ = f$ + "in vec2 uv;" + Chr$(10)
f$ = f$ + "uniform vec2 points[" + Str$(TOTAL) + "];" + Chr$(10)
f$ = f$ + "uniform vec3 colors[" + Str$(TOTAL) + "];" + Chr$(10)
f$ = f$ + "void main() {" + Chr$(10)
f$ = f$ + " int nearestP = 0;" + Chr$(10)
f$ = f$ + " float nearDist = length(points[0] - uv);" + Chr$(10)
f$ = f$ + " for (int i = 1; i < " + Str$(TOTAL) + "; i++) {" + Chr$(10)
f$ = f$ + " float newDist = length(points[i] - uv);" + Chr$(10)
f$ = f$ + " if (newDist < nearDist) {" + Chr$(10)
f$ = f$ + " nearDist = newDist;" + Chr$(10)
f$ = f$ + " nearestP = i;" + Chr$(10)
f$ = f$ + " }" + Chr$(10)
f$ = f$ + " }" + Chr$(10)
f$ = f$ + " gl_FragColor = vec4(colors[nearestP], 255);" + Chr$(10)
f$ = f$ + "}" + Chr$(0)
Dim Shared square As model
loadSquareModel square
Dim Shared startGL As _Unsigned Long
Sleep 1
startGL = -1
Do
_Limit 60
Dim k As String
k$ = InKey$
If k$ = Chr$(27) Then Exit Do
Loop
End
Sub _GL
Static initShad
If initShad = 0 And startGL Then
setupModel square, v$, f$
initShad = -1
End If
If Not initShad Then Exit Sub
glDisable GL_CULL_FACE
glEnable GL_DEPTH_TEST
glDepthFunc GL_LESS
RenderModel square
Dim p As Long
p = 0
Dim dx As Single, dy As Single
Do ' begin point update loop
dx = points(p).x + vectors(p).x ' calculate new look ahead point x location
dy = points(p).y + vectors(p).y ' calculate new look ahead point y location
If dx < 0 Or dx > 1 Then vectors(p).x = -vectors(p).x ' reverse vector if left/right side of image reached
If dy < 0 Or dy > 1 Then vectors(p).y = -vectors(p).y ' reverse vector if top/bottom side of image reached
points(p).x = points(p).x + vectors(p).x ' calculate new point x location
points(p).y = points(p).y + vectors(p).y ' calculate new point y location
p = p + 1 ' increment point counter
Loop Until p = TOTAL ' leave when all points updated
End Sub
Sub RenderModel (m As model)
glUseProgram m.prog
glUniform2fv m.pointsId, UBound(points), _Offset(points())
glUniform3fv m.colorsId, UBound(cols), _Offset(cols())
glBindVertexArray m.vertArrId
glDrawArrays GL_TRIANGLES, 0, m.triCount * 3
End Sub
Sub loadSquareModel (m As model)
Dim t As tri
m.tris = _MemNew(Len(t) * 2)
m.triCount = 2
putTriVec m.tris, 0, 0, 0, 0, 0
putTriVec m.tris, 0, 1, 0, 1, 0
putTriVec m.tris, 0, 2, 1, 0, 0
putTriVec m.tris, 1, 0, 0, 1, 0
putTriVec m.tris, 1, 1, 1, 1, 0
putTriVec m.tris, 1, 2, 1, 0, 0
End Sub
Sub putTriVec (m As _MEM, TriIndex As _Unsigned Long, VecIndex As _Unsigned Long, x As Single, y As Single, z As Single)
Dim v As vec3, t As tri
v.x = x: v.y = y: v.z = z
_MemPut m, m.OFFSET + TriIndex * Len(t) + Len(v) * VecIndex, v
End Sub
Sub setupModel (m As model, vshad As String, fshad As String)
Dim t As tri
Dim vs As _Unsigned Long, fs As _Unsigned Long
Dim o As _Offset
vs = glCreateShader&(GL_VERTEX_SHADER)
o = _Offset(vshad$)
glShaderSource vs, 1, _Offset(o), 0
glGenBuffers 1, _Offset(m.bufId)
glBindBuffer GL_ARRAY_BUFFER, m.bufId
glGenVertexArrays 1, _Offset(m.vertArrId)
glBindVertexArray m.vertArrId
glEnableVertexAttribArray 0
glBindBuffer GL_ARRAY_BUFFER, m.bufId
glVertexAttribPointer 0, 3, GL_FLOAT, GL_FALSE, 0, 0
glBindBuffer GL_ARRAY_BUFFER, m.bufId
glBufferData GL_ARRAY_BUFFER, m.triCount * Len(t), m.tris.OFFSET, GL_STATIC_DRAW
m.prog = glCreateProgram&
fs = glCreateShader&(GL_FRAGMENT_SHADER)
o = _Offset(fshad$)
glShaderSource fs, 1, _Offset(o), 0
glCompileShader fs
glAttachShader m.prog, vs
glAttachShader m.prog, fs
glLinkProgram m.prog
m.pointsId = glGetUniformLocation(m.prog, "points")
m.colorsId = glGetUniformLocation(m.prog, "colors")
End Sub
This is the header (name it "stained_glass_help.h" and place it next to the .bas file):
Code: (Select All)void myShaderSource(int shad, int count, ptrszint text, ptrszint length)
{
__glewShaderSource(shad, count, (const GLchar **)text, (const GLint *)length);
}
void myGenBuffers(int count, uintptr_t offset)
{
__glewGenBuffers(count, (GLuint *)offset);
}
void myGenVertexArrays(int count, uintptr_t buffers)
{
glGenVertexArrays(count, (GLuint *)buffers);
}
void myBufferData(int target, uintptr_t size, uintptr_t data, int usage)
{
glBufferData(target, size, (GLuint *)data, usage);
}
void myDrawArrays(int mode, int first, int count)
{
glDrawArrays(mode, first, count);
}
void myUniformMatrix4fv(int id, int count, unsigned char transpose, uintptr_t mat)
{
glUniformMatrix4fv(id, count, transpose, (GLfloat *)mat);
}
void myUniform2fv(int id, int count, uintptr_t mat)
{
glUniform2fv(id, count, (GLfloat *)mat);
}
void myUniform3fv(int id, int count, uintptr_t mat)
{
glUniform3fv(id, count, (GLfloat *)mat);
}
RE: Morphing Stained Glass - bplus - 09-14-2024
Stained Glass Blowing into Dreamland:
Code: (Select All)
_Title "Moving Voronoi Diagram" ' b+ mod Andy Amaya 2024-09-13
'=====================================================================
' Changes number of points and screen size here
'=====================================================================
Const pnt = 100
Const px = 800
Const py = 600
Dim As Long i, x, y, adjct, sy, ly
'=====================================================================
Screen _NewImage(px, py, 32)
_ScreenMove 250, 60
Randomize Timer
Dim Shared As Long pax(pnt), pay(pnt), indx(px, py), dx(pnt), dy(pnt)
Dim Shared As Long dSqr(px, py), counter
Dim Shared As _Unsigned Long col(pnt)
For i = 1 To pnt
pax(i) = Int(Rnd * px)
pay(i) = Int(Rnd * py)
col(i) = _RGB32(Rnd * 180, (Rnd < .5) * -255, Rnd * 150, Rnd * 255)
dx(i) = Int(Rnd * 15) + 3
dy(i) = Int(Rnd * 11) - 5
Next
While _KeyDown(27) = 0
For x = 0 To px - 1
For y = 0 To py - 1
dSqr(x, y) = (pax(1) - x) * (pax(1) - x) + (pay(1) - y) * (pay(1) - y)
indx(x, y) = 1
Next
Next
For i = 2 To pnt
ly = py - 1
For x = pax(i) To 0 Step -1
If (scan(i, x, ly)) = 0 Then Exit For
Next x
For x = pax(i) + 1 To px - 1
If (scan(i, x, ly)) = 0 Then Exit For
Next
Next
For x = 0 To px - 1
For y = 0 To py - 1
sy = y
adjct = indx(x, y)
For y = y + 1 To py
If indx(x, y) <> adjct Then y = y - 1: Exit For
Next
Line (x, sy)-(x, y + 1), col(adjct), BF ' bplus added BF
Next
Next
For i = 1 To pnt
pax(i) = pax(i) + dx(i)
If pax(i) < 0 Then pax(i) = 0: dx(i) = -dx(i)
If pax(i) > px - 1 Then newPnt i
pay(i) = pay(i) + dy(i)
If pay(i) < 0 Then pay(i) = 0: dy(i) = -dy(i)
If pay(i) > py - 1 Then pay(i) = py - 1: dy(i) = -dy(i)
Next
Wend
Sub newPnt (i)
Dim a As Long
counter = counter + 1
pax(i) = 0
pay(i) = Int(Rnd * py)
a = Rnd * (255 - counter / 2)
If a < 4 Then a = 4 ' fix
col(i) = _RGB32(Rnd * 180, (Rnd < .5) * -255, Rnd * 150, a)
dx(i) = Int(Rnd * 15) + 3
dy(i) = Int(Rnd * 11) - 5
End Sub
Function scan (site As Integer, x As Integer, ly As Integer)
Dim As Integer ty
Dim As Long delt2, dsq
delt2 = (pax(site) - x) * (pax(site) - x)
For ty = 0 To ly
dsq = (pay(site) - ty) * (pay(site) - ty) + delt2
If dsq <= dSqr(x, ty) Then
dSqr(x, ty) = dsq
indx(x, ty) = site
scan = 1
End If
Next
End FunctionGoodnight Gentlemen
Dang one more fix!
RE: Morphing Stained Glass - SMcNeill - 09-14-2024
Sorry Terry -- The refactoring I mentioned won't quite work in this case as you're making use of those X/Y variables in other places than just that _MEMPUT. You can still simplify the math somewhat though:
Code: (Select All)
' Moving stained glass
Option _Explicit ' declare those variables!
Const TOTAL = 25 ' total pieces of glass
Type IPOINT ' PANE CENTER POINT PROPERTIES
x As Single ' x location
y As Single ' y location
c As _Unsigned Long ' color
xv As Single ' x vector
yv As Single ' y vector
End Type
Dim Points(TOTAL) As IPOINT ' center of each glass pane
Dim sWidth As Integer ' width of screen
Dim sHeight As Integer ' height of screen
Dim Image As Long ' stained glass output image
Dim ScreenImage As Long ' view screen
Dim x As Integer ' horizontal counter
Dim y As Integer ' vertical counter
Dim p As Integer ' point counter
Dim NearestDist As _Unsigned Long ' nearest distance to another point
Dim Nearest As Integer ' final nearest point
Dim dx As Long ' x distance
Dim dy As Long ' y distance
Dim Dist As Long ' x,y to dx,dy distance
Dim mScreen As _MEM ' screen memory
Dim mImage As _MEM ' output image memory
Dim MaxDist As _Unsigned Long ' max distance possible
Dim ty As _Offset
sWidth = 640 ' set screen width
sHeight = 480 ' set screen height
MaxDist = sWidth * sWidth + sHeight * sHeight ' maximum possible distance
Image = _NewImage(sWidth, sHeight, 32) ' output image
mImage = _MemImage(Image) ' output image memory
ScreenImage = _CopyImage(Image, 32) ' view screen
mScreen = _MemImage(ScreenImage) ' view screen memory
Screen ScreenImage ' create view screen
Randomize Timer ' seed RND generator
For p = 0 To TOTAL - 1 ' cycle through pane center points
Points(p).x = Rnd * sWidth ' random x location
Points(p).y = Rnd * sHeight ' random y location
Points(p).c = _RGB32(Rnd * 128 + 128, Rnd * 128 + 128, Rnd * 128 + 128) ' random color above 128, 128, 128
Points(p).xv = (Rnd - Rnd) * 3 ' random x velocity
Points(p).yv = (Rnd - Rnd) * 3 ' random y velocity
Next p
Do ' begin animation loop
$Checking:Off
y = 0 ' reset vertical counter
Do ' begin vertical loop
x = 0 ' reset horizontal counter
ty = mImage.OFFSET + y * sWidth * 4
Do ' begin horizontal loop
NearestDist = MaxDist ' reset nearest distance seen
p = 0 ' reset point counter
Do ' begin point loop
dx = Points(p).x - x ' calculate distance from x to point x
dy = Points(p).y - y ' calculate distance from y to point y
Dist = dx * dx + dy * dy ' calculate hypotenuse distance
If Dist < NearestDist Then ' is this the nearest distance seen?
Nearest = p ' yes, mark this point as nearest
NearestDist = Dist ' set new nearest distance seen
End If
p = p + 1 ' increment point counter
Loop Until p = TOTAL ' leave when all points checked
_MemPut mImage, ty + x * 4, Points(Nearest).c ' draw pixel on output image
x = x + 1 ' increment horizontal counter
Loop Until x = sWidth ' leave when width of image reached
y = y + 1 ' increment vertical counter
Loop Until y = sHeight ' leave when height of image reached
_MemCopy mImage, mImage.OFFSET, mImage.SIZE To mScreen, mScreen.OFFSET ' copy image to view screen
p = 0 ' reset point counter
Do ' begin point update loop
dx = Points(p).x + Points(p).xv ' calculate new look ahead point x location
dy = Points(p).y + Points(p).yv ' calculate new look ahead point y location
If dx < 0 Or dx > sWidth - 1 Then Points(p).xv = -Points(p).xv ' reverse vector if left/right side of image reached
If dy < 0 Or dy > sHeight - 1 Then Points(p).yv = -Points(p).yv ' reverse vector if top/bottom side of image reached
Points(p).x = Points(p).x + Points(p).xv ' calculate new point x location
Points(p).y = Points(p).y + Points(p).yv ' calculate new point y location
p = p + 1 ' increment point counter
Loop Until p = TOTAL ' leave when all points updated
$Checking:On
Loop Until _KeyDown(27) ' leave when ESC key pressed
System ' return to operating system
This takes that original line which was:
_MEMPUT mImage, mImage.OFFSET + (y * sWidth + x) * 4, Points(Nearest).c
And turns it into an easier to calculate:
_MemPut mImage, ty + x * 4, Points(Nearest).c
Overall, it's not that much of a speed savings in this routine, but hey -- every little bit helps.
RE: Morphing Stained Glass - SMcNeill - 09-14-2024
Here's about all the little tweaks I can see to squeeze for performance:
Code: (Select All)
' Moving stained glass
Option _Explicit ' declare those variables!
Const TOTAL = 25 ' total pieces of glass
Type IPOINT ' PANE CENTER POINT PROPERTIES
x As Single ' x location
y As Single ' y location
c As _Unsigned Long ' color
xv As Single ' x vector
yv As Single ' y vector
End Type
Dim Points(TOTAL) As IPOINT ' center of each glass pane
Dim Image As Long ' stained glass output image
Dim ScreenImage As Long ' view screen
Dim x As Integer ' horizontal counter
Dim y As Integer ' vertical counter
Dim p As Integer ' point counter
Dim NearestDist As _Unsigned Long ' nearest distance to another point
Dim Nearest As Integer ' final nearest point
Dim dx As Long ' x distance
Dim dy As Long ' y distance
Dim Dist As Long ' x,y to dx,dy distance
Dim mScreen As _MEM ' screen memory
Dim mImage As _MEM ' output image memory
Dim MaxDist As _Unsigned Long ' max distance possible
Dim ty As _Offset
Const sWidth = 640 ' set screen width
Const sHeight = 480 ' set screen height
MaxDist = sWidth * sWidth + sHeight * sHeight ' maximum possible distance
Image = _NewImage(sWidth, sHeight, 32) ' output image
mImage = _MemImage(Image) ' output image memory
'ScreenImage = _CopyImage(Image, 32) ' view screen
'mScreen = _MemImage(ScreenImage) ' view screen memory
Screen Image ' create view screen
Randomize Timer ' seed RND generator
For p = 0 To TOTAL - 1 ' cycle through pane center points
Points(p).x = Rnd * sWidth ' random x location
Points(p).y = Rnd * sHeight ' random y location
Points(p).c = _RGB32(Rnd * 128 + 128, Rnd * 128 + 128, Rnd * 128 + 128) ' random color above 128, 128, 128
Points(p).xv = (Rnd - Rnd) * 3 ' random x velocity
Points(p).yv = (Rnd - Rnd) * 3 ' random y velocity
Next p
Do ' begin animation loop
$Checking:Off
y = 0 ' reset vertical counter
Do ' begin vertical loop
x = 0 ' reset horizontal counter
ty = mImage.OFFSET + y * sWidth * 4
Do ' begin horizontal loop
NearestDist = MaxDist ' reset nearest distance seen
p = 0 ' reset point counter
Do ' begin point loop
dx = Points(p).x - x ' calculate distance from x to point x
dy = Points(p).y - y ' calculate distance from y to point y
Dist = dx * dx + dy * dy ' calculate hypotenuse distance
If Dist < NearestDist Then ' is this the nearest distance seen?
Nearest = p ' yes, mark this point as nearest
NearestDist = Dist ' set new nearest distance seen
End If
p = p + 1 ' increment point counter
Loop Until p = TOTAL ' leave when all points checked
_MemPut mImage, ty + x * 4, Points(Nearest).c ' draw pixel on output image
x = x + 1 ' increment horizontal counter
Loop Until x = sWidth ' leave when width of image reached
y = y + 1 ' increment vertical counter
Loop Until y = sHeight ' leave when height of image reached
' _MemCopy mImage, mImage.OFFSET, mImage.SIZE To mScreen, mScreen.OFFSET ' copy image to view screen
p = 0 ' reset point counter
Do ' begin point update loop
dx = Points(p).x + Points(p).xv ' calculate new look ahead point x location
dy = Points(p).y + Points(p).yv ' calculate new look ahead point y location
If dx < 0 _Orelse dx >= sWidth Then Points(p).xv = -Points(p).xv ' reverse vector if left/right side of image reached
If dy < 0 _Orelse dy >= sHeight Then Points(p).yv = -Points(p).yv ' reverse vector if top/bottom side of image reached
Points(p).x = Points(p).x + Points(p).xv ' calculate new point x location
Points(p).y = Points(p).y + Points(p).yv ' calculate new point y location
p = p + 1 ' increment point counter
Loop Until p = TOTAL ' leave when all points updated
$Checking:On
Loop Until _KeyDown(27) ' leave when ESC key pressed
System ' return to operating system
Use of CONST for SWidth and SHeight, as those don't change and it saves the compiler from having to do a variable look up.
Use of _ORELSE instead of OR in those IF statements, so we can short circuit out it one side has been met, without checking the other.
Change of comparision from > sWidth -1 to >= sWidth (It's not a big change, but it all adds up one bit at a time).
Removal of second screen. What's that for? Just use the single screen and save that copy of the memory every cycle.
Refactor of the math, as per the post above to (ty + x * 4) as the offset for that _MEMPUT
If there's anything else out there to tweak, it's not showing up as something obvious to me, at the moment. Maybe it's enough to see a change on slower end computers. I dunno. Both with and without the changes, it performs reasonably well for me on my laptop.