{$R-}    {Range checking off}
{$B-}    {Short-circuit boolean evaluation}
{$S+}    {Stack checking on}
{$I-}    {I/O error checking off}
{$N-}    {No numeric coprocessor}

program maiz;

{Copyright 1988, Curtis Clark and Jaime Tres}

Uses
  Crt,dos,graph;

const
   xpos : array[0..4] of integer =
   (10,21,32,43,68);
   ypos : array[0..3] of integer =
   (7,10,13,16);

   NULL = #0;
   BS = #8;
   FORMFEED = #12;
   CR = #13;
   ESC = #27;
   HOMEKEY = #199;
   ENDKEY = #207;
   UPKEY = #200;
   DOWNKEY = #208;
   PGUPKEY = #201;
   PGDNKEY = #209;
   LEFTKEY = #203;
   INSKEY = #210;
   RIGHTKEY = #205;
   DELKEY = #211;
   CTRLLEFTKEY = #243;
   CTRLRIGHTKEY = #244;
   F1 = #187;
   F2 = #188;
   F3 = #189;
   F4 = #190;
   F5 = #191;
   F6 = #192;
   F7 = #193;
   F8 = #194;
   F9 = #195;
   F10 = #196;

type
   string79 = string[79];
   charset  = set of char;

var
   total,
   temptotal   : longint;
   n,m,
   choice,
   valerror    : integer;
   done,mono,
   stats,
   stop,
   bw,
   abort,
   win         : boolean;
   ch          : char;
   switch      : string[2];
   colorsave  : byte;

{-----------------------------------------------------------------------}

procedure checkmono;

var gd,gm : integer;

begin
   gd := detect;
   detectgraph(gd,gm);
   if (gd=-2) or (gd=7) then mono := true else mono := false;
   if gd=1 then checksnow := true else checksnow := false
end;

{-----------------------------------------------------------------------}

procedure checkparams;

begin
   bw := false;
   if paramcount = 0 then exit else switch := paramstr(1);
   if (switch = '/b') or (switch = '/B') then begin
      mono := true;
      bw   := true;
   end;
end;

{-----------------------------------------------------------------------}

procedure SetCursor (StartLine,EndLine : Integer);

var
   RegPack : Registers;
CxRegArray : Array [1..2] of Byte;
     CxReg : integer absolute CxRegArray;

begin
     CxRegArray [2] := Lo (StartLine);
     CxRegArray [1] := Lo (EndLine);
     With RegPack do
          begin
               ax := $0100;          {ah = 1 means set cursor type         }
               bx := $0;             {bx = page number, zero for us        }
               cx := CxReg;          {cx bits 4 to 0 = start line for      }
                                     {Cursor                               }
                                     {cl bits 4 to 0 = end line for cursor }
               intr ($10,RegPack);   {set cursor                           }
          end;
end;

{-----------------------------------------------------------------------}

function GetKey : Char;
{ Reads the next keyboard character }
var
  C : Char;
begin
  C := ReadKey;
  repeat
    if C = NULL then
    begin
      C := ReadKey;
      if Ord(C) > 127 then
        C := NULL
      else
        GetKey := Chr(Ord(C) + 128);
    end
    else
      GetKey := C;
  until C <> NULL;
end; { GetKey }

{-----------------------------------------------------------------------}

procedure GetLine(var S: String79;            { String to edit       }
                         OkCh: charset;       { OK characters        }
                         ColNO,LineNO,        { Where start line     }
                         MAX,                 { Max length           }
                         ErrPos: integer;     { Where to begin       }
                         var abort:Boolean);  { abort if ESC         }
var
  X,n      : integer;
  InsertOn : boolean;
  OkChars  : set of Char;


  procedure GotoX;
  begin
    GotoXY(X+ColNo-1,LineNo);
  end;

begin
  InsertOn:=false;
  abort := false;
  OkChars:=OkCh;
  X:=1; GotoX;
  Write(S);
  if Length(S)=1 then X:=2;
  if ErrPos<>0 then X:=ErrPos;
  GotoX;
  repeat
    if inserton then
       if mono then setcursor(1,14) else setcursor(1,7)
    else
       if mono then setcursor(13,14) else setcursor(6,7);
    Ch := getkey;
    case Ch of
     ESC      : begin
                  S:=''; { abort editing }
                  Ch:=CR;
                  abort := true;
                end;
     RIGHTKEY: begin { Move cursor right }
                  X:=X+1;
                  if (X>length(S)+1) or (X>MAX) then X:=X-1;
                  GotoX;
                end;
     DELKEY   : begin { Delete right char }
                  if X<=Length(S) then
                  begin
                    Delete(S,X,1);
                    Write(copy(S,X,Length(S)-X+1),' ');
                    GotoX;
                  end;
                end;
     LEFTKEY  : begin { Move cursor left }
                  X:=X-1;
                  if X<1 then X:=1;
                  GotoX;
                end;
     ENDKEY   : begin { Move cursor to end of line }
                   X:=Length(S)+1;
                   GotoX;
                end;
     HOMEKEY  : begin { Move cursor to beginning of line }
                  X:=1;
                  GotoX;
                end;
     BS       : begin { Delete left char }
                  X:=X-1;
                  if (Length(S)>0) and (X>0)  then
                  begin
                    Delete(S,X,1);                         gotox;
                    Write(copy(S,X,Length(S)-X+1),' ');
                    GotoX;
                    if X<1 then X:=1;
                  end else X:=1;
                end;
     INSKEY   : InsertOn:= not InsertOn;
    else
      begin
        if Ch in OkChars  then
        begin
          if InsertOn then
          begin
            insert(Ch,S,X);
            Write(copy(S,X,Length(S)-X+1),' ');
          end else
          begin
            write(Ch);
            if X=length(S)+1 then S:=S+Ch
              else S[X]:=Ch;
          end;
          if (Length(S)+1<=MAX) or ((not inserton) and (x+1<=max)) then X:=X+1
          else OkChars:=[]; { Line too Long }
          GotoX;
        end else
        if (Length(S)+1<=Max) or ((not inserton) and (x+1<=max)) then
          OkChars:= OkCh; { Line ok again }
      end;
    end;
  until CH=CR;
  x := 1;
  gotox;
  write(S);
  for n := length(S) to max do write(' ');
  gotox
