diff options
Diffstat (limited to 'src/MTools/Comp/MMultiSelection.pm')
| -rw-r--r-- | src/MTools/Comp/MMultiSelection.pm | 754 |
1 files changed, 754 insertions, 0 deletions
diff --git a/src/MTools/Comp/MMultiSelection.pm b/src/MTools/Comp/MMultiSelection.pm new file mode 100644 index 0000000..f124720 --- /dev/null +++ b/src/MTools/Comp/MMultiSelection.pm @@ -0,0 +1,754 @@ +package MTools::Comp::MMultiSelection; +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU LGPL Libray General Public License +# as published by the Free Software Foundation; either version 2 +# of the License, or (at your option) any later version. +# +# 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. See the +# GNU Library General Public License for more details. +# +# You should have received a copy of the GNU Library General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA, +# or refer to http://www.gnu.org/copyleft/lgpl.html +# +################################################################## + + +# Le composant MMultiSelection associe deux comportements : +# 1. Selection multiple d'objets repartis eventuellement dans plusieurs plans. +# La selection des objets est geree en les entourant et des-entourant. +# Si un objet est selectionne dans le plan 1, les objets situes dans les plans 2, 3, etc. sont negliges. +# De meme, si un objet est selectionne dans le plan, les objets situes dans les plans 3, 4, etc. sont negliges. +# 2. Deux interactions peuvent-etre initiees depuis la zone de selection. Si l'interaction est demarree +# au-dessus d'un objet, on deplace les objets selectionnes. Si on demarre un interaction au-dessus du fond, +# on demarre une operation de designation de cibles. +# +# Les cibles et les objets selectionnables doivent declarer des proprietes particulieres. Il n'y a ce jour de +# composant definissant ces interfaces, c'est un tord... Qui est volontaire :) +# +# Les source doivent definir les prorpiete +# barycentre_x +# barycentre_y +# La position d'un objet est definie par +# la valeur de barycentre_x plus optionnelement la valeur de la propriete x si celle-ci est definie +# la valeur de barycentre_y plus optionnelement la valeur de la propriete y si celle-ci est definie +# Les cibles doivent emettre les evenements +# DRAGENTER +# DRAGLEAVE +# RELEASEDOVER +# +# NOTA : le deuxieme comportement devrait etre dissocie de l'objet multi-selection... +# Cela reste a faire egalement +# +# Parametres : +# * src : Objet sur lequel est effectue l'interaction de selection +# * dessin : Group parent du dessin de la selection +# * reference a la frame principale +# Proprietes : +# * delay : duree pendant laquelle le dessin de la selection s'estompe et pendant laquelle le demarrage de la +# seconde interaction est possible +# * inertie : coefficient d'inertie dqns le deplacement de la fleche +# Evenements : +# * PRESSED : Notifie lorsque l'on demarre la selection +# * MOVED : Notifie lorsque la selection evolue +# * RELEASED : Notifie lorsque la selection est terminee +# * FLECHEPRESSED : Notifie lorsque une seconde interaction est demarree depuis la zone de selection +# * FLECHEMOVED : Notifie lorsque la seconde interaction evolue +# * FLECHERELEASED : Notifie lorsque la seconde interaction se termine +# * SELECTION_CHANGED : Notifie lorsque le statut d'un objet a change +# Fonctions : +# * addObject : $multi -> addObject ($objet, $plan) +# Ajoute l'objet $objet dans le plan de selection $plan +# * removeObject : $multi -> removeObject ($objet, $plan) +# Supprime l'objet $objet du plan de selection $plan +# * addDropTarget : $multi -> addDropTarget ($target) +# Ajoute la cible $target +# * removeDropTarget : $multi -> removeDropTarget ($target) +# Supprime la cible $target +# * applySelection : $multi -> applySelection ($plan, $fonction, @parametres) +# Applique la fonction $fonction (@parametres) ? tous les objets selectionnes dans le plan $plan +# * applyAll : $multi -> applyAll ($plan, $fonction, @parametres) +# Applique la fonction $fonction (@parametres) ? tous les objets du plan $plan +# * getSelectedPlan : $multi -> getSelectedPlan () +# Retourne l'index du plan selectionne +# * getSelection : $multi -> getSelection ($plan) +# Retourne la liste des objets selectionnes dans le plan $plan si $plan est d?fini +# sinon retourne $multi -> getSelection ($multi -> getSelectedPlan ()) +# + + + +use strict; +use MTools; +use MTools::MObjet; +use Math::Trig; +use MTools::Anim::MOpacity; +use MTools::Comp::MInertie; +use MTools::MGroup; + +use vars qw /@ISA/; + +BEGIN +{ + @ISA = qw /MTools::MObjet/; +} + +use Tk; + +sub new { + my ($class, $src, $dessin, $frame, %options) = @_; + my $self = new MTools::MObjet (); + bless $self, $class; + + $self -> recordProperty ('delay', 0); + $self -> recordProperty ('inertie', 0.6); + $self -> recordEvent ('PRESSED'); + $self -> recordEvent ('MOVED'); + $self -> recordEvent ('RELEASED'); + $self -> recordEvent ('FLECHEPRESSED'); + $self -> recordEvent ('FLECHEMOVED'); + $self -> recordEvent ('FLECHERELEASED'); + $self -> recordEvent ('SELECTION_CHANGED'); + $self -> recordEvent ('DESELECT_ALL'); + $self -> mconfigure (%options); + + binding ($src, '<Button-1>', [\&__pressed, $self, Ev('x'), Ev('y'), Ev('t')]); + binding ($src, '<Button1-Motion>', [\&__moved, $self, Ev('x'), Ev('y'), Ev('t')]); + binding ($src, '<ButtonRelease-1>', [\&__released, $self, Ev('x'), Ev('y'), Ev('t')]); + + $self -> {__inertie} = my $inertie = new MTools::Comp::MInertie( + $self, + 'rate' => $self -> mget ('inertie'), + ); + binding ($inertie, 'INERTIE_STOPPED', [$self, \&__fin_moved]); + + my $inertie = new MTools::Comp::MInertie( + $self, + 'rate' => 0.75, + 'msg_pressed' => 'FLECHEPRESSED', + 'msg_moved' => 'FLECHEMOVED', + 'msg_released' => 'FLECHERELEASED', + 'msg_stopped' => 'FLECHEINERTIE_STOPPED', + 'inertie_callback' => '__translate_fleche', + ); + binding ($inertie, 'FLECHEINERTIE_STOPPED', [$self, \&__fin_fleche_moved]); + + $self -> {__frame} = $frame; + $self -> {__drop_targets} = (); + $self -> {__objects} = (); + $self -> {__points} = (); + $self -> {__owns_data} = (); + $self -> {__source} = minstance ($src); + + $self -> {__gp_anime} = my $group = new MTools::MGroup ($dessin); + + push (@{$self -> {__owns_data}}, minstance ($src)); + push (@{$self -> {__owns_data}}, minstance ($group)); + + $self -> {__anim__disparition} = new MTools::Anim::MOpacity ( + duration => 0.8, + targets => $group, + from_opacity => 100, + to_opacity => 0, + ); + + binding ($self -> {__anim__disparition}, 'ANIMATION_END', [$self, \&__clear]); + + $self -> {__curve_bck} = $zinc -> add ('curve', minstance($group), [[0,0],[0,0]], + -linecolor => "#888888;50", + -linewidth => 2, + -smoothrelief => 1, + -priority => 10, + -visible => 1, + -sensitive => 1, + -filled => 0, + ); + $self -> {__curve} = $zinc -> add ('curve', minstance($group), [[0,0],[0,0]], + -linecolor => "#FFFFFF;90", + -linewidth => 1, + -smoothrelief => 1, + -priority => 10, + -visible => 1, + -sensitive => 1, + -fillcolor => "#FFFFFF;10", + -filled => 1, + ); + push (@{$self -> {__owns_data}}, minstance ($self -> {__curve})); + + $self -> {__fleche} = $zinc -> add ('curve', minstance($dessin), [[0,0],[0,0]], + -linecolor => "black", + -linewidth => 2, + -priority => 10, + -visible => 1, + -sensitive => 0, + ); + push (@{$self -> {__owns_data}}, minstance ($self -> {__fleche})); + + $self -> {__ph_fleche} = $zinc -> add ('curve', minstance($dessin), [[0,0],[0,0]], + -linecolor => "black", + -linewidth => 2, + -priority => 10, + -visible => 1, + -sensitive => 0, + ); + push (@{$self -> {__owns_data}}, minstance ($self -> {__ph_fleche})); + + $self -> {__pb_fleche} = $zinc -> add ('curve', minstance($dessin), [[0,0],[0,0]], + -linecolor => "black", + -linewidth => 2, + -priority => 10, + -visible => 1, + -sensitive => 0, + ); + push (@{$self -> {__owns_data}}, minstance ($self -> {__pb_fleche})); + + binding ($self -> {__curve}, '<Button-1>', [\&__fleche_pressed, $self, Ev('x'), Ev('y'), Ev('t')]); + binding ($self -> {__curve}, '<Button1-Motion>', [\&__fleche_moved, $self, Ev('x'), Ev('y'), Ev('t')]); + binding ($self -> {__curve}, '<ButtonRelease-1>', [\&__fleche_released, $self, Ev('x'), Ev('y'), Ev('t')]); + $self -> {__fleche_points} = (); + $self -> {__fleche_started} = 0; + $self -> {__drag_started} = 0; + return $self; +} + +sub __hide_cursor { + my ($self) = @_; + my $frame = $self -> {__frame}; + $frame -> {window} -> Tk::configure ( + -cursor => [ '@'.Tk::findINC('emptycursor.xbm'), + Tk::findINC('emptycursor.mask'), + 'black', 'black' + ] + ); +} + +sub __show_cursor { + my ($self) = @_; + my $frame = $self -> {__frame}; + $frame -> {window} -> Tk::configure ( + -cursor => "", + ); +} + +sub addObject { + my ($self, $object, $plan) = @_; + if (!defined $plan) {$plan = 0;} + if (!$object -> propertyExists ('barycentre_x')) + { + print "MMultiSelection Error property barycentre_x isn't defined in $object\n"; + return; + } + if (!$object -> propertyExists ('barycentre_y')) + { + print "MMultiSelection Error property barycentre_y isn't defined in $object\n"; + return; + } + $object -> {__surround_angle} = 0; + push (@{$self -> {__objects} [$plan]}, $object); +} + +sub removeObject { + my ($self, $target, $plan) = @_; + if (!defined $plan) {$plan = 0;} + for (my $i = @{$self -> {__objects} [$plan]} - 1; $i >= 0; $i --) + { + if (@{$self -> {__objects} [$plan]} [$i] eq $target) + { + splice (@{$self -> {__objects} [$plan]}, $i, 1); + last; + } + } +} + +sub addDropTarget { + my ($self, $target) = @_; + push (@{$self -> {__drop_targets}}, $target); +} + +sub removeDropTarget { + my ($self, $target) = @_; + if ($self -> {__last_notified} == $target) + { + $self -> {__last_notified} = undef; + } + for (my $i = @{$self -> {__drop_targets}} - 1; $i >= 0; $i--) + { + if (@{$self -> {__drop_targets}} [$i] eq $target) + { + splice (@{$self -> {__drop_targets}}, $i, 1); + last; + } + } +} + +sub __clear { + my ($self) = @_; + $self -> {__anim__disparition} -> stop (); + $self -> {__inertie} -> interrupt (); + $self -> {__fleche_started} = 0; + $self -> {__drag_started} = 0; + $self -> {__points} = (); + $self -> {__fleche_points} = (); + $self -> __reset_surrounding (); + $zinc -> coords ($self -> {__ph_fleche}, 0, [[0,0],[0,0]]); + $zinc -> coords ($self -> {__pb_fleche}, 0, [[0,0],[0,0]]); + $zinc -> coords ($self -> {__fleche}, 0, [[0,0],[0,0]]); + $zinc -> coords ($self -> {__curve}, 0, [[0,0],[0,0]]); + $zinc -> coords ($self -> {__curve_bck}, 0, [[0,0],[0,0]]); + $self -> {__gp_anime} -> mconfigure ( + -alpha => 100, + ); +} + +sub __pressed { + my ($self, $x, $y, $t) = @_; + $self -> __clear (); + push (@{$self -> {__points}}, [$x, $y]); + $self -> notify ('PRESSED', $x, $y, $t); + $self -> notify ('DESELECT_ALL'); +} + +sub __released { + my ($self, $x, $y, $t) = @_; + my $pt = $self -> {__points}[@{$self -> {__points}} - 2]; + $self -> notify ('RELEASED', $x - $pt -> [0], $y - $pt -> [1], $t); +} + +sub __fin_moved { + my ($self) = @_; + if (!$self -> {__fleche_started} && !$self -> {__drag_started}) + { + $self -> {__anim__disparition} -> start (); + } +} + +sub __moved { + my ($self, $x, $y, $t) = @_; + push (@{$self -> {__points}}, [$x, $y]); + my @pts = @{$self -> {__points}}; + $zinc -> coords ($self -> {__curve}, 0, \@pts); + $zinc -> coords ($self -> {__curve_bck}, 0, \@pts); + my $pt = $self -> {__points}[@{$self -> {__points}} - 2]; + $self -> notify ('MOVED', $x - $pt -> [0], $y - $pt -> [1], $t); + $self -> __update_all (); +} + +sub translate { + my ($self, $dx, $dy) = @_; + my $pt = $self -> {__points}[@{$self -> {__points}} - 1]; + push (@{$self -> {__points}}, [$pt -> [0] - $dx, $pt -> [1] - $dy]); + my @pts = @{$self -> {__points}}; + $zinc -> coords ($self -> {__curve}, 0, \@pts); + $zinc -> coords ($self -> {__curve_bck}, 0, \@pts); + $self -> __update_all (); +} + +sub __fleche_pressed { + my ($self, $x, $y, $t) = @_; + my @all = $zinc -> find ('overlapping', $x, $y, $x + 1, $y +1); + if ($all [1] == $self -> {__source}) + { + $self -> {__fleche_points} = (); + push (@{$self -> {__fleche_points}}, [$x, $y]); + $self -> {__fleche_started} = 1; + $self -> __hide_cursor (); + $self -> notify ('FLECHEPRESSED', $x, $y, $t); + $self -> __stop_animation (); + } + else + { + $self -> {__drag_started} = 1; + $self -> {__lx} = $x; + $self -> {__ly} = $y; + $self -> notify ('FLECHEPRESSED', $x, $y, $t); + } +} + +sub __stop_animation { + my ($self) = @_; + $self -> {__anim__disparition} -> stop (); + $self -> {__gp_anime} -> mconfigure ( + -alpha => 100, + ); +} + +sub __fleche_released { + my ($self, $x, $y, $t) = @_; + if ($self -> {__fleche_started}) + { + my $pt = $self -> {__fleche_points}[@{$self -> {__fleche_points}} - 1]; + $self -> notify ('FLECHERELEASED', $x - $pt -> [0], $y - $pt -> [1], $t); + } + else + { + $self -> notify ('FLECHERELEASED', $x - $self -> {__lx}, $y - $self -> {__ly}, $t); + $self -> {__lx} = $x; + $self -> {__ly} = $y; + } + +} + +sub __fin_fleche_moved { + my ($self) = @_; + if ($self -> {__fleche_started}) + { + $self -> __clear (); + if (defined $self -> {__last_notified}) + { + $self -> {__last_notified} -> notify ('RELEASEDOVER', $self); + $self -> {__last_notified} = undef; + } + elsif (defined $self -> {__secondary_last_notified}) + { + $self -> {__secondary_last_notified} -> notify ('RELEASEDOVER', $self); + $self -> {__secondary_last_notified} = undef; + } + $self -> __show_cursor (); + } + else + { + } +} + +sub __fleche_moved { + my ($self, $x, $y, $t) = @_; + if ($self -> {__fleche_started}) + { + push (@{$self -> {__fleche_points}}, [$x, $y]); + my @pts = @{$self -> {__fleche_points}}; + $zinc -> coords ($self -> {__fleche}, 0, \@pts); + my $pt = $self -> {__fleche_points}[@{$self -> {__fleche_points}} - 2]; + $self -> notify ('FLECHEMOVED', $x - $pt -> [0], $y - $pt -> [1], $t); + $self -> __update_fleche_moved ($x, $y); + } + else + { + $self -> notify ('FLECHEMOVED', $x - $self -> {__lx}, $y - $self -> {__ly}, $t); + $self -> __translate_selection ($x - $self -> {__lx}, $y - $self -> {__ly}); + $self -> {__lx} = $x; + $self -> {__ly} = $y; + } +} + +sub __translate_fleche { + my ($self, $dx, $dy) = @_; + if ($self -> {__fleche_started}) + { + my $pt = $self -> {__fleche_points}[@{$self -> {__fleche_points}} - 1]; + push (@{$self -> {__fleche_points}}, [$pt -> [0] - $dx, $pt -> [1] - $dy]); + my @pts = @{$self -> {__fleche_points}}; + $zinc -> coords ($self -> {__fleche}, 0, \@pts); + $self -> __update_fleche_moved ($pt -> [0] - $dx, $pt -> [1] - $dy); + } + else + { + $self -> __translate_selection (-$dx, -$dy); + } +} + +sub __translate_selection { + my ($self, $dx, $dy) = @_; + my @oldy = $self -> applySelection (0, 'mget', 'y'); + my @oldx = $self -> applySelection (0, 'mget', 'x'); + my @selection = $self -> getSelection (); + for (my $i = 0; $i < @selection; $i ++) + { + my $x = $selection [$i] -> mget ('x'); + my $pdx = $dx - ($x - $oldx [$i]); + my $y = $selection [$i] -> mget ('y'); + my $pdy = $dy - ($y - $oldy [$i]); + $selection [$i] -> translate ($pdx, $pdy); + } +} + +sub __update_fleche_moved { + my ($self, $x, $y) = @_; + my $pt; + if (@{$self -> {__fleche_points}} > 2) + { + $pt = $self -> {__fleche_points}[@{$self -> {__fleche_points}} - 3]; + } + else + { + $pt = $self -> {__fleche_points}[@{$self -> {__fleche_points}} - 2]; + } + my $xa = $x - $pt -> [0]; + my $ya = $y - $pt -> [1]; + if ($xa + $ya == 0) {return;} + + my $norme = sqrt ($xa * $xa + $ya * $ya); + $xa = $xa * 8 / $norme; + $ya = $ya * 8 / $norme; + + if ( $xa != 0) + { + my $yb = sqrt ((10 * 10 - $xa * $xa - $ya * $ya) / (1 + $ya * $ya / ($xa * $xa))); + my $xb = -$yb * $ya / $xa; + $zinc -> coords ($self -> {__ph_fleche}, 0, [[$x, $y], [$x + $xb - $xa, $y + $yb - $ya]]); + $zinc -> coords ($self -> {__pb_fleche}, 0, [[$x, $y], [$x - $xb - $xa, $y - $yb - $ya]]); + } + else + { + my $xb = sqrt (10 * 10 - $ya * $ya); + my $yb = 0; + $zinc -> coords ($self -> {__ph_fleche}, 0, [[$x, $y], [$x + $xb - $xa, $y + $yb - $ya]]); + $zinc -> coords ($self -> {__pb_fleche}, 0, [[$x, $y], [$x - $xb - $xa, $y - $yb - $ya]]); + } + my @all = $zinc -> find ('overlapping', $x, $y, $x + 1, $y +1); + + if (defined $self -> {__drop_targets}) + { + my @selected; + my @owns = @{$self -> {__owns_data}}; + for (my $i = 0; $i < @all; $i++) + { + my $find = 0; + for (my $j = 0; $j < @owns; $j ++) + { + if ($all [$i] == $owns [$j]) + { + $find = 1; + } + } + if (!$find) + { + push (@selected, $all [$i]); + } + } + if (defined @selected) + { + my @targets = @{$self -> {__drop_targets}}; + my $last_notified = $self -> {__last_notified}; + $self -> {__last_notified} = undef; + for (my $i = 0; $i < @targets; $i ++) + { + if (minstance ($targets [$i]) == $selected [0] || minstance ($targets [$i]) == $selected [1]) + { + if ($last_notified != $targets [$i]) + { + $targets [$i] -> notify ('DRAGENTER'); + } + $self -> {__last_notified} = $targets [$i]; + } + else + { + if ($last_notified == $targets [$i]) + { + $targets [$i] -> notify ('DRAGLEAVE'); + } + } + } + } + } +} + +sub getObjectBellow { + my ($self, $x, $y, @objects) = @_; + my @all = $zinc -> find ('overlapping', $x, $y, $x + 1, $y +1); + my @owns = @{$self -> {__owns_data}}; + my @below; + for (my $i = 0; $i < @all; $i++) + { + my $find = 0; + for (my $j = 0; $j < @owns; $j ++) + { + if ($all [$i] == $owns [$j]) + { + $find = 1; + } + } + if (!$find) + { + push (@below, $all [$i]); + } + } + my $nb = @below; + my @elements; + for (my $i = 0; $i < $nb; $i ++) + { + my @fils = $zinc -> find ('ancestors', $below [$i]); + push (@elements, '-'.$below [$i], @fils); + } + my $main; + for (my $j = 0; $j < @elements; $j ++) + { + if (index($elements [$j], '-') == 0) + { + $elements [$j] = substr ($elements [$j], 1, length ($elements [$j])); + $main = $elements [$j]; + } + for (my $i = 0; $i < @objects; $i++) + { + if (minstance ($objects [$i]) == $elements [$j]) + { + return ($objects [$i], $main); + } + } + } + return undef; +} + +sub __update_all { + my ($self) = @_; + my $selection_changed = 0; + $self -> {_selected} = 0; + $self -> {__selected_plan} = -1; + if (defined $self -> {__objects}) + { + my @object_plan = @{$self -> {__objects}}; + for (my $j = 0; $j < @object_plan; $j ++) + { + if (defined $self -> {__objects} [$j]) + { + my @items = @{$self -> {__objects} [$j]}; + for (my $i = 0; $i < @items; $i++) + { + $selection_changed = $selection_changed || $self -> __update_surrouding ($items [$i], ($self -> {__selected_plan} != -1), $self -> {__points}); + } + if ($self -> {_selected} && $self -> {__selected_plan} == -1) + { + $self -> {__selected_plan} = $j; + } + } + } + } + if ($selection_changed) + { + $self -> notify ('SELECTION_CHANGED', $self) + } +} + +sub getSelectedPlan { + my ($self) = @_; + return $self -> {__selected_plan}; +} + +sub __update_surrouding { + my ($self, $item, $force_non_sel, $coords) = @_; + my $center_x = $item -> mget ('barycentre_x'); + if ($item -> propertyExists ('x')) + { + $center_x += $item -> mget ('x'); + } + my $center_y = $item -> mget ('barycentre_y'); + if ($item -> propertyExists ('y')) + { + $center_y += $item -> mget ('y'); + } + my ($tmp,$ref); + $ref = -$self -> __angle($coords, @{$coords} - 1, $center_x, $center_y, 0); + $tmp = -$self -> __angle($coords, @{$coords} - 2, $center_x, $center_y, $ref); + $item -> {__surround_angle} += $tmp; + $tmp = $self -> __angle($coords, 0, $center_x, $center_y, $ref); + if ($force_non_sel) + { + if ($item -> isSelected ()) + { + $item -> setSelected (0); + } + } + else + { + if (abs ($item -> {__surround_angle} + $tmp) > 2) + { + $self -> {_selected} ++; + if (!$item -> isSelected ()) + { + $item -> setSelected (1); + return 1; + } + } + else + { + if ($item -> isSelected ()) + { + $item -> setSelected (0); + return 1; + } + } + } + return 0; +} + +sub __angle { + my ($self, $coords, $index, $center_x, $center_y, $ref) = @_; + my $angle; + my $tab = $coords -> [$index]; + $angle = atan2 ($tab -> [1] - $center_y, $tab -> [0] - $center_x) + $ref; + $angle -= 2*pi if ($angle > pi); + $angle += 2*pi if ($angle < - pi); + return $angle; +} + +sub __reset_surrounding { + my ($self) = @_; + if (defined $self -> {__objects}) + { + my @object_plan = @{$self -> {__objects}}; + for (my $j = 0; $j < @object_plan; $j ++) + { + if (defined $self -> {__objects} [$j]) + { + my @items = @{$self -> {__objects} [$j]}; + for (my $i = 0; $i < @items; $i++) + { + $items [$i] -> {__surround_angle} = 0; + } + } + } + } +} + +sub applySelection { + my ($self, $plan, $fct, @args) = @_; + my @retour; + if (defined $self -> {__objects} [$plan]) + { + my @items = @{$self -> {__objects} [$plan]}; + for (my $i = 0; $i < @items; $i++) + { + if ($items [$i] -> isSelected ()) + { + push (@retour, $items [$i] -> $fct (@args)); + } + } + } + return @retour; +} + +sub applyAll { + my ($self, $plan, $fct, @args) = @_; + my @retour; + if (defined $self -> {__objects} [$plan]) + { + my @items = @{$self -> {__objects} [$plan]}; + for (my $i = 0; $i < @items; $i++) + { + push (@retour, $items [$i] -> $fct (@args)); + } + } + return @retour; +} + +sub getSelection { + my ($self, $plan) = @_; + if (!defined $plan) {$plan = $self -> getSelectedPlan ();} + my @selection; + if (defined $self -> {__objects} [$plan]) + { + my @items = @{$self -> {__objects} [$plan]}; + for (my $i = 0; $i < @items; $i++) + { + if ($items [$i] -> isSelected ()) + { + push (@selection, $items [$i]); + } + } + } + return @selection; +} + +1; |