The task is to create 1 pixel wide coloured vertical pinstripes with a sufficient number of pinstripes to span the entire width of the graphics display.



The pinstripes should either follow the system palette sequence,   or a sequence that includes:

black,   red,   green,   blue,   magenta,   cyan,   yellow,   and   white:

   after filling the top quarter, switch to a wider 2 pixel wide vertical pinstripe pattern,
   halfway down the display, switch to 3 pixel wide vertical pinstripe,
   finally to a 4 pixels wide vertical pinstripe for the last quarter of the display.


See also

   display black and white 
   print colour


--
-- demo\rosetta\Colour_pinstripe.exw
-- =================================
--
with javascript_semantics -- but not yet CD_PRINTER
include pGUI.e

constant colours = {CD_BLACK, CD_RED, CD_GREEN, CD_MAGENTA, CD_CYAN, CD_YELLOW, CD_WHITE}
--constant colours = {CD_BLACK, CD_WHITE}

procedure draw_to(cdCanvas cdcanvas)
    cdCanvasActivate(cdcanvas)
    integer {width, height} = cdCanvasGetSize(cdcanvas) 
    for y=1 to 4 do
        integer x = 0, c = 1, h = floor(height/(5-y))
        while x<width do
            cdCanvasSetForeground(cdcanvas, colours[c])
            cdCanvasBox(cdcanvas, x, x+y, height-h, height)
            x += y
            c = iff(c=length(colours)?1:c+1)
        end while
        height -= h
    end for
    cdCanvasFlush(cdcanvas)
end procedure

Ihandle dlg, canvas
cdCanvas cddbuffer, cdcanvas

function redraw_cb(Ihandle /*ih*/)
    draw_to(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 print_cb(Ihandle /*ih*/)
    if platform()!=JS then
        cdCanvan print_canvas = cdCreateCanvas(CD_PRINTER, "pinstripe -d") 
        if print_canvas!=NULL then 
            draw_to(print_canvas)
            cdKillCanvas(print_canvas) 
        end if 
    end if 
    return IUP_DEFAULT
end function

function exit_cb(Ihandle /*ih*/)
    return IUP_CLOSE
end function

procedure main()
    IupOpen()

    Ihandle file_menu = IupMenu({IupMenuItem("&Print",Icallback("print_cb")),
                                 IupMenuItem("E&xit", Icallback("exit_cb"))})

    Ihandle main_menu = IupMenu({IupSubmenu("File", file_menu)})

    canvas = IupCanvas(NULL)
    IupSetAttribute(canvas, "RASTERSIZE", "600x400") -- initial size

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

    dlg = IupDialog(canvas)
    IupSetAttribute(dlg, "TITLE", "Colour pinstripe")
    IupSetAttributeHandle(dlg,"MENU",main_menu)
    IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))
    IupShowXY(dlg,IUP_CENTER,IUP_CENTER)
    IupSetAttribute(canvas, "RASTERSIZE", NULL) -- release the minimum limitation
    if platform()!=JS then
        IupMainLoop()
        IupClose()
    end if
end procedure

main()
