create table clock;  # initialise package table, no C libraries

clock.initstring :=
   'clock package v1.3.5 as of June 17, 2014\n';

# Adjust time values, i.e. tm(0, 65) (65 seconds) -> tm(1, 5) (1 minute, 5 seconds)
if unassigned(_clockAdjust) then
   _clockAdjust := true
fi;


# Metatable for adding, subtracting, multiplying, and dividing tm values
clock.clock_mt := [
   '__add' ~ proc(a, b) is
               return clock.add(a, b)
             end,
   '__sub' ~ proc(a, b) is
               return clock.sub(a, b)
             end,
   '__mul' ~ proc(a, b) is
               return clock.muls(a, b)
             end,
   '__div' ~ proc(a, b) is  # Agena 1.6.0, patched 1.11.4
               return clock.divs(a, b)
             end,
   '__pow' ~ proc(a, b) is  # Agena 1.11.4u1
               return clock.pow(a, b)
             end,
   '__unm' ~ proc(a) is
               return clock.muls(-1, a)
             end,
   '__lt' ~  proc(a :: tm, b :: tm) is
                return clock.todec(a) < clock.todec(b)
             end,
   '__eq' ~  proc(a :: tm, b :: tm) is
                return clock.todec(a) = clock.todec(b)
             end,
   '__abs' ~ proc(a :: tm) is
                return clock.tm(abs(a[1]), abs(a[2]), abs(a[3]))
             end,
   '__sqrt' ~ proc(a :: tm) is
                 local d := sqrt(clock.todec(a));
                 if nan(d) then  # changed to `nan` operator, 2.1.2
                    return undefined
                 else
                    return clock.totm(d)
                 fi
             end,
   '__ln' ~  proc(a :: tm) is
                 local d := ln(clock.todec(a));
                 if nan(d) then  # changed to `nan` operator, 2.1.2
                    return undefined
                 else
                    return clock.totm(d)
                 fi
             end,
   '__exp' ~ proc(a :: tm) is
                return clock.totm(exp(clock.todec(a)))
             end,
   '__sin' ~ proc(a :: tm) is
                return clock.totm(sin(clock.todec(a)))
             end,
   '__cos' ~ proc(a :: tm) is
                return clock.totm(cos(clock.todec(a)))
             end,
   '__tan' ~ proc(a :: tm) is
                 local d := tan(clock.todec(a));
                 if nan(d) then  # changed to `nan` operator, 2.1.2
                    return undefined
                 else
                    return clock.totm(d)
                 fi
             end,
   '__arctan' ~ proc(a :: tm) is
                 local d := arctan(clock.todec(a));
                 if nan(d) then  # changed to `nan` operator, 2.1.2
                    return undefined
                 else
                    return clock.totm(d)
                 fi
             end,
   '__sign' ~ proc(a :: tm) is
                return sign(clock.todec(a))
             end
];


# define a time object
clock.tm := proc(?) is
   local r, item;
   create seq r(3);
   if nargs < 1 or nargs > 3 then
      error('Error in `clock.tm`: wrong number of arguments.')
   fi;
   item := varargs[1];
   if item :: pair then  # handle tm format [hh:]mm:ss (as pair or nested pair)
      if right(item) :: pair then
         insert left(item), left(right(item)), right(right(item)) into r
      else
         insert left(item), right(item) into r
      fi;
      # item has now been converted to its sequence representation
      if not checktype(r, sequence, number) then
         error('Error in `clock.tm`: number expected in (nested) pair.')
      fi
   else
      local v;
      for i to nargs do
         v := varargs[i];
         if v :- number then
            argerror(v, 'clock.tm', 'number expected')
         else
            insert v into r
         fi
      od
   fi;
   if size(r) = 1 then
      r := clock.tm(0, unpack(r), 0)
   elif size(r) = 2 then
      r := clock.tm(0, unpack(r))
   fi;
   r := is _clockAdjust then clock.adjust(r) else seq(unpack(r)) si;
   settype(r, 'tm');
   setmetatable(r, clock.clock_mt);
   return r
end;


# simplify time, i.e. tm(0, 65) (65 seconds) -> tm(1, 5) (1 minute, 5 seconds)
clock.adjust := proc(struct :: sequence) is
   local hours, minutes, seconds, inseconds, sgn;
   inseconds := struct[1] * 3600 + struct[2] * 60 + int(struct[3]);  # 1.12.4, time in seconds
   sgn := sign(inseconds);  # remember sign
   inseconds := abs(inseconds);  # proceed calculation with absolute values
   hours := inseconds \ 3600;
   minutes := (inseconds % 3600) \ 60;
   seconds := (inseconds % 3600) % 60 + frac(struct[3]);  # 1.12.4, prevent round-off errors if seconds component includes milliseconds
   struct[1] := hours; struct[2] := minutes; struct[3] := seconds;
   # if given time was negative, then make all components negative (avoids -0's, too)
   return map(<< x -> is sgn = -1 then -x else x si>>, struct)
end;


# adds two or more values of type tm
clock.add := proc(?) is
   local hours, minutes, seconds;
   hours := 0;
   minutes := 0;
   seconds := 0;
   for i in varargs do
      if typeof(i) <> 'tm' then
         argerror(i, 'clock.add', 'expected a `tm` value')
      else
         inc hours, i[1];
         inc minutes, i[2];
         inc seconds, i[3]
      fi
   od;
   return clock.tm(hours, minutes, seconds)
