{ ********************************************************************** }
{                                                                        }
{ COPYRIGHT AND DISCLAIMER                                               }
{ ------------------------                                               }
{                                                                        }
{ Copyright (c) 1997 Iacopo Giangrandi,                                  }
{ All rights reserved.                                                   }
{                                                                        }
{ Redistribution and use in source and binary forms, with or without     }
{ modification, are permitted provided that the following conditions     }
{ are met: 1. Redistributions of source code must retain the above       }
{ copyright notice, this list of conditions and the following            }
{ disclaimer. 2. Redistributions in binary form must reproduce the       }
{ above copyright notice, this list of conditions and the following      }
{ disclaimer in the documentation and/or other materials provided        }
{ with the distribution. 3. All advertising materials mentioning         }
{ features or use of this software must display the following            }
{ acknowledgment: "This product includes software developed by           }
{ Iacopo Giangrandi". 4. The name of the author (Iacopo Giangrandi)      }
{ may not be used to endorse or promote products derived from this       }
{ software without specific prior written permission.                    }
{                                                                        }
{ THIS SOFTWARE IS PROVIDED BY THE AUTHOR (IACOPO GIANGRANDI) "AS IS"    }
{ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT              }
{ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND              }
{ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.                       }
{ IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,       }
{ INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,   }
{ BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;       }
{ LOSS OF USE, DATA, OR PROFITS, OR BUSINESS INTERRUPTION) HOWEVER       }
{ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT     }
{ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN      }
{ ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE        }
{ POSSIBILITY OF SUCH DAMAGE.                                            }
{                                                                        }
{ ********************************************************************** }

{ This program interfaces a DCF77 receiver connected to a RS232 serial }
{ port. The DTR and RTS lines are set high (+12V on the port) and the TXD }
{ is kept low (-12V) for the supplay of the receiver. This should return a }
{ DCF77 signal (RS232 compatible) on the RXD pin. This pin must be always }
{ high (-12V since pin is inverted) and go low one per second (except the }
{ 59th second that is not transmitted to supply a minute marker). The DCF77 }
{ standard impose a pulse time of 200ms for set bits and a time of 100ms }
{ for clear bits, but, since receivers usually use about 40ms for a safe }
{ reception these times are modified in 160 and 60ms. Receiving pulses at }
{ the speed of about 40 baud N81 a 160ms pulse will be decoded as a $80 or }
{ a $C0 and a 60ms as a $FE or $FC. }

{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y-}
{$M 16384,0,655360}
program dcf_clock;
uses
  dos, crt;




const
  default_port    = 2;                    { default port (COM1..4) }

{ constants about receiver and DCF77 speed }
  bit_rate        = 40;                   { 40..50 baud }
  rcvr_thershold  = 200;                  { thershold between 0s and 1s }
  timer_thershold = 26;                   { timer ticks min. marker (1.5s) }
  tmout_thershold = 364;                  { timer ticks for timeout (20s) }

{ hardware constants (COM, PIC, BIOS) }
  ier             = 1;                    { interrupt enable register }
  iir             = 2;                    { interrupt ident. register }
  lcr             = 3;                    { line control register }
  mcr             = 4;                    { modem control register }
  lsr             = 5;                    { line status register }
  msr             = 6;                    { modem status register }
  pic_addr        = $0020;                { programmable int. controller }
  imr             = 1;                    { interrupt mask register }
  eoi             = $20;                  { end of interrupt }
  bios_data       = $0040;                { BIOS data segment }
  bios_ports      = $0000;                { BIOS com ports addresses }
  bios_timer      = $006C;                { BIOS timer counter }
  valid_irqs      = [3..5,7,9..10];       { valid IRQs for a com port }
  min_io_port     = $0100;                { minimum I/O port address }

{ basic time constants }
  seconds         = 0;                    { seconds are always 0 }
  this_year       = 97;                   { year smaller then this are }
                                          { assumed to be in the 21th cent. }

{ this defines what is a "clear" and a "set" bit }
  bit0            = 0;                    { value stored when a 0 is rcvd }
  bit1            = 1;                    { value stored when a 1 is rcvd }

{ constants that defines the buffer structure }
  max_buffer_size = 78;                   { receiver buffer size }
  res1_offset     = 0;                    { the first 15 bit are reserved }
  res1_size       = 8;                    { and we store them in 2 bytes }
  res2_offset     = 8;
  res2_size       = 7;
  sec_ant_offset  = 15;                   { 2nd antenna bit offset }
  dst_chg_offset  = 16;                   { DST change in next hour offset }
  is_dst_offset   = 17;                   { DST bit offset }
  time_zn_offset  = 18;                   { time zone bit offset }
  comm_offset     = 19;                   { comm. in next second bit offset }
  parity0         = 20;                   { marker offset (always 1) }
  minutes_offset  = 21;                   { position of minutes in buffer }
  minutes_size    = 7;                    { size (in bits) of minutes }
  parity1         = 28;                   { first parity offset }
  hours_offset    = 29;                   { position of hours in buffer }
  hours_size      = 6;                    { size (in bits) of hours }
  parity2         = 35;                   { second parity offset }
  day_o_m_offset  = 36;                   { position of days (m.) in buffer }
  day_o_m_size    = 6;                    { size (in bits) of days of month }
  day_o_w_offset  = 42;                   { position of days (w.) in buffer }
  day_o_w_size    = 3;                    { size (in bits) of days of week }
  month_offset    = 45;                   { position of months in buffer }
  month_size      = 5;                    { size (in bits) of month }
  year_offset     = 50;                   { position of the year in buffer }
  year_size       = 8;                    { size (in bits) of the year }
  parity3         = 58;                   { third parity offset }

{ color definitions }
  copyright_color = 14;                   { color of the copyright }
  message_color   = 3;                    { color for instructions }
  header_color    = 7;                    { color for screen header }
  unknown_color   = 3;                    { color used to draw rcvd bits }
  empty_color     = 3;                    { color used to draw empty bits }
  right_color     = 11;                   { color for right bits }
  wrong_color     = 12;                   { color for wrong bits }
  time_color      = 15;                   { color to use for time and date }
  separator_color = 7;                    { color to use separators in time }

{ characters, keys, and separators strings }
  esc_key         = #27;                  { ESC key scan code }
  cr              = #13;                  { carriage return }
  empty_chr       = '.';                  { char to draw in empty bits }
  after_hours     = ':';                  { str between time }
  after_minutes   = ':';                  { str between time }
  after_seconds   = '  ';                 { str between time }
  after_d_o_w     = ', ';                 { str to write after day of week }
  after_month     = ' ';                  { str to write after the month }
  after_d_o_m     = '. ';                 { str after the day of the month }
  blank           = '  ';                 { str between other items }

{ data strings to translate received data }
  day_o_w_str     : array [0..7] of string[3] = { sunday = 7 }
                      ('Sun','Mon','Tue','Wed','Thu','Fri','Sat','Sun');
  months_str      : array [1..12] of string[3] =
                      ('Jan','Feb','Mar','Apr','May','Jun',
                       'Jul','Aug','Sep','Oct','Nov','Dec');
  dst_str         : array [boolean] of string[5] =
                      ('noDST','DST');
  antenna_str     : array [boolean] of string[17] =
                      ('Primary antenna','Secondary antenna');
  time_zone_str   : array [boolean] of string[3] =
                      ('UTC','CET');
  dst_change_str  = 'DST change on next hour. ';
  commutation_str = 'A second will be insered. ';

{ program messages }
  copyright_str   = 'DCF77 receiver v1.00 þ Copyright (c) 1997 by '+
                    'Iacopo Giangrandi';
  port_str1       = 'Reading from port ';
  port_str2       = 'h (IRQ ';
  port_str3       = ').';
  hit_esc_str     = 'Press [ESC] to quit...';
  header_10s      = '000000000011111111112222222222'+
                    '33333333334444444444555555555';
  header_1s       = '012345678901234567890123456789'+
                    '01234567890123456789012345678';
  rtc_updated_str = 'System real time clock synchronized.';
  command_usage1  = 'Use:    DCF77 [ COMx | Pyyyy Izz ] [ -sync [ -ret ] ] '+
                    '[ -nochk ] [ -notmout ]';
  command_usage2  = '';
  command_usage3  = 'Where:  x         is the COM port number (1..4) of the'+
                    ' receiver (default COM'+chr(default_port+ord('0'))+')';
  command_usage4  = '        yyyy      is the I/O port number (hex) of the '+
                    'non-standard COM port';
  command_usage5  = '        zz        is the IRQ number (dec) of the non '+
                    'standard COM port';
  command_usage6  = '        -sync     sets the real time clock of the PC '+
                    'after having decoded';
  command_usage7  = '        -ret      returns to DOS after having '+
                    'synchronized the clock';
  command_usage8  = '        -nochk    skips IRQ busy checking (use '+
                    'carefully)';
  command_usage9  = '        -notmout  skips timeout checking (use when '+
                    'reception is difficoult)';
  no_sync_str     = 'Warning: clock will not be updated (use -sync switch).';
  timeout_str     = 'Error: receiver timeout.';
  not_found_str1  = 'Error: cannot find COM';
  not_found_str2  = '.';
  inv_port_str1   = 'Error: COM';
  inv_port_str2   = ' is not a valid port.';
  invalid_io_str  = 'Error: invalid I/O port address.';
  invalid_irq_str = 'Error: invalid IRQ number.';
  conflict_str    = 'Error: parameter missing or incompatible parameters';
  irq_busy_str1   = 'Error: IRQ';
  irq_busy_str2   = ' is already in use (try -nochk).';

{ command line parameters }
  port_prm        = 'com';                { specify comm. port (COM1..4) }
  io_prm          = 'p';                  { specify I/O port (hex) }
  irq_prm         = 'i';                  { specify IRQ (dec) }
  sync_prm        = '-sync';              { synchronize clock }
  exit_prm        = '-ret';               { exit after syncing }
  no_irq_chk_prm  = '-nochk';             { do not check IRQ }
  no_tmout_prm    = '-notmout';           { do not check timeouts }




var
  comm_irq        : byte;                 { COMx port IRQ (see get_port) }
  comm_addr       : word;                 { COMx port I/O (see get_port) }

  set_time,                               { true for syncing the PC clock }
  exit_after_sync,                        { true quit after syncing }
  check_irq,                              { when false skips IRQ checking }
  no_tmout_chk    : boolean;              { skip timeout checking when true }

  saved           : record                { variable where current port }
                      old_irq_handler   : pointer; { status is saved, for }
                      old_lcr, old_mcr,   { restoring at exit. }
                      old_imr, old_ier,
                      old_bit_rate_lo,
                      old_bit_rate_hi,
                      dos_color         : byte;
                      end;

  buffer          : array [0..(max_buffer_size-1)] of byte; { rcvr buffer }
  buffer_pos      : byte;                 { pointer on the next free byte }
  new_data        : boolean;              { true when new data is arrived }
  new_buffer      : boolean;              { true at the beg. of each min. }
  valid_time      : boolean;              { true whe a valid time was rcvd }
  last_read       : longint;              { timer count at last rcvd bit }

  time            : record                { the time informetion is stored }
                      reserved1,          { here after having been decoded }
                      reserved2,          { note: bytes are in BCD format }
                      seconds, minutes,
                      hours,
                      day_of_month,
                      day_of_week,
                      month, year       : byte;
                      second_antenna,
                      dst_change,
                      is_dst, time_zone,
                      commutation       : boolean;
                      end;




procedure disable_interrupts;
inline($FA);     { cli }




procedure enable_interrupts;
inline($FB);     { sti }




function byte_to_hex(value : byte) : string;
{ This functions returns a string[2] whit "value" converted in hexadecimal. }
const
  hex : array [$00..$0F] of char = ('0','1','2','3','4','5','6','7',
                                     '8','9','A','B','C','D','E','F');
begin
byte_to_hex := hex[value shr $04] + hex[value and $0F];
end;




function bcd_to_dec(value : byte) : byte;
{ This function converts a BCD value into a decimal value. }
begin
bcd_to_dec := (value shr $04)*10+(value and $0F);
end;




{$F+}                                     { IRQ called procedures are far }
function check_parity(parity : byte) : boolean;
{ This function checks the marker bit (parity = 0) and the 3 parity bits }
{ (parity = 1..3) of the buffer and returns ture if the parity is good. }
var
  i, j : byte;
begin
j := 0;
case parity of
  0: check_parity := (buffer[parity0] = bit1); { check if the marker is 1 }
  1: begin
     for i := 0 to parity1 do
       if buffer[1] = bit1 then
         inc(j);
     check_parity := not odd(j);
     end;
  2: begin
     for i := 0 to parity2 do
       if buffer[1] = bit1 then
         inc(j);
     check_parity := not odd(j);
     end;
  3: begin
     for i := 0 to parity3 do
       if buffer[1] = bit1 then
         inc(j);
     check_parity := not odd(j);
     end;
  else check_parity := false;
  end;
end;
{$F-}




{$F+}                                     { IRQ called procedures are far }
procedure decode_buffer;
{ This procedure decodes the received buffer and stores the result in the }
{ "time" golbal variable. No error checking is performed. }

 function bits_to_byte(offset, size : byte) : byte;
{ This function converts "size" bits at the prosition "offset" of the }
{ buffer and returns a single byte whith this bits. No conversion is made, }
{ and data is still in BCD format }
 var
   i, j, k : byte;
 begin
 k := $00;
 for i := 0 to (size-1) do
   begin
   if buffer[offset+i] = bit1 then        { get bit values }
     j := $01
   else
     j := $00;
   k := k or (j shl i);                   { put separate bits in a byte }
   end;
 bits_to_byte := k;                       { k is in BCD }
 end;

begin
time.seconds := seconds;                  { seconds are always 00 }
time.minutes := bits_to_byte(minutes_offset,minutes_size);
time.hours := bits_to_byte(hours_offset,hours_size);
time.day_of_month := bits_to_byte(day_o_m_offset,day_o_m_size);
time.day_of_week := bits_to_byte(day_o_w_offset,day_o_w_size);
time.month := bits_to_byte(month_offset,month_size);
time.year := bits_to_byte(year_offset,year_size);
time.second_antenna := (buffer[sec_ant_offset] = bit1);
time.dst_change := (buffer[dst_chg_offset] = bit1);
time.is_dst := (buffer[is_dst_offset] = bit1);
time.time_zone := (buffer[time_zn_offset] = bit1);
time.commutation := (buffer[comm_offset] = bit1);
time.reserved1 := bits_to_byte(res1_offset,res1_size);
time.reserved2 := bits_to_byte(res2_offset,res2_size);
end;
{$F-}




{$F+}                                     { IRQ called procedures are far }
procedure irq_handler; interrupt;
{ This is the IRQ handler of the comm. port. It's called each time a bit }
{ is received. This procedure stores the bit in the buffer, checks }
{ overflows, and timeouts. It idetifys when a minute beging whit a timeout }
{ since the 59th second is not transmitted. }

var
  i         : byte;
  timer_now : longint;

 function get_bit(received : byte) : byte;
{ this function identifys the bits. When received "set" bit are 160ms long }
{ and "clear" bit are only 60. Since the UART is programmed at about 40b/s }
{ "set" bit will have smaller values (they remain 0 for a longer time), and }
{ the thershold is fixed by rcvr_thershold. }
 begin
 if received < rcvr_thershold then        { the bit was 0 or 1? }
   get_bit := bit1
 else
   get_bit := bit0;
 end;

begin
{disable_interrupts;                       { cli }
timer_now := longint(memw[bios_data:bios_timer]) or { get timer count }
             (longint((memw[bios_data:bios_timer+$0002] and $3FFF)) shl 16);
if timer_now > (last_read+timer_thershold) then { more than 1s elpased? }
  begin                                   { yes: clear buffer }
  new_buffer := true;
  buffer_pos := 0;
  end
else
  begin
  new_buffer := false;                    { no: it's still the same minute }
  valid_time := false;
  end;
last_read := timer_now;                   { save timer count for next IRQ }

if buffer_pos <= (max_buffer_size-1) then { is buffer full? }
  begin                                   { no... }
  buffer[buffer_pos] := get_bit(port[comm_addr]); { add new received byte }
  inc(buffer_pos);                        { increase buffer size }
  new_data := true;                       { set new data flag }
  end
else
  begin                                   { yes: it's full... }
  for i := 1 to (max_buffer_size-1) do    { shift buffer left }
    buffer[i-1] := buffer[i];
  buffer[max_buffer_size-1] := get_bit(port[comm_addr]); { add new rcvd data }
  new_data := true;                       { set new data flag }
  end;
if (buffer_pos = parity3+1) and check_parity(0) and check_parity(1) and
   check_parity(2) and check_parity(3) then { a full buffer arrived }
  begin
  decode_buffer;
  valid_time := true;
  end;
{enable_interrupts;                        { sti }
port[pic_addr] := eoi;                    { send EOI }
end;
{$F-}




procedure set_port;
{ This procedure set the communication port at the right speed, activate }
{ lines in order to switch receiver on, installs the IRQ handler and }
{ initializes the buffer, the timer and the related variables. The current }
{ status of the comm. port is also saved in "saved". }
var
  divisor : word;
  i       : byte;
begin
{ *** prepare buffer *** }
for i := 0 to (max_buffer_size - 1) do
  buffer[i] := 0;
buffer_pos := 0;
new_data := false;
new_buffer := false;
valid_time := false;

{ *** init timer *** }
last_read := longint(memw[bios_data:bios_timer]) or { get timer count }
             (longint((memw[bios_data:bios_timer+$0002] and $3FFF)) shl 16);

{ *** set line parameters *** }
saved.old_lcr := port[comm_addr+lcr];     { save current LCR }
port[comm_addr+lcr] := $03;               { set 8N1 }

{ *** reset UART chip *** }
port[comm_addr+lcr] := port[comm_addr+lcr] and $7F; { set read mode }
i := port[comm_addr+lsr];                 { read LSR to reset any errors }
i := port[comm_addr];                     { empty the buffer }

{ *** install new interrupt handler *** }
disable_interrupts;                       { cli }
getintvec(comm_irq+$08,saved.old_irq_handler); { save current IRQ address }
setintvec(comm_irq+$08,@irq_handler);     { set new ISR vector }

{ *** enable UART IRQ *** }
saved.old_ier := port[comm_addr+ier];     { save current IER }
port[comm_addr+ier] := $01;               { enable IRQ when data is ready }

{ *** clear the interrupt mask register *** }
saved.old_imr := port[pic_addr+imr];      { save current IMR }
port[pic_addr+imr] := saved.old_imr and (not (1 shl comm_irq)); { unmask IRQ }
enable_interrupts;                        { sti }

{ *** enable UART IRQ output *** }
saved.old_mcr := port[comm_addr+mcr];     { save current MCR }
port[comm_addr+mcr] := port[comm_addr+mcr] or $08; { enable OUT2 on 8250 }

{ *** set baudrate *** }
i :=  port[comm_addr+lcr];                { get current LCR }
port[comm_addr+lcr] := i or $80;          { enables bit rate setting (bit 7) }
saved.old_bit_rate_lo := port[comm_addr]; { save old bit rate }
saved.old_bit_rate_hi := port[comm_addr+ier];
divisor := 1843200 div (bit_rate * 16);   { calculate bit rate divisor }
port[comm_addr] := lo(divisor);           { write new bit rate }
port[comm_addr+ier] := hi(divisor);
port[comm_addr+lcr] := i and $7F;         { restore data I/O }

{ *** switch on receiver by rising RTS (bit 1) and DTR (bit 0) *** }
port[comm_addr+mcr] := port[comm_addr+mcr] or $03;
end;




procedure clear_port;
{ This procedure uninstalls the IRQ handler, reset the comm. port as it was }
{ before starting this program (set_port should be executed first), and }
{ switch off the receiver. }
begin
port[comm_addr+mcr] := saved.old_mcr;     { switch receiver off }
disable_interrupts;                       { cli }
port[comm_addr+ier] := saved.old_ier;     { restore IER }
port[comm_addr+lcr] := saved.old_lcr or $80; { enables bit rate setting }
port[comm_addr] := saved.old_bit_rate_lo; { restore old bit rate }
port[comm_addr+ier] := saved.old_bit_rate_hi;
port[comm_addr+lcr] := saved.old_lcr and $7F; { restore old LCR }
port[pic_addr+imr] := saved.old_imr;      { restore IMR }
setintvec(comm_irq+$08,saved.old_irq_handler); { restore original vector }
enable_interrupts;                        { sti }
end;




procedure init_display(to_do : byte);
{ If to_do is 0 this procedure save the color attribute used by DOS and }
{ write the copyright. It else writes some instruction and the header. }
begin
if to_do = 0 then
  begin
  saved.dos_color := textattr;            { save screen color }
  textattr := copyright_color;            { write copyright }
  write(copyright_str);
  textattr := empty_color;
  writeln;
  writeln;
  end
else
  begin
  textattr := message_color;              { write instructions }
  write(port_str1,byte_to_hex(hi(comm_addr)),byte_to_hex(lo(comm_addr)),
        port_str2,comm_irq,port_str3);
  textattr := empty_color;
  writeln;
  if not set_time then                    { warn if no sync was required }
    begin
    textattr := message_color;
    write(no_sync_str);
    textattr := empty_color;
    writeln;
    end;
  textattr := message_color;              { write instructions }
  write(hit_esc_str);
  textattr := empty_color;
  writeln;
  writeln;
  textattr := header_color;               { write header }
  write(header_10s);
  textattr := empty_color;
  writeln;
  textattr := header_color;
  write(header_1s);
  textattr := empty_color;
  writeln;
  writeln;
  end;
end;




procedure done_display;
{ This restores the color attribute used by DOS. }
begin
textattr := empty_color;
writeln;
textattr := saved.dos_color;              { restore screen color }
writeln;
end;




procedure check_busy_irq;
{ This procedure checks if the IRQ is free or it's already in use. }
begin
if check_irq and                          { set to false to skip this test }
   ((port[comm_addr+ier] and $0F) <> $00 ) and { interrupt enabled in IER }
   ((port[pic_addr+imr] and (1 shl comm_irq)) = $00) and { enabled in IMR }
   ((port[comm_addr+mcr] and $08) = $08) then { OUT2 enabled on 8250 }
  begin
  textattr := empty_color;
  writeln;
  writeln(irq_busy_str1,comm_irq,irq_busy_str2);
  done_display;
  halt;
  end;
end;




function check_timeout : boolean;
{ This function checks if the timeout has elpased and in this case returns }
{ true. It's used to check if the receiver is conncted and is receiving }
{ something. }
var
  timer_now : longint;
begin
if no_tmout_chk then
  check_timeout := false
else
  begin
  timer_now := longint(memw[bios_data:bios_timer]) or { get timer count }
               (longint((memw[bios_data:bios_timer+$0002] and $3FFF)) shl 16);
  if timer_now > (last_read+tmout_thershold) then
    begin
    check_timeout := true;
    textattr := saved.dos_color;
    writeln;
    writeln(timeout_str);
    end
  else
    check_timeout := false;
  end;
end;




procedure write_buffer;
{ This procedure writes the current received buffer, changing color if the }
{ received bits are good, wrong or unknown. }
var
  i : byte;
begin
write(cr);
if buffer_pos > 59 then                   { the buffer is longer than 59 }
  begin                                   { bits: the minute marker was }
  textattr := wrong_color;                { missed }
  for i := 0 to (buffer_pos-1) do
    write(buffer[i]);
  end
else if (buffer_pos-1) < parity0 then     { the marker bit was still }
  begin                                   { not transmitted. We don't know }
  textattr := unknown_color;              { if the current buffer is right }
  for i := 0 to (buffer_pos-1) do         { or not }
    write(buffer[i]);
  textattr := empty_color;
  for i := buffer_pos to 58 do
    write(empty_chr);
  end
else if (buffer_pos-1) < parity1 then     { the marker bit is arrived }
  begin
  if check_parity(0) then                 { ckeck if the rcvd data is good }
    textattr := right_color
  else
    textattr := wrong_color;
  for i := 0 to parity0 do
    write(buffer[i]);
  if textattr = right_color then          { write the rest of the data. The }
    textattr := unknown_color;            { 1st parity bit is still missing }
  for i := parity0+1 to (buffer_pos-1) do
    write(buffer[i]);
  textattr := empty_color;
  for i := buffer_pos to 58 do
    write(empty_chr);
  end
else if (buffer_pos-1) < parity2 then     { the first parity bit is arrived }
  begin
  if check_parity(0) then                 { was the previous data good? }
    begin
    textattr := right_color;              { yes: write the first part }
    for i := 0 to parity0 do
      write(buffer[i]);
    if not check_parity(1) then           { is the second part good too? }
      textattr := wrong_color;
    for i := parity0+1 to parity1 do      { write also the second }
      write(buffer[i]);
    if textattr = right_color then        { and the rest }
      textattr := unknown_color;
    for i := parity1+1 to (buffer_pos-1) do
      write(buffer[i]);
    textattr := empty_color;
    for i := buffer_pos to 58 do
      write(empty_chr);
    end
  else
    begin                                 { the marker is already wrong, }
    textattr := wrong_color;              { and all the rest of the data is }
    for i := 0 to (buffer_pos-1) do       { also wrong }
      write(buffer[i]);
    textattr := empty_color;
    for i := buffer_pos to 58 do
      write(empty_chr);
    end;
  end
else if (buffer_pos-1) < parity3 then     { the 2nd parity bit is arrived }
  begin
  if check_parity(0) then                 { was the previous data good? }
    begin
    textattr := right_color;              { yes: write the first part }
    for i := 0 to parity0 do
      write(buffer[i]);
    if check_parity(1) then
      begin
      for i := parity0+1 to parity1 do    { write also the second }
        write(buffer[i]);
      if not check_parity(2) then
        textattr := wrong_color;
      for i := parity1+1 to parity2 do    { write also the second }
        write(buffer[i]);
      if textattr = right_color then      { and the rest }
        textattr := unknown_color;
      for i := parity2+1 to (buffer_pos-1) do
        write(buffer[i]);
      textattr := empty_color;
      for i := buffer_pos to 58 do
        write(empty_chr);
      end
    else
      begin                               { the 1st parity is already wrong }
      textattr := wrong_color;            { and all the rest of the data is }
      for i := parity0 to (buffer_pos-1) do { also wrong }
        write(buffer[i]);
      textattr := empty_color;
      for i := buffer_pos to 58 do
        write(empty_chr);
      end;
    end
  else
    begin                                 { the marker is already wrong, }
    textattr := wrong_color;              { and all the rest of the data is }
    for i := 0 to (buffer_pos-1) do       { also wrong }
      write(buffer[i]);
    textattr := empty_color;
    for i := buffer_pos to 58 do
      write(empty_chr);
    end;
  end
else                                      { we just received the 59th bit }
  begin                                   { buffer_pos = 59 }
  if check_parity(0) then
    begin
    textattr := right_color;              { the first part of data is good }
    for i := 0 to parity0 do
      write(buffer[i]);
    if check_parity(1) then
      begin
      for i := parity0+1 to parity1 do    { the second part of data is good }
        write(buffer[i]);
      if check_parity(2) then
        begin
        for i := parity1+1 to parity2 do  { the third part of data is good }
          write(buffer[i]);
        if check_parity(3) then           { check the third parity bit }
          textattr := right_color
        else
          textattr := wrong_color;
        for i := parity2+1 to (buffer_pos-1) do
          write(buffer[i]);
        end
      else
        begin
        textattr := wrong_color;          { the rest of the data is wrong }
        for i := parity1+1 to (buffer_pos-1) do
          write(buffer[i]);
        end;
      end
    else
      begin
      textattr := wrong_color;            { the rest of the data is wrong }
      for i := parity0+1 to (buffer_pos-1) do
        write(buffer[i]);
      end;
    end
  else
    begin                                 { the marker is already wrong, }
    textattr := wrong_color;              { and all the rest of the data is }
    for i := 0 to (buffer_pos-1) do       { also wrong }
      write(buffer[i]);
    end;
  end;
end;




procedure write_cr_lf;
{ this procedure arites a CR and a LF each time the buffer is zeroed }
begin
if new_buffer then                        { a new minute is beginning }
  begin
  textattr := empty_color;                { new line }
  writeln;
  end;
end;




procedure write_new_time;
{ this procedure writes the time we just decoded. }
begin
if new_buffer and valid_time then
  begin
  textattr := time_color;               { writes hours minutes and sec. }
  write(byte_to_hex(time.hours));
  textattr := separator_color;
  write(after_hours);
  textattr := time_color;
  write(byte_to_hex(time.minutes));
  textattr := separator_color;
  write(after_minutes);
  textattr := time_color;               { even if seconds are always 0 }
  write(byte_to_hex(time.seconds));
  textattr := separator_color;
  write(after_seconds);

  textattr := time_color;               { writes the day of the week }
  write(day_o_w_str[bcd_to_dec(time.day_of_week)]);
  textattr := separator_color;
  write(after_d_o_w);
  textattr := time_color;               { writes the date }
  write(months_str[bcd_to_dec(time.month)]);
  textattr := separator_color;
  write(after_month);
  textattr := time_color;
  write(bcd_to_dec(time.day_of_month));
  textattr := separator_color;
  write(after_d_o_m);
  textattr := time_color;
  write(byte_to_hex(time.year));
  textattr := separator_color;
  write(blank);

  textattr := time_color;               { notify DST or not }
  write(dst_str[time.is_dst]);
  textattr := separator_color;
  write(blank);
  textattr := time_color;               { write time zone }
  write(time_zone_str[time.time_zone]);
  textattr := separator_color;
  write(blank);
  textattr := time_color;               { write antenna informations }
  write(antenna_str[time.second_antenna]);
  textattr := separator_color;
  write(blank);
  textattr := time_color;               { write reserved bits }
  write('(',byte_to_hex(time.reserved2),byte_to_hex(time.reserved1),'h)');

  if time.dst_change or time.commutation then { we got messages }
    begin
    textattr := empty_color;            { new line }
    writeln;
    end;
  textattr := time_color;
  if time.dst_change then               { notify DST change in next hour }
    write(dst_change_str);
  if time.commutation then              { notify commutaion info }
    write(commutation_str);
  textattr := empty_color;
  writeln;
  end;
end;




procedure set_clock;
{ This procedure synchrnizes the real time clock of the PC with the DCF77 }
{ received clock. This only works with year in 1997..2096. }
var
  w : word;
begin
settime(bcd_to_dec(time.hours),bcd_to_dec(time.minutes),
        bcd_to_dec(time.seconds),0);
if time.year < this_year then             { in which century are we now? }
  setdate(bcd_to_dec(time.year)+2000,bcd_to_dec(time.month),
          bcd_to_dec(time.day_of_month))  { in the 21th }
else                                      { still in the 20th }
  setdate(bcd_to_dec(time.year)+1900,bcd_to_dec(time.month),
          bcd_to_dec(time.day_of_month));
w := memw[bios_data:bios_timer];
while w = memw[bios_data:bios_timer] do;  { wait one timer tick before }
last_read := longint(memw[bios_data:bios_timer]) or { reiniting the timer }
             (longint((memw[bios_data:bios_timer+$0002] and $3FFF)) shl 16);

textattr := message_color;
write(rtc_updated_str);
textattr := empty_color;
writeln;
end;




procedure get_port(port_number : byte);
{ This procedure finds the correct I/O address and IRQ number for a }
{ specified COM port. Only COM1..4 are supported, and the must be at the }
{ default interrupt. For custom ports set comm_addr and comm_irq directly. }
const
  irq_table :  array [1..4] of byte = (4,3,4,3); { COMx default IRQ numbers }
begin
if port_number in [1..4] then             { only ports 1..4 are allowed }
  begin
  comm_addr := memw[bios_data:bios_ports+(port_number-1)*2]; { BIOS address }
  if comm_addr = $0000 then               { is port installed? }
    begin
    writeln(not_found_str1,port_number,not_found_str2);
    done_display;
    halt;
    end;
  comm_irq := irq_table[port_number];     { get default IRQ }
  end
else
  begin                                   { only ports 1..4 are allowed }
  writeln(inv_port_str1,port_number,inv_port_str2);
  done_display;
  halt;
  end;
end;




procedure parse_cmd_line;
{ This procedure checks the command line for arguments and options. It than }
{ sets global variables with the results. }
var
  i                   : byte;
  j                   : integer;
  st                  : string;
  was_port, was_irq,
  was_sync, was_exit,
  was_chk_irq,
  was_no_tmout        : boolean;

 function lo_case_str(in_st : string) : string;
{ This function converts a string into lower case }
 var
   k : byte;
 begin
 for k := 1 to length(in_st) do
   if in_st[k] in ['A'..'Z'] then
     in_st[k] := char(byte(in_st[k])+byte(ord('a')-ord('A')));
 lo_case_str := in_st;
 end;

 procedure param_error(error_str : string);
{ This procedure shows an the specified error message (or the command line }
{ use if error_str = '') and than exits to DOS. }
 begin
 textattr := empty_color;
 if error_str = '' then
   begin
   writeln(command_usage1);
   writeln(command_usage2);
   writeln(command_usage3);
   writeln(command_usage4);
   writeln(command_usage5);
   writeln(command_usage6);
   writeln(command_usage7);
   writeln(command_usage8);
   writeln(command_usage9);
   end
 else
   begin
   writeln;
   writeln(error_str);
   end;
 done_display;
 halt;
 end;

begin
if paramcount = 0 then                    { no parameters: assume default }
  begin
  get_port(default_port);
  set_time := false;
  exit_after_sync := false;
  end
else
  begin
  was_port := false;                      { zero required parameters }
  was_irq := false;
  was_sync := false;
  was_exit := false;
  was_chk_irq := false;
  was_no_tmout := false;
  set_time := false;                      { init global variables }
  exit_after_sync := false;
  check_irq := true;
  no_tmout_chk := false;
  for i := 1 to paramcount do             { parse all arguments }
    begin
    st := lo_case_str(paramstr(i));       { convert to lower case }
    if (pos(port_prm,st) = 1) and (length(st) = length(port_prm)+1) and
       (st[length(port_prm)+1] in ['1'..'4']) and (not was_port) and
       (not was_irq) then                 { com port specified }
      begin
      get_port(byte(st[length(port_prm)+1])-ord('0')); { get I/O and IRQ }
      was_port := true;                   { mark what was set }
      was_irq := true;
      end
    else if (pos(io_prm,st) = 1) and (not was_port) then { I/O port }
      begin
      if not (length(st) in [length(io_prm)+3,length(io_prm)+4]) then
        param_error(invalid_io_str);      { wrong size }
      delete(st,1,length(io_prm));
      val('$'+st,comm_addr,j);            { convert to numerical values }
      if (j <> 0) or (comm_addr < min_io_port) then { error in number }
        param_error(invalid_io_str);
      was_port := true;                   { mark that the port was set }
      end
    else if (pos(irq_prm,st) = 1) and (not was_irq) then
      begin                               { the IRQ was specified }
      if not (length(st) in [length(irq_prm)+1,length(irq_prm)+2]) then
        param_error(invalid_irq_str);     { wrong size }
      delete(st,1,length(irq_prm));
      val('$'+st,comm_irq,j);             { convert to numerical values }
      if (j <> 0) or (not (comm_irq in valid_irqs)) then { not a valid IRQ }
        param_error(invalid_irq_str);
      was_irq := true;                    { mark that the IRQ was specified }
      end
    else if (st = sync_prm) and (not was_sync) then
      begin
      set_time := true;                   { set global variable }
      was_sync := true;                   { sync_prm was specified }
      end
    else if (st = exit_prm) and (not was_exit) then
      begin
      exit_after_sync := true;            { set global variable }
      was_exit := true;                   { exit_prm was specified }
      end
    else if (st = no_irq_chk_prm) and (not was_chk_irq) then
      begin
      check_irq := false;                 { set global variable }
      was_chk_irq := true;                { exit_prm was specified }
      end
    else if (st = no_tmout_prm) and (not was_no_tmout) then
      begin
      no_tmout_chk := true;               { set global variable }
      was_no_tmout := true;               { exit_prm was specified }
      end
    else
      param_error('');                    { it wasn't a valid parameter }
    end;
  if (not was_port) and (not was_irq) then { no port or interrupt specified }
    begin                                 { use default }
    get_port(default_port);
    was_port := true;
    was_irq := true;
    end;
  if (not was_port) or (not was_irq) or (was_exit and (not was_sync)) then
    param_error(conflict_str);            { parameter missing or in conflict }
  end;
end;




procedure main_loop;
{ This is the program main loop. The local variable "new_data" is toggled }
{ in real time by the IRQ handler. }
var
  done : boolean;
begin
done := false;
repeat
  if new_data then                        { a new bit is arrived }
    begin
    new_data := false;                    { reset the variable }
    write_cr_lf;                          { new line for each new buffer }
    write_new_time;                       { writes the new received time }
    if set_time and new_buffer and valid_time then { set the PC clock }
      begin
      set_clock;
      if exit_after_sync then             { exit program if requested }
        done := true;
      end;
    if not done then
      write_buffer;                       { write the new buffer }
    end;
  if keypressed then                      { exit the program if the ESC key }
    if readkey = esc_key then             { was pressed. }
      done := true;
  if check_timeout then                   { or exit if a timeout occours }
    done := true;
until done;
while keypressed do                       { flush keyboard buffer }
  readkey;
end;




begin
checkbreak := false;                      { no ctrl-br in IRQ program }
init_display(0);                          { write copyright message }
parse_cmd_line;                           { get command line parameters }
check_busy_irq;                           { check if the IRQ uis free }
init_display(1);                          { write header }
set_port;                                 { init port and switch on rcvr }
main_loop;                                { program main loop }
clear_port;                               { switch off receiver }
done_display;                             { restore display color }
end.