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::GUI::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, '', [\&__pressed, $self, Ev('x'), Ev('y'), Ev('t')]); binding ($src, '', [\&__moved, $self, Ev('x'), Ev('y'), Ev('t')]); binding ($src, '', [\&__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' => [$self, '__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::GUI::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}, '', [\&__fleche_pressed, $self, Ev('x'), Ev('y'), Ev('t')]); binding ($self -> {__curve}, '', [\&__fleche_moved, $self, Ev('x'), Ev('y'), Ev('t')]); binding ($self -> {__curve}, '', [\&__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;