• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1#!/usr/bin/perl
2
3use Getopt::Long;
4use 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
15if(!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
29if ($timing) {
30	eval 'use Time::HiRes';
31	$timing=0 if $@;
32	$starttime=-1;
33}
34
35if ($symbolic) {
36	eval 'use X11::Keysyms qw(%Keysyms)';
37	$symbolic=0 if $@;
38	%sym_name = reverse %Keysyms;
39}
40
41$server=$ARGV[0];
42
43if($server=~/^(.*):(\d+)$/) {
44	$server=$1;
45	$port=$2;
46	if($2<100) {
47		$port+=5900;
48	}
49}
50
51if($listen_port<100) {
52	$listen_port+=5900;
53}
54
55# do not overwrite script
56
57if(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
65if($vnc<0) {
66	print STDERR "Could not initialize $server:$port\n";
67	exit 1;
68}
69
70open OUT, ">$output.pl";
71print OUT "#!/usr/bin/perl\n";
72print OUT "\n";
73if ($symbolic) {
74	print OUT "use X11::Keysyms qw(\%sym);\n";
75}
76print OUT "use nacro;\n";
77print OUT "\n";
78print OUT "\$x_origin=0; \$y_origin=0;\n";
79print 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
86sub 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
98sub 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
111sub 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
134while(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
283