home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / BEEHIVE / BBS / C128PICS.ARC / CPMPLUS.CLK < prev    next >
Text File  |  1991-08-11  |  4KB  |  97 lines
  1. { PICS.CLK - Remote Operating System Clock Routines
  2.              Updated 24/6/89 for PICS compatibility by Peter B. Carter }
  3.  
  4. { File:        CPMPLUS.CLK This is a CP/M+ (generic) BDOS clock modual.
  5.                Use DATE.COM to set the correct time/date. }
  6.  
  7. Var
  8.    old_date,old_day,old_month,old_year : integer;
  9.  
  10. function BCD_to_Bin(BCD : Byte): byte;
  11.          {convert packed bcd to binary value}
  12.          begin
  13.               BCD_to_Bin := (10 * (BCD div 16)) + (BCD mod 16)
  14.          end;            {bcd to bin}
  15.  
  16. function BIN_to_Bcd(Bin : byte): byte;
  17. {convert binary value to bcd}
  18.          begin
  19.               Bin_to_BCD := (16 * (Bin div 10)) + (Bin mod 10)
  20.          end;            {bin to bcd}
  21.  
  22. procedure GetTAD(var t: tad_array);
  23. { Return a 6 element integer array of the current system time in
  24.   seconds, minutes, hours, day, month, and year. }
  25.           var
  26.              time_buf : array[1..4] of byte;
  27.              a,d,year,leap,month : integer;
  28.           const
  29.                days : array[0..1,0..11] of byte = ((31,28,31,30,31,30,31,31,30,31,30,31)
  30.                                                   ,(31,29,31,30,31,30,31,31,30,31,30,31));
  31.  
  32.           begin
  33.                d := addr(time_buf);
  34.                a := bdos(105,d);
  35.                t[0] := BCD_to_bin(a);            {seconds}
  36.                t[1] := BCD_to_bin(time_buf[4]);  {minutes}
  37.                t[2] := BCD_to_bin(time_buf[3]);  {hours}
  38.                d := time_buf[1] or (time_buf[2] shl 8);
  39.                if d = 0 then                     {date not set correctly}
  40.                begin
  41.                     t[3] := BCD_to_bin(0);       {day}
  42.                     t[4] := BCD_to_bin(0);       {month}
  43.                     t[5] := BCD_to_bin(0);       {year}
  44.                     exit;
  45.                end;
  46.                if d = old_date then              {why re-calc when same?}
  47.                begin
  48.                     t[3] := old_day;
  49.                     t[4] := old_month;
  50.                     t[5] := old_year;
  51.                     exit;
  52.                end;
  53.                old_date := d;                    {mark new date}
  54.                d := d-1;                         {we use base 0 for calcs
  55.                                                   as it works out easier}
  56.                year := d div 1461;               {4 years of 365 days}
  57.                d := d - year * 1461;             {bump}
  58.                leap := d div 365;                {act find what is remanding}
  59.                year := year * 4 + 1978 + leap;   {1978 is base year}
  60.                if (leap = 3) or (leap = 4) then leap := 1 else leap := 0;
  61.                                                  {conv value for array}
  62.                d := d mod 365;                   {now we just have the
  63.                                                   number of days left in 1 year}
  64.                month := 0;
  65.                while days[leap,month] < (d+1) do
  66.                begin
  67.                     d := d - days[leap,month];   {bump}
  68.                     month := month+1;
  69.                end;
  70.                year := year mod 100;             {we just want lower nibble}
  71.                t[3] := d + 1;                    {current day}
  72.                t[4] := month + 1;
  73.                t[5] := year;
  74.                old_day := d+1;                   {mark for short cuts}
  75.                old_month := month+1;
  76.                old_year  := year;
  77.           end;
  78.  
  79. procedure SetTAD(var t: tad_array);
  80. { Set the system time using a 6 element integer array which contains
  81.   seconds, minutes, hours, day, month, and year. }
  82.   begin
  83.        {not implemented yet}
  84.   end;
  85.  
  86. procedure tick_a_min;
  87. { increments global date if no clock is in use}
  88.   begin
  89.   end;
  90.  
  91. procedure tick_a_sec;
  92. {increments global date if no clock being used}
  93.   begin
  94.   end;
  95.  
  96. {end of C128.CLK}
  97.