diff options
Diffstat (limited to 'VisualNaCro/recorder.pl')
| -rw-r--r-- | VisualNaCro/recorder.pl | 282 |
1 files changed, 0 insertions, 282 deletions
diff --git a/VisualNaCro/recorder.pl b/VisualNaCro/recorder.pl deleted file mode 100644 index 01ab3f2..0000000 --- a/VisualNaCro/recorder.pl +++ /dev/null @@ -1,282 +0,0 @@ -#!/usr/bin/perl - -use Getopt::Long; -use nacro; - -$output="my_script"; -$server="localhost"; -$port=5900; -$listen_port=5923; -$timing=0; -$symbolic=0; -$compact=0; -$compact_dragging=0; - -if(!GetOptions( - "script:s" => \$output, - "listen:i" => \$listen_port, - "timing" => \$timing, - "symbolic" => \$symbolic, - "compact" => \$compact, - "compact-dragging" => \$compact_dragging, -) || $#ARGV!=0) { - print STDERR "Usage: $ARGV0 [--script output_name] [--listen listen_port] [--timing]\n\t[--symbolic] [--compact] [--compact-dragging] server[:port]\n"; - exit 2; -} - -$output=~s/\.pl$//; - -if ($timing) { - eval 'use Time::HiRes'; - $timing=0 if $@; - $starttime=-1; -} - -if ($symbolic) { - eval 'use X11::Keysyms qw(%Keysyms)'; - $symbolic=0 if $@; - %sym_name = reverse %Keysyms; -} - -$server=$ARGV[0]; - -if($server=~/^(.*):(\d+)$/) { - $server=$1; - $port=$2; - if($2<100) { - $port+=5900; - } -} - -if($listen_port<100) { - $listen_port+=5900; -} - -# do not overwrite script - -if(stat("$output.pl")) { - print STDERR "Will not overwrite $output.pl\n"; - exit 2; -} - -# start connection -$vnc=nacro::initvnc($server,$port,$listen_port); - -if($vnc<0) { - print STDERR "Could not initialize $server:$port\n"; - exit 1; -} - -open OUT, ">$output.pl"; -print OUT "#!/usr/bin/perl\n"; -print OUT "\n"; -if ($symbolic) { - print OUT "use X11::Keysyms qw(\%sym);\n"; -} -print OUT "use nacro;\n"; -print OUT "\n"; -print OUT "\$x_origin=0; \$y_origin=0;\n"; -print OUT "\$vnc=nacro::initvnc(\"$server\",$port,$listen_port);\n"; - -$mode="passthru"; -$image_counter=1; -$magickey=0; -$x_origin=0; $y_origin=0; - -sub writetiming () { - if ($timing) { - $now=Time::HiRes::time(); - if ($starttime>0) { - print OUT "nacro::process(\$vnc," . ($now - $starttime) . ");\n"; - } - $starttime=$now; - } -} - -$last_button = -1; - -sub handle_mouse { - my $x = shift; - my $y = shift; - my $buttons = shift; - if(nacro::sendmouse($vnc,$x,$y,$buttons)) { - $x-=$x_origin; $y-=$y_origin; - writetiming(); - print OUT "nacro::sendmouse(\$vnc,\$x_origin" - . ($x>=0?"+":"")."$x,\$y_origin" - . ($y>=0?"+":"")."$y,$buttons);\n"; - } -} - -sub toggle_text { - my $text = shift; - if ($text eq "Timing") { - return $text . " is " . ($timing ? "on" : "off"); - } elsif ($text eq "Key presses") { - return $text . " are recorded " . ($symbolic ? "symbolically" - : "numerically"); - } elsif ($text eq "Mouse moves") { - return $text . " are recorded " . ($compact ? "compacted" - : "verbosely"); - } elsif ($text eq "Mouse drags") { - return $text . " are recorded " . ($compact ? "compacted" - : "verbosely"); - } - return $text . ": <unknown>"; -} - -$menu_message = "VisualNaCro: press 'q' to quit,\n" - . "'i' to display current settings,\n" - . "'c', 'r' to toggle compact mouse movements or drags,\n" - . "'d' to display current reference image,\n" - . "or mark reference rectangle by dragging"; - -while(1) { - $result=nacro::waitforinput($vnc,999999); - if($result==0) { - # server went away - close OUT; - exit 0; - } - - if($mode eq "passthru") { - if($result&$nacro::RESULT_KEY) { - $keysym=nacro::getkeysym($vnc); - $keydown=nacro::getkeydown($vnc); - if(nacro::sendkey($vnc,$keysym,$keydown)) { - writetiming(); - if ($symbolic and exists $sym_name{$keysym}) { - print OUT 'nacro::sendkey($vnc,$sym{'.$sym_name{$keysym}."},$keydown);\n"; - } else { - print OUT "nacro::sendkey(\$vnc,$keysym,$keydown);\n"; - } - } - if($keysym==0xffe3 || $keysym==0xffe4) { - if (!$keydown) { - # Control pressed - $magickey++; - if ($magickey > 1) { - $magickey = 0; - $mode = "menu"; - nacro::alert($vnc, - $menu_message, 10); - } - } - } else { - $magickey=0; - } - } - if($result&$nacro::RESULT_MOUSE) { - $x=nacro::getx($vnc); - $y=nacro::gety($vnc); - $buttons=nacro::getbuttons($vnc); - if ($buttons != $last_buttons) { - if (!$buttons && $compact_dragging) { - handle_mouse($x, $y, $last_buttons); - } - $last_buttons = $buttons; - } else { - if (($buttons && $compact_dragging) || - (!$buttons && $compact)) { - next; - } - } - handle_mouse($x, $y, $buttons); - } - if ($result & $nacro::RESULT_TEXT_CLIENT) { - my $text = nacro::gettext_client($vnc); - if (nacro::sendtext($vnc,$text)) { - writetiming(); - print OUT "nacro::sendtext(\$vnc, q(\Q$text\E));\n"; - print "got text from client: $text\n"; - } - } - if ($result & $nacro::RESULT_TEXT_SERVER) { - my $text = nacro::gettext_server($vnc); - if (nacro::sendtext_to_server($vnc,$text)) { - writetiming(); - print OUT "nacro::sendtext_to_server(\$vnc, q(\Q$text\E));\n"; - print "got text from server: $text\n"; - } - } - } else { - if($result&$nacro::RESULT_KEY) { - $keysym=nacro::getkeysym($vnc); - $keydown=nacro::getkeydown($vnc); - if($keysym==ord('q')) { - # shutdown - close OUT; - nacro::closevnc($vnc); - exit 0; - } elsif ($keysym == ord('d')) { - $pnm=$output.($image_counter - 1).".pnm"; - $res = nacro::displaypnm($vnc, $pnm, - $x_origin, $y_origin, 1, 10); - #0, 0, 1, 10); - if ($res == 0) { - nacro::alert($vnc, "Error displaying " - . $pnm, 10); - } - } elsif ($keysym == ord('i')) { - nacro::alert($vnc, "Current settings:\n" - . "\n" - . "Script: $output\n" - . "Server: $server\n" - . "Listening on port: $port\n" - . toggle_text("Timing") . "\n" - . toggle_text("Key presses") . "\n" - . toggle_text("Mouse moves") . "\n" - . toggle_text("Mouse drags"), 10); - } elsif ($keysym == ord('c')) { - $compact = !$compact; - nacro::alert($vnc, - toggle_text("Mouse moves"), 10); - } elsif ($keysym == ord('r')) { - $compact_dragging = !$compact_dragging; - nacro::alert($vnc, - toggle_text("Mouse drags"), 10); - } else { - nacro::alert($vnc,"Unknown key",10); - } - $mode="passthru"; - } - if($result&$nacro::RESULT_MOUSE) { - $x=nacro::getx($vnc); - $y=nacro::gety($vnc); - $buttons=nacro::getbuttons($vnc); - if(($buttons&1)==1) { - print STDERR "start draggin: $x $y\n"; - $start_x=$x; - $start_y=$y; - nacro::rubberband($vnc, $x, $y); - $x=nacro::getx($vnc); - $y=nacro::gety($vnc); - if($start_x==$x && $start_y==$y) { - # reset - print OUT "\$x_origin=0; \$y_origin=0;\n"; - } else { - if($start_x>$x) { - $dummy=$x; $x=$start_x; $start_x=$dummy; - } - if($start_y>$y) { - $dummy=$y; $y=$start_y; $start_y=$dummy; - } - $pnm=$output.$image_counter.".pnm"; - $image_counter++; - if(!nacro::savepnm($vnc,$pnm,$start_x,$start_y,$x,$y)) { - nacro::alert($vnc,"Saving $pnm failed!",10); - } else { - $x_origin=$start_x; - $y_origin=$start_y; - nacro::alert($vnc,"Got new origin: $x_origin $y_origin",10); - print OUT "if(nacro::visualgrep(\$vnc,\"$pnm\",999999)) {\n" - . "\t\$x_origin=nacro::getxorigin(\$vnc);\n" - . "\t\$y_origin=nacro::getyorigin(\$vnc);\n}\n"; - } - } - $mode="passthru"; - } - } - } -} - |