#!/usr/local/bin/perl

use 5.006002;

use strict;
use warnings;

use Astro::SpaceTrack qw{ :ref };
use IO::File;
use Tk;
use Tk::Pane;

our $VERSION = '0.172';

my @pad = qw{ -padx 5 -pady 5 };	# Standard cell padding

# Instantiate the Space Track accesor class.
my $st = Astro::SpaceTrack->new( @ARGV );

# Display the banner text if desired.
banner();

# Display the main window.
main_window();


# Display the banner text if desired, and wait for the user to dismiss
# it.
sub banner {

    $st->getv( 'banner' ) or return;

    my $mw = MainWindow->new( -title => 'Front Matter' );
    my $text = "SpaceTrackTk $VERSION" . $st->banner->content();
    $text =~ s/ \A \s+ //smx;
    $text =~ s/ \s+ \z //smx;
    $mw->Label( -text => $text )->pack( -side => 'top', @pad );
    $mw->Button( -text => 'OK', -command => sub { $mw->destroy() } )->
	pack( -side => 'bottom', @pad );

    MainLoop();

    return 1;
}

sub grid_args {
    my ( $hash, %arg ) = @_;
    my %merged = %{ $hash };
    foreach my $key ( keys %arg ) {
	$merged{$key} = $arg{$key};
    }
    my @rslt;
    while ( my ( $key, $val ) = each %merged ) {
	push @rslt, "-$key", $val;
    }
    exists $hash->{column}
	and $hash->{column} += ( $merged{columnspan} || 1 );
    return @rslt;
}

sub grid_new {
    my ( $row ) = @_;
    defined $row or $row = 0;
    return { row => $row, column => 0, padx => 5, pady => 5 };
}

sub grid_next_row {
    my ( $hash, $row ) = @_;
    if ( defined $row ) {
	$hash->{row} = $row;
    } else {
	$hash->{row}++;
    }
    $hash->{column} = 0;
    return;
}

# Main window
sub main_window {

    my %data;	# Data
    my %widget;	# Widget references

    $widget{main_window} = MainWindow->new(
	-title => 'Retrieve satellite orbital data' );

    # Set up the data frame.
    my $df = $widget{data_frame} = $widget{main_window}->Frame->pack(
	-side => 'top', @pad );

    # Create the data source label and widget, but don't put them in the
    # data frame yet.
    $widget{data_source_label} = $df->Label( -text => 'Data source:' );
    $widget{data_source_widget} = $df->Optionmenu(
	-variable => \$data{data_source},
	-command => sub { load_data_frame( \%widget, \%data ) },
    );
    load_data_source_widget( \%widget );

    # Set up the pushbuttons

    my @buttons;
    $widget{main_buttons} = \@buttons;

    my $bf = $widget{main_window}->Frame->pack(
	-side => 'bottom', @pad );
    my $bg = grid_new();

    push @buttons, $bf->Button(
	-text => 'Exit',
	-command => sub {
	    $widget{main_window}->destroy()
	}
    )->grid( grid_args( $bg ) );

    push @buttons, $bf->Button(
	-text => 'View data ...',
	-command => sub {
	    my @args = retrieve( \%widget, \%data )
		or return;
	    my $content = shift @args;
	    view_window( \%widget, "@args", $content );
	},
    )->grid( grid_args( $bg ) );

    push @buttons, $bf->Button(
	-text => 'Save data ...',
	-command => sub {
	    my $source = $data{data_source};
	    exists $data{save_file}{$source}
		or $data{save_file}{$source} = (
		ref $data{$source} || ! exists $data{$source} ) ?
		"$source.tle" : "$data{$source}.tle";
	    my $file = $widget{main_window}->getSaveFile(
		-filetypes => [
		    [ 'TLE files', '.tle', 'TEXT' ],
		    [ 'All files', '*' ],
		],
		-initialfile => $data{save_file}{$source},
		-defaultextension => '.txt',
		-title => 'Save TLE data',
	    );
	    defined $file and $file ne '' or return;
	    $data{save_file}{$source} = $file;
	    my @args = retrieve( \%widget, \%data )
		or return;
	    my $fh;
	    $fh = IO::File->new( $file, '>' )
		and print { $fh } $args[0]
		or $widget{main_window}->messageBox(
		-icon => 'error',
		-type => 'OK',
		-title => 'File open error',
		-message => $!,
	    );
	    return;
	},
    )->grid( grid_args( $bg ) );

    push @buttons, $bf->Button(
	-text => 'Settings ...',
	-command => sub{ settings( \%widget, \%data ); },
    )->grid( grid_args( $bg ) );

    # OK, now load the data frame with whatever is appropriate to the
    # default data source.
    load_data_frame( \%widget, \%data );

    MainLoop();

    return;

}

