#! /usr/bin/perl -s

use IO::Handle;
use FileHandle;

BEGIN {
  STDERR->autoflush(1);

  ($me = $0) =~ s%^.*/|-(old|new)$%%g if !defined $me;
  $conf = $ENV{HOME} . '/.' . $me . '.pl' if !defined $conf;

  local *C;
  my $expr = '';

  if (open(C, "< $conf")) {
    {local $/; $expr = <C>;}
    close(C);
  }

  eval $expr if $expr ne '';
}

use Garmin::FIT;

$debug = 0 if !defined $debug;
$verbose = 0 if !defined $verbose;
$indent_step = 0 if !defined $indent_step;
$tplimit = 0 if !defined $tplimit;
$tplimit_smart = 1 if !defined $tplimit_smart;
$must = '' if !defined $must;
$double_precision = 7 if !defined $double_precision;
$gpxversion = '1.1' if !defined $gpxversion;
$gpxns = 'http://www.topografix.com/GPX/1/1' if !defined $gpxns;
$tpmask = '' if !defined $tpmask;
$tpfake = '' if !defined $tpfake;
$tpexclude = '' if !defined $tpexclude;
$tpdesc = 0 if !defined $tpdesc;
$show_version = 0 if !defined $show_version;
$metadata_name = '' if !defined $metadata_name;
$nl = "\n" if !defined $nl;
$single_trkseg = 0 if !defined $single_trkseg;

my $version = "0.01";
my $pm_version = Garmin::FIT->version_string;
my $full_version_string = "$me $version with Garmin::FIT $pm_version";

if ($show_version > 1) {
  print $full_version_string, "\n";
  exit;
}
elsif ($show_version) {
  print $version, "\n";
  exit;
}

my @must = split /,/, $must;
my @tpexclude = split /,/, $tpexclude;
my ($from, $to) = qw(- -);

if (@ARGV) {
  $from = shift @ARGV;
  @ARGV and $to = shift @ARGV;
}

my $xml_start = "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>$nl";
my $indent = ' ' x $indent_step;
my $pf = $double_precision eq '' ? 'g' : '.' . $double_precision . 'f';

my %gpx_def =
  (
   'name' => 'gpx',

   'attr' => [
	      +{'name' => 'version', 'fixed' => $gpxversion},
	      +{'name' => 'creator', 'fixed' => $full_version_string},
	      +{'name' => 'xmlns', 'fixed' => $gpxns},
	      ],

   'sub' => [ 
	     +{
	       'name' => 'metadata',

	       'sub' => [
			 +{'name' => 'name', 'format' => 's'},
			 +{'name' => 'time', 'format' => 's'},
			 ],
	       },

	     +{
	       'name' => 'trk',

	       'sub' => [
			 +{
			   'name' => 'trkseg',

			   'sub' => [
				     +{
				       'name' => 'trkpt',

				       'attr' => [
						  +{'name' => 'lat', 'format' => $pf},
						  +{'name' => 'lon', 'format' => $pf},
						  ],

				       'sub' => [
						 +{'name' => 'ele', 'format' => $pf},
						 +{'name' => 'time', 'format' => 's'},
						 +{'name' => 'desc', 'format' => 's'},
						 ],
				       },
				     ],
				       },
			 ],
				       },
	     ],
   );

sub cmp_long {
  my ($a, $b) = @_;

  if ($a < $b) {
    if ($a - $b <= -180) {
      1;
    }
    else {
      -1;
    }
  }
  elsif ($a > $b) {
    if ($a - $b >= 180) {
      -1;
    }
    else {
      1;
    }
  }
  else {
    0;
  }
}

sub tpmask_rect {
  my ($lat, $lon, $lat_sw, $lon_sw, $lat_ne, $lon_ne) = @_;

  $lat >= $lat_sw && $lat <= $lat_ne && &cmp_long($lon, $lon_sw) >= 0 && &cmp_long($lon, $lon_ne) <= 0;
}

