SPACE 2/SPACE - Library 2 - Volume 1.iso/program/138/pascal/stats.pas

Pascal/Delphi Source File | 1987-05-13 | 45.5 KB | 1,961 lines

program STATS;


{

   AUTHOR : Gary Curtis Newport
            27808 Manon Ave # 18
            Hayward, CA 94544

  COMPUTER: Atari 1040 ST

  LANGUAGE: Personal Pascal
            Optimised Systems Software
            1221 B Kentwood Ave
            San Jose, CA 95129


   This program does one statistical task--it calculates the mean and
   standard deviation of a set of numbers--but allows great flexibility
   to the user while accomplishing that task.  Numbers may be entered
   from the keyboard or read from a disk file.  Once entered, the
   numbers can be edited, saved to disk or printed in their original
   order or in sorted order.  The calculated results can be displayed
   on the screen and then printed out.  A bar chart of the frequency
   distribution can be displayed or printed.  Several help screens are
   available from the menu to explain these options.  Numbers entered
   from the keyboard are validated upon entry, and a non-numeric entry
   brings up an alert box which offers the option to stop data entry
   and go on to some other function, or to edit the numbers already
   entered.  The program is designed to run in medium resolution, but
   will probably work fine in high resolution IF the call to load the
   medium resolution Degas title is omitted.

   For Pascal programmers, the source code offers a number of potentially
   useful examples.  Besides menus, alert boxes and dialog boxes, there
   are: use of a DEGAS picture as a title page, cursor control, saving
   screens (to avoid redrawing), checking monitor resolution, checking
   whether the printer is online, help screens, use of library routines,
   and one or two other things.

   Note that the DEGAS picture file, TITLE.PI2, must be available
   to the program when run, and that a folder, INCLIB, must
   be available, and must contain the appropriate routines, when
   compiling the program.

   I must apologise for the condition of the source code: it is poorly
   commented and there are stylistic inconsistencies.  The slovenly
   state of the source is primarily due to the fact that I wrote the
   program as an exercise in learning GEM manipulation from Personal
   Pascal and not as an exercise in software engineering.

   The first rule of programming is: "steal from the best," so I want
   to acknowledge the folks at Optimised Systems Software, and
   especially the OSS bulletin board, as well as Jinfu Chen and
   several anonymous Pascalites on CompuServe and elsewhere, for
   offering something worth stealing.  The Public Domain belongs to
   all of us: do your part to keep it healthy!

}


   CONST

      {$I gemconst }

      Max_array_size   = 1000;
      space            = ' ';
      Desk_title       = 3;
      bell             = 7;

      Max_lines        = 18;  {                  }
      MaxPlusOne       = 19;  {  Page control    }
      Max_chars        = 80;  {                  }
      Offset           = 4;   {                  }

      ShowWhite        = 0 ;  {                  }
      ShowRed          = 1 ;  {  Display colors  }
      ShowGreen        = 2 ;  {                  }
      ShowBlack        = 3 ;  {                  }

   TYPE

      {$I gemtype }

      Xarraytype        = array [1..Max_array_size] of real;
      NumStrType        = array [1..80] of char;

   VAR

                   {    PROGRAM VARIABLES   }

      Data,
      Sorted_data      : Xarraytype;

      Mean,
      Std_dev,
      Sample_Std_Dev,
      Median           : real;
      index,
      WrapIndex,
      N                : integer;      { counts input values }
      Numeric_chrs     : set of char;
      Done             : boolean;
      DataSetName      : Str255;


                   {    GEM VARIABLES   }


      Msg              : Message_Buffer;
      The_menu         : Menu_Ptr;

      Help,                 { menu title }
      Option,               { menu title }
      Instructions,         { menu item  }
      HelpEnter,            { menu item  }
      HelpRead,             { menu item  }
      HelpEdit,             { menu item  }
      HelpGraph,            { menu item  }
      Enter_data,           { menu item  }
      Read_data,            { menu item  }
      Edit_data,            { menu item  }
      View_sorted,          { menu item  }
      Calc_results,         { menu item  }
      Show_graph,           { menu item  }
      Print_results,        { menu item  }
      Print_graph,          { menu item  }
      Print_sorted_data,    { menu item  }
      Print_raw_data,       { menu item  }
      Save_sorted_data,     { menu item  }
      Save_raw_data,        { menu item  }
      Exit_stats,           { menu item  }

      what_key,
      resolution,
      dummy,
      event,
      event_mask         : integer;



              {    PROCEDURES AND FUNCTIONS    }


{$I gemsubs         }
{$I INCLIB\MIN      }
{$I INCLIB\MEANSTD  }
{$I INCLIB\STR_REAL }
{$I INCLIB\COUNTDIG }
{$I INCLIB\CURSOR   }
{$I INCLIB\GOTOXY   }


function
GetRez    : integer;

   XBIOS( 4 );




procedure
Initialize;

   VAR

      i     : integer;


BEGIN {INITIALIZE}

Numeric_chrs := [ '-', '.'] + [ '0'..'9' ];
Done := false;
index := 0;
N := 0;
WrapIndex := 0;


Event_mask := E_Message |  E_Keyboard;
Menu_disable( The_menu, Edit_data);
Menu_disable( The_menu, View_sorted);
Menu_disable( The_menu, Calc_results);
Menu_disable( The_menu, Show_graph);
Menu_disable( The_menu, Print_results);
Menu_disable( The_menu, Print_graph);
Menu_disable( The_menu, Save_sorted_data);
Menu_disable( The_menu, Save_raw_data );
Menu_disable( The_menu, Print_sorted_data);
Menu_disable( The_menu, Print_raw_data);

END;  {INITIALIZE}


function
GetPrinterStatus : long_integer;

GEMDOS($11);





procedure
Show_ProgName;

BEGIN {SHOW_PROGNAME}

   dummy := Do_alert(

'[0][STATS|Version 1.4|By Gary C. Newport|Written in OSS PERSONAL PASCAL][OK]'
                   ,1)

END; {SHOW_PROGNAME}


