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

program corn;

{Copyright 1988, Curtis Clark}

Uses
  Crt,dos,graph;

const
   xpos : array[0..4] of integer =
   (10,21,32,43,65);
   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('                 A Simulation of the Classic Dihybrid Cross');
writeln;
writeln('                   endosperm:  starchy (S) or sweet  (s)');
writeln('                    aleurone:  purple  (R) or yellow (r)');
gotoxy(1,25);textcolor(brown);
write('Copyright 1988, Curtis Clark');
textcolor(white);
write('                            Hit any key to continue');

      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('Instructions');
      gotoxy(xpos+xofs,f1pos+1);
      write('Look at the effect of sample size on genotypic and phenotypic ratios');
      gotoxy(xpos+xofs,f1pos+2);
      write('Multiple runs with a set sample size');
      gotoxy(xpos+xofs,f1pos+3);
      write('Play a game');
      gotoxy(xpos+xofs,f1pos+4);
      write('Quit');
      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('³                      Genotypes                    ³  Phenotypic Ratios      ³');
      writeln('³                                                   ³                         ³');
      writeln('³         RS         Rs         rS         rs       ³                         ³');
      writeln('³    ÉÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍ»  ³                         ³');
      writeln('³ RS º   RRSS   º   RRSs   º   RrSS   º   RrSs   º  ³  Purple                 ³');
      writeln('³    º          º          º          º          º  ³  Starchy:               ³');
      writeln('³    ÌÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍ͹  ³                         ³');
      writeln('³ Rs º   RRSs   º   RRss   º   RrSs   º   Rrss   º  ³  Yellow                 ³');
      writeln('³    º          º          º          º          º  ³  Starchy:               ³');
      writeln('³    ÌÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍ͹  ³                         ³');
      writeln('³ rS º   RrSS   º   RrSs   º   rrSS   º   rrSs   º  ³  Purple                 ³');
      writeln('³    º          º          º          º          º  ³  Sweet:                 ³');
      writeln('³    ÌÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍ͹  ³                         ³');
      writeln('³ rs º   RrSs   º   Rrss   º   rrSs   º   rrss   º  ³  Yellow                 ³');
      writeln('³    º          º          º          º          º  ³  Sweet:                 ³');
      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  : extended;

   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('GO');
      gotoxy(xpos+xofs,f1pos+1);
      write('Change the number of progeny');
      gotoxy(xpos+xofs,f1pos+4);
      write('Return to main menu');
      textcolor(textc);
      gotoxy(6,2);
      write('progeny = ');
      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('Enter new value, 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(16,2);
                    write('     ');
                    textcolor(hc); textbackground(hb);
                    gotoxy(16,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(' So you''re ready to quit?  Let''s take a look at your finances.');
         writeln(' You have $',dollars,' cash.  Your debt to the house is $',debt,'.');
         owe := dollars - debt;
         if owe > 0 then
            if owe > 1000 then begin
               writeln(' That gives you $',owe,' to take home.  Congratulations!');
               writeln(' You came out ahead.  Come back and play again sometime.')
            end else begin
               writeln(' That gives you $',owe,' to take home.  Don''t look so glum!');
               writeln(' Plenty of folks have done worse.');
            end
         else if owe = 0 then writeln(' That gives you nothing, but, hey, you got your shirt!')
            else begin
               writeln(' So I''ll take that cash, and you owe us another $',abs(owe),'.  You do');
               write(' have VISA, MasterCard, or American Express, don''t you? (Y/N)');
               repeat ch := readkey until ch in ['y','Y','n','N'];
               case ch of
                  'Y','y' : begin
                               clrscr;
                               writeln;
                               write(' Enter number: ');
                               junk := '';
                               getline(junk,['0'..'9'],wherex,wherey,20,1,trash);
                               writeln;
                               junk := '';
                               write(' Enter expiration date: ');
                               getline(junk,['0'..'9'],wherex,wherey,6,1,trash);
                               setcursor(32,0);
                               writeln;
                               write(' Dialing...');
                               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(' Transaction complete');
                               write(' Hit any key');
                            end;
                  'N','n' : begin
                               clrscr;
                               writeln;
                               writeln(' I think you better step into the office and talk with my associate...');
                            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('GO');
      gotoxy(xpos+xofs,f1pos+1);
      write('Change your bet');
{      gotoxy(xpos+xofs,f1pos+2);
      write('');                     }
      gotoxy(xpos+xofs,f1pos+3);
      write('Borrow $1000');
      gotoxy(xpos+xofs,f1pos+4);
      write('Return to main menu');
      textcolor(textc-1);
      repeat
         gotoxy(50,f1pos+1);
         write('You have $',dollars,' left    ');
         gotoxy(50,f1pos+2);
         write('You owe the house $',debt);
         gotoxy(50,f1pos+3);
         if dollars < bet then bet := dollars;
         write('Current bet: $',bet,'     ');
         repeat
            ch := getkey;
         until ch in [ESC,f1,f2,f3,f4];
         gotoxy(56,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('CONGRATULATIONS!');
                          sound(440);
                          delay(200);
                          sound(660);
                          delay(500);
                          nosound;
                          window(2,19,78,23);
                          clrscr;
                          textattr := textattr - blink;
                          gotoxy(22,2);
                          write('You have exceeded the house limit');
                          gotoxy(58,5);
                          write('Hit ESC to continue');
                          repeat ch := readkey until ch = esc;
                          alldone := true
                       end else begin
                          write('YOU WIN!!!!');
                          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('SORRY, YOU''RE BUSTED.');
                          delay(500);
                          nosound;
                          gotoxy(56,4);
                          write('                      ');
                       end;
                    end;
                 end;
            f2 : begin
                    betstring := '';
                    gotoxy(xpos+xofs,f1pos+2);
                    write('New bet: ');
                    getline(betstring,['0'..'9'],xpos+xofs+9,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(56,4);
                       sound(55);
                       write('NO MORE CREDIT NOW');
                       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 : extended;
   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('GO');
   gotoxy(xpos+xofs,f1pos+1);
   write('Change the number of progeny');
   gotoxy(xpos+xofs,f1pos+2);
   write('Change the number of runs');
   gotoxy(xpos+xofs,f1pos+4);
   write('Return to main menu');
   textcolor(textc);
   gotoxy(6,2);
   write('progeny = ');
   textcolor(hc); textbackground(hb);
   write(total);
   textcolor(textc); textbackground(textb);
   gotoxy(40,2);
   write('runs = ');
   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);
                 if runs*total > 2000 then begin
                    gotoxy(xpos+xofs,f1pos+3);
                    write('This run may take a while - ESC to abort');
                 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,' runs remaining ');
                    textbackground(textb);textcolor(textc);
                 end;
                 proportion := count/runs;
                 gotoxy(54,ypos-1);
                 write('                      ');
                 gotoxy(55,ypos);
                 write('Proportion of runs');
                 gotoxy(55,ypos+1);
                 write('  where p < 0.05:');
                 gotoxy(60,ypos+2);
                 textcolor(hc); textbackground(gb);
                 if not stop then write(' ',proportion:5:4,' ');
                 textcolor(textc); textbackground(textb);
                 gotoxy(xpos+xofs,f1pos+3);
                 write('                                        ');
              end;
         f2 : begin
                 tempstring := '';
                 gotoxy(xpos+xofs+30,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(16,2);
                 write('     ');
                 textcolor(hc); textbackground(hb);
                 gotoxy(16,2);
                 write(total);
                 textcolor(textc); textbackground(textb);
                 gotoxy(xpos+xofs+30,f1pos+1);
                 write('               ');
              end;
         f3 : begin
                 tempstring := '';
                 gotoxy(xpos+xofs+30,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+30,f1pos+2);
                 write('               ');
              end;
        ESC : begin
                 gotoxy(6,2);
                 write('               ');
                 gotoxy(40,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('General introduction');
         gotoxy(xpos+xofs,f1pos+1);
         write('The effect of sample size');
         gotoxy(xpos+xofs,f1pos+2);
         write('Multiple runs and probability');
         gotoxy(xpos+xofs,f1pos+3);
         write('A game');
         gotoxy(xpos+xofs,f1pos+4);
         write('Return to main menu');
         repeat
            ch := getkey;
         until ch in [ESC,f1,f2,f3,f4];
         case ch of
            f1 : begin
                    window(1,1,80,25);
                    clrscr;
writeln('                                CORN 2.1');
writeln('');
writeln('This program is a simulation of the dihybrid cross RrSs X RrSs, where (R) is');
writeln('the dominant allele for purple aleurone (a cell layer just beneath the seed');
writeln('coat), (r) is the recessive allele for yellow aleurone, (S) is the dominant');
writeln('allele for starchy endosperm (and smooth kernels), and (s) is the recessive');
writeln('allele for sweet endosperm (and wrinkled kernels).');
writeln('');
writeln('In an ideal cross, we would expect every cell in the Punnett square to');
writeln('contain the same number of progeny (this is more traditionally expressed by');
writeln('combining cells with the same genotype to arrive at the familiar ratio of');
writeln('1:2:1:2:4:2:1:2:1).  We would also expect phenotypes to be expressed in a');
writeln('ratio of 9:3:3:1.');
writeln('');
writeln('As you know, segregation and recombination are stochastic processes, so the');
writeln('observed ratios often deviate from the expected ones.  This program allows');
writeln('you to vary the sample size, so you can observe that larger sample sizes');
writeln('generally give closer ratios.  It also calculates chi-squared (Xý) to show');
writeln('that observed ratios are generally not significantly different from expected');
writeln('ones.  Other options allow you to perform multiple runs to better understand');
writeln('probability, and to play a game where you bet on the ratio being perfect.');
gotoxy(20,25);write('Hit any key to return to help menu');
                    ch := readkey;
                 end;
            f2 : begin
                    window(1,1,80,25);
                    clrscr;
writeln('                       The Effect of Sample Size');
writeln('');
writeln('If you were to count 16 kernels on an ear of dihybrid F2 corn, you would not');
writeln('be likely to find nine purple starchy kernels, three purple sweet kernels,');
writeln('three yellow starchy kernels, and one yellow sweet kernel.  But if you');
writeln('counted a thousand, you would not be surprised to find that the observed');
writeln('ratio was very close to the expected one.');
writeln('');
writeln('In this module, you may choose the sample size (up to 16,000), and the');
writeln('program will generate gametes, fill in the Punnett square, and calculate the');
writeln('phenotypic ratios.  It will also calculate Xý, to show that most observed');
writeln('ratios are not significantly different from the expected.');
gotoxy(20,25);write('Hit any key to return to help menu');
                    ch := readkey;
                 end;
            f3 : begin
                    window(1,1,80,25);
                    clrscr;
writeln('                      Multiple Runs and Probability');
writeln;
writeln('When we perform a chi-square test, the null hypothesis is that the observed');
writeln('value minus the expected value equals zero, which is the same thing as');
writeln('saying that the observed value equals the expected value.  Of course, they');
writeln('are not often the same, and the test allows us to determine the probability');
writeln('that the difference arose by chance alone.  It is common in biology to');
writeln('choose a probability of 5% as a cut-off.  If the probability that the');
writeln('differences arose by chance alone is greater than 5% (p > .05), we accept');
writeln('that the observed and expected are the same.  If the probability is less');
writeln('than 5% (p < .05), we decide that some factor other than chance has caused');
writeln('the difference, i.e., that it is real.');
writeln;
writeln('Nevertheless, the same rules of probability tell us that if we choose the 5%');
writeln('"confidence level", we will incorrectly conclude that a chance difference');
writeln('has an external cause about 5% of the time.  In this module, you choose the');
writeln('number of progeny to be generated in a dihybrid cross.  You then choose the');
writeln('number of times that the dihybrid cross is generated (each time uses');
writeln('different random numbers).  The program then performs the crosses and keeps');
writeln('track of how many of the crosses give p < .05.  In theory, you could expect');
writeln('this to occur 5% of the time.');
gotoxy(20,25);write('Hit any key to return to help menu');
                    ch := readkey;
                 end;
            f4 : begin
                    window(1,1,80,25);
                    clrscr;
writeln('                           Beat the Gametes!');
writeln;
writeln('When this program generates a dihybrid cross with a sample size of 16, the');
writeln('phenotypic ratios will be exactly 9:3:3:1 about 2.4% of the time. In this');
writeln('module, you can bet on it.  You start out with $1000, a gift from your rich');
writeln('geneticist uncle.  You can bet any part of it that the next trial will come');
writeln('out exactly 9:3:3:1.  If it doesn''t, you lose your bet.  If it does, you win');
writeln('42 times your bet (these odds are slightly in your favor). When you run out');
writeln('of money, you can borrow more from the house, but remember that you will be');
writeln('expected to pay it back.  The house limit for gross winnings is $100,000; if');
writeln('you exceed that, be prepared for a hearty round of congratulations as you');
writeln('are escorted out the door.');
gotoxy(20,25);write('Hit any key to return to help menu');
                    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(23,21);
                colorsave := textattr;
                if mono then begin
                   textcolor(black); textbackground(7)
                end else begin
                   textcolor(15); textbackground(red)
                end;
                write(' Do you really want to quit? (Y/N) ');
                textattr := colorsave;
                repeat
                   ch := readkey
                until ch in ['Y','y','N','n'];
                if ch in ['Y','y'] 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('I hope you have enjoyed using this program.  Please pass it on to anyone who');
   writeln('would be interested in it.  No donations are requested (and none are');
   writeln('refused).  If you have any comments about the program or suggestions for');
   writeln('improving it, please write or E-mail:');
   writeln;
   writeln('             Curtis Clark');
   writeln('             Biological Sciences');
   writeln('             California State Polytechnic University');
   writeln('             Pomona CA 91768 U.S.A.');
   writeln('             (Bitnet cclark@calstate)');
   writeln;
   writeln('I would like to thank Dan Curran for inspiring the original mainframe');
   writeln('version of the program and Steve Bryant for suggesting and helping to');
   writeln('implement the multiple runs chi-square module.');
end.