end;

{-----------------------------------------------------------------------}

procedure openscreen;

   const
      smooth   = 79;                          {2}
      wrinkled = 88;                          {1}

   var
      row, column : integer;
      ch          : char;
      cob         : array[1..80,1..8] of byte;

   begin
      textcolor(yellow);
      textbackground(black);
      clrscr;
writeln('');
WriteLn('                      ÛÛ     ÛÛ    ÛÛÛ    ÛÛÛÛ  ÛÛÛÛÛÛÛ');
WriteLn('                      ÛÛÛ   ÛÛÛ   ÛÛ ÛÛ    ÛÛ        ÛÛ');
WriteLn('                      ÛÛÛÛ ÛÛÛÛ  ÛÛ   ÛÛ   ÛÛ       ÛÛ');
WriteLn('                      ÛÛ ÛÛÛ ÛÛ  ÛÛ   ÛÛ   ÛÛ      ÛÛ');
WriteLn('                      ÛÛ  Û  ÛÛ  ÛÛÛÛÛÛÛ   ÛÛ     ÛÛ');
WriteLn('                      ÛÛ     ÛÛ  ÛÛ   ÛÛ   ÛÛ    ÛÛ');
WriteLn('                      ÛÛ     ÛÛ  ÛÛ   ÛÛ  ÛÛÛÛ  ÛÛÛÛÛÛÛ');
writeln;
writeln;
textcolor(lightgreen);
WriteLn('                 Una Simulaci¢n del Cl sico Cruce Dih¡brido');
writeln;
WriteLn('                 endosperma:  almidonado (S) ¢ dulce    (s)');
WriteLn('                   aleurona:  purpura    (R) ¢ amarilla (r)');
gotoxy(1,25);textcolor(brown);
{write('******** 1988, Curtis Clark y Jaime Tres');}
textcolor(white);
Write('                                       Precione cualquier tecla para continuar');

      for row := 1 to 8 do
         for column := 1 to 80 do
            cob[column,row] := random(16);
      gotoxy(1,16);
      for row := 1 to 8 do
         for column := 1 to 80 do begin
            case cob[column,row] of
               0..8 : begin
                         textcolor(magenta);
                         write(chr(smooth))
                      end;
              9..11 : begin
                         textcolor(yellow);
                         write(chr(smooth))
                      end;
             12..14 : begin
                         textcolor(magenta);
                         write(chr(wrinkled))
                      end;
                 15 : begin
                         textcolor(yellow);
                         write(chr(wrinkled))
                      end;
            end;  {case}
         end;  {for}
         ch := readkey;
      end;

{-----------------------------------------------------------------------}

procedure getchoice(var choice : integer);

const
   xpos = 2;
   xofs = 6;
   f1pos = 1;

var
   textc,textb,hc,hb : byte;

   begin
      if mono then begin
         textc := white;
         textb := black;
         hc    := black;
         hb    := lightgray
      end else begin
         textc := white;
         textb := blue;
         hc    := white;
         hb    := green
      end;
      textbackground(textb);
      window(2,19,78,23);
      clrscr;
      textbackground(hb);
      textcolor(hc);
      gotoxy(xpos,f1pos+0);
      write(' F1  ');
      gotoxy(xpos,f1pos+1);
      write(' F2  ');
      gotoxy(xpos,f1pos+2);
      write(' F3  ');
      gotoxy(xpos,f1pos+3);
      write(' F4  ');
      gotoxy(xpos,f1pos+4);
      write(' ESC ');
      textbackground(textb);
      textcolor(textc);
      gotoxy(xpos+xofs,f1pos+0);
      write('Instrucciones');
      gotoxy(xpos+xofs,f1pos+1);
      write('Observe el efecto del tama¤o de la muestra');
      gotoxy(xpos+xofs,f1pos+2);
      write('Corridas m£ltiples con un tama¤o de muestra fijo');
      gotoxy(xpos+xofs,f1pos+3);
      write('Juege un juego');
      gotoxy(xpos+xofs,f1pos+4);
      write('Termine');
      repeat
         ch := getkey;
      until ch in [ESC,f1,f2,f3,f4];
      case ch of
         f1 : choice := 1;
         f2 : choice := 2;
         f3 : choice := 3;
         f4 : choice := 4;
        ESC : choice := 5;
      end;
      clrscr;
      window(1,1,80,25);
   end;

