program ABO3;
(* variante di AB02 migliore *)
uses crt;
var feno:string[10];
      s:char;
      tipo,esatte,errate,totale:integer;
      f:array[1..9] of string[10];
      g:array[1..9] of string[10];
      h:array[1..9] of string[10];
      
 procedure gruppi;  
 begin
 f[1]:='A,0';f[2]:='B,0';f[3]:='0';f[4]:='A,B,AB';f[5]:='A,B,AB,0';
 f[6]:='A,0';f[7]:='A,B,AB';f[8]:='B,0';f[9]:='A,B,AB';
 g[1]:='0,A';g[2]:='0,B';g[3]:='0';g[4]:='A,B,AB';g[5]:='A,B,AB,0';
 g[6]:='0,A';g[7]:='A,B,AB';g[8]:='0,B';g[9]:='A,B,AB';
 h[1]:='A,A';h[2]:='B,B';h[3]:='0,0';h[4]:='AB,AB';h[5]:='A,B';
 h[6]:='A,0';h[7]:='A,AB';h[8]:='B,0';h[9]:='B,AB';
 
 clrscr;
 writeln('indicare fenotipo dei genitori,scrivendo il numero ');
 writeln('----------------------------------------------------');
 writeln('1...A,A');
 writeln('2...B,B');
 writeln('3...0,0');
 writeln('4...AB,AB');
 writeln('5...A,B');
 writeln('6...A,0');
 writeln('7...A,AB');
 writeln('8...B,0');
 writeln('9...B,AB');
 writeln('-----------------------------------------------------');
 write('fenotipo=');readln(tipo);
 end;
 
    
      
 procedure chiede;  
 begin
 gruppi;
 clrscr;
 writeln('fenotipo genitori=',h[tipo]);
 writeln('-------------------------------------------------');
 writeln('indicare fenotipi possibili nei figli ');
 writeln('scrivendo le sigle separate da virgola ');
 writeln('es.A,AB......0.....A,0..');
 writeln('es.se sono 3-4 scrivere in ordine A,B,AB,0 ');
 writeln('--------------------------------------------------');
 writeln('fenotipi possibili=');readln(feno);
 if ((feno<>f[tipo]) and (feno<>g[tipo])) then 
 begin writeln('errato:era :',f[tipo]) ;errate:=errate+1;end
 ELSE begin WRITELN('esatto:  ',f[tipo]);esatte:=esatte+1;end;
 writeln('--------------------------------------------------');
 writeln('premi INVIO');
 readln;clrscr;
 writeln('scrivi S per altra prova,oppure N per finire');
 write('scelta=');readln(s);
 if ((s='S') or (s='s')) then chiede;
 end;
 
    
begin
clrscr;
writeln;
esatte:=0;errate:=0;totale:=0;
writeln('GENETICA dei GRUPPI SANGUIGNI AB0 ');
writeln('esempio di fenotipi compatibili nei figli');
writeln('in funzione dei fenotipi noti nei genitori');
writeln('-------------------------------------------');
writeln('ricordare che A e B sono codominanti e 0 recessivo');
writeln('premi ENTER');readln;
chiede;
clrscr;
totale:=esatte+errate;
writeln('risposte esatte = ',esatte);
writeln('risposte errate = ',errate);
writeln('domande totali  = ',totale);
writeln('premi INVIO per finire ');readln;clrscr;
end.