QB64 Phoenix Edition
Drawing Tools Subs or Functions with Demo - Printable Version

+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://qb64phoenix.com/forum/forumdisplay.php?fid=26)
+---- Forum: bplus (https://qb64phoenix.com/forum/forumdisplay.php?fid=36)
+---- Thread: Drawing Tools Subs or Functions with Demo (/showthread.php?tid=272)

Pages: 1 2 3 4 5 6

RE: Drawing Tools Subs or Functions with Demo - bplus - 09-05-2024

@TerryRitchie

First I want to emphasize my update to my reply to you yesterday that I think we are taking points on the circle (fill) and seeking the equivalent point for color on the rectangular image and the tu and tv are helpers to that translation/conversion. We are not likely taking all the points from a section of the image and plotting them by color into the circle fill, they wouldn't all fit!

2nd about the 3 and the 6. The circumference of a circle is 2*Pi*R = 6.28.... * R almost 6.
You need Pi*R displayed for the front of the globe = 3.14 *R
So the 3 and 6 are simplifications of Pi and 2*Pi is my guess.

As far as attributions go, I wonder if Paul Dunn stole/studied/and applied the above You Tube code from some other source say Richard Russel who has been doing spinning globes forever with BBC Basic. I say this because I see a couple of my works included in his You Tube collection Smile

Like I said, "We stand on the shoulders of Copiers, not so much giants as knowers of good code when they see it and can figure out how to make it work for themselves carrying it forward with tiny improvements." This is why beginning artists are trained to copy the Masters, not to do that for their entire career but to carry great ideas forward to higher realms.

RE: Drawing Tools Subs or Functions with Demo - TerryRitchie - 09-05-2024

Thank you for taking the time to find this information.

RE: Drawing Tools Subs or Functions with Demo - TerryRitchie - 09-05-2024

Ok, I finally figured out what the math is doing. However, in doing so I realized this approach only works in one certain circumstance ... the image to be mapped must be exactly twice as wide as it is high. While it's possible to supply a radius for the output sphere the overall math still uses half the height of the image as the radius when calculating.

For example, the worldmap image is 1235x617 and fits the one circumstance. Even though I can supply a radius of 100 the math still uses 308 (half the image height) when calculating points on the image to use and then simply scales 308 to 100 when outputting the pixels. This is why no matter which radius value you supply the drawing always takes the same amount of time.

It's an ingenious approach that needs some tweaking that I'm working on to speed things up.

The need for an image to have a width twice the height can't be overcome using this method however. As the code in the youtube video shows this is "fake sphere mapping" but very convincing nonetheless.

I should have some code to post shortly.

RE: Drawing Tools Subs or Functions with Demo - bplus - 09-05-2024

OK I am sorry I failed to mention the ratio width : height, 2:1, thing of image, that is important caveat; but the Sphere Radius, sr, should be anything you want (within reason of screen dimensions)? did I misunderstand?

If you use a smaller image it probably takes less time? (going by what you are saying) so take the image and shrink it before submitting to the sub, if time is an issue?

RE: Drawing Tools Subs or Functions with Demo - TerryRitchie - 09-06-2024

(09-05-2024, 07:46 PM)bplus Wrote: OK I am sorry I failed to mention the ratio width : height, 2:1, thing of image, that is important caveat; but the Sphere Radius, sr, should be anything you want (within reason of screen dimensions)? did I misunderstand?

If you use a smaller image it probably takes less time? (going by what you are saying) so take the image and shrink it before submitting to the sub, if time is an issue?
I'm not saying there is anything wrong with the code, quite the opposite as it works well for what is intended. Like I said, it's ingenious.

I contacted Paul Dunn and he said he adapted the code from an algorithm for mapping latitude and longitude coordinates to a rectangle. After he explained its origins it all makes sense now in how it works.

I have code now that can take any size image and create any size sphere. I'm putting it through its paces now to make sure I haven't missed any bugs.

Your thoughts about the magic numbers being related to PI were spot on. 1.5 is half Pi, 3 is Pi, and 6 is 2 * Pi. I used the reciprocal of Pi and 2 * Pi to remove as many divisions as I could from the code for speed.

RE: Drawing Tools Subs or Functions with Demo - TerryRitchie - 09-06-2024

Here is the code I created from your code base.

The code will now resize the input image based on the radius supplied or create still images with a 1 to 1 ratio or based on the radius supplied. See the documentation in the subroutine for a full explanation on use.

The major change here is the subroutine passes back an image that contains the sphere instead of drawing directly to the screen.

Code: (Select All)
OPTION _EXPLICIT


CONST wW = 800 '               screen width
CONST wH = 600 '               screen height
DIM map AS LONG '              world map image
DIM Sphere AS LONG '           returned sphere image
DIM xoff AS INTEGER '          map image x offset
DIM x AS INTEGER '             counter
DIM y AS INTEGER '             counter
DIM PaintNow AS INTEGER '      paint toggle

SCREEN _NEWIMAGE(wW, wH, 32)


' ---------------------------------
'| PRESS ESC TO MOVE THROUGH DEMOS |
' ---------------------------------

' Spinning sphere example

map = _LOADIMAGE("worldmap.png", 32)
WHILE _KEYDOWN(27) = 0 '                        ESC key pressed?
    xoff = (xoff + 1) MOD (_WIDTH(map) + 1) '   no, rotate left (can't go right because of MOD use)
    Image2Sphere map, Sphere, 100, xoff '       map image to sphere
    _PUTIMAGE (0, 0), Sphere
    _DISPLAY
    _LIMIT 60
