unit uio;

interface
uses umain;
  procedure choix_out;
  procedure inv(stt : integer ; tty : integer);
  procedure choix_in;
  procedure lire_ph;
  procedure pwrite;
  procedure pread;
  procedure rendcar(fils1:integer);
  procedure treadkbd;
  procedure tgetord;
  procedure tputchr;
  procedure tinkey;
  procedure treadcar;
  procedure teof(ind_not : boolean);
  procedure tstatus(index:integer);
  procedure teoln(ind_not : boolean);
  procedure lireint(des : tdes; descr: tdescr );
  procedure write_format(ty : integer);
  procedure tstore;
  procedure twait;
  procedure trepet(v:integer;fils1:integer;fils2:integer);
  procedure tlire(nom_fichier	:ttstring);
  procedure topen(cod:integer;var place : integer);
  procedure tclose;
  procedure tpoutput;
  procedure tpinput;
  procedure inifen;
  procedure fenet(forme:integer);


implementation
uses usp,userv,uana,uunif,ulist;
	(********************************************************)
	(*	gestion des entrees sorties			*)
	(*		ecran, clavier, imprimante, fichiers	*)
	(*	mio.pas	-	prolog				*)
	(********************************************************)

procedure choix_out;
var	i	: integer;
begin
if( noeud^[fils1].code=p_console) or (noeud^[fils1].code=p_outpt0)
then	begin
	if noeud^[fils1].code=p_console
	then	ttyout:=0;
	fait1:=noeud^[fait1].frere;
	end
else	begin
	for i:=2 to max_fich do
		begin
		if (noeud^[fils1].code=cfichier[i]) and (efichier[i]=2)
		then	begin
			ttyout:=i;
			fait1:=noeud^[fait1].frere;
			end;
		end;
	end;
end;

procedure inv(stt : integer ; tty : integer);
begin
if stt <> tty
then	begin
	pfichier[stt] := phrase;
	ifichier[stt] := indphrase;
	phrase := pfichier[tty];
	indphrase := ifichier[tty];
	end;
ttyin := tty;
end;

procedure choix_in;
var	i	: integer;
	stt	: integer;
begin
stt := ttyin;
if (noeud^[fils1].code = p_keyboard)
or (noeud^[fils1].code = p_input0)
then	begin
	if noeud^[fils1].code = p_keyboard
	then	ttyin := 0;
	fait1:=noeud^[fait1].frere;
	end
else	begin
	for i:=2 to max_fich do
		begin
		if (noeud^[fils1].code=cfichier[i]) and (efichier[i]=1)
		then	begin
			ttyin := i;
			fait1:=noeud^[fait1].frere;
			end;
		end;
	end;
inv(stt,ttyin);
end;

procedure lire_ph;
begin
ioresu := 0;
if ttyin <= 0
then	begin

	write(output,prompt);
	if eof(input)
	then	begin
		phrase:='$';
		ioresu:=1;
		end
	else	begin
		read(input,phrase);
		readln(input);
		end;

	end
else	begin
	if eof(fichier[ttyin])
	then	begin
		ioresu := 1;
		ok := false;
		phrase := '';
		end
	else	begin

		read(fichier[ttyin],phrase);
		readln(fichier[ttyin]);

		end;
	end;
indphrase := 0;
if noaccent
then	vireaccent;
end;

procedure pwrite;	(* traitement de la commande write (...) *)
var	i	:integer;
	stt	:integer;
begin
stt:=ttyout;
choix_out;
while  fait1 <> 0 do
	begin
	fait2 := getval(fait1);
	ecrire(fait2);
	if (noeud^[objet].code = p_wwords) or (noeud^[objet].code = p_wwln)
	then	tcar(' ');
	fait1 := noeud^[fait1].frere;
	end;
if (noeud^[objet].code = p_writeln) or (noeud^[objet].code = p_putln)
	or (noeud^[objet].code = p_wwln)
then	if ttyout=0
	then	writeln(output)
	else	writeln(fichier[ttyout]);