{
    my %authen;
    my %info;

    BEGIN {

	%authen = map { $_ => 1 } qw{ password username };

	%info = (
	    Checkbutton => {
		default => {
		    -relief => 'flat',
		},
		variable => '-variable',
	    },
	    Entry => {
		default => {
		    -relief => 'sunken',
		},
	    },
	);
    }

    my $settings;

    sub settings {
	my ( $widget, $data ) = @_;

	$settings and Exists( $settings ) and do {
	    $settings->raise();
	    return;
	};

	my %current = map { $_ => $st->getv( $_ ) } qw{ 
	    max_range password username identity verbose verify_hostname
	    webcmd
	};
	my %old = %current;

	$settings = $widget->{main_window}->Toplevel(
	    -title => 'Settings' );

	my $sg = grid_new();

	foreach (
	    'Access',
	    [ username => 'User Name:' ],
	    [ password => 'Password:', Entry => -show => '*' ],
	    [ identity => 'Identity from file:', 'Checkbutton' ],
	    'General',
	    [ max_range => 'Maximum range:' ],
	    [ verbose => 'Verbose Errors:', 'Checkbutton' ],
	    [ verify_hostname => 'Verify Host Name:', 'Checkbutton' ],
	    [ webcmd => 'Web Command:' ],
	) {
	    if ( ARRAY_REF eq ref $_ ) {
		my ( $name, $label, $entry, %args ) = @{ $_ };
		defined $entry or $entry = 'Entry';
		if ( $info{$entry}{default} ) {
		    while(  my ( $key, $val ) = each %{
			    $info{$entry}{default} } ) {
			exists $args{$key}
			    or $args{$key} = $val;
		    }
		}
		my $variable = $info{$entry}{variable} || '-textvariable';
		$settings->Label( -text => $label )->grid(
		    grid_args( $sg, sticky => 'e' ));
		$settings->$entry( %args, $variable => \$current{$name} )->grid(
		    grid_args( $sg, sticky => 'w' ) );
	    } else {
		$settings->Label( -text => $_ )->grid(
		    grid_args( $sg, columnspan => 2, sticky => 'ew' ) );
	    }

	    grid_next_row( $sg );
	}

	my $bf = $settings->Frame()->grid(
	    grid_args( $sg, columnspan => 2, sticky => 'ew' ) );
	my $bg = grid_new();

	$bf->Button( -text => 'Save', -command => sub {
		my $re_login;
		foreach my $key ( keys %current ) {
		    no warnings qw{ uninitialized };
		    $current{$key} eq $old{$key} and next;
		    if ( $key eq 'identity' ) {
			if ( $current{$key} ) {
			    $re_login = 1;
			} else {
			    $st->set( username => '', password => '' );
			    $st->logout();
			}
		    } else {
			$re_login ||= $authen{$key};
		    }
		    $st->set( $key => $current{$key} );
		}
		if ( $re_login ) {
		    my $rslt = $st->login();
		    $rslt->is_success() or do {
			$widget->{main_window}->messageBox(
			    -icon => 'error', -type => 'OK',
			    -title => 'Login failure',
			    -message => $rslt->status_line
			);
			return;
		    };
		    load_data_source_widget( $widget );
		    load_data_frame( $widget, $data );
		}
		$settings->destroy();
	    } )->grid( grid_args( $bg ) );

	$bf->Button( -text => 'Cancel', -command => sub {
		$settings->destroy();
		return;
	    } )->grid( grid_args( $bg ) );

	return;
    }
}

sub amsat_panel {
    my ( $widget, $data ) = @_;

    my $dg = grid_new( 1 );

    include_common_names( $widget, $data, $dg );

    return;
}

sub box_score_panel {
##  my ( $widget, $data ) = @_;		# Arguments unused
    return;
}