WEND

_FREEIMAGE map
_AUTODISPLAY
CLS

' Static spehere demo

map = _NEWIMAGE(600, 600, 32) '                 create a red/white checkerboard image
_DEST map
CLS , _RGB32(255, 255, 255)
FOR y = 0 TO 599 STEP 30
    IF y / 30 MOD 2 = 0 THEN PaintNow = 1 ELSE PaintNow = 0
    FOR x = 0 TO 599 STEP 30
        PaintNow = 1 - PaintNow
        IF PaintNow THEN LINE (x, y)-(x + 29, y + 29), _RGB32(255, 0, 0), BF
    NEXT x
NEXT y
_DEST 0

Image2Sphere map, Sphere, 0, -1 '       map image to sphere without resizing (1 to 1 image to sphere)
_PUTIMAGE (0, 0), Sphere
SLEEP
CLS
Image2Sphere map, Sphere, 100, 0 '      map image to sphere with resizing
_PUTIMAGE (0, 0), Sphere




'------------------------------------------------------------------------------------------------------------------+
SUB Image2Sphere (InImage AS LONG, OutImage AS LONG, Radius AS INTEGER, xo AS INTEGER) '                           |
    '+-------------------------------------------------------------------------------------------------------------+
    '| Fake Sphere Mapping                                                                                         |
    '|                                                                                                             |
    '| Adapted from code by bplus: https://qb64phoenix.com/forum/showthread.php?tid=272&pid=2647#pid2647           |
    '| Which was adapted from code by Paul Dunn: https://www.youtube.com/watch?v=0EGDJybA_HE                       |
    '| I contacted Paul Dunn and confirmed that the code in the video above is his original work.                  |
    '| Quote from Paul, "yep, this one is mine, worked out from an algorithm for mapping lat/long to a rectangle." |
    '|                                                                                                             |
    '| Maps an image to a sphere.                                                                                  |
    '|                                                                                                             |
    '| InImage  : image passed in                                                                                  |
    '| OutImage : processed output image                                                                           |
    '| Radius   : sphere radius                                                                                    |
    '| xo       : input image x offset (supplying a negative value will not scale the input image)                 |
    '|                                                                                                             |
    '| If you wish to create a rotating image (such as a globe or planet) the input image (InImage) must be twice  |
    '| as wide as it is high. xo will then control the current view of the image on the sphere.                    |
    '|                                                                                                             |
    '| If you wish to map an image 1 to 1 onto a sphere then the input image (InImage) must have the same width    |
    '| and height (a square). xo must be set to a negative value so no scaling occurs. Radius will have no effect  |
    '| because Radius will be calculated based on the input image.                                                 |
    '|                                                                                                             |
    '| Anything other than the two conditions above will yield, let's say, "interesting" effects.                  |
    '|                                                                                                             |
    '| NOTE: the larger the sphere to be created the slower this algorithm performs.                               |
    '+-------------------------------------------------------------------------------------------------------------+

    CONST rPI = .31830981 '     value of Pi recipricated
    CONST rTWOPI = .1591549 '   twice the value of Pi recipricated
    CONST HALFPI = 1.5707963 '  half the value of Pi
    DIM iWidth AS INTEGER '     width of input image
    DIM iHeight AS INTEGER '    height of input image
    DIM x AS INTEGER '          location along horizontal line within sphere
    DIM y AS INTEGER '          vertical location within sphere
    DIM LineLength AS INTEGER ' length of horizontal line within sphere
    DIM ix AS SINGLE '          location of x within scaled image
    DIM iy AS SINGLE '          location of y within scaled image
    DIM oSource AS LONG '       calling SOURCE
    DIM oDest AS LONG '         calling DESTINATION
    DIM ScaledImage AS LONG '   temporary scaled input image

    ' -----------------------------------
    '| Scale input image to match radius |
    ' -----------------------------------

    IF xo < 0 THEN '                                          don't scale image?
        ScaledImage = _COPYIMAGE(InImage) '                   yes, just make a copy of image
        Radius = _HEIGHT(ScaledImage) * .5 '                  calculate radius
        xo = 0 '                                              reset x offset value
    ELSE '                                                    image needs scaling
        ScaledImage = _NEWIMAGE(Radius * 4, Radius * 2, 32) ' create scaled image canvas
        _PUTIMAGE , InImage, ScaledImage '                    stretch input image to scaled canvas
    END IF

    iWidth = _WIDTH(ScaledImage) '                            width of scaled image
    iHeight = _HEIGHT(ScaledImage) '                          height of scaled image

    ' ----------------------------
    '| Set scaled image as source |
    ' ----------------------------

    oSource = _SOURCE '                                       get calling source
    _SOURCE ScaledImage '                                     POINT data will be retireved from scaled image

    ' ----------------------
    '| Prepare output image |
    ' ----------------------

    oDest = _DEST '                                           get calling destination
    IF OutImage < -1 THEN _FREEIMAGE OutImage '               remove residual image if it exists
    OutImage = _NEWIMAGE(iHeight, iHeight, 32) '              create square output image
    _DEST OutImage '                                          draw on output image

    ' ---------------------
    '| Map image to sphere |
    ' ---------------------

    $CHECKING:OFF
    y = -Radius + 1 '                                         start at top of sphere
    DO '                                                      begin vertical loop
        LineLength = SQR(Radius * Radius - y * y) '           calculate line length across sphere at current y location

        ' -------------------------------------------------------------------
        '| We want to use the full height of the scaled image here ( * rPI ) |
        '| The value returned here will be 0 to 1 (0% to 100%)               |
        ' -------------------------------------------------------------------

        iy = (_ASIN(y / Radius) + HALFPI) * rPI '             calculate how far to come down vertically (y) within scaled image
        x = -LineLength + 1 '                                 start at left side of line
        DO '                                                  begin horizontal loop

            ' --------------------------------------------------------------------------
            '| We only want to use half the width of the scaled image here ( * rTWOPI ) |
            '| The value returned will be 0 to .5 (0% to 50%)                           |
            ' --------------------------------------------------------------------------

            ix = (_ASIN(x / LineLength) + HALFPI) * rTWOPI '  calculate how far to go horizontally (x) within scaled image

            ' ----------------------------------------------------------------------------------------------------
            '| Multiply ix and iy by scaled image width and height to get location of pixel on scaled image.      |
            '| Then, map that pixel onto the output image within the current horizontal line length.              |
            ' ----------------------------------------------------------------------------------------------------

            PSET (x + Radius, y + Radius), POINT((xo + ix * iWidth) MOD iWidth, iy * iHeight) ' map scaled image pixel to output image
            x = x + 1 '                                       move one pixel across line to the right
        LOOP UNTIL x > LineLength - 1 '                       leave when right side of line reached
        y = y + 1 '                                           move one pixel down the sphere
    LOOP UNTIL y > Radius - 1 '                               leave when bottom of sphere reached
    $CHECKING:ON

    ' -----------------------------------------
    '| Restore original source and destination |
    ' -----------------------------------------

    _FREEIMAGE ScaledImage '                                  remove temporary scaled image
    _SOURCE oSource '                                         restore calling source
    _DEST oDest '                                             restore calling destination

