home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / bbs / turbobbs / clock.inc < prev    next >
Encoding:
Text File  |  1985-08-24  |  2.6 KB  |  115 lines
  1. type monthname = string[3];
  2.      monames  = array[1..12] of monthname;
  3.  
  4. const months: monames = ('Jan','Feb','Mar','Apr','May','Jun',
  5.                          'Jul','Aug','Sep','Oct','Nov','Dec');
  6.               rtca    = $20;  {                                   }
  7.               rtcs    = $22;  { Real-time clock control registers }
  8.               rtcd    = $24;  {                                   }
  9.  
  10. procedure clock(var month,date,hour,min,sec: byte);
  11.  
  12.   var
  13.     temp: byte;
  14.  
  15.   function bcd_to_dec(bcd: byte): byte;
  16.  
  17.     begin
  18.       bcd_to_dec := (bcd and 15) + 10 * (bcd div 16);
  19.     end;
  20.  
  21.   function inport(loc: byte): byte;
  22.  
  23.     begin
  24.       port[rtca] := loc;
  25.       inport := bcd_to_dec(port[rtcd]);
  26.     end;
  27.  
  28.   procedure setupclock;
  29.  
  30.     var
  31.       junk: byte;
  32.  
  33.     begin
  34.       port[rtcs] := $CF;
  35.       port[rtcs] := $E0;
  36.       port[rtcs] := $03;
  37.       junk := inport($14);
  38.     end;
  39.  
  40.   begin
  41.     if clockin then begin
  42.       setupclock;
  43.       repeat
  44.         sec   := inport(2);
  45.         min   := inport(3);
  46.         hour  := inport(4);
  47.         date  := inport(6);
  48.         month := inport(7);
  49.         temp  := inport(2);
  50.       until temp = sec;
  51.     end;
  52.   end;
  53.  
  54. function time(month, date, hour, min, sec: byte): name;
  55.  
  56.   var
  57.     temps,
  58.     tempm,
  59.     tempd,
  60.     temph: string[2];
  61.  
  62.   begin
  63.     if clockin then begin
  64.       str(sec:2,temps);
  65.       str(min:2,tempm);
  66.       str(hour:2,temph);
  67.       str(date:2,tempd);
  68.       if sec < 10 then temps := '0' + temps[2];
  69.       if min < 10 then tempm := '0' + tempm[2];
  70.       if date < 10 then tempd := '0' + tempd[2];
  71.       time := temph + ':' + tempm + ':' + temps + ' ' + months[month] + tempd;
  72.     end
  73.     else time := '';
  74.   end;
  75.  
  76. procedure showtime;
  77.  
  78.   var
  79.     message: name;
  80.  
  81.   begin
  82.     if clockin then begin
  83.       clock(month, date, hour, min, sec);
  84.       message := time(month, date, hour, min, sec);
  85.       lineout('Time is: ' + message);
  86.     end;
  87.   end;
  88.  
  89. procedure connecttime;
  90.  
  91.   var
  92.     message: name;
  93.  
  94.   begin
  95.     if clockin then begin
  96.       clock(month, date, hour, min, sec);
  97.       usemin := 0;
  98.       usehour := 0;
  99.       usesec := sec - onsec;
  100.       if usesec < 0 then begin
  101.         usesec := usesec + 60;
  102.         usemin := -1;
  103.       end;
  104.       usemin := min - onmin + usemin;
  105.       if usemin < 0 then begin
  106.         usemin := usemin + 60;
  107.         usehour := -1;
  108.       end;
  109.       usehour := hour - onhour + usehour;
  110.       if usehour < 0 then usehour := usehour + 24;
  111.       message := copy(time(1, 1, usehour, usemin, usesec), 1, 8);
  112.       lineout('Connect time: ' + message);
  113.     end;
  114.   end;
  115. əəəəəəəəəəəəəəəəəəəəəəəəəəəə