
procedure initpsy;	(* initialisation, lecture du fichier de donnees *)
var	i,j,ic	:integer;
procedure traitligne;	(* analyse d'une ligne du fichier de donnees *)
var	cc	:char;
	i	:integer;
begin
cc := ligne[1];
case cc of
	'2','3','4'	:begin		(* ligne de reponse *)
			mem := false;
			if nr = 0	then	tsr[nsr+1].rep := xxx-1;
			nr := nr+1;
			stomes(nr);
			end;
	'0','1','6','7'	:begin		(* mots cles *)
			ic:=1;
			while ligne[ic+1] = ',' do
				begin
				nkey := nkey+1;
				if (ligne[ic] = '0' ) or (ligne[ic] = '6')
				then	begin
					nsr := nsr+1;
					with tsr[nsr] do
						begin
						nrep := nr;
						alea := 1;
						imem := mem;
						end;
					end;
				with tkey[nkey] do
					begin	(* stocker le mot cl‚ *)
					for i:=1 to nm do key[i]:=' ';
					key[nm] := ligne[ic];
					i := 1;   ic := ic+2;
					while (ic < j)
					and (ligne[ic] <> chr(9)) do
						begin
						key[i] := ligne[ic];
						i := i+1;    ic := ic+1;
						end;
					ic := ic+1;	nckey:=i-1;
					if ligne[ic]=chr(9)	then ic:=ic+1;
					psr := nsr;
					end;
				nr := 0;
				end;
			end;
	'5'		:begin		(* mot a retourner *)
			ntrad := ntrad+1;	(* moi --> toi *)
			ttrad1[ntrad] := logne;   ttrad2[ntrad] := lagne;
			nctrad1[ntrad] := n1+1;   nctrad2[ntrad] := n2;
			end;
	'9'		:xxx := 0;	(* fin du fichier *)
	'm'		:mem := true;	(* memorisation *)
	'*','#'		:begin		(* commentaire *)
			end;
	else		begin
			writeln(output,'PSY FAUX ',ligne);	xxx := 0;
			end;
	end;
end;
begin		(* code de initpsy *)
xmem := 0;	ymem := 0;	zmem := 0;	imm := 0;	nkey := 0;
ntrad := 0;	nsr := 0;	nr := 0;	vi := 0;	id := 0;
xxx := phpsy;
while xxx <> 0 do
	begin
	lirepsy(xxx);	xxx := xxx+1;	n1 := 0;	n2 := 0;
	for i := 1 to nm do	logne[i] := ' ';
	lagne := logne;	(* extraction des 2 mots a retourner du code 5 *)
	if ligne[1] <> 'm'
	then	begin
		j := 3;
		while (ligne[j] <> ',') and (ligne[j] <> ';') do
			begin
			if j < nm	then	logne[j-2] := ligne[j];
			j := j+1;	n1 := n1+1;
			end;
		i := 1;
		if ligne[1] = '5'	then	j := j+1;
		while ligne[j] <> ';' do
			begin
			if i < nm then	lagne[i] := ligne[j];
			i := i+1;	j := j+1; n2 := n2+1;
			end;
		ligne[j] := ' ';
		end;
	traitligne;
	end;
end;
procedure pentree;
var	i:integer;
begin		(* extraction des mots de la phrase *)

posi := 0;
mi := smi;
if mi <> 0
then	begin
	ligne[mi] := ' ';
	for i := 1 to mi-1 do
		begin
		car := ligne[i];
		if (car = ',') or (car = '''')
		or (car = '-') or (car = '?')
		then	ligne[i] := ' ';
		if ligne[i] = ' '
		then	begin	(* nouveau mot *)
			posi := posi+1;
			tposi[posi] := i+1;
			tposi[posi+1] := 1000;
			if (i > 1) and (ligne[i-1] = ' ')
			then	posi := posi-1;	(* 2 espaces *)
			end;
		end;
	end;


if mi = 0
then	begin	(* ligne vide *)
	vi := vi+1;
	if odd(vi)
	then	writeln(output,'allons mon petit, dis moi tout')
	else	writeln(output,'qu est ce que tu as, un gros chagrin');
	mi := 0;
	end
else	begin
	mi := mi+1;
	if ligne = sli
	then	begin	(* ligne egale a la precedente *)
		id := id+1;
		if odd(id)
		then	writeln(output,'tu te repetes')
		else	writeln(output,'tu viens de me le dire');
		mi := 0;
		end
	else	sli := ligne;
	end;
end;















procedure psyc;
var i,j,is:integer;
begin		(* recherche des mots cl‚ psy *)

ik := 0;
pz := 0;
while pz = 0 do
	begin
	if ik = nkey
	then	pz := 1
	else	begin		(* recherche du mot cle ik *)
		ik := ik+1;
		posi := 0;
		la := 1;
		az := tkey[ik].nckey;
		if la+az > mi+1
		then	ind := 1
		else	ind := 0;
		while ind = 0 do
			begin
			j := 0;
			while j < az do
				begin
				j := j+1;
				if ligne[la+j-1] <> tkey[ik].key[j]
				then	j := 1000;
				end;
			if j = 1000
			then	begin	(* passage au mot suivant
					de la phrase *)
				posi := posi+1;
				la := tposi[posi];
				if la+az > mi+1	then	ind := 1;
				end
			else	begin	(* c est lui *)
				ind := 1;
				pz := 1;
				sla := la;
				la := la+az;
				is := tkey[ik].psr;
				with tkey[ik],tsr[is] do
					begin
					if (tkey[ik].key[nm] = '6')
					or (tkey[ik].key[nm] = '7')
					then	begin
						if alea = nrep
						then tkey[ik].key[1] := '[';
						end;
					end;
				end;
			end;
		end;
	end;
end;









procedure repon;
	(* reponse du psy en fonction du mot cle *)
var	i	:integer;
procedure rajoutfin;
var	j	:integer;
begin	(* on rajoute la fin de la phrase du malade *)
while la < mi do
	begin
	i := 0;
	while i < ntrad do
		begin	(* faut il retourner le mot *)
		i := i+1;	pz := 0;	j := 0;
		while j < nctrad1[i] do
			begin
			j := j+1;
			if ligne[la+j-1] <> ttrad1[i][j]
			then	begin
				j := 1000;	pz := 1;
				end;
			end;
		if pz = 0
		then	begin			(* on retourne le mot *)
			la := la+nctrad1[i];	(* moi --> toi ... *)
			for j := 1 to nctrad2[i] do
				write(output,ttrad2[i][j]);
			write(output,' ');
			i := ntrad;
			end;
		end;
	if j = 1000
	then	begin
		y := 0;
		while y = 0 do
			begin
			if ligne[la] = ' '
			then	begin
				y := 1;
				la := la+1;
				end
			else	begin
				write(output,ligne[la]);
				la := la+1;
				end;
			end;
		write(output,' ');
		end;
	end;
end;
procedure sorcar(car:char);
begin
if car = ';'
then	pz := 1
else	begin
	if car = '$'
	then	begin
		aleat;
		if z	then	ecrnom	else	write(output,'Bibiche ');
		end
	else	begin
		if car = '^'  then  ecrnom  else  write(output,car);
		end;
	end;
end;
begin		(* code de repon *)
i := 2;
is := tkey[ik].psr;
if ik = nkey
then	begin	(* pas de mot cle dans la phrase *)
	if tsr[is].alea = 5
	then	if tsr[is-1].nrep <> 0	(* au bout de 5 *)
		then	ik := nkey-1;	(* on va poser des questions *)
	imm := imm+1;
	if imm = 5
	then	begin
		imm := 0;
		if ymem  <> 0
		then	begin	(* on va ressortir une phrase memorisee *)
			zmem := zmem+1;
			if zmem = nbmemo+1	then	zmem := 1;
			ligne := memolig[zmem];
			mi := memomi[zmem];
			la := 1;
			ik := 1;
			ymem := ymem-1;
			end;
		end;
	end;
is := tkey[ik].psr;
with tkey[ik],tsr[is] do
	begin
	if imem
	then	begin	(* on va memoriser la phrase *)
		xmem := xmem+1;
		if xmem = nbmemo+1	then	xmem := 1;
		memolig[xmem] := ligne;
		memomi[xmem] := mi;
		ymem := ymem+1;
		end;
	x := alea-1+rep;	(* choix de la reponse dans le lot
			de celles correspondant au mot cle *)
	liremes(x);
	if phrase^[1] = '4'	then	la := sla;
	i := 2;
	pz := 0;
	while pz = 0 do
		begin	(* sortie des caracteres de la reponse *)
		i := i+1;
		car := phrase^[i];
		sorcar(car);
		end;
	write(output,' ');
	if alea = nrep
	then	begin
		alea := 1;
		if ik = nkey-1	then	tsr[is].nrep := 0;
		end
	else	alea := alea+1;
	if (phrase^[1] = '3') or (phrase^[1] = '4')
	then	rajoutfin;  (* on rajoute la fin de la phrase du malade *)
	end;
writeln(output);
end;	