END SUB


RE: Drawing Tools Subs or Functions with Demo - vince - 09-06-2024

nice sphere mapping mod, B+

RE: Drawing Tools Subs or Functions with Demo - bplus - 09-06-2024

+1 @TerryRitchie for deep dive into this, specially impressed getting with Paul Dunn!

Terry, do you think that seam between Asia and Americas is from not precise 2:1 ratio of image?
I am suspecting that seam is why I did not switch the 3 and 6 back to 3.1415... and 2*Pi.
As it stands, no offense but it is kinda yucky.

The Red and White checkered glode seems fine! and good speed on both.

For everyone's convenience I've got all relevant files zipped into a project folder for easy download and viewing.
I added a modified version of Terry's Update version demo dressed up a tiny bit.

Update: On my mod of Terry's demo of his update Image2Sphere, escape refused to work even with a _keyclear so to exit the last demo use spacebar.
Someone, @SMcNeill might know, why _keydown(32) works fine but _Keydown(27) doesn't even with _KeyClear???

PS thanks @vince


Update: well _Keyclear doen't work with _Keydown for one thing! Maybe the code was running so fast that the last escape keypress was still being held down when we hit the loop code.

So a _delay to get free of the last escape keypress
Code: (Select All)
Option _Explicit
_Title "bplus mod TerryRitchie Sphere2Image Update.bas" ' b+ 2024-09-06

