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::GUI::MGroup; use MTools::MSwitch; use MTools::MState; use MTools::MTimer; use vars qw /@ISA/; BEGIN { @ISA = qw /MTools::GUI::MGroup/; } sub new { my ($class, %options) = @_; my $self = new MTools::GUI::MGroup ($options {parent}); bless $self, $class; my $on1 = minstance ($options {g_on1}, $self); my $off1 = minstance ($options {g_off1}, $self); my $over1 = defined $options {g_over1} ? minstance ($options {g_over1}, $self) : $on1; my $on2 = minstance ($options {g_on2}, $self); my $off2 = minstance ($options {g_off2}, $self); my $over2 = defined $options {g_over2} ? minstance ($options {g_over2}, $self) : $on2; my $event1On = defined $options {e_press1} ? $options {e_press1} : 'PRESS1'; my $event1Off = defined $options {e_release1} ? $options {e_release1} : 'RELEASE1'; my $event2On = defined $options {e_press2} ? $options {e_press2} : 'PRESS2'; my $event2Off = defined $options {e_release2} ? $options {e_release2} : 'RELEASE2'; # my $cb = $options {call} if (defined $options {call}); $self -> recordEvent ('TOGGLE'); $self -> recordEvent ('FORCE_PRESS'); $self -> recordEvent ('FORCE_RELEASE'); my @gon1; push (@gon1, $on1); my @goff1; push (@goff1, $off1); my @gover1; push (@gover1, $over1); my @gon2; push (@gon2, $on2); my @goff2; push (@goff2, $off2); my @gover2; push (@gover2, $over2); if (defined $options {g_text1}) { $self -> recordProperty ('text1', $options {text1}); my $txt1 = minstance ($options {g_text1}, $self); push (@gon1, $txt1); push (@goff1, $txt1); push (@gover1, $txt1); plink ([$self, 'text1'], [$txt1, '-text']); } if (defined $options {g_text2}) { $self -> recordProperty ('text2', $options {text2}); my $txt2 = minstance ($options {g_text2}, $self); push (@gon2, $txt2); push (@goff2, $txt2); push (@gover2, $txt2); plink ([$self, 'text2'], [$txt2, '-text']); } $self -> {gp_over} = new MTools::GUI::MGroup ($self); push (@gon1, $self -> {gp_over}); push (@goff1, $self -> {gp_over}); push (@gover1, $self -> {gp_over}); push (@gon2, $self -> {gp_over}); push (@goff2, $self -> {gp_over}); push (@gover2, $self -> {gp_over}); my $timer = new MTools::MTimer (5, 1); my @gon1_tmp = @gon1; push (@gon1_tmp, $timer); my @gon2_tmp = @gon2; push (@gon2_tmp, $timer); my $sw = $self->{switch} = new MTools::MSwitch ( $self, 'idle1' => \@gon1, 'idle1_tmp' => \@gon1_tmp, 'hover1' => \@gover1, 'pressed1' => \@goff1, 'idle2' => \@gon2, 'idle2_tmp' => \@gon2_tmp, 'hover2' => \@gover2, 'pressed2' => \@goff2, ); my $st = $self->{states} = new MTools::MState ( current_state => 'idle1', events => { press => [$self, ''], release => [$self, ''], enter => [$self, ''], leave => [$self, ''], toggle => [$self, 'TOGGLE'], frelease => [$self, 'FORCE_RELEASE'], fpress => [$self, 'FORCE_PRESS'], timeout => [$timer, 'TIME_OUT'] }, transitions => { 'idle1' => { 'enter' => { to => 'hover1', }, 'press' => { to => 'pressed1', notify => $event1On, }, 'toggle' => { to => 'idle2', }, 'fpress' => { to => 'idle2', }, }, 'idle1_tmp' => { 'press' => { to => 'pressed1', notify => $event1On, }, 'toggle' => { to => 'idle2', }, 'fpress' => { to => 'idle2', }, 'timeout' => { to => 'idle1', }, }, 'hover1' => { 'press' => { to => 'pressed1', notify => $event1On, }, 'toggle' => { to => 'idle2', }, 'fpress' => { to => 'idle2', }, 'leave' => { to => 'idle1_tmp', }, }, 'pressed1' => { 'release' => { to => 'hover2', notify => $event1Off, }, 'toggle' => { to => 'idle2', }, 'fpress' => { to => 'idle2', }, 'leave' => { to => 'idle1', }, }, 'idle2' => { 'enter' => { to => 'hover2', }, 'toggle' => { to => 'idle1', }, 'frelease' => { to => 'idle1', }, 'press' => { to => 'pressed2', notify => $event2On, }, }, 'idle2_tmp' => { 'press' => { to => 'pressed2', notify => $event2On, }, 'toggle' => { to => 'idle1', }, 'frelease' => { to => 'idle1', }, 'timeout' => { to => 'idle2', }, }, 'hover2' => { 'press' => { to => 'pressed2', notify => $event2On, }, 'toggle' => { to => 'idle1', }, 'frelease' => { to => 'idle1', }, 'leave' => { to => 'idle2_tmp', } }, 'pressed2' => { 'release' => { to => 'hover1', notify => $event2Off, }, 'toggle' => { to => 'idle1', }, 'frelease' => { to => 'idle1', }, 'leave' => { to => 'idle2', } }, }, switchs => [$sw], ); # if (defined $cb) # { # $st -> binding ($eventOn, sub { # executer ($cb); # }); # } $self -> propagate ($st, $event1On); $self -> propagate ($st, $event1Off); $self -> propagate ($st, $event2On); $self -> propagate ($st, $event2Off); delete $options {g_on1} if defined $options {g_on1}; delete $options {g_off1} if defined $options {g_off1}; delete $options {g_over1} if defined $options {g_over1}; delete $options {g_on2} if defined $options {g_on2}; delete $options {g_off2} if defined $options {g_off2}; delete $options {g_over2} if defined $options {g_over2}; delete $options {e_press1} if defined $options {e_press1}; delete $options {e_release1} if defined $options {e_release1}; delete $options {e_press2} if defined $options {e_press2}; delete $options {e_release2} if defined $options {e_release2}; # delete $options {call} if defined $options {call}; delete $options {text1} if defined $options {text1}; delete $options {g_text1} if defined $options {g_text1}; delete $options {text2} if defined $options {text2}; delete $options {g_text2} if defined $options {g_text2}; delete $options {parent} if defined $options {parent}; $self -> mconfigure (%options); return $self; } sub isDown { my ($self) = @_; return $self -> {states} -> mget ('state') eq 'idle2'; } sub changeCurrentState { my ($self) = @_; my $currentState = $self->{switch}->mget('state'); if ($currentState =~ /(.*)1(.*)/ ) { $self->{states}->mconfigure('state' => 'idle2'); $self->{switch}->mconfigure('state' => 'idle2'); } elsif ($currentState =~ /(.*)2(.*)/ ) { $self->{states}->mconfigure('state' => 'idle1'); $self->{switch}->mconfigure('state' => 'idle1'); } } 1;