procedure
Ask_DS_Name;

   CONST

      sf          = System_Font;

   VAR

      DialogBox   : Dialog_ptr;
      pushed,
      ok_button,
      DItem       : integer;

BEGIN {ASK_DS_NAME}

DialogBox := New_Dialog( 8, 0, 0, 40, 10 );
DItem := Add_DItem(DialogBox, G_Text, none, 2, 1,36, 1, 0, $1180);
Set_DText( DialogBox, DItem,
           'Enter the name of your data set :', sf, TE_Left);
DItem := Add_DItem(DialogBox, G_FBoxText, Editable, 2, 3, 36, 2, 0, $1180);
Set_DEdit( DialogBox, DItem,
          '______________________________',
          'nnnnnnnnnnnnnnnnnnnnnnnnnnnnnn',
          '',
          sf, TE_Center
         );
ok_button := Add_DItem(DialogBox, G_Button, Exit_Btn | Selectable,
                       18, 7, 4, 2, 0, $1180
                      );
Set_DText( DialogBox, ok_button, 'OK', sf, TE_Center );
Center_Dialog( DialogBox );
pushed := Do_Dialog( DialogBox, DItem );
Get_DEdit( DialogBox, DItem, DataSetName );
End_Dialog( DialogBox );

END; {ASK_DS_NAME}



procedure
Erase_Page;

   VAR
       i    : integer;

BEGIN {ERASE_PAGE}

Hide_mouse;
Gotoxy( 1, Offset - 1 );
ClrEos;
Show_mouse;

END; {ERASE_PAGE}



procedure
Erase_Commands;

   CONST

      CommandLine = 23;


BEGIN {ERASE_COMMANDS}

Hide_mouse;
Gotoxy( 1, CommandLine );
ClrEos;
Show_mouse

END; {ERASE_COMMANDS}


procedure
SelectSort ( VAR Data, Sorted_Data : XarrayType );

   VAR

      i, j, k   : integer;
      small       : real;

BEGIN {SELECTSORT}

Sorted_data := Data;

For i := 1 to N - 1 do begin
   k := i;
   small := Sorted_Data [ i ];

   For j := i + 1 to N do
      If Sorted_Data [ j ] < small then
         begin
            k := j;
            small := Sorted_Data [ j ]
         end; {If}

      Sorted_Data [ k ] := Sorted_data [ i ];
      Sorted_Data [ i ] := small;
end {For i }

END; {SELECTSORT}



procedure
Is_There_More ( VAR More : boolean;
                VAR Edit : boolean
              );


   VAR

      Response          : integer;


BEGIN {IS_THERE_MORE}

Response := Do_Alert(

'[2][MORE data|DONE entering|EDIT this page    ][ MORE | DONE | EDIT ]'
                   ,0);

More := ( Response = 1 );
Edit := ( Response = 3 )

END; {IS_THERE_MORE}


procedure
Get_Index   ( VAR index     : integer;
                  LowValue  : integer;
                  Highvalue : integer;
              VAR GoodIndex : boolean
           );

   VAR

      Temp      : integer;
      RealTemp  : real;


BEGIN {GET_INDEX}

Get_Num(RealTemp, GoodIndex);
Temp := trunc(RealTemp);
If (GoodIndex
And (Temp >= LowValue)
And (Temp <= HighValue)) then
   index := Temp
Else
   GoodIndex := false

END; {GET_INDEX}




procedure
Edit_Item(
          VAR item       : integer;
          VAR Data       : Xarraytype;
              PageNum    : integer;
          VAR N          : integer;
          VAR Change     : boolean;
          VAR Delete     : boolean;
          VAR Cancel     : boolean
          );

   CONST

      A_Change     = 1;
      A_Delete     = 1;
      A_Cancel     = 2;
      NullChoice   = 0;

   VAR

      i,
      Choice,
      Topline,
      Bottomline   : integer;
      Temp         : real;
      GoodIndex,
      GoodValue    : boolean;

BEGIN {EDIT_ITEM}

If PageNum = 1 then
   Topline := 1
Else
   Topline := (PageNum - 1) * Max_lines;
Bottomline := Min_Int( (PageNum * Max_lines), (N + 1) );
Gotoxy(40,23);
write('topline = ',topline, ' p ',PageNum);
gotoxy(40,24);
write('bottom line = ',bottomline);

Choice := Do_Alert(

'[2][ Change item| Delete item][ CHANGE | DELETE ]'
               , 0 );
If (Choice = A_Change) then
   begin
      change := true;
      delete := false;
      cancel := false;
      Gotoxy( 1, 23 );
      TextColor(ShowRed);
      write('Change which datum? ');

      Repeat
         Gotoxy(22, 23 );
         ClrEol;
         CursOn;
         Get_Index( item, Topline, Bottomline, GoodIndex );
         If not GoodIndex then
            begin
               write( Chr(bell) );
               Choice := Do_Alert(

   '[3][You can only change |data on this page][ CHANGE | CANCEL ]',
                         2)

             end; {If}
         Cancel := ( Choice = A_Cancel );
         Change := ( Not Cancel )
      Until (GoodIndex
      Or     Cancel    );

      CursOff;
      TextColor(ShowBlack);
      If (GoodIndex
      And Change    ) then
         begin

            Repeat
               Gotoxy(1, 24);
               TextColor(ShowRed);
               write('New value? ');
               CursOn;
               Get_Num(Temp, GoodValue);
               If ( not GoodValue ) then
                  write( chr(bell) );
               CursOff;
               TextColor(ShowBlack)
            Until GoodValue;

            Data[item] := Temp;
            If item = (N + 1) then
               N := N + 1;
         end {If}
   end {If}
Else
   begin
      Choice := NullChoice;
      delete := true;
      cancel := false;
      change := false;
      TextColor(ShowRed);
      Gotoxy(1, 23);
      Bottomline := Min_Int( (PageNum * Max_lines), N );
      write('Delete which datum? ');

      Repeat
         CursOn;
         Gotoxy(22, 23);
         Get_Index(item, Topline, Bottomline, GoodIndex);
         If not GoodIndex then
            begin
               write( chr(bell) );
               Choice := Do_Alert(

   '[3][You can only delete |data on this page][ DELETE | CANCEL ]',
                         2);
               Gotoxy(22, 23 );
               ClrEol;
               Delete := ( Choice = A_Delete );
               Cancel := ( Not Delete )
             end; {If}
          CursOff;
          TextColor(ShowBlack)
       Until (GoodIndex
       Or     Cancel    );

      If (GoodIndex
      And Delete   ) then
         begin
            N := N - 1;

            For i := item to N do
               Data[i] := Data[i + 1];

         end {If}
   end; {Else}

