70 lines
2 KiB
Text
70 lines
2 KiB
Text
--
|
|
-- demo\rosetta\SierpinskyTriangle.exw
|
|
--
|
|
include pGUI.e
|
|
|
|
Ihandle dlg, canvas
|
|
cdCanvas cddbuffer, cdcanvas
|
|
|
|
procedure SierpinskyTriangle(integer level, atom x, atom y, atom w, atom h)
|
|
atom w2 = w/2, w4 = w/4, h2 = h/2
|
|
if level=1 then
|
|
cdCanvasBegin(cddbuffer,CD_CLOSED_LINES)
|
|
cdCanvasVertex(cddbuffer, x, y)
|
|
cdCanvasVertex(cddbuffer, x+w2, y+h)
|
|
cdCanvasVertex(cddbuffer, x+w, y)
|
|
cdCanvasEnd(cddbuffer)
|
|
else
|
|
SierpinskyTriangle(level-1, x, y, w2, h2)
|
|
SierpinskyTriangle(level-1, x+w4, y+h2, w2, h2)
|
|
SierpinskyTriangle(level-1, x+w2, y, w2, h2)
|
|
end if
|
|
end procedure
|
|
|
|
integer level = 7
|
|
|
|
function redraw_cb(Ihandle /*ih*/, integer /*posx*/, integer /*posy*/)
|
|
integer {w, h} = IupGetIntInt(canvas, "DRAWSIZE")
|
|
cdCanvasActivate(cddbuffer)
|
|
cdCanvasClear(cddbuffer)
|
|
SierpinskyTriangle(level, w*0.05, h*0.05, w*0.9, h*0.9)
|
|
cdCanvasFlush(cddbuffer)
|
|
IupSetStrAttribute(dlg, "TITLE", "Sierpinsky Triangle (level %d)",{level})
|
|
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_GRAY)
|
|
return IUP_DEFAULT
|
|
end function
|
|
|
|
function esc_close(Ihandle /*ih*/, atom c)
|
|
if c=K_ESC then return IUP_CLOSE end if
|
|
if find(c,"+-") then
|
|
level = max(1,min(12,level+','-c))
|
|
IupRedraw(canvas)
|
|
end if
|
|
return IUP_CONTINUE
|
|
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)
|
|
IupSetAttribute(dlg, "TITLE", "Sierpinsky Triangle")
|
|
IupSetCallback(dlg, "K_ANY", Icallback("esc_close"))
|
|
|
|
IupShow(dlg)
|
|
IupSetAttribute(canvas, "RASTERSIZE", NULL)
|
|
IupMainLoop()
|
|
IupClose()
|
|
end procedure
|
|
main()
|