{  Global Decelerations required  }

VAR  Arrows,arrows_m,
     letters,exit_list  : soc;
     test               : lstr;

Function Flash (y,y1,x,x1 :integer; strng :lstr; acept :soc) : char;

     Const hi = 75;                {  Flashes information <strng> at location <y,x>   }
           lo = 150;               {  then gets a character at location<x1,y1>        }
                                   {  only characters within <acept> are allowed      }
     Var   count : integer;
           ch    : char;
           tflag : boolean;

     begin
     count :=0;
     repeat
         gotoxy(x1,y1);
         if count = hi then
             begin
             highvideo;
             gotoxy(x,y);  write (strng);
             gotoxy(x1,y1);
             end;
         if count = lo then
             begin
             count :=0;
             lowvideo;
             gotoxy(x,y);  write (strng);
             gotoxy(x1,y1);
             highvideo;
             end;
         ch := chr(bdos(6,255));
         count := count + 1;
         until ch in acept;
     lowvideo;
     gotoxy(x,y); write (strng);
     flash := ch;
     highvideo;
     gotoxy (x1,y1);
     end;
{.pa}
Function Get_string2 (y,x,
                      leng,
                      adjust   : integer;
                      default  : lstr;
                      allowed  : soc;
                      exit     : soc;
                 Var  ch       : char        ) :lstr;

    VAR  a     : char;           {   This will return a string up to the length  }
         count : integer;        {   requested by <leng> at location <y,x>       }
         b     : string [255];   {   Flash is used to get a character and the    }
                                 {   char is flashed at <y,x-adjust)             }
    begin                        {   The characters are echoed to the screen     }
        gotoxy (y,x);            {   All of the arrows are available             }
        b := '';                 {   for cursor movement when used in screen     }
        count := 0;              {   input.                                      }
        repeat
                a := flash (y,y,x-adjust,x+count,'<',[chr(1)..chr(255)]);
            if ((a in allowed ) and (count < leng)) then
                begin
                b := b+a;
                write (a);
                count := count + 1;
                if count = 1 then
                    write (' ':leng-1);
                end;
            if  a in [chr(8),chr(19)] then
                if count > 0 then
                    begin
                    count := count - 1;
                    delete (b,count+1,1);
                    write (chr(8),' ',chr(8));
                    end;
            ch := a;
            until (a in exit-[^h,^s]) or
                     ((a in exit * [chr(8),chr(19)]) and (count = 0));
        if count > 0 then
            get_string2 := b
          else get_string2 := default;
        highvideo;
        end;
{.pa}
Function Get_boolean  (x,y,adjust : integer;
                       default    : boolean;
                       def_true,
                       def_false,
                       exit       : soc;
                  var  ch         : char ) : boolean;


    begin
    gotoxy (x,y);
    repeat
        ch := flash (y,y,x-adjust,x,'(',[chr(1)..chr(255)]);
        until ch in def_true+def_false+exit;
    if ch in def_true then
        get_boolean := true;
    if ch in def_false then
        get_boolean := false;
    if ch in exit then
        get_boolean := default;
    end;

{.pa}
Function Get_integer (x,y,
                      leng,
                      adjust   : integer;
                      default  : integer;
                      exit     : soc;
                 Var  ch       : char        ) :integer;

    var  count  : integer;
         b      : lstr;
         error  : integer;

    begin
    b := '';
    count := 0;
    repeat
        ch := flash (y,y,x-adjust,x+count,':',[chr(1)..chr(255)]);
        if ((ch in ['0'..'9'] ) and (count < leng)) then
            begin
            b := b+ch;
            write (ch);
            count := count + 1;
            if count = 1 then
                write (' ':leng-1);
            end;
        if  ch in [chr(8),chr(19)] then
            if count > 0 then
                begin
                count := count - 1;
                delete (b,count+1,1);
                write (chr(8),' ',chr(8));
                end;
        until (ch in exit-[^h,^s]) or
             ((ch in exit * [chr(8),chr(19)]) and (count = 0));
    if count > 0 then
        begin
        val(b,count,error);
        if error = 0 then get_integer := count;
        end
      else get_integer := default;
    highvideo;
    end;
{.pa}
Procedure fill_in_data_for_input;

    begin
    gotoxy (17,3); highvideo;
    write (File_name);
    gotoxy (27,5);
    if proportional_print then write ('Yes')
                          else write ('No ');
    gotoxy (27,6);
    if pro_print then write ('Yes')
                 else write ('No ');
    gotoxy (27,7);
    if headings then write ('Yes')
                else write ('No ');
    gotoxy (27,8);
    if Disk_file then
        begin
        write ('Yes');
        gotoxy (33,8);
        write ('<',Disk_file_name,'':15-length(disk_file_name),'>');
        Screen_file := false;
        end
      else
        begin
        write ('No ');
        gotoxy (33,8); clreol;
        end;
    gotoxy (27,9);
    if screen_file then write ('Yes')
                   else write ('No ');
    gotoxy (27,10);
    if Index_in_text then write ('Yes')
                     else write ('No ');
    gotoxy (27,11);
    if Cross_index   then write ('Yes')
                     else write ('No ');
    gotoxy(27,12);
    if included_files then write ('Yes')
                      else write ('No ');
    gotoxy (27,13);
    if number_lines   then write ('Yes')
                      else write ('No ');
    gotoxy (27,14);
    write (Char_per_inch:3);
    gotoxy (27,15);
    if double_strike then write ('Yes')
                     else write ('No ');
    gotoxy (27,16);
    if emphasized then write ('Yes')
                  else write ('No ');
    gotoxy (19,18);
    write (Start:4);
    gotoxy (42,18);
    write (stop:4);

    gotoxy (23,24);
    end;


