{ ********************************************************************** }
{                                                                        }
{ COPYRIGHT AND DISCLAIMER                                               }
{ ------------------------                                               }
{                                                                        }
{ Copyright (c) 1999 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 software is intended to be connected to the C.I.G.R.E. lightning     }
{ flash counter (see Electra CIGRE n.22 may 1972) and keeps a log with      }
{ time and date of each detected lightning strike.                          }
{ This software is sensible on the falling edge of the input pulse (high    }
{ to low) that must be connected to the DCD line. On the RTS line a         }
{ positive voltage is supplyed for the pulse switch and on the TXD a        }
{ negative supply allows the connection of a pull-down resistor (10KOhm).   }
{ The COM port must be specified in the command line (COM1..COM4), and a /P }
{ switch sends a copy of the log also to the printer (on LPT1).             }
{ The log is saved in LIGHTNIN.LOG in the same directory of LIGHTNIN.EXE.   }

program lightning_counter;
uses
  crt, dos, printer;



const
  copyright_msg   = 'CIGRE lightning flash counter logger v1.1, '+
                    'Copyright (c) 1999 Iacopo Giangrandi';
  counter_msg     = ' -- ';
  start_msg       = ' -- Log session started.';
  stop_msg        = ' -- Log session stopped.';
  default_msg     = ' -- Hit Alt-X to exit.';
  event_msg       = ' -- Lightning strike detected.';

  log_ext         = 'LOG';         { File extensions }
  cnt_ext         = 'CNT';

  ier             = 1;             { UART address constants }
  iir             = 2;
  fcr             = 2;
  lcr             = 3;
  mcr             = 4;
  lsr             = 5;
  msr             = 6;
  spr             = 7;

  time_out        = 3600;          { Number of seconds before writing CR, -1=off }
  init            = 0;             { Constants of time_out_elpased }
  check           = 1;
  stop            = 2;



var
  print       : boolean;
  com_number  : byte;
  com_address : word;
  saved_com   : record
                  ier, lcr, mcr : byte;
                end;



function to_hex(n : byte) : string;
{ Converts a byte into a hexadecimal string. }
const
  hex_digit : array [$0..$F] of char = ('0','1','2','3','4','5','6','7',
                                        '8','9','A','B','C','D','E','F');
begin
to_hex := hex_digit[n shr 4] + hex_digit[n and $0F];
end;



function to_str(n : word; size : byte; fill_with_0s : boolean) : string;
{ Converts a word into a string (with zeros). }
var
  st : string;
  i  : byte;
begin
str(n:size,st);
if fill_with_0s then
  for i := 1 to length(st) do
    if st[i] = ' ' then
      st[i] := '0';
to_str := st;
end;



function up_case_str(st : string) : string;
{ converts st in upper case. }
var
  i : byte;
begin
for i := 1 to length(st) do
  st[i] := upcase(st[i]);
up_case_str := st;
end;



procedure set_com_address(com_x : byte);
{ Stores the COMx address into com_address }
begin
if not (com_x in [1..4]) then
  begin
  writeln('Error: only COM1..4 are supported.');
  halt;
  end;
com_address := memw[$0040:(com_x-1)*2];
if com_address = 0 then
  begin
  writeln('Error: COM',com_x,' is not present on this system.');
  halt;
  end
else
  writeln('Using COM',com_x,' at port ',to_hex(hi(com_address)),
  to_hex(lo(com_address)),'h.');
end;



procedure save_com_status;
{ Saves partially the port status }
begin
port[com_address+lcr] := port[com_address+lcr] and $7F; { Access IER }
saved_com.ier := port[com_address+ier];
saved_com.lcr := port[com_address+lcr];
saved_com.mcr := port[com_address+mcr];
end;



procedure restore_com_status;
{ Restores partially the port }
begin
port[com_address+lcr] := port[com_address+lcr] and $7F; { Access IER }
port[com_address+1] := saved_com.ier;
port[com_address+3] := saved_com.lcr;
port[com_address+4] := saved_com.mcr;
end;



procedure init_com_port;
{ Initializes the COM port by rising RTS }
var
  dummy : byte;
begin
port[com_address+lcr] := port[com_address+lcr] and $7F; { Access IER }
port[com_address+ier] := $00; { No interrupts }
port[com_address+mcr] := $02; { Rise RTS }
dummy := port[com_address+msr]; { Reset MSR }
dummy := port[com_address]; { Reset port }
end;



function input_changed : boolean;
{ Detect the falling edge of the input signal (DCD). }
begin
input_changed := false;
if (port[com_address+msr] and $08) = $08 then   { DCD has changed }
  if (port[com_address+msr] and $80) = $00 then { DCD is now 0 }
    input_changed := true;
end;



function one_second_elpased : boolean;
{ Returns true when the second is changed. }
const
  last_second : word = 0; { Static variable }
