recorder.pl

#!/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";
			}
		}
	}
}