end;


# substract two or more values of type tm
clock.sub := proc(?) is
   local hours, minutes, seconds, item, first;
   first := varargs[1];
   hours := first[1];
   minutes := first[2];
   seconds := first[3];
   for i from 2 to nargs do
      item := varargs[i];
      if typeof(item) <> 'tm' then
         argerror(item, 'clock.sub', 'expected a `tm` value')
      else
         dec hours, item[1];
         dec minutes, item[2];
         dec seconds, item[3]
      fi
   od;
   if minutes > 0 then
      while seconds < 0 do
         inc seconds, 60;
         dec minutes, 1
      od;
      while minutes < 0 do
         inc minutes, 60;
         dec hours, 1
      od;
   fi;
   return clock.tm(hours, minutes, seconds)
end;


# multiplication
clock.muls := proc(?) is
   local factor, struct, inseconds;
   if nargs <> 2 then
      error('Error in `clock.muls`: two arguments expected.')
   elif typeof(varargs[1]) = 'tm' and varargs[2] :: number then
      struct := varargs[1];
      factor := varargs[2]
   elif varargs[1] :: number and typeof(varargs[2]) = 'tm' then
      struct := varargs[2];
      factor := varargs[1]
   elif typeof(varargs[1]) = 'tm' and typeof(varargs[2]) = 'tm' then
      struct := varargs[2];
      factor := clock.todec(varargs[1])
   else
      error('Error in `clock.muls`: arguments must be of type `tm` and/or type number.')
   fi;
   inseconds := struct[1] * 3600 + struct[2] * 60 + struct[3];
   return clock.tm(0, factor * inseconds)
end;


# division
clock.divs := proc(?) is
   local factor, struct, inseconds;
   if nargs <> 2 then
      error('Error in `clock.divs`: two arguments expected.')
   elif typeof(varargs[1]) = 'tm' and varargs[2] :: number then
      struct := varargs[1];
      factor := varargs[2];
      if factor = 0 then return undefined fi;
      inseconds := struct[1] * 3600 + struct[2] * 60 + struct[3];
      return clock.tm(0, inseconds / factor)
   elif varargs[1] :: number and typeof(varargs[2]) = 'tm' then
      struct := varargs[2];
      factor := varargs[1] * 3600;
      inseconds := struct[1] * 3600 + struct[2] * 60 + struct[3];
      if inseconds = 0 then return undefined fi;
      return clock.tm(factor / inseconds, 0, 0)
   elif typeof(varargs[1]) = 'tm' and typeof(varargs[2]) = 'tm' then
      struct := varargs[1];
      factor := varargs[2];
      factor := factor[1] * 3600 + factor[2] * 60 + factor[3];
      if factor = 0 then return undefined fi;
      inseconds := struct[1] * 3600 + struct[2] * 60 + struct[3];
      return clock.tm(inseconds / factor, 0, 0)
   else
      error('Error in `clock.divs`: arguments must be of type `tm` and/or type number.')
   fi;
end;


# exponentiation
clock.pow := proc(?) is
   if nargs <> 2 then
      error('Error in `clock.pow`: two arguments expected.')
   elif typeof(varargs[1]) = 'tm' and varargs[2] :: number then
      return clock.totm(clock.todec(varargs[1]) ^ varargs[2])
   elif varargs[1] :: number and typeof(varargs[2]) = 'tm' then
      return clock.totm(varargs[1] ^ clock.todec(varargs[2]))
   elif typeof(varargs[1]) = 'tm' and typeof(varargs[2]) = 'tm' then
      return clock.totm(clock.todec(varargs[1]) ^ clock.todec(varargs[2]))
   else
      error('Error in `clock.pow`: arguments must be of type `tm` and/or type number.')
   fi;
end;


# Converts a time value in decimals (of type number) into its `tm` representation.

clock.totm := proc(x :: number) is
   local h, m, s, f;
   if x < 0 then
      error('Error in `clock.dectotm`: value must be in the range [0 .. infinity[.')
   fi;
   h := int(x);
   f := frac(x);
   m := int(f*60);
   s := roundf(frac(f*60)*60, 2);  # 1.12.0 u1
   return clock.tm(h, m, s)
end;


# Converts a `tm` value into its decimal representation of type number. Please have a look at the
# `clock` package chapter for further details.

clock.todec := proc(x :: tm) is
   return x[1] + (x[2]*60 + x[3])/3600
end;


# converts a float or `tm` value into its sexagesimal string representation of the format hh:mm:ss, 1.12.0 u1.
clock.sgstr := proc(x, d) is
   local rtm, str;
   if x :: number then
      rtm := clock.totm(x)
   elif x :: 'tm' then
      rtm := x
   else
      argerror(x, 'clock.sgstr', 'number or `tm` value expected for first argument')
   fi;
   create sequence str(3);
   if unassigned(d) then
      d := ':'
   elif d :- string then
      argerror(d, 'clock.sgstr', 'expected a string as second argument')
   fi;
   for i to 3 do
      insert strings.rjustify(int(rtm[i]), 2, '0') into str
   od;
   if float(rtm[3]) then  # 1.12.4 patch for fractional seconds
      local seconds := tostring(rtm[3]);
      str[3] := str[3] & seconds['.' in seconds to -1]
   fi;
   return join(str, d)
end;


clock.tmtodec := clock.todec;
clock.dectotm := clock.totm;