{.pa}
procedure Input_screen;

    begin
    clrscr;
    lowvideo;
    gotoxy (1,1);
    writeln ('              Pascal Program Lister');
    writeln;
    writeln ('  File to list <               >');
    writeln;
    writeln ('  Near Letter Quality ?  (   )  (10,12 cpi only)');
    writeln ('    Proportional print   (   )');
    writeln ('  include Headings ?     (   )');
    writeln ('  list to disk ?         (   )');
    writeln ('  List to screen ?       (   )');
    writeln ('  Index numbers in text  (   )');
    writeln ('  Print cross index      (   )');
    writeln ('  Included files         (   )');
    writeln ('  Number lines           (   )');
    writeln ('  Char Per Inch<10,12,17>:    ');
    writeln ('  Double_Strike ?        (   )');
    writeln ('  Emphasized ?           (   )');
    writeln;
    writeln ('  Starting Page :          Ending Page :     ');
    writeln;
    writeln;
    write   (' Options:   '); highvideo; write ('E');
    lowvideo; write ('dit      '); highvideo; write ('P');
    lowvideo; writeln ('rint');
    write   ('            '); highvideo; write ('Q');
    lowvideo; write ('uit      '); highvideo; write ('D');
    lowvideo; writeln ('ir');
    writeln;
    write   ('            Command >');
    end;

{.pa}
Function Get_file_name : lstr;

    var  name  : string[15];
         count : integer;
         command_line : string[128] absolute $80;
         x,y   : integer;

    begin
    name := '';
    if length (command_line) <> 0 then
        begin
        repeat
            if not(command_line[1] in ['A'..'Z']) then
                delete (command_line,1,1);
            until (command_line[1] in ['A'..'Z']) or (length(command_line) = 0);
        if length(command_line) <> 0 then
            begin
            count := 1;
            repeat
                name := name + command_line[count];
                count := count + 1;
                until (command_line[count] in [' ',',']) or (count > length(command_line));
            end;
        end;
    get_file_name := name;

