09-06-2024, 02:41 AM
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.
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