unit ulhm;

interface
uses umain;
  procedure tliremots;
  procedure tlirecars;


implementation
uses uio,usp,uunif,userv;
		(********************************)
		(*	liremots		*)
		(*	lirecars		*)
		(*	tmenu			*)
		(*	trazlhm			*)
		(*	writelhm		*)
		(*	read_modify		*)
		(*	readlhm			*)
		(*  mlhm.pas	 - prolog	*)
		(********************************)
procedure from_console (str:tstring);
begin
end;

procedure tliremots;
var	sstr	: tstring;
	mot	: tstring;
	st	: ttstring;
	i	: integer;
	sor,el	: integer;
	nouv	: boolean;
	car	: char;
	cor	: integer;
	nc	: integer;
	chiffres: boolean;
	point	: boolean;
	nb_rea	: real;
	stt	: integer;
	rl,forme: integer;
	sf	: integer;
	motcon	: boolean;
	quote	: boolean;
	doubleq	: boolean;
	multlig	: boolean;
	gesquote: boolean;
	doublecon:boolean;
	comment	: boolean;
	prem	: boolean;
	eco	: boolean;
	sousliste:integer;
begin
stt := ttyin;
sf := fait1 ;
choix_in;
if sf = fait1
then	rl := 1
else	rl := 2;
fait2 := noeud^[fait1].frere;
fait1 := getval(fait1);
if fait2 = 0
then	forme := 0
else	forme := trunc(evaluation(fait2));
if ttyin = 0
then	begin
	if read_bavard
	then	ecrire(fait1);
	end;
lire_ph;
sstr:=phrase;
indphrase := length(phrase);
crevide(sor);
i:=0;
mot:='';
nouv:=false;
chiffres := true;
point:=false;
quote:=false;
doubleq:=false;
doublecon:=false;
multlig:=false;
comment:=false;
gesquote := false;
prem:=true;
eco := false;
if forme < 0
then	begin
	forme := - forme;
	eco := true;
	end;
if forme > 10000
then	begin
	forme := forme-10000;
	doublecon:=true;
	end;
if forme >= 1000
then	begin
	forme:=forme-1000;
	gesquote := true;
	end;
if forme >= 100
then	begin
	forme := forme -100;
	comment := true;
	end;
if forme >= 10
then	begin
	forme := forme - 10;
	multlig := true;
	end;
