diff options
Diffstat (limited to 'perl/tc1kpen_calib.pl')
| -rwxr-xr-x | perl/tc1kpen_calib.pl | 841 |
1 files changed, 841 insertions, 0 deletions
diff --git a/perl/tc1kpen_calib.pl b/perl/tc1kpen_calib.pl new file mode 100755 index 0000000..8eaa4f3 --- /dev/null +++ b/perl/tc1kpen_calib.pl @@ -0,0 +1,841 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Getopt::Std; + +use Device::SerialPort; + +use Time::HiRes qw(gettimeofday); + + +# +# Constants +# + +# Serial device defaults +use constant DEFAULT_DEVICE => '/dev/ttyS0'; +use constant DEFAULT_BAUDRATE => 19200; +use constant DEFAULT_PARITY => 'none'; +use constant DEFAULT_DATABITS => 8; +use constant DEFAULT_STOPBITS => 1; +use constant DEFAULT_HANDSHAKE => 'none'; +use constant DEFAULT_DATATYPE => 'raw'; + +# Serial device messages +use constant DEFAULT_ERROR_MSG_ON => 1; +use constant DEFAULT_USER_MSG_ON => 1; + +# Serial device reading +use constant DEFAULT_READ_CONST_TIME => 100; +use constant DEFAULT_READ_CHAR_TIME => 5; + +# TC1000 tablet protocol +use constant PACKET_SIZE => 5; + +use constant BTN_1_BIT_INDEX => 0; +use constant BTN_2_BIT_INDEX => 1; +use constant BTN_3_BIT_INDEX => 2; +use constant PROX_BIT_INDEX => 5; +use constant BTN_STATUS_BIT_INDEX => 6; + +use constant BTN_1_BIT => 0x01 << BTN_1_BIT_INDEX; +use constant BTN_2_BIT => 0x01 << BTN_2_BIT_INDEX; +use constant BTN_3_BIT => 0x01 << BTN_3_BIT_INDEX; +use constant PROX_BIT => 0x01 << PROX_BIT_INDEX; +use constant BTN_STATUS_BIT => 0x01 << BTN_STATUS_BIT_INDEX; +use constant BTNS_BITMASK => (BTN_1_BIT | BTN_2_BIT | BTN_3_BIT); + +use constant DEFAULT_BTN3EMU_TIMEOUT => 200; + +# Protocol debug levels +use constant DEBUG_OFF => 0; +use constant DEBUG_PROXIMITY => 1; +use constant DEBUG_BUTTONS_STATUS => 2; +use constant DEBUG_PACKET_DUMP => 3; +use constant DEBUG_ALL => 4; + + + +# +# Global variables +# + +# Progress marks (the last is used for cleaning) +my @progress = map("\b$_", ('|', '/', '-', '\\', ' ')); + +# Flush written chars immediately +$| = 1; + + + +# +# Functions +# + +sub printProgressMark() +{ + our $id = 0 unless (defined $id); + + print $progress[$id]; + + $id++; + + $id = 0 if ($id == $#progress); +} + +sub clearProgressMark() +{ + print $progress[-1]; +} + +sub openSerialPort(@) +{ + my $dev = shift || DEFAULT_DEVICE; + my $baud_rate = shift || DEFAULT_BAUDRATE; + my $parity = shift || DEFAULT_PARITY; + my $data_bits = shift || DEFAULT_DATABITS; + my $stop_bits = shift || DEFAULT_STOPBITS; + my $handshake = shift || DEFAULT_HANDSHAKE; + my $data_type = shift || DEFAULT_DATATYPE; + + my $err_msg_on = shift || DEFAULT_ERROR_MSG_ON; + my $user_msg_on = shift || DEFAULT_USER_MSG_ON; + + my $read_cnst_t = shift || DEFAULT_READ_CONST_TIME; + my $read_char_t = shift || DEFAULT_READ_CHAR_TIME; + + my $port = Device::SerialPort->new($dev) + or die "Can't open $dev: $!"; + + $port->baudrate($baud_rate) + or die "Can't set baud rate to $baud_rate"; + + $port->parity($parity) + or die "Can't set parity to $parity"; + + $port->databits($data_bits) + or die "Can't set data bits to $data_bits"; + + $port->stopbits($stop_bits) + or die "Can't set stop bits to $stop_bits"; + + $port->handshake($handshake) + or die "Can't set handshake to $handshake"; + + $port->datatype($data_type) + or die "Can't set data type to $data_type"; + + $port->write_settings() + or die "Can't write settings"; + + # Use messages + $port->error_msg($err_msg_on); + $port->user_msg($user_msg_on); + + # Reading times + $port->read_const_time($read_cnst_t); + $port->read_char_time($read_char_t); + + return $port; +} + +sub readPacket($) +{ + my $port = shift; + + my ($cnt, $data) = (0, ''); + + for (;;) + { + my ($c, $d) = $port->read(PACKET_SIZE); + + $cnt += $c; $data .= $d; + + last if ($cnt >= PACKET_SIZE); + + &printProgressMark(); + } + + &clearProgressMark(); + + die sprintf("Expected %d B from port, got $cnt", PACKET_SIZE) + unless (PACKET_SIZE == $cnt); + + my @packet = map(ord($_), split('', $data)); + + return @packet; +} + +sub getButtons($) +{ + my $packet_ref = shift; + + return $packet_ref->[0] & BTNS_BITMASK; +} + +sub getStatus($) +{ + my $packet_ref = shift; + + return $packet_ref->[0] & BTN_STATUS_BIT; +} + +sub getProximity($) +{ + my $packet_ref = shift; + + return $packet_ref->[0] & PROX_BIT; +} + +sub isButton($$) +{ + my ($buttons, $btn_bit) = @_; + + return $buttons & $btn_bit; +} + +sub getCoords($) +{ + my $packet_ref = shift; + + my $x = ($packet_ref->[1] & 0x7f) + (($packet_ref->[2] & 0x7f) << 7); + my $y = ($packet_ref->[3] & 0x7f) + (($packet_ref->[4] & 0x7f) << 7); + + return ($x, $y); +} + + + +# +# Button event handlers +# + +sub getTimeInMillis() +{ + my ($s, $us) = gettimeofday(); + + return $s * 1000 + int($us / 1000); +} + + +my $btn3emu_timeout = DEFAULT_BTN3EMU_TIMEOUT; + +my %button_event_handlers = ( +'2HW' => sub +{ + our $my_buttons = 0 unless (defined $my_buttons); + + my ($status, $buttons) = @_; + + my @ret; + + my $btn_diff = $buttons - $my_buttons; + + return @ret if (not $btn_diff); + + $my_buttons = $buttons; + + # Could be implemented nicely in C using a switch + goto RELEASE_B if (-3 == $btn_diff); + goto RELEASE_3 if (-2 == $btn_diff); + goto RELEASE_1 if (-1 == $btn_diff); + + goto PRESS_1 if (1 == $btn_diff); + goto PRESS_3 if (2 == $btn_diff); + goto PRESS_B if (3 == $btn_diff); + + RELEASE_B: + $ret[0] = 'released'; + + RELEASE_3: + $ret[2] = 'released'; + return @ret; + + RELEASE_1: + $ret[0] = 'released'; + return @ret; + + PRESS_B: + $ret[0] = 'pressed'; + + PRESS_3: + $ret[2] = 'pressed'; + return @ret; + + PRESS_1: + $ret[0] = 'pressed'; + return @ret; +}, + +'2EMU' => sub +{ + our $button = 0 unless (defined $button); + + my ($status, $buttons) = @_; + + my @ret; + + my $button_1 = &isButton($buttons, BTN_1_BIT); + + return @ret if (not ($button xor $button_1)); + + if ($button) + { + $ret[$button - 1] = 'released'; + + $button = 0; + } + elsif (!$status) + { + $button = $buttons; + + $ret[$button - 1] = 'pressed'; + } + + return @ret; +}, + +'3EMU' => sub +{ + our $button = 0 unless (defined $button); + our $timer = 0 unless (defined $timer); + + my ($status, $buttons) = @_; + + my @ret; + + my $button_1 = &isButton($buttons, BTN_1_BIT); + + if (not ($button xor $button_1)) + { + if (not ($status or $button)) + { + my $button_2 = &isButton($buttons, BTN_2_BIT); + + if ($button_2) + { + $timer = &getTimeInMillis(); + } + elsif ($timer) + { + my $t = &getTimeInMillis(); + + $ret[1] = 'pressed, released' + if ($t - $timer <= $btn3emu_timeout); + + } + } + + return @ret; + } + + if ($button) + { + $ret[$button - 1] = 'released'; + + $button = 0; + + $timer = 0; + } + elsif (!$status) + { + $button = $buttons; + + $ret[$button - 1] = 'pressed'; + } + + return @ret; +}, + +'3EMUtap' => sub +{ + our $button = 0 unless (defined $button); + our $timer = 0 unless (defined $timer); + our $btn_inc = 0 unless (defined $btn_inc); + our $btn_prox = 0 unless (defined $btn_prox); + + my ($status, $buttons, $prox_cnt) = @_; + + my @ret; + + my $button_1 = &isButton($buttons, BTN_1_BIT); + + if (not ($button xor $button_1)) + { + if (not ($status or $button)) + { + my $button_2 = &isButton($buttons, BTN_2_BIT); + + if ($button_2) + { + $timer = &getTimeInMillis(); + } + elsif ($timer) + { + my $t = &getTimeInMillis(); + + if ($t - $timer <= $btn3emu_timeout) + { + $btn_prox = $prox_cnt; + + $btn_inc ^= 0x01; + } + } + } + + return @ret; + } + + if ($button) + { + $ret[$button - 1] = 'released'; + + $button = 0; + + $timer = 0; + } + elsif (!$status) + { + $btn_inc = 0 if ($prox_cnt != $btn_prox); + + $button = $buttons + $btn_inc; + + $ret[$button - 1] = 'pressed'; + + $btn_inc = 0; + } + + return @ret; +}, +); + + + +# +# Default settings +# + +my $device = DEFAULT_DEVICE; +my $baud_rate = DEFAULT_BAUDRATE; + +my $force = 0; +my $proto_debug = DEBUG_OFF; + +my $btn_events_tst = 0; + +my $button_event_handler_id = '2EMU'; + + + +# +# Initializations +# +my @snapshots; +my $max_label_length = 0; + + + +# +# Usage +# + +my $usage = <<HERE; +Usage: $0 [OPTIONS] + +OPTIONS: + -h show this help and exit + -d <device> set serial device to open + (default is $device) + -b <baud_rate> set serail port baud rate + (default is $baud_rate) + -f force to run even if in X + -D <debug_level> run in protocol debug mode + the higher the level + more verbose messages + -B run in button events test mode + -M <btn_mode> set button mode: + 2HW - 2 buttons, hardware mode + 2EMU - 2 buttons, emulated mode + 3EMU - 3 buttons, emulated mode (no tap) + 3EMUtap - 3 buttons, emulated mode with tap + -t <timeout> set 3EMU modes click timeout + (default $btn3emu_timeout) + +HERE + + +# +# Options +# + +my %opts; + +die $usage unless (getopts('hd:b:fD:BM:t:', \%opts)); + +if ($opts{h}) +{ + print $usage; + + exit 0; +} + +$device = $opts{d} if ($opts{d}); +$baud_rate = $opts{b} if ($opts{b}); + +$force = $opts{f} if ($opts{f}); +$proto_debug = $opts{D} if ($opts{D}); +$btn_events_tst = $opts{B} if ($opts{B}); + +$button_event_handler_id = $opts{M} if ($opts{M}); + +$btn3emu_timeout = $opts{t} if ($opts{t}); + + + +# +# Print basic info +# + +print <<HERE; +This is simple TC1000 tablet driver calibration tool. +You may use it to find raw coordinates for the X11 +driver configuration (or to write a driver in Perl... ;-) + +HERE + + + +# +# Check if X is running +# + +if (`ps -A | grep ' X\$'`) +{ + print <<HERE; +It seems that you're in X, currently. + +This tool reads $device directly. +If you are in X and the tablet driver is loaded, +The utility may not run well because it has to +compete with the driver over the device. You +may experience wierd behaviour (or even hang-up). + +HERE + + if ($force) + { + print <<HERE; +You've forced to proceed, though. + +HERE + } + else + { + print <<HERE; +If you don't use the device, currently (i.e. there's +no driver for the tablet loaded), you may force +to run the utility using -f switch. Use -h switch +to obtain usage info. +Otherwise, you should shut X down and run this from +a console (or disable the tablet driver in X11 config). + +HERE + + exit 1; + } +} + + + +# +# Initialize the serial device +# + +my $port = &openSerialPort($device, $baud_rate); + + + +# +# Print functionality info +# +if ($btn_events_tst) +{ + print <<HERE; +The tool runs in button events test mode, which means +that it will print press/release button message each time +press/release events would occur in X. +Try to tap/pick the pen and/or press/release the pen button +to see if you like the way button events are handled +(may be specified via -M switch). + +HERE +} + +if ($proto_debug) +{ + print <<HERE; +The tool runs in protocol debug mode level $proto_debug + +HERE +} + +print <<HERE; +$button_event_handler_id button events handler was chosen. + +Move your pen around. +You will see current coordinates, followed by 'P' if pen +is in the screen proximity (i.e. detected by the tablet). +'S' will flash each time pen tip/button status changes. +Pen tip contact is indicated by '.', pen button hold by '*'. + +HERE + +unless ($btn_events_tst || $proto_debug) +{ + print <<HERE; +Now, let's explore the following: + * minimal coordinates (left-bottom corner in landscape) + * maximal coordinates (right-top corner in landscape) + * side buttons area Y threshold + * side button 1 center coordinates + * side button 2 center coordinates + * side button 3 center coordinates + +You can switch between what of the coords above shall be taken +by button 3 (depends on what button events handler you've chosen; +the default is to tap the pen while you hold pen button). +At the end, a chart of snapshots will be displayed. + +Coordinates snapshot is taken by pen tap. + +HERE + + @snapshots = ( + { + label => 'minimal coords', + hint => 'Hit the left-bottom corner of the screen (landscape).', + }, + { + label => 'maximal coords', + hint => 'Hit the right-top corner of the screen (landscape).', + }, + { + label => 'side buttons area Y threshold', + hint => 'Slide the pen left towards the side buttons. Take the most earlier activation.', + }, + { + label => 'side button 1 center', + hint => 'Hit the center of the left-most side button (portrait).', + }, + { + label => 'side button 2 center', + hint => 'Hit the center of the middle side button.', + }, + { + label => 'side button 3 center', + hint => 'Hit the center of the right-most side button (portrait).', + }, + ); + + # Count max. label length + foreach (@snapshots) + { + my $length = length($_->{label}); + + $max_label_length = $length if ($length > $max_label_length); + } +} + +print <<HERE; +Press [Ctrl] + [C] when finished. + +HERE + + +# +# Resumee chart printing +# + +sub printResumee() +{ + print <<HERE; + + +Thanks. + +In the table below you may see the coords snapshots taken. +Use the values to configure the X driver, appropriately. + +For the side buttons area Y threshold, only Y coordinate +is interresting. Use even lower coordinate (but greater +then Y max, of course). + +For the side buttons centers, X coords are most interresting. +Common Y coordinate is required for X driver (use the best +capture). + +Snapshots chart: +---------------- +HERE + + foreach my $exp (@snapshots) + { + my $x = $exp->{x}; + my $y = $exp->{y}; + + my $coords; + + if (defined $x && defined $y) + { + $coords = sprintf("X: %4d Y: %4d", $x, $y); + } + else + { + $coords = 'no snapshot taken'; + } + + printf( "%-$max_label_length" . "s : $coords\n", + ucfirst($exp->{label})); + } + + print "\n"; + + exit 0; +} + +$SIG{INT} = \&printResumee unless ($btn_events_tst || $proto_debug); + + + +# +# Main +# + +my $explore = 0; +my $explore_change = 1; +my $old_proximity = 0; +my $old_buttons = 0; + +my $btn_event_handler = $button_event_handlers{$button_event_handler_id}; + +my $old_status = 0; +my $proximity_cnt = 0; + +for (my $pac_id = 0; ; $pac_id++) +{ + # Read tablet serial iface + my @packet = &readPacket($port); + + # Unpack the information + my $status = &getStatus(\@packet); + my $proximity = &getProximity(\@packet); + my $buttons = &getButtons(\@packet); + my ($x, $y) = &getCoords(\@packet); + + # Resolve button press/release if any + my ($button_1, $button_2, $button_3); + + ($button_1, $button_2, $button_3) = + &$btn_event_handler($status, $buttons, $proximity_cnt) + if ($status ^ $old_status); + + # Update proximity counter + $proximity_cnt++ if (not $proximity); + + # Packet dump + if ($proto_debug >= DEBUG_PACKET_DUMP) + { + printf( "\nPACKET %06d: %02x %02x %02x %02x %02x:\n", + $pac_id, + $packet[4], $packet[3], $packet[2], + $packet[1], $packet[0]); + } + + # Protocol debugging + if ($proto_debug >= DEBUG_PROXIMITY) + { + my $prox_cmp = $proximity <=> $old_proximity; + + if ($prox_cmp) + { + printf( "\r%06d: PROX DIFF: %2d: STATUS: %02x\n", + $pac_id, $prox_cmp, $status); + } + } + + if ($proto_debug >= DEBUG_BUTTONS_STATUS) + { + # Buttons states changes + my $status_cmp = $status <=> $old_status; + my $buttons_cmp = $buttons <=> $old_buttons; + + if ($status || $status_cmp || $buttons_cmp) + { + printf( "\r%06d: STAT DIFF: %2d: ". + "BUTTONS: %02x -> %02x (%2d)\n", $pac_id, + $status_cmp, + $old_buttons, $buttons, $buttons_cmp); + } + } + + # Button events testing + if ($btn_events_tst) + { + print "\rButton 1 $button_1 \n" + if (defined $button_1); + + print "\rButton 2 $button_2 \n" + if (defined $button_2); + + print "\rButton 3 $button_3 \n" + if (defined $button_3); + } + + unless ($btn_events_tst || $proto_debug) + { + # Pen tap + if (defined $button_1 and 'pressed' eq $button_1) + { + $snapshots[$explore]->{x} = $x; + $snapshots[$explore]->{y} = $y; + + print "\rCurrent " . $snapshots[$explore]->{label} . + ' snapshot: [' . $snapshots[$explore]->{x} . ',' . + $snapshots[$explore]->{y} . "]\n"; + } + + # Button press + if (defined $button_3 and 'pressed' eq $button_3) + { + $explore++; + + $explore = 0 if ($explore == @snapshots); + + $explore_change = 1; + } + + # Display current explore mode hint + if ($explore_change) + { + print "\r \n" . + "Exploring " . $snapshots[$explore]->{label} . ".\n" . + $snapshots[$explore]->{hint} . "\n"; + + $explore_change = 0; + } + } + + # Display current pen status + my $status_flag = $status ? 'S' : ' '; + my $prox = $proximity ? 'P' : ' '; + my $tip = &isButton($buttons, BTN_1_BIT) ? '.' : ' '; + my $btn = &isButton($buttons, BTN_2_BIT) ? '*' : ' '; + + print "\r[$x,$y]: $prox $status_flag $tip $btn "; + + $old_status = $status; + $old_proximity = $proximity; + $old_buttons = $buttons; +} |