# Adjust the data panel to request Celestrak data.
sub celestrak_panel {
    my ( $widget, $data ) = @_;

    $widget->{celestrak} ||= {
	label => $widget->{data_frame}->Label( -text => 'Catalog name:'
	),
	selector => $widget->{data_frame}->Optionmenu(
	    -options => ( $st->names( 'celestrak' ) )[1],
	    -variable => \$data->{celestrak},
	),
    };

    my $dg = grid_new( 1 );
    $widget->{celestrak}{label}->grid( grid_args( $dg, sticky => 'e' ) );
    $widget->{celestrak}{selector}->grid( grid_args( $dg, sticky => 'w')
	)->raise();

    include_common_names( $widget, $data, $dg );

    return;
}

# Adjust the data panel to request Celestrak supplemental data
sub celestrak_supplemental_panel {
    my ( $widget, $data ) = @_;

    $widget->{celestrak_supplemental} ||= {
	label => $widget->{data_frame}->Label( -text => 'Catalog name:'
	),
	selector => $widget->{data_frame}->Optionmenu(
	    -options => ( $st->names( 'celestrak_supplemental' ) )[1],
	    -variable => \$data->{celestrak_supplemental}{name},
	),
	rms_label => $widget->{data_frame}->Label( -text => 'RMS:' ),
	rms_value => $widget->{data_frame}->Checkbutton(
	    -relief	=> 'flat',
	    -variable	=> \$data->{celestrak_supplemental}{rms},
	),
    };

    my $dg = grid_new( 1 );
    $widget->{celestrak_supplemental}{label}->grid( grid_args( $dg, sticky => 'e' ) );
    $widget->{celestrak_supplemental}{selector}->grid( grid_args( $dg, sticky => 'w')
	)->raise();
    grid_next_row( $dg );
    $widget->{celestrak_supplemental}{rms_label}->grid( grid_args( $dg, sticky => 'e' ) );
    $widget->{celestrak_supplemental}{rms_value}->grid( grid_args( $dg, sticky => 'w')
	)->raise();

    return;
}

sub celestrak_supplemental_args {
    my ( $data ) = @_;
    my @rslt;
    $data->{celestrak_supplemental}{rms}
	and push @rslt, '-rms';
    push @rslt, $data->{celestrak_supplemental}{name};
    return @rslt;
}

# Adjust the data panel to retrieve data specified in a local file.
sub file_panel {
    my ( $widget, $data ) = @_;

    $widget->{file} ||= {
	button => $widget->{data_frame}->Button(
	    -text => 'Find file ...',
	    -command => sub {
		my $file = $widget->{main_window}->getOpenFile(
		    -filetypes => [
			[ 'Text files' => '.txt', 'TEXT' ],
			[ 'All files', '*' ],
		    ],
		    -initialfile => $data->{file},
		    -defaultextension => '.txt',
		);
		$file and $data->{file} = $file;
	    },
	),
	value => $widget->{data_frame}->Entry(
	    -relief => 'sunken',
	    -state => 'readonly',
	    -width => 40,
	    -textvariable => \$data->{file},
	),
    };

    my $dg = grid_new( 1 );
    $widget->{file}{button}->grid( grid_args( $dg, sticky => 'e' )
	)->raise();
    $widget->{file}{value}->grid( grid_args( $dg, sticky => 'w' )
	)->raise();

    include_common_names( $widget, $data, $dg );

    return;
}

# Adjust the data panel to retrieve data from Space Track by OID.
sub retrieve_panel {
    my ( $widget, $data ) = @_;

    $widget->{retrieve} ||= {
	label => $widget->{data_frame}->Label(
	    -text => 'Satellite OIDs:'
	),
	value => $widget->{data_frame}->Entry(
	    -relief => 'sunken',
	    -textvariable => \$data->{retrieve}{value},
	),
    };

    my $dg = grid_new( 1 );
    $widget->{retrieve}{label}->grid( grid_args( $dg, sticky => 'e' ) );
    $widget->{retrieve}{value}->grid( grid_args( $dg, sticky => 'w' )
	)->raise();

    retrieve_options_widgets( $widget, retrieve => $data, $dg );

    return;
}

# Adjust the data panel to add widgets to specify the standard Space
# Track retrieval arguments.
sub retrieve_args {
    my ( $data ) = @_;
    my $val = $data->{retrieve}{value};
    $val =~ s/ ( \d ) [^-\d]* - [^-\d]* ( \d ) /$1-$2/smxg;
    return (
	retrieve_options_args( retrieve => $data ),
	split qr{ [^\d-]+ }smx, $val
    );
}

