wkpmc

#!/usr/bin/perl -w
#
# Copyright (c) 2008 Rainer Clasen
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms described in the file LICENSE included in this
# distribution.
#


# TODO: pod

# TODO: adjust window title to include date range
use strict;
use DateTime;
use Getopt::Long;
use Workout;

use Gtk2 '-init';
use MyChart::Gtk;
use I18N::Langinfo qw(langinfo CODESET);

my $charset = langinfo(CODESET);
binmode STDIN, ":encoding($charset)";
binmode STDOUT, ":encoding($charset)";
binmode STDERR, ":encoding($charset)";


my $ctlconst = 42;
my $atlconst = 7;

my $debug;
my $ftp;
my $itype;

my $wanthelp;
my $needhelp;

if( ! GetOptions(
	"debug!"	=> \$debug,
	"ftp=i"		=> \$ftp,
	"help!"		=> \$wanthelp,
	"itype=s"	=> \$itype,
)){
	$needhelp++;
}

if( $wanthelp ){
	print <<EOF;
$0 [opt] <fnames> ...
plot Pmc Chart (CTL/ATL/TSB)

Options:
--itype=<type>      input file type for all files

--ftp=<power>       Functional Threshold Power

--debug             enable debuging output
--help              this cruft
EOF
	exit 0;
}

if( ! $ftp ){
	print STDERR "missing --ftp\n";
	$needhelp++;
}

if( $needhelp ){
	print STDERR "please use $0 --help for usage info\n";
	exit 1;
}

my( $first, $last ); # TODO: add option for this
my %tss;
foreach my $fname ( @ARGV ){
	$debug && print STDERR "reading $fname...\n";
	my $src = Workout::file_read( $fname, { 
		ftype	=> $itype,
		debug	=> $debug, 
	} );
	my $if = Workout::filter( 'FTP', $src, {
		debug	=> $debug,
		ftp	=> $ftp,
	});
	$if->finish;

	my $date = DateTime->from_epoch(
		epoch	=> $src->time_start,
		time_zone	=> 'local',
	)->truncate( to => 'day' );

	if( ! $first || $date < $first ){
		$first = $date->clone;
	}

	if( ! $last || $date > $last ){
		$last = $date->clone;
	}

	my $d = $date->ymd;
	#$tss{$d} ||= 0;
	$tss{$d} += ($if->tss ||0);
}

if( ! $first ){
	print "no data found\n";
	exit;
}

my $atlf = exp(-1/$atlconst);
my $ctlf = exp(-1/$ctlconst);

$debug && print STDERR "building ctl, atl, tsb ", $first->ymd, " to ", $last->ymd, "...\n";
my $ctl = 0; # TODO: option for initial value
my $atl = 0; # TODO: option for initial value
my @dat;
my( %min, %max );
my $day = $first->clone;
while( $day <= $last ){
	my $d = $day->ymd;
	my $tss = $tss{$d}||0;

	my $tsb = $ctl - $atl;
	$atl = $tss * (1- $atlf) + $atl * $atlf;
	$ctl = $tss * (1- $ctlf) + $ctl * $ctlf;

	$debug && print join("\t", $d, map { int($_) } ($tss, $atl, $ctl, $tsb) ),"\n";
	my %r = (
		time	=> $day->epoch,
		date	=> $d,
		tss	=> $tss,
		ctl	=> $ctl,
		atl	=> $atl, 
		tsb	=> $tsb,
	);
	push @dat, \%r;

	foreach my $f (qw( time tss ctl atl tsb )){
		if( ! defined $min{$f} || $min{$f} > $r{$f} ){
			$min{$f} = $r{$f};
		}

		if( ! defined $max{$f} || $max{$f} < $r{$f} ){
			$max{$f} = $r{$f};
		}

	}
	$day->add( days => 1 );
}


my $s = MyChart::Source->new( {
	list	=> \@dat,
	min	=> \%min,
	max	=> \%max,
} );


my $chart = MyChart->new;
$chart->add_scale(
	time	=> {
		orientation	=> 0,
		position	=> 1,
		label_fmt	=> sub {
			DateTime->from_epoch(
				epoch		=> $_[0],
				time_zone	=> 'local',
			)->ymd;
		},
		#label_rotate	=> 1,
	},
	tsb	=> {
		position	=> 1,
		label_fmt	=> '%d',
	},
	ctl	=> {
		position	=> 2,
		min		=> 0,
		label_fmt	=> '%d',
	},
);
$chart->add_plot({
	xscale	=> 'time',
	yscale	=> 'ctl',
	source	=> $s,
	xcol	=> 'time',
	ycol	=> 'ctl',
},{
	xscale	=> 'time',
	yscale	=> 'ctl',
	source	=> $s,
	xcol	=> 'time',
	ycol	=> 'atl',
},{
	xscale	=> 'time',
	yscale	=> 'tsb',
	source	=> $s,
	xcol	=> 'time',
	ycol	=> 'tsb',
});

my $win = Gtk2::Window->new;
$win->set_title( "wkpmc: ". $first->ymd ." - ". $last->ymd );
$win->signal_connect( 'destroy' => sub { Gtk2->main_quit } );
$win->signal_connect( 'size-request' => sub {
	my( $self, $req ) = @_;

	$req->width( 600 );
	$req->height( 300 );

	1;
} );

my $box = Gtk2::VBox->new;
$win->add( $box );

my $graph = MyChart::Gtk->new(
	chart	=> $chart,
);

$box->pack_start( $graph, 1, 1, 0 );

my $hbox = Gtk2::HBox->new;
$box->pack_start( $hbox, 0, 0, 0 );

# Quit 
my $quit = Gtk2::Button->new( 'Quit' );
$quit->signal_connect( clicked => sub {
	my( $button, $window ) = @_;
	$window->destroy;
}, $win );
$hbox->pack_start( $quit, 1, 0, 0 );




$win->show_all;
Gtk2->main;