Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/JTTLIB.ZIP/JTTLIB.PAS

Pascal/Delphi Source File | 1987-02-06 | 22.2 KB | 943 lines

{Jttlib.Pas}
{$V-}

(* The following types and vars must be declared global to the entire program
   in order for the functions and procedures in JTTLIB to be usable :
*)
Const

Ref_Date = '01/01/80,2';  {Basis for Date math functions; 2 = Wednesday}

Type

Str2 = String[2];
Str6 = String[6];
Str8 = String[8];
Str10 = String[10];
Str12 = String[12];
Str15 = String[15];
Str25 = String[25];
Str80 = String[80];

Regpack = Record
  Ax,Bx,Cx,Dx,Bp,Di,Si,Ds,Es,Flags: Integer;
End;

Var

Problem : Boolean;
Vol : Str2;
Err : Integer;

(* This is the end of the necessary declarations  *)

{ ***** Miscellaneous/Utility *****}

Procedure Clrpos(First,Last : Byte);
{
Clears part of the screen from line First to line Last
}
Var L : Integer;

Begin
  For L := First to Last Do
    Begin
      Gotoxy(1,L);
      Clreol;
    End;
  Gotoxy(1,First);
End;

Procedure Uc(Var St : Str80);
{
Upcases a string up to 80 characters long
}
Var I : Integer;

Begin
  For I := 1 to Length(St) do St[I] := Upcase(St[I]);
End;

Function Exist(F : Str25) : Boolean;
{
Determines if a file exists
}
Var Fil : File;

Begin
  Exist := True;
  Assign(Fil,F);
{$I-}
  Reset(Fil);
{$I+}
  Exist := (Ioresult = 0);
  Close(Fil);
End;

{***** Messages & Prompts *****}

Procedure Pause;
{
Causes the program to wait for a key to be pressed
}
Var Ch : Char;

Begin
  Gotoxy(1,25);
  Reset(Kbd);
  Clreol;
  Write('Press any key to continue.');
  Read(Kbd,Ch);
  Gotoxy(1,25);
  Clreol;
End;

Procedure Say(Yy : Byte; St : Str80);
{
Prints a message on line Yy for 1 second
}

Begin
  Gotoxy(1,Yy);
  Clreol;
  Write(St);
  Delay(1000);
  Gotoxy(1,Yy);
  Clreol;
End;

Procedure Error(St : Str80);
{
Prints an error message at the bottom of the screen, sets a flag, and beeps
}
Begin
  Gotoxy(1,24);
  Clreol;
  Write(St,Chr(7));
  Pause;
  Gotoxy(1,24);
  Clreol;
  Problem := True;
End;

Function Verify(What : Str25) : Boolean;
{
Used to verify the accuracy of inout; as in Repeat..Until Verify constructs
}
Var An : Char;
    Xplace, Yplace : Byte;

Begin
  Xplace := Wherex;
  Yplace := Wherey;
  Gotoxy(1,25);
  Reset(Kbd);
  Clreol;
  Write('Is this ',What,' correct? ');
    Repeat
      Read(Kbd,An)
    Until An in ['Y','N','y','n'];
  Gotoxy(1,25);
  Clreol;
  Gotoxy(Xplace,Yplace);
  Verify := An in ['Y','y'];
End;

Function Ask(Yy : Byte; St : Str80) : Char;
{
Returns a Char answer to a prompt asked on line Yy
}
Var Ch : Char;

Begin
  Gotoxy(1,Yy);
  Reset(Kbd);
  Clreol;
  Write(St);
  Read(Kbd,Ch);
  Gotoxy(1,Yy);
  Clreol;
  Ask := Ch;
End;

{***** Edit Checked Input *****}

Procedure Get_Vol(Var Drive : Str2);
{
Gets drive letter to be concated onto filenames
}
Var Ch : Char;

Begin
  Gotoxy(1,3);
  Clreol;
  Reset(Kbd);
  Write('Input letter of data disk (A,B, Or C) : ');
  Repeat
    Read(Kbd,Ch);
    Ch := Upcase(Ch);
  Until Ch in ['A','B','C'];
  Drive := Concat(Ch,':');
  Gotoxy(1,3);
  Clreol;
End;

Function Get_Real : Real;
{
Inputs a real number at the current cursor location
}
Var Inst : Str25;
    Result : Real;
    Xhold, Yhold : Byte;

