cpm/utils/RTCDEMO.PAS

   1 program RTCDemo;
   2 {$C- } {Sonst funktioniert 'keypressed' nicht}
   3
   4 {---------------------------------------------------------------------
   5         AVRCPM
   6         Test und Demonstration des I2C-Interface
   7         I2C Uhrenchip PCF8583
   8         Zeit und Datum lesen und schreiben
   9
  10         Moegliche Erweiterung (TODO:):
  11         - Control/Status-Register und Alarmregister lesen/schreiben
  12         - RAM lesen/schreiben
  13
  14         $Id$
  15 ----------------------------------------------------------------------}
  16
  17 const
  18   I2CCMD    = 5;        {adr of I2C Command Port (1=read, 2=write)}
  19   I2CMSGLEN = 6;        {Transferpuffergroesse}
  20   I2CADRL   = 7;        {Transferpufferadresse low/high}
  21   I2CADRH   = 8;
  22
  23   I2C_CMD_Read  = 1;    {I2C Read Command}
  24   I2C_CMD_Write = 2;    {I2C Write Command}
  25
  26   { TP Delay Loop }
  27   T100ms = 100;         {20MHz AVR + Config fuer 3 MHz Z80 (TINST)}
  28   {T100ms = 75;}        {20MHz AVR + Config fuer 4 MHz Z80 (TINST default)}
  29
  30 type
  31   I2CBufLen = 0..16;
  32
  33   CalTime = record
  34     sec: 0..59;
  35     min: 0..59;
  36     hrs: 0..23;
  37     day: 1..31;
  38     month: 1..12;
  39     year: integer;
  40   end;
  41
  42   DTinput = array [1..3] of integer;
  43
  44 var
  45   msgbuf : array[0..16] of Byte;        {TODO: Transferbuffer nicht global}
  46
  47   Time : CalTime;
  48   Done: boolean;
  49
  50 {---------------------------------------------------------------------
  51         Debugging: Print 16 byte RAM ab adr
  52 ----------------------------------------------------------------------}
  53 procedure hexdump(adr: integer);
  54 var
  55   i: integer;
  56   c: byte;
  57
  58   function hexdigit(c: byte): char;
  59   begin
  60     if c < 10 then
  61       hexdigit := char(c + $30)
  62     else
  63       hexdigit := char(c - 10 + $41);
  64   end;
  65
  66 {TODO: print adr }
  67 begin
  68   for i := 0 to 15 do
  69   begin
  70     c := Mem[adr+i];
  71     write(hexdigit(c shr 4), hexdigit(c and $f), ' ');
  72   end;
  73   writeln;
  74 end;
  75
  76 {---------------------------------------------------------------------
  77         I2C - Routinen
  78 ----------------------------------------------------------------------}
  79 procedure i2c_init;
  80 var
  81   i: integer;
  82 begin
  83   msgbuf[0] := $A0;     {I2C-Adresse des RTC-Chips}
  84
  85   Port[I2CADRH] := Hi(Addr(msgbuf));
  86   Port[I2CADRL] := Lo(Addr(msgbuf));
  87 end;
  88
  89 procedure i2c_write(len:Byte);
  90 begin
  91   Port[I2CMSGLEN] := len;
  92   Port[I2CCMD] := I2C_CMD_Write;
  93 end;
  94
  95 procedure i2c_read(len:Byte);
  96 begin
  97   Port[I2CMSGLEN] := len;
  98   Port[I2CCMD] := I2C_CMD_Read;
  99 end;
 100
 101
 102 function BCDtoBINbyte(i: byte): byte;
 103 begin
 104   BCDtoBINbyte := (i div 16) * 10 + (i and $F);
 105 end;
 106
 107 function BINtoBCDbyte(i: byte): byte;
 108 begin
 109   BINtoBCDbyte := (i div 10) * 16 + (i mod 10);
 110 end;
 111
 112 procedure ReadRTC(var t: CalTime);
 113 begin
 114   msgbuf[1] := 2;
 115   i2c_write(2);
 116   i2c_read(6);
 117   with t do
 118   begin
 119     sec  := BCDtoBINbyte(msgbuf[1]);
 120     min  := BCDtoBINbyte(msgbuf[2]);
 121     hrs  := BCDtoBINbyte(msgbuf[3] and $3F);
 122   end;
 123   msgbuf[1] := $10;
 124   i2c_write(2);
 125   i2c_read(3);
 126   with t do
 127   begin
 128     day  := BCDtoBINbyte(msgbuf[4] and $3F);
 129     month:= BCDtoBINbyte(msgbuf[5] and $1F);
 130     year := msgbuf[1] + 256*msgbuf[2];
 131     while Lo(year) and $3 <> (msgbuf[4] shr 6) do
 132       year := year + 1;
 133   end;
 134 end;
 135
 136
 137 procedure WriteRTC(t: CalTime);
 138 begin
 139   with t do begin
 140     msgbuf[1] := 1;                   {register address}
 141     msgbuf[2] := 0;                   {hundredth of sec}
 142     msgbuf[3] := BINtoBCDbyte(sec);
 143     msgbuf[4] := BINtoBCDbyte(min);
 144     msgbuf[5] := BINtoBCDbyte(hrs);
 145     msgbuf[6] := BINtoBCDbyte(day) + (Lo(year) shl 6);
 146     msgbuf[7] := BINtoBCDbyte(month); {TODO: weekdays}
 147   end;
 148   i2c_write(8);
 149
 150   msgbuf[1] := $10;                  {register address}
 151   with t do begin
 152     msgbuf[2] := Lo(year);
 153     msgbuf[3] := Hi(year);
 154   end;
 155   i2c_write(4);
 156 end;
 157
 158 {---------------------------------------------------------------------
 159         Dialog Routinen
 160 ----------------------------------------------------------------------}
 161
 162 procedure PrintTime(t: CalTime);
 163 begin
 164   with t do             {TODO: Fuehrende '0' statt ' '}
 165   begin
 166     write('Zeit: ', hrs:2, ':',min:2, ':',sec:2, '  ',
 167           'Datum: ', day, '.', month, '.', year);
 168   end;
 169 end;
 170
 171 procedure PrintMenu;
 172 begin
 173   ClrScr;
 174   writeln('Menu:');
 175   writeln(' T) Zeit setzen');
 176   writeln(' D) Datum setzen');
 177   writeln(' Q) Quit');
 178   writeln('> ');
 179 end;
 180
 181 function GetKey: char;
 182 var
 183   c: char;
 184 begin
 185   Read(Kbd, c);
 186   GetKey := c;
 187 end;
 188
 189 {Daemliche input routine ohne Fehlerpruefung (TODO:)}
 190 procedure GetDateTime(var a: DTinput; sep: char);
 191 var
 192   line: String[80];
 193   s: String[4];
 194   i,j,k: integer;
 195   rc: integer;
 196
 197 begin
 198   readln(line);
 199   line := line + sep;
 200   j := 1;
 201   for i := 1 to 3 do
 202   begin
 203     k := 1;
 204     while line[k+j] in ['0'..'9'] do
 205       k := k + 1;
 206     s := Copy(line, j, k);
 207     val(s, a[i], rc);
 208     j := j + k + 1;
 209   end;
 210 end;
 211
 212 procedure SetTime;
 213 var
 214   a: DTinput;
 215
 216 begin
 217   write('Zeit (hh:mm:ss): ');
 218   a[1] := -1;
 219   GetDateTime(a, ':');
 220 {  writeln('intime:', a[1], ':', a[2], ':', a[3]);
 221 }
 222   if (a[1] in [0..24]) and (a[2] in [0..59]) and (a[3] in [0..59]) then
 223   begin
 224     ReadRTC(Time);
 225     Time.hrs  := a[1];
 226     Time.min  := a[2];
 227     Time.sec  := a[3];
 228     WriteRTC(Time);
 229   end else
 230   begin
 231     writeln('Fehler in Eingabe.');
 232   end;
 233 end;
 234
 235 procedure SetDate;
 236 var
 237   a: DTinput;
 238
 239 begin
 240   write('Datum (TT.MM.JJJJ): ');
 241   a[1] := -1;
 242   GetDateTime(a, '.');
 243 {  writeln('indate:', a[1], '.', a[2], '.', a[3]);
 244 }
 245   if (a[1] in [1..31]) and (a[2] in [1..12]) and (a[3] > 0) and (a[3] <= 2076) then
 246   begin
 247     ReadRTC(Time);
 248     Time.day  := a[1];
 249     Time.month:= a[2];
 250     Time.year := a[3];
 251     WriteRTC(Time);
 252   end else
 253   begin
 254     writeln('Fehler in Eingabe.');
 255   end;
 256 end;
 257
 258 procedure CleanConsolebuffer;
 259 var
 260   c: char;
 261 begin
 262   while keypressed do c := GetKey;
 263 end;
 264
 265 {---------------------------------------------------------------------
 266         main
 267 ----------------------------------------------------------------------}
 268
 269 begin
 270   PrintMenu;
 271   i2c_init;
 272
 273   writeln;
 274   Done := False;
 275   repeat
 276     Delay(T100ms);
 277     ReadRTC(Time);
 278     GotoXY(35,1); PrintTime(Time); ClrEol;
 279     gotoXY(2,5);  ClrEol;
 280
 281     if keypressed then
 282     begin
 283       gotoXY(1,7); ClrEol;
 284       gotoXY(1,6); ClrEol;
 285       case UpCase(GetKey) of
 286        'T': SetTime;
 287        'D': SetDate;
 288        'Q': Done := True;
 289       end;
 290     end;
 291   until Done;
 292   CleanConsolebuffer;
 293 end.
 294 \1a\1a\1a\1a\1a\1a\1a\1a\1a\1a\1a\1a