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.