Erase_Commands

END; {EDIT_ITEM}



procedure
Allow_Options;

BEGIN {ALLOW_OPTIONS}

Menu_enable( The_menu, Calc_results);
Menu_enable( The_menu, Edit_data);
Menu_enable( The_menu, View_sorted );
Menu_enable( The_menu, Print_sorted_data );
Menu_enable( The_menu, Print_Raw_Data );
Menu_enable( The_menu, Save_sorted_data );
Menu_enable( The_menu, Save_raw_data );

END; {ALLOW_OPTIONS}



procedure
Input_Data(
           VAR index     : integer;
           VAR Data      : XarrayType;
           VAR WrapIndex : integer;
           VAR N         : integer
           );

   VAR

      More_data,
      Edit,
      change,
      delete,
      cancel,
      Good_value         : boolean;
      Temp               : real;
      Alert,
      Skip,
      item,
      PageNum,
      LineCount,
      NewLine,
      i, j, k            : integer;


BEGIN {INPUT_DATA}

More_data := true;
index := N;
If ( N > 0 ) then
   PageNum := N div Max_lines
Else
   PageNum := 0;
PageNum := PageNum + 1;
LineCount := 1 + (index - WrapIndex);
{If LineCount = 1 then
   Erase_Page;}

While More_data and ( index <= Max_Array_Size ) do begin
   index := index + 1;
   If index = Max_Array_Size then
      begin
         write( chr( bell ) );
         Alert := Do_Alert(

'[3][WARNING! |You can enter only|one more value][OK]', 1

                       );
      end; {If}

   Hide_mouse;
   NewLine := LineCount;
   Gotoxy( 1, ((NewLine  mod MaxPlusOne) + offset) );
   write(space:80);
   Gotoxy( 1, ((NewLine  mod MaxPlusOne) + offset) );
   write ('datum[', index, '] ');
   Get_Num( temp, Good_value );

   If Good_value then
      begin
         N := N + 1;
         Data[N] := Temp;
         LineCount := LineCount + 1
      end {If }
   Else
      begin
         index := index - 1;
         write( Chr( bell ) );
         Is_There_More ( More_data, Edit);

         If Edit then
            begin
               More_data := true;
               item := index;
               Edit_Item( item, Data, PageNum, N, change,
                          delete, cancel );
               If change then
                  begin
                     If item = index + 1  then
                        begin
                           index := item;   { Datum added to end of array. }
                           LineCount := LineCount + 1
                        end; {If}
                     If item = WrapIndex then
                        Gotoxy( 1, Offset - 1)
                     Else
                        begin
                           j := item - WrapIndex;
                           Gotoxy( 1, ( (j mod MaxPlusOne) + Offset) )
                        end; {Else}
                     write('datum[', item, '] ');
                     skip := 7 - CountDigits(item);
                     TextColor(ShowRed);
                     write( space:skip, Data[item]:14:6 );
                     TextColor(ShowBlack)
                  end {change}
               Else If delete then
                  begin
                     Erase_Page;
                     If ( (item = WrapIndex)
                     And  (LineCount = 1) ) then
                        begin
                           PageNum := PageNum - 1;
                           LineCount := MaxPlusOne;
                           WrapIndex := ((PageNum - 1) * Max_lines) ;
                        end; {If}
                     index := index - 1;
                     LineCount := LineCount - 1;
                     If (WrapIndex <> 0) then
                        begin
                           Gotoxy(1, Offset - 1);
                           skip := 7 - CountDigits(WrapIndex);
                           write('datum[', WrapIndex, '] ',
                                 space:skip, Data[WrapIndex]:14:6)
                         end; {If}

                      For j := 1 to LineCount do begin
                         k := j + WrapIndex;
                         skip := 7 - CountDigits(k);
                         Gotoxy(1, ((j mod MaxPlusOne) + Offset ) );
                         write('datum[', k, '] ', space:skip,
                                Data[k]:14:6 )
                      end; {For}

                  end; {Else}
               Edit := false
            end {If}
      end; {Else}
   If (( (LineCount mod MaxPlusOne) = 0)
   And   (N >= Max_lines) ) then
      begin
         Erase_Page;
         PageNum := PageNum + 1;
         WrapIndex := Max_lines + WrapIndex;
         LineCount := 1;
         Gotoxy( 1, Offset - 1 );
         Skip := 7 - CountDigits( index - 1 );
         write( 'datum[', WrapIndex, '] ', Space:Skip,
                 Data[ WrapIndex ]:14:6 )
      end; {If}
   Show_mouse;
end; {while }

Menu_disable( The_menu, Enter_data);
Menu_disable( The_menu, Read_data );
Allow_options;
Menu_Normal( The_menu, Option)

END; {INPUT_DATA}



procedure
ReadFromDisk ( Var N : integer );

   VAR

      Default_path,
      Chosen_path    : Path_name;
      i              : integer;
      temp           : real;

BEGIN {READFROMDISK}

Default_path := 'D:\PASCAL\*.DAT';
i := 0;
If Get_In_File( Default_path, Chosen_path ) then
   begin
      Set_mouse( M_bee );
      Reset( Input, Chosen_path );

      While not eof do begin
         Readln( temp );
         i := i + 1;
         Data[i] := temp
      end; {While}

      N := i;
      Reset( Input, 'CON:' );
      Set_mouse( M_arrow );
      Menu_normal( The_menu,Option );
      Menu_disable( The_menu, Enter_data );
      Allow_options;
   end; {If}
Erase_page;
Erase_commands;

END; {READFROMDISK}



procedure
Offer_Edit(
            VAR Editing     : boolean
          );


   VAR

      choice  : integer;

