program mendel2;
uses crt;
var m,p,f,d,fp,fm,f1,r,g1,g2:string[20];
      s:char;
      tipo:integer;

 procedure chiede;      
begin
clrscr;
write('scrivi fenotipo genitore1=nero ');readln(fp);
write('scrivi fenotipo genitore2=bianco ');readln(fm);
write('scrivi fenotipo filiale1=nero ');readln(f1);
p:=copy(fp,1,1);m:=copy(fm,1,1);
writeln('-----------------------------------');
if f1=fp then begin d:=fp ;r:=fm;g1:=p;g2:=m;tipo:=1;end
  else if f1=fm then begin d:=fm;r:=fp;g1:=m;g2:=p;tipo:=1;end
    else  begin tipo:=2;g1:=p;g2:=m;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('-----------------------------------');
writeln('dominante o codominante':30,'recessivo o codominante':30);
writeln('genotipo =  ':30,g1,g1,'      genotipo =  ':30,g2,g2);
writeln('genotipo generazione1 = ':50,g1,g2);
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('viene segnalato anche il GENOTIPO ');
writeln;
writeln('premi ENTER');readln;
chiede;
end.