home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / bbs / picssup.ark / OSBEXEC.CLK < prev    next >
Encoding:
Text File  |  1986-10-18  |  3.9 KB  |  129 lines
  1. { PICS.CLK - Remote Operating System Clock Routines
  2.              Updated 8/24/86 for PICS compatibility by Les Archambault }
  3.  
  4. { File:        OSBEXEC.CLK
  5.   Description: This driver set is designed to support the Osborne Executive.
  6.                I have done little here but extract and reformat this code
  7.                from Maurice's file (which I believe is originally from a
  8.                Kaypro .INC file). In fact, I have only the vaguest idea of
  9.                what some of this code is doing.
  10.   Date:        9/10/85
  11.   Author:      Mick Gaitor
  12.                CURA1 RBBS: 1-718-625-5931
  13.   Based on:    OX-MAC.INC for ROS 3.2 by Maurice Thaler.
  14. }
  15.  
  16.   var
  17.      Year,Hour,Minute,Second,Day,Month : byte;   { CPM+ time variables }
  18.      JulDate : integer;
  19. {
  20.   These routines do conversion between single bytes of BCD data, which
  21.   the Exec's clock outputs by default and single bytes of binary data,
  22.   which ROS expects. They were written by Kevin Karns (with thanks to
  23.   Steve Fox for finding them for me).  [MAG]
  24. }
  25. function BCD_to_Bin(BCD : Byte): byte;
  26. { Convert packed BCD value to binary }
  27.   begin
  28.      BCD_to_Bin := (10*(BCD div 16))+(BCD mod 16)
  29.   end; {BCD_to_Bin}
  30.  
  31. function Bin_to_BCD(Bin : byte): byte;
  32. { Convert binary value to packed BCD }
  33.   begin
  34.      Bin_to_BCD := (16*(Bin div 10))+(Bin mod 10)
  35.   end; {Bin_to_BCD}
  36.  
  37. procedure Jul_to_Day(Year : byte; JulDate : integer; var Month,Day : Byte);
  38.   const
  39.     DaysInMonth = ' 312831303130313130313031';
  40.   var
  41.     DayInMon, ResCode  : integer;
  42.     Finished : boolean;
  43.   begin
  44.     Month := 1;
  45.     Finished := false;
  46.     while not Finished do
  47.       begin
  48.         val(copy(DaysInMonth,2*Month,2),DayInMon,ResCode);
  49.         if Month = 2
  50.           then if (Year mod 4) = 0
  51.                  then DayInMon := succ(DayInMon);
  52.         if JulDate <= DayInMon
  53.           then Finished := true
  54.           else
  55.             begin
  56.               JulDate := JulDate - DayInMon;
  57.               Month := succ(Month)
  58.             end
  59.       end;
  60.     Day := JulDate
  61.   end;
  62.  
  63. procedure CPM_to_Julian(CPMdate: integer; var Year: byte; var JulDate: integer);
  64.   const
  65.     BaseYear = 78;
  66.   begin
  67.     Year    := CPMdate div 365;
  68.     JulDate := (CPMdate mod 365) - ((succ(Year)) div 4);
  69.     Year    := Year + BaseYear
  70.   end;
  71.  
  72. procedure GetTimeAndDate(var Year: byte; var JulDate: integer;
  73.   var Hour, Minute, Second: byte);
  74.   const
  75.     SysTimDat = 105;
  76.   var
  77.     DateRec   : record
  78.       DateInt  : integer;
  79.       HourByte : byte;
  80.       MinByte  : byte
  81.     end;
  82.   begin
  83.     Second := BCD_to_Bin(bdos(SysTimDat, Addr(DateRec)));
  84.     with DateRec do
  85.       begin
  86.         Hour   := BCD_to_Bin(HourByte);
  87.         Minute := BCD_to_Bin(MinByte);
  88.         CPM_to_Julian(DateInt, Year, JulDate)
  89.       end
  90.   end;
  91.  
  92. procedure GetTAD(var t: tad_array);
  93. { Return a 6 element integer array of the current system time in
  94.   seconds, minutes, hours, day, month, and year. }
  95.   begin
  96.      GetTimeAndDate(Year,JulDate,Hour,Minute,Second);
  97.      Jul_to_Day (Year,JulDate,Month,Day);
  98.      t[0] := Second;
  99.      t[1] := Minute;
  100.      t[2] := Hour;
  101.      t[3] := Day;
  102.      t[4] := Month;
  103.      t[5] := Year
  104.   end;
  105.  
  106. procedure SetTAD(var t: tad_array);
  107. { Set the system time using a 6 element byte array which contains
  108.     seconds, minutes, hours, day, month, and year.
  109. }
  110.   begin
  111. { **************************************************************
  112.   Sorry guys, but you're on your own here. After all that mess
  113.   up above to get the time out, I wouldn't even BEGIN to ATTEMPT
  114.   to TRY to put it back in. Good luck...      [MAG]
  115. **************************************************************
  116. }
  117.   end;
  118.  
  119. {The following two procedures MUST remain here to maintain compatibility
  120.  with systems not using a clock. Please don't remove them.}
  121.  
  122. Procedure tick_a_min;
  123.   begin
  124.   end;
  125.  
  126. procedure tick_a_sec;
  127.   begin
  128.   end;
  129.