sub retrieve_options_widgets {
    my ( $widget, $source, $data, $dg ) = @_;

    $widget->{$source}{last5_label} ||= $widget->{data_frame}->Label(
	-text => 'Return last 5 data sets:' );
    $widget->{$source}{last5_value} ||= $widget->{data_frame}->Checkbutton(
	-relief => 'flat',
	-variable => \$data->{$source}{last5},
	-command => sub {
	    $widget->{$source}{start_value}->configure( -state =>
		$data->{$source}{last5} ? 'disable' : 'normal' );
	    $widget->{$source}{end_value}->configure( -state =>
		$data->{$source}{last5} ? 'disable' : 'normal' );
	},
    );

    $widget->{$source}{start_label} ||= $widget->{data_frame}->Label(
	-text => 'Start epoch (year-month-day):' );
    $widget->{$source}{start_value} ||= $widget->{data_frame}->Entry(
	-relief => 'sunken',
	-textvariable => \$data->{$source}{start_epoch},
    );

    $widget->{$source}{end_label} ||= $widget->{data_frame}->Label(
	-text => 'End epoch (year-month-day):' );
    $widget->{$source}{end_value} ||= $widget->{data_frame}->Entry(
	-relief => 'sunken',
	-textvariable => \$data->{$source}{end_epoch},
    );

    $widget->{$source}{sort_label} ||= $widget->{data_frame}->Label(
	-text => 'Sort order:' );
    $widget->{$source}{sort_value} ||= $widget->{data_frame}->Optionmenu(
	-options => [
	    [ 'Sort by OID number' => 'catnum' ],
	    [ 'Sort by epoch' => 'epoch' ],
	],
	-variable => \$data->{$source}{sort_type},
    );

    $widget->{$source}{desc_label} ||= $widget->{data_frame}->Label(
	-text => 'Sort in descending order:' );
    $widget->{$source}{desc_value} ||= $widget->{data_frame}->Checkbutton(
	-relief => 'flat',
	-variable => \$data->{$source}{descending},
    );

    grid_next_row( $dg );
    $widget->{$source}{last5_label}->grid(
	grid_args( $dg, sticky => 'e') );
    $widget->{$source}{last5_value}->grid(
	grid_args( $dg, sticky => 'w') )->raise();

    grid_next_row( $dg );
    $widget->{$source}{start_label}->grid(
	grid_args( $dg, sticky => 'e') );
    $widget->{$source}{start_value}->grid(
	grid_args( $dg, sticky => 'w') )->raise();

    grid_next_row( $dg );
    $widget->{$source}{end_label}->grid(
	grid_args( $dg, sticky => 'e') );
    $widget->{$source}{end_value}->grid(
	grid_args( $dg, sticky => 'w') )->raise();

    grid_next_row( $dg );
    $widget->{$source}{sort_label}->grid(
	grid_args( $dg, sticky => 'e') );
    $widget->{$source}{sort_value}->grid(
	grid_args( $dg, sticky => 'w') )->raise();

    grid_next_row( $dg );
    $widget->{$source}{desc_label}->grid(
	grid_args( $dg, sticky => 'e') );
    $widget->{$source}{desc_value}->grid(
	grid_args( $dg, sticky => 'w') )->raise();

    include_common_names( $widget, $data, $dg );

    return;
}

# Adjust the state of the standard Space Track retrieval widgets.
sub retrieve_options_widgets_state {
    my ( $widget, $source, $data ) = @_;

    my $state = ( exists $data->{$source}{retrieve_tle}
	&& ! $data->{$source}{retrieve_tle} ) ? 'disable' : 'normal';

    foreach my $name ( qw{ last5_value sort_value desc_value
	retrieve_rcs_value } ) {
	exists $widget->{$source}{$name} or next;
	$widget->{$source}{$name}->configure( -state => $state );
    }

    $data->{$source}{last5} and $state = 'disable';

    foreach my $name ( qw{ start_value end_value } ) {
	exists $widget->{$source}{$name} or next;
	$widget->{$source}{$name}->configure( -state => $state );
    }

    return;
}

# Return the standard Space Track retrieval arguments.
sub retrieve_options_args {
    my ( $source, $data ) = @_;
    my @rslt;

    exists $data->{$source}{retrieve_tle}
	and not $data->{$source}{retrieve_tle}
	and return @rslt;

    if ( $data->{$source}{last5} ) {
	push @rslt, '-last5';
    } else {
	$data->{$source}{start_epoch}
	    and push @rslt, '-start_epoch', $data->{$source}{start_epoch};
	$data->{$source}{end_epoch}
	    and push @rslt, '-end_epoch', $data->{$source}{end_epoch};
    }
    $data->{$source}{sort_type}
	and push @rslt, '-sort', $data->{$source}{sort_type};
    $data->{$source}{descending} and push @rslt, '-descending';

    return @rslt;

}

