Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Drawing Tools Subs or Functions with Demo
#41
(09-07-2024, 12:51 AM)bplus Wrote: @TerryRitchie the escape worked fine in your demo but when I tried

while _keydown(27) = 0

to loop the rotation of the checkered glode it would not draw anytyhing.

This is my mod of your code included in the zip. I rotated the checkered globe like the first worldmap globe to check speed for one thing and to see how easy it was to adopt your version image2sphere for another reason.

The checkerboard image is square. If you want to rotate it you'll need to change the code to make the image twice as wide.

Edit: oops, that's only if you need something like a globe of Mars or Earth for instance. Never mind, getting late, tired.
There are two ways to write error-free programs; only the third one works.
QB64 Tutorial
Reply
#42
I have dived deeper into this rabbit hole and come up with even faster (much faster) code for the fake sphere mapping.

This time the code creates a precalculated x coordinate translation array which removes the need to calculate latitude and longitude coordinates every time the sphere is redrawn. Next, the translation array and images are all handled in memory using _MEM commands for speed.

I'm getting very close to 100 frames per second rotating a 953x953 sphere!

I'm exploring ways of turning this proof on concept code into a workable subroutine or function.

The downside to this approach is that the map image needs to be doubled in width. Essentially two of the images need to be next to each other since there is no way to do what MOD is performing in the previous code above. I'm exploring ways of overcoming this as well, perhaps through some clever memory address manipulation.

The ZIP file below contains the world map image that is 954 pixels high.

Code: (Select All)
' Fake Sphere Mapping
'
' Proof of concept using a precalculated x coordinate translation array and _MEM memory buffers.
' This demo achieves almost 100 frames per second creating and rotating a 953x953 spehere.
' This was achieved on an older test system running an i7-6700K at 4Ghz.
' Results on more modern equipment should be even more impressive.

OPTION _EXPLICIT

DIM imageWidth AS INTEGER '     width of initial image
DIM imageHeight AS INTEGER '    height of initial image
DIM baseImage AS LONG '         initial image (temporary)
DIM image AS LONG '             working image (2 base images next to each other)
DIM sphere AS LONG '            output image
DIM Mapx AS INTEGER '           calculation map x coordinate
DIM x AS INTEGER '              horizontal counter
DIM y AS INTEGER '              vertical counter
DIM xOffset AS INTEGER '        horizontal drawing offset within image
DIM mMap AS _MEM '              texture map x coordinate array
DIM mMapOffset AS _OFFSET '     memory location of calculation map array
DIM mImage AS _MEM '            image array
DIM mImageOffset AS _OFFSET '   memory location of image array
DIM mSphere AS _MEM '           sphere output image array
DIM mSphereOffset AS _OFFSET '  memory location of sphere output image array
DIM Pixel AS _UNSIGNED LONG '   image pixel

baseImage = _LOADIMAGE("worldmap2.png", 32) '                                load image to map
imageWidth = _WIDTH(baseImage) '                                             record image width
imageHeight = _HEIGHT(baseImage) '                                           record image height
image = _NEWIMAGE(imageWidth * 2, imageHeight, 32) '                         create texture image (2 base images side by side)
_PUTIMAGE (0, 0), baseImage, image '                                         draw first image onto texture image
_PUTIMAGE (imageWidth, 0), baseImage, image '                                draw second image onto texture image
_FREEIMAGE baseImage '                                                       map image no longer needed
mImage = _MEMIMAGE(image) '                                                  create image array in memory from texture image
sphere = _NEWIMAGE(imageHeight, imageHeight, 32) '                           create image array in memory from output image
mMap = _MEMNEW(imageHeight * imageHeight * 2) '                              create texture map x coordinate array in memory
mSphere = _MEMIMAGE(sphere) '                                                create sphere array in memory
SCREEN _NEWIMAGE(imageHeight, imageHeight, 32) '                             screen same height as output image
initMapPos '                                                                 create texture map x coordinate array
xOffset = 0 '                                                                reset image x offset
DO '                                                                         begin demo
    $CHECKING:OFF
    y = 0 '                                                                  reset vertical counter
    DO '                                                                     begin vertical loop
        mMapOffset = mMap.OFFSET + (y * imageHeight * 2) '                   start memory location of horizontal line within map
        mSphereOffset = mSphere.OFFSET + (y * imageHeight * 4) '             start memory location of horizontal line within sphere
        mImageOffset = mImage.OFFSET + (y * imageWidth * 8) '                start memory location of horizontal line within image
        x = 0 '                                                              reset horizontal counter
        DO '                                                                 begin horizontal loop
            _MEMGET mMap, mMapOffset + (x * 2), Mapx '                       get x texture coordinate
            IF Mapx <> -1 THEN '                                             valid coordinate?
                _MEMGET mImage, mImageOffset + (Mapx + xOffset) * 4, Pixel ' yes, get pixel from image
                _MEMPUT mSphere, mSphereOffset + (x * 4), Pixel '            apply pixel to output image
            END IF
            x = x + 1 '                                                      increment horizontal counter
        LOOP UNTIL x = imageHeight '                                         leave when entire horizontal line processed
        y = y + 1 '                                                          increment vertical counter
    LOOP UNTIL y = imageHeight '                                             leave when entire vertical line processed
    xOffset = xOffset + 1 '                                                  increment image x offset
    IF xOffset > imageWidth - 1 THEN xOffset = 0 '                           reset image x offset when needed
    _PUTIMAGE (0, 0), sphere '                                               display output image
    _DISPLAY '                                                               update screen with changes
    '_LIMIT 60
    $CHECKING:ON