BEGIN {OFFER_EDIT}

   choice := Do_Alert(

'[0][EDIT this page|GO TO next page][ EDIT | GO TO ]', 2 );

   Editing := ( choice = 1 );

END; {OFFER_EDIT}


procedure
Edit_All ( VAR Data : Xarraytype );

   VAR

      i,
      choice,
      item,
      PageNum,
      Skip,
      LineCount,
      data_left,
      index            : integer;
      Editing,
      Change,
      Delete,
      Cancel,
      More_data        : boolean;

BEGIN {EDIT_ALL}


Menu_disable( The_menu, Print_results);
Menu_disable(The_menu, Show_graph);
Menu_disable(The_menu, Print_graph);
index := 0;
More_data := true;
PageNum := 1;
LineCount := 0;
More_data := ( N >= 1 );
Hide_mouse;

while More_data do begin
   Erase_Page;
   data_left := N - index;
   WrapIndex := index;
   LineCount := Min_Int( Max_lines, data_left );
   If WrapIndex <> 0 then
      begin
         Gotoxy(1, Offset - 1);
         skip := 7 - CountDigits(WrapIndex);
         write('datum[', WrapIndex, '] ', space:skip,
                Data[WrapIndex]:14:6)
      end; {If}

   For i := 1 to LineCount do begin
      index := Index + 1;
      skip := 7 - CountDigits(index);
      Gotoxy(1, ((i mod MaxPlusOne) + Offset) );
      write('datum[',index, '] ', space:skip,
             Data[index]:14:6 )
   end; {For}

   editing := true;

   While editing do begin
      Offer_Edit( editing );
      If editing then
         begin
            Edit_Item(item, Data, PageNum, N, Change,
                      Delete, Cancel );
            If Change then
               begin
                  If item = WrapIndex then
                     Gotoxy(1, Offset - 1)
                  Else
                     begin
                        i := item - wrapIndex;
                        Gotoxy(1, ((i mod MaxPlusOne) + Offset) )
                     end; {Else}
                  skip := 7 - Countdigits(item);
                  write('datum[', item, '] ', space:skip);
                  TextColor(ShowRed);
                  write(Data[item]:14:6);
                  TextColor(ShowBlack)
               end {If}
            Else If Delete then
               begin
                  editing := false;
                  i := item - WrapIndex;
                  Gotoxy(1, ((i mod MaxPlusOne) + Offset) );
                  write(space:80);
                  PageNum := PageNum - 1;
                  index := WrapIndex
               end {Else If}
         end {If}

   end; {While}

More_data := ( ( N - Index ) >= 1 );
If More_data then
   PageNum := PageNum + 1;

end; {While}

write( chr(bell) );
choice := Do_Alert(

'[2][DONE editing|ADD to data][ DONE | ADD ]', 1 );

If choice = 2 then
   begin
      Menu_enable(The_menu, Enter_data);
      If ( LineCount = Max_lines ) then
         begin
            PageNum := PageNum + 1;
            Erase_Page;
            WrapIndex := N;
            Gotoxy(1, Offset - 1);
            skip := 7 - CountDigits(WrapIndex);
            write('datum[',wrapIndex,'] ', space:skip,
                   Data[WrapIndex]:14:6)
         end;
    end; {If}
Show_mouse;
Menu_normal( The_menu, Option );

END; {EDIT_ALL}



procedure
Build_Menu;

BEGIN {BUILD_MENU}

The_menu := NEW_MENU(32, 'STATS PROGRAM');
Help := Add_MTitle(The_menu, ' Help ');
Option := Add_MTitle(The_menu, ' Option ');

Instructions := Add_MItem(The_menu, Help,      '  Instructions      ');
HelpEnter := Add_MItem(The_menu, Help,         '  Enter data        ');
HelpRead := Add_MItem(The_menu, Help,          '  Read data         ');
HelpEdit := Add_MItem(The_menu, Help,          '  Edit data         ');
HelpGraph := Add_MItem(The_menu, Help,         '  The graph         ');
Enter_data := Add_MItem(The_menu,Option,       '  Enter data        ');
Read_Data  := Add_MItem(The_menu,Option,       '  Read data file    ');
Edit_data := Add_MItem(The_menu,Option,        '  Edit data         ');
View_sorted := Add_MItem(The_menu,Option,      '  View sorted data  ');
Calc_results := Add_MItem(The_menu,Option,     '  Calculate results ');
Show_graph := Add_MItem( The_menu, Option,     '  Show graph        ');
Print_results := Add_MItem(The_menu,Option,    '  Print results     ');
Print_graph := Add_MItem(The_menu, Option,     '  Print graph       ');
Print_sorted_data := Add_MItem(The_menu,Option,'  Print sorted data ');
Print_raw_data := Add_MItem(The_menu,Option,   '  Print raw data    ');
Save_sorted_data := Add_MItem(The_menu,Option, '  Save sorted data  ');
Save_raw_data := Add_MItem(The_menu,Option,    '  Save raw data     ');
Exit_stats     := Add_MItem(The_menu,Option,   '  Exit program      ');
Draw_Menu (The_menu);

END; {BUILD_MENU}



procedure
View      ( VAR Data : Xarraytype );

   VAR

      i,
      Skip,
      data_left,
      index,
      lines      : integer;
      More_data  : boolean;

BEGIN { VIEW }

index := 0;
ERASE_PAGE;
Hide_Mouse;
More_data := (N >= 1);


While More_data do begin

   Erase_Page;
   data_left := N - index;
   lines := Min_Int(Max_lines, data_left);

   For i := 1 to lines do begin
      index := index + 1;
      GOTOXY( 1, ( i  mod MaxPlusOne ) + Offset );
      Skip := 7 - ( CountDigits( index ) );
      write ('datum[', index, '] ', Space:Skip, Data[index]:14:6 )
   end; {For}

   dummy := Do_Alert(

  '[2][Next page][OK]', 1);

   More_data := ((N - index) >= 1)
end; {While}

write( Chr( bell ));
dummy := Do_Alert(

'[1][Last page][OK]',1);

