Sierpinski curve: Difference between revisions

Line 928:

=={{header|Phix}}==

<lang Phix>-- demo\rosetta\Sierpinski_curve.exw

You can run this online [http://phix.x10.mx/p2js/Sierpinski_curve.htm here].

--

-- Draws curves lo to hi (simultaneously), initially {1,1}, max {8,8}

--

-- Press +/- to change hi, shift +/- to change lo.

-- demo\rosetta\Sierpinski_curve.exw

-- ("=_" are also mapped to "+-", for the non-numpad +/-)

-- =================================

--

include pGUI.e

-- Draws curves lo to hi (simultaneously), initially {1,1}, max {8,8}

-- Press +/- to change hi, shift +/- to change lo, ctrl +/- for both.

Ihandle dlg, canvas

-- ("=_" are also mapped to "+-", for the non-numpad +/-)

cdCanvas cddbuffer, cdcanvas

--

with javascript_semantics

integer width, height,

include pGUI.e

lo = 1, hi = 1

atom cx, cy, h

procedure lineTo(atom newX, newY)

cdCanvasVertex(cddbuffer, newX-width/2+h, height-newY+2*h)

cx = newX

cy = newY

end procedure

procedure lineN() lineTo(cx,cy-2*h) end procedure

procedure lineS() lineTo(cx,cy+2*h) end procedure

procedure lineE() lineTo(cx+2*h,cy) end procedure

procedure lineW() lineTo(cx-2*h,cy) end procedure

Ihandle dlg, canvas

procedure lineNW() lineTo(cx-h,cy-h) end procedure

cdCanvas cddbuffer, cdcanvas

procedure lineNE() lineTo(cx+h,cy-h) end procedure

procedure lineSE() lineTo(cx+h,cy+h) end procedure

procedure lineSW() lineTo(cx-h,cy+h) end procedure

procedure sierN(integer level)

if level=1 then

lineNE() lineN()

lineNW()

else

sierN(level-1) lineNE()

sierE(level-1) lineN()

sierW(level-1) lineNW()

sierN(level-1)

end if

end procedure

integer width, height,

procedure sierE(integer level)

lm = 0, tm = 0, -- left and top margins

if level=1 then

lo = 1, hi = 1

lineSE() lineE()

atom cx, cy, h

lineNE()

else

sierE(level-1) lineSE()

sierS(level-1) lineE()

sierN(level-1) lineNE()

sierE(level-1)

end if

end procedure

procedure lineTo(atom newX, newY)

procedure sierS(integer level)

cdCanvasVertex(cddbuffer, newX-width/2+h+lm, height-newY+2*h+tm)

if level=1 then

cx = newX

lineSW() lineS()

cy = newY

lineSE()

end procedure

else

sierS(level-1) lineSW()

sierW(level-1) lineS()

sierE(level-1) lineSE()

sierS(level-1)

end if

end procedure

procedure lineN() lineTo(cx,cy-2*h) end procedure

procedure sierW(integer level)

procedure lineS() lineTo(cx,cy+2*h) end procedure

if level=1 then

procedure lineE() lineTo(cx+2*h,cy) end procedure

lineNW() lineW()

procedure lineW() lineTo(cx-2*h,cy) end procedure

lineSW()

~~else~~

procedure lineNW() lineTo(cx-h,cy-h) end procedure

sierW(level-1) lineNW()

procedure lineNE() lineTo(cx+h,cy-h) end procedure

sierN(level-1) lineW()

procedure lineSE() lineTo(cx+h,cy+h) end procedure

sierS(level-1) lineSW()

procedure lineSW() lineTo(cx-h,cy+h) end procedure

sierW(level-1)

end if

forward procedure sierN(integer level)

end procedure

forward procedure sierE(integer level)

forward procedure sierS(integer level)

procedure sierpinskiCurve(integer level)

forward procedure sierW(integer level)

sierN(level) lineNE()

sierE(level) lineSE()

procedure sierN(integer level)

sierS(level) lineSW()

if level=1 then

sierW(level) lineNW()

lineNE() lineN()

end procedure

lineNW()

else

function redraw_cb(Ihandle /*ih*/, integer /*posx*/, integer /*posy*/)

sierN(level-1) lineNE()

{width, height} = IupGetIntInt(canvas, "DRAWSIZE")

sierE(level-1) lineN()

cdCanvasActivate(cddbuffer)

sierW(level-1) lineNW()

for level=lo to hi do

sierN(level-1)

cx = width/2

end if

cy = height

end procedure

h = cx/power(2,level+1)

cdCanvasBegin(cddbuffer, CD_CLOSED_LINES)

procedure sierE(integer level)

sierpinskiCurve(level)

if level=1 then

cdCanvasEnd(cddbuffer)

lineSE() lineE()

end for

lineNE()

cdCanvasFlush(cddbuffer)

else

return IUP_DEFAULT

sierE(level-1) lineSE()

end function

sierS(level-1) lineE()

sierN(level-1) lineNE()

function map_cb(Ihandle ih)

sierE(level-1)

cdcanvas = cdCreateCanvas(CD_IUP, ih)

end if

cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)