# Adjust the data panel to search for a date.
sub search_generic_date_panel {
    my ( $widget, $data, $source, $label ) = @_;

    $widget->{$source} ||= {
	year_label => $widget->{data_frame}->Label(
	    -text => "$label year:"
	),
	year => $widget->{data_frame}->Optionmenu(
	    -options => [ reverse 1959 .. ( localtime )[5] + 1900 ],
	    -variable => \$data->{$source}{year},
	),
	month_label => $widget->{data_frame}->Label(
	    -text => "$label month:"
	),
	month => $widget->{data_frame}->Optionmenu(
	    -options => [ '', 1 .. 12 ],
	    -variable => \$data->{$source}{month},
	),
	day_label => $widget->{data_frame}->Label(
	    -text => "$label day:"
	),
	day => $widget->{data_frame}->Optionmenu(
	    -options => [ '', 1 .. 31 ],
	    -variable => \$data->{$source}{day},
	),
    };

    my $dg = grid_new( 1 );
    $widget->{$source}{year_label}->grid( grid_args(
	    $dg, sticky => 'e' ) );
    $widget->{$source}{year}->grid( grid_args( $dg, sticky => 'w' )
	)->raise();

    grid_next_row( $dg );
    $widget->{$source}{month_label}->grid( grid_args(
	    $dg, sticky => 'e' ) );
    $widget->{$source}{month}->grid( grid_args( $dg, sticky => 'w' )
	)->raise();

    grid_next_row( $dg );
    $widget->{$source}{day_label}->grid( grid_args(
	    $dg, sticky => 'e' ) );
    $widget->{$source}{day}->grid( grid_args( $dg, sticky => 'w' )
	)->raise();

    search_options_widgets( $widget, $source => $data, $dg );

    return;
}

# Return the arguments for a generic Space Track date search.
sub search_generic_date_args {
    my ( $data ) = @_;
    my $source = $data->{data_source};
    my @date;
    foreach my $unit ( qw{ year month day } ) {
	defined( my $val = $data->{$source}{$unit} ) or last;
	$val eq '' and last;
	push @date, $val;
    }
    return (
	search_options_args( $source => $data ),
	retrieve_options_args( $source => $data ),
	join '-', @date
    );
}

# Adjust the data panel for a generic Space Track search.
sub search_generic_panel {
    my ( $widget, $data, $source, $label, $opt ) = @_;

    $widget->{$source} ||= {
	label => $widget->{data_frame}->Label(
	    -text => $label
	),
	value => $widget->{data_frame}->Entry(
	    -relief => 'sunken',
	    -textvariable => \$data->{$source}{value},
	),
    };

    my $dg = grid_new( 1 );
    $widget->{$source}{label}->grid( grid_args( $dg, sticky => 'e' ) );
    $widget->{$source}{value}->grid( grid_args( $dg, sticky => 'w' )
	)->raise();

    search_options_widgets( $widget, $source => $data, $dg, $opt );

    return;
}

# Return the arguments for a generic Space Track search.
sub search_generic_args {
    my ( $data ) = @_;
    my $source = $data->{data_source};
    return (
	search_options_args( $source => $data ),
	retrieve_options_args( $source => $data ),
	split qr{ [\s,;]+ }smx, $data->{$source}{value}
    );
}

# Adjust the data panel to search Space Track for satellites by launch
# date.
sub search_date_panel {
    my ( $widget, $data ) = @_;

    search_generic_date_panel( $widget, $data,
	search_date => 'Launch' );

    return;
}

# Return the arguments for the search_date() method.
sub search_date_args {
    goto &search_generic_date_args;
}

# Adjust the data panel to search Space Track for satellites by decay
# date.
sub search_decay_panel {
    my ( $widget, $data ) = @_;

    search_generic_date_panel( $widget, $data,
	search_decay => 'Decay' );

    return;
}

# Return the arguments for the search_decay() method.
sub search_decay_args {
    goto &search_generic_date_args;
}

