Commit 7960c687 authored by Christian Beier's avatar Christian Beier
parent 9bf5fe01
/COPYING
/INSTALL
/nacro.pm
/nacro.so
/nacro_wrap.c
Johannes Schindelin <Johannes.Schindelin@gmx.de>
2006-10-10: Johannes Schindelin <Johannes.Schindelin@gmx.de>
* implement --compact and --compact-dragging to shut up the
script about mouse movements or drags.
* add 'i', 'c' and 'r' menu keys.
2006-09-12: Johannes Schindelin <Johannes.Schindelin@gmx.de>
* the reference rectangle is selected with a rubber band,
and can be shown with 'd'.
2006-06-15: Johannes Schindelin <Johannes.Schindelin@gmx.de>
* added timing: you can record the events with their timestamps now
2005-01-13: Johannes Schindelin <Johannes.Schindelin@gmx.de>
* started the project
INTERFACE=nacro.h
SRCS=nacro.c
OBJS=nacro.o
ISRCS=nacro_wrap.c
IOBJS=nacro_wrap.o
TARGET=nacro
LIBS= @LIBVNCSERVERLIBS@
nacro_CFLAGS= @LIBVNCSERVERCFLAGS@
SWIGOPT=
EXTRA_DIST=autogen.sh $(INTERFACE) $(SRCS) $(ISRCS) nacro.pm recorder.pl
all: $(LIBPREFIX)$(TARGET)$(SO)
# the following is borrowed from SWIG
SWIG= @SWIG@
##################################################################
##### PERL 5 ######
##################################################################
# You need to set this variable to the Perl5 directory containing the
# files "perl.h", "EXTERN.h" and "XSUB.h". With Perl5.003, it's
# usually something like /usr/local/lib/perl5/arch-osname/5.003/CORE.
PERL5_INCLUDE= @PERL5EXT@
# Extra Perl specific dynamic linking options
PERL5_DLNK = @PERL5DYNAMICLINKING@
PERL5_CCFLAGS = @PERL5CCFLAGS@
# ----------------------------------------------------------------
# Build a Perl5 dynamically loadable module (C)
# ----------------------------------------------------------------
$(ISRCS): $(INTERFACE)
@test -n "$(SWIG)" || (echo "Need SWIG" && exit 1)
$(SWIG) -perl5 $(SWIGOPT) $(INTERFACE)
$(OBJS): $(SRCS) $(INTERFACE)
$(CC) -c -Dbool=char $(CCSHARED) $(CFLAGS) -o $@ $< $(LIBVNCSERVERCFLAGS) $(INCLUDES) -I$(PERL5_INCLUDE)
$(IOBJS): $(ISRCS) $(INTERFACE)
$(CC) -c -Dbool=char $(CCSHARED) $(CFLAGS) -o $@ $< $(INCLUDES) $(PERL5_CCFLAGS) -I$(PERL5_INCLUDE)
$(LIBPREFIX)$(TARGET)$(SO): $(OBJS) $(IOBJS)
$(LDSHARED) $(OBJS) $(IOBJS) $(PERL5_DLNK) $(LIBS) -o $(LIBPREFIX)$(TARGET)$(SO)
With --timing, you can actually record action scripts which are meaningful...
Earlier, the events just got garbled, because the GUI could not react as
fast as the events were churned out.
Clipboard is supported (thanks to Uwe).
Keys are recorded by their symbols with the --symbolic switch, provided you
have the X11::Keysyms module.
After pressing Control twice, you can show the last reference image with 'd'.
This is VisualNaCro.
DISCLAIMER: recorder.pl is not yet functional.
What does it?
It is a Perl module meant to remote control a VNC server.
It includes a recorder (written in Perl) to make it easy to
record a macro, which is just a Perl script, and which you can
modify to your heart's content.
The most important feature, however, is that you can mark a
rectangle which the Perl script will try to find again when you
run it. Thus when you play a game and want to hit a certain button,
you just hit the Ctrl key twice, mark the button, and from then on,
all mouse movements will be repeated relative to that button, even
if the button is somewhere else when you run the script the next
time.
If you know Tcl Expect, you will recognize this approach. Only this
time, it is not text, but an image which is expected.
How does it work?
It acts as a VNC proxy: your Perl script starts its own VNC server.
The script now can intercept inputs and outputs, and act upon them.
In order to write a macro, start
recorder.pl --script my-macro.pl --timing host:port
connect with a vncviewer of your choice to <host2>:23, where <host2>
is the computer on which recorder.pl was started (not necessarily the
same as the VNC server!). Now your actions are recorded into
my_macro.pl, and the images you want to grep for will be saved as
my_macro-1.pnm, my_macro-2.pnm, ...
In order to finish the script, hit Ctrl twice and say "q".
Why did I do it?
Because I could ;-)
No really, I needed a way to write automated tests. While there
exist a lot of OpenSource programs for web testing, I found none
of them easy to use, and for GUI testing I found xautomation.
Xautomation has this "visual grep" (or "graphical expect") feature:
given an image it tries to find it on the desktop and returns the
coordinates. Unfortunately, there is no easy way to record macros
with it, and it only works on X11.
As I know VNC pretty well, and there are VNC servers for every OS
and gadget, I thought it might be cool to have this feature to
control a VNC server.
Actually, it makes it even easier: with plain X11, for example, you
can not know where on the screen the action is if you don't check
the whole screen. This complex problem is beautifully addressed
in Karl Runge's x11vnc.
My main purpose is to run regression tests on different browsers,
which I can easily do by starting Xvnc and using VisualNaCro.
How did I do it?
I wondered long about how to do it. I couldn't take the same approach
as xautomation: I cannot connect to the VNC server thousand times
per second. So I decided to create an interface of LibVNCServer/
LibVNCClient for use in a script language.
Fortunately, this task is made very, very easy by SWIG. As Perl
is one of my favorite script languages, I decided to use this.
But SWIG makes it easy to use the very same interface for other
popular languages, so you are welcome to port VisualNaCro to
the language of your choice!
Isn't it pronounced "Visual Macro"?
Yes. But I liked the Visual Na Cro play of acronyms. I'm sorry if
you don't find it funny.
What's the license?
GPL. It is based on LibVNCServer/LibVNCClient, so it has to be.
If you want to port this package to use vncreflector, which has a
BSD license, go ahead.
#! /bin/sh
# Run this to generate all the initial makefiles, etc.
srcdir=`dirname $0`
test -z "$srcdir" && srcdir=.
DIE=0
AUTOMAKE=automake-1.4
ACLOCAL=aclocal-1.4
($AUTOMAKE --version) < /dev/null > /dev/null 2>&1 || {
AUTOMAKE=automake
ACLOCAL=aclocal
}
(autoconf --version) < /dev/null > /dev/null 2>&1 || {
echo
echo "You must have autoconf installed to compile VisualNaCro."
echo "Download the appropriate package for your distribution,"
echo "or get the source tarball at ftp://ftp.gnu.org/pub/gnu/"
DIE=1
}
($AUTOMAKE --version) < /dev/null > /dev/null 2>&1 || {
echo
echo "You must have automake installed to compile VisualNaCro."
echo "Get ftp://sourceware.cygnus.com/pub/automake/automake-1.4.tar.gz"
echo "(or a newer version if it is available)"
DIE=1
}
if test "$DIE" -eq 1; then
exit 1
fi
(test -f $srcdir/nacro.h) || {
echo "You must run this script in the top-level VisualNaCro directory"
exit 1
}
if test -z "$*"; then
echo "I am going to run ./configure with no arguments - if you wish "
echo "to pass any to it, please specify them on the $0 command line."
fi
$ACLOCAL $ACLOCAL_FLAGS
#autoheader
$AUTOMAKE --add-missing --copy
autoconf
echo "Running ./configure --enable-maintainer-mode" "$@"
$srcdir/configure --enable-maintainer-mode "$@"
echo "Now type 'make' to compile VisualNaCro."
dnl Process this file with autoconf to produce a configure script.
dnl The macros which aren't shipped with the autotools are stored in the
dnl Tools/config directory in .m4 files.
AC_INIT([VisualNaCro],[0.1],[http://libvncserver.sourceforge.net])
AC_PREREQ(2.54)
AC_CANONICAL_HOST
AM_INIT_AUTOMAKE
dnl Checks for programs.
AC_CHECK_PROG(SWIG,swig,swig)
AC_CHECK_PROG(LIBVNCSERVERCONFIG,libvncserver-config,yes,no)
if test "$LIBVNCSERVERCONFIG" != "yes"; then
AC_MSG_ERROR([Need to have libvncserver-config in PATH])
exit 1
fi
AC_PROG_CC
AC_PROG_RANLIB
AC_EXEEXT
AC_OBJEXT
LIBVNCSERVERCFLAGS=`libvncserver-config --cflags`
LIBVNCSERVERLIBS=`libvncserver-config --libs`
AC_SUBST(LIBVNCSERVERCFLAGS)
AC_SUBST(LIBVNCSERVERLIBS)
dnl Checks for header files.
AC_HEADER_STDC
dnl How to specify include directories that may be system directories.
# -I should not be used on system directories (GCC)
if test "$GCC" = yes; then
ISYSTEM="-isystem "
else
ISYSTEM="-I"
fi
# Set info about shared libraries.
AC_SUBST(SO)
AC_SUBST(LDSHARED)
AC_SUBST(CCSHARED)
AC_SUBST(LINKFORSHARED)
# SO is the extension of shared libraries `(including the dot!)
AC_MSG_CHECKING(SO)
if test -z "$SO"
then
case $host in
*-*-hp*) SO=.sl;;
*-*-darwin*) SO=.bundle;;
*-*-cygwin* | *-*-mingw*) SO=.dll;;
*) SO=.so;;
esac
fi
AC_MSG_RESULT($SO)
# LDSHARED is the ld *command* used to create shared library
# -- "ld" on SunOS 4.x.x, "ld -G" on SunOS 5.x, "ld -shared" on IRIX 5
# (Shared libraries in this instance are shared modules to be loaded into
# Python, as opposed to building Python itself as a shared library.)
AC_MSG_CHECKING(LDSHARED)
if test -z "$LDSHARED"
then
case $host in
*-*-aix*) LDSHARED="\$(srcdir)/ld_so_aix \$(CC)";;
*-*-cygwin* | *-*-mingw*)
if test "$GCC" = yes; then
LDSHARED="dllwrap --driver-name gcc --dlltool dlltool --export-all-symbols --as as --dllname \$(LIBPREFIX)\$(TARGET)\$(SO)"
else
if test "cl" = $CC ; then
# Microsoft Visual C++ (MSVC)
LDSHARED="$CC -nologo -LD"
else
# Unknown compiler try gcc approach
LDSHARED="$CC -shared"
fi
fi ;;
*-*-irix5*) LDSHARED="ld -shared";;
*-*-irix6*) LDSHARED="ld ${SGI_ABI} -shared -all";;
*-*-sunos4*) LDSHARED="ld";;
*-*-solaris*) LDSHARED="ld -G";;
*-*-hp*) LDSHARED="ld -b";;
*-*-osf*) LDSHARED="ld -shared -expect_unresolved \"*\"";;
*-sequent-sysv4) LDSHARED="ld -G";;
*-*-next*)
if test "$ns_dyld"
then LDSHARED='$(CC) $(LDFLAGS) -bundle -prebind'
else LDSHARED='$(CC) $(CFLAGS) -nostdlib -r';
fi
if test "$with_next_framework" ; then
LDSHARED="$LDSHARED \$(LDLIBRARY)"
fi ;;
*-*-linux*) LDSHARED="gcc -shared";;
*-*-dgux*) LDSHARED="ld -G";;
*-*-freebsd3*) LDSHARED="gcc -shared";;
*-*-freebsd* | *-*-openbsd*) LDSHARED="ld -Bshareable";;
*-*-netbsd*)
if [[ "`$CC -dM -E - </dev/null | grep __ELF__`" != "" ]]
then
LDSHARED="cc -shared"
else
LDSHARED="ld -Bshareable"
fi;;
*-sco-sysv*) LDSHARED="cc -G -KPIC -Ki486 -belf -Wl,-Bexport";;
*-*-darwin*) LDSHARED="cc -bundle -undefined suppress -flat_namespace";;
*) LDSHARED="ld";;
esac
fi
AC_MSG_RESULT($LDSHARED)
# CCSHARED are the C *flags* used to create objects to go into a shared
# library (module) -- this is only needed for a few systems
AC_MSG_CHECKING(CCSHARED)
if test -z "$CCSHARED"
then
case $host in
*-*-hp*) if test "$GCC" = yes;
then CCSHARED="-fpic";
else CCSHARED="+z";
fi;;
*-*-linux*) CCSHARED="-fpic";;
*-*-freebsd* | *-*-openbsd*) CCSHARED="-fpic";;
*-*-netbsd*) CCSHARED="-fPIC";;
*-sco-sysv*) CCSHARED="-KPIC -dy -Bdynamic";;
*-*-irix6*) case $CC in
*gcc*) CCSHARED="-shared";;
*) CCSHARED="";;
esac;;
esac
fi
AC_MSG_RESULT($CCSHARED)
# RPATH is the path used to look for shared library files.
AC_MSG_CHECKING(RPATH)
if test -z "$RPATH"
then
case $host in
*-*-solaris*) RPATH='-R. -R$(exec_prefix)/lib';;
*-*-irix*) RPATH='-rpath .:$(exec_prefix)/lib';;
*-*-linux*) RPATH='-Xlinker -rpath $(exec_prefix)/lib -Xlinker -rpath .';;
*) RPATH='';;
esac
fi
AC_MSG_RESULT($RPATH)
AC_SUBST(RPATH)
# LINKFORSHARED are the flags passed to the $(CC) command that links
# the a few executables -- this is only needed for a few systems
AC_MSG_CHECKING(LINKFORSHARED)
if test -z "$LINKFORSHARED"
then
case $host in
*-*-aix*) LINKFORSHARED='-Wl,-bE:$(srcdir)/python.exp -lld';;
*-*-hp*)
LINKFORSHARED="-Wl,-E -Wl,+s -Wl,+b\$(BINLIBDEST)/lib-dynload";;
*-*-linux*) LINKFORSHARED="-Xlinker -export-dynamic";;
*-*-next*) LINKFORSHARED="-u libsys_s";;
*-sco-sysv*) LINKFORSHARED="-Bdynamic -dy -Wl,-Bexport";;
*-*-irix6*) LINKFORSHARED="-all";;
esac
fi
AC_MSG_RESULT($LINKFORSHARED)
# This variation is needed on OS-X because there is no (apparent) consistency in shared libary naming.
# Sometimes .bundle works, but sometimes .so is needed. It depends on the target language
# Optional CFLAGS used to silence compiler warnings on some platforms.
AC_SUBST(PLATFLAGS)
case $host in
*-*-darwin*) PLATFLAGS="-Wno-long-double";;
*) PLATFLAGS="";;
esac
#----------------------------------------------------------------
# Look for Perl5
#----------------------------------------------------------------
PERLBIN=
AC_ARG_WITH(perl5,[ --with-perl5=path Set location of Perl5 executable],[ PERLBIN="$withval"], [PERLBIN=])
# First figure out what the name of Perl5 is
if test -z "$PERLBIN"; then
AC_CHECK_PROGS(PERL, perl perl5.8.1 perl5.6.1 perl5.6.0 perl5.004 perl5.003 perl5.002 perl5.001 perl5 perl)
else
PERL="$PERLBIN"
fi
AC_MSG_CHECKING(for Perl5 header files)
if test -n "$PERL"; then
PERL5DIR=`($PERL -e 'use Config; print $Config{archlib}, "\n";') 2>/dev/null`
if test "$PERL5DIR" != ""; then
dirs="$PERL5DIR $PERL5DIR/CORE"
PERL5EXT=none
for i in $dirs; do
if test -r $i/perl.h; then
AC_MSG_RESULT($i)
PERL5EXT="$i"
break;
fi
done
if test "$PERL5EXT" = none; then
PERL5EXT="$PERL5DIR/CORE"
AC_MSG_RESULT(could not locate perl.h...using $PERL5EXT)
fi
AC_MSG_CHECKING(for Perl5 library)
PERL5LIB=`($PERL -e 'use Config; $_=$Config{libperl}; s/^lib//; s/$Config{_a}$//; print $_, "\n"') 2>/dev/null`
if test "$PERL5LIB" = "" ; then
AC_MSG_RESULT(not found)
else
AC_MSG_RESULT($PERL5LIB)
fi
AC_MSG_CHECKING(for Perl5 compiler options)
PERL5CCFLAGS=`($PERL -e 'use Config; print $Config{ccflags}, "\n"' | sed "s/-I/$ISYSTEM/") 2>/dev/null`
if test "$PERL5CCFLAGS" = "" ; then
AC_MSG_RESULT(not found)
else
AC_MSG_RESULT($PERL5CCFLAGS)
fi
else
AC_MSG_RESULT(unable to determine perl5 configuration)
PERL5EXT=$PERL5DIR
fi
else
AC_MSG_RESULT(could not figure out how to run perl5)
fi
# Cygwin (Windows) needs the library for dynamic linking
case $host in
*-*-cygwin* | *-*-mingw*) PERL5DYNAMICLINKING="-L$PERL5EXT -l$PERL5LIB";;
*)PERL5DYNAMICLINKING="";;
esac
AC_SUBST(PERL)
AC_SUBST(PERL5EXT)
AC_SUBST(PERL5DYNAMICLINKING)
AC_SUBST(PERL5LIB)
AC_SUBST(PERL5CCFLAGS)
#----------------------------------------------------------------
# Miscellaneous
#----------------------------------------------------------------
AC_CONFIG_FILES([Makefile])
AC_OUTPUT
dnl configure.in ends here
This diff is collapsed.
This diff is collapsed.
#ifndef NACRO_H
#define NACRO_H
#ifdef SWIG
%module nacro
%{
/* types used */
/* 0=false, every other value=true */
typedef int bool_t;
/* a keysym: identical with ASCII for values between 0-127 */
typedef int keysym_t;
/* this can be negative, because of a new origin set via visual grep */
typedef int coordinate_t;
/* left button is 1<<0, middle button is 1<<1, right button is 1<<2 */
typedef unsigned char buttons_t;
/* this is sort of a "file descriptor" for the proxy */
typedef int resource_t;
/* the timeout, specified in microseconds, for process() and friends */
typedef double timeout_t;
/* the return values of process() and friends */
typedef int result_t;
/*
%constant int RESULT_TIMEOUT=1;
%constant int RESULT_KEY=2;
%constant int RESULT_MOUSE=4;
%constant int RESULT_TEXT_CLIENT=8;
%constant int RESULT_TEXT_CLIENT=16;
%constant int RESULT_SCREEN=32;
%constant int RESULT_FOUNDIMAGE=64;
%constant int RESULT_SHUTDOWN=128;
*/
%}
#endif // SWIG
typedef int bool_t;
typedef int keysym_t;
typedef int coordinate_t;
typedef unsigned char buttons_t;
typedef int resource_t;
typedef double timeout_t;
typedef int result_t;
#define RESULT_TIMEOUT 1
#define RESULT_KEY 2
#define RESULT_MOUSE 4
#define RESULT_TEXT_CLIENT 8
#define RESULT_TEXT_SERVER 16
#define RESULT_SCREEN 32
#define RESULT_FOUNDIMAGE 64
#define RESULT_SHUTDOWN 128
/* init/shutdown */
resource_t initvnc(const char* server,int serverPort,int listenPort);
void closevnc(resource_t res);
/* run the event loop for a while: process() and friends:
* process() returns only on timeout,
* waitforanything returns on any event (input, output or timeout),
* waitforupdate() returns only on timeout or screen update,
* waitforinput() returns only on timeout or user input,
* visualgrep() returns only on timeout or if the specified PNM was found
* (in that case, x_origin and y_origin are set to the upper left
* corner of the matched image). */
result_t process(resource_t res,timeout_t seconds);
result_t waitforanything(resource_t res,timeout_t seconds);
result_t waitforupdate(resource_t res,timeout_t seconds);
result_t waitforinput(resource_t res,timeout_t seconds);
result_t visualgrep(resource_t res,const char* filename,timeout_t seconds);
/* inspect last events */
keysym_t getkeysym(resource_t res);
bool_t getkeydown(resource_t res);
coordinate_t getx(resource_t res);
coordinate_t gety(resource_t res);
buttons_t getbuttons(resource_t res);
const char *gettext_client(resource_t res);
const char *gettext_server(resource_t res);
/* send events to the server */
bool_t sendkey(resource_t res,keysym_t keysym,bool_t keydown);
bool_t sendascii(resource_t res,const char *string);
bool_t sendmouse(resource_t res,coordinate_t x,coordinate_t y,buttons_t buttons);
bool_t sendtext(resource_t res, const char *string);
bool_t sendtext_to_server(resource_t res, const char *string);
/* for visual grepping */
coordinate_t getxorigin(resource_t res);
coordinate_t getyorigin(resource_t res);
bool_t savepnm(resource_t res,const char* filename,coordinate_t x1, coordinate_t y1, coordinate_t x2, coordinate_t y2);
result_t displaypnm(resource_t res, const char *filename, coordinate_t x, coordinate_t y, bool_t border, timeout_t timeout);
/* this displays an overlay which is shown for a certain time */
result_t alert(resource_t res,const char* message,timeout_t timeout);
/* display a rectangular rubber band between (x0, y0) and the current
mouse pointer, as long as a button us pressed. */
result_t rubberband(resource_t res, coordinate_t x0, coordinate_t y0);
#endif
#!/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";
}
}
}
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment