RosettaCodeData/Task/Fractal-tree/Phix/fractal-tree.phix
2017-09-25 22:28:19 +02:00

60 lines
1.6 KiB
Text

--
-- demo\rosetta\FractalTree.exw
--
include pGUI.e
Ihandle dlg, canvas
cdCanvas cddbuffer, cdcanvas
procedure drawTree(integer level, atom angle, atom len, integer x, integer y)
integer xn = x + floor(len*cos(angle))
integer yn = y + floor(len*sin(angle))
integer red = 255-level*8
integer grn = level*12+100
cdCanvasSetForeground(cddbuffer, red*#10000 + grn*#100)
cdCanvasLineWidth(cddbuffer,floor(5-level/3))
cdCanvasLine(cddbuffer, x, 480-y, xn, 480-yn)
if level<12 then
drawTree(level+1, angle-0.4, len*0.8, xn, yn) --left
drawTree(level+1, angle+0.1, len*0.8, xn, yn) --right
end if
end procedure
function redraw_cb(Ihandle /*ih*/, integer /*posx*/, integer /*posy*/)
cdCanvasActivate(cddbuffer)
cdCanvasClear(cddbuffer)
drawTree(0, -PI/2.0, 80.0, 360, 460)
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_PARCHMENT)
return IUP_DEFAULT
end function
function esc_close(Ihandle /*ih*/, atom c)
if c=K_ESC then return IUP_CLOSE end if
return IUP_CONTINUE
end function
procedure main()
IupOpen()
canvas = IupCanvas(NULL)
IupSetAttribute(canvas, "RASTERSIZE", "640x480")
IupSetCallback(canvas, "MAP_CB", Icallback("map_cb"))
IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))
dlg = IupDialog(canvas,"RESIZE=NO")
IupSetAttribute(dlg, "TITLE", "Fractal Tree")
IupSetCallback(dlg, "K_ANY", Icallback("esc_close"))
IupShow(dlg)
IupMainLoop()
IupClose()
end procedure
main()