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.