ttyout:=stt;
end;

procedure pread;	(* traitement de la commande  read (...) *)
var	lu	: tstring;
	q,i,j	: integer;
	condi	: integer;
	stt	: integer;
	sind	: integer;
	sphrase	: tstring;
begin
stt:=ttyin;
choix_in;
while fait1 <> 0 do
	begin
	ok := true;
	if indphrase >= length(phrase)
	then	begin
		if ttyin=0
		then	begin
			if read_bavard
			then	ecrire(fait1);
			end;
		lire_ph;
		if phrase = ''
		then	phrase := '.';
		indphrase := 0;
		end;
	q:=pos(',',phrase);
	if q<>0
	then	begin
		sind := -1;
		sphrase:=copy(phrase,q+1,length(phrase)-q);
		phrase := copy(phrase , 1 , q-1);
		end
	else	sind := 0;
	if phrase[length(phrase)] <> '.'
	then	begin
		phrase := phrase + '.';
		end;
	if ok
	then	analyse_phrase;
	if ok
	then	begin
		if sind <> 0
		then	begin
			phrase := sphrase;
			indphrase := 0;
			end;
		cindex := 1;
		pcond := addr(tconver[1]);

		ralo := 0;
		decomp(condi,nenv);
		if not unifier(condi,fait1)
		then	begin
			fait1 := 0;
			backtrack := true;
			end
		else	fait1:=noeud^[fait1].frere;
		end
	else	begin
		fait1 := 0;
		backtrack := true;
		end;
	end;
inv(ttyin,stt);
end;

procedure rendcar(fils1:integer);
var	v,el : integer;
begin
mot[0] := chr(1);
mot[1] := ansichar(car);

convertir_mot(mot,0,v);
prend_noeud(el);
noeud^[el].code := v;
if not unifier(fils1,el)
then	backtrack := true;
end;

procedure treadkbd;
begin
lirecar;
rendcar(fils1);
end;

procedure tgetord;
begin
if indphrase>=length(phrase)
then	begin
	if ttyin <=0
	then	begin
		lirecar;

		phrase[0] := chr(1);
		phrase[1] := ansichar(car);

		end
	else	lire_ph;
	indphrase := 0;
	end;
indphrase := indphrase + 1;
car := char(phrase[indphrase]);
rend(ord(car) ,1);
end;

procedure tputchr;
var	st	: integer;
begin
st := ttyout;
choix_out;
fait1 := getvval(fait1);
car := chr(trunc(noeud^[fait1].value));
if ttyout = 0
then	write(output,car)
else	write(fichier[ttyout],car);
ttyout := st;
end;

procedure tinkey;
begin
(* if keypressed
then	treadkbd
else	backtrack := true;     *)
end;

procedure treadcar;
var	car	:char;
begin
if ttyin=0
then	read(input,car)
else	read(fichier[ttyin],car);
rendcar(fils1);
end;

procedure teof(ind_not : boolean);
var	stt	: integer;
begin
stt:=ttyin;
choix_in;
backtrack:=true;
if ttyin=0
then	begin
	end
else	begin
	if indphrase >= length(phrase)
	then	begin
		if eof(fichier[ttyin])
		then	backtrack:=false;
		end;
	end;
inv(ttyin,stt);
if ind_not
then	backtrack := not backtrack;
end;

procedure tstatus(index:integer);
var	stt,i	:integer;
begin
if ttyin<>0
then	i:=ioresu
else	i:=0;
rend(i,index);
end;

procedure teoln(ind_not : boolean);
var	stt	: integer;
begin
stt := ttyin;
choix_in;
backtrack:=true;
if indphrase >= length(phrase)
then	backtrack := false;
inv(ttyin,stt);
if ind_not
then	backtrack := not backtrack;
end;

procedure lireint(des : tdes; descr: tdescr );
var	nb	: real;
	mot	: tstring;
	q,i	: integer;
