#!/pro/bin/perl

use strict;
use warnings;

use     Test::More;
require Test::NoWarnings;

BEGIN {
    use_ok ("Tk");
    use_ok ("Tk::Clock");
    }

my ($delay, $period, $m, $c) = (0, $ENV{TK_TEST_LENGTH} || 5000);
unless ($m = eval { MainWindow->new  (-title => "clock") }) {
    diag ("No valid Tk environment");
    done_testing;
    exit 0;
    }

ok ($c = $m->Clock (-background => "Black"),	"Clock Widget");

# Safe to use en_US.UTF-8, as the fallback is C and all values are the same
foreach my $loc ("C", "en_US.UTF-8") {
    is (Tk::Clock::_month ($loc, 0, 0), "1",       "Month   format m    Jan in $loc");
    is (Tk::Clock::_month ($loc, 2, 1), "03",      "Month   format mm   Mar in $loc");
    is (Tk::Clock::_month ($loc, 4, 2), "May",     "Month   format mmm  May in $loc");
    is (Tk::Clock::_month ($loc, 6, 3), "July",    "Month   format mmmm Jul in $loc");

    is (Tk::Clock::_wday  ($loc, 0, 0), "Sun",     "Weekday format ddd  Sun in $loc");
    is (Tk::Clock::_wday  ($loc, 2, 1), "Tuesday", "Weekday format dddd Tue in $loc");
    }

like ($c->config (
    tickColor => "Orange",
    handColor => "Red",
    secsColor => "Green",
    timeColor => "lightBlue",
    dateColor => "Gold",
    timeFont  => "Helvetica 6",
    dateFont  => "Helvetica 6",
    ), qr(^Tk::Clock=HASH), "config");
ok ($c->pack (-expand => 1, -fill => "both"), "pack");
# Three stupid tests to align the rest
is ($delay, 0, "Delay is 0");
like ($period, qr/^\d+$/, "Period is $period");

$delay += $period;
like ($delay, qr/^\d+$/, "First after $delay");

$c->after ($delay, sub {
    $c->configure (-background => "Blue4");
    ok ($c->config (
	tickColor  => "Yellow",
	useAnalog  => 1,
	useInfo    => 0,
	useDigital => 0,
	), "Blue4   Ad Yellow");
    });

$delay += $period;
$c->after ($delay, sub {
    $c->configure (-background => "Tan4");
    ok ($c->config (
	useAnalog  => 0,
	useInfo    => 0,
	useDigital => 1,
	), "Tan4    aD");
    });

$delay += $period;
$c->after ($delay, sub {
    $c->configure (-background => "Maroon4");
    ok ($c->config (
	useAnalog  => 1,
	useInfo    => 1,
	useDigital => 4,	# Should be normalized to 1
	dateFormat => "m/d/y",
	timeFormat => "hh:MM A",
	_digSize   => 800,	# Should be ignored
	), "Maroon4 AD m/d/y hh:MM A");
    });

$delay += $period;
$c->after ($delay, sub {
    $c->configure (-background => "Red4");
    ok ($c->config (
	useAnalog  => 0,
	useInfo    => 0,
	useDigital => 1,
	dateFormat => "mmm yyy",
	timeFormat => "HH:MM:SS",
	), "Red4    aD mmm yyy HH:MM:SS");
    });

$delay += $period;
$c->after ($delay, sub {
    $c->configure (-background => "Gray10");
    ok ($c->config (
	useAnalog  => 1,
	useInfo    => 1,
	useDigital => 1,
	digiAlign  => "right",
	), "Gray10  right digital");
    });

$delay += $period;
$c->after ($delay, sub {
    $c->configure (-background => "Gray30");
    ok ($c->config (
	useAnalog  => 1,
	useInfo    => 0,
	useDigital => 1,
	digiAlign  => "left",
	), "Gray30  left digital");
    });

$delay += $period;
$c->after ($delay, sub {
    $c->configure (-background => "Purple4");
    ok ($c->config (
	useAnalog  => 0,
	useInfo    => 0,
	useDigital => 1,
	useLocale  => ($^O eq "MSWin32" ? "Japanese_Japan.932" : "ja_JP.utf8"),
	timeFont   => "Helvetica 8",
	dateFont   => "Helvetica 8",
	dateFormat => "dddd\nd mmm yyy",
	timeFormat => "",
	), "Purple4 aD dddd\\nd mmm yyy ''");
    });

$delay += $period;
$c->after ($delay, sub {
    $c->configure (-background => "Gray75");
    ok ($c->config (
	useAnalog  => 1,
	useInfo    => 1,
	useDigital => 0,
	anaScale   => 300,
	timeFont   => "Helvetica 12",
	dateFont   => "Helvetica 12",
	infoFormat => "Tk-Clock",
	), "Gray75  Ad scale 300");
    });

$delay += $period;
$c->after ($delay, sub {
    ok ($c->config (
	useAnalog  => 1,
	useInfo    => 0,
	useDigital => 0,
	anaScale   => 67,
	tickFreq   => 5,
	), "        Ad scale  67 tickFreq 5");
    });

$delay += $period;
$c->after ($delay, sub {
    ok ($c->config (
	useAnalog  => 1,
	useInfo    => 0,
	useDigital => 1,
	anaScale   => 100,
	tickFreq   => 5,
	dateFormat => "ww dd-mm",
	timeFormat => "dd HH:SS",
	), "        AD scale 100 tickFreq 5 ww dd-mm dd HH:SS");
    });

$delay += $period;
$c->after ($delay, sub {
    ok ($c->config ({
	anaScale   => 150,
	dateFont   => "Helvetica 9",
	}), "        Increase date font size");
    });

$delay += $period;
$c->after ($delay, sub {
    $c->configure (-background => "Black");
    ok ($c->config ({
	anaScale   => 250,
	useAnalog  => 1,
	useInfo    => 0,
	useDigital => 0,
	secsColor  => "Red",
	tickColor  => "White",
	handColor  => "White",
	handCenter => 1,
	tickFreq   => 1,
	tickDiff   => 1,
	}), "        Station clock: hand centers and tick width");
    });

$delay += $period;
$c->after ($delay, sub {
    $c->configure (-background => "Black");
    ok ($c->config ({
	useInfo     => 1,
	useDigital  => 1,
	anaScale    => 300,
	dateFormat  => "dd-mm-yyyy",
	timeFormat  => "HH:MM:SS",
	localOffset => -363967, # minus 4 days, 5 hours, 6 minutes and 7 seconds
	}), "        Station clock: Time offset -4'05:06:07");
    });

$delay += $period;
$c->after ($delay, sub {
    $c->destroy;
    ok (!Exists ($c), "Destroy Clock");
    $m->destroy;
    ok (!Exists ($m), "Destroy Main");

    Test::NoWarnings::had_no_warnings ();
    done_testing;
    });

MainLoop;