Task

Draw a sphere.

The sphere can be represented graphically, or in ASCII art, depending on the language capabilities.

Either static or rotational projection is acceptable for this task.



Related tasks

 draw a cuboid
 draw a rotating cube
 write language name in 3D ASCII
 draw a Deathstar


--
-- demo\rosetta\Draw_a_sphere.exw
-- ==============================
--
with javascript_semantics
include pGUI.e

constant title = "Draw a sphere"
Ihandle dlg, canvas
cdCanvas cddbuffer, cdcanvas

function dot(sequence x, y)
    return sum(sq_mul(x,y))
end function

function normalize(sequence v)
    atom len = sqrt(dot(v, v))
    return iff(len=0?{0,0,0}:sq_mul(v,1/len))
end function

procedure drawSphere(integer width, height, atom k, amb, sequence direction)
    atom t0 = time()+1, t1 = t0,
         lmul = 255/(1+amb)
    integer r = floor((min(width,height)-20)/2),
           cx = floor(width/2),
           cy = floor(height/2)
    for x=-r to r do
        if time()>t1 then
            -- Let the user know we aren't completely dead just yet
            IupSetStrAttribute(dlg,"TITLE","%s - drawing (%d%%)",{title,100*(x+r)/(2*r)})
            t1 = time()+1
            -- (as per DeathStar.exw, prevent "(Not Responding)" nonsense)
            if platform()!=JS then
                if IupLoopStep()=IUP_CLOSE then
                    IupExitLoop()
                    exit
                end if
            end if
        end if
        for y=-r to r do
            integer z = r*r-(x*x+y*y)
            if z>=0 then
                atom s = dot(direction, normalize({x,y,sqrt(z)})),
                     l = iff(s<=0?0:power(s,k))
                integer lum = and_bits(#FF,lmul*(l+amb))
                cdCanvasPixel(cddbuffer, x+cx, y+cy, lum*#10101)
            end if
        end for
    end for
    if t1!=t0 then
        IupSetStrAttribute(dlg,"TITLE",title)
    end if
end procedure

function redraw_cb(Ihandle /*ih*/, integer /*posx*/, /*posy*/)
    integer {width, height} = IupGetIntInt(canvas, "DRAWSIZE")
    cdCanvasActivate(cddbuffer)
    cdCanvasClear(cddbuffer) 
    drawSphere(width,height,1.5,0.2,normalize({-30,-30,50}))
    cdCanvasFlush(cddbuffer)
    return IUP_DEFAULT
end function

function map_cb(Ihandle ih)
    cdcanvas = cdCreateCanvas(CD_IUP, ih)
    cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)
    cdCanvasSetBackground(cddbuffer, CD_BLACK)
    return IUP_DEFAULT
end function

procedure main()
    IupOpen()

    canvas = IupCanvas("RASTERSIZE=340x340")
    IupSetCallbacks(canvas, {"MAP_CB", Icallback("map_cb"),
                             "ACTION", Icallback("redraw_cb")})
    dlg = IupDialog(canvas,`TITLE="%s"`,{title})
    IupShow(dlg)
    IupSetAttribute(canvas, "RASTERSIZE", NULL) -- release the minimum limitation
    if platform()!=JS then
        IupMainLoop()
        IupClose()
    end if
end procedure

main()
