Vibrating rectangles: Difference between revisions

Line 755:

=={{header|Phix}}==

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

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

--

-- Draws concentric rectangles in random colours to simulate vibration.

--

-- Press +/- to increase/decrease the number of rectangles being drawn.

-- demo\rosetta\vibrect.exw

-- Resizing the window, as it turns out, achieves much the same effect

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

-- as +/-, only much quicker (by increasing/decreasing the spacing).

--

-- Draws concentric rectangles in random colours to simulate vibration.

integer numrects = 125 -- (max non-touching for a height of 500)

-- Press +/- to increase/decrease the number of rectangles being drawn.

-- Resizing the window, as it turns out, achieves much the same effect

include pGUI.e

-- as +/-, only much quicker (by increasing/decreasing the spacing).

--

Ihandle dlg, canvas

with javascript_semantics

cdCanvas cddbuffer, cdcanvas

integer numrects = 125 -- (max non-touching for a height of 500)

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

include pGUI.e

integer {w,h} = IupGetIntInt(canvas, "DRAWSIZE")

atom dw = w/(numrects*2+1),

Ihandle dlg, canvas

dh = h/(numrects*2+1)

cdCanvas cddbuffer, cdcanvas

cdCanvasActivate(cddbuffer)

function redraw_cb(Ihandle /*ih*/)

for i=1 to numrects do

integer {w,h} = IupGetIntInt(canvas, "DRAWSIZE")

cdCanvasSetForeground(cddbuffer,rand(#FFFFFF))

atom dw = w/(numrects*2+1),

atom wd = i*dw,

dh = h/(numrects*2+1)

hd = i*dh

cdCanvasRect(cddbuffer, wd, w-wd, hd, h-hd)

cdCanvasActivate(cddbuffer)

end for

for i=1 to numrects do

cdCanvasFlush(cddbuffer)

cdCanvasSetForeground(cddbuffer,rand(#FFFFFF))

return IUP_DEFAULT

atom wd = i*dw,

end function

hd = i*dh

cdCanvasRect(cddbuffer, wd, w-wd, hd, h-hd)

function map_cb(Ihandle ih)

end for

cdcanvas = cdCreateCanvas(CD_IUP, ih)

cdCanvasFlush(cddbuffer)

cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)

return IUP_DEFAULT

cdCanvasSetBackground(cddbuffer, CD_WHITE)

end function

cdCanvasSetForeground(cddbuffer, CD_BLACK)

return IUP_DEFAULT

function map_cb(Ihandle ih)

end function

cdcanvas = cdCreateCanvas(CD_IUP, ih)

cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)

function timer_cb(Ihandle /*ih*/)

cdCanvasSetBackground(cddbuffer, CD_WHITE)

IupUpdate(canvas)

cdCanvasSetForeground(cddbuffer, CD_BLACK)

return IUP_IGNORE

return IUP_DEFAULT

end function

end function

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

function timer_cb(Ihandle /*ih*/)

if c=K_ESC then return IUP_CLOSE end if

IupUpdate(canvas)

if c='+' or (c='-' and numrects>3) then

return IUP_IGNORE

numrects -= c-','

end function

cdCanvasClear(cddbuffer)

IupUpdate(canvas)

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

end if

if c=K_ESC then return IUP_CLOSE end if

return IUP_CONTINUE

if c='+' or (c='-' and numrects>3) then

end function

numrects -= c-','

cdCanvasClear(cddbuffer)

procedure main()

IupUpdate(canvas)

IupOpen()

end if

return IUP_CONTINUE

canvas = IupCanvas(NULL)

end function

IupSetAttribute(canvas, "RASTERSIZE", "602x502") -- initial size

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

procedure main()

IupOpen()

dlg = IupDialog(canvas)

canvas = IupCanvas("RASTERSIZE=602x502")

IupSetAttribute(dlg, "TITLE", "Vibrating Rectangles")

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

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

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

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

dlg = IupDialog(canvas,`TITLE="Vibrating Rectangles"`)

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

IupMap(dlg)

IupShow(dlg)

IupSetAttribute(canvas, "RASTERSIZE", NULL) -- release the minimum limitation

IupSetAttribute(canvas, "RASTERSIZE", NULL) -- release the minimum limitation

IupShowXY(dlg,IUP_CENTER,IUP_CENTER)

Ihandle timer = IupTimer(Icallback("timer_cb"), 40)

Ihandle timer = IupTimer(Icallback("timer_cb"), 40)

if platform()!=JS then

IupMainLoop()

IupMainLoop()

IupClose()

IupClose()

end procedure

end if

main()</lang>

end procedure

main()

=={{header|Python}}==