diff options
Diffstat (limited to 'src/MTools/Widget')
-rw-r--r-- | src/MTools/Widget/MBouton.pm | 180 | ||||
-rw-r--r-- | src/MTools/Widget/MRadioBouton.pm | 108 | ||||
-rw-r--r-- | src/MTools/Widget/MRadioGroup.pm | 86 | ||||
-rw-r--r-- | src/MTools/Widget/MSplitPane.pm | 224 | ||||
-rw-r--r-- | src/MTools/Widget/MToggleBouton.pm | 81 |
5 files changed, 679 insertions, 0 deletions
diff --git a/src/MTools/Widget/MBouton.pm b/src/MTools/Widget/MBouton.pm new file mode 100644 index 0000000..73c0fc0 --- /dev/null +++ b/src/MTools/Widget/MBouton.pm @@ -0,0 +1,180 @@ +package MTools::Widget::MBouton; +# 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 +# +################################################################## + +use strict; +use MTools; +use MTools::MGroup; +use MTools::MSwitch; +use MTools::MState; +use MTools::MTimer; + +use vars qw /@ISA/; + +BEGIN +{ + @ISA = qw /MTools::MGroup/; +} + +sub new { + my ($class, %options) = @_; + my $self = new MTools::MGroup ($options {parent}); + + bless $self, $class; + + my $on = minstance ($options {g_on}, $self); + my $off = minstance ($options {g_off}, $self); + my $over = defined $options {g_over} ? minstance ($options {g_over}, $self) : $on; + my $eventOn = defined $options {e_press} ? $options {e_press} : 'PRESS'; + my $eventOff = defined $options {e_release} ? $options {e_release} : 'RELEASED'; + my $cb = $options {call} if (defined $options {call}); + + + $self -> recordEvent ('MAINTAIN_DOWN'); + $self -> recordEvent ('PRESS'); + $self -> recordEvent ('RELEASE'); + $self -> mconfigure (-atomic => 1); + + my @gon; + push (@gon, $on); + my @goff; + push (@goff, $off); + my @gover; + push (@gover, $over); + + if (defined $options {g_text}) + { + $self -> recordProperty ('text', $options {text}); + my $txt = minstance ($options {g_text}, $self); + push (@gon, $txt); + push (@goff, $txt); + push (@gover, $txt); + plink ([$self, 'text'], [$txt, '-text']); + } + + $self -> {gp_over} = new MTools::MGroup ($self); + push (@gon, $self -> {gp_over}); + push (@goff, $self -> {gp_over}); + push (@gover, $self -> {gp_over}); + + my $timer = new MTools::MTimer (5, 1); + my @gon_tmp = @gon; + push (@gon_tmp, $timer); + + my $sw = new MTools::MSwitch ( + $self, + 'up' => \@gon, + 'up_tmp' => \@gon_tmp, + 'down' => \@goff, + 'over' => \@gover, + 'maintain_down' => \@goff, + ); + + my $st = new MTools::MState ( + current_state => 'up', + events => { + press => [$self, '<Button-1>'], + force_press => [$self, 'PRESS'], + maintain => [$self, 'MAINTAIN_DOWN'], + release => [$self, '<ButtonRelease-1>'], + force_release => [$self, 'RELEASE'], + enter => [$self, '<Enter>'], + leave => [$self, '<Leave>'], + timeout => [$timer, 'TIME_OUT'] + }, + transitions => { + 'up' => { + 'press' => { + to => 'down', + notify => $eventOn, + }, + 'force_press' => { + to => 'down', + notify => $eventOn, + }, + 'enter' => { + to => 'over', + }, + }, + 'up_tmp' => { + 'press' => { + to => 'down', + notify => $eventOn, + }, + 'force_press' => { + to => 'down', + notify => $eventOn, + }, + 'timeout' => { + to => 'up', + }, + }, + 'over' => { + 'press' => { + to => 'down', + notify => $eventOn, + }, + 'force_press' => { + to => 'down', + notify => $eventOn, + }, + 'leave' => { + to => 'up_tmp', + } + }, + 'down' => { + 'release' => { + to => 'up', + notify => $eventOff, + }, + 'force_release' => { + to => 'up', + notify => $eventOff, + }, + 'maintain' => { + to => 'maintain_down', + }, + }, + 'maintain_down' => { + 'press' => { + to => 'down', + }, + 'force_release' => { + to => 'up', + notify => $eventOff, + }, + }, + }, + switchs => [$sw], + ); + + if (defined $cb) + { + $st -> binding ($eventOn, sub { + executer ($cb); + }); + } + + $self -> propagate ($st, $eventOn); + $self -> propagate ($st, $eventOff); + + return $self; +} + + +1; + diff --git a/src/MTools/Widget/MRadioBouton.pm b/src/MTools/Widget/MRadioBouton.pm new file mode 100644 index 0000000..630f0f6 --- /dev/null +++ b/src/MTools/Widget/MRadioBouton.pm @@ -0,0 +1,108 @@ +package MTools::Widget::MRadioBouton; +# 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 +# +################################################################## + +use strict; +use MTools; +use MTools::MGroup; +use MTools::MSwitch; +use MTools::MState; + +use vars qw /@ISA/; + +BEGIN +{ + @ISA = qw /MTools::MGroup/; +} + +sub new { + my ($class, %options) = @_; + my $self = new MTools::MGroup ($options {parent}); + + bless $self, $class; + + my $on = $options {g_on}; + my $off = $options {g_off}; + + $self -> recordEvent ('RELEASE'); + $self -> recordEvent ('PRESS'); + $self -> recordProperty ('selected', 0); + + my @gon; + push (@gon, $on); + my @goff; + push (@goff, $off); + + if (defined $options {g_text}) + { + $self -> recordProperty ('text', $options {text}); + my $txt = minstance ($options {g_text}, $self); + push (@gon, $txt); + push (@goff, $txt); + plink ([$self, 'text'], [$txt, '-text']); + } + $self -> mconfigure (-atomic => 1); + my $sw = new MTools::MSwitch ( + $self, + on => \@gon, + off => \@goff, + ); + my $st = new MTools::MState ( + current_state => 'on', + events => { + press => [$self, '<Button-1>'], + press2 => [$self, 'PRESS'], + release => [$self, 'RELEASE'], + }, + transitions => { + on => { + press => { + to => 'off', + notify => 'PRESSED', + }, + press2 => { + to => 'off', + notify => 'PRESSED', + }, + }, + off => { + release => { + to => 'on', + notify => 'RELEASED', + }, + }, + }, + switchs => [$sw], + ); + + $st -> binding ('PRESSED', sub { + $self -> mconfigure ('selected', 1); + }); + + $st -> binding ('RELEASED', sub { + $self -> mconfigure ('selected', 0); + }); + + $self -> propagate ($st, 'PRESSED'); + + + return $self; +} + + +1; + diff --git a/src/MTools/Widget/MRadioGroup.pm b/src/MTools/Widget/MRadioGroup.pm new file mode 100644 index 0000000..13a38d8 --- /dev/null +++ b/src/MTools/Widget/MRadioGroup.pm @@ -0,0 +1,86 @@ +package MTools::Widget::MRadioGroup; +# 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 +# +################################################################## + +use strict; + +use MTools; +use MTools::MObjet; +use vars qw / @ISA /; + +BEGIN +{ + @ISA = qw /MTools::MObjet/; +} + +sub new { + my ($class, @buttons) = @_; + my $self = new MTools::MObjet (); + bless $self, $class; + + $self -> recordEvent ('BUTTON_SELECTED'); + $self -> {buttons} = (); + + for (my $i = 0; $i < @buttons; $i ++) + { + $self -> addButton ($buttons [$i]); + } + + return $self; +} + +sub addButton { + my ($self, $button) = @_; + push (@{$self -> {buttons}}, $button); + $button -> binding ('PRESSED', sub { + my @buttons = @{$self -> {buttons}}; + for (my $i = 0; $i < @buttons; $i ++) + { + if ($buttons [$i] != $button) + { + $buttons [$i] -> notify ('RELEASE'); + } + } + $self -> notify ('BUTTON_SELECTED', $button); + }); +} + +sub getSelected { + my ($self) = @_; + my @buttons = @{$self -> {buttons}}; + for (my $i = 0; $i < @buttons; $i ++) + { + if ($buttons [$i] -> mget ('selected')) + { + return $buttons [$i]; + } + } +} + +sub setSelected { + my ($self, $button) = @_; + my @buttons = @{$self -> {buttons}}; + for (my $i = 0; $i < @buttons; $i ++) + { + if ($buttons [$i] == $button) + { + $buttons [$i] -> notify ('PRESS'); + } + } +} + +1; diff --git a/src/MTools/Widget/MSplitPane.pm b/src/MTools/Widget/MSplitPane.pm new file mode 100644 index 0000000..dd593bf --- /dev/null +++ b/src/MTools/Widget/MSplitPane.pm @@ -0,0 +1,224 @@ +package MTools::Widget::MSplitPane; +# 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 +# +################################################################## + +use strict; + +use MTools; +use MTools::SVG::SVGLoader; + +use vars qw /@ISA/; + +use MTools::MGroup; +use MTools::Widget::MBouton; +use MTools::Comp::MMover; +use MTools::Anim::MTranslator; +use MTools::GUI::MClip; + +BEGIN +{ + @ISA = qw /MTools::MGroup/; +} + +sub new { + my ($class, $parent, %options) = @_; + my $self = new MTools::MGroup ($parent); + bless $self, $class; + + $self -> recordProperty ('percentage', 0.00001); + my $size = $options {size}; + $self -> recordProperty ('size', $size); + + $self -> {__firstgp} = my $gp_first = $options {first_group}; + $self -> {__secondgp} = my $gp_second = $options {second_group}; + my $orientation = $options {orientation}? $options {orientation}:'vertical'; + $self -> {__vertical} = my $vertical = $orientation eq 'vertical'; + $self -> {__cursor_size} = $options {cursor_size}? $options {cursor_size}:'10'; + + if ($vertical) + { + new MTools::GUI::MClip ($gp_first, ['rectangle', -2, -1000, $size, 1000]); + new MTools::GUI::MClip ($gp_second, ['rectangle', -2, -1000, $size, 1000]); + } + else + { + new MTools::GUI::MClip ($gp_first, ['rectangle', -1000, -2, 1000, $size]); + new MTools::GUI::MClip ($gp_second, ['rectangle',-1000, -2, 1000, $size]); + } + + $self -> {__curseur} = new MTools::MSwitch ( + $self, + on => [$options {cursor_on}], + off => [$options {cursor_off}], + ); + + $self -> {__mover} = my $mover = new MTools::Comp::MMover($self -> {__curseur}, $self, 1, + x_min => 0, + y_min => 0, + x_max => $vertical ? $options {size} : 0, + y_max => !$vertical ? $options {size} : 0, + ); + + $self -> propagate ($mover, 'MOVED'); + + if ($options {with_buttons}) + { + my $bouton_open = new MTools::Widget::MBouton ( + parent => $self, + g_on => $options {button_open_on}, + g_off => $options {button_open_off}, + e_press => 'PRESS', + e_release => 'OPEN', + ); + my $bouton_close = new MTools::Widget::MBouton ( + parent => $self, + g_on => $options {button_close_on}, + g_off => $options {button_close_off}, + e_press => 'PRESS', + e_release => 'CLOSE', + ); + $self -> {__boutons} = new MTools::MSwitch ( + $self, + open => $bouton_open, + close => $bouton_close, + ); + $self -> {__boutons} -> mconfigure ('state' => 'open'); + $self -> {__anim_open} = new MTools::Anim::MTranslator ( + from_x => 0, + from_y => 0, + to_x => $vertical * $options {size}, + to_y => (!$vertical) * $options {size}, + targets => $mover, + duration => 0.5, + ); + $bouton_open -> binding ('OPEN', [$self, \&opening]); + $bouton_close -> binding ('CLOSE', [$self, \&closing]); + } + + $gp_first -> scale ( $vertical? 0.00001:1, !$vertical? 0.00001:1); + $self -> {__old_val} = 0; + $gp_second -> translate ($vertical * $self -> {__cursor_size}, (!$vertical) * $self -> {__cursor_size}); + + $mover -> binding ('MOVED', [$self, \&moved]); + + new MTools::MState ( + current_state => 'on', + events => { + press => [$mover, 'PRESSED'], + release => [$mover, 'RELEASED'], + }, + transitions => { + on => { + press => { + to => 'off', + }, + }, + off => { + release => { + to => 'on', + }, + }, + }, + switchs => [$self -> {__curseur}], + ); + + return $self; +} + +sub moved { + my ($self, $x, $y) = @_; + + my $gp_first = $self -> {__firstgp}; + my $gp_second = $self -> {__secondgp}; + + my $vertical = $self -> {__vertical}; + my $val = $vertical ? $x : $y; + + my $size = $self -> mget ('size'); + my $oldperc = $self -> mget ('percentage'); + my $perc = $val / $size; + my $operc = 1 - $perc; + my $oldoperc = 1 - $oldperc; + if ($perc < 0.00001) + { + $perc = 0.00001; + } + if ($operc < 0.00001) + { + $operc = 0.00001; + } + if ($oldoperc < 0.00001) + { + $oldoperc = 0.00001; + } + + $gp_first -> scale ($vertical ? $perc / $oldperc : 1, !$vertical ? $perc / $oldperc : 1); + my $trans = $val - $self -> {__old_val}; + $gp_second -> translate ($vertical * $trans, (!$vertical) * $trans); + my $pos = $val + $self -> {__cursor_size}; + $gp_second -> scale ($vertical ? $operc / $oldoperc : 1, !$vertical ? $operc / $oldoperc : 1, $vertical * $pos, (!$vertical) * $pos); + + $self -> mconfigure ('percentage', $perc); + $self -> {__old_val} = $val; + if ($val > $size / 2) + { + $self -> {__boutons} -> mconfigure ('state' => 'close'); + } + else + { + $self -> {__boutons} -> mconfigure ('state' => 'open'); + } +} + +sub opening { + my ($self) = @_; + if ($self -> {__vertical}) + { + $self -> {__anim_open} -> mconfigure ( + from_x => $self -> {__old_val}, + to_x => $self -> mget ('size'), + ); + } + else + { + $self -> {__anim_open} -> mconfigure ( + from_y => $self -> {__old_val}, + to_y => $self -> mget ('size'), + ); + } + $self -> {__anim_open} -> start (); +} + +sub closing { + my ($self) = @_; + if ($self -> {__vertical}) + { + $self -> {__anim_open} -> mconfigure ( + from_x => $self -> {__old_val}, + to_x => 0, + ); + } + else + { + $self -> {__anim_open} -> mconfigure ( + from_y => $self -> {__old_val}, + to_y => 0, + ); + } + $self -> {__anim_open} -> start (); +} +1; diff --git a/src/MTools/Widget/MToggleBouton.pm b/src/MTools/Widget/MToggleBouton.pm new file mode 100644 index 0000000..56c976c --- /dev/null +++ b/src/MTools/Widget/MToggleBouton.pm @@ -0,0 +1,81 @@ +package MTools::Widget::MToggleBouton; +# 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 +# +################################################################## + +use strict; +use MTools; +use MTools::MGroup; +use MTools::MSwitch; +use MTools::MState; + +use vars qw /@ISA/; + +BEGIN +{ + @ISA = qw /MTools::MGroup/; +} + +sub new { + my ($class, %options) = @_; + my $self = new MTools::MGroup ($options {parent}); + + bless $self, $class; + + my $on = $options {g_on}; + my $off = $options {g_off}; + my $eventOn = $options {e_press}; + my $eventOff = $options {e_release}; + + my $sw = new MTools::MSwitch ( + $self, + on => [$on], + off => [$off], + ); + my $st = new MTools::MState ( + current_state => 'on', + events => { + press => [$sw, '<Button-1>'], + }, + transitions => { + on => { + press => { + to => 'off', + notify => $eventOn, + }, + }, + off => { + press => { + to => 'on', + notify => $eventOff, + }, + }, + }, + switchs => [$sw], + ); + + $self -> propagate ($st, $eventOn); + $self -> propagate ($st, $eventOff); + + return $self; +} + + +1; + + + + |