Erase_Page;
Show_mouse;
Menu_normal( The_menu, Option )

END; {VIEW}



procedure
Results_Proc;

   VAR

      Dummychar   : char;

BEGIN {RESULTS_PROC}

HIDE_MOUSE;
ERASE_PAGE;
GOTOXY( 1, Offset - 1 );
writeln( space:20, 'DATA SET: ',DataSetName );
writeln;
writeln('Number of values entered  :  ', N);
writeln;
SELECTSORT( Data, Sorted_data );
MEANSTD (Sorted_data, N, Mean, Std_dev, Sample_Std_Dev);

If Odd( N ) then
   Median := Sorted_data [ Trunc( N/2) + 1 ]
Else
   Median := ( Sorted_data [ N div 2 ] + Sorted_data [ (N div 2) + 1 ] )/2 ;
write('low : ',Sorted_Data[1]:14:6);
writeln(space:15,'high : ',Sorted_data[N]:14:6);
writeln;
writeln('median               : ', median:14:6);
writeln;
writeln('mean                 : ',mean:14:6);
writeln;
writeln('std dev (population) : ',Std_dev:14:6);
write(  'std dev (sample)     : ',Sample_Std_Dev:14:6);
Gotoxy(1, 23);
TextColor( ShowRed );
write('Press ');
InverseVideo;
write(' Return ');
NormVideo;
write(' to continue...');
show_mouse;
readln( dummychar );
TextColor( ShowBlack );
Hide_mouse;
ERASE_PAGE;
ERASE_COMMANDS;
SHOW_MOUSE;
Menu_enable( The_menu, Show_graph );
Menu_enable( The_menu, Print_results );
Menu_enable( The_menu, Print_graph );
Menu_normal(The_menu, Option )

END; {RESULTS_PROC}


procedure
ShowGraph;

   VAR

      FreqCount     : array [1..10] of integer;
      LowValue,
      HighValue,
      UpperBound,
      Range,
      NextBound     : real;
      row,
      i, j          : integer;
      DummyChar      : char;


BEGIN {SHOWGRAPH}

Hide_mouse;
Erase_Page;
GoToxy( 1, Offset - 1 );
write( 'DATA SET : ', DataSetName );
LowValue := Sorted_Data[1];
HighValue := Sorted_Data[N];
Range := HighValue - LowValue;
NextBound := (Range / 10 );

For i := 1 to 10 do
   FreqCount[i] := 0;

UpperBound := LowValue;
j := 1;

For i := 1 to 10 do begin
   UpperBound := UpperBound + NextBound;

   While (( Sorted_Data[j] <=  UpperBound )
   And    ( j <= N )) do begin
      FreqCount[i] := FreqCount[i] + 1;
      j := j + 1
   end; {while}

end; {For}


row := Offset + 1;
GoToxy( 16, row );
write('Value');
row := row + 1;
UpperBound := HighValue;

For i := 10 downto 1 do begin
   Gotoxy(1, row );
   write( UpperBound:14:6);
   write( space:3, '|' );
   If FreqCount[i] <> 0 then
      begin
         TextColor( ShowGreen );
         If FreqCount[i] <= 50 then
            For j := 1 to FreqCount[i] do
               write('X')
         Else
            begin
               For j := 1 to 50 do
                   write('X');
                   TextColor(ShowRed);
               write(space, FreqCount[i])
            end; {Else}
         TextColor( ShowBlack )
      end; {If}
   row := row + 1;
   UpperBound := UpperBound - NextBound
end; {For}

GoToxy(1, row);
write( LowValue:14:6);
GoToxy( 18, row );
write( '+' );

For i := 1 to 53 do
   If ( i mod 5 ) = 0 then
      write('+')
   Else
      write('-');

write('Frequency');
row := row + 2;
GoToxy( 1, row );
write(space:5, 'Frequency increment : ', 1 );
write(space:5, 'Value increment : ', NextBound:14:6 );
Gotoxy(1, 23);
TextColor( ShowRed );
write('Press ');
InverseVideo;
write(' Return ');
NormVideo;
write(' to continue...');
Show_mouse;
readln( dummychar );
TextColor( ShowBlack );
Hide_mouse;
Erase_Page;
Erase_Commands;
Show_mouse;
Menu_Normal( The_Menu, Option )

END; {SHOWGRAPH}


procedure
PrintGraph;

   VAR

      Alert         : integer;
      FreqCount     : array [1..10] of integer;
      LowValue,
      HighValue,
      UpperBound,
      Range,
      NextBound     : real;
      i, j          : integer;
      PrinterStatus : long_integer;


BEGIN {PRINTGRAPH}

Repeat
   PrinterStatus := GetPrinterStatus;
   If PrinterStatus = 0 then
      Alert := Do_Alert(

   '[3][Printer is not online][ OK ]', 1);

Until ( PrinterStatus <> 0 );

set_mouse(M_bee);
rewrite(output, 'PRN:');
writeln(space:25, 'STATS : ',DataSetName);
writeln;
writeln(space:18, 'FREQUENCY DISTRIBUTION');
writeln;
writeln;

LowValue := Sorted_Data[1];
HighValue := Sorted_Data[N];
Range := HighValue - LowValue;
NextBound := (Range / 10 );

For i := 1 to 10 do
   FreqCount[i] := 0;

UpperBound := LowValue;
j := 1;

For i := 1 to 10 do begin
   UpperBound := UpperBound + NextBound;

   While (( Sorted_Data[j] <=  UpperBound )
   And    ( j <= N )) do begin
      FreqCount[i] := FreqCount[i] + 1;
      j := j + 1
   end; {while}

end; {For}

writeln('Value':20);
UpperBound := HighValue;

For i := 10 downto 1 do begin
   write( UpperBound:14:6);
   write( space:3, '|' );
   If FreqCount[i] <> 0 then
      begin
         If FreqCount[i] <= 50 then
            For j := 1 to FreqCount[i] do
               write('X')
         Else
            begin
               For j := 1 to 50 do
                   write('X');
               write(space, FreqCount[i])
            end {Else}
      end; {If}
   writeln;
   UpperBound := UpperBound - NextBound;