var
  hour, minute, second, sec100 : word;
begin
gettime(hour,minute,second,sec100);
one_second_elpased := second <> last_second;
last_second := second;
end;



function time_out_elpased(to_do : byte) : boolean;
{ Returns true when one hour is elpased if the counter is running. This }
{ procedure is used to write a once CR one hour after the last detected }
{ lightning. to_do: 0: reset and restart, 1: check, 2: stop. }
const
  last_second     : word    = 0;     { Static variables }
  seconds_elpased : longint = 0;
  count           : boolean = true;
var
  hour, minute, second, sec100 : word;
begin
if time_out < 0 then                 { time_out=-1 diasbles this function }
  begin
  time_out_elpased := false;
  exit;
  end;
case to_do of
  init  : begin
          seconds_elpased := 0;
          count := true;
          time_out_elpased := false;
          end;
  check : begin
          if count then
            begin
            gettime(hour,minute,second,sec100);
            if (second <> last_second) then
              seconds_elpased := seconds_elpased+1;
            last_second := second;
            time_out_elpased := seconds_elpased > time_out;
            end
          else
            time_out_elpased := false;
          end;
  stop  : begin
          count := false;
          time_out_elpased := false;
          end;
  end;
end;



function is_midnight : boolean;
{ Returns true once per day at midnight. }
const
  was_midnight : boolean = false; { Static variable }
var
  hour, minute, second, sec100 : word;
begin
is_midnight := false;
gettime(hour,minute,second,sec100);
if (hour = 0) and (minute = 0) and (second = 0) then
  if not was_midnight then
    begin
    is_midnight := true;
    was_midnight := true;
    end;
if (hour = 0) and (minute = 0) and (second = 1) and was_midnight then
  was_midnight := false;
end;



function time_to_string : string;
{ Returns current date and time in a string ("Wed Aug 19 10:55:28 1998") }
const
  week   : array [0..6] of string[3] =
             ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
  months : array [1..12] of string[3] =
             ('Jan','Feb','Mar','Apr','May','Jun',
              'Jul','Aug','Sep','Oct','Nov','Dec');
var
  hour, minute, second, sec100,
  year, month, day, day_of_week : word;
begin
gettime(hour,minute,second,sec100);
getdate(year,month,day,day_of_week);
time_to_string := week[day_of_week] + ' ' + months[month] + ' ' +
                  to_str(day,2,false) + ' ' + to_str(hour,2,false) + ':' +
                  to_str(minute,2,true) + ':' + to_str(second,2,true) +
                  ' ' + to_str(year,4,true);
end;



procedure set_counter(st : string);
{ Set the counter file to the specified value. }
var
  cnt_name      : string;
  cnt_file      : file of longint;
  counter       : longint;
  result        : integer;
begin
val(st,counter,result);
if result <> 0 then
  begin
  writeln('Error in number at position ',result,'.');
  halt;
  end;
cnt_name := paramstr(0);
delete(cnt_name,length(cnt_name)-2,3);
cnt_name := cnt_name+cnt_ext;
assign(cnt_file,cnt_name);         { Open counter file }
{$I-}
reset(cnt_file);
if ioresult <> 0 then              { Counter file does not exists: create one }
  begin
  rewrite(cnt_file);
  result := ioresult;
  if result <> 0 then
    begin
    writeln('Error (',result,') creating ',cnt_name,'.');
    halt;
    end
  else
    begin
    write(cnt_file,counter);
    writeln(cnt_name,' created and set to ',counter,'.');
    end;
  end
else
  begin
  write(cnt_file,counter);         { Set the counter }
  writeln(cnt_name,' set to ',counter,'.');
  end;
close(cnt_file);                   { Close counter file }
{$I+}
end;




procedure main_loop;
{ Program main loop that writes into the log. }
var
  done,
  just_changed  : boolean;
  log_name,
  cnt_name,
  st            : string;
  log_file      : text;
  cnt_file      : file of longint;
  result        : integer;
  counter       : longint;
begin
st := paramstr(0);
delete(st,length(st)-2,3);
cnt_name := st+cnt_ext;
log_name := st+log_ext;
assign(log_file,log_name);         { Open log file }
assign(cnt_file,cnt_name);         { Open counter file }
{$I-}
append(log_file);
if ioresult <> 0 then              { Log file does not exists: create one }
  begin
  rewrite(log_file);
  result := ioresult;
  if result <> 0 then
    begin
    writeln('Error (',result,') creating ',log_name,'.');
    restore_com_status;
    halt;
    end
  else
    begin
    writeln(log_file,copyright_msg);
    writeln(log_file);
    writeln(log_name,' created.');
    end;
  end;

