unit udemo;

interface
  procedure trait_phrase;
  procedure repondre;

implementation
uses umain,uini,userv,usp,ulist,uunif,
  uio,udiv,ufait,ulhm,usys,uovl;

(* procedure tgetpic(i:integer);
type	buf	= packed array[1..20000] of char;
var	nom_fichier : tstring;
	pic	: file of buf;
	buffer	: ^buf;
begin
lire_symbole(fils1_code);
nom_fichier:=symbole_lu + '.pic';
assign(pic,nom_fichier);
if i=0
then	(*$i-* ) rewrite(pic)	(*$i+* )
else	(*$i-* ) reset(pic); (*$i+* )
if ioresult = 0
then	begin
	new(buffer);
	if i=0
	then	begin
		getpic(buffer^,1,1,320,200);
		write(pic,buffer^);
		end
	else	begin
		read(pic,buffer^);
		putpic(buffer^,1,200);
		end;
	dispose(buffer);
	close(pic);
	end
else	backtrack := true;
end;    *)

procedure tmark;
begin
if noeud^[fait1].niveau > 0
then	begin
	if nmark = max_mark
	then	writeln(output,'trop de variables marquees')
	else	begin
		nmark := nmark + 1;
		mark[nmark] := noeud^[fait1].niveau;
		nommark[nmark] := noeud^[fait1].code;
		arbre_mark[nmark] := narbre;
		end;
	end;
end;

procedure tffor;
begin
indarb := narbre - 1;
imbric := 1;
while indarb > 0 do
	begin
	with table_arbre^[indarb] do
		begin
		if noeud^[demo].code = p_for
		then	imbric := imbric - 1;
		if noeud^[demo].code = p_ffor
		then	imbric := imbric + 1;
		if imbric = 0
		then	begin
			fait1 := noeud^[table_arbre^[indarb]
					.demo].fils;
			fils1 := noeud^[getval(fait1)].code;
			fils1 := table_symbole^[fils1].vale;
			if info > noeud^[fils1].value
			then	begin
				noeud^[fils1].value :=
					noeud^[fils1].value+1;
				narbre := indarb;
				(* nnoeud := table_arbre^[narbre].snoeud;
				nenv := table_arbre^[narbre].senv; *)
				numero := 0;
				end
			else	numero :=  - 1;
			indarb := 0;
			end
		else	begin
			numero := -1;
			indarb := indarb - 1;
			end;
		end;
	end;
end;

procedure tsucceed;
begin
(* nomblock := fils1_code;
while fils1 > 0 do
	begin
	with noeud^[fils1] do
		begin
		if code = nomblock
		then	begin
			fils1 := 0;
			end
		else	fils1 := frere;
		end;
	end;
*)
end;

procedure tif;
begin
	(* if(condition),action,else,action,end *)
	(* if , conditions , then , action , else , action , end *)
with table_arbre^[narbre] do
	begin
	case info of
		0	: begin	(* 1er passage *)
			(* on empile la condition du not *)
			snum := 0;
			info := 1;
			if fils1 <> 0
			then	begin
				noeud^[fils1].frere := -narbre;
				brother := fils1;
				end;
			backtrack := false;
			end;
		1	: begin
			(* 2eme passage par retour arriere *)
			(* la condition du not est fausse *)
			snum := -1;
			backtrack := false;
			imbric := 1;
			fils1 := noeud^[objet].frere;
			while fils1 > 0 do
				begin
				with noeud^[fils1] do
					begin
					if code = p_end
					then	imbric := imbric - 1;
					if (code = p_else) and (imbric = 1)
					then	imbric := imbric - 1;
					if imbric = 0
					then	begin
						brother := frere;
						fils1 := 0;
						end
					else	fils1 := frere;
					end;
				end;
			end;
		2	: begin
			(* 2eme passage si condition vraie *)
			(* la condition du if est vraie *)
			snum := -1;
			backtrack := false;
			brother := noeud^[objet].frere;
			end;
		else
		end;
	end;
end;

procedure tuntil;
begin
with table_arbre^[narbre] do
	begin
	case info of
		0	: begin	(* 1er passage *)
			(* on empile la condition du until *)
			info := 1;
			snum := 0;
			if fils2 = 0
			then	begin
				noeud^[fils1].frere := -narbre;
				brother := fils1;
				end
			else	begin
				noeud^[fils2].frere := -narbre;
				brother := fils2;
				end;
			backtrack := false;
			end;
		1	: begin
			(* 2eme passage par retour arriere *)
			(* la condition du until est fausse *)
			snum := -1;
			backtrack := false;
			indarb := narbre - 1;
			imbric := 1;
			while indarb > 0 do
				begin
				with table_arbre^[indarb] do
					begin
					if (noeud^[demo].code = p_repet0)
					or (noeud^[demo].code = p_repet1)
					then	imbric := imbric - 1;
					if (noeud^[demo].code = p_until1)
					or (noeud^[demo].code = p_until2)
					then	imbric := imbric + 1;
					if imbric = 0
					then	begin
						narbre := indarb;
						indarb := 0;
						end
					else	begin
						numero := -1;
						indarb := indarb - 1;
						end;
					end;
				end;
			end;
		2	: begin
			(* 2eme passage si condition vraie *)
			(* la condition du not est vraie *)
			snum := -1;
			backtrack := false;
			brother := noeud^[objet].frere;
			end;
		else
		end;
	end;
end;

procedure tfindall;
begin
with table_arbre^[narbre] do
	begin
	if info = 0
	then	begin	(* 1er passage *)
			(* on empile la propri‚t‚ *)
		empile_env;
		snum := 0;
		glob := true;
		crevide(info);
		glob := false;
		noeud^[objet].value := noeud^[fils2].frere;
		noeud^[fils2].frere := -narbre;
		brother := fils2;
		backtrack := false;
		end
	else	begin	(* 2eme passage par retour arriere *)
			(* la condition est ‚puis‚e *)
		backtrack := false;
		brother := noeud^[objet].frere;
		noeud^[fils2].frere := trunc(noeud^[objet].value);
		noeud^[info].frere := 0;
		pcopy(info , snum);
		liber_glob(info);
		rend_liste(snum,3);
		snum := -1;
		end;
	end;
end;


