San Mehat | a430b2b | 2014-09-23 08:30:51 -0700 | [diff] [blame] | 1 | #!/usr/bin/perl |
| 2 | |
| 3 | use Getopt::Long; |
| 4 | use nacro; |
| 5 | |
| 6 | $output="my_script"; |
| 7 | $server="localhost"; |
| 8 | $port=5900; |
| 9 | $listen_port=5923; |
| 10 | $timing=0; |
| 11 | $symbolic=0; |
| 12 | $compact=0; |
| 13 | $compact_dragging=0; |
| 14 | |
| 15 | if(!GetOptions( |
| 16 | "script:s" => \$output, |
| 17 | "listen:i" => \$listen_port, |
| 18 | "timing" => \$timing, |
| 19 | "symbolic" => \$symbolic, |
| 20 | "compact" => \$compact, |
| 21 | "compact-dragging" => \$compact_dragging, |
| 22 | ) || $#ARGV!=0) { |
| 23 | print STDERR "Usage: $ARGV0 [--script output_name] [--listen listen_port] [--timing]\n\t[--symbolic] [--compact] [--compact-dragging] server[:port]\n"; |
| 24 | exit 2; |
| 25 | } |
| 26 | |
| 27 | $output=~s/\.pl$//; |
| 28 | |
| 29 | if ($timing) { |
| 30 | eval 'use Time::HiRes'; |
| 31 | $timing=0 if $@; |
| 32 | $starttime=-1; |
| 33 | } |
| 34 | |
| 35 | if ($symbolic) { |
| 36 | eval 'use X11::Keysyms qw(%Keysyms)'; |
| 37 | $symbolic=0 if $@; |
| 38 | %sym_name = reverse %Keysyms; |
| 39 | } |
| 40 | |
| 41 | $server=$ARGV[0]; |
| 42 | |
| 43 | if($server=~/^(.*):(\d+)$/) { |
| 44 | $server=$1; |
| 45 | $port=$2; |
| 46 | if($2<100) { |
| 47 | $port+=5900; |
| 48 | } |
| 49 | } |
| 50 | |
| 51 | if($listen_port<100) { |
| 52 | $listen_port+=5900; |
| 53 | } |
| 54 | |
| 55 | # do not overwrite script |
| 56 | |
| 57 | if(stat("$output.pl")) { |
| 58 | print STDERR "Will not overwrite $output.pl\n"; |
| 59 | exit 2; |
| 60 | } |
| 61 | |
| 62 | # start connection |
| 63 | $vnc=nacro::initvnc($server,$port,$listen_port); |
| 64 | |
| 65 | if($vnc<0) { |
| 66 | print STDERR "Could not initialize $server:$port\n"; |
| 67 | exit 1; |
| 68 | } |
| 69 | |
| 70 | open OUT, ">$output.pl"; |
| 71 | print OUT "#!/usr/bin/perl\n"; |
| 72 | print OUT "\n"; |
| 73 | if ($symbolic) { |
| 74 | print OUT "use X11::Keysyms qw(\%sym);\n"; |
| 75 | } |
| 76 | print OUT "use nacro;\n"; |
| 77 | print OUT "\n"; |
| 78 | print OUT "\$x_origin=0; \$y_origin=0;\n"; |
| 79 | print OUT "\$vnc=nacro::initvnc(\"$server\",$port,$listen_port);\n"; |
| 80 | |
| 81 | $mode="passthru"; |
| 82 | $image_counter=1; |
| 83 | $magickey=0; |
| 84 | $x_origin=0; $y_origin=0; |
| 85 | |
| 86 | sub writetiming () { |
| 87 | if ($timing) { |
| 88 | $now=Time::HiRes::time(); |
| 89 | if ($starttime>0) { |
| 90 | print OUT "nacro::process(\$vnc," . ($now - $starttime) . ");\n"; |
| 91 | } |
| 92 | $starttime=$now; |
| 93 | } |
| 94 | } |
| 95 | |
| 96 | $last_button = -1; |
| 97 | |
| 98 | sub handle_mouse { |
| 99 | my $x = shift; |
| 100 | my $y = shift; |
| 101 | my $buttons = shift; |
| 102 | if(nacro::sendmouse($vnc,$x,$y,$buttons)) { |
| 103 | $x-=$x_origin; $y-=$y_origin; |
| 104 | writetiming(); |
| 105 | print OUT "nacro::sendmouse(\$vnc,\$x_origin" |
| 106 | . ($x>=0?"+":"")."$x,\$y_origin" |
| 107 | . ($y>=0?"+":"")."$y,$buttons);\n"; |
| 108 | } |
| 109 | } |
| 110 | |
| 111 | sub toggle_text { |
| 112 | my $text = shift; |
| 113 | if ($text eq "Timing") { |
| 114 | return $text . " is " . ($timing ? "on" : "off"); |
| 115 | } elsif ($text eq "Key presses") { |
| 116 | return $text . " are recorded " . ($symbolic ? "symbolically" |
| 117 | : "numerically"); |
| 118 | } elsif ($text eq "Mouse moves") { |
| 119 | return $text . " are recorded " . ($compact ? "compacted" |
| 120 | : "verbosely"); |
| 121 | } elsif ($text eq "Mouse drags") { |
| 122 | return $text . " are recorded " . ($compact ? "compacted" |
| 123 | : "verbosely"); |
| 124 | } |
| 125 | return $text . ": <unknown>"; |
| 126 | } |
| 127 | |
| 128 | $menu_message = "VisualNaCro: press 'q' to quit,\n" |
| 129 | . "'i' to display current settings,\n" |
| 130 | . "'c', 'r' to toggle compact mouse movements or drags,\n" |
| 131 | . "'d' to display current reference image,\n" |
| 132 | . "or mark reference rectangle by dragging"; |
| 133 | |
| 134 | while(1) { |
| 135 | $result=nacro::waitforinput($vnc,999999); |
| 136 | if($result==0) { |
| 137 | # server went away |
| 138 | close OUT; |
| 139 | exit 0; |
| 140 | } |
| 141 | |
| 142 | if($mode eq "passthru") { |
| 143 | if($result&$nacro::RESULT_KEY) { |
| 144 | $keysym=nacro::getkeysym($vnc); |
| 145 | $keydown=nacro::getkeydown($vnc); |
| 146 | if(nacro::sendkey($vnc,$keysym,$keydown)) { |
| 147 | writetiming(); |
| 148 | if ($symbolic and exists $sym_name{$keysym}) { |
| 149 | print OUT 'nacro::sendkey($vnc,$sym{'.$sym_name{$keysym}."},$keydown);\n"; |
| 150 | } else { |
| 151 | print OUT "nacro::sendkey(\$vnc,$keysym,$keydown);\n"; |
| 152 | } |
| 153 | } |
| 154 | if($keysym==0xffe3 || $keysym==0xffe4) { |
| 155 | if (!$keydown) { |
| 156 | # Control pressed |
| 157 | $magickey++; |
| 158 | if ($magickey > 1) { |
| 159 | $magickey = 0; |
| 160 | $mode = "menu"; |
| 161 | nacro::alert($vnc, |
| 162 | $menu_message, 10); |
| 163 | } |
| 164 | } |
| 165 | } else { |
| 166 | $magickey=0; |
| 167 | } |
| 168 | } |
| 169 | if($result&$nacro::RESULT_MOUSE) { |
| 170 | $x=nacro::getx($vnc); |
| 171 | $y=nacro::gety($vnc); |
| 172 | $buttons=nacro::getbuttons($vnc); |
| 173 | if ($buttons != $last_buttons) { |
| 174 | if (!$buttons && $compact_dragging) { |
| 175 | handle_mouse($x, $y, $last_buttons); |
| 176 | } |
| 177 | $last_buttons = $buttons; |
| 178 | } else { |
| 179 | if (($buttons && $compact_dragging) || |
| 180 | (!$buttons && $compact)) { |
| 181 | next; |
| 182 | } |
| 183 | } |
| 184 | handle_mouse($x, $y, $buttons); |
| 185 | } |
| 186 | if ($result & $nacro::RESULT_TEXT_CLIENT) { |
| 187 | my $text = nacro::gettext_client($vnc); |
| 188 | if (nacro::sendtext($vnc,$text)) { |
| 189 | writetiming(); |
| 190 | print OUT "nacro::sendtext(\$vnc, q(\Q$text\E));\n"; |
| 191 | print "got text from client: $text\n"; |
| 192 | } |
| 193 | } |
| 194 | if ($result & $nacro::RESULT_TEXT_SERVER) { |
| 195 | my $text = nacro::gettext_server($vnc); |
| 196 | if (nacro::sendtext_to_server($vnc,$text)) { |
| 197 | writetiming(); |
| 198 | print OUT "nacro::sendtext_to_server(\$vnc, q(\Q$text\E));\n"; |
| 199 | print "got text from server: $text\n"; |
| 200 | } |
| 201 | } |
| 202 | } else { |
| 203 | if($result&$nacro::RESULT_KEY) { |
| 204 | $keysym=nacro::getkeysym($vnc); |
| 205 | $keydown=nacro::getkeydown($vnc); |
| 206 | if($keysym==ord('q')) { |
| 207 | # shutdown |
| 208 | close OUT; |
| 209 | nacro::closevnc($vnc); |
| 210 | exit 0; |
| 211 | } elsif ($keysym == ord('d')) { |
| 212 | $pnm=$output.($image_counter - 1).".pnm"; |
| 213 | $res = nacro::displaypnm($vnc, $pnm, |
| 214 | $x_origin, $y_origin, 1, 10); |
| 215 | #0, 0, 1, 10); |
| 216 | if ($res == 0) { |
| 217 | nacro::alert($vnc, "Error displaying " |
| 218 | . $pnm, 10); |
| 219 | } |
| 220 | } elsif ($keysym == ord('i')) { |
| 221 | nacro::alert($vnc, "Current settings:\n" |
| 222 | . "\n" |
| 223 | . "Script: $output\n" |
| 224 | . "Server: $server\n" |
| 225 | . "Listening on port: $port\n" |
| 226 | . toggle_text("Timing") . "\n" |
| 227 | . toggle_text("Key presses") . "\n" |
| 228 | . toggle_text("Mouse moves") . "\n" |
| 229 | . toggle_text("Mouse drags"), 10); |
| 230 | } elsif ($keysym == ord('c')) { |
| 231 | $compact = !$compact; |
| 232 | nacro::alert($vnc, |
| 233 | toggle_text("Mouse moves"), 10); |
| 234 | } elsif ($keysym == ord('r')) { |
| 235 | $compact_dragging = !$compact_dragging; |
| 236 | nacro::alert($vnc, |
| 237 | toggle_text("Mouse drags"), 10); |
| 238 | } else { |
| 239 | nacro::alert($vnc,"Unknown key",10); |
| 240 | } |
| 241 | $mode="passthru"; |
| 242 | } |
| 243 | if($result&$nacro::RESULT_MOUSE) { |
| 244 | $x=nacro::getx($vnc); |
| 245 | $y=nacro::gety($vnc); |
| 246 | $buttons=nacro::getbuttons($vnc); |
| 247 | if(($buttons&1)==1) { |
| 248 | print STDERR "start draggin: $x $y\n"; |
| 249 | $start_x=$x; |
| 250 | $start_y=$y; |
| 251 | nacro::rubberband($vnc, $x, $y); |
| 252 | $x=nacro::getx($vnc); |
| 253 | $y=nacro::gety($vnc); |
| 254 | if($start_x==$x && $start_y==$y) { |
| 255 | # reset |
| 256 | print OUT "\$x_origin=0; \$y_origin=0;\n"; |
| 257 | } else { |
| 258 | if($start_x>$x) { |
| 259 | $dummy=$x; $x=$start_x; $start_x=$dummy; |
| 260 | } |
| 261 | if($start_y>$y) { |
| 262 | $dummy=$y; $y=$start_y; $start_y=$dummy; |
| 263 | } |
| 264 | $pnm=$output.$image_counter.".pnm"; |
| 265 | $image_counter++; |
| 266 | if(!nacro::savepnm($vnc,$pnm,$start_x,$start_y,$x,$y)) { |
| 267 | nacro::alert($vnc,"Saving $pnm failed!",10); |
| 268 | } else { |
| 269 | $x_origin=$start_x; |
| 270 | $y_origin=$start_y; |
| 271 | nacro::alert($vnc,"Got new origin: $x_origin $y_origin",10); |
| 272 | print OUT "if(nacro::visualgrep(\$vnc,\"$pnm\",999999)) {\n" |
| 273 | . "\t\$x_origin=nacro::getxorigin(\$vnc);\n" |
| 274 | . "\t\$y_origin=nacro::getyorigin(\$vnc);\n}\n"; |
| 275 | } |
| 276 | } |
| 277 | $mode="passthru"; |
| 278 | } |
| 279 | } |
| 280 | } |
| 281 | } |
| 282 | |