sub tpmask_make {
  my ($masks, $maskv) = @_;
  my $mask;

  foreach $mask (split /:|\s+/, $masks) {
    my @v = split /,/, $mask;

    if (@v % 2) {
      die "$mask: not a sequence of latitude and longitude pairs";
    }
    elsif (@v < 4) {
      die "$mask: \# of vertices < 2";
    }
    elsif (@v > 4) {
      die "$mask: sorry but arbitrary polygons are not implemented";
    }
    else {
      grep {
	s/^\s+|\s+$//g;
      } @v;

      $v[0] > $v[2] and @v[0, 2] = @v[2, 0];
      &cmp_long($v[1], $v[3]) > 0 and @v[1, 3] = @v[3, 1];
      push @$maskv, [\&tpmask_rect, @v];
    }
  }
}

my @tpmask;

&tpmask_make($tpmask, \@tpmask);

my %memo = ('tpv' => [], 'tsv' => [], 'gpxv' => [], 'lap_id' => 1);
my $fit = new Garmin::FIT;

$fit->use_gmtime(1);
$fit->numeric_date_time(0);
$fit->semicircles_to_degree(1);
$fit->without_unit(1);

sub cb_file_id {
  my ($obj, $desc, $v, $memo) = @_;
  my $file_type = $obj->value_cooked(@{$desc}{qw(t_type a_type I_type)}, $v->[$desc->{i_type}]);

  if ($file_type eq 'activity') {
    1;
  }
  else {
    $obj->error("$file_type: not an activity");
    undef;
  }
}

sub cb_record {
  my ($obj, $desc, $v, $memo) = @_;
  my (%tp, $lat, $lon, $speed, $watts);

  $lat = $obj->value_processed($v->[$desc->{i_position_lat}], $desc->{a_position_lat})
    if defined $desc->{i_position_lat} && $v->[$desc->{i_position_lat}] != $desc->{I_position_lat};

  $lon = $obj->value_processed($v->[$desc->{i_position_long}], $desc->{a_position_long})
    if defined $desc->{i_position_long} && $v->[$desc->{i_position_long}] != $desc->{I_position_long};

  if (defined $lat && defined $lon) {
    $tp{time} = $obj->named_type_value($desc->{t_timestamp}, $v->[$desc->{i_timestamp}]);

    unless (defined $memo->{id}) {
      if ($metadata_name eq '') {
	$memo->{id} = $tp{time};
      }
      else {
	$memo->{id} = "$metadata_name ($tp{time})";
      }
    }

    defined $lat and $tp{'<a>lat'} = $lat;

    defined $lon and $tp{'<a>lon'} = $lon;

    $tp{ele} = $obj->value_processed($v->[$desc->{i_altitude}], $desc->{a_altitude})
      if defined $desc->{i_altitude} && $v->[$desc->{i_altitude}] != $desc->{I_altitude};

    my ($miss, $k);

    foreach $k (@tpexclude) {
      delete $tp{$k};
    }

    foreach $k (@must) {
      defined $tp{$k} or ++$miss;
    }

    unless ($miss) {
      if ($tpdesc && (!@{$memo->{tpv}} || $tpdesc > 1)) {
	my $desc = sprintf('lap %d', $memo->{lap_id});

	if ($memo->{event_desc} ne '') {
	  $desc .= ', ' . $memo->{event_desc};
	  $memo->{event_desc} = '';
	}

	$tp{desc} = $desc;
      }

      push @{$memo->{tpv}}, \%tp;
    }
  }

  1;
}

sub track_end {
  my ($memo, $force) = @_;
  my $ntps = @{$memo->{tpv}};

  if ($ntps && (!$single_trkseg || $force)) {
    my %ts = ('trkpt' => [@{$memo->{tpv}}]);

    @{$memo->{tpv}} = ();
    $memo->{ntps} += $ntps;
    push @{$memo->{tsv}}, \%ts;
  }
}

sub cb_event {
  my ($obj, $desc, $v, $memo) = @_;
  my $event = $obj->named_type_value($desc->{t_event}, $v->[$desc->{i_event}]);
  my $event_type = $obj->named_type_value($desc->{t_event_type}, $v->[$desc->{i_event_type}]);

  if ($event_type eq 'stop_all' || $event_type eq 'stop') {
    &track_end($memo);
    $memo->{event_desc} = "restart after $event_type";
  }

  1;
}

