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
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.
09-05-2024, 07:17 PM (This post was last modified: 09-05-2024, 07:18 PM by TerryRitchie.)
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.
New to QB64pe? Visit the QB64 tutorial to get started. QB64 Tutorial
09-05-2024, 07:46 PM (This post was last modified: 09-05-2024, 07:52 PM by bplus.)
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?
(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.
New to QB64pe? Visit the QB64 tutorial to get started. QB64 Tutorial
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
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 |
' -----------------------------------------
09-06-2024, 09:09 PM (This post was last modified: 09-07-2024, 01:15 PM by bplus.)
+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???
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
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
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 |
' -----------------------------------------
(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???
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.
New to QB64pe? Visit the QB64 tutorial to get started. QB64 Tutorial
@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.
