program mendely;
(* legge della dominanza o uniformita prima generazione *)

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:='  ';
a1:=upcase(f1[1]);a2:=upcase(f2[1]);
writeln('carattere :',carattere);
textcolor(3);writeln('lettera codificante codominante :',a1);
textcolor(6);writeln('lettera codificante codominante :',a2);
textcolor(3);writeln('allele codominante              :',f1);
textcolor(6);writeln('allele codominante              :',f2);
writeln('--------------------------------');
textcolor(3);writeln('fenotipo codominante1   =',f1);
writeln('genotipo codominante1   =',a1+a1,' gameti :',a1,s,a1);
writeln('---------------------------------');
textcolor(6);writeln('fenotipo codominante2   =',f2);
writeln('genotipo codominante2   =',a2+a2,' gameti :',a2,s,a2);
writeln('---------------------------------');
textcolor(5);writeln('fenotipo filiale     =',f12);
writeln('genotipo filiale     =',a1+a2);
writeln('---------------------------------');
end;

procedure chiede;
var ris:char;
begin
cancella;
writeln('scrivere tutto minuscolo ');
writeln('genitori entrambi omozigotici per il carattere considerato');
writeln('fenotipo filiale diverso da fenotipi genitori');
write('scrivi tipo carattere:es.colore ');readln(carattere);
cancella;
write('scrivi fenotipo 1 genitore            =giallo ');readln(f1);
write('scrivi fenotipo 2 genitore            =verde ');readln(f2);
repeat
write('scrivi fenotipo generazione filiale 1 =rosso ');readln(f12);
until ((f12<>f1) and(f12<>f2));
stampa;
writeln('----------------------------------------------------');
write('scrivi S per altra prova,scrivi N per finire ' );readln(ris);
if upcase(ris)='S' then chiede;
end;

begin
cancella;
chiede;
end.