* cpm/BIOS.MAC

[avrcpm.git] / cpm / utils / RTCDEMO.PAS

program RTCDemo;\r
{$C- } {Sonst funktioniert 'keypressed' nicht}\r
\r
{---------------------------------------------------------------------\r
        AVRCPM \r
        Test und Demonstration des I2C-Interface\r
        I2C Uhrenchip PCF8583 \r
        Zeit und Datum lesen und schreiben\r
\r
        Moegliche Erweiterung (TODO:):\r
        - Control/Status-Register und Alarmregister lesen/schreiben\r
        - RAM lesen/schreiben\r
\r
        $Id$\r
----------------------------------------------------------------------}\r
  \r
const\r
  I2CCMD    = 5;        {adr of I2C Command Port (1=read, 2=write)}\r
  I2CMSGLEN = 6;        {Transferpuffergroesse}\r
  I2CADRL   = 7;        {Transferpufferadresse low/high}\r
  I2CADRH   = 8;\r
\r
  I2C_CMD_Read  = 1;    {I2C Read Command}\r
  I2C_CMD_Write = 2;    {I2C Write Command}\r
\r
  { TP Delay Loop }\r
  T100ms = 100;         {20MHz AVR + Config fuer 3 MHz Z80 (TINST)}\r
  {T100ms = 75;}        {20MHz AVR + Config fuer 4 MHz Z80 (TINST default)}\r
\r
type\r
  I2CBufLen = 0..16;\r
\r
  CalTime = record\r
    sec: 0..59;\r
    min: 0..59;\r
    hrs: 0..23;\r
    day: 1..31;\r
    month: 1..12;\r
    year: integer;\r
  end;\r
\r
  DTinput = array [1..3] of integer;\r
\r
var\r
  msgbuf : array[0..16] of Byte;        {TODO: Transferbuffer nicht global}\r
\r
  Time : CalTime;\r
  Done: boolean;\r
\r
{---------------------------------------------------------------------\r
        Debugging: Print 16 byte RAM ab adr \r
----------------------------------------------------------------------}\r
procedure hexdump(adr: integer);\r
var\r
  i: integer;\r
  c: byte;\r
\r
  function hexdigit(c: byte): char;\r
  begin\r
    if c < 10 then\r
      hexdigit := char(c + $30)\r
    else\r
      hexdigit := char(c - 10 + $41);\r
  end;\r
\r
{TODO: print adr }\r
begin\r
  for i := 0 to 15 do\r
  begin\r
    c := Mem[adr+i];\r
    write(hexdigit(c shr 4), hexdigit(c and $f), ' ');\r
  end;\r
  writeln;\r
end;\r
\r
{---------------------------------------------------------------------\r
        I2C - Routinen\r
----------------------------------------------------------------------}\r
procedure i2c_init;\r
var\r
  i: integer;\r
begin\r
  msgbuf[0] := $A0;     {I2C-Adresse des RTC-Chips}\r
\r
  Port[I2CADRH] := Hi(Addr(msgbuf));\r
  Port[I2CADRL] := Lo(Addr(msgbuf));\r
end;\r
\r
procedure i2c_write(len:Byte);\r
begin\r
  Port[I2CMSGLEN] := len;\r
  Port[I2CCMD] := I2C_CMD_Write;\r
end;\r
\r
procedure i2c_read(len:Byte);\r
begin\r
  Port[I2CMSGLEN] := len;\r
  Port[I2CCMD] := I2C_CMD_Read;\r
end;\r
\r
\r
function BCDtoBINbyte(i: byte): byte;\r
begin\r
  BCDtoBINbyte := (i div 16) * 10 + (i and $F);\r
end;\r
\r
function BINtoBCDbyte(i: byte): byte;\r
begin\r
  BINtoBCDbyte := (i div 10) * 16 + (i mod 10);\r
end;\r
\r
procedure ReadRTC(var t: CalTime);\r
begin\r
  msgbuf[1] := 2;\r
  i2c_write(2);\r
  i2c_read(6);\r
  with t do\r
  begin\r
    sec  := BCDtoBINbyte(msgbuf[1]);\r
    min  := BCDtoBINbyte(msgbuf[2]);\r
    hrs  := BCDtoBINbyte(msgbuf[3] and $3F);\r
  end;\r
  msgbuf[1] := $10;\r
  i2c_write(2);\r
  i2c_read(3);\r
  with t do\r
  begin\r
    day  := BCDtoBINbyte(msgbuf[4] and $3F);\r
    month:= BCDtoBINbyte(msgbuf[5] and $1F);\r
    year := msgbuf[1] + 256*msgbuf[2];\r
    while Lo(year) and $3 <> (msgbuf[4] shr 6) do\r
      year := year + 1;\r
  end;\r