Const wW = 800 '               screen width
Const wH = 600 '               screen height
Dim map As Long '              world map image
Dim Sphere As Long '           returned sphere image
Dim xoff As Integer '          map image x offset
Dim x As Integer '             counter
Dim y As Integer '             counter
Dim PaintNow As Integer '      paint toggle

Screen _NewImage(wW, wH, 32)


' ---------------------------------
_Title "PRESS ESC TO MOVE THROUGH DEMOS" ' bplus mod
' ---------------------------------

' Spinning sphere example

map = _LoadImage("worldmap.png", 32)
While _KeyDown(27) = 0 '                        ESC key pressed?
    xoff = (xoff + 1) Mod (_Width(map) + 1) '   no, rotate left (can't go right because of MOD use)
    Image2Sphere map, Sphere, 100, xoff '       map image to sphere
    _PutImage (300, 200), Sphere ' bplus mod
    _Display
    _Limit 60
Wend

_FreeImage map
_AutoDisplay
Cls

' Static spehere demo

map = _NewImage(600, 600, 32) '                 create a red/white checkerboard image
_Dest map
Cls , _RGB32(255, 255, 255)
For y = 0 To 599 Step 30
    If y / 30 Mod 2 = 0 Then PaintNow = 1 Else PaintNow = 0
    For x = 0 To 599 Step 30
        PaintNow = 1 - PaintNow
        If PaintNow Then Line (x, y)-(x + 29, y + 29), _RGB32(255, 0, 0), BF
    Next x
Next y
_Dest 0

