% Prolog befunge interpreter V2

% Use loadprog(file) to load a program
% Assumes LF for newlines
%
% Use runprog(0) to run the program, runprog(1) to run with trace.
%
% Use showprog to display fungespace
%
% When entering an integer it must end in a full stop
%
% There may be a couple of backtracking issues causing funny behaviour

% p([x,y],[xd,yd],stack,smode)
% instr(p,code,p1)
% ^v><0123456789"#|_`$:gp+-*/%\@!&~,.?

% ASCII codes:
% 32=  33=! 34=" 35=# 36=$ 37=% 38=& 39=' 40=( 41=) 42=* 43=+ 44=, 45=- 46=.
% 47=/ 48=0 49=1 50=2 51=3 52=4 53=5 54=6 55=7 56=8 57=9 58=: 59=; 60=< 61==
% 62=> 63=? 64=@ 65=A 66=B 67=C 68=D 69=E 70=F 71=G 72=H 73=I 74=J 75=K 76=L
% 77=M 78=N 79=O 80=P 81=Q 82=R 83=S 84=T 85=U 86=V 87=W 88=X 89=Y 90=Z 91=[
% 92=\ 93=] 94=^ 95=_ 96=` 97=a 98=b 99=c 100=d 101=e 102=f 103=g 104=h 105=i
% 106=j 107=k 108=l 109=m 110=n 111=o 112=p 113=q 114=r 115=s 116=t 117=u 118=v
% 119=w 120=x 121=y 122=z 123={ 124=| 125=} 126=~

%%%%%%%%%%%% Instructions

% ^v<>
instr(p(P,_,T,0),94,p(P,[0,-1],T,0)).	% up
instr(p(P,_,T,0),118,p(P,[0,1],T,0)).	% down
instr(p(P,_,T,0),60,p(P,[-1,0],T,0)).	% left
instr(p(P,_,T,0),62,p(P,[1,0],T,0)).	% right

% 0-9
instr(p(P,D,T,0),X,p(P,D,[X1|T],0)) :-
	X >= 48,
	X =< 57,
	X1 is X-48.

% "
instr(p(P,D,T,M),34,p(P,D,T,M1)) :-		% Toggle
	M1 is 1-M.
instr(p(P,D,T,1),X,p(P,D,[X|T],1)) :-
	X =\= 34.

% #
instr(p([X,Y],[XD,YD],T,0),35,p([X1,Y1],[XD,YD],T,0)) :-
	X1 is (X+XD+80) mod 80,
	Y1 is (Y+YD+25) mod 25.

% |
instr(p(P,_,[X|T],0),124,p(P,[0,-1],T,0)) :-
	X =\= 0.
instr(p(P,_,[0|T],0),124,p(P,[0,1],T,0)).
instr(p(P,_,[],0),124,p(P,[0,1],[],0)).

% _
instr(p(P,_,[X|T],0),95,p(P,[-1,0],T,0)) :-
	X =\= 0.
instr(p(P,_,[0|T],0),95,p(P,[1,0],T,0)).
instr(p(P,_,[],0),95,p(P,[1,0],[],0)).

% `
instr(p(P,D,[Y,X|T],0),96,p(P,D,[1|T],0)) :-
	X > Y.
instr(p(P,D,[Y,X|T],0),96,p(P,D,[0|T],0)) :-
	X =< Y.
instr(p(P,D,[_],0),96,p(P,D,[],0)).

% $
instr(p(P,D,[_|T],0),36,p(P,D,T,0)).

% :
instr(p(P,D,[X|T],0),58,p(P,D,[X,X|T],0)).

% g
instr(p(P,D,[Y,X|T],0),103,p(P,D,[Z|T],0)) :-
	getcell([X,Y],Z).
instr(p(P,D,[Y],0),103,p(P,D,[Z],0)) :-
	getcell([0,Y],Z).
instr(p(P,D,[],0),103,p(P,D,[Z],0)) :-
	getcell([0,0],Z).

% p
instr(p(P,D,[Y,X,Z|T],0),112,p(P,D,T,0)) :-
	Z1 is Z /\ 255,
	setcell([X,Y],Z1).
instr(p(P,D,[Y,X],0),112,p(P,D,[],0)) :-
	setcell([X,Y],0).
instr(p(P,D,[Y],0),112,p(P,D,[],0)) :-
	setcell([0,Y],0).
instr(p(P,D,[],0),112,p(P,D,[],0)) :-
	setcell([0,0],0).

% +
instr(p(P,D,[Y,X|T],0),43,p(P,D,[Z|T],0)) :-
	Z is X+Y.

% -
instr(p(P,D,[Y,X|T],0),45,p(P,D,[Z|T],0)) :-
	Z is X-Y.
instr(p(P,D,[Y],0),45,p(P,D,[Z],0)) :-
	Z is -Y.

% *
instr(p(P,D,[Y,X|T],0),42,p(P,D,[Z|T],0)) :-
	Z is X*Y.
instr(p(P,D,[_],0),42,p(P,D,[],0)).

% /
instr(p(P,D,[Y,X|T],0),47,p(P,D,[Z|T],0)) :-
	Z is X//Y.
instr(p(P,D,[_],0),47,p(P,D,[],0)).

% %
instr(p(P,D,[Y,X|T],0),37,p(P,D,[Z|T],0)) :-
	Z is X mod Y.
instr(p(P,D,[_],0),37,p(P,D,[],0)).

% \
instr(p(P,D,[Y,X|T],0),92,p(P,D,[X,Y|T],0)).
instr(p(P,D,[Y],0),92,p(P,D,[0,Y],0)).

% @ - not needed?
instr(p(P,D,T,0),64,p(P,D,T,0)).

