September 2017 Update

Task/Sierpinski-triangle-Graphical/Phix/sierpinski-triangle-graphical.phix

@@ -0,0 +1,70 @@
+--
+-- 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()