$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->Tk::LabelFmt::ClassInit($mw); } sub Populate { my ($w, $args) = @_; $w->Tk::LabelFmt::Populate($args); $w->ConfigSpecs( -undefstring => [qw/PASSIVE undefstring UndefString/, "-- --.--'?"], -formatcmd => [qw/CALLBACK formatCmd FormatCmd/, \&FormatCmdWgs], -axis => [qw/METHOD axis Axis/, "alt"], -compass => [qw/PASSIVE compass Compass/, ['N', 'S', 'E', 'W']], -format => [qw/PASSIVE format Format/, "%10.3f"], -bases => [qw/PASSIVE format Format/, [1, 60, 100] ], ); } my %AXIES = ('lat' => 0, 'lon' => 1, 'alt' => 2); sub axis { my $w = shift; return $w->{'axis'} if (!@_); # This is a cget. my $axis = shift; if (!exists $AXIES{$axis}) { $w->BackTrace("Invalid wgs type specified: '$axis'"); } else { $w->{'axis'} = $axis; } } sub FormatCmdWgs { my ($w, $dwgs) = @_; return $w->cget('-undefstring') if (!defined $dwgs); my $axis = $w->cget('-axis'); return sprintf($w->cget('-format'), $dwgs) if ($axis eq 'alt'); my $bases = $w->cget('-bases'); my $compass = $w->cget('-compass'); my $hemi = $compass->[$AXIES{$axis}*2+($dwgs < 0)]; $dwgs = abs($dwgs); my $deg = int $dwgs * $bases->[0]; $dwgs = ($dwgs - $deg) * $bases->[1]; my $min = int $dwgs; my $hmin = int (($dwgs - $min) * $bases->[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< >I<$lo> = I<$parent>-EB(I<-option> =E I, ... ); =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