Begin
  Xhold := Wherex;
  Yhold := Wherey;
  Repeat
    Inst := '0';
    Gotoxy(Xhold,Yhold);
    Clreol;
    Readln(Inst);
    If (Inst[1] = '.') then Inst := Concat('0',Inst);
    Val(Inst,Result,Err);
  Until (Err = 0);
  Get_Real := Result;
End;

Function Get_Integer : Integer;
{
Inputs an integer at the current cursor location
}
Var Inst : Str25;
    Result : Integer;
    Xhold, Yhold : Byte;

Begin
  Xhold := Wherex;
  Yhold := Wherey;
  Repeat
    Inst := '0';
    Gotoxy(Xhold,Yhold);
    Clreol;
    Readln(Inst);
    Val(Inst,Result,Err);
  Until (Err = 0);
  Get_Integer := Result;
End;

Function Get_String(Show : Boolean; L : Byte) : Str80;
{
Inputs a string of length L at the current cursor location, optionally
non-printing
}
Var Inst : Str80;
    Cha : Char;
    C1, Xplace, Yplace : Byte;

Begin
  If (L > 0) Then
    Begin
      Xplace := Wherex;
      Yplace := Wherey;
      For C1 := 1 to L do Write('_');
      Gotoxy(Xplace,Yplace);
    End;
  Reset(Kbd);
  Inst := '';
  Repeat
    Read(Kbd,Cha);
    If Show and (Ord(Cha) in [8,32..127]) then Write(Cha);
    If Ord(Cha) in [32..126] Then
    Inst := Concat(Inst,Cha)
    else If Ord(Cha) = 8 then If (Length(Inst) > 0) Then
      Begin
        If Show then Write(' ',Chr(8));
        Inst := Copy(Inst,1,(Length(Inst)-1));
      End;
  Until (Ord(Cha) in [9,10,12,13,26]);
  If L <> 0 then Inst := Copy(Inst,1,L);
  Get_String := Inst;
End;

Function Read_String(L : Byte) : Str80;
{
Inputs a string of length L at the current cursor location
}
Var Inst : Str80;
    C1, Xplace, Yplace : Byte;

{$C-}
Begin
  If (L > 0) Then
    Begin
      Xplace := Wherex;
      Yplace := Wherey;
      For C1 := 1 to L do Write('_');
      Gotoxy(Xplace,Yplace);
    End;
  Reset(Kbd);
  Readln(Inst);
  If L <> 0 then Inst := Copy(Inst,1,L);
  Read_String := Inst;
{$C+}
End;

Function Check_String(Inst, Template : Str80; Len : Byte) : Boolean;
{
Compares a string to a template for edit checking as follows:
   Template character       Acceptable character(S) in string
           A                          Any character
           L                      Alphabetic characters
           N            Digit characters excluding '.' '+' and '-'
                  (Use Get_Real or Get_Integer for numeric edit checking)
           D         Delimiter characters '.' '/' ',' '\' '-' and ' '
         Other                       That character

Note that length checking is disabled if (Len = 0)
}
Var P, Size : Byte;
    Ok : Boolean;

