   with TEXT_IO;
   with DIRECT_IO;
   with STRINGS_PACKAGE; use STRINGS_PACKAGE;
   with INFLECTIONS_PACKAGE; use INFLECTIONS_PACKAGE;
   with DICTIONARY_PACKAGE; use DICTIONARY_PACKAGE;
   procedure SORTER is   
   --  This program sorts a file of lines (strings) on 5 substrings Mx..Nx
   --  Sort by stringwise (different cases), numeric, or POS enumeration
   
      package BOOLEAN_IO is new TEXT_IO.ENUMERATION_IO(BOOLEAN);
      use BOOLEAN_IO;
      package INTEGER_IO is new TEXT_IO.INTEGER_IO(INTEGER);
      use INTEGER_IO;
      package FLOAT_IO is new TEXT_IO.FLOAT_IO(FLOAT);
      use FLOAT_IO;
      use TEXT_IO;
   
      NAME_LENGTH : constant := 80; 
      ST, ENTER_LINE : STRING(1..NAME_LENGTH) := (others => ' ');
      LS, LAST : INTEGER := 0;
      INPUT_NAME : STRING(1..80) := (others => ' ');
   
      LINE_LENGTH : constant := 300;        --  ##################################
                                        --  Max line length on input file
                                        --  Shorter => less disk space to sort
      CURRENT_LENGTH : INTEGER := 0;
      subtype TEXT_TYPE is STRING(1..LINE_LENGTH);
   --type LINE_TYPE is 
   -- record
   --   CURRENT_LENGTH : CURRENT_LINE_LENGTH_TYPE := 0;
   --   TEXT : TEXT_TYPE;
   -- end record;
      package LINE_IO is new DIRECT_IO(TEXT_TYPE);
      use LINE_IO;
      BLANK_TEXT : TEXT_TYPE := (others => ' ');
   
      LINE_TEXT : TEXT_TYPE := BLANK_TEXT;
      OLD_LINE : TEXT_TYPE := BLANK_TEXT;
      P_LINE : TEXT_TYPE := BLANK_TEXT;
   
      type SORT_TYPE is (A, C, G, U, N, F, P, R, S);
      package SORT_TYPE_IO is new TEXT_IO.ENUMERATION_IO(SORT_TYPE);
      use SORT_TYPE_IO;
   
      type WAY_TYPE is (I, D);
      package WAY_TYPE_IO is new TEXT_IO.ENUMERATION_IO(WAY_TYPE);
      use WAY_TYPE_IO;
   
   
      INPUT  : TEXT_IO.FILE_TYPE;
      OUTPUT : TEXT_IO.FILE_TYPE;
      WORK   : LINE_IO.FILE_TYPE;
   
      M1, M2, M3, M4, M5 : NATURAL := 1;
      N1, N2, N3, N4, N5 : NATURAL := LINE_LENGTH;
      Z1, Z2, Z3, Z4, Z5 : NATURAL := 0;           
   
      S1, S2, S3, S4, S5 : SORT_TYPE := A;
      W1, W2, W3, W4, W5 : WAY_TYPE := I;
   
      ENTRY_FINISHED : exception;
   
   
   --  For section numbering of large documents and standards
      type SECTION_TYPE is 
         record
            FIRST_LEVEL   : INTEGER := 0;
            SECOND_LEVEL  : INTEGER := 0;
            THIRD_LEVEL   : INTEGER := 0;
            FOURTH_LEVEL  : INTEGER := 0;
            FIFTH_LEVEL   : INTEGER := 0;
         end record;
   
      NO_SECTION : constant SECTION_TYPE := (0, 0, 0, 0, 0);
   
      type APPENDIX_TYPE is (NONE, A, B, C, D, E, F, G, H, I, J, K, L, M,
                             N, O, P, Q, R, S, T, U, V, W, X, Y, Z);
      package APPENDIX_IO is new TEXT_IO.ENUMERATION_IO(APPENDIX_TYPE);
   
      type APPENDIX_SECTION_TYPE is    record
            APPENDIX : APPENDIX_TYPE := NONE;     
            SECTION  : SECTION_TYPE  := NO_SECTION;
         end record;
   
      NO_APPENDIX_SECTION : constant APPENDIX_SECTION_TYPE := 
         (NONE, (0, 0, 0, 0, 0));
   
   --  procedure PUT(OUTPUT : TEXT_IO.FILE_TYPE; S : SECTION_TYPE);
   --  procedure PUT(S : SECTION_TYPE);  
   --  procedure GET(FROM : in STRING; 
   --                   S : out SECTION_TYPE; LAST : out POSITIVE);  
   --  function "<"(A, B : SECTION_TYPE) return BOOLEAN;  
   -- 
   --  procedure PUT(OUTPUT : TEXT_IO.FILE_TYPE; S : APPENDIX_SECTION_TYPE);
   --  procedure PUT(S : APPENDIX_SECTION_TYPE);  
   --  procedure GET(FROM : in STRING; 
   --                   S : out APPENDIX_SECTION_TYPE; LAST : out POSITIVE);  
   --  function "<"(A, B : APPENDIX_SECTION_TYPE) return BOOLEAN;  
   -- 
   
   
      procedure PUT(OUTPUT : TEXT_IO.FILE_TYPE; S : SECTION_TYPE) is
         LEVEL : INTEGER := 0;
      
         procedure PUT_LEVEL(OUTPUT : TEXT_IO.FILE_TYPE; L : INTEGER) is
         begin
            if L > 9999  then
               PUT(OUTPUT, "****");
            elsif L > 999  then
               PUT(OUTPUT, L, 4);
            elsif L > 99  then
               PUT(OUTPUT, L, 3);
            elsif L > 9  then
               PUT(OUTPUT, L, 2);
            elsif L >= 0  then
               PUT(OUTPUT, L, 1);
            else  
               PUT(OUTPUT, "**");
            end if;
         end PUT_LEVEL;
      
      begin
         if S.FIFTH_LEVEL <= 0  then
            if S.FOURTH_LEVEL <= 0  then
               if S.THIRD_LEVEL <= 0  then
                  if S.SECOND_LEVEL <= 0  then
                     LEVEL := 1;
                  else
                     LEVEL := 2;
                  end if;
               else
                  LEVEL := 3;
               end if;
            else
               LEVEL := 4;
            end if;
         else
            LEVEL := 5;
         end if;
      
         if S.FIRST_LEVEL <= 9  then
            PUT(OUTPUT, ' ');
         end if;
         PUT_LEVEL(OUTPUT, S.FIRST_LEVEL);
         if LEVEL = 1  then
            PUT(OUTPUT, '.');
            PUT(OUTPUT, '0');           --  To match the ATLAS index convention
         end if;
         if LEVEL >= 2  then
            PUT(OUTPUT, '.');
            PUT_LEVEL(OUTPUT, S.SECOND_LEVEL);
         end if;
         if LEVEL >= 3  then
            PUT(OUTPUT, '.');
            PUT_LEVEL(OUTPUT, S.THIRD_LEVEL);
         end if;
         if LEVEL >= 4  then
            PUT(OUTPUT, '.');
            PUT_LEVEL(OUTPUT, S.FOURTH_LEVEL);
         end if;
         if LEVEL >= 5  then
            PUT(OUTPUT, '.');
            PUT_LEVEL(OUTPUT, S.FIFTH_LEVEL);
         end if;
      end PUT;
   
      procedure PUT(S : SECTION_TYPE) is
         LEVEL : INTEGER := 0;
      
         procedure PUT_LEVEL(L : INTEGER) is
         begin
            if L > 9999  then
               PUT("****");
            elsif L > 999  then
               PUT(L, 4);
            elsif L > 99  then
               PUT(L, 3);
            elsif L > 9  then
               PUT(L, 2);
            elsif L >= 0  then
               PUT(L, 1);
            else  
               PUT("**");
            end if;
         end PUT_LEVEL;
      
      begin
         if S.FIFTH_LEVEL = 0  then
            if S.FOURTH_LEVEL = 0  then
               if S.THIRD_LEVEL = 0  then
                  if S.SECOND_LEVEL = 0  then
                     LEVEL := 1;
                  else
                     LEVEL := 2;
                  end if;
               else
                  LEVEL := 3;
               end if;
            else
               LEVEL := 4;
            end if;
         else
            LEVEL := 5;
         end if;
      
         if S.FIRST_LEVEL <= 9  then
            PUT(' ');
         end if;
         PUT_LEVEL(S.FIRST_LEVEL);
         PUT('.');
         if LEVEL = 1  then
            PUT('0');           --  To match the ATLAS index convention
         end if;
         if LEVEL >= 2  then
            PUT_LEVEL(S.SECOND_LEVEL);
         end if;
         if LEVEL >= 3  then
            PUT('.');
            PUT_LEVEL(S.THIRD_LEVEL);
         end if;
         if LEVEL >= 4  then
            PUT('.');
            PUT_LEVEL(S.FOURTH_LEVEL);
         end if;
         if LEVEL >= 5  then
            PUT('.');
            PUT_LEVEL(S.FIFTH_LEVEL);
         end if;
      end PUT;
   
      procedure GET(FROM : in STRING; 
                    S : out SECTION_TYPE; LAST : out INTEGER) is
         L  : INTEGER := 0;
         FT : INTEGER := FROM'FIRST;
         LT : INTEGER := FROM'LAST;
      begin
         S := NO_SECTION;
         if TRIM(FROM)'LAST < FROM'FIRST   then   
            return;   --  Empty string, no data         --  Return default
         end if;
      
         GET(FROM, S.FIRST_LEVEL, L);
         if L+1 >= LT  then
            LAST := L;
            return;
         end if;
         GET(FROM(L+2..LT), S.SECOND_LEVEL, L);
         if L+1 >= LT  then
            LAST := L;
            return;
         end if;
         GET(FROM(L+2..LT), S.THIRD_LEVEL, L);
         if L+1 >= LT  then
            LAST := L;
            return;
         end if;
         GET(FROM(L+2..LT), S.FOURTH_LEVEL, L);
         if L+1 >= LT  then
            LAST := L;
            return;
         end if;
         GET(FROM(L+2..LT), S.FIFTH_LEVEL, L);
         LAST := L;
         return;
         exception
            when TEXT_IO.END_ERROR =>
               LAST := L;
               return;
            when TEXT_IO.DATA_ERROR =>
               LAST := L;
               return;
            when others =>
               PUT(" Unexpected exception in GET(FROM; SECTION_TYPE) with input =>");
               PUT(FROM);
               NEW_LINE;
               LAST := L;
               raise; 
      end GET;
   
      function "<"(A, B : SECTION_TYPE) return BOOLEAN is
      begin
      
         if A.FIRST_LEVEL > B.FIRST_LEVEL  then
            return FALSE;
         elsif A.FIRST_LEVEL < B.FIRST_LEVEL  then
            return TRUE; 
         else
            if A.SECOND_LEVEL > B.SECOND_LEVEL  then
               return FALSE;
            elsif A.SECOND_LEVEL < B.SECOND_LEVEL  then
               return TRUE;
            else
               if A.THIRD_LEVEL > B.THIRD_LEVEL  then
                  return FALSE;
               elsif A.THIRD_LEVEL < B.THIRD_LEVEL  then
                  return TRUE;
               else
                  if A.FOURTH_LEVEL > B.FOURTH_LEVEL  then
                     return FALSE;
                  elsif A.FOURTH_LEVEL < B.FOURTH_LEVEL  then
                     return TRUE;
                  else
                     if A.FIFTH_LEVEL > B.FIFTH_LEVEL  then
                        return FALSE;
                     elsif A.FIFTH_LEVEL < B.FIFTH_LEVEL  then
                        return TRUE;
                     else
                        return FALSE;
                     end if;
                  end if;
               end if;
            end if;
         end if;
      
         return FALSE;
      
      end "<";
   
      procedure PUT(OUTPUT : TEXT_IO.FILE_TYPE; S : APPENDIX_SECTION_TYPE) is
         use APPENDIX_IO;
      begin
         PUT(OUTPUT, S.APPENDIX);
         PUT(OUTPUT, ' ');
         PUT(OUTPUT, S.SECTION);
      end PUT;
   
      procedure PUT(S : APPENDIX_SECTION_TYPE) is
         use APPENDIX_IO;
      begin
         PUT(S.APPENDIX);
         PUT(' ');
         PUT(S.SECTION);
      end PUT;
   
      procedure GET(FROM : in STRING; 
                    S : out APPENDIX_SECTION_TYPE; LAST : out INTEGER) is
         use APPENDIX_IO;
         L  : INTEGER := 0;
         FT : INTEGER := FROM'FIRST;
         LT : INTEGER := FROM'LAST;
      begin
      
         S := NO_APPENDIX_SECTION;
         if (FT = LT)  or else
            (TRIM(FROM)'LENGTH = 0)  then   --  Empty/blank string, no data
            PUT("@");
            return;                      --  Return default
         end if;
      
      --PUT_LINE("In GET =>" & FROM & '|');
      
         begin
            GET(FROM, S.APPENDIX, L);
         --PUT("A");
            if L+1 >= LT  then
               LAST := L;
               return;
            end if;
            exception
               when others  =>
                  S.APPENDIX := NONE;
                  L := FT - 2;
         end;
      
      --    PUT("B");
      --    GET(FROM(L+2..LT), S.SECTION.FIRST_LEVEL, L);
      --    if L+1 >= LT  then
      --      LAST := L;
      --      return;
      --    end if;
      --PUT("C");
      --    GET(FROM(L+2..LT), S.SECTION.SECOND_LEVEL, L);
      --    if L+1 >= LT  then
      --      LAST := L;
      --      return;
      --    end if;
      --PUT("D");
      --    GET(FROM(L+2..LT), S.SECTION.THIRD_LEVEL, L);
      --    if L+1 >= LT  then
      --      LAST := L;
      --      return;
      --    end if;
      --PUT("E");
      --    GET(FROM(L+2..LT), S.SECTION.FOURTH_LEVEL, L);
      --    if L+1 >= LT  then
      --      LAST := L;
      --      return;
      --    end if;
      --PUT("F");
      --    GET(FROM(L+2..LT), S.SECTION.FIFTH_LEVEL, L);
      --    LAST := L;
      --PUT("G");
      
      
         GET(FROM(L+2..LT), S.SECTION, L);
      --PUT("F");
         return;
         exception
            when TEXT_IO.END_ERROR =>
               LAST := L;
               return;
            when TEXT_IO.DATA_ERROR =>
               LAST := L;
               return;
            when others =>
               PUT
                     (" Unexpected exception in GET(FROM; APPENDIX_SECTION_TYPE) with input =>");
               PUT(FROM);
               NEW_LINE;
               LAST := L;
               return;
      end GET;
   
      function "<"(A, B : APPENDIX_SECTION_TYPE) return BOOLEAN is
      begin
      
         if A.APPENDIX > B.APPENDIX  then
            return FALSE;
         elsif A.APPENDIX < B.APPENDIX  then
            return TRUE; 
         else
            if A.SECTION.FIRST_LEVEL > B.SECTION.FIRST_LEVEL  then
               return FALSE;
            elsif A.SECTION.FIRST_LEVEL < B.SECTION.FIRST_LEVEL  then
               return TRUE; 
            else
               if A.SECTION.SECOND_LEVEL > B.SECTION.SECOND_LEVEL  then
                  return FALSE;
               elsif A.SECTION.SECOND_LEVEL < B.SECTION.SECOND_LEVEL  then
                  return TRUE;
               else
                  if A.SECTION.THIRD_LEVEL > B.SECTION.THIRD_LEVEL  then
                     return FALSE;
                  elsif A.SECTION.THIRD_LEVEL < B.SECTION.THIRD_LEVEL  then
                     return TRUE;
                  else
                     if A.SECTION.FOURTH_LEVEL > B.SECTION.FOURTH_LEVEL  then
                        return FALSE;
                     elsif A.SECTION.FOURTH_LEVEL < B.SECTION.FOURTH_LEVEL  then
                        return TRUE;
                     else
                        if A.SECTION.FIFTH_LEVEL > B.SECTION.FIFTH_LEVEL  then
                           return FALSE;
                        elsif A.SECTION.FIFTH_LEVEL < B.SECTION.FIFTH_LEVEL  then
                           return TRUE;
                        else
                           return FALSE;
                        end if;
                     end if;
                  end if;
               end if;
            end if;
         end if;  
      end "<";
   
      procedure PROMPT_FOR_ENTRY(ENTRY_NUMBER : STRING) is
      begin
         PUT("Give starting column and size of ");
         PUT(ENTRY_NUMBER);
         PUT_LINE(" significant sort field ");
         PUT("  with optional sort type and way  => ");
      end PROMPT_FOR_ENTRY;
   
   
      procedure GET_ENTRY (MX, NX  : out NATURAL;
                           SX  : out SORT_TYPE;
                           WX  : out WAY_TYPE ) is
         M : NATURAL := 1;
         N : NATURAL := LINE_LENGTH;
         S : SORT_TYPE := A;
         W : WAY_TYPE := I;
         Z : NATURAL := 0;
      
         procedure ECHO_ENTRY is
         begin
            PUT("                    Sorting on LINE("); PUT(M,3); 
            PUT(".."); PUT(N, 3); PUT(")");
            PUT("  with S = "); PUT(S); PUT(" and W = "); PUT(W); 
            NEW_LINE(2);
         end ECHO_ENTRY;
      
      begin
      
         M := 0;
         N := LINE_LENGTH;
         S := A;
         W := I;
      
      
         GET_LINE(ENTER_LINE, LS);
         if LS = 0  then
            raise ENTRY_FINISHED;
         end if;
         INTEGER_IO.GET(ENTER_LINE(1..LS), M, LAST);
         begin
            INTEGER_IO.GET(ENTER_LINE(LAST+1..LS), Z, LAST);
            if  M = 0 or Z = 0  then
               PUT_LINE("Start or size of zero, you must be kidding, aborting");
               raise PROGRAM_ERROR;
            elsif M + Z > LINE_LENGTH  then
               PUT_LINE("Size too large, going to end of line");
               N := LINE_LENGTH;
            else
               N := M + Z - 1;
            end if;
            SORT_TYPE_IO.GET(ENTER_LINE(LAST+1..LS), S, LAST);
            WAY_TYPE_IO.GET(ENTER_LINE(LAST+1..LS), W, LAST);
            MX := M; NX := N;  SX := S; WX := W;
            ECHO_ENTRY;
            return;
            exception
               when PROGRAM_ERROR  =>
                  PUT_LINE("PROGRAM_ERROR raised in GET_ENTRY");
                  raise;
               when others =>
                  MX := M; NX := N; SX := S; WX := W;
                  ECHO_ENTRY;
                  return;
         end;
      end GET_ENTRY;
   
      function IGNORE_SEPARATORS(S : STRING) return STRING is
         T : STRING(S'FIRST..S'LAST) := LOWER_CASE(S);
      begin
         for I in S'FIRST+1..S'LAST-1  loop
            if (S(I-1) /= '-'  and then S(I-1) /= '_')  and then
               (S(I) = '-'  or else S(I) = '_')  and then
               (S(I+1) /= '-'  and then S(I+1) /= '_')  then
               T(I) := ' ';
            end if;
         end loop;
         return T;
      end IGNORE_SEPARATORS;
   
      function LTU(C, D : CHARACTER) return BOOLEAN is
      begin
         if (D = 'v')  then
            if (C < 'u')  then
               return TRUE;
            else
               return FALSE;
            end if;
         elsif (D = 'j')  then
            if (C < 'i')  then
               return TRUE;
            else
               return FALSE;
            end if;
         elsif (D = 'V')  then
            if (C < 'U')  then
               return TRUE;
            else
               return FALSE;
            end if;
         elsif (D = 'J')  then
            if (C < 'I')  then
               return TRUE;
            else
               return FALSE;
            end if;
         else
            return C < D; 
         end if;
      end LTU; 
   
      function EQU(C, D : CHARACTER) return BOOLEAN is
      begin
         if (D = 'u') or (D = 'v')  then
            if (C = 'u') or (C = 'v')  then
               return TRUE;
            else
               return FALSE;
            end if;
         elsif (D = 'i') or (D = 'j')  then
            if (C = 'i') or (C = 'j')  then
               return TRUE;
            else
               return FALSE;
            end if;
         elsif (D = 'U') or (D = 'V')  then
            if (C = 'U') or (C = 'V')  then
               return TRUE;
            else
               return FALSE;
            end if;
         elsif (D = 'I') or (D = 'J')  then
            if (C = 'I') or (C = 'J')  then
               return TRUE;
            else
               return FALSE;
            end if;
         else
            return C = D; 
         end if;
      end EQU; 
   
      function GTU(C, D : CHARACTER) return BOOLEAN is
      begin
         if D = 'u'  then
            if (C > 'v')  then
               return TRUE;
            else
               return FALSE;
            end if;
         elsif D = 'i'  then
            if (C > 'j')  then
               return TRUE;
            else
               return FALSE;
            end if;
         elsif D = 'U'  then
            if (C > 'V')  then
               return TRUE;
            else
               return FALSE;
            end if;
         elsif D = 'I'  then
            if (C > 'J')  then
               return TRUE;
            else
               return FALSE;
            end if;
         else
            return C > D; 
         end if;
      end GTU; 
   
   
      function LTU(S, T : STRING) return BOOLEAN is
      begin
         for I in 1..S'LENGTH  loop   --  Not TRIMed, so same length
            if EQU(S(S'FIRST+I-1), T(T'FIRST+I-1))  then
               null;
            elsif GTU(S(S'FIRST+I-1), T(T'FIRST+I-1))  then
               return FALSE;
            elsif LTU(S(S'FIRST+I-1), T(T'FIRST+I-1))  then
               return TRUE;
            end if;
         end loop;
         return FALSE;
      end LTU;
   
      function GTU(S, T : STRING) return BOOLEAN is
      begin
         for I in 1..S'LENGTH  loop   
            if EQU(S(S'FIRST+I-1), T(T'FIRST+I-1))  then
               null;
            elsif LTU(S(S'FIRST+I-1), T(T'FIRST+I-1))  then
               return FALSE;
            elsif GTU(S(S'FIRST+I-1), T(T'FIRST+I-1))  then
               return TRUE;
            end if;
         end loop;
         return FALSE;
      end GTU;
   
   
      function EQU(S, T : STRING) return BOOLEAN is
      begin
         if S'LENGTH /= T'LENGTH  then
            return FALSE;
         end if;
      
         for I in 1..S'LENGTH  loop     
            if not EQU(S(S'FIRST+I-1), T(T'FIRST+I-1))  then
               return FALSE;
            end if;
         end loop;
      
         return TRUE;
      end EQU;
   
   
   
   
      function SLT (X, Y : STRING;         --  Make LEFT and RIGHT
                    ST : SORT_TYPE := A; 
                    WT : WAY_TYPE := I) return BOOLEAN is
         AS : STRING(X'RANGE) := X;
         BS : STRING(Y'RANGE) := Y;
         MN, NN : INTEGER := 0;
         FN, GN : FLOAT := 0.0;
      --FS, GS : SECTION_TYPE := NO_SECTION;
         FS, GS : APPENDIX_SECTION_TYPE := NO_APPENDIX_SECTION;
         PX, PY : PART_ENTRY;       --  So I can X here
         RX, RY : PART_OF_SPEECH_TYPE;   --  So I can X here
      begin
         if ST = A  then
            AS := LOWER_CASE(AS);
            BS := LOWER_CASE(BS);
            if WT = I  then 
               return AS < BS;
            else
               return AS > BS;
            end if;
         
         elsif ST = C  then
            if WT = I  then 
               return AS < BS;
            else
               return AS > BS;
            end if;
         
         elsif ST = G  then
            AS := IGNORE_SEPARATORS(AS);
            BS := IGNORE_SEPARATORS(BS);
            if WT = I  then 
               return AS < BS;
            else
               return AS > BS;
            end if;
         
         elsif ST = U  then
            AS := LOWER_CASE(AS);
            BS := LOWER_CASE(BS);
            if WT = I  then 
               return LTU(AS, BS);
            else
               return GTU(AS, BS);
            end if;
         
         elsif ST = N  then
            INTEGER_IO.GET(AS, MN, LAST);
            INTEGER_IO.GET(BS, NN, LAST);
            if WT = I  then 
               return MN < NN;
            else
               return MN > NN;
            end if;
         
         elsif ST = F  then
            FLOAT_IO.GET(AS, FN, LAST);
            FLOAT_IO.GET(BS, GN, LAST);
            if WT = I  then 
               return FN < GN;
            else
               return FN > GN;
            end if;
         
         elsif ST = P  then
            PART_ENTRY_IO.GET(AS, PX, LAST);
            PART_ENTRY_IO.GET(BS, PY, LAST);
            if WT = I  then 
               return PX < PY;
            else
               return (not (PX < PY)) and (not (PX = PY));
            end if;
         
         elsif ST = R  then
            PART_OF_SPEECH_TYPE_IO.GET(AS, RX, LAST);
            PART_OF_SPEECH_TYPE_IO.GET(BS, RY, LAST);
            if WT = I  then 
               return RX < RY;
            else
               return (not (RX < RY)) and (not (RX = RY));
            end if;
         
         elsif ST = S  then
         --PUT_LINE("AS =>" & AS & '|');
            GET(AS, FS, LAST);
         --PUT_LINE("BS =>" & BS & '|');
            GET(BS, GS, LAST);
         --PUT_LINE("GOT AS & BS");
            if WT = I  then 
               return FS < GS;
            else
               return (not (FS < GS)) and (not (FS = GS));
            end if;
         
         else
            return FALSE;
         end if;
      
         exception  
            when others  =>
               TEXT_IO.PUT_LINE("exception in SLT    showing LEFT and RIGHT");
               TEXT_IO.PUT_LINE(X & "&");
               TEXT_IO.PUT_LINE(Y & "|");
               raise;
      
      end SLT;
   
      function SORT_EQUAL (X, Y : STRING; 
                           ST : SORT_TYPE := A; 
                           WT : WAY_TYPE := I) return BOOLEAN is
         AS : STRING(X'RANGE) := X;
         BS : STRING(Y'RANGE) := Y;
         MN, NN : INTEGER := 0;
         FN, GN : FLOAT := 0.0;
         FS, GS : APPENDIX_SECTION_TYPE := NO_APPENDIX_SECTION;
         PX, PY : PART_ENTRY;
         RX, RY : PART_OF_SPEECH_TYPE;
      begin
         if ST = A  then
            AS := LOWER_CASE(AS);
            BS := LOWER_CASE(BS);
            return AS = BS;
         
         elsif ST = C  then
            return AS = BS;
         
         elsif ST = G  then
            AS := IGNORE_SEPARATORS(AS);
            BS := IGNORE_SEPARATORS(BS);
            return AS = BS;
         
         elsif ST = U  then
            AS := LOWER_CASE(AS);
            BS := LOWER_CASE(BS);
            return EQU(AS,  BS);
         
         elsif ST = N  then
            INTEGER_IO.GET(AS, MN, LAST);
            INTEGER_IO.GET(BS, NN, LAST);
            return MN = NN;
         
         elsif ST = F  then
            FLOAT_IO.GET(AS, FN, LAST);
            FLOAT_IO.GET(BS, GN, LAST);
            return FN = GN;
         
         elsif ST = P  then
            PART_ENTRY_IO.GET(AS, PX, LAST);
            PART_ENTRY_IO.GET(BS, PY, LAST);
            return PX = PY;
         
         elsif ST = R  then
            PART_OF_SPEECH_TYPE_IO.GET(AS, RX, LAST);
            PART_OF_SPEECH_TYPE_IO.GET(BS, RY, LAST);
            return RX = RY;
         
         elsif ST = S  then
            GET(AS, FS, LAST);
            GET(BS, GS, LAST);
            return FS = GS;
         
         
         else
            return FALSE;
         end if;
      
         exception
            when others  =>
               TEXT_IO.PUT_LINE("exception in LT    showing LEFT and RIGHT");
               TEXT_IO.PUT_LINE(X & "|");
               TEXT_IO.PUT_LINE(Y & "|");
               raise;
      
      end SORT_EQUAL;
   
   
      function LT  (LEFT, RIGHT : TEXT_TYPE) return BOOLEAN is
      begin
      
            if SLT(LEFT(M1..N1),  RIGHT(M1..N1), S1, W1)  then
              return TRUE;
            
            elsif SORT_EQUAL(LEFT(M1..N1),  RIGHT(M1..N1), S1, W1) then
              if ((N2 > 0) and then 
                SLT(LEFT(M2..N2),  RIGHT(M2..N2), S2, W2) ) then
               return TRUE;
               
              elsif ((N2 > 0) and then 
                   SORT_EQUAL(LEFT(M2..N2),  RIGHT(M2..N2), S2, W2)) then
                if ((N3 > 0) and then 
                   SLT(LEFT(M3..N3),  RIGHT(M3..N3), S3, W3 ))  then
                  return TRUE;
                  
                elsif ((N3 > 0) and then 
                      SORT_EQUAL(LEFT(M3..N3),  RIGHT(M3..N3), S3, W3))  then
                  if ((N4 > 0) and then 
                      SLT(LEFT(M4..N4),  RIGHT(M4..N4), S4, W4) )  then
                     return TRUE;
                     
                  elsif ((N4 > 0) and then 
                        SORT_EQUAL(LEFT(M4..N4),  RIGHT(M4..N4), S4, W4))  then
                    if ((N5 > 0) and then                
                        SLT(LEFT(M5..N5),  RIGHT(M5..N5), S5, W5) )  then
                       return TRUE;
                       
                    end if; 
                  end if;
                end if;
              end if;
            end if;
            return FALSE;
          exception 
            when others =>
               TEXT_IO.PUT_LINE("exception in LT    showing LEFT and RIGHT");
               TEXT_IO.PUT_LINE(LEFT & "|");
               TEXT_IO.PUT_LINE(RIGHT & "|");
               raise;
      end LT; 
   
      procedure OPEN_FILE_FOR_INPUT(INPUT : in out TEXT_IO.FILE_TYPE;
                                    PROMPT : STRING := "File for input => ") is
         LAST : NATURAL := 0;
      begin
      GET_INPUT_FILE:
         loop
            CHECK_INPUT:
            begin
               NEW_LINE;
            
               PUT(PROMPT);
               GET_LINE(INPUT_NAME, LAST);
               OPEN(INPUT, IN_FILE, INPUT_NAME(1..LAST));
               exit;
               exception
                  when others  =>
                     PUT_LINE("   !!!!!!!!!  Try Again  !!!!!!!!");
            end CHECK_INPUT;
         end loop GET_INPUT_FILE;
      
      end OPEN_FILE_FOR_INPUT;
   
   
      procedure CREATE_FILE_FOR_OUTPUT(OUTPUT : in out TEXT_IO.FILE_TYPE;
                                       PROMPT : STRING := "File for output => ") is
         NAME : STRING(1..80) := (others => ' ');
         LAST : NATURAL := 0;
      begin
      
      GET_OUTPUT_FILE:
         loop
            CHECK_OUTPUT:
            begin
               NEW_LINE;
            
               PUT(PROMPT);
               GET_LINE(NAME, LAST);
               if TRIM(NAME(1..LAST))'LENGTH /= 0  then
                  CREATE(OUTPUT, OUT_FILE, NAME(1..LAST));
               else
                  CREATE(OUTPUT, OUT_FILE, TRIM(INPUT_NAME));
               end if;                                    
               exit;
               exception
                  when others  =>
                     PUT_LINE("   !!!!!!!!!  Try Again  !!!!!!!!");
            end CHECK_OUTPUT;
         end loop GET_OUTPUT_FILE;
      
      end CREATE_FILE_FOR_OUTPUT;
   
      function GRAPHIC(S : STRING) return STRING is
         T : STRING(1..S'LENGTH) := S;
      begin
         for I in S'RANGE  loop
            if CHARACTER'POS(S(I)) < 32  then
               T(I) := ' ';
            end if;
         end loop;
         return T;
      end GRAPHIC;
   
   begin
   
      NEW_LINE;
      PUT_LINE("Sorts a text file of lines four times on substrings M..N");
      PUT_LINE("A)lphabetic (all case) C)ase sensitive, iG)nore seperators, U)i_is_vj,");
      PUT_LINE("    iN)teger, F)loating point, S)ection, P)art entry, or paR)t of speech");
      PUT_LINE("         I)ncreasing or D)ecreasing");
      NEW_LINE;
   
      OPEN_FILE_FOR_INPUT(INPUT, "What file to sort from => ");
      NEW_LINE;
   
      PROMPT_FOR_ENTRY("first");
      begin
         GET_ENTRY(M1, N1, S1, W1);
         exception
            when PROGRAM_ERROR  =>
               raise;
            when others => 
               null;
      end;
   
   
      begin
         PROMPT_FOR_ENTRY("second");
         GET_ENTRY(M2, N2, S2, W2);
         PROMPT_FOR_ENTRY("third");
         GET_ENTRY(M3, N3, S3, W3);
         PROMPT_FOR_ENTRY("fourth");
         GET_ENTRY(M4, N4, S4, W4);
         PROMPT_FOR_ENTRY("fifth");
         GET_ENTRY(M5, N5, S5, W5);
         exception
            when PROGRAM_ERROR  =>
               raise;
            when ENTRY_FINISHED =>
               null;  
            when TEXT_IO.DATA_ERROR  | TEXT_IO.END_ERROR  => 
               null;
      end;
   
    --PUT_LINE("CREATING WORK FILE");
      NEW_LINE;
      CREATE (WORK, INOUT_FILE, "WORK."); 
      PUT_LINE("CREATED  WORK FILE");
   
      while not END_OF_FILE(INPUT)  loop
      --begin
         GET_LINE(INPUT, LINE_TEXT, CURRENT_LENGTH);
      --exception when others  =>
      --TEXT_IO.PUT_LINE("INPUT GET exception");
      --TEXT_IO.PUT_LINE(LINE_TEXT(1..CURRENT_LENGTH) & "|");
      --end;
      --PUT_LINE(LINE_TEXT(1..CURRENT_LENGTH));
      --PUT_LINE("=>" & HEAD(LINE_TEXT(1..CURRENT_LENGTH), LINE_LENGTH) & "|");
         if TRIM(LINE_TEXT(1..CURRENT_LENGTH)) /= ""  then
         --begin
            WRITE(WORK, HEAD(LINE_TEXT(1..CURRENT_LENGTH), LINE_LENGTH)  );
         --exception when others  =>
         --TEXT_IO.PUT_LINE("WORK WRITE exception");
         --TEXT_IO.PUT_LINE(LINE_TEXT(1..CURRENT_LENGTH) & "|");
         --end;
         end if;
      end loop;
      CLOSE(INPUT);
   
      PUT_LINE("Begin sorting");
   
   
      LINE_HEAPSORT:  
      declare
      
         L    : LINE_IO.POSITIVE_COUNT := SIZE(WORK) / 2 + 1; 
         IR   : LINE_IO.POSITIVE_COUNT := SIZE(WORK);
         I, J : LINE_IO.POSITIVE_COUNT;
      
      begin
         TEXT_IO.PUT_LINE("SIZE OF WORK = " & INTEGER'IMAGE(INTEGER(SIZE(WORK))));
      MAIN:
         loop
         
            if L > 1  then
               L := L - 1;
               READ(WORK, LINE_TEXT, L);
               OLD_LINE := LINE_TEXT;
            else
               READ(WORK, LINE_TEXT, IR);
               OLD_LINE := LINE_TEXT;
               READ(WORK, LINE_TEXT, 1);
               WRITE(WORK, LINE_TEXT, IR);
               IR := IR - 1;
               if IR = 1 THEN
                  WRITE(WORK, OLD_LINE, 1);
                  exit MAIN;  
               end if;
            end if;
            I := L;
            J := L + L;
         
            while J <= IR   loop
               if J < IR  then
                  READ(WORK, LINE_TEXT, J);
                  READ(WORK, P_LINE, J+1);
               --if LT (LINE.TEXT, P_LINE.TEXT)  then
                  if LT (LINE_TEXT, P_LINE)  then
                     J := J + 1;
                  end if;
               end if;
               READ(WORK, LINE_TEXT, J);
            --if OLD_LINE.TEXT < LINE.TEXT  then
               if LT (OLD_LINE , LINE_TEXT)  then
                  WRITE(WORK, LINE_TEXT, I);
                  I := J;
                  J := J + J;
               else
                  J := IR + 1;
               end if;
            end loop;
            WRITE(WORK, OLD_LINE, I);
         
         end loop MAIN;
      
         exception
            when CONSTRAINT_ERROR => PUT_LINE("HEAP CONSTRAINT_ERROR"); 
            when others           => PUT_LINE("HEAP other_ERROR"); 
      end LINE_HEAPSORT;
   
      PUT_LINE("Finished sorting in WORK");
   
      CREATE_FILE_FOR_OUTPUT(OUTPUT, "Where to put the output => ");
   
   
   --RESET(WORK);
      Set_Index(WORK, 1);
      while not END_OF_FILE(WORK)  loop
         READ(WORK, LINE_TEXT);
         if TRIM(GRAPHIC(LINE_TEXT))'LENGTH > 0  then
         --PUT_LINE(TRIM(LINE_TEXT, RIGHT));
            PUT_LINE(OUTPUT, TRIM(LINE_TEXT, RIGHT));
         end if;
      end loop;
   
      CLOSE(WORK);
      CLOSE(OUTPUT);
      PUT_LINE("Done!");
      NEW_LINE;
   
      exception
         when PROGRAM_ERROR  =>
            PUT_LINE("SORT terminated on a PROGRAM_ERROR");
            CLOSE(OUTPUT);
         when TEXT_IO.DATA_ERROR =>     --Terminate on primary start or size = 0
            PUT_LINE("SORT terminated on a DATA_ERROR");
            PUT_LINE(LINE_TEXT);
            CLOSE(OUTPUT);
         when CONSTRAINT_ERROR =>       --Terminate on blank line for file name
            PUT_LINE("SORT terminated on a CONSTRAINT_ERROR");
            CLOSE(OUTPUT);
         when TEXT_IO.DEVICE_ERROR  =>     --Ran out of space to write output file
            PUT_LINE("SORT terminated on a DEVICE_ERROR");
            DELETE(OUTPUT);
            CREATE_FILE_FOR_OUTPUT(OUTPUT, "Wherelse to put the output => ");
            RESET(WORK);
            while not END_OF_FILE(WORK)  loop
               READ(WORK, LINE_TEXT);
               PUT_LINE(OUTPUT, LINE_TEXT);    --(1..LINE.CURRENT_LENGTH));
            end loop;
            CLOSE(OUTPUT);
   end SORTER;
