diff options
Diffstat (limited to 'PerlQt')
82 files changed, 13166 insertions, 0 deletions
diff --git a/PerlQt/INSTALL b/PerlQt/INSTALL new file mode 100644 index 0000000..bd4a724 --- /dev/null +++ b/PerlQt/INSTALL @@ -0,0 +1,82 @@ +PerlQt is distributed under the GPL. Development is coordinated on the +kde-perl@mail.kde.org mailing-list. To subscribe, visit +http://mail.kde.org/mailman/listinfo/kde-perl or send a subscribe message +to kde-perl-request@mail.kde.org. Please send patches and bug reports +to the mailing-list. + +This file contains instructions for downloading and building the SmokeQt +library and PerlQt. PerlQt is not a direct Perl interface to the Qt +library, but is rather an interface to the SmokeQt library generated by +Kalyptus. + +The programs+version I use, but not necessarily required: +Linux (oddly enough, most of the developers use Mandrake) +Perl-5.6.0 or above (tested up to 5.8.0-RC1) +Qt-3.0.1 or above (untested with 3.0.0, should work though) +automake-1.5 (KDE requires recent automake) +autoconf-2.53 (KDE requires recent autoconf) + +Make sure your $QTDIR environment-variable is set. + +I'm sorry for all the requirements, but you *are* getting this from +CVS. Release versions will be much easier and more independant. + +First, you need to download the development environment for smokeqt. +Please use compression for cvs downloads ('cvs -z4' in .cvsrc). + +$ export CVSROOT=:pserver:anonymous@anoncvs.kde.org:/home/kde +$ cvs login # no password +$ cvs co -l kdebindings # downloads configure/makefile stubs +$ cvs co kdebindings/kalyptus # for generating smoke files from scratch +$ cvs co kdebindings/smoke # pre-generated smoke library +$ cd kdebindings # kdebindings/ +$ cvs co admin # get kde build tools + +At this point, you now have the full smokeqt environment. The +pre-generated smoke library is based off KDE's copy of Qt-3.0.4. I have +Qt-3.0.1, so I have to re-generate the files to match my installed +version of Qt. Here's how to do it. + +$ cd smoke/qt # kdebindings/smoke/qt/ +$ perl ./qtguess.pl # simple script to find disabled Qt features +$ perl ./generate.pl # calls kalyptus which generates code + +Now you have the SmokeQt source-code generated for your personal Qt +configuration. Here's how to compile. + +$ cd ../.. # kdebindings/ +$ make -f Makefile.cvs # create ./configure, will croak but succeed +$ ./configure # use --prefix or whatever options you want +$ cd smoke # kdebindings/smoke/ +$ make # this should succeed +$ make install # will install to --prefix from configure + +Okay, you now have libsmokeqt installed on your system. You can now +compile PerlQt. First, get the latest version of PerlQt-3. + +$ export CVSROOT=:pserver:anonymous@cvs.perlqt.sf.net:/cvsroot/perlqt +$ cvs login # no password +$ cvs co PerlQt-3 +$ cd PerlQt-3 # PerlQt-3/ + +If you installed libsmokeqt in a non-standard library path, you will +need to edit Makefile.PL and add -L/your/lib/path to the LIBS +parameter. If any of the other options in Makefile.PL need changing for +your system, you will need to change it now. + +$ perl Makefile.PL +$ make + +Now PerlQt is built on your system. To test it out: + +$ cd tutorials # PerlQt-3/tutorials/ +$ perl runall.pl + +All 14 tutorials should run in order. As you close one program out by +clicking Quit or the window close button, the next should start. If all 14 +tutorials run without error and work like the C++ version, PerlQt is built +correctly and you can make install if you wish. If an error occurs which +you can't fix, contact the kde-perl mailing list and make a bug report. + +Good luck, +Ashley Winters <qaqortog@nwlink.com> diff --git a/PerlQt/MANIFEST b/PerlQt/MANIFEST new file mode 100644 index 0000000..d52681c --- /dev/null +++ b/PerlQt/MANIFEST @@ -0,0 +1,82 @@ +INSTALL +MANIFEST +Makefile.PL.in +Qt.pm +Qt.xs +Qt.pod +bin/pqtapi +bin/pqtsh +examples/aclock/AnalogClock.pm +examples/aclock/aclock.pl +examples/buttongroups/ButtonsGroups.pm +examples/buttongroups/buttongroups.pl +examples/dclock/DigitalClock.pm +examples/dclock/dclock.pl +examples/drawdemo/drawdemo.pl +examples/drawlines/drawlines.pl +examples/forever/forever.pl +examples/network/httpd/httpd.pl +examples/opengl/README +examples/opengl/box/GLBox.pm +examples/opengl/box/glbox +examples/opengl/gear/gear +examples/progress/progress.pl +examples/richedit/imageCollection.pm +examples/richedit/richedit.pl +handlers.cpp +lib/Qt/attributes.pm +lib/Qt/debug.pm +lib/Qt/enumerations.pm +lib/Qt/isa.pm +lib/Qt/constants.pm +lib/Qt/properties.pm +lib/Qt/signals.pm +lib/Qt/slots.pm +lib/Qt/GlobalSpace.pm +marshall.h +perlqt.h +smokeperl.cpp +smokeperl.h +t/My/Codec.pm +t/My/SubCodec.pm +t/Foo/SubCodec.pm +t/a_loading.t +t/b_nogui.t +t/c_qapp.t +t/ca_i18n.t +t/d_sigslot.t +t/e_sigslot_inherit.t +t/f_import.t +t/g_gui.t +tutorials/runall.pl +tutorials/t1/t1.pl +tutorials/t10/CannonField.pm +tutorials/t10/LCDRange.pm +tutorials/t10/t10.pl +tutorials/t11/CannonField.pm +tutorials/t11/LCDRange.pm +tutorials/t11/t11.pl +tutorials/t12/CannonField.pm +tutorials/t12/LCDRange.pm +tutorials/t12/t12.pl +tutorials/t13/CannonField.pm +tutorials/t13/GameBoard.pm +tutorials/t13/LCDRange.pm +tutorials/t13/t13.pl +tutorials/t14/CannonField.pm +tutorials/t14/GameBoard.pm +tutorials/t14/LCDRange.pm +tutorials/t14/t14.pl +tutorials/t2/t2.pl +tutorials/t3/t3.pl +tutorials/t4/t4.pl +tutorials/t5/t5.pl +tutorials/t6/t6.pl +tutorials/t7/LCDRange.pm +tutorials/t7/t7.pl +tutorials/t8/CannonField.pm +tutorials/t8/LCDRange.pm +tutorials/t8/t8.pl +tutorials/t9/CannonField.pm +tutorials/t9/LCDRange.pm +tutorials/t9/t9.pl diff --git a/PerlQt/Makefile.PL.in b/PerlQt/Makefile.PL.in new file mode 100644 index 0000000..e848160 --- /dev/null +++ b/PerlQt/Makefile.PL.in @@ -0,0 +1,223 @@ + +### do not edit Makefile.PL, edit Makefile.PL.in + +use Config; +use File::Spec; +use strict; + +my %x; +$x{'prefix'} = '@prefix@'; +$x{'exec_prefix'}='@exec_prefix@'; +$x{'libdir'} = '@libdir@'; +$x{'datadir'} = '@datadir@'; +$x{'qt_libraries'} = '@qt_libraries@'; +$x{'LIBPNG'} = '@LIBPNG@'; +$x{'LIBJPEG'} = '@LIBJPEG@'; +$x{'LIBSM'} = '@LIBSM@'; +$x{'LIBSOCKET'} = '@LIBSOCKET@'; +$x{'LIBRESOLV'} = '@LIBRESOLV@'; +$x{'LIB_X11'} = '@LIB_X11@'; +$x{'X_PRE_LIBS'} = '@X_PRE_LIBS@'; + +interpolate('LIB_X11', 'exec_prefix', 'libdir', 'datadir'); + +my $objects='Qt$(OBJ_EXT) handlers$(OBJ_EXT)'; +my $qtlib ='@LIB_QT@'; + +interpolate(\$qtlib); + +my $rpath='@USE_RPATH@'; + +my $cxx = '@CXX@'; +my $sh= '@SHELL@'; +my $topdir= '@top_builddir@'; +if($^O =~ /solaris/i && $cxx eq 'CC') { + # we have Forte/Sunworkshop on Solaris + # do we build only static libs? + my $only_static = 0; + foreach(`$topdir/libtool --config 2>&1`) { + /^build_libtool_libs=no/ && $only_static++; + /^build_old_libs=yes/ && $only_static++; + } + # ...then add the C++ runtime lib + $qtlib .= ' -lCrun' if($only_static == 2); +} + +my $libtool = File::Spec->catfile( $topdir, "libtool" ); +my $devnull = File::Spec->devnull(); +my $libtool_rpath = `$libtool --mode=link $cxx -o foo.so foo.o -R $x{'libdir'} -R $x{'qt_libraries'} 2>${devnull}`; +$libtool_rpath = "" unless $libtool_rpath =~ s/.*foo.so foo.o//s; +chomp $libtool_rpath; +$rpath = $rpath eq "yes" ? + ($libtool_rpath ? + $libtool_rpath : + ('@CXX@' eq 'g++' ? + "-Wl,--rpath -Wl,$x{'libdir'} -Wl,--rpath -Wl,$x{'qt_libraries'}" : "" + ) + ) : ""; + +my @scripts = ("bin/pqtsh", "bin/pqtapi"); + +my $cxxflags = '@CXXFLAGS@'; + $cxxflags =~ s/ -pedantic / /g; + $cxxflags =~ s/ -Wwrite-strings / /g; + $cxxflags =~ s/ -Wall / /g; + +my $doc_dir_glob; + +### + +use ExtUtils::MakeMaker; +use Cwd; + +my $pwd = getcwd; +my @pwd = File::Spec->splitdir( $pwd ); +pop @pwd; +my $abs_topdir = File::Spec->catdir(@pwd); +my $localsmoke = File::Spec->catdir($abs_topdir,"smoke","qt",".libs"); + + +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. + +WriteMakefile( + 'NAME' => 'Qt', + 'VERSION_FROM' => 'Qt.pm', # finds $VERSION + 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1, + 'INC' => '@all_includes@ -I. -I../smoke', + 'LIBS' => ['@all_libraries@'." -L$localsmoke -lsmokeqt ".'@LIBCRYPT@'." $qtlib"], +# 'XS' => {'Qt.xs' => 'Qt.cpp'}, # does not work ... still expects Qt.c + 'XSOPT' => "-C++", + 'OBJECT' => "$objects", # Object files + 'CC' => '@CXX@', + # use the CC/g++ utility to link if linking is done with cc/gcc + ($Config{ld} =~ /cc/ ? ( + 'LD' => '@CXX@' + ) : ()), + 'INST_BIN' => './bin', + 'DEFINE' => $cxxflags, + 'H' => ["marshall.h", "perlqt.h", "smokeperl.h"], + 'ABSTRACT' => "An OO interface to Trolltech's Qt toolkit", + 'dynamic_lib' => {'OTHERLDFLAGS' => $rpath}, + ($] >= 5.005 ? ## Add these new keywords supported since 5.005 + ( + AUTHOR => 'Ashley Winters <qaqortog@nwlink.com>') : ()), +); + +sub MY::clean { + package MY; + my $i = shift->SUPER::clean(@_); + my $pl = '$(PERL) Makefile.PL'; + $i =~ s/\n+$/\n\t$pl$&/s; + $i; +} + +sub MY::const_loadlibs { + package MY; + my $i = shift->SUPER::const_loadlibs(@_); + # hacks for linking against a non-yet-installed smoke + $i =~ s/((?:EXTRALIBS|LDLOADLIBS).*?)\n/$1 -L$localsmoke -lsmokeqt\n/gs unless $i =~/-lsmokeqt/; + $i =~ s#(LD_RUN_PATH.*?)(${localsmoke})?\n#"$1".($2?"":":")."$x{'libdir'}\n"#se; + $i; +} + +sub MY::dist { + package MY; + my $i = shift->SUPER::dist(@_); + $i =~ s#(DISTVNAME =).*?\n#$1 \$(distdir)\n#s; + $i; +} + +sub MY::install { + package MY; + my $i = shift->SUPER::install(@_); + my $lng = $ENV{LANG}; + my $doc_dir = "/usr/share/doc/libqt-perl/tutorial"; + my $src= File::Spec->catdir(File::Spec->updir, "doc"); + my $found = 0; + # for my $l( split(":", $lng) ) + # { + # $l =~ s/^(.*?)_.*$/$1/; + # $l = lc($l); + # if( $l and -d File::Spec->catdir( $src, $l ) ) + # { + # $src = File::Spec->catdir( $src, $l); + # $found++; + # last; + # } + # } + $i =~ s/^install\s+::\s+all.*$/$& install_my_perlqt_doc/m; + # $src = File::Spec->catdir( $src, "en" ) unless $found; + $i .= "\ninstall_my_perlqt_doc:\n". + "\t\@echo Installing documentation in ${doc_dir}\n". + "\t\@$^X -MExtUtils::Install -MConfig -e \\\n". + "\t\t'install({ \"$src\" => \"\$(PREFIX)/share/doc/libqt-perl/tutorial\" },0,0)' \$(DEV_NULL)\n"; + $doc_dir_glob = $doc_dir; + $i; +} + +sub interpolate +{ + for( @_ ) + { + my $r = ref( $_ ) ? $_ : \$x{"$_"}; + $$r =~ s/\$\(\s*(.*?)\s*\)/$x{$1}/g; + $$r =~ s/\$\{\s*(.*?)\s*\}/$x{$1}/g; + } +} + +######### + +for my $s( @scripts ) +{ + MY->fixin( $s ); + chmod 0755, $s; +} + +open(IN, ">Qt.pod") or die "couldn't write Qt.pod: $!\n"; +print IN <<STOP; + +=head1 NAME + +PerlQt - Perl interface to the Qt GUI Widget toolkit + +=head1 Qt + +Given the huge size of the Qt module +(more than 400 classes and 13000 methods) +it doesn't have any formal documentation. + +Instead, it provides two introspection tools + +=over 4 + +=item * pqtapi: + +a command line PerlQt API introspector + +=item * pqtsh: + +a graphical PerlQt shell + +=back + +and a detailed B<tutorial> with comprehensive +explanations. +This is where anyone new to PerlQt +should start. + +The tutorial has been originally installed +on this system in C<$doc_dir_glob>, in both B<POD> and +B<HTML> format. + +For a complete IDE allowing RAD and visual programming, +check the pqt-designer package. + +--- The PerlQt team + +http://perlqt.sf.net - PerlQt Project Homepage + +=cut +STOP +close IN; + diff --git a/PerlQt/Qt.pm b/PerlQt/Qt.pm new file mode 100644 index 0000000..01a08e8 --- /dev/null +++ b/PerlQt/Qt.pm @@ -0,0 +1,1109 @@ +package Qt::base; +use strict; + +sub this () {} + +sub new { + no strict 'refs'; + my $t = this; + shift->NEW(@_); + my $ret = this; + Qt::_internal::setThis($t); + return $ret; +} + +package Qt::base::_overload; +use strict; + +no strict 'refs'; +use overload + "fallback" => 1, + "==" => "Qt::base::_overload::op_equal", + "!=" => "Qt::base::_overload::op_not_equal", + "+=" => "Qt::base::_overload::op_plus_equal", + "-=" => "Qt::base::_overload::op_minus_equal", + "*=" => "Qt::base::_overload::op_mul_equal", + "/=" => "Qt::base::_overload::op_div_equal", + ">>" => "Qt::base::_overload::op_shift_right", + "<<" => "Qt::base::_overload::op_shift_left", + "<=" => "Qt::base::_overload::op_lesser_equal", + ">=" => "Qt::base::_overload::op_greater_equal", + "^=" => "Qt::base::_overload::op_xor_equal", + "|=" => "Qt::base::_overload::op_or_equal", + ">" => "Qt::base::_overload::op_greater", + "<" => "Qt::base::_overload::op_lesser", + "+" => "Qt::base::_overload::op_plus", + "-" => "Qt::base::_overload::op_minus", + "*" => "Qt::base::_overload::op_mul", + "/" => "Qt::base::_overload::op_div", + "^" => "Qt::base::_overload::op_xor", + "|" => "Qt::base::_overload::op_or", + "--" => "Qt::base::_overload::op_decrement", + "++" => "Qt::base::_overload::op_increment", + "neg"=> "Qt::base::_overload::op_negate"; + +sub op_equal { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator=='; + my $autoload = ref($_[0])."::_UTOLOAD"; + my ($ret, $err); + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + $Qt::_internal::strictArgMatch = 0; + return $ret unless $err = $@; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator=='; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + die $err.$@ if $@; + $ret +} + +sub op_not_equal { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator!='; + my $autoload = ref($_[0])."::_UTOLOAD"; + my ($ret, $err); + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + $Qt::_internal::strictArgMatch = 0; + return $ret unless $err = $@; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator!='; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + die $err.$@ if $@; + $ret +} + +sub op_plus_equal { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator+='; + my $autoload = ref($_[0])."::_UTOLOAD"; + my $err; + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + $Qt::_internal::strictArgMatch = 0; + return ($_[2] ? $_[1] : $_[0]) unless $err = $@; + my $ret; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator+='; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + die $err.$@ if $@; + $ret +} + +sub op_minus_equal { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator-='; + my $autoload = ref($_[0])."::_UTOLOAD"; + my $err; + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + $Qt::_internal::strictArgMatch = 0; + return ($_[2] ? $_[1] : $_[0]) unless $err = $@; + my $ret; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator-='; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + die $err.$@ if $@; + $ret +} + +sub op_mul_equal { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator*='; + my $autoload = ref($_[0])."::_UTOLOAD"; + my $err; + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + $Qt::_internal::strictArgMatch = 0; + return ($_[2] ? $_[1] : $_[0]) unless $err = $@; + my $ret; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator*='; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + die $err.$@ if $@; + $ret +} + +sub op_div_equal { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator/='; + my $autoload = ref($_[0])."::_UTOLOAD"; + my $err; + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + $Qt::_internal::strictArgMatch = 0; + return ($_[2] ? $_[1] : $_[0]) unless $err = $@; + my $ret; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator/='; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + die $err.$@ if $@; + $ret +} + +sub op_shift_right { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator>>'; + my $autoload = ref($_[0])."::_UTOLOAD"; + my ($ret, $err); + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + $Qt::_internal::strictArgMatch = 0; + return $ret unless $err = $@; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator>>'; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + die $err.$@ if $@; + $ret +} + +sub op_shift_left { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator<<'; + my $autoload = ref($_[0])."::_UTOLOAD"; + my ($ret, $err); + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + $Qt::_internal::strictArgMatch = 0; + return $ret unless $err = $@; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator<<'; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + die $err.$@ if $@; + $ret +} + +sub op_lesser_equal { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator<='; + my $autoload = ref($_[0])."::_UTOLOAD"; + my $err; + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + return ($_[2] ? $_[1] : $_[0]) unless $err = $@; + $Qt::_internal::strictArgMatch = 0; + my $ret; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator<='; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + die $err.$@ if $@; + $ret +} + +sub op_greater_equal { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator>='; + my $autoload = ref($_[0])."::_UTOLOAD"; + my $err; + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + $Qt::_internal::strictArgMatch = 0; + return ($_[2] ? $_[1] : $_[0]) unless $err = $@; + my $ret; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator>='; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + die $err.$@ if $@; + $ret +} + +sub op_xor_equal { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator^='; + my $autoload = ref($_[0])."::_UTOLOAD"; + my $err; + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + $Qt::_internal::strictArgMatch = 0; + return ($_[2] ? $_[1] : $_[0]) unless $err = $@; + my $ret; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator^='; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + die $err.$@ if $@; + $ret +} + +sub op_or_equal { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator|='; + my $autoload = ref($_[0])."::_UTOLOAD"; + my $err; + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + $Qt::_internal::strictArgMatch = 0; + return ($_[2] ? $_[1] : $_[0]) unless $err = $@; + my $ret; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator|='; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + die $err.$@ if $@; + $ret +} + +sub op_greater { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator>'; + my $autoload = ref($_[0])."::_UTOLOAD"; + my ($ret, $err); + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + $Qt::_internal::strictArgMatch = 0; + return $ret unless $err = $@; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator>'; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + die $err.$@ if $@; + $ret +} + +sub op_lesser { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator<'; + my $autoload = ref($_[0])."::_UTOLOAD"; + my ($ret, $err); + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + $Qt::_internal::strictArgMatch = 0; + return $ret unless $err = $@; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator<'; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + die $err.$@ if $@; + $ret +} + +sub op_plus { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator+'; + my $autoload = ref($_[0])."::_UTOLOAD"; + my ($ret, $err); + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + $Qt::_internal::strictArgMatch = 0; + return $ret unless $err = $@; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator+'; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + die $err.$@ if $@; + $ret +} + +sub op_minus { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator-'; + my $autoload = ref($_[0])."::_UTOLOAD"; + my ($ret, $err); + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + $Qt::_internal::strictArgMatch = 0; + return $ret unless $err = $@; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator-'; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + die $err.$@ if $@; + $ret +} + +sub op_mul { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator*'; + my $autoload = ref($_[0])."::_UTOLOAD"; + my ($ret, $err); + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + $Qt::_internal::strictArgMatch = 0; + return $ret unless $err = $@; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator*'; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + die $err.$@ if $@; + $ret +} + +sub op_div { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator/'; + my $autoload = ref($_[0])."::_UTOLOAD"; + my ($ret, $err); + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + $Qt::_internal::strictArgMatch = 0; + return $ret unless $err = $@; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator/'; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + die $err.$@ if $@; + $ret +} + +sub op_negate { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator-'; + my $autoload = ref($_[0])."::AUTOLOAD"; + my ($ret, $err); + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $ret = $autoload->($_[0]) }; + $Qt::_internal::strictArgMatch = 0; + return $ret unless $err = $@; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator-'; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; $ret = &$autoload($_[0]) }; + die $err.$@ if $@; + $ret +} + +sub op_xor { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator^'; + my $autoload = ref($_[0])."::_UTOLOAD"; + my ($ret, $err); + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + $Qt::_internal::strictArgMatch = 0; + return $ret unless $err = $@; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator^'; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + die $err.$@ if $@; + $ret +} + +sub op_or { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator|'; + my $autoload = ref($_[0])."::_UTOLOAD"; + my ($ret, $err); + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + $Qt::_internal::strictArgMatch = 0; + return $ret unless $err = $@; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator|'; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; + die $err.$@ if $@; + $ret +} + +sub op_increment { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator++'; + my $autoload = ref($_[0])."::_UTOLOAD"; + my $err; + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $autoload->($_[0]) }; + $Qt::_internal::strictArgMatch = 0; + return $_[0] unless $err = $@; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator++'; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; &$autoload($_[0]) }; + die $err.$@ if $@; + $_[0] +} + +sub op_decrement { + $Qt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator--'; + my $autoload = ref($_[0])."::_UTOLOAD"; + my $err; + $Qt::_internal::strictArgMatch = 1; + eval { local $SIG{'__DIE__'}; $autoload->($_[0]) }; + $Qt::_internal::strictArgMatch = 0; + return $_[0] unless $err = $@; + $Qt::AutoLoad::AUTOLOAD = 'Qt::GlobalSpace::operator--'; + $autoload = "Qt::GlobalSpace::_UTOLOAD"; + eval { local $SIG{'__DIE__'}; &$autoload($_[0]) }; + die $err.$@ if $@; + $_[0] +} + +package Qt::_internal; + +use strict; + +our $Classes; +our %CppName; +our @IdClass; + +our @PersistentObjects; # objects which need a "permanent" reference in Perl +our @sigslots; +our $strictArgMatch = 0; + +sub this () {} + + +sub init_class { + no strict 'refs'; + my $c = shift; + my $class = $c; + $class =~ s/^Q(?=[A-Z])/Qt::/; + my $classId = Qt::_internal::idClass($c); + insert_pclassid($class, $classId); + + $IdClass[$classId] = $class; + $CppName{$class} = $c; + Qt::_internal::installautoload("$class"); + { + package Qt::AutoLoad; # this package holds $AUTOLOAD + my $closure = \&{ "$class\::_UTOLOAD" }; + *{ $class . "::AUTOLOAD" } = sub{ &$closure }; + } + + my @isa = Qt::_internal::getIsa($classId); + for my $super (@isa) { + $super =~ s/^Q(?=[A-Z])/Qt::/; + } + # the general base class is Qt::base. + # implicit new(@_) calls are forwarded there. + @isa = ("Qt::base") unless @isa; + *{ "$class\::ISA" } = \@isa; + + Qt::_internal::installautoload(" $class"); + { + package Qt::AutoLoad; + # do lookup at compile-time + my $autosub = \&{ " $class\::_UTOLOAD" }; + *{ " $class\::AUTOLOAD" } = sub { &$autosub }; + } + + *{ " $class\::ISA" } = ["Qt::base::_overload"]; + + *{ "$class\::NEW" } = sub { + my $class = shift; + $Qt::AutoLoad::AUTOLOAD = "$class\::$c"; + my $autoload = " $class\::_UTOLOAD"; + { + no warnings; + # the next line triggers a warning on SuSE's Perl 5.6.1 (?) + setThis(bless &$autoload, " $class"); + } + setAllocated(this, 1); + mapObject(this); + } unless defined &{"$class\::NEW"}; + + *{ $class } = sub { + $class->new(@_); + } unless defined &{ $class }; +} + +sub argmatch { + my $methods = shift; + my $args = shift; + my $i = shift; + my %match; + my $argtype = getSVt($args->[$i]); + for my $methix(0..$#$methods) { + my $method = $$methods[$methix]; + my $typename = getTypeNameOfArg($method, $i); + if($argtype eq 'i') { + if($typename =~ /^(?:bool|(?:(?:un)?signed )?(?:int|long)|uint)[*&]?$/) { + $match{$method} = [0,$methix]; + } + } elsif($argtype eq 'n') { + if($typename =~ /^(?:float|double)$/) { + $match{$method} = [0,$methix]; + } + } elsif($argtype eq 's') { + if($typename =~ /^(?:(?:const )?u?char\*|(?:const )?(?:(Q(C?)String)|QByteArray)[*&]?)$/) { + # the below read as: is it a (Q(C)String) ? ->priority 1 + # is it a (QString) ? -> priority 2 + # neither: normal priority + # Watch the capturing parens vs. non-capturing (?:) + $match{$method}[0] = defined $2 && $2 ? 1 : ( defined $1 ? 2 : 0 ); + $match{$method}[1] = $methix + } + } elsif($argtype eq 'a') { + # FIXME: shouldn't be hardcoded. Installed handlers should tell what perl type they expect. + if($typename =~ /^(?: + const\ QCOORD\*| + (?:const\ )? + (?: + Q(?:String|Widget|Object|FileInfo|CanvasItem)List[\*&]?| + QValueList<int>[\*&]?| + QPtrList<Q(?:Tab|ToolBar|DockWindow|NetworkOperation)>| + QRgb\*| + char\*\* + ) + )$/x) { + $match{$method} = [0,$methix]; + } + } elsif($argtype eq 'r' or $argtype eq 'U') { + $match{$method} = [0,$methix]; + } else { + my $t = $typename; + $t =~ s/^const\s+//; + $t =~ s/(?<=\w)[&*]$//; + my $isa = classIsa($argtype, $t); + if($isa != -1) { + $match{$method} = [-$isa,$methix]; + } + } + } + return sort { $match{$b}[0] <=> $match{$a}[0] or $match{$a}[1] <=> $match{$b}[1] } keys %match; +} + +sub objmatch { + my $method = shift; + my $args = shift; + for my $i(0..$#$args) { + my $argtype = getSVt($$args[$i]); + my $t = getTypeNameOfArg($method, $i); + next if length $argtype == 1; + $t =~ s/^const\s+//; + $t =~ s/(?<=\w)[&*]$//; + return 0 unless classIsa($argtype, $t) != -1; + } + 1; +} + +sub do_autoload { + my $package = pop; + my $method = pop; + my $classId = pop; + + my $class = $CppName{$IdClass[$classId]}; + my @methods = ($method); + for my $arg (@_) { + unless(defined $arg) { + @methods = map { $_ . '?', $_ . '#', $_ . '$' } @methods; + } elsif(isObject($arg)) { + @methods = map { $_ . '#' } @methods; + } elsif(ref $arg) { + @methods = map { $_ . '?' } @methods; + } else { + @methods = map { $_ . '$' } @methods; + } + } + my @methodids = map { findMethod($class, $_) } @methods; +# @methodids = map { findMethod('QGlobalSpace', $_) } @methods +# if (!@methodids and $withObject || $class eq 'Qt'); + + if(@methodids > 1) { + # ghetto method resolution + my $count = scalar @_; + for my $i (0..$count-1) { + my @matching = argmatch(\@methodids, \@_, $i); + @methodids = @matching if @matching or $strictArgMatch; + } + do { + my $c = ($method eq $class)? 4:2; + warn "Ambiguous method call for :\n". + "\t${class}::${method}(".catArguments(\@_).")". + ((debug() && (debug() & $Qt::debug::channel{'verbose'})) ? + "\nCandidates are:\n".dumpCandidates(\@methodids). + "\nTaking first one...\nat " : ""). + (caller($c))[1]." line ".(caller($c))[2].".\n" + } if debug() && @methodids > 1 && (debug() & $Qt::debug::channel{'ambiguous'}); + + } + elsif( @methodids == 1 and @_ ) { + @methodids = () unless objmatch($methodids[0], \@_) + } + unless(@methodids) { + if(@_) { + @methodids = findMethod($class, $method); + do { + do { + my $c = ($method eq $class)? 4:2; + warn "Lookup for ${class}::${method}(".catArguments(\@_). + ")\ndid not yeld any result.\n". + ((debug() && (debug() & $Qt::debug::channel{'verbose'})) ? + "Might be a call for an enumerated value (enum).\n":""). + "Trying ${class}::${method}() with no arguments\nat ". + (caller($c))[1]." line ".(caller($c))[2].".\n" + } if debug() && @_ > 1 && (debug() & $Qt::debug::channel{'ambiguous'}); + @_ = () + } if @methodids; + } + do{ + my $verbose = ""; + if(debug() && (debug() & $Qt::debug::channel{'verbose'})) { + my $alt = findAllMethods( $classId ); + getAllParents($classId, \my @sup); + for my $s(@sup) + { + my $h = findAllMethods( $s ); + map { $alt->{$_} = $h->{$_} } keys %$h + } + my $pat1 = my $pat2 = $method; + my @near = (); + while(!@near && length($pat1)>2) { + @near = map { /$pat1|$pat2/i ? @{ $$alt{$_} }:() } sort keys %$alt; + chop $pat1; + substr($pat2,-1,1)= ""; + } + $verbose = @near ? ("\nCloser candidates are :\n".dumpCandidates(\@near)) : + "\nNo close candidate found.\n"; + } + my $c = ($method eq $class)? 4:2; + + die "--- No method to call for :\n\t${class}::${method}(". + catArguments(\@_).")".$verbose."\nat ".(caller($c))[1]. + " line ".(caller($c))[2].".\n"; + } unless @methodids; + } + setCurrentMethod($methodids[0]); + return 1; +} + +sub init { + no warnings; + installthis(__PACKAGE__); + installthis("Qt::base"); + $Classes = getClassList(); + for my $c (@$Classes) { + init_class($c); + } +} + +sub splitUnnested { + my $string = shift; + my(%open) = ( + '[' => ']', + '(' => ')', + '<' => '>', + '{' => '}', + ); + my(%close) = reverse %open; + my @ret; + my $depth = 0; + my $start = 0; + $string =~ tr/"'//; + while($string =~ /([][}{)(><,])/g) { + my $c = $1; + if(!$depth and $c eq ',') { + my $len = pos($string) - $start - 1; + my $ret = substr($string, $start, $len); + $ret =~ s/^\s*(.*?)\s*$/$1/; + push @ret, $ret; + $start = pos($string); + } elsif($open{$c}) { + $depth++; + } elsif($close{$c}) { + $depth--; + } + } + my $subs = substr($string, $start); + $subs =~ s/^\s*(.*?)\s*$/$1/; + push @ret, $subs if ($subs); + return @ret; +} + +sub getSubName +{ + my $glob = getGV( shift ); + return ( $glob =~ /^.*::(.*)$/ )[0]; +} + +sub Qt::Application::NEW { + my $class = shift; + my $argv = shift; + unshift @$argv, $0; + my $count = scalar @$argv; + setThis( bless Qt::Application::QApplication($count, $argv, @_), " $class" ); + mapObject(this); + setAllocated(this, 1); + setqapp(this); + shift @$argv; +} + +sub Qt::Image::NEW { + no strict 'refs'; + # another ugly hack, whee + my $class = shift; + if(@_ == 6) { + my $colortable = $_[4]; + my $numColors = (ref $colortable eq 'ARRAY') ? @$colortable : 0; + splice(@_, 5, 0, $numColors); + } + + # FIXME: this is evil + $Qt::AutoLoad::AUTOLOAD = 'Qt::Image::QImage'; + my $autoload = " Qt::Image::_UTOLOAD"; + dontRecurse(); + setThis( $autoload->(@_) ); + setAllocated(this, 1); +} + +sub makeMetaData { + my $data = shift; + my @tbl; + for my $entry (@$data) { + my @params; + my $argcnt = scalar @{ $entry->{arguments} }; + for my $arg (@{ $entry->{arguments} }) { + push @params, make_QUParameter($arg->{name}, $arg->{type}, 0, 1); + } + my $method = make_QUMethod($entry->{name}, \@params); + push @tbl, make_QMetaData($entry->{prototype}, $method); + } + my $count = scalar @tbl; + my $metadata = make_QMetaData_tbl(\@tbl); + return ($metadata, $count); +} + +# This is the key function for signal/slots... +# All META hash entries have been defined by /lib/Qt/slots.pm and /lib/Qt/signals.pm +# Thereafter, /lib/Qt/isa.pm build the MetaObject by calling this function +# Here is the structure of the META hash: +# META { 'slot' => { $slotname-1 => { name => $slotname-1, +# arguments => xxx, +# prototype => xxx, +# returns => xxx, +# method => xxx, +# index => <index in 'slots' array>, +# mocargs => xxx, +# argcnt => xxx }, +# ... , +# $slotname-n => ... +# }, +# 'slots' => [ slot1-hash, slot2-hash...slot-n-hash ], +# 'signal' => ibidem, +# 'signals' => ibidem, +# 'superClass' => ["classname1", .."classname-n"] # inherited +# } + +sub getMetaObject { + no strict 'refs'; + my $class = shift; + my $meta = \%{ $class . '::META' }; + return $meta->{object} if $meta->{object} and !$meta->{changed}; + updateSigSlots() if( @sigslots ); + inheritSuperSigSlots($class); + my($slot_tbl, $slot_tbl_count) = makeMetaData($meta->{slots}); + my($signal_tbl, $signal_tbl_count) = makeMetaData($meta->{signals}); + $meta->{object} = make_metaObject($class, Qt::this()->staticMetaObject, + $slot_tbl, $slot_tbl_count, + $signal_tbl, $signal_tbl_count); + $meta->{changed} = 0; + return $meta->{object}; +} + +sub updateSigSlots +{ + require Qt::signals; + require Qt::slots; + for my $i (@sigslots) { + no strict 'refs'; + my $mod = "Qt::" . lc($$i[0]) . ( substr($$i[0], 0, 1) eq 'S' ? 's' : '' ) . "::import"; + $mod->( $$i[1], getSubName($$i[2]) => $$i[3] ); + } + @sigslots = (); +} + +sub inheritSuperSigSlots { + no strict 'refs'; + my $class = shift; + my $meta = \%{ $class . '::META' }; + if(defined $meta->{'superClass'} && @{ $meta->{'superClass'} }) { + for my $super(@{$meta->{'superClass'}}) { + inheritSuperSigSlots($super); + for my $ssn(keys %{${$super.'::META'}{slot}}) { + if(!exists $meta->{slot}->{"$ssn"}) { + my %ss = %{${$super.'::META'}{slot}{$ssn}}; + push @{$meta->{slots}}, \%ss; + $meta->{slot}->{$ssn} = \%ss; + $ss{index} = $#{ $meta->{slots} }; + } + } + for my $ssn(keys %{${$super.'::META'}{signal}}) { + if(!exists $meta->{signal}->{"$ssn"}) { + my %ss = %{${$super.'::META'}{signal}{$ssn}}; + push @{$meta->{signals}}, \%ss; + $meta->{signal}->{$ssn} = \%ss; + $ss{index} = $#{ $meta->{signals} }; + Qt::_internal::installsignal("$class\::$ssn"); + } + } + Qt::_internal::installqt_invoke($class . '::qt_invoke') + if( !defined &{ $class. '::qt_invoke' } && exists $meta->{slots} && @{ $meta->{slots} }); + Qt::_internal::installqt_invoke($class . '::qt_emit') + if( !defined &{ $class. '::qt_emit' } && exists $meta->{signals} && @{ $meta->{signals} }); + } + } +} + +sub getAllParents +{ + my $classId = shift; + my $res = shift; + my @classes = Qt::_internal::getIsa( $classId ); + for my $s( @classes ) + { + my $c = Qt::_internal::idClass($s); + push @{ $res }, $c; + getAllParents($c, $res) + } +} + +sub Qt::PointArray::setPoints { + my $points = $_[0]; + no strict 'refs'; + # what a horrible, horrible way to do this + $Qt::AutoLoad::AUTOLOAD = 'Qt::PointArray::setPoints'; + my $autoload = " Qt::PointArray::_UTOLOAD"; + dontRecurse(); + $autoload->(scalar(@$points)/2, $points); +} + +sub Qt::GridLayout::addMultiCellLayout { + # yet another hack. Turnaround for a bug in Qt < 3.1 + # (addMultiCellLayout doesn't reparent its QLayout argument) + no strict 'refs'; + if(!defined $_[0]->{'has been hidden'}) + { + push @{ this()->{'hidden children'} }, $_[0]; + $_[0]->{'has been hidden'} = 1; + } + $Qt::AutoLoad::AUTOLOAD = 'Qt::GridLayout::addMultiCellLayout'; + my $autoload = " Qt::GridLayout::_UTOLOAD"; + dontRecurse(); + $autoload->(@_); +} + +package Qt::Object; +use strict; + +sub MODIFY_CODE_ATTRIBUTES +{ + package Qt::_internal; + my ($package, $coderef, @attrs ) = @_; + my @reject; + foreach my $attr( @attrs ) + { + if( $attr !~ /^ (SIGNAL|SLOT|DCOP) \(( .* )\) $/x ) + { + push @reject, $attr; + next; + } + push @sigslots, + [ $1, $package, $coderef, [ splitUnnested( $2 ) ] ]; + } + if( @sigslots ) + { + no strict 'refs'; + my $meta = \%{ $package . '::META' }; + $meta->{ 'changed' } = 1; + } + return @reject; +} + +package Qt; + +use 5.006; +use strict; +use warnings; +use XSLoader; + +require Exporter; + +our $VERSION = '3.008'; + +our @EXPORT = qw(&SIGNAL &SLOT &CAST &emit &min &max); + +XSLoader::load 'Qt', $VERSION; + +# try to avoid KDE's buggy malloc +# only works for --enable-fast-malloc, +# not when --enable-fast-malloc=full +$ENV{'KDE_MALLOC'} = 0; + +Qt::_internal::init(); + +# In general, I'm not a fan of prototypes. +# However, I'm also not a fan of parentheses + +sub SIGNAL ($) { '2' . $_[0] } +sub SLOT ($) { '1' . $_[0] } +sub CAST ($$) { bless $_[0], " $_[1]" } +sub emit (@) { pop @_ } +sub min ($$) { $_[0] < $_[1] ? $_[0] : $_[1] } +sub max ($$) { $_[0] > $_[1] ? $_[0] : $_[1] } + +sub import { goto &Exporter::import } + +sub Qt::base::ON_DESTROY { 0 }; + +sub Qt::Object::ON_DESTROY +{ + package Qt::_internal; + my $parent = this()->parent; + if( $parent ) + { + ${ $parent->{"hidden children"} } { sv_to_ptr(this()) } = this(); + this()->{"has been hidden"} = 1; + return 1 + } + return 0 +} + +sub Qt::Application::ON_DESTROY { 0 } + +# we need to solve an ambiguity for Q*Items: they aren't QObjects, +# and are meant to be created on the heap / destroyed manually. +# On the one hand, we don't want to delete them if they are still owned by a QObject hierarchy +# but on the other hand, what can we do if the user DOES need to destroy them? +# +# So the solution adopted here is to use the takeItem() method when it exists +# to lower the refcount and allow explicit destruction/removal. + +sub Qt::ListViewItem::ON_DESTROY { + package Qt::_internal; + my $parent = this()->listView(); + if( $parent ) + { + ${ $parent->{"hidden children"} } { sv_to_ptr(this) } = this(); + this()->{"has been hidden"} = 1; + setAllocated( this(), 0 ); + return 1 + } + setAllocated( this(), 1 ); + return 0 +} + +sub Qt::ListViewItem::takeItem +{ + package Qt::_internal; + delete ${ this()->{"hidden children"} } { sv_to_ptr($_[0]) }; + delete $_[0]->{"has been hidden"}; + setAllocated( $_[0], 1 ); + no strict 'refs'; + $Qt::AutoLoad::AUTOLOAD = 'Qt::ListViewItem::takeItem'; + my $autoload = " Qt::ListViewItem::_UTOLOAD"; + dontRecurse(); + $autoload->( $_[0] ); +} + +sub Qt::ListView::takeItem +{ + package Qt::_internal; + delete ${ this()->{"hidden children"} } { sv_to_ptr($_[0]) }; + delete $_[0]->{"has been hidden"}; + setAllocated( $_[0], 1 ); + no strict 'refs'; + $Qt::AutoLoad::AUTOLOAD = 'Qt::ListView::takeItem'; + my $autoload = " Qt::ListView::_UTOLOAD"; + dontRecurse(); + $autoload->( $_[0] ); +} + +sub Qt::IconViewItem::ON_DESTROY +{ + package Qt::_internal; + my $parent = this()->iconView; + if( $parent ) + { + ${ $parent->{"hidden children"} } { sv_to_ptr(this()) } = this(); + this()->{"has been hidden"} = 1; + setAllocated( this(), 0 ); + return 1 + } + setAllocated( this(), 1 ); + return 0 +} + +sub Qt::IconView::takeItem +{ + package Qt::_internal; + delete ${ this()->{"hidden children"} } { sv_to_ptr($_[0]) }; + delete $_[0]->{"has been hidden"}; + setAllocated( $_[0], 1 ); + no strict 'refs'; + $Qt::AutoLoad::AUTOLOAD = 'Qt::IconView::takeItem'; + my $autoload = " Qt::IconView::_UTOLOAD"; + Qt::_internal::dontRecurse(); + $autoload->( $_[0] ); +} + + +sub Qt::ListBoxItem::ON_DESTROY +{ + package Qt::_internal; + my $parent = this()->listBox(); + if( $parent ) + { + ${ $parent->{"hidden children"} } { sv_to_ptr(this()) } = this(); + this()->{"has been hidden"} = 1; + setAllocated( this(), 0 ); + return 1 + } + setAllocated( this(), 1 ); + return 0 +} + +sub Qt::ListBox::takeItem +{ + # Unfortunately, takeItem() won't reset the Item's listBox() pointer to 0. + # That's a Qt bug (I reported it and it got fixed as of Qt 3.2b2) + package Qt::_internal; + delete ${ this()->{"hidden children"} } { sv_to_ptr($_[0]) }; + delete $_[0]->{"has been hidden"}; + setAllocated( $_[0], 1 ); + no strict 'refs'; + $Qt::Autoload::AUTOLOAD = 'Qt::ListBox::takeItem'; + my $autoload = " Qt::ListBox::_UTOLOAD"; + dontRecurse(); + $autoload->( $_[0] ); +} + +sub Qt::TableItem::ON_DESTROY +{ + package Qt::_internal; + my $parent = this()->table; + if( $parent ) + { + ${ $parent->{"hidden children"} } { sv_to_ptr(this()) } = this(); + this()->{"has been hidden"} = 1; + setAllocated( this(), 0 ); + return 1 + } + setAllocated( this(), 1 ); + return 0 +} + +sub Qt::Table::takeItem +{ + package Qt::_internal; + delete ${ this()->{"hidden children"} } { sv_to_ptr($_[0]) }; + delete $_[0]->{"has been hidden"}; + setAllocated( $_[0], 1 ); + no strict 'refs'; + $Qt::AutoLoad::AUTOLOAD = 'Qt::Table::takeItem'; + my $autoload = " Qt::Table::_UTOLOAD"; + dontRecurse(); + $autoload->( $_[0] ); +} + +sub Qt::LayoutItem::ON_DESTROY +{ + package Qt::_internal; + my $parent = this()->widget() || this()->layout(); + if( $parent ) + { + ${ $parent->{"hidden children"} } { sv_to_ptr(this()) } = this(); + } + else # a SpacerItem... + { + push @PersistentObjects, this(); + } + this()->{"has been hidden"} = 1; + setAllocated( this(), 0 ); + return 1 +} + +sub Qt::Layout::ON_DESTROY +{ + package Qt::_internal; + my $parent = this()->mainWidget() || this()->parent(); + if( $parent ) + { + ${ $parent->{"hidden children"} } { sv_to_ptr(this()) } = this(); + this()->{"has been hidden"} = 1; + return 1 + } + return 0 +} + +sub Qt::StyleSheetItem::ON_DESTROY +{ + package Qt::_internal; + my $parent = this()->styleSheet(); + if( $parent ) + { + ${ $parent->{"hidden children"} } { sv_to_ptr(this()) } = this(); + this()->{"has been hidden"} = 1; + setAllocated( this(), 0 ); + return 1 + } + setAllocated( this(), 1 ); + return 0 +} + +sub Qt::SqlCursor::ON_DESTROY +{ + package Qt::_internal; + push @PersistentObjects, this(); + this()->{"has been hidden"} = 1; + setAllocated( this(), 0 ); + return 1 +} + +1; diff --git a/PerlQt/Qt.pod b/PerlQt/Qt.pod new file mode 100644 index 0000000..94503ba --- /dev/null +++ b/PerlQt/Qt.pod @@ -0,0 +1,42 @@ + +=head1 NAME + +PerlQt - Perl interface to the Qt GUI Widget toolkit + +=head1 Qt + +Given the huge size of the Qt module +(more than 400 classes and 13000 methods) +it doesn't have any formal documentation. + +Instead, it provides two introspection tools + +=over 4 + +=item * pqtapi: + +a command line PerlQt API introspector + +=item * pqtsh: + +a graphical PerlQt shell + +=back + +and a detailed B<tutorial> with comprehensive +explanations. +This is where anyone new to PerlQt +should start. + +The tutorial has been originally installed +on this system in C</usr/share/doc/libqt-perl/tutorial>, in both B<POD> and +B<HTML> format. + +For a complete IDE allowing RAD and visual programming, +check the pqt-designer package. + +--- The PerlQt team + +http://perlqt.sf.net - PerlQt Project Homepage + +=cut diff --git a/PerlQt/Qt.xs b/PerlQt/Qt.xs new file mode 100644 index 0000000..e72bffd --- /dev/null +++ b/PerlQt/Qt.xs @@ -0,0 +1,2198 @@ +#include <stdio.h> +#include <qglobal.h> +#include <qstring.h> +#include <qapplication.h> +#include <qmetaobject.h> +#include <private/qucomextra_p.h> +#include "smoke.h" + +#undef DEBUG +#ifndef _GNU_SOURCE +#define _GNU_SOURCE +#endif +#ifndef __USE_POSIX +#define __USE_POSIX +#endif +#ifndef __USE_XOPEN +#define __USE_XOPEN +#endif +#ifdef _BOOL +#define HAS_BOOL +#endif +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#ifndef QT_VERSION_STR +#define QT_VERSION_STR "Unknown" +#endif + +#undef free +#undef malloc + +#include "marshall.h" +#include "perlqt.h" +#include "smokeperl.h" + +#ifndef IN_BYTES +#define IN_BYTES IN_BYTE +#endif + +#ifndef IN_LOCALE +#define IN_LOCALE (PL_curcop->op_private & HINT_LOCALE) +#endif + +extern Smoke *qt_Smoke; +extern void init_qt_Smoke(); + +int do_debug = qtdb_none; + +HV *pointer_map = 0; +SV *sv_qapp = 0; +int object_count = 0; +void *_current_object = 0; // TODO: ask myself if this is stupid + +bool temporary_virtual_function_success = false; + +static QAsciiDict<Smoke::Index> *methcache = 0; +static QAsciiDict<Smoke::Index> *classcache = 0; + +SV *sv_this = 0; + +Smoke::Index _current_object_class = 0; +Smoke::Index _current_method = 0; +/* + * Type handling by moc is simple. + * + * If the type name matches /^(?:const\s+)?\Q$types\E&?$/, use the + * static_QUType, where $types is join('|', qw(bool int double char* QString); + * + * Everything else is passed as a pointer! There are types which aren't + * Smoke::tf_ptr but will have to be passed as a pointer. Make sure to keep + * track of what's what. + */ + +/* + * Simply using typeids isn't enough for signals/slots. It will be possible + * to declare signals and slots which use arguments which can't all be + * found in a single smoke object. Instead, we need to store smoke => typeid + * pairs. We also need additional informatation, such as whether we're passing + * a pointer to the union element. + */ + +enum MocArgumentType { + xmoc_ptr, + xmoc_bool, + xmoc_int, + xmoc_double, + xmoc_charstar, + xmoc_QString +}; + +struct MocArgument { + // smoke object and associated typeid + SmokeType st; + MocArgumentType argType; +}; + + +extern TypeHandler Qt_handlers[]; +void install_handlers(TypeHandler *); + +void *sv_to_ptr(SV *sv) { // ptr on success, null on fail + smokeperl_object *o = sv_obj_info(sv); + return o ? o->ptr : 0; +} + +bool isQObject(Smoke *smoke, Smoke::Index classId) { + if(!strcmp(smoke->classes[classId].className, "QObject")) + return true; + for(Smoke::Index *p = smoke->inheritanceList + smoke->classes[classId].parents; + *p; + p++) { + if(isQObject(smoke, *p)) + return true; + } + return false; +} + +int isDerivedFrom(Smoke *smoke, Smoke::Index classId, Smoke::Index baseId, int cnt) { + if(classId == baseId) + return cnt; + cnt++; + for(Smoke::Index *p = smoke->inheritanceList + smoke->classes[classId].parents; + *p; + p++) { + if(isDerivedFrom(smoke, *p, baseId, cnt) != -1) + return cnt; + } + return -1; +} + +int isDerivedFrom(Smoke *smoke, const char *className, const char *baseClassName, int cnt) { + if(!smoke || !className || !baseClassName) + return -1; + Smoke::Index idClass = smoke->idClass(className); + Smoke::Index idBase = smoke->idClass(baseClassName); + return isDerivedFrom(smoke, idClass, idBase, cnt); +} + +SV *getPointerObject(void *ptr) { + HV *hv = pointer_map; + SV *keysv = newSViv((IV)ptr); + STRLEN len; + char *key = SvPV(keysv, len); + SV **svp = hv_fetch(hv, key, len, 0); + if(!svp){ + SvREFCNT_dec(keysv); + return 0; + } + if(!SvOK(*svp)){ + hv_delete(hv, key, len, G_DISCARD); + SvREFCNT_dec(keysv); + return 0; + } + return *svp; +} + +void unmapPointer(smokeperl_object *o, Smoke::Index classId, void *lastptr) { + HV *hv = pointer_map; + void *ptr = o->smoke->cast(o->ptr, o->classId, classId); + if(ptr != lastptr) { + lastptr = ptr; + SV *keysv = newSViv((IV)ptr); + STRLEN len; + char *key = SvPV(keysv, len); + if(hv_exists(hv, key, len)) + hv_delete(hv, key, len, G_DISCARD); + SvREFCNT_dec(keysv); + } + for(Smoke::Index *i = o->smoke->inheritanceList + o->smoke->classes[classId].parents; + *i; + i++) { + unmapPointer(o, *i, lastptr); + } +} + +// Store pointer in pointer_map hash : "pointer_to_Qt_object" => weak ref to associated Perl object +// Recurse to store it also as casted to its parent classes. + +void mapPointer(SV *obj, smokeperl_object *o, HV *hv, Smoke::Index classId, void *lastptr) { + void *ptr = o->smoke->cast(o->ptr, o->classId, classId); + if(ptr != lastptr) { + lastptr = ptr; + SV *keysv = newSViv((IV)ptr); + STRLEN len; + char *key = SvPV(keysv, len); + SV *rv = newSVsv(obj); + sv_rvweaken(rv); // weak reference! + hv_store(hv, key, len, rv, 0); + SvREFCNT_dec(keysv); + } + for(Smoke::Index *i = o->smoke->inheritanceList + o->smoke->classes[classId].parents; + *i; + i++) { + mapPointer(obj, o, hv, *i, lastptr); + } +} + +Marshall::HandlerFn getMarshallFn(const SmokeType &type); + +class VirtualMethodReturnValue : public Marshall { + Smoke *_smoke; + Smoke::Index _method; + Smoke::Stack _stack; + SmokeType _st; + SV *_retval; +public: + const Smoke::Method &method() { return _smoke->methods[_method]; } + SmokeType type() { return _st; } + Marshall::Action action() { return Marshall::FromSV; } + Smoke::StackItem &item() { return _stack[0]; } + SV *var() { return _retval; } + void unsupported() { + croak("Cannot handle '%s' as return-type of virtual method %s::%s", + type().name(), + _smoke->className(method().classId), + _smoke->methodNames[method().name]); + } + Smoke *smoke() { return _smoke; } + void next() {} + bool cleanup() { return false; } + VirtualMethodReturnValue(Smoke *smoke, Smoke::Index meth, Smoke::Stack stack, SV *retval) : + _smoke(smoke), _method(meth), _stack(stack), _retval(retval) { + _st.set(_smoke, method().ret); + Marshall::HandlerFn fn = getMarshallFn(type()); + (*fn)(this); + } +}; + +class VirtualMethodCall : public Marshall { + Smoke *_smoke; + Smoke::Index _method; + Smoke::Stack _stack; + GV *_gv; + int _cur; + Smoke::Index *_args; + SV **_sp; + bool _called; + SV *_savethis; + +public: + SmokeType type() { return SmokeType(_smoke, _args[_cur]); } + Marshall::Action action() { return Marshall::ToSV; } + Smoke::StackItem &item() { return _stack[_cur + 1]; } + SV *var() { return _sp[_cur]; } + const Smoke::Method &method() { return _smoke->methods[_method]; } + void unsupported() { + croak("Cannot handle '%s' as argument of virtual method %s::%s", + type().name(), + _smoke->className(method().classId), + _smoke->methodNames[method().name]); + } + Smoke *smoke() { return _smoke; } + void callMethod() { + dSP; + if(_called) return; + _called = true; + SP = _sp + method().numArgs - 1; + PUTBACK; + int count = call_sv((SV*)GvCV(_gv), G_SCALAR); + SPAGAIN; + VirtualMethodReturnValue r(_smoke, _method, _stack, POPs); + PUTBACK; + FREETMPS; + LEAVE; + } + void next() { + int oldcur = _cur; + _cur++; + while(!_called && _cur < method().numArgs) { + Marshall::HandlerFn fn = getMarshallFn(type()); + (*fn)(this); + _cur++; + } + callMethod(); + _cur = oldcur; + } + bool cleanup() { return false; } // is this right? + VirtualMethodCall(Smoke *smoke, Smoke::Index meth, Smoke::Stack stack, SV *obj, GV *gv) : + _smoke(smoke), _method(meth), _stack(stack), _gv(gv), _cur(-1), _sp(0), _called(false) { + dSP; + ENTER; + SAVETMPS; + PUSHMARK(SP); + EXTEND(SP, method().numArgs); + _savethis = sv_this; + sv_this = newSVsv(obj); + _sp = SP + 1; + for(int i = 0; i < method().numArgs; i++) + _sp[i] = sv_newmortal(); + _args = _smoke->argumentList + method().args; + } + ~VirtualMethodCall() { + SvREFCNT_dec(sv_this); + sv_this = _savethis; + } +}; + +class MethodReturnValue : public Marshall { + Smoke *_smoke; + Smoke::Index _method; + SV *_retval; + Smoke::Stack _stack; +public: + MethodReturnValue(Smoke *smoke, Smoke::Index method, Smoke::Stack stack, SV *retval) : + _smoke(smoke), _method(method), _retval(retval), _stack(stack) { + Marshall::HandlerFn fn = getMarshallFn(type()); + (*fn)(this); + } + const Smoke::Method &method() { return _smoke->methods[_method]; } + SmokeType type() { return SmokeType(_smoke, method().ret); } + Marshall::Action action() { return Marshall::ToSV; } + Smoke::StackItem &item() { return _stack[0]; } + SV *var() { return _retval; } + void unsupported() { + croak("Cannot handle '%s' as return-type of %s::%s", + type().name(), + _smoke->className(method().classId), + _smoke->methodNames[method().name]); + } + Smoke *smoke() { return _smoke; } + void next() {} + bool cleanup() { return false; } +}; + +class MethodCall : public Marshall { + int _cur; + Smoke *_smoke; + Smoke::Stack _stack; + Smoke::Index _method; + Smoke::Index *_args; + SV **_sp; + int _items; + SV *_retval; + bool _called; +public: + MethodCall(Smoke *smoke, Smoke::Index method, SV **sp, int items) : + _smoke(smoke), _method(method), _sp(sp), _items(items), _cur(-1), _called(false) { + _args = _smoke->argumentList + _smoke->methods[_method].args; + _items = _smoke->methods[_method].numArgs; + _stack = new Smoke::StackItem[items + 1]; + _retval = newSV(0); + } + ~MethodCall() { + delete[] _stack; + SvREFCNT_dec(_retval); + } + SmokeType type() { return SmokeType(_smoke, _args[_cur]); } + Marshall::Action action() { return Marshall::FromSV; } + Smoke::StackItem &item() { return _stack[_cur + 1]; } + SV *var() { + if(_cur < 0) return _retval; + SvGETMAGIC(*(_sp + _cur)); + return *(_sp + _cur); + } + inline const Smoke::Method &method() { return _smoke->methods[_method]; } + void unsupported() { + croak("Cannot handle '%s' as argument to %s::%s", + type().name(), + _smoke->className(method().classId), + _smoke->methodNames[method().name]); + } + Smoke *smoke() { return _smoke; } + inline void callMethod() { + if(_called) return; + _called = true; + Smoke::ClassFn fn = _smoke->classes[method().classId].classFn; + void *ptr = _smoke->cast( + _current_object, + _current_object_class, + method().classId + ); + _items = -1; + (*fn)(method().method, ptr, _stack); + MethodReturnValue r(_smoke, _method, _stack, _retval); + } + void next() { + int oldcur = _cur; + _cur++; + + while(!_called && _cur < _items) { + Marshall::HandlerFn fn = getMarshallFn(type()); + (*fn)(this); + _cur++; + } + + callMethod(); + _cur = oldcur; + } + bool cleanup() { return true; } +}; + +class UnencapsulatedQObject : public QObject { +public: + QConnectionList *public_receivers(int signal) const { return receivers(signal); } + void public_activate_signal(QConnectionList *clist, QUObject *o) { activate_signal(clist, o); } +}; + +class EmitSignal : public Marshall { + UnencapsulatedQObject *_qobj; + int _id; + MocArgument *_args; + SV **_sp; + int _items; + int _cur; + Smoke::Stack _stack; + bool _called; +public: + EmitSignal(QObject *qobj, int id, int items, MocArgument *args, SV **sp) : + _qobj((UnencapsulatedQObject*)qobj), _id(id), _items(items), _args(args), + _sp(sp), _cur(-1), _called(false) { + _stack = new Smoke::StackItem[_items]; + } + ~EmitSignal() { + delete[] _stack; + } + const MocArgument &arg() { return _args[_cur]; } + SmokeType type() { return arg().st; } + Marshall::Action action() { return Marshall::FromSV; } + Smoke::StackItem &item() { return _stack[_cur]; } + SV *var() { return _sp[_cur]; } + void unsupported() { + croak("Cannot handle '%s' as signal argument", type().name()); + } + Smoke *smoke() { return type().smoke(); } + void emitSignal() { + if(_called) return; + _called = true; + + QConnectionList *clist = _qobj->public_receivers(_id); + if(!clist) return; + + QUObject *o = new QUObject[_items + 1]; + for(int i = 0; i < _items; i++) { + QUObject *po = o + i + 1; + Smoke::StackItem *si = _stack + i; + switch(_args[i].argType) { + case xmoc_bool: + static_QUType_bool.set(po, si->s_bool); + break; + case xmoc_int: + static_QUType_int.set(po, si->s_int); + break; + case xmoc_double: + static_QUType_double.set(po, si->s_double); + break; + case xmoc_charstar: + static_QUType_charstar.set(po, (char*)si->s_voidp); + break; + case xmoc_QString: + static_QUType_QString.set(po, *(QString*)si->s_voidp); + break; + default: + { + const SmokeType &t = _args[i].st; + void *p; + switch(t.elem()) { + case Smoke::t_bool: + p = &si->s_bool; + break; + case Smoke::t_char: + p = &si->s_char; + break; + case Smoke::t_uchar: + p = &si->s_uchar; + break; + case Smoke::t_short: + p = &si->s_short; + break; + case Smoke::t_ushort: + p = &si->s_ushort; + break; + case Smoke::t_int: + p = &si->s_int; + break; + case Smoke::t_uint: + p = &si->s_uint; + break; + case Smoke::t_long: + p = &si->s_long; + break; + case Smoke::t_ulong: + p = &si->s_ulong; + break; + case Smoke::t_float: + p = &si->s_float; + break; + case Smoke::t_double: + p = &si->s_double; + break; + case Smoke::t_enum: + { + // allocate a new enum value + Smoke::EnumFn fn = SmokeClass(t).enumFn(); + if(!fn) { + warn("Unknown enumeration %s\n", t.name()); + p = new int((int)si->s_enum); + break; + } + Smoke::Index id = t.typeId(); + (*fn)(Smoke::EnumNew, id, p, si->s_enum); + (*fn)(Smoke::EnumFromLong, id, p, si->s_enum); + // FIXME: MEMORY LEAK + } + break; + case Smoke::t_class: + case Smoke::t_voidp: + p = si->s_voidp; + break; + default: + p = 0; + break; + } + static_QUType_ptr.set(po, p); + } + } + } + + _qobj->public_activate_signal(clist, o); + delete[] o; + } + void next() { + int oldcur = _cur; + _cur++; + + while(!_called && _cur < _items) { + Marshall::HandlerFn fn = getMarshallFn(type()); + (*fn)(this); + _cur++; + } + + emitSignal(); + _cur = oldcur; + } + bool cleanup() { return true; } +}; + +class InvokeSlot : public Marshall { + QObject *_qobj; + GV *_gv; + int _items; + MocArgument *_args; + QUObject *_o; + int _cur; + bool _called; + SV **_sp; + Smoke::Stack _stack; +public: + const MocArgument &arg() { return _args[_cur]; } + SmokeType type() { return arg().st; } + Marshall::Action action() { return Marshall::ToSV; } + Smoke::StackItem &item() { return _stack[_cur]; } + SV *var() { return _sp[_cur]; } + Smoke *smoke() { return type().smoke(); } + bool cleanup() { return false; } + void unsupported() { + croak("Cannot handle '%s' as slot argument\n", type().name()); + } + void copyArguments() { + for(int i = 0; i < _items; i++) { + QUObject *o = _o + i + 1; + switch(_args[i].argType) { + case xmoc_bool: + _stack[i].s_bool = static_QUType_bool.get(o); + break; + case xmoc_int: + _stack[i].s_int = static_QUType_int.get(o); + break; + case xmoc_double: + _stack[i].s_double = static_QUType_double.get(o); + break; + case xmoc_charstar: + _stack[i].s_voidp = static_QUType_charstar.get(o); + break; + case xmoc_QString: + _stack[i].s_voidp = &static_QUType_QString.get(o); + break; + default: // case xmoc_ptr: + { + const SmokeType &t = _args[i].st; + void *p = static_QUType_ptr.get(o); + switch(t.elem()) { + case Smoke::t_bool: + _stack[i].s_bool = *(bool*)p; + break; + case Smoke::t_char: + _stack[i].s_char = *(char*)p; + break; + case Smoke::t_uchar: + _stack[i].s_uchar = *(unsigned char*)p; + break; + case Smoke::t_short: + _stack[i].s_short = *(short*)p; + break; + case Smoke::t_ushort: + _stack[i].s_ushort = *(unsigned short*)p; + break; + case Smoke::t_int: + _stack[i].s_int = *(int*)p; + break; + case Smoke::t_uint: + _stack[i].s_uint = *(unsigned int*)p; + break; + case Smoke::t_long: + _stack[i].s_long = *(long*)p; + break; + case Smoke::t_ulong: + _stack[i].s_ulong = *(unsigned long*)p; + break; + case Smoke::t_float: + _stack[i].s_float = *(float*)p; + break; + case Smoke::t_double: + _stack[i].s_double = *(double*)p; + break; + case Smoke::t_enum: + { + Smoke::EnumFn fn = SmokeClass(t).enumFn(); + if(!fn) { + warn("Unknown enumeration %s\n", t.name()); + _stack[i].s_enum = *(int*)p; + break; + } + Smoke::Index id = t.typeId(); + (*fn)(Smoke::EnumToLong, id, p, _stack[i].s_enum); + } + break; + case Smoke::t_class: + case Smoke::t_voidp: + _stack[i].s_voidp = p; + break; + } + } + } + } + } + void invokeSlot() { + dSP; + if(_called) return; + _called = true; + + SP = _sp + _items - 1; + PUTBACK; + int count = call_sv((SV*)GvCV(_gv), G_SCALAR); + SPAGAIN; + SP -= count; + PUTBACK; + FREETMPS; + LEAVE; + } + void next() { + int oldcur = _cur; + _cur++; + + while(!_called && _cur < _items) { + Marshall::HandlerFn fn = getMarshallFn(type()); + (*fn)(this); + _cur++; + } + + invokeSlot(); + _cur = oldcur; + } + InvokeSlot(QObject *qobj, GV *gv, int items, MocArgument *args, QUObject *o) : + _qobj(qobj), _gv(gv), _items(items), _args(args), _o(o), _cur(-1), _called(false) { + dSP; + ENTER; + SAVETMPS; + PUSHMARK(SP); + EXTEND(SP, items); + PUTBACK; + _sp = SP + 1; + for(int i = 0; i < _items; i++) + _sp[i] = sv_newmortal(); + _stack = new Smoke::StackItem[_items]; + copyArguments(); + } + ~InvokeSlot() { + delete[] _stack; + } + +}; + +class QtSmokeBinding : public SmokeBinding { +public: + QtSmokeBinding(Smoke *s) : SmokeBinding(s) {} + void deleted(Smoke::Index classId, void *ptr) { + SV *obj = getPointerObject(ptr); + smokeperl_object *o = sv_obj_info(obj); + if(do_debug && (do_debug & qtdb_gc)) { + fprintf(stderr, "%p->~%s()\n", ptr, smoke->className(classId)); + } + if(!o || !o->ptr) { + return; + } + unmapPointer(o, o->classId, 0); + o->ptr = 0; + } + bool callMethod(Smoke::Index method, void *ptr, Smoke::Stack args, bool isAbstract) { + SV *obj = getPointerObject(ptr); + smokeperl_object *o = sv_obj_info(obj); + if(do_debug && (do_debug & qtdb_virtual)) fprintf(stderr, "virtual %p->%s::%s() called\n", ptr, + smoke->classes[smoke->methods[method].classId].className, + smoke->methodNames[smoke->methods[method].name] + ); + + if(!o) { + if(!PL_dirty && (do_debug && (do_debug & qtdb_virtual)) ) // if not in global destruction + fprintf(stderr, "Cannot find object for virtual method\n"); + return false; + } + HV *stash = SvSTASH(SvRV(obj)); + if(*HvNAME(stash) == ' ') + stash = gv_stashpv(HvNAME(stash) + 1, TRUE); + const char *methodName = smoke->methodNames[smoke->methods[method].name]; + GV *gv = gv_fetchmethod_autoload(stash, methodName, 0); + if(!gv) return false; + + VirtualMethodCall c(smoke, method, args, obj, gv); + // exception variable, just temporary + temporary_virtual_function_success = true; + c.next(); + bool ret = temporary_virtual_function_success; + temporary_virtual_function_success = true; + return ret; + } + char *className(Smoke::Index classId) { + const char *className = smoke->className(classId); + char *buf = new char[strlen(className) + 6]; + strcpy(buf, " Qt::"); + strcat(buf, className + 1); + return buf; + } +}; + +// ---------------- Helpers ------------------- + +SV *catArguments(SV** sp, int n) +{ + SV* r=newSVpvf(""); + for(int i = 0; i < n; i++) { + if(i) sv_catpv(r, ", "); + if(!SvOK(sp[i])) { + sv_catpv(r, "undef"); + } else if(SvROK(sp[i])) { + smokeperl_object *o = sv_obj_info(sp[i]); + if(o) + sv_catpv(r, o->smoke->className(o->classId)); + else + sv_catsv(r, sp[i]); + } else { + bool isString = SvPOK(sp[i]); + STRLEN len; + char *s = SvPV(sp[i], len); + if(isString) sv_catpv(r, "'"); + sv_catpvn(r, s, len > 10 ? 10 : len); + if(len > 10) sv_catpv(r, "..."); + if(isString) sv_catpv(r, "'"); + } + } + return r; +} + +Smoke::Index package_classid(const char *p) +{ + Smoke::Index *item = classcache->find(p); + if(item) + return *item; + char *nisa = new char[strlen(p)+6]; + strcpy(nisa, p); + strcat(nisa, "::ISA"); + AV* isa=get_av(nisa, true); + delete[] nisa; + for(int i=0; i<=av_len(isa); i++) { + SV** np = av_fetch(isa, i, 0); + if(np) { + Smoke::Index ix = package_classid(SvPV_nolen(*np)); + if(ix) { + classcache->insert(p, new Smoke::Index(ix)); + return ix; + } + } + } + return (Smoke::Index) 0; +} + +char *get_SVt(SV *sv) +{ + char *r; + if(!SvOK(sv)) + r = "u"; + else if(SvIOK(sv)) + r = "i"; + else if(SvNOK(sv)) + r = "n"; + else if(SvPOK(sv)) + r = "s"; + else if(SvROK(sv)) { + smokeperl_object *o = sv_obj_info(sv); + if(!o) { + switch (SvTYPE(SvRV(sv))) { + case SVt_PVAV: + r = "a"; + break; +// case SVt_PV: +// case SVt_PVMG: +// r = "p"; + default: + r = "r"; + } + } + else + r = (char*)o->smoke->className(o->classId); + } + else + r = "U"; + return r; +} + +SV *prettyPrintMethod(Smoke::Index id) { + SV *r = newSVpvf(""); + Smoke::Method &meth = qt_Smoke->methods[id]; + const char *tname = qt_Smoke->types[meth.ret].name; + if(meth.flags & Smoke::mf_static) sv_catpv(r, "static "); + sv_catpvf(r, "%s ", (tname ? tname:"void")); + sv_catpvf(r, "%s::%s(", qt_Smoke->classes[meth.classId].className, qt_Smoke->methodNames[meth.name]); + for(int i = 0; i < meth.numArgs; i++) { + if(i) sv_catpv(r, ", "); + tname = qt_Smoke->types[qt_Smoke->argumentList[meth.args+i]].name; + sv_catpv(r, (tname ? tname:"void")); + } + sv_catpv(r, ")"); + if(meth.flags & Smoke::mf_const) sv_catpv(r, " const"); + return r; +} + +// --------------- Unary Keywords && Attributes ------------------ + + +// implements unary 'this' +XS(XS_this) { + dXSARGS; + ST(0) = sv_this; + XSRETURN(1); +} + +// implements unary attributes: 'foo' means 'this->{foo}' +XS(XS_attr) { + dXSARGS; + char *key = GvNAME(CvGV(cv)); + U32 klen = strlen(key); + SV **svp = 0; + if(SvROK(sv_this) && SvTYPE(SvRV(sv_this)) == SVt_PVHV) { + HV *hv = (HV*)SvRV(sv_this); + svp = hv_fetch(hv, key, klen, 1); + } + if(svp) { + ST(0) = *svp; + XSRETURN(1); + } + XSRETURN_UNDEF; +} + +// implements unary SUPER attribute: 'SUPER' means ${(CopSTASH)::_INTERNAL_STATIC_}{SUPER} +XS(XS_super) { + dXSARGS; + char *key = "SUPER"; + U32 klen = strlen(key); + SV **svp = 0; + if(SvROK(sv_this) && SvTYPE(SvRV(sv_this)) == SVt_PVHV) { + HV *cs = (HV*)CopSTASH(PL_curcop); + if(!cs) XSRETURN_UNDEF; + svp = hv_fetch(cs, "_INTERNAL_STATIC_", 17, 0); + if(!svp) XSRETURN_UNDEF; + cs = GvHV((GV*)*svp); + if(!cs) XSRETURN_UNDEF; + svp = hv_fetch(cs, "SUPER", 5, 0); + } + if(svp) { + ST(0) = *svp; + XSRETURN(1); + } + XSRETURN_UNDEF; +} + +//---------- XS Autoload (for all functions except fully qualified statics & enums) --------- + +static inline bool isQt(char *p) { + return (p[0] == 'Q' && p[1] && p[1] == 't' && ((p[2] && p[2] == ':') || !p[2])); +} + +bool avoid_fetchmethod = false; +XS(XS_AUTOLOAD) { + // Err, XS autoload is borked. Lets try... + dXSARGS; + SV *sv = get_sv("Qt::AutoLoad::AUTOLOAD", TRUE); + char *package = SvPV_nolen(sv); + char *method = 0; + for(char *s = package; *s ; s++) + if(*s == ':') method = s; + if(!method) XSRETURN_NO; + *(method++ - 1) = 0; // sorry for showing off. :) + int withObject = (*package == ' ') ? 1 : 0; + int isSuper = 0; + if(withObject) { + package++; + if(*package == ' ') { + isSuper = 1; + char *super = new char[strlen(package) + 7]; + package++; + strcpy(super, package); + strcat(super, "::SUPER"); + package = super; + } + } else if( isQt(package) ) + avoid_fetchmethod = true; + + HV *stash = gv_stashpv(package, TRUE); + + if(do_debug && (do_debug & qtdb_autoload)) + warn("In XS Autoload for %s::%s()\n", package, method); + + // check for user-defined methods in the REAL stash; skip prefix + GV *gv = 0; + if(avoid_fetchmethod) + avoid_fetchmethod = false; + else + gv = gv_fetchmethod_autoload(stash, method, 0); + + // If we've made it here, we need to set sv_this + if(gv) { + if(do_debug && (do_debug & qtdb_autoload)) + warn("\tfound in %s's Perl stash\n", package); + + // call the defined Perl method with new 'this' + SV *old_this; + if(withObject && !isSuper) { + old_this = sv_this; + sv_this = newSVsv(ST(0)); + } + + ENTER; + SAVETMPS; + PUSHMARK(SP - items + withObject); + PUTBACK; + int count = call_sv((SV*)GvCV(gv), G_SCALAR|G_EVAL); + SPAGAIN; + SV *ret = newSVsv(TOPs); + SP -= count; + PUTBACK; + FREETMPS; + LEAVE; + + if(withObject && !isSuper) { + SvREFCNT_dec(sv_this); + sv_this = old_this; + } + else if(isSuper) + delete[] package; + + if(SvTRUE(ERRSV)) + croak(SvPV_nolen(ERRSV)); + ST(0) = sv_2mortal(ret); + XSRETURN(1); + } + else if(!strcmp(method, "DESTROY")) { + SV *old_this; + if(withObject && !isSuper) { + old_this = sv_this; + sv_this = newSVsv(ST(0)); + } + smokeperl_object *o = sv_obj_info(sv_this); + + if(!(o && o->ptr && (o->allocated || getPointerObject(o->ptr)))) { + if(isSuper) + delete[] package; + if(withObject && !isSuper) { + SvREFCNT_dec(sv_this); + sv_this = old_this; + } + XSRETURN_YES; + } + const char *key = "has been hidden"; + U32 klen = 15; + SV **svp = 0; + if(SvROK(sv_this) && SvTYPE(SvRV(sv_this)) == SVt_PVHV) { + HV *hv = (HV*)SvRV(sv_this); + svp = hv_fetch(hv, key, klen, 0); + } + if(svp) { + if(isSuper) + delete[] package; + if(withObject && !isSuper) { + SvREFCNT_dec(sv_this); + sv_this = old_this; + } + XSRETURN_YES; + } + gv = gv_fetchmethod_autoload(stash, "ON_DESTROY", 0); + if( !gv ) + croak( "Couldn't find ON_DESTROY method for %s=%p\n", package, o->ptr); + PUSHMARK(SP); + call_sv((SV*)GvCV(gv), G_SCALAR|G_NOARGS); + SPAGAIN; + int ret = POPi; + PUTBACK; + if(withObject && !isSuper) { + SvREFCNT_dec(sv_this); + sv_this = old_this; + } + if( do_debug && ret && (do_debug & qtdb_gc) ) + fprintf(stderr, "Increasing refcount in DESTROY for %s=%p (still has a parent)\n", package, o->ptr); + } else { + + if( items > 18 ) XSRETURN_NO; // current max number of args in Qt is 13. + + // save the stack -- we'll need it + SV **savestack = new SV*[items+1]; + SV *saveobj = ST(0); + SV *old_this; + + Copy(SP - items + 1 + withObject, savestack, items-withObject, SV*); + + // Get the classid (eventually converting SUPER to the right Qt class) + Smoke::Index cid = package_classid(package); + // Look in the cache + char *cname = (char*)qt_Smoke->className(cid); + int lcname = strlen(cname); + int lmethod = strlen(method); + char mcid[256]; + strncpy(mcid, cname, lcname); + char *ptr = mcid + lcname; + *(ptr++) = ';'; + strncpy(ptr, method, lmethod); + ptr += lmethod; + for(int i=withObject ; i<items ; i++) + { + *(ptr++) = ';'; + char *t = get_SVt(ST(i)); + int tlen = strlen(t); + strncpy(ptr, t, tlen ); + ptr += tlen; + } + *ptr = 0; + Smoke::Index *rcid = methcache->find(mcid); + + if(rcid) { + // Got a hit + _current_method = *rcid; + if(withObject && !isSuper) { + old_this = sv_this; + sv_this = newSVsv(ST(0)); + } + } + else { + + // Find the C++ method to call. I'll do that from Perl for now + + ENTER; + SAVETMPS; + PUSHMARK(SP - items + withObject); + EXTEND(SP, 3); + PUSHs(sv_2mortal(newSViv((IV)cid))); + PUSHs(sv_2mortal(newSVpv(method, 0))); + PUSHs(sv_2mortal(newSVpv(package, 0))); + PUTBACK; + if(withObject && !isSuper) { + old_this = sv_this; + sv_this = newSVsv(saveobj); + } + call_pv("Qt::_internal::do_autoload", G_DISCARD|G_EVAL); + FREETMPS; + LEAVE; + + // Restore sv_this on error, so that eval{ } works + if(SvTRUE(ERRSV)) { + if(withObject && !isSuper) { + SvREFCNT_dec(sv_this); + sv_this = old_this; + } + else if(isSuper) + delete[] package; + delete[] savestack; + croak(SvPV_nolen(ERRSV)); + } + + // Success. Cache result. + methcache->insert(mcid, new Smoke::Index(_current_method)); + } + // FIXME: I shouldn't have to set the current object + { + smokeperl_object *o = sv_obj_info(sv_this); + if(o && o->ptr) { + _current_object = o->ptr; + _current_object_class = o->classId; + } else { + _current_object = 0; + } + } + // honor debugging channels + if(do_debug && (do_debug & qtdb_calls)) { + warn("Calling method\t%s\n", SvPV_nolen(sv_2mortal(prettyPrintMethod(_current_method)))); + if(do_debug & qtdb_verbose) + warn("with arguments (%s)\n", SvPV_nolen(sv_2mortal(catArguments(savestack, items-withObject)))); + } + MethodCall c(qt_Smoke, _current_method, savestack, items-withObject); + c.next(); + if(savestack) + delete[] savestack; + + if(withObject && !isSuper) { + SvREFCNT_dec(sv_this); + sv_this = old_this; + } + else if(isSuper) + delete[] package; + + SV *ret = c.var(); + SvREFCNT_inc(ret); + ST(0) = sv_2mortal(ret); + XSRETURN(1); + } + if(isSuper) + delete[] package; + XSRETURN_YES; +} + + +//----------------- Sig/Slot ------------------ + + +MocArgument *getmetainfo(GV *gv, const char *name, int &offset, int &index, int &argcnt) { + char *signalname = GvNAME(gv); + HV *stash = GvSTASH(gv); + + // $meta = $stash->{META} + SV **svp = hv_fetch(stash, "META", 4, 0); + if(!svp) return 0; + HV *hv = GvHV((GV*)*svp); + if(!hv) return 0; + + // $metaobject = $meta->{object} + // aka. Class->staticMetaObject + svp = hv_fetch(hv, "object", 6, 0); + if(!svp) return 0; + smokeperl_object *ometa = sv_obj_info(*svp); + if(!ometa) return 0; + QMetaObject *metaobject = (QMetaObject*)ometa->ptr; + + offset = metaobject->signalOffset(); + + // $signals = $meta->{signal} + U32 len = strlen(name); + svp = hv_fetch(hv, name, len, 0); + if(!svp) return 0; + HV *signalshv = (HV*)SvRV(*svp); + + // $signal = $signals->{$signalname} + len = strlen(signalname); + svp = hv_fetch(signalshv, signalname, len, 0); + if(!svp) return 0; + HV *signalhv = (HV*)SvRV(*svp); + + // $index = $signal->{index} + svp = hv_fetch(signalhv, "index", 5, 0); + if(!svp) return 0;; + index = SvIV(*svp); + + // $argcnt = $signal->{argcnt} + svp = hv_fetch(signalhv, "argcnt", 6, 0); + if(!svp) return 0; + argcnt = SvIV(*svp); + + // $mocargs = $signal->{mocargs} + svp = hv_fetch(signalhv, "mocargs", 7, 0); + if(!svp) return 0; + MocArgument *args = (MocArgument*)SvIV(*svp); + + return args; +} + +MocArgument *getslotinfo(GV *gv, int id, char *&slotname, int &index, int &argcnt, bool isSignal = false) { + HV *stash = GvSTASH(gv); + + // $meta = $stash->{META} + SV **svp = hv_fetch(stash, "META", 4, 0); + if(!svp) return 0; + HV *hv = GvHV((GV*)*svp); + if(!hv) return 0; + + // $metaobject = $meta->{object} + // aka. Class->staticMetaObject + svp = hv_fetch(hv, "object", 6, 0); + if(!svp) return 0; + smokeperl_object *ometa = sv_obj_info(*svp); + if(!ometa) return 0; + QMetaObject *metaobject = (QMetaObject*)ometa->ptr; + + int offset = isSignal ? metaobject->signalOffset() : metaobject->slotOffset(); + + index = id - offset; // where we at + // FIXME: make slot inheritance work + if(index < 0) return 0; + // $signals = $meta->{signal} + const char *key = isSignal ? "signals" : "slots"; + svp = hv_fetch(hv, key, strlen(key), 0); + if(!svp) return 0; + AV *signalsav = (AV*)SvRV(*svp); + svp = av_fetch(signalsav, index, 0); + if(!svp) return 0; + HV *signalhv = (HV*)SvRV(*svp); + // $argcnt = $signal->{argcnt} + svp = hv_fetch(signalhv, "argcnt", 6, 0); + if(!svp) return 0; + argcnt = SvIV(*svp); + // $mocargs = $signal->{mocargs} + svp = hv_fetch(signalhv, "mocargs", 7, 0); + if(!svp) return 0; + MocArgument *args = (MocArgument*)SvIV(*svp); + + svp = hv_fetch(signalhv, "name", 4, 0); + if(!svp) return 0; + slotname = SvPV_nolen(*svp); + + return args; +} + +XS(XS_signal) { + dXSARGS; + + smokeperl_object *o = sv_obj_info(sv_this); + QObject *qobj = (QObject*)o->smoke->cast( + o->ptr, + o->classId, + o->smoke->idClass("QObject") + ); + if(qobj->signalsBlocked()) XSRETURN_UNDEF; + + int offset; + int index; + int argcnt; + MocArgument *args; + + args = getmetainfo(CvGV(cv), "signal", offset, index, argcnt); + if(!args) XSRETURN_UNDEF; + + // Okay, we have the signal info. *whew* + if(items < argcnt) + croak("Insufficient arguments to emit signal"); + + EmitSignal signal(qobj, offset + index, argcnt, args, &ST(0)); + signal.next(); + + XSRETURN_UNDEF; +} + +XS(XS_qt_invoke) { + dXSARGS; + // Arguments: int id, QUObject *o + int id = SvIV(ST(0)); + QUObject *_o = (QUObject*)SvIV(SvRV(ST(1))); + + smokeperl_object *o = sv_obj_info(sv_this); + QObject *qobj = (QObject*)o->smoke->cast( + o->ptr, + o->classId, + o->smoke->idClass("QObject") + ); + + // Now, I need to find out if this means me + int index; + char *slotname; + int argcnt; + MocArgument *args; + bool isSignal = !strcmp(GvNAME(CvGV(cv)), "qt_emit"); + args = getslotinfo(CvGV(cv), id, slotname, index, argcnt, isSignal); + if(!args) { + // throw an exception - evil style + temporary_virtual_function_success = false; + XSRETURN_UNDEF; + } + HV *stash = GvSTASH(CvGV(cv)); + GV *gv = gv_fetchmethod_autoload(stash, slotname, 0); + if(!gv) XSRETURN_UNDEF; + InvokeSlot slot(qobj, gv, argcnt, args, _o); + slot.next(); + + XSRETURN_UNDEF; +} + +// ------------------- Tied types ------------------------ + +MODULE = Qt PACKAGE = Qt::_internal::QString +PROTOTYPES: DISABLE + +SV* +FETCH(obj) + SV* obj + CODE: + if (!SvROK(obj)) + croak("?"); + IV tmp = SvIV((SV*)SvRV(obj)); + QString *s = (QString*) tmp; + RETVAL = newSV(0); + if( s ) + { + if(!(IN_BYTES)) + { + sv_setpv_mg(RETVAL, (const char *)s->utf8()); + SvUTF8_on(RETVAL); + } + else if(IN_LOCALE) + sv_setpv_mg(RETVAL, (const char *)s->local8Bit()); + else + sv_setpv_mg(RETVAL, (const char *)s->latin1()); + } + else + sv_setsv_mg(RETVAL, &PL_sv_undef); + OUTPUT: + RETVAL + +void +STORE(obj,what) + SV* obj + SV* what + CODE: + if (!SvROK(obj)) + croak("?"); + IV tmp = SvIV((SV*)SvRV(obj)); + QString *s = (QString*) tmp; + s->truncate(0); + if(SvOK(what)) { + if(SvUTF8(what)) + s->append(QString::fromUtf8(SvPV_nolen(what))); + else if(IN_LOCALE) + s->append(QString::fromLocal8Bit(SvPV_nolen(what))); + else + s->append(QString::fromLatin1(SvPV_nolen(what))); + } + +void +DESTROY(obj) + SV* obj + CODE: + if (!SvROK(obj)) + croak("?"); + IV tmp = SvIV((SV*)SvRV(obj)); + QString *s = (QString*) tmp; + delete s; + +MODULE = Qt PACKAGE = Qt::_internal::QByteArray +PROTOTYPES: DISABLE + +SV* +FETCH(obj) + SV* obj + CODE: + if (!SvROK(obj)) + croak("?"); + IV tmp = SvIV((SV*)SvRV(obj)); + QByteArray *s = (QByteArray*) tmp; + RETVAL = newSV(0); + if( s ) + { + sv_setpvn_mg(RETVAL, s->data(), s->size()); + } + else + sv_setsv_mg(RETVAL, &PL_sv_undef); + OUTPUT: + RETVAL + +void +STORE(obj,what) + SV* obj + SV* what + CODE: + if (!SvROK(obj)) + croak("?"); + IV tmp = SvIV((SV*)SvRV(obj)); + QByteArray *s = (QByteArray*) tmp; + + if(SvOK(what)) { + STRLEN len; + char* tmp2 = SvPV(what, len); + s->resize(len); + Copy((void*)tmp2, (void*)s->data(), len, char); + } else + s->truncate(0); + +void +DESTROY(obj) + SV* obj + CODE: + if (!SvROK(obj)) + croak("?"); + IV tmp = SvIV((SV*)SvRV(obj)); + QByteArray *s = (QByteArray*) tmp; + delete s; + +MODULE = Qt PACKAGE = Qt::_internal::QRgbStar +PROTOTYPES: DISABLE + +SV* +FETCH(obj) + SV* obj + CODE: + if (!SvROK(obj)) + croak("?"); + IV tmp = SvIV((SV*)SvRV(obj)); + QRgb *s = (QRgb*) tmp; + AV* ar = newAV(); + RETVAL = newRV_noinc((SV*)ar); + for(int i=0; s[i] ; i++) + { + SV *item = newSViv((IV)s[i]); + if(!av_store(ar, (I32)i, item)) + SvREFCNT_dec( item ); + } + OUTPUT: + RETVAL + +void +STORE(obj,sv) + SV* obj + SV* sv + CODE: + if (!SvROK(obj)) + croak("?"); + IV tmp = SvIV((SV*)SvRV(obj)); + QRgb *s = (QRgb*) tmp; + if(!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV || + av_len((AV*)SvRV(sv)) < 0) { + s = new QRgb[1]; + s[0] = 0; + sv_setref_pv(obj, "Qt::_internal::QRgbStar", (void*)s); + return; + } + AV *list = (AV*)SvRV(sv); + int count = av_len(list); + s = new QRgb[count + 2]; + int i; + for(i = 0; i <= count; i++) { + SV **item = av_fetch(list, i, 0); + if(!item || !SvOK(*item)) { + s[i] = 0; + continue; + } + s[i] = SvIV(*item); + } + s[i] = 0; + sv_setref_pv(obj, "Qt::_internal::QRgbStar", (void*)s); + +void +DESTROY(obj) + SV* obj + CODE: + if (!SvROK(obj)) + croak("?"); + IV tmp = SvIV((SV*)SvRV(obj)); + QRgb *s = (QRgb*) tmp; + delete[] s; + +# --------------- XSUBS for Qt::_internal::* helpers ---------------- + + +MODULE = Qt PACKAGE = Qt::_internal +PROTOTYPES: DISABLE + +void +getMethStat() + PPCODE: + XPUSHs(sv_2mortal(newSViv((int)methcache->size()))); + XPUSHs(sv_2mortal(newSViv((int)methcache->count()))); + +void +getClassStat() + PPCODE: + XPUSHs(sv_2mortal(newSViv((int)classcache->size()))); + XPUSHs(sv_2mortal(newSViv((int)classcache->count()))); + +void +getIsa(classId) + int classId + PPCODE: + Smoke::Index *parents = + qt_Smoke->inheritanceList + + qt_Smoke->classes[classId].parents; + while(*parents) + XPUSHs(sv_2mortal(newSVpv(qt_Smoke->classes[*parents++].className, 0))); + +void +dontRecurse() + CODE: + avoid_fetchmethod = true; + +void * +sv_to_ptr(sv) + SV* sv + +void * +allocateMocArguments(count) + int count + CODE: + RETVAL = (void*)new MocArgument[count + 1]; + OUTPUT: + RETVAL + +void +setMocType(ptr, idx, name, static_type) + void *ptr + int idx + char *name + char *static_type + CODE: + Smoke::Index typeId = qt_Smoke->idType(name); + if(!typeId) XSRETURN_NO; + MocArgument *arg = (MocArgument*)ptr; + arg[idx].st.set(qt_Smoke, typeId); + if(!strcmp(static_type, "ptr")) + arg[idx].argType = xmoc_ptr; + else if(!strcmp(static_type, "bool")) + arg[idx].argType = xmoc_bool; + else if(!strcmp(static_type, "int")) + arg[idx].argType = xmoc_int; + else if(!strcmp(static_type, "double")) + arg[idx].argType = xmoc_double; + else if(!strcmp(static_type, "char*")) + arg[idx].argType = xmoc_charstar; + else if(!strcmp(static_type, "QString")) + arg[idx].argType = xmoc_QString; + XSRETURN_YES; + +void +installsignal(name) + char *name + CODE: + char *file = __FILE__; + newXS(name, XS_signal, file); + +void +installqt_invoke(name) + char *name + CODE: + char *file = __FILE__; + newXS(name, XS_qt_invoke, file); + +void +setDebug(on) + int on + CODE: + do_debug = on; + +int +debug() + CODE: + RETVAL = do_debug; + OUTPUT: + RETVAL + +char * +getTypeNameOfArg(method, idx) + int method + int idx + CODE: + Smoke::Method &m = qt_Smoke->methods[method]; + Smoke::Index *args = qt_Smoke->argumentList + m.args; + RETVAL = (char*)qt_Smoke->types[args[idx]].name; + OUTPUT: + RETVAL + +int +classIsa(className, base) + char *className + char *base + CODE: + RETVAL = isDerivedFrom(qt_Smoke, className, base, 0); + OUTPUT: + RETVAL + +void +insert_pclassid(p, ix) + char *p + int ix + CODE: + classcache->insert(p, new Smoke::Index((Smoke::Index)ix)); + +int +find_pclassid(p) + char *p + CODE: + Smoke::Index *r = classcache->find(p); + if(r) + RETVAL = (int)*r; + else + RETVAL = 0; + OUTPUT: + RETVAL + +void +insert_mcid(mcid, ix) + char *mcid + int ix + CODE: + methcache->insert(mcid, new Smoke::Index((Smoke::Index)ix)); + +int +find_mcid(mcid) + char *mcid + CODE: + Smoke::Index *r = methcache->find(mcid); + if(r) + RETVAL = (int)*r; + else + RETVAL = 0; + OUTPUT: + RETVAL + +char * +getSVt(sv) + SV *sv + CODE: + RETVAL=get_SVt(sv); + OUTPUT: + RETVAL + +void * +make_QUParameter(name, type, extra, inout) + char *name + char *type + SV *extra + int inout + CODE: + QUParameter *p = new QUParameter; + p->name = new char[strlen(name) + 1]; + strcpy((char*)p->name, name); + if(!strcmp(type, "bool")) + p->type = &static_QUType_bool; + else if(!strcmp(type, "int")) + p->type = &static_QUType_int; + else if(!strcmp(type, "double")) + p->type = &static_QUType_double; + else if(!strcmp(type, "char*") || !strcmp(type, "const char*")) + p->type = &static_QUType_charstar; + else if(!strcmp(type, "QString") || !strcmp(type, "QString&") || + !strcmp(type, "const QString") || !strcmp(type, "const QString&")) + p->type = &static_QUType_QString; + else + p->type = &static_QUType_ptr; + // Lacking support for several types. Evil. + p->inOut = inout; + p->typeExtra = 0; + RETVAL = (void*)p; + OUTPUT: + RETVAL + +void * +make_QMetaData(name, method) + char *name + void *method + CODE: + QMetaData *m = new QMetaData; // will be deleted + m->name = new char[strlen(name) + 1]; + strcpy((char*)m->name, name); + m->method = (QUMethod*)method; + m->access = QMetaData::Public; + RETVAL = m; + OUTPUT: + RETVAL + +void * +make_QUMethod(name, params) + char *name + SV *params + CODE: + QUMethod *m = new QUMethod; // permanent memory allocation + m->name = new char[strlen(name) + 1]; // this too + strcpy((char*)m->name, name); + m->count = 0; + m->parameters = 0; + if(SvOK(params) && SvRV(params)) { + AV *av = (AV*)SvRV(params); + m->count = av_len(av) + 1; + if(m->count > 0) { + m->parameters = new QUParameter[m->count]; + for(int i = 0; i < m->count; i++) { + SV *sv = av_shift(av); + if(!SvOK(sv)) + croak("Invalid paramater for QUMethod\n"); + QUParameter *p = (QUParameter*)SvIV(sv); + SvREFCNT_dec(sv); + ((QUParameter*)m->parameters)[i] = *p; + delete p; + } + } else + m->count = 0; + } + RETVAL = m; + OUTPUT: + RETVAL + +void * +make_QMetaData_tbl(list) + SV *list + CODE: + RETVAL = 0; + if(SvOK(list) && SvRV(list)) { + AV *av = (AV*)SvRV(list); + int count = av_len(av) + 1; + QMetaData *m = new QMetaData[count]; + for(int i = 0; i < count; i++) { + SV *sv = av_shift(av); + if(!SvOK(sv)) + croak("Invalid metadata\n"); + QMetaData *old = (QMetaData*)SvIV(sv); + SvREFCNT_dec(sv); + m[i] = *old; + delete old; + } + RETVAL = (void*)m; + } + OUTPUT: + RETVAL + +SV * +make_metaObject(className, parent, slot_tbl, slot_count, signal_tbl, signal_count) + char *className + SV *parent + void *slot_tbl + int slot_count + void *signal_tbl + int signal_count + CODE: + smokeperl_object *po = sv_obj_info(parent); + if(!po || !po->ptr) croak("Cannot create metaObject\n"); + QMetaObject *meta = QMetaObject::new_metaobject( + className, (QMetaObject*)po->ptr, + (const QMetaData*)slot_tbl, slot_count, // slots + (const QMetaData*)signal_tbl, signal_count, // signals + 0, 0, // properties + 0, 0, // enums + 0, 0); + + // this object-creation code is so, so wrong here + HV *hv = newHV(); + SV *obj = newRV_noinc((SV*)hv); + + smokeperl_object o; + o.smoke = qt_Smoke; + o.classId = qt_Smoke->idClass("QMetaObject"); + o.ptr = meta; + o.allocated = true; + sv_magic((SV*)hv, sv_qapp, '~', (char*)&o, sizeof(o)); + MAGIC *mg = mg_find((SV*)hv, '~'); + mg->mg_virtual = &vtbl_smoke; + char *buf = qt_Smoke->binding->className(o.classId); + sv_bless(obj, gv_stashpv(buf, TRUE)); + delete[] buf; + RETVAL = obj; + OUTPUT: + RETVAL + +void +dumpObjects() + CODE: + hv_iterinit(pointer_map); + HE *e; + while(e = hv_iternext(pointer_map)) { + STRLEN len; + SV *sv = HeVAL(e); + printf("key = %s, refcnt = %d, weak = %d, ref? %d\n", HePV(e, len), SvREFCNT(sv), SvWEAKREF(sv), SvROK(sv)?1:0); + if(SvRV(sv)) + printf("REFCNT = %d\n", SvREFCNT(SvRV(sv))); + //SvREFCNT_dec(HeVAL(e)); + //HeVAL(e) = &PL_sv_undef; + } + +void +dangle(obj) + SV *obj + CODE: + if(SvRV(obj)) + SvREFCNT_inc(SvRV(obj)); + +void +setAllocated(obj, b) + SV *obj + bool b + CODE: + smokeperl_object *o = sv_obj_info(obj); + if(o) { + o->allocated = b; + } + +void +setqapp(obj) + SV *obj + CODE: + if(!obj || !SvROK(obj)) + croak("Invalid Qt::Application object. Couldn't set Qt::app()\n"); + sv_qapp = SvRV(obj); + +void +setThis(obj) + SV *obj + CODE: + sv_setsv_mg(sv_this, obj); + +void +deleteObject(obj) + SV *obj + CODE: + smokeperl_object *o = sv_obj_info(obj); + if(!o) { XSRETURN_EMPTY; } + QObject *qobj = (QObject*)o->smoke->cast(o->ptr, o->classId, o->smoke->idClass("QObject")); + delete qobj; + +void +mapObject(obj) + SV *obj + CODE: + smokeperl_object *o = sv_obj_info(obj); + if(!o) + XSRETURN_EMPTY; + SmokeClass c( o->smoke, o->classId ); + if(!c.hasVirtual() ) { + XSRETURN_EMPTY; + } + mapPointer(obj, o, pointer_map, o->classId, 0); + +bool +isQObject(obj) + SV *obj + CODE: + RETVAL = 0; + smokeperl_object *o = sv_obj_info(obj); + if(o && isQObject(o->smoke, o->classId)) + RETVAL = 1; + OUTPUT: + RETVAL + +bool +isValidAllocatedPointer(obj) + SV *obj + CODE: + RETVAL = 0; + smokeperl_object *o = sv_obj_info(obj); + if(o && o->ptr && o->allocated) + RETVAL = 1; + OUTPUT: + RETVAL + +SV* +findAllocatedObjectFor(obj) + SV *obj + CODE: + RETVAL = &PL_sv_undef; + smokeperl_object *o = sv_obj_info(obj); + SV *ret; + if(o && o->ptr && (ret = getPointerObject(o->ptr))) + RETVAL = ret; + OUTPUT: + RETVAL + +SV * +getGV(cv) + SV *cv + CODE: + RETVAL = (SvROK(cv) && (SvTYPE(SvRV(cv))==SVt_PVCV) ? + SvREFCNT_inc(CvGV((CV*)SvRV(cv))) : &PL_sv_undef); + OUTPUT: + RETVAL + +int +idClass(name) + char *name + CODE: + RETVAL = qt_Smoke->idClass(name); + OUTPUT: + RETVAL + +int +idMethodName(name) + char *name + CODE: + RETVAL = qt_Smoke->idMethodName(name); + OUTPUT: + RETVAL + +int +idMethod(idclass, idmethodname) + int idclass + int idmethodname + CODE: + RETVAL = qt_Smoke->idMethod(idclass, idmethodname); + OUTPUT: + RETVAL + +void +findMethod(c, name) + char *c + char *name + PPCODE: + Smoke::Index meth = qt_Smoke->findMethod(c, name); +// printf("DAMNIT on %s::%s => %d\n", c, name, meth); + if(!meth) { + // empty list + } else if(meth > 0) { + Smoke::Index i = qt_Smoke->methodMaps[meth].method; + if(!i) { // shouldn't happen + croak("Corrupt method %s::%s", c, name); + } else if(i > 0) { // single match + PUSHs(sv_2mortal(newSViv( + (IV)qt_Smoke->methodMaps[meth].method + ))); + } else { // multiple match + i = -i; // turn into ambiguousMethodList index + while(qt_Smoke->ambiguousMethodList[i]) { + PUSHs(sv_2mortal(newSViv( + (IV)qt_Smoke->ambiguousMethodList[i] + ))); + i++; + } + } + } + +void +findMethodFromIds(idclass, idmethodname) + int idclass + int idmethodname + PPCODE: + Smoke::Index meth = qt_Smoke->findMethod(idclass, idmethodname); + if(!meth) { + // empty list + } else if(meth > 0) { + Smoke::Index i = qt_Smoke->methodMaps[meth].method; + if(i >= 0) { // single match + PUSHs(sv_2mortal(newSViv((IV)i))); + } else { // multiple match + i = -i; // turn into ambiguousMethodList index + while(qt_Smoke->ambiguousMethodList[i]) { + PUSHs(sv_2mortal(newSViv( + (IV)qt_Smoke->ambiguousMethodList[i] + ))); + i++; + } + } + } + +# findAllMethods(classid [, startingWith]) : returns { "mungedName" => [index in methods, ...], ... } + +HV* +findAllMethods(classid, ...) + SV* classid + CODE: + RETVAL=newHV(); + if(SvIOK(classid)) { + Smoke::Index c = (Smoke::Index) SvIV(classid); + char * pat = 0L; + if(items > 1 && SvPOK(ST(1))) + pat = SvPV_nolen(ST(1)); + Smoke::Index imax = qt_Smoke->numMethodMaps; + Smoke::Index imin = 0, icur = -1, methmin = 0, methmax = 0; + int icmp = -1; + while(imax >= imin) { + icur = (imin + imax) / 2; + icmp = qt_Smoke->leg(qt_Smoke->methodMaps[icur].classId, c); + if(!icmp) { + Smoke::Index pos = icur; + while(icur && qt_Smoke->methodMaps[icur-1].classId == c) + icur --; + methmin = icur; + icur = pos; + while(icur < imax && qt_Smoke->methodMaps[icur+1].classId == c) + icur ++; + methmax = icur; + break; + } + if (icmp > 0) + imax = icur - 1; + else + imin = icur + 1; + } + if(!icmp) { + for(Smoke::Index i=methmin ; i <= methmax ; i++) { + Smoke::Index m = qt_Smoke->methodMaps[i].name; + if(!pat || !strncmp(qt_Smoke->methodNames[m], pat, strlen(pat))) { + Smoke::Index ix= qt_Smoke->methodMaps[i].method; + AV* meths = newAV(); + if(ix >= 0) { // single match + av_push(meths, newSViv((IV)ix)); + } else { // multiple match + ix = -ix; // turn into ambiguousMethodList index + while(qt_Smoke->ambiguousMethodList[ix]) { + av_push(meths, newSViv((IV)qt_Smoke->ambiguousMethodList[ix])); + ix++; + } + } + hv_store(RETVAL, qt_Smoke->methodNames[m],strlen(qt_Smoke->methodNames[m]),newRV_inc((SV*)meths),0); + } + } + } + } + OUTPUT: + RETVAL + +SV * +dumpCandidates(rmeths) + SV *rmeths + CODE: + if(SvROK(rmeths) && SvTYPE(SvRV(rmeths)) == SVt_PVAV) { + AV *methods = (AV*)SvRV(rmeths); + SV *errmsg = newSVpvf(""); + for(int i = 0; i <= av_len(methods); i++) { + sv_catpv(errmsg, "\t"); + IV id = SvIV(*(av_fetch(methods, i, 0))); + Smoke::Method &meth = qt_Smoke->methods[id]; + const char *tname = qt_Smoke->types[meth.ret].name; + if(meth.flags & Smoke::mf_static) sv_catpv(errmsg, "static "); + sv_catpvf(errmsg, "%s ", (tname ? tname:"void")); + sv_catpvf(errmsg, "%s::%s(", qt_Smoke->classes[meth.classId].className, qt_Smoke->methodNames[meth.name]); + for(int i = 0; i < meth.numArgs; i++) { + if(i) sv_catpv(errmsg, ", "); + tname = qt_Smoke->types[qt_Smoke->argumentList[meth.args+i]].name; + sv_catpv(errmsg, (tname ? tname:"void")); + } + sv_catpv(errmsg, ")"); + if(meth.flags & Smoke::mf_const) sv_catpv(errmsg, " const"); + sv_catpv(errmsg, "\n"); + } + RETVAL=errmsg; + } + else + RETVAL=newSVpvf(""); + OUTPUT: + RETVAL + +SV * +catArguments(r_args) + SV* r_args + CODE: + RETVAL=newSVpvf(""); + if(SvROK(r_args) && SvTYPE(SvRV(r_args)) == SVt_PVAV) { + AV* args=(AV*)SvRV(r_args); + for(int i = 0; i <= av_len(args); i++) { + SV **arg=av_fetch(args, i, 0); + if(i) sv_catpv(RETVAL, ", "); + if(!arg || !SvOK(*arg)) { + sv_catpv(RETVAL, "undef"); + } else if(SvROK(*arg)) { + smokeperl_object *o = sv_obj_info(*arg); + if(o) + sv_catpv(RETVAL, o->smoke->className(o->classId)); + else + sv_catsv(RETVAL, *arg); + } else { + bool isString = SvPOK(*arg); + STRLEN len; + char *s = SvPV(*arg, len); + if(isString) sv_catpv(RETVAL, "'"); + sv_catpvn(RETVAL, s, len > 10 ? 10 : len); + if(len > 10) sv_catpv(RETVAL, "..."); + if(isString) sv_catpv(RETVAL, "'"); + } + } + } + OUTPUT: + RETVAL + +SV * +callMethod(...) + PPCODE: + if(_current_method) { + MethodCall c(qt_Smoke, _current_method, &ST(0), items); + c.next(); + SV *ret = c.var(); + SvREFCNT_inc(ret); + PUSHs(sv_2mortal(ret)); + } else + PUSHs(sv_newmortal()); + +bool +isObject(obj) + SV *obj + CODE: + RETVAL = sv_to_ptr(obj) ? TRUE : FALSE; + OUTPUT: + RETVAL + +void +setCurrentMethod(meth) + int meth + CODE: + // FIXME: damn, this is lame, and it doesn't handle ambiguous methods + _current_method = meth; //qt_Smoke->methodMaps[meth].method; + +SV * +getClassList() + CODE: + AV *av = newAV(); + for(int i = 1; i <= qt_Smoke->numClasses; i++) { +//printf("%s => %d\n", qt_Smoke->classes[i].className, i); + av_push(av, newSVpv(qt_Smoke->classes[i].className, 0)); +// hv_store(hv, qt_Smoke->classes[i].className, 0, newSViv(i), 0); + } + RETVAL = newRV((SV*)av); + OUTPUT: + RETVAL + +void +installthis(package) + char *package + CODE: + if(!package) XSRETURN_EMPTY; + char *name = new char[strlen(package) + 7]; + char *file = __FILE__; + strcpy(name, package); + strcat(name, "::this"); + // *{ $name } = sub () : lvalue; + CV *thissub = newXS(name, XS_this, file); + sv_setpv((SV*)thissub, ""); // sub this () : lvalue; + delete[] name; + +void +installattribute(package, name) + char *package + char *name + CODE: + if(!package || !name) XSRETURN_EMPTY; + char *attr = new char[strlen(package) + strlen(name) + 3]; + sprintf(attr, "%s::%s", package, name); + char *file = __FILE__; + // *{ $attr } = sub () : lvalue; + CV *attrsub = newXS(attr, XS_attr, file); + sv_setpv((SV*)attrsub, ""); + CvLVALUE_on(attrsub); + CvNODEBUG_on(attrsub); + delete[] attr; + +void +installsuper(package) + char *package + CODE: + if(!package) XSRETURN_EMPTY; + char *attr = new char[strlen(package) + 8]; + sprintf(attr, "%s::SUPER", package); + char *file = __FILE__; + CV *attrsub = newXS(attr, XS_super, file); + sv_setpv((SV*)attrsub, ""); + delete[] attr; + +void +installautoload(package) + char *package + CODE: + if(!package) XSRETURN_EMPTY; + char *autoload = new char[strlen(package) + 11]; + strcpy(autoload, package); + strcat(autoload, "::_UTOLOAD"); + char *file = __FILE__; + // *{ $package."::AUTOLOAD" } = XS_AUTOLOAD + newXS(autoload, XS_AUTOLOAD, file); + delete[] autoload; + +# ----------------- XSUBS for Qt:: ----------------- + +MODULE = Qt PACKAGE = Qt + +SV * +this() + CODE: + RETVAL = newSVsv(sv_this); + OUTPUT: + RETVAL + +SV * +app() + CODE: + RETVAL = newRV_inc(sv_qapp); + OUTPUT: + RETVAL + +SV * +version() + CODE: + RETVAL = newSVpv(QT_VERSION_STR,0); + OUTPUT: + RETVAL + +BOOT: + init_qt_Smoke(); + qt_Smoke->binding = new QtSmokeBinding(qt_Smoke); + install_handlers(Qt_handlers); + pointer_map = newHV(); + sv_this = newSV(0); + methcache = new QAsciiDict<Smoke::Index>(1187); + classcache = new QAsciiDict<Smoke::Index>(827); + methcache->setAutoDelete(1); + classcache->setAutoDelete(1); diff --git a/PerlQt/bin/pqtapi b/PerlQt/bin/pqtapi new file mode 100755 index 0000000..9c5eadf --- /dev/null +++ b/PerlQt/bin/pqtapi @@ -0,0 +1,82 @@ +#!/usr/bin/perl + +# Note: this program is part of PerlQt and makes use of its internal functions. +# You should not rely on those in your own programs. + +use Getopt::Std; +use strict 'vars'; + +our (%o, @x, $h); +getopts('r:hvimp', \%o); + +package Qt::_internal; +use Qt; + +exists $o{'v'} and do{ print "PerlQt-$Qt::VERSION using Qt-".&Qt::version."\n" and exit 0 }; +exists $o{'h'} and do{ print $h and exit 0 }; +exists $o{'m'} and do{ # interactive mode for driving the Qt Designer Plugin + select(STDOUT); $| = 1; # unbuffered + while(<STDIN>) + { + chomp; + s/^Q(?=[A-Z])/Qt::/; + my $i = find_pclassid( $_ ); + print "__START__\n"; + if ($i) + { + my $a = findAllMethods( $i ); + my $t = dumpCandidates( [map {@{ $$a{$_} }} sort keys %$a] ); + getAllParents($i, \my @sup); + for my $s(@sup) + { + $a = findAllMethods( $s ); + $t.= dumpCandidates( [map {@{ $$a{$_} }} sort keys %$a] ); + } + $t =~ s/\t//gs; + print $t; + } + print "__END__\n"; + } +}; +(my $c = $ARGV[0]) =~ s/^Q(?=[A-Z])/Qt::/; +my $i = $c ? find_pclassid( $c ) : 1; +my $r = exists $o{'r'} ? (exists $o{'i'} ? qr|$o{'r'}|i : qr|$o{'r'}|) : 0; +my $d = ""; + +while ($i) +{ + my $a=findAllMethods($i); + last unless keys %$a; + @x=map {@{ $$a{$_} }} sort keys %$a; + $d = dumpCandidates(\@x); + if($c and $i and exists $o{'p'}) + { + getAllParents($i, \my @sup); + for my $s(@sup) + { + $a = findAllMethods( $s ); + $d.= dumpCandidates( [map {@{ $$a{$_} }} sort keys %$a] ); + } + } + if($r) + { + map { print "$_\n" if $_=~$r } split("\n", $d); + } + else + { + print $d + } + $c and last; + $i++ +} + +BEGIN { + $h = "pqtapi - a PerlQt introspection tool\t(c) Germain Garand 2003 <germain\@ebooksfrance.org>\n\n". + "usage: pqtapi [-r <re>] [<class>]\n\n". + "options:\n". + "\t-r <re> : find all functions matching regular expression/keyword <re>\n". + "\t-i : together with -r, performs a case insensitive search\n". + "\t-p : display also inherited methods for <class>.\n". + "\t-v : print PerlQt and Qt versions\n". + "\t-h : print this help message\n"; +} diff --git a/PerlQt/bin/pqtsh b/PerlQt/bin/pqtsh new file mode 100755 index 0000000..11a9e64 --- /dev/null +++ b/PerlQt/bin/pqtsh @@ -0,0 +1,675 @@ +#!/usr/bin/perl + +# pqtsh : a graphical shell for PerlQt. +# +# author: Germain Garand <germain@ebooksfrance.org> +# license: GNU Public License v2 +# + +use utf8; +use strict 'vars'; + +package QtShellControl; + +use Qt; +use Qt::isa qw(Qt::MainWindow); +use Qt::slots + fileOpen => [], + fileSave => [], + fileSaveAs => [], + filePrint => [], + fileExit => [], + helpExample => []; +use Qt::signals + fileNeedsEval => [QString]; +use Qt::attributes qw( + menubar + fileMenu + helpMenu + toolBar + fileName + fileOpenAction + fileSaveAction + fileSaveAsAction + filePrintAction + fileExitAction + helpExampleAction + comboBox + sessionLog + executedLines + printer +); + +our $image0_data = +["22 22 7 1", +". c None", +"# c #000000", +"b c #292c29", +"c c #5a5d5a", +"d c #838583", +"e c #c5c2c5", +"a c #ffffff", +"......................", +"....##########........", +"....#aaaaaaa#b#.......", +"....#aaaaaaa#cb#......", +"....#aaaaaaa#dcb#.....", +"....#aaaaaaa#edcb#....", +"....#aaaaaaa#aedcb#...", +"....#aaaaaaa#######...", +"....#aaaaaaaaaaaaa#...", +"....#aaaaaaaaaaaaa#...", +"....#aaaaaaaaaaaaa#...", +"....#aaaaaaaaaaaaa#...", +"....#aaaaaaaaaaaaa#...", +"....#aaaaaaaaaaaaa#...", +"....#aaaaaaaaaaaaa#...", +"....#aaaaaaaaaaaaa#...", +"....#aaaaaaaaaaaaa#...", +"....#aaaaaaaaaaaaa#...", +"....#aaaaaaaaaaaaa#...", +"....###############...", +"......................", +"......................"]; + +our $image1_data = +["22 22 5 1", +". c None", +"# c #000000", +"c c #838100", +"a c #ffff00", +"b c #ffffff", +"......................", +"......................", +"......................", +"............####....#.", +"...........#....##.##.", +"..................###.", +".................####.", +".####...........#####.", +"#abab##########.......", +"#babababababab#.......", +"#ababababababa#.......", +"#babababababab#.......", +"#ababab###############", +"#babab##cccccccccccc##", +"#abab##cccccccccccc##.", +"#bab##cccccccccccc##..", +"#ab##cccccccccccc##...", +"#b##cccccccccccc##....", +"###cccccccccccc##.....", +"##cccccccccccc##......", +"###############.......", +"......................"]; + +our $image2_data = +["22 22 5 1", +". c None", +"# c #000000", +"a c #838100", +"b c #c5c2c5", +"c c #cdb6d5", +"......................", +".####################.", +".#aa#bbbbbbbbbbbb#bb#.", +".#aa#bbbbbbbbbbbb#bb#.", +".#aa#bbbbbbbbbcbb####.", +".#aa#bbbccbbbbbbb#aa#.", +".#aa#bbbccbbbbbbb#aa#.", +".#aa#bbbbbbbbbbbb#aa#.", +".#aa#bbbbbbbbbbbb#aa#.", +".#aa#bbbbbbbbbbbb#aa#.", +".#aa#bbbbbbbbbbbb#aa#.", +".#aaa############aaa#.", +".#aaaaaaaaaaaaaaaaaa#.", +".#aaaaaaaaaaaaaaaaaa#.", +".#aaa#############aa#.", +".#aaa#########bbb#aa#.", +".#aaa#########bbb#aa#.", +".#aaa#########bbb#aa#.", +".#aaa#########bbb#aa#.", +".#aaa#########bbb#aa#.", +"..##################..", +"......................"]; + +our $image3_data = +["22 22 88 2", +"Qt c None", +".2 c #000000", +".S c #08ff08", +"#v c #100810", +".U c #101010", +"#c c #101018", +".M c #181018", +"#e c #181818", +".A c #181820", +".L c #201820", +"#l c #202020", +".z c #202029", +"#m c #292029", +"#u c #292829", +"#n c #292831", +".R c #29ff29", +"#o c #312831", +".T c #313031", +"#p c #313039", +".Z c #31ff31", +"#q c #393039", +"#t c #393839", +".y c #393841", +"#s c #413841", +".o c #414041", +"#h c #4a4852", +".n c #5a505a", +"#r c #5a5962", +".I c #5ace5a", +"#b c #6a616a", +".p c #6a696a", +".x c #6a6973", +".Y c #6aff62", +".l c #736973", +".t c #7b717b", +".s c #7b7183", +".0 c #7bff7b", +".r c #837983", +".u c #83798b", +"#g c #83858b", +".v c #8b7994", +"#i c #8b858b", +".w c #8b8594", +"#j c #8b8d8b", +".8 c #8b8d94", +".m c #948d94", +"#k c #948d9c", +"#f c #949594", +".q c #94959c", +".J c #94c694", +"#d c #9c959c", +"#a c #9c95a4", +".k c #9c9d9c", +".N c #9c9da4", +".H c #9ccea4", +".K c #a49da4", +"#. c #a49dac", +".i c #a4a5a4", +".3 c #a4a5ac", +"## c #ac9dac", +".V c #aca5ac", +".d c #acaeac", +".j c #acaeb4", +".9 c #b4aeb4", +".# c #b4b6b4", +".a c #bdbebd", +".7 c #bdd6bd", +".c c #c5c6c5", +".5 c #cdc6cd", +".b c #cdcecd", +".4 c #cdced5", +".F c #d5ced5", +".G c #d5cede", +".h c #d5d6d5", +".E c #d5d6de", +".Q c #d5ffd5", +".B c #ded6de", +".1 c #ded6e6", +".g c #dedede", +".D c #dedee6", +".6 c #e6dee6", +".f c #e6e6e6", +".C c #e6e6ee", +".X c #e6ffe6", +".O c #eee6ee", +".e c #eeeeee", +".W c #f6f6f6", +".P c #ffffff", +"QtQtQtQtQtQt.#.a.b.b.b.b.c.c.a.a.d.aQtQtQtQt", +"QtQtQtQtQtQt.a.e.f.f.f.f.f.e.e.e.g.aQtQtQtQt", +"QtQtQtQtQtQt.a.c.c.c.b.b.c.c.c.c.a.cQtQtQtQt", +"QtQtQtQtQtQt.#.a.a.a.a.#.a.a.#.#.d.aQtQtQtQt", +"QtQtQtQtQt.c.d.c.a.c.c.c.a.a.a.c.#QtQtQtQtQt", +"QtQtQtQtQt.a.a.#.a.a.a.a.a.a.c.c.#QtQtQtQtQt", +"QtQtQtQtQt.a.#.c.a.a.a.a.a.c.a.c.dQtQtQtQtQt", +"QtQtQtQtQt.c.a.a.a.a.a.a.a.a.a.a.#QtQtQtQtQt", +"QtQtQtQtQt.d.b.f.g.g.g.g.g.g.h.g.i.i.jQtQtQt", +"QtQtQt.a.k.l.#.h.b.h.b.h.b.h.g.g.m.n.o.p.#Qt", +"QtQt.a.q.r.s.t.t.t.t.t.t.t.u.v.w.x.y.z.A.o.i", +"Qt.a.k.B.C.D.B.E.E.E.E.F.G.H.I.J.K.o.L.L.M.y", +".a.N.O.P.P.P.P.P.P.P.P.P.Q.R.S.R.b.v.T.A.U.L", +".V.W.P.P.P.P.P.P.P.P.P.P.X.Y.Z.0.P.1.t.A.2.L", +".3.E.4.5.4.h.E.E.g.6.D.B.D.E.7.F.4.5.8.M.2.A", +".m.9.j.V.3#..3.K#.#..i#..K#.###a.q.8#b#c.2.L", +".m.j.j#..3.K.K.K.N.K.N.N.N.N#a#d#d.w#b#c.2#e", +"#f#.#..K.N.K.N.N.N#a.k#a#d#d#d#a.m#g#b.M.2#h", +".m.3.K.K#a.k#a#d#a.k#a#d#a#d.q.m.8#i.x#c#e.d", +"#f#g#i.w#j.w#i.8.w#i.8.8.m.8.m#k.8.w#b#e#fQt", +".#.l.z.A#l.z#m#m#m#n#o#o#p#p#q#q#p#o#p#fQtQt", +"QtQt.d#r#s#s#t#p.T.T.T#u#u.z#e#e#v.o.kQtQtQt"]; + + +sub NEW +{ + shift->SUPER::NEW(@_); + + my $image0 = Qt::Pixmap($image0_data); + my $image1 = Qt::Pixmap($image1_data); + my $image2 = Qt::Pixmap($image2_data); + my $image3 = Qt::Pixmap($image3_data); + my $box = VBox(this); + sessionLog = TextEdit($box, "sessionLog"); + sessionLog->setTextFormat(Qt::RichText()); + sessionLog->setReadOnly(1); + comboBox = ComboBox($box, "comboBox"); + comboBox->setEditable(1); + comboBox->setAutoCompletion(1); + this->setCentralWidget($box); + comboBox->setFocus; + this->resize(500,300); + setCaption("PerlQt Shell"); +# fileNewAction= Qt::Action(this, "fileNewAction"); +# fileNewAction->setIconSet(Qt::IconSet($image0)); +# fileNewAction->setText(trUtf8("New")); +# fileNewAction->setMenuText(trUtf8("&New")); +# fileNewAction->setAccel(KeySequence(trUtf8("Ctrl+N"))); + fileOpenAction= Qt::Action(this, "fileOpenAction"); + fileOpenAction->setIconSet(Qt::IconSet($image1)); + fileOpenAction->setText(trUtf8("Open")); + fileOpenAction->setMenuText(trUtf8("&Open...")); + fileOpenAction->setAccel(KeySequence(trUtf8("Ctrl+O"))); + fileSaveAction= Qt::Action(this, "fileSaveAction"); + fileSaveAction->setIconSet(Qt::IconSet($image2)); + fileSaveAction->setText(trUtf8("Save")); + fileSaveAction->setMenuText(trUtf8("&Save")); + fileSaveAction->setAccel(KeySequence(trUtf8("Ctrl+S"))); + fileSaveAsAction= Qt::Action(this, "fileSaveAsAction"); + fileSaveAsAction->setText(trUtf8("Save As")); + fileSaveAsAction->setMenuText(trUtf8("Save &As...")); + fileSaveAsAction->setAccel(KeySequence(trUtf8("Ctrl+A"))); + filePrintAction= Qt::Action(this, "filePrintAction"); + filePrintAction->setIconSet(Qt::IconSet($image3)); + filePrintAction->setText(trUtf8("Print")); + filePrintAction->setMenuText(trUtf8("&Print...")); + filePrintAction->setAccel(KeySequence(trUtf8("Ctrl+P"))); + fileExitAction= Qt::Action(this, "fileExitAction"); + fileExitAction->setText(trUtf8("Exit")); + fileExitAction->setMenuText(trUtf8("E&xit")); + fileExitAction->setAccel(KeySequence(trUtf8("Ctrl+E"))); + + helpExampleAction= Qt::Action(this, "helpExampleAction"); + helpExampleAction->setText(trUtf8("Example")); + helpExampleAction->setMenuText(trUtf8("Examp&le")); + helpExampleAction->setAccel(KeySequence(trUtf8("Ctrl+L"))); + + toolBar = Qt::ToolBar("", this, DockTop()); + + toolBar->setLabel(trUtf8("Tools")); + fileOpenAction->addTo(toolBar); + fileSaveAction->addTo(toolBar); + filePrintAction->addTo(toolBar); + + + menubar= Qt::MenuBar( this, "menubar"); + + fileMenu= Qt::PopupMenu(this); +# fileNewAction->addTo(fileMenu); + fileOpenAction->addTo(fileMenu); + fileSaveAction->addTo(fileMenu); + fileSaveAsAction->addTo(fileMenu); + fileMenu->insertSeparator; + filePrintAction->addTo(fileMenu); + fileMenu->insertSeparator; + fileExitAction->addTo(fileMenu); + menubar->insertItem(trUtf8("&File"), fileMenu); + + menubar->insertSeparator; + + helpMenu= Qt::PopupMenu(this); + helpExampleAction->addTo(helpMenu); + menubar->insertItem(trUtf8("&Help"), helpMenu); + +# Qt::Object::connect(fileNewAction, SIGNAL "activated()", this, SLOT "fileNew()"); + Qt::Object::connect(fileOpenAction, SIGNAL "activated()", this, SLOT "fileOpen()"); + Qt::Object::connect(fileSaveAction, SIGNAL "activated()", this, SLOT "fileSave()"); + Qt::Object::connect(fileSaveAsAction, SIGNAL "activated()", this, SLOT "fileSaveAs()"); + Qt::Object::connect(filePrintAction, SIGNAL "activated()", this, SLOT "filePrint()"); + Qt::Object::connect(fileExitAction, SIGNAL "activated()", this, SLOT "fileExit()"); + Qt::Object::connect(helpExampleAction, SIGNAL "activated()", this, SLOT "helpExample()"); + + + executedLines = []; +} + +#sub fileNew +#{ +# print "Form1->fileNew(): Not implemented yet.\n"; +#} + +sub fileOpen +{ + my $fn = Qt::FileDialog::getOpenFileName( + ".", + "Pqtsh Session (*.pqts)", + this, + "open session", + "Choose a file to open" ); + $fn or return; + emit fileNeedsEval($fn); + +} + +sub getFileName +{ + fileName = Qt::FileDialog::getSaveFileName( + ".", + "Pqtsh Session (*.pqts)", + this, + "save session", + "Choose a filename" ); + fileName !~ /\.pqts$/ and fileName = fileName . ".pqts"; + return fileName; +} + + +sub save +{ + my $fn = shift; + open( OUT, ">$fn") or do { + Qt::MessageBox::critical( + this, + "Error" , + "Couldn't open $fn for writing: $!", + &Qt::MessageBox::Ok, + &Qt::MessageBox::NoButton ); + return + }; + for (@{ &executedLines }) + { + next if /^\s*$/; + chomp; + $_ .= ";" unless /;\s*$/; + print OUT $_, "\n" + } + close OUT +} + +sub fileSave +{ + emptySession() and return; + my $fn = fileName || getFileName(); + $fn or return; + save($fn) +} + +sub fileSaveAs +{ + emptySession() and return; + my $fn; + my ($cond, $doit); + AGAIN: + { + $fn = getFileName(); + $fn or return; + if( -e $fn ) + { + $cond++; + $doit = Qt::MessageBox::warning( + this, + "Warning" , + "File exists, overwrite ?", + &Qt::MessageBox::Yes, + &Qt::MessageBox::No ); + } + else + { $cond = 0 } + } + goto AGAIN if $cond and $doit == &Qt::MessageBox::No; + save($fn) +} + +sub filePrint +{ + my $Margin = 10; + my $pageNo = 1; + emptySession() and return; + printer = Qt::Printer unless printer; + if ( printer->setup(this) ) { + statusBar()->message( "Printing..." ); + my $p = Qt::Painter; + if( !$p->begin( printer ) ) + { + statusBar()->message( "An error occured..." ); + return + } + + $p->setFont( sessionLog->font() ); + my $yPos = 0; + my $fm = $p->fontMetrics; + my $metrics = Qt::PaintDeviceMetrics( printer ); + + for( my $i = 0 ; $i < @{ &executedLines } ; $i++ ) { + if ( $Margin + $yPos > $metrics->height() - $Margin ) { + my $msg ="Printing (page ". ++$pageNo . ")..."; + statusBar()->message( $msg ); + printer->newPage(); + $yPos = 0; + } + $p->drawText( $Margin, $Margin + $yPos, + $metrics->width(), $fm->lineSpacing(), + &ExpandTabs | &DontClip, + ${ &executedLines }[ $i ] ); + $yPos = $yPos + $fm->lineSpacing(); + } + $p->end(); + statusBar()->message( "Printing completed", 3000 ); + } else { + statusBar()->message( "Printing aborted", 3000 ); + } +} + +sub fileExit +{ + emit Qt::app()->quit() if confirmExit(); +} + +sub closeEvent +{ + my $e = shift; + if(confirmExit()) + { + $e->accept + } + else + { + $e->ignore + } +} + +sub confirmExit +{ + my $doit; + if(@{ &executedLines }) + { + $doit = Qt::MessageBox::warning( + this, + "Warning" , + "A session is opened, quit anyway ?", + &Qt::MessageBox::Yes, + &Qt::MessageBox::No ); + } + else + { return 1 } + + return (($doit == &Qt::MessageBox::No) ? 0 : 1); +} + +sub emptySession +{ + unless (@{ &executedLines }) + { + statusBar()->message("Session is empty...", 3000); + return 1; + } + 0 +} + +sub helpExample +{ + emit fileNeedsEval("__DATA__") +} + +1; + +package QtShell; + +use Qt; +use Qt::isa qw(Qt::MainWindow); +use Qt::slots + evalInput=>[], + evalFile=>[QString]; +use Qt::attributes qw( + shellWindow +); +use QtShellControl; + +sub NEW +{ + shift->SUPER::NEW(@_); + + shellWindow = QtShellControl(undef, "shellWindow"); + this->resize(350,350); + this->move(Point(10,10)); + shellWindow->move(Point(300,200)); + this->show; + shellWindow->show; + + + this->connect(shellWindow->comboBox->lineEdit, SIGNAL 'returnPressed()', SLOT 'evalInput()'); + this->{'prompt'} = '<b><font color="blue">$></font></b>'; + setCaption("MainWindow - this"); + shellWindow->sessionLog->setText("Ready.<br>"); + Qt::Object::connect(shellWindow, SIGNAL 'fileNeedsEval(QString)', this, SLOT 'evalFile(QString)'); +} + +sub logAppend +{ + shellWindow->sessionLog->setText( shellWindow->sessionLog->text . shift ) +} + +sub evalInput +{ + evalOneLine( shellWindow->comboBox->currentText ); +} + +sub evalOneLine +{ + my $prot = my $ln = shift; + $prot =~ s/</</gs; + $prot =~ s/>/>/gs; + logAppend( this->{'prompt'}. "$prot<br>" ); + { + no strict; + eval $ln; + } + if($@) + { + my $prot = $@ ; + $prot =~ s/</</gs; + $prot =~ s/>/>/gs; + my $c = shellWindow->sessionLog->color; + $prot =~ s/\n/<br>/gs; + logAppend('<font color="red">'.$prot.'</font><br>'); + shellWindow->sessionLog->setColor( $c ); + } + else + { + push @{ shellWindow()->{'executedLines'} }, $ln; + shellWindow->comboBox->clearEdit; + shellWindow->comboBox->setFocus; + } + shellWindow->sessionLog->scrollToBottom +} + +sub evalFile +{ + my $fn = shift; + my $fh; + if($fn eq "__DATA__") + { + $fh = \*::DATA + } + else + { + open($fh, $fn) or do { + Qt::MessageBox::warning ( + this, + "Error" , + "Couldn't open $fn: $!", + &Qt::MessageBox::Ok, + &Qt::MessageBox::NoButton ); + return + }; + } + while(<$fh>) + { + evalOneLine($_) + } + close $fh +} + +1; + +package Qt::TextHandle; + +sub TIEHANDLE { my ( $classnm, $widg, $color) = @_; + my $h = { widg => $widg, color => $color}; + bless $h, $classnm; + +} + +sub PRINT { + my $me = shift; + my $color = $me->{color}; + my $printed = join $/, @_; + $printed =~ s/</</gs; + $printed =~ s/>/>/gs; + $printed =~ s/\n/<br>/gs; + $me->{widg}->setText( $me->{widg}->text . "<font color=\"$color\">$printed</font>" ); + +} + +sub PRINTF { shift->PRINT(sprintf shift, @_); } +sub CLOSE { shift->UNTIE; } +sub UNTIE { } + + +1; + +package main; +use strict; +use Qt; +use QtShell; +use Qt::debug; + +my $app = Qt::Application(\@ARGV); +my $w = QtShell(undef, "mainWindow"); +my $shw = $w->shellWindow; +$app->setMainWidget($shw); +tie *STDOUT, 'Qt::TextHandle', $shw->sessionLog, 'black'; +tie *STDERR, 'Qt::TextHandle', $shw->sessionLog, 'red'; + +exit $app->exec; + +__DATA__ +statusBar()->message("Hello World !"); +use Qt::attributes qw|datetime button textedit sample vbox| ; +vbox = VBox(this); +datetime = DateTimeEdit(vbox); +textedit = Qt::TextEdit(vbox); +button = PushButton("Hello World!", vbox) ; +this->setCentralWidget(vbox); +resize(220,240); +vbox->show; +sample = Qt::PopupMenu( this ); +use Qt::slots 'there' => []; +sample->insertItem("&There", this, SLOT 'there()'); +menuBar()->insertItem("&Here", sample); +sub there { statusBar()->message("There...", 2000) }; diff --git a/PerlQt/examples/aclock/AnalogClock.pm b/PerlQt/examples/aclock/AnalogClock.pm new file mode 100644 index 0000000..d4aeff9 --- /dev/null +++ b/PerlQt/examples/aclock/AnalogClock.pm @@ -0,0 +1,137 @@ +package AnalogClock; +use Qt; +use Qt::isa qw(Qt::Widget); +use Qt::slots + setTime => ['const QTime&'], + drawClock => ['QPainter*'], + timeout => []; +use Qt::attributes qw( + clickPos + _time +); + +# +# Constructs an analog clock widget that uses an internal QTimer +# + +sub NEW { + shift->SUPER::NEW(@_); + _time = Qt::Time::currentTime(); # get current time + my $internalTimer = Qt::Timer(this); # create internal timer + this->connect($internalTimer, SIGNAL('timeout()'), SLOT('timeout()')); + $internalTimer->start(5000); # emit signal every 5 seconds +} + +sub mousePressEvent { + my $e = shift; + if(isTopLevel()) { + # Lack of operators is really noticable here + my $topLeft = Qt::Point( + geometry()->topLeft->x - frameGeometry()->topLeft->x, + geometry()->topLeft->y - frameGeometry()->topLeft->y + ); + clickPos = Qt::Point($e->pos->x + $topLeft->x, + $e->pos->y + $topLeft->y); + } +} + +sub mouseMoveEvent { + my $e = shift; + if(isTopLevel()) { + move(Qt::Point($e->globalPos->x - clickPos->x, + $e->globalPos->y - clickPos->y)); + } +} + +sub setTime { + my $t = shift; + timeout(); +} + +# +# The QTimer::timeout() signal is received by this slot. +# + +sub timeout { + my $new_time = Qt::Time::currentTime(); # get the current time + _time = _time->addSecs(5); + if($new_time->minute != _time->minute) { # minute has changed + if(autoMask()) { + updateMask(); + } else { + update(); + } + } +} + +sub paintEvent { + return if autoMask(); + my $paint = Qt::Painter(this); + $paint->setBrush(colorGroup()->foreground); + drawClock($paint); +} + +# If clock is transparent, we use updateMask() +# instead of paintEvent() + +sub updateMask { # paint clock mask + my $bm = Qt::Bitmap(size()); + $bm->fill(&color0); # transparent + + my $paint = Qt::Painter; + $paint->begin($bm, this); + $paint->setBrush(&color1); # use non-transparent color + $paint->setPen(&color1); + + drawClock($paint); + + $paint->end; + setMask($bm); +} + +# +# The clock is painted using a 1000x1000 square coordinate system, in +# the centered square, as big as possible. The painter's pen and +# brush colors are used. +# +sub drawClock { + my $paint = shift; + $paint->save; + + $paint->setWindow(-500,-500, 1000,1000); + + my $v = $paint->viewport; + my $d = min($v->width, $v->height); + $paint->setViewport($v->left + ($v->width-$d)/2, + $v->top - ($v->height-$d)/2, $d, $d); + + # _time = Qt::Time::currentTime(); + my $pts = Qt::PointArray(); + + $paint->save; + $paint->rotate(30*(_time->hour%12-3) + _time->minute/2); + $pts->setPoints([-20,0, 0,-20, 300,0, 0,20]); + $paint->drawConvexPolygon($pts); + $paint->restore; + + $paint->save; + $paint->rotate((_time->minute-15)*6); + $pts->setPoints([-10,0, 0,-10, 400,0, 0,10]); + $paint->drawConvexPolygon($pts); + $paint->restore; + + for(1 .. 12) { + $paint->drawLine(440,0, 460,0); + $paint->rotate(30); + } + + $paint->restore; +} + +sub setAutoMask { + my $b = shift; + setBackgroundMode($b ? &PaletteForeground : &PaletteBackground); + Qt::Widget::setAutoMask($b); +} + +1; diff --git a/PerlQt/examples/aclock/aclock.pl b/PerlQt/examples/aclock/aclock.pl new file mode 100644 index 0000000..ff59ec1 --- /dev/null +++ b/PerlQt/examples/aclock/aclock.pl @@ -0,0 +1,13 @@ +#!/usr/bin/perl -w +use strict; +use Qt; +use AnalogClock; + +my $a = Qt::Application(\@ARGV); +my $clock = AnalogClock; +$clock->setAutoMask(1) if @ARGV and $ARGV[0] eq '-transparent'; +$clock->resize(100, 100); +$a->setMainWidget($clock); +$clock->setCaption("PerlQt example - Analog Clock"); +$clock->show; +exit $a->exec; diff --git a/PerlQt/examples/buttongroups/ButtonsGroups.pm b/PerlQt/examples/buttongroups/ButtonsGroups.pm new file mode 100644 index 0000000..0bb6c73 --- /dev/null +++ b/PerlQt/examples/buttongroups/ButtonsGroups.pm @@ -0,0 +1,104 @@ +package ButtonsGroups; +use strict; +use Qt; +use Qt::isa qw(Qt::Widget); +use Qt::slots + slotChangeGrp3State => []; +use Qt::attributes qw( + state + rb21 + rb22 + rb23 +); + +# +# Constructor +# +# Creates all child widgets of the ButtonGroups window +# + +sub NEW { + shift->SUPER::NEW(@_); + + # Create Widgets which allow easy layouting + my $vbox = Qt::VBoxLayout(this); + my $box1 = Qt::HBoxLayout($vbox); + my $box2 = Qt::HBoxLayout($vbox); + + # ------- first group + + # Create an exclusive button group + my $bgrp1 = Qt::ButtonGroup(1, &Horizontal, "Button Group &1 (exclusive)", this); + $box1->addWidget($bgrp1); + $bgrp1->setExclusive(1); + + # insert 3 radiobuttons + Qt::RadioButton("R&adiobutton 2", $bgrp1); + Qt::RadioButton("Ra&diobutton 3", $bgrp1); + + # ------- second group + + # Create a non-exclusive buttongroup + my $bgrp2 = Qt::ButtonGroup(1, &Horizontal, "Button Group &2 (non-exclusive)", this); + $box1->addWidget($bgrp2); + $bgrp2->setExclusive(0); + + # insert 3 checkboxes + Qt::CheckBox("&Checkbox 1", $bgrp2); + my $cb12 = Qt::CheckBox("C&heckbox 2", $bgrp2); + $cb12->setChecked(1); + my $cb13 = Qt::CheckBox("Triple &State Button", $bgrp2); + $cb13->setTristate(1); + $cb13->setChecked(1); + + # ----------- third group + + # create a buttongroup which is exclusive for radiobuttons and non-exclusive for all other buttons + my $bgrp3 = Qt::ButtonGroup(1, &Horizontal, "Button Group &3 (Radiobutton-exclusive)", this); + $box2->addWidget($bgrp3); + $bgrp3->setRadioButtonExclusive(1); + + # insert three radiobuttons + rb21 = Qt::RadioButton("Rad&iobutton 1", $bgrp3); + rb22 = Qt::RadioButton("Radi&obutton 2", $bgrp3); + rb23 = Qt::RadioButton("Radio&button 3", $bgrp3); + rb23->setChecked(1); + + # insert a checkbox + state = Qt::CheckBox("E&nable Radiobuttons", $bgrp3); + state->setChecked(1); + # ...and connect its SIGNAL clicked() with the SLOT slotChangeGrp3State() + this->connect(state, SIGNAL('clicked()'), SLOT('slotChangeGrp3State()')); + + # ----------- fourth group + + # create a groupbox which layouts its childs in a columns + my $bgrp4 = Qt::ButtonGroup(1, &Horizontal, "Groupbox with &normal buttons", this); + $box2->addWidget($bgrp4); + + # insert three pushbuttons... + Qt::PushButton("&Push Button", $bgrp4); + my $tb2 = Qt::PushButton("&Toggle Button", $bgrp4); + my $tb3 = Qt::PushButton("&Flat Button", $bgrp4); + + # ... and make the second one a toggle button + $tb2->setToggleButton(1); + $tb2->setOn(1); + + # ... and make the third one a flat button + $tb3->setFlat(1); +} + +# +# SLOT slotChangeGrp3State() +# +# enables/disables the radiobuttons of the third buttongroup +# + +sub slotChangeGrp3State { + rb21->setEnabled(state->isChecked); + rb22->setEnabled(state->isChecked); + rb23->setEnabled(state->isChecked); +} + +1; diff --git a/PerlQt/examples/buttongroups/buttongroups.pl b/PerlQt/examples/buttongroups/buttongroups.pl new file mode 100644 index 0000000..3fdf884 --- /dev/null +++ b/PerlQt/examples/buttongroups/buttongroups.pl @@ -0,0 +1,13 @@ +#!/usr/bin/perl -w +use strict; +use Qt; +use ButtonsGroups; + +my $a = Qt::Application(\@ARGV); + +my $buttonsgroups = ButtonsGroups; +$buttonsgroups->resize(500, 250); +$buttonsgroups->setCaption("PerlQt Example - Buttongroups"); +$a->setMainWidget($buttonsgroups); +$buttonsgroups->show; +exit $a->exec; diff --git a/PerlQt/examples/dclock/DigitalClock.pm b/PerlQt/examples/dclock/DigitalClock.pm new file mode 100644 index 0000000..4611272 --- /dev/null +++ b/PerlQt/examples/dclock/DigitalClock.pm @@ -0,0 +1,88 @@ +package DigitalClock; +use strict; +use Qt; +use Qt::isa qw(Qt::LCDNumber); +use Qt::slots + stopDate => [], + showTime => []; +use Qt::attributes qw( + showingColon + normalTimer + showDateTimer +); + +# +# Constructs a DigitalClock widget +# + +sub NEW { + shift->SUPER::NEW(@_); + showingColon = 0; + setFrameStyle(&Panel | &Raised); + setLineWidth(2); + showTime(); + normalTimer = startTimer(500); + showDateTimer = -1; +} + +# +# Handles timer events and the digital clock widget. +# There are two different timers; one timer for updating the clock +# and another one for switching back from date mode to time mode +# + +sub timerEvent { + my $e = shift; + if($e->timerId == showDateTimer) { # stop showing date + stopDate(); + } elsif(showDateTimer == -1) { # normal timer + showTime(); + } +} + +# +# Enters date mode when the left mouse button is pressed +# + +sub mousePressEvent { + my $e = shift; + showDate() if $e->button == &LeftButton; +} + +# +# Shows the durrent date in the internal lcd widget. +# Fires a timer to stop showing the date. +# + +sub showDate { + return if showDateTimer != -1; # already showing date + my $date = Qt::Date::currentDate(); + my $s = sprintf("%2d %2d", $date->month, $date->day); + display($s); # sets the LCD number/text + showDateTimer = startTimer(2000); # keep this state for 2 secs +} + +# +# Stops showing the date. +# + +sub stopDate { + killTimer(showDateTimer); + showDateTimer = -1; + showTime(); +} + +# +# Shows the current time in the internal lcd widget. +# + +sub showTime { + showingColon = !showingColon; + my $s = substr(Qt::Time::currentTime()->toString, 0, 5); + $s =~ s/^0/ /; + $s =~ s/:/ / unless showingColon; + display($s); +} + +1; + diff --git a/PerlQt/examples/dclock/dclock.pl b/PerlQt/examples/dclock/dclock.pl new file mode 100644 index 0000000..f5820fd --- /dev/null +++ b/PerlQt/examples/dclock/dclock.pl @@ -0,0 +1,12 @@ +#!/usr/bin/perl -w +use strict; +use Qt; +use DigitalClock; + +my $a = Qt::Application(\@ARGV); +my $clock = DigitalClock; +$clock->resize(170, 80); +$a->setMainWidget($clock); +$clock->setCaption("PerlQt Example - Digital Clock"); +$clock->show; +exit $a->exec; diff --git a/PerlQt/examples/drawdemo/drawdemo.pl b/PerlQt/examples/drawdemo/drawdemo.pl new file mode 100644 index 0000000..c58e10d --- /dev/null +++ b/PerlQt/examples/drawdemo/drawdemo.pl @@ -0,0 +1,198 @@ +#!/usr/bin/perl -w +use strict; +package DrawView; +use Qt; +use Qt::isa qw(Qt::Widget); +use Qt::slots + updateIt => ['int'], + printIt => []; +use Qt::attributes qw( + printer + bgroup + _print + drawindex + maxindex +); + +# +# First we define the functionality our demo should present +# to the user. You might add different demo-modes if you wish so +# + +# +# This function draws a color wheel. +# The coordinate system x=(0..500), y=(0..500) spans the paint device. +# + +sub drawColorWheel { + my $p = shift; + my $f = Qt::Font("times", 18, &Qt::Font::Bold); + $p->setFont($f); + $p->setPen(&black); + $p->setWindow(0, 0, 500, 500); # defines coordinate system + + for my $i (0..35) { + my $matrix = Qt::WMatrix; + $matrix->translate(250.0, 250.0); # move to center + $matrix->shear(0.0, 0.3); # twist it + $matrix->rotate($i*10.0); # rotate 0,10,20,.. degrees + $p->setWorldMatrix($matrix); # use this world matrix + + my $c = Qt::Color; + $c->setHsv($i*10, 255, 255); # rainbow effect + $p->setBrush($c); # solid fill with color $c + $p->drawRect(70, -10, 80, 10); # draw the rectangle + + my $n = sprintf "H=%d", $i*10; + $p->drawText(80+70+5, 0, $n); # draw the hue number + } +} + +# +# This function draws a few lines of text using different fonts. +# + +sub drawFonts { + my $p = shift; + my @fonts = qw(Helvetica Courier Times); + my @sizes = (10, 12, 18, 24, 36); + my $y = 0; + for my $f (@fonts) { + for my $s (@sizes) { + my $font = Qt::Font($f, $s); + $p->setFont($font); + my $fm = $p->fontMetrics; + $y += $fm->ascent; + $p->drawText(10, $y, "Quartz Glyph Job Vex'd Cwm Finks"); + $y += $fm->descent; + } + } +} + +# +# This function draws some shapes +# + +sub drawShapes { + my $p = shift; + my $b1 = Qt::Brush(&blue); + my $b2 = Qt::Brush(&green, &Dense6Pattern); # green 12% fill + my $b3 = Qt::Brush(&NoBrush); # void brush + my $b4 = Qt::Brush(&CrossPattern); # black cross pattern + + $p->setPen(&red); + $p->setBrush($b1); + $p->drawRect(10, 10, 200, 100); + $p->setBrush($b2); + $p->drawRoundRect(10, 150, 200, 100, 20, 20); + $p->setBrush($b3); + $p->drawEllipse(250, 10, 200, 100); + $p->setBrush($b4); + $p->drawPie(250, 150, 200, 100, 45*16, 90*16); +} + +our @drawFunctions = ( +# title presented to user, reference to the function + { name => "Draw color wheel", f => \&drawColorWheel }, + { name => "Draw fonts" , f => \&drawFonts }, + { name => "Draw shapes" , f => \&drawShapes }, +); + +# +# Construct the DrawView with buttons. +# + +sub NEW { + shift->SUPER::NEW(@_); + + setCaption("PerlQt Draw Demo Application"); + setBackgroundColor(&white); + + # Create a button group to contain all buttons + bgroup = Qt::ButtonGroup(this); + bgroup->resize(200, 200); + this->connect(bgroup, SIGNAL('clicked(int)'), SLOT('updateIt(int)')); + + # Calculate the size for the radio buttons + my $maxwidth = 80; + my $maxheight = 10; + my $fm = bgroup->fontMetrics; + + for my $i (0 .. $#drawFunctions) { + my $n = $drawFunctions[$i]{name}; + my $w = $fm->width($n); + $maxwidth = max($w, $maxwidth); + } + + $maxwidth += 30; + + for my $i (0 .. $#drawFunctions) { + my $n = $drawFunctions[$i]{name}; + my $rb = Qt::RadioButton($n, bgroup); + $rb->setGeometry(10, $i*30+10, $maxwidth, 30); + + $maxheight += 30; + + $rb->setChecked(1) unless $i; + $i++; + } + + $maxheight += 10; + + drawindex = 0; + maxindex = scalar @drawFunctions; + $maxwidth += 20; + + bgroup->resize($maxwidth, $maxheight); + + printer = Qt::Printer; + + _print = Qt::PushButton("Print...", bgroup); + _print->resize(80, 30); + _print->move($maxwidth/2 - _print->width/2, maxindex*30+20); + this->connect(_print, SIGNAL('clicked()'), SLOT('printIt()')); + + bgroup->resize($maxwidth, _print->y+_print->height+10); + + resize(640,300); +} + +sub updateIt { + my $index = shift; + if($index < maxindex) { + drawindex = $index; + update(); + } +} + +sub drawIt { + my $p = shift; + $drawFunctions[drawindex]{f}->($p); +} + +sub printIt { + if(printer->setup(this)) { + my $paint = Qt::Painter(printer); + drawIt($paint); + } +} + +sub paintEvent { + my $paint = Qt::Painter(this); + drawIt($paint); +} + +sub resizeEvent { + bgroup->move(int(width() - bgroup->width), int(0)); +} + +package main; +use Qt; +use DrawView; + +my $app = Qt::Application(\@ARGV); +my $draw = DrawView; +$app->setMainWidget($draw); +$draw->setCaption("PerlQt Example - Drawdemo"); +$draw->show; +exit $app->exec; diff --git a/PerlQt/examples/drawlines/drawlines.pl b/PerlQt/examples/drawlines/drawlines.pl new file mode 100644 index 0000000..7297fa2 --- /dev/null +++ b/PerlQt/examples/drawlines/drawlines.pl @@ -0,0 +1,74 @@ +#!/usr/bin/perl -w +use strict; +package ConnectWidget; +use Qt; +use Qt::isa qw(Qt::Widget); +use Qt::attributes qw( + points + colors + count + down +); +use constant MAXPOINTS => 2000; +use constant MAXCOLORS => 40; + +# +# Constructs a ConnectWidget. +# + +sub NEW { + shift->SUPER::NEW(@_[0,1], &WStaticContents); + + setBackgroundColor(&white); + count = 0; + down = 0; + points = []; + my @colors; + for(1 .. MAXCOLORS) { + push @colors, Qt::Color(rand(255), rand(255), rand(255)); + } + colors = \@colors; +} + +sub paintEvent { + my $paint = Qt::Painter(this); + for(my $i = 0; $i < count-1; $i++) { + for(my $j = $i+1; $j < count; $j++) { + $paint->setPen(colors->[rand(MAXCOLORS)]); + $paint->drawLine(points->[$i], points->[$j]); + } + } +} + +sub mousePressEvent { + down = 1; + count = 0; + points = []; + erase(); +} + +sub mouseReleaseEvent { + down = 0; + update(); +} + +sub mouseMoveEvent { + my $e = shift; + if(down && count < MAXPOINTS) { + my $paint = Qt::Painter(this); + push @{this->points}, Qt::Point($e->pos); + count++; + $paint->drawPoint($e->pos); + } +} + +package main; +use Qt; +use ConnectWidget; + +my $a = Qt::Application(\@ARGV); +my $connect = ConnectWidget; +$connect->setCaption("PerlQt Example - Draw lines"); +$a->setMainWidget($connect); +$connect->show; +exit $a->exec; diff --git a/PerlQt/examples/forever/forever.pl b/PerlQt/examples/forever/forever.pl new file mode 100644 index 0000000..bf6d56a --- /dev/null +++ b/PerlQt/examples/forever/forever.pl @@ -0,0 +1,59 @@ +#!/usr/bin/perl -w +use strict; +package Forever; +use Qt; +use Qt::isa qw(Qt::Widget); +use Qt::slots + updateCaption => []; +use Qt::attributes qw( + rectangles + colors +); +use constant numColors => 120; + +sub NEW { + shift->SUPER::NEW(@_); + colors = \my @colors; + for(my $a = 0; $a < numColors; $a++) { + push @colors, Qt::Color(rand(255), rand(255), rand(255)); + } + rectangles = 0; + startTimer(0); + my $counter = Qt::Timer(this); + this->connect($counter, SIGNAL('timeout()'), SLOT('updateCaption()')); + $counter->start(1000); +} + +sub updateCaption { + my $s = sprintf "PerlQt Example - Forever - %d rectangles/second", rectangles; + rectangles = 0; + setCaption($s); +} + +sub paintEvent { + my $paint = Qt::Painter(this); + my $w = width(); + my $h = height(); + return if $w <= 0 || $h <= 0; + $paint->setPen(&NoPen); + $paint->setBrush(colors->[rand(numColors)]); + $paint->drawRect(rand($w), rand($h), rand($w), rand($h)); +} + +sub timerEvent { + for(my $i = 0; $i < 100; $i++) { + repaint(0); + rectangles++; + } +} + +package main; +use Qt; +use Forever; + +my $a = Qt::Application(\@ARGV); +my $always = Forever; +$a->setMainWidget($always); +$always->setCaption("PerlQt Example - Forever"); +$always->show; +exit $a->exec; diff --git a/PerlQt/examples/network/httpd/httpd.pl b/PerlQt/examples/network/httpd/httpd.pl new file mode 100644 index 0000000..3f46041 --- /dev/null +++ b/PerlQt/examples/network/httpd/httpd.pl @@ -0,0 +1,140 @@ +#!/usr/bin/perl -w + +## This program is based on an example program for Qt. It +## may be used, distributed and modified without limitation. +## +## Copyright (C) 1992-2000 Trolltech AS. All rights reserved. + + +# When a new client connects, the server constructs a Qt::Socket and all +# communication with the client is done over this Socket object. Qt::Socket +# works asynchronously - this means that all the communication is done +# through the two slots readClient() and discardClient(). + +package HttpDaemon; + +use Qt; +use Qt::isa qw(Qt::ServerSocket); +use Qt::signals + newConnect => [], + endConnect => [], + wroteToClient => []; +use Qt::slots + readClient => [], + discardClient => []; +use Qt::attributes qw( + sockets +); + +sub NEW +{ + shift->SUPER::NEW(8080, 1, $_[0]); + if( !this->ok() ) + { + die "Failed to bind to port 8080\n"; + } + sockets = {}; +} + +sub newConnection +{ + my $s = Qt::Socket( this ); + this->connect( $s, SIGNAL 'readyRead()', this, SLOT 'readClient()' ); + this->connect( $s, SIGNAL 'delayedCloseFinished()', this, SLOT 'discardClient()' ); + $s->setSocket( shift ); + sockets->{ $s } = $s; + emit newConnect(); +} + +sub readClient +{ + # This slot is called when the client sent data to the server. The + # server looks if it was a get request and sends a very simple HTML + # document back. + my $s = sender(); + if ( $s->canReadLine() ) + { + my @tokens = split( /\s\s*/, $s->readLine() ); + if ( $tokens[0] eq "GET" ) + { + my $string = "HTTP/1.0 200 Ok\n\rContent-Type: text/html; charset=\"utf-8\"\n\r". + "\n\r<h1>Nothing to see here</h1>\n"; + $s->writeBlock($string, length($string)); + $s->close(); + emit wroteToClient(); + } + } +} + +sub discardClient +{ + my $s = sender(); + sockets->{$s} = 0; + emit endConnect(); +} + +1; + + +# HttpInfo provides a simple graphical user interface to the server and shows +# the actions of the server. + +package HttpInfo; + +use Qt; +use Qt::isa qw(Qt::VBox); +use Qt::slots + newConnect => [], + endConnect => [], + wroteToClient => []; +use Qt::attributes qw( + httpd + infoText +); + +use HttpDaemon; + +sub NEW +{ + shift->SUPER::NEW(@_); + httpd = HttpDaemon( this ); + my $port = httpd->port(); + my $itext = "This is a small httpd example.\n". + "You can connect with your\n". + "web browser to port $port\n"; + my $lb = Label( $itext, this ); + $lb->setAlignment( &AlignHCenter ); + infoText = TextView( this ); + my $quit = PushButton( "quit" , this ); + this->connect( httpd, SIGNAL 'newConnect()', SLOT 'newConnect()' ); + this->connect( httpd, SIGNAL 'endConnect()', SLOT 'endConnect()' ); + this->connect( httpd, SIGNAL 'wroteToClient()', SLOT 'wroteToClient()' ); + this->connect( $quit, SIGNAL 'pressed()', Qt::app(), SLOT 'quit()' ); +} + +sub newConnect +{ + infoText->append( "New connection" ); +} + +sub endConnect +{ + infoText->append( "Connection closed\n\n" ); +} + +sub wroteToClient +{ + infoText->append( "Wrote to client" ); +} + +1; + +package main; +use Qt; +use HttpInfo; + +my $app = Qt::Application(\@ARGV); +my $info = HttpInfo; +$app->setMainWidget($info); +$info->show; +exit $app->exec; diff --git a/PerlQt/examples/opengl/README b/PerlQt/examples/opengl/README new file mode 100644 index 0000000..5c93086 --- /dev/null +++ b/PerlQt/examples/opengl/README @@ -0,0 +1,12 @@ +Before you can run the OpenGL examples, you need to install +the OpenGL module available on CPAN (http://www.cpan.org) + +Latest version is 0.54, as of 09/11/02 + +Both Smoke and Qt must also have been compiled with OpenGL support. + +If your Qt library has OpenGL support but PerlQt complains about lacking + methods or classes, check ./configure's config.log file for any +error that might have occured while detecting your OpenGL settings. + +You might also want to check if OpenGL is properly installed on your system. diff --git a/PerlQt/examples/opengl/box/GLBox.pm b/PerlQt/examples/opengl/box/GLBox.pm new file mode 100644 index 0000000..dd6ceb9 --- /dev/null +++ b/PerlQt/examples/opengl/box/GLBox.pm @@ -0,0 +1,149 @@ +package GLBox; + +use OpenGL qw(:all); + +use strict; + +use Qt; +use Qt::isa qw(Qt::GLWidget); +use Qt::slots + setXRotation => ['int'], + setYRotation => ['int'], + setZRotation => ['int']; +use Qt::attributes qw( + xRot + yRot + zRot + scale + object + list +); + +sub NEW { + shift->SUPER::NEW(@_); + xRot = yRot = zRot = 0.0; + scale = 1.25; + object = undef; +} + +sub paintGL +{ + glClear( GL_COLOR_BUFFER_BIT ); + glClear( GL_DEPTH_BUFFER_BIT ); + + glLoadIdentity(); + glTranslatef( 0.0, 0.0, -10.0 ); + glScalef( scale, scale, scale ); + + glRotatef( xRot, 1.0, 0.0, 0.0 ); + glRotatef( yRot, 0.0, 1.0, 0.0 ); + glRotatef( zRot, 0.0, 0.0, 1.0 ); + + glCallList( object ); +} + +sub initializeGL +{ + qglClearColor( &black ); # Let OpenGL clear to black + object = makeObject(); # Generate an OpenGL display list + glShadeModel( GL_FLAT ); + glEnable( GL_DEPTH_TEST ); +} + +# Set up the OpenGL view port, matrix mode, etc. + +sub resizeGL +{ + my $w = shift; + my $h = shift; + glViewport( 0, 0, $w, $h ); + glMatrixMode( GL_PROJECTION ); + glLoadIdentity(); + glFrustum( -1.0, 1.0, -1.0, 1.0, 5.0, 15.0 ); + glMatrixMode( GL_MODELVIEW ); +} + +# Generate an OpenGL display list for the object to be shown, i.e. the box + +sub makeObject +{ + my $list = glGenLists( 1 ); + + glNewList( $list, GL_COMPILE ); + + qglColor( &darkGreen ); # Shorthand for glColor3f or glIndex + + glLineWidth( 2.0 ); + + glBegin( GL_QUADS ); + glVertex3f( 1.0, 0.5, -0.4 ); + glVertex3f( 1.0, -0.5, -0.4 ); + glVertex3f( -1.0, -0.5, -0.4 ); + glVertex3f( -1.0, 0.5, -0.4 ); + glEnd(); + + qglColor( &blue ); + + glBegin( GL_QUADS ); + glVertex3f( 1.0, 0.5, 0.4 ); + glVertex3f( 1.0, -0.5, 0.4 ); + glVertex3f( -1.0, -0.5, 0.4 ); + glVertex3f( -1.0, 0.5, 0.4 ); + glEnd(); + + qglColor( &darkRed ); + + glBegin( GL_QUAD_STRIP ); + glVertex3f( 1.0, 0.5, -0.4 ); glVertex3f( 1.0, 0.5, 0.4 ); + glVertex3f( 1.0, -0.5, -0.4 ); glVertex3f( 1.0, -0.5, 0.4 ); + qglColor( &yellow ); + glVertex3f( -1.0, -0.5, -0.4 ); glVertex3f( -1.0, -0.5, 0.4 ); + qglColor( &green ); + glVertex3f( -1.0, 0.5, -0.4 ); glVertex3f( -1.0, 0.5, 0.4 ); + qglColor( &lightGray ); + glVertex3f( 1.0, 0.5, -0.4 ); glVertex3f( 1.0, 0.5, 0.4 ); + glEnd(); + + glEndList(); + + return $list; +} + + + +# Set the rotation angle of the object to \e degrees around the X axis. + +sub setXRotation +{ + my $deg = shift; + xRot = $deg % 360; + updateGL(); +} + + +# Set the rotation angle of the object to \e degrees around the Y axis. + +sub setYRotation +{ + my $deg = shift; + yRot = $deg % 360; + updateGL(); +} + + +# Set the rotation angle of the object to \e degrees around the Z axis. + +sub setZRotation +{ + my $deg = shift; + zRot = $deg % 360; + updateGL(); +} + +sub DESTROY +{ +# makeCurrent(); + glDeleteLists( object, 1 ); +} + +1; diff --git a/PerlQt/examples/opengl/box/glbox b/PerlQt/examples/opengl/box/glbox new file mode 100644 index 0000000..613a274 --- /dev/null +++ b/PerlQt/examples/opengl/box/glbox @@ -0,0 +1,90 @@ + +package GLObjectWindow; + +use strict; + +use Qt; +use Qt::isa qw(Qt::Widget); +use Qt::attributes qw( + file + frame + menu + box + xpos + ypos + zpos +); + +use GLBox; + +sub NEW +{ + shift->SUPER::NEW(@_); + + # Create a menu + file = Qt::PopupMenu( this ); + file->insertItem( "Exit", Qt::app(), SLOT 'quit()', Qt::KeySequence(int &CTRL + &Key_Q )); + + # Create a menu bar + menu = Qt::MenuBar( this ); + menu->setSeparator( &Qt::MenuBar::InWindowsStyle ); + menu->insertItem("&File", file ); + + # Create a nice frame to put around the OpenGL widget + frame = Qt::Frame( this, "frame" ); + frame->setFrameStyle( &Qt::Frame::Sunken | &Qt::Frame::Panel ); + frame->setLineWidth( 2 ); + + # Create our OpenGL widget + box = GLBox( frame, "glbox"); + + # Create the three sliders; one for each rotation axis + xpos = Qt::Slider ( 0, 360, 60, 0, &Qt::Slider::Vertical, this, "xsl" ); + xpos->setTickmarks( &Qt::Slider::Left ); + Qt::Object::connect( xpos, SIGNAL 'valueChanged(int)', box, SLOT 'setXRotation(int)' ); + + ypos = Qt::Slider ( 0, 360, 60, 0, &Qt::Slider::Vertical, this, "ysl" ); + ypos->setTickmarks( &Qt::Slider::Left ); + Qt::Object::connect( ypos, SIGNAL 'valueChanged(int)', box, SLOT 'setYRotation(int)' ); + + zpos = Qt::Slider ( 0, 360, 60, 0, &Qt::Slider::Vertical, this, "zsl" ); + zpos->setTickmarks( &Qt::Slider::Left ); + Qt::Object::connect( zpos, SIGNAL 'valueChanged(int)', box, SLOT 'setZRotation(int)' ); + + + # Now that we have all the widgets, put them into a nice layout + + # Put the sliders on top of each other + my $vlayout = Qt::VBoxLayout( 20, "vlayout"); + $vlayout->addWidget( xpos ); + $vlayout->addWidget( ypos ); + $vlayout->addWidget( zpos ); + + # Put the GL widget inside the frame + my $flayout = Qt::HBoxLayout( frame, 2, 2, "flayout"); + $flayout->addWidget( box, 1 ); + + # Top level layout, puts the sliders to the left of the frame/GL widget + my $hlayout = Qt::HBoxLayout( this, 20, 20, "hlayout"); + $hlayout->setMenuBar( menu ); + $hlayout->addLayout( $vlayout ); + $hlayout->addWidget( frame, 1 ); +} + +1; + +package main; + +use Qt; +use GLObjectWindow; + +my $a = Qt::Application(\@ARGV); + +my $w = GLObjectWindow; +$w->resize(350,350); +$w->show; + +$a->setMainWidget( $w); + +exit $a->exec; + diff --git a/PerlQt/examples/opengl/gear/gear b/PerlQt/examples/opengl/gear/gear new file mode 100644 index 0000000..2edc951 --- /dev/null +++ b/PerlQt/examples/opengl/gear/gear @@ -0,0 +1,267 @@ +#!/usr/bin/perl -w +# +# Draws a gear. +# +# This code is originally from Qt-1.44, by Troll Tech +# +# Portions of this code have been borrowed from Brian Paul's Mesa +# distribution. +# + +package GearWidget; +use OpenGL qw(:all); + +use Qt; +use Qt::attributes qw( + gear1 + gear2 + gear3 + view_rotx + view_roty + view_rotz + angle +); + +use Qt::isa qw(Qt::GLWidget); + +# +# Draw a gear wheel. You'll probably want to call this function when +# building a display list since we do a lot of trig here. +# +# Input: inner_radius - radius of hole at center +# outer_radius - radius at center of teeth +# width - width of gear +# teeth - number of teeth +# tooth_depth - depth of tooth +# + +sub gear { + my($inner_radius, $outer_radius, $width, $teeth, $tooth_depth) = @_; + my $i; + my($r0, $r1, $r2); + my($angle, $da); + my($u, $v, $len); + + $r0 = $inner_radius; + $r1 = $outer_radius - $tooth_depth/2.0; + $r2 = $outer_radius + $tooth_depth/2.0; + + my $pi = 3.141592654; + $da = 2.0*$pi / $teeth / 4.0; + + glShadeModel(GL_FLAT); + + glNormal3f(0.0, 0.0, 1.0); + + # draw front face + glBegin(GL_QUAD_STRIP); + for $i (0 .. $teeth) { + $angle = $i * 2.0*$pi / $teeth; + glVertex3f($r0*cos($angle), $r0*sin($angle), $width*0.5); + glVertex3f($r1*cos($angle), $r1*sin($angle), $width*0.5); + glVertex3f($r0*cos($angle), $r0*sin($angle), $width*0.5); + glVertex3f($r1*cos($angle+3*$da), $r1*sin($angle+3*$da), $width*0.5); + } + glEnd(); + + # draw front sides of teeth + glBegin(GL_QUADS); + $da = 2.0*$pi / $teeth / 4.0; + for $i (0 .. $teeth-1) { + $angle = $i * 2.0*$pi / $teeth; + + glVertex3f($r1*cos($angle), $r1*sin($angle), $width*0.5); + glVertex3f($r2*cos($angle+$da), $r2*sin($angle+$da), $width*0.5); + glVertex3f($r2*cos($angle+2*$da), $r2*sin($angle+2*$da), $width*0.5); + glVertex3f($r1*cos($angle+3*$da), $r1*sin($angle+3*$da), $width*0.5); + } + glEnd(); + + + glNormal3f(0.0, 0.0, -1.0); + + # draw back face + glBegin(GL_QUAD_STRIP); + for $i (0 .. $teeth) { + $angle = $i * 2.0*$pi / $teeth; + glVertex3f($r1*cos($angle), $r1*sin($angle), -$width*0.5); + glVertex3f($r0*cos($angle), $r0*sin($angle), -$width*0.5); + glVertex3f($r1*cos($angle+3*$da), $r1*sin($angle+3*$da), -$width*0.5); + glVertex3f($r0*cos($angle), $r0*sin($angle), -$width*0.5); + } + glEnd(); + + # draw back sides of teeth + glBegin(GL_QUADS); + $da = 2.0*$pi / $teeth / 4.0; + for $i (0 .. $teeth-1) { + $angle = $i * 2.0*$pi / $teeth; + + glVertex3f($r1*cos($angle+3*$da), $r1*sin($angle+3*$da), -$width*0.5); + glVertex3f($r2*cos($angle+2*$da), $r2*sin($angle+2*$da), -$width*0.5); + glVertex3f($r2*cos($angle+$da), $r2*sin($angle+$da), -$width*0.5); + glVertex3f($r1*cos($angle), $r1*sin($angle), -$width*0.5); + } + glEnd(); + + # draw outward faces of teeth + glBegin(GL_QUAD_STRIP); + for $i (0 .. $teeth-1) { + $angle = $i * 2.0*$pi / $teeth; + + glVertex3f($r1*cos($angle), $r1*sin($angle), $width*0.5); + glVertex3f($r1*cos($angle), $r1*sin($angle), -$width*0.5); + $u = $r2*cos($angle+$da) - $r1*cos($angle); + $v = $r2*sin($angle+$da) - $r1*sin($angle); + $len = sqrt($u*$u + $v*$v); + $u /= $len; + $v /= $len; + glNormal3f($v, -$u, 0.0); + glVertex3f($r2*cos($angle+$da), $r2*sin($angle+$da), $width*0.5); + glVertex3f($r2*cos($angle+$da), $r2*sin($angle+$da), -$width*0.5); + glNormal3f(cos($angle), sin($angle), 0.0); + glVertex3f($r2*cos($angle+2*$da), $r2*sin($angle+2*$da), $width*0.5); + glVertex3f($r2*cos($angle+2*$da), $r2*sin($angle+2*$da), -$width*0.5); + $u = $r1*cos($angle+3*$da) - $r2*cos($angle+2*$da); + $v = $r1*sin($angle+3*$da) - $r2*sin($angle+2*$da); + glNormal3f($v, -$u, 0.0); + glVertex3f($r1*cos($angle+3*$da), $r1*sin($angle+3*$da), $width*0.5); + glVertex3f($r1*cos($angle+3*$da), $r1*sin($angle+3*$da), -$width*0.5); + glNormal3f(cos($angle), sin($angle), 0.0); + } + + glVertex3f($r1*cos(0.0), $r1*sin(0.0), $width*0.5); + glVertex3f($r1*cos(0.0), $r1*sin(0.0), -$width*0.5); + + glEnd(); + + + glShadeModel(GL_SMOOTH); + + # draw inside radius cylinder + glBegin(GL_QUAD_STRIP); + for $i (0 .. $teeth) { + $angle = $i * 2.0*$pi / $teeth; + glNormal3f(-cos($angle), -sin($angle), 0.0); + glVertex3f($r0*cos($angle), $r0*sin($angle), -$width*0.5); + glVertex3f($r0*cos($angle), $r0*sin($angle), $width*0.5); + } + glEnd(); +} + + + +sub draw { + angle += 2.0; + view_roty += 1.0; + + glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT); + + glPushMatrix(); + glRotatef(view_rotx, 1.0, 0.0, 0.0); + glRotatef(view_roty, 0.0, 1.0, 0.0); + glRotatef(view_rotz, 0.0, 0.0, 1.0); + + glPushMatrix(); + glTranslatef(-3.0, -2.0, 0.0); + glRotatef(angle, 0.0, 0.0, 1.0); + glCallList(gear1); + glPopMatrix(); + + glPushMatrix(); + glTranslatef(3.1, -2.0, 0.0); + glRotatef(-2.0*angle-9.0, 0.0, 0.0, 1.0); + glCallList(gear2); + glPopMatrix(); + + glPushMatrix(); + glTranslatef(-3.1, 2.2, -1.8); + glRotatef(90.0, 1.0, 0.0, 0.0); + glRotatef(2.0*angle-2.0, 0.0, 0.0, 1.0); + glCallList(gear3); + glPopMatrix(); + + glPopMatrix(); +} + +sub NEW { + shift->SUPER::NEW(@_); + this->startTimer(10); + view_rotx = 20.0; + view_roty = 30.0; + view_rotz = 0.0; + angle = 0.0; +} + +sub initializeGL { + my $pos = [ 5.0, 5.0, 10.0, 1.0 ]; + my $red = [ 0.8, 0.1, 0.0, 1.0 ]; + my $green = [ 0.0, 0.8, 0.2, 1.0 ]; + my $blue = [ 0.2, 0.2, 1.0, 1.0 ]; + + glLightfv_p(GL_LIGHT0, GL_POSITION, @$pos); + glEnable(GL_CULL_FACE); + glEnable(GL_LIGHTING); + glEnable(GL_LIGHT0); + glEnable(GL_DEPTH_TEST); + + # make the gears + gear1 = glGenLists(1); + glNewList(gear1, GL_COMPILE); + glMaterialfv_p(GL_FRONT, GL_AMBIENT_AND_DIFFUSE, @$red); + gear(1.0, 4.0, 1.0, 20, 0.7); + glEndList(); + + gear2 = glGenLists(1); + glNewList(gear2, GL_COMPILE); + glMaterialfv_p(GL_FRONT, GL_AMBIENT_AND_DIFFUSE, @$green); + gear(0.5, 2.0, 2.0, 10, 0.7); + glEndList(); + + gear3 = glGenLists(1); + glNewList(gear3, GL_COMPILE); + glMaterialfv_p(GL_FRONT, GL_AMBIENT_AND_DIFFUSE, @$blue); + gear(1.3, 2.0, 0.5, 10, 0.7); + glEndList(); + + glEnable(GL_NORMALIZE); +} + +sub resizeGL { + my($width, $height) = @_; + my $w = $width / $height; + my $h = 1.0; + + glViewport(0, 0, $width, $height); + glMatrixMode(GL_PROJECTION); + glLoadIdentity(); + glFrustum(-$w, $w, -$h, $h, 5.0, 60.0); + glMatrixMode(GL_MODELVIEW); + glLoadIdentity(); + glTranslatef(0.0, 0.0, -40.0); +} + +sub paintGL { + draw(); +} + +sub timerEvent { + updateGL(); +} + +package main; + +use Qt; +use GearWidget; + +$app = Qt::Application(\@ARGV); + +if(!Qt::GLFormat::hasOpenGL()) { + warn("This system has no OpenGL support. Exiting."); + exit -1; +} + +$w = GearWidget; +$app->setMainWidget($w); +$w->show; +exit $app->exec; diff --git a/PerlQt/examples/progress/progress.pl b/PerlQt/examples/progress/progress.pl new file mode 100644 index 0000000..a63e95e --- /dev/null +++ b/PerlQt/examples/progress/progress.pl @@ -0,0 +1,348 @@ +#!/usr/bin/perl -w + +use strict; + +package AnimatedThingy; + +use Qt; +use Qt::isa "Qt::Label"; +use Qt::attributes qw[ + label + step + ox oy + x0 x1 + y0 y1 + dx0 dx1 + dy0 dy1 +]; + +use constant nqix => 10; + +sub NEW +{ + shift->SUPER::NEW($_[0]); + label= $_[1]."\n... and wasting CPU\nwith this animation!\n"; + ox = []; + oy = []; + step = 0; + for (my $i=0; $i<nqix; $i++) + { ox->[0][$i] = oy->[0][$i] = ox->[1][$i] = oy->[1][$i] = 0 } + x0 = y0 = x1 = y1 = 0; + dx0 = rand(8)+2; + dy0 = rand(8)+2; + dx1 = rand(8)+2; + dy1 = rand(8)+2; + setBackgroundColor(&black); +} + +sub show +{ + startTimer(150) unless isVisible(); + SUPER->show; +} + +sub hide +{ + SUPER->hide; + killTimers() +} + +sub sizeHint +{ + Qt::Size(120,100) +} + +sub timerEvent +{ + my $p = Qt::Painter(this); + my $pn= $p->pen; + $pn->setWidth(2); + $pn->setColor(backgroundColor()); + $p->setPen($pn); + + step = (step + 1) % nqix; + + $p->drawLine(ox->[0][step], oy->[0][step], ox->[1][step], oy->[1][step]); + + (x0, dx0) = inc(x0, dx0, width()); + (y0, dy0) = inc(y0, dy0, height()); + (x1, dx1) = inc(x1, dx1, width()); + (y1, dy1) = inc(y1, dy1, height()); + ox->[0][step] = x0; + oy->[0][step] = y0; + ox->[1][step] = x1; + oy->[1][step] = y1; + + my $c = Qt::Color; + $c->setHsv( (step*255)/nqix, 255, 255 ); # rainbow effect + $pn->setColor($c); + $pn->setWidth(2); + $p->setPen($pn); + $p->drawLine(ox->[0][step], oy->[0][step], ox->[1][step], oy->[1][step]); + $p->setPen(&white); + $p->drawText(rect(), &AlignCenter, label); +} + +sub paintEvent +{ + my $ev = shift; + my $p = Qt::Painter(this); + my $pn= $p->pen; + $pn->setWidth(2); + $p->setPen($pn); + $p->setClipRect($ev->rect); + for (my $i=0; $i<nqix; $i++) { + my $c = Qt::Color; + $c->setHsv( ($i*255)/nqix, 255, 255 ); # rainbow effect + $pn->setColor($c); + $p->setPen($pn); + $p->drawLine(ox->[0][$i], oy->[0][$i], ox->[1][$i], oy->[1][$i]); + } + $p->setPen(&white); + $p->drawText(rect(), &AlignCenter, label); +} + +sub inc +{ + my ($x, $dx, $b)= @_; + $x += $dx; + if ($x<0) { $x=0; $dx=rand(8)+2; } + elsif ($x>=$b) { $x=$b-1; $dx=-(rand(8)+2); } + return ($x, $dx) +} + +1; + +package CPUWaster; + +use Qt; +use Qt::isa "Qt::Widget"; +use Qt::attributes qw[ + menubar + file + options + rects + pb + td_id + ld_id + dl_id + cl_id + md_id + got_stop + timer_driven + default_label +]; +use Qt::slots + drawItemRects => ['int'], + doMenuItem => ['int'], + stopDrawing => [ ], + timerDriven => [ ], + loopDriven => [ ], + defaultLabel => [ ], + customLabel => [ ], + toggleMinimumDuration + => [ ]; +use AnimatedThingy; + +use constant first_draw_item => 1000; +use constant last_draw_item => 1006; + +sub NEW +{ + shift->SUPER::NEW(@_); + + menubar = MenuBar( this, "menu" ); + pb = 0; + + file = Qt::PopupMenu; + menubar->insertItem( "&File", file ); + for (my $i=first_draw_item; $i<=last_draw_item; $i++) + { file->insertItem( drawItemRects($i)." Rectangles", $i) } + Qt::Object::connect( menubar, SIGNAL "activated(int)", this, SLOT "doMenuItem(int)" ); + file->insertSeparator; + file->insertItem( "Quit", Qt::app(), SLOT "quit()" ); + options = Qt::PopupMenu; + menubar->insertItem( "&Options", options ); + td_id = options->insertItem( "Timer driven", this, SLOT "timerDriven()" ); + ld_id = options->insertItem( "Loop driven", this, SLOT "loopDriven()" ); + options->insertSeparator; + dl_id = options->insertItem( "Default label", this, SLOT "defaultLabel()" ); + cl_id = options->insertItem( "Custom label", this, SLOT "customLabel()" ); + options->insertSeparator; + md_id = options->insertItem( "No minimum duration", this, SLOT "toggleMinimumDuration()" ); + options->setCheckable( 1 ); + loopDriven(); + customLabel(); + + setFixedSize( 400, 300 ); + + setBackgroundColor( &black ); +} + + +sub drawItemRects +{ + my $id = shift; + my $n = $id - first_draw_item; + my $r = 100; + while($n--) + { $r *= $n%3 ? 5:4 } + return $r +} + + +sub doMenuItem +{ + my $id = shift; + draw(drawItemRects($id)) if ($id >= first_draw_item && $id <= last_draw_item) +} + +sub stopDrawing +{ got_stop = 1 } + +sub timerDriven() +{ + timer_driven = 1; + options->setItemChecked( td_id, 1 ); + options->setItemChecked( ld_id, 0 ); +} + +sub loopDriven +{ + timer_driven = 0; + options->setItemChecked( ld_id, 1 ); + options->setItemChecked( td_id, 0 ); +} + +sub defaultLabel +{ + default_label = 1; + options->setItemChecked( dl_id, 1 ); + options->setItemChecked( cl_id, 0 ); +} + +sub customLabel +{ + default_label = 0; + options->setItemChecked( dl_id, 0 ); + options->setItemChecked( cl_id, 1 ); +} + +sub toggleMinimumDuration +{ + options->setItemChecked( md_id, + !options->isItemChecked( md_id ) ); +} + +sub timerEvent +{ + pb->setProgress( pb->totalSteps - rects ) if(!(rects%100)); + rects--; + + { + my $p = Qt::Painter(this); + + my $ww = width(); + my $wh = height(); + + if ( $ww > 8 && $wh > 8 ) + { + my $c = Qt::Color(rand(255), rand(255), rand(255)); + my $x = rand($ww-8); + my $y = rand($wh-8); + my $w = rand($ww-$x); + my $h = rand($wh-$y); + $p->fillRect( $x, $y, $w, $h, Brush($c) ); + } + } + + if (!rects || got_stop) + { + pb->setProgress( pb->totalSteps ); + my $p = Qt::Painter(this); + $p->fillRect(0, 0, width(), height(), Brush(backgroundColor())); + enableDrawingItems(1); + killTimers(); + pb = 0; + } +} + +sub newProgressDialog +{ + my($label, $steps, $modal) = @_; + my $d = ProgressDialog($label, "Cancel", $steps, this, + "progress", $modal); + if ( options->isItemChecked( md_id ) ) + { $d->setMinimumDuration(0) } + if ( !default_label ) + { $d->setLabel( AnimatedThingy($d,$label) ) } + return $d; +} + +sub enableDrawingItems +{ + my $yes = shift; + for (my $i=first_draw_item; $i<=last_draw_item; $i++) + { + menubar->setItemEnabled($i, $yes); + } +} + +sub draw +{ + my $n = shift; + if ( timer_driven ) + { + if ( pb ) { + warn("This cannot happen!"); + return; + } + rects = $n; + pb = newProgressDialog("Drawing rectangles.\n". + "Using timer event.", $n, 0); + pb->setCaption("Please Wait"); + Qt::Object::connect(pb, SIGNAL "cancelled()", this, SLOT "stopDrawing()"); + enableDrawingItems(0); + startTimer(0); + got_stop = 0; + } + else + { + my $lpb = newProgressDialog("Drawing rectangles.\n". + "Using loop.", $n, 1); + $lpb->setCaption("Please Wait"); + + my $p = Qt::Painter(this); + for (my $i=0; $i<$n; $i++) + { + if(!($i%100)) + { + $lpb->setProgress($i); + last if ( $lpb->wasCancelled ); + } + my ($cw, $ch) = (width(), height()); + my $c = Qt::Color(rand(255), rand(255), rand(255)); + my $x = rand($cw-8); + my $y = rand($cw-8); + my $w = rand($cw-$x); + my $h = rand($cw-$y); + $p->fillRect($x, $y, $w, $h, Brush($c)); + } + $lpb->cancel; + $p->fillRect(0, 0, width(), height(), Brush(backgroundColor())); + } +} + +1; + +package main; + +use Qt; +use CPUWaster; + +my $a=Qt::Application(\@ARGV); +my $w=CPUWaster; + +$w->show; +$a->setMainWidget($w); +exit $a->exec; diff --git a/PerlQt/examples/richedit/imageCollection.pm b/PerlQt/examples/richedit/imageCollection.pm new file mode 100644 index 0000000..318d4e5 --- /dev/null +++ b/PerlQt/examples/richedit/imageCollection.pm @@ -0,0 +1,1461 @@ +# Image collection for project 'richedit'. +# +# Generated from reading image files: +# images/CVS +# images/editcopy +# images/editcut +# images/editpaste +# images/filenew +# images/fileopen +# images/filesave +# images/print +# images/redo +# images/searchfind +# images/textbold +# images/textcenter +# images/textitalic +# images/textleft +# images/textright +# images/textunder +# images/undo +# +# Created: jeu jun 13 20:03:44 2002 +# by: The PerlQt User Interface Compiler (puic) +# +# WARNING! All changes made in this file will be lost! + +use strict; + +package DesignerMimeSourceFactory_richedit; +use Qt; +use Qt::isa qw(Qt::MimeSourceFactory); + +# images/editcopy +my $image_0_data = pack 'L*', + + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xffffffff, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xffffffff, 0xff000000, + 0xffffffff, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xff000000, 0xffffffff, 0xffffffff, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xffffffff, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xffffffff, 0xff000000, 0xff000082, 0xff000082, 0xff000082, 0xff000082, + 0xff000082, 0xff000082, 0xff000082, 0xff000082, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xff000000, + 0xff000082, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xff000082, 0xff000082, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xffffffff, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xffffffff, 0xff000082, 0xffffffff, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xffffffff, 0xff000082, + 0xff3c3cfd, 0xff000082, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xff000082, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xff000082, 0xff8b8bfd, 0xff3c3cfd, + 0xff000082, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xffffffff, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xffffffff, + 0xff000082, 0xffffffff, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xffffffff, 0xff000082, 0xffffffff, 0xff8b8bfd, 0xff3c3cfd, 0xff000082, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xff000082, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xff000082, + 0xff000082, 0xff000082, 0xff000082, 0xff000082, 0xff000082, 0xc6c6c6, + 0xff000000, 0xffffffff, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xffffffff, 0xff000082, 0xffffffff, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xff000082, 0xc6c6c6, 0xff000000, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xff000082, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xff000082, 0xc6c6c6, 0xff000000, 0xffffffff, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xffffffff, 0xff000082, 0xffffffff, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xffffffff, 0xff000082, 0xc6c6c6, + 0xff000000, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xff000082, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xff000082, 0xc6c6c6, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000082, 0xffffffff, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xffffffff, + 0xff000082, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000082, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xff000082, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000082, 0xffffffff, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xffffffff, 0xff000082, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000082, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xff000082, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000082, 0xff000082, + 0xff000082, 0xff000082, 0xff000082, 0xff000082, 0xff000082, 0xff000082, + 0xff000082, 0xff000082, 0xff000082, 0xff000082, 0xff000082, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6; + +# images/editcut +my $image_1_data = pack 'L*', + + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xff000000, 0xc6c6c6, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000082, + 0xff000000, 0xff000082, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000082, 0xff000082, 0xc6c6c6, 0xff000082, + 0xff000082, 0xff000082, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000082, + 0xc6c6c6, 0xff000082, 0xc6c6c6, 0xff000082, 0xc6c6c6, 0xc6c6c6, + 0xff000082, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000082, 0xc6c6c6, 0xc6c6c6, 0xff000082, + 0xc6c6c6, 0xff000082, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000082, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000082, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000082, 0xc6c6c6, 0xff000082, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000082, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000082, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000082, 0xc6c6c6, 0xff000082, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000082, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000082, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000082, + 0xc6c6c6, 0xc6c6c6, 0xff000082, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000082, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000082, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000082, 0xc6c6c6, 0xc6c6c6, + 0xff000082, 0xc6c6c6, 0xc6c6c6, 0xff000082, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000082, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000082, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000082, + 0xff000082, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000082, 0xff000082, 0xff000082, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6; + +# images/editpaste +my $image_2_data = pack 'L*', + + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xffffff00, 0xffffff00, + 0xffffff00, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xffffff00, 0xffffff00, 0xffffff00, 0xffffff00, 0xffffff00, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, + 0xff848284, 0xff848200, 0xff848284, 0xff000000, 0xff000000, 0xffffff00, + 0xff000000, 0xff000000, 0xff000000, 0xffffff00, 0xff000000, 0xff000000, + 0xff848284, 0xff848200, 0xff848284, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff848284, 0xff848200, 0xff848284, + 0xff000000, 0xffc6c3c6, 0xffc6c3c6, 0xffc6c3c6, 0xffc6c3c6, 0xffc6c3c6, + 0xffc6c3c6, 0xffc6c3c6, 0xffc6c3c6, 0xffc6c3c6, 0xff000000, 0xff848284, + 0xff848200, 0xff848284, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xff848200, 0xff848284, 0xff848200, 0xff000000, 0xffc6c3c6, + 0xffc6c3c6, 0xffc6c3c6, 0xffc6c3c6, 0xffc6c3c6, 0xffc6c3c6, 0xffc6c3c6, + 0xffc6c3c6, 0xffc6c3c6, 0xff000000, 0xff848200, 0xff848284, 0xff848200, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff848284, + 0xff848200, 0xff848284, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff848284, 0xff848200, 0xff848284, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff848200, 0xff848284, 0xff848200, + 0xff848284, 0xff848200, 0xff848284, 0xff848200, 0xff848284, 0xff848200, + 0xff848284, 0xff848200, 0xff848284, 0xff848200, 0xff848284, 0xff848200, + 0xff848284, 0xff848200, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xff848284, 0xff848200, 0xff848284, 0xff848200, 0xff848284, + 0xff848200, 0xff848284, 0xff848200, 0xff848284, 0xff848200, 0xff848284, + 0xff848200, 0xff848284, 0xff848200, 0xff848284, 0xff848200, 0xff848284, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff848200, + 0xff848284, 0xff848200, 0xff848284, 0xff848200, 0xff848284, 0xff848200, + 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, + 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff848284, 0xff848200, 0xff848284, + 0xff848200, 0xff848284, 0xff848200, 0xff848284, 0xff000084, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xff000084, 0xffffffff, 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xff848200, 0xff848284, 0xff848200, 0xff848284, 0xff848200, + 0xff848284, 0xff848200, 0xff000084, 0xffffffff, 0xff000084, 0xff000084, + 0xff000084, 0xff000084, 0xff000084, 0xffffffff, 0xff000084, 0xffffffff, + 0xffffffff, 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff848284, + 0xff848200, 0xff848284, 0xff848200, 0xff848284, 0xff848200, 0xff848284, + 0xff000084, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xff000084, 0xffffffff, 0xffffffff, 0xffffffff, + 0xff000084, 0xc6c6c6, 0xff000000, 0xff848200, 0xff848284, 0xff848200, + 0xff848284, 0xff848200, 0xff848284, 0xff848200, 0xff000084, 0xffffffff, + 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xffffffff, + 0xff000084, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xff000084, + 0xff000000, 0xff848284, 0xff848200, 0xff848284, 0xff848200, 0xff848284, + 0xff848200, 0xff848284, 0xff000084, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xff000084, 0xff000084, + 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000000, 0xff848200, + 0xff848284, 0xff848200, 0xff848284, 0xff848200, 0xff848284, 0xff848200, + 0xff000084, 0xffffffff, 0xff000084, 0xff000084, 0xff000084, 0xff000084, + 0xff000084, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xff000084, 0xff000000, 0xff848284, 0xff848200, 0xff848284, + 0xff848200, 0xff848284, 0xff848200, 0xff848284, 0xff000084, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xff000084, + 0xff000000, 0xff848200, 0xff848284, 0xff848200, 0xff848284, 0xff848200, + 0xff848284, 0xff848200, 0xff000084, 0xffffffff, 0xff000084, 0xff000084, + 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, + 0xff000084, 0xff000084, 0xffffffff, 0xff000084, 0xc6c6c6, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000084, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, + 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, + 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6; + +# images/filenew +my $image_3_data = pack 'L*', + + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xff000000, 0xff2e2e2e, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xff000000, 0xff5c5c5c, 0xff2e2e2e, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xff000000, 0xff878787, + 0xff5c5c5c, 0xff2e2e2e, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xff000000, 0xffc2c2c2, 0xff878787, 0xff5c5c5c, + 0xff2e2e2e, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xff000000, 0xffffffff, 0xffc2c2c2, 0xff878787, 0xff5c5c5c, 0xff2e2e2e, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6; + +# images/fileopen +my $image_4_data = pack 'L*', + + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xc6c6c6, 0xff000000, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xc6c6c6, 0xff000000, 0xffffff00, 0xffffffff, 0xffffff00, + 0xffffffff, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xffffffff, 0xffffff00, 0xffffffff, 0xffffff00, 0xffffffff, + 0xffffff00, 0xffffffff, 0xffffff00, 0xffffffff, 0xffffff00, 0xffffffff, + 0xffffff00, 0xffffffff, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xffffff00, + 0xffffffff, 0xffffff00, 0xffffffff, 0xffffff00, 0xffffffff, 0xffffff00, + 0xffffffff, 0xffffff00, 0xffffffff, 0xffffff00, 0xffffffff, 0xffffff00, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xffffffff, 0xffffff00, 0xffffffff, + 0xffffff00, 0xffffffff, 0xffffff00, 0xffffffff, 0xffffff00, 0xffffffff, + 0xffffff00, 0xffffffff, 0xffffff00, 0xffffffff, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xffffff00, 0xffffffff, 0xffffff00, 0xffffffff, 0xffffff00, + 0xffffffff, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xffffffff, + 0xffffff00, 0xffffffff, 0xffffff00, 0xffffffff, 0xff000000, 0xff000000, + 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, + 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, + 0xff000000, 0xff000000, 0xff000000, 0xffffff00, 0xffffffff, 0xffffff00, + 0xffffffff, 0xff000000, 0xff000000, 0xff848200, 0xff848200, 0xff848200, + 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, + 0xff848200, 0xff848200, 0xff848200, 0xff000000, 0xff000000, 0xc6c6c6, + 0xff000000, 0xffffffff, 0xffffff00, 0xffffffff, 0xff000000, 0xff000000, + 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, + 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, + 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xffffff00, + 0xffffffff, 0xff000000, 0xff000000, 0xff848200, 0xff848200, 0xff848200, + 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, + 0xff848200, 0xff848200, 0xff848200, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xffffffff, 0xff000000, 0xff000000, + 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, + 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, + 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xff000000, 0xff000000, 0xff848200, 0xff848200, 0xff848200, + 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, + 0xff848200, 0xff848200, 0xff848200, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, + 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, + 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, + 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6; + +# images/filesave +my $image_5_data = pack 'L*', + + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff848200, 0xff848200, + 0xff000000, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, + 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, + 0xffc1c1c1, 0xff000000, 0xffc1c1c1, 0xffc1c1c1, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xff848200, 0xff848200, 0xff000000, 0xffc1c1c1, + 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, + 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xff000000, + 0xffc1c1c1, 0xffc1c1c1, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff848200, 0xff848200, 0xff000000, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, + 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, + 0xffcab5d1, 0xffc1c1c1, 0xffc1c1c1, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff848200, 0xff848200, + 0xff000000, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffcab5d1, 0xffcab5d1, + 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, + 0xffc1c1c1, 0xff000000, 0xff848200, 0xff848200, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xff848200, 0xff848200, 0xff000000, 0xffc1c1c1, + 0xffc1c1c1, 0xffc1c1c1, 0xffcab5d1, 0xffcab5d1, 0xffc1c1c1, 0xffc1c1c1, + 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xff000000, + 0xff848200, 0xff848200, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff848200, 0xff848200, 0xff000000, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, + 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, + 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xff000000, 0xff848200, 0xff848200, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff848200, 0xff848200, + 0xff000000, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, + 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, + 0xffc1c1c1, 0xff000000, 0xff848200, 0xff848200, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xff848200, 0xff848200, 0xff000000, 0xffc1c1c1, + 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, + 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xff000000, + 0xff848200, 0xff848200, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff848200, 0xff848200, 0xff000000, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, + 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, + 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xff000000, 0xff848200, 0xff848200, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff848200, 0xff848200, + 0xff848200, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff848200, 0xff848200, 0xff848200, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xff848200, 0xff848200, 0xff848200, 0xff848200, + 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, + 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, + 0xff848200, 0xff848200, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, + 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, + 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, 0xff848200, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff848200, 0xff848200, + 0xff848200, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff848200, 0xff848200, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xff848200, 0xff848200, 0xff848200, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xff000000, + 0xff848200, 0xff848200, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff848200, 0xff848200, 0xff848200, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xff000000, 0xff848200, 0xff848200, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff848200, 0xff848200, + 0xff848200, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xffc1c1c1, 0xffc1c1c1, + 0xffc1c1c1, 0xff000000, 0xff848200, 0xff848200, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xff848200, 0xff848200, 0xff848200, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xff000000, + 0xff848200, 0xff848200, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff848200, 0xff848200, 0xff848200, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xffc1c1c1, 0xffc1c1c1, 0xffc1c1c1, 0xff000000, 0xff848200, 0xff848200, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6; + +# images/print +my $image_6_data = pack 'L*', + + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xffb5b5b5, 0xffbdbdbd, 0xffcecece, 0xffcecece, 0xffcecece, 0xffcecece, + 0xffc6c6c6, 0xffc6c6c6, 0xffbdbdbd, 0xffbdbdbd, 0xffadadad, 0xffbdbdbd, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xffbdbdbd, 0xffefefef, + 0xffe7e7e7, 0xffe7e7e7, 0xffe7e7e7, 0xffe7e7e7, 0xffe7e7e7, 0xffefefef, + 0xffefefef, 0xffefefef, 0xffdedede, 0xffbdbdbd, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xffbdbdbd, 0xffc6c6c6, 0xffc6c6c6, 0xffc6c6c6, + 0xffcecece, 0xffcecece, 0xffc6c6c6, 0xffc6c6c6, 0xffc6c6c6, 0xffc6c6c6, + 0xffbdbdbd, 0xffc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xffb5b5b5, 0xffbdbdbd, 0xffbdbdbd, 0xffbdbdbd, 0xffbdbdbd, 0xffb5b5b5, + 0xffbdbdbd, 0xffbdbdbd, 0xffb5b5b5, 0xffb5b5b5, 0xffadadad, 0xffbdbdbd, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xffc6c6c6, 0xffadadad, 0xffc6c6c6, + 0xffbdbdbd, 0xffc6c6c6, 0xffc6c6c6, 0xffc6c6c6, 0xffbdbdbd, 0xffbdbdbd, + 0xffbdbdbd, 0xffc6c6c6, 0xffb5b5b5, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xffbdbdbd, 0xffbdbdbd, 0xffb5b5b5, 0xffbdbdbd, 0xffbdbdbd, + 0xffbdbdbd, 0xffbdbdbd, 0xffbdbdbd, 0xffbdbdbd, 0xffc6c6c6, 0xffc6c6c6, + 0xffb5b5b5, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xffbdbdbd, + 0xffb5b5b5, 0xffc6c6c6, 0xffbdbdbd, 0xffbdbdbd, 0xffbdbdbd, 0xffbdbdbd, + 0xffbdbdbd, 0xffc6c6c6, 0xffbdbdbd, 0xffc6c6c6, 0xffadadad, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xffc6c6c6, 0xffbdbdbd, 0xffbdbdbd, + 0xffbdbdbd, 0xffbdbdbd, 0xffbdbdbd, 0xffbdbdbd, 0xffbdbdbd, 0xffbdbdbd, + 0xffbdbdbd, 0xffbdbdbd, 0xffb5b5b5, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xffadadad, 0xffcecece, 0xffe7e7e7, 0xffdedede, 0xffdedede, + 0xffdedede, 0xffdedede, 0xffdedede, 0xffdedede, 0xffd6d6d6, 0xffdedede, + 0xffa5a5a5, 0xffa5a5a5, 0xffadadb5, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xffbdbdbd, 0xff9c9c9c, 0xff736b73, + 0xffb5b5b5, 0xffd6d6d6, 0xffcecece, 0xffd6d6d6, 0xffcecece, 0xffd6d6d6, + 0xffcecece, 0xffd6d6d6, 0xffdedede, 0xffdedede, 0xff948c94, 0xff5a525a, + 0xff424242, 0xff6b6b6b, 0xffb5b5b5, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xffbdbdbd, 0xff94949c, 0xff847b84, 0xff7b7384, 0xff7b737b, 0xff7b737b, + 0xff7b737b, 0xff7b737b, 0xff7b737b, 0xff7b737b, 0xff7b737b, 0xff847b8c, + 0xff8c7b94, 0xff8c8494, 0xff6b6b73, 0xff393942, 0xff212129, 0xff181821, + 0xff424242, 0xffa5a5a5, 0xc6c6c6, 0xffbdbdbd, 0xff9c9c9c, 0xffded6de, + 0xffe7e7ef, 0xffdedee7, 0xffded6de, 0xffd6d6de, 0xffd6d6de, 0xffd6d6de, + 0xffd6d6de, 0xffd6ced6, 0xffd6cede, 0xff9ccea5, 0xff5ace5a, 0xff94c694, + 0xffa59ca5, 0xff424242, 0xff211821, 0xff211821, 0xff181018, 0xff393942, + 0xffbdbdbd, 0xff9c9ca5, 0xffefe7ef, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffd6ffd6, 0xff29ff29, 0xff08ff08, 0xff29ff29, 0xffcecece, 0xff8c7b94, + 0xff313131, 0xff181821, 0xff101010, 0xff211821, 0xffada5ad, 0xfff7f7f7, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, + 0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff, 0xffe7ffe7, 0xff6bff63, + 0xff31ff31, 0xff7bff7b, 0xffffffff, 0xffded6e7, 0xff7b737b, 0xff181821, + 0xff000000, 0xff211821, 0xffa5a5ad, 0xffd6d6de, 0xffceced6, 0xffcec6ce, + 0xffceced6, 0xffd6d6d6, 0xffd6d6de, 0xffd6d6de, 0xffdedede, 0xffe7dee7, + 0xffdedee7, 0xffded6de, 0xffdedee7, 0xffd6d6de, 0xffbdd6bd, 0xffd6ced6, + 0xffceced6, 0xffcec6ce, 0xff8c8c94, 0xff181018, 0xff000000, 0xff181821, + 0xff948c94, 0xffb5adb5, 0xffadadb5, 0xffada5ad, 0xffa5a5ad, 0xffa59cad, + 0xffa5a5ad, 0xffa59ca5, 0xffa59cad, 0xffa59cad, 0xffa5a5a5, 0xffa59cad, + 0xffa59ca5, 0xffa59cad, 0xffad9cad, 0xff9c94a5, 0xff94949c, 0xff8c8c94, + 0xff6b636b, 0xff101018, 0xff000000, 0xff211821, 0xff948c94, 0xffadadb5, + 0xffadadb5, 0xffa59cad, 0xffa5a5ad, 0xffa59ca5, 0xffa59ca5, 0xffa59ca5, + 0xff9c9ca5, 0xffa59ca5, 0xff9c9ca5, 0xff9c9ca5, 0xff9c9ca5, 0xff9c9ca5, + 0xff9c94a5, 0xff9c949c, 0xff9c949c, 0xff8c8494, 0xff6b636b, 0xff101018, + 0xff000000, 0xff181818, 0xff949494, 0xffa59cad, 0xffa59cad, 0xffa59ca5, + 0xff9c9ca5, 0xffa59ca5, 0xff9c9ca5, 0xff9c9ca5, 0xff9c9ca5, 0xff9c94a5, + 0xff9c9c9c, 0xff9c94a5, 0xff9c949c, 0xff9c949c, 0xff9c949c, 0xff9c94a5, + 0xff948c94, 0xff84848c, 0xff6b636b, 0xff181018, 0xff000000, 0xff4a4a52, + 0xff948c94, 0xffa5a5ad, 0xffa59ca5, 0xffa59ca5, 0xff9c94a5, 0xff9c9c9c, + 0xff9c94a5, 0xff9c949c, 0xff9c94a5, 0xff9c9c9c, 0xff9c94a5, 0xff9c949c, + 0xff9c94a5, 0xff9c949c, 0xff94949c, 0xff948c94, 0xff8c8c94, 0xff8c848c, + 0xff6b6b73, 0xff101018, 0xff181818, 0xffadadad, 0xff949494, 0xff84848c, + 0xff8c848c, 0xff8c8494, 0xff8c8c8c, 0xff8c8494, 0xff8c848c, 0xff8c8c94, + 0xff8c8494, 0xff8c848c, 0xff8c8c94, 0xff8c8c94, 0xff948c94, 0xff8c8c94, + 0xff948c94, 0xff948c9c, 0xff8c8c94, 0xff8c8494, 0xff6b636b, 0xff181818, + 0xff949494, 0xc6c6c6, 0xffb5b5b5, 0xff736b73, 0xff212129, 0xff181821, + 0xff212121, 0xff212129, 0xff292129, 0xff292129, 0xff292129, 0xff292931, + 0xff312931, 0xff312931, 0xff313139, 0xff313139, 0xff393139, 0xff393139, + 0xff313139, 0xff312931, 0xff313139, 0xff949494, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xffadadad, 0xff5a5a63, 0xff423942, 0xff423942, + 0xff393939, 0xff313139, 0xff313131, 0xff313131, 0xff313131, 0xff292929, + 0xff292929, 0xff212129, 0xff181818, 0xff181818, 0xff100810, 0xff424242, + 0xff9c9c9c, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6; + +# images/redo +my $image_7_data = pack 'L*', + + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff848284, 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, + 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, 0xff000084, + 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, + 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff848284, 0xff000084, 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, 0xff000084, + 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, 0xff000084, + 0xc6c6c6, 0xff000084, 0xff000084, 0xff000084, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, 0xff000084, 0xff000084, + 0xff000084, 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000084, 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, + 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, + 0xff000084, 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff848284, 0xff000084, 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, + 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000084, + 0xff000084, 0xff000084, 0xff848284, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, + 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6; + +# images/searchfind +my $image_8_data = pack 'L*', + + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xffb5b5b5, + 0xff949494, 0xff7b7b7b, 0xff6b7373, 0xff6b7373, 0xff7b7b7b, 0xff9c9c9c, + 0xffbdbdbd, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xffadadad, 0xff737b7b, 0xff849c94, 0xffadcec6, + 0xffaddece, 0xffaddece, 0xff94bdad, 0xff6b7b7b, 0xff7b7b7b, 0xffb5b5b5, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xffadadad, + 0xff5a5a5a, 0xff94a59c, 0xffceffef, 0xffceffef, 0xffc6f7e7, 0xffbdefde, + 0xffb5efd6, 0xffa5e7c6, 0xff6b8c7b, 0xff737373, 0xffbdbdbd, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xffbdbdbd, 0xff737b73, 0xff9cbdb5, 0xffbdefde, + 0xffc6f7e7, 0xffc6def7, 0xffbdd6ff, 0xffbdc6f7, 0xffa5b5de, 0xff94ceb5, + 0xff94d6bd, 0xff738c84, 0xff8c8c8c, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff9c9c9c, 0xff849c94, 0xffd6fff7, 0xffbdefde, 0xffcedeff, 0xffb5bdde, + 0xffa5cece, 0xffa5cece, 0xffadadef, 0xff9c94d6, 0xff8cc6ad, 0xff94c6ad, + 0xff636b6b, 0xffb5b5b5, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff7b8484, 0xffadd6c6, + 0xffceffef, 0xffb5dede, 0xffadb5de, 0xff94ceb5, 0xff9ce7bd, 0xff8ccead, + 0xffa5b5de, 0xffa594de, 0xff84ada5, 0xff94ceb5, 0xff6b847b, 0xff9c9c9c, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff737b7b, 0xffbde7d6, 0xffbdf7de, 0xff9ce7c6, + 0xff9ce7c6, 0xff9cdebd, 0xff94d6b5, 0xff9ccece, 0xffa5b5ef, 0xff8484b5, + 0xff7bbd9c, 0xff94c6b5, 0xff739484, 0xff848484, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff737b7b, 0xffaddece, 0xffb5efd6, 0xff9cdebd, 0xff94debd, 0xff94d6b5, + 0xff9cbdd6, 0xffa5b5ef, 0xff8c94b5, 0xff7bad94, 0xff7bbda5, 0xff8cb5a5, + 0xff73948c, 0xff848484, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff737b73, 0xffadd6c6, + 0xffade7ce, 0xff94d6b5, 0xff94d6b5, 0xff8cceb5, 0xffa5b5de, 0xff8c8cbd, + 0xff7bbd9c, 0xff7bc69c, 0xff7bb59c, 0xff84bda5, 0xff6b847b, 0xff8c8c8c, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff8c8c8c, 0xff8cb5a5, 0xffa5dec6, 0xff8cceb5, + 0xff8cc6ad, 0xff84cead, 0xff8cadbd, 0xff84a5ad, 0xff73bd9c, 0xff73b594, + 0xff73b594, 0xff7bad9c, 0xff5a736b, 0xffadadad, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xffadadad, 0xff737b7b, 0xff9ccebd, 0xff84c6a5, 0xff84c6a5, 0xff7bbda5, + 0xff94a5ce, 0xff8484b5, 0xff63ad8c, 0xff6bad94, 0xff6bad94, 0xff6b9484, + 0xff737373, 0xffbdbdbd, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff8c8c8c, + 0xff6b8c7b, 0xff7bc6a5, 0xff7bbda5, 0xff7bbd9c, 0xff73a59c, 0xff73948c, + 0xff73b594, 0xff5a9c84, 0xff5a9c84, 0xff636363, 0xff9c9c9c, 0xffced6ce, + 0xffadadad, 0xffbdbdbd, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xffbdbdbd, 0xff7b7b7b, 0xff6b7b73, + 0xff84b59c, 0xff84b5a5, 0xff84bda5, 0xff7bb59c, 0xff7bad94, 0xff739484, + 0xff5a5a5a, 0xff9c9c9c, 0xc6c6c6, 0xffadadad, 0xff636363, 0xff5a5a5a, + 0xffadadad, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xffbdbdbd, 0xff8c8c8c, 0xff636b6b, 0xff6b7b73, + 0xff6b847b, 0xff6b847b, 0xff63736b, 0xff6b6b6b, 0xffadadad, 0xc6c6c6, + 0xc6c6c6, 0xffc6c6c6, 0xff7b7b7b, 0xff292929, 0xff393939, 0xff8c8c8c, + 0xffbdbdbd, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xffb5b5b5, 0xff9c9c9c, 0xff8c8c8c, 0xff949494, + 0xffa5a5a5, 0xffc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xffa5a5a5, 0xff424242, 0xff292929, 0xff6b6b6b, 0xffadadad, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xffbdbdbd, 0xff737373, 0xff212121, 0xff393939, 0xff949494, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff9c9c9c, 0xff393939, 0xff212121, 0xff6b6b6b, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xffb5b5b5, + 0xff636363, 0xff5a5a5a, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6; + +# images/textbold +my $image_9_data = pack 'L*', + + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6; + +# images/textcenter +my $image_10_data = pack 'L*', + + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6; + +# images/textitalic +my $image_11_data = pack 'L*', + + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6; + +# images/textleft +my $image_12_data = pack 'L*', + + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6; + +# images/textright +my $image_13_data = pack 'L*', + + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6; + +# images/textunder +my $image_14_data = pack 'L*', + + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, + 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000000, 0xff000000, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, + 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xff000000, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6; + +# images/undo +my $image_15_data = pack 'L*', + + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, + 0xff000084, 0xff848284, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, 0xff000084, + 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, + 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000084, 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000084, + 0xff000084, 0xff000084, 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, 0xff848284, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, + 0xff000084, 0xc6c6c6, 0xff000084, 0xff000084, 0xff000084, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, 0xff000084, 0xff000084, + 0xff000084, 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000084, 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, + 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, 0xff000084, 0xff000084, + 0xff000084, 0xff000084, 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000084, 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, 0xff000084, + 0xff000084, 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, 0xff848284, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff848284, + 0xff000084, 0xff000084, 0xff000084, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xff000084, 0xff000084, 0xff000084, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, + 0xc6c6c6, 0xc6c6c6, 0xc6c6c6, 0xc6c6c6; + +my %embed_images = ( + "editcopy" => [$image_0_data, 22, 22, 32, undef, 1], + "editcut" => [$image_1_data, 22, 22, 32, undef, 1], + "editpaste" => [$image_2_data, 22, 22, 32, undef, 1], + "filenew" => [$image_3_data, 22, 22, 32, undef, 1], + "fileopen" => [$image_4_data, 22, 22, 32, undef, 1], + "filesave" => [$image_5_data, 22, 22, 32, undef, 1], + "print" => [$image_6_data, 22, 22, 32, undef, 1], + "redo" => [$image_7_data, 22, 22, 32, undef, 1], + "searchfind" => [$image_8_data, 22, 22, 32, undef, 1], + "textbold" => [$image_9_data, 22, 22, 32, undef, 1], + "textcenter" => [$image_10_data, 22, 22, 32, undef, 1], + "textitalic" => [$image_11_data, 22, 22, 32, undef, 1], + "textleft" => [$image_12_data, 22, 22, 32, undef, 1], + "textright" => [$image_13_data, 22, 22, 32, undef, 1], + "textunder" => [$image_14_data, 22, 22, 32, undef, 1], + "undo" => [$image_15_data, 22, 22, 32, undef, 1], +); + +my %images = (); + + +sub uic_findImage +{ + my $name = shift; + return $images{$name} if exists $images{$name}; + return Qt::Image() unless exists $embed_images{$name}; + + my $img = Qt::Image(@{$embed_images{$name}}[0..4], &Qt::Image::BigEndian); + ${$embed_images{$name}}[5] && $img->setAlphaBuffer(1); + $images{$name} = $img; + return $img; +} + +sub data +{ + my $abs_name = shift; + my $img = uic_findImage($abs_name); + if($img->isNull()) + { + Qt::MimeSourceFactory::removeFactory(this); + my $s = Qt::MimeSourceFactory::defaultFactory()->data($abs_name); + Qt::MimeSourceFactory::addFactory(this); + return $s; + } + Qt::MimeSourceFactory::defaultFactory()->setImage($abs_name, $img); + return Qt::MimeSourceFactory::defaultFactory()->data($abs_name); +} + + +package staticImages; +use Qt; +use DesignerMimeSourceFactory_richedit; +our %factories; + +my $factory = DesignerMimeSourceFactory_richedit; +Qt::MimeSourceFactory::defaultFactory()->addFactory($factory); +$factories{'DesignerMimeSourceFactory_richedit'} = $factory; + +END +{ + for( values %factories ) + { + Qt::MimeSourceFactory::defaultFactory()->removeFactory($_); + } + %factories = (); +} +1; + diff --git a/PerlQt/examples/richedit/richedit.pl b/PerlQt/examples/richedit/richedit.pl new file mode 100644 index 0000000..ef39e73 --- /dev/null +++ b/PerlQt/examples/richedit/richedit.pl @@ -0,0 +1,376 @@ +# Form implementation generated from reading ui file 'richedit.ui' +# +# Created: jeu jun 13 20:02:56 2002 +# by: The PerlQt User Interface Compiler (puic) +# + + +use strict; + +# the below is a manual addition... +# maybe puic should do that. +# Allows to run a modular application from anywhere +use FindBin; +use lib "$FindBin::Bin"; + +package EditorForm; +use Qt; +use Qt::isa qw(Qt::MainWindow); +use Qt::slots + init => [], + fileExit => [], + fileNew => [], + fileOpen => [], + fileSave => [], + fileSaveAs => [], + helpAbout => [], + helpContents => [], + helpIndex => [], + changeAlignment => ['QAction*'], + saveAndContinue => ['const QString&']; +use Qt::attributes qw( + textEdit + fontComboBox + SpinBox2 + menubar + fileMenu + editMenu + PopupMenu_2 + helpMenu + toolBar + Toolbar + fileNewAction + fileOpenAction + fileSaveAction + fileSaveAsAction + fileExitAction + editUndoAction + editRedoAction + editCutAction + editCopyAction + editPasteAction + helpContentsAction + helpIndexAction + helpAboutAction + boldAction + italicAction + underlineAction + alignActionGroup + leftAlignAction + rightAlignAction + centerAlignAction +); + + +sub uic_load_pixmap_EditorForm +{ + my $pix = Qt::Pixmap(); + my $m = Qt::MimeSourceFactory::defaultFactory()->data(shift); + + if($m) + { + Qt::ImageDrag::decode($m, $pix); + } + + return $pix; +} + + +sub NEW +{ + shift->SUPER::NEW(@_[0..2]); + this->statusBar(); + + if( this->name() eq "unnamed" ) + { + this->setName("EditorForm"); + } + this->resize(646,436); + this->setCaption(this->trUtf8("Rich Edit")); + + this->setCentralWidget(Qt::Widget(this, "qt_central_widget")); + my $EditorFormLayout = Qt::HBoxLayout(this->centralWidget(), 11, 6, '$EditorFormLayout'); + + textEdit = Qt::TextEdit(this->centralWidget(), "textEdit"); + textEdit->setSizePolicy(Qt::SizePolicy(7, 7, 0, 0, textEdit->sizePolicy()->hasHeightForWidth())); + textEdit->setTextFormat(&Qt::TextEdit::RichText); + $EditorFormLayout->addWidget(textEdit); + + fileNewAction= Qt::Action(this,"fileNewAction"); + fileNewAction->setIconSet(Qt::IconSet(uic_load_pixmap_EditorForm("filenew"))); + fileNewAction->setText(this->trUtf8("New")); + fileNewAction->setMenuText(this->trUtf8("&New")); + fileNewAction->setAccel(Qt::KeySequence(int(4194382))); + fileOpenAction= Qt::Action(this,"fileOpenAction"); + fileOpenAction->setIconSet(Qt::IconSet(uic_load_pixmap_EditorForm("fileopen"))); + fileOpenAction->setText(this->trUtf8("Open")); + fileOpenAction->setMenuText(this->trUtf8("&Open...")); + fileOpenAction->setAccel(Qt::KeySequence(int(4194383))); + fileSaveAction= Qt::Action(this,"fileSaveAction"); + fileSaveAction->setIconSet(Qt::IconSet(uic_load_pixmap_EditorForm("filesave"))); + fileSaveAction->setText(this->trUtf8("Save")); + fileSaveAction->setMenuText(this->trUtf8("&Save")); + fileSaveAction->setAccel(Qt::KeySequence(int(4194387))); + fileSaveAsAction= Qt::Action(this,"fileSaveAsAction"); + fileSaveAsAction->setText(this->trUtf8("Save As")); + fileSaveAsAction->setMenuText(this->trUtf8("Save &As...")); + fileSaveAsAction->setAccel(Qt::KeySequence(int(0))); + fileExitAction= Qt::Action(this,"fileExitAction"); + fileExitAction->setText(this->trUtf8("Exit")); + fileExitAction->setMenuText(this->trUtf8("E&xit")); + fileExitAction->setAccel(Qt::KeySequence(int(0))); + editUndoAction= Qt::Action(this,"editUndoAction"); + editUndoAction->setIconSet(Qt::IconSet(uic_load_pixmap_EditorForm("undo"))); + editUndoAction->setText(this->trUtf8("Undo")); + editUndoAction->setMenuText(this->trUtf8("&Undo")); + editUndoAction->setAccel(Qt::KeySequence(int(4194394))); + editRedoAction= Qt::Action(this,"editRedoAction"); + editRedoAction->setIconSet(Qt::IconSet(uic_load_pixmap_EditorForm("redo"))); + editRedoAction->setText(this->trUtf8("Redo")); + editRedoAction->setMenuText(this->trUtf8("&Redo")); + editRedoAction->setAccel(Qt::KeySequence(int(4194393))); + editCutAction= Qt::Action(this,"editCutAction"); + editCutAction->setIconSet(Qt::IconSet(uic_load_pixmap_EditorForm("editcut"))); + editCutAction->setText(this->trUtf8("Cut")); + editCutAction->setMenuText(this->trUtf8("&Cut")); + editCutAction->setAccel(Qt::KeySequence(int(4194392))); + editCopyAction= Qt::Action(this,"editCopyAction"); + editCopyAction->setIconSet(Qt::IconSet(uic_load_pixmap_EditorForm("editcopy"))); + editCopyAction->setText(this->trUtf8("Copy")); + editCopyAction->setMenuText(this->trUtf8("C&opy")); + editCopyAction->setAccel(Qt::KeySequence(int(4194371))); + editPasteAction= Qt::Action(this,"editPasteAction"); + editPasteAction->setIconSet(Qt::IconSet(uic_load_pixmap_EditorForm("editpaste"))); + editPasteAction->setText(this->trUtf8("Paste")); + editPasteAction->setMenuText(this->trUtf8("&Paste")); + editPasteAction->setAccel(Qt::KeySequence(int(4194390))); + helpContentsAction= Qt::Action(this,"helpContentsAction"); + helpContentsAction->setText(this->trUtf8("Contents")); + helpContentsAction->setMenuText(this->trUtf8("&Contents...")); + helpContentsAction->setAccel(Qt::KeySequence(int(0))); + helpIndexAction= Qt::Action(this,"helpIndexAction"); + helpIndexAction->setText(this->trUtf8("Index")); + helpIndexAction->setMenuText(this->trUtf8("&Index...")); + helpIndexAction->setAccel(Qt::KeySequence(int(0))); + helpAboutAction= Qt::Action(this,"helpAboutAction"); + helpAboutAction->setText(this->trUtf8("About")); + helpAboutAction->setMenuText(this->trUtf8("&About...")); + helpAboutAction->setAccel(Qt::KeySequence(int(0))); + boldAction= Qt::Action(this,"boldAction"); + boldAction->setToggleAction(1); + boldAction->setIconSet(Qt::IconSet(uic_load_pixmap_EditorForm("textbold"))); + boldAction->setText(this->trUtf8("bold")); + boldAction->setMenuText(this->trUtf8("&Bold")); + boldAction->setAccel(Qt::KeySequence(int(272629826))); + italicAction= Qt::Action(this,"italicAction"); + italicAction->setToggleAction(1); + italicAction->setIconSet(Qt::IconSet(uic_load_pixmap_EditorForm("textitalic"))); + italicAction->setText(this->trUtf8("italic")); + italicAction->setMenuText(this->trUtf8("&Italic")); + italicAction->setAccel(Qt::KeySequence(int(272629833))); + underlineAction= Qt::Action(this,"underlineAction"); + underlineAction->setToggleAction(1); + underlineAction->setIconSet(Qt::IconSet(uic_load_pixmap_EditorForm("textunder"))); + underlineAction->setText(this->trUtf8("underline")); + underlineAction->setMenuText(this->trUtf8("&Underline")); + underlineAction->setAccel(Qt::KeySequence(int(272629845))); + alignActionGroup= Qt::ActionGroup(this,"alignActionGroup"); + alignActionGroup->setText(this->trUtf8("align")); + alignActionGroup->setUsesDropDown(0); + leftAlignAction= Qt::Action(alignActionGroup,"leftAlignAction"); + leftAlignAction->setToggleAction(1); + leftAlignAction->setIconSet(Qt::IconSet(uic_load_pixmap_EditorForm("textleft"))); + leftAlignAction->setText(this->trUtf8("left")); + leftAlignAction->setMenuText(this->trUtf8("&Left")); + leftAlignAction->setAccel(Qt::KeySequence(int(272629836))); + rightAlignAction= Qt::Action(alignActionGroup,"rightAlignAction"); + rightAlignAction->setToggleAction(1); + rightAlignAction->setIconSet(Qt::IconSet(uic_load_pixmap_EditorForm("textright"))); + rightAlignAction->setText(this->trUtf8("right")); + rightAlignAction->setMenuText(this->trUtf8("&Right")); + rightAlignAction->setAccel(Qt::KeySequence(int(272629842))); + centerAlignAction= Qt::Action(alignActionGroup,"centerAlignAction"); + centerAlignAction->setToggleAction(1); + centerAlignAction->setIconSet(Qt::IconSet(uic_load_pixmap_EditorForm("textcenter"))); + centerAlignAction->setText(this->trUtf8("center")); + centerAlignAction->setMenuText(this->trUtf8("&Center")); + + + toolBar = Qt::ToolBar("", this, &DockTop); + + toolBar->setLabel(this->trUtf8("Tools")); + fileNewAction->addTo(toolBar); + fileOpenAction->addTo(toolBar); + fileSaveAction->addTo(toolBar); + toolBar->addSeparator; + editUndoAction->addTo(toolBar); + editRedoAction->addTo(toolBar); + editCutAction->addTo(toolBar); + editCopyAction->addTo(toolBar); + editPasteAction->addTo(toolBar); + Toolbar = Qt::ToolBar("", this, &DockTop); + + Toolbar->setLabel(this->trUtf8("Toolbar")); + leftAlignAction->addTo(Toolbar); + centerAlignAction->addTo(Toolbar); + rightAlignAction->addTo(Toolbar); + Toolbar->addSeparator; + boldAction->addTo(Toolbar); + italicAction->addTo(Toolbar); + underlineAction->addTo(Toolbar); + Toolbar->addSeparator; + + fontComboBox = Qt::ComboBox(0, Toolbar, "fontComboBox"); + + SpinBox2 = Qt::SpinBox(Toolbar, "SpinBox2"); + SpinBox2->setMinValue(int(6)); + SpinBox2->setValue(int(10)); + + + menubar= Qt::MenuBar( this, "menubar"); + + fileMenu= Qt::PopupMenu(this); + fileNewAction->addTo(fileMenu); + fileOpenAction->addTo(fileMenu); + fileSaveAction->addTo(fileMenu); + fileSaveAsAction->addTo(fileMenu); + fileMenu->insertSeparator; + fileExitAction->addTo(fileMenu); + menubar->insertItem(this->trUtf8("&File"), fileMenu); + + editMenu= Qt::PopupMenu(this); + editUndoAction->addTo(editMenu); + editRedoAction->addTo(editMenu); + editMenu->insertSeparator; + editCutAction->addTo(editMenu); + editCopyAction->addTo(editMenu); + editPasteAction->addTo(editMenu); + menubar->insertItem(this->trUtf8("&Edit"), editMenu); + + PopupMenu_2= Qt::PopupMenu(this); + leftAlignAction->addTo(PopupMenu_2); + rightAlignAction->addTo(PopupMenu_2); + centerAlignAction->addTo(PopupMenu_2); + PopupMenu_2->insertSeparator; + boldAction->addTo(PopupMenu_2); + italicAction->addTo(PopupMenu_2); + underlineAction->addTo(PopupMenu_2); + menubar->insertItem(this->trUtf8("F&ormat"), PopupMenu_2); + + helpMenu= Qt::PopupMenu(this); + helpContentsAction->addTo(helpMenu); + helpIndexAction->addTo(helpMenu); + helpMenu->insertSeparator; + helpAboutAction->addTo(helpMenu); + menubar->insertItem(this->trUtf8("&Help"), helpMenu); + + + + Qt::Object::connect(fileNewAction, SIGNAL "activated()", this, SLOT "fileNew()"); + Qt::Object::connect(fileOpenAction, SIGNAL "activated()", this, SLOT "fileOpen()"); + Qt::Object::connect(fileSaveAction, SIGNAL "activated()", this, SLOT "fileSave()"); + Qt::Object::connect(fileSaveAsAction, SIGNAL "activated()", this, SLOT "fileSaveAs()"); + Qt::Object::connect(fileExitAction, SIGNAL "activated()", this, SLOT "fileExit()"); + Qt::Object::connect(helpIndexAction, SIGNAL "activated()", this, SLOT "helpIndex()"); + Qt::Object::connect(helpContentsAction, SIGNAL "activated()", this, SLOT "helpContents()"); + Qt::Object::connect(helpAboutAction, SIGNAL "activated()", this, SLOT "helpAbout()"); + Qt::Object::connect(SpinBox2, SIGNAL "valueChanged(int)", textEdit, SLOT "setPointSize(int)"); + Qt::Object::connect(editCutAction, SIGNAL "activated()", textEdit, SLOT "cut()"); + Qt::Object::connect(editPasteAction, SIGNAL "activated()", textEdit, SLOT "paste()"); + Qt::Object::connect(editCopyAction, SIGNAL "activated()", textEdit, SLOT "copy()"); + Qt::Object::connect(editRedoAction, SIGNAL "activated()", textEdit, SLOT "redo()"); + Qt::Object::connect(editUndoAction, SIGNAL "activated()", textEdit, SLOT "undo()"); + Qt::Object::connect(alignActionGroup, SIGNAL "selected(QAction*)", this, SLOT "changeAlignment(QAction*)"); + Qt::Object::connect(underlineAction, SIGNAL "toggled(bool)", textEdit, SLOT "setUnderline(bool)"); + Qt::Object::connect(italicAction, SIGNAL "toggled(bool)", textEdit, SLOT "setItalic(bool)"); + Qt::Object::connect(boldAction, SIGNAL "toggled(bool)", textEdit, SLOT "setBold(bool)"); + Qt::Object::connect(fontComboBox, SIGNAL "activated(const QString&)", textEdit, SLOT "setFamily(const QString&)"); + Qt::Object::connect(fontComboBox, SIGNAL "activated(const QString&)", textEdit, SLOT "setFocus()"); + + init(); +} + + +sub init +{ + + textEdit->setFocus; + my $fonts = Qt::FontDatabase; + fontComboBox->insertStringList($fonts->families); + my $font = lc textEdit->family; + for(my $i = 0; $i < fontComboBox->count; $i++) { + if($font eq fontComboBox->text($i)) { + fontComboBox->setCurrentItem($i); + last; + } + } + +} + +sub fileExit +{ + print "EditorForm->fileExit(): Not implemented yet.\n"; +} + +sub fileNew +{ + print "EditorForm->fileNew(): Not implemented yet.\n"; +} + +sub fileOpen +{ + print "EditorForm->fileOpen(): Not implemented yet.\n"; +} + +sub fileSave +{ + print "EditorForm->fileSave(): Not implemented yet.\n"; +} + +sub fileSaveAs +{ + print "EditorForm->fileSaveAs(): Not implemented yet.\n"; +} + +sub helpAbout +{ + print "EditorForm->helpAbout(): Not implemented yet.\n"; +} + +sub helpContents +{ + print "EditorForm->helpContents(): Not implemented yet.\n"; +} + +sub helpIndex +{ + print "EditorForm->helpIndex(): Not implemented yet.\n"; +} + +sub changeAlignment +{ + print "EditorForm->changeAlignment(QAction*): Not implemented yet.\n"; +} + +sub saveAndContinue +{ + print "EditorForm->saveAndContinue(const QString&): Not implemented yet.\n"; +} + +1; + + +package main; + +use Qt; +use EditorForm; +use imageCollection; + +my $a = Qt::Application(\@ARGV); +Qt::Object::connect($a, SIGNAL("lastWindowClosed()"), $a, SLOT("quit()")); +my $w = EditorForm; +$a->setMainWidget($w); +$w->show; +exit $a->exec; + + diff --git a/PerlQt/handlers.cpp b/PerlQt/handlers.cpp new file mode 100644 index 0000000..da0278c --- /dev/null +++ b/PerlQt/handlers.cpp @@ -0,0 +1,1347 @@ +#include <qstring.h> +#include <qregexp.h> +#include <qapplication.h> +#include <qmetaobject.h> +#include <qvaluelist.h> +#include <qwidgetlist.h> +#include <qcanvas.h> +#include <qobjectlist.h> +#include <qintdict.h> +#include <qtoolbar.h> +#include <qtabbar.h> +#include <qdir.h> +#include <qdockwindow.h> +#include <qnetworkprotocol.h> +#include <private/qucomextra_p.h> +#include "smoke.h" + +#undef DEBUG +#ifndef _GNU_SOURCE +#define _GNU_SOURCE +#endif +#ifndef __USE_POSIX +#define __USE_POSIX +#endif +#ifndef __USE_XOPEN +#define __USE_XOPEN +#endif +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#if PERL_VERSION == 6 && PERL_SUBVERSION == 0 + #include <qtextcodec.h> +#endif + +#include "marshall.h" +#include "perlqt.h" +#include "smokeperl.h" + +#ifndef HINT_BYTES +#define HINT_BYTES HINT_BYTE +#endif + +#ifndef PERL_MAGIC_tiedscalar +#define PERL_MAGIC_tiedscalar 'q' +#endif + +extern HV* pointer_map; +static QIntDict<Smoke::Index> *dtorcache= 0; +static QIntDict<Smoke::Index> *cctorcache= 0; + +int smokeperl_free(pTHX_ SV *sv, MAGIC *mg) { + smokeperl_object *o = (smokeperl_object*)mg->mg_ptr; + + const char *className = o->smoke->classes[o->classId].className; + if(o->allocated && o->ptr) { + if(do_debug && (do_debug & qtdb_gc)) fprintf(stderr, "Deleting (%s*)%p\n", className, o->ptr); + SmokeClass sc(o->smoke, o->classId); + if(sc.hasVirtual()) + unmapPointer(o, o->classId, 0); + Smoke::Index *pmeth = dtorcache->find( o->classId ); + if(pmeth) { + Smoke::Method &m = o->smoke->methods[o->smoke->methodMaps[*pmeth].method]; + Smoke::ClassFn fn = o->smoke->classes[m.classId].classFn; + Smoke::StackItem i[1]; + (*fn)(m.method, o->ptr, i); + } else { + char *methodName = new char[strlen(className) + 2]; + methodName[0] = '~'; + strcpy(methodName + 1, className); + Smoke::Index nameId = o->smoke->idMethodName(methodName); + Smoke::Index meth = o->smoke->findMethod(o->classId, nameId); + if(meth > 0) { + dtorcache->insert(o->classId, new Smoke::Index(meth)); + Smoke::Method &m = o->smoke->methods[o->smoke->methodMaps[meth].method]; + Smoke::ClassFn fn = o->smoke->classes[m.classId].classFn; + Smoke::StackItem i[1]; + (*fn)(m.method, o->ptr, i); + } + delete[] methodName; + } + } + return 0; +} + +struct mgvtbl vtbl_smoke = { 0, 0, 0, 0, smokeperl_free }; + +bool matches_arg(Smoke *smoke, Smoke::Index meth, Smoke::Index argidx, const char *argtype) { + Smoke::Index *arg = smoke->argumentList + smoke->methods[meth].args + argidx; + SmokeType type = SmokeType(smoke, *arg); + if(type.name() && !strcmp(type.name(), argtype)) + return true; + return false; +} + +void *construct_copy(smokeperl_object *o) { + Smoke::Index *pccMeth = cctorcache->find(o->classId); + Smoke::Index ccMeth = 0; + if(!pccMeth) { + const char *className = o->smoke->className(o->classId); + int classNameLen = strlen(className); + char *ccSig = new char[classNameLen + 2]; // copy constructor signature + strcpy(ccSig, className); + strcat(ccSig, "#"); + Smoke::Index ccId = o->smoke->idMethodName(ccSig); + delete[] ccSig; + + char *ccArg = new char[classNameLen + 8]; + sprintf(ccArg, "const %s&", className); + + ccMeth = o->smoke->findMethod(o->classId, ccId); + + if(!ccMeth) { + cctorcache->insert(o->classId, new Smoke::Index(0)); + return 0; + } + Smoke::Index method = o->smoke->methodMaps[ccMeth].method; + if(method > 0) { + // Make sure it's a copy constructor + if(!matches_arg(o->smoke, method, 0, ccArg)) { + delete[] ccArg; + cctorcache->insert(o->classId, new Smoke::Index(0)); + return 0; + } + delete[] ccArg; + ccMeth = method; + } else { + // ambiguous method, pick the copy constructor + Smoke::Index i = -method; + while(o->smoke->ambiguousMethodList[i]) { + if(matches_arg(o->smoke, o->smoke->ambiguousMethodList[i], 0, ccArg)) + break; + i++; + } + delete[] ccArg; + ccMeth = o->smoke->ambiguousMethodList[i]; + if(!ccMeth) { + cctorcache->insert(o->classId, new Smoke::Index(0)); + return 0; + } + } + cctorcache->insert(o->classId, new Smoke::Index(ccMeth)); + } else { + ccMeth = *pccMeth; + if(!ccMeth) + return 0; + } + // Okay, ccMeth is the copy constructor. Time to call it. + Smoke::StackItem args[2]; + args[0].s_voidp = 0; + args[1].s_voidp = o->ptr; + Smoke::ClassFn fn = o->smoke->classes[o->classId].classFn; + (*fn)(o->smoke->methods[ccMeth].method, 0, args); + return args[0].s_voidp; +} + +static void marshall_basetype(Marshall *m) { + switch(m->type().elem()) { + case Smoke::t_bool: + switch(m->action()) { + case Marshall::FromSV: + m->item().s_bool = SvTRUE(m->var()) ? true : false; + break; + case Marshall::ToSV: + sv_setsv_mg(m->var(), boolSV(m->item().s_bool)); + break; + default: + m->unsupported(); + break; + } + break; + case Smoke::t_char: + switch(m->action()) { + case Marshall::FromSV: + m->item().s_char = (char)SvIV(m->var()); + break; + case Marshall::ToSV: + sv_setiv_mg(m->var(), (IV)m->item().s_char); + break; + default: + m->unsupported(); + break; + } + break; + case Smoke::t_uchar: + switch(m->action()) { + case Marshall::FromSV: + m->item().s_uchar = (unsigned char)SvIV(m->var()); + break; + case Marshall::ToSV: + sv_setiv_mg(m->var(), (IV)m->item().s_uchar); + break; + default: + m->unsupported(); + break; + } + break; + case Smoke::t_short: + switch(m->action()) { + case Marshall::FromSV: + m->item().s_short = (short)SvIV(m->var()); + break; + case Marshall::ToSV: + sv_setiv_mg(m->var(), (IV)m->item().s_short); + break; + default: + m->unsupported(); + break; + } + break; + case Smoke::t_ushort: + switch(m->action()) { + case Marshall::FromSV: + m->item().s_ushort = (unsigned short)SvIV(m->var()); + break; + case Marshall::ToSV: + sv_setiv_mg(m->var(), (IV)m->item().s_ushort); + break; + default: + m->unsupported(); + break; + } + break; + case Smoke::t_int: + switch(m->action()) { + case Marshall::FromSV: + m->item().s_int = (int)SvIV(m->var()); + break; + case Marshall::ToSV: + sv_setiv_mg(m->var(), (IV)m->item().s_int); + break; + default: + m->unsupported(); + break; + } + break; + case Smoke::t_uint: + switch(m->action()) { + case Marshall::FromSV: + m->item().s_uint = (unsigned int)SvIV(m->var()); + break; + case Marshall::ToSV: + sv_setiv_mg(m->var(), (IV)m->item().s_uint); + break; + default: + m->unsupported(); + break; + } + break; + case Smoke::t_long: + switch(m->action()) { + case Marshall::FromSV: + m->item().s_long = (long)SvIV(m->var()); + break; + case Marshall::ToSV: + sv_setiv_mg(m->var(), (IV)m->item().s_long); + break; + default: + m->unsupported(); + break; + } + break; + case Smoke::t_ulong: + switch(m->action()) { + case Marshall::FromSV: + m->item().s_ulong = (unsigned long)SvIV(m->var()); + break; + case Marshall::ToSV: + sv_setiv_mg(m->var(), (IV)m->item().s_ulong); + break; + default: + m->unsupported(); + break; + } + break; + case Smoke::t_float: + switch(m->action()) { + case Marshall::FromSV: + m->item().s_float = (float)SvNV(m->var()); + break; + case Marshall::ToSV: + sv_setnv_mg(m->var(), (NV)m->item().s_float); + break; + default: + m->unsupported(); + break; + } + break; + case Smoke::t_double: + switch(m->action()) { + case Marshall::FromSV: + m->item().s_double = (double)SvNV(m->var()); + break; + case Marshall::ToSV: + sv_setnv_mg(m->var(), (NV)m->item().s_double); + break; + default: + m->unsupported(); + break; + } + break; + case Smoke::t_enum: + switch(m->action()) { + case Marshall::FromSV: + m->item().s_enum = (long)SvIV(m->var()); + break; + case Marshall::ToSV: + sv_setiv_mg(m->var(), (IV)m->item().s_enum); + break; + default: + m->unsupported(); + break; + } + break; + case Smoke::t_class: + switch(m->action()) { + case Marshall::FromSV: + { + smokeperl_object *o = sv_obj_info(m->var()); + if(!o || !o->ptr) { + if(m->type().isRef()) { + warn("References can't be null or undef\n"); + m->unsupported(); + } + m->item().s_class = 0; + break; + } + void *ptr = o->ptr; + if(!m->cleanup() && m->type().isStack()) { + void *p = construct_copy(o); + if(p) + ptr = p; + } + const Smoke::Class &c = m->smoke()->classes[m->type().classId()]; + ptr = o->smoke->cast( + ptr, // pointer + o->classId, // from + o->smoke->idClass(c.className) // to + ); + m->item().s_class = ptr; + break; + } + break; + case Marshall::ToSV: + { + if(!m->item().s_voidp) { + sv_setsv_mg(m->var(), &PL_sv_undef); + break; + } + void *p = m->item().s_voidp; + SV *obj = getPointerObject(p); + if(obj) { + sv_setsv_mg(m->var(), obj); + break; + } + HV *hv = newHV(); + obj = newRV_noinc((SV*)hv); + // TODO: Generic mapping from C++ classname to Qt classname + + smokeperl_object o; + o.smoke = m->smoke(); + o.classId = m->type().classId(); + o.ptr = p; + o.allocated = false; + + if(m->type().isStack()) + o.allocated = true; + + char *buf = m->smoke()->binding->className(m->type().classId()); + sv_bless(obj, gv_stashpv(buf, TRUE)); + delete[] buf; + if(m->type().isConst() && m->type().isRef()) { + p = construct_copy( &o ); + if(p) { + o.ptr = p; + o.allocated = true; + } + } + sv_magic((SV*)hv, sv_qapp, '~', (char*)&o, sizeof(o)); + MAGIC *mg = mg_find((SV*)hv, '~'); + mg->mg_virtual = &vtbl_smoke; + sv_setsv_mg(m->var(), obj); + SmokeClass sc( m->type() ); + if( sc.hasVirtual() ) + mapPointer(obj, &o, pointer_map, o.classId, 0); + SvREFCNT_dec(obj); + } + break; + default: + m->unsupported(); + break; + } + break; + default: + m->unsupported(); + break; + } +} + +static void marshall_void(Marshall *) {} +static void marshall_unknown(Marshall *m) { + m->unsupported(); +} + +static void marshall_charP(Marshall *m) { + switch(m->action()) { + case Marshall::FromSV: + { + SV *sv = m->var(); + if(!SvOK(sv)) { + m->item().s_voidp = 0; + break; + } + if(m->cleanup()) + m->item().s_voidp = SvPV_nolen(sv); + else { + STRLEN len; + char *svstr = SvPV(sv, len); + char *str = new char [len + 1]; + strncpy(str, svstr, len); + str[len] = 0; + m->item().s_voidp = str; + } + } + break; + case Marshall::ToSV: + { + char *p = (char*)m->item().s_voidp; + if(p) + sv_setpv_mg(m->var(), p); + else + sv_setsv_mg(m->var(), &PL_sv_undef); + if(m->cleanup()) + delete[] p; + } + break; + default: + m->unsupported(); + break; + } +} + +void marshall_ucharP(Marshall *m) { + switch(m->action()) { + case Marshall::FromSV: + { + SV* sv = m->var(); + QByteArray *s = 0; + MAGIC* mg = 0; + bool hasMagic = false; + if(SvOK(sv)) { + if( SvTYPE(sv) == SVt_PVMG && (mg = mg_find(sv, PERL_MAGIC_tiedscalar)) + && sv_derived_from(mg->mg_obj, "Qt::_internal::QByteArray") ) { + s = (QByteArray*)SvIV((SV*)SvRV(mg->mg_obj)); + hasMagic = true; + } else { + STRLEN len; + char* tmp = SvPV(sv, len); + s = new QByteArray(len); + Copy((void*)tmp, (void*)s->data(), len, char); + if( !m->type().isConst() && !SvREADONLY(sv) ) { + SV* rv = newSV(0); + sv_setref_pv(rv, "Qt::_internal::QByteArray", (void*)s); + sv_magic(sv, rv, PERL_MAGIC_tiedscalar, Nullch, 0); + hasMagic = true; + } + } + } else { + if( !m->type().isConst() ) { + if(SvREADONLY(sv) && m->type().isPtr()) { + m->item().s_voidp = 0; + break; + } + s = new QByteArray(0); + if( !SvREADONLY(sv) ) { + SV* rv = newSV(0); + sv_setpv_mg(sv, ""); + sv_setref_pv(rv, "Qt::_internal::QByteArray", s); + sv_magic(sv, rv, PERL_MAGIC_tiedscalar, Nullch, 0); + hasMagic = true; + } + } else + s = new QByteArray(0); + } + m->item().s_voidp = s->data(); + m->next(); + if(s && !hasMagic && m->cleanup()) + delete s; + } + break; + default: + m->unsupported(); + break; + } +} + +static void marshall_QString(Marshall *m) { + switch(m->action()) { + case Marshall::FromSV: + { + SV* sv = m->var(); + QString *s = 0; + MAGIC* mg = 0; + bool hasMagic = false; + if(SvOK(sv) || m->type().isStack()) { + if( SvTYPE(sv) == SVt_PVMG && (mg = mg_find(sv, PERL_MAGIC_tiedscalar)) + && sv_derived_from(mg->mg_obj, "Qt::_internal::QString") ) { + s = (QString*)SvIV((SV*)SvRV(mg->mg_obj)); + hasMagic = true; + } else { + COP *cop = cxstack[cxstack_ix].blk_oldcop; + if(SvUTF8(sv)) + s = new QString(QString::fromUtf8(SvPV_nolen(sv))); + else if(cop->op_private & HINT_LOCALE) + s = new QString(QString::fromLocal8Bit(SvPV_nolen(sv))); + else + s = new QString(QString::fromLatin1(SvPV_nolen(sv))); + if( !m->type().isConst() && !m->type().isStack() && !SvREADONLY(sv)) { + SV* rv = newSV(0); + sv_setref_pv(rv, "Qt::_internal::QString", (void*)s); + sv_magic(sv, rv, PERL_MAGIC_tiedscalar, Nullch, 0); + hasMagic = true; + } + } + } else { + if(!m->type().isConst()) { + if(SvREADONLY(sv) && m->type().isPtr()) { + m->item().s_voidp = 0; + break; + } + s = new QString; + if( !SvREADONLY(sv) ) { + SV* rv = newSV(0); + sv_setpv_mg(sv, ""); + sv_setref_pv(rv, "Qt::_internal::QString", s); + sv_magic(sv, rv, PERL_MAGIC_tiedscalar, Nullch, 0); + hasMagic = true; + } + } else + s = new QString; + } + m->item().s_voidp = s; + m->next(); + if(s && !hasMagic && m->cleanup()) + delete s; + } + break; + case Marshall::ToSV: + { + QString *s = (QString*)m->item().s_voidp; + if(s) { + COP *cop = cxstack[cxstack_ix].blk_oldcop; + if(!(cop->op_private & HINT_BYTES)) + { + sv_setpv_mg(m->var(), (const char *)s->utf8()); + SvUTF8_on(m->var()); + } + else if(cop->op_private & HINT_LOCALE) + sv_setpv_mg(m->var(), (const char *)s->local8Bit()); + else + sv_setpv_mg(m->var(), (const char *)s->latin1()); + } + else + sv_setsv_mg(m->var(), &PL_sv_undef); + if(m->cleanup()) + delete s; + } + break; + default: + m->unsupported(); + break; + } +} + +static void marshall_QByteArray(Marshall *m) { + switch(m->action()) { + case Marshall::FromSV: + { + SV* sv = m->var(); + QByteArray *s = 0; + MAGIC* mg = 0; + bool hasMagic = false; + if(SvOK(sv) || m->type().isStack()) { + if( SvTYPE(sv) == SVt_PVMG && (mg = mg_find(sv, PERL_MAGIC_tiedscalar)) + && sv_derived_from(mg->mg_obj, "Qt::_internal::QByteArray") ) { + s = (QByteArray*)SvIV((SV*)SvRV(mg->mg_obj)); + hasMagic = true; + } else { + STRLEN len; + char* tmp = SvPV(sv, len); + s = new QByteArray(len); + Copy((void*)tmp, (void*)s->data(), len, char); + if( !m->type().isConst() && !SvREADONLY(sv) ) { // we tie also stack because of the funny QDataStream behaviour + // fprintf(stderr, "Tying\n"); + SV* rv = newSV(0); + sv_setref_pv(rv, "Qt::_internal::QByteArray", (void*)s); + sv_magic(sv, rv, PERL_MAGIC_tiedscalar, Nullch, 0); + hasMagic = true; + } + } + } else { + if( !m->type().isConst() ) { + if(SvREADONLY(sv) && m->type().isPtr()) { + m->item().s_voidp = 0; + break; + } + s = new QByteArray(0); + if( !SvREADONLY(sv) ) { + SV* rv = newSV(0); + sv_setpv_mg(sv, ""); + sv_setref_pv(rv, "Qt::_internal::QByteArray", s); + sv_magic(sv, rv, PERL_MAGIC_tiedscalar, Nullch, 0); + hasMagic = true; + } + } else + s = new QByteArray(0); + } + m->item().s_voidp = s; + m->next(); + if(s && !hasMagic && m->cleanup()) + delete s; + } + break; +// ToSV is probably overkill here, but will do well as a template for other types. + case Marshall::ToSV: + { + bool hasMagic = false; + SV *sv = m->var(); + QByteArray *s = (QByteArray*)m->item().s_voidp; + if(s) { + if( !m->type().isConst() && !m->type().isStack() && !SvREADONLY(sv)) { + SV* rv = newSV(0); + sv_setref_pv(rv, "Qt::_internal::QByteArray", (void*)s); + sv_magic(sv, rv, PERL_MAGIC_tiedscalar, Nullch, 0); // err, is a previous magic auto-untied here? + hasMagic = true; + } else + sv_setpvn_mg(sv, (const char *)s->data(), s->size()); + } + else + sv_setsv_mg(sv, &PL_sv_undef); + if(m->cleanup() && !hasMagic) + delete s; + } + break; + default: + m->unsupported(); + break; + } +} + +static const char *not_ascii(const char *s, uint &len) +{ + bool r = false; + for(; *s ; s++, len--) + if((uint)*s > 0x7F) + { + r = true; + break; + } + return r ? s : 0L; +} + +static void marshall_QCString(Marshall *m) { + switch(m->action()) { + case Marshall::FromSV: + { + QCString *s = 0; + if(SvOK(m->var()) || m->type().isStack()) + s = new QCString(SvPV_nolen(m->var())); + m->item().s_voidp = s; + m->next(); + if(s && m->cleanup()) + delete s; + } + break; + case Marshall::ToSV: + { + QCString *s = (QCString*)m->item().s_voidp; + if(s) { + sv_setpv_mg(m->var(), (const char *)*s); + const char * p = (const char *)*s; + uint len = s->length(); + COP *cop = cxstack[cxstack_ix].blk_oldcop; + if(!(cop->op_private & HINT_BYTES) && not_ascii(p,len)) + { + #if PERL_VERSION == 6 && PERL_SUBVERSION == 0 + QTextCodec* c = QTextCodec::codecForMib(106); // utf8 + if(c->heuristicContentMatch(p,len) >= 0) + #else + if(is_utf8_string((U8 *)p,len)) + #endif + SvUTF8_on(m->var()); + } + } + else + sv_setsv_mg(m->var(), &PL_sv_undef); + + if(m->cleanup()) + delete s; + } + break; + default: + m->unsupported(); + break; + } +} + +static void marshall_QCOORD_array(Marshall *m) { + switch(m->action()) { + case Marshall::FromSV: + { + SV *sv = m->var(); + if(!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV || + av_len((AV*)SvRV(sv)) < 0) { + m->item().s_voidp = 0; + break; + } + AV *av = (AV*)SvRV(sv); + int count = av_len(av); + QCOORD *coord = new QCOORD[count + 2]; + for(int i = 0; i <= count; i++) { + SV **svp = av_fetch(av, i, 0); + coord[i] = svp ? SvIV(*svp) : 0; + } + m->item().s_voidp = coord; + m->next(); + } + break; + default: + m->unsupported(); + } +} + +static void marshall_intR(Marshall *m) { + switch(m->action()) { + case Marshall::FromSV: + { + SV *sv = m->var(); + if(m->type().isPtr() && // is pointer + !SvOK(sv) && SvREADONLY(sv)) { // and real undef + m->item().s_voidp = 0; // pass null pointer + break; + } + if(m->cleanup()) { + int i = SvIV(sv); + m->item().s_voidp = &i; + m->next(); + sv_setiv_mg(sv, (IV)i); + } else { + m->item().s_voidp = new int((int)SvIV(sv)); + if(PL_dowarn) + warn("Leaking memory from int& handler"); + } + } + break; + case Marshall::ToSV: + { + int *ip = (int*)m->item().s_voidp; + SV *sv = m->var(); + if(!ip) { + sv_setsv_mg(sv, &PL_sv_undef); + break; + } + sv_setiv_mg(sv, *ip); + m->next(); + if(!m->type().isConst()) + *ip = (int)SvIV(sv); + } + break; + default: + m->unsupported(); + break; + } +} + +static void marshall_boolR(Marshall *m) { + switch(m->action()) { + case Marshall::FromSV: + { + SV *sv = m->var(); + if(m->type().isPtr() && // is pointer + !SvOK(sv) && SvREADONLY(sv)) { // and real undef + m->item().s_voidp = 0; // pass null pointer + break; + } + if(m->cleanup()) { + bool i = SvTRUE(sv)? true : false; + m->item().s_voidp = &i; + m->next(); + sv_setsv_mg(sv, boolSV(i)); + } else { + m->item().s_voidp = new bool(SvTRUE(sv)?true:false); + if(PL_dowarn) + warn("Leaking memory from bool& handler"); + } + } + break; + case Marshall::ToSV: + { + bool *ip = (bool*)m->item().s_voidp; + SV *sv = m->var(); + if(!ip) { + sv_setsv_mg(sv, &PL_sv_undef); + break; + } + sv_setsv_mg(sv, boolSV(*ip)); + m->next(); + if(!m->type().isConst()) + *ip = SvTRUE(sv)? true : false; + } + break; + default: + m->unsupported(); + break; + } +} + +static void marshall_charP_array(Marshall *m) { + switch(m->action()) { + case Marshall::FromSV: + { + SV *sv = m->var(); + if(!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV || + av_len((AV*)SvRV(sv)) < 0) { + m->item().s_voidp = 0; + break; + } + + AV *arglist = (AV*)SvRV(sv); + int count = av_len(arglist); + char **argv = new char *[count + 2]; + int i; + for(i = 0; i <= count; i++) { + SV **item = av_fetch(arglist, i, 0); + if(!item || !SvOK(*item)) { + argv[i] = new char[1]; + argv[i][0] = 0; // should undef warn? + continue; + } + + STRLEN len; + char *s = SvPV(*item, len); + argv[i] = new char[len + 1]; + strncpy(argv[i], s, len); + argv[i][len] = 0; // null terminazi? yes + } + argv[i] = 0; + m->item().s_voidp = argv; + m->next(); + if(m->cleanup()) { + av_clear(arglist); + for(i = 0; argv[i]; i++) + av_push(arglist, newSVpv(argv[i], 0)); + + // perhaps we should check current_method? + } + } + break; + default: + m->unsupported(); + break; + } +} + +static void marshall_QStringList(Marshall *m) { + switch(m->action()) { + case Marshall::FromSV: + { + SV *sv = m->var(); + if(!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV || + av_len((AV*)SvRV(sv)) < 0) { + m->item().s_voidp = 0; + break; + } + AV *list = (AV*)SvRV(sv); + int count = av_len(list); + QStringList *stringlist = new QStringList; + int i; + COP *cop = cxstack[cxstack_ix].blk_oldcop; + bool lc = cop->op_private & HINT_LOCALE; + for(i = 0; i <= count; i++) { + SV **item = av_fetch(list, i, 0); + if(!item || !SvOK(*item)) { + stringlist->append(QString()); + continue; + } + + if(SvUTF8(*item)) + stringlist->append(QString::fromUtf8(SvPV_nolen(*item))); + else if(lc) + stringlist->append(QString::fromLocal8Bit(SvPV_nolen(*item))); + else + stringlist->append(QString::fromLatin1(SvPV_nolen(*item))); + } + + m->item().s_voidp = stringlist; + m->next(); + + if(m->cleanup()) { + av_clear(list); + for(QStringList::Iterator it = stringlist->begin(); + it != stringlist->end(); + ++it) + av_push(list, newSVpv((const char *)*it, 0)); + delete stringlist; + } + } + break; + case Marshall::ToSV: + { + QStringList *stringlist = (QStringList*)m->item().s_voidp; + if(!stringlist) { + sv_setsv_mg(m->var(), &PL_sv_undef); + break; + } + + AV *av = newAV(); + { + SV *rv = newRV_noinc((SV*)av); + sv_setsv_mg(m->var(), rv); + SvREFCNT_dec(rv); + } + COP *cop = cxstack[cxstack_ix].blk_oldcop; + if(!(cop->op_private & HINT_BYTES)) + for(QStringList::Iterator it = stringlist->begin(); + it != stringlist->end(); + ++it) { + SV *sv = newSVpv((const char *)(*it).utf8(), 0); + SvUTF8_on(sv); + av_push(av, sv); + } + else if(cop->op_private & HINT_LOCALE) + for(QStringList::Iterator it = stringlist->begin(); + it != stringlist->end(); + ++it) { + SV *sv = newSVpv((const char *)(*it).local8Bit(), 0); + av_push(av, sv); + } + else + for(QStringList::Iterator it = stringlist->begin(); + it != stringlist->end(); + ++it) { + SV *sv = newSVpv((const char *)(*it).latin1(), 0); + av_push(av, sv); + } + if(m->cleanup()) + delete stringlist; + } + break; + default: + m->unsupported(); + break; + } +} + +static void marshall_QValueListInt(Marshall *m) { + switch(m->action()) { + case Marshall::FromSV: + { + SV *sv = m->var(); + if(!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV || + av_len((AV*)SvRV(sv)) < 0) { + m->item().s_voidp = 0; + break; + } + AV *list = (AV*)SvRV(sv); + int count = av_len(list); + QValueList<int> *valuelist = new QValueList<int>; + int i; + for(i = 0; i <= count; i++) { + SV **item = av_fetch(list, i, 0); + if(!item || !SvOK(*item)) { + valuelist->append(0); + continue; + } + + valuelist->append(SvIV(*item)); + } + + m->item().s_voidp = valuelist; + m->next(); + + if(m->cleanup()) { + av_clear(list); + for(QValueListIterator<int> it = valuelist->begin(); + it != valuelist->end(); + ++it) + av_push(list, newSViv((int)*it)); + delete valuelist; + } + } + break; + case Marshall::ToSV: + { + QValueList<int> *valuelist = (QValueList<int>*)m->item().s_voidp; + if(!valuelist) { + sv_setsv_mg(m->var(), &PL_sv_undef); + break; + } + + AV *av = newAV(); + { + SV *rv = newRV_noinc((SV*)av); + sv_setsv_mg(m->var(), rv); + SvREFCNT_dec(rv); + } + + for(QValueListIterator<int> it = valuelist->begin(); + it != valuelist->end(); + ++it) + av_push(av, newSViv((int)*it)); + if(m->cleanup()) + delete valuelist; + } + break; + default: + m->unsupported(); + break; + } +} + +void marshall_voidP(Marshall *m) { + switch(m->action()) { + case Marshall::FromSV: + { + SV *sv = m->var(); + if(SvROK(sv) && SvRV(sv) && SvOK(SvRV(sv))) + m->item().s_voidp = (void*)SvIV(SvRV(m->var())); + else + m->item().s_voidp = 0; + } + break; + case Marshall::ToSV: + { + SV *sv = newSViv((IV)m->item().s_voidp); + SV *rv = newRV_noinc(sv); + sv_setsv_mg(m->var(), rv); + SvREFCNT_dec(rv); + } + break; + default: + m->unsupported(); + break; + } +} + +void marshall_QRgb_array(Marshall *m) { + switch(m->action()) { + case Marshall::FromSV: + { + SV* sv = m->var(); + QRgb* s = 0; + MAGIC* mg = 0; + if( SvOK(sv) && SvTYPE(sv) == SVt_PVMG && (mg = mg_find(sv, PERL_MAGIC_tiedscalar)) + && sv_derived_from(mg->mg_obj, "Qt::_internal::QRgbStar") ) { + s = (QRgb*)SvIV((SV*)SvRV(mg->mg_obj)); + } else if(!SvROK(sv) || SvREADONLY(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV || + av_len((AV*)SvRV(sv)) < 0) { + m->item().s_voidp = 0; + break; + } else { + AV *list = (AV*)SvRV(sv); + int count = av_len(list); + s = new QRgb[count + 2]; + int i; + for(i = 0; i <= count; i++) { + SV **item = av_fetch(list, i, 0); + if(!item || !SvOK(*item)) { + s[i] = 0; + continue; + } + s[i] = SvIV(*item); + } + s[i] = 0; + SV* rv = newSV(0); + sv_setref_pv(rv, "Qt::_internal::QRgbStar", (void*)s); + sv_magic(sv, rv, PERL_MAGIC_tiedscalar, Nullch, 0); + } + m->item().s_voidp = s; + } + break; + default: + m->unsupported(); + break; + } +} + +// Templated classes marshallers + +#define GET_PERL_OBJECT( CCLASS, PCLASS, IS_STACK ) \ + SV *sv = getPointerObject((void*)t); \ + SV *ret= newSV(0); \ + if(!sv || !SvROK(sv)){ \ + HV *hv = newHV(); \ + SV *obj = newRV_noinc((SV*)hv); \ + \ + smokeperl_object o; \ + o.smoke = m->smoke(); \ + o.classId = ix; \ + o.ptr = (void*)t; \ + o.allocated = IS_STACK; \ + \ + sv_bless(obj, gv_stashpv( PCLASS, TRUE)); \ + \ + if(m->type().isConst() && m->type().isRef()) { \ + void* p = construct_copy( &o ); \ + if(p) { \ + o.ptr = p; \ + o.allocated = true; \ + } \ + } \ + sv_magic((SV*)hv, sv_qapp, '~', (char*)&o, sizeof(o)); \ + MAGIC *mg = mg_find((SV*)hv, '~'); \ + mg->mg_virtual = &vtbl_smoke; \ + \ + sv_setsv_mg(ret, obj); \ + SvREFCNT_dec(obj); \ + } \ + else \ + sv_setsv_mg(ret, sv); + + + + + +#define MARSHALL_QPTRLIST( FNAME, TMPLNAME, CCLASSNAME, PCLASSNAME, IS_STACK ) \ +static void marshall_ ## FNAME (Marshall *m) { \ + switch(m->action()) { \ + case Marshall::FromSV: \ + { \ + SV *sv = m->var(); \ + if(!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV || \ + av_len((AV*)SvRV(sv)) < 0) { \ + if(m->type().isRef()) { \ + warn("References can't be null or undef\n"); \ + m->unsupported(); \ + } \ + m->item().s_voidp = 0; \ + break; \ + } \ + AV *list = (AV*)SvRV(sv); \ + int count = av_len(list); \ + TMPLNAME *ptrlist = new TMPLNAME; \ + int i; \ + for(i = 0; i <= count; i++) { \ + SV **item = av_fetch(list, i, 0); \ + if(!item || !SvROK(*item) || SvTYPE(SvRV(*item)) != SVt_PVHV) \ + continue; \ + smokeperl_object *o = sv_obj_info(*item); \ + if(!o || !o->ptr) \ + continue; \ + void *ptr = o->ptr; \ + ptr = o->smoke->cast( \ + ptr, \ + o->classId, \ + o->smoke->idClass( #CCLASSNAME ) \ + ); \ + \ + ptrlist->append( ( CCLASSNAME *) ptr); \ + } \ + \ + m->item().s_voidp = ptrlist; \ + m->next(); \ + \ + if(m->cleanup()) { \ + av_clear(list); \ + int ix = m->smoke()->idClass( #CCLASSNAME ); \ + for( CCLASSNAME *t = ptrlist->first(); t ; t = ptrlist->next()){ \ + GET_PERL_OBJECT( CCLASSNAME, PCLASSNAME, IS_STACK ) \ + av_push(list, ret); \ + } \ + delete ptrlist; \ + } \ + } \ + break; \ + case Marshall::ToSV: \ + { \ + TMPLNAME *list = ( TMPLNAME *)m->item().s_voidp; \ + if(!list) { \ + sv_setsv_mg(m->var(), &PL_sv_undef); \ + break; \ + } \ + \ + AV *av = newAV(); \ + { \ + SV *rv = newRV_noinc((SV*)av); \ + sv_setsv_mg(m->var(), rv); \ + SvREFCNT_dec(rv); \ + } \ + int ix = m->smoke()->idClass( #CCLASSNAME ); \ + for( CCLASSNAME *t = list->first(); t ; t = list->next()){ \ + GET_PERL_OBJECT( CCLASSNAME, PCLASSNAME, IS_STACK ) \ + av_push(av, ret); \ + } \ + if(m->cleanup()) \ + delete list; \ + } \ + break; \ + default: \ + m->unsupported(); \ + break; \ + } \ +} + +MARSHALL_QPTRLIST( QPtrListQNetworkOperation, QPtrList<QNetworkOperation>, QNetworkOperation, " Qt::NetworkOperation", FALSE ) +MARSHALL_QPTRLIST( QPtrListQToolBar, QPtrList<QToolBar>, QToolBar, " Qt::ToolBar", FALSE ) +MARSHALL_QPTRLIST( QPtrListQTab, QPtrList<QTab>, QTab, " Qt::Tab", FALSE ) +MARSHALL_QPTRLIST( QPtrListQDockWindow, QPtrList<QDockWindow>, QDockWindow, " Qt::DockWindow", FALSE ) +MARSHALL_QPTRLIST( QWidgetList, QWidgetList, QWidget, " Qt::Widget", FALSE ) +MARSHALL_QPTRLIST( QObjectList, QObjectList, QObject, " Qt::Object", FALSE ) +MARSHALL_QPTRLIST( QFileInfoList, QFileInfoList, QFileInfo, " Qt::FileInfo", FALSE ) + +void marshall_QCanvasItemList(Marshall *m) { + switch(m->action()) { + + case Marshall::ToSV: + { + QCanvasItemList *cilist = (QCanvasItemList*)m->item().s_voidp; + if(!cilist) { + sv_setsv_mg(m->var(), &PL_sv_undef); + break; + } + + AV *av = newAV(); + { + SV *rv = newRV_noinc((SV*)av); + sv_setsv_mg(m->var(), rv); + SvREFCNT_dec(rv); + } + + int ix = m->smoke()->idClass( "QCanvasItem" ); + for(QValueListIterator<QCanvasItem*> it = cilist->begin(); + it != cilist->end(); + ++it){ + QCanvasItem* t= *it; + GET_PERL_OBJECT( QCanvasItem, " Qt::CanvasItem", FALSE ) + av_push(av, ret); + } + if(m->cleanup()) + delete cilist; + } + break; + default: + m->unsupported(); + break; + } +} + + + +TypeHandler Qt_handlers[] = { + { "QString", marshall_QString }, + { "QString&", marshall_QString }, + { "QString*", marshall_QString }, + { "const QString", marshall_QString }, + { "const QString&", marshall_QString }, + { "const QString*", marshall_QString }, + { "QCString", marshall_QCString }, + { "QCString&", marshall_QCString }, + { "QCString*", marshall_QCString }, + { "const QCString", marshall_QCString }, + { "const QCString&", marshall_QCString }, + { "const QCString*", marshall_QCString }, + { "QStringList", marshall_QStringList }, + { "QStringList&", marshall_QStringList }, + { "QStringList*", marshall_QStringList }, + { "int&", marshall_intR }, + { "int*", marshall_intR }, + { "bool&", marshall_boolR }, + { "bool*", marshall_boolR }, + { "char*", marshall_charP }, + { "const char*", marshall_charP }, + { "char**", marshall_charP_array }, + { "uchar*", marshall_ucharP }, + { "QRgb*", marshall_QRgb_array }, + { "QUObject*", marshall_voidP }, + { "const QCOORD*", marshall_QCOORD_array }, + { "void", marshall_void }, + { "QByteArray", marshall_QByteArray }, + { "QByteArray&", marshall_QByteArray }, + { "QByteArray*", marshall_QByteArray }, + { "QValueList<int>", marshall_QValueListInt }, + { "QValueList<int>*", marshall_QValueListInt }, + { "QValueList<int>&", marshall_QValueListInt }, + { "QCanvasItemList", marshall_QCanvasItemList }, + { "QCanvasItemList*", marshall_QCanvasItemList }, + { "QCanvasItemList&", marshall_QCanvasItemList }, + { "QWidgetList", marshall_QWidgetList }, + { "QWidgetList*", marshall_QWidgetList }, + { "QWidgetList&", marshall_QWidgetList }, + { "QObjectList", marshall_QObjectList }, + { "QObjectList*", marshall_QObjectList }, + { "QObjectList&", marshall_QObjectList }, + { "QFileInfoList", marshall_QFileInfoList }, + { "QFileInfoList*", marshall_QFileInfoList }, + { "QFileInfoList&", marshall_QFileInfoList }, + { "QPtrList<QToolBar>", marshall_QPtrListQToolBar }, + { "QPtrList<QToolBar>*", marshall_QPtrListQToolBar }, + { "QPtrList<QToolBar>&", marshall_QPtrListQToolBar }, + { "QPtrList<QTab>", marshall_QPtrListQTab }, + { "QPtrList<QTab>*", marshall_QPtrListQTab }, + { "QPtrList<QTab>&", marshall_QPtrListQTab }, + { "QPtrList<QDockWindow>", marshall_QPtrListQDockWindow }, + { "QPtrList<QDockWindow>*", marshall_QPtrListQDockWindow }, + { "QPtrList<QDockWindow>&", marshall_QPtrListQDockWindow }, + { "QPtrList<QNetworkOperation>", marshall_QPtrListQNetworkOperation }, + { "QPtrList<QNetworkOperation>*", marshall_QPtrListQNetworkOperation }, + { "QPtrList<QNetworkOperation>&", marshall_QPtrListQNetworkOperation }, + { 0, 0 } +}; + +static HV *type_handlers = 0; + +void install_handlers(TypeHandler *h) { + if(!type_handlers) type_handlers = newHV(); + while(h->name) { + hv_store(type_handlers, h->name, strlen(h->name), newSViv((IV)h), 0); + h++; + } + if(!dtorcache){ + dtorcache = new QIntDict<Smoke::Index>(113); + dtorcache->setAutoDelete(1); + } + if(!cctorcache) { + cctorcache = new QIntDict<Smoke::Index>(113); + cctorcache->setAutoDelete(1); + } +} + +Marshall::HandlerFn getMarshallFn(const SmokeType &type) { + if(type.elem()) + return marshall_basetype; + if(!type.name()) + return marshall_void; + if(!type_handlers) { + return marshall_unknown; + } + U32 len = strlen(type.name()); + SV **svp = hv_fetch(type_handlers, type.name(), len, 0); + if(!svp && type.isConst() && len > 6) + svp = hv_fetch(type_handlers, type.name() + 6, len - 6, 0); + if(svp) { + TypeHandler *h = (TypeHandler*)SvIV(*svp); + return h->fn; + } + return marshall_unknown; +} diff --git a/PerlQt/lib/Qt/GlobalSpace.pm b/PerlQt/lib/Qt/GlobalSpace.pm new file mode 100644 index 0000000..65e481a --- /dev/null +++ b/PerlQt/lib/Qt/GlobalSpace.pm @@ -0,0 +1,25 @@ +package Qt::GlobalSpace; +use strict; +require Qt; +require Exporter; + +our @ISA = qw(Exporter); +our @EXPORT; +our $allMeth = Qt::_internal::findAllMethods( Qt::_internal::idClass("QGlobalSpace") ); +no strict 'refs'; + +for my $proto( keys %$allMeth ) +{ + next if $proto =~ /operator\W/; # skip operators + $proto =~ s/[\#\$\?]+$//; + *{ $proto } = sub + { + $Qt::_internal::autoload::AUTOLOAD = "Qt::GlobalSpace\::$proto"; + goto &Qt::GlobalSpace::AUTOLOAD + } unless defined &$proto; + push @EXPORT, $proto; +} + +our %EXPORT_TAGS = ( "all" => [@EXPORT] ); + +1;
\ No newline at end of file diff --git a/PerlQt/lib/Qt/attributes.pm b/PerlQt/lib/Qt/attributes.pm new file mode 100644 index 0000000..3a25487 --- /dev/null +++ b/PerlQt/lib/Qt/attributes.pm @@ -0,0 +1,51 @@ +package Qt::attributes; +# +# I plan to support public/protected/private attributes. here goes. +# Attributes default to protected. +# +# package MyBase; +# use Qt::attributes qw( +# private: +# foo +# protected: +# bar +# public: +# baz +# ); +# +# package MyDerived; +# use Qt::isa qw(MyBase); +# +# sub foo { +# # 1 way to access private attributes from derived class +# # +# # this->{$class} contains private attributes for $class +# # I specify it to always work that way, +# # so feel free to use it in code. +# this->{MyBase}{foo} = 10; +# +# # 2 ways to access protected attributes +# bar = 10; +# this->{bar} = 10; +# +# # 3 ways to access public attributes +# baz = 10; +# this->{baz} = 10; +# this->baz = 10; +# } +# +# Attributes override any method with the same name, so you may want +# to prefix them with _ to prevent conflicts. +# +sub import { + my $class = shift; + my $caller = (caller)[0]; + + for my $attribute (@_) { + exists ${ ${$caller . '::META'}{'attributes'} }{$attribute} and next; + Qt::_internal::installattribute($caller, $attribute); + ${ ${$caller . '::META'}{'attributes'} }{$attribute} = 1; + } +} + +1; diff --git a/PerlQt/lib/Qt/constants.pm b/PerlQt/lib/Qt/constants.pm new file mode 100644 index 0000000..9c7081c --- /dev/null +++ b/PerlQt/lib/Qt/constants.pm @@ -0,0 +1,62 @@ +package Qt::constants; + +require Exporter; + +our @ISA = qw(Exporter); +our @EXPORT = qw( + IO_Direct + IO_Sequential + IO_Combined + IO_TypeMask + IO_Raw + IO_Async + IO_ReadOnly + IO_WriteOnly + IO_ReadWrite + IO_Append + IO_Truncate + IO_Translate + IO_ModeMask + IO_Open + IO_StateMask + IO_Ok + IO_ReadError + IO_WriteError + IO_FatalError + IO_ResourceError + IO_OpenError + IO_ConnectError + IO_AbortError + IO_TimeOutError + IO_UnspecifiedError +); + +our %EXPORT_TAGS = ( 'IO' => [ @EXPORT ] ); + +sub IO_Direct () { 0x0100 } +sub IO_Sequential () { 0x0200 } +sub IO_Combined () { 0x0300 } +sub IO_TypeMask () { 0x0f00 } +sub IO_Raw () { 0x0040 } +sub IO_Async () { 0x0080 } +sub IO_ReadOnly () { 0x0001 } +sub IO_WriteOnly () { 0x0002 } +sub IO_ReadWrite () { 0x0003 } +sub IO_Append () { 0x0004 } +sub IO_Truncate () { 0x0008 } +sub IO_Translate () { 0x0010 } +sub IO_ModeMask () { 0x00ff } +sub IO_Open () { 0x1000 } +sub IO_StateMask () { 0xf000 } +sub IO_Ok () { 0 } +sub IO_ReadError () { 1 } +sub IO_WriteError () { 2 } +sub IO_FatalError () { 3 } +sub IO_ResourceError () { 4 } +sub IO_OpenError () { 5 } +sub IO_ConnectError () { 5 } +sub IO_AbortError () { 6 } +sub IO_TimeOutError () { 7 } +sub IO_UnspecifiedError() { 8 } + +1;
\ No newline at end of file diff --git a/PerlQt/lib/Qt/debug.pm b/PerlQt/lib/Qt/debug.pm new file mode 100644 index 0000000..28c0a43 --- /dev/null +++ b/PerlQt/lib/Qt/debug.pm @@ -0,0 +1,36 @@ +package Qt::debug; +use Qt; + +our %channel = ( + 'ambiguous' => 0x01, + 'autoload' => 0x02, + 'calls' => 0x04, + 'gc' => 0x08, + 'virtual' => 0x10, + 'verbose' => 0x20, + 'all' => 0xffff +); + +sub import { + shift; + my $db = (@_)? 0x0000 : (0x01|0x20); + my $usage = 0; + for my $ch(@_) { + if( exists $channel{$ch}) { + $db |= $channel{$ch}; + } else { + warn "Unknown debugging channel: $ch\n"; + $usage++; + } + } + Qt::_internal::setDebug($db); + print "Available channels: \n\t". + join("\n\t", sort keys %channel). + "\n" if $usage; +} + +sub unimport { + Qt::_internal::setDebug(0); +} + +1;
\ No newline at end of file diff --git a/PerlQt/lib/Qt/enumerations.pm b/PerlQt/lib/Qt/enumerations.pm new file mode 100644 index 0000000..003b65b --- /dev/null +++ b/PerlQt/lib/Qt/enumerations.pm @@ -0,0 +1,15 @@ +package Qt::enumerations; +# +# Proposed usage: +# +# package MyWidget; +# +# use Qt::enumerations MyInfo => { +# Foo => 1, +# Bar => 10, +# Baz => 64 +# }; +# +# use Qt::enumerations MyInfo => [qw(Foo Bar Baz)]; +# +1; diff --git a/PerlQt/lib/Qt/isa.pm b/PerlQt/lib/Qt/isa.pm new file mode 100644 index 0000000..fb4b646 --- /dev/null +++ b/PerlQt/lib/Qt/isa.pm @@ -0,0 +1,81 @@ +package Qt::isa; +use strict; + +sub import { + no strict 'refs'; + my $class = shift; + my $caller = (caller)[0]; + + # Trick 'use' into believing the file for this class has been read + my $pm = $caller . ".pm"; + $pm =~ s!::!/!g; + unless(exists $::INC{$pm}) { + $::INC{$pm} = $::INC{"Qt/isa.pm"}; + } + + for my $super (@_) { + push @{ $caller . '::ISA' }, $super; + push @{ ${$caller . '::META'}{'superClass'} }, $super; # if isa(QObject)? + } + + *{ $caller . '::className' } = sub { # closure on $caller + return $caller; + }; + + ${ $caller. '::_INTERNAL_STATIC_'}{'SUPER'} = bless {}, " $caller"; + Qt::_internal::installsuper($caller) unless defined &{ $caller.'::SUPER' }; + + *{ $caller . '::metaObject' } = sub { + Qt::_internal::getMetaObject($caller); + }; + + *{ $caller . '::import' } = sub { + my $name = shift; # classname = function-name + my $incaller = (caller)[0]; + $incaller = (caller(1))[0] if $incaller eq 'if'; # work-around bug in package 'if' pre 0.02 + (my $cname = $name) =~ s/.*::// and do + { + *{ "$name" } = sub { + $name->new(@_); + } unless defined &{ "$name" }; + }; + my $p = defined $&? $&:''; + $p eq ($incaller=~/.*::/?($p?$&:''):'') and + *{ "$incaller\::$cname" } = sub { + $name->new(@_); + }; + + if(defined @{ ${$caller.'::META'}{'superClass'} } && + @{ ${$caller.'::META'}{'superClass'} } ) + { + # attributes inheritance + for my $attribute( keys %{ ${$caller.'::META'}{'attributes'} } ) + { + if(! defined &{$incaller.'::'.$attribute }) + { + Qt::_internal::installattribute($incaller, $attribute); + ${ ${$incaller .'::META'}{'attributes'} }{$attribute} = 1; + } + } + } + }; + + Qt::_internal::installautoload(" $caller"); + Qt::_internal::installautoload(" $caller"); + Qt::_internal::installautoload($caller); + { + package Qt::AutoLoad; + my $autosub = \&{ " $caller\::_UTOLOAD" }; + *{ " $caller\::AUTOLOAD" } = sub { &$autosub }; + $autosub = \&{ " $caller\::_UTOLOAD" }; + *{ " $caller\::AUTOLOAD" } = sub { &$autosub }; + $autosub = \&{ "$caller\::_UTOLOAD" }; + *{ "$caller\::AUTOLOAD" } = sub { &$autosub }; + } + Qt::_internal::installthis($caller); + + # operator overloading + *{ " $caller\::ISA" } = ["Qt::base::_overload"]; +} + +1; diff --git a/PerlQt/lib/Qt/properties.pm b/PerlQt/lib/Qt/properties.pm new file mode 100644 index 0000000..5dfcdb7 --- /dev/null +++ b/PerlQt/lib/Qt/properties.pm @@ -0,0 +1,14 @@ +package Qt::properties; +# +# Proposed usage: +# +# use Qt::properties foo => { +# TYPE => 'bool', +# READ => 'getFoo', +# WRITE => 'setFoo', +# STORED => 0, +# RESET => 'unsetFoo', +# DESIGNABLE => 0 +# }; +# +1; diff --git a/PerlQt/lib/Qt/signals.pm b/PerlQt/lib/Qt/signals.pm new file mode 100644 index 0000000..00aa061 --- /dev/null +++ b/PerlQt/lib/Qt/signals.pm @@ -0,0 +1,77 @@ +package Qt::signals; +use Carp; +# +# Proposed usage: +# +# use Qt::signals fooActivated => ['int']; +# +# use Qt::signals fooActivated => { +# name => 'fooActivated(int)', +# args => ['int'] +# }; +# +# sub whatever { emit fooActivated(10); } +# + +sub import { + no strict 'refs'; + my $self = shift; + my $caller = $self eq "Qt::signals" ? (caller)[0] : $self; + my $parent = ${ $caller . '::ISA' }[0]; + my $parent_qt_emit = $parent . '::qt_emit'; + + Qt::_internal::installqt_invoke($caller . '::qt_emit') unless defined &{ $caller. '::qt_emit' }; + +# *{ $caller . '::qt_emit' } = sub { +# my $meta = \%{ $caller . '::META' }; +# die unless $meta->{object}; +# my $offset = $_[0] - $meta->{object}->signalOffset; +# if($offset >= 0) { +# Qt::_internal::invoke(Qt::this(), $meta->{signals}[$offset], $_[1]); +# return 1; +# } else { +# Qt::this()->$parent_qt_emit(@_); +# } +# } unless defined &{ $caller . '::qt_emit' }; + + my $meta = \%{ $caller . '::META' }; + croak "Odd number of arguments in signal declaration" if @_%2; + my(%signals) = @_; + for my $signalname (keys %signals) { + my $signal = { name => $signalname }; + my $args = $signals{$signalname}; + $signal->{arguments} = [map { s/\s(?=[*&])//; { type => $_, name => "" } } @$args]; + my $arglist = join ',', @$args; + $signal->{prototype} = $signalname . "($arglist)"; + $signal->{returns} = 'void'; + $signal->{method} = $signalname; + push @{$meta->{signals}}, $signal; + my $signal_index = $#{ $meta->{signals} }; + + my $argcnt = scalar @$args; + my $mocargs = Qt::_internal::allocateMocArguments($argcnt); + my $i = 0; + for my $arg (@$args) { + my $a = $arg; + $a =~ s/^const\s+//; + if($a =~ /^(bool|int|double|char\*|QString)&?$/) { + $a = $1; + } else { + $a = 'ptr'; + } + my $valid = Qt::_internal::setMocType($mocargs, $i, $arg, $a); + die "Invalid type for signal argument ($arg)\n" unless $valid; + $i++; + } + + $meta->{signal}{$signalname} = $signal; + $signal->{index} = $signal_index; + $signal->{mocargs} = $mocargs; + $signal->{argcnt} = $argcnt; + + Qt::_internal::installsignal("$caller\::$signalname"); + } + @_ and $meta->{changed} = 1; +} + +1; diff --git a/PerlQt/lib/Qt/slots.pm b/PerlQt/lib/Qt/slots.pm new file mode 100644 index 0000000..5d1daf6 --- /dev/null +++ b/PerlQt/lib/Qt/slots.pm @@ -0,0 +1,84 @@ +package Qt::slots; +use Carp; +# +# Proposed usage: +# +# use Qt::slots changeSomething => ['int']; +# +# use Qt::slots 'changeSomething(int)' => { +# args => ['int'], +# call => 'changeSomething' +# }; +# + +sub import { + no strict 'refs'; + my $self = shift; + my $caller = $self eq "Qt::slots" ? (caller)[0] : $self; + my $parent = ${ $caller . '::ISA' }[0]; + my $parent_qt_invoke = $parent . '::qt_invoke'; + + Qt::_internal::installqt_invoke($caller . '::qt_invoke') unless defined &{ $caller. '::qt_invoke' }; + +# *{ $caller . '::qt_invoke' } = sub { +# my $meta = \%{ $caller . '::META' }; +# die unless $meta->{object}; +# my $offset = $_[0] - $meta->{object}->slotOffset; +# if($offset >= 0) { +# Qt::_internal::invoke(Qt::this(), $meta->{slots}[$offset], $_[1]); +# return 1; +# } else { +# Qt::this()->$parent_qt_invoke(@_); +# } +# } unless defined &{ $caller . '::qt_invoke' }; + + my $meta = \%{ $caller . '::META' }; + croak "Odd number of arguments in slot declaration" if @_%2; + my(%slots) = @_; + for my $slotname (keys %slots) { + my $slot = { name => $slotname }; + my $args = $slots{$slotname}; + $slot->{arguments} = [map { s/\s(?=[*&])//; { type => $_, name => "" } } @$args]; + my $arglist = join ',', @$args; + + $slot->{prototype} = $slotname . "($arglist)"; + if ( exists $meta->{slot}{$slotname} ) { + (my $s1 = $slot->{prototype}) =~ s/\s+//g; + (my $s2 = $meta->{slot}{$slotname}{prototype}) =~ s/\s+//g; + if( $s1 ne $s2 ) { + warn( "Slot declaration:\n\t$slot->{prototype}\nwill override ". + "previous declaration:\n\t$meta->{slot}{$slotname}{prototype}"); + } else { + next; + } + } + $slot->{returns} = 'void'; + $slot->{method} = $slotname; + push @{$meta->{slots}}, $slot; + my $slot_index = $#{ $meta->{slots} }; + + my $argcnt = scalar @$args; + my $mocargs = Qt::_internal::allocateMocArguments($argcnt); + my $i = 0; + for my $arg (@$args) { + my $a = $arg; + $a =~ s/^const\s+//; + if($a =~ /^(bool|int|double|char\*|QString)&?$/) { + $a = $1; + } else { + $a = 'ptr'; + } + my $valid = Qt::_internal::setMocType($mocargs, $i, $arg, $a); + die "Invalid type for slot argument ($arg)\n" unless $valid; + $i++; + } + + $meta->{slot}{$slotname} = $slot; + $slot->{index} = $slot_index; + $slot->{mocargs} = $mocargs; + $slot->{argcnt} = $argcnt; + } + @_ and $meta->{changed} = 1; +} + +1; diff --git a/PerlQt/marshall.h b/PerlQt/marshall.h new file mode 100644 index 0000000..55be867 --- /dev/null +++ b/PerlQt/marshall.h @@ -0,0 +1,44 @@ +#ifndef MARSHALL_H +#define MARSHALL_H +#include "smoke.h" + +class SmokeType; + +class Marshall { +public: + /** + * FromSV is used for virtual function return values and regular + * method arguments. + * + * ToSV is used for method return-values and virtual function + * arguments. + */ + typedef void (*HandlerFn)(Marshall *); + enum Action { FromSV, ToSV }; + virtual SmokeType type() = 0; + virtual Action action() = 0; + virtual Smoke::StackItem &item() = 0; + virtual SV* var() = 0; + virtual void unsupported() = 0; + virtual Smoke *smoke() = 0; + /** + * For return-values, next() does nothing. + * For FromSV, next() calls the method and returns. + * For ToSV, next() calls the virtual function and returns. + * + * Required to reset Marshall object to the state it was + * before being called when it returns. + */ + virtual void next() = 0; + /** + * For FromSV, cleanup() returns false when the handler should free + * any allocated memory after next(). + * + * For ToSV, cleanup() returns true when the handler should delete + * the pointer passed to it. + */ + virtual bool cleanup() = 0; + + virtual ~Marshall() {} +}; +#endif diff --git a/PerlQt/perlqt.h b/PerlQt/perlqt.h new file mode 100644 index 0000000..e4a2c33 --- /dev/null +++ b/PerlQt/perlqt.h @@ -0,0 +1,54 @@ +#ifndef PERLQT_H +#define PERLQT_H + +#include "marshall.h" + +struct smokeperl_object { + bool allocated; + Smoke *smoke; + int classId; + void *ptr; +}; + +struct TypeHandler { + const char *name; + Marshall::HandlerFn fn; +}; + +extern int do_debug; // evil +extern SV *sv_qapp; +extern int object_count; + +// keep this enum in sync with lib/Qt/debug.pm + +enum QtDebugChannel { + qtdb_none = 0x00, + qtdb_ambiguous = 0x01, + qtdb_autoload = 0x02, + qtdb_calls = 0x04, + qtdb_gc = 0x08, + qtdb_virtual = 0x10, + qtdb_verbose = 0x20 +}; + +void unmapPointer(smokeperl_object *, Smoke::Index, void*); +SV *getPointerObject(void *ptr); +void mapPointer(SV *, smokeperl_object *, HV *, Smoke::Index, void *); + + +extern struct mgvtbl vtbl_smoke; + +inline smokeperl_object *sv_obj_info(SV *sv) { // ptr on success, null on fail + if(!sv || !SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVHV) + return 0; + SV *obj = SvRV(sv); + MAGIC *mg = mg_find(obj, '~'); + if(!mg || mg->mg_virtual != &vtbl_smoke) { + // FIXME: die or something? + return 0; + } + smokeperl_object *o = (smokeperl_object*)mg->mg_ptr; + return o; +} + +#endif // PERLQT_H diff --git a/PerlQt/smokeperl.cpp b/PerlQt/smokeperl.cpp new file mode 100644 index 0000000..12b6700 --- /dev/null +++ b/PerlQt/smokeperl.cpp @@ -0,0 +1,426 @@ +#include "smokeperl.h" + +class SmokePerlQt : public SmokePerl { +public: + SmokePerlQt(); + virtual ~SmokePerlQt(); + + void registerSmoke(const char *name, Smoke *smoke); + Smoke *getSmoke(const char *name); + + void registerHandlers(TypeHandler *h); + + SmokeObject newObject(void *p, const SmokeClass &c); + SmokeObject wrapObject(void *p, const SmokeClass &c); + SmokeObject getObject(void *p); + SmokeObject getObject(SV *sv); + +private: + HV *_registered_smoke; + HV *_registered_handlers; + HV *_remembered_pointers; + + void rememberPointer(SmokeObject &o, const SmokeClass &c, bool remember, void *lastptr = 0); + void rememberPointer(SmokeObject &o); + void forgetPointer(SmokeObject &o); + SmokeObject createObject(void *p, const SmokeClass &c); + + const char *getSmokeName(Smoke *smoke) { + static const char none[] = ""; + HE *he; + + hv_iterinit(_registered_smoke); + while(he = hv_iternext(_registered_smoke)) { + SV *sv = hv_iterval(_registered_smoke, he); + if((Smoke*)SvIV(sv) == smoke) { + I32 toss; + return hv_iterkey(he, &toss); + } + } + return none; + } + + HV *package(const SmokeClass &c) { + // for now, we cheat on the class names by assuming they're all Qt:: + if(!strcmp(c.className(), "Qt")) + return gv_stashpv(c.className(), TRUE); + + SV *name = newSVpv("Qt::", 0); + sv_catpv(name, c.className() + 1); + HV *stash = gv_stashpv(SvPV_nolen(name), TRUE); + SvREFCNT_dec(name); + + return stash; + } +}; + + +Marshall::HandlerFn getMarshallFn(const SmokeType &type); + +class VirtualMethodReturnValue : public Marshall { + Smoke *_smoke; + Smoke::Index _method; + Smoke::Stack _stack; + SmokeType _st; + SV *_retval; +public: + const Smoke::Method &method() { return _smoke->methods[_method]; } + SmokeType type() { return _st; } + Marshall::Action action() { return Marshall::FromSV; } + Smoke::StackItem &item() { return _stack[0]; } + SV *var() { return _retval; } + void unsupported() { + croak("Cannot handle '%s' as return-type of virtual method %s::%s", + type().name(), + _smoke->className(method().classId), + _smoke->methodNames[method().name]); + } + Smoke *smoke() { return _smoke; } + void next() {} + bool cleanup() { return false; } + VirtualMethodReturnValue(Smoke *smoke, Smoke::Index meth, Smoke::Stack stack, SV *retval) : + _smoke(smoke), _method(meth), _stack(stack), _retval(retval) { + _st.set(_smoke, method().ret); + Marshall::HandlerFn fn = getMarshallFn(type()); + (*fn)(this); + } +}; + +extern SV *sv_this; +extern void *_current_object; +extern Smoke::Index _current_object_class; +extern int object_count; +extern bool temporary_virtual_function_success; +extern struct mgvtbl vtbl_smoke; + +class VirtualMethodCall : public Marshall { + Smoke *_smoke; + Smoke::Index _method; + Smoke::Stack _stack; + GV *_gv; + int _cur; + Smoke::Index *_args; + SV **_sp; + bool _called; + SV *_savethis; + +public: + SmokeType type() { return SmokeType(_smoke, _args[_cur]); } + Marshall::Action action() { return Marshall::ToSV; } + Smoke::StackItem &item() { return _stack[_cur + 1]; } + SV *var() { return _sp[_cur]; } + const Smoke::Method &method() { return _smoke->methods[_method]; } + void unsupported() { + croak("Cannot handle '%s' as argument of virtual method %s::%s", + type().name(), + _smoke->className(method().classId), + _smoke->methodNames[method().name]); + } + Smoke *smoke() { return _smoke; } + void callMethod() { + dSP; + if(_called) return; + _called = true; + SP = _sp + method().numArgs - 1; + PUTBACK; + int count = call_sv((SV*)_gv, G_SCALAR); + SPAGAIN; + VirtualMethodReturnValue r(_smoke, _method, _stack, POPs); + PUTBACK; + FREETMPS; + LEAVE; + } + void next() { + int oldcur = _cur; + _cur++; + while(!_called && _cur < method().numArgs) { + Marshall::HandlerFn fn = getMarshallFn(type()); + _sp[_cur] = sv_newmortal(); + (*fn)(this); + _cur++; + } + callMethod(); + _cur = oldcur; + } + bool cleanup() { return false; } // is this right? + VirtualMethodCall(Smoke *smoke, Smoke::Index meth, Smoke::Stack stack, SV *obj, GV *gv) : + _smoke(smoke), _method(meth), _stack(stack), _gv(gv), _cur(-1), _sp(0), _called(false) { + dSP; + ENTER; + SAVETMPS; + PUSHMARK(SP); + EXTEND(SP, method().numArgs); + _savethis = sv_this; + sv_this = newSVsv(obj); + _sp = SP + 1; + for(int i = 0; i < method().numArgs; i++) + _sp[i] = sv_newmortal(); + _args = _smoke->argumentList + method().args; + } + ~VirtualMethodCall() { + SvREFCNT_dec(sv_this); + sv_this = _savethis; + } +}; + +class MethodReturnValue : public Marshall { + Smoke *_smoke; + Smoke::Index _method; + SV *_retval; + Smoke::Stack _stack; +public: + MethodReturnValue(Smoke *smoke, Smoke::Index method, Smoke::Stack stack, SV *retval) : + _smoke(smoke), _method(method), _retval(retval), _stack(stack) { + Marshall::HandlerFn fn = getMarshallFn(type()); + (*fn)(this); + } + const Smoke::Method &method() { return _smoke->methods[_method]; } + SmokeType type() { return SmokeType(_smoke, method().ret); } + Marshall::Action action() { return Marshall::ToSV; } + Smoke::StackItem &item() { return _stack[0]; } + SV *var() { return _retval; } + void unsupported() { + croak("Cannot handle '%s' as return-type of %s::%s", + type().name(), + _smoke->className(method().classId), + _smoke->methodNames[method().name]); + } + Smoke *smoke() { return _smoke; } + void next() {} + bool cleanup() { return false; } +}; + +class MethodCall : public Marshall { + int _cur; + Smoke *_smoke; + Smoke::Stack _stack; + Smoke::Index _method; + Smoke::Index *_args; + SV **_sp; + int _items; + SV *_retval; + bool _called; +public: + MethodCall(Smoke *smoke, Smoke::Index method, SV **sp, int items) : + _smoke(smoke), _method(method), _sp(sp), _items(items), _cur(-1), _called(false) { + _args = _smoke->argumentList + _smoke->methods[_method].args; + _items = _smoke->methods[_method].numArgs; + _stack = new Smoke::StackItem[items + 1]; + _retval = newSV(0); + } + ~MethodCall() { + delete[] _stack; + SvREFCNT_dec(_retval); + } + SmokeType type() { return SmokeType(_smoke, _args[_cur]); } + Marshall::Action action() { return Marshall::FromSV; } + Smoke::StackItem &item() { return _stack[_cur + 1]; } + SV *var() { + if(_cur < 0) return _retval; + SvGETMAGIC(*(_sp + _cur)); + return *(_sp + _cur); + } + inline const Smoke::Method &method() { return _smoke->methods[_method]; } + void unsupported() { + croak("Cannot handle '%s' as argument to %s::%s", + type().name(), + _smoke->className(method().classId), + _smoke->methodNames[method().name]); + } + Smoke *smoke() { return _smoke; } + inline void callMethod() { + if(_called) return; + _called = true; + Smoke::ClassFn fn = _smoke->classes[method().classId].classFn; + void *ptr = _smoke->cast( + _current_object, + _current_object_class, + method().classId + ); + _items = -1; + (*fn)(method().method, ptr, _stack); + MethodReturnValue r(_smoke, _method, _stack, _retval); + } + void next() { + int oldcur = _cur; + _cur++; + + while(!_called && _cur < _items) { + Marshall::HandlerFn fn = getMarshallFn(type()); + (*fn)(this); + _cur++; + } + + callMethod(); + _cur = oldcur; + } + bool cleanup() { return true; } +}; + +class SmokeBindingQt : public SmokeBinding { + SmokePerlQt *_smokeperl; +public: + SmokeBindingQt(Smoke *s, SmokePerlQt *smokeperl) : + SmokeBinding(s), _smokeperl(smokeperl) {} + void deleted(Smoke::Index classId, void *ptr) { + if(do_debug) printf("%p->~%s()\n", ptr, smoke->className(classId)); + object_count--; + if(do_debug) printf("Remaining objects: %d\n", object_count); + SV *obj = getPointerObject(ptr); + smokeperl_object *o = sv_obj_info(obj); + if(!o || !o->ptr) { + return; + } + unmapPointer(o, o->classId, 0); + o->ptr = 0; + } + bool callMethod(Smoke::Index method, void *ptr, Smoke::Stack args, bool isAbstract) { + SV *obj = getPointerObject(ptr); + smokeperl_object *o = sv_obj_info(obj); + if(do_debug) printf("virtual %p->%s::%s() called\n", ptr, + smoke->classes[smoke->methods[method].classId].className, + smoke->methodNames[smoke->methods[method].name] + ); + + if(!o) { + if(!PL_dirty) // if not in global destruction + warn("Cannot find object for virtual method"); + return false; + } + HV *stash = SvSTASH(SvRV(obj)); + if(*HvNAME(stash) == ' ') + stash = gv_stashpv(HvNAME(stash) + 1, TRUE); + const char *methodName = smoke->methodNames[smoke->methods[method].name]; + GV *gv = gv_fetchmethod_autoload(stash, methodName, 0); + if(!gv) return false; + + VirtualMethodCall c(smoke, method, args, obj, gv); + // exception variable, just temporary + temporary_virtual_function_success = true; + c.next(); + bool ret = temporary_virtual_function_success; + temporary_virtual_function_success = true; + return ret; + } + char *className(Smoke::Index classId) { + const char *className = smoke->className(classId); + char *buf = new char[strlen(className) + 6]; + strcpy(buf, " Qt::"); + strcat(buf, className + 1); + return buf; + } +}; + +SmokePerlQt::SmokePerlQt() { + _registered_smoke = newHV(); + _registered_handlers = newHV(); + _remembered_pointers = newHV(); +} + +SmokePerlQt::~SmokePerlQt() { + SvREFCNT_dec((SV*)_registered_smoke); + SvREFCNT_dec((SV*)_registered_handlers); + SvREFCNT_dec((SV*)_remembered_pointers); +} + +void SmokePerlQt::registerSmoke(const char *name, Smoke *smoke) { + hv_store(_registered_smoke, name, strlen(name), newSViv((IV)smoke), 0); + + // This will also need to handle the per-class initialization + smoke->binding = new SmokeBindingQt(smoke, this); +} + +Smoke *SmokePerlQt::getSmoke(const char *name) { + SV **svp = hv_fetch(_registered_smoke, name, strlen(name), 0); + if(svp && SvOK(*svp)) + return (Smoke*)SvIV(*svp); + return 0; +} + +void SmokePerlQt::registerHandlers(TypeHandler *h) { + while(h->name) { + hv_store(_registered_handlers, h->name, strlen(h->name), newSViv((IV)h->fn), 0); + h++; + } +} + +SmokeObject SmokePerlQt::createObject(void *p, const SmokeClass &c) { + HV *hv = newHV(); + SV *obj = newRV_noinc((SV*)hv); + + Smoke_MAGIC m(p, c); + sv_magic((SV*)hv, (SV*)newAV(), '~', (char*)&m, sizeof(m)); + MAGIC *mg = mg_find((SV*)hv, '~'); + mg->mg_virtual = &vtbl_smoke; + + sv_bless(obj, package(c)); + + SmokeObject o(obj, (Smoke_MAGIC*)mg->mg_ptr); + SvREFCNT_dec(obj); + + if(c.hasVirtual()) + rememberPointer(o); + + return o; +} + +SmokeObject SmokePerlQt::newObject(void *p, const SmokeClass &c) { + SmokeObject o = createObject(p, c); + + if(c.isVirtual()) + rememberPointer(o); + o.setAllocated(true); + + return o; +} + +SmokeObject SmokePerlQt::wrapObject(void *p, const SmokeClass &c) { + SmokeObject o = createObject(p, c); + return o; +} + +void SmokePerlQt::rememberPointer(SmokeObject &o, const SmokeClass &c, bool remember, void *lastptr) { + void *ptr = o.cast(c); + if(ptr != lastptr) { + SV *keysv = newSViv((IV)o.ptr()); + STRLEN klen; + char *key = SvPV(keysv, klen); + + if(remember) + hv_store(_remembered_pointers, key, klen, + sv_rvweaken(newSVsv(o.var())), 0); + else + hv_delete(_remembered_pointers, key, klen, G_DISCARD); + + SvREFCNT_dec(keysv); + } + for(Smoke::Index *i = c.smoke()->inheritanceList + c.c().parents; + *i; + i++) + rememberPointer(o, SmokeClass(c.smoke(), *i), remember, ptr); +} + +void SmokePerlQt::rememberPointer(SmokeObject &o) { + rememberPointer(o, o.c(), true); +} + +void SmokePerlQt::forgetPointer(SmokeObject &o) { + rememberPointer(o, o.c(), false); +} + +SmokeObject SmokePerlQt::getObject(SV *sv) { + MAGIC *mg = mg_find(SvRV(sv), '~'); + Smoke_MAGIC *m = (Smoke_MAGIC*)mg->mg_ptr; + return SmokeObject(sv, m); +} + +SmokeObject SmokePerlQt::getObject(void *p) { + SV *keysv = newSViv((IV)p); + STRLEN klen; + char *key = SvPV(keysv, klen); + SV **svp = hv_fetch(_remembered_pointers, key, klen, 0); + if(svp && SvROK(*svp)) + return getObject(sv_2mortal(newRV(SvRV(*svp)))); // paranoid copy of a weak ref + return SmokeObject(&PL_sv_undef, 0); +} + diff --git a/PerlQt/smokeperl.h b/PerlQt/smokeperl.h new file mode 100644 index 0000000..21e8298 --- /dev/null +++ b/PerlQt/smokeperl.h @@ -0,0 +1,281 @@ +#ifndef SMOKEPERL_H +#define SMOKEPERL_H + +#include "smoke.h" + +#undef DEBUG +#ifndef _GNU_SOURCE +#define _GNU_SOURCE +#endif +#ifndef __USE_POSIX +#define __USE_POSIX +#endif +#ifndef __USE_XOPEN +#define __USE_XOPEN +#endif +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include "perlqt.h" +#include "marshall.h" + +class SmokePerl; + +class SmokeType { + Smoke::Type *_t; // derived from _smoke and _id, but cached + + Smoke *_smoke; + Smoke::Index _id; +public: + SmokeType() : _t(0), _smoke(0), _id(0) {} + SmokeType(Smoke *s, Smoke::Index i) : _smoke(s), _id(i) { + if(_id < 0 || _id > _smoke->numTypes) _id = 0; + _t = _smoke->types + _id; + } + // default copy constructors are fine, this is a constant structure + + // mutators + void set(Smoke *s, Smoke::Index i) { + _smoke = s; + _id = i; + _t = _smoke->types + _id; + } + + // accessors + Smoke *smoke() const { return _smoke; } + Smoke::Index typeId() const { return _id; } + const Smoke::Type &type() const { return *_t; } + unsigned short flags() const { return _t->flags; } + unsigned short elem() const { return _t->flags & Smoke::tf_elem; } + const char *name() const { return _t->name; } + Smoke::Index classId() const { return _t->classId; } + + // tests + bool isStack() const { return ((flags() & Smoke::tf_ref) == Smoke::tf_stack); } + bool isPtr() const { return ((flags() & Smoke::tf_ref) == Smoke::tf_ptr); } + bool isRef() const { return ((flags() & Smoke::tf_ref) == Smoke::tf_ref); } + bool isConst() const { return (flags() & Smoke::tf_const); } + bool isClass() const { + if(elem() == Smoke::t_class) + return classId() ? true : false; + return false; + } + + bool operator ==(const SmokeType &b) const { + const SmokeType &a = *this; + if(a.name() == b.name()) return true; + if(a.name() && b.name() && !strcmp(a.name(), b.name())) + return true; + return false; + } + bool operator !=(const SmokeType &b) const { + const SmokeType &a = *this; + return !(a == b); + } + +}; + +class SmokeClass { + Smoke::Class *_c; + Smoke *_smoke; + Smoke::Index _id; +public: + SmokeClass(const SmokeType &t) { + _smoke = t.smoke(); + _id = t.classId(); + _c = _smoke->classes + _id; + } + SmokeClass(Smoke *smoke, Smoke::Index id) : _smoke(smoke), _id(id) { + _c = _smoke->classes + _id; + } + + Smoke *smoke() const { return _smoke; } + const Smoke::Class &c() const { return *_c; } + Smoke::Index classId() const { return _id; } + const char *className() const { return _c->className; } + Smoke::ClassFn classFn() const { return _c->classFn; } + Smoke::EnumFn enumFn() const { return _c->enumFn; } + bool operator ==(const SmokeClass &b) const { + const SmokeClass &a = *this; + if(a.className() == b.className()) return true; + if(a.className() && b.className() && !strcmp(a.className(), b.className())) + return true; + return false; + } + bool operator !=(const SmokeClass &b) const { + const SmokeClass &a = *this; + return !(a == b); + } + bool isa(const SmokeClass &sc) const { + // This is a sick function, if I do say so myself + if(*this == sc) return true; + Smoke::Index *parents = _smoke->inheritanceList + _c->parents; + for(int i = 0; parents[i]; i++) { + if(SmokeClass(_smoke, parents[i]).isa(sc)) return true; + } + return false; + } + + unsigned short flags() const { return _c->flags; } + bool hasConstructor() const { return flags() & Smoke::cf_constructor; } + bool hasCopy() const { return flags() & Smoke::cf_deepcopy; } + bool hasVirtual() const { return flags() & Smoke::cf_virtual; } + bool hasFire() const { return !(flags() & Smoke::cf_undefined); } +}; + +class SmokeMethod { + Smoke::Method *_m; + Smoke *_smoke; + Smoke::Index _id; +public: + SmokeMethod(Smoke *smoke, Smoke::Index id) : _smoke(smoke), _id(id) { + _m = _smoke->methods + _id; + } + + Smoke *smoke() const { return _smoke; } + const Smoke::Method &m() const { return *_m; } + SmokeClass c() const { return SmokeClass(_smoke, _m->classId); } + const char *name() const { return _smoke->methodNames[_m->name]; } + int numArgs() const { return _m->numArgs; } + unsigned short flags() const { return _m->flags; } + SmokeType arg(int i) const { + if(i >= numArgs()) return SmokeType(); + return SmokeType(_smoke, _smoke->argumentList[_m->args + i]); + } + SmokeType ret() const { return SmokeType(_smoke, _m->ret); } + Smoke::Index methodId() const { return _id; } + Smoke::Index method() const { return _m->method; } + + bool isStatic() const { return flags() & Smoke::mf_static; } + bool isConst() const { return flags() & Smoke::mf_const; } + + void call(Smoke::Stack args, void *ptr = 0) const { + Smoke::ClassFn fn = c().classFn(); + (*fn)(method(), ptr, args); + } +}; + +class Smoke_MAGIC { // to be rewritten + SmokeClass _c; + void *_ptr; + bool _isAllocated; +public: + Smoke_MAGIC(void *p, const SmokeClass &c) : + _c(c), _ptr(p), _isAllocated(false) {} + const SmokeClass &c() const { return _c; } + void *ptr() const { return _ptr; } + bool isAllocated() const { return _isAllocated; } + void setAllocated(bool isAllocated) { _isAllocated = isAllocated; } +}; + +/** + * SmokeObject is a thin wrapper around SV* objects. Each SmokeObject instance + * increments the refcount of its SV* for the duration of its existance. + * + * SmokeObject instances are only returned from SmokePerl, since the method + * of binding data to the scalar must be consistent across all modules. + */ +class SmokeObject { + SV *sv; + Smoke_MAGIC *m; + +public: + SmokeObject(SV *obj, Smoke_MAGIC *mag) : sv(obj), m(mag) { + SvREFCNT_inc(sv); + } + ~SmokeObject() { + SvREFCNT_dec(sv); + } + SmokeObject(const SmokeObject &other) { + sv = other.sv; + m = other.m; + SvREFCNT_inc(sv); + } + SmokeObject &operator =(const SmokeObject &other) { + sv = other.sv; + m = other.m; + SvREFCNT_inc(sv); + return *this; + } + + const SmokeClass &c() { return m->c(); } + Smoke *smoke() { return c().smoke(); } + SV *var() { return sv; } + void *ptr() { return m->ptr(); } + Smoke::Index classId() { return c().classId(); } + void *cast(const SmokeClass &toc) { + return smoke()->cast( + ptr(), + classId(), + smoke()->idClass(toc.className()) + ); + } + const char *className() { return c().className(); } + + bool isValid() const { return SvOK(sv) ? true : false; } + bool isAllocated() const { return m->isAllocated(); } + void setAllocated(bool i) { m->setAllocated(i); } +}; + +/** + * Since it's not easy to share functions between Perl modules, the common + * interface between all Smoked libraries and Perl will be defined in this + * class. There will be only one SmokePerl instance loaded for an entire Perl + * process. It has no data members here -- this is only an abstract interface. + */ + +class SmokePerl { + void *future_extension; +public: + SmokePerl() : future_extension(0) {} + + // don't need this, we're only defining an interface + virtual ~SmokePerl() = 0; + + /** + * Registers a Smoke object + */ + virtual void registerSmoke(const char *name, Smoke *smoke) = 0; + + /** + * Gets a smoke object from its name + */ + virtual Smoke *getSmoke(const char *name) = 0; + + /** + * Determines if the named smoke is registered. + */ + bool isSmokeRegistered(const char *name) { return getSmoke(name) ? true : false; } + + virtual void registerHandlers(TypeHandler *handlers) = 0; + + /** + * Returns a new blessed SV referring to the pointer passed. + * Use sv_2mortal() before passing it around. + * + * @param p pointer to the C++ object. The pointer isn't automatically deleted by SmokePerl. + * @param c class of the pointer + * @see #getObject + * @see #deleteObject + */ + virtual SmokeObject newObject(void *p, const SmokeClass &c) = 0; + + /** + * Same as newObject(), except it doesn't treat p as owned by Perl + */ + virtual SmokeObject wrapObject(void *p, const SmokeClass &c) = 0; + + /** + * Any SV* created with newObject() on a class with virtual methods can be + * retrieved again. + */ + virtual SmokeObject getObject(void *p) = 0; + + /** + * Create a SmokeObject from the given SV + */ + virtual SmokeObject getObject(SV *sv) = 0; +}; + +#endif // SMOKEPERL_H diff --git a/PerlQt/t/Foo/SubCodec.pm b/PerlQt/t/Foo/SubCodec.pm new file mode 100644 index 0000000..15ce08a --- /dev/null +++ b/PerlQt/t/Foo/SubCodec.pm @@ -0,0 +1,14 @@ +package Foo::SubCodec; +use Qt; +use My::Codec; +use Qt::isa qw( My::Codec ); + + +sub NEW +{ + shift->SUPER::NEW(@_); +} + +sub foo {} + +1; diff --git a/PerlQt/t/My/Codec.pm b/PerlQt/t/My/Codec.pm new file mode 100644 index 0000000..93e1d01 --- /dev/null +++ b/PerlQt/t/My/Codec.pm @@ -0,0 +1,10 @@ +package My::Codec; +use Qt; +use Qt::isa qw( Qt::TextCodec ); + +sub NEW +{ + shift->SUPER::NEW(@_); +} + +1;
\ No newline at end of file diff --git a/PerlQt/t/My/SubCodec.pm b/PerlQt/t/My/SubCodec.pm new file mode 100644 index 0000000..58f8987 --- /dev/null +++ b/PerlQt/t/My/SubCodec.pm @@ -0,0 +1,15 @@ + +package My::SubCodec; +use Qt; +use My::Codec; +use Qt::isa qw( My::Codec ); + + +sub NEW +{ + shift->SUPER::NEW(@_); +} + +sub bar {} + +1;
\ No newline at end of file diff --git a/PerlQt/t/a_loading.t b/PerlQt/t/a_loading.t new file mode 100644 index 0000000..4a9f4a1 --- /dev/null +++ b/PerlQt/t/a_loading.t @@ -0,0 +1,6 @@ + +BEGIN { print "1..1\n" } + +use Qt; + +print "ok 1\n" diff --git a/PerlQt/t/b_nogui.t b/PerlQt/t/b_nogui.t new file mode 100644 index 0000000..23bdd72 --- /dev/null +++ b/PerlQt/t/b_nogui.t @@ -0,0 +1,48 @@ + +BEGIN { print "1..6\n" } + +use Qt; +use Qt::constants; + +eval {my $c = Qt::TextCodec::codecForLocale()}; + +print +$@ ? "not ok\n" : "ok 1\n"; + +eval {my $s = Qt::Variant( Qt::DateTime::currentDateTime() ) }; + +print +$@ ? "not ok\n" : "ok 2\n"; + +my $ret; +eval {$ret = Qt::Point(20,20); $ret += Qt::Point(10,10); $ret *= 2 ; $ret /= 3 }; + +print +$@ ? "not ok\n" : "ok 3\n"; + +eval { $ret = ($ret->x != 20 or $ret->y != 20) ? 1 : 0 }; + +print +($@ || $ret) ? "not ok\n" : "ok 4\n"; + +eval { my $z = Qt::GlobalSpace::qVersion() }; + +if( $@ ) +{ + print "ok 5 # skip Smoke version too old\n"; + print "ok 6 # skip Smoke version too old\n"; +} +else +{ + eval{ my $p = Qt::Point( 20, 20 ); + my $p2 = Qt::Point( 30, 30 ); + $p = $p + $p2 + $p; + $p2 = $p * 2; + $p2 = -$p2; + $ret = ($p2->x != -140 or $p2->y != -140) ? 1 : 0 + }; + print +($@ || $ret) ? "not ok\n" : "ok 5\n"; + + eval { + $str = "Fooooooooooo"; + $ts = Qt::TextStream( $str, IO_WriteOnly ); + $ts << "pi = " << 3.14; + }; + print +($str eq "pi = 3.14ooo") ? "ok 6\n":"not ok\n"; +} diff --git a/PerlQt/t/c_qapp.t b/PerlQt/t/c_qapp.t new file mode 100644 index 0000000..ee28266 --- /dev/null +++ b/PerlQt/t/c_qapp.t @@ -0,0 +1,23 @@ +BEGIN { print "1..3\n" } + +use Qt; + +$a=0; + +# testing if the Qt::Application ctor works + +eval { $a=Qt::Application(\@ARGV) }; + +print +$@ ? "not ok\n" : "ok 1\n"; + +# testing wether the global object is properly setup + +eval { Qt::app()->libraryPaths() }; + +print +$@ ? "not ok\n" : "ok 2\n"; + +# one second test of the event loop + +Qt::Timer::singleShot( 300, Qt::app(), SLOT "quit()" ); + +print Qt::app()->exec ? "not ok\n" : "ok 3\n"; diff --git a/PerlQt/t/ca_i18n.t b/PerlQt/t/ca_i18n.t new file mode 100644 index 0000000..fddbff7 --- /dev/null +++ b/PerlQt/t/ca_i18n.t @@ -0,0 +1,23 @@ +BEGIN { print "1..1\n" } + +use Qt; + +$a = Qt::Application(); +$pb=Qt::PushButton("Foooo", undef); + +{ + use bytes; + $pb->setText( "élégant" ); + + $b = $pb->text(); + $b2 = Qt::Widget::tr("élégant"); +} + + +$c = $pb->text(); +$c2= Qt::Widget::tr("élégant"); + +{ + use bytes; + print +($b ne $c and $b2 ne $c2) ? "ok 1\n":"not ok\n"; +} diff --git a/PerlQt/t/d_sigslot.t b/PerlQt/t/d_sigslot.t new file mode 100644 index 0000000..1b455e1 --- /dev/null +++ b/PerlQt/t/d_sigslot.t @@ -0,0 +1,49 @@ +BEGIN { print "1..3\n" } + +package MyApp; +use Qt; +use Qt::isa qw(Qt::Application); +use Qt::slots + foo => ['int'], + baz => []; +use Qt::signals + bar => ['int']; + +sub NEW { + shift->SUPER::NEW(@_); + + # 1) testing correct subclassing of Qt::Application and this pointer + print +(ref(this) eq " MyApp")? "ok 1\n" : "not ok\n"; + + this->connect(this, SIGNAL 'bar(int)', SLOT 'foo(int)'); + + # 3) automatic quitting will test Qt sig to custom slot + this->connect(this, SIGNAL 'aboutToQuit()', SLOT 'baz()'); + + # 2) testing custom sig to custom slot + emit bar(3); +} + +sub foo +{ + print +($_[0] == 3) ? "ok 2\n" : "not ok\n"; +} + +sub baz +{ + print "ok 3\n"; +} + +1; + +package main; + +use Qt; +use MyApp; + +$a = 0; +$a = MyApp(\@ARGV); + +Qt::Timer::singleShot( 300, Qt::app(), SLOT "quit()" ); + +exit Qt::app()->exec; diff --git a/PerlQt/t/e_sigslot_inherit.t b/PerlQt/t/e_sigslot_inherit.t new file mode 100644 index 0000000..aa3bd76 --- /dev/null +++ b/PerlQt/t/e_sigslot_inherit.t @@ -0,0 +1,72 @@ +BEGIN { print "1..6\n" } + +package MyApp; +use Qt; +use Qt::isa('Qt::Application'); +use Qt::slots + foo => ['int'], + baz => []; +use Qt::signals + bar => ['int']; + +sub NEW +{ + shift->SUPER::NEW(@_); + this->connect(this, SIGNAL 'bar(int)', SLOT 'foo(int)'); + this->connect(this, SIGNAL 'aboutToQuit()', SLOT 'baz()'); +} + +sub foo +{ + # 1) testing correct inheritance of sig/slots + print +($_[0] == 3) ? "ok 1\n" : "not ok\n"; +} + +sub baz +{ + print "ok 3\n"; +} + +sub coincoin +{ + print +(@_ == 2) ? "ok 5\n":"not ok\n"; + print +(ref(this) eq " MySubApp") ? "ok 6\n":"not ok\n"; +} + +1; + +package MySubApp; +use Qt; +use Qt::isa('MyApp'); + + +sub NEW +{ + shift->SUPER::NEW(@_); + emit foo(3); +} + +sub baz +{ + # 2) testing further inheritance of sig/slots + print "ok 2\n"; + # 3) testing Perl to Perl SUPER + SUPER->baz(); + # 4) 5) 6) testing non-qualified enum calls vs. Perl method/static calls + eval { &blue }; print !$@ ? "ok 4\n":"not ok\n"; + coincoin("a","b"); +} + +1; + +package main; + +use Qt; +use MySubApp; + +$a = 0; +$a = MySubApp(\@ARGV); + +Qt::Timer::singleShot( 300, Qt::app(), SLOT "quit()" ); + +exit Qt::app()->exec; diff --git a/PerlQt/t/f_import.t b/PerlQt/t/f_import.t new file mode 100644 index 0000000..c6467a3 --- /dev/null +++ b/PerlQt/t/f_import.t @@ -0,0 +1,19 @@ +BEGIN { push @INC, "./t" ; print "1..1\n" } + +package main; + +use Qt; +use My::SubCodec; +use Foo::SubCodec; + +$tc1 = My::SubCodec(); +$tc2 = Foo::SubCodec(); + +$tc1->bar(); +$tc2->foo(); + +$tc2->deleteAllCodecs; + +# all imports OK + +print "ok 1\n"; diff --git a/PerlQt/t/g_gui.t b/PerlQt/t/g_gui.t new file mode 100644 index 0000000..b47c0c0 --- /dev/null +++ b/PerlQt/t/g_gui.t @@ -0,0 +1,127 @@ + +BEGIN { print "1..1\n" } + +package ButtonsGroups; +use strict; +use Qt; +use Qt::isa qw(Qt::Widget); +use Qt::slots + slotChangeGrp3State => []; +use Qt::attributes qw( + state + rb21 + rb22 + rb23 +); + +# +# Constructor +# +# Creates all child widgets of the ButtonGroups window +# + +sub NEW { + shift->SUPER::NEW(@_); + + # Create Widgets which allow easy layouting + my $vbox = Qt::VBoxLayout(this); + my $box1 = Qt::HBoxLayout($vbox); + my $box2 = Qt::HBoxLayout($vbox); + + # ------- first group + + # Create an exclusive button group + my $bgrp1 = Qt::ButtonGroup(1, &Horizontal, "Button Group &1 (exclusive)", this); + $box1->addWidget($bgrp1); + $bgrp1->setExclusive(1); + + # insert 3 radiobuttons + Qt::RadioButton("R&adiobutton 2", $bgrp1); + Qt::RadioButton("Ra&diobutton 3", $bgrp1); + + # ------- second group + + # Create a non-exclusive buttongroup + my $bgrp2 = Qt::ButtonGroup(1, &Horizontal, "Button Group &2 (non-exclusive)", this); + $box1->addWidget($bgrp2); + $bgrp2->setExclusive(0); + + # insert 3 checkboxes + Qt::CheckBox("&Checkbox 1", $bgrp2); + my $cb12 = Qt::CheckBox("C&heckbox 2", $bgrp2); + $cb12->setChecked(1); + my $cb13 = Qt::CheckBox("Triple &State Button", $bgrp2); + $cb13->setTristate(1); + $cb13->setChecked(1); + + # ----------- third group + + # create a buttongroup which is exclusive for radiobuttons and non-exclusive for all other buttons + my $bgrp3 = Qt::ButtonGroup(1, &Horizontal, "Button Group &3 (Radiobutton-exclusive)", this); + $box2->addWidget($bgrp3); + $bgrp3->setRadioButtonExclusive(1); + + # insert three radiobuttons + rb21 = Qt::RadioButton("Rad&iobutton 1", $bgrp3); + rb22 = Qt::RadioButton("Radi&obutton 2", $bgrp3); + rb23 = Qt::RadioButton("Radio&button 3", $bgrp3); + rb23->setChecked(1); + + # insert a checkbox + state = Qt::CheckBox("E&nable Radiobuttons", $bgrp3); + state->setChecked(1); + # ...and connect its SIGNAL clicked() with the SLOT slotChangeGrp3State() + this->connect(state, SIGNAL('clicked()'), SLOT('slotChangeGrp3State()')); + + # ----------- fourth group + + # create a groupbox which layouts its childs in a columns + my $bgrp4 = Qt::ButtonGroup(1, &Horizontal, "Groupbox with &normal buttons", this); + $box2->addWidget($bgrp4); + + # insert three pushbuttons... + Qt::PushButton("&Push Button", $bgrp4); + my $tb2 = Qt::PushButton("&Toggle Button", $bgrp4); + my $tb3 = Qt::PushButton("&Flat Button", $bgrp4); + + # ... and make the second one a toggle button + $tb2->setToggleButton(1); + $tb2->setOn(1); + + # ... and make the third one a flat button + $tb3->setFlat(1); +} + +# +# SLOT slotChangeGrp3State() +# +# enables/disables the radiobuttons of the third buttongroup +# + +sub slotChangeGrp3State { + rb21->setEnabled(state->isChecked); + rb22->setEnabled(state->isChecked); + rb23->setEnabled(state->isChecked); +} + +1; + +package main; + +use Qt; +use ButtonsGroups; + +Qt::StyleFactory::keys(); # disable style plugins (hacky) + +my $a = Qt::Application(\@ARGV); + +my $buttonsgroups = ButtonsGroups; +$buttonsgroups->resize(500, 250); +$buttonsgroups->setCaption("PerlQt Test - Please wait"); +$a->setMainWidget($buttonsgroups); +$buttonsgroups->show; + +Qt::Timer::singleShot( 2000, Qt::app(), SLOT "quit()" ); +my $r = $a->exec; +print +$r?"not ok\n" : "ok 1\n"; +exit $r; diff --git a/PerlQt/tutorials/runall.pl b/PerlQt/tutorials/runall.pl new file mode 100644 index 0000000..d0363f1 --- /dev/null +++ b/PerlQt/tutorials/runall.pl @@ -0,0 +1,8 @@ +#!/usr/bin/perl -w +# Use the tutorials as a test suite +@tutorials = (sort(glob("t?")), sort(glob("t??"))); +for $tutorial (@tutorials) { + chdir($tutorial) || next; + system("$^X -w $tutorial.pl"); + chdir(".."); +} diff --git a/PerlQt/tutorials/t1/t1.pl b/PerlQt/tutorials/t1/t1.pl new file mode 100644 index 0000000..a1e2cd8 --- /dev/null +++ b/PerlQt/tutorials/t1/t1.pl @@ -0,0 +1,13 @@ +#!/usr/bin/perl -w +use strict; +use blib; +use Qt; + +my $a = Qt::Application(\@ARGV); + +my $hello = Qt::PushButton("Hello World!", undef); +$hello->resize(100, 30); + +$a->setMainWidget($hello); +$hello->show; +exit $a->exec; diff --git a/PerlQt/tutorials/t10/CannonField.pm b/PerlQt/tutorials/t10/CannonField.pm new file mode 100644 index 0000000..27bfcee --- /dev/null +++ b/PerlQt/tutorials/t10/CannonField.pm @@ -0,0 +1,76 @@ +package CannonField; +use strict; +use Qt; +use Qt::isa qw(Qt::Widget); +use Qt::signals + angleChanged => ['int'], + forceChanged => ['int']; +use Qt::slots + setAngle => ['int'], + setForce => ['int']; +use Qt::attributes qw( + ang + f +); +use POSIX qw(atan); + +sub angle () { ang } +sub force () { f } + +sub NEW { + shift->SUPER::NEW(@_); + + ang = 45; + f = 0; + setPalette(Qt::Palette(Qt::Color(250, 250, 200))); +} + +sub setAngle { + my $degrees = shift; + $degrees = 5 if $degrees < 5; + $degrees = 70 if $degrees > 70; + return if ang == $degrees; + ang = $degrees; + repaint(cannonRect(), 0); + emit angleChanged(ang); +} + +sub setForce { + my $newton = shift; + $newton = 0 if $newton < 0; + return if f == $newton; + f = $newton; + emit forceChanged(f); +} + +sub paintEvent { + my $e = shift; + return unless $e->rect->intersects(cannonRect()); + my $cr = cannonRect(); + my $pix = Qt::Pixmap($cr->size); + $pix->fill(this, $cr->topLeft); + + my $p = Qt::Painter($pix); + $p->setBrush(&blue); + $p->setPen(&NoPen); + $p->translate(0, $pix->height - 1); + $p->drawPie(Qt::Rect(-35, -35, 70, 70), 0, 90*16); + $p->rotate(- ang); + $p->drawRect(Qt::Rect(33, -4, 15, 8)); + $p->end; + + $p->begin(this); + $p->drawPixmap($cr->topLeft, $pix); +} + +sub cannonRect { + my $r = Qt::Rect(0, 0, 50, 50); + $r->moveBottomLeft(rect()->bottomLeft); + return $r; +} + +sub sizePolicy { + Qt::SizePolicy(&Qt::SizePolicy::Expanding, &Qt::SizePolicy::Expanding); +} + +1; diff --git a/PerlQt/tutorials/t10/LCDRange.pm b/PerlQt/tutorials/t10/LCDRange.pm new file mode 100644 index 0000000..be0f8ec --- /dev/null +++ b/PerlQt/tutorials/t10/LCDRange.pm @@ -0,0 +1,43 @@ +package LCDRange; +use strict; +use Qt; +use Qt::isa qw(Qt::VBox); +use Qt::slots + setValue => ['int'], + setRange => ['int', 'int']; +use Qt::signals + valueChanged => ['int']; +use Qt::attributes qw( + slider +); + +sub NEW { + shift->SUPER::NEW(@_); + + my $lcd = Qt::LCDNumber(2, this, "lcd"); + + slider = Qt::Slider(&Horizontal, this, "slider"); + slider->setRange(0, 99); + slider->setValue(0); + $lcd->connect(slider, SIGNAL('valueChanged(int)'), SLOT('display(int)')); + this->connect(slider, SIGNAL('valueChanged(int)'), SIGNAL('valueChanged(int)')); + + setFocusProxy(slider); +} + +sub value { slider->value } + +sub setValue { slider->setValue(shift) } + +sub setRange { + my($minVal, $maxVal) = @_; + if($minVal < 0 || $maxVal > 99 || $minVal > $maxVal) { + warn "LCDRange::setRange($minVal,$maxVal)\n" . + "\tRange must be 0..99\n" . + "\tand minVal must not be greater than maxVal\n"; + return; + } + slider->setRange($minVal, $maxVal); +} + +1; diff --git a/PerlQt/tutorials/t10/t10.pl b/PerlQt/tutorials/t10/t10.pl new file mode 100644 index 0000000..d9b825e --- /dev/null +++ b/PerlQt/tutorials/t10/t10.pl @@ -0,0 +1,61 @@ +#!/usr/bin/perl -w +use strict; +use blib; + +package MyWidget; +use strict; +use Qt; +use Qt::isa qw(Qt::Widget); + +use LCDRange; +use CannonField; + +sub NEW { + shift->SUPER::NEW(@_); + + my $quit = Qt::PushButton("&Quit", this, "quit"); + $quit->setFont(Qt::Font("Times", 18, &Qt::Font::Bold)); + + Qt::app->connect($quit, SIGNAL('clicked()'), SLOT('quit()')); + + my $angle = LCDRange(this, "angle"); + $angle->setRange(5, 70); + + my $force = LCDRange(this, "force"); + $force->setRange(10, 50); + + my $cannonField = CannonField(this, "cannonField"); + + $cannonField->connect($angle, SIGNAL('valueChanged(int)'), SLOT('setAngle(int)')); + $angle->connect($cannonField, SIGNAL('angleChanged(int)'), SLOT('setValue(int)')); + + $cannonField->connect($force, SIGNAL('valueChanged(int)'), SLOT('setForce(int)')); + $force->connect($cannonField, SIGNAL('forceChanged(int)'), SLOT('setValue(int)')); + + my $grid = Qt::GridLayout(this, 2, 2, 10); + $grid->addWidget($quit, 0, 0); + $grid->addWidget($cannonField, 1, 1); + $grid->setColStretch(1, 10); + + my $leftBox = Qt::VBoxLayout; + $grid->addLayout($leftBox, 1, 0); + $leftBox->addWidget($angle); + $leftBox->addWidget($force); + + $angle->setValue(60); + $force->setValue(25); + $angle->setFocus(); +} + +package main; +use Qt; +use MyWidget; + +Qt::Application::setColorSpec(&Qt::Application::CustomColor); +my $a = Qt::Application(\@ARGV); + +my $w = MyWidget; +$w->setGeometry(100, 100, 500, 355); +$a->setMainWidget($w); +$w->show; +exit $a->exec; diff --git a/PerlQt/tutorials/t11/CannonField.pm b/PerlQt/tutorials/t11/CannonField.pm new file mode 100644 index 0000000..7ddfb24 --- /dev/null +++ b/PerlQt/tutorials/t11/CannonField.pm @@ -0,0 +1,146 @@ +package CannonField; +use strict; +use Qt; +use Qt::isa qw(Qt::Widget); +use Qt::signals + angleChanged => ['int'], + forceChanged => ['int']; +use Qt::slots + setAngle => ['int'], + setForce => ['int'], + shoot => [], + moveShot => []; +use Qt::attributes qw( + ang + f + + timerCount + autoShootTimer + shoot_ang + shoot_f +); +use POSIX qw(atan); + +sub angle () { ang } +sub force () { f } + +sub NEW { + shift->SUPER::NEW(@_); + + ang = 45; + f = 0; + timerCount = 0; + autoShootTimer = Qt::Timer(this, "movement handler"); + this->connect(autoShootTimer, SIGNAL('timeout()'), SLOT('moveShot()')); + shoot_ang = 0; + shoot_f = 0; + setPalette(Qt::Palette(Qt::Color(250, 250, 200))); +} + +sub setAngle { + my $degrees = shift; + $degrees = 5 if $degrees < 5; + $degrees = 70 if $degrees > 70; + return if ang == $degrees; + ang = $degrees; + repaint(cannonRect(), 0); + emit angleChanged(ang); +} + +sub setForce { + my $newton = shift; + $newton = 0 if $newton < 0; + return if f == $newton; + f = $newton; + emit forceChanged(f); +} + +sub shoot { + return if autoShootTimer->isActive; + timerCount = 0; + shoot_ang = ang; + shoot_f = f; + autoShootTimer->start(50); +} + +sub moveShot { + my $r = Qt::Region(shotRect()); + timerCount++; + + my $shotR = shotRect(); + + if($shotR->x > width() || $shotR->y > height()) { + autoShootTimer->stop; + } else { + $r = $r->unite(Qt::Region($shotR)); + } + repaint($r); +} + +sub paintEvent { + my $e = shift; + my $updateR = $e->rect; + my $p = Qt::Painter(this); + + paintCannon($p) if $updateR->intersects(cannonRect()); + paintShot($p) if autoShootTimer->isActive and $updateR->intersects(shotRect()); +} + +sub paintShot { + my $p = shift; + $p->setBrush(&black); + $p->setPen(&NoPen); + $p->drawRect(shotRect()); +} + +my $barrelRect = Qt::Rect(33, -4, 15, 8); + +sub paintCannon { + my $p = shift; + my $cr = cannonRect(); + my $pix = Qt::Pixmap($cr->size); + $pix->fill(this, $cr->topLeft); + + my $tmp = Qt::Painter($pix); + $tmp->setBrush(&blue); + $tmp->setPen(&NoPen); + + $tmp->translate(0, $pix->height - 1); + $tmp->drawPie(Qt::Rect(-35, -35, 70, 70), 0, 90*16); + $tmp->rotate(- ang); + $tmp->drawRect($barrelRect); + $tmp->end; + + $p->drawPixmap($cr->topLeft, $pix); +} + +sub cannonRect { + my $r = Qt::Rect(0, 0, 50, 50); + $r->moveBottomLeft(rect()->bottomLeft); + return $r; +} + +sub shotRect { + my $gravity = 4; + + my $time = timerCount / 4.0; + my $velocity = shoot_f; + my $radians = shoot_ang*3.14159265/180; + + my $velx = $velocity*cos($radians); + my $vely = $velocity*sin($radians); + my $x0 = ($barrelRect->right + 5)*cos($radians); + my $y0 = ($barrelRect->right + 5)*sin($radians); + my $x = $x0 + $velx*$time; + my $y = $y0 + $vely*$time - 0.5*$gravity*$time**2; + + my $r = Qt::Rect(0, 0, 6, 6); + $r->moveCenter(Qt::Point(int($x), height() - 1 - int($y))); + return $r; +} + +sub sizePolicy { + Qt::SizePolicy(&Qt::SizePolicy::Expanding, &Qt::SizePolicy::Expanding); +} + +1; diff --git a/PerlQt/tutorials/t11/LCDRange.pm b/PerlQt/tutorials/t11/LCDRange.pm new file mode 100644 index 0000000..be0f8ec --- /dev/null +++ b/PerlQt/tutorials/t11/LCDRange.pm @@ -0,0 +1,43 @@ +package LCDRange; +use strict; +use Qt; +use Qt::isa qw(Qt::VBox); +use Qt::slots + setValue => ['int'], + setRange => ['int', 'int']; +use Qt::signals + valueChanged => ['int']; +use Qt::attributes qw( + slider +); + +sub NEW { + shift->SUPER::NEW(@_); + + my $lcd = Qt::LCDNumber(2, this, "lcd"); + + slider = Qt::Slider(&Horizontal, this, "slider"); + slider->setRange(0, 99); + slider->setValue(0); + $lcd->connect(slider, SIGNAL('valueChanged(int)'), SLOT('display(int)')); + this->connect(slider, SIGNAL('valueChanged(int)'), SIGNAL('valueChanged(int)')); + + setFocusProxy(slider); +} + +sub value { slider->value } + +sub setValue { slider->setValue(shift) } + +sub setRange { + my($minVal, $maxVal) = @_; + if($minVal < 0 || $maxVal > 99 || $minVal > $maxVal) { + warn "LCDRange::setRange($minVal,$maxVal)\n" . + "\tRange must be 0..99\n" . + "\tand minVal must not be greater than maxVal\n"; + return; + } + slider->setRange($minVal, $maxVal); +} + +1; diff --git a/PerlQt/tutorials/t11/t11.pl b/PerlQt/tutorials/t11/t11.pl new file mode 100644 index 0000000..84d762d --- /dev/null +++ b/PerlQt/tutorials/t11/t11.pl @@ -0,0 +1,71 @@ +#!/usr/bin/perl -w +use strict; +use blib; + +package MyWidget; +use strict; +use Qt; +use Qt::isa qw(Qt::Widget); + +use LCDRange; +use CannonField; + +sub NEW { + shift->SUPER::NEW(@_); + + my $quit = Qt::PushButton("&Quit", this, "quit"); + $quit->setFont(Qt::Font("Times", 18, &Qt::Font::Bold)); + + Qt::app->connect($quit, SIGNAL('clicked()'), SLOT('quit()')); + + my $angle = LCDRange(this, "angle"); + $angle->setRange(5, 70); + + my $force = LCDRange(this, "force"); + $force->setRange(10, 50); + + my $cannonField = CannonField(this, "cannonField"); + + $cannonField->connect($angle, SIGNAL('valueChanged(int)'), SLOT('setAngle(int)')); + $angle->connect($cannonField, SIGNAL('angleChanged(int)'), SLOT('setValue(int)')); + + $cannonField->connect($force, SIGNAL('valueChanged(int)'), SLOT('setForce(int)')); + $force->connect($cannonField, SIGNAL('forceChanged(int)'), SLOT('setValue(int)')); + + my $shoot = Qt::PushButton('&Shoot', this, "shoot"); + $shoot->setFont(Qt::Font("Times", 18, &Qt::Font::Bold)); + + $cannonField->connect($shoot, SIGNAL('clicked()'), SLOT('shoot()')); + + my $grid = Qt::GridLayout(this, 2, 2, 10); + $grid->addWidget($quit, 0, 0); + $grid->addWidget($cannonField, 1, 1); + $grid->setColStretch(1, 10); + + my $leftBox = Qt::VBoxLayout; + $grid->addLayout($leftBox, 1, 0); + $leftBox->addWidget($angle); + $leftBox->addWidget($force); + + my $topBox = Qt::HBoxLayout; + $grid->addLayout($topBox, 0, 1); + $topBox->addWidget($shoot); + $topBox->addStretch(1); + + $angle->setValue(60); + $force->setValue(25); + $angle->setFocus(); +} + +package main; +use Qt; +use MyWidget; + +Qt::Application::setColorSpec(&Qt::Application::CustomColor); +my $a = Qt::Application(\@ARGV); + +my $w = MyWidget; +$w->setGeometry(100, 100, 500, 355); +$a->setMainWidget($w); +$w->show; +exit $a->exec; diff --git a/PerlQt/tutorials/t12/CannonField.pm b/PerlQt/tutorials/t12/CannonField.pm new file mode 100644 index 0000000..df4eb96 --- /dev/null +++ b/PerlQt/tutorials/t12/CannonField.pm @@ -0,0 +1,177 @@ +package CannonField; +use strict; +use Qt; +use Qt::isa qw(Qt::Widget); +use Qt::signals + hit => [], + missed => [], + angleChanged => ['int'], + forceChanged => ['int']; +use Qt::slots + setAngle => ['int'], + setForce => ['int'], + shoot => [], + moveShot => []; +use Qt::attributes qw( + ang + f + + timerCount + autoShootTimer + shoot_ang + shoot_f + + target +); +use POSIX qw(atan); + +sub angle () { ang } +sub force () { f } + +sub NEW { + shift->SUPER::NEW(@_); + + ang = 45; + f = 0; + timerCount = 0; + autoShootTimer = Qt::Timer(this, "movement handler"); + this->connect(autoShootTimer, SIGNAL('timeout()'), SLOT('moveShot()')); + shoot_ang = 0; + shoot_f = 0; + target = Qt::Point(0, 0); + setPalette(Qt::Palette(Qt::Color(250, 250, 200))); + newTarget(); +} + +sub setAngle { + my $degrees = shift; + $degrees = 5 if $degrees < 5; + $degrees = 70 if $degrees > 70; + return if ang == $degrees; + ang = $degrees; + repaint(cannonRect(), 0); + emit angleChanged(ang); +} + +sub setForce { + my $newton = shift; + $newton = 0 if $newton < 0; + return if f == $newton; + f = $newton; + emit forceChanged(f); +} + +sub shoot { + return if autoShootTimer->isActive; + timerCount = 0; + shoot_ang = ang; + shoot_f = f; + autoShootTimer->start(50); +} + +sub newTarget { + my $r = Qt::Region(targetRect()); + target = Qt::Point(200 + int(rand(190)), + 10 + int(rand(255))); + repaint($r->unite(Qt::Region(targetRect()))); +} + +sub moveShot { + my $r = Qt::Region(shotRect()); + timerCount++; + + my $shotR = shotRect(); + + if($shotR->intersects(targetRect())) { + autoShootTimer->stop; + emit hit(); + } elsif($shotR->x > width() || $shotR->y > height()) { + autoShootTimer->stop; + emit missed(); + } else { + $r = $r->unite(Qt::Region($shotR)); + } + repaint($r); +} + +sub paintEvent { + my $e = shift; + my $updateR = $e->rect; + my $p = Qt::Painter(this); + + paintCannon($p) if $updateR->intersects(cannonRect()); + paintShot($p) if autoShootTimer->isActive and $updateR->intersects(shotRect()); + paintTarget($p) if $updateR->intersects(targetRect()); +} + +sub paintShot { + my $p = shift; + $p->setBrush(&black); + $p->setPen(&NoPen); + $p->drawRect(shotRect()); +} + +sub paintTarget { + my $p = shift; + $p->setBrush(&red); + $p->setPen(&black); + $p->drawRect(targetRect()); +} + +my $barrelRect = Qt::Rect(33, -4, 15, 8); + +sub paintCannon { + my $p = shift; + my $cr = cannonRect(); + my $pix = Qt::Pixmap($cr->size); + $pix->fill(this, $cr->topLeft); + + my $tmp = Qt::Painter($pix); + $tmp->setBrush(&blue); + $tmp->setPen(&NoPen); + + $tmp->translate(0, $pix->height - 1); + $tmp->drawPie(Qt::Rect(-35, -35, 70, 70), 0, 90*16); + $tmp->rotate(- ang); + $tmp->drawRect($barrelRect); + $tmp->end; + + $p->drawPixmap($cr->topLeft, $pix); +} + +sub cannonRect { + my $r = Qt::Rect(0, 0, 50, 50); + $r->moveBottomLeft(rect()->bottomLeft); + return $r; +} + +sub shotRect { + my $gravity = 4; + + my $time = timerCount / 4.0; + my $velocity = shoot_f; + my $radians = shoot_ang*3.14159265/180; + + my $velx = $velocity*cos($radians); + my $vely = $velocity*sin($radians); + my $x0 = ($barrelRect->right + 5)*cos($radians); + my $y0 = ($barrelRect->right + 5)*sin($radians); + my $x = $x0 + $velx*$time; + my $y = $y0 + $vely*$time - 0.5*$gravity*$time**2; + + my $r = Qt::Rect(0, 0, 6, 6); + $r->moveCenter(Qt::Point(int($x), height() - 1 - int($y))); + return $r; +} + +sub targetRect { + my $r = Qt::Rect(0, 0, 20, 10); + $r->moveCenter(Qt::Point(target->x, height() - 1 - target->y)); + return $r; +} + +sub sizePolicy { + Qt::SizePolicy(&Qt::SizePolicy::Expanding, &Qt::SizePolicy::Expanding); +} + +1; diff --git a/PerlQt/tutorials/t12/LCDRange.pm b/PerlQt/tutorials/t12/LCDRange.pm new file mode 100644 index 0000000..3562fee --- /dev/null +++ b/PerlQt/tutorials/t12/LCDRange.pm @@ -0,0 +1,62 @@ +package LCDRange; +use strict; +use Qt; +use Qt::isa qw(Qt::VBox); +use Qt::slots + setValue => ['int'], + setRange => ['int', 'int'], + setText => ['const char*']; +use Qt::signals + valueChanged => ['int']; +use Qt::attributes qw( + slider + label +); + +sub NEW { + my $class = shift; + my $s; + $s = shift if $_[0] and not ref $_[0]; + $class->SUPER::NEW(@_); + + init(); + setText($s) if $s; +} + + +sub init { + my $lcd = Qt::LCDNumber(2, this, "lcd"); + + slider = Qt::Slider(&Horizontal, this, "slider"); + slider->setRange(0, 99); + slider->setValue(0); + + label = Qt::Label(" ", this, "label"); + label->setAlignment(&AlignCenter); + + $lcd->connect(slider, SIGNAL('valueChanged(int)'), SLOT('display(int)')); + this->connect(slider, SIGNAL('valueChanged(int)'), SIGNAL('valueChanged(int)')); + + setFocusProxy(slider); +} + +sub value { slider->value } + +sub text { label->text } + +sub setValue { slider->setValue(shift) } + +sub setRange { + my($minVal, $maxVal) = @_; + if($minVal < 0 || $maxVal > 99 || $minVal > $maxVal) { + warn "LCDRange::setRange($minVal,$maxVal)\n" . + "\tRange must be 0..99\n" . + "\tand minVal must not be greater than maxVal\n"; + return; + } + slider->setRange($minVal, $maxVal); +} + +sub setText { label->setText(shift) } + +1; diff --git a/PerlQt/tutorials/t12/t12.pl b/PerlQt/tutorials/t12/t12.pl new file mode 100644 index 0000000..87c50be --- /dev/null +++ b/PerlQt/tutorials/t12/t12.pl @@ -0,0 +1,71 @@ +#!/usr/bin/perl -w +use strict; +use blib; + +package MyWidget; +use strict; +use Qt; +use Qt::isa qw(Qt::Widget); + +use LCDRange; +use CannonField; + +sub NEW { + shift->SUPER::NEW(@_); + + my $quit = Qt::PushButton("&Quit", this, "quit"); + $quit->setFont(Qt::Font("Times", 18, &Qt::Font::Bold)); + + Qt::app->connect($quit, SIGNAL('clicked()'), SLOT('quit()')); + + my $angle = LCDRange("ANGLE", this, "angle"); + $angle->setRange(5, 70); + + my $force = LCDRange("FORCE", this, "force"); + $force->setRange(10, 50); + + my $cannonField = CannonField(this, "cannonField"); + + $cannonField->connect($angle, SIGNAL('valueChanged(int)'), SLOT('setAngle(int)')); + $angle->connect($cannonField, SIGNAL('angleChanged(int)'), SLOT('setValue(int)')); + + $cannonField->connect($force, SIGNAL('valueChanged(int)'), SLOT('setForce(int)')); + $force->connect($cannonField, SIGNAL('forceChanged(int)'), SLOT('setValue(int)')); + + my $shoot = Qt::PushButton('&Shoot', this, "shoot"); + $shoot->setFont(Qt::Font("Times", 18, &Qt::Font::Bold)); + + $cannonField->connect($shoot, SIGNAL('clicked()'), SLOT('shoot()')); + + my $grid = Qt::GridLayout(this, 2, 2, 10); + $grid->addWidget($quit, 0, 0); + $grid->addWidget($cannonField, 1, 1); + $grid->setColStretch(1, 10); + + my $leftBox = Qt::VBoxLayout; + $grid->addLayout($leftBox, 1, 0); + $leftBox->addWidget($angle); + $leftBox->addWidget($force); + + my $topBox = Qt::HBoxLayout; + $grid->addLayout($topBox, 0, 1); + $topBox->addWidget($shoot); + $topBox->addStretch(1); + + $angle->setValue(60); + $force->setValue(25); + $angle->setFocus(); +} + +package main; +use Qt; +use MyWidget; + +Qt::Application::setColorSpec(&Qt::Application::CustomColor); +my $a = Qt::Application(\@ARGV); + +my $w = MyWidget; +$w->setGeometry(100, 100, 500, 355); +$a->setMainWidget($w); +$w->show; +exit $a->exec; diff --git a/PerlQt/tutorials/t13/CannonField.pm b/PerlQt/tutorials/t13/CannonField.pm new file mode 100644 index 0000000..a1475e5 --- /dev/null +++ b/PerlQt/tutorials/t13/CannonField.pm @@ -0,0 +1,207 @@ +package CannonField; +use strict; +use Qt; +use Qt::isa qw(Qt::Widget); +use Qt::signals + hit => [], + missed => [], + angleChanged => ['int'], + forceChanged => ['int'], + canShoot => ['bool']; +use Qt::slots + setAngle => ['int'], + setForce => ['int'], + shoot => [], + moveShot => [], + newTarget => []; +use Qt::attributes qw( + ang + f + + timerCount + autoShootTimer + shoot_ang + shoot_f + + target + + gameEnded +); +use POSIX qw(atan); + +sub angle () { ang } +sub force () { f } +sub gameOver () { gameEnded } + +sub NEW { + shift->SUPER::NEW(@_); + + ang = 45; + f = 0; + timerCount = 0; + autoShootTimer = Qt::Timer(this, "movement handler"); + this->connect(autoShootTimer, SIGNAL('timeout()'), SLOT('moveShot()')); + shoot_ang = 0; + shoot_f = 0; + target = Qt::Point(0, 0); + gameEnded = 0; + setPalette(Qt::Palette(Qt::Color(250, 250, 200))); + newTarget(); +} + +sub setAngle { + my $degrees = shift; + $degrees = 5 if $degrees < 5; + $degrees = 70 if $degrees > 70; + return if ang == $degrees; + ang = $degrees; + repaint(cannonRect(), 0); + emit angleChanged(ang); +} + +sub setForce { + my $newton = shift; + $newton = 0 if $newton < 0; + return if f == $newton; + f = $newton; + emit forceChanged(f); +} + +sub shoot { + return if isShooting(); + timerCount = 0; + shoot_ang = ang; + shoot_f = f; + autoShootTimer->start(50); + emit canShoot(0); +} + +sub newTarget { + my $r = Qt::Region(targetRect()); + target = Qt::Point(200 + int(rand(190)), + 10 + int(rand(255))); + repaint($r->unite(Qt::Region(targetRect()))); +} + +sub setGameOver { + return if gameEnded; + autoShootTimer->stop if isShooting(); + gameEnded = 1; + repaint(); +} + +sub restartGame { + autoShootTimer->stop if isShooting(); + gameEnded = 0; + repaint(); + emit canShoot(1); +} + +sub moveShot { + my $r = Qt::Region(shotRect()); + timerCount++; + + my $shotR = shotRect(); + + if($shotR->intersects(targetRect())) { + autoShootTimer->stop; + emit hit(); + emit canShoot(1); + } elsif($shotR->x > width() || $shotR->y > height()) { + autoShootTimer->stop; + emit missed(); + emit canShoot(1); + } else { + $r = $r->unite(Qt::Region($shotR)); + } + repaint($r); +} + +sub paintEvent { + my $e = shift; + my $updateR = $e->rect; + my $p = Qt::Painter(this); + + if(gameEnded) { + $p->setPen(&black); + $p->setFont(Qt::Font("Courier", 48, &Qt::Font::Bold)); + $p->drawText(rect(), &AlignCenter, "Game Over"); + } + paintCannon($p) if $updateR->intersects(cannonRect()); + paintShot($p) if isShooting() and $updateR->intersects(shotRect()); + paintTarget($p) if !gameEnded and $updateR->intersects(targetRect()); +} + +sub paintShot { + my $p = shift; + $p->setBrush(&black); + $p->setPen(&NoPen); + $p->drawRect(shotRect()); +} + +sub paintTarget { + my $p = shift; + $p->setBrush(&red); + $p->setPen(&black); + $p->drawRect(targetRect()); +} + +my $barrelRect = Qt::Rect(33, -4, 15, 8); + +sub paintCannon { + my $p = shift; + my $cr = cannonRect(); + my $pix = Qt::Pixmap($cr->size); + $pix->fill(this, $cr->topLeft); + + my $tmp = Qt::Painter($pix); + $tmp->setBrush(&blue); + $tmp->setPen(&NoPen); + + $tmp->translate(0, $pix->height - 1); + $tmp->drawPie(Qt::Rect(-35, -35, 70, 70), 0, 90*16); + $tmp->rotate(- ang); + $tmp->drawRect($barrelRect); + $tmp->end; + + $p->drawPixmap($cr->topLeft, $pix); +} + +sub cannonRect { + my $r = Qt::Rect(0, 0, 50, 50); + $r->moveBottomLeft(rect()->bottomLeft); + return $r; +} + +sub shotRect { + my $gravity = 4; + + my $time = timerCount / 4.0; + my $velocity = shoot_f; + my $radians = shoot_ang*3.14159265/180; + + my $velx = $velocity*cos($radians); + my $vely = $velocity*sin($radians); + my $x0 = ($barrelRect->right + 5)*cos($radians); + my $y0 = ($barrelRect->right + 5)*sin($radians); + my $x = $x0 + $velx*$time; + my $y = $y0 + $vely*$time - 0.5*$gravity*$time**2; + + my $r = Qt::Rect(0, 0, 6, 6); + $r->moveCenter(Qt::Point(int($x), height() - 1 - int($y))); + return $r; +} + +sub targetRect { + my $r = Qt::Rect(0, 0, 20, 10); + $r->moveCenter(Qt::Point(target->x, height() - 1 - target->y)); + return $r; +} + +sub isShooting { autoShootTimer->isActive } + +sub sizePolicy { + Qt::SizePolicy(&Qt::SizePolicy::Expanding, &Qt::SizePolicy::Expanding); +} + +1; diff --git a/PerlQt/tutorials/t13/GameBoard.pm b/PerlQt/tutorials/t13/GameBoard.pm new file mode 100644 index 0000000..1c4ab71 --- /dev/null +++ b/PerlQt/tutorials/t13/GameBoard.pm @@ -0,0 +1,114 @@ +package GameBoard; +use strict; +use Qt; +use Qt::isa qw(Qt::Widget); +use Qt::slots + fire => [], + hit => [], + missed => [], + newGame => []; +use Qt::attributes qw( + hits + shotsLeft + cannonField +); + +use LCDRange; +use CannonField; + +sub NEW { + shift->SUPER::NEW(@_); + + my $quit = Qt::PushButton("&Quit", this, "quit"); + $quit->setFont(Qt::Font("Times", 18, &Qt::Font::Bold)); + + Qt::app->connect($quit, SIGNAL('clicked()'), SLOT('quit()')); + + my $angle = LCDRange("ANGLE", this, "angle"); + $angle->setRange(5, 70); + + my $force = LCDRange("FORCE", this, "force"); + $force->setRange(10, 50); + + cannonField = CannonField(this, "cannonField"); + + cannonField->connect($angle, SIGNAL('valueChanged(int)'), SLOT('setAngle(int)')); + $angle->connect(cannonField, SIGNAL('angleChanged(int)'), SLOT('setValue(int)')); + + cannonField->connect($force, SIGNAL('valueChanged(int)'), SLOT('setForce(int)')); + $force->connect(cannonField, SIGNAL('forceChanged(int)'), SLOT('setValue(int)')); + + this->connect(cannonField, SIGNAL('hit()'), SLOT('hit()')); + this->connect(cannonField, SIGNAL('missed()'), SLOT('missed()')); + + my $shoot = Qt::PushButton('&Shoot', this, "shoot"); + $shoot->setFont(Qt::Font("Times", 18, &Qt::Font::Bold)); + + this->connect($shoot, SIGNAL('clicked()'), SLOT('fire()')); + + $shoot->connect(cannonField, SIGNAL('canShoot(bool)'), SLOT('setEnabled(bool)')); + + my $restart = Qt::PushButton('&New Game', this, "newgame"); + $restart->setFont(Qt::Font("Times", 18, &Qt::Font::Bold)); + + this->connect($restart, SIGNAL('clicked()'), SLOT('newGame()')); + + hits = Qt::LCDNumber(2, this, "hits"); + shotsLeft = Qt::LCDNumber(2, this, "shotsleft"); + my $hitsL = Qt::Label("HITS", this, "hitsLabel"); + my $shotsLeftL = Qt::Label("SHOTS LEFT", this, "shotsLeftLabel"); + + my $grid = Qt::GridLayout(this, 2, 2, 10); + $grid->addWidget($quit, 0, 0); + $grid->addWidget(cannonField, 1, 1); + $grid->setColStretch(1, 10); + + my $leftBox = Qt::VBoxLayout; + $grid->addLayout($leftBox, 1, 0); + $leftBox->addWidget($angle); + $leftBox->addWidget($force); + + my $topBox = Qt::HBoxLayout; + $grid->addLayout($topBox, 0, 1); + $topBox->addWidget($shoot); + $topBox->addWidget(hits); + $topBox->addWidget($hitsL); + $topBox->addWidget(shotsLeft); + $topBox->addWidget($shotsLeftL); + $topBox->addStretch(1); + $topBox->addWidget($restart); + + $angle->setValue(60); + $force->setValue(25); + $angle->setFocus(); + + newGame(); +} + +sub fire { + return if cannonField->gameOver or cannonField->isShooting; + shotsLeft->display(int(shotsLeft->intValue - 1)); + cannonField->shoot; +} + +sub hit { + hits->display(int(hits->intValue + 1)); + if(shotsLeft->intValue == 0) { + cannonField->setGameOver; + } else { + cannonField->newTarget; + } +} + +sub missed { + cannonField->setGameOver if shotsLeft->intValue == 0; +} + +sub newGame { + shotsLeft->display(int(15)); + hits->display(0); + cannonField->restartGame; + cannonField->newTarget; +} + +1; diff --git a/PerlQt/tutorials/t13/LCDRange.pm b/PerlQt/tutorials/t13/LCDRange.pm new file mode 100644 index 0000000..b08827e --- /dev/null +++ b/PerlQt/tutorials/t13/LCDRange.pm @@ -0,0 +1,67 @@ +package LCDRange; +use strict; +use Qt; +use Qt::isa qw(Qt::Widget); +use Qt::slots + setValue => ['int'], + setRange => ['int', 'int'], + setText => ['const char*']; +use Qt::signals + valueChanged => ['int']; +use Qt::attributes qw( + slider + label +); + +sub NEW { + my $class = shift; + my $s; + $s = shift if $_[0] and not ref $_[0]; + $class->SUPER::NEW(@_); + + init(); + setText($s) if $s; +} + + +sub init { + my $lcd = Qt::LCDNumber(2, this, "lcd"); + + slider = Qt::Slider(&Horizontal, this, "slider"); + slider->setRange(0, 99); + slider->setValue(0); + + label = Qt::Label(" ", this, "label"); + label->setAlignment(&AlignCenter); + + $lcd->connect(slider, SIGNAL('valueChanged(int)'), SLOT('display(int)')); + this->connect(slider, SIGNAL('valueChanged(int)'), SIGNAL('valueChanged(int)')); + + setFocusProxy(slider); + + my $l = Qt::VBoxLayout(this); + $l->addWidget($lcd, 1); + $l->addWidget(slider); + $l->addWidget(label); +} + +sub value { slider->value } + +sub text { label->text } + +sub setValue { slider->setValue(shift) } + +sub setRange { + my($minVal, $maxVal) = @_; + if($minVal < 0 || $maxVal > 99 || $minVal > $maxVal) { + warn "LCDRange::setRange($minVal,$maxVal)\n" . + "\tRange must be 0..99\n" . + "\tand minVal must not be greater than maxVal\n"; + return; + } + slider->setRange($minVal, $maxVal); +} + +sub setText { label->setText(shift) } + +1; diff --git a/PerlQt/tutorials/t13/t13.pl b/PerlQt/tutorials/t13/t13.pl new file mode 100644 index 0000000..b0f5c25 --- /dev/null +++ b/PerlQt/tutorials/t13/t13.pl @@ -0,0 +1,14 @@ +#!/usr/bin/perl -w +use strict; +use blib; +use Qt; +use GameBoard; + +Qt::Application::setColorSpec(&Qt::Application::CustomColor); +my $a = Qt::Application(\@ARGV); + +my $gb = GameBoard; +$gb->setGeometry(100, 100, 500, 355); +$a->setMainWidget($gb); +$gb->show; +exit $a->exec; diff --git a/PerlQt/tutorials/t14/CannonField.pm b/PerlQt/tutorials/t14/CannonField.pm new file mode 100644 index 0000000..05fdbce --- /dev/null +++ b/PerlQt/tutorials/t14/CannonField.pm @@ -0,0 +1,256 @@ +package CannonField; +use strict; +use Qt; +use Qt::isa qw(Qt::Widget); +use Qt::signals + hit => [], + missed => [], + angleChanged => ['int'], + forceChanged => ['int'], + canShoot => ['bool']; +use Qt::slots + setAngle => ['int'], + setForce => ['int'], + shoot => [], + moveShot => [], + newTarget => [], + setGameOver => [], + restartGame => []; +use Qt::attributes qw( + ang + f + + timerCount + autoShootTimer + shoot_ang + shoot_f + + target + + gameEnded + barrelPressed +); +use POSIX qw(atan); + +sub angle () { ang } +sub force () { f } +sub gameOver () { gameEnded } + +sub NEW { + shift->SUPER::NEW(@_); + + ang = 45; + f = 0; + timerCount = 0; + autoShootTimer = Qt::Timer(this, "movement handler"); + this->connect(autoShootTimer, SIGNAL('timeout()'), SLOT('moveShot()')); + shoot_ang = 0; + shoot_f = 0; + target = Qt::Point(0, 0); + gameEnded = 0; + barrelPressed = 0; + setPalette(Qt::Palette(Qt::Color(250, 250, 200))); + newTarget(); +} + +sub setAngle { + my $degrees = shift; + $degrees = 5 if $degrees < 5; + $degrees = 70 if $degrees > 70; + return if ang == $degrees; + ang = $degrees; + repaint(cannonRect(), 0); + emit angleChanged(ang); +} + +sub setForce { + my $newton = shift; + $newton = 0 if $newton < 0; + return if f == $newton; + f = $newton; + emit forceChanged(f); +} + +sub shoot { + return if isShooting(); + timerCount = 0; + shoot_ang = ang; + shoot_f = f; + autoShootTimer->start(50); + emit canShoot(0); +} + +sub newTarget { + my $r = Qt::Region(targetRect()); + target = Qt::Point(200 + int(rand(190)), + 10 + int(rand(255))); + repaint($r->unite(Qt::Region(targetRect()))); +} + +sub setGameOver { + return if gameEnded; + autoShootTimer->stop if isShooting(); + gameEnded = 1; + repaint(); +} + +sub restartGame { + autoShootTimer->stop if isShooting(); + gameEnded = 0; + repaint(); + emit canShoot(1); +} + +sub moveShot { + my $r = Qt::Region(shotRect()); + timerCount++; + + my $shotR = shotRect(); + + if($shotR->intersects(targetRect())) { + autoShootTimer->stop; + emit hit(); + emit canShoot(1); + } elsif($shotR->x > width() || $shotR->y > height() || + $shotR->intersects(barrierRect())) { + autoShootTimer->stop; + emit missed(); + emit canShoot(1); + } else { + $r = $r->unite(Qt::Region($shotR)); + } + repaint($r); +} + +sub mousePressEvent { + my $e = shift; + return if $e->button != &LeftButton; + barrelPressed = 1 if barrelHit($e->pos); +} + +sub mouseMoveEvent { + my $e = shift; + return unless barrelPressed; + my $pnt = $e->pos; + $pnt->setX(1) if $pnt->x <= 0; + $pnt->setY(height() - 1) if $pnt->y >= height(); + my $rad = atan((rect()->bottom - $pnt->y) / $pnt->x); + setAngle(int($rad*180/3.14159265)); +} + +sub mouseReleaseEvent { + my $e = shift; + barrelPressed = 0 if $e->button == &LeftButton; +} + +sub paintEvent { + my $e = shift; + my $updateR = $e->rect; + my $p = Qt::Painter(this); + + if(gameEnded) { + $p->setPen(&black); + $p->setFont(Qt::Font("Courier", 48, &Qt::Font::Bold)); + $p->drawText(rect(), &AlignCenter, "Game Over"); + } + paintCannon($p) if $updateR->intersects(cannonRect()); + paintBarrier($p) if $updateR->intersects(barrierRect()); + paintShot($p) if isShooting() and $updateR->intersects(shotRect()); + paintTarget($p) if !gameEnded and $updateR->intersects(targetRect()); +} + +sub paintShot { + my $p = shift; + $p->setBrush(&black); + $p->setPen(&NoPen); + $p->drawRect(shotRect()); +} + +sub paintTarget { + my $p = shift; + $p->setBrush(&red); + $p->setPen(&black); + $p->drawRect(targetRect()); +} + +sub paintBarrier { + my $p = shift; + $p->setBrush(&yellow); + $p->setPen(&black); + $p->drawRect(barrierRect()); +} + +my $barrelRect = Qt::Rect(33, -4, 15, 8); + +sub paintCannon { + my $p = shift; + my $cr = cannonRect(); + my $pix = Qt::Pixmap($cr->size); + $pix->fill(this, $cr->topLeft); + + my $tmp = Qt::Painter($pix); + $tmp->setBrush(&blue); + $tmp->setPen(&NoPen); + + $tmp->translate(0, $pix->height - 1); + $tmp->drawPie(Qt::Rect(-35, -35, 70, 70), 0, 90*16); + $tmp->rotate(- ang); + $tmp->drawRect($barrelRect); + $tmp->end; + + $p->drawPixmap($cr->topLeft, $pix); +} + +sub cannonRect { + my $r = Qt::Rect(0, 0, 50, 50); + $r->moveBottomLeft(rect()->bottomLeft); + return $r; +} + +sub shotRect { + my $gravity = 4; + + my $time = timerCount / 4.0; + my $velocity = shoot_f; + my $radians = shoot_ang*3.14159265/180; + + my $velx = $velocity*cos($radians); + my $vely = $velocity*sin($radians); + my $x0 = ($barrelRect->right + 5)*cos($radians); + my $y0 = ($barrelRect->right + 5)*sin($radians); + my $x = $x0 + $velx*$time; + my $y = $y0 + $vely*$time - 0.5*$gravity*$time**2; + + my $r = Qt::Rect(0, 0, 6, 6); + $r->moveCenter(Qt::Point(int($x), height() - 1 - int($y))); + return $r; +} + +sub targetRect { + my $r = Qt::Rect(0, 0, 20, 10); + $r->moveCenter(Qt::Point(target->x, height() - 1 - target->y)); + return $r; +} + +sub barrierRect { + return Qt::Rect(145, height() - 100, 15, 100); +} + +sub barrelHit { + my $p = shift; + my $mtx = Qt::WMatrix; + $mtx->translate(0, height() - 1); + $mtx->rotate(- ang); + $mtx = $mtx->invert; + return $barrelRect->contains($mtx->map($p)); +} + +sub isShooting { autoShootTimer->isActive } + +sub sizeHint { Qt::Size(400, 300) } + +sub sizePolicy { + Qt::SizePolicy(&Qt::SizePolicy::Expanding, &Qt::SizePolicy::Expanding); +} + +1; diff --git a/PerlQt/tutorials/t14/GameBoard.pm b/PerlQt/tutorials/t14/GameBoard.pm new file mode 100644 index 0000000..96f9cbb --- /dev/null +++ b/PerlQt/tutorials/t14/GameBoard.pm @@ -0,0 +1,125 @@ +package GameBoard; +use strict; +use Qt; +use Qt::isa qw(Qt::Widget); +use Qt::slots + fire => [], + hit => [], + missed => [], + newGame => []; +use Qt::attributes qw( + hits + shotsLeft + cannonField +); + +use LCDRange; +use CannonField; + +sub NEW { + shift->SUPER::NEW(@_); + + my $quit = Qt::PushButton("&Quit", this, "quit"); + $quit->setFont(Qt::Font("Times", 18, &Qt::Font::Bold)); + + Qt::app->connect($quit, SIGNAL('clicked()'), SLOT('quit()')); + + my $angle = LCDRange("ANGLE", this, "angle"); + $angle->setRange(5, 70); + + my $force = LCDRange("FORCE", this, "force"); + $force->setRange(10, 50); + + my $box = Qt::VBox(this, "cannonFrame"); + $box->setFrameStyle($box->WinPanel | $box->Sunken); + + cannonField = CannonField($box, "cannonField"); + + cannonField->connect($angle, SIGNAL('valueChanged(int)'), SLOT('setAngle(int)')); + $angle->connect(cannonField, SIGNAL('angleChanged(int)'), SLOT('setValue(int)')); + + cannonField->connect($force, SIGNAL('valueChanged(int)'), SLOT('setForce(int)')); + $force->connect(cannonField, SIGNAL('forceChanged(int)'), SLOT('setValue(int)')); + + this->connect(cannonField, SIGNAL('hit()'), SLOT('hit()')); + this->connect(cannonField, SIGNAL('missed()'), SLOT('missed()')); + + my $shoot = Qt::PushButton('&Shoot', this, "shoot"); + $shoot->setFont(Qt::Font("Times", 18, &Qt::Font::Bold)); + + this->connect($shoot, SIGNAL('clicked()'), SLOT('fire()')); + + $shoot->connect(cannonField, SIGNAL('canShoot(bool)'), SLOT('setEnabled(bool)')); + + my $restart = Qt::PushButton('&New Game', this, "newgame"); + $restart->setFont(Qt::Font("Times", 18, &Qt::Font::Bold)); + + this->connect($restart, SIGNAL('clicked()'), SLOT('newGame()')); + + hits = Qt::LCDNumber(2, this, "hits"); + shotsLeft = Qt::LCDNumber(2, this, "shotsleft"); + my $hitsL = Qt::Label("HITS", this, "hitsLabel"); + my $shotsLeftL = Qt::Label("SHOTS LEFT", this, "shotsLeftLabel"); + + my $accel = Qt::Accel(this); + $accel->connectItem($accel->insertItem(Qt::KeySequence(int &Key_Enter)), + this, SLOT('fire()')); + $accel->connectItem($accel->insertItem(Qt::KeySequence(int &Key_Return)), + this, SLOT('fire()')); + $accel->connectItem($accel->insertItem(Qt::KeySequence(int &CTRL+&Key_Q)), + Qt::app, SLOT('quit()')); + + my $grid = Qt::GridLayout(this, 2, 2, 10); + $grid->addWidget($quit, 0, 0); + $grid->addWidget($box, 1, 1); + $grid->setColStretch(1, 10); + + my $leftBox = Qt::VBoxLayout; + $grid->addLayout($leftBox, 1, 0); + $leftBox->addWidget($angle); + $leftBox->addWidget($force); + + my $topBox = Qt::HBoxLayout; + $grid->addLayout($topBox, 0, 1); + $topBox->addWidget($shoot); + $topBox->addWidget(hits); + $topBox->addWidget($hitsL); + $topBox->addWidget(shotsLeft); + $topBox->addWidget($shotsLeftL); + $topBox->addStretch(1); + $topBox->addWidget($restart); + + $angle->setValue(60); + $force->setValue(25); + $angle->setFocus(); + + newGame(); +} + +sub fire { + return if cannonField->gameOver or cannonField->isShooting; + shotsLeft->display(int(shotsLeft->intValue - 1)); + cannonField->shoot; +} + +sub hit { + hits->display(int(hits->intValue + 1)); + if(shotsLeft->intValue == 0) { + cannonField->setGameOver; + } else { + cannonField->newTarget; + } +} + +sub missed { + cannonField->setGameOver if shotsLeft->intValue == 0; +} + +sub newGame { + shotsLeft->display(int(15)); + hits->display(0); + cannonField->restartGame; + cannonField->newTarget; +} + +1; diff --git a/PerlQt/tutorials/t14/LCDRange.pm b/PerlQt/tutorials/t14/LCDRange.pm new file mode 100644 index 0000000..b08827e --- /dev/null +++ b/PerlQt/tutorials/t14/LCDRange.pm @@ -0,0 +1,67 @@ +package LCDRange; +use strict; +use Qt; +use Qt::isa qw(Qt::Widget); +use Qt::slots + setValue => ['int'], + setRange => ['int', 'int'], + setText => ['const char*']; +use Qt::signals + valueChanged => ['int']; +use Qt::attributes qw( + slider + label +); + +sub NEW { + my $class = shift; + my $s; + $s = shift if $_[0] and not ref $_[0]; + $class->SUPER::NEW(@_); + + init(); + setText($s) if $s; +} + + +sub init { + my $lcd = Qt::LCDNumber(2, this, "lcd"); + + slider = Qt::Slider(&Horizontal, this, "slider"); + slider->setRange(0, 99); + slider->setValue(0); + + label = Qt::Label(" ", this, "label"); + label->setAlignment(&AlignCenter); + + $lcd->connect(slider, SIGNAL('valueChanged(int)'), SLOT('display(int)')); + this->connect(slider, SIGNAL('valueChanged(int)'), SIGNAL('valueChanged(int)')); + + setFocusProxy(slider); + + my $l = Qt::VBoxLayout(this); + $l->addWidget($lcd, 1); + $l->addWidget(slider); + $l->addWidget(label); +} + +sub value { slider->value } + +sub text { label->text } + +sub setValue { slider->setValue(shift) } + +sub setRange { + my($minVal, $maxVal) = @_; + if($minVal < 0 || $maxVal > 99 || $minVal > $maxVal) { + warn "LCDRange::setRange($minVal,$maxVal)\n" . + "\tRange must be 0..99\n" . + "\tand minVal must not be greater than maxVal\n"; + return; + } + slider->setRange($minVal, $maxVal); +} + +sub setText { label->setText(shift) } + +1; diff --git a/PerlQt/tutorials/t14/t14.pl b/PerlQt/tutorials/t14/t14.pl new file mode 100644 index 0000000..b0f5c25 --- /dev/null +++ b/PerlQt/tutorials/t14/t14.pl @@ -0,0 +1,14 @@ +#!/usr/bin/perl -w +use strict; +use blib; +use Qt; +use GameBoard; + +Qt::Application::setColorSpec(&Qt::Application::CustomColor); +my $a = Qt::Application(\@ARGV); + +my $gb = GameBoard; +$gb->setGeometry(100, 100, 500, 355); +$a->setMainWidget($gb); +$gb->show; +exit $a->exec; diff --git a/PerlQt/tutorials/t2/t2.pl b/PerlQt/tutorials/t2/t2.pl new file mode 100644 index 0000000..970ccb4 --- /dev/null +++ b/PerlQt/tutorials/t2/t2.pl @@ -0,0 +1,16 @@ +#!/usr/bin/perl -w +use strict; +use blib; +use Qt; + +my $a = Qt::Application(\@ARGV); + +my $quit = Qt::PushButton("Quit", undef); +$quit->resize(75, 30); +$quit->setFont(Qt::Font("Times", 18, &Qt::Font::Bold)); + +$a->connect($quit, SIGNAL('clicked()'), SLOT('quit()')); + +$a->setMainWidget($quit); +$quit->show; +exit $a->exec; diff --git a/PerlQt/tutorials/t3/t3.pl b/PerlQt/tutorials/t3/t3.pl new file mode 100644 index 0000000..bdd27fd --- /dev/null +++ b/PerlQt/tutorials/t3/t3.pl @@ -0,0 +1,19 @@ +#!/usr/bin/perl -w +use strict; +use blib; +use Qt; + +my $a = Qt::Application(\@ARGV); + +my $box = Qt::VBox; +$box->resize(200, 120); + +my $quit = Qt::PushButton("Quit", $box); +$quit->setFont(Qt::Font("Times", 18, &Qt::Font::Bold)); + +$a->connect($quit, SIGNAL('clicked()'), SLOT('quit()')); + +$a->setMainWidget($box); +$box->show; + +exit $a->exec; diff --git a/PerlQt/tutorials/t4/t4.pl b/PerlQt/tutorials/t4/t4.pl new file mode 100644 index 0000000..889a96a --- /dev/null +++ b/PerlQt/tutorials/t4/t4.pl @@ -0,0 +1,31 @@ +#!/usr/bin/perl -w +use strict; +use blib; + +package MyWidget; +use Qt; +use Qt::isa qw(Qt::Widget); + +sub NEW { + shift->SUPER::NEW(@_); + + setMinimumSize(200, 120); + setMaximumSize(200, 120); + + my $quit = Qt::PushButton("Quit", this, "quit"); + $quit->setGeometry(62, 40, 75, 30); + $quit->setFont(Qt::Font("Times", 18, &Qt::Font::Bold)); + + Qt::app->connect($quit, SIGNAL('clicked()'), SLOT('quit()')); +} + +package main; +use MyWidget; + +my $a = Qt::Application(\@ARGV); + +my $w = MyWidget; +$w->setGeometry(100, 100, 200, 120); +$a->setMainWidget($w); +$w->show; +exit $a->exec; diff --git a/PerlQt/tutorials/t5/t5.pl b/PerlQt/tutorials/t5/t5.pl new file mode 100644 index 0000000..d2dc201 --- /dev/null +++ b/PerlQt/tutorials/t5/t5.pl @@ -0,0 +1,34 @@ +#!/usr/bin/perl -w +use strict; +use blib; + +package MyWidget; +use Qt; +use Qt::isa qw(Qt::VBox); + +sub NEW { + shift->SUPER::NEW(@_); + + my $quit = Qt::PushButton("Quit", this, "quit"); + $quit->setFont(Qt::Font("Times", 18, &Qt::Font::Bold)); + + Qt::app->connect($quit, SIGNAL('clicked()'), SLOT('quit()')); + + my $lcd = Qt::LCDNumber(2, this, "lcd"); + + my $slider = Qt::Slider(&Horizontal, this, "slider"); + $slider->setRange(0, 99); + $slider->setValue(0); + + $lcd->connect($slider, SIGNAL('valueChanged(int)'), SLOT('display(int)')); +} + +package main; +use MyWidget; + +my $a = Qt::Application(\@ARGV); + +my $w = MyWidget; +$a->setMainWidget($w); +$w->show; +exit $a->exec; diff --git a/PerlQt/tutorials/t6/t6.pl b/PerlQt/tutorials/t6/t6.pl new file mode 100644 index 0000000..210626a --- /dev/null +++ b/PerlQt/tutorials/t6/t6.pl @@ -0,0 +1,49 @@ +#!/usr/bin/perl -w +use strict; +use blib; + +package LCDRange; +use Qt; +use Qt::isa qw(Qt::VBox); + +sub NEW { + shift->SUPER::NEW(@_); + + my $lcd = Qt::LCDNumber(2, this, "lcd"); + my $slider = Qt::Slider(&Horizontal, this, "slider"); + $slider->setRange(0, 99); + $slider->setValue(0); + $lcd->connect($slider, SIGNAL('valueChanged(int)'), SLOT('display(int)')); +} + +package MyWidget; +use Qt; +use Qt::isa qw(Qt::VBox); +use LCDRange; + +sub NEW { + shift->SUPER::NEW(@_); + + my $quit = Qt::PushButton("Quit", this, "quit"); + $quit->setFont(Qt::Font("Times", 18, &Qt::Font::Bold)); + + Qt::app->connect($quit, SIGNAL('clicked()'), SLOT('quit()')); + + my $grid = Qt::Grid(4, this); + + for(0..3) { + for(0..3) { + LCDRange($grid); + } + } +} + +package main; +use MyWidget; + +my $a = Qt::Application(\@ARGV); + +my $w = MyWidget; +$a->setMainWidget($w); +$w->show; +exit $a->exec; diff --git a/PerlQt/tutorials/t7/LCDRange.pm b/PerlQt/tutorials/t7/LCDRange.pm new file mode 100644 index 0000000..8a79e39 --- /dev/null +++ b/PerlQt/tutorials/t7/LCDRange.pm @@ -0,0 +1,29 @@ +package LCDRange; +use strict; +use Qt; +use Qt::isa qw(Qt::VBox); +use Qt::slots setValue => ['int']; +use Qt::signals valueChanged => ['int']; +use Qt::attributes qw(slider); + +sub NEW { + shift->SUPER::NEW(@_); + + my $lcd = Qt::LCDNumber(2, this, "lcd"); + + my $slider = Qt::Slider(&Horizontal, this, "slider"); + slider = $slider; + slider->setRange(0, 99); + slider->setValue(0); + $lcd->connect(slider, SIGNAL('valueChanged(int)'), SLOT('display(int)')); + this->connect(slider, SIGNAL('valueChanged(int)'), SIGNAL('valueChanged(int)')); +} + +sub value { slider->value } + +sub setValue { + my $value = shift; + slider->setValue($value); +} + +1; diff --git a/PerlQt/tutorials/t7/t7.pl b/PerlQt/tutorials/t7/t7.pl new file mode 100644 index 0000000..c798e28 --- /dev/null +++ b/PerlQt/tutorials/t7/t7.pl @@ -0,0 +1,40 @@ +#!/usr/bin/perl -w +use strict; +use blib; + +package MyWidget; +use Qt; +use Qt::isa qw(Qt::VBox); + +use LCDRange; + +sub NEW { + shift->SUPER::NEW(@_); + + my $quit = Qt::PushButton("Quit", this, "quit"); + $quit->setFont(Qt::Font("Times", 18, &Qt::Font::Bold)); + + Qt::app->connect($quit, SIGNAL('clicked()'), SLOT('quit()')); + + my $grid = Qt::Grid(4, this); + + my $previous; + for my $r (0..3) { + for my $c (0..3) { + my $lr = LCDRange($grid); + $previous->connect( + $lr, SIGNAL('valueChanged(int)'), + SLOT('setValue(int)')) if $previous; + $previous = $lr; + } + } +} + +package main; +use MyWidget; + +my $a = Qt::Application(\@ARGV); +my $w = MyWidget; +$a->setMainWidget($w); +$w->show; +exit $a->exec; diff --git a/PerlQt/tutorials/t8/CannonField.pm b/PerlQt/tutorials/t8/CannonField.pm new file mode 100644 index 0000000..28e4986 --- /dev/null +++ b/PerlQt/tutorials/t8/CannonField.pm @@ -0,0 +1,43 @@ +package CannonField; +use strict; +use Qt; +use Qt::isa qw(Qt::Widget); +use Qt::signals + angleChanged => ['int']; +use Qt::slots + setAngle => ['int']; +use Qt::attributes qw( + ang +); +use POSIX qw(atan); + +sub angle () { ang } + +sub NEW { + shift->SUPER::NEW(@_); + + ang = 45; + setPalette(Qt::Palette(Qt::Color(250, 250, 200))); +} + +sub setAngle { + my $degrees = shift; + $degrees = 5 if $degrees < 5; + $degrees = 70 if $degrees > 70; + return if ang == $degrees; + ang = $degrees; + repaint(); + emit angleChanged(ang); +} + +sub paintEvent { + my $s = "Angle = " . ang; + my $p = Qt::Painter(this); + $p->drawText(200, 200, $s); +} + +sub sizePolicy { + Qt::SizePolicy(&Qt::SizePolicy::Expanding, &Qt::SizePolicy::Expanding); +} + +1; diff --git a/PerlQt/tutorials/t8/LCDRange.pm b/PerlQt/tutorials/t8/LCDRange.pm new file mode 100644 index 0000000..be0f8ec --- /dev/null +++ b/PerlQt/tutorials/t8/LCDRange.pm @@ -0,0 +1,43 @@ +package LCDRange; +use strict; +use Qt; +use Qt::isa qw(Qt::VBox); +use Qt::slots + setValue => ['int'], + setRange => ['int', 'int']; +use Qt::signals + valueChanged => ['int']; +use Qt::attributes qw( + slider +); + +sub NEW { + shift->SUPER::NEW(@_); + + my $lcd = Qt::LCDNumber(2, this, "lcd"); + + slider = Qt::Slider(&Horizontal, this, "slider"); + slider->setRange(0, 99); + slider->setValue(0); + $lcd->connect(slider, SIGNAL('valueChanged(int)'), SLOT('display(int)')); + this->connect(slider, SIGNAL('valueChanged(int)'), SIGNAL('valueChanged(int)')); + + setFocusProxy(slider); +} + +sub value { slider->value } + +sub setValue { slider->setValue(shift) } + +sub setRange { + my($minVal, $maxVal) = @_; + if($minVal < 0 || $maxVal > 99 || $minVal > $maxVal) { + warn "LCDRange::setRange($minVal,$maxVal)\n" . + "\tRange must be 0..99\n" . + "\tand minVal must not be greater than maxVal\n"; + return; + } + slider->setRange($minVal, $maxVal); +} + +1; diff --git a/PerlQt/tutorials/t8/t8.pl b/PerlQt/tutorials/t8/t8.pl new file mode 100644 index 0000000..51967ca --- /dev/null +++ b/PerlQt/tutorials/t8/t8.pl @@ -0,0 +1,49 @@ +#!/usr/bin/perl -w +use strict; +use blib; + +package MyWidget; +use strict; +use Qt; +use Qt::isa qw(Qt::Widget); + +use LCDRange; +use CannonField; + +sub NEW { + shift->SUPER::NEW(@_); + + my $quit = Qt::PushButton("Quit", this, "quit"); + $quit->setFont(Qt::Font("Times", 18, &Qt::Font::Bold)); + + Qt::app->connect($quit, SIGNAL('clicked()'), SLOT('quit()')); + + my $angle = LCDRange(this, "angle"); + $angle->setRange(5, 70); + + my $cannonField = CannonField(this, "cannonField"); + + $cannonField->connect($angle, SIGNAL('valueChanged(int)'), SLOT('setAngle(int)')); + $angle->connect($cannonField, SIGNAL('angleChanged(int)'), SLOT('setValue(int)')); + + my $grid = Qt::GridLayout(this, 2, 2, 10); + $grid->addWidget($quit, 0, 0); + $grid->addWidget($angle, 1, 0, &AlignTop); + $grid->addWidget($cannonField, 1, 1); + $grid->setColStretch(1, 10); + + $angle->setValue(60); + $angle->setFocus(); +} + +package main; +use Qt; +use MyWidget; + +my $a = Qt::Application(\@ARGV); + +my $w = MyWidget; +$w->setGeometry(100, 100, 500, 355); +$a->setMainWidget($w); +$w->show; +exit $a->exec; diff --git a/PerlQt/tutorials/t9/CannonField.pm b/PerlQt/tutorials/t9/CannonField.pm new file mode 100644 index 0000000..e12489a --- /dev/null +++ b/PerlQt/tutorials/t9/CannonField.pm @@ -0,0 +1,48 @@ +package CannonField; +use strict; +use Qt; +use Qt::isa qw(Qt::Widget); +use Qt::signals + angleChanged => ['int']; +use Qt::slots + setAngle => ['int']; +use Qt::attributes qw( + ang +); +use POSIX qw(atan); + +sub angle () { ang } + +sub NEW { + shift->SUPER::NEW(@_); + + ang = 45; + setPalette(Qt::Palette(Qt::Color(250, 250, 200))); +} + +sub setAngle { + my $degrees = shift; + $degrees = 5 if $degrees < 5; + $degrees = 70 if $degrees > 70; + return if ang == $degrees; + ang = $degrees; + repaint(); + emit angleChanged(ang); +} + +sub paintEvent { + my $p = Qt::Painter(this); + $p->setBrush(&blue); + $p->setPen(&NoPen); + + $p->translate(0, rect()->bottom); + $p->drawPie(Qt::Rect(-35, -35, 70, 70), 0, 90*16); + $p->rotate(- ang); + $p->drawRect(Qt::Rect(33, -4, 15, 8)); +} + +sub sizePolicy { + Qt::SizePolicy(&Qt::SizePolicy::Expanding, &Qt::SizePolicy::Expanding); +} + +1; diff --git a/PerlQt/tutorials/t9/LCDRange.pm b/PerlQt/tutorials/t9/LCDRange.pm new file mode 100644 index 0000000..be0f8ec --- /dev/null +++ b/PerlQt/tutorials/t9/LCDRange.pm @@ -0,0 +1,43 @@ +package LCDRange; +use strict; +use Qt; +use Qt::isa qw(Qt::VBox); +use Qt::slots + setValue => ['int'], + setRange => ['int', 'int']; +use Qt::signals + valueChanged => ['int']; +use Qt::attributes qw( + slider +); + +sub NEW { + shift->SUPER::NEW(@_); + + my $lcd = Qt::LCDNumber(2, this, "lcd"); + + slider = Qt::Slider(&Horizontal, this, "slider"); + slider->setRange(0, 99); + slider->setValue(0); + $lcd->connect(slider, SIGNAL('valueChanged(int)'), SLOT('display(int)')); + this->connect(slider, SIGNAL('valueChanged(int)'), SIGNAL('valueChanged(int)')); + + setFocusProxy(slider); +} + +sub value { slider->value } + +sub setValue { slider->setValue(shift) } + +sub setRange { + my($minVal, $maxVal) = @_; + if($minVal < 0 || $maxVal > 99 || $minVal > $maxVal) { + warn "LCDRange::setRange($minVal,$maxVal)\n" . + "\tRange must be 0..99\n" . + "\tand minVal must not be greater than maxVal\n"; + return; + } + slider->setRange($minVal, $maxVal); +} + +1; diff --git a/PerlQt/tutorials/t9/t9.pl b/PerlQt/tutorials/t9/t9.pl new file mode 100644 index 0000000..192041c --- /dev/null +++ b/PerlQt/tutorials/t9/t9.pl @@ -0,0 +1,50 @@ +#!/usr/bin/perl -w +use strict; +use blib; + +package MyWidget; +use strict; +use Qt; +use Qt::isa qw(Qt::Widget); + +use LCDRange; +use CannonField; + +sub NEW { + shift->SUPER::NEW(@_); + + my $quit = Qt::PushButton("&Quit", this, "quit"); + $quit->setFont(Qt::Font("Times", 18, &Qt::Font::Bold)); + + Qt::app->connect($quit, SIGNAL('clicked()'), SLOT('quit()')); + + my $angle = LCDRange(this, "angle"); + $angle->setRange(5, 70); + + my $cannonField = CannonField(this, "cannonField"); + + $cannonField->connect($angle, SIGNAL('valueChanged(int)'), SLOT('setAngle(int)')); + $angle->connect($cannonField, SIGNAL('angleChanged(int)'), SLOT('setValue(int)')); + + my $grid = Qt::GridLayout(this, 2, 2, 10); + $grid->addWidget($quit, 0, 0); + $grid->addWidget($angle, 1, 0, &AlignTop); + $grid->addWidget($cannonField, 1, 1); + $grid->setColStretch(1, 10); + + $angle->setValue(60); + $angle->setFocus(); +} + +package main; +use Qt; +use MyWidget; + +Qt::Application::setColorSpec(&Qt::Application::CustomColor); +my $a = Qt::Application(\@ARGV); + +my $w = MyWidget; +$w->setGeometry(100, 100, 500, 355); +$a->setMainWidget($w); +$w->show; +exit $a->exec; |