Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TIMEXX.ZIP/TIMEXX.PAS

Pascal/Delphi Source File | 1985-08-24 | 6.1 KB | 197 lines

{TIME/DATE IN ENGLISH -- an exercise... thanks to
T.U.G., Bela Lubkin, the author of qt, especially, Skip Gilbrech, others.
Please forward comments/ suggestions to J. Levine at 718 238 7855
or leave on Compuserve 70210,1027.  Thanks}

type
    REGPACK = record          {establish record for registers}
        case integer of
            1: (Ax,Bx,Cx,Dx,Bp,Di,Si,Ds,Es,Flags : integer);
            2: (Al,Ah,Bl,Bh,Cl,Ch,Dl,Dh : byte);
    end;

    STRING1 = string[1];        {set up strings for varying lengths}
    STRING2 = string[2];
    STRING3 = string[3];
    STRING4 = string[4];
    STRING5 = string[5];
    STRING6 = string[6];
    STRING7 = string[7];
    STRING8 = string[8];
    STRING9 = string[9];
    STRING10 = string[10];
    STRING11 = string[11];
    STRING12 = string[12];
    STRING13 = string[13];
    STRING14 = string[14];
    STRING15 = string[15];
    STRING16 = string[16];
    STRING17 = string[17];
    STRING18 = string[18];
    STRING19 = string[19];
    STRING20 = string[20];

var
   rg : regpack;              {variable to be used within procedures}

{------------------------------------------------------------------------}
{ Fill passed variables with current date from DOS }

procedure GetDate ( var Yr : integer; var Mn, Dt, Dy : byte );
                      {Yr, Mn, Dt, Dy will be passed values from registers}


     begin
          With rg do            {using the registers}
               begin
                    Ah := $2A;      { set AH and perform DOS interrupt }
                    Intr( $21, Rg );
                    Yr := Cx;       { set passed variables to register values }
                    Mn := Dh - 1;   { change 1-12 to 0-11 }
                    Dt := Dl;
                    Dy := Al;
              end;
    end;
{------------------------------------------------------------------------}
{ Fill passed variables with current time from DOS }

procedure GetTime ( var Hr, Min, Sec, Hsec : byte );


    begin
         with rg do
             begin
                  Ah := $2C;           { set AH and perform DOS interrupt }
                  Intr( $21, Rg );

                  Hr := Ch;         { set passed variables to register values }
                  Min := Cl;
                  Sec := Dh;
                  Hsec := Dl;
             end;
   end;
{------------------------------------------------------------------------}
{ Return an ascii string representing minutes past the hour }

function GetMin (Min : byte) : STRING17;

    const
        MinName1 : array [1..19] of STRING10 =
        (
            'one ','two ','three ','four ','five ','six ','seven ','eight ',
            'nine ','ten ','eleven ','twelve ','thirteen ','fourteen ',
            'fifteen ','sixteen ','seventeen ', 'eighteen ','nineteen '
        );

        MinName2 : array[2..5] of STRING6 =
        (
            'twenty','thirty','forty','fifty'
        );

    var
        MinTens, MinOnes : integer;     { local variables for 'tens' & 'ones' }
        RetString : STRING17;           { local work string }

    begin
        if Min < 20 then          { use only numbers from 'one' to 'nineteen' }
            RetString := MinName1 [ Min ]
        else
            begin                { first get tens, then add ones string }

                MinTens := Min div 10; { use integer division to get 'tens' }
                MinOnes := Min mod 10; { get remainder to use as 'ones' }

                RetString := MinName2 [ MinTens ];  { get 'tens' string }

                if MinOnes <> 0 then   { concatenate 'ones'
                                       string if appropriate }
                    begin
                        RetString := RetString + '-';
                        RetString := RetString + MinName1 [ MinOnes ];
                    end
                else
                    RetString := RetString + ' ';
            end;

        Getmin := RetString;    { return the completed string }

    end;

{------------------------------------------------------------------------}
{ Return an ascii string representing the hour in 12-hour format }

function GetHr (Hr : byte) : STRING7;

    const
        HourName : array [0..11] of STRING7 =
        (
            'twelve ','one ','two ','three ','four ','five ',
            'six ','seven ','eight ','nine ','ten ','eleven '
        );

    begin
        GetHr := HourName [ Hr mod 12 ]; { ensure value never greater than 11 }
    end;

{------------------------------------------------------------------------}
{ main body of program }

const
    DayName : array [0..6] of STRING9 =
    (
        'Sunday','Monday','Tuesday','Wednesday',
        'Thursday','Friday','Saturday'
    );

    MonthName : array [0..11] of STRING9 =
    (
        'January','February','March','April','May','June',
        'July','August','September', 'October','November','December'
    );

var                                    {set up the variables}
    Year : integer;

    Month, Date, Day, Hour, Min, Sec, Hsec : byte;

begin
    Getdate ( Year, Month, Date, Day );
    GetTime ( Hour, Min, Sec, Hsec );

    WriteLn;

    Write ( 'Today is ', DayName [ Day ], ',', ' ' );
    Write ( MonthName [ Month ], ' ' );
    WriteLn ( Date : 2, ',', ' ', year, '.' );

    Write ( 'It is now ' );
    if Min = 0 then
        Write( 'exactly ' )
    else

        begin
            Write ( Getmin ( Min ) );
            if Min = 1 then
                Write ( 'minute past ' )
            else
                Write ( 'minutes past ' );
        end;

    Write ( GetHr ( Hour ) );

    case Hour of
        0       :   WriteLn ( 'midnight.' );
        1 .. 11 :   WriteLn ( 'a.m.' );
        12      :   WriteLn ( 'noon.' );
        else        WriteLn ( 'p.m.' );
    end;

    WriteLn;

    case Hour of
        0 .. 11 :   WriteLn ( ' Good morning.' );
        12 ..17 :   WriteLn ( ' Good afternoon.' );
        else        WriteLn ( ' Good evening.' );
    end;
end.