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

{
   update resarf on site coz the star speeds are the wrong settings.
   the fastest star speed is too fast.

   when recording on zigzag. do a zigzag from the bottom to top. so the
   sequence looks like a zigzag

   make the stars colour different from resarf colour, on the random demo

   sort the format menu
}

program Resarf; { ver. 4.6 }
{$M 8192,0,65000}
uses
   crt,dos;

const
   LT  = #75;
   RT  = #77;
   UP  = #72;
   DN  = #80;
   ESC = #27;
   SP  = #32;
   CR  = #13;
   BS  = #8;
   F1  = #59;
   F2  = #60;
   F3  = #61;

   CTRL_CR  = #10;
   INCREASE = '=';
   DECREASE = '-';
   SPC      = ' ';
   NULL     = '';
   BAR      = #219;

   MaxPath   = 79;
   NameLen   = 8;
   MaxChars  = 91;

   ListMax     = 30000; { reduce this no. if any problems }
   Max_X_Turn  = 32;    { any problems with path add var to all optionsRec }
   Max_Y_Turn  = 32;

   CpuDemoLen  = 2000;  { any problems with window command check windmax }
   BlocksLen   = 80;
   ControlTime = 5;

   MaxMenuOpt  = 8;
   OptionLen   = 12;
   MaxMenu     = 4;

   MaxStr      = 255;
   MaxTruncStr = 25;
   MaxTextStr  = 10;

   MaxFiles    = 10;
   SysFiles    = 5;
   MaxFormat   = 10;

   LeFT_POiNTeR  = #175;
   RiGHT_POiNTeR = #174;
   PLAY          = #16;

   foreground_text : array[1..5] of string[13] =
   ('Off','Rnd Colours 1','Rnd Colours 2','Colours 1','Colours 2');

   background_text : array[1..5] of string[14] =
   ('Off','Stars 1','Stars 2','Stars 3','Colour Squares');

   mode_text       : array[1..2] of byte = (25,50);
   resarf_text     : array[1..3] of string[6] = ('Normal','Blocks','Random');

   OnOff           : array[0..1] of string[3] = ('Off','On');

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

   SysNames        : array[1..SysFiles] of string[12] =
   ('Names.dat','Text.dat','Format.dat','Resarf.gfx','Disk.gfx');

   speed_text      : array[1..3] of string[10] =
   ('Normal','Fast','Super Fast');

   speedlist       : array[1..3,1..5] of word =
   ((1000,500,250,180,160),(130,100,60,40,20),(15,10,5,2,0));

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

   errmsg : array[1..14] of string[31] =
   ('Error loading GFX',
    'Error loading sequence',
    'Error writing to temp file',
    'Error saving sequence',
    'Error importing sequence',
    'Error loading sequence filenames',
    'Error saving sequence filenames',
    'Error loading text file',
    'Error saving text file',
    'Error loading format',
    'Error saving format',
    'Error loading format filenames',
    'Error saving format filenames',
    'Error deleting format');

   tmpmax   : integer = 0;
   c1       : byte    = 9;
   c2       : byte    = 15;
   c3       : byte    = 12; {not used often}
   winexp   : boolean = false;
   winexp2  : boolean = false;
{   formatno : byte    = 1;}
   CheckBreak: Boolean = true; {disables the ctrl+c, but not the ctrl+break}

type
   FileRec =
   RECORD
      x2,y2 : byte;
   END;

   CpuRec =
   RECORD
      computer : boolean;
      zigzag   : boolean;
      x_turn   : byte;
      y_turn   : byte;
   END;

   EffectsRec =
   RECORD
      foreNo,
      backNo,
      modeNo,
      typeNo    : byte;
      rndNo,
      autopause : boolean;
   END;

   SpeedRec =
   RECORD
      starsno,
      clearafter,
      pausedelay,
      pauselength,
      resarfno,
      speedno : byte;
   END;

   ColoursRec =
   RECORD
      col1,col2 : byte;
      rndcol    : boolean;
   END;

   OptionsRec =
   RECORD
      effects : EffectsRec;
      speed   : SpeedRec;
      colours : ColoursRec;
      cpu     : CpuRec;
   END;

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

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

   FnameRec =
   RECORD
      name : string[NameLen];
      size : integer;
   END;

   progType    = array[1..{MAX}1] of boolean; {for setup assoc}

   DataRecord =
   RECORD
      path  : string;{[MaxPath]}
      osver : byte;
      prog  : progType;
      icons : array[1..4] of boolean;
   END;

   ListType    = array[1..2,1..ListMax] of byte;
   FileType    = file of FileRec;
   FnameType   = array[1..MaxFiles] of FnameRec;
   PicType     = file of PatternRec;
   MenuArray   = array[1..MaxMenu,1..MaxMenuOpt] of MenuRecord;
   ColType     = array[1..3] of byte;
   FormatType  = array[1..MaxFormat] of string[NameLen];
   TextstrType = array[0..MaxTextStr] of string[MaxStr];
   OptionsType = array[0..MaxFormat] of OptionsRec;
   GfxType     = array[4..5,1..MaxChars] of PatternRec;
   OptionsFile = file of OptionsRec;


const
   MenuOption : MenuArray =
   (((Name: 'Computer'     ; x: 34; y: 12),
     (Name: 'Zigzag'       ; x: 34; y: 13),
     (Name: 'X Turn'       ; x: 34; y: 15),
     (Name: 'Y Turn'       ; x: 34; y: 16),
     (Name: 'Random Turns' ; x: 34; y: 19),
     (Name: 'Preset'       ; x: 37; y: 20),
     (Name: 'Exit'         ; x: 38; y: 21),
     (Name: ''             ; x:  0; y:  0)),

    ((Name: 'Foreground'   ; x: 27; y: 10),
     (Name: 'Background'   ; x: 27; y: 11),
     (Name: 'Random'       ; x: 27; y: 13),
     (Name: 'Auto Pause'   ; x: 27; y: 14),
     (Name: 'Text Mode'    ; x: 27; y: 16),
     (Name: 'Resarf Type'  ; x: 27; y: 17),
     (Name: 'Preset'       ; x: 37; y: 19),
     (Name: 'Exit'         ; x: 38; y: 20)),

    ((Name: 'Resarf Speed' ; x: 27; y: 10),
     (Name: 'Stars Speed'  ; x: 27; y: 12),
     (Name: 'Clear Stars'  ; x: 27; y: 13),
     (Name: 'Pause Delay'  ; x: 27; y: 15),
     (Name: 'Pause Length' ; x: 27; y: 16),
     (Name: 'Preset'       ; x: 37; y: 18),
     (Name: 'Exit'         ; x: 38; y: 19),
     (Name: ''             ; x:  0; y:  0)),

    ((Name: 'Colour 1'     ; x: 32; y: 12),
     (Name: 'Colour 2'     ; x: 32; y: 13),
     (Name: 'Random'       ; x: 32; y: 15),
     (Name: 'Invert'       ; x: 37; y: 17),
     (Name: 'Preset'       ; x: 37; y: 18),
     (Name: 'Exit'         ; x: 38; y: 19),
     (Name: ''             ; x:  0; y:  0),
     (Name: ''             ; x:  0; y:  0)));


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

var
   rnd : word;

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


procedure clear;

begin
   textcolor(black);
   clrscr;
end;


procedure pause(var ch : char);

begin
   ch := readkey;
   if ch = #0 then
      ch := readkey;

   if upcase(ch) = 'X' then
      halt;
end;


procedure setbg(x1,y1 : byte;
                x2,y2 : byte;
                  col : byte);

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


procedure display_squares(var options : OptionsType);

var
   x,y : byte;
   ext : byte;

begin
   if options[{formatno}0].effects.modeNo = 1 then
      ext := 5
   else
      ext := 10;

   for x := 1 to 4 do
      for y := 1 to 5 do
      begin
         window(x*20-19,(y*ext)-(ext-1),x*20,y*ext);
         textbackground(rnd_limits(1,7));
         clear;
         window(1,1,80,hi(windmax)+1);
      end;
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);

begin
   writeto(text,(80 - length(text) + 1) div 2,row,colour);
end;


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

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


procedure limits(var num : byte;
                 min,max : byte;
              wraparound : boolean);

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


function cv(number : longint) : string;

var
   tmpstr : string[10];

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


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

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

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

   limits(number,min,max,false);
end;


procedure press_space;

var
   ch : char;

begin
   writexy('Press SPACE to continue',17,c3);
   repeat
      pause(ch);
   until ch = SP;
end;


function test_error(type1 : boolean; txt1 : string) : boolean;

var
   ch : char;

begin
   if IOresult <> 0 then
   begin
      if type1 then {major error}
      begin
         clear;
         writexy('A fatal error has occured',13,c1);
         writexy(txt1,14,c2);
         press_space;
         clrscr;
         halt;
      end else
      begin
         writeto(txt1,1,1,c2);
         test_error := true;
         pause(ch);
      end;
   end else
      test_error := false;
end;


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

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

begin
   tmp := NULL;

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

   fillstr := tmp;
end;


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

begin
   ok := false;
   repeat
      pause(key);
      key := upcase(key);

      for i := 1 to length(choices) do
         if choices[i] = key then
            ok := true;
   until ok;
end;


function choice : boolean;

var
   hold : char;

begin
   check_keys('YN',hold);

   case upcase(hold) of
      'N' : choice := false;
      'Y' : choice := true;
   end;
end;


procedure test_for_forward_slash(num : byte;
                                   i : byte;
                          var colour : byte);