end; {For}

write( LowValue:14:6);
write(space:3);
write( '+' );
For i := 1 to 53 do
   If ( i mod 5 ) = 0 then
      write('+')
   Else
      write('-');

writeln('Frequency');
writeln;
writeln;
write(space:5, 'Frequency increment : ', 1 );
write(space:5, 'Value increment : ', NextBound:14:6 );
page;
rewrite(output, 'CON:');
set_mouse(M_arrow);
Menu_Normal( The_Menu, Option )

END; {PRINTGRAPH}

procedure
Do_Print_Results;

   VAR

      PrinterStatus : long_integer;
      Alert         : integer;


BEGIN {DO_PRINT_RESULTS}


Set_mouse( M_bee );
Rewrite( Output, 'PRN:' );

Repeat
   PrinterStatus := GetPrinterStatus;
   If PrinterStatus = 0 then
      Alert := Do_Alert(

   '[3][Printer is not online][ OK ]', 1);

Until ( PrinterStatus <> 0 );

writeln(space:25, 'STATS : ', DataSetName );
writeln;
writeln( Space:30, 'RESULTS' );
writeln;
writeln;
writeln( Space:6, 'Number of values entered : ', N );
writeln( Space:6,
        'Low value : ',Sorted_data[1]:14:6, '       High value : ',
         Sorted_data[N]:14:6);
writeln;
writeln( Space:6,' Median : ', median:14:6 );
writeln;
writeln( Space:6,' Mean   : ', Mean:14:6 );
writeln;
writeln( Space:6,'Standard deviation for population : ', Std_dev:14:6 );
writeln;
writeln(Space:6, 'Standard deviation for sample     : ', Sample_Std_Dev:14:6);
page;
Rewrite( Output, 'CON:' );
Set_mouse( M_arrow );
Menu_normal( The_menu, Option );

END; {DO_PRINT_RESULTS}



procedure
Do_Title;

BEGIN {DO-TITLE}

write( Space:25, 'STATS : ',DataSetName );
writeln;
writeln;
writeln

END; {DO_TITLE}



procedure
Print_Array ( VAR Data : XarrayType; N : integer );

   CONST

      MaxLines         = 50;  { Max lines per page }

   VAR

      PrinterStatus : long_integer;
      Alert         : integer;
      Skip,
      i, j          : integer;
      EndOfData     : boolean;


BEGIN {PRINT_ARRAY}

Repeat
   PrinterStatus := GetPrinterStatus;
   If PrinterStatus = 0 then
      Alert := Do_Alert(

   '[3][Printer is not online][ OK ]', 1);

Until ( PrinterStatus <> 0 );

Set_mouse( M_bee );
rewrite( Output, 'PRN:' );
i := 0;
j := 0;
DO_TITLE;
EndOfData := ( N <= 0 );

While (not EndOfData) do begin
   i := i + 1;
   Skip := 7 - ( CountDigits( i ) );
   write( Space:6);
   write('[', i, '] ', Space:Skip, Data[i]:15:6 );
   If ( i + MaxLines ) <= N then
      begin
         write( Space:18 );
         Skip := 7 - ( CountDigits( i + MaxLines ) );
         write( '[', ( i + MaxLines ), '] ', Space:Skip,
                 Data[ i + MaxLines ]:15:6 );
         j := j + 1;
         If (j mod MaxLines ) = 0 then
            begin
               page;
               DO_TITLE;
               i := i + MaxLines;
               j := 0
            end; {If}
      end; {If}
   writeln;
   EndOfData := ( i + j ) >= N
end; {While}

page;
Set_mouse( M_arrow );
rewrite( Output,'CON:' );
Menu_normal( The_menu, Option)

END; {PRINT_ARRAY}



procedure
Save      ( VAR Data: Xarraytype );

   VAR

     i          : integer;
     Disk_file  : Path_name;

BEGIN {SAVE}

If Get_Out_File( 'Save as: filename.DAT', Disk_file ) then
   begin
      Set_mouse( M_bee );
      Rewrite( Output, Disk_file );
      i := 1;

      While ( i <= N ) do begin
         writeln( Data[i] );
         i := i + 1
      end; {While}

      Rewrite( Output, 'CON:' );
      Set_mouse( M_arrow )
    end; {If}
Menu_normal( The_menu, Option );
Erase_page;
Erase_commands;

END; {SAVE}




procedure
EXIT_PROC;

BEGIN {EXIT_PROC}

ERASE_MENU (The_menu);
Init_Mouse;

END; {EXIT_PROC}



procedure
Option_Proc;

BEGIN {OPTION_PROC}

if msg[4] = Enter_data then
   Input_Data (index, Data, WrapIndex, N )
else if msg[4] = Read_data then
   ReadFromDisk( N )
else if msg[4] = Calc_results then
   Results_Proc
else if msg[4] = Edit_data then
   Edit_All ( Data )
else if msg[4] = View_sorted then
   begin
      SelectSort( Data, Sorted_data );
      View ( Sorted_data )
   end { else }
else if msg[4] = Print_results then
   Do_Print_Results
else if msg[4] = Show_graph then
   ShowGraph
else if msg[4] = Print_graph then
   PrintGraph
else if msg[4] = Print_Sorted_Data then
   begin
      SelectSort( Data, Sorted_data );
      Print_Array( Sorted_Data, N )
   end {else}
else if msg[4] = Print_Raw_Data then
   Print_Array( Data, N )
else if msg[4] = Save_sorted_data then
   begin
      Selectsort( Data, Sorted_data );
      Save( Sorted_data )
   end {else}
else if msg[4] = Save_raw_data then
   Save( Data )
else if msg[4] = Exit_stats then
   Done := true;
Menu_normal( The_menu, Option )

END; {OPTION_PROC}



procedure
GIVEINSTRUCTIONS;

   VAR

      dummychar   : char;

BEGIN { GiveInstructions }

