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.