09-14-2024, 05:09 AM
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:
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.
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.