begin
if indphrase>=length(phrase)
then	lire_ph
else	phrase := copy(phrase,indphrase+1,length(phrase)-indphrase);
ioresu := -3;
q := pos(' ',phrase);
if q=0
then	q:=pos(',',phrase);
if q=0
then	begin
	mot := phrase;
	indphrase := length(phrase);
	end
else	begin
	mot := copy(phrase,1,q-1);
	indphrase := q;
	end;
	if mot = '?'
	then	begin
		if descr.des1.l <> 0
		then	begin
			posit(l24,1);
			remet_couleur;
			clreol;
			end;
		highvideo;
		write(output,'Un nombre entier compris entre 1 et ',
					trunc(descr.max));
		lowvideo;
		end
	else	begin
		if mot = '$'
		then	ioresu := -2
		else	begin
			if mot = ''
			then	begin
				if not descr.oblig
				then	ioresu := -1
				else	begin
			affmsg('Ce parametre est obligatoire',true,descr.des1.l);
					end;
				end
			else	begin
			val(mot,nb,i);
			if i <> 0
			then	begin
				affmsg('Ce n''est pas un nombre',true,descr.des1.l);
				end
			else	begin
				if (nb < descr.min)
				or (nb > descr.max)
				then	begin
			affmsg('Le nombre est hors limite',true,descr.des1.l);
					end
				else	begin
					ioresu := trunc(nb);
					if descr.des1.l <> 0
					then	begin
						posit(l24,1);
						remet_couleur;
						clreol;
						end;
					end;
				end;
				end;
			end;
		end;
	remet_couleur;
end;

procedure write_format(ty : integer);
var	i	: integer;
	stt	: integer;
	forme	: integer;
	descrip	: tdescr;
	obj	: integer;
begin
stt:=ttyout;
with descrip do
	begin
	case ty of
		0	: begin		(* write_format *)
			choix_out;
			forme := noeud^[fait1].frere;
			obj := getval(fait1) ;
			anadesc(forme , descrip , 0);
			des1.rz := false;
			end;
		1	: begin		(* write_error *)
			obj := fils1;
			des1.l := l24;
			des1.c := 1;
			des1.v := p_videoinv;
			des1.tc := -1;
			des1.bc := -1;
			des1.num := -1;
			des1.rz := true;
			end;
		2	: begin		(* write_title *)
			forme := noeud^[fait1].frere;
			anadesc(forme , descrip , 0);
			obj := fils1;
			with des1 do
				begin
				if l <> 1
				then	begin
					l := 1;
					c := 10;
					end;
				if v+tc+bc=-2
				then	v := p_videoinv;
				num := -1;
				rz := true;
				end;
			end;
		end;

	with des1 do
		begin
		if ttyout <=0
		then	begin
			if l <> 0
			then	posit(l,c);
			if v = p_videoinv
			then	highvideo;
			if v = p_videonor
			then	lowvideo;
		  (*	if tc <> -1
			then	textcolor(tc);
			if bc <> -1
			then	textbackground(bc);     *)
			end;
		if ty = 0
		then	ecrire(obj)
		else	begin
			indput := true;
			indword := true;
			ecrire(obj);
			indput := false;
			indword := false;
			end;
		if ttyout <=0
		then	begin
			ecri(0 , des1 , 2);
			end;
		end;
	end;
ttyout:=stt;

end;

procedure tstore;
var	i,j,k,l,m	: integer;
begin
(* with fenetre[curfen] do
	begin
	if valeur(-1,i)
	and valeur(-2,j)
	and valeur(-3,k)
	and valeur(-4,l)
	and valeur(-5,m)
	then	begin
		lig_cous := i;
		lig_cour := i;
		col_cour := j;
		col_val := k;
		col_saisie := l;
		ecart := m;
		end;
	end;     *)
end;

procedure twait;
begin
if ttyin <=0
then	begin
	posit(l23,30);
	highvideo;
	write(output,'frappez return ');
	lowvideo;
	remet_couleur;
	lire_ph;
	indphrase := length(phrase);
	if phrase = '$'
	then	ioresu := -2
	else	ioresu := 0;
	end;