sub cb_lap {
  my ($obj, $desc, $v, $memo) = @_;

  &track_end($memo);
  $memo->{lap_id} += 1;
  1;
}

sub cb_session {
  my ($obj, $desc, $v, $memo) = @_;

  &track_end($memo, 1);

  if (@{$memo->{tsv}}) {
    my (%md, %ts);

    $md{name} = $memo->{id};
    $md{time} = $obj->named_type_value($desc->{t_start_time}, $v->[$desc->{i_start_time}]);
    push @{$memo->{gpxv}}, +{'metadata' => \%md, 'trk' => +{'trkseg' => [@{$memo->{tsv}}]}};
  }

  @{$memo->{tpv}} = ();
  @{$memo->{tsv}} = ();
  delete $memo->{id};
  1;
}

sub output {
  my ($datum, $def, $indent, $T) = @_;

  if (ref $datum eq 'ARRAY') {
    my $datum1;

    foreach $datum1 (@$datum) {
      &output($datum1, $def, $indent, $T);
    }
  }
  else {
    $T->print("$indent<$def->{name}");

    my $attrv = $def->{attr};

    if (ref $attrv eq 'ARRAY') {
      my $attr;

      foreach $attr (@$attrv) {
	my ($aname, $aformat, $afixed) = @{$attr}{qw(name format fixed)};

	$T->print(" $aname=\"");

	if (defined $afixed) {
	  $T->print($afixed);
	}
	elsif (defined $aformat) {
	  $T->printf("%$aformat", $datum->{'<a>' . $aname});
	}

	$T->print("\"");
      }
    }

    $T->print(">");

    my ($sub, $format) = @{$def}{qw(sub format)};

    if ($format ne '') {
      $T->printf("%$format", $datum);
    }
    elsif (ref $sub eq 'ARRAY') {
      $T->print($nl);

      my $subindent = $indent . ' ' x $indent_step;
      my $i;

      for ($i = 0 ; $i < @$sub ;) {
	my $subdef = $sub->[$i++];
	my $subdatum = $datum->{$subdef->{name}};

	defined $subdatum and &output($subdatum, $subdef, $subindent, $T);
      }

      $T->print($indent);
    }

    $T->print("</$def->{name}>$nl");
  }
}

$fit->data_message_callback_by_name('file_id', \&cb_file_id, \%memo) || die $fit->error;
$fit->data_message_callback_by_name('record', \&cb_record, \%memo) || die $fit->error;
$fit->data_message_callback_by_name('event', \&cb_event, \%memo) || die $fit->error;
$fit->data_message_callback_by_name('lap', \&cb_lap, \%memo) || die $fit->error;
$fit->data_message_callback_by_name('session', \&cb_session, \%memo) || die $fit->error;
$fit->file($from);
$fit->open || die $fit->error;

sub dead {
  my ($obj, $err) = @_;
  my ($p, $fn, $l, $subr, $fit);

  $err = $obj->{error} if !defined $err;
  (undef, $fn, $l) = caller(0);
  ($p, undef, undef, $subr) = caller(1);
  $obj->close;
  die "$p::$subr\#$l\@$fn: $err\n";
}

my ($fsize, $proto_ver, $prof_ver, $h_extra, $h_crc_expected, $h_crc_calculated) = $fit->fetch_header;

defined $fsize || &dead($fit);

my ($proto_major, $proto_minor) = $fit->protocol_version_major($proto_ver);
my ($prof_major, $prof_minor) = $fit->profile_version_major($prof_ver);

if ($verbose) {
  printf "File size: %lu, protocol version: %u.%02u, profile_verion: %u.%02u\n", $fsize, $proto_major, $proto_minor, $prof_major, $prof_minor;

  if ($h_extra ne '') {
    print "Hex dump of extra octets in the file header";

    my ($i, $n);

    for ($i = 0, $n = length($h_extra) ; $i < $n ; ++$i) {
      print "\n  " if !($i % 16);
      print ' ' if !($i % 4);
      printf " %02x", ord(substr($h_extra, $i, 1));
    }

    print "\n";
  }

  if (defined $h_crc_calculated) {
    printf "File header CRC: expected=0x%04X, calculated=0x%04X\n", $h_crc_expected, $h_crc_calculated;
  }
}