Image2Sphere map, Sphere, 0, -1 '       map image to sphere without resizing (1 to 1 image to sphere)
_PutImage (0, 0), Sphere
Sleep
Cls
_Delay .5 ' <<<< get your finger off last escape keypress fixed 9/7/2024 !!!!!!!!!!!!
Dim xo As Integer ' bplus mod
While _KeyDown(27) = 0 ' note: _keyclear doesn't do anything for _Keydown
    xo = xo + 1
    Image2Sphere map, Sphere, 100, xo '      map image to sphere with resizing
    _PutImage (300, 200), Sphere
Wend


'------------------------------------------------------------------------------------------------------------------+
Sub Image2Sphere (InImage As Long, OutImage As Long, Radius As Integer, xo As Integer) '                           |
    '+-------------------------------------------------------------------------------------------------------------+
    '| Fake Sphere Mapping                                                                                         |
    '|                                                                                                             |
    '| Adapted from code by bplus: https://qb64phoenix.com/forum/showthread.php?tid=272&pid=2647#pid2647           |
    '| Which was adapted from code by Paul Dunn: https://www.youtube.com/watch?v=0EGDJybA_HE                       |
    '| I contacted Paul Dunn and confirmed that the code in the video above is his original work.                  |
    '| Quote from Paul, "yep, this one is mine, worked out from an algorithm for mapping lat/long to a rectangle." |
    '|                                                                                                             |
    '| Maps an image to a sphere.                                                                                  |
    '|                                                                                                             |
    '| InImage  : image passed in                                                                                  |
    '| OutImage : processed output image                                                                           |
    '| Radius   : sphere radius                                                                                    |
    '| xo       : input image x offset (supplying a negative value will not scale the input image)                 |
    '|                                                                                                             |
    '| If you wish to create a rotating image (such as a globe or planet) the input image (InImage) must be twice  |
    '| as wide as it is high. xo will then control the current view of the image on the sphere.                    |
    '|                                                                                                             |
    '| If you wish to map an image 1 to 1 onto a sphere then the input image (InImage) must have the same width    |
    '| and height (a square). xo must be set to a negative value so no scaling occurs. Radius will have no effect  |
    '| because Radius will be calculated based on the input image.                                                 |
    '|                                                                                                             |
    '| Anything other than the two conditions above will yield, let's say, "interesting" effects.                  |
    '|                                                                                                             |
    '| NOTE: the larger the sphere to be created the slower this algorithm performs.                               |
    '+-------------------------------------------------------------------------------------------------------------+

    Const rPI = .31830981 '     value of Pi recipricated
    Const rTWOPI = .1591549 '   twice the value of Pi recipricated
    Const HALFPI = 1.5707963 '  half the value of Pi
    Dim iWidth As Integer '     width of input image
    Dim iHeight As Integer '    height of input image
    Dim x As Integer '          location along horizontal line within sphere
    Dim y As Integer '          vertical location within sphere
    Dim LineLength As Integer ' length of horizontal line within sphere
    Dim ix As Single '          location of x within scaled image
    Dim iy As Single '          location of y within scaled image
    Dim oSource As Long '       calling SOURCE
    Dim oDest As Long '         calling DESTINATION
    Dim ScaledImage As Long '   temporary scaled input image

    ' -----------------------------------
    '| Scale input image to match radius |
    ' -----------------------------------

    If xo < 0 Then '                                          don't scale image?
        ScaledImage = _CopyImage(InImage) '                   yes, just make a copy of image
        Radius = _Height(ScaledImage) * .5 '                  calculate radius
        xo = 0 '                                              reset x offset value
    Else '                                                    image needs scaling
        ScaledImage = _NewImage(Radius * 4, Radius * 2, 32) ' create scaled image canvas
        _PutImage , InImage, ScaledImage '                    stretch input image to scaled canvas
    End If

    iWidth = _Width(ScaledImage) '                            width of scaled image
    iHeight = _Height(ScaledImage) '                          height of scaled image

    ' ----------------------------
    '| Set scaled image as source |
    ' ----------------------------

    oSource = _Source '                                       get calling source
    _Source ScaledImage '                                     POINT data will be retireved from scaled image

    ' ----------------------
    '| Prepare output image |
    ' ----------------------

    oDest = _Dest '                                           get calling destination
    If OutImage < -1 Then _FreeImage OutImage '               remove residual image if it exists
    OutImage = _NewImage(iHeight, iHeight, 32) '              create square output image
    _Dest OutImage '                                          draw on output image

    ' ---------------------
    '| Map image to sphere |
    ' ---------------------

    $Checking:Off
    y = -Radius + 1 '                                         start at top of sphere
    Do '                                                      begin vertical loop
        LineLength = Sqr(Radius * Radius - y * y) '           calculate line length across sphere at current y location

        ' -------------------------------------------------------------------
        '| We want to use the full height of the scaled image here ( * rPI ) |
        '| The value returned here will be 0 to 1 (0% to 100%)               |
        ' -------------------------------------------------------------------

        iy = (_Asin(y / Radius) + HALFPI) * rPI '             calculate how far to come down vertically (y) within scaled image
        x = -LineLength + 1 '                                 start at left side of line
        Do '                                                  begin horizontal loop

            ' --------------------------------------------------------------------------
            '| We only want to use half the width of the scaled image here ( * rTWOPI ) |
            '| The value returned will be 0 to .5 (0% to 50%)                           |
            ' --------------------------------------------------------------------------

            ix = (_Asin(x / LineLength) + HALFPI) * rTWOPI '  calculate how far to go horizontally (x) within scaled image

            ' ----------------------------------------------------------------------------------------------------
            '| Multiply ix and iy by scaled image width and height to get location of pixel on scaled image.      |
            '| Then, map that pixel onto the output image within the current horizontal line length.              |
            ' ----------------------------------------------------------------------------------------------------

            PSet (x + Radius, y + Radius), Point((xo + ix * iWidth) Mod iWidth, iy * iHeight) ' map scaled image pixel to output image
            x = x + 1 '                                       move one pixel across line to the right
        Loop Until x > LineLength - 1 '                       leave when right side of line reached
        y = y + 1 '                                           move one pixel down the sphere
    Loop Until y > Radius - 1 '                               leave when bottom of sphere reached
    $Checking:On

    ' -----------------------------------------
    '| Restore original source and destination |
    ' -----------------------------------------

    _FreeImage ScaledImage '                                  remove temporary scaled image
    _Source oSource '                                         restore calling source
    _Dest oDest '                                             restore calling destination

