diff options
Diffstat (limited to 'PerlQt')
82 files changed, 0 insertions, 13166 deletions
diff --git a/PerlQt/INSTALL b/PerlQt/INSTALL deleted file mode 100644 index bad4e4a..0000000 --- a/PerlQt/INSTALL +++ /dev/null @@ -1,82 +0,0 @@ -PerlTQt is distributed under the GPL. Development is coordinated on the [email protected] mailing-list. To subscribe, visit -http://mail.kde.org/mailman/listinfo/kde-perl or send a subscribe message -to [email protected]. Please send patches and bug reports -to the mailing-list. - -This file contains instructions for downloading and building the SmokeTQt -library and PerlTQt. PerlTQt is not a direct Perl interface to the TQt -library, but is rather an interface to the SmokeTQt 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) -TQt-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 $TQTDIR 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:[email protected]:/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 TQt-3.0.4. I have -TQt-3.0.1, so I have to re-generate the files to match my installed -version of TQt. Here's how to do it. - -$ cd smoke/qt # kdebindings/smoke/qt/ -$ perl ./qtguess.pl # simple script to find disabled TQt features -$ perl ./generate.pl # calls kalyptus which generates code - -Now you have the SmokeTQt source-code generated for your personal TQt -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 PerlTQt. First, get the latest version of PerlTQt-3. - -$ export CVSROOT=:pserver:[email protected]:/cvsroot/perlqt -$ cvs login # no password -$ cvs co PerlTQt-3 -$ cd PerlTQt-3 # PerlTQt-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 PerlTQt is built on your system. To test it out: - -$ cd tutorials # PerlTQt-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, PerlTQt 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 <[email protected]> diff --git a/PerlQt/MANIFEST b/PerlQt/MANIFEST deleted file mode 100644 index 53d07ac..0000000 --- a/PerlQt/MANIFEST +++ /dev/null @@ -1,82 +0,0 @@ -INSTALL -MANIFEST -Makefile.PL.in -TQt.pm -TQt.xs -TQt.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/TQt/attributes.pm -lib/TQt/debug.pm -lib/TQt/enumerations.pm -lib/TQt/isa.pm -lib/TQt/constants.pm -lib/TQt/properties.pm -lib/TQt/signals.pm -lib/TQt/slots.pm -lib/TQt/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 deleted file mode 100644 index e4009db..0000000 --- a/PerlQt/Makefile.PL.in +++ /dev/null @@ -1,223 +0,0 @@ - -### 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='TQt$(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' => 'TQt', - 'VERSION_FROM' => 'TQt.pm', # finds $VERSION - 'PRERETTQ_PM' => {}, # e.g., Module::Name => 1.1, - 'INC' => '@all_includes@ -I. -I../smoke', - 'LIBS' => ['@all_libraries@'." -L$localsmoke -lsmokeqt ".'@LIBCRYPT@'." $qtlib"], -# 'XS' => {'TQt.xs' => 'TQt.cpp'}, # does not work ... still expects TQt.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 TQt toolkit", - 'dynamic_lib' => {'OTHERLDFLAGS' => $rpath}, - ($] >= 5.005 ? ## Add these new keywords supported since 5.005 - ( - AUTHOR => 'Ashley Winters <[email protected]>') : ()), -); - -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, ">TQt.pod") or die "couldn't write TQt.pod: $!\n"; -print IN <<STOP; - -=head1 NAME - -PerlTQt - Perl interface to the TQt GUI Widget toolkit - -=head1 TQt - -Given the huge size of the TQt 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 PerlTQt API introspector - -=item * pqtsh: - -a graphical PerlTQt shell - -=back - -and a detailed B<tutorial> with comprehensive -explanations. -This is where anyone new to PerlTQt -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 PerlTQt team - -http://perlqt.sf.net - PerlTQt Project Homepage - -=cut -STOP -close IN; - diff --git a/PerlQt/Qt.pm b/PerlQt/Qt.pm deleted file mode 100644 index 69bcbca..0000000 --- a/PerlQt/Qt.pm +++ /dev/null @@ -1,1109 +0,0 @@ -package TQt::base; -use strict; - -sub this () {} - -sub new { - no strict 'refs'; - my $t = this; - shift->NEW(@_); - my $ret = this; - TQt::_internal::setThis($t); - return $ret; -} - -package TQt::base::_overload; -use strict; - -no strict 'refs'; -use overload - "fallback" => 1, - "==" => "TQt::base::_overload::op_equal", - "!=" => "TQt::base::_overload::op_not_equal", - "+=" => "TQt::base::_overload::op_plus_equal", - "-=" => "TQt::base::_overload::op_minus_equal", - "*=" => "TQt::base::_overload::op_mul_equal", - "/=" => "TQt::base::_overload::op_div_equal", - ">>" => "TQt::base::_overload::op_shift_right", - "<<" => "TQt::base::_overload::op_shift_left", - "<=" => "TQt::base::_overload::op_lesser_equal", - ">=" => "TQt::base::_overload::op_greater_equal", - "^=" => "TQt::base::_overload::op_xor_equal", - "|=" => "TQt::base::_overload::op_or_equal", - ">" => "TQt::base::_overload::op_greater", - "<" => "TQt::base::_overload::op_lesser", - "+" => "TQt::base::_overload::op_plus", - "-" => "TQt::base::_overload::op_minus", - "*" => "TQt::base::_overload::op_mul", - "/" => "TQt::base::_overload::op_div", - "^" => "TQt::base::_overload::op_xor", - "|" => "TQt::base::_overload::op_or", - "--" => "TQt::base::_overload::op_decrement", - "++" => "TQt::base::_overload::op_increment", - "neg"=> "TQt::base::_overload::op_negate"; - -sub op_equal { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator=='; - my $autoload = ref($_[0])."::_UTOLOAD"; - my ($ret, $err); - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - $TQt::_internal::strictArgMatch = 0; - return $ret unless $err = $@; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator=='; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - die $err.$@ if $@; - $ret -} - -sub op_not_equal { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator!='; - my $autoload = ref($_[0])."::_UTOLOAD"; - my ($ret, $err); - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - $TQt::_internal::strictArgMatch = 0; - return $ret unless $err = $@; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator!='; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - die $err.$@ if $@; - $ret -} - -sub op_plus_equal { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator+='; - my $autoload = ref($_[0])."::_UTOLOAD"; - my $err; - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - $TQt::_internal::strictArgMatch = 0; - return ($_[2] ? $_[1] : $_[0]) unless $err = $@; - my $ret; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator+='; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - die $err.$@ if $@; - $ret -} - -sub op_minus_equal { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator-='; - my $autoload = ref($_[0])."::_UTOLOAD"; - my $err; - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - $TQt::_internal::strictArgMatch = 0; - return ($_[2] ? $_[1] : $_[0]) unless $err = $@; - my $ret; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator-='; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - die $err.$@ if $@; - $ret -} - -sub op_mul_equal { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator*='; - my $autoload = ref($_[0])."::_UTOLOAD"; - my $err; - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - $TQt::_internal::strictArgMatch = 0; - return ($_[2] ? $_[1] : $_[0]) unless $err = $@; - my $ret; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator*='; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - die $err.$@ if $@; - $ret -} - -sub op_div_equal { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator/='; - my $autoload = ref($_[0])."::_UTOLOAD"; - my $err; - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - $TQt::_internal::strictArgMatch = 0; - return ($_[2] ? $_[1] : $_[0]) unless $err = $@; - my $ret; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator/='; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - die $err.$@ if $@; - $ret -} - -sub op_shift_right { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator>>'; - my $autoload = ref($_[0])."::_UTOLOAD"; - my ($ret, $err); - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - $TQt::_internal::strictArgMatch = 0; - return $ret unless $err = $@; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator>>'; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - die $err.$@ if $@; - $ret -} - -sub op_shift_left { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator<<'; - my $autoload = ref($_[0])."::_UTOLOAD"; - my ($ret, $err); - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - $TQt::_internal::strictArgMatch = 0; - return $ret unless $err = $@; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator<<'; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - die $err.$@ if $@; - $ret -} - -sub op_lesser_equal { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator<='; - my $autoload = ref($_[0])."::_UTOLOAD"; - my $err; - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - return ($_[2] ? $_[1] : $_[0]) unless $err = $@; - $TQt::_internal::strictArgMatch = 0; - my $ret; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator<='; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - die $err.$@ if $@; - $ret -} - -sub op_greater_equal { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator>='; - my $autoload = ref($_[0])."::_UTOLOAD"; - my $err; - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - $TQt::_internal::strictArgMatch = 0; - return ($_[2] ? $_[1] : $_[0]) unless $err = $@; - my $ret; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator>='; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - die $err.$@ if $@; - $ret -} - -sub op_xor_equal { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator^='; - my $autoload = ref($_[0])."::_UTOLOAD"; - my $err; - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - $TQt::_internal::strictArgMatch = 0; - return ($_[2] ? $_[1] : $_[0]) unless $err = $@; - my $ret; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator^='; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - die $err.$@ if $@; - $ret -} - -sub op_or_equal { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator|='; - my $autoload = ref($_[0])."::_UTOLOAD"; - my $err; - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - $TQt::_internal::strictArgMatch = 0; - return ($_[2] ? $_[1] : $_[0]) unless $err = $@; - my $ret; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator|='; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - die $err.$@ if $@; - $ret -} - -sub op_greater { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator>'; - my $autoload = ref($_[0])."::_UTOLOAD"; - my ($ret, $err); - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - $TQt::_internal::strictArgMatch = 0; - return $ret unless $err = $@; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator>'; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - die $err.$@ if $@; - $ret -} - -sub op_lesser { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator<'; - my $autoload = ref($_[0])."::_UTOLOAD"; - my ($ret, $err); - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - $TQt::_internal::strictArgMatch = 0; - return $ret unless $err = $@; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator<'; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - die $err.$@ if $@; - $ret -} - -sub op_plus { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator+'; - my $autoload = ref($_[0])."::_UTOLOAD"; - my ($ret, $err); - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - $TQt::_internal::strictArgMatch = 0; - return $ret unless $err = $@; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator+'; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - die $err.$@ if $@; - $ret -} - -sub op_minus { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator-'; - my $autoload = ref($_[0])."::_UTOLOAD"; - my ($ret, $err); - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - $TQt::_internal::strictArgMatch = 0; - return $ret unless $err = $@; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator-'; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - die $err.$@ if $@; - $ret -} - -sub op_mul { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator*'; - my $autoload = ref($_[0])."::_UTOLOAD"; - my ($ret, $err); - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - $TQt::_internal::strictArgMatch = 0; - return $ret unless $err = $@; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator*'; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - die $err.$@ if $@; - $ret -} - -sub op_div { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator/'; - my $autoload = ref($_[0])."::_UTOLOAD"; - my ($ret, $err); - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - $TQt::_internal::strictArgMatch = 0; - return $ret unless $err = $@; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator/'; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - die $err.$@ if $@; - $ret -} - -sub op_negate { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator-'; - my $autoload = ref($_[0])."::AUTOLOAD"; - my ($ret, $err); - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $ret = $autoload->($_[0]) }; - $TQt::_internal::strictArgMatch = 0; - return $ret unless $err = $@; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator-'; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; $ret = &$autoload($_[0]) }; - die $err.$@ if $@; - $ret -} - -sub op_xor { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator^'; - my $autoload = ref($_[0])."::_UTOLOAD"; - my ($ret, $err); - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - $TQt::_internal::strictArgMatch = 0; - return $ret unless $err = $@; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator^'; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - die $err.$@ if $@; - $ret -} - -sub op_or { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator|'; - my $autoload = ref($_[0])."::_UTOLOAD"; - my ($ret, $err); - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $ret = $autoload->(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - $TQt::_internal::strictArgMatch = 0; - return $ret unless $err = $@; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator|'; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; $ret = &$autoload(($_[2] ? (@_)[1,0] : (@_)[0,1])) }; - die $err.$@ if $@; - $ret -} - -sub op_increment { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator++'; - my $autoload = ref($_[0])."::_UTOLOAD"; - my $err; - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $autoload->($_[0]) }; - $TQt::_internal::strictArgMatch = 0; - return $_[0] unless $err = $@; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator++'; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; &$autoload($_[0]) }; - die $err.$@ if $@; - $_[0] -} - -sub op_decrement { - $TQt::AutoLoad::AUTOLOAD = ref($_[0]).'::operator--'; - my $autoload = ref($_[0])."::_UTOLOAD"; - my $err; - $TQt::_internal::strictArgMatch = 1; - eval { local $SIG{'__DIE__'}; $autoload->($_[0]) }; - $TQt::_internal::strictArgMatch = 0; - return $_[0] unless $err = $@; - $TQt::AutoLoad::AUTOLOAD = 'TQt::GlobalSpace::operator--'; - $autoload = "TQt::GlobalSpace::_UTOLOAD"; - eval { local $SIG{'__DIE__'}; &$autoload($_[0]) }; - die $err.$@ if $@; - $_[0] -} - -package TQt::_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])/TQt::/; - my $classId = TQt::_internal::idClass($c); - insert_pclassid($class, $classId); - - $IdClass[$classId] = $class; - $CppName{$class} = $c; - TQt::_internal::installautoload("$class"); - { - package TQt::AutoLoad; # this package holds $AUTOLOAD - my $closure = \&{ "$class\::_UTOLOAD" }; - *{ $class . "::AUTOLOAD" } = sub{ &$closure }; - } - - my @isa = TQt::_internal::getIsa($classId); - for my $super (@isa) { - $super =~ s/^Q(?=[A-Z])/TQt::/; - } - # the general base class is TQt::base. - # implicit new(@_) calls are forwarded there. - @isa = ("TQt::base") unless @isa; - *{ "$class\::ISA" } = \@isa; - - TQt::_internal::installautoload(" $class"); - { - package TQt::AutoLoad; - # do lookup at compile-time - my $autosub = \&{ " $class\::_UTOLOAD" }; - *{ " $class\::AUTOLOAD" } = sub { &$autosub }; - } - - *{ " $class\::ISA" } = ["TQt::base::_overload"]; - - *{ "$class\::NEW" } = sub { - my $class = shift; - $TQt::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)|TQByteArray)[*&]?)$/) { - # the below read as: is it a (Q(C)String) ? ->priority 1 - # is it a (TQString) ? -> 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\ TQCOORD\*| - (?:const\ )? - (?: - Q(?:String|Widget|Object|FileInfo|CanvasItem)List[\*&]?| - TQValueList<int>[\*&]?| - TQPtrList<Q(?:Tab|ToolBar|DockWindow|NetworkOperation)>| - TQRgb\*| - 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('TQGlobalSpace', $_) } @methods -# if (!@methodids and $withObject || $class eq 'TQt'); - - 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() & $TQt::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() & $TQt::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() & $TQt::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() & $TQt::debug::channel{'ambiguous'}); - @_ = () - } if @methodids; - } - do{ - my $verbose = ""; - if(debug() && (debug() & $TQt::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("TQt::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 TQt::Application::NEW { - my $class = shift; - my $argv = shift; - unshift @$argv, $0; - my $count = scalar @$argv; - setThis( bless TQt::Application::TQApplication($count, $argv, @_), " $class" ); - mapObject(this); - setAllocated(this, 1); - setqapp(this); - shift @$argv; -} - -sub TQt::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 - $TQt::AutoLoad::AUTOLOAD = 'TQt::Image::TQImage'; - my $autoload = " TQt::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_TQUParameter($arg->{name}, $arg->{type}, 0, 1); - } - my $method = make_TQUMethod($entry->{name}, \@params); - push @tbl, make_TQMetaData($entry->{prototype}, $method); - } - my $count = scalar @tbl; - my $metadata = make_TQMetaData_tbl(\@tbl); - return ($metadata, $count); -} - -# This is the key function for signal/slots... -# All META hash entries have been defined by /lib/TQt/slots.pm and /lib/TQt/signals.pm -# Thereafter, /lib/TQt/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, TQt::this()->staticMetaObject, - $slot_tbl, $slot_tbl_count, - $signal_tbl, $signal_tbl_count); - $meta->{changed} = 0; - return $meta->{object}; -} - -sub updateSigSlots -{ - require TQt::signals; - require TQt::slots; - for my $i (@sigslots) { - no strict 'refs'; - my $mod = "TQt::" . 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} }; - TQt::_internal::installsignal("$class\::$ssn"); - } - } - TQt::_internal::installqt_invoke($class . '::qt_invoke') - if( !defined &{ $class. '::qt_invoke' } && exists $meta->{slots} && @{ $meta->{slots} }); - TQt::_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 = TQt::_internal::getIsa( $classId ); - for my $s( @classes ) - { - my $c = TQt::_internal::idClass($s); - push @{ $res }, $c; - getAllParents($c, $res) - } -} - -sub TQt::PointArray::setPoints { - my $points = $_[0]; - no strict 'refs'; - # what a horrible, horrible way to do this - $TQt::AutoLoad::AUTOLOAD = 'TQt::PointArray::setPoints'; - my $autoload = " TQt::PointArray::_UTOLOAD"; - dontRecurse(); - $autoload->(scalar(@$points)/2, $points); -} - -sub TQt::GridLayout::addMultiCellLayout { - # yet another hack. Turnaround for a bug in TQt < 3.1 - # (addMultiCellLayout doesn't reparent its TQLayout argument) - no strict 'refs'; - if(!defined $_[0]->{'has been hidden'}) - { - push @{ this()->{'hidden children'} }, $_[0]; - $_[0]->{'has been hidden'} = 1; - } - $TQt::AutoLoad::AUTOLOAD = 'TQt::GridLayout::addMultiCellLayout'; - my $autoload = " TQt::GridLayout::_UTOLOAD"; - dontRecurse(); - $autoload->(@_); -} - -package TQt::Object; -use strict; - -sub MODIFY_CODE_ATTRIBUTES -{ - package TQt::_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 TQt; - -use 5.006; -use strict; -use warnings; -use XSLoader; - -require Exporter; - -our $VERSION = '3.008'; - -our @EXPORT = qw(&TQT_SIGNAL &TQT_SLOT &CAST &emit &min &max); - -XSLoader::load 'TQt', $VERSION; - -# try to avoid KDE's buggy malloc -# only works for --enable-fast-malloc, -# not when --enable-fast-malloc=full -$ENV{'KDE_MALLOC'} = 0; - -TQt::_internal::init(); - -# In general, I'm not a fan of prototypes. -# However, I'm also not a fan of parentheses - -sub TQT_SIGNAL ($) { '2' . $_[0] } -sub TQT_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 TQt::base::ON_DESTROY { 0 }; - -sub TQt::Object::ON_DESTROY -{ - package TQt::_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 TQt::Application::ON_DESTROY { 0 } - -# we need to solve an ambiguity for Q*Items: they aren't TQObjects, -# 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 TQObject 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 TQt::ListViewItem::ON_DESTROY { - package TQt::_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 TQt::ListViewItem::takeItem -{ - package TQt::_internal; - delete ${ this()->{"hidden children"} } { sv_to_ptr($_[0]) }; - delete $_[0]->{"has been hidden"}; - setAllocated( $_[0], 1 ); - no strict 'refs'; - $TQt::AutoLoad::AUTOLOAD = 'TQt::ListViewItem::takeItem'; - my $autoload = " TQt::ListViewItem::_UTOLOAD"; - dontRecurse(); - $autoload->( $_[0] ); -} - -sub TQt::ListView::takeItem -{ - package TQt::_internal; - delete ${ this()->{"hidden children"} } { sv_to_ptr($_[0]) }; - delete $_[0]->{"has been hidden"}; - setAllocated( $_[0], 1 ); - no strict 'refs'; - $TQt::AutoLoad::AUTOLOAD = 'TQt::ListView::takeItem'; - my $autoload = " TQt::ListView::_UTOLOAD"; - dontRecurse(); - $autoload->( $_[0] ); -} - -sub TQt::IconViewItem::ON_DESTROY -{ - package TQt::_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 TQt::IconView::takeItem -{ - package TQt::_internal; - delete ${ this()->{"hidden children"} } { sv_to_ptr($_[0]) }; - delete $_[0]->{"has been hidden"}; - setAllocated( $_[0], 1 ); - no strict 'refs'; - $TQt::AutoLoad::AUTOLOAD = 'TQt::IconView::takeItem'; - my $autoload = " TQt::IconView::_UTOLOAD"; - TQt::_internal::dontRecurse(); - $autoload->( $_[0] ); -} - - -sub TQt::ListBoxItem::ON_DESTROY -{ - package TQt::_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 TQt::ListBox::takeItem -{ - # Unfortunately, takeItem() won't reset the Item's listBox() pointer to 0. - # That's a TQt bug (I reported it and it got fixed as of TQt 3.2b2) - package TQt::_internal; - delete ${ this()->{"hidden children"} } { sv_to_ptr($_[0]) }; - delete $_[0]->{"has been hidden"}; - setAllocated( $_[0], 1 ); - no strict 'refs'; - $TQt::Autoload::AUTOLOAD = 'TQt::ListBox::takeItem'; - my $autoload = " TQt::ListBox::_UTOLOAD"; - dontRecurse(); - $autoload->( $_[0] ); -} - -sub TQt::TableItem::ON_DESTROY -{ - package TQt::_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 TQt::Table::takeItem -{ - package TQt::_internal; - delete ${ this()->{"hidden children"} } { sv_to_ptr($_[0]) }; - delete $_[0]->{"has been hidden"}; - setAllocated( $_[0], 1 ); - no strict 'refs'; - $TQt::AutoLoad::AUTOLOAD = 'TQt::Table::takeItem'; - my $autoload = " TQt::Table::_UTOLOAD"; - dontRecurse(); - $autoload->( $_[0] ); -} - -sub TQt::LayoutItem::ON_DESTROY -{ - package TQt::_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 TQt::Layout::ON_DESTROY -{ - package TQt::_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 TQt::StyleSheetItem::ON_DESTROY -{ - package TQt::_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 TQt::SqlCursor::ON_DESTROY -{ - package TQt::_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 deleted file mode 100644 index 2feceeb..0000000 --- a/PerlQt/Qt.pod +++ /dev/null @@ -1,42 +0,0 @@ - -=head1 NAME - -PerlTQt - Perl interface to the TQt GUI Widget toolkit - -=head1 TQt - -Given the huge size of the TQt 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 PerlTQt API introspector - -=item * pqtsh: - -a graphical PerlTQt shell - -=back - -and a detailed B<tutorial> with comprehensive -explanations. -This is where anyone new to PerlTQt -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 PerlTQt team - -http://perlqt.sf.net - PerlTQt Project Homepage - -=cut diff --git a/PerlQt/Qt.xs b/PerlQt/Qt.xs deleted file mode 100644 index 22a66de..0000000 --- a/PerlQt/Qt.xs +++ /dev/null @@ -1,2198 +0,0 @@ -#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 TQT_VERSION_STR -#define TQT_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 TQAsciiDict<Smoke::Index> *methcache = 0; -static TQAsciiDict<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_TQUType, where $types is join('|', qw(bool int double char* TQString); - * - * 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_TQString -}; - -struct MocArgument { - // smoke object and associated typeid - SmokeType st; - MocArgumentType argType; -}; - - -extern TypeHandler TQt_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 isTQObject(Smoke *smoke, Smoke::Index classId) { - if(!strcmp(smoke->classes[classId].className, "TQObject")) - return true; - for(Smoke::Index *p = smoke->inheritanceList + smoke->classes[classId].parents; - *p; - p++) { - if(isTQObject(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_TQt_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 UnencapsulatedTQObject : public TQObject { -public: - TQConnectionList *public_receivers(int signal) const { return receivers(signal); } - void public_activate_signal(TQConnectionList *clist, TQUObject *o) { activate_signal(clist, o); } -}; - -class EmitSignal : public Marshall { - UnencapsulatedTQObject *_qobj; - int _id; - MocArgument *_args; - SV **_sp; - int _items; - int _cur; - Smoke::Stack _stack; - bool _called; -public: - EmitSignal(TQObject *qobj, int id, int items, MocArgument *args, SV **sp) : - _qobj((UnencapsulatedTQObject*)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; - - TQConnectionList *clist = _qobj->public_receivers(_id); - if(!clist) return; - - TQUObject *o = new TQUObject[_items + 1]; - for(int i = 0; i < _items; i++) { - TQUObject *po = o + i + 1; - Smoke::StackItem *si = _stack + i; - switch(_args[i].argType) { - case xmoc_bool: - static_TQUType_bool.set(po, si->s_bool); - break; - case xmoc_int: - static_TQUType_int.set(po, si->s_int); - break; - case xmoc_double: - static_TQUType_double.set(po, si->s_double); - break; - case xmoc_charstar: - static_TQUType_charstar.set(po, (char*)si->s_voidp); - break; - case xmoc_TQString: - static_TQUType_TQString.set(po, *(TQString*)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_TQUType_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 { - TQObject *_qobj; - GV *_gv; - int _items; - MocArgument *_args; - TQUObject *_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++) { - TQUObject *o = _o + i + 1; - switch(_args[i].argType) { - case xmoc_bool: - _stack[i].s_bool = static_TQUType_bool.get(o); - break; - case xmoc_int: - _stack[i].s_int = static_TQUType_int.get(o); - break; - case xmoc_double: - _stack[i].s_double = static_TQUType_double.get(o); - break; - case xmoc_charstar: - _stack[i].s_voidp = static_TQUType_charstar.get(o); - break; - case xmoc_TQString: - _stack[i].s_voidp = &static_TQUType_TQString.get(o); - break; - default: // case xmoc_ptr: - { - const SmokeType &t = _args[i].st; - void *p = static_TQUType_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(TQObject *qobj, GV *gv, int items, MocArgument *args, TQUObject *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 TQtSmokeBinding : public SmokeBinding { -public: - TQtSmokeBinding(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, " TQt::"); - 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 isTQt(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("TQt::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( isTQt(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 TQt 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 TQt 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("TQt::_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; - TQMetaObject *metaobject = (TQMetaObject*)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; - TQMetaObject *metaobject = (TQMetaObject*)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); - TQObject *qobj = (TQObject*)o->smoke->cast( - o->ptr, - o->classId, - o->smoke->idClass("TQObject") - ); - 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, TQUObject *o - int id = SvIV(ST(0)); - TQUObject *_o = (TQUObject*)SvIV(SvRV(ST(1))); - - smokeperl_object *o = sv_obj_info(sv_this); - TQObject *qobj = (TQObject*)o->smoke->cast( - o->ptr, - o->classId, - o->smoke->idClass("TQObject") - ); - - // 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 = TQt PACKAGE = TQt::_internal::TQString -PROTOTYPES: DISABLE - -SV* -FETCH(obj) - SV* obj - CODE: - if (!SvROK(obj)) - croak("?"); - IV tmp = SvIV((SV*)SvRV(obj)); - TQString *s = (TQString*) 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)); - TQString *s = (TQString*) tmp; - s->truncate(0); - if(SvOK(what)) { - if(SvUTF8(what)) - s->append(TQString::fromUtf8(SvPV_nolen(what))); - else if(IN_LOCALE) - s->append(TQString::fromLocal8Bit(SvPV_nolen(what))); - else - s->append(TQString::fromLatin1(SvPV_nolen(what))); - } - -void -DESTROY(obj) - SV* obj - CODE: - if (!SvROK(obj)) - croak("?"); - IV tmp = SvIV((SV*)SvRV(obj)); - TQString *s = (TQString*) tmp; - delete s; - -MODULE = TQt PACKAGE = TQt::_internal::TQByteArray -PROTOTYPES: DISABLE - -SV* -FETCH(obj) - SV* obj - CODE: - if (!SvROK(obj)) - croak("?"); - IV tmp = SvIV((SV*)SvRV(obj)); - TQByteArray *s = (TQByteArray*) 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)); - TQByteArray *s = (TQByteArray*) 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)); - TQByteArray *s = (TQByteArray*) tmp; - delete s; - -MODULE = TQt PACKAGE = TQt::_internal::TQRgbStar -PROTOTYPES: DISABLE - -SV* -FETCH(obj) - SV* obj - CODE: - if (!SvROK(obj)) - croak("?"); - IV tmp = SvIV((SV*)SvRV(obj)); - TQRgb *s = (TQRgb*) 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)); - TQRgb *s = (TQRgb*) tmp; - if(!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV || - av_len((AV*)SvRV(sv)) < 0) { - s = new TQRgb[1]; - s[0] = 0; - sv_setref_pv(obj, "TQt::_internal::TQRgbStar", (void*)s); - return; - } - AV *list = (AV*)SvRV(sv); - int count = av_len(list); - s = new TQRgb[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, "TQt::_internal::TQRgbStar", (void*)s); - -void -DESTROY(obj) - SV* obj - CODE: - if (!SvROK(obj)) - croak("?"); - IV tmp = SvIV((SV*)SvRV(obj)); - TQRgb *s = (TQRgb*) tmp; - delete[] s; - -# --------------- XSUBS for TQt::_internal::* helpers ---------------- - - -MODULE = TQt PACKAGE = TQt::_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, "TQString")) - arg[idx].argType = xmoc_TQString; - 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_TQUParameter(name, type, extra, inout) - char *name - char *type - SV *extra - int inout - CODE: - TQUParameter *p = new TQUParameter; - p->name = new char[strlen(name) + 1]; - strcpy((char*)p->name, name); - if(!strcmp(type, "bool")) - p->type = &static_TQUType_bool; - else if(!strcmp(type, "int")) - p->type = &static_TQUType_int; - else if(!strcmp(type, "double")) - p->type = &static_TQUType_double; - else if(!strcmp(type, "char*") || !strcmp(type, "const char*")) - p->type = &static_TQUType_charstar; - else if(!strcmp(type, "TQString") || !strcmp(type, "TQString&") || - !strcmp(type, "const TQString") || !strcmp(type, "const TQString&")) - p->type = &static_TQUType_TQString; - else - p->type = &static_TQUType_ptr; - // Lacking support for several types. Evil. - p->inOut = inout; - p->typeExtra = 0; - RETVAL = (void*)p; - OUTPUT: - RETVAL - -void * -make_TQMetaData(name, method) - char *name - void *method - CODE: - TQMetaData *m = new TQMetaData; // will be deleted - m->name = new char[strlen(name) + 1]; - strcpy((char*)m->name, name); - m->method = (TQUMethod*)method; - m->access = TQMetaData::Public; - RETVAL = m; - OUTPUT: - RETVAL - -void * -make_TQUMethod(name, params) - char *name - SV *params - CODE: - TQUMethod *m = new TQUMethod; // 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 TQUParameter[m->count]; - for(int i = 0; i < m->count; i++) { - SV *sv = av_shift(av); - if(!SvOK(sv)) - croak("Invalid paramater for TQUMethod\n"); - TQUParameter *p = (TQUParameter*)SvIV(sv); - SvREFCNT_dec(sv); - ((TQUParameter*)m->parameters)[i] = *p; - delete p; - } - } else - m->count = 0; - } - RETVAL = m; - OUTPUT: - RETVAL - -void * -make_TQMetaData_tbl(list) - SV *list - CODE: - RETVAL = 0; - if(SvOK(list) && SvRV(list)) { - AV *av = (AV*)SvRV(list); - int count = av_len(av) + 1; - TQMetaData *m = new TQMetaData[count]; - for(int i = 0; i < count; i++) { - SV *sv = av_shift(av); - if(!SvOK(sv)) - croak("Invalid metadata\n"); - TQMetaData *old = (TQMetaData*)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"); - TQMetaObject *meta = TQMetaObject::new_metaobject( - className, (TQMetaObject*)po->ptr, - (const TQMetaData*)slot_tbl, slot_count, // slots - (const TQMetaData*)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("TQMetaObject"); - 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 TQt::Application object. Couldn't set TQt::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; } - TQObject *qobj = (TQObject*)o->smoke->cast(o->ptr, o->classId, o->smoke->idClass("TQObject")); - 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 -isTQObject(obj) - SV *obj - CODE: - RETVAL = 0; - smokeperl_object *o = sv_obj_info(obj); - if(o && isTQObject(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 TQt:: ----------------- - -MODULE = TQt PACKAGE = TQt - -SV * -this() - CODE: - RETVAL = newSVsv(sv_this); - OUTPUT: - RETVAL - -SV * -app() - CODE: - RETVAL = newRV_inc(sv_qapp); - OUTPUT: - RETVAL - -SV * -version() - CODE: - RETVAL = newSVpv(TQT_VERSION_STR,0); - OUTPUT: - RETVAL - -BOOT: - init_qt_Smoke(); - qt_Smoke->binding = new TQtSmokeBinding(qt_Smoke); - install_handlers(TQt_handlers); - pointer_map = newHV(); - sv_this = newSV(0); - methcache = new TQAsciiDict<Smoke::Index>(1187); - classcache = new TQAsciiDict<Smoke::Index>(827); - methcache->setAutoDelete(1); - classcache->setAutoDelete(1); diff --git a/PerlQt/bin/pqtapi b/PerlQt/bin/pqtapi deleted file mode 100755 index 338d600..0000000 --- a/PerlQt/bin/pqtapi +++ /dev/null @@ -1,82 +0,0 @@ -#!/usr/bin/perl - -# Note: this program is part of PerlTQt 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 TQt::_internal; -use TQt; - -exists $o{'v'} and do{ print "PerlTQt-$TQt::VERSION using TQt-".&TQt::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 TQt Designer Plugin - select(STDOUT); $| = 1; # unbuffered - while(<STDIN>) - { - chomp; - s/^Q(?=[A-Z])/TQt::/; - 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])/TQt::/; -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 PerlTQt 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 PerlTQt and TQt versions\n". - "\t-h : print this help message\n"; -} diff --git a/PerlQt/bin/pqtsh b/PerlQt/bin/pqtsh deleted file mode 100755 index ec44e43..0000000 --- a/PerlQt/bin/pqtsh +++ /dev/null @@ -1,675 +0,0 @@ -#!/usr/bin/perl - -# pqtsh : a graphical shell for PerlTQt. -# -# author: Germain Garand <[email protected]> -# license: GNU Public License v2 -# - -use utf8; -use strict 'vars'; - -package TQtShellControl; - -use TQt; -use TQt::isa qw(TQt::MainWindow); -use TQt::slots - fileOpen => [], - fileSave => [], - fileSaveAs => [], - filePrint => [], - fileExit => [], - helpExample => []; -use TQt::signals - fileNeedsEval => [TQString]; -use TQt::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", -"TQt 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", -"TQtTQtTQtTQtTQtTQt.#.a.b.b.b.b.c.c.a.a.d.aTQtTQtTQtTQt", -"TQtTQtTQtTQtTQtTQt.a.e.f.f.f.f.f.e.e.e.g.aTQtTQtTQtTQt", -"TQtTQtTQtTQtTQtTQt.a.c.c.c.b.b.c.c.c.c.a.cTQtTQtTQtTQt", -"TQtTQtTQtTQtTQtTQt.#.a.a.a.a.#.a.a.#.#.d.aTQtTQtTQtTQt", -"TQtTQtTQtTQtTQt.c.d.c.a.c.c.c.a.a.a.c.#TQtTQtTQtTQtTQt", -"TQtTQtTQtTQtTQt.a.a.#.a.a.a.a.a.a.c.c.#TQtTQtTQtTQtTQt", -"TQtTQtTQtTQtTQt.a.#.c.a.a.a.a.a.c.a.c.dTQtTQtTQtTQtTQt", -"TQtTQtTQtTQtTQt.c.a.a.a.a.a.a.a.a.a.a.#TQtTQtTQtTQtTQt", -"TQtTQtTQtTQtTQt.d.b.f.g.g.g.g.g.g.h.g.i.i.jTQtTQtTQt", -"TQtTQtTQt.a.k.l.#.h.b.h.b.h.b.h.g.g.m.n.o.p.#TQt", -"TQtTQt.a.q.r.s.t.t.t.t.t.t.t.u.v.w.x.y.z.A.o.i", -"TQt.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#fTQt", -".#.l.z.A#l.z#m#m#m#n#o#o#p#p#q#q#p#o#p#fTQtTQt", -"TQtTQt.d#r#s#s#t#p.T.T.T#u#u.z#e#e#v.o.kTQtTQtTQt"]; - - -sub NEW -{ - shift->SUPER::NEW(@_); - - my $image0 = TQt::Pixmap($image0_data); - my $image1 = TQt::Pixmap($image1_data); - my $image2 = TQt::Pixmap($image2_data); - my $image3 = TQt::Pixmap($image3_data); - my $box = VBox(this); - sessionLog = TextEdit($box, "sessionLog"); - sessionLog->setTextFormat(TQt::RichText()); - sessionLog->setReadOnly(1); - comboBox = ComboBox($box, "comboBox"); - comboBox->setEditable(1); - comboBox->setAutoCompletion(1); - this->setCentralWidget($box); - comboBox->setFocus; - this->resize(500,300); - setCaption("PerlTQt Shell"); -# fileNewAction= TQt::Action(this, "fileNewAction"); -# fileNewAction->setIconSet(TQt::IconSet($image0)); -# fileNewAction->setText(trUtf8("New")); -# fileNewAction->setMenuText(trUtf8("&New")); -# fileNewAction->setAccel(KeySequence(trUtf8("Ctrl+N"))); - fileOpenAction= TQt::Action(this, "fileOpenAction"); - fileOpenAction->setIconSet(TQt::IconSet($image1)); - fileOpenAction->setText(trUtf8("Open")); - fileOpenAction->setMenuText(trUtf8("&Open...")); - fileOpenAction->setAccel(KeySequence(trUtf8("Ctrl+O"))); - fileSaveAction= TQt::Action(this, "fileSaveAction"); - fileSaveAction->setIconSet(TQt::IconSet($image2)); - fileSaveAction->setText(trUtf8("Save")); - fileSaveAction->setMenuText(trUtf8("&Save")); - fileSaveAction->setAccel(KeySequence(trUtf8("Ctrl+S"))); - fileSaveAsAction= TQt::Action(this, "fileSaveAsAction"); - fileSaveAsAction->setText(trUtf8("Save As")); - fileSaveAsAction->setMenuText(trUtf8("Save &As...")); - fileSaveAsAction->setAccel(KeySequence(trUtf8("Ctrl+A"))); - filePrintAction= TQt::Action(this, "filePrintAction"); - filePrintAction->setIconSet(TQt::IconSet($image3)); - filePrintAction->setText(trUtf8("Print")); - filePrintAction->setMenuText(trUtf8("&Print...")); - filePrintAction->setAccel(KeySequence(trUtf8("Ctrl+P"))); - fileExitAction= TQt::Action(this, "fileExitAction"); - fileExitAction->setText(trUtf8("Exit")); - fileExitAction->setMenuText(trUtf8("E&xit")); - fileExitAction->setAccel(KeySequence(trUtf8("Ctrl+E"))); - - helpExampleAction= TQt::Action(this, "helpExampleAction"); - helpExampleAction->setText(trUtf8("Example")); - helpExampleAction->setMenuText(trUtf8("Examp&le")); - helpExampleAction->setAccel(KeySequence(trUtf8("Ctrl+L"))); - - toolBar = TQt::ToolBar("", this, DockTop()); - - toolBar->setLabel(trUtf8("Tools")); - fileOpenAction->addTo(toolBar); - fileSaveAction->addTo(toolBar); - filePrintAction->addTo(toolBar); - - - menubar= TQt::MenuBar( this, "menubar"); - - fileMenu= TQt::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= TQt::PopupMenu(this); - helpExampleAction->addTo(helpMenu); - menubar->insertItem(trUtf8("&Help"), helpMenu); - -# TQt::Object::connect(fileNewAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileNew()"); - TQt::Object::connect(fileOpenAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileOpen()"); - TQt::Object::connect(fileSaveAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileSave()"); - TQt::Object::connect(fileSaveAsAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileSaveAs()"); - TQt::Object::connect(filePrintAction, TQT_SIGNAL "activated()", this, TQT_SLOT "filePrint()"); - TQt::Object::connect(fileExitAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileExit()"); - TQt::Object::connect(helpExampleAction, TQT_SIGNAL "activated()", this, TQT_SLOT "helpExample()"); - - - executedLines = []; -} - -#sub fileNew -#{ -# print "Form1->fileNew(): Not implemented yet.\n"; -#} - -sub fileOpen -{ - my $fn = TQt::FileDialog::getOpenFileName( - ".", - "Pqtsh Session (*.pqts)", - this, - "open session", - "Choose a file to open" ); - $fn or return; - emit fileNeedsEval($fn); - -} - -sub getFileName -{ - fileName = TQt::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 { - TQt::MessageBox::critical( - this, - "Error" , - "Couldn't open $fn for writing: $!", - &TQt::MessageBox::Ok, - &TQt::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 = TQt::MessageBox::warning( - this, - "Warning" , - "File exists, overwrite ?", - &TQt::MessageBox::Yes, - &TQt::MessageBox::No ); - } - else - { $cond = 0 } - } - goto AGAIN if $cond and $doit == &TQt::MessageBox::No; - save($fn) -} - -sub filePrint -{ - my $Margin = 10; - my $pageNo = 1; - emptySession() and return; - printer = TQt::Printer unless printer; - if ( printer->setup(this) ) { - statusBar()->message( "Printing..." ); - my $p = TQt::Painter; - if( !$p->begin( printer ) ) - { - statusBar()->message( "An error occured..." ); - return - } - - $p->setFont( sessionLog->font() ); - my $yPos = 0; - my $fm = $p->fontMetrics; - my $metrics = TQt::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 TQt::app()->quit() if confirmExit(); -} - -sub closeEvent -{ - my $e = shift; - if(confirmExit()) - { - $e->accept - } - else - { - $e->ignore - } -} - -sub confirmExit -{ - my $doit; - if(@{ &executedLines }) - { - $doit = TQt::MessageBox::warning( - this, - "Warning" , - "A session is opened, quit anyway ?", - &TQt::MessageBox::Yes, - &TQt::MessageBox::No ); - } - else - { return 1 } - - return (($doit == &TQt::MessageBox::No) ? 0 : 1); -} - -sub emptySession -{ - unless (@{ &executedLines }) - { - statusBar()->message("Session is empty...", 3000); - return 1; - } - 0 -} - -sub helpExample -{ - emit fileNeedsEval("__DATA__") -} - -1; - -package TQtShell; - -use TQt; -use TQt::isa qw(TQt::MainWindow); -use TQt::slots - evalInput=>[], - evalFile=>[TQString]; -use TQt::attributes qw( - shellWindow -); -use TQtShellControl; - -sub NEW -{ - shift->SUPER::NEW(@_); - - shellWindow = TQtShellControl(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, TQT_SIGNAL 'returnPressed()', TQT_SLOT 'evalInput()'); - this->{'prompt'} = '<b><font color="blue">$></font></b>'; - setCaption("MainWindow - this"); - shellWindow->sessionLog->setText("Ready.<br>"); - TQt::Object::connect(shellWindow, TQT_SIGNAL 'fileNeedsEval(TQString)', this, TQT_SLOT 'evalFile(TQString)'); -} - -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 { - TQt::MessageBox::warning ( - this, - "Error" , - "Couldn't open $fn: $!", - &TQt::MessageBox::Ok, - &TQt::MessageBox::NoButton ); - return - }; - } - while(<$fh>) - { - evalOneLine($_) - } - close $fh -} - -1; - -package TQt::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 TQt; -use TQtShell; -use TQt::debug; - -my $app = TQt::Application(\@ARGV); -my $w = TQtShell(undef, "mainWindow"); -my $shw = $w->shellWindow; -$app->setMainWidget($shw); -tie *STDOUT, 'TQt::TextHandle', $shw->sessionLog, 'black'; -tie *STDERR, 'TQt::TextHandle', $shw->sessionLog, 'red'; - -exit $app->exec; - -__DATA__ -statusBar()->message("Hello World !"); -use TQt::attributes qw|datetime button textedit sample vbox| ; -vbox = VBox(this); -datetime = DateTimeEdit(vbox); -textedit = TQt::TextEdit(vbox); -button = PushButton("Hello World!", vbox) ; -this->setCentralWidget(vbox); -resize(220,240); -vbox->show; -sample = TQt::PopupMenu( this ); -use TQt::slots 'there' => []; -sample->insertItem("&There", this, TQT_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 deleted file mode 100644 index 0a52c44..0000000 --- a/PerlQt/examples/aclock/AnalogClock.pm +++ /dev/null @@ -1,137 +0,0 @@ -package AnalogClock; -use TQt; -use TQt::isa qw(TQt::Widget); -use TQt::slots - setTime => ['const TQTime&'], - drawClock => ['TQPainter*'], - timeout => []; -use TQt::attributes qw( - clickPos - _time -); - -# -# Constructs an analog clock widget that uses an internal TQTimer -# - -sub NEW { - shift->SUPER::NEW(@_); - _time = TQt::Time::currentTime(); # get current time - my $internalTimer = TQt::Timer(this); # create internal timer - this->connect($internalTimer, TQT_SIGNAL('timeout()'), TQT_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 = TQt::Point( - geometry()->topLeft->x - frameGeometry()->topLeft->x, - geometry()->topLeft->y - frameGeometry()->topLeft->y - ); - clickPos = TQt::Point($e->pos->x + $topLeft->x, - $e->pos->y + $topLeft->y); - } -} - -sub mouseMoveEvent { - my $e = shift; - if(isTopLevel()) { - move(TQt::Point($e->globalPos->x - clickPos->x, - $e->globalPos->y - clickPos->y)); - } -} - -sub setTime { - my $t = shift; - timeout(); -} - -# -# The TQTimer::timeout() signal is received by this slot. -# - -sub timeout { - my $new_time = TQt::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 = TQt::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 = TQt::Bitmap(size()); - $bm->fill(&color0); # transparent - - my $paint = TQt::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 = TQt::Time::currentTime(); - my $pts = TQt::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); - TQt::Widget::setAutoMask($b); -} - -1; diff --git a/PerlQt/examples/aclock/aclock.pl b/PerlQt/examples/aclock/aclock.pl deleted file mode 100644 index b4ae659..0000000 --- a/PerlQt/examples/aclock/aclock.pl +++ /dev/null @@ -1,13 +0,0 @@ -#!/usr/bin/perl -w -use strict; -use TQt; -use AnalogClock; - -my $a = TQt::Application(\@ARGV); -my $clock = AnalogClock; -$clock->setAutoMask(1) if @ARGV and $ARGV[0] eq '-transparent'; -$clock->resize(100, 100); -$a->setMainWidget($clock); -$clock->setCaption("PerlTQt example - Analog Clock"); -$clock->show; -exit $a->exec; diff --git a/PerlQt/examples/buttongroups/ButtonsGroups.pm b/PerlQt/examples/buttongroups/ButtonsGroups.pm deleted file mode 100644 index 106cf1b..0000000 --- a/PerlQt/examples/buttongroups/ButtonsGroups.pm +++ /dev/null @@ -1,104 +0,0 @@ -package ButtonsGroups; -use strict; -use TQt; -use TQt::isa qw(TQt::Widget); -use TQt::slots - slotChangeGrp3State => []; -use TQt::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 = TQt::VBoxLayout(this); - my $box1 = TQt::HBoxLayout($vbox); - my $box2 = TQt::HBoxLayout($vbox); - - # ------- first group - - # Create an exclusive button group - my $bgrp1 = TQt::ButtonGroup(1, &Horizontal, "Button Group &1 (exclusive)", this); - $box1->addWidget($bgrp1); - $bgrp1->setExclusive(1); - - # insert 3 radiobuttons - TQt::RadioButton("R&adiobutton 2", $bgrp1); - TQt::RadioButton("Ra&diobutton 3", $bgrp1); - - # ------- second group - - # Create a non-exclusive buttongroup - my $bgrp2 = TQt::ButtonGroup(1, &Horizontal, "Button Group &2 (non-exclusive)", this); - $box1->addWidget($bgrp2); - $bgrp2->setExclusive(0); - - # insert 3 checkboxes - TQt::CheckBox("&Checkbox 1", $bgrp2); - my $cb12 = TQt::CheckBox("C&heckbox 2", $bgrp2); - $cb12->setChecked(1); - my $cb13 = TQt::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 = TQt::ButtonGroup(1, &Horizontal, "Button Group &3 (Radiobutton-exclusive)", this); - $box2->addWidget($bgrp3); - $bgrp3->setRadioButtonExclusive(1); - - # insert three radiobuttons - rb21 = TQt::RadioButton("Rad&iobutton 1", $bgrp3); - rb22 = TQt::RadioButton("Radi&obutton 2", $bgrp3); - rb23 = TQt::RadioButton("Radio&button 3", $bgrp3); - rb23->setChecked(1); - - # insert a checkbox - state = TQt::CheckBox("E&nable Radiobuttons", $bgrp3); - state->setChecked(1); - # ...and connect its TQT_SIGNAL clicked() with the TQT_SLOT slotChangeGrp3State() - this->connect(state, TQT_SIGNAL('clicked()'), TQT_SLOT('slotChangeGrp3State()')); - - # ----------- fourth group - - # create a groupbox which layouts its childs in a columns - my $bgrp4 = TQt::ButtonGroup(1, &Horizontal, "Groupbox with &normal buttons", this); - $box2->addWidget($bgrp4); - - # insert three pushbuttons... - TQt::PushButton("&Push Button", $bgrp4); - my $tb2 = TQt::PushButton("&Toggle Button", $bgrp4); - my $tb3 = TQt::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); -} - -# -# TQT_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 deleted file mode 100644 index 632ad43..0000000 --- a/PerlQt/examples/buttongroups/buttongroups.pl +++ /dev/null @@ -1,13 +0,0 @@ -#!/usr/bin/perl -w -use strict; -use TQt; -use ButtonsGroups; - -my $a = TQt::Application(\@ARGV); - -my $buttonsgroups = ButtonsGroups; -$buttonsgroups->resize(500, 250); -$buttonsgroups->setCaption("PerlTQt Example - Buttongroups"); -$a->setMainWidget($buttonsgroups); -$buttonsgroups->show; -exit $a->exec; diff --git a/PerlQt/examples/dclock/DigitalClock.pm b/PerlQt/examples/dclock/DigitalClock.pm deleted file mode 100644 index 2d25428..0000000 --- a/PerlQt/examples/dclock/DigitalClock.pm +++ /dev/null @@ -1,88 +0,0 @@ -package DigitalClock; -use strict; -use TQt; -use TQt::isa qw(TQt::LCDNumber); -use TQt::slots - stopDate => [], - showTime => []; -use TQt::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 = TQt::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(TQt::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 deleted file mode 100644 index 57c02bd..0000000 --- a/PerlQt/examples/dclock/dclock.pl +++ /dev/null @@ -1,12 +0,0 @@ -#!/usr/bin/perl -w -use strict; -use TQt; -use DigitalClock; - -my $a = TQt::Application(\@ARGV); -my $clock = DigitalClock; -$clock->resize(170, 80); -$a->setMainWidget($clock); -$clock->setCaption("PerlTQt Example - Digital Clock"); -$clock->show; -exit $a->exec; diff --git a/PerlQt/examples/drawdemo/drawdemo.pl b/PerlQt/examples/drawdemo/drawdemo.pl deleted file mode 100644 index f119a94..0000000 --- a/PerlQt/examples/drawdemo/drawdemo.pl +++ /dev/null @@ -1,198 +0,0 @@ -#!/usr/bin/perl -w -use strict; -package DrawView; -use TQt; -use TQt::isa qw(TQt::Widget); -use TQt::slots - updateIt => ['int'], - printIt => []; -use TQt::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 = TQt::Font("times", 18, &TQt::Font::Bold); - $p->setFont($f); - $p->setPen(&black); - $p->setWindow(0, 0, 500, 500); # defines coordinate system - - for my $i (0..35) { - my $matrix = TQt::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 = TQt::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 = TQt::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 = TQt::Brush(&blue); - my $b2 = TQt::Brush(&green, &Dense6Pattern); # green 12% fill - my $b3 = TQt::Brush(&NoBrush); # void brush - my $b4 = TQt::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("PerlTQt Draw Demo Application"); - setBackgroundColor(&white); - - # Create a button group to contain all buttons - bgroup = TQt::ButtonGroup(this); - bgroup->resize(200, 200); - this->connect(bgroup, TQT_SIGNAL('clicked(int)'), TQT_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 = TQt::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 = TQt::Printer; - - _print = TQt::PushButton("Print...", bgroup); - _print->resize(80, 30); - _print->move($maxwidth/2 - _print->width/2, maxindex*30+20); - this->connect(_print, TQT_SIGNAL('clicked()'), TQT_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 = TQt::Painter(printer); - drawIt($paint); - } -} - -sub paintEvent { - my $paint = TQt::Painter(this); - drawIt($paint); -} - -sub resizeEvent { - bgroup->move(int(width() - bgroup->width), int(0)); -} - -package main; -use TQt; -use DrawView; - -my $app = TQt::Application(\@ARGV); -my $draw = DrawView; -$app->setMainWidget($draw); -$draw->setCaption("PerlTQt Example - Drawdemo"); -$draw->show; -exit $app->exec; diff --git a/PerlQt/examples/drawlines/drawlines.pl b/PerlQt/examples/drawlines/drawlines.pl deleted file mode 100644 index 1d7575f..0000000 --- a/PerlQt/examples/drawlines/drawlines.pl +++ /dev/null @@ -1,74 +0,0 @@ -#!/usr/bin/perl -w -use strict; -package ConnectWidget; -use TQt; -use TQt::isa qw(TQt::Widget); -use TQt::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, TQt::Color(rand(255), rand(255), rand(255)); - } - colors = \@colors; -} - -sub paintEvent { - my $paint = TQt::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 = TQt::Painter(this); - push @{this->points}, TQt::Point($e->pos); - count++; - $paint->drawPoint($e->pos); - } -} - -package main; -use TQt; -use ConnectWidget; - -my $a = TQt::Application(\@ARGV); -my $connect = ConnectWidget; -$connect->setCaption("PerlTQt 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 deleted file mode 100644 index e388e44..0000000 --- a/PerlQt/examples/forever/forever.pl +++ /dev/null @@ -1,59 +0,0 @@ -#!/usr/bin/perl -w -use strict; -package Forever; -use TQt; -use TQt::isa qw(TQt::Widget); -use TQt::slots - updateCaption => []; -use TQt::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, TQt::Color(rand(255), rand(255), rand(255)); - } - rectangles = 0; - startTimer(0); - my $counter = TQt::Timer(this); - this->connect($counter, TQT_SIGNAL('timeout()'), TQT_SLOT('updateCaption()')); - $counter->start(1000); -} - -sub updateCaption { - my $s = sprintf "PerlTQt Example - Forever - %d rectangles/second", rectangles; - rectangles = 0; - setCaption($s); -} - -sub paintEvent { - my $paint = TQt::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 TQt; -use Forever; - -my $a = TQt::Application(\@ARGV); -my $always = Forever; -$a->setMainWidget($always); -$always->setCaption("PerlTQt Example - Forever"); -$always->show; -exit $a->exec; diff --git a/PerlQt/examples/network/httpd/httpd.pl b/PerlQt/examples/network/httpd/httpd.pl deleted file mode 100644 index a9aa0fd..0000000 --- a/PerlQt/examples/network/httpd/httpd.pl +++ /dev/null @@ -1,140 +0,0 @@ -#!/usr/bin/perl -w - -## This program is based on an example program for TQt. 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 TQt::Socket and all -# communication with the client is done over this Socket object. TQt::Socket -# works asynchronously - this means that all the communication is done -# through the two slots readClient() and discardClient(). - -package HttpDaemon; - -use TQt; -use TQt::isa qw(TQt::ServerSocket); -use TQt::signals - newConnect => [], - endConnect => [], - wroteToClient => []; -use TQt::slots - readClient => [], - discardClient => []; -use TQt::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 = TQt::Socket( this ); - this->connect( $s, TQT_SIGNAL 'readyRead()', this, TQT_SLOT 'readClient()' ); - this->connect( $s, TQT_SIGNAL 'delayedCloseFinished()', this, TQT_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 TQt; -use TQt::isa qw(TQt::VBox); -use TQt::slots - newConnect => [], - endConnect => [], - wroteToClient => []; -use TQt::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, TQT_SIGNAL 'newConnect()', TQT_SLOT 'newConnect()' ); - this->connect( httpd, TQT_SIGNAL 'endConnect()', TQT_SLOT 'endConnect()' ); - this->connect( httpd, TQT_SIGNAL 'wroteToClient()', TQT_SLOT 'wroteToClient()' ); - this->connect( $quit, TQT_SIGNAL 'pressed()', TQt::app(), TQT_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 TQt; -use HttpInfo; - -my $app = TQt::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 deleted file mode 100644 index 7e2f174..0000000 --- a/PerlQt/examples/opengl/README +++ /dev/null @@ -1,12 +0,0 @@ -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 TQt must also have been compiled with OpenGL support. - -If your TQt library has OpenGL support but PerlTQt 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 deleted file mode 100644 index 1c6ceb8..0000000 --- a/PerlQt/examples/opengl/box/GLBox.pm +++ /dev/null @@ -1,149 +0,0 @@ -package GLBox; - -use OpenGL qw(:all); - -use strict; - -use TQt; -use TQt::isa qw(TQt::GLWidget); -use TQt::slots - setXRotation => ['int'], - setYRotation => ['int'], - setZRotation => ['int']; -use TQt::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_TQUADS ); - 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_TQUADS ); - 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_TQUAD_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 deleted file mode 100644 index fed74a3..0000000 --- a/PerlQt/examples/opengl/box/glbox +++ /dev/null @@ -1,90 +0,0 @@ - -package GLObjectWindow; - -use strict; - -use TQt; -use TQt::isa qw(TQt::Widget); -use TQt::attributes qw( - file - frame - menu - box - xpos - ypos - zpos -); - -use GLBox; - -sub NEW -{ - shift->SUPER::NEW(@_); - - # Create a menu - file = TQt::PopupMenu( this ); - file->insertItem( "Exit", TQt::app(), TQT_SLOT 'quit()', TQt::KeySequence(int &CTRL + &Key_Q )); - - # Create a menu bar - menu = TQt::MenuBar( this ); - menu->setSeparator( &TQt::MenuBar::InWindowsStyle ); - menu->insertItem("&File", file ); - - # Create a nice frame to put around the OpenGL widget - frame = TQt::Frame( this, "frame" ); - frame->setFrameStyle( &TQt::Frame::Sunken | &TQt::Frame::Panel ); - frame->setLineWidth( 2 ); - - # Create our OpenGL widget - box = GLBox( frame, "glbox"); - - # Create the three sliders; one for each rotation axis - xpos = TQt::Slider ( 0, 360, 60, 0, &TQt::Slider::Vertical, this, "xsl" ); - xpos->setTickmarks( &TQt::Slider::Left ); - TQt::Object::connect( xpos, TQT_SIGNAL 'valueChanged(int)', box, TQT_SLOT 'setXRotation(int)' ); - - ypos = TQt::Slider ( 0, 360, 60, 0, &TQt::Slider::Vertical, this, "ysl" ); - ypos->setTickmarks( &TQt::Slider::Left ); - TQt::Object::connect( ypos, TQT_SIGNAL 'valueChanged(int)', box, TQT_SLOT 'setYRotation(int)' ); - - zpos = TQt::Slider ( 0, 360, 60, 0, &TQt::Slider::Vertical, this, "zsl" ); - zpos->setTickmarks( &TQt::Slider::Left ); - TQt::Object::connect( zpos, TQT_SIGNAL 'valueChanged(int)', box, TQT_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 = TQt::VBoxLayout( 20, "vlayout"); - $vlayout->addWidget( xpos ); - $vlayout->addWidget( ypos ); - $vlayout->addWidget( zpos ); - - # Put the GL widget inside the frame - my $flayout = TQt::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 = TQt::HBoxLayout( this, 20, 20, "hlayout"); - $hlayout->setMenuBar( menu ); - $hlayout->addLayout( $vlayout ); - $hlayout->addWidget( frame, 1 ); -} - -1; - -package main; - -use TQt; -use GLObjectWindow; - -my $a = TQt::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 deleted file mode 100644 index d9e4c8a..0000000 --- a/PerlQt/examples/opengl/gear/gear +++ /dev/null @@ -1,267 +0,0 @@ -#!/usr/bin/perl -w -# -# Draws a gear. -# -# This code is originally from TQt-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 TQt; -use TQt::attributes qw( - gear1 - gear2 - gear3 - view_rotx - view_roty - view_rotz - angle -); - -use TQt::isa qw(TQt::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_TQUAD_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_TQUADS); - $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_TQUAD_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_TQUADS); - $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_TQUAD_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_TQUAD_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 TQt; -use GearWidget; - -$app = TQt::Application(\@ARGV); - -if(!TQt::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 deleted file mode 100644 index 4112e64..0000000 --- a/PerlQt/examples/progress/progress.pl +++ /dev/null @@ -1,348 +0,0 @@ -#!/usr/bin/perl -w - -use strict; - -package AnimatedThingy; - -use TQt; -use TQt::isa "TQt::Label"; -use TQt::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 -{ - TQt::Size(120,100) -} - -sub timerEvent -{ - my $p = TQt::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 = TQt::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 = TQt::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 = TQt::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 TQt; -use TQt::isa "TQt::Widget"; -use TQt::attributes qw[ - menubar - file - options - rects - pb - td_id - ld_id - dl_id - cl_id - md_id - got_stop - timer_driven - default_label -]; -use TQt::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 = TQt::PopupMenu; - menubar->insertItem( "&File", file ); - for (my $i=first_draw_item; $i<=last_draw_item; $i++) - { file->insertItem( drawItemRects($i)." Rectangles", $i) } - TQt::Object::connect( menubar, TQT_SIGNAL "activated(int)", this, TQT_SLOT "doMenuItem(int)" ); - file->insertSeparator; - file->insertItem( "Quit", TQt::app(), TQT_SLOT "quit()" ); - options = TQt::PopupMenu; - menubar->insertItem( "&Options", options ); - td_id = options->insertItem( "Timer driven", this, TQT_SLOT "timerDriven()" ); - ld_id = options->insertItem( "Loop driven", this, TQT_SLOT "loopDriven()" ); - options->insertSeparator; - dl_id = options->insertItem( "Default label", this, TQT_SLOT "defaultLabel()" ); - cl_id = options->insertItem( "Custom label", this, TQT_SLOT "customLabel()" ); - options->insertSeparator; - md_id = options->insertItem( "No minimum duration", this, TQT_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 = TQt::Painter(this); - - my $ww = width(); - my $wh = height(); - - if ( $ww > 8 && $wh > 8 ) - { - my $c = TQt::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 = TQt::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"); - TQt::Object::connect(pb, TQT_SIGNAL "cancelled()", this, TQT_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 = TQt::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 = TQt::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 TQt; -use CPUWaster; - -my $a=TQt::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 deleted file mode 100644 index 9ba9880..0000000 --- a/PerlQt/examples/richedit/imageCollection.pm +++ /dev/null @@ -1,1461 +0,0 @@ -# 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 PerlTQt User Interface Compiler (puic) -# -# WARNING! All changes made in this file will be lost! - -use strict; - -package DesignerMimeSourceFactory_richedit; -use TQt; -use TQt::isa qw(TQt::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 TQt::Image() unless exists $embed_images{$name}; - - my $img = TQt::Image(@{$embed_images{$name}}[0..4], &TQt::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()) - { - TQt::MimeSourceFactory::removeFactory(this); - my $s = TQt::MimeSourceFactory::defaultFactory()->data($abs_name); - TQt::MimeSourceFactory::addFactory(this); - return $s; - } - TQt::MimeSourceFactory::defaultFactory()->setImage($abs_name, $img); - return TQt::MimeSourceFactory::defaultFactory()->data($abs_name); -} - - -package staticImages; -use TQt; -use DesignerMimeSourceFactory_richedit; -our %factories; - -my $factory = DesignerMimeSourceFactory_richedit; -TQt::MimeSourceFactory::defaultFactory()->addFactory($factory); -$factories{'DesignerMimeSourceFactory_richedit'} = $factory; - -END -{ - for( values %factories ) - { - TQt::MimeSourceFactory::defaultFactory()->removeFactory($_); - } - %factories = (); -} -1; - diff --git a/PerlQt/examples/richedit/richedit.pl b/PerlQt/examples/richedit/richedit.pl deleted file mode 100644 index d2dee84..0000000 --- a/PerlQt/examples/richedit/richedit.pl +++ /dev/null @@ -1,376 +0,0 @@ -# Form implementation generated from reading ui file 'richedit.ui' -# -# Created: jeu jun 13 20:02:56 2002 -# by: The PerlTQt 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 TQt; -use TQt::isa qw(TQt::MainWindow); -use TQt::slots - init => [], - fileExit => [], - fileNew => [], - fileOpen => [], - fileSave => [], - fileSaveAs => [], - helpAbout => [], - helpContents => [], - helpIndex => [], - changeAlignment => ['TQAction*'], - saveAndContinue => ['const TQString&']; -use TQt::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 = TQt::Pixmap(); - my $m = TQt::MimeSourceFactory::defaultFactory()->data(shift); - - if($m) - { - TQt::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(TQt::Widget(this, "qt_central_widget")); - my $EditorFormLayout = TQt::HBoxLayout(this->centralWidget(), 11, 6, '$EditorFormLayout'); - - textEdit = TQt::TextEdit(this->centralWidget(), "textEdit"); - textEdit->setSizePolicy(TQt::SizePolicy(7, 7, 0, 0, textEdit->sizePolicy()->hasHeightForWidth())); - textEdit->setTextFormat(&TQt::TextEdit::RichText); - $EditorFormLayout->addWidget(textEdit); - - fileNewAction= TQt::Action(this,"fileNewAction"); - fileNewAction->setIconSet(TQt::IconSet(uic_load_pixmap_EditorForm("filenew"))); - fileNewAction->setText(this->trUtf8("New")); - fileNewAction->setMenuText(this->trUtf8("&New")); - fileNewAction->setAccel(TQt::KeySequence(int(4194382))); - fileOpenAction= TQt::Action(this,"fileOpenAction"); - fileOpenAction->setIconSet(TQt::IconSet(uic_load_pixmap_EditorForm("fileopen"))); - fileOpenAction->setText(this->trUtf8("Open")); - fileOpenAction->setMenuText(this->trUtf8("&Open...")); - fileOpenAction->setAccel(TQt::KeySequence(int(4194383))); - fileSaveAction= TQt::Action(this,"fileSaveAction"); - fileSaveAction->setIconSet(TQt::IconSet(uic_load_pixmap_EditorForm("filesave"))); - fileSaveAction->setText(this->trUtf8("Save")); - fileSaveAction->setMenuText(this->trUtf8("&Save")); - fileSaveAction->setAccel(TQt::KeySequence(int(4194387))); - fileSaveAsAction= TQt::Action(this,"fileSaveAsAction"); - fileSaveAsAction->setText(this->trUtf8("Save As")); - fileSaveAsAction->setMenuText(this->trUtf8("Save &As...")); - fileSaveAsAction->setAccel(TQt::KeySequence(int(0))); - fileExitAction= TQt::Action(this,"fileExitAction"); - fileExitAction->setText(this->trUtf8("Exit")); - fileExitAction->setMenuText(this->trUtf8("E&xit")); - fileExitAction->setAccel(TQt::KeySequence(int(0))); - editUndoAction= TQt::Action(this,"editUndoAction"); - editUndoAction->setIconSet(TQt::IconSet(uic_load_pixmap_EditorForm("undo"))); - editUndoAction->setText(this->trUtf8("Undo")); - editUndoAction->setMenuText(this->trUtf8("&Undo")); - editUndoAction->setAccel(TQt::KeySequence(int(4194394))); - editRedoAction= TQt::Action(this,"editRedoAction"); - editRedoAction->setIconSet(TQt::IconSet(uic_load_pixmap_EditorForm("redo"))); - editRedoAction->setText(this->trUtf8("Redo")); - editRedoAction->setMenuText(this->trUtf8("&Redo")); - editRedoAction->setAccel(TQt::KeySequence(int(4194393))); - editCutAction= TQt::Action(this,"editCutAction"); - editCutAction->setIconSet(TQt::IconSet(uic_load_pixmap_EditorForm("editcut"))); - editCutAction->setText(this->trUtf8("Cut")); - editCutAction->setMenuText(this->trUtf8("&Cut")); - editCutAction->setAccel(TQt::KeySequence(int(4194392))); - editCopyAction= TQt::Action(this,"editCopyAction"); - editCopyAction->setIconSet(TQt::IconSet(uic_load_pixmap_EditorForm("editcopy"))); - editCopyAction->setText(this->trUtf8("Copy")); - editCopyAction->setMenuText(this->trUtf8("C&opy")); - editCopyAction->setAccel(TQt::KeySequence(int(4194371))); - editPasteAction= TQt::Action(this,"editPasteAction"); - editPasteAction->setIconSet(TQt::IconSet(uic_load_pixmap_EditorForm("editpaste"))); - editPasteAction->setText(this->trUtf8("Paste")); - editPasteAction->setMenuText(this->trUtf8("&Paste")); - editPasteAction->setAccel(TQt::KeySequence(int(4194390))); - helpContentsAction= TQt::Action(this,"helpContentsAction"); - helpContentsAction->setText(this->trUtf8("Contents")); - helpContentsAction->setMenuText(this->trUtf8("&Contents...")); - helpContentsAction->setAccel(TQt::KeySequence(int(0))); - helpIndexAction= TQt::Action(this,"helpIndexAction"); - helpIndexAction->setText(this->trUtf8("Index")); - helpIndexAction->setMenuText(this->trUtf8("&Index...")); - helpIndexAction->setAccel(TQt::KeySequence(int(0))); - helpAboutAction= TQt::Action(this,"helpAboutAction"); - helpAboutAction->setText(this->trUtf8("About")); - helpAboutAction->setMenuText(this->trUtf8("&About...")); - helpAboutAction->setAccel(TQt::KeySequence(int(0))); - boldAction= TQt::Action(this,"boldAction"); - boldAction->setToggleAction(1); - boldAction->setIconSet(TQt::IconSet(uic_load_pixmap_EditorForm("textbold"))); - boldAction->setText(this->trUtf8("bold")); - boldAction->setMenuText(this->trUtf8("&Bold")); - boldAction->setAccel(TQt::KeySequence(int(272629826))); - italicAction= TQt::Action(this,"italicAction"); - italicAction->setToggleAction(1); - italicAction->setIconSet(TQt::IconSet(uic_load_pixmap_EditorForm("textitalic"))); - italicAction->setText(this->trUtf8("italic")); - italicAction->setMenuText(this->trUtf8("&Italic")); - italicAction->setAccel(TQt::KeySequence(int(272629833))); - underlineAction= TQt::Action(this,"underlineAction"); - underlineAction->setToggleAction(1); - underlineAction->setIconSet(TQt::IconSet(uic_load_pixmap_EditorForm("textunder"))); - underlineAction->setText(this->trUtf8("underline")); - underlineAction->setMenuText(this->trUtf8("&Underline")); - underlineAction->setAccel(TQt::KeySequence(int(272629845))); - alignActionGroup= TQt::ActionGroup(this,"alignActionGroup"); - alignActionGroup->setText(this->trUtf8("align")); - alignActionGroup->setUsesDropDown(0); - leftAlignAction= TQt::Action(alignActionGroup,"leftAlignAction"); - leftAlignAction->setToggleAction(1); - leftAlignAction->setIconSet(TQt::IconSet(uic_load_pixmap_EditorForm("textleft"))); - leftAlignAction->setText(this->trUtf8("left")); - leftAlignAction->setMenuText(this->trUtf8("&Left")); - leftAlignAction->setAccel(TQt::KeySequence(int(272629836))); - rightAlignAction= TQt::Action(alignActionGroup,"rightAlignAction"); - rightAlignAction->setToggleAction(1); - rightAlignAction->setIconSet(TQt::IconSet(uic_load_pixmap_EditorForm("textright"))); - rightAlignAction->setText(this->trUtf8("right")); - rightAlignAction->setMenuText(this->trUtf8("&Right")); - rightAlignAction->setAccel(TQt::KeySequence(int(272629842))); - centerAlignAction= TQt::Action(alignActionGroup,"centerAlignAction"); - centerAlignAction->setToggleAction(1); - centerAlignAction->setIconSet(TQt::IconSet(uic_load_pixmap_EditorForm("textcenter"))); - centerAlignAction->setText(this->trUtf8("center")); - centerAlignAction->setMenuText(this->trUtf8("&Center")); - - - toolBar = TQt::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 = TQt::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 = TQt::ComboBox(0, Toolbar, "fontComboBox"); - - SpinBox2 = TQt::SpinBox(Toolbar, "SpinBox2"); - SpinBox2->setMinValue(int(6)); - SpinBox2->setValue(int(10)); - - - menubar= TQt::MenuBar( this, "menubar"); - - fileMenu= TQt::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= TQt::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= TQt::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= TQt::PopupMenu(this); - helpContentsAction->addTo(helpMenu); - helpIndexAction->addTo(helpMenu); - helpMenu->insertSeparator; - helpAboutAction->addTo(helpMenu); - menubar->insertItem(this->trUtf8("&Help"), helpMenu); - - - - TQt::Object::connect(fileNewAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileNew()"); - TQt::Object::connect(fileOpenAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileOpen()"); - TQt::Object::connect(fileSaveAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileSave()"); - TQt::Object::connect(fileSaveAsAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileSaveAs()"); - TQt::Object::connect(fileExitAction, TQT_SIGNAL "activated()", this, TQT_SLOT "fileExit()"); - TQt::Object::connect(helpIndexAction, TQT_SIGNAL "activated()", this, TQT_SLOT "helpIndex()"); - TQt::Object::connect(helpContentsAction, TQT_SIGNAL "activated()", this, TQT_SLOT "helpContents()"); - TQt::Object::connect(helpAboutAction, TQT_SIGNAL "activated()", this, TQT_SLOT "helpAbout()"); - TQt::Object::connect(SpinBox2, TQT_SIGNAL "valueChanged(int)", textEdit, TQT_SLOT "setPointSize(int)"); - TQt::Object::connect(editCutAction, TQT_SIGNAL "activated()", textEdit, TQT_SLOT "cut()"); - TQt::Object::connect(editPasteAction, TQT_SIGNAL "activated()", textEdit, TQT_SLOT "paste()"); - TQt::Object::connect(editCopyAction, TQT_SIGNAL "activated()", textEdit, TQT_SLOT "copy()"); - TQt::Object::connect(editRedoAction, TQT_SIGNAL "activated()", textEdit, TQT_SLOT "redo()"); - TQt::Object::connect(editUndoAction, TQT_SIGNAL "activated()", textEdit, TQT_SLOT "undo()"); - TQt::Object::connect(alignActionGroup, TQT_SIGNAL "selected(TQAction*)", this, TQT_SLOT "changeAlignment(TQAction*)"); - TQt::Object::connect(underlineAction, TQT_SIGNAL "toggled(bool)", textEdit, TQT_SLOT "setUnderline(bool)"); - TQt::Object::connect(italicAction, TQT_SIGNAL "toggled(bool)", textEdit, TQT_SLOT "setItalic(bool)"); - TQt::Object::connect(boldAction, TQT_SIGNAL "toggled(bool)", textEdit, TQT_SLOT "setBold(bool)"); - TQt::Object::connect(fontComboBox, TQT_SIGNAL "activated(const TQString&)", textEdit, TQT_SLOT "setFamily(const TQString&)"); - TQt::Object::connect(fontComboBox, TQT_SIGNAL "activated(const TQString&)", textEdit, TQT_SLOT "setFocus()"); - - init(); -} - - -sub init -{ - - textEdit->setFocus; - my $fonts = TQt::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(TQAction*): Not implemented yet.\n"; -} - -sub saveAndContinue -{ - print "EditorForm->saveAndContinue(const TQString&): Not implemented yet.\n"; -} - -1; - - -package main; - -use TQt; -use EditorForm; -use imageCollection; - -my $a = TQt::Application(\@ARGV); -TQt::Object::connect($a, TQT_SIGNAL("lastWindowClosed()"), $a, TQT_SLOT("quit()")); -my $w = EditorForm; -$a->setMainWidget($w); -$w->show; -exit $a->exec; - - diff --git a/PerlQt/handlers.cpp b/PerlQt/handlers.cpp deleted file mode 100644 index 395298f..0000000 --- a/PerlQt/handlers.cpp +++ /dev/null @@ -1,1347 +0,0 @@ -#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 TQIntDict<Smoke::Index> *dtorcache= 0; -static TQIntDict<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 TQt 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(); - TQByteArray *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, "TQt::_internal::TQByteArray") ) { - s = (TQByteArray*)SvIV((SV*)SvRV(mg->mg_obj)); - hasMagic = true; - } else { - STRLEN len; - char* tmp = SvPV(sv, len); - s = new TQByteArray(len); - Copy((void*)tmp, (void*)s->data(), len, char); - if( !m->type().isConst() && !SvREADONLY(sv) ) { - SV* rv = newSV(0); - sv_setref_pv(rv, "TQt::_internal::TQByteArray", (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 TQByteArray(0); - if( !SvREADONLY(sv) ) { - SV* rv = newSV(0); - sv_setpv_mg(sv, ""); - sv_setref_pv(rv, "TQt::_internal::TQByteArray", s); - sv_magic(sv, rv, PERL_MAGIC_tiedscalar, Nullch, 0); - hasMagic = true; - } - } else - s = new TQByteArray(0); - } - m->item().s_voidp = s->data(); - m->next(); - if(s && !hasMagic && m->cleanup()) - delete s; - } - break; - default: - m->unsupported(); - break; - } -} - -static void marshall_TQString(Marshall *m) { - switch(m->action()) { - case Marshall::FromSV: - { - SV* sv = m->var(); - TQString *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, "TQt::_internal::TQString") ) { - s = (TQString*)SvIV((SV*)SvRV(mg->mg_obj)); - hasMagic = true; - } else { - COP *cop = cxstack[cxstack_ix].blk_oldcop; - if(SvUTF8(sv)) - s = new TQString(TQString::fromUtf8(SvPV_nolen(sv))); - else if(cop->op_private & HINT_LOCALE) - s = new TQString(TQString::fromLocal8Bit(SvPV_nolen(sv))); - else - s = new TQString(TQString::fromLatin1(SvPV_nolen(sv))); - if( !m->type().isConst() && !m->type().isStack() && !SvREADONLY(sv)) { - SV* rv = newSV(0); - sv_setref_pv(rv, "TQt::_internal::TQString", (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 TQString; - if( !SvREADONLY(sv) ) { - SV* rv = newSV(0); - sv_setpv_mg(sv, ""); - sv_setref_pv(rv, "TQt::_internal::TQString", s); - sv_magic(sv, rv, PERL_MAGIC_tiedscalar, Nullch, 0); - hasMagic = true; - } - } else - s = new TQString; - } - m->item().s_voidp = s; - m->next(); - if(s && !hasMagic && m->cleanup()) - delete s; - } - break; - case Marshall::ToSV: - { - TQString *s = (TQString*)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_TQByteArray(Marshall *m) { - switch(m->action()) { - case Marshall::FromSV: - { - SV* sv = m->var(); - TQByteArray *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, "TQt::_internal::TQByteArray") ) { - s = (TQByteArray*)SvIV((SV*)SvRV(mg->mg_obj)); - hasMagic = true; - } else { - STRLEN len; - char* tmp = SvPV(sv, len); - s = new TQByteArray(len); - Copy((void*)tmp, (void*)s->data(), len, char); - if( !m->type().isConst() && !SvREADONLY(sv) ) { // we tie also stack because of the funny TQDataStream behaviour - // fprintf(stderr, "Tying\n"); - SV* rv = newSV(0); - sv_setref_pv(rv, "TQt::_internal::TQByteArray", (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 TQByteArray(0); - if( !SvREADONLY(sv) ) { - SV* rv = newSV(0); - sv_setpv_mg(sv, ""); - sv_setref_pv(rv, "TQt::_internal::TQByteArray", s); - sv_magic(sv, rv, PERL_MAGIC_tiedscalar, Nullch, 0); - hasMagic = true; - } - } else - s = new TQByteArray(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(); - TQByteArray *s = (TQByteArray*)m->item().s_voidp; - if(s) { - if( !m->type().isConst() && !m->type().isStack() && !SvREADONLY(sv)) { - SV* rv = newSV(0); - sv_setref_pv(rv, "TQt::_internal::TQByteArray", (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_TQCString(Marshall *m) { - switch(m->action()) { - case Marshall::FromSV: - { - TQCString *s = 0; - if(SvOK(m->var()) || m->type().isStack()) - s = new TQCString(SvPV_nolen(m->var())); - m->item().s_voidp = s; - m->next(); - if(s && m->cleanup()) - delete s; - } - break; - case Marshall::ToSV: - { - TQCString *s = (TQCString*)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 - TQTextCodec* c = TQTextCodec::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_TQCOORD_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); - TQCOORD *coord = new TQCOORD[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_TQStringList(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); - TQStringList *stringlist = new TQStringList; - 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(TQString()); - continue; - } - - if(SvUTF8(*item)) - stringlist->append(TQString::fromUtf8(SvPV_nolen(*item))); - else if(lc) - stringlist->append(TQString::fromLocal8Bit(SvPV_nolen(*item))); - else - stringlist->append(TQString::fromLatin1(SvPV_nolen(*item))); - } - - m->item().s_voidp = stringlist; - m->next(); - - if(m->cleanup()) { - av_clear(list); - for(TQStringList::Iterator it = stringlist->begin(); - it != stringlist->end(); - ++it) - av_push(list, newSVpv((const char *)*it, 0)); - delete stringlist; - } - } - break; - case Marshall::ToSV: - { - TQStringList *stringlist = (TQStringList*)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(TQStringList::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(TQStringList::Iterator it = stringlist->begin(); - it != stringlist->end(); - ++it) { - SV *sv = newSVpv((const char *)(*it).local8Bit(), 0); - av_push(av, sv); - } - else - for(TQStringList::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_TQValueListInt(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); - TQValueList<int> *valuelist = new TQValueList<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(TQValueListIterator<int> it = valuelist->begin(); - it != valuelist->end(); - ++it) - av_push(list, newSViv((int)*it)); - delete valuelist; - } - } - break; - case Marshall::ToSV: - { - TQValueList<int> *valuelist = (TQValueList<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(TQValueListIterator<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_TQRgb_array(Marshall *m) { - switch(m->action()) { - case Marshall::FromSV: - { - SV* sv = m->var(); - TQRgb* 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, "TQt::_internal::TQRgbStar") ) { - s = (TQRgb*)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 TQRgb[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, "TQt::_internal::TQRgbStar", (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_TQPTRLIST( 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_TQPTRLIST( TQPtrListTQNetworkOperation, TQPtrList<TQNetworkOperation>, TQNetworkOperation, " TQt::NetworkOperation", FALSE ) -MARSHALL_TQPTRLIST( TQPtrListTQToolBar, TQPtrList<TQToolBar>, TQToolBar, " TQt::ToolBar", FALSE ) -MARSHALL_TQPTRLIST( TQPtrListTQTab, TQPtrList<TQTab>, TQTab, " TQt::Tab", FALSE ) -MARSHALL_TQPTRLIST( TQPtrListTQDockWindow, TQPtrList<TQDockWindow>, TQDockWindow, " TQt::DockWindow", FALSE ) -MARSHALL_TQPTRLIST( TQWidgetList, TQWidgetList, TQWidget, " TQt::Widget", FALSE ) -MARSHALL_TQPTRLIST( TQObjectList, TQObjectList, TQObject, " TQt::Object", FALSE ) -MARSHALL_TQPTRLIST( TQFileInfoList, TQFileInfoList, TQFileInfo, " TQt::FileInfo", FALSE ) - -void marshall_TQCanvasItemList(Marshall *m) { - switch(m->action()) { - - case Marshall::ToSV: - { - TQCanvasItemList *cilist = (TQCanvasItemList*)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( "TQCanvasItem" ); - for(TQValueListIterator<TQCanvasItem*> it = cilist->begin(); - it != cilist->end(); - ++it){ - TQCanvasItem* t= *it; - GET_PERL_OBJECT( TQCanvasItem, " TQt::CanvasItem", FALSE ) - av_push(av, ret); - } - if(m->cleanup()) - delete cilist; - } - break; - default: - m->unsupported(); - break; - } -} - - - -TypeHandler TQt_handlers[] = { - { "TQString", marshall_TQString }, - { "TQString&", marshall_TQString }, - { "TQString*", marshall_TQString }, - { "const TQString", marshall_TQString }, - { "const TQString&", marshall_TQString }, - { "const TQString*", marshall_TQString }, - { "TQCString", marshall_TQCString }, - { "TQCString&", marshall_TQCString }, - { "TQCString*", marshall_TQCString }, - { "const TQCString", marshall_TQCString }, - { "const TQCString&", marshall_TQCString }, - { "const TQCString*", marshall_TQCString }, - { "TQStringList", marshall_TQStringList }, - { "TQStringList&", marshall_TQStringList }, - { "TQStringList*", marshall_TQStringList }, - { "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 }, - { "TQRgb*", marshall_TQRgb_array }, - { "TQUObject*", marshall_voidP }, - { "const TQCOORD*", marshall_TQCOORD_array }, - { "void", marshall_void }, - { "TQByteArray", marshall_TQByteArray }, - { "TQByteArray&", marshall_TQByteArray }, - { "TQByteArray*", marshall_TQByteArray }, - { "TQValueList<int>", marshall_TQValueListInt }, - { "TQValueList<int>*", marshall_TQValueListInt }, - { "TQValueList<int>&", marshall_TQValueListInt }, - { "TQCanvasItemList", marshall_TQCanvasItemList }, - { "TQCanvasItemList*", marshall_TQCanvasItemList }, - { "TQCanvasItemList&", marshall_TQCanvasItemList }, - { "TQWidgetList", marshall_TQWidgetList }, - { "TQWidgetList*", marshall_TQWidgetList }, - { "TQWidgetList&", marshall_TQWidgetList }, - { "TQObjectList", marshall_TQObjectList }, - { "TQObjectList*", marshall_TQObjectList }, - { "TQObjectList&", marshall_TQObjectList }, - { "TQFileInfoList", marshall_TQFileInfoList }, - { "TQFileInfoList*", marshall_TQFileInfoList }, - { "TQFileInfoList&", marshall_TQFileInfoList }, - { "TQPtrList<TQToolBar>", marshall_TQPtrListTQToolBar }, - { "TQPtrList<TQToolBar>*", marshall_TQPtrListTQToolBar }, - { "TQPtrList<TQToolBar>&", marshall_TQPtrListTQToolBar }, - { "TQPtrList<TQTab>", marshall_TQPtrListTQTab }, - { "TQPtrList<TQTab>*", marshall_TQPtrListTQTab }, - { "TQPtrList<TQTab>&", marshall_TQPtrListTQTab }, - { "TQPtrList<TQDockWindow>", marshall_TQPtrListTQDockWindow }, - { "TQPtrList<TQDockWindow>*", marshall_TQPtrListTQDockWindow }, - { "TQPtrList<TQDockWindow>&", marshall_TQPtrListTQDockWindow }, - { "TQPtrList<TQNetworkOperation>", marshall_TQPtrListTQNetworkOperation }, - { "TQPtrList<TQNetworkOperation>*", marshall_TQPtrListTQNetworkOperation }, - { "TQPtrList<TQNetworkOperation>&", marshall_TQPtrListTQNetworkOperation }, - { 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 TQIntDict<Smoke::Index>(113); - dtorcache->setAutoDelete(1); - } - if(!cctorcache) { - cctorcache = new TQIntDict<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 deleted file mode 100644 index 75f30a2..0000000 --- a/PerlQt/lib/Qt/GlobalSpace.pm +++ /dev/null @@ -1,25 +0,0 @@ -package TQt::GlobalSpace; -use strict; -require TQt; -require Exporter; - -our @ISA = qw(Exporter); -our @EXPORT; -our $allMeth = TQt::_internal::findAllMethods( TQt::_internal::idClass("TQGlobalSpace") ); -no strict 'refs'; - -for my $proto( keys %$allMeth ) -{ - next if $proto =~ /operator\W/; # skip operators - $proto =~ s/[\#\$\?]+$//; - *{ $proto } = sub - { - $TQt::_internal::autoload::AUTOLOAD = "TQt::GlobalSpace\::$proto"; - goto &TQt::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 deleted file mode 100644 index 4398fa5..0000000 --- a/PerlQt/lib/Qt/attributes.pm +++ /dev/null @@ -1,51 +0,0 @@ -package TQt::attributes; -# -# I plan to support public/protected/private attributes. here goes. -# Attributes default to protected. -# -# package MyBase; -# use TQt::attributes qw( -# private: -# foo -# protected: -# bar -# public: -# baz -# ); -# -# package MyDerived; -# use TQt::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; - TQt::_internal::installattribute($caller, $attribute); - ${ ${$caller . '::META'}{'attributes'} }{$attribute} = 1; - } -} - -1; diff --git a/PerlQt/lib/Qt/constants.pm b/PerlQt/lib/Qt/constants.pm deleted file mode 100644 index 5bdeed0..0000000 --- a/PerlQt/lib/Qt/constants.pm +++ /dev/null @@ -1,62 +0,0 @@ -package TQt::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 deleted file mode 100644 index a0f4e19..0000000 --- a/PerlQt/lib/Qt/debug.pm +++ /dev/null @@ -1,36 +0,0 @@ -package TQt::debug; -use TQt; - -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++; - } - } - TQt::_internal::setDebug($db); - print "Available channels: \n\t". - join("\n\t", sort keys %channel). - "\n" if $usage; -} - -sub unimport { - TQt::_internal::setDebug(0); -} - -1;
\ No newline at end of file diff --git a/PerlQt/lib/Qt/enumerations.pm b/PerlQt/lib/Qt/enumerations.pm deleted file mode 100644 index 9fea98f..0000000 --- a/PerlQt/lib/Qt/enumerations.pm +++ /dev/null @@ -1,15 +0,0 @@ -package TQt::enumerations; -# -# Proposed usage: -# -# package MyWidget; -# -# use TQt::enumerations MyInfo => { -# Foo => 1, -# Bar => 10, -# Baz => 64 -# }; -# -# use TQt::enumerations MyInfo => [qw(Foo Bar Baz)]; -# -1; diff --git a/PerlQt/lib/Qt/isa.pm b/PerlQt/lib/Qt/isa.pm deleted file mode 100644 index 71e9391..0000000 --- a/PerlQt/lib/Qt/isa.pm +++ /dev/null @@ -1,81 +0,0 @@ -package TQt::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{"TQt/isa.pm"}; - } - - for my $super (@_) { - push @{ $caller . '::ISA' }, $super; - push @{ ${$caller . '::META'}{'superClass'} }, $super; # if isa(TQObject)? - } - - *{ $caller . '::className' } = sub { # closure on $caller - return $caller; - }; - - ${ $caller. '::_INTERNAL_STATIC_'}{'SUPER'} = bless {}, " $caller"; - TQt::_internal::installsuper($caller) unless defined &{ $caller.'::SUPER' }; - - *{ $caller . '::metaObject' } = sub { - TQt::_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 }) - { - TQt::_internal::installattribute($incaller, $attribute); - ${ ${$incaller .'::META'}{'attributes'} }{$attribute} = 1; - } - } - } - }; - - TQt::_internal::installautoload(" $caller"); - TQt::_internal::installautoload(" $caller"); - TQt::_internal::installautoload($caller); - { - package TQt::AutoLoad; - my $autosub = \&{ " $caller\::_UTOLOAD" }; - *{ " $caller\::AUTOLOAD" } = sub { &$autosub }; - $autosub = \&{ " $caller\::_UTOLOAD" }; - *{ " $caller\::AUTOLOAD" } = sub { &$autosub }; - $autosub = \&{ "$caller\::_UTOLOAD" }; - *{ "$caller\::AUTOLOAD" } = sub { &$autosub }; - } - TQt::_internal::installthis($caller); - - # operator overloading - *{ " $caller\::ISA" } = ["TQt::base::_overload"]; -} - -1; diff --git a/PerlQt/lib/Qt/properties.pm b/PerlQt/lib/Qt/properties.pm deleted file mode 100644 index 951cdb6..0000000 --- a/PerlQt/lib/Qt/properties.pm +++ /dev/null @@ -1,14 +0,0 @@ -package TQt::properties; -# -# Proposed usage: -# -# use TQt::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 deleted file mode 100644 index 1f454c1..0000000 --- a/PerlQt/lib/Qt/signals.pm +++ /dev/null @@ -1,77 +0,0 @@ -package TQt::signals; -use Carp; -# -# Proposed usage: -# -# use TQt::signals fooActivated => ['int']; -# -# use TQt::signals fooActivated => { -# name => 'fooActivated(int)', -# args => ['int'] -# }; -# -# sub whatever { emit fooActivated(10); } -# - -sub import { - no strict 'refs'; - my $self = shift; - my $caller = $self eq "TQt::signals" ? (caller)[0] : $self; - my $parent = ${ $caller . '::ISA' }[0]; - my $parent_qt_emit = $parent . '::qt_emit'; - - TQt::_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) { -# TQt::_internal::invoke(TQt::this(), $meta->{signals}[$offset], $_[1]); -# return 1; -# } else { -# TQt::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 = TQt::_internal::allocateMocArguments($argcnt); - my $i = 0; - for my $arg (@$args) { - my $a = $arg; - $a =~ s/^const\s+//; - if($a =~ /^(bool|int|double|char\*|TQString)&?$/) { - $a = $1; - } else { - $a = 'ptr'; - } - my $valid = TQt::_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; - - TQt::_internal::installsignal("$caller\::$signalname"); - } - @_ and $meta->{changed} = 1; -} - -1; diff --git a/PerlQt/lib/Qt/slots.pm b/PerlQt/lib/Qt/slots.pm deleted file mode 100644 index c12990e..0000000 --- a/PerlQt/lib/Qt/slots.pm +++ /dev/null @@ -1,84 +0,0 @@ -package TQt::slots; -use Carp; -# -# Proposed usage: -# -# use TQt::slots changeSomething => ['int']; -# -# use TQt::slots 'changeSomething(int)' => { -# args => ['int'], -# call => 'changeSomething' -# }; -# - -sub import { - no strict 'refs'; - my $self = shift; - my $caller = $self eq "TQt::slots" ? (caller)[0] : $self; - my $parent = ${ $caller . '::ISA' }[0]; - my $parent_qt_invoke = $parent . '::qt_invoke'; - - TQt::_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) { -# TQt::_internal::invoke(TQt::this(), $meta->{slots}[$offset], $_[1]); -# return 1; -# } else { -# TQt::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 = TQt::_internal::allocateMocArguments($argcnt); - my $i = 0; - for my $arg (@$args) { - my $a = $arg; - $a =~ s/^const\s+//; - if($a =~ /^(bool|int|double|char\*|TQString)&?$/) { - $a = $1; - } else { - $a = 'ptr'; - } - my $valid = TQt::_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 deleted file mode 100644 index 55be867..0000000 --- a/PerlQt/marshall.h +++ /dev/null @@ -1,44 +0,0 @@ -#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 deleted file mode 100644 index 7eb240a..0000000 --- a/PerlQt/perlqt.h +++ /dev/null @@ -1,54 +0,0 @@ -#ifndef PERLTQT_H -#define PERLTQT_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/TQt/debug.pm - -enum TQtDebugChannel { - 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 // PERLTQT_H diff --git a/PerlQt/smokeperl.cpp b/PerlQt/smokeperl.cpp deleted file mode 100644 index 1998c85..0000000 --- a/PerlQt/smokeperl.cpp +++ /dev/null @@ -1,426 +0,0 @@ -#include "smokeperl.h" - -class SmokePerlTQt : public SmokePerl { -public: - SmokePerlTQt(); - virtual ~SmokePerlTQt(); - - 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 TQt:: - if(!strcmp(c.className(), "TQt")) - return gv_stashpv(c.className(), TRUE); - - SV *name = newSVpv("TQt::", 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 SmokeBindingTQt : public SmokeBinding { - SmokePerlTQt *_smokeperl; -public: - SmokeBindingTQt(Smoke *s, SmokePerlTQt *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, " TQt::"); - strcat(buf, className + 1); - return buf; - } -}; - -SmokePerlTQt::SmokePerlTQt() { - _registered_smoke = newHV(); - _registered_handlers = newHV(); - _remembered_pointers = newHV(); -} - -SmokePerlTQt::~SmokePerlTQt() { - SvREFCNT_dec((SV*)_registered_smoke); - SvREFCNT_dec((SV*)_registered_handlers); - SvREFCNT_dec((SV*)_remembered_pointers); -} - -void SmokePerlTQt::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 SmokeBindingTQt(smoke, this); -} - -Smoke *SmokePerlTQt::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 SmokePerlTQt::registerHandlers(TypeHandler *h) { - while(h->name) { - hv_store(_registered_handlers, h->name, strlen(h->name), newSViv((IV)h->fn), 0); - h++; - } -} - -SmokeObject SmokePerlTQt::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 SmokePerlTQt::newObject(void *p, const SmokeClass &c) { - SmokeObject o = createObject(p, c); - - if(c.isVirtual()) - rememberPointer(o); - o.setAllocated(true); - - return o; -} - -SmokeObject SmokePerlTQt::wrapObject(void *p, const SmokeClass &c) { - SmokeObject o = createObject(p, c); - return o; -} - -void SmokePerlTQt::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 SmokePerlTQt::rememberPointer(SmokeObject &o) { - rememberPointer(o, o.c(), true); -} - -void SmokePerlTQt::forgetPointer(SmokeObject &o) { - rememberPointer(o, o.c(), false); -} - -SmokeObject SmokePerlTQt::getObject(SV *sv) { - MAGIC *mg = mg_find(SvRV(sv), '~'); - Smoke_MAGIC *m = (Smoke_MAGIC*)mg->mg_ptr; - return SmokeObject(sv, m); -} - -SmokeObject SmokePerlTQt::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 deleted file mode 100644 index 21e8298..0000000 --- a/PerlQt/smokeperl.h +++ /dev/null @@ -1,281 +0,0 @@ -#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 deleted file mode 100644 index 9d79fba..0000000 --- a/PerlQt/t/Foo/SubCodec.pm +++ /dev/null @@ -1,14 +0,0 @@ -package Foo::SubCodec; -use TQt; -use My::Codec; -use TQt::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 deleted file mode 100644 index f853f5d..0000000 --- a/PerlQt/t/My/Codec.pm +++ /dev/null @@ -1,10 +0,0 @@ -package My::Codec; -use TQt; -use TQt::isa qw( TQt::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 deleted file mode 100644 index 35e2b0c..0000000 --- a/PerlQt/t/My/SubCodec.pm +++ /dev/null @@ -1,15 +0,0 @@ - -package My::SubCodec; -use TQt; -use My::Codec; -use TQt::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 deleted file mode 100644 index 1cffc31..0000000 --- a/PerlQt/t/a_loading.t +++ /dev/null @@ -1,6 +0,0 @@ - -BEGIN { print "1..1\n" } - -use TQt; - -print "ok 1\n" diff --git a/PerlQt/t/b_nogui.t b/PerlQt/t/b_nogui.t deleted file mode 100644 index cd28260..0000000 --- a/PerlQt/t/b_nogui.t +++ /dev/null @@ -1,48 +0,0 @@ - -BEGIN { print "1..6\n" } - -use TQt; -use TQt::constants; - -eval {my $c = TQt::TextCodec::codecForLocale()}; - -print +$@ ? "not ok\n" : "ok 1\n"; - -eval {my $s = TQt::Variant( TQt::DateTime::currentDateTime() ) }; - -print +$@ ? "not ok\n" : "ok 2\n"; - -my $ret; -eval {$ret = TQt::Point(20,20); $ret += TQt::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 = TQt::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 = TQt::Point( 20, 20 ); - my $p2 = TQt::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 = TQt::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 deleted file mode 100644 index 01d6b39..0000000 --- a/PerlQt/t/c_qapp.t +++ /dev/null @@ -1,23 +0,0 @@ -BEGIN { print "1..3\n" } - -use TQt; - -$a=0; - -# testing if the TQt::Application ctor works - -eval { $a=TQt::Application(\@ARGV) }; - -print +$@ ? "not ok\n" : "ok 1\n"; - -# testing wether the global object is properly setup - -eval { TQt::app()->libraryPaths() }; - -print +$@ ? "not ok\n" : "ok 2\n"; - -# one second test of the event loop - -TQt::Timer::singleShot( 300, TQt::app(), TQT_SLOT "quit()" ); - -print TQt::app()->exec ? "not ok\n" : "ok 3\n"; diff --git a/PerlQt/t/ca_i18n.t b/PerlQt/t/ca_i18n.t deleted file mode 100644 index 1e71c29..0000000 --- a/PerlQt/t/ca_i18n.t +++ /dev/null @@ -1,23 +0,0 @@ -BEGIN { print "1..1\n" } - -use TQt; - -$a = TQt::Application(); -$pb=TQt::PushButton("Foooo", undef); - -{ - use bytes; - $pb->setText( "�l�gant" ); - - $b = $pb->text(); - $b2 = TQt::Widget::tr("�l�gant"); -} - - -$c = $pb->text(); -$c2= TQt::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 deleted file mode 100644 index acd3c4a..0000000 --- a/PerlQt/t/d_sigslot.t +++ /dev/null @@ -1,49 +0,0 @@ -BEGIN { print "1..3\n" } - -package MyApp; -use TQt; -use TQt::isa qw(TQt::Application); -use TQt::slots - foo => ['int'], - baz => []; -use TQt::signals - bar => ['int']; - -sub NEW { - shift->SUPER::NEW(@_); - - # 1) testing correct subclassing of TQt::Application and this pointer - print +(ref(this) eq " MyApp")? "ok 1\n" : "not ok\n"; - - this->connect(this, TQT_SIGNAL 'bar(int)', TQT_SLOT 'foo(int)'); - - # 3) automatic quitting will test TQt sig to custom slot - this->connect(this, TQT_SIGNAL 'aboutToQuit()', TQT_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 TQt; -use MyApp; - -$a = 0; -$a = MyApp(\@ARGV); - -TQt::Timer::singleShot( 300, TQt::app(), TQT_SLOT "quit()" ); - -exit TQt::app()->exec; diff --git a/PerlQt/t/e_sigslot_inherit.t b/PerlQt/t/e_sigslot_inherit.t deleted file mode 100644 index 338a405..0000000 --- a/PerlQt/t/e_sigslot_inherit.t +++ /dev/null @@ -1,72 +0,0 @@ -BEGIN { print "1..6\n" } - -package MyApp; -use TQt; -use TQt::isa('TQt::Application'); -use TQt::slots - foo => ['int'], - baz => []; -use TQt::signals - bar => ['int']; - -sub NEW -{ - shift->SUPER::NEW(@_); - this->connect(this, TQT_SIGNAL 'bar(int)', TQT_SLOT 'foo(int)'); - this->connect(this, TQT_SIGNAL 'aboutToQuit()', TQT_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 TQt; -use TQt::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 TQt; -use MySubApp; - -$a = 0; -$a = MySubApp(\@ARGV); - -TQt::Timer::singleShot( 300, TQt::app(), TQT_SLOT "quit()" ); - -exit TQt::app()->exec; diff --git a/PerlQt/t/f_import.t b/PerlQt/t/f_import.t deleted file mode 100644 index 9f8977c..0000000 --- a/PerlQt/t/f_import.t +++ /dev/null @@ -1,19 +0,0 @@ -BEGIN { push @INC, "./t" ; print "1..1\n" } - -package main; - -use TQt; -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 deleted file mode 100644 index f3a7d05..0000000 --- a/PerlQt/t/g_gui.t +++ /dev/null @@ -1,127 +0,0 @@ - -BEGIN { print "1..1\n" } - -package ButtonsGroups; -use strict; -use TQt; -use TQt::isa qw(TQt::Widget); -use TQt::slots - slotChangeGrp3State => []; -use TQt::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 = TQt::VBoxLayout(this); - my $box1 = TQt::HBoxLayout($vbox); - my $box2 = TQt::HBoxLayout($vbox); - - # ------- first group - - # Create an exclusive button group - my $bgrp1 = TQt::ButtonGroup(1, &Horizontal, "Button Group &1 (exclusive)", this); - $box1->addWidget($bgrp1); - $bgrp1->setExclusive(1); - - # insert 3 radiobuttons - TQt::RadioButton("R&adiobutton 2", $bgrp1); - TQt::RadioButton("Ra&diobutton 3", $bgrp1); - - # ------- second group - - # Create a non-exclusive buttongroup - my $bgrp2 = TQt::ButtonGroup(1, &Horizontal, "Button Group &2 (non-exclusive)", this); - $box1->addWidget($bgrp2); - $bgrp2->setExclusive(0); - - # insert 3 checkboxes - TQt::CheckBox("&Checkbox 1", $bgrp2); - my $cb12 = TQt::CheckBox("C&heckbox 2", $bgrp2); - $cb12->setChecked(1); - my $cb13 = TQt::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 = TQt::ButtonGroup(1, &Horizontal, "Button Group &3 (Radiobutton-exclusive)", this); - $box2->addWidget($bgrp3); - $bgrp3->setRadioButtonExclusive(1); - - # insert three radiobuttons - rb21 = TQt::RadioButton("Rad&iobutton 1", $bgrp3); - rb22 = TQt::RadioButton("Radi&obutton 2", $bgrp3); - rb23 = TQt::RadioButton("Radio&button 3", $bgrp3); - rb23->setChecked(1); - - # insert a checkbox - state = TQt::CheckBox("E&nable Radiobuttons", $bgrp3); - state->setChecked(1); - # ...and connect its TQT_SIGNAL clicked() with the TQT_SLOT slotChangeGrp3State() - this->connect(state, TQT_SIGNAL('clicked()'), TQT_SLOT('slotChangeGrp3State()')); - - # ----------- fourth group - - # create a groupbox which layouts its childs in a columns - my $bgrp4 = TQt::ButtonGroup(1, &Horizontal, "Groupbox with &normal buttons", this); - $box2->addWidget($bgrp4); - - # insert three pushbuttons... - TQt::PushButton("&Push Button", $bgrp4); - my $tb2 = TQt::PushButton("&Toggle Button", $bgrp4); - my $tb3 = TQt::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); -} - -# -# TQT_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 TQt; -use ButtonsGroups; - -TQt::StyleFactory::keys(); # disable style plugins (hacky) - -my $a = TQt::Application(\@ARGV); - -my $buttonsgroups = ButtonsGroups; -$buttonsgroups->resize(500, 250); -$buttonsgroups->setCaption("PerlTQt Test - Please wait"); -$a->setMainWidget($buttonsgroups); -$buttonsgroups->show; - -TQt::Timer::singleShot( 2000, TQt::app(), TQT_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 deleted file mode 100644 index d0363f1..0000000 --- a/PerlQt/tutorials/runall.pl +++ /dev/null @@ -1,8 +0,0 @@ -#!/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 deleted file mode 100644 index 96c7153..0000000 --- a/PerlQt/tutorials/t1/t1.pl +++ /dev/null @@ -1,13 +0,0 @@ -#!/usr/bin/perl -w -use strict; -use blib; -use TQt; - -my $a = TQt::Application(\@ARGV); - -my $hello = TQt::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 deleted file mode 100644 index 08b2e10..0000000 --- a/PerlQt/tutorials/t10/CannonField.pm +++ /dev/null @@ -1,76 +0,0 @@ -package CannonField; -use strict; -use TQt; -use TQt::isa qw(TQt::Widget); -use TQt::signals - angleChanged => ['int'], - forceChanged => ['int']; -use TQt::slots - setAngle => ['int'], - setForce => ['int']; -use TQt::attributes qw( - ang - f -); -use POSIX qw(atan); - -sub angle () { ang } -sub force () { f } - -sub NEW { - shift->SUPER::NEW(@_); - - ang = 45; - f = 0; - setPalette(TQt::Palette(TQt::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 = TQt::Pixmap($cr->size); - $pix->fill(this, $cr->topLeft); - - my $p = TQt::Painter($pix); - $p->setBrush(&blue); - $p->setPen(&NoPen); - $p->translate(0, $pix->height - 1); - $p->drawPie(TQt::Rect(-35, -35, 70, 70), 0, 90*16); - $p->rotate(- ang); - $p->drawRect(TQt::Rect(33, -4, 15, 8)); - $p->end; - - $p->begin(this); - $p->drawPixmap($cr->topLeft, $pix); -} - -sub cannonRect { - my $r = TQt::Rect(0, 0, 50, 50); - $r->moveBottomLeft(rect()->bottomLeft); - return $r; -} - -sub sizePolicy { - TQt::SizePolicy(&TQt::SizePolicy::Expanding, &TQt::SizePolicy::Expanding); -} - -1; diff --git a/PerlQt/tutorials/t10/LCDRange.pm b/PerlQt/tutorials/t10/LCDRange.pm deleted file mode 100644 index ab63af0..0000000 --- a/PerlQt/tutorials/t10/LCDRange.pm +++ /dev/null @@ -1,43 +0,0 @@ -package LCDRange; -use strict; -use TQt; -use TQt::isa qw(TQt::VBox); -use TQt::slots - setValue => ['int'], - setRange => ['int', 'int']; -use TQt::signals - valueChanged => ['int']; -use TQt::attributes qw( - slider -); - -sub NEW { - shift->SUPER::NEW(@_); - - my $lcd = TQt::LCDNumber(2, this, "lcd"); - - slider = TQt::Slider(&Horizontal, this, "slider"); - slider->setRange(0, 99); - slider->setValue(0); - $lcd->connect(slider, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('display(int)')); - this->connect(slider, TQT_SIGNAL('valueChanged(int)'), TQT_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 deleted file mode 100644 index 7056680..0000000 --- a/PerlQt/tutorials/t10/t10.pl +++ /dev/null @@ -1,61 +0,0 @@ -#!/usr/bin/perl -w -use strict; -use blib; - -package MyWidget; -use strict; -use TQt; -use TQt::isa qw(TQt::Widget); - -use LCDRange; -use CannonField; - -sub NEW { - shift->SUPER::NEW(@_); - - my $quit = TQt::PushButton("&Quit", this, "quit"); - $quit->setFont(TQt::Font("Times", 18, &TQt::Font::Bold)); - - TQt::app->connect($quit, TQT_SIGNAL('clicked()'), TQT_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, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('setAngle(int)')); - $angle->connect($cannonField, TQT_SIGNAL('angleChanged(int)'), TQT_SLOT('setValue(int)')); - - $cannonField->connect($force, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('setForce(int)')); - $force->connect($cannonField, TQT_SIGNAL('forceChanged(int)'), TQT_SLOT('setValue(int)')); - - my $grid = TQt::GridLayout(this, 2, 2, 10); - $grid->addWidget($quit, 0, 0); - $grid->addWidget($cannonField, 1, 1); - $grid->setColStretch(1, 10); - - my $leftBox = TQt::VBoxLayout; - $grid->addLayout($leftBox, 1, 0); - $leftBox->addWidget($angle); - $leftBox->addWidget($force); - - $angle->setValue(60); - $force->setValue(25); - $angle->setFocus(); -} - -package main; -use TQt; -use MyWidget; - -TQt::Application::setColorSpec(&TQt::Application::CustomColor); -my $a = TQt::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 deleted file mode 100644 index 0806f66..0000000 --- a/PerlQt/tutorials/t11/CannonField.pm +++ /dev/null @@ -1,146 +0,0 @@ -package CannonField; -use strict; -use TQt; -use TQt::isa qw(TQt::Widget); -use TQt::signals - angleChanged => ['int'], - forceChanged => ['int']; -use TQt::slots - setAngle => ['int'], - setForce => ['int'], - shoot => [], - moveShot => []; -use TQt::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 = TQt::Timer(this, "movement handler"); - this->connect(autoShootTimer, TQT_SIGNAL('timeout()'), TQT_SLOT('moveShot()')); - shoot_ang = 0; - shoot_f = 0; - setPalette(TQt::Palette(TQt::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 = TQt::Region(shotRect()); - timerCount++; - - my $shotR = shotRect(); - - if($shotR->x > width() || $shotR->y > height()) { - autoShootTimer->stop; - } else { - $r = $r->unite(TQt::Region($shotR)); - } - repaint($r); -} - -sub paintEvent { - my $e = shift; - my $updateR = $e->rect; - my $p = TQt::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 = TQt::Rect(33, -4, 15, 8); - -sub paintCannon { - my $p = shift; - my $cr = cannonRect(); - my $pix = TQt::Pixmap($cr->size); - $pix->fill(this, $cr->topLeft); - - my $tmp = TQt::Painter($pix); - $tmp->setBrush(&blue); - $tmp->setPen(&NoPen); - - $tmp->translate(0, $pix->height - 1); - $tmp->drawPie(TQt::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 = TQt::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 = TQt::Rect(0, 0, 6, 6); - $r->moveCenter(TQt::Point(int($x), height() - 1 - int($y))); - return $r; -} - -sub sizePolicy { - TQt::SizePolicy(&TQt::SizePolicy::Expanding, &TQt::SizePolicy::Expanding); -} - -1; diff --git a/PerlQt/tutorials/t11/LCDRange.pm b/PerlQt/tutorials/t11/LCDRange.pm deleted file mode 100644 index ab63af0..0000000 --- a/PerlQt/tutorials/t11/LCDRange.pm +++ /dev/null @@ -1,43 +0,0 @@ -package LCDRange; -use strict; -use TQt; -use TQt::isa qw(TQt::VBox); -use TQt::slots - setValue => ['int'], - setRange => ['int', 'int']; -use TQt::signals - valueChanged => ['int']; -use TQt::attributes qw( - slider -); - -sub NEW { - shift->SUPER::NEW(@_); - - my $lcd = TQt::LCDNumber(2, this, "lcd"); - - slider = TQt::Slider(&Horizontal, this, "slider"); - slider->setRange(0, 99); - slider->setValue(0); - $lcd->connect(slider, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('display(int)')); - this->connect(slider, TQT_SIGNAL('valueChanged(int)'), TQT_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 deleted file mode 100644 index d493b1e..0000000 --- a/PerlQt/tutorials/t11/t11.pl +++ /dev/null @@ -1,71 +0,0 @@ -#!/usr/bin/perl -w -use strict; -use blib; - -package MyWidget; -use strict; -use TQt; -use TQt::isa qw(TQt::Widget); - -use LCDRange; -use CannonField; - -sub NEW { - shift->SUPER::NEW(@_); - - my $quit = TQt::PushButton("&Quit", this, "quit"); - $quit->setFont(TQt::Font("Times", 18, &TQt::Font::Bold)); - - TQt::app->connect($quit, TQT_SIGNAL('clicked()'), TQT_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, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('setAngle(int)')); - $angle->connect($cannonField, TQT_SIGNAL('angleChanged(int)'), TQT_SLOT('setValue(int)')); - - $cannonField->connect($force, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('setForce(int)')); - $force->connect($cannonField, TQT_SIGNAL('forceChanged(int)'), TQT_SLOT('setValue(int)')); - - my $shoot = TQt::PushButton('&Shoot', this, "shoot"); - $shoot->setFont(TQt::Font("Times", 18, &TQt::Font::Bold)); - - $cannonField->connect($shoot, TQT_SIGNAL('clicked()'), TQT_SLOT('shoot()')); - - my $grid = TQt::GridLayout(this, 2, 2, 10); - $grid->addWidget($quit, 0, 0); - $grid->addWidget($cannonField, 1, 1); - $grid->setColStretch(1, 10); - - my $leftBox = TQt::VBoxLayout; - $grid->addLayout($leftBox, 1, 0); - $leftBox->addWidget($angle); - $leftBox->addWidget($force); - - my $topBox = TQt::HBoxLayout; - $grid->addLayout($topBox, 0, 1); - $topBox->addWidget($shoot); - $topBox->addStretch(1); - - $angle->setValue(60); - $force->setValue(25); - $angle->setFocus(); -} - -package main; -use TQt; -use MyWidget; - -TQt::Application::setColorSpec(&TQt::Application::CustomColor); -my $a = TQt::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 deleted file mode 100644 index 6cc1529..0000000 --- a/PerlQt/tutorials/t12/CannonField.pm +++ /dev/null @@ -1,177 +0,0 @@ -package CannonField; -use strict; -use TQt; -use TQt::isa qw(TQt::Widget); -use TQt::signals - hit => [], - missed => [], - angleChanged => ['int'], - forceChanged => ['int']; -use TQt::slots - setAngle => ['int'], - setForce => ['int'], - shoot => [], - moveShot => []; -use TQt::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 = TQt::Timer(this, "movement handler"); - this->connect(autoShootTimer, TQT_SIGNAL('timeout()'), TQT_SLOT('moveShot()')); - shoot_ang = 0; - shoot_f = 0; - target = TQt::Point(0, 0); - setPalette(TQt::Palette(TQt::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 = TQt::Region(targetRect()); - target = TQt::Point(200 + int(rand(190)), - 10 + int(rand(255))); - repaint($r->unite(TQt::Region(targetRect()))); -} - -sub moveShot { - my $r = TQt::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(TQt::Region($shotR)); - } - repaint($r); -} - -sub paintEvent { - my $e = shift; - my $updateR = $e->rect; - my $p = TQt::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 = TQt::Rect(33, -4, 15, 8); - -sub paintCannon { - my $p = shift; - my $cr = cannonRect(); - my $pix = TQt::Pixmap($cr->size); - $pix->fill(this, $cr->topLeft); - - my $tmp = TQt::Painter($pix); - $tmp->setBrush(&blue); - $tmp->setPen(&NoPen); - - $tmp->translate(0, $pix->height - 1); - $tmp->drawPie(TQt::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 = TQt::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 = TQt::Rect(0, 0, 6, 6); - $r->moveCenter(TQt::Point(int($x), height() - 1 - int($y))); - return $r; -} - -sub targetRect { - my $r = TQt::Rect(0, 0, 20, 10); - $r->moveCenter(TQt::Point(target->x, height() - 1 - target->y)); - return $r; -} - -sub sizePolicy { - TQt::SizePolicy(&TQt::SizePolicy::Expanding, &TQt::SizePolicy::Expanding); -} - -1; diff --git a/PerlQt/tutorials/t12/LCDRange.pm b/PerlQt/tutorials/t12/LCDRange.pm deleted file mode 100644 index d3a5166..0000000 --- a/PerlQt/tutorials/t12/LCDRange.pm +++ /dev/null @@ -1,62 +0,0 @@ -package LCDRange; -use strict; -use TQt; -use TQt::isa qw(TQt::VBox); -use TQt::slots - setValue => ['int'], - setRange => ['int', 'int'], - setText => ['const char*']; -use TQt::signals - valueChanged => ['int']; -use TQt::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 = TQt::LCDNumber(2, this, "lcd"); - - slider = TQt::Slider(&Horizontal, this, "slider"); - slider->setRange(0, 99); - slider->setValue(0); - - label = TQt::Label(" ", this, "label"); - label->setAlignment(&AlignCenter); - - $lcd->connect(slider, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('display(int)')); - this->connect(slider, TQT_SIGNAL('valueChanged(int)'), TQT_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 deleted file mode 100644 index e8072ef..0000000 --- a/PerlQt/tutorials/t12/t12.pl +++ /dev/null @@ -1,71 +0,0 @@ -#!/usr/bin/perl -w -use strict; -use blib; - -package MyWidget; -use strict; -use TQt; -use TQt::isa qw(TQt::Widget); - -use LCDRange; -use CannonField; - -sub NEW { - shift->SUPER::NEW(@_); - - my $quit = TQt::PushButton("&Quit", this, "quit"); - $quit->setFont(TQt::Font("Times", 18, &TQt::Font::Bold)); - - TQt::app->connect($quit, TQT_SIGNAL('clicked()'), TQT_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, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('setAngle(int)')); - $angle->connect($cannonField, TQT_SIGNAL('angleChanged(int)'), TQT_SLOT('setValue(int)')); - - $cannonField->connect($force, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('setForce(int)')); - $force->connect($cannonField, TQT_SIGNAL('forceChanged(int)'), TQT_SLOT('setValue(int)')); - - my $shoot = TQt::PushButton('&Shoot', this, "shoot"); - $shoot->setFont(TQt::Font("Times", 18, &TQt::Font::Bold)); - - $cannonField->connect($shoot, TQT_SIGNAL('clicked()'), TQT_SLOT('shoot()')); - - my $grid = TQt::GridLayout(this, 2, 2, 10); - $grid->addWidget($quit, 0, 0); - $grid->addWidget($cannonField, 1, 1); - $grid->setColStretch(1, 10); - - my $leftBox = TQt::VBoxLayout; - $grid->addLayout($leftBox, 1, 0); - $leftBox->addWidget($angle); - $leftBox->addWidget($force); - - my $topBox = TQt::HBoxLayout; - $grid->addLayout($topBox, 0, 1); - $topBox->addWidget($shoot); - $topBox->addStretch(1); - - $angle->setValue(60); - $force->setValue(25); - $angle->setFocus(); -} - -package main; -use TQt; -use MyWidget; - -TQt::Application::setColorSpec(&TQt::Application::CustomColor); -my $a = TQt::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 deleted file mode 100644 index ec220bc..0000000 --- a/PerlQt/tutorials/t13/CannonField.pm +++ /dev/null @@ -1,207 +0,0 @@ -package CannonField; -use strict; -use TQt; -use TQt::isa qw(TQt::Widget); -use TQt::signals - hit => [], - missed => [], - angleChanged => ['int'], - forceChanged => ['int'], - canShoot => ['bool']; -use TQt::slots - setAngle => ['int'], - setForce => ['int'], - shoot => [], - moveShot => [], - newTarget => []; -use TQt::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 = TQt::Timer(this, "movement handler"); - this->connect(autoShootTimer, TQT_SIGNAL('timeout()'), TQT_SLOT('moveShot()')); - shoot_ang = 0; - shoot_f = 0; - target = TQt::Point(0, 0); - gameEnded = 0; - setPalette(TQt::Palette(TQt::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 = TQt::Region(targetRect()); - target = TQt::Point(200 + int(rand(190)), - 10 + int(rand(255))); - repaint($r->unite(TQt::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 = TQt::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(TQt::Region($shotR)); - } - repaint($r); -} - -sub paintEvent { - my $e = shift; - my $updateR = $e->rect; - my $p = TQt::Painter(this); - - if(gameEnded) { - $p->setPen(&black); - $p->setFont(TQt::Font("Courier", 48, &TQt::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 = TQt::Rect(33, -4, 15, 8); - -sub paintCannon { - my $p = shift; - my $cr = cannonRect(); - my $pix = TQt::Pixmap($cr->size); - $pix->fill(this, $cr->topLeft); - - my $tmp = TQt::Painter($pix); - $tmp->setBrush(&blue); - $tmp->setPen(&NoPen); - - $tmp->translate(0, $pix->height - 1); - $tmp->drawPie(TQt::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 = TQt::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 = TQt::Rect(0, 0, 6, 6); - $r->moveCenter(TQt::Point(int($x), height() - 1 - int($y))); - return $r; -} - -sub targetRect { - my $r = TQt::Rect(0, 0, 20, 10); - $r->moveCenter(TQt::Point(target->x, height() - 1 - target->y)); - return $r; -} - -sub isShooting { autoShootTimer->isActive } - -sub sizePolicy { - TQt::SizePolicy(&TQt::SizePolicy::Expanding, &TQt::SizePolicy::Expanding); -} - -1; diff --git a/PerlQt/tutorials/t13/GameBoard.pm b/PerlQt/tutorials/t13/GameBoard.pm deleted file mode 100644 index 52f5e9b..0000000 --- a/PerlQt/tutorials/t13/GameBoard.pm +++ /dev/null @@ -1,114 +0,0 @@ -package GameBoard; -use strict; -use TQt; -use TQt::isa qw(TQt::Widget); -use TQt::slots - fire => [], - hit => [], - missed => [], - newGame => []; -use TQt::attributes qw( - hits - shotsLeft - cannonField -); - -use LCDRange; -use CannonField; - -sub NEW { - shift->SUPER::NEW(@_); - - my $quit = TQt::PushButton("&Quit", this, "quit"); - $quit->setFont(TQt::Font("Times", 18, &TQt::Font::Bold)); - - TQt::app->connect($quit, TQT_SIGNAL('clicked()'), TQT_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, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('setAngle(int)')); - $angle->connect(cannonField, TQT_SIGNAL('angleChanged(int)'), TQT_SLOT('setValue(int)')); - - cannonField->connect($force, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('setForce(int)')); - $force->connect(cannonField, TQT_SIGNAL('forceChanged(int)'), TQT_SLOT('setValue(int)')); - - this->connect(cannonField, TQT_SIGNAL('hit()'), TQT_SLOT('hit()')); - this->connect(cannonField, TQT_SIGNAL('missed()'), TQT_SLOT('missed()')); - - my $shoot = TQt::PushButton('&Shoot', this, "shoot"); - $shoot->setFont(TQt::Font("Times", 18, &TQt::Font::Bold)); - - this->connect($shoot, TQT_SIGNAL('clicked()'), TQT_SLOT('fire()')); - - $shoot->connect(cannonField, TQT_SIGNAL('canShoot(bool)'), TQT_SLOT('setEnabled(bool)')); - - my $restart = TQt::PushButton('&New Game', this, "newgame"); - $restart->setFont(TQt::Font("Times", 18, &TQt::Font::Bold)); - - this->connect($restart, TQT_SIGNAL('clicked()'), TQT_SLOT('newGame()')); - - hits = TQt::LCDNumber(2, this, "hits"); - shotsLeft = TQt::LCDNumber(2, this, "shotsleft"); - my $hitsL = TQt::Label("HITS", this, "hitsLabel"); - my $shotsLeftL = TQt::Label("SHOTS LEFT", this, "shotsLeftLabel"); - - my $grid = TQt::GridLayout(this, 2, 2, 10); - $grid->addWidget($quit, 0, 0); - $grid->addWidget(cannonField, 1, 1); - $grid->setColStretch(1, 10); - - my $leftBox = TQt::VBoxLayout; - $grid->addLayout($leftBox, 1, 0); - $leftBox->addWidget($angle); - $leftBox->addWidget($force); - - my $topBox = TQt::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 deleted file mode 100644 index 1647e85..0000000 --- a/PerlQt/tutorials/t13/LCDRange.pm +++ /dev/null @@ -1,67 +0,0 @@ -package LCDRange; -use strict; -use TQt; -use TQt::isa qw(TQt::Widget); -use TQt::slots - setValue => ['int'], - setRange => ['int', 'int'], - setText => ['const char*']; -use TQt::signals - valueChanged => ['int']; -use TQt::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 = TQt::LCDNumber(2, this, "lcd"); - - slider = TQt::Slider(&Horizontal, this, "slider"); - slider->setRange(0, 99); - slider->setValue(0); - - label = TQt::Label(" ", this, "label"); - label->setAlignment(&AlignCenter); - - $lcd->connect(slider, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('display(int)')); - this->connect(slider, TQT_SIGNAL('valueChanged(int)'), TQT_SIGNAL('valueChanged(int)')); - - setFocusProxy(slider); - - my $l = TQt::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 deleted file mode 100644 index ef412ab..0000000 --- a/PerlQt/tutorials/t13/t13.pl +++ /dev/null @@ -1,14 +0,0 @@ -#!/usr/bin/perl -w -use strict; -use blib; -use TQt; -use GameBoard; - -TQt::Application::setColorSpec(&TQt::Application::CustomColor); -my $a = TQt::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 deleted file mode 100644 index cbf675d..0000000 --- a/PerlQt/tutorials/t14/CannonField.pm +++ /dev/null @@ -1,256 +0,0 @@ -package CannonField; -use strict; -use TQt; -use TQt::isa qw(TQt::Widget); -use TQt::signals - hit => [], - missed => [], - angleChanged => ['int'], - forceChanged => ['int'], - canShoot => ['bool']; -use TQt::slots - setAngle => ['int'], - setForce => ['int'], - shoot => [], - moveShot => [], - newTarget => [], - setGameOver => [], - restartGame => []; -use TQt::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 = TQt::Timer(this, "movement handler"); - this->connect(autoShootTimer, TQT_SIGNAL('timeout()'), TQT_SLOT('moveShot()')); - shoot_ang = 0; - shoot_f = 0; - target = TQt::Point(0, 0); - gameEnded = 0; - barrelPressed = 0; - setPalette(TQt::Palette(TQt::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 = TQt::Region(targetRect()); - target = TQt::Point(200 + int(rand(190)), - 10 + int(rand(255))); - repaint($r->unite(TQt::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 = TQt::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(TQt::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 = TQt::Painter(this); - - if(gameEnded) { - $p->setPen(&black); - $p->setFont(TQt::Font("Courier", 48, &TQt::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 = TQt::Rect(33, -4, 15, 8); - -sub paintCannon { - my $p = shift; - my $cr = cannonRect(); - my $pix = TQt::Pixmap($cr->size); - $pix->fill(this, $cr->topLeft); - - my $tmp = TQt::Painter($pix); - $tmp->setBrush(&blue); - $tmp->setPen(&NoPen); - - $tmp->translate(0, $pix->height - 1); - $tmp->drawPie(TQt::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 = TQt::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 = TQt::Rect(0, 0, 6, 6); - $r->moveCenter(TQt::Point(int($x), height() - 1 - int($y))); - return $r; -} - -sub targetRect { - my $r = TQt::Rect(0, 0, 20, 10); - $r->moveCenter(TQt::Point(target->x, height() - 1 - target->y)); - return $r; -} - -sub barrierRect { - return TQt::Rect(145, height() - 100, 15, 100); -} - -sub barrelHit { - my $p = shift; - my $mtx = TQt::WMatrix; - $mtx->translate(0, height() - 1); - $mtx->rotate(- ang); - $mtx = $mtx->invert; - return $barrelRect->contains($mtx->map($p)); -} - -sub isShooting { autoShootTimer->isActive } - -sub sizeHint { TQt::Size(400, 300) } - -sub sizePolicy { - TQt::SizePolicy(&TQt::SizePolicy::Expanding, &TQt::SizePolicy::Expanding); -} - -1; diff --git a/PerlQt/tutorials/t14/GameBoard.pm b/PerlQt/tutorials/t14/GameBoard.pm deleted file mode 100644 index a81deef..0000000 --- a/PerlQt/tutorials/t14/GameBoard.pm +++ /dev/null @@ -1,125 +0,0 @@ -package GameBoard; -use strict; -use TQt; -use TQt::isa qw(TQt::Widget); -use TQt::slots - fire => [], - hit => [], - missed => [], - newGame => []; -use TQt::attributes qw( - hits - shotsLeft - cannonField -); - -use LCDRange; -use CannonField; - -sub NEW { - shift->SUPER::NEW(@_); - - my $quit = TQt::PushButton("&Quit", this, "quit"); - $quit->setFont(TQt::Font("Times", 18, &TQt::Font::Bold)); - - TQt::app->connect($quit, TQT_SIGNAL('clicked()'), TQT_SLOT('quit()')); - - my $angle = LCDRange("ANGLE", this, "angle"); - $angle->setRange(5, 70); - - my $force = LCDRange("FORCE", this, "force"); - $force->setRange(10, 50); - - my $box = TQt::VBox(this, "cannonFrame"); - $box->setFrameStyle($box->WinPanel | $box->Sunken); - - cannonField = CannonField($box, "cannonField"); - - cannonField->connect($angle, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('setAngle(int)')); - $angle->connect(cannonField, TQT_SIGNAL('angleChanged(int)'), TQT_SLOT('setValue(int)')); - - cannonField->connect($force, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('setForce(int)')); - $force->connect(cannonField, TQT_SIGNAL('forceChanged(int)'), TQT_SLOT('setValue(int)')); - - this->connect(cannonField, TQT_SIGNAL('hit()'), TQT_SLOT('hit()')); - this->connect(cannonField, TQT_SIGNAL('missed()'), TQT_SLOT('missed()')); - - my $shoot = TQt::PushButton('&Shoot', this, "shoot"); - $shoot->setFont(TQt::Font("Times", 18, &TQt::Font::Bold)); - - this->connect($shoot, TQT_SIGNAL('clicked()'), TQT_SLOT('fire()')); - - $shoot->connect(cannonField, TQT_SIGNAL('canShoot(bool)'), TQT_SLOT('setEnabled(bool)')); - - my $restart = TQt::PushButton('&New Game', this, "newgame"); - $restart->setFont(TQt::Font("Times", 18, &TQt::Font::Bold)); - - this->connect($restart, TQT_SIGNAL('clicked()'), TQT_SLOT('newGame()')); - - hits = TQt::LCDNumber(2, this, "hits"); - shotsLeft = TQt::LCDNumber(2, this, "shotsleft"); - my $hitsL = TQt::Label("HITS", this, "hitsLabel"); - my $shotsLeftL = TQt::Label("SHOTS LEFT", this, "shotsLeftLabel"); - - my $accel = TQt::Accel(this); - $accel->connectItem($accel->insertItem(TQt::KeySequence(int &Key_Enter)), - this, TQT_SLOT('fire()')); - $accel->connectItem($accel->insertItem(TQt::KeySequence(int &Key_Return)), - this, TQT_SLOT('fire()')); - $accel->connectItem($accel->insertItem(TQt::KeySequence(int &CTRL+&Key_Q)), - TQt::app, TQT_SLOT('quit()')); - - my $grid = TQt::GridLayout(this, 2, 2, 10); - $grid->addWidget($quit, 0, 0); - $grid->addWidget($box, 1, 1); - $grid->setColStretch(1, 10); - - my $leftBox = TQt::VBoxLayout; - $grid->addLayout($leftBox, 1, 0); - $leftBox->addWidget($angle); - $leftBox->addWidget($force); - - my $topBox = TQt::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 deleted file mode 100644 index 1647e85..0000000 --- a/PerlQt/tutorials/t14/LCDRange.pm +++ /dev/null @@ -1,67 +0,0 @@ -package LCDRange; -use strict; -use TQt; -use TQt::isa qw(TQt::Widget); -use TQt::slots - setValue => ['int'], - setRange => ['int', 'int'], - setText => ['const char*']; -use TQt::signals - valueChanged => ['int']; -use TQt::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 = TQt::LCDNumber(2, this, "lcd"); - - slider = TQt::Slider(&Horizontal, this, "slider"); - slider->setRange(0, 99); - slider->setValue(0); - - label = TQt::Label(" ", this, "label"); - label->setAlignment(&AlignCenter); - - $lcd->connect(slider, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('display(int)')); - this->connect(slider, TQT_SIGNAL('valueChanged(int)'), TQT_SIGNAL('valueChanged(int)')); - - setFocusProxy(slider); - - my $l = TQt::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 deleted file mode 100644 index ef412ab..0000000 --- a/PerlQt/tutorials/t14/t14.pl +++ /dev/null @@ -1,14 +0,0 @@ -#!/usr/bin/perl -w -use strict; -use blib; -use TQt; -use GameBoard; - -TQt::Application::setColorSpec(&TQt::Application::CustomColor); -my $a = TQt::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 deleted file mode 100644 index c7b76e4..0000000 --- a/PerlQt/tutorials/t2/t2.pl +++ /dev/null @@ -1,16 +0,0 @@ -#!/usr/bin/perl -w -use strict; -use blib; -use TQt; - -my $a = TQt::Application(\@ARGV); - -my $quit = TQt::PushButton("Quit", undef); -$quit->resize(75, 30); -$quit->setFont(TQt::Font("Times", 18, &TQt::Font::Bold)); - -$a->connect($quit, TQT_SIGNAL('clicked()'), TQT_SLOT('quit()')); - -$a->setMainWidget($quit); -$quit->show; -exit $a->exec; diff --git a/PerlQt/tutorials/t3/t3.pl b/PerlQt/tutorials/t3/t3.pl deleted file mode 100644 index 24fcdf0..0000000 --- a/PerlQt/tutorials/t3/t3.pl +++ /dev/null @@ -1,19 +0,0 @@ -#!/usr/bin/perl -w -use strict; -use blib; -use TQt; - -my $a = TQt::Application(\@ARGV); - -my $box = TQt::VBox; -$box->resize(200, 120); - -my $quit = TQt::PushButton("Quit", $box); -$quit->setFont(TQt::Font("Times", 18, &TQt::Font::Bold)); - -$a->connect($quit, TQT_SIGNAL('clicked()'), TQT_SLOT('quit()')); - -$a->setMainWidget($box); -$box->show; - -exit $a->exec; diff --git a/PerlQt/tutorials/t4/t4.pl b/PerlQt/tutorials/t4/t4.pl deleted file mode 100644 index b4b0b1e..0000000 --- a/PerlQt/tutorials/t4/t4.pl +++ /dev/null @@ -1,31 +0,0 @@ -#!/usr/bin/perl -w -use strict; -use blib; - -package MyWidget; -use TQt; -use TQt::isa qw(TQt::Widget); - -sub NEW { - shift->SUPER::NEW(@_); - - setMinimumSize(200, 120); - setMaximumSize(200, 120); - - my $quit = TQt::PushButton("Quit", this, "quit"); - $quit->setGeometry(62, 40, 75, 30); - $quit->setFont(TQt::Font("Times", 18, &TQt::Font::Bold)); - - TQt::app->connect($quit, TQT_SIGNAL('clicked()'), TQT_SLOT('quit()')); -} - -package main; -use MyWidget; - -my $a = TQt::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 deleted file mode 100644 index 9990c3e..0000000 --- a/PerlQt/tutorials/t5/t5.pl +++ /dev/null @@ -1,34 +0,0 @@ -#!/usr/bin/perl -w -use strict; -use blib; - -package MyWidget; -use TQt; -use TQt::isa qw(TQt::VBox); - -sub NEW { - shift->SUPER::NEW(@_); - - my $quit = TQt::PushButton("Quit", this, "quit"); - $quit->setFont(TQt::Font("Times", 18, &TQt::Font::Bold)); - - TQt::app->connect($quit, TQT_SIGNAL('clicked()'), TQT_SLOT('quit()')); - - my $lcd = TQt::LCDNumber(2, this, "lcd"); - - my $slider = TQt::Slider(&Horizontal, this, "slider"); - $slider->setRange(0, 99); - $slider->setValue(0); - - $lcd->connect($slider, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('display(int)')); -} - -package main; -use MyWidget; - -my $a = TQt::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 deleted file mode 100644 index b50c415..0000000 --- a/PerlQt/tutorials/t6/t6.pl +++ /dev/null @@ -1,49 +0,0 @@ -#!/usr/bin/perl -w -use strict; -use blib; - -package LCDRange; -use TQt; -use TQt::isa qw(TQt::VBox); - -sub NEW { - shift->SUPER::NEW(@_); - - my $lcd = TQt::LCDNumber(2, this, "lcd"); - my $slider = TQt::Slider(&Horizontal, this, "slider"); - $slider->setRange(0, 99); - $slider->setValue(0); - $lcd->connect($slider, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('display(int)')); -} - -package MyWidget; -use TQt; -use TQt::isa qw(TQt::VBox); -use LCDRange; - -sub NEW { - shift->SUPER::NEW(@_); - - my $quit = TQt::PushButton("Quit", this, "quit"); - $quit->setFont(TQt::Font("Times", 18, &TQt::Font::Bold)); - - TQt::app->connect($quit, TQT_SIGNAL('clicked()'), TQT_SLOT('quit()')); - - my $grid = TQt::Grid(4, this); - - for(0..3) { - for(0..3) { - LCDRange($grid); - } - } -} - -package main; -use MyWidget; - -my $a = TQt::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 deleted file mode 100644 index 9bc48cb..0000000 --- a/PerlQt/tutorials/t7/LCDRange.pm +++ /dev/null @@ -1,29 +0,0 @@ -package LCDRange; -use strict; -use TQt; -use TQt::isa qw(TQt::VBox); -use TQt::slots setValue => ['int']; -use TQt::signals valueChanged => ['int']; -use TQt::attributes qw(slider); - -sub NEW { - shift->SUPER::NEW(@_); - - my $lcd = TQt::LCDNumber(2, this, "lcd"); - - my $slider = TQt::Slider(&Horizontal, this, "slider"); - slider = $slider; - slider->setRange(0, 99); - slider->setValue(0); - $lcd->connect(slider, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('display(int)')); - this->connect(slider, TQT_SIGNAL('valueChanged(int)'), TQT_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 deleted file mode 100644 index 0d0d0d2..0000000 --- a/PerlQt/tutorials/t7/t7.pl +++ /dev/null @@ -1,40 +0,0 @@ -#!/usr/bin/perl -w -use strict; -use blib; - -package MyWidget; -use TQt; -use TQt::isa qw(TQt::VBox); - -use LCDRange; - -sub NEW { - shift->SUPER::NEW(@_); - - my $quit = TQt::PushButton("Quit", this, "quit"); - $quit->setFont(TQt::Font("Times", 18, &TQt::Font::Bold)); - - TQt::app->connect($quit, TQT_SIGNAL('clicked()'), TQT_SLOT('quit()')); - - my $grid = TQt::Grid(4, this); - - my $previous; - for my $r (0..3) { - for my $c (0..3) { - my $lr = LCDRange($grid); - $previous->connect( - $lr, TQT_SIGNAL('valueChanged(int)'), - TQT_SLOT('setValue(int)')) if $previous; - $previous = $lr; - } - } -} - -package main; -use MyWidget; - -my $a = TQt::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 deleted file mode 100644 index 1c23244..0000000 --- a/PerlQt/tutorials/t8/CannonField.pm +++ /dev/null @@ -1,43 +0,0 @@ -package CannonField; -use strict; -use TQt; -use TQt::isa qw(TQt::Widget); -use TQt::signals - angleChanged => ['int']; -use TQt::slots - setAngle => ['int']; -use TQt::attributes qw( - ang -); -use POSIX qw(atan); - -sub angle () { ang } - -sub NEW { - shift->SUPER::NEW(@_); - - ang = 45; - setPalette(TQt::Palette(TQt::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 = TQt::Painter(this); - $p->drawText(200, 200, $s); -} - -sub sizePolicy { - TQt::SizePolicy(&TQt::SizePolicy::Expanding, &TQt::SizePolicy::Expanding); -} - -1; diff --git a/PerlQt/tutorials/t8/LCDRange.pm b/PerlQt/tutorials/t8/LCDRange.pm deleted file mode 100644 index ab63af0..0000000 --- a/PerlQt/tutorials/t8/LCDRange.pm +++ /dev/null @@ -1,43 +0,0 @@ -package LCDRange; -use strict; -use TQt; -use TQt::isa qw(TQt::VBox); -use TQt::slots - setValue => ['int'], - setRange => ['int', 'int']; -use TQt::signals - valueChanged => ['int']; -use TQt::attributes qw( - slider -); - -sub NEW { - shift->SUPER::NEW(@_); - - my $lcd = TQt::LCDNumber(2, this, "lcd"); - - slider = TQt::Slider(&Horizontal, this, "slider"); - slider->setRange(0, 99); - slider->setValue(0); - $lcd->connect(slider, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('display(int)')); - this->connect(slider, TQT_SIGNAL('valueChanged(int)'), TQT_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 deleted file mode 100644 index 620f912..0000000 --- a/PerlQt/tutorials/t8/t8.pl +++ /dev/null @@ -1,49 +0,0 @@ -#!/usr/bin/perl -w -use strict; -use blib; - -package MyWidget; -use strict; -use TQt; -use TQt::isa qw(TQt::Widget); - -use LCDRange; -use CannonField; - -sub NEW { - shift->SUPER::NEW(@_); - - my $quit = TQt::PushButton("Quit", this, "quit"); - $quit->setFont(TQt::Font("Times", 18, &TQt::Font::Bold)); - - TQt::app->connect($quit, TQT_SIGNAL('clicked()'), TQT_SLOT('quit()')); - - my $angle = LCDRange(this, "angle"); - $angle->setRange(5, 70); - - my $cannonField = CannonField(this, "cannonField"); - - $cannonField->connect($angle, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('setAngle(int)')); - $angle->connect($cannonField, TQT_SIGNAL('angleChanged(int)'), TQT_SLOT('setValue(int)')); - - my $grid = TQt::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 TQt; -use MyWidget; - -my $a = TQt::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 deleted file mode 100644 index 1500480..0000000 --- a/PerlQt/tutorials/t9/CannonField.pm +++ /dev/null @@ -1,48 +0,0 @@ -package CannonField; -use strict; -use TQt; -use TQt::isa qw(TQt::Widget); -use TQt::signals - angleChanged => ['int']; -use TQt::slots - setAngle => ['int']; -use TQt::attributes qw( - ang -); -use POSIX qw(atan); - -sub angle () { ang } - -sub NEW { - shift->SUPER::NEW(@_); - - ang = 45; - setPalette(TQt::Palette(TQt::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 = TQt::Painter(this); - $p->setBrush(&blue); - $p->setPen(&NoPen); - - $p->translate(0, rect()->bottom); - $p->drawPie(TQt::Rect(-35, -35, 70, 70), 0, 90*16); - $p->rotate(- ang); - $p->drawRect(TQt::Rect(33, -4, 15, 8)); -} - -sub sizePolicy { - TQt::SizePolicy(&TQt::SizePolicy::Expanding, &TQt::SizePolicy::Expanding); -} - -1; diff --git a/PerlQt/tutorials/t9/LCDRange.pm b/PerlQt/tutorials/t9/LCDRange.pm deleted file mode 100644 index ab63af0..0000000 --- a/PerlQt/tutorials/t9/LCDRange.pm +++ /dev/null @@ -1,43 +0,0 @@ -package LCDRange; -use strict; -use TQt; -use TQt::isa qw(TQt::VBox); -use TQt::slots - setValue => ['int'], - setRange => ['int', 'int']; -use TQt::signals - valueChanged => ['int']; -use TQt::attributes qw( - slider -); - -sub NEW { - shift->SUPER::NEW(@_); - - my $lcd = TQt::LCDNumber(2, this, "lcd"); - - slider = TQt::Slider(&Horizontal, this, "slider"); - slider->setRange(0, 99); - slider->setValue(0); - $lcd->connect(slider, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('display(int)')); - this->connect(slider, TQT_SIGNAL('valueChanged(int)'), TQT_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 deleted file mode 100644 index 779d859..0000000 --- a/PerlQt/tutorials/t9/t9.pl +++ /dev/null @@ -1,50 +0,0 @@ -#!/usr/bin/perl -w -use strict; -use blib; - -package MyWidget; -use strict; -use TQt; -use TQt::isa qw(TQt::Widget); - -use LCDRange; -use CannonField; - -sub NEW { - shift->SUPER::NEW(@_); - - my $quit = TQt::PushButton("&Quit", this, "quit"); - $quit->setFont(TQt::Font("Times", 18, &TQt::Font::Bold)); - - TQt::app->connect($quit, TQT_SIGNAL('clicked()'), TQT_SLOT('quit()')); - - my $angle = LCDRange(this, "angle"); - $angle->setRange(5, 70); - - my $cannonField = CannonField(this, "cannonField"); - - $cannonField->connect($angle, TQT_SIGNAL('valueChanged(int)'), TQT_SLOT('setAngle(int)')); - $angle->connect($cannonField, TQT_SIGNAL('angleChanged(int)'), TQT_SLOT('setValue(int)')); - - my $grid = TQt::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 TQt; -use MyWidget; - -TQt::Application::setColorSpec(&TQt::Application::CustomColor); -my $a = TQt::Application(\@ARGV); - -my $w = MyWidget; -$w->setGeometry(100, 100, 500, 355); -$a->setMainWidget($w); -$w->show; -exit $a->exec; |