RosettaCodeData/Task/Greyscale-bars-Display/Phix/greyscale-bars-display.phix
2017-09-25 22:28:19 +02:00

70 lines
1.8 KiB
Text

--
-- demo\rosetta\Greyscale_bars.exw
--
include pGUI.e
Ihandle dlg, canvas
cdCanvas cddbuffer, cdcanvas
function redraw_cb(Ihandle /*ih*/, integer /*posx*/, integer /*posy*/)
cdCanvasActivate(cddbuffer)
integer {width, height} = IupGetIntInt(canvas, "DRAWSIZE")
integer h = ceil(height/4)
for row=1 to 4 do
integer x = 0, p2 = power(2,row+2), c = floor(255/(p2-1))
for n=0 to p2-1 do
integer colour = c*n*#010101
if and_bits(row,1)=0 then colour = xor_bits(colour,#FFFFFF) end if
cdCanvasSetForeground(cddbuffer, colour)
integer nx = ceil(width*(n+1)/p2)
cdCanvasBox(cddbuffer, x, nx, height-h, height)
x = nx
end for
height -= h
end for
cdCanvasFlush(cddbuffer)
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 esc_close(Ihandle /*ih*/, atom c)
if c=K_ESC then return IUP_CLOSE end if
return IUP_CONTINUE
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", "Greyscale bars")
IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))
IupSetCallback(dlg, "K_ANY", Icallback("esc_close"))
IupMap(dlg)
IupSetAttribute(canvas, "RASTERSIZE", NULL)
IupShowXY(dlg,IUP_CENTER,IUP_CENTER)
IupMainLoop()
IupClose()
end procedure
main()