Rugxulo
2010-05-28 05:41:41 UTC
{$standard-pascal}
{$transparent-file-names}
{$case-value-checking}
{ ====================================================================
Wednesday, May 26, 2010
Befunge-93 in standard-ish Pascal -- public domain, nenies proprajxo
(GPC 20070904 via DJGPP + GCC 3.4.4)
rugxulo _AT_ gmail _DOT_ com
!! Christus Rex !!
BUGS:
= most of the examples that I tested work fine (except NEGMOD.BEF)
= random via '?' is still not implemented (how???) :-/
LINKS:
= http://catseye.tc/projects/bef.html
= http://www.esolangs.org/wiki/Befunge
= http://board.flatassembler.net/topic.php?t=10810
= #esoteric on irc.freenode.net
HISTORY:
= v1.0 : initial (pre)release
==================================================================== }
program Befunge93(input,output,example);
label 9999;
const xmax = 80; ymax = 25; stackmax=1000;
type int = integer; {longint}
var
example: text;
x, y, i, j, k, l, m, numlines, a, b, c, sp, xdelta, ydelta: int;
stack: packed array [1..stackmax] of int;
bspace: packed array [1..xmax, 1..ymax] of char;
ch, chartemp: char;
strmode: boolean;
procedure incr(var k: int); begin k := succ(k) end;
procedure decr(var l: int); begin l := pred(l) end;
procedure push(m: int); begin stack[sp] := m;
if sp > 1 then decr(sp); end;
procedure pop(var m: int); begin
if sp < stackmax then begin incr(sp); m := stack[sp]; end
else m := 0; end;
{procedure unimplemented(r: array of char);
begin writeln(r,': *** not implemented yet ***'); end;}
begin {Befunge93}
for i := 1 to stackmax do stack[i] := 0;
for j := 1 to ymax do for i := 1 to xmax do bspace[i,j] := ' ';
i := 0; j := 1; numlines := 0; sp := stackmax;
{assign(example,'example');}
reset(example);
while not eof(example) do
begin
incr(i);
if eoln(example) then
begin
read(example,chartemp); i := 0; incr(numlines); incr(j);
end
else read(example,bspace[i,j]);
end;
{for j := 1 to ymax do for i := 1 to xmax do
if i < xmax then write(bspace[i,j]) else writeln;}
x := -1; y := 0; xdelta := 1; ydelta := 0; strmode := false;
while true do begin {main loop}
x := x + xdelta; y := y + ydelta;
if x > 79 then x := 0; if y > 24 then y := 0;
if x < 0 then x := 79; if y < 0 then y := 24;
ch := bspace[x+1,y+1];
{ *************************************************** }
{if paramstr(1) = '-d' then begin
write(' x,y = ',x:2,',',y:2);
if ch <> '"' then write(' ch = "',ch,'"')
else write(' ch = ''',ch,'''');
for i := 1 to 5 do if sp+i < stackmax then write(' ',stack[sp+i]);
if strmode then writeln(' """"') else writeln; end;}
{ *************************************************** }
{for i := sp downto 1 do stack[i] := 0;}
if strmode then if ch <> '"' then push(ord(ch));
if ch = '"' then strmode := not strmode;
{writeln(' ch = ''',ch,'''');}
if not strmode then
if ch in ['0'..'9'] then push(ord(ch)-ord('0')) else
if ch in ['+','-','*','/','%','!','`','^','v','<','>','|','_','?','#',
',','.','~','&','$',':','\','g','p','"','@',' '] then
case ch of
' ': a := 0; {nop}
'"': a := 0; {already taken care of strmode}
{'0'..'9': push(ord(ch)-ord('0'));}
'.': begin pop(a); write(a:1,' '); end;
',': begin pop(a); if a=10 then writeln else write(chr(a)); end;
'v': begin xdelta := 0; ydelta := 1; end;
'^': begin xdelta := 0; ydelta := -1; end;
'<': begin xdelta := -1; ydelta := 0; end;
'>': begin xdelta := 1; ydelta := 0; end;
'#': begin {writeln('xd=',xdelta:1,'yd=',ydelta:1);}
case ydelta of -1: decr(y); 1: incr(y); 0: a := 0; end;
case xdelta of -1: decr(x); 1: incr(x); 0: a := 0; end; end;
'_': begin pop(a); ydelta := 0; if a <> 0 then xdelta := -1
else xdelta := 1; end;
'|': begin pop(a); xdelta := 0; if a <> 0 then ydelta := -1
else ydelta := 1; end;
'`': begin pop(b); pop(a); if a > b then push(1) else push(0); end;
'!': begin pop(a); if a = 0 then push(1) else push(0); end;
'\': begin pop(a); pop(b); push(a); push(b); end;
':': begin pop(a); push(a); push(a); end;
'$': pop(a);
'+': begin pop(b); pop(a); push(a + b); end;
'-': begin pop(b); pop(a); push(a - b); end;
'*': begin pop(b); pop(a); push(a * b); end;
'/': begin pop(b); pop(a); push(a div b); end;
'%': begin pop(b); pop(a); push(a mod b); end;
'~': begin read(input,chartemp); push(ord(chartemp)); end;
'&': begin read(input,a); push(a); end;
'g': begin pop(b); pop(a); c := ord(bspace[a+1,b+1]); push(c); end;
'p': begin pop(b); pop(a); pop(c); bspace[a+1,b+1] := chr(c); end;
'?': a := 0; {unimplemented('rand');}
'@': goto 9999; {exit;}
{otherwise write('ch = ',ch);}
end {case ch}
else a := 0; {write('*** unknown ch = ''',ch,''' ***');}
end; {while true do}
9999: a := 0;
end. {Befunge93}
{$transparent-file-names}
{$case-value-checking}
{ ====================================================================
Wednesday, May 26, 2010
Befunge-93 in standard-ish Pascal -- public domain, nenies proprajxo
(GPC 20070904 via DJGPP + GCC 3.4.4)
rugxulo _AT_ gmail _DOT_ com
!! Christus Rex !!
BUGS:
= most of the examples that I tested work fine (except NEGMOD.BEF)
= random via '?' is still not implemented (how???) :-/
LINKS:
= http://catseye.tc/projects/bef.html
= http://www.esolangs.org/wiki/Befunge
= http://board.flatassembler.net/topic.php?t=10810
= #esoteric on irc.freenode.net
HISTORY:
= v1.0 : initial (pre)release
==================================================================== }
program Befunge93(input,output,example);
label 9999;
const xmax = 80; ymax = 25; stackmax=1000;
type int = integer; {longint}
var
example: text;
x, y, i, j, k, l, m, numlines, a, b, c, sp, xdelta, ydelta: int;
stack: packed array [1..stackmax] of int;
bspace: packed array [1..xmax, 1..ymax] of char;
ch, chartemp: char;
strmode: boolean;
procedure incr(var k: int); begin k := succ(k) end;
procedure decr(var l: int); begin l := pred(l) end;
procedure push(m: int); begin stack[sp] := m;
if sp > 1 then decr(sp); end;
procedure pop(var m: int); begin
if sp < stackmax then begin incr(sp); m := stack[sp]; end
else m := 0; end;
{procedure unimplemented(r: array of char);
begin writeln(r,': *** not implemented yet ***'); end;}
begin {Befunge93}
for i := 1 to stackmax do stack[i] := 0;
for j := 1 to ymax do for i := 1 to xmax do bspace[i,j] := ' ';
i := 0; j := 1; numlines := 0; sp := stackmax;
{assign(example,'example');}
reset(example);
while not eof(example) do
begin
incr(i);
if eoln(example) then
begin
read(example,chartemp); i := 0; incr(numlines); incr(j);
end
else read(example,bspace[i,j]);
end;
{for j := 1 to ymax do for i := 1 to xmax do
if i < xmax then write(bspace[i,j]) else writeln;}
x := -1; y := 0; xdelta := 1; ydelta := 0; strmode := false;
while true do begin {main loop}
x := x + xdelta; y := y + ydelta;
if x > 79 then x := 0; if y > 24 then y := 0;
if x < 0 then x := 79; if y < 0 then y := 24;
ch := bspace[x+1,y+1];
{ *************************************************** }
{if paramstr(1) = '-d' then begin
write(' x,y = ',x:2,',',y:2);
if ch <> '"' then write(' ch = "',ch,'"')
else write(' ch = ''',ch,'''');
for i := 1 to 5 do if sp+i < stackmax then write(' ',stack[sp+i]);
if strmode then writeln(' """"') else writeln; end;}
{ *************************************************** }
{for i := sp downto 1 do stack[i] := 0;}
if strmode then if ch <> '"' then push(ord(ch));
if ch = '"' then strmode := not strmode;
{writeln(' ch = ''',ch,'''');}
if not strmode then
if ch in ['0'..'9'] then push(ord(ch)-ord('0')) else
if ch in ['+','-','*','/','%','!','`','^','v','<','>','|','_','?','#',
',','.','~','&','$',':','\','g','p','"','@',' '] then
case ch of
' ': a := 0; {nop}
'"': a := 0; {already taken care of strmode}
{'0'..'9': push(ord(ch)-ord('0'));}
'.': begin pop(a); write(a:1,' '); end;
',': begin pop(a); if a=10 then writeln else write(chr(a)); end;
'v': begin xdelta := 0; ydelta := 1; end;
'^': begin xdelta := 0; ydelta := -1; end;
'<': begin xdelta := -1; ydelta := 0; end;
'>': begin xdelta := 1; ydelta := 0; end;
'#': begin {writeln('xd=',xdelta:1,'yd=',ydelta:1);}
case ydelta of -1: decr(y); 1: incr(y); 0: a := 0; end;
case xdelta of -1: decr(x); 1: incr(x); 0: a := 0; end; end;
'_': begin pop(a); ydelta := 0; if a <> 0 then xdelta := -1
else xdelta := 1; end;
'|': begin pop(a); xdelta := 0; if a <> 0 then ydelta := -1
else ydelta := 1; end;
'`': begin pop(b); pop(a); if a > b then push(1) else push(0); end;
'!': begin pop(a); if a = 0 then push(1) else push(0); end;
'\': begin pop(a); pop(b); push(a); push(b); end;
':': begin pop(a); push(a); push(a); end;
'$': pop(a);
'+': begin pop(b); pop(a); push(a + b); end;
'-': begin pop(b); pop(a); push(a - b); end;
'*': begin pop(b); pop(a); push(a * b); end;
'/': begin pop(b); pop(a); push(a div b); end;
'%': begin pop(b); pop(a); push(a mod b); end;
'~': begin read(input,chartemp); push(ord(chartemp)); end;
'&': begin read(input,a); push(a); end;
'g': begin pop(b); pop(a); c := ord(bspace[a+1,b+1]); push(c); end;
'p': begin pop(b); pop(a); pop(c); bspace[a+1,b+1] := chr(c); end;
'?': a := 0; {unimplemented('rand');}
'@': goto 9999; {exit;}
{otherwise write('ch = ',ch);}
end {case ch}
else a := 0; {write('*** unknown ch = ''',ch,''' ***');}
end; {while true do}
9999: a := 0;
end. {Befunge93}