Yurttas/PL/IL/Ada-95/Sort/QSort/qsortif ad 00.adb

From ZCubes Wiki
Jump to navigation Jump to search
  1--
  2-- Copyright (C) 1998
  3-- All Rights Reserved. Salih Yurttas, ZCubes, BitsOfCode Software Systems, Inc..
  4--
  5-- Permission to use, copy, modify, and distribute this 
  6-- software and its documentation for EDUCATIONAL purposes
  7-- and without fee is hereby granted provided that this 
  8-- copyright notice appears in all copies. 
  9-- 
 10-- 
 11 
 12-- date   : January 1, 1998.
 13-- author : Salih Yurttas.
 14
 15-- purpose : sorting of a list of integers/floats
 16--           in ascending/descending order
 17--           using Quick-Sort.
 18
 19-- qsortif_ad_00.adb
 20
 21
 22with Text_IO; use Text_IO;
 23
 24with ListIF_P;   use ListIF_P;
 25with I_ListIF_P; use I_ListIF_P;
 26with O_ListIF_P; use O_ListIF_P;
 27
 28with QSortEL_AD_00_P; use QSortEL_AD_00_P;
 29
 30procedure QSortIF_AD_00 is
 31
 32  N : constant Integer := 16;
 33
 34  Y_N : Character := 'Y';
 35  I_F : Character;
 36  A_D : Character;
 37
 38  List_Count : Integer;
 39
 40begin
 41
 42  while Y_N = 'Y' or Y_N = 'y'
 43  loop
 44
 45    Put("--> I_F : I for Integer,"); New_Line;
 46    Put("          F for Float    : ");
 47
 48    Get(I_F); Skip_Line;
 49    New_Line;
 50
 51    Put("--> A_D : A for Ascending,"); New_Line;
 52    Put("          D for Desscending : ");
 53
 54    Get(A_D); Skip_Line;
 55    New_Line;
 56
 57    case I_F is
 58    when 'I' | 'i' => 
 59    declare
 60      D_ListI : ListI(1..N);
 61    begin
 62      case A_D is
 63      when 'A' | 'a' => 
 64      declare
 65        procedure Quick_SortI_A is new Quick_SortE (Element => Integer, 
 66                                                    ListE   => ListI,
 67                                                    Compare => "<");
 68        PageHeaderI : constant String :=
 69          "The sorted list of integers in ascending order are :";
 70      begin
 71        GetIL(List_Count, D_ListI);
 72        Quick_SortI_A(1, List_Count, D_ListI);
 73        PutIL(List_Count, D_ListI, PageHeaderI);
 74      end;
 75      when 'D' | 'd' => 
 76      declare
 77        procedure Quick_SortI_D is new Quick_SortE (Element => Integer, 
 78                                                    ListE   => ListI,
 79                                                    Compare => ">");
 80        PageHeaderI : constant String :=
 81          "The sorted list of integers in descending order are :";
 82      begin
 83        GetIL(List_Count, D_ListI);
 84        Quick_SortI_D(1, List_Count, D_ListI);
 85        PutIL(List_Count, D_ListI, PageHeaderI);
 86      end;
 87      when others => null;
 88      end case;
 89    end;
 90
 91    when 'F' | 'f' => 
 92    declare
 93      D_ListF : ListF(1..N);
 94    begin
 95      case A_D is
 96      when 'A' | 'a' => 
 97      declare
 98        procedure Quick_SortF_A is new Quick_SortE (Element => Float,
 99                                                    ListE   => ListF,
100                                                    Compare => "<");
101        PageHeaderF : constant String :=
102          "The sorted list of floats in ascending order are :";
103      begin
104        GetFL(List_Count, D_ListF);
105        Quick_SortF_A(1, List_Count, D_ListF);
106        PutFL(List_Count, D_ListF, PageHeaderF);
107      end;
108      when 'D' | 'd' => 
109      declare
110        procedure Quick_SortF_D is new Quick_SortE (Element => Float,
111                                                    ListE   => ListF,
112                                                    Compare => ">");
113        PageHeaderF : constant String :=
114          "The sorted list of floats in descending order are :";
115      begin
116        GetFL(List_Count, D_ListF);
117        Quick_SortF_D(1, List_Count, D_ListF);
118        PutFL(List_Count, D_ListF, PageHeaderF);
119      end;
120      when others => null;
121      end case;
122    end;
123
124    when others => null;
125
126    end case;
127
128    New_Line(2);
129    Put("--> Y_N :  Y for Continue,"); New_Line;
130    Put("           N for Stop     : ");
131
132    Get(Y_N); Skip_Line;
133    New_Line;
134
135  end loop;
136
137end QSortIF_AD_00;