procedure repondre;
var	condit		: integer;
	precedent	: integer;
	condi		: integer;
	demo		: integer;
	i		: integer;

procedure demontrer;
const	vrai = 1;
	faux = 2;
	trouve = 3;
var	condit	: integer;
	frangin : integer;
	i	: integer;

procedure predefini(objett:integer; var numero : integer);
const	d100=100;
	d159=159;
var	truncrea	: integer;
	rea		: real;
	x,y		: real;
	xx,yy		: integer;
	angle,longueur	: real;
	i,fils3		: integer;
	vv1,vv2,vv3	: integer;
	vvx	: real;
	c,s		: real;
	x1,y1		: real;
	codefon		: integer;

begin		(* code de predefini *)
objet := objett;
fait1 := noeud^[objet].fils;
if fait1 <> 0
then	fait2 := noeud^[fait1].frere
else	fait2 := 0;
fils1 := getval(fait1);
if fils1 <> 0
then	fils1_code := noeud^[fils1].code;
fils2 := getval(fait2);
snum := -1;
codefon := noeud^[objet].code;

case codefon of

			(********************************)
			(* unifications et comparaisons *)
			(********************************)

	p_egalu	: if not unifier(fils1 , fils2)
			then	backtrack := true
			else	backtrack := false;
	p_egal	: begin
		if noeud^[fils1].niveau <> -1
		then	affecte(fils1,fils2,1)
		else	begin
			x := evaluation(fils1);
			if backtrack
			then	begin
				fait1 := getvval(fils1);
				backtrack := false;
				y := evaluation(fils2);
				if backtrack
				then	begin
					fait2 := getvval(fils2);
					if unifier(fait1 , fait2)
					then	backtrack := false;
					end
				else	backtrack := true;
				end
			else	begin
				backtrack := false;
				y := evaluation(fils2);
				if not backtrack
				then	begin
					if x <> y
					then	backtrack := true;
					end
				else	backtrack := true;
				end;
			end;
		end;
	p_diffu	:if unifier(fils1 , fils2)
		then	backtrack := true
		else	backtrack := false;
	p_diff,p_noega	: begin
		if noeud^[fils1].niveau <> -1
		then	backtrack := true
		else	begin
			x := evaluation(fils1);
			if backtrack
			then	begin
				fait1 := getvval(fils1);
				backtrack := false;
				y := evaluation(fils2);
				if backtrack
				then	begin
					fait2 := getvval(fils2);
					if unifier(fait1 , fait2)
					then	backtrack := false;
					end
				else	backtrack := true;
				end
			else	begin
				backtrack := false;
				y := evaluation(fils2);
				if not backtrack
				then	begin
					if x <> y
					then	backtrack := true;
					end
				else	backtrack := true;
				end;
			backtrack := not backtrack;
			end;
		end;
	p_petit	: if evaluation(fils1) >= evaluation(fils2)
			then	backtrack := true;
	p_grand	: if evaluation(fils1) <= evaluation(fils2)
			then	backtrack := true;
	p_egapetit,p_petitega : if evaluation(fils1) > evaluation(fils2)
			then	backtrack := true;
	p_egagrand,p_grandega : if evaluation(fils1) < evaluation(fils2)
			then	backtrack := true;
   (*	p_pet		: petcomp(0);
	p_petega	: petcomp(1);    *)
	p_affecu	: affecte(fils1,fils2,0);	(* := *)
	p_affece	: affecte(fils1,fils2,1);	(* :== *)
	p_affecs	: affecte(fils1,fils2,2);	(* :=. *)
	p_value		: begin		(* value(ident,variable) *)
			with table_symbole^[fils1_code] do
				begin
				if vale = 0
				then	backtrack := true
				else	begin
					locopy(vale,fils1);
					if not unifier(fils1,fils2)
					then	backtrack := true;
					end;
				end;
			end;
	p_function	: tfunction;	(* function(fon(...) , _fon(...)) *)
	p_functor	: tfunctor;	(* functor(struct , ident , nb_arg *)
	p_rp_arg	: treparg;
	p_name		: tname;	(* name(nom , "nom")	*)
	p_funclist	: tstrulist;	(* terme compos‚ :=: liste *)

			(********************************)
			(*	tests des objets	*)
			(********************************)

	p_var	: if noeud^[fils1].niveau = -1	(* var(objet) *)
			then	backtrack := true;
	p_novar	: if noeud^[fils1].niveau <> -1	(* novar(objet) *)
			then	backtrack := true;
	p_ident	: if (noeud^[fils1].niveau <> -1) (* ident(objet) *)
			or (noeud^[fils1].fils <> 0)
			or (fils1_code = p_nombre)
			or (fils1_code = p_nil)
			then	backtrack := true;
	p_structure	: if (noeud^[fils1].niveau <> -1) (* structure(objet)*)
			or (noeud^[fils1].fils = 0)
			then	backtrack := true;
	p_real		:begin		(* real (objet) *)
			if fils1_code = p_nombre
			then	begin
				rea:=noeud^[fils1].value;
				if (rea>=minint) and (rea<=maxint)
				then	begin
					truncrea:=trunc(rea);
					if truncrea = rea
					then	backtrack:=true;
					end;
				end
			else	backtrack:=true;
			end;
	p_integer	:begin		(* integer(objet) *)
			if fils1_code = p_nombre
			then	begin
				rea:=noeud^[fils1].value;
				if (rea>=minint) and (rea<=maxint)
				then	begin
					truncrea:=trunc(rea);
					if truncrea <> rea
					then	backtrack:=true;
					end
				else	backtrack:=true;
				end
			else	backtrack:=true;
			end;
	p_liste	:begin		(* liste(objet) *)
			if (fils1_code <> p_point)
			and (fils1_code <> p_nil)
			then	backtrack:=true;
			end;
	p_vide    :if fils1_code <> p_nil      (* nil (liste) *)
			then	backtrack:=true;
	p_number :if fils1_code <> p_nombre   (* number (objet) *)
		     then	backtrack:=true;
	p_numeric :if not numeric(fils1)  (* numeric(objet) *)
		     then	backtrack := true;
	p_constante:begin	(* constante(objet) *)
		if (noeud^[fils1].fils <> 0) or (noeud^[fils1].niveau <> -1)
		then	backtrack := true;
		end;

			(*****************************)
			(* controle de la resolution *)
			(*****************************)
	p_coupe0	: begin		(* / *)
		indarb := narbre - 1;
		nomblock := trunc(noeud^[table_arbre^[narbre].demo].value);
		while indarb > 0 do
			begin
			if nomblock <= indarb
			then	begin
				table_arbre^[indarb].numero := -1;
				indarb := indarb - 1;
				end
			else	indarb := 0;
			end;
		end;
	p_coupe1	:begin		(* /(nom) *)
		indarb := narbre - 1;
		nomblock := fils1_code;
		while indarb > 0 do
			begin
			with table_arbre^[indarb] do
				begin
				numero := -1;
				if (noeud^[demo].code = p_block)
				or (noeud^[demo].code = p_repet1)
				then	if noeud^[noeud^[demo].fils].code =
								nomblock
					then	indarb := 0;
				indarb := indarb - 1;
				end;
			end;
		end;
	p_block	: begin		(* block(nom)	*)
		end;
	p_fail0	: begin		(* fail	*)
		backtrack := true;
		end;
	p_fail1	: begin		(* fail(nom)	*)
		backtrack := true;
		indarb := narbre - 1;
		nomblock := fils1_code;
		while indarb > 0 do
			begin
			with table_arbre^[indarb] do
				begin
				numero := -1;
				if (noeud^[demo].code = p_block)
				or (noeud^[demo].code = p_repet1)
				then	if noeud^[noeud^[demo].fils].code =
								nomblock
					then	indarb := 0;
				indarb := indarb - 1;
				end;
			end;
		end;
	p_succ0	: begin		(* succeed	*)
		end;
	p_succ1	: tsucceed;		(* succeed(nom)	*)
	p_repet0,p_repet1	: begin
				snum := 0;	(* repeat	*)
				empile_env;
				end;
	p_until1,p_until2	: tuntil;		(* until(condition) *)
	p_for	: begin		(* for(var,min,max)	*)
		empile_env;
		if table_arbre^[narbre].info = 0
		then	begin
			affecte(fils1,fils2,1);
			table_arbre^[narbre].info :=
				 trunc(evaluation(noeud^[fait2].frere));
			end;
		end;
	p_ffor	: tffor;		(* ffor *)
	p_not	:begin
		with table_arbre^[narbre] do
			begin
			case info of
				0	: begin	(* 1er passage *)
					(* on empile la condition du not *)
					empile_env;
					info := 1;
					snum := 0;
					noeud^[objet].value :=
							noeud^[fils1].frere;
					noeud^[fils1].frere := -narbre;
					brother := fils1;
					backtrack := false;
					end;
				1	: begin
					(* 2eme passage par retour arriere *)
					(* la condition du not est fausse *)
					snum := -1;
					backtrack := false;
					brother := noeud^[objet].frere;
					noeud^[fils1].frere :=
						trunc(noeud^[objet].value);
					end;
				2	: begin
					(* 2eme passage si condition vraie *)
					(* la condition du not est vraie *)
					snum := -1;
					backtrack := true;
					noeud^[fils1].frere :=
						trunc(noeud^[objet].value);
					end;
				else
				end;
			end;
		end;
	p_findall,p_f_diff	: tfindall;
	p_if,p_if0		: tif;
	p_else	: begin		(* else	*)
		imbric := 1;
		fils1 := noeud^[objet].frere;
		while fils1 > 0 do
			begin
			with noeud^[fils1] do
				begin
				if code = p_if
				then	imbric := imbric + 1;
				if code = p_end
				then	imbric := imbric - 1;
				if imbric = 0
				then	begin
					table_arbre^[narbre].brother := fils1;
					fils1 := 0;
					end
				else	fils1 := frere;
				end;
			end;
		end;
	p_end	: begin		(* end	*)
		end;
	p_then	:begin
		end;
	p_exit	: sortie := true;	(* exit	*)
	p_quit	: begin
		sortie := true;
		finprol := true;
	      (*	if curfen <> 1
		then	begin
			windo(1,1,25,80,1);
			clrscr;
			end;  *)
		end;

	p_mark	: tmark;
	p_unmark : nmark := 0;
	p_index2	: begin		(* index(valeur,back) *)
		indarb := trunc(evaluation(fils1));
		access_index := indarb;
		if trunc(evaluation(fils2)) = 0
		then	back_index := false
		else	back_index := true;
		end;
	p_index1	:begin
		indarb := trunc(evaluation(fils1));
		access_index := indarb;
		back_index := false;
		end;
	p_hsh_coded : hsh_coded;
	p_multi_hsh_coded : hsh_coded;

			(********************************)
			(*	gestion des modules	*)
			(********************************)
	p_module	: if nmodule = -2
			then	begin
				nmodule := fils1_code;
				if nmodule = p_main
				then	nmodule := -2;
				end
			else	writeln(output,'end_module manque');
	p_end_module,p_main	: nmodule := -2;
	p_external	: begin
			i := table_symbole^[fils1_code].modul;
			if i= nmodule
			then	table_symbole^[fils1_code].modul := -3;
			end;
	p_define	: begin
			i := table_symbole^[fils1_code].modul;
			if (i= nmodule) or (i=-3)
			then  table_symbole^[fils1_code].modul:=-nmodule;
			end;
    	p_ref_module	: listing(0,nmodule,2);
	p_ref_all	: listing(0,0,2);
	p_ref_ident	: listing(fils1,0,2);

	(* p_help		: thelp;
	p_help0		:begin
			help('prolog.hlp','');
			indphrase := length(phrase);
			end;
	p_hlp		: begin
			lire_symbole(fils1_code);
			help(symbole_lu,'');
			end;
	p_hlp2		: thelp;
	p_edt		: begin
			lire_symbole(fils1_code);
			tedt(symbole_lu,backtrack);
			end;
	p_edit		: tedit(fils1,nmodule);
	p_edit_all	: tedit(0,0);
	p_edit_module	: tedit(0,nmodule);          *)

			(********************************)
			(*	entrees sorties		*)
			(********************************)

	p_prompt	: begin
			lire_symbole(fils1_code);
			prompt := symbole_lu;
			end;
	p_reset		:topen(1,i);
	p_rewrite	:topen(2,i);
	p_close		:tclose;
  	p_lirecars	:tlirecars;
	p_licar2,p_licar3	:tlirecars;
	p_liremots		:tliremots;
	p_limot2,p_limot3	:tliremots;
	p_readcar,p_rdcar2	:treadcar;
	p_readkbd		: treadkbd;
	p_inkey			: tinkey;
   (*	p__readlhm,p_readlhm	: treadlhm;
	p_read_modify,p_r_modify: treadmodify;
	p_wlhm		: twritelhm;
	p_menu,p_menu1	: tmenu;
	p_wait		: twait;      *)
	p_write,p_writeln : pwrite;	(* write(objet, ...)	*)
	p_put,p_putln	: begin
			indput := true;
			pwrite;		(* put(objet, ...)	*)
			indput := false;
			end;
	p_put_chr,p_pchr:tputchr;
	p_get_ord	:tgetord;
	p_wwords,p_wwln :begin
			indput := true;
			indword:= true;
			pwrite;
			indword := false;
			indput := false;
			end;
	p_write_format,p_wformat	:write_format(0);
	p_werror	: write_format(1);
	p_wtitle,p_w_title	: write_format(2);
  (*	p_razlhm	: trazlhm;          *)
	p_line		: trepet(0,fils1,fils2);
	p_space		: trepet(1,fils1,fils2);
	p_read,p_readln	: pread;	(* read (...,...) *)
	p_lire0	:begin
			if user > 0
			then	begin
				close(user_file[user]);
				user := user - 1;
				end;
			end;
	p_input0	:ttyin := 0;
	p_input1	:tpinput;
	p_outpt0	:ttyout := 0;
	p_outpt1	:tpoutput;
	p_eof1,p_eof0	:teof(false);
	p_eoln1,p_eoln0	:teoln(false);
	p_not_eof	:teof(true);
	p_neoln		:teoln(true);
	p_stat1		:tstatus(1);
	p_lire		:begin
	writeln('lire');
			lire_symbole(fils1_code);
			tlire(symbole_lu);
			end;
	p_relire	:begin
			reinput := nfait;
			lire_symbole(fils1_code);
			tlire(symbole_lu);
			end;
	p_verifie	:begin
			compile := true;
			noquest := true;
			lire_symbole(fils1_code);
			tlire(symbole_lu);
			end;

		(********************************)
		(*	gestion de l'écran	*)
		(********************************)

	p_beep	:tcar(chr(7));
(*	p_logo	:begin
		i := noeud^[fils2].code;
		fils3 := getval(noeud^[fait2].frere);
		fils3 := noeud^[fils3].code;
		logo(table_symbole^[fils1_code].symbol^,
			table_symbole^[i].symbol^,
			table_symbole^[fils3].symbol^);

		end;

	p_sound		: begin
			fait1:=trunc(evaluation(fils1));
			if fait1 = 0
			then	nosound
			else	sound(fait1);
			end;
	p_sound2	: begin
		sound(trunc(evaluation(fils1)));
		delay(trunc(evaluation(fils2)));
		nosound;
		end;
	p_nosound	: nosound;

	p_time		:ftime(0);
	p_wtime,p_w_time	:ftime(1);
	p_date		:fdate(0);
	p_wdate,p_w_date	:fdate(1);
	p_clrscr	:clrscr;               *)
	p_clreol	:clreol;
	p_clrtoend	:clrtoend;
	p_videoinv	:highvideo;
	p_videonor	:lowvideo;
  (*	p_inslin	:insline;
	p_dellin	:delline;         *)
	p_cursor	:tposit;	(* cursor (ligne,colonne) *)
	p_store		:tstore;	(* store (ligne,colonne,col,ecart) *)

	p_iniwindow	:inifen;
	p_window	:fenet(0);
	p_wind2		:fenet(fils2);


			(*************************)
			(*	graphique	 *)
			(*************************)
  (*	p_spawn		:spawn;
	p_hardcopy	:hardcopy;
	p_curson	:cursoronoff(true);
	p_cursoff	:cursoronoff(false);
	p_graphcolor	:graphcolormode;
	p_graphmode	:graphmode;
	p_hires		:hires;
	p_hirescolor	:hirescolor(trunc(evaluation(fils1)));
	p_palette	:palette(trunc(evaluation(fils1)) mod 4);
	p_textmode	:textmode(trunc(evaluation(fils1)));
	p_txtmode	:textmode(3);
	p_textcolor	:begin
			if not nocolor
			then	begin
			fenetre[curfen].color_texte:=trunc(evaluation(fils1));
			textcolor(fenetre[curfen].color_texte);
				end;
			end;
	p_backcolor	:begin
			if not nocolor
			then	begin
			fenetre[curfen].color_fond:=trunc(evaluation(fils1));
			textbackground(fenetre[curfen].color_fond);
				end;
			end;
	p_color		:remet_couleur;
	p_graphback	:graphbackground(trunc(evaluation(fils1)));
	p_getpic	:tgetpic(0);
	p_putpic	:tgetpic(1);
	p_plot		:begin
			fils3 := noeud^[fait2].frere;
			xs:= trunc(evaluation(fils2));
			ys:= trunc(evaluation(fils1));
			plot(xs,ys,trunc(evaluation(fils3)));
			inidraw := true;
			end;
	p_plotpol	:begin
			fils3 := noeud^[fait2].frere;
			vv1 := trunc(evaluation(fils1));
			vv2 := trunc(evaluation(fils2));
			xspol := trunc(vv2 * cos(vv1));
			yspol := -trunc(vv2 * sin(vv1));
			plot(xspol+160,yspol+100,trunc(evaluation(fils3)));
			inidrawpol := true;
			end;
	p_polyrap,p_polyinc	:begin
			vv1 := trunc(evaluation(fils1));
			vv2 := trunc(evaluation(fils2));
			fils3 := noeud^[fait2].frere;
			fils2 := noeud^[fils3].frere;
			if codefon = p_polyrap
			then	vvx := evaluation(fils2)
			else	vv3 := trunc(evaluation(fils2));
			fils3 := trunc(evaluation(fils3));
			for i := 1 to fils3 do
				begin
				forwd(vv1);
				if codefon = p_polyrap
				then	vv1 := trunc(vv1 * vvx)
				else	vv1 := vv1 + vv3;
				turnright(vv2);
				end;
			end;
	p_poly		:begin
			fils3 := noeud^[fait2].frere;
			fils3 := trunc(evaluation(fils3));
			vv1 := trunc(evaluation(fils1));
			vv2 :=trunc(evaluation(fils2));
			for i := 1 to fils3 do
				begin
				forwd(vv1);
				turnright(vv2);
				end;
			end;
	p_draw		:begin
			fils3 := noeud^[fait2].frere;
			vv1 := noeud^[fils3].frere;
			vv2 := noeud^[vv1].frere;
			xx := trunc(evaluation(fils2));
			yy := trunc(evaluation(fils1));
			xs := trunc(evaluation(vv1));
			ys := trunc(evaluation(fils3));
			draw(xx,yy,xs,ys,trunc(evaluation(vv2)));
			inidraw := true;
			end;
	p_draw3		:begin
			fils3 := noeud^[fait2].frere;
			xx := trunc(evaluation(fils2));
			yy := trunc(evaluation(fils1));
			if inidraw
			then	draw(xs,ys,xx,yy,trunc(evaluation(fils3)))
			else	plot(xx,yy,trunc(evaluation(fils3)));
			inidraw := true;
			xs:= xx;
			ys:= yy;
			end;
	p_draw3pol	:begin
			fils3 := noeud^[fait2].frere;
			angle := evaluation(fils1);
			longueur := evaluation(fils2);
			xx := trunc(longueur * cos(angle));
			yy := -trunc(longueur * sin(angle));
			if inidrawpol
			then	draw(xspol+160,yspol+100,xx+160,yy+100,
					trunc(evaluation(fils3)))
			else	plot(xx+160,yy+100,
					trunc(evaluation(fils3)));
			inidrawpol := true;
			xspol := xx;
			yspol := yy;
			end;
	p_drawpol	:begin
			fils3 :=noeud^[fait2].frere;
			vv1 := noeud^[fils3].frere;
			vv2 := noeud^[vv1].frere;
			angle := evaluation(fils1);
			longueur := evaluation(fils2);
			xx := trunc( longueur * cos(angle) );
			yy := -trunc( longueur * sin(angle) );
			angle := evaluation(fils3);
			longueur := evaluation(vv1);
			xspol := trunc( longueur * cos(angle));
			yspol := -trunc( longueur * sin(angle));
			draw(xx+160,yy+100,xspol+160,yspol+100,
				trunc(evaluation(vv2)));
			inidrawpol := true;
			end;
	p_circle	:begin
			fils3 := noeud^[fait2].frere;
			vv1 := noeud^[fils3].frere;
			circle(trunc(evaluation(fils2)),trunc(evaluation(fils1))
			   ,trunc(evaluation(fils3)),trunc(evaluation(vv1)));
			end;
	p_fillscreen	:fillscreen(trunc(evaluation(fils1)) mod 4);
	p_fillshape	:begin
			fils3 := noeud^[fait2].frere;
			vv1 := noeud^[fils3].frere;
			fillshape(trunc(evaluation(fils2)),
				trunc(evaluation(fils1))
				,trunc(evaluation(fils3)) mod 4,
				trunc(evaluation(vv1)));
			end;
	p_fillpol	:begin
			fils3 := noeud^[fait2].frere;
			vv1 := noeud^[fils3].frere;
			angle := evaluation(fils1);
			longueur := evaluation(fils2);
			xx := trunc(longueur * cos(angle));
			yy := -trunc(longueur * sin(angle));
			fillshape(xx+160,yy+100,
				trunc(evaluation(fils3)) mod 4,
				trunc(evaluation(vv1)));
			end;
	p_fshape	:begin
			fillshape(xcor+d159,d100-ycor,
				trunc(evaluation(fils1)) mod 4,
				trunc(evaluation(fils2)));
			end;
	p_fsh3d		:begin
			x1 :=d159 + (focal*x3d)/(focal-z3d) ;
			y1 :=d100 - (focal*y3d)/(focal-z3d) ;
			fillshape(trunc(x1),trunc(y1),
				trunc(evaluation(fils1)) mod 4,
				trunc(evaluation(fils2)));
			end;
	p_clearscreen,	p_hometurtle	: begin
			if codefon=p_clearscreen
			then	begin
				clearscreen;
				inidraw:=false;
				inidrawpol:=false;
				end
			else	home;
			x3d := 0;
			y3d := 0;
			z3d := 0;
			t11:= 0;
			t12:=1;
			t13:=0;
			t21:=-1;
			t22:=0;
			t23:=0;
			t31:=0;
			t32:=0;
			t33:=1;
			remplacer;
			end;
	p_magnify	: grossi := evaluation(fils1);
	p_focal		: focal := evaluation(fils1);
	p_forward,p_backward	: begin
			x := evaluation(fils1);
			if grossi <> 1
			then	x := x * grossi;
			if codefon = p_forward
			then	forwd(trunc(x))
			else	back(trunc(x));
			end;
	p_forwa3d,p_backw3d	: begin
			x := evaluation(fils1);
			if grossi <> 1
			then	x := x * grossi;
			x1 := (focal*x3d)/(focal-z3d) ;
			if codefon = p_backw3d
			then	x := - x;
			y1 := (focal*y3d)/(focal-z3d) ;
			x3d := x3d + x * c11;
			y3d := y3d + x * c12;
			z3d := z3d + x * c13;
			if not pennup
			then	begin
				x := (focal*x3d)/(focal-z3d) ;
				y := (focal*y3d)/(focal-z3d) ;
				draw(trunc(x1+d159),trunc(d100-y1),
					trunc(x+d159),trunc(d100-y),couleurpen);
				end;
			end;
	p_tourner3d	:begin
			x := evaluation(fils1) * 3.141593 / 180;
			c := cos(x);
			s := sin(x);
			t11 := c11*c + c21*s;
			t12 := c12*c + c22*s;
			t13 := c13*c + c23*s;
			t21 := c21*c - c11*s;
			t22 := c22*c - c12*s;
			t23 := c23*c - c13*s;
			remplacer;
			end;
	p_tanguer3d	:begin
			x := evaluation(fils1) * 3.141593 / 180;
			c := cos(x);
			s := sin(x);
			t11 := c11*c - c31*s;
			t12 := c12*c - c32*s;
			t13 := c13*c - c33*s;
			t31 := c31*c + c11*s;
			t32 := c32*c + c12*s;
			t33 := c33*c + c13*s;
			remplacer;
			end;
	p_roulis3d	:begin
			x := evaluation(fils1) * 3.141593 / 180;
			c := cos(x);
			s := sin(x);
			t21 := c21*c + c31*s;
			t22 := c22*c + c32*s;
			t23 := c23*c + c33*s;
			t31 := c31*c - c21*s;
			t32 := c32*c - c22*s;
			t33 := c33*c - c23*s;
			remplacer;
			end;
	p_tourx		:begin
			x := evaluation(fils1) * 3.141593 / 180;
			c := cos(x);
			s := sin(x);
			t12 := c12*c - c13*s;
			t13 := c13*c + c12*s;
			t22 := c22*c - c23*s;
			t23 := c23*c + c22*s;
			t32 := c32*c - c33*s;
			t33 := c33*c + c32*s;
			remplacer;
			end;
	p_toury		:begin
			x := evaluation(fils1) * 3.141593 / 180;
			c := cos(x);
			s := sin(x);
			t11 := c11*c + c13*s;
			t13 := c13*c - c11*s;
			t21 := c21*c + c23*s;
			t23 := c23*c - c21*s;
			t31 := c31*c + c33*s;
			t33 := c33*c - c31*s;
			remplacer;
			end;
	p_tourz		:begin
			x := evaluation(fils1) * 3.141593 / 180;
			c := cos(x);
			s := sin(x);
			t11 := c11*c - c12*s;
			t12 := c12*c + c11*s;
			t21 := c21*c - c22*s;
			t22 := c22*c + c21*s;
			t31 := c31*c - c32*s;
			t32 := c32*c + c31*s;
			remplacer;
			end;
	p_hideturtle	: hideturtle;
	p_showturtle	: showturtle;
	p_forgetdraw	: begin
			inidraw:=false;
			inidrawpol:=false;
			end;
	p_nowrap	: nowrap;
	p_pendown	: begin
			pendown;
			pennup := false;
			end;
	p_penup		: begin
			penup;
			pennup := true;
			end;
	p_setheading	: begin
			x := evaluation(fils1);
			while x > 32000 do
				x := x - 28800;
			fils1 := trunc(x);
			setheading(fils1);
			end;
	p_setpencolor	: begin
			couleurpen := trunc(evaluation(fils1)) mod 4;
			setpencolor(couleurpen);
			end;
	p_setposition	: setposition(trunc(evaluation(fils2))
				,trunc(evaluation(fils1)));
	p_setp		:begin
			fils3 := noeud^[fait2].frere;
			x := evaluation(fils3);
			x1 := evaluation(fils1);
			y1 := evaluation(fils2);
			x3d := x1;
			y3d := y1;
			z3d := x;
			x1 := (focal*x3d)/(focal-z3d) ;
			y1 := (focal*y3d)/(focal-z3d) ;
			setposition(trunc(x1),trunc(y1));
			end;
	p_turnleft	: turnleft(trunc(evaluation(fils1)));
	p_turnright	: turnright(trunc(evaluation(fils1)));
	p_tdelay	: turtledelay(trunc(evaluation(fils1)));
	p_wrap		: wrap;                                           *)


			(********************************)
			(*	debug, divers		*)
			(********************************)
	p_loop		: tloop(0);
	p_noloop	: tloop(1);
	p_assert	:tassert(0,0,0);
	p_assrt_first	:tassert(1,0,0);
	p_asrt_before	:tassert(2,1,0);
	p_ast3_before	:tassert(2,1,1);
	p_asrt_after	:tassert(3,1,0);
	p_ast3_after	:tassert(3,1,1);
	p_retract	:tretract(0,0,0);
	p__retract	:tretract(0,-1,0);
	p_retr3		:tretract(0,-1,1);
	p_retr3_from	:tretract(0,0,1);
	p_anafact	:tretract(1,-1,1);
	p_replace	:treplace(4,0);
	p_repl2		:treplace(2,1);
	p_repl3		:treplace(3,1);
	p_cl_all	:begin
		        final;
			iniprol;
			sortie := true;
			end;
 	p_cl_module 	:begin
	       	   	listing(0,nmodule,1);
		    	if nfait = 0
			then	razall;
			end;
  	p_clear		:listing(fils1,nmodule,1);

	p_trace		:trace := true;
	p_notrace	:trace := false;
  	p_spy		:tspy(0);
	p_nospy		:tspy(1);

	p_echo		:echo := true;
	p_noecho	:echo := false;
	p_auto		:auto := true;
	p_noauto	:auto := false;
	p_fait		:indfait := true;
	p_nofait	:indfait := false;
	p_silent	:read_bavard := false;
	p_nosilent	:read_bavard := true;
  (*	p_noaccent	:begin
			noaccent := true;
			taopt[8].v := 1;
			end;
	p_nocolor	:begin
			nocolor := true;
			taopt[7].v := 1;
			end;
	p_logomode	: begin
			logomode := true;
			clrscr;
			end;
	p_prologmode	: begin
			logomode := false;
			clrscr;
			end;                    *)
  	p_id_predef	:list_ident(0);
	p_id_module	:list_ident(1);
	p_id_main	:list_ident(3);
	p_id_all	:list_ident(2);
	p_id_undef	:list_ident(4);
 	p_flag		:t_flag;
   	p_list_all	:listing(0,0,0);
	p_list_module	:listing(0,nmodule,0);
  	p_stat		:tstat;
   	p_clear_stat 	:clear_stat;
	p_stop		:begin
			if user > 0
			then	begin
				save_user := user;
				user := -1;
				end;
			end;
	p_cont		:begin
			if user = -1
			then	user := save_user;
			if user > 0
			then	begin
				close(user_file[user]);
				user := user - 1;
				end;
			end;
	p_continue	:if user = -1 then	user := save_user;

	p_execute	:begin
			lire_symbole(fils1_code);
		  (*	fexec(symbole_lu);       *)
			end;
  (*	p_save_bin		:save;
	p_load_bin		:load;
	p_user1		:user1(noeud,fils1);
	p_user2		:user2(noeud,fils1,fils2);
	p_user3		:begin
			fait1:= noeud^[fait2].frere;
			fait1 := getval(fait1);
			user3(noeud,fils1,fils2,fait1);
			end;
	p_user4		:begin
			fait1:= noeud^[fait2].frere;
			fait2:= noeud^[fait1].frere;
			fait1 := getval(fait1);
			fait2 := getval(fait2);
			user4(noeud,fils1,fils2,fait1,fait2);
			end;                                     *)

   (*	p_delay		:delay(trunc(evaluation(fils1)));       *)

    	p_type		: ttype(0);
	p_copy		: ttype(1);
  (*	p_setdir	: tsetdir; *)
(*	p_delete	: tdelete;
	p_purge		: tpurge;
	p_dir,p_dir2,p_dir0	: tdir;              *)
	p_list		:begin
			stt := ttyout;
			ttyout := 0;
	      		listing(fils1,nmodule,0);
			ttyout := stt;
			end;
 	p_print1	: begin
			lire_symbole(fils1_code);
			if pos('.',symbole_lu)
				<> 0
			then	ttype(2)
			else	tprint(fils1,nmodule);
			end;
	p_prin_all	: tprint(0,0);
	p_prin_module	: tprint(0,nmodule);
(*	p_stxt_module	: tsave(0,nmodule);
	p_stxt_all	: tsave(0,0);
	p_s_txt2	: tsave(fils2,nmodule);       *)
	p_seed		: begin		(* seed *)
			if valeur(-1,rnd_seed)
			then	backtrack:=false
			else	backtrack:=true;
			end;


			(********************************)
			(*	gestion des listes	*)
			(********************************)

	p_element	:telement(0);
	p_el_one	:telement(-1);
	p_substr	:tsubstr(-2,-3,4);
	p_conc		:tconc;
	p_left		:tsubstr(1,-2,3);
	p_right		:tsubstr(-100,-2,3);
	p_del4		:tdel4;
	p_insert	:tinsert;
	p_flat		:tflat;
	p_inverse	:tinverse;
	p_miroir	:tmiroir;
  	p_trie		:ttrie;
	p_arg		:targ(-2,3);
	p_first2	:targ(1,2);
	p_second	:targ(2,2);
	p_last2		:targ(-100,2);
	p_pushfirst	:tpush(0);
	p_pushlast	:tpush(1);
	p_pushdiff	:tpushdiff;
	p_pop		:tpop(0);
	p_pop_one	:tpop(-1);

			(********************************)
			(*	gestion des ensembles	*)
			(********************************)
	p_union	:tunion;
	p_inter	:tinter;
	p_complement	:tcomplement;
	p_inclus	:tinclus;
	p_listens	:tlistens;
	p_compens	:tcompens;
	else
	end;
numero := snum;
end;

procedure tracer(dem : integer;mot:string);
var	i,j	: integer;
	fait	: integer;
begin
fait := abs(dem);
i := 0;
while i < nspy do
	begin
	i := i + 1;
	if (table_spy[i] = noeud^[fait].code)
	or (table_spy[i] = p_all)
	then	begin
		if narbre < 30
		then	j := narbre
		else	j := 30;
		for i := 1 to j do
			putk('  ');
		putk(mot);

		ecrire(fait);
		putkln('');
		i := nspy;
		end;
	end;
end;
function rajoute : integer;
var	i,j,fait,regle,reg    : integer;
	precedent,condi : integer;
	next_num : integer;
	ii:	integer;



begin		(* code de rajoute *)
rajoute := faux;
with table_arbre^[narbre] do
	begin
	if numero <= 0
	then	begin
		if numero = 0
		then	begin
			if noeud^[demo].code > npredef
			then	begin
				rajoute := faux;
				if trace
				then	tracer(-demo,'... rajoute declaration ');
				end
			else	begin
				numero := numero - 1;
				backtrack := false;
				if trace
				then	tracer(demo,'*** rajoute predefini ');
				predefini(demo , numero);
				if backtrack
				then	rajoute := faux
				else	rajoute := trouve;
				end;
			end;
		end
	else	begin
		if access_index <> 0
		then	begin
			if access_index > 0
			then	numero := numero + access_index - 1
			else	numero := - access_index;
			end;
		reg := table_fait^[numero]^.regle;
		if info = 0
		then	next_num := table_fait^[numero]^.suivant
		else	begin
			next_num := table_fait^[numero]^.coded_next;
			if next_num < 0
			then	begin
				next_num := table_fait^[-next_num]^.fait[info];
				end;
			end;
		if next_num <> 0
		then	begin
			oldenv := nenv;
			nenv := nenv + nniveau;
			if nenv+nniveau > max_env
			then	begin
				sortie := true;
				writeln(output,'trop d''environnements');
				end
			else	begin
				for i := 1 to nniveau do
				   table_env^[nenv+i] := table_env^[oldenv+i];
				end;
			end;
		oldenv := nniveau;
		if nbenv < nenv
		then	nbenv := nenv+nniveau;
		cindex := 1;
		pcond := addr(table_fait^[numero]^.fait[1]);
		ralo := table_fait^[numero]^.ral_cond;
		decomp(fait,oldenv);
		if trace
		then	begin
			tracer(-demo,'... a unifier demo ');
			tracer(-fait,'... au fait ');
			end;
		if not sortie
		then if unifier(fait,demo)
		then	begin
			last_index := - numero;
			if trace
			then	tracer(fait,'*** unification ok ');
			if reg <> 0
			then	begin

				rajoute := vrai;
				cindex := 1;
				pcond := addr(table_fait^[reg]^.fait[1]);
				ralo := table_fait^[reg]^.ral_cond;
				precedent := 0;
				while pcond^[cindex]<>0 do
					begin
					decomp(condi,oldenv);
					noeud^[condi].depend:=narbre;
					if precedent = 0
					then	regle := condi
					else	noeud^[precedent].frere:=condi;
					precedent := condi;
					end;
				noeud^[condi].frere := brother;
				if not comptop(regle)
				then	ajoute_arbre(regle)
				else	rajoute:=faux;
				end
			else	rajoute := trouve;
			end;
		numero := next_num;
		if access_index <> 0
		then	begin
			access_index := 0;
			if not back_index
			then	numero := 0;
			end;
		end;
	end;
end;

procedure retour_arriere;
begin
if table_arbre^[narbre].numero <= 0
then	begin
	if (table_arbre^[narbre].numero = -1)
	or (noeud^[table_arbre^[narbre].demo].code > npredef)
	then	begin
		if narbre = 1
		then	begin
			sortie := true;
			if not repondu
			then	if user <=0
				then	writeln(output,'non');
			end
		else	begin
			narbre := narbre - 1;
			nniveau := nenv - table_arbre^[narbre].senv;
			end;
		end;
	end;
nnoeud := table_arbre^[narbre].snoeud;
nenv := table_arbre^[narbre].senv;
if nmark <> 0
then	begin
	if arbre_mark[nmark] > narbre
	then	nmark := nmark - 1;
	end;
end;

procedure afficher_var;
var	i,narg	: integer;
	sym	: ttstring;
	objet	: integer;
	paq	: integer;
	valvar	: integer;
	nomvar	: integer;

procedure affiche(i : integer);
begin
valvar := table_env^[nenv+i];
if valvar <> 0
then	begin
	lire_symbole(nomvar);
	sym := symbole_lu;
	narg := table_symbole^[nomvar].nbr_arg;
	if (sym = '_')
	or ((length(sym) > 1) and (sym[2] = '_'))
	then	begin
		end
	else	begin
		paq := paq + 1;
		putk(sym);
		putk(' = ');
		objet := getval(valvar);
		if narg = 0
		then	ecrire(objet)
		else	begin
			lire_symbole(noeud^[objet].code);
			write(output,symbole_lu);
			end;
		putkln('');
		repondu := true;
		end;
	end;
end;

begin		(* code de affich *)
paq := 0;
for i := 1 to nnivquest do
	begin
	nomvar := envquest[i];
	affiche(i);
	end;
for i:= 1 to nmark do
	if mark[i] > nnivquest
	then	begin
		nomvar := nommark[i];
		affiche(mark[i]);
		end;
if not repondu
then	begin
	repondu := true;
	if user <= 0
	then	putkln('oui');
	end;
if paq > 1
then	putkln('');
if not auto
then	begin
	writeln(output,'on continue ?');
	if eof(input)
	then	phrase:='non'
	else	begin
		read(input,phrase);
		readln(input);
		end;
	if phrase <> 'oui'
	then	sortie := true;
	end;
end;

procedure ajoute_findall;
var	co,backarb,backvar	: integer;
begin
backarb := -frangin;
co := noeud^[table_arbre^[backarb].demo].code;
if (co<>p_findall) and (co<>p_f_diff)
then	begin	(* not, if(), until *)
	narbre := backarb;
	table_arbre^[narbre].info := 2;
	retour_arriere;
	end
else	begin
	with table_arbre^[backarb] do
		begin
		backvar := noeud^[demo].fils;
		backvar := getval(backvar);
		if noeud^[backvar].niveau = -1
		then	begin
			glob := true;
			if co = p_findall
			then	ajoute_element(backvar,info)
			else	begin
				if not felement(backvar,info)
				then	ajoute_element(backvar,info);
				end;
			glob := false;
			end;
		end;
	retour_arriere;
	end;
end;

begin		(* code de démontrer *)
sortie := false;
while not sortie do
	begin
	case rajoute of
		vrai	: begin
			end;
		trouve	: begin
			frangin := table_arbre^[narbre].brother;
			if frangin = 0
			then	begin
				afficher_var;
				retour_arriere;
				end
			else	begin
				if frangin > 0
				then	begin
					if trace
					then	tracer(frangin,' ... a demontrer ');
					if not comptop(frangin)
					then	ajoute_arbre(frangin)
					else	retour_arriere;
					end
				else	ajoute_findall;
				end;
			end;
		faux	: retour_arriere;
		else
		end;
	end;
end;

begin		(* code de repondre *)
nmark := 0;
access_index := 0;
last_index := 0;
repondu := false;
narbre := 0;
nenv :=0;
nnoeud := max_glob;
nniveau := 0;
cindex := 1;

pcond := addr(conditions[1]);

ralo := 0;
precedent := 0;
while conditions[cindex] <> 0 do
	begin
	decomp(condi,0);
	if precedent = 0
	then	condit := condi
	else	noeud^[precedent].frere := condi;
	precedent := condi;
	end;
nnivquest := nniveau;
for i := 1 to nnivquest do
	envquest[i] := envcour[i];
ajoute_arbre(condit);

demontrer;
end;

procedure trait_phrase;
begin
case type_phrase of
	fait	: if not indfait
		then	repondre
		else	enregistrer(0,0);
	quest	: repondre;
	regle	: enregistrer(0,0);
	else
	end;
end;

procedure lire_phrase;
begin
arret := 'n';
if user <= 0
then	begin
    (*	if logomode
	then	begin
		gotoxy(1,1);
		writeln(output,'                           ');
		gotoxy(1,1);
		end;   *)

	write(output, '?  ');
	if eof(input)
	then	phrase:='quit.'
	else	begin
		read(input,phrase);
		readln(input);
		end;
	if last_com = max_com
	then	last_com := 1
	else	last_com := last_com + 1;
 (*	if phrase = '..'
	then	edtphrase;      *)
	tabl_com[last_com] := phrase;
	end
else	begin
	if eof(user_file[user])
	then	begin
		close(user_file[user]);
		user := user - 1;
		phrase := '';
		if user = 0
		then	begin
			compile := false;
			noquest := false;
			if nb_erreur <> 0
			then	writeln(output,'*** ',nb_erreur,' erreur(s)');
			end;
		end
	else	begin
		read(user_file[user],phrase);
		if noaccent
		then	vireaccent;
		if echo
		then	affiche(phrase);
		no_ligne[user] := no_ligne[user] + 1;
		readln(user_file[user]);
		end;
	end;
indphrase := 0;

	if phrase[1] = '%'
	then	begin
	   (*	if ((phrase[2] <> 'i') or (phrase[3] <> 'n'))
		and (phrase[2] <> 'p') and (phrase[2] <> '*')
		then	traite_pcent;           *)

		phrase := '';
		indphrase := 0;
		end;

if noaccent
then	vireaccent;
end;

end.