{-----------------------------------------------------------------------}

procedure punnett;
   begin
      if mono then begin
         textcolor(lightgray);
         textbackground(black)
      end else begin
         textcolor(white);
         textbackground(blue)
      end;
      clrscr;
      writeln('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
      writeln('³                      Genotipos                    ³ Relaciones Fenot¡picas  ³');
      writeln('³                                                   ³                         ³');
      writeln('³         RS         Rs         rS         rs       ³                         ³');
      writeln('³    ÉÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍ»  ³                         ³');
      writeln('³ RS º   RRSS   º   RRSs   º   RrSS   º   RrSs   º  ³  P£rpura                ³');
      writeln('³    º          º          º          º          º  ³  Almidonado:            ³');
      writeln('³    ÌÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍ͹  ³                         ³');
      writeln('³ Rs º   RRSs   º   RRss   º   RrSs   º   Rrss   º  ³  Amarilla               ³');
      writeln('³    º          º          º          º          º  ³  Almidonado:            ³');
      writeln('³    ÌÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍ͹  ³                         ³');
      writeln('³ rS º   RrSS   º   RrSs   º   rrSS   º   rrSs   º  ³  P£rpura                ³');
      writeln('³    º          º          º          º          º  ³  Dulce:                 ³');
      writeln('³    ÌÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍ͹  ³                         ³');
      writeln('³ rs º   RrSs   º   Rrss   º   rrSs   º   rrss   º  ³  Amarilla               ³');
      writeln('³    º          º          º          º          º  ³  Dulce:                 ³');
      writeln('³    ÈÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍͼ  ³                         ³');
      writeln('ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´');
      writeln('³                                                                             ³');
      writeln('³                                                                             ³');
      writeln('³                                                                             ³');
      writeln('³                                                                             ³');
      writeln('³                                                                             ³');
      writeln('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
   end;

{-----------------------------------------------------------------------}

procedure makeprogeny(total:longint;chi:boolean;var notsigdif,r9331:boolean);

   const
      chix = 56;
      chiy = 4;

   var
      progeny     : array[0..3,0..3] of longint;
      gamete1,
      gamete2     : integer;
      domdom,
      domrec,
      recdom,
      recrec,
      dd,rd,dr,rr,
      ddexpected,
      rdexpected,
      drexpected,
      rrexpected,
      chisquare  : real;

   begin
      setcursor(32,0);
      r9331 := false;
      notsigdif := false;
      stop := false;
      for n := 0 to 3 do for m := 0 to 3 do begin
         progeny[n,m] := 0;
         gotoxy(xpos[n],ypos[m]);
         write('    ')
      end;
      gotoxy(chix,chiy);
      write('                   ');
      gotoxy(xpos[4],ypos[0]);
      write('        ');
      gotoxy(xpos[4],ypos[1]);
      write('        ');
      gotoxy(xpos[4],ypos[2]);
      write('        ');
      gotoxy(xpos[4],ypos[3]);
      write('        ');
      for n := 1 to total do
         begin
            if keypressed then if readkey = #27 then begin
               stop := true;
               exit
            end;
            gamete1 := random(4);
            gamete2 := random(4);
            progeny[gamete1,gamete2] := progeny[gamete1,gamete2] + 1;
            gotoxy(xpos[gamete1],ypos[gamete2]);
            write(int(progeny[gamete1,gamete2]):4:0);
         end;
      dd     := (progeny[0,0] + progeny[0,1] + progeny[0,2] + progeny[0,3] +
                 progeny[1,0] + progeny[1,2] + progeny[2,0] + progeny[2,1] +
                 progeny[3,0]);
      domdom := dd * 16 / total;
      rd     := (progeny[1,1] + progeny[1,3] + progeny[3,1]);
      recdom := rd * 16 / total;
      dr     := (progeny[2,2] + progeny[2,3] + progeny[3,2]);
      domrec := dr * 16 / total;
      rr     := (progeny[3,3]);
      recrec := rr * 16 / total;
      gotoxy(xpos[4],ypos[0]);
      write(domdom:5:2);
      gotoxy(xpos[4],ypos[1]);
      write(recdom:5:2);
      gotoxy(xpos[4],ypos[2]);
      write(domrec:5:2);
      gotoxy(xpos[4],ypos[3]);
      write(recrec:5:2);
      if chi then begin
         ddexpected := total/16*9;
         drexpected := total/16*3;
         rdexpected := total/16*3;
         rrexpected := total/16;
         chisquare :=sqr((dd-ddexpected))/ddexpected +
                     sqr((rd-rdexpected))/rdexpected +
                     sqr((dr-drexpected))/drexpected +
                     sqr((rr-rrexpected))/rrexpected;
         gotoxy(chix,chiy);
         write('Xý=',chisquare:4:2);
         gotoxy(chix+10,chiy);
         if chisquare < 7.815 then begin
            write('p > 0.05');
            notsigdif := true;
         end else begin
            colorsave := textattr;
            if mono then begin
               textcolor(black);
               textbackground(lightgray)
            end else textcolor(lightred);
            write('p < 0.05');
            textattr := colorsave;
            notsigdif := false;
         end;
      end;
      if total = 16 then
         if (round(domdom)=9)  and
            (round(recdom)=3)  and
            (round(domrec)=3)  and
            (round(recrec)=1)  then r9331 := true;
   end;

{-----------------------------------------------------------------------}

procedure samplesize;

const
   ypos = 20;
   xpos = 4;
   xofs = 6;
   f1pos = 19;
   enterxpos = 20;
   againxpos = 22;
   wrypos = 4;

var
   tempstring  : string79;
   textc,textb,
   hc,hb       : byte;

   begin
      total := 16;
      if mono then begin
         textc := white;
         textb := black;
         hc    := black;
         hb    := lightgray
      end else begin
         textc := yellow;
         textb := blue;
         hc    := white;
         hb    := red
      end;
      textbackground(hb);
      textcolor(hc);
      gotoxy(xpos,f1pos);
      write(' F1  ');
      gotoxy(xpos,f1pos+1);
      write(' F2  ');
      gotoxy(xpos,f1pos+4);
      write(' ESC ');
      textbackground(textb);
      textcolor(textc);
      gotoxy(xpos+xofs,f1pos);
      write('Ejecute');
      gotoxy(xpos+xofs,f1pos+1);
      write('Cambie el n£mero de la progenie');
      gotoxy(xpos+xofs,f1pos+4);
      write('Regrese al men£ principal');
      textcolor(textc);
      gotoxy(6,2);
      write('progenie = ');
      textcolor(hc); textbackground(hb);
      write(total);
      textcolor(textc); textbackground(textb);
      repeat
         repeat
            ch := getkey;
         until ch in [ESC,f1,f2];
         case ch of
            f1 : begin
                    textcolor(textc); textbackground(textb);
                    makeprogeny(total,true,stats,win);
                 end;
            f2 : begin
                    tempstring := '';
                    gotoxy(xpos+xofs,f1pos+2);
                    write('Entre un nuevo valor, 1-16000 > ');
                    repeat
                       getline(tempstring,['0'..'9'],wherex,wherey,6,1,abort);
                       val(tempstring,temptotal,valerror);
                    until (abort) or ((temptotal > 0) and (temptotal <= 16000));
                    if not abort then total := temptotal;
                    setcursor(32,0);
                    gotoxy(17,2);
                    write('     ');
                    textcolor(hc); textbackground(hb);
                    gotoxy(17,2);
                    write(total);
                    textcolor(textc); textbackground(textb);
                    gotoxy(xpos+xofs,f1pos+2);
                    write('                                           ');
                 end;
           ESC : begin
                    gotoxy(6,2);
                    write('               ');
                    gotoxy(40,2);
                    write('            ');
                    exit
                 end;
         end;
      until false;
   end;

{-----------------------------------------------------------------------}

procedure game;

   const
      xpos = 3;
      xofs = 6;
      f1pos = 19;

   var
      dollars,
      bet,
      housetotal,
      debt      : longint;
      textc,
      textb,
      hc,hb     : byte;
      betstring : string79;
      alldone   : boolean;

   procedure done;
      var owe : longint; junk : string79; trash : boolean;

      begin
         window(2,19,78,23);
         clrscr;
         writeln(' ¨As¡ que est  listo para retirarse?  Echemos un vistazo a sus finanzas.');
         writeln(' Usted tiene $',dollars,' en efectivo.  Su deuda a la casa es de $',debt,'.');
         owe := dollars - debt;
         if owe > 0 then
            if owe > 1000 then begin
               writeln(' Eso le da $',owe,' para llevar a su casa. ­Felicitaciones!');
               writeln(' Sali¢ ganando.  Regrese alguna vez y juege de nuevo.')
            end else begin
               writeln(' Eso le da $',owe,' para llevar a su casa.  ­No se sienta tan deprimido!');
               writeln(' Mucha gente lo han hecho peor.');
            end
         else if owe = 0 then writeln(' Eso da nada para usted, pero, ­hey!, ­todav¡a tiene su camisa!')
            else begin
               writeln(' As¡ que yo tomo ese efectivo, y usted nos debe otros $',abs(owe),'.');
               write(' Used tiene VISA, MasterCard, ¢ AmericanExpress, ¨verdad? (S/N)');
               repeat ch := readkey until ch in ['s','S','n','N'];
               case ch of
                  'S','s' : begin
                               clrscr;
                               writeln;
                               write(' Entre el n£mero: ');
                               junk := '';
                               getline(junk,['0'..'9'],wherex,wherey,23,1,trash);
                               writeln;
                               junk := '';
                               write(' Entre la fecha de expiraci¢n: ');
                               getline(junk,['0'..'9'],wherex,wherey,6,1,trash);
                               setcursor(32,0);
                               writeln;
                               write(' Llamando...');

sound(83); delay(1000); sound(670); delay(100); nosound; delay(50); sound(830);

delay(100); nosound; delay(50); sound(670); delay(100); nosound; delay(50);

sound(750); delay(100); nosound; delay(50); sound(830); delay(100); nosound;

delay(50); sound(750); delay(100); nosound; delay(50); sound(830); delay(100);

nosound; delay(50); nosound;
                               writeln(' Transacci¢n completa');
                               write(' Precione cualquier tecla');
                            end;
                  'N','n' : begin
                               clrscr;
                               writeln;
                               writeln(' Creo que es mejor que pase a la oficina y hable con mi asociado...');
                            end;
               end
            end;
         ch := readkey;
         window(1,1,80,25);
         gotoxy(56,4);
         write('                    ');
         gotoxy(6,2);
         write('               ');
         gotoxy(40,2);
         write('            ');
         exit
      end;


   begin
      dollars   := 1000;
      housetotal:= 100000;
      bet       := 10;
      debt      := 0;
      win       := false;
      alldone   := false;
      if mono then begin
         textc := white;
         textb := black;
         hc    := black;
         hb    := lightgray
      end else begin
         textc := white;
         textb := blue;
         hc    := white;
         hb    := red
      end;
      textbackground(hb);
      textcolor(hc);
      gotoxy(xpos,f1pos);
      write(' F1  ');
      gotoxy(xpos,f1pos+1);
      write(' F2  ');
{      gotoxy(xpos,f1pos+2);
      write(' F3  ');           }
      gotoxy(xpos,f1pos+3);
      write(' F4  ');
      gotoxy(xpos,f1pos+4);
      write(' ESC ');
      textbackground(textb);
      textcolor(textc);
      gotoxy(xpos+xofs,f1pos);
      write('Ejecute');
      gotoxy(xpos+xofs,f1pos+1);
      write('Cambie su apuesta');
      gotoxy(xpos+xofs,f1pos+3);
      write('Prestar $1000');
      gotoxy(xpos+xofs,f1pos+4);
      write('Regrese al men£ principal');
      textcolor(textc-1);
      repeat
         gotoxy(50,f1pos+1);
         write('                           ');
         gotoxy(50,f1pos+1);
         write('Usted tiene $',dollars,' restantes');
         gotoxy(50,f1pos+2);
         write('                           ');
         gotoxy(50,f1pos+2);
         write('Usted debe a la casa $',debt);
         if dollars < bet then bet := dollars;
         gotoxy(50,f1pos+3);
         write('                           ');
         gotoxy(50,f1pos+3);
         write('Apuesta actual: $',bet,'     ');
         repeat
            ch := getkey;
         until ch in [ESC,f1,f2,f3,f4];
         gotoxy(54,4);
         write('                        ');
         case ch of
            f1 : begin
                    makeprogeny(16,false,stats,win);
                    if win then begin
                       dollars := dollars + bet * 42;
                       gotoxy(56,4);
                       textattr := textattr + blink;
                       if dollars >= housetotal then begin
                          write('­FELICITACIONES!');
                          sound(440);
                          delay(200);
                          sound(660);
                          delay(500);
                          nosound;
                          window(2,19,78,23);
                          clrscr;
                          textattr := textattr - blink;
                          gotoxy(22,2);
                          write('Usted ha exhedido el l¡mite de la casa');
                          gotoxy(27,5);
                          write('Precione ESC para continuar');
                          repeat ch := readkey until ch = esc;
                          alldone := true
                       end else begin
                          write('­USTED GANA!');
                          textattr := textattr - blink;
                          sound(440);
                          delay(200);
                          sound(660);
                          delay(500);
                          nosound
                       end
                    end else begin
                       dollars := dollars - bet;
                       if dollars <= 0 then begin
                          gotoxy(56,4);
                          sound(55);
                          write('USTED ESTA QUEBRADO');
                          delay(500);
                          nosound;
                          gotoxy(56,4);
                          write('                      ');
                       end;
                    end;
                 end;
            f2 : begin
                    betstring := '';
                    gotoxy(xpos+xofs,f1pos+2);
                    write('Nueva apuesta: ');
                    getline(betstring,['0'..'9'],xpos+xofs+15,f1pos+2,4,1,abort);
                    setcursor(32,0);
                    if not abort then val(betstring,bet,valerror);
                    if bet > dollars then begin
                       sound(55);
                       bet := dollars;
                       delay(200);
                       nosound
                    end;
                    gotoxy(xpos+xofs,f1pos+2);
                    write('                   ');
                 end;
            f3 : ;
            f4 : begin
                    if dollars < 5000 then begin
                       dollars := dollars + 1000;
                       debt := debt + 1000
                    end else begin
                       gotoxy(54,4);
                       sound(55);
                       write('NO MAS CREDITO POR AHORA');
                       delay(500);
                       nosound;
                    end
                 end;
           ESC : alldone := true;
         end;
      until alldone;
      done
   end;

{-----------------------------------------------------------------------}

procedure chirun;

const
   ypos = 20;
   xpos = 4;
   xofs = 6;
   f1pos = 19;

var
   textc,
   textb,
   hc,hb,gb   : byte;
   total,
   count,
   runs,r     : integer;
   proportion : real;
   tempstring : string79;

begin
   total := 160; runs := 100;
   if mono then begin
      textc := white;
      textb := black;
      hc    := black;
      hb    := lightgray;
      gb    := hb
   end else begin
      textc := yellow;
      textb := blue;
      hc    := white;
      hb    := red;
      gb    := green
   end;
   textbackground(hb);
   textcolor(hc);
   gotoxy(xpos,f1pos);
   write(' F1  ');
   gotoxy(xpos,f1pos+1);
   write(' F2  ');
   gotoxy(xpos,f1pos+2);
   write(' F3  ');
   gotoxy(xpos,f1pos+4);
   write(' ESC ');
   textbackground(textb);
   textcolor(textc);
   gotoxy(xpos+xofs,f1pos);
   write('Ejecute');
   gotoxy(xpos+xofs,f1pos+1);
   write('Cambie el n£mero de la progenie');
   gotoxy(xpos+xofs,f1pos+2);
   write('Cambie el n£mero de corridas');
   gotoxy(xpos+xofs,f1pos+4);
   write('Regrese al men£ principal');
   textcolor(textc);
   gotoxy(6,2);
   write('progenie = ');
   textcolor(hc); textbackground(hb);
   write(total);
   textcolor(textc); textbackground(textb);
   gotoxy(36,2);
   write('corridas = ');
   textcolor(hc); textbackground(hb);
   write(runs);
   textcolor(textc); textbackground(textb);
   repeat
      repeat
         ch := getkey;
      until ch in [ESC,f1,f2,f3];
      case ch of
         f1 : begin
                 count := 0;
                 textbackground(textb);
                 textcolor(textc);
                 gotoxy(55,ypos);
                 write('                      ');
                 gotoxy(55,ypos+1);
                 write('                  ');
                 gotoxy(62,ypos+2);
                 write('                 ');
                 if runs*total > 2000 then begin
                    gotoxy(xpos+xofs,f1pos+3);
                    write('Esta corrida puede tomar alg£n tiempo - ESC para abortar');
                 end;
                 for r := 1 to runs do begin
                    makeprogeny(total,true,stats,win);
                    if stop then r := runs;
                    if not stats then count := count + 1;
                    textbackground(gb);textcolor(hc);
                    gotoxy(54,ypos-1);
                    write(int(runs-r):4:0,' corridas restantes ');
                    textbackground(textb);textcolor(textc);
                 end;
                 proportion := count/runs;
                 gotoxy(54,ypos-1);
                 write('                        ');
                 gotoxy(xpos+xofs,f1pos+3);
                 write('                                                          ');
                 gotoxy(55,ypos);
                 write('Proporci¢n de corridas');
                 gotoxy(55,ypos+1);
                 write('   donde p < 0.05:');
                 gotoxy(62,ypos+2);
                 textcolor(hc); textbackground(gb);
                 if not stop then write(' ',proportion:5:4,' ');
                 textcolor(textc); textbackground(textb);
              end;
         f2 : begin
                 tempstring := '';
                 gotoxy(xpos+xofs+32,f1pos+1);
                 write('80-1600 >');
                 repeat
                    getline(tempstring,['0'..'9'],wherex,wherey,4,1,abort);
                    val(tempstring,temptotal,valerror);
                 until (abort) or ((temptotal >= 80) and (temptotal <= 1600));
                 if not abort then total := temptotal;
                 setcursor(32,0);
                 gotoxy(17,2);
                 write('     ');
                 textcolor(hc); textbackground(hb);
                 gotoxy(17,2);
                 write(total);
                 textcolor(textc); textbackground(textb);
                 gotoxy(xpos+xofs+32,f1pos+1);
                 write('               ');
              end;
         f3 : begin
                 tempstring := '';
                 gotoxy(xpos+xofs+32,f1pos+2);
                 write('1-10000 >');
                 repeat
                    getline(tempstring,['0'..'9'],wherex,wherey,5,1,abort);
                    val(tempstring,temptotal,valerror);
                 until (abort) or ((temptotal > 0) and (temptotal <= 10000));
                 if not abort then runs := temptotal;
                 setcursor(32,0);
                 gotoxy(47,2);
                 write('     ');
                 textcolor(hc); textbackground(hb);
                 gotoxy(47,2);
                 write(runs);
                 textcolor(textc); textbackground(textb);
                 gotoxy(xpos+xofs+32,f1pos+2);
                 write('               ');
              end;
        ESC : begin
                 gotoxy(6,2);
                 write('               ');
                 gotoxy(36,2);
                 write('                ');
                 exit
              end;
      end;
   until false;
end;

{-----------------------------------------------------------------------}

procedure help;

const
   xpos = 2;
   xofs = 6;
   f1pos = 1;

var
   textc,textb,hc,hb : byte;
   finished          : boolean;

   begin
      finished := false;
      if mono then begin
         textc := white;
         textb := black;
         hc    := black;
         hb    := lightgray
      end else begin
         textc := white;
         textb := blue;
         hc    := white;
         hb    := red
      end;
      repeat
         punnett;
         textbackground(textb);
         window(2,19,78,23);
         clrscr;
         textbackground(hb);
         textcolor(hc);
         gotoxy(xpos,f1pos+0);
         write(' F1  ');
         gotoxy(xpos,f1pos+1);
         write(' F2  ');
         gotoxy(xpos,f1pos+2);
         write(' F3  ');
         gotoxy(xpos,f1pos+3);
         write(' F4  ');
         gotoxy(xpos,f1pos+4);
         write(' ESC ');
         textbackground(textb);
         textcolor(textc);
         gotoxy(xpos+xofs,f1pos+0);
         write('Introducci¢n general');
         gotoxy(xpos+xofs,f1pos+1);
         write('El efecto del tama¤o de la muestra');
         gotoxy(xpos+xofs,f1pos+2);
         write('Corridas m£ltiples y probabilidad');
         gotoxy(xpos+xofs,f1pos+3);
         write('Un juego');
         gotoxy(xpos+xofs,f1pos+4);
         write('Regrese al men£ principal');
         repeat
            ch := getkey;
         until ch in [ESC,f1,f2,f3,f4];
         case ch of
            f1 : begin
                    window(1,1,80,25);
                    clrscr;
WriteLn('                                   MAIZ 2.1');
WriteLn('');
WriteLn(' Este programa es una simulaci¢n del cruce dih¡brido RrSs x RrSs, donde (R) es');
WriteLn(' el alelo dominante para la aleurona p£rpura (una capa celular debajo de la');
WriteLn(' cobertura de la semilla), (r) es el alelo recesivo para la aleurona amarilla,');
WriteLn(' (S) es el alelo dominante para el endosperma almidonado (y granos lizos), y');
WriteLn(' (s) es el alelo recesivo para el endosperma dulce (y granos arrugados).');
WriteLn('');
WriteLn(' En un cruce ideal, esperar¡amos que cada celda en el cuadrado de Punnett');
WriteLn(' contenga, genot¡picamente, el mismo n£mero de progenie (esto es expresado m s');
WriteLn(' tradicionalmente combinando celdas con el mismo genotipo para arribar a la');
WriteLn(' proporci¢n familiar de 1:2:1:2:4:2:1:2:1).  Tambi‚n esperar¡amos fenotipos a');
WriteLn(' ser expresados en una proporci¢n de 9:3:3:1.');
WriteLn('');
WriteLn(' Como usted sabe, la segregaci¢n y recombinaci¢n son procesos probabil¡sticos,');
WriteLn(' por lo que las proporciones observadas amenudo se desv¡an de las esperadas.');
WriteLn(' Este programa le permite variar el tama¤o de la muestra, por lo que usted');
WriteLn(' puede observar que tama¤os de muestra m s grandes generalmente dan');
WriteLn(' proporciones m s cercanas.  El programa tambi‚n calcula el chi-cuadrado (Xý)');
WriteLn(' para mostrar que proporciones observadas generalmente no son significativa-');
WriteLn(' mente diferentes de las esperadas.  Otras opciones le permiten (para entender');
WriteLn(' probabilidad mejor) realizar corridas m£ltiples y, jugar un juego donde usted');
WriteLn(' apuesta a la raz¢n perfecta.');
gotoxy(12,25);write('Precione cualquier tecla para regresar al men£ de ayuda.');
                    ch := readkey;
                 end;
            f2 : begin
                    window(1,1,80,25);
                    clrscr;
WriteLn('                       EL EFECTO DEL TAMA¥O DE LA MUESTRA');
WriteLn('');
WriteLn(' Si usted fuese a contar 16 granos en una mazorca de ma¡z dih¡brido F2, no');
WriteLn(' ser¡a muy probable que usted encontrase nueve granos almidonados p£rpura, tres');
WriteLn(' granos dulces p£rpura, tres granos almidonados amarillos y un grano dulce');
WriteLn(' amarillo.  Pero si usted contase mil, no se sorprender¡a  encontrar de que la');
WriteLn(' proporci¢n observada fue muy cercana a la esperada.');
WriteLn('');
WriteLn(' En este m¢dulo, usted puede escoger el tama¤o de la muestra (hasta 16,000), y');
WriteLn(' el programa generar  gametos, llenar  el cuadrado de Punnett y calcular  las');
WriteLn(' proporciones fenot¡picas.  Tambi‚n calcular  Xý, para mostrar que la mayor');
WriteLn(' parte de las proporciones observadas no son significativamente diferentes de');
WriteLn(' las esperadas.');
gotoxy(12,25);write('Precione cualquier tecla para regresar al men£ de ayuda.');
                    ch := readkey;
                 end;
            f3 : begin
                    window(1,1,80,25);
                    clrscr;
WriteLn('                       CORRIDAS MULTIPLES Y PROBABILIDAD');
WriteLn('');
WriteLn(' Cuando hacemos un test de chi-cuadrado, la hipotesis nula es que el valor');
WriteLn(' observado menos el valor esperado es igual a cero, que es lo mismo que decir');
WriteLn(' que el valor observado es igual al valor esperado.  Por supuesto, usualmente');
WriteLn(' no son lo mismo, y el test nos permite determinar la probabilidad de que la');
WriteLn(' diferencia surgi¢ solamente por azar.  Es muy com£n en biolog¡a el escoger una');
WriteLn(' probabilidad de 5% como separaci¢n.  Si la probabilidad de que las diferencias');
WriteLn(' surgieron £nicamente por azar es mayor del 5% (p > .05), aceptamos de que los');
WriteLn(' valores observados y esperados son lo mismo.  Si la probabilidad es menor del');
WriteLn(' 5% (p < .05), decimos que otro factor, diferente del azar, ha causado la');
WriteLn(' diferencia, i.e., que ella es real.');
WriteLn('');
WriteLn(' Sin embargo, las mismas reglas de probabilidad nos dicen que si escogemos el');
WriteLn(' "nivel de confidencia" del 5%, concluiremos incorrectamente de que una');
WriteLn(' diferencia de azar tiene una causa externa, cerca del 5% de las veces.  En');
WriteLn(' este m¢dulo, usted escoge el n£mero de la progenie a ser generada en un cruce');
WriteLn(' dih¡brido.  Luego usted escoge el n£mero de veces que el crece dih¡brido es');
WriteLn(' generado (el programa usa cada vez, n£meros al azar diferentes).  Luego, el');
WriteLn(' programa realiza los cruces y se mantiene al tanto de cu ntos de los cruces');
WriteLn(' dan p < .05.  En teor¡a, usted puede esperar que esto ocurra el 5% del tiempo.');
gotoxy(12,25);write('Precione cualquier tecla para regresar al men£ de ayuda.');
                    ch := readkey;
                 end;
            f4 : begin
                    window(1,1,80,25);
                    clrscr;
WriteLn('                            ­DERROTE A LOS GAMETOS!');
WriteLn('');
WriteLn(' Cuando ‚ste programa genera un cruce dih¡brido con un tama¤o de muestra de 16,');
WriteLn(' las proporciones fenot¡picas ser n exactamente 9:3:3:1 cerca del 2.4% del');
WriteLn(' tiempo.  En este m¢dulo, usted puede apostar a ello.  Usted comienza con');
WriteLn(' $1000, un regalo de su t¡o, el genetista rico.  Usted puede apostar cualquier');
WriteLn(' parte de eso de que la siguiente prueva saldr  exactamente 9:3:3:1.  Si no');
WriteLn(' sale as¡, usted pierde su apuesta.  Si sale as¡, usted gana 42 veces su');
WriteLn(' apuesta (esta ventaja est  ligeramente a su favor).  Cuando a usted se le');
WriteLn(' acaba el dinero, usted puede prestar m s a la casa, pero recuerde de que se');
WriteLn(' espera que usted lo pague de vuelta.  El l¡mite de la casa para ganancias');
WriteLn(' netas es de $100,000; si usted exede eso, est‚ preparado para una ronda de');
WriteLn(' amorozas felicitaciones a la vez de ser escoltado a la puerta.');
gotoxy(12,25);write('Precione cualquier tecla para regresar al men£ de ayuda.');
                    ch := readkey;
                 end;
           ESC : finished := true
         end;
      until finished;
      clrscr;
      window(1,1,80,25);
   end;

{-----------------------------------------------------------------------}

{Main body of program:}

begin
   done := false;
   checkmono;
   checkparams;
   setcursor(32,0);
   randomize;
   openscreen;
   punnett;
   repeat
      getchoice(choice);
      case choice of
         1 : help;
         2 : samplesize;
         3 : chirun;
         4 : game;
         5 : begin
                gotoxy(20,21);
                colorsave := textattr;
                if mono then begin
                   textcolor(black); textbackground(7)
                end else begin
                   textcolor(15); textbackground(red)
                end;
                write(' ¨Desea usted realmente retirarse? (S/N) ');
                textattr := colorsave;
                repeat
                   ch := readkey
                until ch in ['S','s','N','n'];
                if ch in ['S','s'] then done := true else begin
                end
             end;
      end
   until done;
   if mono then begin
      if bw then setcursor(6,7) else setcursor(13,14)
   end else setcursor(6,7);
   textbackground(black);
   textcolor(lightgray);
   clrscr;
   WriteLn('Espero que haya disfrutado usando este programa.  Por favor p seselo a');
   WriteLn('cualquiera que est‚ interesado en ‚l.  Ninguna donaci¢n es requerida (y');
   WriteLn('ning£na es rehusada).  Si usted tiene alg£n comentario acerca del programa o');
   WriteLn('sugerencias para mejorarlo, porfavor escriba a:');
   WriteLn('');
   WriteLn('          Curtis Clark');
   WriteLn('          Biological Sciences');
   WriteLn('          California State Polytechnic University');
   WriteLn('          Pomona CA 91768 E.U.A.');
   WriteLn('');
   WriteLn('¢ env¡e un mensaje por correo electr¢nico (Bitnet) a:');
   WriteLn('');
   WriteLn('          cclark@calstate');
   WriteLn('');
   WriteLn('Deseo agradecer a Dan Curran por inspirar la versi¢n original del programa');
   WriteLn('para la "mainframe" y a Steve Bryant por sugerir y ayudar a implementar el');
   WriteLn('m¢dulo de chi-cuadrado para corridas m£ltiples.');
   writeln('');
   writeln('');
   WriteLn('Propiedad Literaria (Copyright) 1988 por Curtis Clark y Jaime Tres en los');
   WriteLn('Estados Unidos y todos los dem s paises en los cuales una simple declaraci¢n');
   WriteLn('sirve para establecer propiedad literaria. Como una cortesia hacia los');
   WriteLn('autores, por favor no modifique este programa en ninguna manera.');
end.