reset(cnt_file);
if ioresult <> 0 then              { Counter file does not exists: create one }
  begin
  rewrite(cnt_file);
  result := ioresult;
  if result <> 0 then
    begin
    writeln('Error (',result,') creating ',cnt_name,'.');
    restore_com_status;
    close(log_file);
    halt;
    end
  else
    begin
    counter := 0;                  { Reset counter to 0 when creating a new file }
    write(cnt_file,counter);
    writeln(cnt_name,' created and set to 0.');
    end;
  end
else
  read(cnt_file,counter);          { Read the counter }

time_out_elpased(init);            { Reset hour counter }
time_out_elpased(stop);            { Stop hour counter }
st := time_to_string;              { Log that the session is open }
writeln(st,counter_msg,counter,start_msg);
writeln(log_file,st,counter_msg,counter,start_msg);
if print then
  writeln(lst,st,counter_msg,counter,start_msg);

done := false;
repeat                             { The main loop }
  just_changed := false;
  if input_changed then            { Check input }
    begin
    time_out_elpased(init);        { Reset timeout }
    counter := counter+1;
    just_changed := true;
    st := time_to_string;
    writeln(#13,st,counter_msg,counter,event_msg);
    writeln(log_file,st,counter_msg,counter,event_msg);
    if print then
      writeln(lst,st,counter_msg,counter,event_msg);
    seek(cnt_file,0);
    write(cnt_file,counter);
    end;
  if one_second_elpased or just_changed then { Update onscreen clock once per second }
    write(#13,time_to_string,counter_msg,counter,default_msg);
  if time_out_elpased(check) then  { Write CR after the first hour of no lightnings }
    begin
    time_out_elpased(stop);        { Stop counting hours. }
    writeln(#13,'                                       ',
                '                                      ');
    write(#13,time_to_string,counter_msg,counter,default_msg);
    writeln(log_file);
    if print then
      writeln(lst);
    end;
  if is_midnight then              { Close and reopen all files once per day }
    begin
    close(log_file);
    append(log_file);
    result := ioresult;
    if result <> 0 then
      begin
      writeln('Error: cannot close and reopen ',log_name,' (',result,').');
      restore_com_status;
      close(cnt_file);
      halt;
      end;
    close(cnt_file);
    reset(cnt_file);
    result := ioresult;
    if result <> 0 then
      begin
      writeln('Error: cannot close and reopen ',cnt_name,' (',result,').');
      restore_com_status;
      close(log_file);
      halt;
      end;
    end;
  if keypressed then               { Exit on Alt-X (0,45) }
    if readkey = #0 then
      if readkey = #45 then
        done := true;
until done;

st := time_to_string;              { Log that the session is closed }
writeln(#13,st,counter_msg,counter,stop_msg);
writeln(log_file,st,counter_msg,counter,stop_msg);
writeln(log_file);
if print then
  writeln(lst,st,counter_msg,counter,stop_msg);

close(log_file);                   { Close all files }
result := ioresult;
if result <> 0 then
  writeln('Error: cannot close ',log_name,' (',result,').');
close(cnt_file);
result := ioresult;
if result <> 0 then
  writeln('Error: cannot close ',cnt_name,' (',result,').');
{$I+}
end;



procedure check_cmd_line;
{ This check the command line for the COM port and the use of the printer. }
var
  i             : byte;
  st            : string;
  com_specified : boolean;
begin
com_specified := false;
print := false;
for i := 1 to paramcount do
  begin
  st := up_case_str(paramstr(i));
  if (pos('COM',st) = 1) and (length(st) = 4) then
    begin
    com_number := ord(st[4])-ord('0');
    com_specified := true;
    end
  else if (st = '/P') or (st = '-P') then
    print := true
  else if pos('COUNTER=',st) = 1 then
    begin
    delete(st,1,length('COUNTER='));
    set_counter(st);
    halt;
    end;
  end;
if not com_specified then
  begin
  writeln('Use:      LIGHTNIN COMx [/P]');
  writeln(' or:      LIGHTNIN COUNTER=x');
  writeln;
  writeln('COMx is the COM port where the C.I.G.R.E. lightning flash');
  writeln('counter is connected. Valid COM ports are 1..4.');
  writeln('If the /P switch is specified a copy of the log is also sent to');
  writeln('the printer (on LPT1).');
  writeln;
  writeln('The COUNTER option is used to set the counter to x.');
  writeln;
  writeln('This software is sensible on the falling edge of the input');
  writeln('pulse (high to low) that must be connected to the DCD line.');
  writeln('On the RTS line a positive voltage is supplyed for the pulse');
  writeln('switch and on the TXD a negative supply allows the connection');
  writeln('of a pull-down resistor (10KOhm).');
  halt;
  end;
end;



{ The main program body }
begin
writeln(copyright_msg);
writeln;

check_cmd_line;
set_com_address(com_number);
save_com_status;
init_com_port;
main_loop;
restore_com_status;
end.