+- 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
Morphing Stained Glass - TerryRitchie - 09-13-2024
I came up with the little program below while investigating a method of proceduraly creating landscapes. However, it is slow as heck. Setting TOTAL to anything above 25 is just painful.
I tried using a memory buffer for the Points() array ( _MEMNEW) but it made absolutely no difference in speed.
Does anyone have any ideas on how to speed this routine up?
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
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
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, mImage.OFFSET + (y * sWidth + 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 systemRE: Morphing Stained Glass - bplus - 09-13-2024
Oh you are moving Voronoi Points around, nice idea!
https://en.wikipedia.org/wiki/Voronoi_diagram#:~:text=In%20mathematics%2C%20a%20Voronoi%20diagram,classified%20also%20as%20a%20tessellation.
Andy Amaya had posted something years back that sped up Voronoi nicely, probably in last forum?
RE: Morphing Stained Glass - Petr - 09-13-2024
I achieved only a very slight speedup by not having the image written to the _MEM array point by point, but to the array and then putting it all at once into the MEM area at the end. I have no ideas for further acceleration because nothing can be calculated in advance and it depends on running in a loop.
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
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
Dim O(sWidth * sHeight) As _Unsigned Long
Dim Oi As Long
Do ' begin animation loop
$Checking:Off
y = 0 ' reset vertical counter
Do ' begin vertical loop
x = 0 ' reset horizontal counter
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
O(Oi) = Points(Nearest).c 'place pixels to array
Oi = Oi + 1
'_MemPut mImage, mImage.OFFSET + (y * sWidth + 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
Oi = 0
_MemPut mImage, mImage.OFFSET, O() 'place all pixels to output image at once
_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
RE: Morphing Stained Glass - Petr - 09-13-2024
Also - add _DontBlend before first DO
RE: Morphing Stained Glass - bplus - 09-13-2024
This does 12000 points in the blink of an eye!
here is bplus by Andys Voronoi:
25000 pts
RE: Morphing Stained Glass - TerryRitchie - 09-13-2024
(09-13-2024, 08:38 PM)bplus Wrote: Oh you are moving Voronoi Points around, nice idea!Yes, I stumbled across a web site about Voronoi diagrams and thought I might be able to adapt that to a landscape function. I see another post of yours below. I'll check out the code.
https://en.wikipedia.org/wiki/Voronoi_diagram#:~:text=In%20mathematics%2C%20a%20Voronoi%20diagram,classified%20also%20as%20a%20tessellation.
Andy Amaya had posted something years back that sped up Voronoi nicely, probably in last forum?
Also, thank you @Petr for taking a look at this and your insights.
RE: Morphing Stained Glass - Pete - 09-13-2024
Speed the routine up? Sure, type faster!
Stupid remarks aside, I came up with the same concept as Petr, but I don't think I can see a way to apply it to reasonably speed things up anymore than what you have already accomplished.
Hey, Mark found a way to give himself 25,000 pts. I'm stuck at 97. Best check into what he posted.
Oh well, back to SCREEN 0.
Pete
RE: Morphing Stained Glass - TerryRitchie - 09-13-2024
(09-13-2024, 08:45 PM)Petr Wrote: Also - add _DontBlend before first DOYep, your mods add a noticeable boost. Thank you. It's counterintuitive adding another array to deal with but makes perfect sense. I'm still trying to make sense of what bplus gave me to ponder over though.
RE: Morphing Stained Glass - TerryRitchie - 09-13-2024
(09-13-2024, 08:49 PM)bplus Wrote: This does 12000 points in the blink of an eye!Ok, I found that thread on the old site: https://qb64forum.alephc.xyz/index.php?PHPSESSID=e32ae740c9fe2fdec91b8415ee78706a&topic=3813.0
here is bplus by Andys Voronoi:
25000 pts
This code is fast! I'm picking it apart to make sense of it.
RE: Morphing Stained Glass - DSMan195276 - 09-13-2024
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.
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 SubThis 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);
}