end;

procedure trepet(v:integer;fils1:integer;fils2:integer);
					(* commande line et space *)
var	i,n	:integer;
	stt	:integer;
begin
stt:=ttyout;
if fils1 <> 0
then	choix_out;
n := trunc(evaluation(fils2));
for i := 1 to n do
	begin
	if ttyout=0
	then	begin
		if v = 0
		then	writeln(output)
		else	write(output,' ');
		end
	else	begin
		if v=0
		then	writeln(fichier[ttyout])
		else	write(fichier[ttyout],' ');
		end;
	end;
ttyout:=stt;
end;

procedure tlire(nom_fichier	:ttstring);

begin		(* input (nom_fichier) *)

if pos('.',nom_fichier) = 0
then	begin
	nom_fichier := nom_fichier + '.pro';
	end;
backtrack:=false;
if user = -1
then	writeln(output,'tu es deja en load avec un stop. fait continue.')
else	begin
	if user = 0
	then	nb_erreur := 0;
	user:=user+1;
	no_ligne[user]:=0;
	user_name[user] := nom_fichier;
	mcreset(user_file[user],nom_fichier);
	if ioresu <> 0
	then	begin
		user:=user-1;
		if user=0
		then	begin
			reinput:=0;
			noquest:=false;
			compile:=false;
			end;
		eros;
		write(output,'*** le fichier ',nom_fichier);
		writeln(output,' n''existe pas');
		backtrack:=true;
		end;
	end;
end;

procedure topen(cod:integer;var place : integer);
var	nom_fichier	:ttstring;
	code_fichier:integer;
	i:integer;
begin		(* reset/rewrite (nom_de_fichier) *)
place := 0;
if (cod=-1) or (noeud^[fils1].fils = 0)
then	begin
	backtrack:=false;
	if cod <= 0
	then	begin
		if cod = -1
		then	nom_fichier := 'buffer.tmp'
		else	begin
			lire_symbole(noeud^[fils1].code);
			nom_fichier:=symbole_lu;
			end;
		cod:=2;
		place:=1;
		end
	else	begin
		lire_symbole(noeud^[fils1].code);
		nom_fichier:=symbole_lu;
		if (nom_fichier='keyboard') or (nom_fichier='console')
		or (nom_fichier='print')
		then	place := -1
		else	begin
			lire_symbole(noeud^[fils2].code);
			nom_fichier:= symbole_lu;
			code_fichier:=noeud^[fils1].code;
			place:=0;
			for i:=2 to max_fich do
				begin
				if cfichier[i]=code_fichier
				then	begin
					place:=i;
					close(fichier[place]);
					end;
				if (cfichier[i]=0) and (place=0)
				then	place:=i;
				end;
			if (nom_fichier='input') or (nom_fichier='output')
			then	place := -2;
			end;
		end;
	if place<=0
	then	begin
		eros;
		case place of
			0:	writeln(output,'trop de fichiers ouverts');
			-1:	writeln(output,'nom logique non assignable');
			-2:	writeln(output,'utiliser input() ou output()');
			else
			end;
		end
	else	begin
		i:=0;
		if cod=2
		then	begin
			if nom_fichier='print'
			then	nom_fichier:='prn';
			if nom_fichier='console'
			then	nom_fichier:='con';
			mrewrite(fichier[place],nom_fichier);
			i:=ioresu;
			end
		else	begin
			if nom_fichier='keyboard'
			then	nom_fichier:='con';
			mcreset(fichier[place],nom_fichier);
			i:=ioresu;
			end;
		if i=0
		then	begin
			efichier[place]:=cod;
			cfichier[place]:=code_fichier;
			pfichier[place]:='';
			ifichier[place]:=0;
			end
		else	begin
			backtrack := true;
			(* writeln(output,nom_fichier,' n''existe pas'); *)
			end;
		end;
	end
else	backtrack:=true;
end;

procedure tclose;
var	i:integer;
	code_fichier:integer;