# Adjust the data panel to search Space Track for satellites by
# international launch designator.
sub search_id_panel {
    my ( $widget, $data ) = @_;

    search_generic_panel( $widget, $data,
	search_id => 'International launch ID to search for:' );

    return;
}

# Return the arguments for the search_id() method.
sub search_id_args {
    goto &search_generic_args;
}

# Adjust the data panel to search Space Track for satellites by common
# name.
sub search_name_panel {
    my ( $widget, $data ) = @_;

    search_generic_panel( $widget, $data,
	search_name => 'Names to search for:' );

    return;
}

# Return the arguments for the search_name method.
sub search_name_args {
    goto &search_generic_args;
}

# Adjust the data panel to search Space Track for satellites by OID.
sub search_oid_panel {
    my ( $widget, $data ) = @_;

    search_generic_panel( $widget, $data,
	search_oid => 'OID(s) to search for:', { status => 0 } );

    return;

}

# Return the arguments for the search_oid method.
sub search_oid_args {
    goto &search_generic_args;
}

# Adjust the data panel to add widgets for the standard search
# arguments.
sub search_options_widgets {
    my ( $widget, $source, $data, $dg, $opt ) = @_;

    HASH_REF eq ref $opt
	or $opt = {};
    defined $opt->{status} or $opt->{status} = 1;

    if ( $data->{option}{status} = $opt->{status} ) {

	$widget->{$source}{search_status_label} ||=
	    $widget->{data_frame}->Label( -text => 'Desired status:' );
	$widget->{$source}{search_status_value} ||=
	    $widget->{data_frame}->Optionmenu(
		-options => [
		    [ 'All'		=> 'all' ],
		    [ 'On orbit'	=> 'onorbit' ],
		    [ 'Decayed'		=> 'decayed' ],
		],
		-variable => \$data->{$source}{search_status},
	    );

	$widget->{$source}{exclude_debris_label} ||=
	$widget->{data_frame}->Label( -text => 'Exclude debris:' );
	$widget->{$source}{exclude_debris_value} ||=
	    $widget->{data_frame}->Checkbutton(
		-relief => 'flat',
		-variable => \$data->{$source}{exclude_debris},
	    );

	$widget->{$source}{exclude_rocket_label} ||=
	$widget->{data_frame}->Label( -text => 'Exclude rocket bodies:' );
	$widget->{$source}{exclude_rocket_value} ||=
	    $widget->{data_frame}->Checkbutton(
		-relief => 'flat',
		-variable => \$data->{$source}{exclude_rocket},
	    );

    }

    exists $data->{$source}{retrieve_tle}
	or $data->{$source}{retrieve_tle} = 1;
    $widget->{$source}{retrieve_tle_label} ||=
    $widget->{data_frame}->Label( -text => 'Retrieve TLEs:' );
    $widget->{$source}{retrieve_tle_value} ||=
    $widget->{data_frame}->Checkbutton(
	-relief => 'flat',
	-variable => \$data->{$source}{retrieve_tle},
	-command => sub {
	    retrieve_options_widgets_state( $widget, $source, $data );
	    return;
	},
    );

    $widget->{$source}{retrieve_rcs_label} ||=
    $widget->{data_frame}->Label( -text => 'Retrieve radar cross section:' );
    $widget->{$source}{retrieve_rcs_value} ||=
    $widget->{data_frame}->Checkbutton(
	-relief => 'flat',
	-variable => \$data->{$source}{retrieve_rcs},
    );

    if ( $data->{option}{status} ) {

	grid_next_row( $dg );
	$widget->{$source}{search_status_label}->grid(
	    grid_args( $dg, sticky => 'e' ) );
	$widget->{$source}{search_status_value}->grid(
	    grid_args( $dg, sticky => 'w' ) )->raise();

	grid_next_row( $dg );
	$widget->{$source}{exclude_debris_label}->grid(
	    grid_args( $dg, sticky => 'e' ) );
	$widget->{$source}{exclude_debris_value}->grid(
	    grid_args( $dg, sticky => 'w' ) )->raise();

	grid_next_row( $dg );
	$widget->{$source}{exclude_rocket_label}->grid(
	    grid_args( $dg, sticky => 'e' ) );
	$widget->{$source}{exclude_rocket_value}->grid(
	    grid_args( $dg, sticky => 'w' ) )->raise();

    }

    grid_next_row( $dg );
    $widget->{$source}{retrieve_tle_label}->grid(
	grid_args( $dg, sticky => 'e' ) );
    $widget->{$source}{retrieve_tle_value}->grid(
	grid_args( $dg, sticky => 'w' ) )->raise();

    grid_next_row( $dg );
    $widget->{$source}{retrieve_rcs_label}->grid(
	grid_args( $dg, sticky => 'e' ) );
    $widget->{$source}{retrieve_rcs_value}->grid(
	grid_args( $dg, sticky => 'w' ) )->raise();

    retrieve_options_widgets( $widget, $source => $data, $dg );

    return;
}