1 while $fit->fetch;
$fit->EOF || &dead($fit);

if ($verbose) {
  printf "CRC: expected=0x%04X, calculated=0x%04X\n", $fit->crc_expected, $fit->crc;

  my $garbage_size = $fit->trailing_garbages;

  print "Trailing $garbage_size octets garbages skipped\n" if $garbage_size > 0;
}

$fit->close;

my $gpxv = $memo{gpxv};

if (@$gpxv && @tpmask) {
  my ($i, $j);

  for ($i = $j = 0 ; $i < @$gpxv ; ++$i) {
    my $tsv = $gpxv->[$i]->{trk}->{trkseg};
    my ($p, $q);

    for ($p = $q = 0 ; $p < @$tsv ; ++$p) {
      my $tpv = $tsv->[$p]->{trkpt};
      my $tp0 = $tpv->[0];
      my ($r, $s);

      for ($r = $s = 0 ; $r < @$tpv ; ++$r) {
	my ($mask, $masked);

	foreach $mask (@tpmask) {
	  if ($mask->[0]->(@{$tpv->[$r]}{qw(<a>lat <a>lon)}, @$mask[1 .. $#$mask])) {
	    $memo{ntps} -= 1;
	    $masked = 1;
	    last;
	  }
	}

	$masked or $tpv->[$s++] = $tpv->[$r];
      }

      splice @$tpv, $s;

      if (@$tpv) {
	$tpv->[0] ne $tp0 and $tp0->{desc} ne '' and $tpv->[0]->{desc} = $tp0->{desc};
	$tsv->[$q++] = $tsv->[$p];
      }
    }

    splice @$tsv, $q;
    @$tsv and $gpxv->[$j++] = $gpxv->[$i];
  }

  splice @$gpxv, $j;
}

if (@$gpxv) {
  my $T = new FileHandle "> $to";

  defined $T || &dead($fit, "new FileHandle \"> $to\": $!");
  $T->print($xml_start);

  my ($skip, $gpx);

  if ($tplimit > 0 && ($skip = $memo{ntps} / $tplimit) > 1) {
    foreach $gpx (@$gpxv) {
      my $tsv;

      foreach $tsv (@{$gpx->{trk}->{trkseg}}) {
	my $ts;

	foreach $ts (@$tsv) {
	  my $tpv = $ts->{trkpt};
	  my ($i, $j, @mv);

	  if ($tplimit_smart && defined $tpv->[0]->{ele}) {
	    for ($i = 1 ; $i < $#$tpv ;) {
	      my $updown;

	      for ($j = $i + 1 ; $j < @$tpv ; ++$j) {
		if (defined $tpv->[$j]->{ele}) {
		  if (($updown = $tpv->[$j]->{ele} - $tpv->[$i]->{ele})) {
		    last;
		  }
		}
	      }

	      if ($updown) {
		my $k;

		for ($k = $j + 1 ; $k < @$tpv ; ++$k) {
		  if (defined $tpv->[$k]->{ele}) {
		    if (($tpv->[$k]->{ele} - $tpv->[$j]->{ele}) / $updown < 0) {
		      last;
		    }
		  }
		}

		if ($k < @$tpv && $k - $i > $skip) {
		  push @mv, $k;
		}

		$i = $j;
	      }
	      else {
		last;
	      }
	    }
	  }

	  push @mv, $#$tpv + 1;

	  for ($i = $j = 1 ; @mv ;) {
	    my $m = shift @mv;
	    my $start = $i;
	    my $count;

	    for ($count = 1 ; $i < $m ; ++$j, ++$count) {
	      my $next = $start + int($count * $skip);
	      my $k = $next;

	      $k > $m and $k = $m;
	      $tpv->[$j] = $tpv->[$k - 1];
	      $i = $k;
	    }
	  }

	  $j < @$tpv and splice @$tpv, $j;
	}
      }
    }
  }

  foreach $gpx (@$gpxv) {
    &output($gpx, \%gpx_def, '', $T);
  }

  $T->close;
}

1;
__END__

=head1 NAME

Fit2sgpx - converts a FIT file to a simple GPX file

=head1 SYNOPSIS

  fit2sgpx [<options>] [<FIT activity file> [<GPX file>]]

=head1 DESCRIPTION

B<Fit2sgpx> picks up just the GPS tracking logs from I<<FIT activity file>>,
converts them to correspoding simple GPX formats without any extensions,
and write them to I<<GPX file>>.

=for html The latest version is obtained via

=for html <blockquote>

=for html <!--#include virtual="/cgi-perl/showfile?/cycling/pub/fit2sgpx-[0-9]*.tar.gz"-->.

=for html </blockquote>

It uses a Perl class

=for html <blockquote><a href="GarminFIT.shtml">

C<Garmin::FIT>

=for html </a></blockquote>

of version 0.10 or later.

=head2 Options

=over 4

=item C<-show_version>C<=>I<<non zero number>>

shows the version string of this program,
and exits.
If I<<non zero number>> is greater than 1,
it shows somewhat detailed informations.

=item C<-verbose=1>

shows FIT file header and trailing CRC information on C<stdout>.

=item C<-tplimit=>I<<number>>

tries to limit the number of trackpoints to I<<number>>.

=item C<-must=>I<<list>>

specifies a comma separated list of GPX elements which must be included in trackpoints.

B<Fit2sgpx> convert each C<record> message to a trackpoint in GPX format,
examines whether or not any of the elements in the list are defined,
and drop the trackpoint if not.

=item C<-tpexclude=>I<<list>>

specifies a comma separated list of GPX elements which should be excluded from C<trkpt> elements in I<<GPX file>>.

=item C<-tpmask=>I<<list>>

specifies a colon or space separated list of I<<region>>s,
in which trackpoinsts must be excluded from I<<GPX file>>.

A I<<region>> must be a comma separated quadruple of the form I<<lat_sw>>C<,>I<<long_sw>>C<,>I<<lat_ne>>C<,>I<<long_ne>>.
I<<lat_*>> must be degrees of latitudes,
and I<<long_*>> must be degrees of longitudes.
Suffices I<_sw> and I<_ne> stand for "south west" and "north east", respectively.

Trackpoints in the "rectangle" (including borders) enclosed with paralles and meridians determined by the above latitudes and longitudes,
are not written to I<<GPX file>>.

=item C<-single_trkseg=1>

Unless this option specified,
C<trkseg> elements are divided after the ride paused or a new lap started.

=item C<-tpdesc=>I<<non zero number>>

If this option specified,
some trackpoints include C<desc> elements,
which describe lap numbers and the cause of enclosing C<trkseg> elements if the trackpoints are the first ones.

If I<<non zero number>> is greater than 1,
lap numbers are included in all trackpoints.
Otherwise,
they are included only in the first trackpoints in C<trkseg> elements.

=item C<-metadata_name=>I<<string>>

I<<GPX file>> includes C<metadata> with a C<name> element.
Without this option,
the contents of C<name> is the timestamp (say I<<TS>>) of the first trackpoint.

When this option is specified,
the contents is of the form E<quot>I<<string>> (I<<TS>>)E<quot>.

=item C<-indent_step=>I<<number>>

If you need more human readablility of I<<GPX file>>,
you can specify a positive number as I<<number>>.

=item C<-nl=>

If you need no human readablitity of I<<GPX file>> at all,
you may specify this option.

=back

=head2 Per user configuration file C<.fit2sgpx.pl>

B<Fit2sgpx> evaluates the contents of the file C<.fit2sgpx.pl> in your home directory if it exists,
before starting conversion.
So,
in the file,
you can set appropriate values to scalar variables of the same names of the above options with leading hyphens removed,
and will get the same effects as giving the command line options.

=head1 AUTHOR

Kiyokazu SUTO E<lt>suto@ks-and-ks.ne.jpE<gt>

=head1 DISCLAIMER etc.

This program is distributed with
ABSOLUTELY NO WARRANTY.

Anyone can use, modify, and re-distibute this program
without any restriction.

=cut
