<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">$Tk::LabelWgs::VERSION = 1.0;

package Tk::LabelWgs;

use base qw(Tk::LabelFmt);

use strict;

Construct Tk::Widget 'LabelWgs';

sub ClassInit {
    my ($class, $mw) = @_;
    $class-&gt;Tk::LabelFmt::ClassInit($mw);
}

sub Populate {
    my ($w, $args) = @_;
    $w-&gt;Tk::LabelFmt::Populate($args);
    $w-&gt;ConfigSpecs(
		    -undefstring =&gt;  [qw/PASSIVE undefstring UndefString/, "-- --.--'?"],
		    -formatcmd =&gt;    [qw/CALLBACK formatCmd FormatCmd/, \&amp;FormatCmdWgs],
		    -axis =&gt;         [qw/METHOD axis Axis/, "alt"],
		    -compass =&gt;      [qw/PASSIVE compass Compass/, ['N', 'S', 'E', 'W']],
		    -format  =&gt;      [qw/PASSIVE format Format/, "%10.3f"],
		    -bases  =&gt;       [qw/PASSIVE format Format/, [1, 60, 100] ],
		    );
}

my %AXIES = ('lat' =&gt; 0, 'lon' =&gt; 1, 'alt' =&gt; 2);

sub axis {
    my $w = shift;
    return $w-&gt;{'axis'} if (!@_); # This is a cget.
    my $axis = shift;
    if (!exists $AXIES{$axis}) {
	$w-&gt;BackTrace("Invalid wgs type specified: '$axis'");
    } else {
	$w-&gt;{'axis'} = $axis;
    }
}

sub FormatCmdWgs {
    my ($w, $dwgs) = @_;
    return $w-&gt;cget('-undefstring') if (!defined $dwgs);

    my $axis = $w-&gt;cget('-axis');
    return sprintf($w-&gt;cget('-format'), $dwgs) if ($axis eq 'alt');
    
    my $bases = $w-&gt;cget('-bases');

    my $compass = $w-&gt;cget('-compass');
    my $hemi = $compass-&gt;[$AXIES{$axis}*2+($dwgs &lt; 0)];
    $dwgs = abs($dwgs);
    my $deg = int $dwgs * $bases-&gt;[0];
    $dwgs = ($dwgs - $deg) * $bases-&gt;[1];
    my $min = int $dwgs;
    my $hmin = int (($dwgs - $min) * $bases-&gt;[2]);
    return sprintf("%02ld %02ld.%02ld' %s", $deg, $min, $hmin, $hemi);
}
#sub Configured { Tk::LabelFmt::Configured(@_); }

1;
__END__

=head1 NAME
Tk::LabelWgs - Print variables in wgs84 format.

=head1 SYNOPSIS

S&lt;    &gt;I&lt;$lo&gt; = I&lt;$parent&gt;-E&lt;gt&gt;B&lt;LabelWgs&gt;(I&lt;-option&gt; =E&lt;gt&gt; I&lt;value&gt;, ... );

=head1 DESCRIPTION

This widget is derived from LabelFmt and contains additional options for formatting wgs
latitude, longitude, and altitude values. The same options that are abailable for 
LabelFmt are also available here.

=over 4

=item B&lt;Label options&gt;

LabelTimer takes all valid options of Tk::Label;

=item B&lt;LabelFmt options&gt;

LabelTimer takes all valid options of Tk::LabelFmt;

=item B&lt;-axis&gt;

Must be one of 'lat', 'lon', or 'alt'. Default is 'alt'.

=item B&lt;-compass&gt;

A reference to an array of values to be displayed for north, south, east and west.
Default is ['N','S','E','W'].

=back

=head1 METHODS

None.

=head1 ADVERTISED WIDGETS

None.

=head1 EXAMPLES

my @position = (0,0,0);

I&lt;$lo&gt; = I&lt;$mw&gt;-E&lt;gt&gt;B&lt;LabelWgs&gt;(-axis=&gt;'lat', -textvariable =E&lt;gt&gt; \$position[0]);

I&lt;$lo&gt; = I&lt;$mw&gt;-E&lt;gt&gt;B&lt;LabelWgs&gt;(-axis=&gt;'lon', -textvariable =E&lt;gt&gt; \$position[1]);

I&lt;$lo&gt; = I&lt;$mw&gt;-E&lt;gt&gt;B&lt;LabelWgs&gt;(-axis=&gt;'alt', -textvariable =E&lt;gt&gt; \$position[2]);

@position = (1.0,2.0,3.0);

=head1 AUTHOR

viosca@imageman.com

This program is free software; you can redistribute it andor modify it and/ormodify it 
under the same terms as Perl itself.

=head1 SEE ALSO

L&lt;Tk::LabelFmt|Tk::LabelFmt&gt;
L&lt;Tk::LabelTimer|Tk::LabelTimer&gt;

=cut
</pre></body></html>