diff options
Diffstat (limited to 'src/MTools/Adapters')
| -rw-r--r-- | src/MTools/Adapters/WacomAdapter.pm | 159 |
1 files changed, 159 insertions, 0 deletions
diff --git a/src/MTools/Adapters/WacomAdapter.pm b/src/MTools/Adapters/WacomAdapter.pm new file mode 100644 index 0000000..5d6c77a --- /dev/null +++ b/src/MTools/Adapters/WacomAdapter.pm @@ -0,0 +1,159 @@ +package MTools::Adapters::WacomAdapter; +# 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 MTools::MIvy; +use vars qw /@ISA/; + +BEGIN +{ + @ISA = qw /MTools::MObjet/; +} + +use Tk; + +sub new { + my ($class, $adresse, $ivy_name, $wacom_adresse) = @_; + my $self = new MTools::MObjet (); + if (!defined $wacom_adresse) + { + $wacom_adresse = 'default'; + } + bless $self, $class; + $self -> {__pointer_status} = 0; + $self -> {__ivy} = new MTools::MIvy ($adresse, $ivy_name); + $self -> {__ivy} -> binding ('pad_event wacom_id='.$wacom_adresse.' button=(.*) status=(.*) time=(.*)', [\&wacom_event, $self, 'buttons']); + $self -> {__ivy} -> binding ('slider_event wacom_id='.$wacom_adresse.' value=(.*) side=(.*) time=(.*)', [\&wacom_event, $self, 'sliders']); + $self -> {__ivy} -> binding ('pointer_event wacom_id='.$wacom_adresse.' x=(.*) y=(.*) presure=(.*) tilt_x=(.*) tilt_y=(.*) wheel=(.*) predicted_x=(.*) predicted_y=(.*) type=(.*) serial_number=(.*) time=(.*)', [\&wacom_event, $self, 'pointers']); + return $self; + +} + +sub binding { + my ($self, $reg, $cb) = @_; + if ($reg eq '<WSlider>') + { + push (@{$self -> {sliders} -> {all}}, $cb); + } + elsif ($reg =~ /\<WSlider(.*)-(.*)\>/) + { + push (@{$self -> {sliders} -> {$1} -> {$2}}, $cb); + } + elsif ($reg =~ /\<WSlider(.*)\>/) + { + push (@{$self -> {sliders} -> {$1} -> {all}}, $cb); + } + elsif ($reg eq '<WButton>') + { + push (@{$self -> {buttons} -> {all}}, $cb); + } + elsif ($reg =~ /\<WButton(.*)-(.*)\>/) + { + push (@{$self -> {buttons} -> {$1} -> {$2}}, $cb); + } + elsif ($reg =~ /\<WButton(.*)\>/) + { + push (@{$self -> {buttons} -> {$1} -> {all}}, $cb); + } + elsif ($reg eq '<WPointer>') + { + push (@{$self -> {pointers} -> {all}}, $cb); + } + elsif ($reg =~ /\<WPointer(.*)-(.*)\>/) + { + push (@{$self -> {pointers} -> {$1} -> {$2}}, $cb); + } + elsif ($reg =~ /\<WPointer(.*)\>/) + { + push (@{$self -> {pointers} -> {$1} -> {all}}, $cb); + } + else + { + die "Can't recognize a wacom event in $reg\n"; + } +} + +sub wacom_event { + my ($agent, $self, $type, $value, $status, $time, @others) = @_; + my @callbacks = (); + my @args = (); + if ($type eq 'sliders') + { + my $nb = 0; + if ($value != 0) + { + while ($value != 1) + { + $value = $value / 2; + $nb ++; + } + $nb++; + } + $value = $nb; + } + if ($type eq 'pointers') + { + $status = $others [5]; + if ($status =~ /(.*)_(.*)_(.*)_(.*)/) + { + $status = $3; + } + elsif ($status =~ /(.*)_(.*)_(.*)/) + { + $status = $2; + } + if ($time == 0) + { + $value = 'Release'; + $self -> {__pointer_status} = 0; + } + else + { + if ($self -> {__pointer_status}) + { + $value = 'Motion'; + } + else + { + $value = 'Press'; + $self -> {__pointer_status} = 1; + } + } + } + if (defined $self -> {$type} -> {all}) + { + push (@callbacks, @{$self -> {$type} -> {all}}); + } + if (defined $self -> {$type} -> {$status} -> {all}) + { + push (@callbacks, @{$self -> {$type} -> {$status} -> {all}}); + } + if (defined $self -> {$type} -> {$status} -> {$value}) + { + push (@callbacks, @{$self -> {$type} -> {$status} -> {$value}}); + } + for (my $i = 0; $i < @callbacks; $i ++) + { + executer ($callbacks[$i], $value, $status, $type); + } +} + + +1; |