End Sub

EDIT: 9/7/2024 fixed bplus mod code of the last demo so now you can use escape for all demos.

RE: Drawing Tools Subs or Functions with Demo - TerryRitchie - 09-06-2024

(09-06-2024, 09:09 PM)bplus Wrote: +1 @TerryRitchie for deep dive into this, specially impressed getting with Paul Dunn!

Terry, do you think that seam between Asia and Americas is from not precise 2:1 ratio of image?
I am suspecting that seam is why I did not switch the 3 and 6 back to 3.1415... and 2*Pi.
As it stands, no offense but it is kinda yucky.

The Red and White checkered glode seems fine! and good speed on both.

For everyone's convenience I've got all relevant files zipped into a project folder for easy download and viewing.
I added a modified version of Terry's Update version demo dressed up a tiny bit.

Update: On my mod of Terry's demo of his update Image2Sphere, escape refused to work even with a _keyclear so to exit the last demo use spacebar.
Someone, @SMcNeill might know, why _keydown(32) works fine but _Keydown(27) doesn't even with _KeyClear???

PS thanks @vince
I just assumed the image is to blame for the seam. Your original demo overlaid a grid which covered the seam. I'll play around with another image to see what happens. It may have something to do with the Linelength (x) and image height (y) counters starting with +1 and ending with -1. When I played around with those though the circle was getting clipped ever so slightly on the right side. Some tweaking may be in order.

The ESC key works fine for me all the way through the demos. I wonder why it works for some and not others?

I'm playing around with trying to get the horizontal lines to bend in accordance with height as well. I'll post something if I get that figured out.

RE: Drawing Tools Subs or Functions with Demo - bplus - 09-07-2024

@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.