Blame |
Last modification |
View Log
| RSS feed
#!/usr/bin/perl
#!/usr/bin/perl -d:ptkdb
###############################################################################
#
# libmkcockpit.pl - MK Mission Cockpit - Subroutined for GUI Frontend
#
# Copyright (C) 2009 Rainer Walther (rainerwalther-mail@web.de)
#
# Creative Commons Lizenz mit den Zusaetzen (by, nc, sa)
#
# Es ist Ihnen gestattet:
# * das Werk vervielfältigen, verbreiten und öffentlich zugänglich machen
# * Abwandlungen bzw. Bearbeitungen des Inhaltes anfertigen
#
# Zu den folgenden Bedingungen:
# * Namensnennung.
# Sie müssen den Namen des Autors/Rechteinhabers in der von ihm festgelegten Weise nennen.
# * Keine kommerzielle Nutzung.
# Dieses Werk darf nicht für kommerzielle Zwecke verwendet werden.
# * Weitergabe unter gleichen Bedingungen.
# Wenn Sie den lizenzierten Inhalt bearbeiten oder in anderer Weise umgestalten,
# verändern oder als Grundlage für einen anderen Inhalt verwenden,
# dürfen Sie den neu entstandenen Inhalt nur unter Verwendung von Lizenzbedingungen
# weitergeben, die mit denen dieses Lizenzvertrages identisch oder vergleichbar sind.
#
# Im Falle einer Verbreitung müssen Sie anderen die Lizenzbedingungen, unter welche dieses
# Werk fällt, mitteilen. Am Einfachsten ist es, einen Link auf diese Seite einzubinden.
#
# Jede der vorgenannten Bedingungen kann aufgehoben werden, sofern Sie die Einwilligung
# des Rechteinhabers dazu erhalten.
#
# Diese Lizenz lässt die Urheberpersönlichkeitsrechte unberührt.
#
# Weitere Details zur Lizenzbestimmung gibt es hier:
# Kurzform: http://creativecommons.org/licenses/by-nc-sa/3.0/de/
# Komplett: http://creativecommons.org/licenses/by-nc-sa/3.0/de/legalcode
#
###############################################################################
# 2009-08-09 0.2.5 rw subroutines moved from mkcockpit.pl
# 2009-09-05 0.2.6 rw POI heading control added
# 2009-10-10 0.2.7 rw Layout Config-dialog
# Fix Message-Balloon in KML-Mode
# 2009-10-25 0.3.0 rw NC 0.17
# Read/Write KopterTool WPL Waypoint list
# configuration Combo Box
# 2010-02-10 0.4.0 rw Show Grid on map
# Show crosshair in player pause mode
# joystick and 3D-Mouse support
# Cfg file selection dialog
# serial channel
# Event engine
# External control - Limit, expo
# Resize WP-Icon to 24x48 pixel
# 2010-02-14 0.4.1 rw ExpoLimit
# 2010-02-15 0.4.2 rw Input control parser added
# FctKey, RcStick, RcPoti input device
#
###############################################################################
$Version{'libmkcockpit.pl'} = "0.4.0 - 2010-02-10";
# check, if %MkOsd is valid
sub MkOsdIsValid
()
{
return ( $MkOsd{'_Timestamp'} >= time
-2 );
}
# check, if current GPS position is valid
sub CurPosIsValid
()
{
return ( &MkOsdIsValid() and $MkOsd{'SatsInUse'} >= 6 and $MkOsd{'CurPos_Stat'} == 1 );
}
# check, if home GPS position is valid
sub HomePosIsValid
()
{
return ( &MkOsdIsValid() and $MkOsd{'SatsInUse'} >= 6 and $MkOsd{'HomePos_Stat'} == 1 );
}
# check, if target GPS position is valid
sub TargetIsValid
()
{
return ( &MkOsdIsValid() and $MkOsd{'SatsInUse'} >= 6 and $MkOsd{'TargetPos_Stat'} == 1 );
}
# check, if motor are on
sub MkIsMotorOn
()
{
return ( &MkOsdIsValid() and $MkOsd{'MKFlags'} & 0x01
);
}
# check, if MK is flying
sub MkIsFlying
()
{
return ( &MkOsdIsValid() and $MkOsd{'MKFlags'} & 0x02
);
}
# check, if MK is calibrating
sub MkIsCalibrating
()
{
return ( &MkOsdIsValid() and $MkOsd{'MKFlags'} & 0x04
);
}
# check, if Motor is starting
sub MkIsMotorStarting
()
{
return ( &MkOsdIsValid() and $MkOsd{'MKFlags'} & 0x08
);
}
# check, Emergency Landing
sub MkEmergencyLanding
()
{
return ( &MkOsdIsValid() and $MkOsd{'MKFlags'} & 0x10
);
}
# check, if MK is FREE Mode
sub MkIsFreeMode
()
{
return ( &MkOsdIsValid() and $MkOsd{'NCFlags'} & 0x01
);
}
# check, if MK is in PH Mode
sub MkIsPhMode
()
{
return ( &MkOsdIsValid() and $MkOsd{'NCFlags'} & 0x02
);
}
# check, if MK is in WPT Mode
sub MkIsWptMode
()
{
return ( &MkOsdIsValid() and $MkOsd{'NCFlags'} & 0x04
);
}
# check, Range Limit
sub MkRangeLimit
()
{
return ( &MkOsdIsValid() and $MkOsd{'NCFlags'} & 0x08
);
}
# check, Serial Link
sub MkSerialLink
()
{
return ( &MkOsdIsValid() and $MkOsd{'NCFlags'} & 0x10
);
}
# check, Target reached
sub MkTargetReached
()
{
return ( &MkOsdIsValid() and $MkOsd{'NCFlags'} & 0x20
);
}
# check, Manual Control
sub MkManualControl
()
{
return ( &MkOsdIsValid() and $MkOsd{'NCFlags'} & 0x40
);
}
# Get altitude (hoehensensor)
sub AltitudeAir
()
{
return ( $MkOsd{'Altimeter'} / $Cfg->{'map'}->{'AltFactor'} );
}
# Get altitude (GPS)
sub AltitudeGPS
()
{
return ( $MkOsd{'CurPos_Alt'} - $MkOsd{'HomePos_Alt'} );
}
# Get altitude (average hoehensensor , GPS)
sub Altitude
()
{
my $Alt = ( 4 * &AltitudeAir + &AltitudeGPS ) / 5;
return ($Alt);
}
# check, if Fct-Key "Num" pressed, Num = 1..12
sub FctKey
()
{
my ($Num) = @_;
$Num--;
return (($Stick{'FctKey'} >> $Num) & 1) == 1;
}
# Get RcPoti value. Poti = 1..8
sub RcPoti
()
{
my ($Poti) = @_;
return $Stick{"RcPoti" . "$Poti"};
}
# Get Rc Stick value. Stick = Nick, Roll, Gas, Gier
sub RcStick
()
{
my ($Stick) = @_;
return $Stick{"RcStick" . "$Stick"};
}
# range 0 .. 255
sub CheckUnsignedChar
()
{
my ($U8) = @_;
if ( $U8 < 0) { $U8 = 0; };
if ( $U8 > 255) { $U8 = 255; };
return $U8;
}
# range -128 .. 127
sub CheckSignedChar
()
{
my ($S8) = @_;
if ( $S8 < -128) { $S8 = -128; };
if ( $S8 > 127) { $S8 = 127; };
return $S8;
}
# Set serial Channel value. Num: 0..11, Val: -128..0..127
sub SerialChannel
()
{
my ($Num, $Val) = @_;
my $Key = sprintf ("SerialChannel%02d", $Num + 1);
lock
(%MkSerialChannel); # until end of block
$MkSerialChannel{$Key} = &CheckSignedChar($Val);
# timestamp, when channel value was set
$MkSerialChannel{'_Timestamp'} = time;
}
# Limit: 0% .. 100%
# Expo : -100% .. 0 .. 100%
sub ExpoLimit
()
{
my ($StickMin, $StickMax, $Stick, $Expo, $LimitMin, $LimitMax) = @_;
if ( $Expo ne "" )
{
# neg. Expo: 1..0.2 (0% .. -100%)
# pos. Expo: 1..5 (0% .. 100%)
if ( $Expo >= 0 )
{
$Expo = 1 + $Expo / 100 * 4;
}
else
{
$Expo = 1 + $Expo / 100 * 0.8;
}
if( $Stick >= 0 )
{
$Stick = $StickMax * ( $Stick ** $Expo ) / ( $StickMax ** $Expo);
}
else
{
$Stick = $StickMin * ( (- $Stick) ** $Expo ) / ( (- $StickMin) ** $Expo);
}
}
# Travel limiter
if ( $Stick >= 0 and $LimitMax ne "" )
{
$Stick = $Stick * $LimitMax / 100;
}
elsif ( $Stick < 0 and $LimitMin ne "" )
{
$Stick = $Stick * $LimitMin / 100;
}
return ($Stick);
}
# Multipoint Curve
sub Curve
()
{
my ($Min, $Max, $Resolution, $Stick, @Curve) = @_;
my $Points = scalar @Curve;
if ( $Points < 2 )
{
# need at least 2 points
return $Stick;
}
my $Val;
if ( $Stick < $Min )
{
$Val= $Curve[0];
}
elsif ( $Stick > $Max )
{
$Val = $Curve[$Points -1];
}
else
{
my $i = 0;
my $dx = ($Max - $Min) / ($Points - 1);
for (my $x = $Min; $x < $Max; $x += $dx)
{
if ( $Stick >= $x and $Stick <= $x + $dx)
{
my $y1 = $Curve[$i];
my $y2 = $Curve[$i+1];
my $dy = $y2 - $y1;
$Val = $y1 + $dy / $dx * ($Stick - $x);
last;
}
$i ++;
}
}
# Prozent in steps umrechnen
$Stick = $Val / 100 * $Resolution;
return $Stick;
}
# parse input controls for one output channel
# Syntax: [ChannelOption,par,par] + Control1[_Reverse],par,par,par + Control2 ... + Control3 ...
sub ParseControls
{
my ($Channel, $ControlVal, $Expo, $Limit, $Timing) = @_;
if ( $Expo eq "" ) { $Expo = 0; };
if ( $Limit eq "" ) { $Limit = 100; };
my $ChannelRes = 125; # Channel Resolution pos+neg = 250 Steps
my $ChannelInc = 0; # Channel Incremental Mode: 0, 1, 2
my $ChannelReverse = 1; # Channel reverse factor, 1 , -1
my $ChannelOffset = 0; # Channel Offset in %
my $ChannelTravelNeg = $Limit; # Channel travel in %
my $ChannelTravelPos = $Limit; # Channel travel in %
my $ChannelLimitNeg = $Limit; # Channel limit in %
my $ChannelLimitPos = $Limit; # Channel limit in %
my $ChannelExpo = $Expo; # Channel expo in %
my $ChannelSwitchVal = "OFF"; # Channel switch value in % or "OFF"
my $ChannelSwitchMin = 100; # Channel switch min output in %
my $ChannelSwitchMax = 100; # Channel switch max output in %
my @ChannelCurve; # Channel curve
my $IsAsymChannel = 0;
if ( "ExternControlGas ExternControlHeight" =~ /$Channel/i )
{
# special handling for asymmetric channels
$IsAsymChannel = 1;
$ChannelLimitNeg = 0;
$ChannelTravelNeg = 0;
}
# Channel output is sum of multiple input controls
my $ChannelVal = 0;
$ControlVal =~ s/ //g;
my @Controls = split('\+', $ControlVal); # controls separated by "+"
foreach $ControlVal (@Controls)
{
# Control params separated by ","
my @Par = split(',', $ControlVal);
my $Control = $Par[0];
my $ControlTravelNeg = $Par[1]; # in %
my $ControlTravelPos = $Par[2]; # in %
my $ControlExpo = $Par[3]; # in %
my $ControlOffset = $Par[4]; # in %
# take Pos as Neg, if only Neg is given
if ( $ControlTravelNeg eq "" ) { $ControlTravelNeg = 100; }
if ( $ControlTravelPos eq "" ) { $ControlTravelPos = $ControlTravelNeg; }
if ( $ControlExpo eq "" ) { $ControlExpo = 0; }
if ( $ControlOffset eq "" ) { $ControlOffset = 0; }
my $Val = 0; # control value
my $ControlReverse = 1; # control reverse factor: 1, -1
my ($Control, $Option) = split('_', $Control, 2); # Control options separeted by "_"
if ( $Control ne "" )
{
#
# Output Channel Options
#
if ( $Control =~ /Rev/i )
{
$ChannelReverse *= -1;
next;
}
if ( $Control =~ /IncStop/i )
{
# stop at neutral point
$ChannelInc = 2;
next;
}
elsif ( $Control =~ /Inc/i )
{
# don't stop at neutral point
$ChannelInc = 1;
next;
}
if ( $Control =~ /Offset/i )
{
$ChannelOffset = $Par[1];
if ( $ChannelOffset eq "" ) { $ChannelOffset = 0; };
next;
}
if ( $Control =~ /Travel/i )
{
$ChannelTravelNeg = $Par[1];
$ChannelTravelPos = $Par[2];
# take symmetrical Pos as Neg, if only Neg is given
if ( $ChannelTravelNeg eq "" ) { $ChannelTravelNeg = 100; }
if ( $ChannelTravelPos eq "" ) { $ChannelTravelPos = $ChannelTravelNeg; }
next;
}
if ( $Control =~ /Limit/i )
{
$ChannelLimitNeg = $Par[1];
$ChannelLimitPos = $Par[2];
if ( $IsAsymChannel and $ChannelLimitNeg ne "" and $ChannelLimitPos eq "" )
{
# only Neg given. Take Neg as Pos.
$ChannelLimitPos = $ChannelLimitNeg;
$ChannelLimitNeg = 0;
}
# take symmetrical Pos as Neg, if only Neg is given
if ( $ChannelLimitNeg eq "" ) { $ChannelLimitNeg = 100; }
if ( $ChannelLimitPos eq "" ) { $ChannelLimitPos = $ChannelLimitNeg; }
next;
}
if ( $Control =~ /Expo/i )
{
$ChannelExpo = $Par[1];
if ( $ChannelExpo eq "" ) { $ChannelExpo = 0; };
next;
}
if ( $Control =~ /Switch/i )
{
$ChannelSwitchVal = $Par[1];
$ChannelSwitchMin = $Par[2];
$ChannelSwitchMax = $Par[3];
if ( $ChannelSwitchVal eq "" ) { $ChannelSwitchVal = "OFF"; };
if ( $ChannelSwitchMin eq "" ) { $ChannelSwitchMin = 100; };
if ( $ChannelSwitchMax eq "" ) { $ChannelSwitchMax = 100; };
next;
}
if ( $Control =~ /Curve/i )
{
@ChannelCurve = @Par;
splice @ChannelCurve, 0, 1;
next;
}
#
# Input Control Options
#
if ( $Option =~ /Rev/i )
{
$ControlReverse *= -1;
}
#
# Input controls
#
# Joystick Button
if ( $Control =~ /^JoystickButton(\d+)/i )
{
my $Button = $1 - 1;
$Val = &JoystickButton($Button) ? $ChannelRes : -$ChannelRes;
}
# Joystick POV Button
elsif ( $Control =~ /^JoystickPov(\d+)/i )
{
my $Angle = $1;
my $Pov = $Stick{'JoystickPov'} / 100;
$Val = ($Pov == $Angle) ? $ChannelRes : -$ChannelRes;
}
# Mouse Button
elsif ( $Control =~ /^MouseButton(\d+)/i )
{
my $Button = $1 - 1;
$Val = &MouseButton($Button) ? $ChannelRes : -$ChannelRes;
}
# Function Key
elsif ( $Control =~ /^FctKey(\d+)/i )
{
my $Key = $1 - 1;
$Val = &FctKey($Key) ? $ChannelRes : -$ChannelRes;
}
# Serial Channel
elsif ( $Control =~ /^SerialChannel/i )
{
$Val = $MkSerialChannel{$Control};
}
# fixed value
elsif ( $Control =~ /^(-*\d+)/i )
{
$Val = $1;
if ( $IsAsymChannel )
{
$Val = $Val - $ChannelRes;
}
}
# Joystick
elsif ( $Control =~ /^Joystick/i )
{
# Scale Stick 0..StickRange to -125..0..125
$Val = $Stick{$Control} / $Stick{'StickRange'} * 2 * $ChannelRes - $ChannelRes;
}
# 3D-Maus
elsif ( $Control =~ /^Mouse/i )
{
# Scale Stick 0..StickRange to -125..0..125
$Val = $Stick{$Control} / $Stick{'StickRange'} * 2 * $ChannelRes - $ChannelRes;
}
# Rc Poti
elsif ( $Control =~ /^RcPoti/i )
{
$Val = $Stick{$Control};
}
# Rc Stick
elsif ( $Control =~ /^RcStick/i )
{
$Val = $Stick{$Control};
}
else
{
# unknown, fall through
print "ParseControls: $Channel : Unknown Control \"$Control\"\n";
next;
}
# Control Reverse
$Val *= $ControlReverse;
# Expo/Limit for each input control
if ( $IsAsymChannel and $ChannelInc == 0 )
{
# asymmetric channel 0..250, if not in INC mode
$Val += $ChannelRes;
$Val = &ExpoLimit (0.001, 2 * $ChannelRes, $Val, $ControlExpo, $ControlTravelNeg, $ControlTravelPos);
}
else
{
# symmetric channel -125..0..125
$Val = &ExpoLimit (- $ChannelRes, $ChannelRes, $Val, $ControlExpo, $ControlTravelNeg, $ControlTravelPos);
}
# Control Offset
$Val = $Val + $ControlOffset / 100 * $ChannelRes;
# sum controls
$ChannelVal += $Val;
}
}
# Incremental Channel Mode. Control must be neg ..0..pos
if ( $ChannelInc > 0 )
{
# Channel travel time is 1s for 125 steps at control full speed
# Channel neutral point crossing detection
my $Neutral = $ChannelVal;
my $LastNeutral = $Controls{$Channel}{'Neutral'};
$Controls{$Channel}{'Neutral'} = $Neutral;
my $LastVal = $Controls{$Channel}{'Value'};
$ChannelVal = $LastVal + $ChannelVal * $Timing / 1000;
if ( $ChannelInc > 1 )
{
# stop at neutral position
if ( $LastVal <= 0 and $ChannelVal >= 0 and $LastNeutral > 5 and $Neutral > 5 )
{
# coming from left
$ChannelVal = 0;
}
elsif ( $LastVal >= 0 and $ChannelVal <= 0 and $LastNeutral < -5 and $Neutral < -5 )
{
# comimg from right
$ChannelVal = 0;
}
}
if ( $IsAsymChannel )
{
# asymmetric channel 0..250
if ( $ChannelVal > 2 * $ChannelRes ) { $ChannelVal = 2 * $ChannelRes };
if ( $ChannelVal < 0 ) { $ChannelVal = 0 };
}
else
{
# symmetric channel -125..0..125
if ( $ChannelVal > $ChannelRes ) { $ChannelVal = $ChannelRes };
if ( $ChannelVal < -$ChannelRes ) { $ChannelVal = -$ChannelRes };
}
$Controls{$Channel}{'Value'} = $ChannelVal;
}
# channel output processing
if ( $IsAsymChannel )
{
# asymmetric channel 0..250
# Channel Multipoint curve
$ChannelVal = &Curve (0.001, 2 * $ChannelRes, 2 * $ChannelRes, $ChannelVal, @ChannelCurve);
# Channel Expo, Travel
$ChannelVal = &ExpoLimit (0.001, 2 * $ChannelRes, $ChannelVal, $ChannelExpo, $ChannelTravelNeg, $ChannelTravelPos);
# Channel Switch
if ( $ChannelSwitchVal ne "OFF" )
{
if ( $ChannelVal < 2 * $ChannelRes * $ChannelSwitchVal / 100 )
{
$ChannelVal = 2 * $ChannelRes * $ChannelSwitchMin / 100;
}
else
{
$ChannelVal = 2 * $ChannelRes * $ChannelSwitchMax / 100;
}
}
# Channel Reverse
if ( $ChannelReverse == -1 )
{
$ChannelVal = 2 * $ChannelRes - $ChannelVal;
}
# Channel offset
$ChannelVal = $ChannelVal + $ChannelOffset / 100 * 2 * $ChannelRes;
# Channel Limiter
my $Pos = 2 * $ChannelRes * $ChannelLimitPos / 100;
if ( $ChannelVal > $Pos )
{
$ChannelVal = $Pos;
}
my $Neg = 2 * $ChannelRes * $ChannelLimitNeg / 100;
if ( $ChannelVal < $Neg )
{
$ChannelVal = $Neg;
}
# round to integer
if ( $ChannelVal >= 0 )
{
$ChannelVal = int ($ChannelVal + 0.5);
}
else
{
$ChannelVal = int ($ChannelVal - 0.5);
}
$ChannelVal = &CheckUnsignedChar($ChannelVal);
}
else
{
# symmetric channel -125..0..125
# Channel Multipoint curve
$ChannelVal = &Curve (-$ChannelRes, $ChannelRes, $ChannelRes, $ChannelVal, @ChannelCurve);
# Channel Expo, Travel
$ChannelVal = &ExpoLimit (-$ChannelRes, $ChannelRes, $ChannelVal, $ChannelExpo, $ChannelTravelNeg, $ChannelTravelPos);
# Channel Switch
if ( $ChannelSwitchVal ne "OFF" )
{
if ( $ChannelVal < $ChannelRes * $ChannelSwitchVal / 100 )
{
$ChannelVal = $ChannelRes * $ChannelSwitchMin / 100;
}
else
{
$ChannelVal = $ChannelRes * $ChannelSwitchMax / 100;
}
}
# Channel Reverse
$ChannelVal *= $ChannelReverse;
# Channel offset
$ChannelVal = $ChannelVal + $ChannelOffset / 100 * $ChannelRes;
# Channel Limiter
my $Pos = $ChannelRes * $ChannelLimitPos / 100;
if ( $ChannelVal > $Pos )
{
$ChannelVal = $Pos;
}
my $Neg = - $ChannelRes * $ChannelLimitNeg / 100;
if ( $ChannelVal < $Neg )
{
$ChannelVal = $Neg;
}
# round to integer
if ( $ChannelVal >= 0 )
{
$ChannelVal = int ($ChannelVal + 0.5);
}
else
{
$ChannelVal = int ($ChannelVal - 0.5);
}
$ChannelVal = &CheckSignedChar($ChannelVal);
}
return $ChannelVal;
}
#
# Waypoint handling
#
# Add a Waypoint to @Waypoints List
sub WpAdd
()
{
my %Param = @_;
my $Wp_x = $Param{'-x'};
my $Wp_y = $Param{'-y'};
my $Lat = $Param{'-lat'};
my $Lon = $Param{'-lon'};
# x/y and/or Lat/Lon must be passed
if ( $Wp_x eq "" and $Wp_y eq "" )
{
($Wp_x, $Wp_y) = &MapGps2XY($Lat, $Lon);
}
if ( $Lat eq "" and $Lon eq "" )
{
($Lat, $Lon) = &MapXY2Gps($Wp_x, $Wp_y);
}
# save Wp-Hash in Waypoint-Array
my $Wp = {};
# kind of unique Tag for this Wp
my ($t0_s, $t0_us) = gettimeofday
;
my $Tag = sprintf "WP-%d.%d", $t0_s, $t0_us;
$Wp->{'Tag'} = $Tag;
$Wp->{'MapX'} = $Wp_x;
$Wp->{'MapY'} = $Wp_y;
$Wp->{'Pos_Lat'} = $Lat;
$Wp->{'Pos_Lon'} = $Lon;
$Wp->{'Pos_Alt'} = $MkOsd{'CurPos_Alt'};
$Wp->{'Heading'} = $Cfg->{'waypoint'}->{'DefaultHeading'};
$Wp->{'ToleranceRadius'} = $Cfg->{'waypoint'}->{'DefaultToleranceRadius'};
$Wp->{'Holdtime'} = $Cfg->{'waypoint'}->{'DefaultHoldtime'};
$Wp->{'Event_Flag'} = $Cfg->{'waypoint'}->{'DefaultEventFlag'};
push @Waypoints, $Wp;
}
# Delete Waypoint from @Waypoints List
sub WpDelete
()
{
my ($WpIndex) = @_;
# delete Wp in Waypoint-Array
splice @Waypoints, $WpIndex, 1;
}
# Delete all Waypoints
sub WpDeleteAll
()
{
undef @Waypoints;
$WpPlayerIndex = 0;
$WpPlayerHoldtime = -1;
# remove all Wp-Icons and Wp-Number on canvas
&WpHide();
}
# Load @Waypoints from file
sub WpLoadFile
()
{
my ($WpFile) = @_;
if ( $WpFile =~ /.wpl$/i )
{
# load Mikrokopter Tool WP List *.wpl
my $WpCnt = 0;
my $WpIndex = 0;
my @WpWpl;
open WPL
, "<$WpFile";
my @Wpl = <WPL>;
close WPL
;
foreach my $Line (@Wpl)
{
chomp $Line;
if ( $Line =~ /NumberOfWaypoints\s*=\s*(\d*)/i )
{
$WpCnt = $1;
}
elsif ( $Line =~ /\[Waypoint(\d*)\]/i )
{
$WpIndex = $1;
}
elsif ( $Line =~ /(\S*)\s*=\s*(\S*)/i )
{
my $Key = $1;
my $Value = $2;
$WpWpl[$WpIndex]{$Key} = $Value;
}
}
# WPL Array in Waypoints-Array umkopieren
undef @Waypoints;
for ( $Index=0; $Index < $WpCnt; $Index++)
{
my $Wp = {};
my $Tag = sprintf "Waypoint-%d.%d", time, $Index + 1; # kind of unique Tag for this Wp
my $Lat = $WpWpl[$Index]{'Latitude'};
my $Lon = $WpWpl[$Index]{'Longitude'};
($MapX, $MapY) = &MapGps2XY($Lat, $Lon);
$Wp->{'Tag'} = $Tag;
$Wp->{'MapX'} = $MapX;
$Wp->{'MapY'} = $MapY;
$Wp->{'Pos_Lat'} = $Lat;
$Wp->{'Pos_Lon'} = $Lon;
$Wp->{'Pos_Alt'} = $MkOsd{'CurPos_Alt'};
$Wp->{'Heading'} = $Cfg->{'waypoint'}->{'DefaultHeading'};
$Wp->{'ToleranceRadius'} = $WpWpl[$Index]{'Radius'};
$Wp->{'Holdtime'} = $WpWpl[$Index]{'DelayTime'};
$Wp->{'Event_Flag'} = $Cfg->{'waypoint'}->{'DefaultEventFlag'};
push @Waypoints, $Wp;
}
}
else
{
# load Mission Cockpit XML
# XML in Hash-Ref lesen
my $Wp = XMLin
($WpFile, ForceArray
=> 1);
# XML Hash-Ref in Wp-Array umkopieren
undef @Waypoints;
foreach $key (sort keys %$Wp)
{
my $Point = $Wp->{$key}->[0];
# relative Pixelkoordinaten auf Bildgroesse umrechnen
if ( $Point->{'MapX'} <= 1 and $Point->{'MapY'} <= 1 )
{
$Point->{'MapX'} = int ( $Point->{'MapX'} * $MapSizeX + 0.5 );
$Point->{'MapY'} = int ( $Point->{'MapY'} * $MapSizeY + 0.5 );
}
# abs. pixel koordinates not needed
delete $Point->{'MapX_Pixel'};
delete $Point->{'MapY_Pixel'};
# GPS Koordinaten für die aktuelle Karte neu aus Map x/y berechnen
my ($Lat, $Lon) = &MapXY2Gps($Point->{'MapX'}, $Point->{'MapY'});
$Point->{'Pos_Lat'} = $Lat;
$Point->{'Pos_Lon'} = $Lon;
push @Waypoints, $Point;
}
}
# Start with 1st WP
&WpTargetFirst();
}
# Save @Waypoints to file
sub WpSaveFile
()
{
my ($WpFile) = @_;
if ( $WpFile =~ /.wpl$/i )
{
# save Mikrokopter Tool WP List *.wpl
open WPL
, ">$WpFile";
my $WpCnt = scalar @Waypoints;
print WPL
"[General\]\n";
print WPL
"FileVersion=1\n";
print WPL
"NumberOfWaypoints=$WpCnt\n";
for $i ( 0 .. $#Waypoints )
{
print WPL
"\[Waypoint${i}\]\n";
print WPL
"Latitude=$Waypoints[$i]{'Pos_Lat'}\n";
print WPL
"Longitude=$Waypoints[$i]{'Pos_Lon'}\n";
print WPL
"Radius=$Waypoints[$i]{'ToleranceRadius'}\n";
print WPL
"DelayTime=$Waypoints[$i]{'Holdtime'}\n";
}
close WPL
;
}
else
{
# save Mission Cockpit XML
# Waypoint-Array in Hash umkopieren
for $i ( 0 .. $#Waypoints )
{
my $key = sprintf ("WP-%04d", $i);
my $Wp = {%{$Waypoints[$i]}}; # copy of Hash-content
$WpOut{$key} = $Wp;
# Pixelkoordinaten relativ zur Bildgroesse speichern
$WpOut{$key}{'MapX_Pixel'} = $WpOut{$key}{'MapX'};
$WpOut{$key}{'MapY_Pixel'} = $WpOut{$key}{'MapY'};
$WpOut{$key}{'MapX'} /= $MapSizeX;
$WpOut{$key}{'MapY'} /= $MapSizeY;
}
# WP-Hash als XML speichern
&XMLout (\%WpOut,
'OutputFile' => $WpFile,
'AttrIndent' => '1',
'RootName' => 'Waypoints',
);
}
}
# Get Wp Index from Canvas Id
sub WpGetIndexFromId
()
{
my ($id) = @_;
my @Tags = $map_canvas->gettags($id);
my $WpTag = $Tags[1];
for $i (0 .. $#Waypoints)
{
my $Wp = $Waypoints[$i];
if ( $Wp->{'Tag'} eq $WpTag )
{
# got it
return $i;
}
}
return -1;
}
# Resend all Waypoints to MK
sub WpSendAll
()
{
# OSD/Debug Abfragefrequenz verringern, sonst kommen nicht alle Wp im MK an
# Sicherheitshalber doppelt senden
$MkSendWp = 1; # verhindert ueberschreiben im Timer
$MkSendQueue->enqueue( "o", "$AddrNC", pack ("C", 1000) ); # Frequenz OSD Datensatz, * 10ms
$MkSendQueue->enqueue( "d", "$AddrNC", pack ("C", 1000) ); # Frequenz MK Debug Datensatz, * 10ms
usleep
(200000);
$MkSendQueue->enqueue( "o", "$AddrNC", pack ("C", 1000) ); # Frequenz OSD Datensatz, * 10ms
$MkSendQueue->enqueue( "d", "$AddrNC", pack ("C", 1000) ); # Frequenz MK Debug Datensatz, * 10ms
usleep
(200000);
# Alte WP-Liste im MK löschen
my $Wp = $Waypoints[0];
&MkFlyTo ( '-lat' => $Wp->{'Pos_Lat'},
'-lon' => $Wp->{'Pos_Lon'},
'-mode' => "Waypoint Delete"
);
for $i (0 .. $#Waypoints)
{
my $Wp = $Waypoints[$i];
&MkFlyTo ( '-lat' => $Wp->{'Pos_Lat'},
'-lon' => $Wp->{'Pos_Lon'},
'-alt' => $Wp->{'Pos_Alt'},
'-heading' => $Wp->{'Heading'},
'-toleranceradius' => $Wp->{'ToleranceRadius'},
'-holdtime' => $Wp->{'Holdtime'},
'-eventflag' => $Wp->{'Event_Flag'},
'-mode' => "Waypoint",
'-index' => $i,
);
usleep
(150000) # NC Zeit zum Verarbeiten geben
}
$MkSendWp = 0; # normale OSD/Debug Abfragefrequenz wird automatisch im 5s Timer wieder eingestellt
# grey connectors: Wp are sent to MK
$map_canvas->itemconfigure('Waypoint-Connector',
'-fill' => $Cfg->{'mkcockpit'}->{'ColorWpConnector'},
);
# MK ist nun synchron mit @Waypoints
$WaypointsModified = 0;
}
# Redraw Waypoint Icons
sub WpRedrawIcons
()
{
if ( $PlayerWptKmlMode =~ /WPT/i )
{
# delete old icons and Wp-Number from canvas
$map_canvas->delete('Waypoint');
$map_canvas->delete('WaypointNumber');
# create new icons
for $i (0 .. $#Waypoints)
{
my $Wp = $Waypoints[$i];
my $x = $Wp->{'MapX'};
my $y = $Wp->{'MapY'};
my $Tag = $Wp->{'Tag'};
# Waypoint Icon
my $IconHeight = 48;
my $IconWidth = 24;
$map_canvas->createImage($x-$IconWidth/2, $y-$IconHeight,
'-tags' => ['Waypoint', $Tag],
'-anchor' => 'nw',
'-image' => 'Waypoint-Photo',
);
# Waypoint Number
my $WpNumber = $i + 1;
$map_canvas->createText ( $x+3, $y-$IconHeight/2+12,
'-tags' => ['WaypointNumber', $Tag],
'-text' => $WpNumber,
'-font' => '-*-Arial-Bold-R-Normal--*-100-*',
'-fill' => $Cfg->{'mkcockpit'}->{'ColorWpNumber'},
'-anchor' => 'w',
);
}
$map_canvas->lower('Waypoint', 'Target'); # waypoint below Target
$map_canvas->lower('WaypointNumber', 'Waypoint'); # waypoint-number below waypoint
}
}
# Redraw Waypoint connectors
sub WpRedrawLines
()
{
if ( $PlayerWptKmlMode eq 'WPT' and $PlayerRandomMode eq 'STD' )
{
# delete old connectors from canvas
$map_canvas->delete('Waypoint-Connector');
my $Color = $Cfg->{'mkcockpit'}->{'ColorWpConnector'};
if ( $WaypointsModified )
{
$Color = $Cfg->{'mkcockpit'}->{'ColorWpResend'};
}
my $Wp = $Waypoints[0];
my $x_last = $Wp->{'MapX'};
my $y_last = $Wp->{'MapY'};
for $i (1 .. $#Waypoints)
{
my $Wp = $Waypoints[$i];
my $x = $Wp->{'MapX'};
my $y = $Wp->{'MapY'};
$map_canvas->createLine ( $x_last, $y_last, $x, $y,
'-tags' => 'Waypoint-Connector',
'-arrow' => 'last',
'-arrowshape' => [10, 10, 3 ],
'-fill' => $Color,
'-width' => 1,
);
$x_last = $x;
$y_last = $y;
}
$map_canvas->raise('Waypoint-Connector', 'Map'); # connector above map
}
}
# Hide Waypoints and connectors on Canvas
sub WpHide
()
{
$map_canvas->delete('Waypoint');
$map_canvas->delete('WaypointNumber');
$map_canvas->delete('Waypoint-Connector');
}
# Hide Kml-Track on Canvas
sub KmlHide
()
{
$map_canvas->delete('KML-Track');
}
# Load @KmlTargets from file
sub KmlLoadFile
()
{
my ($File) = @_;
# XML in Hash-Ref lesen
my $Kml = XMLin
($File);
# init state maschine
undef @KmlTargets;
$KmlPlayerIndex = 0;
my $Coordinates = $Kml->{Document
}->{Placemark
}->{LineString
}->{coordinates
};
foreach $Line (split "\n", $Coordinates)
{
chomp $Line;
$Line =~ s/\s//g; # remove white space
if ( $Line ne "" )
{
my ($Lon, $Lat, $Alt) = split ",", $Line;
$Lon = sprintf ("%f", $Lon);
$Lat = sprintf ("%f", $Lat);
$Alt = sprintf ("%f", $Alt);
push @KmlTargets, {'Lat' => $Lat,
'Lon' => $Lon,
'Alt' => $Alt,
};
}
}
}
# Redraw KML track
sub KmlRedraw
()
{
# delete old Track from canvas
$map_canvas->delete('KML-Track');
my @Track;
foreach $Target ( @KmlTargets )
{
my $Lat = $Target->{'Lat'};
my $Lon = $Target->{'Lon'};
my $Alt = $Target->{'Alt'};
my ($x, $y) = &MapGps2XY($Lat, $Lon);
push @Track, $x, $y;
}
if ( scalar @Track >= 4 ) # at least 2 Koordinaten-Paare
{
$map_canvas->createLine ( @Track,
'-tags' => 'KML-Track',
'-fill' => $Cfg->{'mkcockpit'}->{'ColorKmlTrack'},
'-width' => 1,
);
$map_canvas->lower('KML-Track', 'Target'); # Track below Target
}
}
# Redraw Footprint
sub FootprintRedraw
()
{
# delete old Footprint from canvas
$map_canvas->delete('Footprint');
if ( scalar @Footprint >= 4 ) # at least 2 Koordinaten-Paare
{
$map_canvas->createLine ( @Footprint,
'-tags' => 'Footprint',
'-fill' => $Cfg->{'mkcockpit'}->{'ColorFootprint'},
'-width' => 1,
);
}
$map_canvas->lower('Footprint', 'Target');
}
# Waypoint Player: Set Waypoint - sequence or random
sub WpTargetSet
()
{
my ($Index) = @_;
my $WpCnt = scalar @Waypoints;
if ( $Index < 0 or $Index >= $WpCnt )
{
# invalid WP number
return 1;
}
my $Wp = $Waypoints[$Index];
my $Wp_x = $Wp->{'MapX'};
my $Wp_y = $Wp->{'MapY'};
# is Wp reachable?
if ( ! &IsTargetReachable($Wp_x, $Wp_y) )
{
# new Wp-Target is not reachable
return 1;
}
# set new Wp-Target
$WpPlayerIndex = $Index;
$WpPlayerHoldtime = -1;
return 0;
}
# Waypoint Player: Goto next Waypoint - sequence or random
sub WpTargetNext
()
{
my $WpCnt = scalar @Waypoints;
# Std- or Random Waypoint sequence
if ( $PlayerRandomMode =~ /STD/i or
$PlayerRandomMode =~ /RND/i )
{
$NewIndex = $WpPlayerIndex;
# get next Wp
for ( $i=0; $i<5; $i++) # avoid deadlock, if no WP reachable
{
for ( $j=0; $j<5; $j++ ) # avoid deadlock, if only 1 WP
{
if ( $PlayerRandomMode =~ /STD/i )
{
$NewIndex ++;
if ( $NewIndex >= $WpCnt )
{
# Restart with 1st Wp
$NewIndex = 0;
}
}
if ( $PlayerRandomMode =~ /RND/i )
{
$NewIndex = int (rand($WpCnt));
}
# want to have different Wp
if ( $NewIndex ne $WpPlayerIndex )
{
last;
}
}
# Set new Target
if ( &WpTargetSet ($NewIndex) == 0 )
{
# new Wp-Target set
last;
}
}
}
# Random Map sequence
if ( $PlayerRandomMode =~ /MAP/i )
{
$RandomTarget_x = $MkPos_x;
$RandomTarget_y = $MkPos_y;
for ( $i=0; $i<50; $i++) # avoid deadlock, if target not reachable
{
# don't use 10% around the map
my $New_x = int (rand($MapSizeX - 2 * $MapSizeX/10));
my $New_y = int (rand($MapSizeY - 2 * $MapSizeY/10));
$New_x += $MapSizeX/10;
$New_y += $MapSizeY/10;
# is Target reachable?
if ( &IsTargetReachable($New_x, $New_y) )
{
# new Target found
$RandomTarget_x = $New_x;
$RandomTarget_y = $New_y;
last;
}
}
}
&TtsSpeak ('MEDIUM', $Translate{'TtsNextTarget'});
$WpPlayerHoldtime = -1;
}
# Waypoint Player: Goto previous Waypoint
sub WpTargetPrev
()
{
if ( $PlayerRandomMode =~ /STD/i )
{
$WpPlayerIndex --;
if ( $WpPlayerIndex < 0 )
{
# Restart with last Wp
$WpPlayerIndex = $#Waypoints;
}
}
else
{
# Next Random Target
&WpTargetNext();
}
$WpPlayerHoldtime = -1;
}
# Waypoint Player: Goto first Waypoint
sub WpTargetFirst
()
{
$WpPlayerIndex = 0;
$WpPlayerHoldtime = -1;
}
# Waypoint Player: Goto last Waypoint
sub WpTargetLast
()
{
$WpPlayerIndex = $#Waypoints;
$WpPlayerHoldtime = -1;
}
# Waypoint Player: Waypoint Target reached?
sub WpCheckTargetReached
()
{
if ( $WpPlayerHoldtime == -1 )
{
lock
(%MkOsd); # until end of block
if ( &CurPosIsValid() and &HomePosIsValid() and &MkIsWptMode() )
{
# Gueltige SAT Daten
# for Wp mode
my $Wp = $Waypoints[$WpPlayerIndex];
my $WpTarget_Lat = $Wp->{'Pos_Lat'};
my $WpTarget_Lon = $Wp->{'Pos_Lon'};
my $WpTolerance = $Wp->{'ToleranceRadius'};
my $WpHoldtime = $Wp->{'Holdtime'};
# Random-Map Mode
if ( $PlayerRandomMode =~ /MAP/i )
{
($WpTarget_Lat, $WpTarget_Lon) = &MapXY2Gps ($RandomTarget_x, $RandomTarget_y);
$WpTolerance = $Cfg->{'waypoint'}->{'DefaultToleranceRadius'};
$WpHoldtime = $Cfg->{'waypoint'}->{'DefaultHoldtime'};
}
# Operation Radius pruefen
my ($HomeDist, $HomeBearing) = &MapGpsTo($MkOsd{'HomePos_Lat'}, $MkOsd{'HomePos_Lon'}, $WpTarget_Lat, $WpTarget_Lon );
if ( $HomeDist > $MkOsd{'OperatingRadius'} )
{
# Target entsprechend Operation Radius neu berechnen
$HomeDist = $MkOsd{'OperatingRadius'};
($WpTarget_Lat, $WpTarget_Lon) = &MapGpsAt($MkOsd{'HomePos_Lat'}, $MkOsd{'HomePos_Lon'}, $HomeDist, $HomeBearing);
}
# Abstand zum Ziel pruefen
my ($Dist, $Bearing) = &MapGpsTo($MkOsd{'CurPos_Lat'}, $MkOsd{'CurPos_Lon'}, $WpTarget_Lat, $WpTarget_Lon );
$Dist = int ($Dist + 0.5);
if ( $Dist <= $WpTolerance )
{
# Target reached - count down Holdtime
$WpPlayerHoldtime = 2 * $WpHoldtime; # 0..2n - decrement im 0.5s timer
&TtsSpeak ('MEDIUM', $Translate{'TtsTargetReached'});
}
}
}
if ( $WpPlayerHoldtime == 0 ) # wird im 0.5s timer runtergezaehlt
{
# Target reached - Holdtime is over
$WpPlayerHoldtime = -1;
return 1;
}
# Target NOT reached
return 0;
}
# KML Player: 10s forward
sub KmlTargetNext
()
{
$KmlPlayerIndex += int (10 / $Cfg->{waypoint
}->{'KmlTimeBase'} + 0.5);
if ( $KmlPlayerIndex > $#KmlTargets )
{
# Next loop
$KmlPlayerIndex -= $#KmlTargets;
}
}
# KML Player: 10s backward
sub KmlTargetPrev
()
{
$KmlPlayerIndex -= int (10 / $Cfg->{waypoint
}->{'KmlTimeBase'} + 0.5);
if ( $KmlPlayerIndex < 0 )
{
# Next loop
$KmlPlayerIndex += $#KmlTargets;
}
}
# KML Player: Goto first Target
sub KmlTargetFirst
()
{
$KmlPlayerIndex = 0;
}
# KML Player: Goto last Target
sub KmlTargetLast
()
{
$KmlPlayerIndex = $#KmlTargets;
}
#
# Set Player modes
#
# set Player mode
sub PlayerModeSet
()
{
my ($Mode) = @_;
if ( $Mode =~ /play/i ) { &PlayerPlay(); }
elsif ( $Mode =~ /pause/i ) { &PlayerPause(); }
elsif ( $Mode =~ /home/i ) { &PlayerHome(); }
elsif ( $Mode =~ /stop/i ) { &PlayerStop(); }
}
# set player to "Play" mode
sub PlayerPlay
()
{
$PlayerMode = 'Play';
$WpPlayerHoldtime = -1;
# Play/Pause-Icon loeschen und neu anzeigen
$map_canvas->delete('Wp-PlayPause');
$map_canvas->createImage($MapSizeX/2+150, $MapSizeY-48,
'-tags' => 'Wp-PlayPause',
'-anchor' => 'nw',
'-image' => 'WpPause-Foto',
);
&FoxHide();
&CrosshairHide();
}
# set player to "Pause" mode
sub PlayerPause
()
{
$PlayerMode = 'Pause';
$WpPlayerHoldtime = -1;
# Play/Pause-Icon loeschen und neu anzeigen
$map_canvas->delete('Wp-PlayPause');
$map_canvas->createImage($MapSizeX/2+150, $MapSizeY-48,
'-tags' => 'Wp-PlayPause',
'-anchor' => 'nw',
'-image' => 'WpPlay-Foto',
);
# momentane Position merken und im Player-Timer senden
$PlayerPause_Lon = "";
$PlayerPause_Lat = "";
lock
(%MkOsd); # until end of block
if ( &CurPosIsValid() )
{
$PlayerPause_Lon = $MkOsd{'CurPos_Lon'};
$PlayerPause_Lat = $MkOsd{'CurPos_Lat'};
}
&FoxShow();
# restart crosshair timer
$CrosshairTimerCnt = 0;
}
# set player to "Home" mode
sub PlayerHome
()
{
$PlayerMode = 'Home';
&WpTargetFirst();
# Play/Pause-Icon loeschen und neu anzeigen
$map_canvas->delete('Wp-PlayPause');
$map_canvas->createImage($MapSizeX/2+150, $MapSizeY-48,
'-tags' => 'Wp-PlayPause',
'-anchor' => 'nw',
'-image' => 'WpPlay-Foto',
);
&FoxHide();
&CrosshairHide();
}
# set player to "Stop" mode
sub PlayerStop
()
{
$PlayerMode = 'Stop';
&WpTargetFirst();
# set Play/Pause Icon to "Play
$map_canvas->delete('Wp-PlayPause');
$map_canvas->createImage($MapSizeX/2+150, $MapSizeY-48,
'-tags' => 'Wp-PlayPause',
'-anchor' => 'nw',
'-image' => 'WpPlay-Foto',
);
# switch player to Wp Mode
&PlayerWpt();
&FoxHide();
&CrosshairHide();
}
# set player Random Mode to "STD"
sub PlayerRandomStd
()
{
$PlayerRandomMode = "STD";
# Set Icon
$map_canvas->delete('Wp-WptRandom');
$map_canvas->createImage($MapSizeX/2-200, $MapSizeY-48,
'-tags' => 'Wp-WptRandom',
'-anchor' => 'nw',
'-image' => 'WpRandomOn-Foto',
);
# redraw connectors and Icons on canvas
&WpRedrawLines();
&WpRedrawIcons();
}
# set player Random Mode to "RND"
sub PlayerRandomRnd
()
{
$PlayerRandomMode = "RND";
# Set Icon
$map_canvas->delete('Wp-WptRandom');
$map_canvas->createImage($MapSizeX/2-200, $MapSizeY-48,
'-tags' => 'Wp-WptRandom',
'-anchor' => 'nw',
'-image' => 'WpRandomMap-Foto',
);
# delete Wp-connectors from canvas
$map_canvas->delete('Waypoint-Connector');
}
# set player Random Mode to "MAP"
sub PlayerRandomMap
()
{
$PlayerRandomMode = "MAP";
# Set Icon
$map_canvas->delete('Wp-WptRandom');
$map_canvas->createImage($MapSizeX/2-200, $MapSizeY-48,
'-tags' => 'Wp-WptRandom',
'-anchor' => 'nw',
'-image' => 'WpRandomOff-Foto',
);
# Get 1st Target
&WpTargetNext();
# hide WP and connectors on canvas
&WpHide();
}
# set player Pause Mode to "MAP", "MK"
sub PlayerPauseMode
()
{
($PlayerPauseMode) = @_;
}
# set player to KML mode
sub PlayerKml
()
{
$PlayerWptKmlMode = 'KML';
# Wpt/Kml-Player-Icon loeschen und neu anzeigen
$map_canvas->delete('Wp-WptKml');
$map_canvas->createImage($MapSizeX/2-250, $MapSizeY-48,
'-tags' => 'Wp-WptKml',
'-anchor' => 'nw',
'-image' => 'WpKml-Foto',
);
# delete Waypoints from canvas
&WpHide();
# show KML Track
&KmlRedraw();
}
# set player to WPT mode
sub PlayerWpt
()
{
$PlayerWptKmlMode = 'WPT';
# Wpt/Kml-Player-Icon loeschen und neu anzeigen
$map_canvas->delete('Wp-WptKml');
$map_canvas->createImage($MapSizeX/2-250, $MapSizeY-48,
'-tags' => 'Wp-WptKml',
'-anchor' => 'nw',
'-image' => 'WpWpt-Foto',
);
# delete Kml-Track from canvas
&KmlHide();
# Show waypoints, WP resend required
$WaypointsModified = 1;
if ( $PlayerRandomMode ne 'MAP' )
{
&WpRedrawIcons()
}
if ( $PlayerRandomMode eq 'STD' )
{
&WpRedrawLines()
}
}
# Activate Recording mode
sub PlayerRecordOn
{
$PlayerRecordMode = "REC";
$map_canvas->itemconfigure ('MK-OSD-Rec-Value', '-text' => "Recording" );
# Record new KML-Track
undef @KmlTargets;
$KmlPlayerIndex = 0;
# delete Kml-Track from canvas
&KmlHide();
}
# Deactivate Recording mode
sub PlayerRecordOff
{
$PlayerRecordMode = "";
$map_canvas->itemconfigure ('MK-OSD-Rec-Value', '-text' => "" );
}
# Hide Fox icon on canvas
sub FoxHide
()
{
$map_canvas->lower('Fox', 'Map');
}
# Show Fox icon on canvas
sub FoxShow
()
{
$map_canvas->raise('Fox', 'Target');
}
# Hide POI icon on canvas
sub PoiHide
()
{
$map_canvas->lower('POI', 'Map');
}
# Show POI icon on canvas
sub PoiShow
()
{
$map_canvas->raise('POI', 'Track-Antenna');
}
# Show Grid on canvas
sub GridShow
()
{
my $Dist = $Cfg->{map}->{'GridDist'} || 50;
my $Color = $Cfg->{map}->{'GridColor'} || "#909090";
my $xmin = 0;
my $ymin = 0;
my $xmax = $MapSizeX;
my $ymax = $MapSizeY;
my $PhiRef = &MapAngel();
my ($Lat1, $Lon1) = &MapXY2Gps($xmin, $ymin);
my ($Lat2, $Lon2) = &MapGpsAt($Lat1, $Lon1, $Dist, $PhiRef);
my ($x, $y) = &MapGps2XY($Lat2, $Lon2);
my $dpix = int ($x - $xmin + 0.5);
lock
(%MkOsd); # until end of block
my $x0 = $MapSizeX / 2;
my $y0 = $MapSizeY / 2;
if ( &HomePosIsValid() )
{
($x0, $y0) = &MapGps2XY ($MkOsd{'HomePos_Lat'}, $MkOsd{'HomePos_Lon'});
}
for ($x = $xmin + $x0 % $dpix; $x < $xmax; $x +=$dpix)
{
$map_canvas->createLine ( $x, $ymin, $x, $ymax,
'-tags' => 'Map-Grid',
'-arrow' => 'none',
'-fill' => $Color,
'-width' => 1,
);
}
for ($y = $ymin + $y0 % $dpix; $y < $ymax; $y +=$dpix)
{
$map_canvas->createLine ( $xmin, $y, $xmax, $y,
'-tags' => 'Map-Grid',
'-arrow' => 'none',
'-fill' => $Color,
'-width' => 1,
);
}
# Beschriftung x
for ( $x = xmin
+ $x0 % $dpix; $x < $xmax; $x += $dpix)
{
my $ScaleX = int (($x - $x0) / $dpix * $Dist + 0.5);
if ( $ScaleX < 0 )
{
$ScaleX = int (($x - $x0) / $dpix * $Dist - 0.5);
}
$map_canvas->createText ( $x - 2, $y0 - 8,
'-tags' => 'Map-Grid',
'-text' => sprintf ("%d", $ScaleX),
'-font' => '-*-Arial-Bold-R-Normal--*-150-*',
'-fill' => $Color,
'-anchor' => 'e',
);
}
# Beschriftung y
for ( $y = ymin
+ $y0 % $dpix; $y < $ymax; $y += $dpix)
{
my $ScaleY = int (($y - $y0) / $dpix * $Dist + 0.5);
if ( $ScaleY < 0 )
{
$ScaleY = int (($y - $y0) / $dpix * $Dist - 0.5);
}
$map_canvas->createText ( $x0 + 4, $y - 8,
'-tags' => 'Map-Grid',
'-text' => sprintf ("%d", $ScaleY * -1),
'-font' => '-*-Arial-Bold-R-Normal--*-150-*',
'-fill' => $Color,
'-anchor' => 'w',
);
}
$map_canvas->raise('Map-Grid', 'Map');
}
# Hide Grid on canvas
sub GridHide
()
{
$map_canvas->delete('Map-Grid');
}
# Show Crosshair for Pause Position on canvas
sub CrosshairShow
()
{
my ($Lat, $Lon) = @_;
my ($x, $y) = &MapGps2XY ($Lat, $Lon);
if ( $x != $LastCrosshairX and $y != $LastCroshairY )
{
# Only update, if coords changed - CPU consuming!
$map_canvas->coords ('Map-Crosshair-X', 0, $y, $MapSizeX, $y);
$map_canvas->coords ('Map-Crosshair-Y', $x, 0, $x, $MapSizeY);
$map_canvas->raise('Map-Crosshair', 'Target');
}
$LastCrosshairX = $x;
$LastCrosshairY = $y;
}
# Hide Crosshair on canvas
sub CrosshairHide
()
{
$map_canvas->lower('Map-Crosshair', 'Map'); # hide below map
$LastCrosshairX = -1;
$LastCrosshairY = -1;
}
#
# System Messages
#
# Init Messages for a Subsystem/timer
sub MkMessageInit
()
{
my ($Id) = @_;
$MkMessages{$Id} = [];
}
# Register message
sub MkMessage
()
{
my ($Message, $Id) = @_;
push @{$MkMessages{$Id}}, $Message;
}
# show registered messages
sub MkMessageShow
()
{
my @Messages;
my $MsgLines = 0;
my $MaxMsgLen = 0;
# Collect Messages of each category
foreach my $Id (keys %MkMessages)
{
foreach $i ( 0 .. $#{$MkMessages{$Id}} )
{
my $Msg = $MkMessages{$Id}[$i];
push @Messages, $Msg;
$MsgLines ++;
my $Len = length $Msg;
if ( $Len > $MaxMsgLen )
{
$MaxMsgLen = $Len;
}
}
}
$map_canvas->delete('Message-Balloon'); # delete old Balloon
if ( $MsgLines > 0 )
{
# draw Balloon
my @MsgBalloon = ( $MkPos_x , $MkPos_y,
$MkPos_x + 30 , $MkPos_y + 40,
$MkPos_x + 30 + $MaxMsgLen * 11, $MkPos_y + 40,
$MkPos_x + 30 + $MaxMsgLen * 11, $MkPos_y + 44 + $MsgLines * 20,
$MkPos_x + 20, $MkPos_y + 44 + $MsgLines * 20,
$MkPos_x + 20, $MkPos_y + 40,
$MkPos_x, $MkPos_y,
);
$map_canvas->createPolygon( @MsgBalloon,
'-tags' => ['Message-Balloon', 'Message-BalloonBubble'],
'-fill' => 'yellow',
'-outline' => 'yellow',
'-width' => 1,
);
# draw Messages
my $MsgLine = 1;
foreach my $Msg (@Messages)
{
$map_canvas->createText ( $MkPos_x + 25, $MkPos_y + 32 + $MsgLine * 20 ,
'-tags' => ['Message-Balloon', 'Message-BalloonText'],
'-text' => $Msg,
'-font' => '-*-Arial-Bold-R-Normal--*-200-*',
'-fill' => 'blue',
'-anchor' => 'w',
);
$MsgLine ++;
}
$map_canvas->lower('Message-Balloon', 'MK-Arrow');
}
}
# Show Balloon, when arproaching Target
sub TargetMessageShow
()
{
$map_canvas->delete('Target-Balloon'); # delete old Balloon
if ( $OperationMode ne "Free" and $MkOsd{'TargetPos_Stat'} == 1 and $MkOsd{'TargetPosDev_Dist'} /10 < 25 )
{
my $BalloonLines = 0;
$ColorBalloon = "blue";
my ($T_x, $T_y) = &MapGps2XY($MkOsd{'TargetPos_Lat'}, $MkOsd{'TargetPos_Lon'});
my $Wp = $Waypoints[$MkOsd{'WaypointIndex'}];
# Holdtime Wp-Player Mode
if ( $WpPlayerHoldtime >= 0 and $PlayerWptKmlMode eq "WPT" )
{
# Holdtime
$ColorBalloon = 'red';
my $HoldTime = sprintf ("%5s %3d s", "HLD:", int ($WpPlayerHoldtime / 2 + 0.5) );
$map_canvas->createText ( $T_x + 25, $T_y - 40,
'-tags' => ['Target-Balloon', 'Target-BalloonText'],
'-text' => $HoldTime,
'-font' => '-*-Arial-Bold-R-Normal--*-200-*',
'-fill' => $ColorBalloon,
'-anchor' => 'w',
);
$BalloonLines ++;
}
# Holdtime WPT-Mode
if ( &MkTargetReached() and $OperationMode eq "WPT" )
{
# Holdtime from MK
$ColorBalloon = 'red';
my $HoldTime = sprintf ("%5s %3d s", "HLD:", int ($MkOsd{'TargetHoldTime'} + 0.5) );
$map_canvas->createText ( $T_x + 25, $T_y - 40,
'-tags' => ['Target-Balloon', 'Target-BalloonText'],
'-text' => $HoldTime,
'-font' => '-*-Arial-Bold-R-Normal--*-200-*',
'-fill' => $ColorBalloon,
'-anchor' => 'w',
);
$BalloonLines ++;
}
# Tolerance Radius Player Mode
if ( &MkIsWptMode() and $OperationMode eq "Play" and $PlayerWptKmlMode eq "WPT" )
{
my $WpTolerance = sprintf ("%5s %3d m", "TOL:", $Wp->{'ToleranceRadius'});
$map_canvas->createText ( $T_x + 25, $T_y - 60,
'-tags' => ['Target-Balloon', 'Target-BalloonText'],
'-text' => $WpTolerance,
'-font' => '-*-Arial-Bold-R-Normal--*-200-*',
'-fill' => $ColorBalloon,
'-anchor' => 'w',
);
$BalloonLines ++;
}
# Tolerance WPT-Mode
if ( &MkIsWptMode and $OperationMode eq "WPT" )
{
my $WpTolerance = sprintf ("%5s %3d m", "TOL:", $Wp->{'ToleranceRadius'} );
$map_canvas->createText ( $T_x + 25, $T_y - 60,
'-tags' => ['Target-Balloon', 'Target-BalloonText'],
'-text' => $WpTolerance,
'-font' => '-*-Arial-Bold-R-Normal--*-200-*',
'-fill' => $ColorBalloon,
'-anchor' => 'w',
);
$BalloonLines ++;
}
# Distance to Target
my $Dist = int ($MkOsd{'TargetPosDev_Dist'} /10 + 0.5);
$map_canvas->createText ( $T_x + 25, $T_y - 80,
'-tags' => ['Target-Balloon', 'Target-BalloonText'],
'-text' => sprintf ("%5s %3d m", "DST:", $Dist) ,
'-font' => '-*-Arial-Bold-R-Normal--*-200-*',
'-fill' => $ColorBalloon,
'-anchor' => 'w',
);
$BalloonLines ++;
if ( $BalloonLines >= 1 )
{
# draw Balloon
my @TargetBalloon = ( $T_x , $T_y,
$T_x + 30, $T_y - (3 - $BalloonLines) * 20 -27,
$T_x + 150, $T_y - (3 - $BalloonLines) * 20 -27 ,
$T_x + 150, $T_y - 93,
$T_x + 20, $T_y - 93,
$T_x + 20, $T_y - (3 - $BalloonLines) * 20 -27,
$T_x, $T_y,
);
$map_canvas->createPolygon( @TargetBalloon,
'-tags' => ['Target-Balloon', 'Target-BalloonBubble'],
'-fill' => 'lightgray',
'-outline' => 'yellow',
'-width' => 1,
);
}
$map_canvas->lower('Target-Balloon', 'MK-Home-Line');
$map_canvas->lower('Target-BalloonBubble', 'Target-BalloonText');
}
}
#
# Airfield border
#
# Are two segments A(a1/a2), B(b1/b2) and C(c1/c2), D(d1/d2) crossing ?
sub SegmentCross
()
{
my ( $a1, $a2, $b1, $b2, $c1, $c2, $d1, $d2) = @_;
# segment C/D ist vertical, avoid div/0
if ( $c1 == $d1 )
{
$d1 += 0.00001;
}
my $n = ($b1 - $a1) * ($d2 - $c2) - ($b2 - $a2) * ($d1 - $c1);
if ( $n == 0.0 )
{
# AB und CD sind parallel
return 0;
}
my $s = ( ($c1 - $a1) * ($d2 - $c2) - ($c2 - $a2) * ($d1 - $c1) ) / $n;
my $t = ( $a1 - $c1 + $s * ($b1 - $a1) ) / ( $d1 - $c1 );
if ( $s >= 0.0 and $s <= 1.0 and $t >= 0.0 and $t <= 1.0 )
{
# beide Strecken kreuzen sich
# Schnittpunkt: s_x, s_y
my $s_x = $a1 + $s * ( $b1 - $a1 );
my $s_y = $a2 + $s * ( $b2 - $a2 );
return 1;
}
# beide Strecken kreuzen sich nicht
return 0;
}
# How often does a segment A(a1,a2), B(b1,b2) cross the polygon?
sub SegmentPolygonCross
()
{
my ( $a1, $a2, $b1, $b2, $Polygon) = @_;
my $Cross = 0;
my $PolyCnt = scalar @{$Polygon};
my $PolyPointCnt = $PolyCnt / 2;
my $i = 0;
for ( $p=0; $p < $PolyPointCnt; $p++ )
{
my $c1 = ${$Polygon}[$i++];
my $c2 = ${$Polygon}[$i++];
if ( $i >= $PolyCnt ) { $i = 0; }
my $d1 = ${$Polygon}[$i];
my $d2 = ${$Polygon}[$i+1];
# map calibration offsets
$c1 -= $Map{'Offset_x'};
$c2 += $Map{'Offset_y'};
$d1 -= $Map{'Offset_x'};
$d2 += $Map{'Offset_y'};
if ( &SegmentCross($a1, $a2, $b1, $b2, $c1, $c2, $d1, $d2) )
{
$Cross ++;
}
}
return $Cross;
}
# Is point A inside airfield border?
sub IsInsideBorder
()
{
my ($a1, $a2) = @_;
if ( scalar @Map{'Border'} == 0 )
{
# no border defined, always inside
return 1;
}
my $Cross = &SegmentPolygonCross (-10, -10, $a1, $a2, @Map{'Border'} );
# Ungerade Anzahl Kreuzungen: Inside
return ( $Cross % 2 );
}
# Is segment A, B crossing the airfield border?
sub IsCrossingBorder
()
{
my ($a1, $a2, $b1, $b2) = @_;
if ( scalar @Map{'Border'} == 0 )
{
# no border defined, always not crossing
return 0;
}
my $Cross = &SegmentPolygonCross ($a1, $a2, $b1, $b2, @Map{'Border'} );
return ( $Cross > 0 );
}
# How often is segment A, B crossing the airfield border?
sub CrossingBorderCount
()
{
my ($a1, $a2, $b1, $b2) = @_;
if ( scalar @Map{'Border'} == 0 )
{
# no border defined, not crossing
return 0;
}
my $Cross = &SegmentPolygonCross ($a1, $a2, $b1, $b2, @Map{'Border'} );
return ( $Cross );
}
# check, if Target is reachable my MK
sub IsTargetReachable
()
{
my ($T_x, $T_y) = @_;
my $MkIsInside = &IsInsideBorder($MkPos_x, $MkPos_y);
my $TargetIsInside = &IsInsideBorder($T_x, $T_y);
my $MkTargetCrossingCount = &CrossingBorderCount($MkPos_x, $MkPos_y, $T_x, $T_y);
if ( ($MkIsInside and $MkTargetCrossingCount == 0 ) or
(! $MkIsInside and $TargetIsInside and $MkTargetCrossingCount == 1) )
{
# Target is reachable
return 1;
}
# Target is not reachable
return 0;
}
#
# Configuration and data-visualisation
#
# Display or Modify Hash
sub DisplayHash
()
{
my ($hrefData, $Titel, $Mode) = @_;
# $Mode: Display, Edit, Waypoint, Refresh, Heartbeat, SerialChannel, ExternControl
my $MaxRow = 22; # number or Rows in multi column view
my %Id;
my $Label;
my $Value;
# Neues Fenster aufmachen
my $popup = $main->Toplevel();
$popup->title($Titel);
# Frame mit den Buttons
my $popup_button = $popup->Frame() -> pack('-side' => 'bottom',
'-expand' => 'y',
'-anchor' => 's',
'-padx' => 5,
'-pady' => 5,
);
$popup_button->Button('-text' => 'Schließen',
'-command' => sub
{
if ( $Mode =~ /edit/i and $Mode =~ /waypoint/i )
{
$WaypointsModified = 1;
&WpRedrawLines();
&WpRedrawIcons();
}
$popup->destroy()
})->pack;
# Frame mit den Labels und Daten
my $popup_data = $popup->Frame() -> pack('-side' => 'left',
'-expand' => 'y',
'-anchor' => 'w',
'-padx' => 10,
'-pady' => 10,
);
# Labels und Daten anzeigen
my $Row = 0;
my $Col = 0;
foreach $Label ( sort keys %{$hrefData})
{
$LabelView = $Label;
if ( $Translate{$LabelView} ne "" )
{
$LabelView = $Translate{$LabelView};
}
# Label
$popup_data->Label ('-text' => $LabelView,
'-width' => 25,
'-anchor' => 'w',
) -> grid( -row
=> $Row,
-column
=> $Col,
-padx
=> 10,
);
# Daten
if ( $Mode =~ /display/i )
{
# Display
if ( ref ${$hrefData}{$Label} )
{
$Text = "- can't display references -";
}
else
{
$Text = ${$hrefData}{$Label};
}
$Id{$Label} = $popup_data->Label ('-text' => $Text,
'-width' => 20,
'-anchor' => 'e',
'-relief' => 'sunken',
) -> grid( -row
=> $Row,
-column
=> $Col + 1,
-padx
=> 10,
);
}
if ( $Mode =~ /edit/i )
{
# Edit
$Id{$Label} = $popup_data->Entry ('-textvariable' => \
${$hrefData}{$Label},
'-exportselection' => '1',
'-width' => 20,
'-relief' => 'sunken',
) -> grid( -row
=> $Row,
-column
=> $Col + 1,
-padx
=> 10,
);
if ( $Mode =~ /waypoint/i )
{
# einige Waypoint-Felder nicht aenderbar einstellen
if ( "MapX MapY Pos_Lat Pos_Lon Tag" =~ /$Label/i )
{
$Id{$Label}->configure('-state' => 'disabled', );
}
}
}
# multi Column wrap
$Row++;
if ( $Row > $MaxRow )
{
$Row = 0;
$Col += 2;
}
}
if ( $Mode =~ /refresh/i )
{
# Timer: 0.1s
$popup_data->repeat (100, sub
{
# Datenfelder alle 100ms aktualisieren
my $BgColor = 'white';
if ( $Mode =~ /heartbeat/i )
{
$BgColor = 'red';
if ( &MkOsdIsValid() )
{
# gültige daten vom MK
$BgColor = 'white';
}
}
if ( $Mode =~ /serialchannel/i )
{
$BgColor = 'red';
if ( $Cfg->{'serialchannel'}->{'SerialChannelSend'} =~ /y/i )
{
# senden aktiv
$BgColor = 'white';
}
}
if ( $Mode =~ /externcontrol/i )
{
$BgColor = 'red';
if ( $Cfg->{'externcontrol'}->{'ExternControlSend'} =~ /y/i )
{
# senden aktiv
$BgColor = 'white';
}
}
foreach $Label ( sort keys %{$hrefData} )
{
# Eingebbare Waypoint-Felder nicht aktualisieren
if ( ! ($Mode =~ /waypoint/i and
"Event_Flag Heading ToleranceRadius HoldTime Pos_Alt" =~ /$Label/i) )
{
$Id{$Label}->configure('-text' => ${$hrefData}{$Label},
'-background' => "$BgColor",
);
}
}
});
}
return 0;
}
# Konfigurations-Hash (aus XML-Datei) im Popup-Fenster editieren
sub Configure
()
{
my ($CfgFile, $hrefCfg, $Mode) = @_;
# get a copy of Cfg-Hash for editing
my $CfgEdit = &CopyHash($hrefCfg);
# Neues Fenster aufmachen
my $popup = $main->Toplevel();
$popup->title("Einstellungen - $CfgFile");
# Display data in a notebook widget
my $book = $popup->NoteBook(-dynamicgeometry
=> 1,
)->grid(-row
=> 0,
-column
=> 0,
-columnspan
=> 4,
-sticky
=> 'w',
-padx
=> 5,
-pady
=> 5,
);
# Show data
&ConfigureShow($book, $CfgEdit);
# Button: OK
$popup->Button('-text' => 'OK',
'-width' => '10',
'-command' => sub
{
# Save and activate config
&ConfigureSave( $CfgFile, $hrefCfg, $CfgEdit);
$popup->destroy();
} )->grid(-row
=> 1,
-column
=> 0,
-sticky
=> 'w',
-padx
=> 15,
-pady
=> 5,
);
# Button: Apply
$popup->Button('-text' => $Translate{'Apply'},
'-width' => '10',
'-command' => sub
{
# Save and activate config
&ConfigureSave( $CfgFile, $hrefCfg, $CfgEdit);
} )->grid(-row
=> 1,
-column
=> 1,
-sticky
=> 'w',
-padx
=> 15,
-pady
=> 5,
);
# Button: Abort
$popup->Button('-text' => $Translate{'Abort'},
'-width' => '10',
'-command' => sub { $popup->destroy() },
)->grid(-row
=> 1,
-column
=> 2,
-sticky
=> 'w',
-padx
=> 15,
-pady
=> 5,
);
#
# special handling for "Config" configuration
#
if ( $Mode =~ /CONFIG/i )
{
$popup->Label ('-text' => $Translate{'RestartRequired'},
'-anchor' => 'w',
'-foreground' => 'red',
)->grid(-row
=> 1,
-column
=> 3,
-sticky
=> 'w',
-padx
=> 5,
-pady
=> 5,
);
}
#
# special handling for "Event" configuration
#
if ( $Mode =~ /EVENT/i )
{
# notebook must have at least one tab
if (scalar $book->pages() == 0 )
{
# create new record in hash
my $NewEvent = sprintf ("Event%d", scalar $book->pages() + 1);
&EventInit($NewEvent, $CfgEdit);
# Display new event
&ConfigureShow($book, $CfgEdit);
$book->raise($NewEvent);
}
# Menu bar (New, Delete, Rename)
my $menu_bar = $popup->Menu;
$popup->optionAdd("*tearOff", "false");
$popup->configure ('-menu' => $menu_bar);
my $menu_event = $menu_bar->cascade('-label' => $Translate{'Event'});
#
# New Event
#
$menu_event->command('-label' => $Translate{'EventNew'},
'-command' => sub
{
# Event Name in neuem Fenster abfragen
my $popup_new = $popup->Toplevel();
$popup_new->title("Event - $Translate{'EventNew'}");
$popup_new->Label (-text
=> $Translate{'EventNewName'},
-width
=> 20,
-anchor
=> 'w',
)->grid (-row
=> 0,
-column
=> 0,
-sticky
=> 'w',
-padx
=> 5,
-pady
=> 5,
);
my $NewEvent = sprintf ("Event%d", scalar $book->pages() + 1);
$popup_new->Entry ( -textvariable
=> \$NewEvent,
-exportselection
=> '1',
-width
=> 40,
-relief
=> 'sunken',
)->grid (-row
=> 0,
-column
=> 1,
-sticky
=> 'w',
-padx
=> 5,
-pady
=> 5,
);
# Button: OK
$popup_new->Button('-text' => "OK",
'-width' => '10',
'-command' => sub
{
# create new record in hash
$NewEvent = &EventnameAdjust($NewEvent);
&EventInit($NewEvent, $CfgEdit);
# Display new event
&ConfigureShow($book, $CfgEdit);
$book->raise($NewEvent);
$popup_new->destroy();
} )->grid (-row
=> 1,
-column
=> 0,
-sticky
=> 'w',
-padx
=> 20,
-pady
=> 5,
);
# Button: Abort
$popup_new->Button('-text' => $Translate{'Abort'},
'-width' => '10',
'-command' => sub
{
$popup_new->destroy()
} )->grid (-row
=> 1,
-column
=> 1,
-sticky
=> 'e',
-padx
=> 20,
-pady
=> 5,
);
});
#
# Rename Event
#
$menu_event->command('-label' => $Translate{'EventRename'},
'-command' => sub
{
# Event Name in neuem Fenster abfragen
my $popup_rename = $popup->Toplevel();
$popup_rename->title("Event - $Translate{'EventRename'}");
$popup_rename->Label (-text
=> $Translate{'EventName'},
-width
=> 20,
-anchor
=> 'w',
)->grid (-row
=> 0,
-column
=> 0,
-sticky
=> 'e',
-padx
=> 5,
-pady
=> 5,
);
my $CurrentEvent = $book->raised;
$popup_rename->Entry ( -textvariable
=> \$CurrentEvent,
-exportselection
=> '1',
-width
=> 40,
-relief
=> 'sunken',
-state
=> 'disabled',
)->grid (-row
=> 0,
-column
=> 1,
-sticky
=> 'w',
-padx
=> 5,
-pady
=> 5,
);
$popup_rename->Label (-text
=> $Translate{'EventNewName'},
-width
=> 20,
-anchor
=> 'w',
)->grid (-row
=> 1,
-column
=> 0,
-sticky
=> 'e',
-padx
=> 5,
-pady
=> 5,
);
my $NewEvent = sprintf ("Event%d", scalar $book->pages() + 1);
$popup_rename->Entry ( -textvariable
=> \$NewEvent,
-exportselection
=> '1',
-width
=> 40,
-relief
=> 'sunken',
)->grid (-row
=> 1,
-column
=> 1,
-sticky
=> 'w',
-padx
=> 5,
-pady
=> 5,
);
# Button: OK
$popup_rename->Button('-text' => "OK",
'-width' => '10',
'-command' => sub
{
$NewEvent = &EventnameAdjust($NewEvent);
# create new record in hash
$CfgEdit->{$NewEvent} = $CfgEdit->{$CurrentEvent};
delete $CfgEdit->{$CurrentEvent}
# Display events again
&ConfigureShow($book, $CfgEdit);
$book->raise($NewEvent);
$popup_rename->destroy();
} )->grid (-row
=> 2,
-column
=> 0,
-sticky
=> 'e',
-padx
=> 20,
-pady
=> 5,
);
# Button: Abort
$popup_rename->Button('-text' => $Translate{'Abort'},
'-width' => '10',
'-command' => sub
{
$popup_rename->destroy()
} )->grid (-row
=> 2,
-column
=> 1,
-sticky
=> 'w',
-padx
=> 20,
-pady
=> 5,
);
});
#
# Copy Event
#
$menu_event->command('-label' => $Translate{'EventCopy'},
'-command' => sub
{
# Event Name in neuem Fenster abfragen
my $popup_copy = $popup->Toplevel();
$popup_copy->title("Event - $Translate{'EventCopy'}");
my $CurrentEvent = $book->raised;
my $CopyEvent = sprintf ("Event%d", scalar $book->pages() + 1);
$popup_copy->Label (-text
=> $Translate{'EventName'},
-width
=> 20,
-anchor
=> 'w',
)->grid (-row
=> 0,
-column
=> 0,
-sticky
=> 'e',
-padx
=> 5,
-pady
=> 5,
);
$popup_copy->Entry ( -textvariable
=> \$CurrentEvent,
-exportselection
=> '1',
-width
=> 40,
-relief
=> 'sunken',
-state
=> 'disabled',
)->grid (-row
=> 0,
-column
=> 1,
-sticky
=> 'w',
-padx
=> 5,
-pady
=> 5,
);
$popup_copy->Label (-text
=> $Translate{'EventNewName'},
-width
=> 20,
-anchor
=> 'w',
)->grid (-row
=> 1,
-column
=> 0,
-sticky
=> 'w',
-padx
=> 5,
-pady
=> 5,
);
$popup_copy->Entry ( -textvariable
=> \$CopyEvent,
-exportselection
=> '1',
-width
=> 40,
-relief
=> 'sunken',
)->grid (-row
=> 1,
-column
=> 1,
-sticky
=> 'w',
-padx
=> 5,
-pady
=> 5,
);
# Button: OK
$popup_copy->Button('-text' => "OK",
'-width' => '10',
'-command' => sub
{
$CopyEvent = &EventnameAdjust($CopyEvent);
# copy hash
$CfgEdit->{$CopyEvent} = {%{$hrefCfg->{$CurrentEvent}}};
# Display new event
&ConfigureShow($book, $CfgEdit);
$book->raise($CopyEvent);
$popup_copy->destroy();
} )->grid (-row
=> 2,
-column
=> 0,
-sticky
=> 'w',
-padx
=> 20,
-pady
=> 5,
);
# Button: Abort
$popup_copy->Button('-text' => $Translate{'Abort'},
'-width' => '10',
'-command' => sub
{
$popup_copy->destroy()
} )->grid (-row
=> 2,
-column
=> 1,
-sticky
=> 'e',
-padx
=> 20,
-pady
=> 5,
);
});
#
# Delete event
#
$menu_event->command('-label' => $Translate{'EventDelete'},
'-command' => sub
{
my $CurrentBook = $book->raised;
# delet event in Cfg-Hash
delete $CfgEdit->{$CurrentBook};
# Display events again
&ConfigureShow($book, $CfgEdit);
});
#
# Export current Event
#
$menu_event->command('-label' => $Translate{'EventExport'},
'-command' => sub
{
my $XmlFile = $popup->getSaveFile('-defaultextension' => ".xml",
'-filetypes' =>
[['Event', '.xml' ],
['All Files', '*', ],
],
'-initialdir' => "event",
'-title' => $Translate{'EventExport'},
);
if ( $XmlFile ne "" )
{
my %ExportCfg;
my $CurrentEvent = $book->raised;
# copy and quote event
foreach $key (keys %{$CfgEdit->{$CurrentEvent}})
{
my $Line = $CfgEdit->{$CurrentEvent}->{$key};
$ExportCfg->{$key} = &QuoteXML($Line);
}
# Event in XML-Datei speichern
&XMLout ($ExportCfg, # save quoted hash
'OutputFile' => $XmlFile,
'AttrIndent' => '1',
'RootName' => 'mkcockpit-Event',
'NoEscape' => '1',
);
}
});
#
# Import XML to current Event
#
$menu_event->command('-label' => $Translate{'EventImport'},
'-command' => sub
{
my $XmlFile = $popup->getOpenFile(-defaultextension
=> ".xml",
-filetypes
=>
[['Event', '.xml' ],
['All Files', '*', ],
],
-initialdir
=> "event",
-title
=> $Translate{'EventImport'},
);
if ( -f
$XmlFile )
{
my $CurrentEvent = $book->raised;
my $ImportCfg = XMLin
($XmlFile);
# copy event
foreach $key (keys %{$ImportCfg})
{
$CfgEdit->{$CurrentEvent}->{$key} = $ImportCfg->{$key};
}
# deactivate Event
$CfgEdit->{$CurrentEvent}->{'Active'} = "NO";
}
});
}
}
# Copy a Cfg-Hash including real copy of hash-references
sub CopyHash
()
{
my ($hrefCfg) = @_;
my $CfgCopy = {%{$hrefCfg}};
foreach $key (keys %{$hrefCfg})
{
if ( ref $hrefCfg->{$key} )
{
$CfgCopy->{$key} = {%{$hrefCfg->{$key}}};
}
}
return $CfgCopy;
}
# Initialize a new event
sub EventInit
()
{
my ($EventName, $Cfg) = @_;
$Cfg->{$EventName}->{'Active'} = "no";
$Cfg->{$EventName}->{'Action'} = "";
$Cfg->{$EventName}->{'ActionElse'} = "";
$Cfg->{$EventName}->{'Condition'} = "";
$Cfg->{$EventName}->{'Delay'} = "";
$Cfg->{$EventName}->{'Repeat'} = "";
$Cfg->{$EventName}->{'RepeatElse'} = "";
$Cfg->{$EventName}->{'Description'} = "";
$Cfg->{$EventName}->{'Trigger'} = "TRUE";
}
# Event-Name XML konform anpassen
sub EventnameAdjust
()
{
my ($Name) = @_;
$Name =~ s/\W/_/g;
if ( substr ($Name, 0, 1) =~ /\d/ )
{
substr ($Name, 0, 1) = "_";
}
return $Name;
}
# Reiter mit Konfigurationsdaten anzeigen
sub ConfigureShow
()
{
my ($book, $CfgEdit) = @_;
# delete all existing tabs in notebook
foreach my $Tab ($book->pages)
{
$book->delete($Tab);
}
# jede Sektion in eigenem Tab anzeigen
foreach $key (sort keys %{$CfgEdit})
{
if ( ! ref $CfgEdit->{$key} )
{
next;
}
my $TabLabel = "$key";
if ( $Translate{$key} ne "" )
{
$TabLabel = $Translate{$key};
}
my $Tab = $book->add( "$key",
-label
=> "$TabLabel",
-wraplength
=> "75",
);
# Frame for label and data
my $popup_cfg = $Tab->Frame() -> pack('-anchor' => 'w',
'-padx' => 5,
'-pady' => 5,
);
# Eingabefelder/Optionmenu/Fileselection mit Daten anzeigen
$Row = 0;
foreach $Entry ( sort keys %{$CfgEdit->{$key}})
{
# Label
my $Label = $Entry;
if ( $Translate{$Label} ne "" )
{
$Label = $Translate{$Label};
}
$popup_cfg->Label (-text
=> $Label,
-width
=> 35,
-anchor
=> 'w',
)->grid (-row
=> $Row,
-column
=> 0,
);
#
# Combo Box with optiones defined in libcfgopt.pl
#
if ( defined $CfgOpt{$Entry}[0] )
{
my $cbo = $popup_cfg->BrowseEntry( -label
=> "",
-variable
=> \$CfgEdit->{$key}->{$Entry},
-width
=> 37,
-relief
=> 'sunken',
)->grid (-row
=> $Row,
-column
=> 1,
-columnspan
=> 2,
-sticky
=> 'w',
);
# add options
$cbo->insert("end", @{ $CfgOpt{$Entry} });
}
#
# File selection, if defined in libcfgopt.pl
#
elsif ( defined $CfgFile{$Entry} )
{
# a) Text entry
my $TextEntry = $popup_cfg->Entry ( -textvariable
=> \$CfgEdit->{$key}->{$Entry},
-exportselection
=> '1',
-width
=> 37,
-relief
=> 'sunken',
)->grid (-row
=> $Row,
-column
=> 1,
-columnspan
=> 1,
-sticky
=> 'e',
);
# b) button with file selection dialog
my $Mode = $CfgFile{$Entry};
$popup_cfg->Button('-text' => '>',
'-width' => 1,
'-command' => sub
{
my $File = $popup_cfg->getOpenFile( '-title' => $Label );
if ($File ne "" )
{
if ( $Mode =~ /Filename/i )
{
$File = substr ($File, rindex ($File, '/') +1 );
}
elsif ( $Mode =~ /Path/i )
{
# nothing to do
}
# show selection in text entry
$TextEntry->delete (0, length $TextEntry->get );
$TextEntry->insert (0, $File);
}
} )->grid (-row
=> $Row,
-column
=> 2,
-sticky
=> 'e',
);
}
#
# Multiline Text widget, if defined in libcfgopt.pl
#
elsif ( defined $CfgText{$Entry} )
{
# a) Text entry
my $State = 'normal';
my $NumLines = grep /\n/, $CfgEdit->{$key}->{$Entry};
if ( $NumLines > 0 )
{
$State = 'disabled';
}
my $TextEntry = $popup_cfg->Entry ( -textvariable
=> \$CfgEdit->{$key}->{$Entry},
-exportselection
=> '1',
-state
=> $State,
-width
=> 37,
-relief
=> 'sunken',
)->grid (-row
=> $Row,
-column
=> 1,
-columnspan
=> 1,
-sticky
=> 'e',
);
# b) button with multiline Text-Edit dialog
my ($Width, $Height) = split /;/, $CfgText{$Entry};
my $Title = "Edit: $key -> $Entry";
my $refVariable = \$CfgEdit->{$key}->{$Entry};
$popup_cfg->Button('-text' => '>',
'-width' => 1,
'-command' => sub
{
# popup mit Text-Widget
my $popup_text = $popup_cfg->Toplevel();
$popup_text->title($Title);
my $text = $popup_text->Scrolled( "Text",
-height
=> $Height,
-width
=> $Width,
-wrap
=> 'none',
-scrollbars
=> 'se',
)->pack();
$text->insert('end', $$refVariable);
# OK Button
$popup_text->Button('-text' => 'OK',
'-width' => 10,
'-command' => sub
{
# Text uebernehmen
$$refVariable = $text->get("1.0", "end");
chomp $$refVariable;
$popup_text->destroy()
} )->pack ('-side' => 'left',
'-expand' => 'y',
'-anchor' => 's',
'-padx' => 5,
'-pady' => 5,
);
# Anwenden Button
$popup_text->Button('-text' => $Translate{'Apply'},
'-width' => 10,
'-command' => sub
{
# Text uebernehmen
$$refVariable = $text->get("1.0", "end");
chomp $$refVariable;
} )->pack ('-side' => 'left',
'-expand' => 'y',
'-anchor' => 's',
'-padx' => 5,
'-pady' => 5,
);
# Abort Button
$popup_text->Button('-text' => $Translate{'Abort'},
'-width' => '10',
'-command' => sub
{
$popup_text->destroy();
} )->pack ('-side' => 'left',
'-expand' => 'y',
'-anchor' => 's',
'-padx' => 5,
'-pady' => 5,
);
} )->grid (-row
=> $Row,
-column
=> 2,
-sticky
=> 'e',
);
}
#
# Text entry
#
else
{
$popup_cfg->Entry ( -textvariable
=> \$CfgEdit->{$key}->{$Entry},
-exportselection
=> '1',
-width
=> 40,
-relief
=> 'sunken',
)->grid (-row
=> $Row,
-column
=> 1,
-columnspan
=> 2,
-sticky
=> 'e',
);
}
# next Variable in next row
$Row ++;
}
}
}
# Quote for output to XML-file
sub QuoteXML
()
{
my ($Line) = @_;
$Line =~ s/\&/\&/g;
$Line =~ s/'/\'/g;
$Line =~ s/</\</g;
$Line =~ s/>/\>/g;
$Line =~ s/"/\"/g;
$Line =~ s/\n/\ /g;
return $Line;
}
# Activate and save Config to file
sub ConfigureSave
()
{
my ($CfgFile, $hrefCfg, $CfgEdit) = @_;
# set new timestamp
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
my $TimeStamp = sprintf ("%04d%02d%02d-%02d%02d%02d", $year+1900, $mon+1, $mday, $hour, $min, $sec);
$CfgEdit->{'CreationDate'} = $TimeStamp;
# set MkCockpit Version
$CfgEdit->{'Version'} = $Version{'mkcockpit.pl'};
# empty original hash
foreach $key (keys %{$hrefCfg})
{
delete $hrefCfg->{$key};
}
# Build %CfgXml with XML-quoting
my $CfgXml = {};
# then copy %CfgEdit back to $hrefCfg.
foreach $key (keys %{$CfgEdit})
{
if ( ref $CfgEdit->{$key} )
{
# Reference
foreach $val (keys %{$CfgEdit->{$key}})
{
my $Line = $CfgEdit->{$key}->{$val};
$hrefCfg->{$key}->{$val} = $Line;
$CfgXml->{$key}->{$val} = &QuoteXML($Line);
}
}
else
{
# Scalar
my $Line = $CfgEdit->{$key};
$hrefCfg->{$key} = $Line;
$CfgXml->{$key} = &QuoteXML($Line);
}
}
# Cfg in XML-Datei speichern
&XMLout ($CfgXml, # save quoted hash
'OutputFile' => $CfgFile,
'AttrIndent' => '1',
'RootName' => 'mkcockpit-Config',
'NoEscape' => '1',
);
}
1;
__END__