Drawing Tools Subs or Functions with Demo
#21
Here is a slight mod to your Image to Sphere demo. I changed it so it doesn't show the background map, just the mapped sphere with the grid. I also smoothed the animation out a little bit by doubling the Limit from 60 to 120. Using a black background I also added a CLS. You probably knew how to do this already but I thought I would add this for people that just wanted the sphere. This needs the Worldmap.png from your original post on this thread. 

Code: (Select All)
_Title "Image to Sphere by bplus - mod with only globe by SierraKen" 'b+ 2022-05-23  SierraKen 2022-05-26
Randomize Timer
Const wW = 1280, wH = 720
Screen _NewImage(wW, wH, 32)
_ScreenMove 65, 0
'_MouseHide
map& = _LoadImage("worldmap.png")
mw& = _Width(map&)
mh& = _Height(map&)
grid& = _NewImage(mw&, mh&, 32)
_Dest grid&
Color &HFF000000
drawGrid 0, 0, (mw& - 1) / 36, (mh& - 1) / 18, 36, 18
_Dest 0
'Color , &HFFFFFFFF   ' test grid
'Cls
'_PutImage (0, 0), grid&, 0
'End

While _KeyDown(27) = 0
    '_PutImage , map&, 0  <<< Removed
    '_PutImage , grid&, 0 <<< Removed
    xoff = (xoff + 4) Mod (_Width(map&) + 1)
    a = a + _Pi(2 / 320)
    x = 640 + 330 * Cos(a): y = 360 + 58 * Sin(a)
    projectImagetoSphere map&, x, y, 300, xoff
    projectImagetoSphere grid&, x, y, 300, xoff
    _Display
    Cls '<<< Needed for black background.
    _Limit 120 '<<< Doubled to make video smoother.
Wend

Sub projectImagetoSphere (image&, x0, y0, sr, xo)
    r = _Height(image&) / 2
    iW = _Width(image&)
    iH = _Height(image&)
    scale = sr / r
    For y = -r To r
        x1 = Sqr(r * r - y * y)
        tv = (_Asin(y / r) + 1.5) / 3
        For x = -x1 + 1 To x1
            tu = (_Asin(x / x1) + 1.5) / 6
            _Source image&
            pc~& = Point((xo + tu * iW) Mod iW, tv * iH)
            _Dest 0
            PSet (x * scale + x0, y * scale + y0), pc~&
        Next x
    Next y
End Sub

Sub drawGrid (x, y, xs, ys, xn, yn) ' top left x, y, x side, y side, number of x, nmber of y
    Dim As Long i, dx, dy
    dx = xs * xn: dy = ys * yn
    For i = 0 To xn
        Line (x + xs * i, y)-(x + xs * i, y + dy)
    Next
    For i = 0 To yn
        Line (x, y + ys * i)-(x + dx, y + ys * i)
    Next
End Sub
Reply


Messages In This Thread
RE: Drawing Tools Subs or Functions with Demo - by SierraKen - 05-26-2022, 10:01 PM



Users browsing this thread: 2 Guest(s)