program mendel1;
uses crt;
var d,fp,fm,f1,r:string[20];
      s:char;
      tipo:integer;
 procedure chiede;

begin
clrscr;
write('scrivi fenotipo paterno=nero ');readln(fp);
write('scrivi fenotipo materno=bianco ');readln(fm);
write('scrivi fenotipo filiale1=nero ');readln(f1);
writeln('-----------------------------------');
if f1=fp then begin d:=fp ;r:=fm;tipo:=1;end
  else if f1=fm then begin d:=fm;r:=fp;tipo:=1;end
    else  begin tipo:=2;end;

case tipo of
1:begin
writeln('fattore dominante=',d);
writeln('fattore recessivo =',r);end;
2:begin
writeln('fattore codominante=',fp);
writeln('fattore codominante =',fm);end;
end;
writeln;
writeln('-----------------------------------');
write('altra prova:scrivi S...per finire scrivi N ');readln(s);
if ((s='S') or (s='s')) then chiede;
end;

begin
clrscr;
writeln('esempio legge DOMINANZA o UNIFORMITA prima generazione ');
writeln('PRIMA LEGGE DI MENDEL ');
writeln('ipotesi di razze pure o omozigotiche per il  carattere');
writeln('si devono inserire i fenotipi dei genitori ');
writeln('e il fenotipo dei figli di prima generazione');
writeln;
writeln('premi ENTER');readln;
chiede;
end.