program numdate(input, {numdatep, bfile,} output);
(* numdate: convert tomdate format to a single number

  Dr. Thomas D. Schneider
  National Institutes of Health
  National Cancer Institute
  Center for Cancer Research Nanobiology Program
  Molecular Information Theory Group
  Frederick, Maryland  21702-1201
  toms@ncifcrf.gov
  permanent email: toms@alum.mit.edu (use only if first address fails)
  http://www.ccrnp.ncifcrf.gov/~toms/

 *)

label 1; (* end of program *)

const
(* begin module version *)
   version = 1.02; (* of numdate.p 2007 Jan 08
2007 Jan 08, 1.02: daydate function
2007 Jan 07, 1.01: write result
2007 Jan 07, 1.00: origin, functional read
*)
updateversion = 1.00; (* defines lowest acceptable current parameter file *)
(* end module version *)

(* begin module describe.numdate *)
(*
name
   numdate: convert tomdate format to a single number

synopsis
   numdate(input: in, numdatep: in, bfile: out, output: out)

files

   input:  a tomdate

   bfile:  not used

   numdatep:  parameters to control the program.  The file must contain the
      following parameters, one per line:

      parameterversion: The version number of the program.  This allows the
         user to be warned if an old parameter file is used.

      Currently not used.

   output: messages to the user

description

   The tomdate format is year, month, day, hour, minute, second
   compressed and in that order:

     2007Jan07.15:14:42

   This program converts the date to a real number.

examples

documentation

see also

  {tomdate script}

author

   Thomas Dana Schneider

bugs

technical notes

*)
(* end module describe.numdate *)

{
var
   numdatep, (* file used by this program *)
   bfile: text; (* file used by this program *)
}

(* begin module halt *)
procedure halt;
(* stop the program.  the procedure performs a goto to the end of the
   program.  you must have a label:
      label 1;
   declared, and also the end of the program must have this label:
      1: end.
   examples are in the module libraries.
   this is the only goto in the delila system. *)
begin
      writeln(output,' program halt.');
      goto 1
end;
(* end module halt version = 'delmod 6.16 84 mar 12 tds/gds'; *)

(* begin module fail *)
procedure fail;
begin
   writeln(output,'PARSE FAILED');
   halt
end;
(* end module fail *)

{
(* begin module daydate *)
procedure daydate(month: integer): integer;
(* convert month to days of the year *)
begin
end;
(* end module daydate *)
}

(* begin module numdate.themain *)
procedure themain{(var numdatep, bfile: text)};
(* the main procedure of the program *)
const
   debugging = false; (* are we to give debugging messages? *)
type
   monthtype = packed array[1..3] of char;
var
{
   parameterversion: real; (* parameter version number *)
   totalseconds: real; (* computed number *)
}

   year: integer; (* year *)
   c: char; (* a character read *)
   monthstring: monthtype; (* month as three characters *)
{
   month: integer; (* month as an integer *)
}
   monthday: integer; (* month as days into the year *)
   day: integer; (* day of month *)
   hour: integer; (* hour of day *)
   minute: integer; (* minute of hour *)
   second: integer; (* second of minute *)

   days: real; (* total days *)
   hours: real; (* total hours *)
   minutes: real; (* total minutes *)
   seconds: real; (* total seconds *)
{zzz}
begin
   if debugging then writeln(output,'numdate ',version:4:2);
{
   reset(numdatep);
   readln(numdatep, parameterversion);
   if round(100*parameterversion) < round(100*updateversion) then begin
      writeln(output, 'You have an old parameter file!');
      halt
   end;
}

   if eof(input) then fail; (* can't handle *)

(* example input:
   2007Jan07.15:14:42
*)

   read(input,year);
   if debugging then writeln(output,year:1);

   read(input,monthstring[1],monthstring[2],monthstring[3]);
   if debugging then writeln(output,monthstring);

{
   month :=  -1;
   if monthstring = 'Jan' then month :=  0;
   if monthstring = 'Feb' then month :=  1;
   if monthstring = 'Mar' then month :=  2;
   if monthstring = 'Apr' then month :=  3;
   if monthstring = 'May' then month :=  4;
   if monthstring = 'Jun' then month :=  5;
   if monthstring = 'Jul' then month :=  6;
   if monthstring = 'Aug' then month :=  7;
   if monthstring = 'Sep' then month :=  8;
   if monthstring = 'Oct' then month :=  9;
   if monthstring = 'Nov' then month := 10;
   if monthstring = 'Dec' then month := 11;
   if month = -1 then fail; (* can't handle *)
}


   monthday :=  -1;
   if monthstring = 'Jan' then monthday :=   0; (* 31 days *)
   if monthstring = 'Feb' then monthday :=  31; (* 28 days *)
   if monthstring = 'Mar' then monthday :=  59; (* 31 days *)
   if monthstring = 'Apr' then monthday :=  90; (* 30 days *)
   if monthstring = 'May' then monthday := 120; (* 31 days *)
   if monthstring = 'Jun' then monthday := 151; (* 30 days *)
   if monthstring = 'Jul' then monthday := 181; (* 31 days *)
   if monthstring = 'Aug' then monthday := 212; (* 31 days *)
   if monthstring = 'Sep' then monthday := 243; (* 30 days *)
   if monthstring = 'Oct' then monthday := 273; (* 31 days *)
   if monthstring = 'Nov' then monthday := 304; (* 30 days *)
   if monthstring = 'Dec' then monthday := 334; (* 31 days *)
   if monthday = -1 then fail; (* can't handle *)

   read(input,day);
   if debugging then writeln(output,day:1);

   read(input,c);
   if c <> '.' then fail;

   read(input,hour);
   if debugging then writeln(output,hour:1);

   read(input,c);
   if c <> ':' then fail;

   read(input,minute);
   if debugging then writeln(output,minute:1);

   read(input,c);
   if c <> ':' then fail;

   read(input,second);
   if debugging then writeln(output,second:1);

{
   totalseconds :=
      second
       + (60 * minute
          + (60 * hour
             + (24 * day
               + (12 * month)
             + (365 * year)
         )  )  ) ;
}

    days     := year*365.25 + monthday + day;
    hours    := days*24 + hour;
{zzz}
    minutes  := hours*60 + minute;
    seconds  := minutes * 60 + second;

    writeln(output,round(seconds):1);

end;
(* end module numdate.themain *)

begin
   themain{(numdatep, bfile)};
1: end.