begin
   if num = 5 then
   begin
      if (i >= 87) and (i <= 90) then
         colour := c1
      else
         colour := c2;
   end else
      colour := c2;
end;


procedure load_gfx(var gfx : GfxType;
                      path : string);

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

begin
   i := 1;
   for m := 4 to 5 do
   begin
      assign(F,path+Dname[2]+SysNames[m]);
      {$I-} reset(F); {$I+}
      test_error(true,errmsg[1]);
      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 display_gfx(num : byte;
                      gfx : GfxType);

var
   colour,i : byte;

begin
   i := 1;
   repeat
      with gfx[num,i] do
      begin
         test_for_forward_slash(num,i,colour);
         writeto(chr(letter2),storex,storey,colour);
         inc(i);
      end;
   until gfx[num,i].storex = 0;
end;


procedure readxy(var text : string;
                      row : byte;
                      max : byte);

var
   count : byte;
   key   : char;

begin
   count := 1;
   text := NULL;
   repeat
      pause(key);
      case key of
         ESC :
         begin
            clrwin(1,row,80,row);
            count := 1;
            text := NULL;
         end;
         BS :
         if count > 1 then
         begin
            dec(count);
            write(BS,SPC,BS);
            delete(text,count,1);
            clrwin(1,row,80,row);
            writexy(text,row,c2);
         end;
         SP..#127,#156 :
         if count <= max then
         begin
            inc(count);
            text := text + key;
            writexy(text,row,c2);
         end;
      end;
   until key = CR;
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;
            'S' : col := c2;
         end;

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


function file_exists(filename : string) : boolean;

var
   F : file;

begin
   file_exists := false;

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

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


function uppercase(text : string) : string;

var
   i : byte;

begin
   for i := 1 to length(text) do
      text[i] := upcase(text[i]);
   uppercase := text;
end;


(*procedure select_path(var path : string);

var
   hold      : char;
   ok        : boolean;
   i,m       : byte;
   filecount : byte;

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

      writexy('Please select path?',12,c1);
      readxy(path,13,MaxPath);

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

      if path = NULL then
         path := 'c:\mydocu~1\pascal\resarf\'
      else
         path := path+'\';

      m := 1;
      filecount := 0;

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

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

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

      if filecount <> SysFiles then
      begin
         sound(220);
         delay(400);
         nosound;
         pause(hold);
      end;
   until ok;
   clear;
end;*)


procedure check_files(path : string);

var
   hold      : char;
   i,m       : byte;
   filecount : byte;

begin
   clear;
   m := 1;
   filecount := 0;

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

      if i = 3 then
         inc(m);
   end;

   case filecount of
      0  : writexy('Resarf files don''t exist in this directory.',13,c2);
      1..SysFiles-1 :
      begin
         writexy('Some of the files maybe be missing or corrupt.',12,c1);
         writexy('You probably have to re-install Resarf.',13,c2);
      end;
   end;

   if filecount <> SysFiles then
   begin
      sound(220);
      delay(400);
      nosound;
      pause(hold);
      clrscr;
      halt;
   end;
end;

procedure initialise(var textstr : TextstrType;
                      var textno : byte;
                      var fileno : byte);

var
   i : byte;

begin
   for i := 1 to BlocksLen do
      textstr[0] := textstr[0] + BAR;

   textno := 1;
   fileno := 1;
end;


procedure display_menu(num : byte);

var
   i : byte;

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


procedure computer_menu(var options : OptionsType);

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

begin
   clear;
   writexy('Computer Menu',9,c1);
   writexy('÷÷÷÷÷÷÷÷÷÷÷÷÷',10,c2);

   done := false;
   HiLite := 7;

   display_menu(1);

   with options[{formatno}0].cpu do
   repeat
      with MenuOption[1,HiLite] do
         writeto(name,x,y,c2);

      writeto(OnOff[ord(computer)],44,12,c2);
      writeto(OnOff[ord(zigzag)],44,13,c2);
      writeto(cv(x_turn),44,15,c2);
      writeto(cv(y_turn),44,16,c2);

      check_keys(UP+DN+LT+RT+CR+ESC,key);

      with MenuOption[1,HiLite] do
      begin
         writeto(name,x,y,c1);
         if HiLite <= 4 then
            writeto(fillstr(3,SPC),44,y,black);
      end;

      case key of
         UP : dec(HiLite);
         DN : inc(HiLite);
         LT :
            case HiLite of
               1 : computer := true;
               2 : zigzag := true;
            end;
         RT :
            case HiLite of
               1 : computer := false;
               2 : zigzag := false;
            end;
         CR :
            case HiLite of
               5 :
               begin
                  x_turn := rnd_limits(1,Max_X_Turn);
                  y_turn := rnd_limits(1,Max_Y_Turn);
                  clrwin(44,15,45,16);
               end;
               6:
               begin
                  computer := false; zigzag := false;
                  x_turn := 8; y_turn := 4;
                  clrwin(44,12,46,16);
               end;
               7 : done := true;
            end;
         ESC : done := true;
      end;

      limits(HiLite,1,7,false);

      case HiLite of
         3 : opt(x_turn,key,1,1,Max_X_Turn);
         4 : opt(y_turn,key,1,1,Max_Y_Turn);
      end;
   until done;
   clear;
end;


procedure colours_menu(var options : OptionsType);

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

begin
   clear;
   writexy('Colours Menu',9,c1);
   writexy('÷÷÷÷÷÷÷÷÷÷÷÷',10,c2);

   with options[{formatno}0].colours do
   begin
      col1 := c1;
      col2 := c2;
   end;

   done := false;
   HiLite := 6;

   display_menu(4);

   with options[{formatno}0].colours do
   repeat
      with MenuOption[4,HiLite] do
         writeto(name,x,y,c2);

      writeto(colourNames[col1],42,12,{c2}col1);
      writeto(colourNames[col2],42,13,{c2}col2);
      writeto(OnOff[ord(rndcol)],42,15,c2);

      check_keys(UP+DN+LT+RT+CR+ESC,key);

      with MenuOption[4,HiLite] do
      begin
         writeto(name,x,y,c1);
         if HiLite <= 3 then
            writeto(fillstr(12,SPC),42,y,black);
      end;

      case key of
         UP : dec(HiLite);
         DN : inc(HiLite);
         LT : if HiLite = 3 then rndcol := true;
         RT : if HiLite = 3 then rndcol := false;
         CR :
            case HiLite of
               4 :
               begin
                  tmpcol := col1;
                  col1 := col2;
                  col2 := tmpcol;
                  clrwin(42,12,56,13);
               end;
               5 :
               begin
                  col1 := 9;
                  col2 := 15;
                  rndcol := true;
                  clrwin(42,12,56,15);
               end;
               6 : done := true;
            end;
         ESC : done := true;
      end;

      limits(HiLite,1,6,false);

      case HiLite of
         1 : opt(col1,key,1,1,15);
         2 : opt(col2,key,1,1,15);
      end;
   until done;

   clear;

   with options[{formatno}0].colours do
   begin
      c1 := col1;
      c2 := col2;
   end;
end;


procedure effects_menu(var options : OptionsType);

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

begin
   done := false;
   HiLite := 8;

   clear;
   writexy('Effects Menu',7,c1);
   writexy('÷÷÷÷÷÷÷÷÷÷÷÷',8,c2);

   display_menu(2);

   with options[{formatno}0].effects do
   repeat
      with MenuOption[2,HiLite] do
         writeto(name,x,y,c2);

      writeto(foreground_text[foreNo],40,10,c2);
      writeto(background_text[backNo],40,11,c2);
      writeto(OnOff[ord(rndNo)],40,13,c2);
      writeto(OnOff[ord(autopause)],40,14,c2);
      writeto(cv(mode_text[modeNo]),40,16,c2);
      writeto(resarf_text[typeNo],40,17,c2);

      check_keys(UP+DN+LT+RT+CR+ESC,key);

      with MenuOption[2,HiLite] do
      begin
         writeto(name,x,y,c1);
         if HiLite <= 6 then
            writeto(fillstr(14,SPC),40,y,black);
      end;

      case key of
         UP : dec(HiLite);
         DN : inc(HiLite);
         LT :
            case HiLite of
               3 : rndNo := true;
               4 : autopause := true;
            end;
         RT :
            case HiLite of
               3 : rndNo := false;
               4 : autopause := false;
            end;
         CR :
            case HiLite of
               7 :
               begin
                  foreNo := 4; backNo := 1;
                  rndNo  := false; modeNo := 1;
                  typeNo := 1; autopause := false;
                  clrwin(40,10,53,17);
               end;
               8 : done := true;
            end;
         ESC : done := true;
      end;

      limits(HiLite,1,8,false);

      case HiLite of
         1 : opt(foreNo,key,1,1,5);
         2 : opt(backNo,key,1,1,5);
         5 : opt(modeNo,key,1,1,2);
         6 : opt(typeNo,key,1,1,3);
      end;
   until done;
   clear;
end;


procedure change_speed_settings(var options : OptionsType;
                                        key : char;
                                        num : byte);

begin
   with options[num].speed do case key of
      LT :
         if not ((resarfno = 1) and (speedno = 1)) then
         begin
            dec(speedno);
            if speedno < 1 then
            begin
               dec(resarfno);
               speedno := 5;
            end;
         end;
      RT :
         if not ((resarfno = 3) and (speedno = 5)) then
         begin
            inc(speedno);
            if speedno > 5 then
            begin
               inc(resarfno);
               speedno := 1;
            end;
         end;
   end;