end;\r
\r
\r
procedure WriteRTC(t: CalTime);\r
begin\r
  with t do begin\r
    msgbuf[1] := 1;                   {register address}\r
    msgbuf[2] := 0;                   {hundredth of sec}\r
    msgbuf[3] := BINtoBCDbyte(sec);\r
    msgbuf[4] := BINtoBCDbyte(min);\r
    msgbuf[5] := BINtoBCDbyte(hrs);\r
    msgbuf[6] := BINtoBCDbyte(day) + (Lo(year) shl 6);\r
    msgbuf[7] := BINtoBCDbyte(month); {TODO: weekdays}\r
  end;\r
  i2c_write(8);\r
\r
  msgbuf[1] := $10;                  {register address}\r
  with t do begin\r
    msgbuf[2] := Lo(year);\r
    msgbuf[3] := Hi(year);\r
  end;\r
  i2c_write(4);\r
end;\r
\r
{---------------------------------------------------------------------\r
        Dialog Routinen\r
----------------------------------------------------------------------}\r
\r
procedure PrintTime(t: CalTime);\r
begin\r
  with t do             {TODO: Fuehrende '0' statt ' '}\r
  begin\r
    write('Zeit: ', hrs:2, ':',min:2, ':',sec:2, '  ',\r
          'Datum: ', day, '.', month, '.', year);\r
  end;\r
end;\r
\r
procedure PrintMenu;\r
begin\r
  ClrScr;\r
  writeln('Menu:');\r
  writeln(' T) Zeit setzen');\r
  writeln(' D) Datum setzen');\r
  writeln(' Q) Quit');\r
  writeln('> ');\r
end;\r
\r
function GetKey: char;\r
var\r
  c: char;\r
begin\r
  Read(Kbd, c);\r
  GetKey := c;\r
end;\r
\r
{Daemliche input routine ohne Fehlerpruefung (TODO:)}\r
procedure GetDateTime(var a: DTinput; sep: char);\r
var\r
  line: String[80];\r
  s: String[4];\r
  i,j,k: integer;\r
  rc: integer;\r
\r
begin\r
  readln(line);\r
  line := line + sep;\r
  j := 1;\r
  for i := 1 to 3 do\r
  begin\r
    k := 1;\r
    while line[k+j] in ['0'..'9'] do\r
      k := k + 1;\r
    s := Copy(line, j, k);\r
    val(s, a[i], rc);\r
    j := j + k + 1;\r
  end;\r
end;\r
\r
procedure SetTime;\r
var\r
  a: DTinput;\r
\r
begin\r
  write('Zeit (hh:mm:ss): ');\r
  a[1] := -1;\r
  GetDateTime(a, ':');\r
{  writeln('intime:', a[1], ':', a[2], ':', a[3]);\r
}\r
  if (a[1] in [0..24]) and (a[2] in [0..59]) and (a[3] in [0..59]) then\r
  begin\r
    ReadRTC(Time);\r
    Time.hrs  := a[1];\r
    Time.min  := a[2];\r
    Time.sec  := a[3];\r
    WriteRTC(Time);\r
  end else\r
  begin\r
    writeln('Fehler in Eingabe.');\r
  end;\r
end;\r
\r
procedure SetDate;\r
var\r
  a: DTinput;\r
\r
begin\r
  write('Datum (TT.MM.JJJJ): ');\r
  a[1] := -1;\r
  GetDateTime(a, '.');\r
{  writeln('indate:', a[1], '.', a[2], '.', a[3]);\r
}\r
  if (a[1] in [1..31]) and (a[2] in [1..12]) and (a[3] > 0) and (a[3] <= 2076) then\r
  begin\r
    ReadRTC(Time);\r
    Time.day  := a[1];\r
    Time.month:= a[2];\r
    Time.year := a[3];\r
    WriteRTC(Time);\r
  end else\r
  begin\r
    writeln('Fehler in Eingabe.');\r
  end;\r
end;\r
\r
procedure CleanConsolebuffer;\r
var\r
  c: char;\r
begin\r
  while keypressed do c := GetKey;\r
end;\r
\r
{---------------------------------------------------------------------\r
        main\r
----------------------------------------------------------------------}\r
\r
begin\r
  PrintMenu;\r
  i2c_init;\r
\r
  writeln;\r
  Done := False;\r
  repeat\r
    Delay(T100ms);\r
    ReadRTC(Time);\r
    GotoXY(35,1); PrintTime(Time); ClrEol;\r
    gotoXY(2,5);  ClrEol;\r
\r
    if keypressed then\r
    begin\r
      gotoXY(1,7); ClrEol;\r
      gotoXY(1,6); ClrEol;\r
      case UpCase(GetKey) of\r
       'T': SetTime;\r
       'D': SetDate;\r
       'Q': Done := True;\r
      end;\r
    end;\r
  until Done;\r
  CleanConsolebuffer;\r
end.\r
\1a\1a\1a\1a\1a\1a\1a\1a\1a\1a\1a\1a