ClrScr;
Gotoxy( 1, Offset );
writeln('STATS calculates the mean, median and standard deviation for a');
writeln('set of numbers.  Numbers may be ENTERed from the keyboard, or READ');
writeln('from a disk file.  Once entered, the data may be EDITed, VIEWed');
writeln('in sorted order, SAVEd to disk or PRINTed in raw or sorted order');
writeln;
writeln('After a data set has been entered, you may CALCULATE the RESULTS;');
writeln('(mean and standard deviation).  The results will be displayed on');
writeln('the screen and several OPTIONs will become enabled; for example,');
writeln('You may then SHOW the GRAPH, which is a frequency distribution');
writeln('of the data set.  You may also PRINT the RESULTS and the GRAPH');
writeln;
Gotoxy(1,23);
TextColor( ShowRed );
write('Press ');
InverseVideo;
write(' Return ');
NormVideo;
write(' to continue...');
readln(dummychar);
TextColor( ShowBlack )

END;  { GiveInstructions }




procedure
GiveEnterHelp;

   VAR

      dummychar  : char;

BEGIN { GiveEnterHelp }

ClrScr;
Gotoxy( 1, Offset );
writeln('Data may be entered from the keyboard as integers or real');
writeln('numbers, or as a mixture of the two.  A maximum of eighteen');
writeln('values can be entered on a screen; the last value will "wrap');
writeln('around" to the top of the next screen.');
writeln;
writeln('If you enter an invalid number, an alert box will appear to ask');
writeln('if you are DONE entering data, if there is MORE data, or if');
writeln('you want to EDIT the data on that page.');
writeln;
writeln('If you enter an incorrect number, just press return at the');
writeln('next prompt and select EDIT in the first alert box.  You will');
writeln('be prompted for the index of the offending value and asked');
writeln('whether you wish to CHANGE the value or DELETE it.  You may');
writeln('change or delete any datum visible on the page, including the');
writeln('"wrapped" value from the previous page.');
writeln;
writeln('When you have finished entering your data, press return at the next');
writeln('prompt, click on DONE, and select an action from the OPTION menu.');
Gotoxy(1, 23);
TextColor( ShowRed );
write('Press ');
InverseVideo;
write(' Return ');
NormVideo;
write(' to continue...');
readln( dummychar );
TextColor( ShowBlack )

END; { GiveEnterHelp }




procedure
GiveReadHelp;


   VAR

      DummyChar  : char;


BEGIN {GiveReadHelp}

ClrScr;
Gotoxy(1, Offset);
writeln('If your data are in a disk file, clicking on READ DATA');
writeln('will bring up a file selector dialog box.  By default,');
writeln('the program looks in the current subdirectory for files');
writeln('with the extender .DAT, but you may edit the file and');
writeln('path name as usual.');
writeln;
writeln('Data files must be ASCII text files with one (real or integer)');
writeln('number per line, terminated by a carriage return.');
writeln;
writeln('Reading a file disables ENTER DATA, but you may modify the');
writeln('data set by selecting EDIT DATA.');
Gotoxy(1, 23);
TextColor( ShowRed );
write('Press ');
InverseVideo;
write(' Return ');
NormVideo;
write(' to continue...');
readln( dummychar );
TextColor( ShowBlack )

END; {GiveReadHelp}



procedure
GiveEditHelp;

   VAR

      DummyChar : Char;

BEGIN {GiveEditHelp}

ClrScr;
Gotoxy(1, Offset);
writeln('When you select EDIT DATA, your data will be displayed one');
writeln('page at a time.  After each page has been displayed, an alert');
writeln('box will appear, giving you the choice to EDIT that page or');
writeln('GO ON to the next page.  If you select EDIT, you will have');
writeln('the opportunity to CHANGE or DELETE any datum on that page,');
writeln('including the "wrapped" datum from the last page.');
writeln;
writeln('When the last page has been displayed, you will be asked');
writeln('whether you are DONE editing, or whether you wish to ADD more');
writeln('data. If you select ADD, you can then return to ENTER DATA');
writeln('mode, starting at the end of the data you have previously');
writeln('entered or read from a disk file.');
Gotoxy(1, 23);
TextColor( ShowRed );
write('Press ');
InverseVideo;
write(' Return ');
NormVideo;
write(' to continue...');
readln( dummychar );
TextColor( ShowBlack )

END; {GiveEditHelp}



procedure
GiveGraphHelp;

   VAR

      DummyChar  : char;


BEGIN {GiveGraphHelp}

ClrScr;
Gotoxy(1, Offset);
writeln('The GRAPH, which you may SHOW and then PRINT, is a frequency');
writeln('distribution, showing the number of data points in each of');
writeln('ten evenly spaced intervals.  This option is enabled after');
writeln('you have clicked on CALCULATE.');
writeln;
writeln('The value just level with the "Frequency" axis is the lowest');
writeln('value in your data set.  The value at the top of the "Value"');
writeln('axis is the highest value in the set.  The numbers in between');
writeln('(including the high value) are upper bounds of the intervals.');
writeln('Each green "X" along the frequency axis to the right of a value');
writeln('represents one datum which is less than or equal to that value, and');
writeln('greater than the next lower value on the "Value" axis.');
writeln;
writeln('A maximum of 50 data points in any interval will be represented');
writeln('by green X''s; if the frequency exceeds 50, the actual number');
writeln('of data points will appear in red to the right of the X''s.');
Gotoxy(1, 23);
TextColor( ShowRed );
write('Press ');
InverseVideo;
write(' Return ');
NormVideo;
write(' to continue...');
readln( dummychar );
TextColor( ShowBlack )

END; {GiveGraphHelp}



procedure
Help_Proc;


TYPE

   Screen = PACKED ARRAY [ 1..32000 ] of BYTE;
   S_Ptr = ^Screen;     { pointer to screen data }


VAR

   Scn_buf : Screen;    { a place to stash the screen }
   Scn_ptr : S_Ptr;     { a pointer to screen }


FUNCTION Physbase : S_Ptr;    { xbios routine returns address of screen }
  Xbios( 2 );


PROCEDURE Sav_scn;              { proc saves screen to buf }
{$P-}           { turn pointer checking off }

   begin
      Scn_ptr := Physbase;      { get addr of screen in memory }
      Scn_buf := Scn_Ptr^;      { do assignment, copy entire array }
   end;

