PROGRAM process_tariff_meter_data;

USES
  DOS,CRT,Comm;

CONST
  Baudraten     : ARRAY[0..5] OF INTEGER = (300,600,1200,2400,4800,9600);
  Baud          : BYTE = 0;
  ComPort       : BYTE = 1;
  Par           : ARRAY[0..7] OF BYTE = (0,0,0,0, 0,0,0,0);


FUNCTION CHR2(chr2_i:BYTE):CHAR;
BEGIN
  CHR2:=CHR(chr2_i AND $7F);
END;

FUNCTION ORD2(ord2_ch:CHAR):BYTE;
VAR
  ORD2_i                : BYTE;
  ORD2_i1               : BYTE;
BEGIN
  ORD2_i1:=0;
  IF ORD(ord2_ch) DIV 2=1 THEN ORD2_i:=ORD(ord2_ch)
                          ELSE ORD2_i:=ORD(ord2_ch);
  IF ORD(ord2_ch) AND $01=$01 THEN INC(ORD2_i1);
  IF ORD(ord2_ch) AND $02=$02 THEN INC(ORD2_i1);
  IF ORD(ord2_ch) AND $04=$04 THEN INC(ORD2_i1);
  IF ORD(ord2_ch) AND $08=$08 THEN INC(ORD2_i1);
  IF ORD(ord2_ch) AND $10=$10 THEN INC(ORD2_i1);
  IF ORD(ord2_ch) AND $20=$20 THEN INC(ORD2_i1);
  IF ORD(ord2_ch) AND $40=$40 THEN INC(ORD2_i1);
  IF ORD(ord2_ch) AND $80=$80 THEN INC(ORD2_i1);
  IF ORD2_i1 MOD 2 = 0 THEN ORD2_i:=(ORD(ord2_ch) AND $7F)
                       ELSE ORD2_i:=(ORD(ord2_ch) AND $7F) + $80;
  ORD2:=ORD2_i;
END;

PROCEDURE BCC(BCC_i:CHAR);
BEGIN
  IF ORD2(BCC_i) AND $01=$01 THEN INC(Par[0]);
  IF ORD2(BCC_i) AND $02=$02 THEN INC(Par[1]);
  IF ORD2(BCC_i) AND $04=$04 THEN INC(Par[2]);
  IF ORD2(BCC_i) AND $08=$08 THEN INC(Par[3]);
  IF ORD2(BCC_i) AND $10=$10 THEN INC(Par[4]);
  IF ORD2(BCC_i) AND $20=$20 THEN INC(Par[5]);
  IF ORD2(BCC_i) AND $40=$40 THEN INC(Par[6]);
  IF ORD2(BCC_i) AND $80=$80 THEN INC(Par[7]);
END;

PROCEDURE BCC_0;
VAR
  BCC0_i        : BYTE;
BEGIN
  FOR BCC0_i:=0 TO 7 DO
    Par[BCC0_i]:=0;
END;

FUNCTION BCC_Gen:BYTE;
VAR
  BCCG_i         : BYTE;
  BCCG_i2        : BYTE;
BEGIN
  BCCG_i:=0;
  BCCG_i2:=0;
  IF Par[0] MOD 2 = 1 THEN BCCG_i:=BCCG_i + $01;
  IF Par[1] MOD 2 = 1 THEN BCCG_i:=BCCG_i + $02;
  IF Par[2] MOD 2 = 1 THEN BCCG_i:=BCCG_i + $04;
  IF Par[3] MOD 2 = 1 THEN BCCG_i:=BCCG_i + $08;
  IF Par[4] MOD 2 = 1 THEN BCCG_i:=BCCG_i + $10;
  IF Par[5] MOD 2 = 1 THEN BCCG_i:=BCCG_i + $20;
  IF Par[6] MOD 2 = 1 THEN BCCG_i:=BCCG_i + $40;
  IF Par[7] MOD 2 = 1 THEN BCCG_i:=BCCG_i + $80;

  IF Par[0] MOD 2 = 1 THEN INC(BCCG_i2);
  IF Par[1] MOD 2 = 1 THEN INC(BCCG_i2);
  IF Par[2] MOD 2 = 1 THEN INC(BCCG_i2);
  IF Par[3] MOD 2 = 1 THEN INC(BCCG_i2);
  IF Par[4] MOD 2 = 1 THEN INC(BCCG_i2);
  IF Par[5] MOD 2 = 1 THEN INC(BCCG_i2);
  IF Par[6] MOD 2 = 1 THEN INC(BCCG_i2);
  IF Par[7] MOD 2 = 1 THEN INC(BCCG_i2);
  IF BCCG_i2 MOD 2 = 1 THEN
  BEGIN
    IF BCCG_i>$7F THEN BCCG_i:=BCCG_i-$80
                  ELSE BCCG_i:=BCCG_i+$80;
  END;
  BCC_Gen:=BCCG_i;
END;

PROCEDURE Auslesen_Lastprofil;
VAR
  a_st        : STRING;
  a_f         : TEXT;
  a_i         : BYTE;
  a_ch        : CHAR;
  a_befst     : STRING;
  a_b         : BOOLEAN;
  a_code      : INTEGER;

