home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol072 / clock.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  6.5 KB  |  258 lines
  1. { Donated by Warren Smith, Feb 1982 }
  2.  
  3. Module Clock;        { This is a collection of routines to access    }
  4.             { an OKI MSM5832 clock chip.            }
  5.  
  6. Const
  7.     { Ports used by the clock    }
  8.     Clk_Cmd_Port    = $5A;
  9.     Clk_Data_Port    = $5B;
  10.     Zero        = 0;
  11.     Dig_Mask    = $0F;
  12.     Rd_Bit        = $10;
  13.     Wr_Bit        = $20;
  14.     Hold_Bit    = $40;
  15.     Min_Time_Index    = 0;
  16.     Max_Time_Index    = 5;
  17.     Day_of_Week    = 6;
  18.     Min_Date_Index    = 7;
  19.     Max_Date_Index    = 12;
  20.  
  21. Type
  22.     Time_Array    = array [Min_Time_Index .. Max_Time_Index] of byte;
  23.     Date_Array    = array [Min_Date_Index .. Max_Date_Index] of byte;
  24.  
  25. { These external routines are only used by the last procedure and may    }
  26. { be erased if that routine is unused.                    }
  27. External Procedure GotoXY (X, Y : integer);
  28.  
  29. External Procedure Read_Cursor (Var X, Y : integer);
  30.  
  31. Function Combine (Byte1, Byte2 : byte) : integer;
  32.  
  33.     begin { Combine }
  34.     Combine := Byte1 * 10 + Byte2
  35.     end;  { Combine }
  36.  
  37. Procedure DisComb (Value : integer; Var Byte1, Byte2 : byte);
  38.  
  39.     begin { DisComb }
  40.     Byte1 := (Value DIV 10) MOD 10;
  41.     Byte2 := Value MOD 10
  42.     end;  { DisComb }
  43.  
  44. Function Rd_Clock (Digit : byte) : byte;
  45.  
  46.     begin { Rd_Clock }
  47.     Out [Clk_Cmd_Port] := Digit ! Rd_Bit;
  48.     Rd_Clock := Inp [Clk_Data_Port];
  49.     Out [Clk_Cmd_Port] := Zero
  50.     end;  { Rd_Clock }
  51.  
  52. Procedure Wrt_Clock (Digit, Value : byte);
  53.  
  54.     begin { Wrt_Clock }
  55.     Digit := Digit & Dig_Mask;
  56.     Out [Clk_Cmd_Port]  := Hold_Bit;
  57.     Out [Clk_Cmd_Port]  := Digit ! Hold_Bit;
  58.     Out [Clk_Data_Port] := Value;
  59.     Out [Clk_Cmd_Port]  := Digit ! Hold_Bit ! Wr_Bit;
  60.     Out [Clk_Cmd_Port]  := Digit ! Hold_Bit;
  61.     Out [Clk_Cmd_Port]  := Zero
  62.     end;  { Wrt_Clock }
  63.  
  64. Procedure Get_Time (Var Seconds, Minutes, Hours : Integer);
  65.  
  66.     Var
  67.     I, Hours10 : integer;
  68.     Time : Time_Array;
  69.  
  70.     begin { Get_Time }
  71.     For I := Min_Time_Index to Max_Time_Index do
  72.     Time [I] := Rd_Clock (I);
  73.     Hours10 := Min_Time_Index + 5;
  74.   { Mask out 12/24 format and AM/PM bit }
  75.     Time [Hours10] := Time [Hours10] & 3;
  76.     I := Min_Time_Index;
  77.     Seconds := Combine (Time[I+1], Time[I]);
  78.     I := I + 2;
  79.     Minutes := Combine (Time[I+1], Time[I]);
  80.     I := I + 2;
  81.     Hours   := Combine (Time[I+1], Time[I])
  82.     end;  { Get_Time }
  83.  
  84. Procedure Set_Time (Seconds, Minutes, Hours : integer);
  85.  
  86.     Const
  87.     Mode_24 = 8;    { 24 hour mode bit }
  88.  
  89.     Var
  90.     I, Hours10 : integer;
  91.     Time : Time_Array;
  92.  
  93.     begin { Set_Time }
  94.     Hours10 := Min_Time_Index + 5;
  95.     I := Min_Time_Index;
  96.     DisComb (Seconds, Time[I+1], Time[I]);
  97.     I := I + 2;
  98.     DisComb (Minutes, Time[I+1], Time[I]);
  99.     I := I + 2;
  100.     DisComb (Hours,   Time[I+1], Time[I]);
  101.     Time [Hours10] := Time [Hours10] ! Mode_24;{set 24 hour mode in hours 10's}
  102.     For I := Min_Time_Index to Max_Time_Index do
  103.     Wrt_Clock ( I, Time [I])
  104.     end;  { Set_Time }
  105.  
  106. Procedure Get_Date (Var Day, Month, Year : integer);
  107.  
  108.     Var
  109.     I, Days10 : integer;
  110.     Date : Date_Array;
  111.  
  112.     begin { Get_Date }
  113.     For I := Min_Date_Index to Max_Date_Index do
  114.     Date [I] := Rd_Clock (I);
  115.     Days10 := Max_Date_Index - 4;
  116.     Date [Days10] := Date [Days10] & 3;        { mask out leap year bit }
  117.     I := Min_Date_Index;
  118.     Day   := Combine (Date[I+1], Date[I]);
  119.     I := I + 2;
  120.     Month := Combine (Date[I+1], Date[I]);
  121.     I := I + 2;
  122.     Year  := Combine (Date[I+1], Date[I])
  123.     end;  { Get_Date }
  124.  
  125. Procedure Set_Date (Day, Month, Year : integer);
  126.  
  127.     Const
  128.     Leap_Bit = 8;
  129.  
  130.     Var
  131.     I, Days10 : integer;
  132.     Date : Date_Array;
  133.  
  134.     begin { Set_Date }
  135.     Days10 := Max_Date_Index - 4;
  136.     I := Min_Date_Index;
  137.     DisComb (Day,   Date[I+1], Date[I]);
  138.     I := I + 2;
  139.     DisComb (Month, Date[I+1], Date[I]);
  140.     I := I + 2;
  141.     DisComb (Year,  Date[I+1], Date[I]);
  142.     if (Month <= 2) AND ((Year Mod 4) = 0) then
  143.     Date[Days10] := Date[Days10] ! Leap_Bit;  { set leap bit in Days 10's}
  144.     For I := Min_Date_Index to Max_Date_Index do
  145.     Wrt_Clock (I, Date[I])
  146.     end;  { Set_Date }
  147.  
  148. Procedure Get_Day (Var Day : integer);
  149.  
  150.     begin { Get_Day }
  151.     Day := Rd_Clock (Day_of_Week)
  152.     end;  { Get_Day }
  153.  
  154. Procedure Set_Day (New_Day : integer);
  155.  
  156.     begin { Set_Day }
  157.     { make sure it is in valid range }
  158.     If (New_Day >= 0) and (New_Day <= 6) then
  159.     Wrt_Clock (Day_of_Week, New_Day)
  160.     end;  { Set_Day }
  161.  
  162. Procedure Wrt_AM_PM (Var Outfile : Text; Seconds, Minutes, Hours : integer);
  163.  
  164.     Var
  165.     AP : array [ 1 .. 2 ] of char;
  166.  
  167.     begin { Wrt_AM_PM }
  168.     If Hours > 12 then
  169.     begin
  170.     Hours := Hours - 12;
  171.     AP := 'pm'
  172.     end
  173.     else
  174.     If Hours = 12 then
  175.         AP := 'pm'
  176.     else
  177.         AP := 'am';
  178.     Write (Outfile, (Hours MOD 100):2, ':',
  179.             ((Minutes DIV 10) MOD 10):1, (Minutes MOD 10):1, ':',
  180.                 ((Seconds DIV 10) MOD 10):1, (Seconds MOD 10):1, ' ',AP)
  181.     end;  { Wrt_AM_PM }
  182.  
  183. Procedure Wrt_Time (Var Outfile : Text; Seconds, Minutes, Hours : integer);
  184.  
  185.     begin { Wrt_Time }
  186.     Write (Outfile, ((Hours DIV 10) MOD 10):1, (Hours MOD 10):1, ':',
  187.             ((Minutes DIV 10) MOD 10):1, (Minutes MOD 10):1, ':',
  188.                 ((Seconds DIV 10) MOD 10):1, (Seconds MOD 10):1)
  189.     end;  { Wrt_Time }
  190.  
  191. Procedure Wrt_Date (Var Outfile : Text; Day, Month, Year : integer);
  192.  
  193.     Var
  194.     Mon : array [ 1 .. 3 ] of char;
  195.  
  196.     begin { Wrt_Date }
  197.     Case Month of
  198.     1  : Mon := 'Jan';
  199.     2  : Mon := 'Feb';
  200.     3  : Mon := 'Mar';
  201.     4  : Mon := 'Apr';
  202.     5  : Mon := 'May';
  203.     6  : Mon := 'Jun';
  204.     7  : Mon := 'Jul';
  205.     8  : Mon := 'Aug';
  206.     9  : Mon := 'Sep';
  207.     10 : Mon := 'Oct';
  208.     11 : Mon := 'Nov';
  209.     12 : Mon := 'Dec';
  210.     else Mon := 'OOP'
  211.     end;
  212.  
  213.     Write (Outfile, Mon, ' ', Day:1, ',', ' 19', (Year MOD 100):2)
  214.     end;  { Wrt_Date }
  215.  
  216. Procedure Wrt_Day (Var OutFile : Text; Day : integer);
  217.  
  218.     Var
  219.     New_Day : array [ 1 .. 3 ] of char;
  220.  
  221.     begin { Wrt_Day }
  222.     Case Day of
  223.     0 : New_Day := 'Sun';
  224.     1 : New_Day := 'Mon';
  225.     2 : New_Day := 'Tue';
  226.     3 : New_Day := 'Wed';
  227.     4 : New_Day := 'Thu';
  228.     5 : New_Day := 'Fri';
  229.     6 : New_Day := 'Sat';
  230.     else New_Day := 'DAY'
  231.     end;
  232.     Write (OutFile, New_Day)
  233.     end;  { Wrt_Day }
  234.  
  235. Procedure Time_Block (X, Y : integer);
  236.  
  237.     Var
  238.     Seconds, Minutes, Hours,
  239.     Day_of_Week,
  240.     Day, Month, Year : integer;
  241.     Old_X, Old_Y : integer;
  242.  
  243.     begin { Time_Block }
  244.     Read_Cursor (Old_X, Old_Y);
  245.     Get_Time (Seconds, Minutes, Hours);
  246.     Get_Date (Day, Month, Year);
  247.     Get_Day (Day_of_Week);
  248.     GotoXY (X, Y);
  249.     Wrt_Day (OutPut, Day_of_Week);
  250.     GotoXY (X, Y + 1);
  251.     Wrt_Date (OutPut, Day, Month, Year);
  252.     GotoXY (X, Y + 2);
  253.     Wrt_AM_PM (OutPut, Seconds, Minutes, Hours);
  254.     GotoXY (Old_X, Old_Y)
  255.     end;  { Time_Block }
  256.  
  257. Modend.
  258.