line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Device::USB::TranceVibrator; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
37
|
|
4
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
35
|
|
5
|
1
|
|
|
1
|
|
5
|
use Carp; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
161
|
|
6
|
1
|
|
|
1
|
|
1836
|
use Device::USB; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
my @vibe_command = ( |
11
|
|
|
|
|
|
|
0x41, # bmRequestType |
12
|
|
|
|
|
|
|
0x00, # bRequest |
13
|
|
|
|
|
|
|
0xFFFF, # value |
14
|
|
|
|
|
|
|
0x30F, # index |
15
|
|
|
|
|
|
|
undef, # bytes |
16
|
|
|
|
|
|
|
0, # size |
17
|
|
|
|
|
|
|
1000, # timeout |
18
|
|
|
|
|
|
|
); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
my $Debug = undef; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub _dprint(@) { ## no critic |
23
|
|
|
|
|
|
|
return unless $Debug; |
24
|
|
|
|
|
|
|
my @m = @_; |
25
|
|
|
|
|
|
|
chomp @m; |
26
|
|
|
|
|
|
|
print STDERR 'DEBUG: ', @m,"\n"; |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub new { |
30
|
|
|
|
|
|
|
my($class, %args) = @_; |
31
|
|
|
|
|
|
|
my $self = {}; |
32
|
|
|
|
|
|
|
bless $self, $class; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
$Debug = delete $args{debug}; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
my $vendor = $args{vendor} || 0x0B49; |
37
|
|
|
|
|
|
|
my $product = $args{product} || 0x064F; |
38
|
|
|
|
|
|
|
my $interface = 0; # interface number |
39
|
|
|
|
|
|
|
_dprint "vendor:$vendor product:$product"; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
my $usb = Device::USB->new() or croak "D::USB new: $!"; |
42
|
|
|
|
|
|
|
my $dev = $usb->find_device($vendor,$product) or croak "D::USB find: $!"; |
43
|
|
|
|
|
|
|
$dev->open() or croak "D::USB open $!"; |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
$dev->set_configuration(1) >= 0 or croak "D::USB conf: $!"; |
46
|
|
|
|
|
|
|
$dev->claim_interface($interface) >= 0 or croak "D::USB claim: $!"; |
47
|
|
|
|
|
|
|
$dev->set_altinterface($interface) >= 0 or croak "D::USB alt: $!"; |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
$self->{device} = $dev; |
50
|
|
|
|
|
|
|
return $self; |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub vibrate { |
54
|
|
|
|
|
|
|
my($self, %param) = @_; |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
my $speed = delete $param{speed} || 128; |
57
|
|
|
|
|
|
|
if ($speed !~ /^\d+$/ || $speed > 255) { |
58
|
|
|
|
|
|
|
carp "speed parameter must be between 0 and 255, so force to be 129"; |
59
|
|
|
|
|
|
|
$speed = 129; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
_dprint "speed:$speed"; |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
my $speed_value = $speed + $speed * 256; |
64
|
|
|
|
|
|
|
$vibe_command[2] = $speed_value; |
65
|
|
|
|
|
|
|
$vibe_command[3] = 0x0300 + ($speed_value & 0x0F); |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
return $self->{device}->control_msg(@vibe_command); |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
sub stop { |
71
|
|
|
|
|
|
|
my($self) = @_; |
72
|
|
|
|
|
|
|
return $self->vibrate(speed => 1); |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
1; |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
__END__ |