program mendelz; (* 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 pausa; begin write('premi INVIO');readln; 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 stampa1; var s:string[4]; begin s:=' '; if ((f1=f12)) then begin a1:=upcase(f1[1]);fd:=f1;fr:=f2;a2:=f1[1];end else begin a1:=upcase(f2[1]);fd:=f2;fr:=f1;a2:=f2[1];end; writeln('carattere :',carattere); textcolor(3);writeln('lettera codificante dominante :',a1); textcolor(6);writeln('lettera codificante recessivo :',a2); textcolor(3);writeln('allele dominante :',fd); textcolor(6);writeln('allele recessivo :',fr); writeln('--------------------------------'); textcolor(3);writeln('fenotipo dominante =',fd); writeln('genotipo dominante =',a1+a1,' gameti :',a1,s,a1); writeln('---------------------------------'); textcolor(6);writeln('fenotipo recessivo =',fr); writeln('genotipo recessivo =',a2+a2,' gameti :',a2,s,a2); writeln('---------------------------------'); textcolor(3);writeln('fenotipo filiale =',f12); writeln('genotipo filiale =',a1+a2); writeln('---------------------------------'); end; procedure chiede; var ris:char; begin cancella; textcolor(15); writeln('scrivere tutto minuscolo '); writeln('genitori entrambi omozigotici per il carattere considerato'); write('scrivi tipo carattere:es.colore ');readln(carattere); write('scrivi fenotipo 1 genitore =giallo ');readln(f1); write('scrivi fenotipo 2 genitore =verde ');readln(f2); write('scrivi fenotipo generazione filiale 1 =verde o rosso ');readln(f12); if ((f12<>f1) and (f12<>f2)) then stampa else stampa1; writeln('----------------------------------------------------'); write('scrivi S per altra prova,scrivi N per finire ' );readln(ris); if upcase(ris)='S' then chiede; end; begin cancella; writeln('legge della UNIFORMITA o della DOMINANZA '); writeln('inserire fenotipi genitori Dominante,Recessivo '); writeln('inserire fenotipo filiale1 come genitori o diverso '); pausa;cancella; chiede; end.