genetica mendeliana

ritorna biologiaturbo.htm

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.