Raster bars: Difference between revisions
→{{header|Phix}}
(Ada version) |
|||
Line 346:
Screenshot still of typical run: [https://github.com/thundergnat/rc/blob/master/img/Raster-bars-Perl6.png (offsite .png image)]
=={{header|Phix}}==
Some grey bars that vaguely shimmer as they march up the screen... (did not turn out quite as well as hoped)
<lang Phix>-- demo\rosetta\Raster_bars.exw
constant N = 10,
nColours = floor(255/N)
integer offset = 0, clast = nColours
include pGUI.e
Ihandle dlg, canvas
cdCanvas cddbuffer, cdcanvas
function colour(integer i)
integer g = i*N
return cdEncodeColorAlpha(g, g, g, 255)
end function
function redraw_cb(Ihandle /*ih*/, integer /*posx*/, integer /*posy*/)
cdCanvasActivate(cddbuffer)
cdCanvasSetBackground(cddbuffer, colour(clast))
cdCanvasClear(cddbuffer)
integer {width, height} = IupGetIntInt(canvas, "DRAWSIZE"),
h = floor(height/(nColours-1)),
y = height+offset
cdCanvasSetInteriorStyle(cddbuffer, CD_SOLID)
for i=2 to nColours do
integer c = clast+i-1
if c>nColours then c -= nColours end if
cdCanvasSetForeground(cddbuffer, colour(c))
cdCanvasBox(cddbuffer, 0, width, y-h, y)
y -= h
end for
cdCanvasFlush(cddbuffer)
offset += 1
if offset>=h then
offset = 0
clast += 1
if clast>nColours then clast = 1 end if
end if
return IUP_DEFAULT
end function
function map_cb(Ihandle ih)
cdcanvas = cdCreateCanvas(CD_IUP, ih)
cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)
return IUP_DEFAULT
end function
function unmap_cb(Ihandle /*ih*/)
cdKillCanvas(cddbuffer)
cdKillCanvas(cdcanvas)
return IUP_DEFAULT
end function
function timer_cb(Ihandle /*ih*/)
IupRedraw(dlg)
return IUP_DEFAULT
end function
procedure main()
IupOpen()
canvas = IupCanvas(NULL)
IupSetAttribute(canvas, "RASTERSIZE", "600x400")
IupSetCallback(canvas, "MAP_CB", Icallback("map_cb"))
IupSetCallback(canvas, "UNMAP_CB", Icallback("unmap_cb"))
dlg = IupDialog(canvas)
IupSetAttribute(dlg, "TITLE", "Raster bars")
IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))
IupCloseOnEscape(dlg)
Ihandle hTimer = IupTimer(Icallback("timer_cb"), 10)
IupMap(dlg)
IupSetAttribute(canvas, "RASTERSIZE", NULL)
IupShowXY(dlg,IUP_CENTER,IUP_CENTER)
IupMainLoop()
IupClose()
end procedure
main()</lang>
| |||