{$P=}           { restore pointer checking to old state }


PROCEDURE Rest_scn;             { restore screen from buf }
{$P-}           { turn pointer checking off }

   begin
      Scn_ptr := Physbase;      { get addr of screen in memory }
      Scn_ptr^ := Scn_buf;      { assign, copy array }
   end;

{$P=}           { set pointer checking to old state }



BEGIN {HELP_PROC}

Hide_mouse;
Sav_scn;
If msg[4] = Instructions then
   GiveInstructions
Else If msg[4] = HelpEnter then
   GiveEnterHelp
Else If msg[4] = HelpRead then
   GiveReadHelp
Else If msg[4] = HelpEdit then
   GiveEditHelp
Else If msg[4] = HelpGraph then
   GiveGraphHelp;
Rest_scn;
Menu_normal( The_menu, Help);
Show_mouse

END; {HELP_PROC}



procedure
Menu_Proc;

BEGIN {MENU_PROC}

if msg[3] = Help then
   HELP_PROC
else if msg[3] = Option then
   OPTION_PROC
else if msg[3] = Desk_title then
   begin
      SHOW_PROGNAME;
      Menu_normal( The_menu, Desk_title)
   end; {else}

END; {MENU_PROC}



procedure
Msg_Proc;

BEGIN {MSG_PROC}

if ( msg[0] = MN_Selected ) then
   MENU_PROC

END; {MSG_PROC}



procedure
Event_Proc;

BEGIN {EVENT_PROC}

event := GET_EVENT( event_mask,
                       0,0,0,
                       0,
                       false,0,0,0,0,
                       false,0,0,0,0,
                       msg,
                       what_key,
                       dummy,dummy,
                       dummy,dummy,
                       dummy
                       );

if ( event & E_Message ) <> 0 then
   MSG_PROC;

END; {EVENT_PROC}



procedure
TitlePage;

{$P-} { turn pointer checking off.. }

{

        Procedure to save and restore the ST display to/from degas files.

        12/9/86 MJC

        Copyright 1986 By OSS, Inc.  All Rights Reserved.

}

CONST
        Mono = 2;               { monochrome screen resolution }

TYPE

        { The ST screen is 32000 bytes of data, soooo.... }
        Screen = packed array [ 0..31999 ] of BYTE;

        Ptr_screen = ^Screen;   { pointer to the screen array }

        Palette = Packed Array [ 0..15 ] of Integer;

        Resolution = Integer;

        Degas_scrn = PACKED RECORD
              Res : Resolution;
              Pal : Palette;
              Pic : Screen;
           End;

VAR

        S_ptr : Ptr_screen;     { a pointer to a packed array of bytes... }
        SavScrn : Screen;       { a place to save the current screen }
        File_nam : String;      { Temp file name..                      }

{ **********************************************************************

        declare routine to get address of screen

  *********************************************************************** }

{ physbase returns a pointer to the start of the ST's screen.  }

FUNCTION Physbase : Ptr_screen;
   XBIOS( 2 );

FUNCTION Getrez : Resolution;
   XBIOS( 4 );

PROCEDURE Setscreen( Logadr, Physadr : Long_Integer; Res : Resolution );
   XBIOS( 5 );

PROCEDURE Setpalette( VAR Pal : Palette );
   XBIOS( 6 );

FUNCTION Setcolor( N , Color : Integer ) : Integer;
   XBIOS( 7 );




{ ***************************************************************************

        Restore screen data from degas file.

  *************************************************************************  }

PROCEDURE SRestore( name : STRING );

VAR
   i : Integer;
   f : file of Degas_scrn;     { a file containing a screenful of bytes.. }
   Rez : Resolution;
   Oldpal : Palette;

   BEGIN

        Rez := Getrez;
        S_ptr := Physbase;              { grab location of screen... }

        reset( f, name );               { bind f to file name }

        { reset automatically fills file buffer with data from first record }

        { decide if resolution can be changed...                }
        IF ( ( f^.Res < Mono ) AND ( Rez < Mono ) ) THEN
              Setscreen( -1, -1, f^.Res );

        { now check for picture compatability...                }

        IF ( ( f^.Res = Mono ) AND ( Rez = Mono )
          OR
           ( Rez < Mono ) AND ( f^.Res < Mono ) ) THEN
           Begin
              For i:= 0 TO 15 DO              { save palette          }
                 Oldpal[ i ] := Setcolor( i, -1 );

              Setpalette( f^.Pal );           { use degas palette     }

              SavScrn := S_ptr^;              { save current screen       }
              S_ptr^ := f^.Pic;               { stuff picture into screen }
(*
              S_Ptr^ := SavScrn;              { restore old screen            }
              Setpalette( Oldpal );           { restore old palette           }
              Setscreen( -1, -1, Rez )        { restore old resolution        }

*)
           End;
        { file is automatically closed when we leave this procedure. }
   END;


{ *********************************************************************

        miscellaneous subroutines...

*********************************************************************** }




{ clear screen procedure }

PROCEDURE cls;

   BEGIN

        write( chr( 27 ) );
        write( 'E' );

   END;





{ ************************************************************************

        Main routine starts here.  Just execute routines in sequence...

  ************************************************************************ }


BEGIN



        File_nam := 'Title.pi2';
        cls;                    { clear screen... }
        SRestore( File_nam ); { read screen data from file... }


END; {TITLEPAGE}






BEGIN {STATS}

If (Init_Gem  >= 0) then
   begin
      resolution := GetRez;
      If resolution = 0 then
         begin
            write( chr(bell) );
            dummy := Do_Alert(

'[3][STATS does not|run in low resolution][ OK ]',1)

          end {If}
      Else
         begin
            N := 0;
            Init_Mouse;
            Hide_Mouse;
            TitlePage;
            Show_Mouse;
            Show_ProgName;
            Ask_DS_Name;
            Clear_Screen;
            Build_Menu;
            Initialize;
            Erase_Page;

            repeat
               Event_Proc
            until Done

         end; {Else}
      Exit_Proc
   end; {if}
Init_mouse

END. {STATS}