end procedure

cdCanvasSetBackground(cddbuffer, CD_WHITE)

cdCanvasSetForeground(cddbuffer, CD_BLUE)

procedure sierS(integer level)

return IUP_DEFAULT

if level=1 then

end function

lineSW() lineS()

lineSE()

function key_cb(Ihandle /*ih*/, atom c)

else

if c=K_ESC then return IUP_CLOSE end if

sierS(level-1) lineSW()

if find(c,"+=-_") then

sierW(level-1) lineS()

bool bShift = IupGetInt(NULL,"SHIFTKEY")

sierE(level-1) lineSE()

if c='+' or c='=' then

sierS(level-1)

if bShift then

end if

lo = min(lo+1,hi)

end procedure

else

hi = min(8,hi+1)

procedure sierW(integer level)

end if

if level=1 then

elsif c='-' or c='_' then

lineNW() lineW()

if bShift then

lineSW()

lo = max(1,lo-1)

else

else

sierW(level-1) lineNW()

hi = max(lo,hi-1)

sierN(level-1) lineW()

end if

sierS(level-1) lineSW()

end if

sierW(level-1)

IupSetStrAttribute(dlg, "TITLE", "Sierpinski curve (%d..%d)",{lo,hi})

end if

cdCanvasClear(cddbuffer)

end procedure

IupUpdate(canvas)

end if

procedure sierpinskiCurve(integer level)

return IUP_CONTINUE

sierN(level) lineNE()

end function

sierE(level) lineSE()

sierS(level) lineSW()

procedure main()

sierW(level) lineNW()

IupOpen()

end procedure

canvas = IupCanvas(NULL)

function redraw_cb(Ihandle /*ih*/)

IupSetAttribute(canvas, "RASTERSIZE", "770x770")

{width, height} = IupGetIntInt(canvas, "DRAWSIZE")

IupSetCallback(canvas, "MAP_CB", Icallback("map_cb"))

if width>height then

IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))

lm = floor((width-height)/2)

tm = 0

dlg = IupDialog(canvas)

width = height

IupSetAttribute(dlg, "TITLE", "Sierpinski curve (1..1)")

else

IupSetCallback(dlg, "K_ANY", Icallback("key_cb"))

lm = 0

tm = floor((height-width)/2)

IupMap(dlg)

height = width

IupShowXY(dlg,IUP_CENTER,IUP_CENTER)

end if

IupMainLoop()

cdCanvasActivate(cddbuffer)

IupClose()

for level=lo to hi do

end procedure

cx = width/2

cy = height

main()</lang>

h = cx/power(2,level+1)

cdCanvasBegin(cddbuffer, CD_CLOSED_LINES)

sierpinskiCurve(level)

cdCanvasEnd(cddbuffer)

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_BLUE)

return IUP_DEFAULT

end function

procedure set_dlg_title()

IupSetStrAttribute(dlg, "TITLE", "Sierpinski curve (%d..%d)",{lo,hi})

end procedure

function key_cb(Ihandle /*ih*/, atom c)

if c=K_ESC then return IUP_CLOSE end if

if c=K_F5 then return IUP_DEFAULT end if -- (let browser reload work)

c = iup_XkeyBase(c)

if find(c,"+=-_") then

bool bCtrl = IupGetInt(NULL,"CONTROLKEY"),

bShift = IupGetInt(NULL,"SHIFTKEY")

if c='+' or c='=' then

if bCtrl or not bShift then hi = min(8,hi+1) end if

if bCtrl or bShift then lo = min(lo+1,hi) end if

elsif c='-' or c='_' then

if bCtrl or bShift then lo = max(1,lo-1) end if

if bCtrl or not bShift then hi = max(lo,hi-1) end if

end if

set_dlg_title()

cdCanvasClear(cddbuffer)

IupUpdate(canvas)

end if

return IUP_CONTINUE

end function

procedure main()

IupOpen()

canvas = IupCanvas("RASTERSIZE=770x770")

IupSetCallbacks(canvas, {"MAP_CB", Icallback("map_cb"),

"ACTION", Icallback("redraw_cb")})

dlg = IupDialog(canvas)

IupSetCallback(dlg, "KEY_CB", Icallback("key_cb"))

set_dlg_title()

IupShow(dlg)

IupSetAttribute(canvas, "RASTERSIZE", NULL)

if platform()!=JS then

IupMainLoop()

IupClose()

end if

end procedure

main()

=={{header|Processing}}==