{,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.
              >                                               <
              <                                               >
              >    * /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/ *    <
              <   *                                       *   >
              >  *                                         *  <
              <  *                  Batty                  *  >
              >  *                                         *  <
              <  *        Programmed By Fraser King        *  >
              >  *                                         *  <
              <   *                                       *   >
              >    * \/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\ *    <
              <                                               >
              >                                               <
              .,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,}




program Batty;

{
  the current folder needs to be in batty folder or the parent of
  batty folder, for the program to compile (use 'Change Dir in File menu)
}

uses
   crt,dos;

const
   NO_OF_BLOCKS = 55;    { the number of blocks (multiplies of 11) }
   MAX_ROUNDS   = 10;    { total rounds in the game }
   FILES        = 10;
   BAR          = #220;
   HI_SCORE_NO  = 5;     { the next four const are for the hi-score }
   END_SIGN     = #207;  { Ï sign }
   BACK_SPACE   = 27;
   MAX_ASCII    = {39}38;
   BONUS_SPEED  = {5}10;
   MAX_PATH     = 79;
   BATSPEED     = 10;    { multiplies of 2 }
   SECS_OFF     = 20;
   NO_OF_BALLS  = 6;
   SKIP         = ' ';
   NULL         = #0;
   EMPTY        = '';

   LEFT         = #75;
   RIGHT        = #77;
   UP           = #72;
   DOWN         = #80;
   ESCAPE       = #27;
   RETURN       = #13;
   SPACE        = #32;
   PAUSE_KEY    = #112;
   SLOW_MOTION  = #13;
   HELP_KEY     = #104;
   TAB_KEY      = #9;
   CTRL_LEFT    = #115;
   CTRL_RIGHT   = #116;
   ALT_F4       = #107;
   DELETE_KEY   = #8;
   F10_KEY      = #68;
   F5_KEY       = #63;

   MAX1         = 400;
   MAX_CHARS    = 78;
   Trow         = 25;
   Tcolumn      = 1;
   endrow       = 1;

   MAX_CHAR     = 100;

   MaxMenuOpt   = 10;
   OptionLen    = 11;

   skip_round   : boolean = false;
   path         : string{[MAX_PATH]} = EMPTY;
   throttle     : boolean = false;
   quit         : boolean = false;

   ballShape    : array[1..NO_OF_BALLS] of byte = (15,3,4,9,35,42);

   colourNames  : array[1..15] of string[12] =
  ('Blue','Green','Cyan','Red','Magenta','Brown','LightGray','DarkGray',
   'LightBlue','LightGreen','LightCyan','LightRed','LightMagenta','Yellow',
   'White');

   Fname        : array[1..FILES] of string[12] =
  ('Options.dat','Hi_score.dat','Patterns.dat','Rounds.dat','Batty.pas',
  'Batty.gfx','Options.gfx','Help.gfx','Hi_score.gfx','Gameover.gfx');

   Dname        : array[1..3] of string[9] = ('Data\','','Graphics\');

type
   attribsRecord =
   RECORD
      batStr    : string;
      batLen,batCol,
      shapeNo,
      ballCol,
      ballSpeed,
      lives,sfx : byte;
   END;

   hi_score_record =
   RECORD
      name      : string[11];
      hiscore   : longint;
      roundtmp  : byte;
      timetaken : integer;
   END;

   pattern_record =
   RECORD
      storex,storey : byte;
      col2,letter2  : byte;
   END;

   menuRecord =
   RECORD
      Name : string[OptionLen];
      x,y  : byte;
   END;

   hi_score_type  = array[1..HI_SCORE_NO] of hi_score_record;
   asciiTableType = array[1..MAX_ASCII] of char;

   visibleType    = array[1..MAX_ROUNDS,1..NO_OF_BLOCKS] of byte;
   attribsType    = attribsRecord;

   words_type     = array[1..MAX1] of string[MAX_CHARS];
   gfxType        = array[6..10,1..MAX_CHAR] of pattern_record;

   menuArray      = array[1..MaxMenuOpt] of menuRecord;

   optionsFile    = file of attribsRecord;
   hi_scoreFile   = file of hi_score_record;

   visibleFile    = file of byte;

const
   menuOption : menuArray =
   ((Name: 'Bat Length'  ; x: 26; y: 8),
    (Name: 'Bat Colour'  ; x: 26; y: 10),
    (Name: 'Ball Shape'  ; x: 26; y: 12),
    (Name: 'Ball Colour' ; x: 25; y: 14),
    (Name: 'Ball Speed'  ; x: 26; y: 16),
    (Name: 'Lives'       ; x: 31; y: 18),
    (Name: 'Sound'       ; x: 31; y: 20),
    (Name: 'Save'        ; x: 38; y: 23),
    (Name: 'Default'     ; x: 37; y: 24),
    (Name: 'Exit'        ; x: 38; y: 25));


procedure clear;

begin
   textcolor(black);
   clrscr;
end;


procedure colourletter(x1,x2 : byte;
                       y1,y2 : byte;
                       col1  : byte);

begin
   window(x1,x2,y1,y2);
   textbackground(col1);
   clear;
   textbackground(black);
   window(1,1,80,25);
end;


procedure pause(var ch : char);

begin
   ch := readkey;

   if keypressed then
      ch := readkey;

   if ch = #3 then { Ctrl-C }
   begin
      textcolor(lightgray);
      clrscr;
      nosound;
      halt;
   end;
end;


procedure clrwin(x1,y1,x2,y2 : byte);

begin
   window(x1,y1,x2,y2);
   clear;
   window(1,1,80,25);
end;


function rnd_limits(min,max : byte) : byte;

var
   rnd : byte;

begin
   repeat
      rnd := random(max+1);
   until rnd >= min;
   rnd_limits := rnd;
end;


function return_column(len : byte) : byte;

begin
   return_column := 40-(len div 2);
end;


procedure writeto(text : string;
                   x,y : byte;
                colour : byte);

begin
   textcolor(colour);
   gotoxy(x,y);
   write(text);
end;


procedure writexy(text : string;
                   row : byte;
                colour : byte);

var
   len    : byte;
   column : byte;

begin
   len := length(text);
   column := return_column(len);
   writeto(text,column,row,colour);
end;

                               { error }
procedure limits(var number  : byte;
                     min,max : byte);

begin
   if number <= min then
      number := min
   else
   if number >= max then
      number := max;
end;


function conv(number : longint): string;

var
   tmpstr : string;

begin
   str(number,tmpstr);
   conv := tmpstr;
end;


procedure check_keys(choices : string;
                     var key : char);
var
   i  : byte;
   ok : boolean;

begin
   ok := false;
   repeat
      key := {upcase(}readkey{)};
      for i := 1 to length(choices) do
         if choices[i] = key then
            ok := true;
   until ok;
end;


procedure interrupt_delay(milliseconds : word;
                              maingame : boolean);

var
   i  : word;
   ch : char;

begin
   for i := 1 to milliseconds div 10 do
   begin
      if throttle then
         delay(1)
      else
         delay(10);

      if keypressed then
         if maingame then
         begin
            pause(ch);
            if ch = ESCAPE then
            begin
               quit := true;
               exit;
            end
            else
               ch := NULL;
         end else
            exit;
   end;
end;


function LeadingZero(w : Word) : String;

var
  s : String[2];

begin
  Str(w:0,s);
  if Length(s) = 1 then
    s := '0' + s;
  LeadingZero := s;
end;


function fillstr(len : byte;
                  ch : char) : string;

var
   i   : byte;
   tmp : string[80]; { column width }

begin
   tmp := EMPTY;

   for i := 1 to len do
      tmp := tmp + ch;

   fillstr := tmp;
end;


procedure set_file(var txtfile : text;
                       details : string;
                          name : string);

begin
   if details <> 'close' then
   begin
      assign(txtfile, name);
      if details = 'reset' then
         reset(txtfile)
      else
      if details = 'rewrite' then
         rewrite(txtfile);
   end else
      close(txtfile);
end;


procedure colourchar(text : string;
                     row  : byte);

var
   len,i  : byte;
   column : byte;

begin
   len := length(text);
   column := return_column(len);
   gotoxy(column,row);

   for i := 1 to len do
   begin
      textcolor(rnd_limits(9,15));
      write(text[i]);
   end;
end;


procedure readto(var text : string;
                      x,y : byte;
                  col,max : byte);

var
   count : byte;
   ch    : char;

begin
   text := EMPTY;
   count := 1;
   repeat
      pause(ch);
      case ch of
         DELETE_KEY :
         if count > 1 then
         begin
            write(DELETE_KEY,SKIP,DELETE_KEY);
            dec(count);
            delete(text,count,1);
         end;
         SPACE..#127,#156 :
         if count <= max then
         begin
            writeto(ch,x+count-1,y,col);
            inc(count);
            text := text + ch;
         end;
         ESCAPE :
         begin
            count := 1;
            gotoxy(x,y);
            clreol;
            text := EMPTY;
         end;
      end;
   until ch = RETURN;
end;


procedure writecol(text : string; { v1.0 }
             column,row : byte);

var
   i,num  : byte;
   col    : byte;
   amount : byte;

begin
   amount := 0;
   for i := 1 to length(text) do
      if text[i] = '[' then
         inc(amount,3);

   if column = 0 then
      column := ((80-(length(text)-amount)) div 2)+1;

   gotoxy(column,row);

   for i := 1 to length(text)-amount do
   begin
      if text[i] = '[' then
      begin
         if text[i+1] in ['A'..'F'] then
            num := 55
         else
            num := 48;

         col := ord(text[i+1])-num;

         case text[i+1] of
            'R' : col := {c1}4;
            'S' : col := {c2}6;
         end;

         textcolor(col);
         delete(text,i,3);
      end;
      write(text[i]);
   end;
end;


procedure display_gfx(num : byte;
                      rnd : byte;
                      gfx : gfxType);

var
   i : byte;

begin
   i := 1;
   repeat
      with gfx[num,i] do
      begin
         if rnd <> 0 then
            col2 := rnd;
         if num = 10 then
            col2 := rnd_limits(1,15);
         writeto(chr(letter2),storex,storey,col2);
         inc(i);
      end;
   until gfx[num,i].storex = 0;
end;


procedure load_gfx(var gfx : gfxType);

var
   i,m     : byte;
   F       : file of pattern_record;
   pattern : pattern_record;

begin
   i := 1;
   for m := 6 to 10 do
   begin
      assign(F,path+Dname[3]+Fname[m]);
      reset(F);
      while not eof(F) do
      begin
         read(F,pattern);
         gfx[m,i] := pattern;
         inc(i);
      end;
      close(F);
      gfx[m,i].storex := 0;
      i := 1;
   end;
end;


procedure change_bat_length(var batLen : byte;
                            var batStr : string;
                                batCol : byte;
                                ch     : char);
var
   i : byte;

begin
   clrwin(40,8,58,8);

   case ch of
      LEFT  : dec(batLen,2);
      RIGHT : inc(batLen,2);
   end;

   limits(batLen,2,20);
   batStr := EMPTY;

   for i := 1 to batLen do
      batStr := batStr + BAR;

   writeto(batStr,38,8,batCol);
end;


procedure read_batty_options(var attribs : attribsType);

var
   F : optionsFile;
   i : byte;

begin
   assign(F,path+Dname[1]+Fname[1]);
   reset(F);

   read(F,attribs);

   close(F);

   with attribs do
   begin
      batStr := EMPTY;
      for i := 1 to batLen do
         batStr := batStr + BAR;
   end;
end;


procedure write_batty_options(attribs : attribsType);

var
   F : optionsFile;

begin
   assign(F,path+Dname[1]+Fname[1]);
   rewrite(F);

   write(F,attribs);

   close(F);
end;


procedure set_default(var attribs : attribsType);

begin
   with attribs do
   begin
      batLen := 20; batStr := 'ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ';
      ballSpeed := 5; batCol := 4; shapeNo := 1;
      ballCol := 12; lives := 9; sfx := 1;
   end;

   clrwin(38,8,58,20);
end;


procedure wait_menu(var HiLite : byte);

var
   i : byte;

begin
   i := 1;
   while (i <= MaxMenuOpt) and (MenuOption[i].name <> NULL) do
      with MenuOption[i] do
      begin
         writeto(name,x,y,6);
         inc(i);
      end;

   with MenuOption[HiLite] do
      writeto(name,x,y,4);
end;


procedure opt(var number : byte;
                     key : char;
                    step : byte;
                 min,max : byte);

begin
   if key = LEFT then
      dec(number,step);

   if key = RIGHT then
      inc(number,step);

   limits(number,min,max);
end;


procedure options_menu(var attribs : attribsType;
                               gfx : gfxType);

const
   on_off : array[1..2] of string[3] =
  ('On','Off');

var
   key    : char;
   done   : boolean;
   HiLite : byte;

begin
   clear;
   display_gfx(7,0,gfx);

   done := false;
   HiLite := 10;
   wait_menu(HiLite);

   with attribs do
   repeat
      writeto(batStr,38,8,batCol);
      writeto(colourNames[batCol],38,10,batCol);

      writeto(chr(ballShape[shapeNo]),38,12,ballCol);
      writeto(colourNames[ballCol],38,14,ballCol);
      writeto(conv(ballSpeed),38,16,3);

      writeto(conv(lives),38,18,3);
      writeto(on_off[sfx]{+SKIP},38,20,3);

      if key in [UP,DOWN] then
         wait_menu(HiLite);

      check_keys(UP+DOWN+LEFT+RIGHT+RETURN+ESCAPE,key);

      case key of
         UP     : dec(HiLite);
         DOWN   : inc(HiLite);
         RETURN :
         case HiLite of
            8 : write_batty_options(attribs); { save settings }
            9 : set_default(attribs);
           10 : done := true;
         end;
         ESCAPE : done := true;
      end;

      if key in [LEFT,RIGHT] then
      case HiLite of
         1 : change_bat_length(batLen,batStr,batCol,key);
         2 :
         begin
            opt(batCol,key,1,1,15);
            clrwin(38,10,50,10);
         end;
         3 : opt(shapeNo,key,1,1,NO_OF_BALLS);
         4 :
         begin
            opt(ballCol,key,1,1,15);
            clrwin(38,14,50,14);
         end;
         5 : opt(ballSpeed,key,1,1,5);
         6 : opt(lives,key,2,3,9);
         7 :
         begin
            opt(sfx,key,1,1,2);
            clrwin(38,20,41,20);
         end;
      end;
      limits(HiLite,1,MaxMenuOpt);
   until done;
   clear;
end;


procedure help_text;

begin
   writexy('In game controls',8,12);
   writecol('[B]LEFT+RIGHT - [A]Moves the bat',26,10);
   writecol('[B]CTRL LF+RT - [A]Moves bat slower',26,11);
   writecol('[B]SPACE      - [A]Tilts the ball',26,12);

   writecol('[B]ESCAPE - [A]End the game',26,14);
   writecol('[B]P      - [A]Pause',26,15);
   writecol('[B]H      - [A]This help page',26,16);
   writecol('[B]TAB    - [A]Skips the round',26,17);
   writecol('[B]F5     - [A]Cheat',26,18);

   writecol('[B]F10    - [A]Throttle (Main Menu)',26,20);
   writecol('[B]RETURN - [A]Slow motion',26,21);
   writecol('[B]1 to 5 - [A]Changes ball speed',26,22);

   writexy('Press ESCAPE to continue',25,12);
end;


procedure help_page(gfx : gfxType);

var
   ch : char;

begin
   clear;
   display_gfx(8,0,gfx);
   help_text;
   repeat
      pause(ch);
   until ch = ESCAPE;
   clear;
end;

{
    User Defined Ascii Table

    1..26  = A..Z
    27..36 = 0..9
    37     = ' '
    38     = Backspace
    39     = 'Ï' Pressing this finishes your hi-score
}

procedure create_ascii_table(var asciiTable : asciiTableType);

var
   i : byte;

begin
   for i := 1 to 26 do
      asciiTable[i] := chr(i+96);

   for i := 27 to 36 do
      asciiTable[i] := chr(i+21);

   asciiTable[37] := SKIP;
   asciiTable[38] := '<';
(*   asciiTable[39] := END_SIGN; { Ï sign }*)
end;


procedure save_hi_score_to_memory(score : longint;
                           var hi_score : hi_score_type;
                                  round : byte;
                               timeLeft : integer;
                              completed : boolean;
                               fullname : string);

begin
   with hi_score[5] do
   begin
      hiscore := score;
      name  := fullname; { max 11 characters for name }
      roundtmp := round;

      if completed then
         timetaken := timeLeft
      else
         timetaken := 0;
   end;
end;


procedure user_enters_name(c1,c2 : byte;
                      asciiTable : asciiTableType;
                    var fullname : string);

var
   ascii,x   : byte;
   ch        : char;
   done      : boolean;
   uppercase : boolean;

begin
   clear;
   done := false;
   uppercase := false;
   x := 39;
   fullname := EMPTY;
   ascii := 1;

   writexy('You have a hi-score',9,c2);
   writexy('Please type your name',10,c1);

   writexy(fillstr(3,chr(22)),13,c1);

   repeat
      if uppercase then
         writeto(upcase(asciiTable[ascii]),x,12,c2)
      else
         writeto(asciiTable[ascii],x,12,c2);

      pause(ch);
      case ch of
         LEFT    : dec(ascii);
         RIGHT   : inc(ascii);
         UP,DOWN : if ascii in [1..26] then
                      uppercase := not uppercase;
         RETURN  :
         case ascii of
            38 :
               if x > 39 then { backspace }
               begin
                  writeto(SKIP,x,12,black);
                  dec(x);
                  delete(fullname,x-38,1);
               end;
            {39 : done := true;}
            else { any key apart from Backspace and exit }
               begin
                  inc(x);
                  if uppercase then
                     fullname := fullname + upcase(asciiTable[ascii])
                  else
                     fullname := fullname + asciiTable[ascii];
               end;
         end; { endcase }
      end; { endcase }
      if x >= 42 then {third character has been entered and now it quits}
            done := true;
      limits(ascii,1,MAX_ASCII);
   until done;
end;


procedure sort_hi_score_table(var hi_score : hi_score_type);

var
   tmpArray : hi_score_type;
   a,b      : byte;

begin
   for a := 1 to HI_SCORE_NO do
      for b := a to HI_SCORE_NO do
         if hi_score[a].hiscore < hi_score[b].hiscore then
         begin
            tmpArray[a] := hi_score[b];
            hi_score[b] := hi_score[a];
            hi_score[a] := tmpArray[a];
         end;
end;


procedure read_hi_score_from_disk(var hi_score : hi_score_type);

var
   F : hi_scoreFile;
   i : byte;

begin
   assign(F,path+Dname[1]+Fname[2]);
   reset(F);

   for i := 1 to HI_SCORE_NO do
      read(F,hi_score[i]);

   close(F);
end;


procedure write_hi_score_to_disk(hi_score : hi_score_type);

var
   F : hi_scoreFile;
   i : byte;

begin
   assign(F,path+Dname[1]+Fname[2]);
   rewrite(F);

   for i := 1 to HI_SCORE_NO do
      write(F,hi_score[i]);

   close(F);
end;


{function underline(number,len : byte) : string;

var
   i : byte;

begin
   for i := 1 to len do
      write(chr(number));
   underline := EMPTY;
end;}


procedure display_hi_score_table(hi_score : hi_score_type);

var
   i      : byte;
   tmpstr : string;

begin
   gotoxy(21,13);
   textcolor(4);
   write('Name':6,'Score':11,'Round':10,'Time':9);

   gotoxy(23,14);
   textcolor(12);
{   write('----':6,'-----':11,'-----':10,'----':9);}
   write(fillstr(4,chr(22)),SKIP:6,fillstr(5,chr(22)),SKIP:5,fillstr(5,chr(22)),SKIP:5,fillstr(4,chr(22)));

   for i := 1 to HI_SCORE_NO do
      with hi_score[i] do
      begin
         tmpstr := EMPTY;
         if timetaken <> 0 then
            tmpstr := conv(timetaken div 60)+'m'+SKIP+conv(timetaken mod 60)+'s';

         gotoxy(21,14+i);
         textcolor(6);
         write(name:6,hiscore:12,roundtmp:8,tmpstr:11);
      end;
end;


procedure user_gets_hi_score(c1,c2 : byte;
                      var hi_score : hi_score_type;
                             score : longint;
                             round : byte;
                          timeLeft : integer;
                     var completed : boolean);

var
   fullname   : string;
   asciiTable : asciiTableType;

begin
   sort_hi_score_table(hi_score);
   if score >= hi_score[5].hiscore then
   begin
      create_ascii_table(asciiTable);
      user_enters_name(c1,c2,asciiTable,fullname);
      save_hi_score_to_memory(score,hi_score,round,timeLeft,completed,fullname);
      write_hi_score_to_disk(hi_score);
   end;
end;


procedure get_ready;

var
   tmp : array[1..3] of byte;
   i,m : byte;

begin
   clear;
   for i := 1 to 3 do
   begin
      for m := 1 to 3 do
         tmp[m] := 0;

      case i of
         1 : tmp[1] := 128;
         2 : tmp[2] := 128;
         3 : tmp[3] := 128;
      end;

      writexy(chr(15),10,tmp[1]+4);
      writexy('READY',11,tmp[1]+4);

      writexy(chr(15),13,tmp[2]+6);
      writexy('STEADY',14,tmp[2]+6);

      writexy(chr(15),16,tmp[3]+2);
      writexy('GO',17,tmp[3]+2);

      interrupt_delay(1000,true);

      if quit then
         break;
   end; { endfor }
   clear;
end;


procedure spectrum(round : byte;
                 visible : visibleType);

var
   i,m   : byte;
   x,y   : byte;
   count : byte;

begin
   count := 1;
   x := 8; y := 10;
   for i := 1 to 5 do
   begin
      for m := 1 to 11 do
      begin
         writeto(fillstr(5,BAR),x,y,visible[round,count]);
         inc(x,6);
         inc(count);
      end;
      inc(y);
      x := 8;
   end;
{   writexy('Round '+conv(round),22,6);}
end;


procedure up_down(sentence : string);

var
   x,y    : byte;
   len    : byte;
   letter : byte;
   ch     : char;

begin
   clear;
   len := length(sentence);
   x := return_column(len);
   y := 12;
   repeat
      writexy(sentence,y,6);                      { shows the whole sentence }
      letter := rnd_limits(1,len);                { picks a random letter }

      writeto(SKIP,x+letter-1,y,black);           { clears the letter }
      writeto(sentence[letter],x+letter-1,y-1,4); { moves the letter up }

      interrupt_delay(750,false);
      writeto(SKIP,x+letter-1,y-1,black);         { then clears the letter }

      interrupt_delay(750,false);
   until keypressed;
   pause(ch); { removes char from kbd buffer }
   clear;
end;


procedure leftTOright(text : string);

var
   x,y   : byte;
   count : byte;
   len   : byte;

begin
   if quit then
      exit;

   clear;
   len := length(text);
   x := 1; y:= 12;
   count := 0;
   while text <> EMPTY do
   begin
      writeto(text,x,y,cyan);

      if x = 40-(len div 2) then
         interrupt_delay(2000,true);

      if x >= 80-len then
      begin
         delete(text,len-count,1);
         inc(count);
      end;

      interrupt_delay(10,true);
      writeto(fillstr(len,SKIP),x,y,black);

      inc(x);

      if quit then
         exit;
   end;
end;


procedure sideways(title : string;
                   row   : byte;
                   speed : word);

var
   moving    : byte;
   direction : boolean;
   x1,x2,tmp : byte;
   ok        : boolean;
   ch        : char;

begin
   tmp := 40-(length(title) div 2);
   x1  := tmp-5;
   x2  := tmp+5;
   direction := true;
   ok := false;
   moving := x1;
   repeat
      clrwin(moving-1,row,moving+11,row);
      writeto(title,moving,row,4);

      delay(speed);

      if direction then
         inc(moving)
      else
         dec(moving);

      if (moving = x2) and (direction) then
         direction := false;
      if (moving = x1) and (not direction) then
         direction := true;

      if keypressed then
      begin
         pause(ch);
{         if ch = RETURN then
            ch := NULL;}
         ok := true;
      end;
   until ok;
end;


procedure two_colours(menu_items : string;
                      row        : byte);

var
   len,i  : byte;
   column : byte;

begin
   len := length(menu_items);
   column := return_column(len);

   textcolor(6);
   gotoxy(column,row);

   for i := 1 to len div 2 do
      write(menu_items[i]);

   textcolor(4);

   for i := (len div 2)+1 to len do
      write(menu_items[i]);

   textcolor(3); {highlights first letter}
   gotoxy(column,row);
   write(menu_items[1]);
end;


procedure display_outline(x1,x2,y1,y2 : byte);

var
   rnd : byte;
   i   : byte;

begin
   for i := 1 to 100 do
   begin
      rnd := rnd_limits(1,15);

      colourletter(x1,y1,x2,y1,rnd);
      colourletter(x1,y2,x2,y2,rnd);
      colourletter(x1,y1,x1,y2,rnd);
      colourletter(x2,y1,x2,y2,rnd);

      interrupt_delay(100,false);

      if keypressed then
         exit;
   end;
end;


procedure display_introduction;

begin
   leftTOright('Fraser King');
   leftTOright('Presents');
   leftTOright('Batty');
end;


procedure display_credits;

begin
   clear;
   writexy('Programmed',10,6);
   writexy('Idea',11,6);
   writexy('Text Layout',12,6);
   writexy('By',13,4);
   writexy('If any comments, suggestions or bugs',17,6);
   writexy('Then send an email to support( at )fraserking.co.uk',18,4);
   writexy('Greetz to Mark, Peter and Mike',21,6);
   sideways('Fraser King',14,100);
   clear;
end;


procedure enter_keys(row : byte);

var
   ch : char;

begin
   pause(ch);
   writexy(ch,row,12);
end;


procedure redefinable_keys;

var
   ch   : char;
   i    : byte;
   step : byte;

begin
   clear;
   two_colours('Left',4);
   two_colours('Right',6);
   two_colours('Up',8);
   two_colours('Down',10);
   two_colours('Tilt Ball',12);
   {two_colours('Skip Round',14);
   two_colours('End Game',16);
   two_colours('Move Faster',18);
   two_colours('Slow Motion',20);
   two_colours('Pause',22);}

   step := 0;
   for i := 1 to 5 do
   begin
      enter_keys(i+step+4); { reads a key from the keyboard }
      inc(step);
   end;

   pause(ch);
   clear;
end;


function file_exists(filename : string) : boolean;

var
   F : text;

begin
   file_exists := false;

   assign(F,filename);
   {$I-} reset(F); {$I+}

   if IOResult = 0 then
   begin
      file_exists := true;
      close(F);
   end;
end;


procedure select_path;

var
   ch        : char;
   ok        : boolean;
   i,m       : byte;
   filecount : byte;
   text      : string;

begin
   ok := false;
   repeat
      clear;
      writexy('Press RETURN for default path',24,9);
      writexy('Press ''x'' to exit',25,12);

      writeto('Please select path? : ',5,13,9);
      readto(text,27,13,12,50);
      path := text;

      if path = EMPTY then { Pressing RETURN uses the default path }
         path := 'c:\mydocu~1\pascal\batty\'
      else
         path := path+'\';

      if path = 'x' then
      begin
         textcolor(lightgray);
         clrscr;
         halt;
      end;

      m := 1;
      filecount := 0;

      for i := 1 to FILES do
      begin
         if file_exists(path+Dname[m]+Fname[i]) then
            inc(filecount);

         if (i = 4) or (i = 5) then
            inc(m);
      end;

      case filecount of
         0  : writexy('Batty files don''t exist in this directory',19,12);
         1..FILES-1 :
         begin
            writexy('Some of the files maybe be missing or corrupt',19,12);
            writexy('You probably have to re-install Batty',20,9);
         end;
         FILES : ok := true;
      end;

      if filecount <> FILES then
      begin
         sound(220);
         delay(400);
         nosound;
         pause(ch);
      end;
   until ok;
   clear;
end;


procedure load_rounds(var visible : visibleType);

var
   F   : visibleFile;
   r,s : byte;

begin
   assign(F,path+Dname[1]+Fname[4]);
   reset(F);

   for r := 1 to MAX_ROUNDS do
      for s := 1 to NO_OF_BLOCKS do
         read(F,visible[r,s]);

   close(F);
end;


procedure makesound(note : word;
                     len : word;
                     sfx : byte);

begin
   if sfx = 1 then
   begin
      sound(note);
      interrupt_delay(len,true);
      nosound;
   end;
end;


procedure select_speed(attribs : attribsType;
                     var speed : byte;
                      computer : boolean);

begin
   case attribs.ballSpeed of
      1 : speed := 70;
      2 : speed := 50;
      3 : speed := 30;
      4 : speed := 20;
      5 : speed := 15;
   end;

   if computer then
      if throttle then
         speed := 1
      else
         speed := 10;
end;


procedure display_blocks(round : byte;
                       visible : visibleType);

var
   box1,box2 : byte;
   row,i,tmp : byte;

begin
   row := 6;
   box1 := 3; box2 := 8;               { the size of each block          }
   for i := 1 to NO_OF_BLOCKS do       { x = 6   y = 1  max per row = 11 }
   begin                               { 1 space in between              }
      if visible[round,i] <> 0 then
      begin
         tmp := visible[round,i];
         colourletter(box1,row,box2,row,tmp);
      end;
      inc(box1,7); inc(box2,7);
      if box1 = 80 then
      begin
         box1 := 3; box2 := 8;
         inc(row,2);
      end;
   end;
end;


procedure clear_blocks(x,y : byte;
                     round : byte;
                   attribs : attribsType;
                 var score : longint;
                      dirX : boolean;
                 var sides : byte;
               var visible : visibleType);

var
   row,i         : byte;
   boxCounter    : byte;
   block_cleared : boolean;

begin
   row := 6;
   boxCounter := 3;
   block_cleared := false;
   for i := 1 to NO_OF_BLOCKS do
   begin
      if (x >= boxCounter) and (x <= boxCounter+6)
        and ((y = row) or (y = row-1)) then
         if visible[round,i] <> 0 then
         begin
            block_cleared := true;
            break;
         end;
      inc(boxCounter,7);
      if boxCounter = 80 then
      begin
         boxCounter := 3;
         inc(row,2);
      end;
   end;

   if block_cleared then
   begin
      colourletter(boxCounter,row,boxCounter+6,row,black);
      visible[round,i] := 0;

      makesound(180,10,attribs.sfx); { hitting bricks sound }
      inc(score,rnd_limits(1,10)*1000);

      if y = row then
      begin
         if dirX then
            sides := 2;
         if not dirX then
            sides := 1;
      end else
      if y = row-1 then
      begin
         if dirX then
            sides := 3; { bouching at the top }
         if not dirX then
            sides := 4;
      end;
   end;
end;


procedure position_ball_hits_bat
                           (x,y : byte;
                             x1 : shortint;
                      var sides : byte;
                           dirX : boolean;
                        attribs : attribsType);
var
   len,i : byte;

begin
   if y <> 24 then
      exit;

   len := attribs.batLen;

   for i := 0 to len+1 do
      if x = x1+i-1 then
      begin
         if dirX then
            sides := 3
         else
         if not dirX then
            sides := 4;

         makesound(240,40,attribs.sfx); { bat sound }
      end;
end;


procedure makes_ball_bounce_of_walls(x,y : byte;
                               dirX,dirY : boolean;
                               var sides : byte);

begin
   if (x = 80) and (y = 1) then
      sides := 1
   else
   if (x = 1) and (y = 1) then
      sides := 2
   else
   if (x = 79) and (y = 23) then
      sides := 4
   else
   if (x = 2) and (y = 23) then
      sides := 3
   else
   if (y = 1) and (dirX = false) then
      sides := 1
   else
   if (y = 1) and (dirX = true) then
      sides := 2
   else
   if (x = 1) and (dirY = false) then
      sides := 3
   else
   if (x = 1) and (dirY = true) then
      sides := 2
   else
   if (x = 80) and (dirY = false) then
      sides := 4
   else
   if (x = 80) and (dirY = true) then
      sides := 1
end;


 { this finds out the direction the ball goes
   by comparing the previous x,y }


procedure works_out_ball_direction(x,y : byte;
                         storeX,storeY : byte;
                         var dirX,dirY : boolean);

begin
   if x > storeX then
      dirX := true
   else
      dirX := false;

   if y > storeY then
      dirY := true
   else
      dirY := false;
end;


procedure angle_of_the_ball(sides : byte;
                          var x,y : byte);

begin
   case sides of
      1 : begin
             dec(x); inc(y);
          end;
      2 : begin
             inc(x); inc(y);
          end;
      3 : begin
             inc(x); dec(y);  { right }
          end;
      4 : begin
             dec(x); dec(y);  { left }
          end;
   end;
end;


procedure display_ball(x,y : byte;
         var storeX,storeY : byte;
                   attribs : attribsType;
                        c2 : byte);

begin
   { position of the ball, it changes next time around }

   storeX := x; storeY := y;
   writeto(chr(ballShape[attribs.shapeNo]),x,y,c2);

   { Last Position  1,24  80,24 }
   { Ball goes out  2,25  79,25 }
end;


procedure activate_slow_motion(var slow : boolean;
                              var speed : byte;
                                attribs : attribsType;
                               computer : boolean);

begin
   slow := not slow;

   if slow then
      speed := 255
   else
      select_speed(attribs,speed,computer);
end;


procedure tilts_ball(var x,y : byte;
           var storeX,storeY : byte);

begin
   storeX := x; storeY := y;
   writeto(SKIP,x,y,black); {}

   if (x-2 >= 1) and (y-2 >= 1) then
   begin
      dec(x,2); dec(y,2);
   end;
end;


procedure move_computer(dirX : boolean;
                      var x1 : shortint;
                           x : byte;
                     attribs : attribsType);

var
   m : shortint;

begin
   with attribs do if dirX then
      for m := x1 to x-(batLen div 2) do
      begin
         if x1 >= 80-batLen then
            exit;
         writeto(fillstr(batLen,SKIP),x1,25,black);
         inc(x1);
      end
   else
      for m := x1 downto x-(batLen div 2) do
      begin
         if x1 = 1 then
            exit;
         writeto(fillstr(batLen,SKIP),x1,25,black);
         dec(x1);
      end;
end;


procedure wait

(var x1            : shortint;
 var slow          : boolean;
     c1            : byte;
 var x,y,speed     : byte;
 var storeX,storeY : byte;
 var attribs       : attribsType;
     dirX,computer : boolean;
     gfx           : gfxType);

var
   ch : char;
   i  : byte;

begin
   for i := 1 to 5 do
   begin
      writeto(attribs.batStr,x1,25,c1);

      if computer then
      begin
         move_computer(dirX,x1,x,attribs);
         if keypressed then
         begin
            quit := true;
            exit;
         end;
      end;

      if keypressed then
      begin
         pause(ch);

         if ch <> PAUSE_KEY then
            writeto(fillstr(attribs.batLen,SKIP),x1,25,black);

         case ch of
            CTRL_LEFT   : dec(x1,BATSPEED div 2);
            CTRL_RIGHT  : inc(x1,BATSPEED div 2);

            LEFT        : dec(x1,BATSPEED);
            RIGHT       : inc(x1,BATSPEED);

            SPACE       : tilts_ball(x,y,storeX,storeY);
            ESCAPE      : quit := true;

            TAB_KEY     : skip_round := true;
            PAUSE_KEY   : pause(ch);

            SLOW_MOTION : activate_slow_motion(slow,speed,attribs,computer);

            '1'..'5'    :
            begin
               attribs.ballspeed := ord(ch) - 48;
               select_speed(attribs,speed,computer);
            end;

            HELP_KEY    : help_page(gfx);
            F5_KEY      : attribs.lives := 99;
            else
               ch := NULL;
         end;
      end;
      if x1 <= 1 then
         x1 := 1;

      if x1 >= 80-attribs.batLen then
         x1 := 80-attribs.batLen;
   end;
   delay(speed);
end;


procedure ball_starts(attribs : attribsType;
                       var x1 : shortint;
                var x,y,sides : byte;
                var dirX,dirY : boolean);


begin
   with attribs do { where the ball starts at start of life }
   begin
      x1 := 40-(batLen div 2);
      x := x1+rnd_limits(1,batLen)-1;
      y := 24;
   end;

   dirY := false;
   sides := rnd_limits(3,4);

   case sides of
      3 : dirX := true;
      4 : dirX := false;
   end;

{   if x < 40 then
   begin
      sides := 4;
      dirX := false;
   end
   else
   begin
      sides := 3;
      dirX := true;
   end;}
end;


procedure set_up_computer_player(computer : boolean;
                              var attribs : attribsType;
                                var round : byte);
var
   i : byte;

begin
   if computer then with attribs do
   begin
      shapeNo := rnd_limits(1,NO_OF_BALLS);
      ballSpeed := 5;
      batStr := EMPTY;
      batLen := rnd_limits(1,10)*2;

      for i := 1 to batLen do
         batStr := batStr + BAR;

      round := rnd_limits(1,MAX_ROUNDS);
   end else
      round := 1;
end;


procedure initialise(var timeOut         : boolean;
                     var score           : longint;
                     var seconds,minutes : byte;
                     var slow            : boolean;
                     var timeLeft        : integer;
                     var end_of_round    : boolean;
                     var c1,c2           : byte;
                         attribs         : attribsType;
                     var completed       : boolean;
                         computer        : boolean;
                     var store           : shortint);

begin
   score := 0;
   seconds := 59; minutes := 1;
   timeOut := false;
   slow := false;
   timeLeft := 0;
   quit := false;
   end_of_round := false;
   completed := false;
   store := -1;

   if computer then  { c1 = 4, c2 = 12 }  { default colours }
   begin
      c1 := rnd_limits(1,15);
      repeat
         c2 := rnd_limits(1,15);
      until c1 <> c2;
   end else
   begin
      c1 := attribs.batCol;
      c2 := attribs.ballCol;
   end;
end;


procedure game_details(c1,c2 : byte;
                       round : byte;
                       score : longint;
                    hi_score : hi_score_type;
                     attribs : attribsType;
             minutes,seconds : byte);

var
   tmpHiScore : longint;

begin
   textcolor(black);
   tmpHiScore := hi_score[1].hiscore;
   if score >= tmpHiScore then { overtake hi-score }
      tmpHiScore := score;

   writeto('Lives : ',1,1,c1);
   writeto('Score : ',1,2,c1);
   writeto('Time  : ',1,3,c1);

   writeto('Round : ',65,1,c1);
   writeto('Hi-Score : ',62,2,c1);
   writeto('Speed : ',65,3,c1);

   writeto(conv(attribs.lives),9,1,c2);
   writeto(conv(score),9,2,c2);
   writeto(conv(minutes)+':'+LeadingZero(seconds),9,3,c2);

   writeto(conv(round),73,1,c2);
   writeto(conv(tmpHiScore),73,2,c2);
   writeto(conv(attribs.ballspeed),73,3,c2);
end;


procedure take_20_seconds_off(var seconds,minutes : byte);

begin
   if seconds < SECS_OFF then  { less than 20 secs }
      if minutes = 0 then
         seconds := 0
      else
      begin
         dec(minutes);
         seconds := seconds+60-SECS_OFF;
      end
   else
      dec(seconds,SECS_OFF)
end;


procedure game_over(attribs : attribsType;
                      c1,c2 : byte;
                        gfx : gfxType);

begin
   if attribs.lives = 0 then { lives ran out }
   begin
      writeto(conv(attribs.lives),9,1,c2);

{      clrwin(24,10,57,14);}
{      writexy('G a m e  O v e r',12,c1);}
      clrwin(15,8,66,17);
      display_gfx(10,0,gfx);

      interrupt_delay(5000,true);
      quit := true;
   end;
end;


procedure lose_life_details(attribs : attribsType;
                                 x1 : shortint;
                      storeX,storeY : byte);

begin
   makesound(220,300,attribs.sfx); { losing life sound }
   interrupt_delay(1500,true);

   writeto(fillstr(attribs.batLen,SKIP),x1,25,black); {}
   writeto(SKIP,storex,storey,black); {}
end;


procedure lose_life

(var attribs         : attribsType;
 var x1              : shortint;
 var storeX,storeY   : byte;
 var seconds,minutes : byte;
 var x,y,sides       : byte;
 var dirX,dirY       : boolean;
     c1,c2           : byte;
     gfx             : gfxType);

begin
   if y <> 25 then
      exit;

   dec(attribs.lives);

   if attribs.lives = 0 then
      game_over(attribs,c1,c2,gfx)
   else
   begin
      lose_life_details(attribs,x1,storeX,storeY);
      take_20_seconds_off(seconds,minutes);
      ball_starts(attribs,x1,x,y,sides,dirX,dirY);
   end;
end;


procedure check_end_of_round(round : byte;
                  var end_of_round : boolean;
                           visible : visibleType);

var
   m         : byte;
   zeroTotal : byte;

begin
   zeroTotal := 0;
   for m := 1 to NO_OF_BLOCKS do
   begin
      if visible[round,m] = 0 then
         inc(zeroTotal);
   end;

   if (NO_OF_BLOCKS = zeroTotal)
     or (skip_round) then { all blocks cleared }
      end_of_round := true;
end;


procedure bonus_screen(minutes,seconds : byte;
                          var timeLeft : integer;
                                 round : byte;
                                 c1,c2 : byte;
                             var score : longint;
                               timeOut : boolean;
                               attribs : attribsType);
var
   once      : boolean;
   exitBonus : boolean;
   ch        : char;

begin
   if quit then
      exit;

   inc(timeLeft,((60*1)+59)-((minutes*60)+seconds));

   once := false;
   exitBonus := false;

   clear;
   colourchar('Round '+conv(round),11);
   writeto('Time   : ',33,14,c1);
   writeto('Score  : ',33,16,c1);

   repeat
      writeto(conv(minutes)+':'+LeadingZero(seconds),43,14,c2); {}
      writeto(conv(score){+fillstr(3,SKIP)},43,16,c2); {}

      textcolor(black);
      write(fillstr(3,SKIP));

      if timeOut then
         break;

      if not once then
      begin
         interrupt_delay(2000,true);
         once := true;
      end;

      inc(score,2000); { 2000 points per 30ms }

      makesound(220,20,attribs.sfx); { countdown sound }
      interrupt_delay(BONUS_SPEED,true);

      if quit then { Pressed Escape }
         exit;

      if (minutes = 0) and (seconds = 0) then
         exitBonus := true
      else
      if seconds = 0 then
      begin
         dec(minutes);
         seconds := 59;
      end;
      dec(seconds);
   until exitBonus;

   writexy('Press SPACE to continue',23,c2);
   repeat
      pause(ch);
      if ch = ESCAPE then
      begin
         quit := true;
         exit;
      end;
   until ch = SPACE;
   clear;
end;


procedure next_round(var score : longint;
                        var x1 : shortint;
                       attribs : attribsType;
                 storeX,storeY : byte;
                            c2 : byte);

begin
   skip_round := false;
   writeto(conv(score),9,2,c2); { fixes small bug }

   interrupt_delay(2000,true);

   writeto(fillstr(attribs.batLen,SKIP),x1,25,black); {}
   writeto(SKIP,storex,storey,black); {}
end;


procedure display_ending;

var
   ch : char;

begin
   clear;
   writexy('76,169 characters, 3500 lines, 3 years to complete',12,6);
   writexy('and here''s the full source code for Batty.',13,4);
   writexy('Press ESCAPE at anytime to skip',16,6);

   writexy('Press SPACE to continue',24,9);

   repeat
      pause(ch);
   until ch = SPACE;

   clear;
end;


procedure read_data(var words : words_type;
                  var sourceF : text);

var
   x,i    : byte;
   tmpstr : string;
   tab    : byte;
   spaces : string;
   m      : integer;

begin
   for m := 1 to MAX1 do
   begin
      readln(sourceF,words[m]);
      x := pos(TAB_KEY,words[m]);
      while x <> 0 do
      begin
         spaces := EMPTY;
         tab := x mod 3;
         case tab of
            0 : tab := 1;
            1 : tab := 3;
            2 : tab := 2;
         end;

         for i := 1 to tab do
            insert(SKIP,spaces,i);

         delete(words[m],x,1);
         insert(spaces,words[m],x);

         x := pos(TAB_KEY,words[m]);
      end;
   end;
end;


procedure display_script(var words : words_type;
                          sentence : integer);

var
   i    : integer;
   row1 : byte;

begin
   row1 := Trow;
   for i := sentence downto 1 do
   begin
      writeto(fillstr(length(words[i-1]){MAX_CHARS},SKIP),Tcolumn,row1,black);
      writeto(words[i],Tcolumn,row1,lightgray);

      dec(row1);

      if row1 < {1}endrow then
         exit;
   end;
end;


procedure display_source_code;

var
   sourceF  : text;
   words    : words_type;
   sentence : integer;
   ch       : char;
   done     : boolean;

begin
   done := false;
   sentence := 1;
{  textbackground(black);}

   set_file(sourceF,'reset',path+Dname[2]+Fname[5]);
   read_data(words,sourceF);

   repeat
      display_script(words,sentence);
      delay(400);

      if keypressed then
      begin
         pause(ch);
         if ch = ESCAPE then
            done := true;
      end;

      if sentence = 22 then
         delay(5000);

      inc(sentence);
      if sentence = MAX1+25 then
         done := true;

   until done;

   set_file(sourceF,'close',EMPTY);
{   textbackground(black);
   clear;}
end;


procedure time_taken_to_complete(timeLeft : integer;
                              var maxTime : integer;
                          minutes,seconds : byte);
var
   ch : char;

begin
   writexy('Time taken to complete',12,4);
   writexy(conv(timeLeft div 60)+' minutes'+SKIP+conv(timeLeft mod 60)+
   ' seconds',14,12);

   if timeLeft < maxTime then
   begin
      maxTime := timeLeft;
      writexy('This is the fastest time in batty',18,9);
   end;

   writexy('Press SPACE to continue',24,13);

   repeat
      pause(ch);
   until ch = SPACE;
end;


procedure game_completed(var maxTime : integer;
                            timeLeft : integer;
                     minutes,seconds : byte;
                        var hi_score : hi_score_type);

begin
   up_down('Game Completed');
   time_taken_to_complete(timeLeft,maxTime,minutes,seconds);
   display_ending;
   display_source_code;
end;


procedure countdown

(var seconds,minutes : byte;
 var timeOut         : boolean;
 var store           : shortint);

var
   h,m,s,hund : word;

begin
   gettime(h,m,s,hund);
   if (store <> s) and (store <> -1) then
   begin
      gettime(h,m,s,hund);

      if (minutes = 0) and (seconds = 0) then
      begin
         timeOut := true;
         exit;
      end;

      if seconds = 0 then
      begin
         dec(minutes);
         seconds := 59;
      end
      else
         dec(seconds);
   end;
   store := s;
end;


procedure start_game

    (attribs  : attribsType;
 var hi_score : hi_score_type;
 var maxTime  : integer;
     computer : boolean;
 var time     : byte;
     visible  : visibleType;
     gfx      : gfxType);

var
   sides,x,y,storeX,storeY,speed : byte;
   round,c1,c2,seconds,minutes   : byte;

   end_of_round,completed : boolean;
   dirX,dirY,timeOut,slow : boolean;

   timeLeft : integer;
   x1,store : shortint;
   score    : longint;

begin
   initialise
  (
   timeOut,score,seconds,minutes,slow,timeLeft,
   end_of_round,c1,c2,attribs,completed,computer,store
  );

   set_up_computer_player(computer,attribs,round);

   select_speed(attribs,speed,computer);
   ball_starts(attribs,x1,x,y,sides,dirX,dirY);

   if not computer then
   begin
      get_ready;
      time := 1; { this for the main menu }
   end;

   while not quit do { main game starts here }
   begin
      game_details(c1,c2,round,score,hi_score,attribs,minutes,seconds);
      countdown(seconds,minutes,timeOut,store);

      display_ball(x,y,storeX,storeY,attribs,c2);
      display_blocks(round,visible);

      wait(x1,slow,c1,x,y,speed,storeX,storeY,attribs,dirX,computer,gfx);

      clear_blocks(x,y,round,attribs,score,dirX,sides,visible);

      makes_ball_bounce_of_walls(x,y,dirX,dirY,sides);
      position_ball_hits_bat(x,y,x1,sides,dirX,attribs);

      lose_life
     (
      attribs,x1,storeX,storeY,seconds,minutes,x,y,sides,dirX,dirY,c1,c2,gfx
     );

      writeto(SKIP,x,y,black);

      angle_of_the_ball(sides,x,y);
      works_out_ball_direction(x,y,storeX,storeY,dirX,dirY);

      check_end_of_round(round,end_of_round,visible);

      if (end_of_round) and (computer) then
         break;

      if end_of_round then  { start of next round }
      begin
         next_round(score,x1,attribs,storeX,storeY,c2);
         ball_starts(attribs,x1,x,y,sides,dirX,dirY);

         bonus_screen
        (
         minutes,seconds,timeLeft,round,c1,c2,score,timeOut,attribs
        );

         if round = MAX_ROUNDS then
         begin
            quit := true;
            completed := true;
         end else
            inc(round);

         timeOut := false;
         end_of_round := false;
         seconds := 59; minutes := 1;
      end;
   end; { main game finishes here }

   if completed then
      game_completed(maxTime,timeLeft,minutes,seconds,hi_score);

   if not computer then
      user_gets_hi_score(c1,c2,hi_score,score,round,timeLeft,completed);

   quit := false;
   clear;
end;


procedure batty_menu(gfx : gfxType);

var
   i : byte;

begin
   clear;
   for i := 1 to 100 do
   begin
      display_gfx(6,rnd_limits(1,15),gfx);
      interrupt_delay(100,false);

      two_colours('START',10);
      two_colours('Redefinable Keys',12);
      two_colours('Editor',14);
      two_colours('Help',16);
      two_colours('Options',18);
      two_colours('Quit',20);

      if keypressed then
         break;
   end;
   clear;
end;


procedure hi_score_table(hi_score : hi_score_type;
                              gfx : gfxType);

begin
   clear;
   display_gfx(9,0,gfx);
   sort_hi_score_table(hi_score);
   display_hi_score_table(hi_score);
   display_outline(10,70,2,23);
   clear;
end;


procedure display_spectrum(visible : visibleType);

var
   i : byte;

begin
   clear;
   for i := 1 to MAX_ROUNDS do
   begin
      spectrum(i,visible);
      interrupt_delay(1000,false);
      if keypressed then
         break;
   end;
   clear;
end;


procedure display_line(x,y,line : byte);

begin
   gotoxy(x,y);
   write(chr(line));
end;


procedure display_rectangle;  { 179³ 196Ä 191¿ 192À  217Ù 218Ú }

var
   i : byte;

begin
   textcolor(9);
   for i := 1 to 10 do      { vertical lines }
   begin
      display_line(2,5+i,179);
      display_line(79,5+i,179);
   end;

   for i := 1 to 78 do      { horizontal lines }
   begin
      display_line(1+i,5,196);
      display_line(1+i,15,196);
   end;

   display_line(2,5,218);   { each corner }
   display_line(79,5,191);
   display_line(2,15,192);
   display_line(79,15,217);
end;


procedure editor_menu;

begin
   writeto('0   Erase',34,17,15);
   writexy('BATTY EDITOR',2,4);

   writeto(fillstr(12,chr(22)),34,3,12);

   writecol('[4]C[C]lear',13,18);
   writecol('[4]V[C]iew',13,20);
   writecol('[4]D[C]efault',13,22);
   writecol('[4]S[C]ave',61,18);
   writecol('[4]L[C]oad',61,20);
   writecol('[4]Q[C]uit',61,22);

   display_rectangle;
end;


procedure clear_pattern(var visible : visibleType);

var
   i : byte;

begin
   for i := 1 to NO_OF_BLOCKS do
      visible[1,i] := 0;

   clrwin(3,6,78,14);
end;


procedure view_pattern(visible : visibleType);

var
   ok : boolean;
   i  : byte;
   ch : char;

begin
   clear;
   for i := 1 to NO_OF_BLOCKS do
      if visible[1,i] <> 0 then
      begin
         ok := true;
         break;
      end;

   if ok then
      display_blocks(1,visible)
   else
      writexy('There''s no patterns',13,6);

   pause(ch);
   clear;
   editor_menu;
end;


procedure default_pattern(var visible : visibleType);

var
   ch : char;

begin
   repeat
      clear;
      writexy('Are you sure you want the default?',12,6);
      writexy('Yes or No',14,4);
      pause(ch);
      clear;
   until upcase(ch) in ['Y','N'];

   case ch of
      'y','Y' :
      begin
         clear_pattern(visible);
         load_rounds(visible);
      end;
   end;
   editor_menu;
end;


procedure save_pattern(visible : visibleType);

var
   i         : byte;
   patternsF : text;

begin
   set_file(patternsF,'rewrite',path+Dname[1]+Fname[3]);

   for i := 1 to NO_OF_BLOCKS do
      writeln(patternsF,visible[1,i]);

   set_file(patternsF,'close',EMPTY);
end;


procedure load_pattern(var visible : visibleType);

var
   patternsF : text;
   i         : byte;

begin
   set_file(patternsF,'reset',path+Dname[1]+Fname[3]);
   clear_pattern(visible);

   for i := 1 to NO_OF_BLOCKS do
      readln(patternsF,visible[1,i]);

   set_file(patternsF,'close',EMPTY);
end;


procedure pattern_test(var visible : visibleType;
                        tmpvisible : visibleType);
var
   i,s : byte;
   ch  : char;

begin
   for i := 1 to NO_OF_BLOCKS do
      if visible[1,i] <> tmpvisible[1,i] then
      begin
         clear;
         writexy('The pattern has been modified. Is this OK?',12,6);
         writexy('Yes or No',14,4);

         while not (upcase(ch) in ['Y','N']) do
            pause(ch);

         if upcase(ch) = 'N' then
            for s := 1 to NO_OF_BLOCKS do
               visible[1,s] := tmpvisible[1,s];
         break;
      end;
   clear;
end;


procedure editor(var visible : visibleType);

var
   x,y         : shortint;
   tmp         : byte;
   colour,i    : byte;
   savex,savey : byte;
   ch          : char;
   tmpvisible  : visibleType;

begin
   clear;

   x := 3; y := 6;
   colour := black;

   for i := 1 to NO_OF_BLOCKS do
      tmpvisible[1,i] := visible[1,i];

   editor_menu;

   repeat
      for i := 1 to 7 do
      begin
         if colour = i then
            textcolor(i+blink)
         else
            textcolor(i);
         gotoxy(34,17+i);
         write(i,SKIP:3,colourNames[i]);
      end;

      display_blocks(1,visible);

      colourletter(x,y,x+5,y,red);
      pause(ch);

      savex := x; savey := y;

      case ch of
         LEFT : dec(x,7);
        RIGHT : inc(x,7);
           UP : dec(y,2);
         DOWN : inc(y,2);
         '0'..'7' : colour := ord(ch)-48;
      end;

{      limits(x,3,73);
      limits(y,6,14);}
      if x <= 3 then x := 3;
      if x >= 73 then x:= 73;
      if y <= 6 then y := 6;
      if y >= 14 then y := 14;

      colourletter(savex,savey,savex+5,savey,colour);

      tmp := 0;
      for i := 6 to savey do
      begin
         if i = savey then
         begin
            inc(tmp,round((savex div 7)+1));
            break;
         end
         else
            inc(tmp,11);
         inc(i);
      end;

      if colour = black then
         visible[1,tmp] := 0
      else
         visible[1,tmp] := 7;

      visible[1,tmp] := colour;

      case upcase(ch) of
         'C' : clear_pattern(visible);
         'V' : view_pattern(visible);
         'D' : default_pattern(visible);
         'S' : save_pattern(visible);
         'L' : load_pattern(visible);
      end;
   until ch = ESCAPE;

   pattern_test(visible,tmpvisible);
end;


procedure load_details(var attribs : attribsType;
                      var hi_score : hi_score_type;
                       var visible : visibleType;
                           var gfx : gfxType);

begin
   read_batty_options(attribs);
   read_hi_score_from_disk(hi_score);
   sort_hi_score_table(hi_score);
   load_rounds(visible);
   load_gfx(gfx);
end;


procedure find_path;

begin
{   select_path;}
{   path := 'c:\mydocu~1\pascal\batty\';}

   GetDir(0,path); { 0 = Current drive }

   if file_exists(path+'\batty\nul') then
      path := path+'\batty\'
   else
      path := path + '\';
end;



    (*  start of main program  *)



var
   time     : byte;
   maxTime  : integer;
   exitgame : boolean;
   visible  : visibleType;
   hi_score : hi_score_type;
   attribs  : attribsType;
   gfx      : gfxType;
   ch       : char;

begin
   swapvectors;
   exec(getenv('COMSPEC'),'/c mode Con: cols=80 lines=25');
   swapvectors;

   textmode(80);
   clear;
   randomize;

   display_introduction;
   find_path;

   load_details(attribs,hi_score,visible,gfx);

   time := 1;
   maxTime := 1230;

   repeat  { code for main menu }
      batty_menu(gfx);

      if keypressed then
      begin
         pause(ch);
         case upcase(ch) of
            'S' : start_game(attribs,hi_score,maxTime,false,time,visible,gfx);
{           'R' : redefinable_keys;}
            'E' : editor(visible);
            'H' : help_page(gfx);
            'O' : options_menu(attribs,gfx);
            'Q' : exitgame := true;
            F10_KEY : throttle := not(throttle);
         end;
      end else
      begin
         case time of
            1 : hi_score_table(hi_score,gfx);
            2 : display_spectrum(visible);
            3 : start_game(attribs,hi_score,maxTime,true,time,visible,gfx);
         end;

         inc(time);
         if time > 3 then
            time := 1;
      end;
   until exitgame;

   display_credits;

(* textcolor(lightgray); { turns the MS-DOS colour to lightgray }
   clrscr;               { and clears the screen                }*)
{  normvideo;}
end.



    (*  end of main program  *)