LOOP UNTIL _KEYDOWN(27) '                                                    leave demo when ESC pressed
_MEMFREE mMap '                                                              free memory assets
_MEMFREE mSphere
_MEMFREE mImage
_FREEIMAGE image '                                                           free image assets
_FREEIMAGE sphere
SYSTEM '                                                                     return to operating system


'-----------------------------------------------------------------------------------------------------------------------------------------+
SUB initMapPos () '                                                                                                                       |
    '+------------------------------------------------------------------------------------------------------------------------------------+
    '| Create an x coordinate translation array so latitude and longitude calculations only need to be peformed once.                     |
    '+------------------------------------------------------------------------------------------------------------------------------------+

    CONST HALFPI = _PI * .5 '         half of Pi
    CONST rPI = 1 / _PI '             Pi reciprocated
    SHARED imageWidth AS INTEGER '    need width of image
    SHARED imageHeight AS INTEGER '   need height of image
    SHARED mMap AS _MEM '             need access to texture map x coordinate array
    DIM radius AS SINGLE '            sphere radius
    DIM Index AS _UNSIGNED LONG '     array memory offset for each value
    DIM sLongitude AS SINGLE '        sine longitude calculation
    DIM longitude AS SINGLE '         longitude calculation
    DIM x AS INTEGER '                horizontal counter
    DIM y AS INTEGER '                vertical counter

    radius = imageHeight * .5 '                                                        calculate sphere radius
    y = 0 '                                                                            reset vertical counter
    DO '                                                                               begin vetical loop
        x = 0 '                                                                        reset horizontal counter
        DO '                                                                           begin horizontal loop
            Index = (y * imageHeight + x) * 2 '                                        value memory location
            sLongitude = (x - radius) / (radius * COS(_ASIN((y - radius) / radius))) ' calculate sine longitude of pixel
            IF sLongitude >= -1 AND sLongitude <= 1 THEN '                             is pixel inside the circle?
                longitude = _ASIN(sLongitude) + HALFPI '                               yes, complete longitude calculation
                _MEMPUT mMap, mMap.OFFSET + Index, (longitude * imageWidth * .5) * rPI AS INTEGER ' store corresponding image x coordinate
            ELSE '                                                                     no, pixel is outside of circle
                _MEMPUT mMap, mMap.OFFSET + Index, -1 AS INTEGER '                     mark x coordinate as outside of circle
            END IF
            x = x + 1 '                                                                increment horizontal counter
        LOOP UNTIL x = imageHeight '                                                   leave when entire horizontal line processed
        y = y + 1 '                                                                    increment vertical counter
    LOOP UNTIL y = imageHeight '                                                       leave when entire vertical line processed

END SUB


Attached Files
.zip   Worldmap2.zip (Size: 373.14 KB / Downloads: 8)
There are two ways to write error-free programs; only the third one works.
QB64 Tutorial
Reply
#43
check out this mod, B+, drag mouse and use mousewheel

Code: (Select All)

defdbl a-z
dim shared pi, p, q, uu, vv

zoom = 200

sw = 800
sh = 600

screen _newimage(sw, sh, 32)

img = _loadimage("bluemarble_small.png")
w = _width(img)
h = _height(img)