end;


procedure speed_menu(var options : OptionsType);

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

begin
   done := false;
   HiLite := 7;

   clear;
   writexy('Speed Menu',7,c1);
   writexy('÷÷÷÷÷÷÷÷÷÷',8,c2);

   display_menu(3);

   with options[{formatno}0].speed do
   repeat
      with MenuOption[3,HiLite] do
         writeto(name,x,y,c2);

      writeto(speed_text[resarfNo]+SPC+cv(speedno),41,10,c2);
      writeto(cv(starsNo),41,12,c2);
      writeto(cv(clearafter)+' secs',41,13,c2);
      writeto(cv(pausedelay),41,15,c2);
      writeto(cv(pauselength)+' secs',41,16,c2);

      check_keys(UP+DN+LT+RT+CR+ESC,key);

      with MenuOption[3,HiLite] do
      begin
         writeto(name,x,y,c1);
         if HiLite <= 5 then
            writeto(fillstr(13,SPC),41,y,black);
      end;

      if HiLite = 1 then
         change_speed_settings(options,key,0);

      case key of
         UP : dec(HiLite);
         DN : inc(HiLite);
         CR :
            case HiLite of
               6 :
               begin
                  starsno := 7; clearafter := 5;
                  pausedelay := 5; pauselength := 2;
                  resarfno := 1; speedno := 5;

                  clrwin(41,10,53,16);
               end;
               7 : done := true;
            end;
         ESC : done := true;
      end;

      limits(HiLite,1,7,false);

      case HiLite of
         2 : opt(starsNo,key,1,1,10);
         3 : opt(clearafter,key,1,1,30);
         4 : opt(pausedelay,key,1,1,50);
         5 : opt(pauselength,key,1,1,10);
      end;
   until done;
   clear;
end;


procedure random_sequence(var list : ListType;
                           var max : integer;
                           options : OptionsType);

var
   x,y       : byte;
   direction : byte;
   wait      : byte;
   i         : integer;
   store,tmp : byte;
   maxY      : byte;

begin
   maxY := hi(windmax)+1;
   x := 40; y := 13;

   max := ListMax;
   direction := rnd_limits(0,3);
   store := direction;

   for i := 1 to max do
   begin
      if direction in [0,2] then
         wait := rnd_limits(1,options[{formatno}0].cpu.x_turn)
      else
         wait := rnd_limits(1,options[{formatno}0].cpu.y_turn);

      case store of
         0 : tmp := 2;
         1 : tmp := 3;
         2 : tmp := 0;
         3 : tmp := 1;
      end;

      if wait = 1 then
      begin
         direction := rnd_limits(0,3);
         while direction = tmp do
            direction := rnd_limits(0,3);
      end;

      case x of
         1  :
            while direction in [tmp,0] do
               direction := rnd_limits(0,3); { Left   }
         79 :
            while direction in [tmp,2] do
               direction := rnd_limits(0,3); { Right  }
      end;

      case y of
         1  :
            while direction in [tmp,1] do
               direction := rnd_limits(0,3); { Top    }
         else
            if y = maxY then
               while direction in [tmp,3] do
                  direction := rnd_limits(0,3); { Bottom }
      end;

      store := direction;

      if not options[{formatno}0].cpu.zigzag then
      case direction of
         0 : dec(x); { Left  }
         1 : dec(y); { Up    }
         2 : inc(x); { Right }
         3 : inc(y); { Down  }
      end else

      case direction of
         0 : begin dec(x); dec(y); end;
         1 : begin dec(y); inc(x); end;
         2 : begin inc(x); inc(y); end;
         3 : begin inc(y); dec(x); end;
      end;

      limits(x,1,79,false);
      limits(y,1,maxY,false);

      list[1,i] := x;
      list[2,i] := y;
   end;
end;


procedure background_effects(var options : OptionsType;
                                       i : integer;
                                   d1,d2 : byte);
var
   rnd : byte;

