program mendelx;
(* legge della dominanza *)

uses crt;
var carattere,f1,f2,f12,fd,fr:string[20];
    a1,a2:char;
    x:integer;

procedure cancella;
begin
clrscr;
end;

procedure stampa;
var s:string[4];
begin
s:='  ';
writeln('carattere :',carattere);
textcolor(3);writeln('lettera codificante dominante :',a1);
textcolor(6);writeln('lettera codificante recessivo :',a2);
textcolor(3);writeln('allele dominante              :',fd);
textcolor(6);writeln('allele recessivo              :',fr);
writeln('--------------------------------');
textcolor(3);writeln('fenotipo dominante   =',fd);
writeln('genotipo dominante   =',a1+a1,' gameti :',a1,s,a1);
writeln('---------------------------------');
textcolor(6);writeln('fenotipo recessivo   =',fr);
writeln('genotipo recessivo   =',a2+a2,' gameti :',a2,s,a2);
writeln('---------------------------------');
textcolor(3);writeln('fenotipo filiale     =',fd);
writeln('genotipo filiale     =',a1+a2);
writeln('---------------------------------');
end;

procedure chiede;
var ris:char;
begin
cancella;
textcolor(15);
writeln('scrivere tutto minuscolo ');
writeln('genitori entrambi omozigotici per il carattere considerato');
write('scrivi tipo carattere:es.colore ');readln(carattere);
cancella;
write('scrivi fenotipo 1 genitore            =nero ');readln(f1);
write('scrivi fenotipo 2 genitore            =bianco ');readln(f2);
repeat
write('scrivi fenotipo generazione filiale 1 =nero ');readln(f12);
until (f12=f1) or (f12=f2);
writeln('----------------------------------------------------');
if f12=f1 then x:=1 else x:=2;
case x of
1:begin a1:=upcase(f1[1]);a2:=f1[1];fd:=f1;fr:=f2;stampa;end;
2:begin a1:=upcase(f2[1]);a2:=f2[1];fd:=f2;fr:=f1;stampa;end;
end;
write('scrivi S per altra prova,scrivi N per finire ' );readln(ris);
if upcase(ris)='S' then chiede;
end;

begin
cancella;
chiede;
end.