All BASIC (reaching out)

[ZXDunny]

Oh, wow! That turned out excellent How is the performance on an image that size? Can you rotate it in real time? I can in SpecBAS at 800x480, but I can only get about 25fps at best so I'm really hitting the limits of the interpreter.

I cannot believe how simple the algorithm turned out to be though. It's literally just ArcSin functions on the x and y coordinates, and voila! (after some massaging to get from the -1.5 to 1.5 coordinates that ArcSin returns to map to the image)

Someone suggested I tweet the BBC logo video, and it's gone viral - as much as anything I do goes viral, that is. Today, I am a very minor celebrity.

[B+]

Code: [Select]

_TITLE "Fake sphere mapping by Paul Dunn, trans from SpecBas to QB64 2018-10-31 B+"
'10  Fake sphere mapping
'20 GRAPHIC NEW t LOAD "demos:3d/lava_strip.png":gw=gfxw t,gh=gfxh t:
'   palette copy t,0,256 to 0:
'   paper rgbn(0):
'   screen lock
'30 r=scrh/2.1,xc=SCRw/2,yc=SCRh/2,xo=0:
'   do:
'      for y=-r+1 to r-1:
'         x1=sqr(r*r-y*y),
'         tv=(asn(y/r)+1.5)/3:
'         for x=-x1 to x1:
'            tu=(asn(x/x1)+1.5)/6:
'            plot ink gpoint(t,(xo+tu*gw) mod gw,tv*gh);x+xc,y+yc:
'         next x:
'      next y:
'      xo+=1,xo%=gw:
'      wait screen:
'      cls:
'   loop

SCREEN _NEWIMAGE(800, 600, 32)
surface& = _LOADIMAGE("martian.png")
'surface& = _LOADIMAGE("mars.png") 'this image has a color change where ends meet
'surface& = _LOADIMAGE("mars0.jpeg") 'better

gw = _WIDTH(surface&)
gh = _HEIGHT(surface&)
map& = _NEWIMAGE(gw, gh, 32)
_DEST map&
_PUTIMAGE , surface&, map&
_DEST 0

stars& = _LOADIMAGE("stars.png")
_SOURCE stars&
_DEST 0
_PUTIMAGE

r = _HEIGHT / 3
xc = _WIDTH / 2
yc = _HEIGHT / 2
xo = 0
DO
    start = TIMER
    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 map&
            pc~& = POINT((xo + tu * gw) MOD gw, tv * gh)
            _DEST 0
            PSET (x + xc, y + yc), pc~&
            'plot ink gpoint(t,(xo+tu*gw) mod gw,tv*gh);x+xc,y+yc
        NEXT x
    NEXT y
    xo = xo + 1
    xo = xo MOD gw
    tyme = TIMER - start
    Total = Total + tyme
    Count = Count + 1
    Ave = Total / Count
    LOCATE 1, 1: PRINT INT(Ave * 10000) / 10000
    _DISPLAY

    ' wait screen
    'CLS
LOOP


This is taking about .0214 secs per loop or 46-47 loops per sec. I did change the radius to smaller and printing times slows things down a bit. (Compiled exe)

:-)) congrats to celebrity status, you have impressed me many a time.

EDIT: sorry dyslexic with digits today.