pi = 4*atn(1)
du = 2*pi/24
dv = pi/14

vv = -pi/6

drag = 0

_source img
_dest 0


do
    oz = zoom
    do
        mx = _mousex
        my = _mousey
        mb = _mousebutton(1)
        zoom = zoom - 10*_mousewheel
    loop while _mouseinput
    cls

    'uu = uu + 0.01
    'vv = vv + 0.01


    if mb and drag = 1 then
        uu = (-mx - omx)*pi/sh
        vv = (my - omy)*pi/sh
    end if

    if mb and drag = 0 then
        omx = mx
        omy = my
        drag = 1
    end if

    if mb = 0 and drag = 1 then
        drag = 0
    end if

    for v=-pi/2 to pi/2 step 3/zoom
        for u=0 to 2*pi step 3/zoom
            r = cos(v)
            z = sin(v)
            x = r*cos(u)
            y = r*sin(u)

            xx = x
            yy = y
            zz = z
           
            rotz x,y,z,uu
            rotx x,y,z,vv

            sx = 0 
            sy = -1
            sz = 0 

            proj xx, yy, zz
            pp = sw/2 + zoom*p
            qq = sh/2 - zoom*q
            if pp>0 and pp<sw and qq>0 and qq<sh then

            if (x*sx + y*sy + z*sz) < 0 then

                dim c as _unsigned long
                cx = (w*u/(2*pi) ) mod w
                cy = (h - h*(v + pi/2)/pi ) mod h
                c = point(cx, cy)

                pset (sw/2 + zoom*p, sh/2 - zoom*q), c
            end if
            end if
           
        next
    next


    if drag or (zoom <> oz) then
    for v=0 to 2*pi step dv
        for u=0 to 2*pi step du

            r = cos(v)
            z = sin(v)
            x = r*cos(u)
            y = r*sin(u)

            rotz x,y,z,uu
            rotx x,y,z,vv

            sx = 0 
            sy = -1
            sz = 0 
           
            color _rgb(100,100,100)
            if  (x*sx + y*sy + z*sz) < 0 then
                r = cos(v)
                proj r*cos(u), r*sin(u), sin(v)
                pset (sw/2 + zoom*p, sh/2 - zoom*q)

                proj r*cos(u + du), r*sin(u + du), sin(v)
                line -(sw/2 + zoom*p, sh/2 - zoom*q)

                r = cos(v + dv)
                proj r*cos(u + du), r*sin(u + du), sin(v + dv)
                line -(sw/2 + zoom*p, sh/2 - zoom*q)

                proj r*cos(u), r*sin(u), sin(v + dv)
                line -(sw/2 + zoom*p, sh/2 - zoom*q)

                r = cos(v)
                proj r*cos(u), r*sin(u), sin(v)
                line -(sw/2 + zoom*p, sh/2 - zoom*q)
            end if

        next
    next
    end if

    _limit 30
    _display
loop until _keyhit = 27
sleep
system

sub proj(x, y, z)
    'p = x + 0.707*y
    'q = z + 0.707*y

    rotz x,y,z,uu
    rotx x,y,z,vv


    d = 10
    p = x*d/(10 + y)
    q = z*d/(10 + y)
end sub

sub rotx(x, y, z, a)
    xx = x
    yy = y*cos(a) - z*sin(a)
    zz = y*sin(a) + z*cos(a)

    x = xx
    y = yy
    z = zz
end sub

sub roty(x, y, z, a)
    xx = x*cos(a) + z*sin(a)
    yy = y
    zz = -x*sin(a) + z*cos(a)

    x = xx
    y = yy
    z = zz
end sub

sub rotz(x, y, z, a)
    xx = x*cos(a) - y*sin(a)
    yy = x*sin(a) + y*cos(a)
    zz = z

    x = xx
    y = yy
    z = zz
end sub


Attached Files Image(s)
   
Reply
#44
+1 @vince allot of nice features you have, rotate glode all 3 axis and use mousewheel to expand and shrink. All the black lines and interferrence patterns detract from image though:
   

I tried Worldmap image from our previous posts, true the image does not have great contrast but lines drown image:
   

Wait... did that get reversed???
b = b + ...
Reply
#45
maybe try this mod, B+

Code: (Select All)

defdbl a-z
dim shared pi, p, q, uu, vv

zoom = 350

sw = 1024
sh = 768

