RosettaCodeData/Task/Draw-a-cuboid/Phix/draw-a-cuboid-1.phix
2019-09-12 10:33:56 -07:00

141 lines
4.3 KiB
Text

--
-- demo\rosetta\draw_cuboid.exw
--
include pGUI.e
Ihandle dlg, canvas, hTimer
cdCanvas cd_canvas
-- arrays: 3D coordinates of vertices
sequence x = {-2.0, +2.0, +2.0, -2.0, -2.0, +2.0, +2.0, -2.0},
y = {-1.5, -1.5, +1.5, +1.5, -1.5, -1.5, +1.5, +1.5},
z = {-1.0, -1.0, -1.0, -1.0, +1.0, +1.0, +1.0, +1.0},
Segment = {1,2, 2,3, 3,4, 4,1, 5,6, 6,7, 7,8, 8,5, 1,5, 2,6, 3,7, 4,8}
atom Size = 50.0, -- drawing size
Sz = 0.008, -- tumbling speeds
Sx =-0.013, -- ""
Sy =-0.013, -- ""
S = 2
procedure draw_cube(integer wx, wh)
atom farthest = 0.0 -- find the farthest vertex
integer farv, v1, v2, c, style
for i=1 to 8 do
if z[i]>farthest then farthest = z[i] farv = i end if
end for
for v=1 to 2*12 by 2 do -- for all the vertices...
v1 = Segment[v] -- get vertex number
v2 = Segment[v+1]
c = CD_RED
style = CD_CONTINUOUS
if v1=farv or v2=farv then
c = CD_BLUE
style = CD_DASHED
end if
cdCanvasSetForeground(cd_canvas, c)
cdCanvasLineStyle(cd_canvas, style)
atom x1 = x[v1]*Size+wx,
y1 = y[v1]*Size+wh,
x2 = x[v2]*Size+wx,
y2 = y[v2]*Size+wh
cdCanvasLine(cd_canvas,x1,y1,x2,y2)
end for
end procedure
function canvas_action_cb(Ihandle canvas)
cdCanvasActivate(cd_canvas)
cdCanvasClear(cd_canvas)
integer {wx, wh} = sq_floor_div(IupGetIntInt(canvas, "DRAWSIZE"),2)
draw_cube(wx,wh)
cdCanvasFlush(cd_canvas)
return IUP_DEFAULT
end function
function canvas_map_cb(Ihandle canvas)
atom res = IupGetDouble(NULL, "SCREENDPI")/25.4
IupGLMakeCurrent(canvas)
cd_canvas = cdCreateCanvas(CD_GL, "10x10 %g", {res})
cdCanvasSetBackground(cd_canvas, CD_BLACK)
return IUP_DEFAULT
end function
function canvas_unmap_cb(Ihandle canvas)
cdKillCanvas(cd_canvas)
return IUP_DEFAULT
end function
function canvas_resize_cb(Ihandle /*canvas*/)
integer {canvas_width, canvas_height} = IupGetIntInt(canvas, "DRAWSIZE")
atom res = IupGetDouble(NULL, "SCREENDPI")/25.4
cdCanvasSetAttribute(cd_canvas, "SIZE", "%dx%d %g", {canvas_width, canvas_height, res})
return IUP_DEFAULT
end function
function k_any(Ihandle /*ih*/, atom c)
if c=K_ESC then
return IUP_CLOSE
elsif c=K_UP then
for i=1 to 8 do
y[i] = y[i]+z[i]*Sx*S -- rotate vertices in Y-Z plane
z[i] = z[i]-y[i]*Sx*S
end for
elsif c=K_DOWN then
for i=1 to 8 do
y[i] = y[i]-z[i]*Sx*S -- rotate vertices in Y-Z plane
z[i] = z[i]+y[i]*Sx*S
end for
elsif c=K_LEFT then
for i=1 to 8 do
x[i] = x[i]+z[i]*Sy*S -- rotate vertices in X-Z plane
z[i] = z[i]-x[i]*Sy*S
end for
elsif c=K_RIGHT then
for i=1 to 8 do
x[i] = x[i]-z[i]*Sy*S -- rotate vertices in X-Z plane
z[i] = z[i]+x[i]*Sy*S
end for
elsif c='+' then
Size += 5
elsif c='-' then
Size = max(10,Size-5)
elsif c=' ' then
IupSetInt(hTimer,"RUN",not IupGetInt(hTimer,"RUN"))
end if
IupRedraw(canvas)
return IUP_CONTINUE
end function
function timer_cb(Ihandle /*ih*/)
for i=1 to 8 do
x[i] = x[i]+y[i]*Sz*S -- rotate vertices in X-Y plane
y[i] = y[i]-x[i]*Sz*S
y[i] = y[i]+z[i]*Sx*S -- rotate vertices in Y-Z plane
z[i] = z[i]-y[i]*Sx*S
x[i] = x[i]+z[i]*Sy*S -- rotate vertices in X-Z plane
z[i] = z[i]-x[i]*Sy*S
end for
IupUpdate(canvas)
return IUP_IGNORE
end function
procedure main()
IupOpen()
IupImageLibOpen()
canvas = IupGLCanvas()
IupSetAttribute(canvas, "RASTERSIZE", "640x480")
IupSetCallback(canvas, "ACTION", Icallback("canvas_action_cb"))
IupSetCallback(canvas, "MAP_CB", Icallback("canvas_map_cb"))
IupSetCallback(canvas, "UNMAP_CB", Icallback("canvas_unmap_cb"))
IupSetCallback(canvas, "RESIZE_CB", Icallback("canvas_resize_cb"))
dlg = IupDialog(IupVbox({canvas}))
IupSetAttribute(dlg, "TITLE", "Draw Cuboid")
IupSetCallback(dlg, "K_ANY", Icallback("k_any"))
IupShow(dlg)
IupSetAttribute(canvas, "RASTERSIZE", NULL)
hTimer = IupTimer(Icallback("timer_cb"), 40)
IupMainLoop()
IupClose()
end procedure
main()