if ttyin = 0
then	eco := false;
if echo
then	affiche(sstr);
sousliste:=0;
from_console(sstr);
while i<length(sstr) do
	begin
	if mot = ''
	then	nouv := false;
	i:=i+1;
	car:=char(sstr[i]);
	if gesquote
	then	begin
		if doubleq
		then	nouv := true;
		if car = '"'
		then	begin
			if doublecon
			then	car := chr(0);
			chiffres := false;
			nouv := true;
			if doubleq
			then	begin
				if (i<>indphrase) and (sstr[i+1] = '"')
				then	begin
					i := i+1;
					car :='"';
					nouv:=false;
					end
				else	begin
					doubleq:=false;
					if doublecon
					then	begin
						ajoute_element(sousliste,sor);
						sousliste:=0;
						end;
					end;
				end
			else	begin
				doubleq:=true;
				if doublecon
				then	crevide(sousliste);
				end;
			end
		else	begin
			if car=''''
			then	begin
				chiffres:=false;
				car := chr(0);
				nouv := true;
				if quote
				then	begin
					if (i<>indphrase) and (sstr[i+1] = '''')
					then	begin
						i:=i+1;
						car :='''';
						nouv := false;
						end
					else	quote := false;
					end
				else	begin
					quote := true;
					end;
				end;
			end
		end;
	if (car=' ') or (car=chr(9))
	then	begin
		if (not quote) and (not doubleq)
		then	begin
			nouv:=true;
			car:=chr(0);
			end;
		end;
	if (not quote) and (not doubleq) and (car<>chr(0))
	then	begin
	if not (car in ['a'..'z','A'..'Z','0'..'9','é','è','ç','à','ù','ê','â','î','û','ô','ï','ë','ü','_','$'])
	then	begin
		if chiffres and (not point) and (length(mot) <> 0)
		then	begin
			if car = '.'
			then	point := true
			else	begin
				if forme = 0
				then	car := ' ';
				nouv:=true;
				end;
			end
		else	begin
			if forme = 0
			then	car := ' ';
			nouv:=true;
			end;
		motcon:=false;
		end
	else	begin
		if not (car in ['0'..'9'])
		then	chiffres := false;
		motcon := true;
		end;
	    end
	else	motcon := true;
	if not nouv
	then	begin
		mot:=mot+car;
		car:=chr(0);
		end;
	if i=length(sstr)
	then	begin
		nouv:=true;
		if motcon
		then	car := chr(0);
		end;
	if (nouv) and (mot <> '')
	then	begin
		prend_noeud(el);
		if chiffres
		then	begin
			val(mot,nb_rea,nc);
			noeud^[el].code := p_nombre;
			noeud^[el].value := nb_rea;
			end
		else	begin
			convertir_mot(mot,0,nc);
			noeud^[el].code:=nc;
			end;
		if sousliste = 0
		then	ajoute_element(el,sor)
		else	ajoute_element(el,sousliste);
		prem := false;
		nouv:=false;
		mot:='';
		chiffres := true;
		point := false;
		end;
	if car <> chr(0)
	then	begin
		mot[0]:=chr(1);
		mot[1]:=ansichar(car);
		if comment and (car = '*') and prem
		then	begin
			sstr := '';
			i:=indphrase;
			end
		else	begin
			prend_noeud(el);
			convertir_mot(mot,0,nc);
			noeud^[el].code:=nc;
			if sousliste = 0
			then	ajoute_element(el,sor)
			else	ajoute_element(el,sousliste);
			end;
		nouv:=false;
		mot:='';
		chiffres := true;
		point := false;
		prem:=false;
		end;
	if i = indphrase
	then	begin
		if multlig
		then	begin
			if (sstr='') or (sstr[indphrase] <> '.')
			then	begin
				if ttyin = 0
				then	write(output,'    ');
				lire_ph;
				if eco
				then	affiche(phrase);
				prem := true;
				if ioresu=1
				then	phrase := '.';
				sstr:=phrase;
				indphrase := length(phrase);
				i:=0;
				quote:=false;
				doubleq:=false;
				end;
			end;
		end;
	end;
fait1 := sf;
rend_liste(sor,rl);
inv(ttyin,stt);
end;

procedure tlirecars;
var	sstr	: tstring;
	mot	: tstring;
	sor,el	: integer;
	i,nc	: integer;
	car,cor	: char;
	stt	: integer;
	rl,forme: integer;
	sf	: integer;
begin
stt := ttyin;
sf := fait1 ;
choix_in;
if sf = fait1
then	rl := 1
else	rl := 2;
fait2 := noeud^[fait1].frere;
fait1 := getval(fait1);
if fait2 = 0
then	forme := 0
else	forme := trunc(evaluation(fait2));
if ttyin = 0
then	begin
	if read_bavard
	then	ecrire(fait1);
	end;
lire_ph;
sstr := phrase;
indphrase := length(phrase);
crevide(sor);
i:=0;
cor := ' ';
while i < length(sstr) do
	begin
	i:=i+1;
	car := char(sstr[i]);
	if (car = chr(9)) and (forme=0)
	then	car := ' ';
	if (forme <> 0) or (cor<>' ') or (car<>' ')
	then	begin
		cor := car;
		mot[0]:=chr(1);
		mot[1]:=ansichar(car);
		convertir_mot(mot,0,nc);
		prend_noeud(el);
		noeud^[el].code:=nc;
		ajoute_element(el,sor);
		end;
	end;
fait1 := sf;
rend_liste(sor,rl);
inv(ttyin,stt);
end;

{procedure tmenu;
var	desc	: integer;
	descrip	: tdescr;
	sor	: integer;
	goon	: boolean;
	ecart	: integer;
	sl,sc	: integer;
	nb	: real;
	valmenu	: integer;
	oldval	: integer;
	fils	: integer;
	iz	: integer;
	stt	: integer;
	ncol,ncolo	: integer;
	maxcolo	: array[-1..10] of integer;
	colo	: array[0..100] of integer;
	lig	: array[1..100] of integer;
	valpar	: array[1..100] of integer;
	mini,maxi	: integer;
begin
stt := ttyin;
desc := fils2;
fils1 := getvval(fils1);
fils := fils1;
anadesc(desc,descrip,0);
with descrip do
	begin
	des1.rz := false;
	des2.rz := true;

	if menuf
	then	begin
		ecart := 1;
		des1.l := 3;
		des1.c := 1;
		if des2.v+des2.tc+des2.bc=-2
		then	des2.v := p_videoinv;
		end
	else	begin
		if min > 0
		then	ecart := trunc(min)
		else	ecart := 1;
		if des1.l = 0
		then	begin
			des1.l := 4;
			des1.c := 10;
			end;
		end;
	min := 0;
	maxi := 0;
	sl := des1.l;
	sc := des1.c;
	ncolo := 1;
	while fils1 <> 0 do
		begin
		lire_element(fils1,sor);
		sor := getval(sor);
		if sor <> 0
		then	begin
			if noeud^[sor].code = p_coupe0
			then	begin
				maxcolo[ncolo] := maxi;
				ncolo := ncolo + 1;
				des1.l := sl;
				des1.c := des1.c + 25;
				end
			else	begin
				min := 1;
				maxi := maxi + 1;
				max := maxi;
				lig[maxi] := des1.l;
				valpar[maxi]:=sor;
				colo[maxi] := ncolo;
				if not menuf
				then	des1.numer := maxi;
				if menuf
				then	ecri(sor,des1,3)
				else	ecri(sor,des1,0);
				des1.l := des1.l + ecart;

				end;
			end;
		end;
	maxcolo[ncolo] := maxi;
	maxcolo[ncolo+1] := maxi + 100;
	maxcolo[0] := 0;
	maxcolo[-1] := 0;
	ioresu := -3;
	if not menuf
	then	begin
		with descrip.des2 do
			begin
			if l = 0
			then	begin
				l := sl+4+maxi;
				if l>l23
				then	l := l23;
				c := 20;
				end;
			if v+tc+bc=-2
			then	v := p_videoinv;
			end;
		while ioresu = -3 do
			begin
			ecri(-2 , des2 , 0);
			lireint(des2 , descrip );
			end;
		end
	else	begin
		oldval := 1;
		valmenu :=  nummenu;
		if (oldval > maxi) or (oldval<=0)
		then	oldval := 1;
		while ioresu = -3 do
			begin
			if oldval <> valmenu
			then	begin
				sor := valpar[oldval];
				des1.l := lig[oldval];
				des1.c := sc + (colo[oldval] -1) * 25;
				if colo[oldval] = ncolo
				then	ecri(sor,des1,3)
				else	ecri(sor,des1,4);
				end;
			if valmenu > maxi
			then	valmenu := 1;
			if valmenu < 1
			then	valmenu := maxi;
			oldval := valmenu;
			sor := valpar[oldval];
			des2.l:=lig[valmenu];
			des2.c:= sc + (colo[valmenu]-1) * 25;
			if colo[valmenu] = ncolo
			then	ecri(sor,des2,3)
			else	ecri(sor,des2,4);
			remet_couleur;
			goon := true;
			while goon do
				begin
				goon := false;
				lirecar;
				if car = chr(0)
				then	begin
					if not true (*keypressed*)
					then	ioresu := -1
					else	begin
						lirecar;
			ncol := colo[valmenu];
			case ord(car) of
				chome:	valmenu := 1;
				cend:	valmenu := maxi;
				cup:	valmenu := valmenu-1;
				cdown:	valmenu:=valmenu+1;
				cright:	begin
					valmenu := valmenu +
					maxcolo[ncol] - maxcolo[ncol-1];
					if valmenu > maxcolo[ncol+1]
					then	valmenu := maxcolo[ncol+1];
					end;
				cleft:	begin
					valmenu := valmenu -
					maxcolo[ncol-1] + maxcolo[ncol-2];
					if valmenu > maxcolo[ncol-1]
					then	valmenu := maxcolo[ncol-1];
					end;
				else
					goon := true;
				end;
						end;
					end
				else	begin
					if (car = '$') or (car='-')
					then	ioresu := -2
					else	begin
						if (car = chr(cret))
						or (car=' ')
						then	ioresu := valmenu
						else	goon := true;
						end;
					end;
				end;
			end;
		end;
	remet_couleur;
	clrscr;
	end;
inv(ttyin,stt);
end;

procedure trazlhm;
var	n,l	: integer;
begin
n := trunc(evaluation(fils1));
with fenetre[curfen] do
	begin
	l := lig_cous + ecart * (n-1);
	if (l>=0) and (l<25)
	then	begin
		posit(l,col_cour);
		clrtoend;
		val_menu := n;
		lig_cour := l;
		end;
	end;
end;

procedure twritelhm;
var	descrip	: tdescr;
	desc	: integer;
begin
desc := noeud^[fait2].frere;
anadesc(desc , descrip , 0);
with descrip do
	begin
	des2.numer := -1;
	if des1.num = -1
	then	ecri(fils1,des1,0);
	if des2.l = 0
	then	write(output,'  ');
	ecri(fils2,des2,0);
	end;
remet_couleur;
end;

procedure treadmodify;
var	descrip	: tdescr;
begin
anadesc(fils1 , descrip , 0);
with descrip.des1 do
	begin
	if fils1 = 0
	then	descrip.oblig := false;
	rz := true;
	if l = 0
	then	begin
		l := fenetre[curfen].lig_cour + 3;
		if l > l23
		then	l := l23;
		c := 30;
		end;
	if tc+bc+v = -2
	then	v := p_videoinv;
	end;
ioresu := -3;
while ioresu = -3 do
	begin
	ecri(-1 , descrip.des1 , 0);
	descrip.min := 1;
	descrip.max := fenetre[curfen].val_menu-1;
	lireint(descrip.des2 , descrip);
	remet_couleur;
	end;
end;

procedure treadlhm;
var	ncar	: integer;
	desc,des: integer;
	goon	: boolean;
	nb	: real;
	sor	: integer;
	vasy	: boolean;
	descrip	: tdescr;
	antic	: boolean;
	mot	: tstring;
	i	: integer;
	savedes2: tdes;

procedure parlhm;
var	i	: integer;
	trouve	: boolean;
	lis,el	: integer;
begin
with descrip do
	begin
	case typ of
		p_time,p_date,
		p_word,p_words	: begin
			if (length(mot)<min) or (length(mot)>max)
			then	begin
				goon := true;
				affmsg('trop de caracteres',true,des1.l);
				end
			else	begin
				convertir_mot(mot,0,i);
				if listword <> 0
				then	begin
					lis := listword;
					trouve := false;
					while lis <> 0 do
						begin
						lire_element(lis , el);
						if el <> 0
						then	begin
							if i = noeud^[el].code
							then	begin
								lis := 0;
								trouve := true;
								end;
							end;
						end;
					if not trouve
					then	begin
					affmsg('ce mot est inconnu',true,des1.l);
						goon := true;
						end;
					end;
				if not goon
				then	begin
					prend_noeud(sor);
					noeud^[sor].code:=i;
					end;
				end;
			end;
		p_real0,p_int0	:begin
			val(mot,nb,i);
			if i <> 0
			then	begin
				goon := true;
				affmsg('Ce n''est pas un nombre',true,des1.l);
				end
			else	begin
				if (nb<min) or (nb>max)
				then	begin
					goon := true;
				affmsg('Le nombre est hors limite',true,des1.l);
					end
				else	begin
					if typ = p_int0
					then	begin
						if (nb < minint)
						or (nb > maxint)
						then	goon := true
						else	if nb <> trunc(nb)
							then	goon := true;
						if goon
						then	begin
				affmsg('ce n''est pas un entier',true,des1.l);
							end
						else	ioresu := trunc(nb);
						end;
					if not goon
					then	begin
						prend_noeud(sor);
						noeud^[sor].code:=p_nombre;
						noeud^[sor].value:=nb;
						end;
					end;
				end;
			end;
		p_yesno	:begin
			if (mot='oui') or (mot='yes') or (mot='o') or (mot='y')
			or (mot='OUI') or (mot='YES') or (mot='O') or (mot='Y')
			then	begin
				i := p_yes;
				ioresu := 1;
				end
			else	begin
				i := p_no;
				ioresu := 0;
				end;
			prend_noeud(sor);
			noeud^[sor].code := i;
			end;
		else
		end;
	end;
end;

begin		(* code de treadlhm *)
desc := noeud^[fait2].frere;
desc := getval(desc);
antic := false;
anadesc(desc,descrip,1);
with descrip, fenetre[curfen] do begin
savedes2:=des2;
des2.l:=des2.ls;
des2.c:=des2.cs;
goon := true;
while goon do
	begin
	des1.rz := false;
	goon := false;
	if ttyin <= 0
	then	begin
		if (indphrase >= length(phrase))
		or (ppr and (descrip.des1.l <> 0))
		then	begin
			if descrip.des1.num = -1
			then	ecri(fils1,descrip.des1,0);
			ecri(fils2,descrip.des2,1);
			if indphrase >= length(phrase)
			then	begin
				lire_ph;
				remet_couleur;
				indphrase := 0;
				if descrip.des1.l <> 0
				then	begin
					posit(l24,1);
					clreol;
					end;
				end
			else	antic := true;
			end;
		end
	else	begin
		if indphrase >= length(phrase)
		then	begin
			if eof(fichier[ttyin])
			then	phrase := '$'
			else	lire_ph;
			indphrase := 0;
			end;
		end;
	vasy := true;
	mot := '';
	ncar := 0;
	while vasy do
		begin
		if indphrase >= length(phrase)
		then	begin
			vasy := false;
			end
		else	begin
			indphrase := indphrase + 1;
			car := phrase[indphrase];
			if car = chr(9)
			then	car := ' ';
			if (car<>' ') or (ncar <> 0)
			then	begin
				if ((car <> ' ')
				and (car <> ',')) or (typ=p_words)
				then	begin
					ncar := ncar + 1;
					mot[0] := chr(ncar);
					mot[ncar] := car;
					end
				else	vasy := false;
				end;
			end;
		end;
	if ppr and (des1.l+des2.l <> 0) and antic
	then	begin
		write(output,mot);
		end;
	if ttyin <= 0
	then	begin
		if des2.v+des2.bc+des2.tc <> -2
		then	remet_couleur;
		end;
	ioresu := 0;
	if mot='?'
	then	begin
		goon := true;
		case typ of
			p_word, p_words	:begin
				if des1.l <> 0
				then	begin
					posit(l24,1);
					clreol;
					end;
				highvideo;
				if listword = 0
				then	begin
					write(output,'Un mot ');
					if min >=0
					then	write(output,'de ',trunc(min):0,' a ',
							trunc(max):0,' lettres');
					lowvideo;
					end
				else	begin
					write(output,'Un des mots : ');
					indput := true;
					indword := true;
					ecrire(listword);
					indput := false;
					indword:=false;
					end;
				remet_couleur;
				if des1.l = 0
				then	writeln(output);
				end;
			p_yesno : begin
				affmsg('Oui ou Non',false,des1.l);
				end;
			p_real0,p_int0	: begin
				if des1.l <> 0
				then	begin
					posit(l24,1);
					clreol;
					end;
				highvideo;
				write(output,'un nombre ');
				if typ = p_int0
				then	write(output,' entier ')
				else	write(output,' reel ');
				if min <> minint
				then	begin
					write(output,'compris entre ');
					if min = trunc(min)
					then	write(output,trunc(min):0)
					else	write(output,min);
					write(output,' et ');
					if max = trunc(max)
					then	write(output,trunc(max))
					else	write(output,max:0);
					end;
				lowvideo;
				remet_couleur;
				end;
			else
			end;
		if not oblig
		then	write(output,'.  facultatif');
		if des1.l = 0
		then	writeln(output);
		end
	else	begin
		if mot = ''
		then	begin
			if oblig
			then	begin
				goon := true;
			affmsg('Ce parametre est obligatoire',true,des1.l);
				end
			else	ioresu := -1;
			end
		else	begin
			if mot = '$'
			then	ioresu := -2
			else	begin
				parlhm;
				end;
			end;
		end;
	end;
if ioresu < 0
then	begin
	prend_noeud(sor);
	if (typ = p_int0) or (typ=p_real0)
	then	begin
		noeud^[sor].code := p_nombre;
		noeud^[sor].value := 0;
		end
	else	begin
		mot := '';
		convertir_mot(mot,0,i);
		noeud^[sor].code := i;
		end;
	end;
rend_liste(sor,2);
if ioresu >= 0
then	begin
	if savedes2.c <> savedes2.cs
	then	begin
		savedes2.numer:=-1;
		ecri(sor,savedes2,0);
		end;
	end;
end;
end;               }
end.