begin
   with options[{formatno}0].effects do
   begin
      case backNo of
         1 : textbackground(black);
         5 :
         if (i mod 100 = 0) or (i = 1) then
         begin
            textcolor(black);
            display_squares(options);
            textbackground(black);
         end;
      end;

      if backNo in [1,5] then
         exit;

      if i mod options[{formatno}0].speed.starsno = 0 then { displays stars }
      begin
         case backNo of
            2 : textcolor(d1);
            3 : textcolor(rnd_limits(1,15));
            4 :
               if rnd_limits(0,1) = 0 then
                  textcolor(d1)
               else
                  textcolor(d2);
         end;

         gotoxy(rnd_limits(1,79),rnd_limits(1,hi(windmax)+1));
         rnd := rnd_limits(1,3);
         case rnd of
            1 : write(#46); {full stop}
            2 : write(#249);
            3 : write(#250);
         end;
      end;
   end;
end;


procedure foreground_effects(var options : OptionsType;
                                       m : byte);

begin
   with options[{formatno}0].effects do
      case foreNo of
         1 : if m = 1 then textcolor(c1);
         2 : if m = 1 then textcolor(rnd_limits(1,15));
         3 : textcolor(rnd_limits(1,15));
         4 :
            if m = 1 then
               if rnd_limits(0,1) = 0 then
                  textcolor(c1)
               else
                  textcolor(c2);
         5 :
            if odd(m) then
               textcolor(c1)
            else
               textcolor(c2);
      end;
end;


procedure random_effects(var options : OptionsType;
                          var textno : byte;
                                   i : integer);

begin
   with options[{formatno}0],effects,colours do
      if (rndNo) and
        ((i = 1) or (i mod CpuDemoLen = 0)) then
      begin
         clear;
         foreno := rnd_limits(1,5);
         backno := rnd_limits(1,5);
         textno := rnd_limits(0,1);

         if rndcol then
         begin
            c1 := rnd_limits(1,15);
            c2 := rnd_limits(1,15);
         end;
      end;
end;


procedure change_speed(key : char;
             var num1,num2 : byte;
               var options : OptionsType;
                var Rspeed : word);

begin
   if (key = INCREASE) or (key = '+') then
      if (num1 = 3) and (num2 = 5) then
      begin
         num1 := 3;
         num2 := 5;
      end
      else
      if num2 = 5 then
      begin
         num2 := 1;
         inc(num1);
      end else
         inc(num2);

   if key = DECREASE then
      if (num1 = 1) and (num2 = 1) then
      begin
         num1 := 1;
         num2 := 1;
      end
      else
      if num2 = 1 then
      begin
         num2 := 5;
         dec(num1);
      end else
         dec(num2);

   with options[{formatno}0].speed do
      Rspeed := speedlist[num1,num2];
end;


procedure control_box(var view : boolean;
                     num1,num2 : byte;
                           col : ColType;
                      var time : byte;
                          bak2 : byte);

begin
   if view then
   begin
      writeto(speed_text[num1]+SPC+cv(num2),1,2,{c2}bak2);

      writeto(RiGHT_POiNTeR+RiGHT_POiNTeR+SPC,1,1,col[1]);
      writeto(PLAY+SPC,4,1,col[2]);
      writeto(LeFT_POiNTeR+LeFT_POiNTeR,6,1,col[3]);
   end;

   if (view) and (time = controlTime) then
   begin
      writeto(fillstr(7,SPC),1,1,black);
      writeto(fillstr(12,SPC),1,2,black);

      view := false;
      time := 0;
   end;
end;


procedure change_controls(key : char;
                     var view : boolean;
                      var col : ColType;
                     var time : byte;
                    bak1,bak2 : byte);
var
   m  : byte;
   ch : char;

begin
   for m := 1 to 3 do
      col[m] := {c2}bak2;

   case key of
      DECREASE : col[1] := {c1}bak1;
      INCREASE,'+' : col[3] := {c1}bak1;
{      CR : col[2] := c1;}
   end;

   view := true;
   time := 0;

   writeto(fillstr(7,SPC),1,1,black);
   writeto(fillstr(12,SPC),1,2,black);

   while keypressed do
      ch := readkey;

   while keypressed do
      ch := readkey;
end;


procedure control_timer(view : boolean;
                    var time : byte;
                   var store : shortint);

var
   h,m1,s,hund : word;

begin
   if view then
   begin
      gettime(h,m1,s,hund);
      if (store <> s) and (store <> -1) then
      begin
         gettime(h,m1,s,hund);
         inc(time);
      end;
      store := s;
   end;
end;


procedure demo_keys(var quit : boolean;
               var num1,num2 : byte;
                 var options : OptionsType;
                  var Rspeed : word;
                    var view : boolean;
                     var col : ColType;
                    var time : byte;
                   bak1,bak2 : byte);

var
   key : char;

begin
   if keypressed then
   begin
      pause(key);
      case upcase(key) of
         'P' : pause(key);
         DECREASE,INCREASE,'+'{,CR} :
         begin
            change_speed(key,num1,num2,options,Rspeed);
            change_controls(key,view,col,time,bak1,bak2);
         end;
         ESC :
         begin
            clear;
            quit := true;
         end;
      end;
   end;
end;


procedure demo(var list : ListType;
                    max : integer;
               var quit : boolean;
            {var} options : OptionsType; { added var to fix cpu problem }
                 textno : byte;         { took out the var to fix textstr }
          var num1,num2 : byte;
               var view : boolean;
              var store : shortint;
               var time : byte;
            var textstr : TextstrType;
              bak1,bak2 : byte);

var
   count,i : integer;
   len     : byte;
   tmp,m   : byte;
   Rspeed  : word;
   col     : ColType;

   d1 : byte;
   d2 : byte;

begin
   if options[{formatno}0].cpu.computer then
      random_sequence(list,max,options);

   count := 1;
   len := length(textstr[textno]);
   tmp := len;

   Rspeed := speedlist[num1,num2];
   clear;

   d1 := rnd_limits(1,15); {stars colour}
   d2 := rnd_limits(1,15);

   for i := 1 to max-MaxStr do with options [{formatno}0] do
   begin
      control_box(view,num1,num2,col,time,bak2);
      control_timer(view,time,store);

      random_effects(options,textno,i);
      background_effects(options,i,d1,d2);

      if (cpu.computer) and (not effects.rndNo) then
         if i mod ((1000 * speed.clearafter) div 2) = 0 then
            clear;

      for m := 1 to len do
      begin
         foreground_effects(options,m);

         dec(tmp);
         gotoxy(list[1,count+tmp],list[2,count+tmp]);
         write(textstr[textno][m]);
      end;

      textcolor(black);
      gotoxy(80,1);

      delay(Rspeed);

      with speed do
         if effects.autopause then
            if rnd_limits(0,pausedelay*50) = 0 then
               delay(pauselength*1000);

      demo_keys(quit,num1,num2,options,Rspeed,view,col,time,bak1,bak2);

      if quit then
         exit;

      gotoxy(list[1,count+tmp],list[2,count+tmp]);
      write(SPC);

      inc(count);
      tmp := len;
   end;
end;


procedure load_sequence(var list : ListType;
                         var max : integer;
                          fileno : byte;
                            path : string;
                           Fname : FnameType);

var
   F       : FileType;
   ListRec : FileRec;

begin
   if winexp then
      assign(F,paramstr(1))
   else
      assign(F,path+Dname[4]+Fname[fileno].name+'.seq');
   {$I-} reset(F); {$I+}

   if test_error(false,errmsg[2]) then
      exit;

   max := 0;

   while not eof(F) do
   begin
      inc(max);
      read(F,ListRec);
      with ListRec do
      begin
         list[1,max] := x2;
         list[2,max] := y2;
      end;
   end;

   close(F);
end;


procedure setup_demo(var list : ListType;
                        Fname : FnameType;
                          max : integer;
                       fileno : byte;
                         path : string;
                  var options : OptionsType;
                       textno : byte;
                      textstr : TextstrType);

var
   quit      : boolean;
   num1,num2 : byte;
   view      : boolean;
   store     : shortint;
   time      : byte;
   bak1,bak2 : byte;

begin
   quit := false;
   view := false;
   time := 0;
   store := -1;

   bak1 := c1;
   bak2 := c2;

   {speed 200,20,10,2,0}

   with options[{formatno}0],effects,speed,cpu,colours do
   begin
      if not computer then
         load_sequence(list,max,fileno,path,Fname);

      if typeNo = 2 then
         textno := 0;

      if modeNo = 2 then
         textmode(80+font8x8);

      num1 := resarfno;
      num2 := speedno;

      if rndcol then
      begin
         c1 := rnd_limits(1,15);
         c2 := rnd_limits(1,15);
      end;
   end;

   while not quit do
      demo(list,max,quit,options,textno,num1,num2,view,store,time,textstr,bak1,bak2);

   if options[{formatno}0].effects.modeNo = 2 then
      textmode(80);

   c1 := bak1;
   c2 := bak2;

   textbackground(black);
   clear;
end;


procedure write_list_to_temp_file(var list : ListType;
                                       max : integer;
                                      path : string);

var
   ListRec : FileRec;
   F       : FileType;
   i       : integer;

begin
   assign(F,path+'Tmp.seq');
   {$I-} rewrite(F); {$I+}

   if test_error(false,errmsg[3]) then
      exit;

   max := tmpmax;

   for i := 1 to max do
      with ListRec do
      begin
         x2 := list[1,i];
         y2 := list[2,i];
         write(F,ListRec);
      end;

   for i := 1 to MaxStr do
      with ListRec do
      begin
         x2 := list[1,i];
         y2 := list[2,i];
         write(F,ListRec);
         inc(max);
      end;

   close(F);
end;


procedure check_min_position(var max : integer;
                       var filesaved : boolean;
                            var done : boolean;
                               start : byte);

begin
   clear;

   if max <= MaxStr then
   begin
      writexy('You have to do more than '+cv(MaxStr)+' positions.',start-1,c1);
      writexy('Cancelling will delete the current sequence.',start,c1);
      writexy('OK to cancel? Y/N',start+2,c2);
      if choice then
      begin
         max := 0;
         filesaved := true;
         done := true;
      end;
   end else
   begin
      writexy('Pressing escape now means the sequence will not loop correctly.',start,c1);
      writexy('OK to finish? Y/N',start+2,c2);
      if choice then
         done := true;
   end;

   clear;
end;


procedure restart_choice(var max : integer;
                         var x,y : byte;
                     var options : OptionsType;
                           start : byte);

begin
   clear;
   writexy('Restarting will delete the current sequence.',start-1,c1);
   writexy('Ok to restart? Y/N',start+1,c2);
   if choice then
   begin
      clear;
      max := 0;
      x := 40; y := 13;

      if options[{formatno}0].effects.modeNo = 2 then
         y := 25;
   end else
   begin
      clear;
      dec(max);
   end;
end;


procedure edit_sequence(var list : ListType;
                         var max : integer;
                   var filesaved : boolean;
                         options : OptionsType);

const
   arrows : array[1..4] of char = (#24,#25,#26,#27);

var
   x,y   : byte;
   key   : char;
   num   : byte;
   done  : boolean;
   maxY  : byte;
   start : byte;
   view  : boolean;
   del   : boolean;

begin
   done := false;
   filesaved := false;
   view := true;
   del := false;

   max := 0;
   x := 40; y := 13;

   if options[{formatno}0].effects.modeNo = 2 then
   begin
      y := 25;
      start := 25;
      textmode(80+font8x8);
   end else
      start := 13;

   clear;
   maxY := hi(windmax)+1;

   repeat
      if not del then
      begin
         inc(max);
         list[1,max] := x;
         list[2,max] := y;
      end;
      del := false;

      writeto(arrows[num],40,start,c2);
      writeto('X',x,y,c1);

      if view then
      begin
         writecol('[R]Position:[S]'+cv(max),66,maxY);
         writecol('[R]X:[S]'+cv(x)+' [R]Y:[S]'+cv(y),1,maxY);
      end;

      check_keys(UP+DN+LT+RT+ESC+BS+'RV'+#71#73#79#81,key);

      writeto(SPC,x,y,black);
      writeto(SPC+SPC,8,maxY,black);

      if max = 1 then
      case key of
         LT : num := 3;
         RT : num := 4;
         UP : num := 2;
         DN : num := 1;
      end;

      case upcase(key) of
         LT : dec(x);
         RT : inc(x);
         UP : dec(y);
         DN : inc(y);
        ESC : check_min_position(max,filesaved,done,start);
        #71 : begin dec(x); dec(y); end;
        #73 : begin inc(x); dec(y); end;
        #81 : begin inc(x); inc(y); end;
        #79 : begin dec(x); inc(y); end;
        'R' : restart_choice(max,x,y,options,start);
        'V' :
         begin
            clear;
            view := not view;
            dec(max);
         end;
         BS :
         if max > 2 then
         begin
            writeto(fillstr(5,SPC),75,maxY,black);
            del := true;
            dec(max);
            x := list[1,max];
            y := list[2,max];
         end else
            dec(max);
      end;

      if not ((x in [1..79]) and (y in [1..maxY]))
       or (key = ESC) then
         dec(max);

      limits(x,1,79,false);
      limits(y,1,maxY,false);

      if (x = 40) and (y = start)
       and (max <> 0) then
         done := true;
   until done;

   if options[{formatno}0].effects.modeNo = 2 then
      textmode(80);

   tmpmax := max;
   clear;
end;


function check_saved_file(no_of_files : byte;
                            filesaved : boolean) : byte;
var
   hold    : char;
   errcode : byte;

begin
   if no_of_files = MaxFiles then
      errcode := 1
   else
   if (tmpmax = 0) or (filesaved) then
      errcode := 2
   else
      errcode := 0;

   if errcode <> 0 then
   begin
      case errcode of
         1 : writexy('There''s a limit of 10 sequence files',23,c2);
         2 : writexy('There''s no sequence to save',23,c2);
      end;
      pause(hold);
   end;
   check_saved_file := errcode;
end;


function check_import_file(Fname : FnameType;
                     no_of_files : byte;
                             P,N : string) : byte;

var
   hold    : char;
   i       : byte;
   errcode : byte;

begin
   errcode := 0;

   if MaxFiles = no_of_files then
      errcode := 1
   else
   if not file_exists(P) then
      errcode := 2
   else
   for i := 1 to no_of_files do
      if uppercase(Fname[i].name) = uppercase(N) then
      begin
         errcode := 3;
         break;
      end;

   check_import_file := errcode;

   if errcode <> 0 then
   begin
      case errcode of
         1 : writexy('There''s a limit of 10 sequence files',23,c2);
         2 : writexy('File doesn''t exist',23,c2);
         3 : writexy('Name already used',23,c2);
      end;
      pause(hold);
   end;
end;


procedure save_sequence(var Fname : FnameType;
                    var filesaved : boolean;
                             path : string;
                  var no_of_files : byte);

var
   tmpstr : string;
   T      : FileType;
   hold   : char;

begin
   if check_saved_file(no_of_files,filesaved) <> 0 then
      exit;

   writexy('Please type the name of the file',22,c1);
   readxy(tmpstr,23,NameLen);

   if tmpstr = NULL then
      exit;

   assign(T,path+'Tmp.seq');
   {$I-} rename(T,path+Dname[4]+tmpstr+'.seq'); {$I+}

   if IOResult <> 0 then
   begin
      clrwin(1,22,80,23);
      writexy('Can''t save file',23,c2);
      pause(hold);
      exit;
   end;

   {$I-} reset(T); {$I+}
   if test_error(false,errmsg[4]) then
      exit;

   inc(no_of_files);
   Fname[no_of_files].name := tmpstr;
   filesaved := true;

   Fname[no_of_files].size := filesize(T);
   close(T);

   clrwin(33,13,48,13+no_of_files-3);
end;


procedure delete_sequence(var Fname : FnameType;
                    var no_of_files : byte;
                               path : string;
                                row : byte;
                         var fileno : byte);

var
   hold : char;
   F    : FileType;
   loop : byte;

begin
   if row <= 11 then
   begin
      writecol('[R]You''re not allowed to [S]delete[R] sample files.',0,23);
      pause(hold);
      exit;
   end;

   writecol('[R]OK to delete [S]'+Fname[row-8].name+'[R] Y/N?',0,23);

   if not choice then
      exit;

   assign(F,path+Dname[4]+Fname[row-8].name+'.seq');
   {$I-} erase(F); {$I+}

   if IOResult <> 0 then
   begin
      clrwin(1,23,80,23);
      writexy('Can''t delete file',23,c2);
      pause(hold);
      exit;
   end;

   if fileno >= row-8 then
      dec(fileno);

   {if row-8 = fileno then
      dec(fileno);}

   for loop := row-8 to no_of_files do
      Fname[loop] := Fname[loop+1];

   dec(no_of_files);
   clrwin(33,13,48+7,13+no_of_files-3);
end;


procedure rename_sequence(var Fname : FnameType;
                               path : string;{PathLen}
                                row : byte;
                        no_of_files : byte);

var
   tmpstr : string;{NameLen}
   F      : FileType;
   hold   : char;

begin
   if row <= 11 then
   begin
      writecol('[R]You''re not allowed to [S]rename[R] sample files.',0,23);
      pause(hold);
      exit;
   end;

   writecol('[R]Please type new name for [S]'+Fname[row-8].name,0,22);
   readxy(tmpstr,23,NameLen);

   if tmpstr = NULL then
      exit;

   assign(F,path+Dname[4]+Fname[row-8].name+'.seq');
   {$I-} rename(F,path+Dname[4]+tmpstr+'.seq'); {$I+}

   if IOResult <> 0 then
   begin
      clrwin(1,22,80,23);
      writexy('Can''t rename file',23,c2);
      pause(hold);
      exit;
   end;

   Fname[row-8].name := tmpstr;
   clrwin(33,13,48,13+no_of_files-3);
end;


procedure import_sequence(var Fname : FnameType;
                    var no_of_files : byte;
                               path : string);

var
   tmpstr  : string;{PathStr}
   T       : FileType;
   hold    : char;
   TmpFile : text;
   tmpio   : integer;

   P : PathStr;
   D : DirStr;
   N : NameStr;
   E : ExtStr;

begin
   writexy('Please type path and filename of sequence to import',22,c1);
   readxy(tmpstr,23,MaxPath);

   if tmpstr = NULL then
      exit;

   P := tmpstr;
   Fsplit(P,D,N,E);

   if E <> '.seq' then
      insert('.seq',P,length(P)+1);

   clrwin(1,22,80,23);

   if check_import_file(Fname,no_of_files,P,N) <> 0 then
      exit;

   swapvectors;
   exec(getenv('COMSPEC'),'/C xcopy '+P+SPC+path+'Sequence'+' /q > '+path+'blank');
   swapvectors;

   if doserror <> 0 then
   begin
      clrwin(1,22,80,23);
      writexy('Could not execute Command.Com',23,c2);
      pause(hold);
      exit;
   end;

   assign(TmpFile,path+'blank');
   {$I-} erase(TmpFile); {$I+}

   if IOresult <> 0 then
      tmpio := 0;

   inc(no_of_files);
   Fname[no_of_files].name := N;

   assign(T,path+Dname[4]+Fname[no_of_files].name+'.seq');
   {$I-} reset(T); {$I+}

   if test_error(false,errmsg[5]) then
      exit;

   Fname[no_of_files].size := filesize(T);
   close(T);

   clrwin(33,13,48,13+no_of_files-3);
end;


procedure export_sequence(Fname : FnameType;
                           path : string;
                            row : byte);

var
   tmpstr  : string;{MaxPath}
   hold    : char;
   TmpFile : text;
   tmpio   : integer;

   P : PathStr;
   D : DirStr;
   N : NameStr;
   E : ExtStr;

begin
   if row <= 11 then
   begin
      writecol('[R]You''re not allowed to [S]export[R] sample files.',0,23);
      pause(hold);
      exit;
   end;

   writecol('[R]Please type directory were [S]'+Fname[row-8].name+'[R] will export to',0,22);
   readxy(tmpstr,23,MaxPath);

   if tmpstr = NULL then
      exit;

   P := tmpstr;
   Fsplit(P,D,N,E);

   if P[length(P)] = '\' then
      delete(P,length(P),1);

   if not file_exists(P+'\nul') then
   begin
      clrwin(1,22,80,23);
      writexy('Directory doesn''t exist',23,c2);
      pause(hold);
      exit;
   end;

   swapvectors;
   exec(getenv('COMSPEC'),'/C xcopy '+path+'Sequence\'+Fname[row-8].name+'.seq'+SPC+P+'\ /y /q > '+path+'blank');
   swapvectors;

   if doserror <> 0 then
   begin
      clrwin(1,22,80,23);
      writexy('Could not execute Command.Com',23,c2);
      pause(hold);
   end;

   assign(TmpFile,path+'blank');
   {$I-} erase(TmpFile); {$I+}

   if IOresult <> 0 then
      tmpio := 0;

   clrwin(1,22,80,23);
   writexy('The file has been exported',23,c2);
   pause(hold);
end;


procedure disk_menu_text(gfx : gfxType);

begin
   display_gfx(5,gfx);

   writeto('Sequence',33,7,c1);
   writexy('~~~~~~~~~~~~~~~',8,c2);

   writeto('Size',44,7,c1);
   writexy('---------------',12,c1);

   writecol('[S]D[R]elete',56,9);
   writecol('[S]R[R]ename',56,10);
   writecol('[S]S[R]ave',56,11);
   writecol('[S]I[R]mport',19,9);
   writecol('[S]E[R]xport',19,10);
   writecol('[S]V[R]iew',19,11);

   writecol('[R]Return : [S]Select',1,25);
   writecol('[R]Escape : [S]Exit',67,25);
end;


procedure view_scroll_bar(min1,max1 : byte;
                                x,y : byte;
                          start,fin : integer;
                              frame : byte);

begin
   clrwin(14,1,67,1);
   clrwin(1,1,80,24);
   clrwin(1,y,min1,y);
   clrwin(max1,y,80,y);

   writecol('[R]Pos [S]'+cv(start)+'[R]-[S]'+cv(fin),1,1);
   writecol('[R]Frame [S]'+cv(x-min1+1)+'[R]/[S]'+cv(frame),70,1);

   setbg(min1,y,max1,y,c1);

   writeto(BAR,x,y,c2);
   textbackground(black);
end;


procedure view_sequence(var list : listType;
                             max : integer;
                          fileno : byte;
                            path : string;
                           Fname : FnameType;
                             gfx : GfxType);
const
   level = 100;

var
   start,
   fin,
   i     : integer;
   ch    : char;
   x,y   : byte;
   frame : byte;
   min1,
   max1  : byte;
   col   : byte;
   hide  : boolean;

begin
   clear;
   load_sequence(list,max,fileno,path,Fname);

   frame := round((max-MaxStr) div level)+1;
   min1 := (80-frame+1) div 2;
   max1 := min1+frame-1;

   x := min1; y := 25;
   start := 1;
   fin := level;

   hide := false;

   repeat
      if not hide then
         view_scroll_bar(min1,max1,x,y,start,fin,frame)
      else
         clear;

      for i := start to fin do
         if i <= max-MaxStr then
         begin
            if (i = 1) or (i = max-MaxStr) then
               col := c2
            else
               col := c1;

            writeto(BAR,list[1,i],list[2,i],col);
         end;

      check_keys(LT+RT+ESC+F1,ch);

      case ch of
         LT :
         if x > min1 then
         begin
            dec(start,level);
            dec(fin,level);
            dec(x);
         end;
         RT :
         if x < max1 then
         begin
            inc(start,level);
            inc(fin,level);
            inc(x);
         end;
         F1 : hide := not hide;
      end;
      limits(x,min1,max1,false);
   until ch = ESC;
   clear;
   disk_menu_text(gfx);
end;


procedure load_filenames(var Fname : FnameType;
                              path : string;
                   var no_of_files : byte);

var
   T : text;
   F : FileType;

begin
   assign(T,path+Dname[1]+SysNames[1]);
   {$I-} reset(T); {$I+}

   test_error(true,errmsg[6]);
   no_of_files := 0;

   while not eof(T) do
   begin
      inc(no_of_files);
      readln(T,Fname[no_of_files].name);

      assign(F,path+Dname[4]+Fname[no_of_files].name+'.seq');
      {$I-} reset(F); {$I+}

      test_error(true,errmsg[6]);

      Fname[no_of_files].size := filesize(F);
      close(F);
   end;

   close(T);
end;


procedure save_filenames(Fname : FnameType;
                          path : string;
                   no_of_files : byte);

var
   A    : text;
   loop : byte;

begin
   assign(A,path+Dname[1]+SysNames[1]);
   {$I-} rewrite(A); {$I+}

   test_error(true,errmsg[7]);

   for loop := 1 to no_of_files do
      writeln(A,Fname[loop].name);

   close(A);
end;


procedure display_filenames(Fname : FnameType;
                      no_of_files : byte;
                              row : byte;
                           fileno : byte);
var
   loop   : byte;
   col    : byte;
   jump   : byte;
   tmpstr : string;{[4]}

begin
   for loop := 1 to no_of_files do
   with Fname[loop] do
   begin
      if row = loop+8 then {highlighter}
         col := c1
      (*else
      if fileno = loop then {colours opened file}
         col := c3*)
      else
         col := c2;

      if loop >= 4 then
         jump := 1
      else
         jump := 0;

      tmpstr := NULL;
      if fileno = loop then
         tmpstr := '(Open)';

      writeto(name,33,loop+jump+8,col);
      writeto(cv(size-MaxStr),44,loop+jump+8,col);

      textcolor(c3);
      write(SPC+tmpstr);
   end;
end;


procedure sort_filenames(var Fname : FnameType;
                       no_of_files : byte);

var
   ctr1,
   ctr2 : byte;
   Tmp  : FnameType;

begin
   for ctr1 := 4 to no_of_files do
      for ctr2 := ctr1 to no_of_files do
         if uppercase(Fname[ctr1].name) > uppercase(Fname[ctr2].name) then
         begin
            Tmp[ctr2] := Fname[ctr2];
            Fname[ctr2] := Fname[ctr1];
            Fname[ctr1] := Tmp[ctr2];
         end;
end;


procedure test_sequence(var fileno : byte;
                               row : byte;
                              path : string;
                             Fname : FnameType;
                          var done : boolean);
var
   hold : char;

begin
   if not file_exists(path+Dname[4]+Fname[row-8].name+'.seq') then
   begin
      clrwin(1,22,80,23);
      writexy('Can''t load file',23,c2);
      pause(hold);
   end else
   begin
      fileno := row-8;
      done := true;
      winexp := false;
   end;
end;


procedure disk_menu(var fileno : byte;
                 var filesaved : boolean;
                          path : string;
                     var Fname : FnameType;
               var no_of_files : byte;
                       var row : byte;
                           gfx : GfxType;
                      var list : listType;
                           max : word);

var
   done : boolean;
   key  : char;

begin
   clear;
   done := false;
   disk_menu_text(gfx);
   repeat
      sort_filenames(Fname,no_of_files);
      display_filenames(Fname,no_of_files,row,fileno);

      check_keys(UP+DN+CR+ESC+'SDRIEV',key);

      case key of
         UP : dec(row);
         DN : inc(row);
         CR : test_sequence(fileno,row,path,Fname,done);
        ESC : done := true;
        'S' : save_sequence(Fname,filesaved,path,no_of_files);
        'D' : delete_sequence(Fname,no_of_files,path,row,fileno);
        'R' : rename_sequence(Fname,path,row,no_of_files);
        'I' : import_sequence(Fname,no_of_files,path);
        'E' : export_sequence(Fname,path,row);
        'V' : view_sequence(list,max,row-8,path,Fname,gfx);
      end;

      if key in ['S','D','R','I','E','V'] then
         save_filenames(Fname,path,no_of_files);

      limits(row,9,no_of_files+8,false);
      clrwin(1,22,80,23);
   until done;
   clear;
end;


procedure load_text(path : string;
          var no_of_text : byte;
             var textstr : TextstrType);

var
   F : text;

begin
   assign(F,path+Dname[1]+SysNames[2]);
   {$I-} reset(F); {$I+}

   test_error(true,errmsg[8]);
   no_of_text := 0;

   while not eof(F) do
   begin
      inc(no_of_text);
      readln(F,textstr[no_of_text]);
   end;

   close(F);
end;


procedure save_text(path : string;
              no_of_text : byte;
                 textstr : TextstrType);

var
   F : text;
   i : byte;

begin
   assign(F,path+Dname[1]+SysNames[2]);
   {$I-} rewrite(F); {$I+}

   test_error(true,errmsg[9]);

   for i := 1 to no_of_text do
      writeln(F,textstr[i]);

   close(F);
end;


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


procedure display_line(x,y,line : byte);  { 179³ 196Ä 191¿ 192À  217Ù 218Ú }

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


var
   i : byte;

begin
   textcolor(c1);
   for i := x1 to x2 do       { horizontal lines }
   begin
      display_line(i,y1,196);
      display_line(i,y2,196);
   end;

   for i := y1 to y2 do       { vertical lines }
   begin
      display_line(x1,i,179);
      display_line(x2,i,179);
   end;

   display_line(x1,y1,218);   { each corner }
   display_line(x2,y1,191);
   display_line(x1,y2,192);
   display_line(x2,y2,217);
end;


procedure type_text(var no_of_text : byte;
                       var textstr : TextstrType);

var
   x,y    : byte;
   count  : byte;
   tmpstr : string[MaxStr];
   key    : char;
   hold   : char;

begin
   if MaxTextStr = no_of_text then
   begin
      writexy('There''s a limit of 10 text strings',24,c1);
      pause(hold);
      clrwin(1,24,80,24);
      exit;
   end;

   x := 15;
   y := 17;
   count := 0;
   tmpstr := NULL;

   clrwin(15,17,65,21);

   writexy('Please type scroll text',24,c2);
   writecol('[R]Return : [S]Finish',1,25);
   writecol('[R]Escape : [S]Clear',66,25);

   repeat
      textcolor(c1);
      pause(key);

      case key of
         BS :
         if count >= 1 then
         begin
            if x <= 15 then
            begin
               x := 66;
               dec(y);
               gotoxy(66,y);
            end;
            write(BS,SPC,BS);
            delete(tmpstr,count,1);
            dec(x);
            dec(count);
         end;
         ESC :
         begin
            x := 15;
            y := 17;
            count := 0;
            tmpstr := NULL;
            clrwin(15,17,65,21);
         end;
      end;

      if (count <= MaxStr-1)
        and (not (key in [CR,BS,ESC])) then
      begin
         tmpstr := tmpstr + key;
         writeto(key,x,y,c2);
         inc(x);
         inc(count);
         if x = 66 then
         begin
            x := 15;
            inc(y);
         end;
      end;
   until key = CR;

   if tmpstr <> NULL then
   begin
      clrwin(15,17,65,21);
      inc(no_of_text);
      textstr[no_of_text] := tmpstr;
   end;

   clrwin(1,24,80,24);

   writecol('[R]Return : [S]Select',1,25);
   writecol('[R]Escape : [S]Exit',67,25);
end;


procedure display_text(textno : byte;
                          row : byte;
                      textstr : TextstrType);

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

begin
   textno := row-3;
   clrwin(15,17,65,21);
   len := length(textstr[textno]);
   x := 15;
   y := 17;
   textcolor(c2);
   for i := 1 to len do
   begin
      gotoxy(x,y);
      write(textstr[textno][i]);
      if x = 65 then
      begin
         x := 15;
         inc(y);
      end else
         inc(x);
   end;
end;


procedure choose_text(no_of_text : byte;
                             row : byte;
                         textstr : TextstrType);

var
   m,i  : byte;
   len  : byte;
   jump : byte;

begin
   jump := 0;
   for m := 1 to no_of_text do
   begin
      if row = m+3 then
         textcolor(c1)
      else
         textcolor(c2);

      len := length(textstr[m]);

      if len >= MaxTruncStr then
         len := MaxTruncStr;

      if m >= 4 then
         jump := 1;

      gotoxy(27,m+jump+3);
      for i := 1 to len do
         write(textstr[m][i]);

      if len >= MaxTruncStr then
         write('...');
   end;
end;


procedure remove_text(var no_of_text : byte;
                                 row : byte;
                          var textno : byte;
                         var textstr : TextstrType);
var
   i    : byte;
   hold : char;

begin
   if row <= 6 then
   begin
      writecol('[R]You''re not allowed to [S]remove[R] sample text.',0,24);
      pause(hold);
      clrwin(1,24,80,24);
      exit;
   end;

   if no_of_text > 2 then
   begin
      if textno = row-3 then
         dec(textno);

      for i := row-3 to no_of_text do
         textstr[i] := textstr[i+1];

      textstr[no_of_text] := NULL;

      clrwin(26,8,MaxTruncStr+29,no_of_text+4);
      dec(no_of_text);
   end;
end;


procedure edit_menu_text;

begin
   clear;
   display_border(14,16,66,22);

   writexy('Edit Text',1,c1);
   writexy('÷÷÷÷÷÷÷÷÷',2,c2);

   writecol('[R]Return : [S]Select',1,25);
   writecol('[R]Escape : [S]Exit',67,25);

   writecol('[S]A[R]dd',11,7);
   writecol('[S]R[R]emove',11,9);
   writecol('[S]E[R]dit',11,11);

   writeto('----------------------------',27,7,c1);
end;


procedure edit_menu(var textno : byte;
                var no_of_text : byte;
                       var row : byte;
                   var textstr : TextstrType);

var
   key  : char;
   done : boolean;

begin
   done := false;
   edit_menu_text;
   repeat
      choose_text(no_of_text,row,textstr);
      display_text(textno,row,textstr);

      check_keys(UP+DN+CR+ESC+'AR',key);

      case key of
         UP : dec(row);
         DN : inc(row);
         CR :
         begin
            done := true;
            textno := row-3;
         end;
         ESC : done := true;
         'A' : type_text(no_of_text,textstr);
         'R' : remove_text(no_of_text,row,textno,textstr);
      end;
      limits(row,4,4+no_of_text-1,false);
   until done;
   clear;
end;


procedure load_format(path : string;
               var options : OptionsType;
                    format : FormatType;
                         d : byte);

var
   tmp1,
   tmp2 : string[5];
   B : optionsFile;

begin
   if winexp2 then
      assign(B,paramstr(1))
   else
      assign(B,path+Dname[3]+Format[d]+'.for');
   {$I-} reset(B); {$I+}

   test_error(true,errmsg[10]);

   read(B,options[d]);
   close(B);
end;


procedure save_format(path : string;
                   options : OptionsType;
                    format : FormatType;
                         d : byte);

var
   B : optionsFile;

begin
   assign(B,path+Dname[3]+Format[d]+'.for');
   {$I-} rewrite(B); {$I+}

   if test_error(false,errmsg[11]) then
      exit;

   write(B,options[d]);
   close(B);
end;


procedure init_format(var options : OptionsType;
                var fileno,textno : byte);

begin
   { to change the default settings. use the format default.for }

   with options[{1}0],effects,speed,colours,cpu do
   begin
      computer := false; zigzag := false;
      x_turn := 8; y_turn := 4;

      foreNo := 2; backNo := 1;
      rndNo  := false; modeNo := 1;
      typeNo := 1; autopause := false;

      starsno := 7; clearafter := 5;
      pausedelay := 5; pauselength := 2;
      resarfno := 1; speedno := 5;

      col1 := 9;
      col2 := 15;
      rndcol := true;

      c1 := col1;
      c2 := col2;

      fileno := 1;
      textno := 1;
      {formatno := 1;}
   end;
end;


procedure format_menu_text;

begin
   clear;
   writexy('Format Menu',2,c1);
   writexy('÷÷÷÷÷÷÷÷÷÷÷',3,c2);

   writexy('Name',7,c1);
   writexy('~~~~',8,c2);

   writecol('[S]N[R]ew Format',62,8);
{   writecol('[S]S[R]ave Format',62,8);
   writecol('[S]L[R]oad Format',62,9);}
   writecol('Rename',62,9);
   writecol('[S]D[R]elete',62,10);

   writecol('[S]E[R]dit',62,11);
{   writecol('[S]C[R]lear Format',62,14);}
   writecol('Import',62,13);
   writecol('Export',62,14);

   writecol('[R]Return : [S]Select',1,25);
   writecol('[R]Escape : [S]Exit',67,25);
end;


procedure edit_format_options(var options : OptionsType;
                                 formatno : byte);

begin
   with options[formatno],effects,colours,speed,cpu do
   begin
      writeto(OnOff[ord(computer)],16,3,c2);
      writeto(OnOff[ord(zigzag)],16,4,c2);
      writeto(cv(x_turn),16,5,c2);
      writeto(cv(y_turn),16,6,c2);

      writeto(foreground_text[foreNo],16,8,c2);
      writeto(background_text[backNo],16,9,c2);
      writeto(OnOff[ord(rndNo)],16,10,c2);
      writeto(OnOff[ord(autopause)],16,11,c2);
      writeto(cv(mode_text[modeNo]),16,12,c2);
      writeto(resarf_text[typeNo],16,13,c2);

      writeto(speed_text[resarfNo]+SPC+cv(speedno),16,15,c2);
      writeto(cv(starsNo),16,16,c2);
      writeto(cv(clearafter)+' secs',16,17,c2);
      writeto(cv(pausedelay),16,18,c2);
      writeto(cv(pauselength)+' secs',16,19,c2);

      writeto(colourNames[col1],16,21,col1);
      writeto(colourNames[col2],16,22,col2);
      writeto(OnOff[ord(rndcol)],16,23,c2);
   end;
end;


procedure load_format_names(var format : FormatType;
                                  path : string;
                     var no_of_formats : byte);

var
   F : text;
   s : byte;

begin
   assign(F,path+Dname[1]+SysNames[3]);
   {$I-} reset(F); {$I+}

   test_error(true,errmsg[12]);

   for s := 1 to MaxFormat do
      format[s] := NULL;

   no_of_formats := 0;
   while not eof(F) do
   begin
      inc(no_of_formats);
      readln(F,format[no_of_formats]);
   end;

   close(F);
end;


procedure save_format_names(var format : FormatType;
                                  path : string;
                         no_of_formats : byte);

var
   F : text;
   s : byte;

begin
   assign(F,path+Dname[1]+SysNames[3]);
   {$I-} rewrite(F); {$I+}

   test_error(true,errmsg[13]);

   for s := 1 to no_of_formats do
      writeln(F,format[s]);

   close(F);
end;


procedure display_format_names(Trow : byte;
                             format : formatType;
                      no_of_formats : byte;
                                bak : byte);

var
   s      : byte;
   jump   : byte;
   col    : byte;
   tmpstr : string{[6]};

begin
   writexy('--------',12,c1);

   for s := 1 to no_of_formats do
   begin
      if Trow = 8+s then
         col := c1
      else
      (*if bak = s then {colours opened file}
         col := c3;
      end
      else*)
         col := c2;

      if s >= 4 then
         jump := 1
      else
         jump := 0;

      tmpstr := NULL;

      if bak = s then
         tmpstr := '(Open)';

      writeto(format[s],36,8+s+jump,col);

      textcolor(c3);
      write(SPC+tmpstr);
   end;
end;


procedure edit_format_text;

var
   s,i    : byte;
   tmp    : byte;
   column : byte;

begin
   column := 3;
   for i := 1 to MaxMenu do
   begin
      case i of
         1 : tmp := 4;
         2 : tmp := 6;
         3 : tmp := 5;
         4 : tmp := {2}3;
      end;

      for s := 1 to tmp do
      with MenuOption[i,s] do
      begin
         writeto(name,1,column,c1);
         writeto(':',14,column,c1);

         inc(column);
      end;
      inc(column);
   end;
end;


procedure find_record(key : char;
          var row,rec,pos : byte);

const
   num : array[1..4] of byte = (3,8,15,21);

begin
   if row in [7,14,20] then
      if key = DN then
         inc(row)
      else
      if key = UP then
         dec(row);

   case row of
      3..6   : rec := 1;
      8..13  : rec := 2;
      15..19 : rec := 3;
      21..{22}23 : rec := 4;
   end;

   pos := row-num[rec]+1;
end;


procedure edit_format(var options : OptionsType;
                          var row : byte;
                         formatno : byte);

var
   key,hold : char;
   done     : boolean;
   rec,pos  : byte;

begin
   if formatno <= 3 then
   begin
      writecol('[R]You''re not allowed to [S]edit[R] sample files.',0,24);
      pause(hold);
      clrwin(20,24,70,24);
      exit;
   end;

   done := false;
   clrwin(16,3,30,23);
   writecol('[R]Press [S]Escape [R]to finish editing',0,24);

   with options[formatno],effects,speed,colours,cpu do
   repeat
      find_record(key,row,rec,pos);
      writeto(MenuOption[rec,pos].name,1,row,c2);

      if key in [LT,RT] then
         writeto(fillstr(14,SPC),16,row,black);

      edit_format_options(options,formatno);

      check_keys(UP+DN+LT+RT+ESC,key);
      writeto(MenuOption[rec,pos].name,1,row,c1);

      if row = 15 then
         change_speed_settings(options,key,formatno);

      case key of
         UP : dec(row);
         DN : inc(row);
         LT :
           case row of
              3  : computer := true;
              4  : zigzag := true;
              10 : rndNo := true;
              11 : autopause := true;
              23 : rndcol := true;
           end;
         RT :
           case row of
              3  : computer := false;
              4  : zigzag := false;
              10 : rndNo := false;
              11 : autopause := false;
              23 : rndcol := false;
           end;
         ESC : done := true;
      end;

      limits(row,3,23,false);

      case row of
         5  : opt(x_turn,key,1,1,Max_X_Turn);
         6  : opt(y_turn,key,1,1,Max_Y_Turn);

         8  : opt(foreNo,key,1,1,5);
         9  : opt(backNo,key,1,1,5);
         12 : opt(modeNo,key,1,1,2);
         13 : opt(typeNo,key,1,1,3);

         16 : opt(starsNo,key,1,1,10);
         17 : opt(clearafter,key,1,1,30);
         18 : opt(pausedelay,key,1,1,50);
         19 : opt(pauselength,key,1,1,10);

         21 : opt(col1,key,1,1,15);
         22 : opt(col2,key,1,1,15);
      end;
   until done;
   clrwin(25,24,70,24);
end;


procedure enter_format_name(var no_of_formats : byte;
                                   var format : FormatType;
                                         path : string;
                                  var options : OptionsType;
                                          bak : byte);
var
   tmp : string;
   for1,for2 : string;
   a   : byte;
   hold  : char;

begin
   if no_of_formats = MaxFormat then
   begin
      clrwin(20,24,70,24);
      writexy('There''s a limit of 10 format files',24,c2);
      pause(hold);
      clrwin(20,24,70,24);
      exit;
   end;

   writexy('Please type name',23,c1);
   readxy(tmp,24,NameLen);

   for2 := tmp; { for1 and for2 can be removed}
   for a := 1 to no_of_formats do
   begin
      for1 := format[a];
      if uppercase(for1) = uppercase(for2) then
      begin
         clrwin(30,23,70,24);
         writexy('Filename already exists',24,c2);
         pause(hold);
         clrwin(25,24,75,24);
         exit;
      end;
   end;

   if tmp <> NULL then
   begin
      inc(no_of_formats);
      format[no_of_formats] := tmp;

      save_format_names(format,path,no_of_formats);
      options[no_of_formats] := options[{1}0];

      save_format(path,options,format,no_of_formats);
   end;
   clrwin(30,23,70,24);
end;


procedure delete_format(var format : FormatType;
                              path : string;
                 var no_of_formats : byte;
                       var options : optionsType;
                      var formatno : byte;
                      var Trow,bak : byte);

var
   s    : byte;
   F    : text;
   hold : char;

begin
   if formatno <= 3 then
   begin
      writecol('[R]You''re not allowed to [S]delete[R] sample files.',0,24);
      pause(hold);
      clrwin(20,24,70,24);
      exit;
   end;

   writecol('[R]Ok to delete [S]'+format[formatno]+'[R] Y/N?',0,24);
   if choice then
   begin
      assign(F,path+Dname[3]+format[formatno]+'.for');
      {$I-} erase(F); {$I+}

      if test_error(false,errmsg[14]) then
         exit;

      for s := formatno to no_of_formats do
      begin
         options[s] := options[s+1];
         format[s] := format[s+1];
      end;

      if bak = Trow-8 then {if current format is deleted, then it uses previous format}
         options[0] := options[formatno-1];

      {if the deleted format is before the current format. then it will move
      the current folder up 1. this is the same as the open text.}

      if bak >= Trow-8 then
      begin
         dec(formatno);
         dec(bak);
      end;

      clrwin(36,9,36+NameLen+7,19);
      dec(no_of_formats);

      save_format_names(format,path,no_of_formats);
   end;
   clrwin(25,23,70,24);
end;


procedure format_menu(path : string;
                var format : FormatType;
               var options : OptionsType;
         var no_of_formats : byte;
                  var Trow : byte;
              var formatno : byte);

var
   row  : byte;
   key  : char;
   done : boolean;
   bak  : byte;

begin
   format_menu_text;
   edit_format_text;

   done := false;
   row := 23;
   bak := formatno;

   repeat
      formatno := Trow-8;
      clrwin(16,3,30,23);

      edit_format_options(options,formatno);
      display_format_names(Trow,format,no_of_formats,bak);

      check_keys(UP+DN+CR+ESC+'NDE',key);

      case key of
         UP : dec(Trow);
         DN : inc(Trow);
         CR :
         begin
            done := true;
            options[0] := options[formatno];
            winexp2 := false;
            with options[Trow-8].colours do
            begin
               c1 := col1;
               c2 := col2;
            end;
         end;
         ESC :
         begin
            done := true;
            formatno := bak; {saves back open file}
         end;
         'N' : enter_format_name(no_of_formats,format,path,options,bak);
         'D' : delete_format(format,path,no_of_formats,options,formatno,Trow,bak);
         'E' :
         begin
            edit_format(options,row,formatno);
            save_format(path,options,format,formatno);
         end;
      end;
      limits(Trow,9,9+no_of_formats-1,false);
   until done;
   clear;
end;


procedure main_menu_text;

begin
   writexy('The',8,c1);
   writexy('Multi-Scrolling Text Demo',9,c2);

   writecol('[R]1[S]...[R]Effects',34,12);
   writecol('[R]2[S]...[R]Speed',34,13);
   writecol('[R]3[S]...[R]Colours',34,14);
   writecol('[R]4[S]...[R]Computer',34,15);
   writecol('[R]5[S]...[R]Record',34,16);
   writecol('[R]6[S]...[R]Edit Text',34,17);
   writecol('[R]7[S]...[R]Load/Save',34,18);
   writecol('[R]8[S]...[R]Format',34,19);

   writexy('SPACE to Start',22,c2);
   writexy('Or ESCAPE to Exit',23,c1);
end;


procedure clear_file(filesaved : boolean;
                      var done : boolean;
                          path : string);

var
   T     : FileType;
   tmpio : integer;

begin
   if not filesaved then
   begin
      clear;
      writexy('There''s a sequence still to be saved.',12,c1);
      writexy('OK to exit? Y/N',14,c2);

      if choice then
      begin
         assign(T,path+'Tmp.seq');
         {$I-} erase(T); {$I+}
         if IOresult <> 0 then
            tmpio := 0;
         done := true;
      end else
         clear;
   end else
   begin
      clear;
      writexy('Are you sure you want to exit?',12,c1);
      writexy('Yes/No',14,c2);

      if choice then
         done := true
      else
         clear;
   end;
end;


procedure overwrite_file(var filesaved : boolean);

begin
   if not filesaved then
   begin
      clear;
      writexy('There''s a sequence still in memory.',12,c1);
      writexy('OK to overwrite? Y/N',14,c2);

      if choice then
         filesaved := true
      else
         clear;
   end;
end;


procedure main_menu(fileno : byte;
                      path : string;
                   options : OptionsType;
                    textno : byte;
            var no_of_text : byte;
               var textstr : TextstrType;
                   var gfx : GfxType;
             no_of_formats : byte;
               no_of_files : byte;
                     Fname : FnameType;
                    format : FormatType);

var
   key         : char;
   list        : ListType;
   max         : integer;
   filesaved   : boolean;
   row,saverow : byte;
   done        : boolean;
   Trow        : byte;
   formatno    : byte;

begin
   clear;
   row := 9;
   saverow := 4;
   filesaved := true;
   done := false;
   Trow := 9; {saves row in format_menu}
   formatno := 1; {saves opened format file}

   repeat
      main_menu_text;
      display_gfx(4,gfx);

      check_keys('12345678'+SP+ESC+CTRL_CR,key);

      case key of
         '1' : effects_menu(options);
         '2' : speed_menu(options);
         '3' : colours_menu(options);
         '4' : computer_menu(options);
         '5' :
         begin
            overwrite_file(filesaved);
            if filesaved then
            begin
               edit_sequence(list,max,filesaved,options);
               write_list_to_temp_file(list,max,path);
            end;
         end;
         '6' : edit_menu(textno,no_of_text,saverow,textstr);
         '7' : disk_menu(fileno,filesaved,path,Fname,no_of_files,row,gfx,list,max);
         '8' : format_menu(path,format,options,no_of_formats,Trow,formatno);
         SP  : setup_demo(list,Fname,max,fileno,path,options,textno,textstr);
         ESC : clear_file(filesaved,done,path);
         CTRL_CR : init_format(options,fileno,textno);
      end;
   until done;
end;


procedure find_path(var path : string);

var
   T    : file of DataRecord;
   data : DataRecord;

begin
{   select_path(path);}

   if paramstr(1) <> '' then
   begin
      assign(T,'c:\windows\Batcomp.ini');
      {$I-} reset(T); {$I+}

      if IOresult = 0 then { file exists }
      begin
         read(T,data);
         path := data.path+'\resarf\';
         close(T);
      end else
      begin
         clrscr;
         halt;
      end;
   end
   else
   begin
      GetDir(0,path); { 0 = Current drive }

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


procedure init_assoc(path : string;
              var options : OptionsType;
               var format : FormatType);

begin
   options[0] := options[1];

   if paramstr(1) <> NULL then
   begin
      if pos('.SEQ',uppercase(paramstr(1))) <> 0 then
         winexp := true;

      if pos('.FOR',uppercase(paramstr(1))) <> 0 then
      begin
         winexp2 := true;
         load_format(path,options,format,0);

         with options[0].colours do
         begin
            c1 := col1;
            c2 := col2;
         end;
      end;
   end;
end;


procedure load_settings(var gfx : GfxType;
                       var path : string;
                 var no_of_text : byte;
                    var textstr : TextstrType;
                      var Fname : FnameType;
                var no_of_files : byte;
                     var format : FormatType;
              var no_of_formats : byte;
                    var options : OptionsType);
var
   i : byte;

begin
   find_path(path);
   check_files(path);

   load_gfx(gfx,path);
   load_text(path,no_of_text,textstr);

   load_filenames(Fname,path,no_of_files);
   load_format_names(format,path,no_of_formats);

   for i := 1 to no_of_formats do
      load_format(path,options,format,i);

   init_assoc(path,options,format);
end;


   {  Start of Main Program  }


var
   fileno        : byte;
   path          : string;
   options       : OptionsType;
   textno        : byte;
   no_of_text    : byte;
   textstr       : TextstrType;
   gfx           : GfxType;
   no_of_formats : byte;
   no_of_files   : byte;
   Fname         : FnameType;
   format        : FormatType;

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

   textmode(80);
   randomize;

   initialise(textstr,textno,fileno);

   load_settings
   (gfx,path,no_of_text,textstr,Fname,no_of_files,format,no_of_formats,
   options);

   main_menu
   (fileno,path,options,textno,no_of_text,textstr,gfx,
   no_of_formats,no_of_files,Fname,format);

   save_text(path,no_of_text,textstr);

   textcolor(lightgray);
   clrscr;
end.


   {  End of Main Program  }