{   now create disk file name if file name is > 0 }

    if length(name) > 0 then
        begin
        x := pos('.',name);
        if x <> 0 then
            delete (name,x,15);
        disk_file_name := name + '.LST';
        end;
    end;
{.pa}
Procedure Edit_data;

    var  count : integer;

    begin
    count := 1;
    repeat
        case count of
            1     : file_name := get_string2(3,17,15,1,file_name,letters,arrows_m+exit_list,ch);
            2     : Proportional_print := get_boolean(27,5,1,Proportional_print,
                                               ['Y','y'],['N','n'],arrows_m+exit_list,ch);
            3     : pro_print := get_boolean(27,6,1,pro_print,
                                               ['Y','y'],['N','n'],arrows_m+exit_list,ch);
            4     : Headings  := get_boolean(27,7,1,headings,
                                               ['Y','y'],['N','n'],arrows_m+exit_list,ch);
            5     : Disk_file := get_boolean(27,8,1,disk_file,
                                               ['Y','y'],['N','n'],arrows_m+exit_list,ch);
            6     : disk_file_name := get_string2(8,34,15,1,disk_file_name,letters,arrows_m+exit_list,ch);
            7     : screen_file := get_boolean(27,9,1,screen_file,
                                               ['Y','y'],['N','n'],arrows_m+exit_list,ch);
            8     : index_in_text := get_boolean(27,10,1,Index_in_text,
                                               ['Y','y'],['N','n'],arrows_m+exit_list,ch);
            9     : Cross_index   := get_boolean(27,11,1,Cross_index,
                                               ['Y','y'],['N','n'],arrows_m+exit_list,ch);
            10    : included_files := get_boolean(27,12,1,Included_files,
                                               ['Y','y'],['N','n'],arrows_m+exit_list,ch);
            11    : number_lines  := get_boolean(27,13,1,Number_lines,
                                               ['Y','y'],['N','n'],arrows_m+exit_list,ch);
            12    : char_per_inch := get_integer(27,14,3,1,char_per_inch,arrows_m+exit_list,ch);
            13    : Double_strike := get_boolean(27,15,1,Double_strike,
                                               ['Y','y'],['N','n'],arrows_m+exit_list,ch);
            14    : Emphasized := get_boolean(27,16,1,Emphasized,
                                               ['Y','y'],['N','n'],arrows_m+exit_list,ch);
            15    : Start := get_integer (19,18,4,2,start,arrows_m+exit_list,ch);
            16    : stop  := get_integer (42,18,4,2,stop,arrows_m+exit_list,ch);
            end;
        if not(Char_per_inch in[10,12,17]) then char_per_inch := 17;
        if proportional_print and not(char_per_inch in [10,12]) then
            char_per_inch := 10;
        if proportional_print then
            begin
            if count = 2 then begin
                              headings       := false;
                              cross_index    := false;    number_lines    := false;
                              end;
            double_strike  := false;    Disk_file       := false;     Screen_file    := false;
            Emphasized     := false;    index_in_text   := false;
            end
          else
            pro_print := false;
        fill_in_data_for_input;
        if ch in [^k,^e] then
            begin
            count := count - 1;
            if ((count = 6) and not(disk_file)) or ((count = 3) and not(proportional_print)) then
                count := count - 1;
            end
          else
            count := count + 1;
        if (count = 6) and not(disk_file) or ((count = 3) and not(proportional_print)) then
            count := count + 1;
        if count < 1 then count := 1;
        if ch in [^a] then count := 17;
        until  (count > 16);
    end;
{.pa}
Procedure directory (x,y,lines:integer);

    var  count,
         pointer   : integer;
         storage   : array [1..64] of string[12];
         buffer    : array [1..128] of char;
         fcb       : array [1..36] of char absolute $5c;
         z,zz      : integer;
         ch        : char;

    procedure extract_name(pointer:integer);

        begin
        count := count + 1;
        storage[count] := '';
        for z := 2 to 9 do
            storage[count] := storage[count] + buffer[z+(pointer-1)*32];
        storage[count] := storage[count] + '.';
        for z := 10 to 12 do
            storage[count] := storage[count] + buffer[z+(pointer-1)*32];
        end;

    Procedure sort_directory (count:integer);

        var  x     : integer;
             valid : boolean;


        Procedure exchange (x1,x2:integer);

            var  temp : string[12];

            begin
            temp := storage[x1];
            storage[x1] := storage [x2];
            storage[x2] := temp;
            end;


        begin
        repeat
            valid := true;
            for x := 2 to count do
                if storage[x] < storage[x-1] then
                    begin
                    exchange (x,x-1);
                    valid := false;
                    end;
            until valid;
        end;   { sort  }

{.pa}
    begin
    clrscr;
    write ('Which drive A or B... < >');
    ch := upcase(flash(y,y,23,24,'< >',['A','a','B','b',^[,^m]));

    pointer := 1;
    count := 0;
    if ch = 'A' then fcb[1] := chr(1);
    if ch = 'B' then fcb[1] := chr(2);
    if ch = ^m  then fcb[1] := chr(0);
    if ch <> ^[ then
        begin
        for z:= 2 to 12 do
            fcb[z] := '?';
        for z := 13 to 36 do
        fcb[z] := chr(0);
        clrscr;

        {   now set DMA address  }

        z := bdos($1A,addr(buffer));

        {   get first directory entry  }

        zz := bdos ($11,addr(fcb));

        if zz < 4 then
            extract_name(zz+1);

        {   get the rest of the directory   }

        repeat
            zz := bdos ($12,addr(fcb));
            pointer := pointer + 1;
            if zz < 4 then extract_name(zz + 1);
            until zz >= 4;

        clrscr;
        sort_directory (count);
        gotoxy (1,y);
        for zz := 1 to count do
            begin
            write (storage[zz]);
            if zz mod 3 in [1,2] then write ('   :   ')
                                 else writeln;

            end;

        writeln;
        Y := y+trunc(count/3) + 3;
        gotoxy (1,y);
        write (' Press any key to continue... < >');
        ch := flash(y,Y,31,32,
                      '< >',[chr(1)..chr(255)]);

        end;
    end;

{.pa}
Procedure Get_command;

    begin
    arrows := [^h,^j,^k,^l,^s,^e,^d,^x];
    arrows_m := arrows-[^h,^s];
    exit_list := [^a,^[,^m] ;
    letters  := [' '..'z'];
    File_name := get_file_name;
    input_screen;
    fill_in_data_for_input;
    ch := chr(0);
    if length (file_name) = 0 then
        ch := 'E';
    repeat
        if ch = 'E' then edit_data;
        if ch = 'D' then
            begin
            directory(1,1,10);
            input_screen;
            fill_in_data_for_input;
            end;
        ch := upcase(Flash(24,24,21,23,'>',['E','e','D','d','Q','q','P','p']));
        until ch in ['Q','P'];
    end;