begin
code_fichier:=noeud^[fils1].code;
for i:=3 to max_fich do
	begin
	if code_fichier=cfichier[i]
	then	begin
		close(fichier[i]);
		cfichier[i]:=0;
		if i=ttyout
		then	ttyout:=0;
		if i=ttyin
		then	begin
			inv(ttyin,0);
			end;
		end;
	end;
end;

procedure tpoutput;
var	i,j:integer;
	code_fichier:integer;
begin
code_fichier:=noeud^[fils1].code;
if code_fichier = p_console
then	ttyout:=0
else	begin
	j:=0;
	for i:=2 to max_fich do
		begin
		if (code_fichier=cfichier[i]) and (efichier[i]=2)
		then	begin
			j:=1;
			ttyout:=i;
			end;
		end;
	if j=0
	then	begin
		eros;
		writeln(output,'le fichier n''est pas ouvert en output');
		end;
	end;
end;

procedure tpinput;
var	i,j:integer;
	code_fichier:integer;
begin
code_fichier:=noeud^[fils1].code;
if code_fichier = p_keyboard
then	begin
	inv(ttyin,0);
	end
else	begin
	j:=0;
	for i:=2 to max_fich do
		begin
		if (code_fichier=cfichier[i]) and (efichier[i]=1)
		then	begin
			j:=1;
			inv(ttyin,i);
			end;
		end;
	if j=0
	then	begin
		eros;
		writeln(output,'le fichier n''est pas ouvert en input');
		end;
	end;
end;

procedure inifen;
var	k,j,nufen	:integer;
begin
(* ok := true;
if not valeur(-1,nufen)
then	ok := false
else	begin
	if (nufen<=1) or (nufen>max_fen)
	then	ok := false
	else	begin
		k:=1;
		while k<5 do
			begin
			k:=k+1;
			if valeur(-k,j)
			then	begin
				fenetre[nufen].coins[k-1]:=j;
				end
			else	begin
				ok:=false;
				k:=5;
				end;
			end;
		end;
	end;
if ok
then	begin
	with fenetre[nufen] do
		begin

		if ok
		then	begin
			iniw := true;
			color_texte := 7;
			color_fond := 0;
			posx:=-1;
			posy:=1;
			lig_cour := 3;
			lig_cous := 3;
			col_cour := 2;
			col_val := 35;
			col_saisie := 55;
			ecart := 2;
			val_menu := 1;
			end;
		end;
	end
else	begin
	backtrack:=true;
	writeln(output,'Le numero de fenetre est debil');
	end;                                     *)
end;

procedure fenet(forme:integer);
var	k,i	: integer;
begin
(* if noeud^[fils1].code <> p_nombre
then	begin
	eros;
	writeln(output,'Le numero de fenetre est faux');
	end
else	begin
	k:=trunc(noeud^[fils1].value);
	if (k>0) and (k<=max_fen)
	then	begin
		if forme = 0
		then	forme := 0
		else	forme := trunc(evaluation(fils2) );
		if fenetre[k].iniw
		then	begin
			fenetre[curfen].posx := wherex;
			fenetre[curfen].posy := wherey;
			curfen := k;
			with fenetre[curfen] do
				begin
				if (posx = -1) and (forme=0)
				then	forme := 1;
				windo(coins[1],coins[2],coins[3],coins[4],forme);
				if forme <> 2
				then	begin
					if color_texte <> -1
					then	textcolor(color_texte);
					if color_fond <> -1
					then	textbackground(color_fond);
					end;
				if forme = 1
				then	begin
					clrscr;
					posx := 1;
					posy := 1;
					lig_cour := lig_cous;
					val_menu := 1;
					end;
				if forme <> 2
				then	gotoxy(posx,posy);
				end;
			if (curfen = 1) and (forme = 1)
			then	begin
				for i := 2 to max_fen do
					fenetre[i].posx := -1;
				end;
			end;
		end
	else	begin
		eros;
		writeln(output,'Le numero de fenetre est debil');
		end;
	end;                      *)
end;

end.
