#! /usr/local/bin/perl5.8.0 -w

use strict;
use 5.008;

use ATR::ProgSetup;
use Tk;
use ATR::Tk::AtrMain;

# $Source: /nfs/disk54/badger/cvs/AniTrack/bin/atr-demo.pl,v $
# $Revision: 1.101 $ $Date: 2005/12/12 11:39:36 $
our $VERSION = (qw$Revision: 1.101 $)[1];

#----------------------------------------------------------------------------
#
# AniTrack setup/teardown

use ATR::MicePE;
use ATR::Tk::Login;

{
    # Print out info about our Xserver, if we can
    my $log_fh = ATR::Tk::AtrMain->getInstance->getLogFh;
    my $xdpyinfo = "/usr/bin/X11/xdpyinfo";
    if (-x $xdpyinfo) {
	$xdpyinfo = `$xdpyinfo 2>&1`;
    } else {
	$xdpyinfo = "$xdpyinfo not available\n";
    }
    $log_fh->print("<=== xdpyinfo\n", $xdpyinfo, "===>\n");
}

{
    # GUI card pre-creation
    my $inst = ATR::Tk::AtrMain->getInstance;

    # Start with the faster card, because the first item must do
    # initial mapping of refFonts.  One of each is enough to start.
    $inst->afterIdle($inst, preCreate => qw(WeaningCard MatingCard));

    # Execution path through "after", login waitWindow() and assorted
    # update calls along the way... it's tortuous but works OK.

    # preCreate call starts while the Tk login window waits for valid
    # input, or if that doesn't happen then in MainLoop after
    # AtrNavigator is made.

    # If preCreate is still running when Tk login has finished,
    # preCreate hogs control and delays the creation of AtrNavigator.
}

ATR::Tk::Login->doGTxLogin(
			   # Shortcut for mca desktop machine
#			   Sys::Hostname::hostname() eq 'deskpro261' ? "OS" :
			   "GUI_barcode");


#----------------------------------------------------------------------------
#
# Local gui parts

use ATR::Tk::AtrNavigator;

our %radio = ( preview => 0); # peeked from ATR::Printing

{
    my $nav = ATR::Tk::AtrMain->ShowType('AtrNavigator');
    $nav->afterIdle(\&quickstart_args) if @ARGV;

    $nav->scaryBanner(ATR::BioTables->check_genotypes);
}

sub quickstart_args {
    my $nav = ATR::Tk::AtrMain->ShowType('AtrNavigator'); # finds existing
    foreach my $item (@ARGV) {
	if ($item =~ /^q(uit)?$/i) {
	    my $inst = ATR::Tk::AtrMain->getInstance;
	    $nav->afterIdle(sub { $inst->destroy });
	} elsif ($item =~ /^cl(ose|ear)$/) {
	    my $inst = ATR::Tk::AtrMain->getInstance;
	    my @pages = $inst->getAllPages();
	    my @close = ($item eq 'clear' ? @pages : $pages[-1]);
	    foreach my $w (@close) {
		next if ATR::Tk::AtrNavigator->asi($w);
		$inst->closeItemDelayed($w);
	    }
	    $inst->update;
	} else {
	    $nav->go_string($item);
	}
	$nav->update;
    }
}

MainLoop;
exit 0;


sub get_menu_data { # used from ATR::Tk::DebugFrame, where available
    my $mw = shift;
    return
 (Name => "origmenu", -menuitems =>
  [
#   [ Cascade => "~Debug", -menuitems =>
#     [
      [ Button => "~Debug dump widgets' structure", -command => sub { ATR::Tk::DebugFrame::showall() }],
      [ Checkbutton => "Preview only", -onvalue => 1, -offvalue => 0, -variable => \$radio{preview} ],
      [ Separator => "" ],
      [ Radiobutton => "Commit",   -value => 'commit',   -variable => ATR::DataSession->getDbmodeRef ],
      [ Radiobutton => "Rollback", -value => 'rollback', -variable => ATR::DataSession->getDbmodeRef ],
      [ Radiobutton => "~Hover",    -value => 'hover',    -variable => ATR::DataSession->getDbmodeRef ],
      [ Separator => "" ],
      [ Command => "Show system ~load info",
	-command => sub { warn Sys::Hostname::hostname, ":\n  ", `uptime` } ],
#     ]
#   ],
  ]);
}
