(phixonline)-->
-- demo\rosetta\PythagorasTree.exw
with javascript_semantics
include pGUI.e
Ihandle dlg, canvas
cdCanvas cddbuffer, cdcanvas
enum FILL, BORDER
procedure drawTree(atom x1, y1, x2, y2, integer depth, dd)
atom dx = x2 - x1,
dy = y1 - y2,
x3 = x2 - dy,
y3 = y2 - dx,
x4 = x1 - dy,
y4 = y1 - dx,
x5 = x4 + 0.5 * (dx - dy),
y5 = y4 - 0.5 * (dx + dy)
if depth=dd then
integer r = 250-depth*20
for draw=FILL to BORDER do
-- one square...
cdCanvasSetForeground(cddbuffer, iff(draw=FILL?rgb(r,#FF,0):CD_GRAY))
integer mode = iff(draw=FILL?CD_FILL:CD_CLOSED_LINES)
cdCanvasBegin(cddbuffer,mode)
cdCanvasVertex(cddbuffer, x1, 640-y1)
cdCanvasVertex(cddbuffer, x2, 640-y2)
cdCanvasVertex(cddbuffer, x3, 640-y3)
cdCanvasVertex(cddbuffer, x4, 640-y4)
cdCanvasEnd(cddbuffer)
-- ...and the attached triangle
if draw=FILL then
cdCanvasSetForeground(cddbuffer, rgb(r-depth*10,#FF,0))
end if
cdCanvasBegin(cddbuffer,mode)
cdCanvasVertex(cddbuffer, x3, 640-y3)
cdCanvasVertex(cddbuffer, x4, 640-y4)
cdCanvasVertex(cddbuffer, x5, 640-y5)
cdCanvasEnd(cddbuffer)
end for
elsif depth<dd then
drawTree(x4, y4, x5, y5, depth + 1, dd)
drawTree(x5, y5, x3, y3, depth + 1, dd)
end if
end procedure
function redraw_cb(Ihandle /*ih*/, integer /*posx*/, /*posy*/)
cdCanvasActivate(cddbuffer)
for i=0 to 7 do -- (draw leaves last)
drawTree(275, 500, 375, 500, 0, i)
end for
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_WHITE)
cdCanvasSetForeground(cddbuffer, CD_RED)
return IUP_DEFAULT
end function
procedure main()
IupOpen()
canvas = IupCanvas(NULL)
IupSetAttribute(canvas, "RASTERSIZE", "640x640")
IupSetCallback(canvas, "MAP_CB", Icallback("map_cb"))
IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))
dlg = IupDialog(canvas,"RESIZE=NO")
IupSetAttribute(dlg, "TITLE", "Pythagoras Tree")
IupShow(dlg)
if platform()!=JS then
IupMainLoop()
IupClose()
end if
end procedure
main()