2 {$C- } {Sonst funktioniert 'keypressed' nicht}
4 {---------------------------------------------------------------------
6 Test und Demonstration des I2C-Interface
8 Zeit und Datum lesen und schreiben
10 Moegliche Erweiterung (TODO:):
11 - Control/Status-Register und Alarmregister lesen/schreiben
15 ----------------------------------------------------------------------}
18 I2CCMD = 5; {adr of I2C Command Port (1=read, 2=write)}
19 I2CMSGLEN = 6; {Transferpuffergroesse}
20 I2CADRL = 7; {Transferpufferadresse low/high}
23 I2C_CMD_Read = 1; {I2C Read Command}
24 I2C_CMD_Write = 2; {I2C Write Command}
27 T100ms = 100; {20MHz AVR + Config fuer 3 MHz Z80 (TINST)}
28 {T100ms = 75;} {20MHz AVR + Config fuer 4 MHz Z80 (TINST default)}
42 DTinput = array [1..3] of integer;
45 msgbuf : array[0..16] of Byte; {TODO: Transferbuffer nicht global}
50 {---------------------------------------------------------------------
51 Debugging: Print 16 byte RAM ab adr
52 ----------------------------------------------------------------------}
53 procedure hexdump(adr: integer);
58 function hexdigit(c: byte): char;
61 hexdigit := char(c + $30)
63 hexdigit := char(c - 10 + $41);
71 write(hexdigit(c shr 4), hexdigit(c and $f), ' ');
76 {---------------------------------------------------------------------
78 ----------------------------------------------------------------------}
83 msgbuf[0] := $A0; {I2C-Adresse des RTC-Chips}
85 Port[I2CADRH] := Hi(Addr(msgbuf));
86 Port[I2CADRL] := Lo(Addr(msgbuf));
89 procedure i2c_write(len:Byte);
91 Port[I2CMSGLEN] := len;
92 Port[I2CCMD] := I2C_CMD_Write;
95 procedure i2c_read(len:Byte);
97 Port[I2CMSGLEN] := len;
98 Port[I2CCMD] := I2C_CMD_Read;
102 function BCDtoBINbyte(i: byte): byte;
104 BCDtoBINbyte := (i div 16) * 10 + (i and $F);
107 function BINtoBCDbyte(i: byte): byte;
109 BINtoBCDbyte := (i div 10) * 16 + (i mod 10);
112 procedure ReadRTC(var t: CalTime);
119 sec := BCDtoBINbyte(msgbuf[1]);
120 min := BCDtoBINbyte(msgbuf[2]);
121 hrs := BCDtoBINbyte(msgbuf[3] and $3F);
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
137 procedure WriteRTC(t: CalTime);
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}
150 msgbuf[1] := $10; {register address}
152 msgbuf[2] := Lo(year);
153 msgbuf[3] := Hi(year);
158 {---------------------------------------------------------------------
160 ----------------------------------------------------------------------}
162 procedure PrintTime(t: CalTime);
164 with t do {TODO: Fuehrende '0' statt ' '}
166 write('Zeit: ', hrs:2, ':',min:2, ':',sec:2, ' ',
167 'Datum: ', day, '.', month, '.', year);
175 writeln(' T) Zeit setzen');
176 writeln(' D) Datum setzen');
181 function GetKey: char;
189 {Daemliche input routine ohne Fehlerpruefung (TODO:)}
190 procedure GetDateTime(var a: DTinput; sep: char);
204 while line[k+j] in ['0'..'9'] do
206 s := Copy(line, j, k);
217 write('Zeit (hh:mm:ss): ');
220 { writeln('intime:', a[1], ':', a[2], ':', a[3]);
222 if (a[1] in [0..24]) and (a[2] in [0..59]) and (a[3] in [0..59]) then
231 writeln('Fehler in Eingabe.');
240 write('Datum (TT.MM.JJJJ): ');
243 { writeln('indate:', a[1], '.', a[2], '.', a[3]);
245 if (a[1] in [1..31]) and (a[2] in [1..12]) and (a[3] > 0) and (a[3] <= 2076) then
254 writeln('Fehler in Eingabe.');
258 procedure CleanConsolebuffer;
262 while keypressed do c := GetKey;
265 {---------------------------------------------------------------------
267 ----------------------------------------------------------------------}
278 GotoXY(35,1); PrintTime(Time); ClrEol;
285 case UpCase(GetKey) of
294 \1a\1a\1a\1a\1a\1a\1a\1a\1a\1a\1a\1a