# Generate standard search method arguments corresponding to the widget
# settings.
sub search_options_args {
    my ( $source, $data ) = @_;
    my @rslt;

    if ( $data->{option}{status} ) {

	$data->{$source}{search_status}
	    and push @rslt, '-status', $data->{$source}{search_status};
	my @exclude = grep { $data->{$source}{"exclude_$_"} } qw{ debris
	    rocket };
	@exclude and push @rslt, '-exclude', join ',', @exclude;

    }

    if ( $data->{$source}{retrieve_tle} ) {
	$data->{$source}{retrieve_rcs}
	    and push @rslt, '-rcs';
    } else {
	push @rslt, '-notle';
    }

    return @rslt;
}

# Adjust the data panel to retrieve Space Track catalogs.
sub spacetrack_panel {
    my ( $widget, $data ) = @_;

    $widget->{spacetrack} ||= {
	label => $widget->{data_frame}->Label(
	    -text => 'Catalog name:' ),
	value => $widget->{data_frame}->Optionmenu(
	    -options => ( $st->names( 'spacetrack' ) )[1],
	    -variable => \$data->{spacetrack},
	),
    };

    my $dg = grid_new( 1 );
    $widget->{spacetrack}{label}->grid(
	grid_args( $dg, sticky => 'e' ) );
    $widget->{spacetrack}{value}->grid(
	grid_args( $dg, sticky => 'w' ) )->raise();

    include_common_names( $widget, $data, $dg );

    return;
}

# Add to the data panel the widget to include common names in the data.
{
    sub include_common_names {
	my ( $widget, $data, $grid ) = @_;

	defined $data->{with_name}
	    or $data->{with_name} = $st->getv( 'with_name' );

	if ( $widget->{common_names} ) {
	    $widget->{common_names}{label}->gridForget();
	    $widget->{common_names}{value}->gridForget();
	}

	return;
    }
}

# Load the data frame for the selected data source.
sub load_data_frame {
    my ( $widget, $data ) = @_;

    foreach my $kid ( $widget->{data_frame}->children() ) {
	$kid->gridForget();
    }

    my $dg = grid_new();

    $widget->{data_source_label}->grid( grid_args( $dg, sticky => 'e' ) );
    $widget->{data_source_widget}->grid( grid_args( $dg, sticky => 'w' )
	)->raise();
    $widget->{data_source_widget}->focus();

    my $handler = __PACKAGE__->can( $data->{data_source} . '_panel' )
	or return;
    $handler->( $widget, $data );

    foreach my $button ( @{ $widget->{main_buttons} } ) {
	$button->raise();
    }

    return;
}

# Load the data source selector widget
{

    my @options;
    BEGIN {
	@options = (
	    [
		[ 'Celestrak catalog'		=> 'celestrak' ],
		[ 'Celestrak supplemental'	=> 'celestrak_supplemental' ],
		[ 'Local file catalog'		=> 'file' ],
		[ 'Radio Amateur Satellite Corporation data' => 'amsat' ],
		[ 'Space Track catalog'		=> 'spacetrack' ],
		[ 'Space Track decay date search' => 'search_decay' ],
		[ 'Space Track international designator search' =>
		    'search_id' ],
		[ 'Space Track launch date search' => 'search_date' ],
		[ 'Space Track name search'	=> 'search_name' ],
		[ 'Space Track OID search'	=> 'search_oid' ],
		[ 'Space Track satellite box score' => 'box_score' ],
		[ 'Space Track satellite OIDs'	=> 'retrieve' ],
	    ],
	    [
		[ 'Celestrak catalog'		=> 'celestrak' ],
		[ 'Celestrak supplemental'	=> 'celestrak_supplemental' ],
		[ 'Radio Amateur Satellite Corporation data' => 'amsat' ],
	    ],
	);
    }

    sub load_data_source_widget {
	my ( $widget ) = @_;
	# FIXME encapsulation violation. The intent is to find out
	# whether we think we have a valid Space Track login cookie.
	$widget->{data_source_widget}->options( $options[
		$st->_check_cookie_generic( 2 ) ? 0 : 1
	    ]
	);
	return;
    }

}