screen _newimage(sw, sh, 32)

img = _loadimage("bluemarble_small.png")
'img = _loadimage("mars_huge.png")
w = _width(img)
h = _height(img)

pi = 4*atn(1)
du = 2*pi/24
dv = pi/14

uu = pi
vv = -pi/6

drag = 0

_source img
_dest 0


do
    oz = zoom
    do
        mx = _mousex
        my = _mousey
        mb = _mousebutton(1)
        zoom = zoom - 10*_mousewheel
    loop while _mouseinput
    cls

    'uu = uu + 0.01
    'vv = vv + 0.01


    if mb and drag = 1 then
        uu = (-mx - omx)*pi/sh
        vv = (my - omy)*pi/sh
    end if

    if mb and drag = 0 then
        omx = mx
        omy = my
        drag = 1
    end if

    if mb = 0 and drag = 1 then
        drag = 0
    end if

    for v=-pi/2 to pi/2 step 0.001
        for u=0 to 2*pi step 0.001
            r = cos(v)
            z = sin(v)
            x = r*cos(u)
            y = r*sin(u)

            xx = x
            yy = y
            zz = z
           
            rotz x,y,z,uu
            rotx x,y,z,vv

            sx = 0 
            sy = -1
            sz = 0 

            proj xx, yy, zz
            pp = sw/2 + zoom*p
            qq = sh/2 - zoom*q
            if pp>0 and pp<sw and qq>0 and qq<sh then

            if (x*sx + y*sy + z*sz) < 0 then

                dim c as _unsigned long
                cx = (w - w*u/(2*pi) ) mod w
                cy = (h - h*(v + pi/2)/pi ) mod h
                c = point(cx, cy)

                pset (sw/2 + zoom*p, sh/2 - zoom*q), c
            end if
            end if
           
        next
    next


    'if drag or (zoom <> oz) then
    for v=0 to 2*pi step dv
        for u=0 to 2*pi step du

            r = cos(v)
            z = sin(v)
            x = r*cos(u)
            y = r*sin(u)

            rotz x,y,z,uu
            rotx x,y,z,vv

            sx = 0 
            sy = -1
            sz = 0 
           
            color _rgb(100,100,100)
            if  (x*sx + y*sy + z*sz) < 0 then
                r = cos(v)
                proj r*cos(u), r*sin(u), sin(v)
                pset (sw/2 + zoom*p, sh/2 - zoom*q)

                proj r*cos(u + du), r*sin(u + du), sin(v)
                line -(sw/2 + zoom*p, sh/2 - zoom*q)

                r = cos(v + dv)
                proj r*cos(u + du), r*sin(u + du), sin(v + dv)
                line -(sw/2 + zoom*p, sh/2 - zoom*q)

                proj r*cos(u), r*sin(u), sin(v + dv)
                line -(sw/2 + zoom*p, sh/2 - zoom*q)

                r = cos(v)
                proj r*cos(u), r*sin(u), sin(v)
                line -(sw/2 + zoom*p, sh/2 - zoom*q)
            end if

        next
    next
    'end if

   
    _limit 30
    _display
loop until _keyhit = 27
sleep
system

sub proj(x, y, z)
    'p = x + 0.707*y
    'q = z + 0.707*y

    rotz x,y,z,uu
    rotx x,y,z,vv


    d = 10
    p = x*d/(10 + y)
    q = z*d/(10 + y)
end sub

sub rotx(x, y, z, a)
    xx = x
    yy = y*cos(a) - z*sin(a)
    zz = y*sin(a) + z*cos(a)

    x = xx
    y = yy
    z = zz
end sub

sub roty(x, y, z, a)
    xx = x*cos(a) + z*sin(a)
    yy = y
    zz = -x*sin(a) + z*cos(a)

    x = xx
    y = yy
    z = zz
end sub

sub rotz(x, y, z, a)
    xx = x*cos(a) - y*sin(a)
    yy = x*sin(a) + y*cos(a)
    zz = z

    x = xx
    y = yy
    z = zz
end sub

i will eventually invert the coordinate systems to get pixel by pixel rendering but it will be so slow per frame, im not yet sure how to approach it, maybe a qbjs solution
Reply
#46
Sorry I ran out of time for playing.

I want to try this, vince's, and Terry's and rotozoom a disk at all sorts of angles Smile
b = b + ...
Reply




Users browsing this thread: 11 Guest(s)