Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Morphing Stained Glass
#1
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
Reply


Messages In This Thread
Morphing Stained Glass - by TerryRitchie - 09-13-2024, 07:52 PM
RE: Morphing Stained Glass - by bplus - 09-13-2024, 08:38 PM
RE: Morphing Stained Glass - by TerryRitchie - 09-13-2024, 09:29 PM
RE: Morphing Stained Glass - by Petr - 09-13-2024, 08:40 PM
RE: Morphing Stained Glass - by Petr - 09-13-2024, 08:45 PM
RE: Morphing Stained Glass - by TerryRitchie - 09-13-2024, 09:54 PM
RE: Morphing Stained Glass - by bplus - 09-13-2024, 08:49 PM
RE: Morphing Stained Glass - by TerryRitchie - 09-13-2024, 10:42 PM
RE: Morphing Stained Glass - by Pete - 09-13-2024, 09:30 PM
RE: Morphing Stained Glass - by DSMan195276 - 09-13-2024, 10:42 PM
RE: Morphing Stained Glass - by SMcNeill - 09-13-2024, 11:28 PM
RE: Morphing Stained Glass - by TerryRitchie - 09-14-2024, 01:41 AM
RE: Morphing Stained Glass - by DSMan195276 - 09-14-2024, 01:18 AM
RE: Morphing Stained Glass - by bplus - 09-14-2024, 01:30 AM
RE: Morphing Stained Glass - by bplus - 09-14-2024, 01:43 AM
RE: Morphing Stained Glass - by SMcNeill - 09-14-2024, 05:09 AM
RE: Morphing Stained Glass - by SMcNeill - 09-14-2024, 05:28 AM



Users browsing this thread: 2 Guest(s)