# Retrieve the desired data.
sub retrieve {
    my ( $widget, $data ) = @_;
    my $source = $data->{data_source};
    my @args;
    if ( my $handler = __PACKAGE__->can( $source . '_args' ) ) {
	@args = $handler->( $data );
    } elsif ( defined $data->{$source} ) {
	@args = $data->{$source};
    }
#   warn "Debug - \$st->$source( ", join( ', ', map { "'$_'" } @args ), ' )';
#   use JSON;
#   warn "Debug - \$data is ", to_json( $data, { pretty => 1 } ), ' ';
    my ( $error );
    if ( my $rslt = eval {
	    local $SIG{__WARN__} = sub {
		( my $msg = $_[0] ) =~
		    s/ \S+ \s+ \S* SpaceTrackTk .* //smx;
		$msg =~ s/ \s+ / /smxg;
		$widget->{main_window}->messageBox( -icon => 'warning',
		    -type => 'OK', -title => 'Data fetch warning',
		    -message => $msg,
		);
	    };
	    $st->$source( @args );
	} ) {
	$rslt->is_success()
	    and return ( $rslt->content(), $source, @args );
	$error = $rslt->status_line();
    } else {
	$error = $@ || 'An unknown error occurred';
    }
    $widget->{main_window}->messageBox( -icon => 'error', -type => 'OK',
	-title => 'Data fetch error',
	-message => $error,
    );
    return;
}

{

    my %tabbed;

    BEGIN {

	%tabbed = (
	    box_score => sub {
		my ( $hash ) = @_;
		if ( $hash->{row} == 0 && $hash->{column} > 0 &&
		    $hash->{column} < 9 ) {
		    return grid_args( $hash, columnspan => 4 );
		} else {
		    return grid_args( $hash );
		}
	    },
	    search => \&grid_args,
	);
    }

    sub view_window {
	my ( $widget, $title, $content ) = @_;

	my $vw = $widget->{main_window}->Toplevel(
	    -title => $title,
	    -borderwidth => 8,
	);

	if ( my $grid_args = $tabbed{ $st->content_type() } ) {

	    my $vf = $vw->Scrolled(
		Frame => -scrollbars => 'osoe',
		-width => 600, -height => 400,
	    )->pack( -expand => 1, -fill => 'both' );

	    my $vg = {
		row => 0, column => 0,
		sticky => 'nsew',
		ipadx => 2, ipady => 2,
	    };

	    my @lo = (
		-relief => 'sunken',
		-justify => 'left',
		-wraplength => '20m',
	    );

	    my $loc = 0;
	    while ( $content =~ m/ ( \t | \r \n? | \n ) /smxg ) {
		$vf->Label(
		    -text => substr( $content, $loc, $-[0] - $loc ),
		    @lo,
		)->grid( $grid_args->( $vg ) );
		$loc = $+[0];
		"\t" eq $1 or grid_next_row( $vg );
	    }

	    $loc < length $content
		and $vf->Label(
		    -text => substr( $content, $loc ),
		    @lo,
		)->grid( $grid_args->( $vg ) );

	} else {

	    my $tx = $vw->Scrolled( 'Text',
		-relief => 'sunken',
		-scrollbars => 'oe',
	    )->pack( -expand => 1, -fill => 'both' );
	    $tx->insert( '0.0', $content );

	}

	return;
    }
}

__END__

=head1 TITLE

SpaceTrackTk - Tk-based interface to Astro::SpaceTrack

=head1 SYNOPSIS

 SpaceTrackTk
 SpaceTrackTk username menuhin password yehudi with_name 1

=head1 OPTIONS

None

=head1 DETAILS

This script provides a L<Tk|Tk> front-end for
L<Astro::SpaceTrack|Astro::SpaceTrack>. The command arguments are passed
to the L<Astro::SpaceTrack|Astro::SpaceTrack> C<set()> method.

=head1 AUTHOR

Thomas R. Wyant, III F<wyant at cpan dot org>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2010-2026 by Thomas R. Wyant, III

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl 5.10.0. For more details, see the full text
of the licenses in the files F<LICENSE-Artistic> and F<LICENSE-GPL>.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=cut

# ex: set textwidth=72 :
