RosettaCodeData/Task/Wireworld/Phix/wireworld.phix

--
-- demo\rosetta\Wireworld.exw
-- ==========================
--
--  Invoke with file to read or let it read the one below (if compiled assumes source is in the same directory)
--
--  Note that tabs in description files are not supported - where necessary spaces can be replaced with _ chars.
--  (tab chars in text files should technically always represent (to-next) 8 spaces, but not many editors respect
--   that, and instead assume the file will only ever be read by the same program/with matching settings. </rant>)
--  (see also demo\edix\src\tabs.e\ExpandTabs() for what you'd need if you knew what tab chars really meant.)
--
/* -- default description:
tH.........
.___.
___...
.___.
Ht.. ......
*/
sequence lines, counts
integer longest

function valid_line(string line, integer l=0)
    if length(line)=0 then return 0 end if
    for i=1 to length(line) do
        integer ch = line[i]
        if not find(ch," _.tH") then
            if l and ch='\t' then
                -- as above
                printf(1,"error: tab char on line %d\n",{l})
                {} = wait_key()
                abort(0)
            end if
            return 0
        end if
    end for
    return 1
end function

procedure load_desc()
    string filename = substitute(command_line()[$],".exe",".exw")
    integer fn = open(filename,"r")
    if fn=-1 then
        printf(1,"error opening %s\n",{filename})
        {} = wait_key()
        abort(0)
    end if
    sequence text = get_text(fn,GT_LF_STRIPPED)
    close(fn)
    lines = {}
    for i=1 to length(text) do
        string line = text[i]
        if valid_line(line) then
            lines = {line}
            longest = length(line)
            for j=i+1 to length(text) do
                line = text[j]
                if not valid_line(line,j) then exit end if
                lines = append(lines,line)
                if longest<length(line) then
                    longest = length(line)
                end if
            end for
            exit
        end if
    end for
    counts = lines
end procedure

constant dxy = {{-1,-1}, {-1,+0}, {-1,+1},
                {+0,-1},          {+0,+1},
                {+1,-1}, {+1,+0}, {+1,+1}}

procedure set_counts()
    for y=1 to length(lines) do
        for x=1 to length(lines[y]) do
            if lines[y][x]='.' then
                integer count = 0
                for k=1 to length(dxy) do
                    integer {cx,cy} = sq_add({x,y},dxy[k])
                    if cy>=1 and cy<=length(lines)
                    and cx>=1 and cx<=length(lines[cy])
                    and lines[cy][cx]='H' then
                        count += 1
                    end if
                end for
                counts[y][x] = (count=1 or count=2)
            end if
        end for
    end for
end procedure

include pGUI.e

Ihandle dlg, canvas, timer
cdCanvas cddbuffer, cdcanvas

function redraw_cb(Ihandle /*ih*/, integer /*posx*/, integer /*posy*/)
    integer {w, h} = IupGetIntInt(canvas, "DRAWSIZE")
    integer dx = floor(w/(longest+2))
    integer dy = floor(h/(length(lines)+2))
    cdCanvasActivate(cddbuffer)
    cdCanvasClear(cddbuffer)
    set_counts()
    for y=1 to length(lines) do
        for x=1 to length(lines[y]) do
            integer c = lines[y][x], colour
            if find(c," _") then
                colour = CD_BLACK
            elsif c='.' then
                colour = CD_YELLOW
                if counts[y][x] then
                    lines[y][x] = 'H'
                end if
            elsif c='H' then
                colour = CD_BLUE
                lines[y][x] = 't'
            elsif c='t' then
                colour = CD_RED
                lines[y][x] = '.'
            end if
            cdCanvasSetForeground(cddbuffer, colour)
            cdCanvasBox(cddbuffer,x*dx,x*dx+dx,h-y*dy,h-(y*dy+dy))
        end for
    end for
    cdCanvasFlush(cddbuffer)
    return IUP_DEFAULT
end function

function timer_cb(Ihandle /*ih*/)
    IupUpdate(canvas)
    return IUP_IGNORE
end function

function map_cb(Ihandle ih)
    cdcanvas = cdCreateCanvas(CD_IUP, ih)
    cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)
    cdCanvasSetBackground(cddbuffer, CD_BLACK)
    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()
    load_desc()
    IupOpen()

    canvas = IupCanvas(NULL)
    IupSetAttribute(canvas, "RASTERSIZE", "300x180")
    IupSetCallback(canvas, "MAP_CB", Icallback("map_cb"))
    IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))

    timer = IupTimer(Icallback("timer_cb"), 500)

    dlg = IupDialog(canvas)
    IupSetAttribute(dlg, "TITLE", "Wireworld")
    IupSetCallback(dlg, "K_ANY", Icallback("esc_close"))

    IupShow(dlg)
    IupSetAttribute(canvas, "RASTERSIZE", NULL)
    IupMainLoop()
    IupClose()
end procedure

main()