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.