Wireworld: Difference between revisions
→{{header|Phix}}
(added lua implementation) |
|||
Line 3,455:
.H.. ......
</pre>
=={{header|Phix}}==
<lang 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()[2],".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\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(join_path({"..","pGUI"},1))
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()</lang>
=={{header|PHP}}==
| |||