% !
instr(p(P,D,[X|T],0),33,p(P,D,[0|T],0)) :-
	X =\= 0.
instr(p(P,D,[0|T],0),33,p(P,D,[1|T],0)).
instr(p(P,D,[],0),33,p(P,D,[1],0)).

% &
instr(p(P,D,T,0),38,p(P,D,[X|T],0)) :-
	write('Enter an integer: '),
	read(X).

% ~
instr(p(P,D,T,0),126,p(P,D,[X|T],0)) :-
	write('Enter a character: '),
	get(X).

% ,
instr(p(P,D,[10|T],0),44,p(P,D,T,0)) :-
	nl.
instr(p(P,D,[X|T],0),44,p(P,D,T,0)) :-
	X =\= 10,
	put(X).

% .
instr(p(P,D,[X|T],0),46,p(P,D,T,0)) :-
	write(X),
	put(32).

% ?
instr(p(P,_,T,0),63,p(P,D,T,0)) :-
	random(X),
	random(Y),
	Z is (2*X)+Y,
	direction(D,Z).

direction([0,1],0).
direction([0,-1],1).
direction([1,0],2).
direction([-1,0],3).

% catch-all for empty stack cond, unknown instr, etc.
instr(X,_,X).

%%%%%%%%%%%% random bit generator, uses 28 bit seed as opposed to full 32bit one

seed(0).

magic(226962241). % AKA 0xD872B41

cutoff(268435456). % AKA 0x10000000

random(_) :-
	seed(0), % No seed?
	gettime(X),
	retract(seed(0)),
	assert(seed(X)),
	fail. % Go on to pick number

random(X) :-
	seed(S),
	magic(M),
	cutoff(C),
	S1 is S*2,
	X is S1 // C, % random bit returned is the top bit
	S2 is S1 mod C, % Remove top bit
	M1 is M * X, % Do we need to exclusive-or?
	eor(S3,S2,M1), % S3 = S2 eor M1
	retract(seed(S)), % Change seed to new value
	assert(seed(S3)),
	!.

gettime(X) :-
	cputime(X)
	;
	magic(X). % For folks without cputime

eor(X,A,B) :- % exclusive-or is (A or B) - (A and B)
	X is (A \/ B) - (A /\ B).

%%%%%%%%%%%%% run program

runprog(TR) :-
	maybe_abolish(curstate,1),
	assert(curstate(p([0,0],[1,0],[],0))),
	dorun(TR).

printtrace(0,_,_) :-
	!.

printtrace(1,p(P,D,_,M),C) :-
	write('IP at '),
	write(P),
	write(' dir '),
	write(D),
	write(' strmode '),
	write(M),
	write(' execing '),
	put(C),
	nl,
	!.

dorun(TR) :-
	repeat,
	curstate(p(P,D,T,M)),
	nonvar(P),nonvar(D),nonvar(T),nonvar(M),
	getcell(P,C),
	printtrace(TR,p(P,D,T,M),C),
	(
		C = 64, !
		;
		instr(p(P,D,T,M),C,p([X,Y],[XD,YD],T1,M1)),
		X1 is (X+XD+80) mod 80,
		Y1 is (Y+YD+25) mod 25,
		retract(curstate(p(P,D,T,M))),	% Will get stuck if newstate == oldstate, but that shouldn't happen anyway
		assert(curstate(p([X1,Y1],[XD,YD],T1,M1))),
		fail
	).

%%%%%%%%%%%% fungespace read/write

getcell([X,Y],S) :-
	cell(X,Y,S),
	!.

getcell(_,32).

setcell([X,Y],_) :-		% Fix OOB writes
	X<0;X>79;Y<0;Y>24.

setcell([X,Y],S) :-
	maybe_retract(cell(X,Y,_)),	% Remove old cell
	assert(cell(X,Y,S)),	% Set new one
	!.

maybe_retract(X) :-
	retract(X).

maybe_retract(_).

%%%%%%%%%%%%%% program load code

maybe_abolish(X,Y) :- % For picky interpreters which complain a lot
	abolish(X,Y).

maybe_abolish(_,_).

loadprog(F) :-
	maybe_abolish(cell,3),	% Clear fungespace
	see(F),
	get0(C),
	!,
	loadprog([0,0],C),
	seen.

loadprog(_,X) :-	% EOF
	X is -1,
	write('eof'),
	nl.

loadprog([_,Y],10) :-	% Newline
	get0(C),
	!,
	write('newline'),
	nl,
	Y1 is Y+1,
	loadprog([0,Y1],C).

loadprog([X,Y],C) :-	% Any other char
	C >= 0,
	setcell([X,Y],C),
	get0(C1),
	!,
	X1 is X+1,
	loadprog([X1,Y],C1).

%%%%%%%%%%%%% program output code

showprog :- % Write program out...
	showprog(0,0).

showprog(80,24).

showprog(80,Y) :-
	nl,
	Y1 is Y+1,
	showprog(0,Y1).

showprog(X,Y) :-
	getcell([X,Y],C),
	showprog(C),
	X1 is X+1,
	showprog(X1,Y).

showprog(C) :-
	C>31,
	C=\=127,
	C<256,
	put(C).

showprog(_) :-
	put(32).

%%%%%%%%%%%%%% simple program pre-loaded

cell(0,0,34).	% "egnufeB">:#,_@
cell(1,0,101).
cell(2,0,103).
cell(3,0,110).
cell(4,0,117).
cell(5,0,102).
cell(6,0,101).
cell(7,0,66).
cell(8,0,34).
cell(9,0,62).
cell(10,0,58).
cell(11,0,35).
cell(12,0,44).
cell(13,0,95).
cell(14,0,64).