Begin
  Ok := True;
  If Len <> 0 then Ok := (Length(Inst) = Length(Template));
  Size := Length(Inst);
  If (Length(Template) < Size) then Size := Length(Template);
  If Ok then For P := 1 to Size Do
  If Template[P] in ['A','L','N','D'] Then
    Begin
        Case Template[P] Of
         'L' : If Ok then Ok := Inst[P] in ['A'..'Z','a'..'z'];
         'N' : If Ok then Ok := Inst[P] in ['0'..'9'];
         'D' : If Ok then Ok := Inst[P] in ['.','/',',','\','-',' '];
        End;
    End
  else If Ok then Ok := (Inst[P] = Template[P]);
  Check_String := Ok;
End;

Function Get_Filename(Present : Boolean; Ext : Str6) : Str25;
{
Returns an acceptable filename.  Present indicates whether it must already
exist or be a new file; Ext is an optional extension that will be added if
it has length > 0.
}
Var Ch : Char;
    St : Str25;
    There : Boolean;
    Xhold, Yhold : Byte;
    L : Byte;
    Ok : Boolean;

Begin
  Xhold := Wherex;
  Yhold := Wherey;
  Repeat
    Ok := True;
    Gotoxy(Xhold,Yhold);
    Clreol;
    St := Get_String(True,25);
    If (Length(Ext) >= 1) then If (Pos('.',St) = 0) then St := Concat(St,Ext);
    Uc(St);
    For L := 1 to Length(St) Do
    If not (St[L] in ['A'..'Z','a'..'z','.',':','\','0'..'9']) then Ok := False;
    If (St[1] in ['0'..'9','.']) then Ok := False;
    If Ok Then
      Begin
        There := Exist(St);
        If There <> Present Then
          Begin
            Gotoxy(1,Yhold+2);
            Clreol;
            Write(Chr(7));
            If There Then
              Begin
                Write('File exists already.  Overwrite (Y/N) ? ');
                Repeat
                  Read(Kbd,Ch);
                  Ch := Upcase(Ch);
                Until Ch in ['Y','N'];
                If Ch = 'Y' then There := Present;
              End
            else Write('File not found');
            Delay(1000);
            Gotoxy(1,Yhold+2);
            Clreol;
          End;
      End
    else
      Begin
        Gotoxy(1,Yhold+2);
        Clreol;
        There := not Present;
        Write(Chr(7),'Invalid file name');
        Delay(1000);
        Gotoxy(1,Yhold+2);
        Clreol;
      End;
  Until There = Present;
  Get_Filename := St;
End;

{***** Time & Date *****}

Function Date: Str10;
{
DOS call that returns system date
}
Var Recpack : Regpack;
    Month, Day : Str2;
    Year : String[4];
    Dx,Cx : Integer;

Begin
  With Recpack Do
    Begin
      Ax := $2a Shl 8;
    End;
  Msdos(Recpack);
  With Recpack Do
    Begin
      Str(Cx,Year);
      Str(Dx Mod 256,Day);
      Str(Dx Shr 8,Month);
    End;
  Year := Copy(Year,3,2);
  If Length(Month) = 1 then Month := Concat('0',Month);
  If Length(Day) = 1 then Day := Concat('0',Day);
  Date := Month+'/'+Day+'/'+Year;
End;

Procedure Read_Date(Var Dt : Str8);
{
Reads in a date in correct date format (mm/dd/yy) at the cursor location
}
Var Ch : Char;
    I : Integer;
    Ok : Boolean;
    Sep, Xhold, Yhold : Byte;

Begin
  Xhold := Wherex;
  Yhold := Wherey;
  Repeat
    Dt := Date;
    I := 0;
    Sep := 0;
    Gotoxy(Xhold,Yhold);
    Lowvideo;
    Write(Dt);
    Normvideo;
    Gotoxy(Xhold,Yhold);
    Repeat
      I := I + 1;
      Ok := False;
      While not Ok Do
        Begin
          Sep := (I-1) Div 2;
          Gotoxy(Xhold+I+Sep - 1,Yhold);
          Read(Kbd,Ch);
          Write(Ch);
          If (Ord(Ch) in [8,13,32]) Then
            Begin
                Case Ord(Ch) Of
                 32 : If (I < 7) Then
                        Begin
                          Ch := Dt[I+Sep];
                          I := I + 1;
                          Write(Chr(8),Ch);
                        End;
                  8 : If (I > 1) then I := I - 1;
                 13 : Begin
                        I := 7;
                        Sep := 2;
                        Ch := Dt[8];
                      End;
                End;
              If (I > 6) then Ok := True;
            End
          else
            Begin
              Case I Of
                5 : Ok := Ch in ['0'..'9'];
                6 : Ok := Ch in ['0'..'9'];
                1 : Ok := Ch in ['0','1'];
                2 : If Dt[1] = '0' then Ok := Ch in ['1'..'9']
                    else Ok := Ch in ['0','1','2'];
                3 : Ok := Ch in ['0','1','2','3'];
                4 : If Dt[4] in ['0'..'2'] then Ok := Ch in ['0'..'9']
                    else Ok := Ch in ['0','1'];
              End;  {case}
            End;
        End;
      If Ok then Dt[I+Sep] := Ch;
    Until (I >= 6);
  Until Verify('Date');
End;

Function Last_Day(Mon : Integer; Year : Integer) : Integer;
{
Determines the last day of a month
}
Var Dys, Err : Integer;
    Leap : Boolean;

Begin
  Dys := 30;
  Leap := ((Year/4) = (Year Div 4));
    Case Mon Of
      1,3,5,7,8,10,12 : Dys := 31;
      4,6,9,11 : Dys := 30;
      2 : If Leap then Dys := 29
          else Dys := 28;
    End;
  Last_Day := Dys;
End;

Function Date_Of(Julian : Integer) : Str8;
{
Date from the Julian date counted from the constant REF_DATE
}
Var Yr, Mo, Dy : Integer;
    Ystr, Mstr, Dstr : Str2;
    Datestr : Str8;

Begin
  Val(Copy(Ref_Date,7,2),Yr,Err);
  If (Julian > 366) Then
    Begin
      Repeat
        Julian := Julian - 365;
        If ((Yr Mod 4) = 0) then Julian := Julian - 1;
        Yr := Yr + 1;
      Until (Julian < 367);
    End;
  If (Julian = 366) then If ((Yr Mod 4) <> 0) Then
    Begin
      Julian := 1;
      Yr := Yr + 1;
    End;
  If ((Yr Mod 4) <> 0) Then
    Begin
        Case Julian Of
        1..31    : Begin
                     Mo := 1;
                     Dy := Julian;
                   End;
        32..59   : Begin
                     Mo := 2;
                     Dy := Julian - 31;
                   End;
        60..90   : Begin
                     Mo := 3;
                     Dy := Julian - 59;
                   End;
        91..120  : Begin
                     Mo := 4;
                     Dy := Julian - 90;
                   End;
        121..151 : Begin
                     Mo := 5;
                     Dy := Julian - 120;
                   End;
        152..181 : Begin
                     Mo := 6;
                     Dy := Julian - 151;
                   End;
        182..212 : Begin
                     Mo := 7;
                     Dy := Julian - 181;
                   End;
        213..243 : Begin
                     Mo := 8;
                     Dy := Julian - 212;
                   End;
        244..273 : Begin
                     Mo := 9;
                     Dy := Julian - 243;
                   End;
        274..304 : Begin
                     Mo := 10;
                     Dy := Julian - 273;
                   End;
        305..334 : Begin
                     Mo := 11;
                     Dy := Julian - 304;
                   End;
        335..365 : Begin
                     Mo := 12;
                     Dy := Julian - 334;
                   End;
        End;
    End
  else
    Begin
        Case Julian Of
        1..31    : Begin
                     Mo := 1;
                     Dy := Julian;
                   End;
        32..60   : Begin
                     Mo := 2;
                     Dy := Julian - 31;
                   End;
        61..91   : Begin
                     Mo := 3;
                     Dy := Julian - 60;
                   End;
        92..121  : Begin
                     Mo := 4;
                     Dy := Julian - 91;
                   End;
        122..152 : Begin
                     Mo := 5;
                     Dy := Julian - 121;
                   End;
        153..182 : Begin
                     Mo := 6;
                     Dy := Julian - 152;
                   End;
        183..213 : Begin
                     Mo := 7;
                     Dy := Julian - 182;
                   End;
        214..244 : Begin
                     Mo := 8;
                     Dy := Julian - 213;
                   End;
        245..274 : Begin
                     Mo := 9;
                     Dy := Julian - 244;
                   End;
        275..305 : Begin
                     Mo := 10;
                     Dy := Julian - 274;
                   End;
        306..335 : Begin
                     Mo := 11;
                     Dy := Julian - 305;
                   End;
        336..366 : Begin
                     Mo := 12;
                     Dy := Julian - 335;
                   End;
        End;
    End;
  Str(Yr,Ystr);
  Str(Mo,Mstr);
  Str(Dy,Dstr);
  If (Length(Ystr) = 1) then Ystr := '0' + Ystr;
  If (Length(Mstr) = 1) then Mstr := '0' + Mstr;
  If (Length(Dstr) = 1) then Dstr := '0' + Dstr;
  Datestr := Mstr + '/'+ Dstr + '/' + Ystr;
  Date_Of := Datestr;
End;

Function Num_Days(Dte : Str8) : Integer;
{
Number of days since Ref_Date
}
Var Yr, Mo, Dy : Integer;
    Yr1, Mo1, Dy1 : Integer;
    Difference : Integer;
    I : Integer;

Begin
  Difference := 0;
  If (Dte <> Copy(Ref_Date,1,8)) Then
    Begin
      Val(Copy(Dte,1,2),Mo,Err);
      Val(Copy(Dte,4,2),Dy,Err);
      Val(Copy(Dte,7,2),Yr,Err);
      Val(Copy(Ref_Date,1,2),Mo1,Err);
      Val(Copy(Ref_Date,4,2),Dy1,Err);
      Val(Copy(Ref_Date,7,2),Yr1,Err);
      If (Yr1 < Yr) Then
       For I := Yr1 to (Yr-1) Do
       If ((I/4) = (I Div 4)) Then
        Difference := Difference + 1;
      Difference := Difference + ((Yr - Yr1) * 365) + Dy - Dy1;
      If Mo > Mo1 Then
        Begin
          For I := Mo1 to (Mo-1) Do
          Difference := Difference + Last_Day(I,Yr);
        End;
    End;
  Num_Days := Difference + 1;
End;

Function Month_Name(Mon : Byte) : Str12;
{
Returns a string for the month from the ordinal month
}

Begin
  Month_Name := 'na';
    Case Mon Of
      1 : Month_Name := 'January';
      2 : Month_Name := 'February';
      3 : Month_Name := 'March';
      4 : Month_Name := 'April';
      5 : Month_Name := 'May';
      6 : Month_Name := 'June';
      7 : Month_Name := 'July';
      8 : Month_Name := 'August';
      9 : Month_Name := 'September';
      10 : Month_Name := 'October';
      11 : Month_Name := 'November';
      12 : Month_Name := 'December';
    End;
End;

Function Day_Name(Etad : Str8) : Str12;
{
Returns a string for the name of the day portion of Etad
}
Var Num, Dae, Plus : Integer;
Sub : Str2;

Begin
  Num := Num_Days(Etad) - 1;
  Sub := Copy(Ref_Date,Pos(',',Ref_Date)+1,1);
  Val(Sub,Plus,Err);
  Dae := (Num+Plus) Mod 7;
  If not (Dae in [0..6]) then Error('Day out of range')
  else
    Case Dae Of
      0 : Day_Name := 'Sunday';
      1 : Day_Name := 'Monday';
      2 : Day_Name := 'Tuesday';
      3 : Day_Name := 'Wednesday';
      4 : Day_Name := 'Thursday';
      5 : Day_Name := 'Friday';
      6 : Day_Name := 'Saturday';
    End;
End;

Procedure Add_Day_To(Var Dt : Str8);
{
Increments a string date by 1.  This could also be accomplished by converting
to Julian, adding 1, then converting back to a string
}
Var Yr, Mo, Dy, Max : Integer;
    Ystr, Mstr, Dstr : Str2;

Begin
  Val(Copy(Dt,1,2),Mo,Err);
  Val(Copy(Dt,4,2),Dy,Err);
  Val(Copy(Dt,7,2),Yr,Err);
  Max := Last_Day(Mo,Yr);
  Dy := Dy + 1;
  If (Dy > Max) Then
    Begin
      Dy := 1;
      Mo := Mo + 1;
      If (Mo > 12) Then
        Begin
          Mo := 1;
          Yr := Yr + 1;
          If (Yr > 100) then Yr := 0;
        End;
    End;
  Str(Mo,Mstr);
  Str(Dy,Dstr);
  Str(Yr,Ystr);
  If (Length(Mstr) = 1) then Mstr := '0' + Mstr;
  If (Length(Dstr) = 1) then Dstr := '0' + Dstr;
  If (Length(Ystr) = 1) then Ystr := '0' + Ystr;
  Dt := Mstr + '/' + Dstr + '/' + Ystr;
End;

Function Get_Month(Dt : Str8) : Integer;
{
Extracts the month from a date in mm/dd/yy format
}
Var Month_Int, Err : Integer;
    Month_Str : Str2;

Begin
  Month_Str := Copy(Dt,1,2);
  Val(Month_Str,Month_Int,Err);
  If (Err <> 0) then Month_Int := 13;
  Get_Month := Month_Int;
End;

Function Time : Str8;
{
DOS call that returns system time
}
Var Recpack : Regpack;
    Ah,Al,Ch,Cl,Dh : Byte;
    Hour,Min,Sec : Str2;

Begin
  Ah := $2c;
  With Recpack Do
    Begin
      Ax := Ah Shl 8 + Al;
    End;
  Intr($21,Recpack);
  With Recpack Do
    Begin
      Str(Cx Shr 8,Hour);
      Str(Cx Mod 256,Min);
      Str(Dx Shr 8,Sec);
    End;
  If (Length(Hour) = 1) then Hour := '0' + Hour;
  If (Length(Min) = 1) then Min := '0' + Min;
  If (Length(Sec) = 1) then Sec := '0' + Sec;
  Time := Hour+':'+Min+':'+Sec;
End;

Procedure Read_Time(Var Hr : Str8);
{
Reads in a time in correct time format (hh:mm) at current cursor location
}
Var Ch : Char;
    I : Integer;
    Ok : Boolean;
    Sep, Xhold, Yhold : Byte;

Begin
  Xhold := Wherex;
  Yhold := Wherey;
  Repeat
    Hr := Copy(Time,1,5);
    I := 0;
    Sep := 0;
    Gotoxy(Xhold,Yhold);
    Lowvideo;
    Write(Hr);
    Normvideo;
    Gotoxy(Xhold,Yhold);
    Repeat
      I := I + 1;
      Ok := False;
      While not Ok Do
        Begin
            Case I Of
            1,2 : Sep := 0;
            3,4 : Sep := 1;
            5,6 : Sep := 2;
            End;
          Gotoxy(Xhold+I+Sep - 1,Yhold);
          Read(Kbd,Ch);
          Write(Ch);
          If (Ord(Ch) = 8) and (I > 1) then I := I - 1
          else
            Begin
              Case I Of
                1 : Ok := Ch in ['0'..'2'];
                2 : If Hr[1] in ['0','1'] then Ok := Ch in ['0'..'9']
                    else Ok := Ch in ['0'..'3'];
                3 : Ok := Ch in ['0'..'5'];
                4 : Ok := Ch in ['0'..'9'];
                5 : Ok := Ch in ['0'..'5'];
                6 : Ok := Ch in ['0'..'9'];
              End;  {case}
            End;
        End;
      Hr[I+Sep] := Ch;
    Until (I >= 4);
  Until Verify('time');
End;

{***** String Handling *****}

Function Ljust(St : Str80; W : Byte) : Str80;
{
Returns a string left-justified in a given field width
}
Var S, L : Integer;

Begin
  L := Length(St);
  If (L < W) then For S := L to (W-1) do St := Concat(St,' ');
  Ljust := St;
End;

Function Cjust(St : Str80; W : Byte) : Str80;
{
Returns a string center-justified in a given field width
}
Var S, L, Half : Integer;

Begin
  L := Length(St);
  If (L < W) Then
    Begin
      Half := (W-L) Div 2;
      For S := L to (L + Half) do St := Concat(St,' ');
    End;
  Cjust := St;
End;

Function Rjust(St : Str80; W : Byte) : Str80;
{
Returns a string right-justified in a given field width
}
Var S, L : Integer;

Begin
  L := Length(St);
  If (L < W) then For S := L to (W-1) do St := Concat(' ',St);
  Rjust := St;
End;

Function Plural(Singular : Str25) : Str80;
{
Returns the correct plural of most strings up to 25 characters long
}
Var Last : Byte;
    St : Str80;

Begin
  Last := Length(Singular);
  If Singular[Last] in ['F','H','N','S','Y','Z','f','h','n','s','y','z'] Then
    Case Singular[Last] Of
     'F' : St := Concat(Copy(Singular,1,(Last-1)),'VES');
     'f' : St := Concat(Copy(Singular,1,(Last-1)),'ves');
     'S','Z' : St := Concat(Singular,'ES');
     's','z' : St := Concat(Singular,'es');
     'H' : If (Singular[Last-1] in ['C','S','c','s']) Then
           St := Concat(Singular,'ES')
           else St := Concat(Singular,'S');
     'h' : If (Singular[Last-1] in ['C','S','c','s']) Then
           St := Concat(Singular,'es')
           else St := Concat(Singular,'s');
     'N' : If (Singular[Last-1] in ['A','a']) Then
           St := Concat(Copy(Singular,1,Last-2),'EN')
           else St := Concat(Singular,'S');
     'n' : If (Singular[Last-1] in ['A','a']) Then
           St := Concat(Copy(Singular,1,Last-2),'en')
           else St := Concat(Singular,'s');
     'Y' : If not (Singular[Last-1] in ['A','E','I','O','U']) Then
           St := Concat(Copy(Singular,1,Last-1),'IES')
           else St := Concat(Singular,'S');
     'y' : If not (Singular[Last-1] in ['a','e','i','o','u']) Then
           St := Concat(Copy(Singular,1,Last-1),'ies')
           else St := Concat(Singular,'s');
    End
  else
  If Singular[Last] <> Upcase(Singular[Last]) Then
  St := Concat(Singular,'s')
  else St := Concat(Singular,'S');
  Plural := St;
End;

{***** Math *****}

Function Raise(X, Y : Real) : Real;
{
Raises a non-negative real to a power
}
Var A : Real;

Begin
  If (X > 0) then A := Ln(X) else A := 0;
  A := A * Abs(Y);
  A := Exp(A);
  If (Y < 0) then A := 1 / A;
  Raise := A;
End;