BEGIN
  WRITELN('L A S T P R O F I L');
  WRITELN;
  WRITELN('Please select:');
  WRITELN('   (0)  Readout all data');
  WRITELN('  (ESC) Exit');
  a_ch:=READKEY;
  CASE a_ch OF
     #027: EXIT;
     #$30: a_befst:='9040';
     #$31: a_befst:='9000';
     #$32: a_befst:='9001';
     #$33: a_befst:='9002';
     #$34: a_befst:='9003';
  END;

  WRITELN;
  a_st:='';
  a_befst:=a_befst+'('+a_st+')';
  WRITELN;
  WRITELN('Please enter the name of the file to save data in! ');
  READLN(a_st);
  REPEAT UNTIL NOT KEYPRESSED;
  WRITE('.');
  ASSIGN(a_f,a_st);
  {$I-}
  APPEND(a_f);
  {$I+}
  IF IOResult<>0 THEN REWRITE(a_f);
  WRITE('.');

  REPEAT UNTIL tx_ready;
  tx(ORD2('/'));
  REPEAT UNTIL tx_ready;
  tx(ORD2('?'));
  REPEAT UNTIL tx_ready;
  tx(ORD2('!'));
  REPEAT UNTIL tx_ready;
  tx(ORD2(#013));
  REPEAT UNTIL tx_ready;
  tx(ORD2(#010));
  REPEAT UNTIL tx_ready;

  WRITELN('Waiting for identification message...');

  a_st:='';
  REPEAT
    IF rx_ready THEN
    BEGIN
      a_ch:=CHR2(rx);
      IF a_ch>#$1F THEN
        a_st:=a_st+a_ch;
      IF a_ch=#$2F THEN a_i:=LENGTH(a_st);
      IF a_ch<>#0 THEN WRITE(a_ch);
    END;
  UNTIL (a_ch=#013) OR (KEYPRESSED);
  WRITELN;
  REPEAT
    IF rx_ready THEN
      a_ch := CHR2(rx);
  UNTIL (a_ch=#010) OR (KEYPRESSED);

  WRITELN(a_f,COPY(a_st,a_i,LENGTH(a_st)-a_i));
  VAL(a_st[a_i+4],Baud,a_code);
  IF (a_code<>0) OR (Baud>5) THEN Baud:=0;
  IF (a_code<>0) OR (Baud>5) THEN a_st[a_i+4]:='0';

  a_st:=#006{ACK} +'0'+a_st[a_i+4]+'1';
  DELAY(50);
  FOR a_i:=1 TO LENGTH(a_st) DO
  BEGIN
    REPEAT UNTIL tx_ready;
    tx(ORD2(a_st[a_i]));
  END;
  WRITELN;
  REPEAT UNTIL tx_ready;
  tx(ORD2(#013));
  REPEAT UNTIL tx_ready;
  tx(ORD(#010));
  REPEAT UNTIL tx_ready;

  WRITELN('Switching Baudrate to ',Baudraten[Baud],' Bd...');

  deinit;

  a_b:=init(Baudraten[Baud],comport);

  a_st:='R2'+#002{STX}+a_befst+#003{ETX};
  DELAY(50);
  REPEAT UNTIL tx_ready;
  tx(ORD2(#001));
  BCC_0;
  FOR a_i:=1 TO LENGTH(a_st) DO
  BEGIN
    REPEAT UNTIL tx_ready;
    tx(ORD2(a_st[a_i]));
    BCC(a_st[a_i]);
  END;
  REPEAT UNTIL tx_ready;
  tx(ORD(BCC_Gen));
  REPEAT UNTIL tx_ready;

  a_st:='';
  REPEAT
    IF rx_ready THEN
    BEGIN
      a_ch:=CHR2(rx);
      IF (a_ch>#$00) THEN WRITE(a_f,a_ch);
      IF a_ch<>#000 THEN WRITE(a_ch);
      BCC(CHR(ORD2(a_ch)));
      a_st:=a_st+a_ch;
      IF a_ch=#001 THEN a_st:='';
    END;
  UNTIL ((a_ch=#003) AND (POS('P0()',a_st)<>0) ) OR (KEYPRESSED);
  WRITELN(a_f);
  WRITELN(a_f,'Data...');
  WRITELN;
  WRITELN('Waiting for data...');

  a_st:='';
  a_ch:=#000;
  REPEAT
    IF rx_ready THEN
      a_ch:=CHR2(rx);
  UNTIL (a_ch=#001) OR (a_ch=#002) OR (KEYPRESSED);
  a_ch:=#000;
  a_st:='';
  BCC_0;
  REPEAT
    IF rx_ready THEN
    BEGIN
      a_ch:=CHR2(rx);
      IF (a_ch>#$00) OR (a_ch=#013) OR (a_ch=#010) THEN WRITE(a_f,a_ch);
      IF a_ch<>#000 THEN WRITE(a_ch);
      BCC(CHR(ORD2(a_ch)));
    END;
  UNTIL (a_ch=#003) OR (KEYPRESSED);

  REPEAT UNTIL (rx_ready) OR (KEYPRESSED);
  a_ch:=CHR(rx);

  WRITELN('Done');
  IF BCC_Gen<>ORD(a_ch) THEN WRITELN('Transfer error');
  CLOSE(a_f);
  deinit;
  Baud:=0;
END;

BEGIN
  IF ParamStr(1)='1' THEN comport:=1;
  IF ParamStr(1)='2' THEN comport:=2;
  CLRSCR;
  IF init(Baudraten[Baud],comport) THEN
  BEGIN
    WRITELN('Current port: COM',comport);
    Auslesen_Lastprofil;
    deinit;
  END
  ELSE
  BEGIN
    WRITELN('Could not initialize COM',comport,'!');
  END;
END.