09-13-2024, 07:52 PM (This post was last modified: 09-13-2024, 07:59 PM by TerryRitchie.)
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 system
New to QB64pe? Visit the QB64 tutorial to get started. QB64 Tutorial
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
Andy Amaya had posted something years back that sped up Voronoi nicely, probably in last forum?
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.
Also, thank you @Petr for taking a look at this and your insights.
New to QB64pe? Visit the QB64 tutorial to get started. QB64 Tutorial
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.
(09-13-2024, 08:45 PM)Petr Wrote: Also - add _DontBlend before first DO
Yep, 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.
New to QB64pe? Visit the QB64 tutorial to get started. QB64 Tutorial
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
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 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
