program mendel3;
uses crt;
var m,p,f,d,fp,fm,f1,r:string[20];
      s,g1,g2:char;
      tipo,cd,cr: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);
writeln('-----------------------------------');
if f1=fp then begin d:=fp ;r:=fm;g1:=upcase(fp[1]);g2:=fp[1];tipo:=1;end
  else if f1=fm then begin d:=fm;r:=fp;g1:=upcase(fm[1]);g2:=fm[1];tipo:=1;end
    else  begin tipo:=2;g1:=upcase(fp[1]);g2:=upcase(fm[1]);end;

case tipo of
1:begin
textcolor(cd);writeln('fattore dominante=',d);
textcolor(cr);writeln('fattore recessivo =',r);end;
2:begin
textcolor(cd);writeln('fattore codominante=',fp);
textcolor(cr);writeln('fattore codominante =',fm);end;
end;
writeln;
textcolor(15);
writeln('legge della dominanza o uniformita prima generazione');
writeln('-----------------------------------');
writeln('dominante o codominante':30,'recessivo o codominante':30);
writeln('genotipo =  ':30,g1,g1,'      genotipo  =  ':30,g2,g2);
writeln('genotipo generazione1  100% eterozigote = ':50,g1,g2);
writeln('------------------------------------');
writeln('premi enter per vedere seconda legge di Mendel');readln;
writeln('incrociando due individui eterozigotici prima generazione');
writeln('genotipo1 ':30,g1,g2,' genotipo2 ':30,g1,g2);
writeln('genotipo seconda generazione :25% omozigote    ',g1,g1);
writeln('genotipo seconda generazione :25% eterozigote  ',g1,g2);
writeln('genotipo seconda generazione :25% eterozigote  ',g1,g2);
writeln('genotipo seconda generazione :25% omozigote    ',g2,g2);
write('altra prova:scrivi S...per finire scrivi N ');readln(s);
if ((s='S') or (s='s')) then chiede;
end;

begin
clrscr;
writeln('scrivere colori per fenotipi ');
writeln('numeri da 1 a 15 se video a colori ');
writeln('scrivere 3,6 o 15 se bianco nero ');
write('colore primo fenotipo =');readln(cd);
write('colore secondo fenotipo =');readln(cr);
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('SECONDA LEGGE DI MENDEL');
writeln;
writeln('premi ENTER');readln;
chiede;
end.