Hello community, here is the log from the commit of package perl-Prima for openSUSE:Factory checked in at 2015-09-30 05:50:56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-Prima (Old) and /work/SRC/openSUSE:Factory/.perl-Prima.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Prima" Changes: -------- --- /work/SRC/openSUSE:Factory/perl-Prima/perl-Prima.changes 2015-04-18 10:39:44.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.perl-Prima.new/perl-Prima.changes 2015-09-30 05:50:57.000000000 +0200 @@ -1,0 +2,11 @@ +Sun Sep 20 16:20:02 UTC 2015 - [email protected] + +- updated to 1.44 + see /usr/share/doc/packages/perl-Prima/Changes + + 1.44 2015-08-04 + - Rewrite rubberband + - Work on portable perls + - Better support of graphic libs where several versions are available + +------------------------------------------------------------------- Old: ---- Prima-1.43.tar.gz New: ---- Prima-1.44.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-Prima.spec ++++++ --- /var/tmp/diff_new_pack.FqFKla/_old 2015-09-30 05:50:58.000000000 +0200 +++ /var/tmp/diff_new_pack.FqFKla/_new 2015-09-30 05:50:58.000000000 +0200 @@ -17,7 +17,7 @@ Name: perl-Prima -Version: 1.43 +Version: 1.44 Release: 0 #Upstream: SUSE-Public-Domain %define cpan_name Prima ++++++ Prima-1.43.tar.gz -> Prima-1.44.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/Changes new/Prima-1.44/Changes --- old/Prima-1.43/Changes 2015-04-10 21:17:48.000000000 +0200 +++ new/Prima-1.44/Changes 2015-08-05 09:18:10.000000000 +0200 @@ -1,5 +1,10 @@ Revision history for Perl module Prima +1.44 2015-08-04 + - Rewrite rubberband + - Work on portable perls + - Better support of graphic libs where several versions are available + 1.43 2015-04-10 - Rewrite font test and polish rough ends in xft font handling - Copy images to clipboard so that GTK recognizes them diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/META.json new/Prima-1.44/META.json --- old/Prima-1.43/META.json 2015-04-10 21:18:49.000000000 +0200 +++ new/Prima-1.44/META.json 2015-08-05 09:19:21.000000000 +0200 @@ -4,7 +4,7 @@ "Dmitry Karasik <[email protected]>" ], "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921", + "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.140640", "license" : [ "freebsd" ], @@ -50,5 +50,5 @@ "url" : "http://github.com/dk/Prima"; } }, - "version" : "1.43" + "version" : "1.44" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/META.yml new/Prima-1.44/META.yml --- old/Prima-1.43/META.yml 2015-04-10 21:18:49.000000000 +0200 +++ new/Prima-1.44/META.yml 2015-08-05 09:19:21.000000000 +0200 @@ -3,15 +3,15 @@ author: - 'Dmitry Karasik <[email protected]>' build_requires: - ExtUtils::MakeMaker: 0 + ExtUtils::MakeMaker: '0' configure_requires: - ExtUtils::MakeMaker: 0 + ExtUtils::MakeMaker: '0' dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921' +generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.140640' license: open_source meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html - version: 1.4 + version: '1.4' name: Prima no_index: directory: @@ -29,4 +29,4 @@ resources: homepage: http://www.prima.eu.org/ repository: http://github.com/dk/Prima -version: 1.43 +version: '1.44' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/Makefile.PL new/Prima-1.44/Makefile.PL --- old/Prima-1.43/Makefile.PL 2015-04-10 21:17:48.000000000 +0200 +++ new/Prima-1.44/Makefile.PL 2015-08-05 09:18:10.000000000 +0200 @@ -428,15 +428,16 @@ } elsif ( `perl -V` =~ /activeperl/i) { $flavor = 'activestate'; } + $flavor .= ( $Config{ptrsize} == 8 ) ? '64' : '32'; } elsif ( $cygwin ) { - $flavor .= ( $Config{ptrsize} == 8 ) ? '64' : '32'; - $flavor .= '.' . ( $cmd_options{CYGWIN_WINAPI} ? 'win32' : 'x11' ); - } + $flavor .= ( $Config{ptrsize} == 8 ) ? '64' : '32'; + $flavor .= '.' . ( $cmd_options{CYGWIN_WINAPI} ? 'win32' : 'x11' ); + } $flavor =~ s/\s/_/g; printlog "$flavor\n"; - $flavor = 'sb32' if $flavor eq 'strawberry'; - $flavor = 'as32' if $flavor eq 'activestate'; + $flavor =~ s/strawberry/sb/; + $flavor =~ s/activestate/as/; $DISTNAME = "Prima-$ver1.$ver2-$flavor-$REVISION.$PATCHLEVEL.$SUBVERSION"; printlog "Build: $DISTNAME\n"; @@ -1434,7 +1435,7 @@ push @codecs, $_; } } - + my @codec_libpath = qd( $Config{installsitearch}); my @warn_codecs; for my $cx ( @codecs) { @@ -1448,8 +1449,19 @@ } close F; + # do we have a versioned inc/lib from dependency hell? + my $version = ''; + if ( + ( $codec ne 'X11' ) && + ( my @versioned = grep { /$codec\d+$/ } @INCPATH ) + ) { + $versioned[0] =~ /$codec(\d+)$/; + $version = $1; + $lib .= $1; + } + AGAIN: - printlog "Checking for $codec library... "; + printlog "Checking for $codec$version library... "; if ( $libs{$lib} || defined ( $foundlib = find_lib( $lib, join('', @inc), '', @codec_libpath)) @@ -1466,13 +1478,19 @@ printlog ", in $foundlib" if defined($foundlib) and length($foundlib); printlog "\n"; } elsif ( $codec eq 'ungif') { - $lib = $codec = 'gif'; + $codec = 'gif'; + $lib = $codec.$version; printlog "no\n"; goto AGAIN; } elsif ( $codec eq 'X11') { $DEFINES{EMULATE_X11_CODEC} = 1; push( @ACTIVE_CODECS, $codec); printlog "no, using built-in\n"; + } elsif ( length $version) { + $lib = $codec; + $version = ''; + printlog "no\n"; + goto AGAIN; } else { $PASSIVE_CODECS{$fn} = 1; push @warn_codecs, $codec; @@ -1650,8 +1668,8 @@ %Config_inst = ( incpaths => [ $ippi ], - gencls => '\$(bin)${ifs}gencls$SCRIPT_EXT', - tmlink => '\$(bin)${ifs}tmlink$SCRIPT_EXT', + gencls => 'gencls$SCRIPT_EXT', + tmlink => 'tmlink$SCRIPT_EXT', libname => '\$(lib)${ifs}auto${ifs}Prima${ifs}${LIB_PREFIX}Prima$LIB_EXT', dlname => '\$(lib)${ifs}auto${ifs}Prima${ifs}Prima.$Config{dlext}', ldpaths => [$libpathi], @@ -1721,11 +1739,16 @@ s/\//\\/g for values %vars; } - print FF <<HEADER; + print FF <<'HEADER'; # This file was automatically generated. package Prima::Config; use vars qw(%Config); +# Determine lib based on the location of this module +use File::Basename qw(dirname); +use File::Spec; +my $lib = File::Spec->catfile(dirname(__FILE__), '..'); + %Config = ( HEADER while ( <F>) { @@ -1738,7 +1761,9 @@ $ci_state = 0; } elsif ( m/^\s*(\S+)\s*/ ) { my $k = $1; - s/\$\((\w+)\)/$vars{$1}/g; + s/\$\((\w+)\)/\$$1/g; + s/'/"/g; + s{\\}{\\\\}g; $ci{$k} = $_; } } @@ -2062,8 +2087,8 @@ my $t = $self->SUPER::install(@_); my $n = $t =~ s[ (pure_\w+_install.*?) # 1 - (INST_ARCHLIB\)\s+)\$\(DEST(\w+)\)(.*?) # 2,3,4 - (INST_BIN\)\s+)\$\(DEST(\w+)\)(.*?) # 5,6,7 + (INST_ARCHLIB\)"?\s+"?)\$\(DEST(\w+)\)(.*?) # 2,3,4 + (INST_BIN\)"?\s+"?)\$\(DEST(\w+)\)(.*?) # 5,6,7 (.*?) # 8 \n\n ][ @@ -2071,16 +2096,16 @@ "$2\$(DEST$3)$4". "$5\$(DEST$6)$7$8". "\n\t\$(NOECHO) \$(ABSPERL) $0 --postinstall ". - "dest=\$(DEST$3) lib=\$($3) bin=\$($6) ". - "slib=$cygwin_fake_Slib\n\n" + "dest=\$(DEST$3) slib=$cygwin_fake_Slib\n\n" ]xgse; $END .= <<BAD_MAKEFILE if $n != 3; ** Warning: expected format of Makefile generated by ExtUtils::MakeMaker -is changed, so post-installation steps may not be performed correcty. +is changed, so post-installation steps may not be performed correctly. Prima will run OK, but modules dependent on it may not build. -Please notify the author. +Please notify the author by sending a report with Makefile and +noting that ExtUtils\:\:MakeMaker version $ExtUtils::MakeMaker::VERSION was used. BAD_MAKEFILE diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/Prima/Config.pm new/Prima-1.44/Prima/Config.pm --- old/Prima-1.43/Prima/Config.pm 2015-04-10 21:17:57.000000000 +0200 +++ new/Prima-1.44/Prima/Config.pm 2015-08-05 09:18:19.000000000 +0200 @@ -5,8 +5,8 @@ %Config_inst = ( incpaths => [ '$(lib)/Prima/CORE','$(lib)/Prima/CORE/generic','/usr/local/include','/usr/local/include/freetype2','/usr/local/include/gtk-2.0','/usr/local/include/atk-1.0','/usr/local/include/cairo','/usr/local/include/pixman-1','/usr/local/include/gdk-pixbuf-2.0','/usr/local/include/libpng16','/usr/local/include/pango-1.0','/usr/local/include/glib-2.0','/usr/local/lib/glib-2.0/include','/usr/local/include/harfbuzz' ], - gencls => '$(bin)/gencls', - tmlink => '$(bin)/tmlink', + gencls => 'gencls', + tmlink => 'tmlink', libname => '$(lib)/auto/Prima/Prima.a', dlname => '$(lib)/auto/Prima/Prima.so', ldpaths => [], @@ -37,7 +37,7 @@ ldlibflag => '-l', ldlibpathflag => '-L', ldpaths => [], - ldlibs => ['Xpm','gif','tiff','png','jpeg','X11','Xext','freetype','fontconfig','Xrender','Xft','iconv','gtk-x11-2.0','gdk-x11-2.0','pangocairo-1.0','atk-1.0','cairo','gdk_pixbuf-2.0','gio-2.0','pangoft2-1.0','pango-1.0','gobject-2.0','glib-2.0','intl','Xrandr'], + ldlibs => ['Xpm','gif','tiff','png16','jpeg','X11','Xext','freetype','fontconfig','Xrender','Xft','iconv','gtk-x11-2.0','gdk-x11-2.0','pangocairo-1.0','atk-1.0','cairo','gdk_pixbuf-2.0','gio-2.0','pangoft2-1.0','pango-1.0','gobject-2.0','glib-2.0','intl','Xrandr'], ldlibext => '', inline => 'inline', dl_load_flags => 1, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/Prima/Docks.pm new/Prima-1.44/Prima/Docks.pm --- old/Prima-1.43/Prima/Docks.pm 2014-07-15 17:27:36.000000000 +0200 +++ new/Prima-1.44/Prima/Docks.pm 2015-08-05 09:18:10.000000000 +0200 @@ -1215,7 +1215,6 @@ sub xorrect { my ( $self, $x1, $y1, $x2, $y2, $width) = @_; - $::application-> begin_paint; if ( defined $x1 ) { $x2--; $y2--; $::application-> rubberband( @@ -1225,7 +1224,6 @@ } else { $::application-> rubberband( destroy => 1 ) } - $::application-> end_paint; } sub on_paint diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/Prima/FrameSet.pm new/Prima-1.44/Prima/FrameSet.pm --- old/Prima-1.43/Prima/FrameSet.pm 2014-07-15 17:27:36.000000000 +0200 +++ new/Prima-1.44/Prima/FrameSet.pm 2015-08-05 09:18:10.000000000 +0200 @@ -296,15 +296,13 @@ sub xorrect { my ( $self, @r) = @_; - my $o = $::application; my $p = $self->get_parent; - $o-> begin_paint; - $o-> clipRect( $p-> client_to_screen( 0,0,$p-> size)); - $o-> rubberband( @r ? - ( rect => \@r, breadth => $self->{thickness} ) : - ( destroy => 1 ) + $::application-> rubberband( + clipRect => [ $p->client_to_screen( 0,0,$p-> size) ], + @r ? + ( rect => \@r, breadth => $self->{thickness} ) : + ( destroy => 1 ) ); - $o-> end_paint; } sub get_delta diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/Prima/PS/Drawable.pm new/Prima-1.44/Prima/PS/Drawable.pm --- old/Prima-1.43/Prima/PS/Drawable.pm 2014-07-15 17:27:36.000000000 +0200 +++ new/Prima-1.44/Prima/PS/Drawable.pm 2015-08-05 09:18:10.000000000 +0200 @@ -723,6 +723,10 @@ } $_[0]-> {useDeviceFonts} = $_[1] unless $_[0]-> get_paint_state; $_[0]-> {useDeviceFonts} = 1 if $_[0]-> {useDeviceFontsOnly}; + if ( !$::application && !$_[1] ) { + warn "warning: ignored .useDeviceFonts(0) because Prima::Application is not instantiated\n"; + $_[0]->{useDeviceFonts} = 1; + } } sub useDeviceFontsOnly @@ -1017,6 +1021,8 @@ $self-> emit( $pg); $self-> emit(";"); $advance = $a + $b + $c; + } elsif ( defined $a ) { + $advance = $a + $b + $c; } else { $advance = $$nd[1] + $$nd[2] + $$nd[3]; } @@ -1511,7 +1517,7 @@ "$scalex $scaley scale $b $bby true [$b 0 0 -$bby 0 $bby] <$cdz> imagemask", $a, $b, $c; } - return ''; + return '', $a, $b, $c; } sub get_rmap diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/Prima/RubberBand.pm new/Prima-1.44/Prima/RubberBand.pm --- old/Prima-1.43/Prima/RubberBand.pm 2012-02-10 18:55:10.000000000 +0100 +++ new/Prima-1.44/Prima/RubberBand.pm 2015-08-05 09:18:10.000000000 +0200 @@ -1,410 +1,480 @@ -package Prima::RubberBand; - -use strict; -use warnings; - -sub new -{ - my ( $class, %profile ) = @_; - my $ref = { - mode => 'auto', # auto, full, xor - canvas => $::application, - rect => [-1,-1,-1,-1], - breadth => 1, - }; - my $self = bless $ref, shift; - $self-> set(%profile); - $self-> show; - return $self; -} - -sub set -{ - my ( $self, %profile ) = @_; - my $visible = $self-> {visible}; - $self-> hide if $visible; - $self-> $_( @{$profile{$_}} ) for grep { exists $profile{$_} } qw(rect); - $self-> $_( $profile{$_} ) for grep { exists $profile{$_} } qw(mode canvas breadth); - $self-> show if $visible; -} - -sub DESTROY { shift-> hide } - -sub show -{ - my $self = shift; - $self-> _visible(1) unless $self-> _visible; -} - -sub hide -{ - my $self = shift; - $self-> _visible(0) if $self-> _visible; -} - -sub _gfx_mode -{ - my $self = shift; - if ( $self-> {mode} eq 'auto') { - return ( - $^O =~ /win32/i && - $::application-> get_system_value( sv::CompositeDisplay ) && - $self-> {canvas} && - $self-> {canvas}-> isa('Prima::Widget') - ) ? 1 : 0; - } else { - return ( $self-> {mode} eq 'full' ) ? 1 : 0; - } -} - -sub canvas -{ - return $_[0]-> {canvas} unless $#_; - - my ( $self, $canvas ) = @_; - $self-> {canvas} = $canvas // $::application; -} - -sub mode -{ - return $_[0]-> {mode} unless $#_; - - my ( $self, $mode ) = @_; - Carp::confess "mode(auto,full,xor)" unless $mode =~ /^(auto|full|xor)$/; - $self-> {mode} = $mode; -} - -# geometry handlers - -sub left { $_[0]-> {rect}-> [0] } -sub bottom { $_[0]-> {rect}-> [1] } -sub right { $_[0]-> {rect}-> [2] } -sub top { $_[0]-> {rect}-> [3] } -sub width { $_[0]-> {rect}-> [2] - $_[0]-> {rect}-> [0] + 1 } -sub height { $_[0]-> {rect}-> [3] - $_[0]-> {rect}-> [1] + 1 } -sub origin { $_[0]-> {rect}-> [0], $_[0]-> {rect}-> [1] } -sub size { $_[0]-> {rect}-> [2] - $_[0]-> {rect}-> [0] + 1 , $_[0]-> {rect}-> [3] - $_[0]-> {rect}-> [1] + 1 } - -sub rect -{ - return @{$_[0]-> {rect}} unless $#_; - - my ( $self, @rect ) = @_; - Carp::confess("@rect") unless 4 == grep { defined } @rect; - - ($rect[2],$rect[0]) = ($rect[0],$rect[2]) if $rect[2] < $rect[0]; - ($rect[3],$rect[1]) = ($rect[1],$rect[3]) if $rect[3] < $rect[1]; - @{$self-> {rect}} = @rect; -} - -sub breadth -{ - return $_[0]-> {breadth} unless $#_; - - my ( $self, $breadth ) = @_; - $breadth = 1 if $breadth < 1; - $breadth = 64 if $breadth > 64; # well, huh? - $self-> {breadth} = $breadth; -} - -# drawing handlers - -sub _intersect -{ - my ( $rect, $outer ) = @_; - - return if - $rect-> [0] > $outer-> [2] || - $rect-> [1] > $outer-> [3] || - $rect-> [2] < $outer-> [0] || - $rect-> [3] < $outer-> [1]; - - my @res = @$rect; - $res[0] = $outer-> [0] if $res[0] < $outer-> [0]; - $res[1] = $outer-> [1] if $res[1] < $outer-> [1]; - $res[2] = $outer-> [2] if $res[2] > $outer-> [2]; - $res[3] = $outer-> [3] if $res[3] > $outer-> [3]; - - return \@res; -} - -sub _visible -{ - return $_[0]-> {visible} unless $#_; - - my ( $self, $visible ) = @_; - $visible = ( $visible ? 1 : 0 ); - my $curr_visible = ( $self-> {visible} ? 1 : 0); - return if $visible == $curr_visible; - return unless $self-> {canvas}; - - $self-> {visible} = $visible; - - my $canvas = $self-> {canvas}; - - # just a regular xor - unless ( $self-> _gfx_mode ) { - $canvas-> rect_focus( $self-> rect, $self-> breadth ); - return; - } - - # save all bits under the rect - if ( $visible ) { - my @desktop = $::application-> size; - @desktop = ( 0, 0, $desktop[0] - 1, $desktop[1] - 1); - - my @outer = $self-> rect; - my @delta = $canvas-> client_to_screen(0,0); - $outer[$_] += $delta[0] for 0,2; - $outer[$_] += $delta[1] for 1,3; - - my @inner = @outer; - my $breadth = $self-> {breadth}; - $inner[$_] += $breadth - 1 for 0,1; - $inner[$_] -= $breadth - 1 for 2,3; - - # save bits: - # 11111111 - # 22 33 - # 00000000 - - my @requests; - if ( $inner[0] >= $inner[2] || $inner[1] >= $inner[3] ) { - push @requests, [ @outer ]; - } else { - push @requests, [ $outer[0], $outer[1], $outer[2], $inner[1] ]; - push @requests, [ $outer[0], $inner[3], $outer[2], $outer[3] ]; - push @requests, [ $outer[0], $inner[1] + 1, $inner[0], $inner[3] - 1 ]; - push @requests, [ $inner[2], $inner[1] + 1, $outer[2], $inner[3] - 1 ]; - } - - @requests = grep { _intersect( $_, \@desktop ) } @requests; - $self-> {_cache} = []; - - return unless @requests; - - for ( @requests ) { - my ( $x1, $y1, $x2, $y2) = @$_; - push @{ $self-> {_cache} }, [ - $x1 - $delta[0], - $y1 - $delta[1], - $::application-> get_image( $x1, $y1, $x2 - $x1 + 1, $y2 - $y1 + 1 ) - ]; - } - - my ( $cl, $cl2, $rop, $fp) = ( $canvas-> color, $canvas-> backColor, $canvas-> rop, $canvas-> fillPattern); - $canvas-> set( - fillPattern => fp::SimpleDots, - color => cl::Set, - backColor => cl::Clear, - rop => rop::XorPut, - ); - - for ( @requests ) { - my ( $x1, $y1, $x2, $y2) = @$_; - $canvas-> bar( - $x1 + $delta[0], - $y1 + $delta[1], - $x2 + $delta[0], - $y2 + $delta[1] - ); - } - - $canvas-> set( - fillPattern => $fp, - backColor => $cl2, - color => $cl, - rop => $rop, - ); - } else { - # restore bits - # $canvas-> rectangle( $_->[0], $_-> [1], $_->[0] - 1 + $_->[2]-> width, $_[1] - 1 + $_-> [2]-> height) for @{ $self-> {_cache} }; - $canvas-> put_image( @$_) for @{ $self-> {_cache} }; - $self-> {_cache} = []; - } -} - -package Prima::Widget; - -sub rubberband -{ - my ($self, %profile) = @_; - - if ($profile{destroy}) { - $self-> {__rubberband}-> hide if $self-> {__rubberband}; - return delete $self-> {__rubberband} - } - - if ( keys %profile) { - if ( $self-> {__rubberband}) { - $self-> {__rubberband}-> set(%profile); - } else { - $profile{canvas} //= $self; - $self-> {__rubberband} = Prima::RubberBand-> new(%profile); - } - } - - return $self-> {__rubberband}; -} - -1; - -__DATA__ - -=pod - -=head1 NAME - -Prima::RubberBand - draw rubberbands - -=head1 DESCRIPTION - -The motivation for this module was that I was tired to see corrupted screens on -Windows 7 when dragging rubberbands in Prima code. Even though MS somewhere -warned of not doing any specific hacks to circumvent the bug, I decided to give -it a go anyway. - -This module thus is a C<Prima::Widget/rect_focus> with a safeguard. The only -thing it can do is to draw a static rubberband - but also remember the last -coordinates drawn, so cleaning comes for free. - -The idea is that a rubberband object is meant to be a short-lived one: as soon -as it get instantiatet it draws itself on the screen. When it is destroyed, the -rubberband is erased too. - -=head1 SYNOPSIS - - use strict; - use Prima qw(Application RubberBand); - - sub xordraw - { - my ($self, @new_rect) = @_; - my $o = $::application; - $o-> begin_paint; - $o-> rubberband( @new_rect ? - ( rect => \@new_rect ) : - ( destroy => 1 ) - ); - $o-> end_paint; - } - - Prima::MainWindow-> create( - onMouseDown => sub { - my ( $self, $btn, $mod, $x, $y) = @_; - $self-> {anchor} = [$self-> client_to_screen( $x, $y)]; - xordraw( $self, @{$self-> {anchor}}, $self-> client_to_screen( $x, $y)); - $self-> capture(1); - }, - onMouseMove => sub { - my ( $self, $mod, $x, $y) = @_; - xordraw( $self, @{$self-> {anchor}}, $self-> client_to_screen( $x, $y)) if $self-> {anchor}; - }, - onMouseUp => sub { - my ( $self, $btn, $mod, $x, $y) = @_; - xordraw if delete $self-> {anchor}; - $self-> capture(0); - }, - ); - - run Prima; - -=head1 API - -=head2 Properties - -=over - -=item breadth INTEGER = 1 - -Defines rubberband breadth, in pixels. - -=item canvas = $::application - -Sets the painting surface, and also the widget (it must be a widget) used for drawing. - -=item mode STRING = 'auto' - -The module implements two techniques, standard classic 'xor' (using .rect_focus method) -and a conservative method that explicitly saves and restores desktop pixels ('full'). -The 'auto' mode checks the system and selects the appropriate mode. - -Allowed modes: auto, xor, full - -=item rect X1, Y1, X2, Y2 - -Defines the band geometry, in inclusive-inclusive coordinates. The band is drawn so that its body -is always inside these coordinates, no matter what breadth is. - -=back - -=head2 Methods - -=over - -=item hide - -Hides the band, if drawn - -=item set %profile - -Applies all properties - -=item left, right, top, bottom, width, height, origin, size - -Same shortcuts as in C<Prima::Widget>, but read-only. - -=back - -=head1 Prima::Widget interface - -The module adds a single method to C<Prima::Widget> namespace, C<rubberband> -(see example of use in the synopsis). - -=over - -=item rubberband(%profile) - -Instantiates a C<Prima::RubberBand> with C<%profile>, also sets C<canvas> to C<$self> -unless C<canvas> is set explicitly. - -=item rubberband() - -Returns the existing C<Prima::RubberBand> object - -=item rubberband(destroy => 1) - -Destroys the existing C<Prima::RubberBand> object - -=back - -=head1 AUTHOR - -Dmitry Karasik, E<lt>[email protected]<gt>. - -=head1 SEE ALSO - -L<Prima::Widget/rect_focus>, L<examples/grip.pl> - -=head2 Windows 7 Aero mode - -Quote from L<http://blogs.msdn.com/b/greg_schechter/archive/2006/05/02/588934.aspx> : - -"One particularly dangerous practice is writing to the screen, either through -the use of GetDC(NULL) and writing to that, or attempting to do XOR rubber-band -lines, etc ... Since the UCE doesn't know about it, it may get cleared in the -next frame refresh, or it may persist for a very long time, depending on what -else needs to be updated on the screen. (We really don't allow direct writing -to the primary anyhow, for that very reason... if you try to access the -DirectDraw primary, for instance, the DWM will turn off until the accessing -application exits)" - -This quote seems to explain the effect why screen sometimes gets badly -corrupted when using a normal xor rubberband. UCE ( Update Compatibility -Evaluator ?? ) seems to be hacky enough to recognize some situations, but not -all. It seems that depending on which widget received mouse button just before -initialting rubberband drawing matters somehow. Anyway, the module tries to -see if we're under Windows 7 aero, and if so, turns the 'full' mode on. - -=cut - +package Prima::RubberBand; + +use strict; +use warnings; + +sub new +{ + my ( $class, %profile ) = @_; + my $ref = { + mode => 'auto', # auto, full, xor + canvas => $::application, + rect => [-1,-1,-1,-1], + clipRect => [-1,-1,-1,-1], + breadth => 1, + }; + my $self = bless $ref, shift; + $self-> set(%profile); + $self-> show; + return $self; +} + +sub _normalize_rect +{ + my $rect = shift; + ($$rect[2],$$rect[0]) = ($$rect[0],$$rect[2]) if $$rect[2] < $$rect[0]; + ($$rect[3],$$rect[1]) = ($$rect[1],$$rect[3]) if $$rect[3] < $$rect[1]; +} + +sub _rect_changed +{ + my ( $a, $b ) = @_; + my @r1 = @$a; + my @r2 = @$b; + _normalize_rect(\@r1); + _normalize_rect(\@r2); + return + $r2[0] != $r1[0] || + $r2[1] != $r1[1] || + $r2[2] != $r1[2] || + $r2[3] != $r1[3]; +} + +sub set +{ + my ( $self, %profile ) = @_; + my $visible = $self-> {visible}; + + my ($rect_changed, $other_changed); + if ( exists $profile{rect} ) { + $rect_changed = 1 if _rect_changed($profile{rect}, $self->{rect}); + } + if ( exists $profile{clipRect} ) { + $other_changed = 1 if _rect_changed($profile{clipRect}, $self->{clipRect}); + } + for my $accessor (grep { exists $profile{$_} } qw(mode canvas breadth)) { + my $old = $self->$accessor(); + next if $old eq $profile{$accessor}; + $other_changed = 1; + last; + } + $other_changed = 1 if $rect_changed and ( !$visible or !$self->_gfx_mode ); + $rect_changed = 0 if $other_changed; + return unless $rect_changed or $other_changed; + + if ( $other_changed ) { + $self-> hide if $visible; + $self-> $_( @{$profile{$_}} ) for grep { exists $profile{$_} } qw(rect clipRect); + $self-> $_( $profile{$_} ) for grep { exists $profile{$_} } qw(mode canvas breadth); + $self-> show if $visible; + } elsif ( $rect_changed ) { + $self->{visible} = 0; + $self->rect( @{ $profile{rect} }); + $self->_visible(1, 1); + } +} + +sub DESTROY { shift-> hide } + +sub show +{ + my $self = shift; + $self-> _visible(1) unless $self-> _visible; +} + +sub hide +{ + my $self = shift; + $self-> _visible(0) if $self-> _visible; +} + +sub _gfx_mode +{ + my $self = shift; + if ( $self-> {mode} eq 'auto') { + return ( + $^O =~ /win32/i && + $::application-> get_system_value( sv::CompositeDisplay ) && + $self-> {canvas} && + $self-> {canvas}-> isa('Prima::Widget') + ) ? 1 : 0; + } else { + return ( $self-> {mode} eq 'full' ) ? 1 : 0; + } +} + +sub canvas +{ + return $_[0]-> {canvas} unless $#_; + + my ( $self, $canvas ) = @_; + $self-> {canvas} = $canvas // $::application; +} + +sub mode +{ + return $_[0]-> {mode} unless $#_; + + my ( $self, $mode ) = @_; + Carp::confess "mode(auto,full,xor)" unless $mode =~ /^(auto|full|xor)$/; + $self-> {mode} = $mode; +} + +# geometry handlers + +sub left { $_[0]-> {rect}-> [0] } +sub bottom { $_[0]-> {rect}-> [1] } +sub right { $_[0]-> {rect}-> [2] } +sub top { $_[0]-> {rect}-> [3] } +sub width { $_[0]-> {rect}-> [2] - $_[0]-> {rect}-> [0] + 1 } +sub height { $_[0]-> {rect}-> [3] - $_[0]-> {rect}-> [1] + 1 } +sub origin { $_[0]-> {rect}-> [0], $_[0]-> {rect}-> [1] } +sub size { $_[0]-> {rect}-> [2] - $_[0]-> {rect}-> [0] + 1 , $_[0]-> {rect}-> [3] - $_[0]-> {rect}-> [1] + 1 } + +sub rect +{ + return @{$_[0]-> {rect}} unless $#_; + + my ( $self, @rect ) = @_; + Carp::confess("@rect") unless 4 == grep { defined } @rect; + + _normalize_rect(\@rect); + @{$self-> {rect}} = @rect; +} + +sub clipRect +{ + return @{$_[0]-> {clipRect}} unless $#_; + + my ( $self, @rect ) = @_; + Carp::confess("@rect") unless 4 == grep { defined } @rect; + + _normalize_rect(\@rect); + @{$self-> {clipRect}} = @rect; +} + +sub has_clip_rect +{ + my $self = shift; + return 4 != grep { $_ == -1 } @{ $self->{clipRect} }; +} + +sub breadth +{ + return $_[0]-> {breadth} unless $#_; + + my ( $self, $breadth ) = @_; + $breadth = 1 if $breadth < 1; + $breadth = 64 if $breadth > 64; # well, huh? + $self-> {breadth} = $breadth; +} + +# drawing handlers + +sub _intersect +{ + my ( $rect, $outer ) = @_; + + return if + $rect-> [0] > $outer-> [2] || + $rect-> [1] > $outer-> [3] || + $rect-> [2] < $outer-> [0] || + $rect-> [3] < $outer-> [1]; + + my @res = @$rect; + $res[0] = $outer-> [0] if $res[0] < $outer-> [0]; + $res[1] = $outer-> [1] if $res[1] < $outer-> [1]; + $res[2] = $outer-> [2] if $res[2] > $outer-> [2]; + $res[3] = $outer-> [3] if $res[3] > $outer-> [3]; + + return \@res; +} + +sub _visible +{ + return $_[0]-> {visible} unless $#_; + + my ( $self, $visible, $optimized_rect_change ) = @_; + $visible = ( $visible ? 1 : 0 ); + my $curr_visible = ( $self-> {visible} ? 1 : 0); + return if $visible == $curr_visible; + return unless $self-> {canvas}; + + $self-> {visible} = $visible; + + my $canvas = $self-> {canvas}; + + # just a regular xor + unless ( $self-> _gfx_mode ) { + my $ps = $canvas->get_paint_state; + $canvas-> begin_paint if $ps == ps::Disabled; + $canvas-> clipRect( $self-> clipRect ) if $self-> has_clip_rect; + $canvas-> rect_focus( $self-> rect, $self-> breadth ); + $canvas-> end_paint if $ps == ps::Disabled; + return; + } + + if ( $visible ) { + my @clip = $self-> has_clip_rect ? + $canvas-> client_to_screen( $self-> clipRect ) : + ( 0, 0, $::application->width - 1, $::application-> height - 1 ); + + my @outer = $self-> rect; + my @delta = $canvas-> client_to_screen(0,0); + $outer[$_] += $delta[0] for 0,2; + $outer[$_] += $delta[1] for 1,3; + + my @inner = @outer; + my $breadth = $self-> {breadth}; + $inner[$_] += $breadth - 1 for 0,1; + $inner[$_] -= $breadth - 1 for 2,3; + + # save bits: + # 11111111 + # 22 33 + # 00000000 + + my @requests; + if ( $inner[0] >= $inner[2] || $inner[1] >= $inner[3] ) { + push @requests, [ @outer ]; + } else { + push @requests, [ $outer[0], $outer[1], $outer[2], $inner[1] ]; + push @requests, [ $outer[0], $inner[3], $outer[2], $outer[3] ]; + push @requests, [ $outer[0], $inner[1] + 1, $inner[0], $inner[3] - 1 ]; + push @requests, [ $inner[2], $inner[1] + 1, $outer[2], $inner[3] - 1 ]; + } + @requests = map { _intersect( $_, \@clip ) } @requests; + + goto LEAVE unless @requests; + + _normalize_rect($_) for @requests; + + unless ( $self->{_widgets} ) { + push @{ $self-> {_widgets} }, Prima::Widget->new( + origin => [ 0, 0 ], + size => [ 1, 1 ], + owner => $::application, + color => cl::White, + backColor => cl::Black, + visible => 0, + onPaint => sub { + my ( $self, $canvas ) = @_; + $canvas->fillPattern( + ($self->left % 2) ? + [ (0xaa, 0x55) x 4 ] : + [ (0x55, 0xaa) x 4 ] + ); + $canvas->bar(0,0,$self->size); + }, + ) for 1..4; + } + + my $i = 0; + for ( @requests ) { + my ( $x1, $y1, $x2, $y2) = @$_; + my $w = $x2 - $x1 + 1; + my $h = $y2 - $y1 + 1; + $self->{_widgets}->[$i++]->set( + origin => [ $x1, $y1 ], + size => [ $w, $h ], + visible => 1, + ); + } + + LEAVE: + if ( $optimized_rect_change ) { + for ( my $i = 0; $i < 4; $i++) { + $self->{_widgets}->[$i]->visible( defined $requests[$i] ); + } + } + } else { + $_->hide for @{$self->{_widgets}}; + } +} + +package Prima::Widget; + +sub rubberband +{ + my ($self, %profile) = @_; + + if ($profile{destroy}) { + $self-> {__rubberband}-> hide if $self-> {__rubberband}; + return delete $self-> {__rubberband} + } + + if ( keys %profile) { + if ( $self-> {__rubberband}) { + $self-> {__rubberband}-> set(%profile); + } else { + $profile{canvas} //= $self; + $self-> {__rubberband} = Prima::RubberBand-> new(%profile); + } + } + + return $self-> {__rubberband}; +} + +1; + +__DATA__ + +=pod + +=head1 NAME + +Prima::RubberBand - draw rubberbands + +=head1 DESCRIPTION + +The motivation for this module was that I was tired to see corrupted screens on +Windows 7 when dragging rubberbands in Prima code. Even though MS somewhere +warned of not doing any specific hacks to circumvent the bug, I decided to give +it a go anyway. + +This module thus is a C<Prima::Widget/rect_focus> with a safeguard. The only +thing it can do is to draw a static rubberband - but also remember the last +coordinates drawn, so cleaning comes for free. + +The idea is that a rubberband object is meant to be a short-lived one: as soon +as it get instantiatet it draws itself on the screen. When it is destroyed, the +rubberband is erased too. + +=head1 SYNOPSIS + + use strict; + use Prima qw(Application RubberBand); + + sub xordraw + { + my ($self, @new_rect) = @_; + $::application-> rubberband( @new_rect ? + ( rect => \@new_rect ) : + ( destroy => 1 ) + ); + } + + Prima::MainWindow-> create( + onMouseDown => sub { + my ( $self, $btn, $mod, $x, $y) = @_; + $self-> {anchor} = [$self-> client_to_screen( $x, $y)]; + xordraw( $self, @{$self-> {anchor}}, $self-> client_to_screen( $x, $y)); + $self-> capture(1); + }, + onMouseMove => sub { + my ( $self, $mod, $x, $y) = @_; + xordraw( $self, @{$self-> {anchor}}, $self-> client_to_screen( $x, $y)) if $self-> {anchor}; + }, + onMouseUp => sub { + my ( $self, $btn, $mod, $x, $y) = @_; + xordraw if delete $self-> {anchor}; + $self-> capture(0); + }, + ); + + run Prima; + +=head1 API + +=head2 Properties + +=over + +=item breadth INTEGER = 1 + +Defines rubberband breadth, in pixels. + +=item canvas = $::application + +Sets the painting surface, and also the widget (it must be a widget) used for drawing. + +=item clipRect X1, Y1, X2, Y2 + +Defines the clipping rectangle, in inclusive-inclusive coordinates. If set to [-1,-1,-1,-1], +means no clipping is done. + +=item mode STRING = 'auto' + +The module implements two techniques, standard classic 'xor' (using .rect_focus method) +and a conservative method that uses widgets instead of drawing on a canvas ('full'). +The 'auto' mode checks the system and selects the appropriate mode. + +Allowed modes: auto, xor, full + +=item rect X1, Y1, X2, Y2 + +Defines the band geometry, in inclusive-inclusive coordinates. The band is drawn so that its body +is always inside these coordinates, no matter what breadth is. + +=back + +=head2 Methods + +=over + +=item hide + +Hides the band, if drawn + +=item set %profile + +Applies all properties + +=item left, right, top, bottom, width, height, origin, size + +Same shortcuts as in C<Prima::Widget>, but read-only. + +=back + +=head1 Prima::Widget interface + +The module adds a single method to C<Prima::Widget> namespace, C<rubberband> +(see example of use in the synopsis). + +=over + +=item rubberband(%profile) + +Instantiates a C<Prima::RubberBand> with C<%profile>, also sets C<canvas> to C<$self> +unless C<canvas> is set explicitly. + +=item rubberband() + +Returns the existing C<Prima::RubberBand> object + +=item rubberband(destroy => 1) + +Destroys the existing C<Prima::RubberBand> object + +=back + +=head1 AUTHOR + +Dmitry Karasik, E<lt>[email protected]<gt>. + +=head1 SEE ALSO + +L<Prima::Widget/rect_focus>, L<examples/grip.pl> + +=head2 Windows 7 Aero mode + +Quote from L<http://blogs.msdn.com/b/greg_schechter/archive/2006/05/02/588934.aspx> : + +"One particularly dangerous practice is writing to the screen, either through +the use of GetDC(NULL) and writing to that, or attempting to do XOR rubber-band +lines, etc ... Since the UCE doesn't know about it, it may get cleared in the +next frame refresh, or it may persist for a very long time, depending on what +else needs to be updated on the screen. (We really don't allow direct writing +to the primary anyhow, for that very reason... if you try to access the +DirectDraw primary, for instance, the DWM will turn off until the accessing +application exits)" + +This quote seems to explain the effect why screen sometimes gets badly +corrupted when using a normal xor rubberband. UCE ( Update Compatibility +Evaluator ?? ) seems to be hacky enough to recognize some situations, but not +all. It seems that depending on which widget received mouse button just before +initialting rubberband drawing matters somehow. Anyway, the module tries to +see if we're under Windows 7 aero, and if so, turns the 'full' mode on. + +=cut + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/Prima/VB/Classes.pm new/Prima-1.44/Prima/VB/Classes.pm --- old/Prima-1.43/Prima/VB/Classes.pm 2014-07-15 17:27:36.000000000 +0200 +++ new/Prima-1.44/Prima/VB/Classes.pm 2015-08-05 09:18:10.000000000 +0200 @@ -2984,8 +2984,10 @@ anchor => 'pack_anchor', expand => 'bool', fill => 'pack_fill', - pad => 'point', - ipad => 'point', + padx => 'iv', + pady => 'iv', + ipadx => 'iv', + ipady => 'iv', side => 'pack_side', ); @@ -2995,8 +2997,10 @@ anchor => 'center', expand => 0, fill => 'none', - pad => [0,0], - ipad => [0,0], + padx => 0, + pady => 0, + ipadx => 0, + ipady => 0, side => 'top', ); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/Prima/VB/VB.pl new/Prima-1.44/Prima/VB/VB.pl --- old/Prima-1.43/Prima/VB/VB.pl 2014-07-15 17:27:36.000000000 +0200 +++ new/Prima-1.44/Prima/VB/VB.pl 2015-08-05 09:18:10.000000000 +0200 @@ -772,17 +772,16 @@ sub veil { my ($self, $draw) = @_; - $::application-> begin_paint; my @r = ( @{$self-> {anchor}}, @{$self-> {dim}}); ( $r[0], $r[2]) = ( $r[2], $r[0]) if $r[2] < $r[0]; ( $r[1], $r[3]) = ( $r[3], $r[1]) if $r[3] < $r[1]; @r = $self-> client_to_screen( @r); - $::application-> clipRect( $self-> client_to_screen( 0,0,$self-> size)); - $::application-> rubberband( $draw ? - ( rect => \@r ) : - ( destroy => 1 ) + $::application-> rubberband( + clipRect => [ $self-> client_to_screen( 0,0,$self->size ) ], + $draw ? + ( rect => \@r ) : + ( destroy => 1 ) ); - $::application-> end_paint; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/Prima.pm new/Prima-1.44/Prima.pm --- old/Prima-1.43/Prima.pm 2015-04-10 21:17:48.000000000 +0200 +++ new/Prima-1.44/Prima.pm 2015-08-05 09:18:10.000000000 +0200 @@ -34,7 +34,7 @@ use vars qw($VERSION @ISA $__import @preload); @ISA = qw(DynaLoader); sub dl_load_flags { 0x00 } -$VERSION = '1.43'; +$VERSION = '1.44'; bootstrap Prima $VERSION; unless ( UNIVERSAL::can('Prima', 'init')) { $::application = 0; @@ -204,11 +204,11 @@ The window is created by invoking - new Prima::Window(); + new Prima::MainWindow(); or - Prima::Window-> create() + Prima::MainWindow-> create() code with the additional parameters. Actually, all Prima objects are created by such a scheme. The class name is passed as the first parameter, and a custom set diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/examples/grip.pl new/Prima-1.44/examples/grip.pl --- old/Prima-1.43/examples/grip.pl 2014-07-15 17:27:36.000000000 +0200 +++ new/Prima-1.44/examples/grip.pl 2015-08-05 09:18:10.000000000 +0200 @@ -59,13 +59,10 @@ sub xordraw { my ($self, $new_rect) = @_; - my $o = $::application; - $o-> begin_paint; - $o-> rubberband( $new_rect ? + $::application-> rubberband( $new_rect ? ( rect => [$self-> {capx},$self-> {capy}, $self-> {dx},$self-> {dy}]) : ( destroy => 1 ) ); - $o-> end_paint; } my $w = Prima::MainWindow-> create( diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/img/codec_png.c new/Prima-1.44/img/codec_png.c --- old/Prima-1.43/img/codec_png.c 2014-07-15 17:27:36.000000000 +0200 +++ new/Prima-1.44/img/codec_png.c 2015-05-02 17:27:17.000000000 +0200 @@ -267,7 +267,7 @@ #endif warning_fn( png_structp png_ptr, png_const_charp msg) { - /* warn( msg); */ + warn( msg); } static void diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/include/apricot.h new/Prima-1.44/include/apricot.h --- old/Prima-1.43/include/apricot.h 2015-03-31 23:47:44.000000000 +0200 +++ new/Prima-1.44/include/apricot.h 2015-05-02 17:27:17.000000000 +0200 @@ -1349,7 +1349,7 @@ #define pdelete( key) (void) hv_delete( profile, # key, (I32) strlen( #key), G_DISCARD) #define dPROFILE SV ** temporary_prf_Sv #define pget_sv( key) ((( temporary_prf_Sv = hv_fetch( profile, # key, (I32) strlen( # key), 0)) == nil) ? croak( "Panic: bad profile key (``%s'') requested in ``%s'', line %d\n", # key, __FILE__, __LINE__ ), &PL_sv_undef : *temporary_prf_Sv) -#define pget_sv_void( key) ((( temporary_prf_Sv = hv_fetch( profile, # key, (I32) strlen( # key), 0)) == nil) ? croak( "Panic: bad profile key (``%s'') requested in ``%s'', line %d\n", # key, __FILE__, __LINE__ ) : NULL) +#define pget_sv_void( key) ((( temporary_prf_Sv = hv_fetch( profile, # key, (I32) strlen( # key), 0)) == nil) ? croak( "Panic: bad profile key (``%s'') requested in ``%s'', line %d\n", # key, __FILE__, __LINE__ ) : (void)NULL) #define pget_i( key) ( pget_sv_void( key), SvIV( *temporary_prf_Sv)) #define pget_f( key) ( pget_sv_void( key), SvNV( *temporary_prf_Sv)) #define pget_c( key) ( pget_sv_void( key), SvPV_nolen( *temporary_prf_Sv)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/include/unix/guts.h new/Prima-1.44/include/unix/guts.h --- old/Prima-1.43/include/unix/guts.h 2015-03-31 23:47:44.000000000 +0200 +++ new/Prima-1.44/include/unix/guts.h 2015-05-02 17:27:17.000000000 +0200 @@ -1185,6 +1185,8 @@ #endif +#ifdef USE_XFT + extern void prima_xft_init( void); @@ -1232,6 +1234,8 @@ extern void prima_xft_update_region( Handle self); +#endif + #ifdef WITH_GTK2 Bool prima_gtk_init( void); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/t/Object/Application.t new/Prima-1.44/t/Object/Application.t --- old/Prima-1.43/t/Object/Application.t 2015-04-10 21:17:48.000000000 +0200 +++ new/Prima-1.44/t/Object/Application.t 2015-08-05 09:18:10.000000000 +0200 @@ -15,8 +15,9 @@ ok( $a-> get_paint_state, "get_paint_state"); SKIP: { - skip "pixel", 1 if $^O eq 'darwin'; + skip "xquartz doesn't support this", 1 if $^O eq 'darwin'; my $pix = $a-> pixel( 10, 10); + skip "rdesktop", 1 if $^O =~ /win32/i && $pix == cl::Invalid; $a-> pixel( 10, 10, 0); my $bl = $a-> pixel( 10, 10); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/t/Object/Clipboard.t new/Prima-1.44/t/Object/Clipboard.t --- old/Prima-1.43/t/Object/Clipboard.t 2015-03-21 23:39:09.000000000 +0100 +++ new/Prima-1.44/t/Object/Clipboard.t 2015-08-05 09:18:10.000000000 +0200 @@ -12,6 +12,14 @@ my %rc = map { $_ => 1 } $c-> get_registered_formats; ok( exists $rc{'Text'} && exists $rc{'Image'}, "predefined formats" ); +SKIP: { +$::application->begin_paint; +skip "rdesktop", 8 if $^O =~ /win32/i && $::application->pixel(0,0) == cl::Invalid; +$::application->end_paint; + +skip "Cannot talk to clipboard", 8 unless $c->open; +$c->close; + $c-> store( "Text", 'jabba dabba du'); my $res = $c-> fetch( 'Text'); my %fm = map { $_ => 1 } $c-> get_formats; @@ -39,3 +47,4 @@ $c-> clear; my @f = $c-> get_formats; is( scalar(@f), 0, "clear"); +} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/t/Object/Fonts.t new/Prima-1.44/t/Object/Fonts.t --- old/Prima-1.43/t/Object/Fonts.t 2015-04-10 21:17:48.000000000 +0200 +++ new/Prima-1.44/t/Object/Fonts.t 2015-05-02 17:27:17.000000000 +0200 @@ -78,8 +78,11 @@ return $ok; } +my $filter = @ARGV ? qr/$ARGV[0]/ : qr/./; + $x = Prima::DeviceBitmap-> create( monochrome => 1, width => 8, height => 8); for my $f ( @{$::application->fonts} ) { + next unless $f->{name} =~ /$filter/; if (!t($f) && Prima::Application-> get_system_info-> {apc} == apc::Unix) { Prima::options(debug => 'f'); t($f); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/t/Widget/Mouse.t new/Prima-1.44/t/Widget/Mouse.t --- old/Prima-1.43/t/Widget/Mouse.t 2015-03-21 23:39:09.000000000 +0100 +++ new/Prima-1.44/t/Widget/Mouse.t 2015-08-05 09:18:10.000000000 +0200 @@ -50,20 +50,25 @@ @keydata = grep { scalar @$_ == 6 && $$_[1] == mb::Left && $$_[2] == 0 && $$_[3] == 1 && $$_[4] == 2 && $$_[5] == 1 } @keydata; ok( get_flag && scalar @keydata, "doubleclick" ); - my @ppx = $c-> pointerPos; $c-> capture(1); $c-> focus; ok( $c-> capture, "capture" ); -reset_flag; -$c-> pointerPos( 10, 10); -my @pp = $c-> pointerPos; -is( $pp[0], 10, "positioning" ); -is( $pp[1], 10, "positioning" ); -$c-> pointerPos( 11, 11); -ok( wait_flag, "simulated movement" ); +SKIP: { + $::application->begin_paint; + skip "rdesktop", 3 if $^O =~ /win32/i && $::application->pixel(0,0) == cl::Invalid; + $::application->end_paint; -$c-> pointerPos( @ppx); -$c-> capture(0); + reset_flag; + $c-> pointerPos( 10, 10); + my @pp = $c-> pointerPos; + is( $pp[0], 10, "positioning" ); + is( $pp[1], 10, "positioning" ); + $c-> pointerPos( 11, 11); + ok( wait_flag, "simulated movement" ); + + $c-> pointerPos( @ppx); + $c-> capture(0); +} $c-> destroy; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/t/Widget/Paint.t new/Prima-1.44/t/Widget/Paint.t --- old/Prima-1.43/t/Widget/Paint.t 2015-03-21 23:39:09.000000000 +0100 +++ new/Prima-1.44/t/Widget/Paint.t 2015-08-05 09:18:10.000000000 +0200 @@ -4,10 +4,15 @@ use Test::More; use Prima::Test; -plan tests => 10; - reset_flag; my $window = create_window; + +$::application->begin_paint; +plan skip_all => "rdesktop" if $^O =~ /win32/i && $::application->pixel(0,0) == cl::Invalid; +$::application->end_paint; + +plan tests => 10; + $window-> bring_to_front; my @rcrect; my $ww = $window-> insert( Widget => origin => [ 0, 0] => size => [ 8, 8], diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/t/Widget/Window.t new/Prima-1.44/t/Widget/Window.t --- old/Prima-1.43/t/Widget/Window.t 2015-03-31 23:47:44.000000000 +0200 +++ new/Prima-1.44/t/Widget/Window.t 2015-08-05 09:18:10.000000000 +0200 @@ -29,7 +29,7 @@ }); $window-> focus; reset_flag; -wait_flag; +wait_flag unless $id{Activate2}; SKIP: { skip "WM doesn't respect focus requests", 4 if !$id{Activate2} && Prima::Application-> get_system_info->{apc} == apc::Unix; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/unix/apc_font.c new/Prima-1.44/unix/apc_font.c --- old/Prima-1.43/unix/apc_font.c 2015-03-31 23:47:44.000000000 +0200 +++ new/Prima-1.44/unix/apc_font.c 2015-05-02 17:27:17.000000000 +0200 @@ -1291,7 +1291,10 @@ /* detailing width */ if ( f-> font. width == 0 || !f-> flags. width) { - if ( XGetFontProperty( s, FXA_AVERAGE_WIDTH, &v) && v) { + if ( f-> vecname && font-> width > 0) { + f-> font. width = font-> width; + Fdebug("font: width = copy as is %d\n", f->font.width); + } else if ( XGetFontProperty( s, FXA_AVERAGE_WIDTH, &v) && v) { XCHECKPOINT; f-> font. width = (v + 5) / 10; Fdebug("font: width = FXA_AVERAGE_WIDTH %d(%d)\n", f->font.width, v); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Prima-1.43/unix/xft.c new/Prima-1.44/unix/xft.c --- old/Prima-1.43/unix/xft.c 2015-04-10 21:17:48.000000000 +0200 +++ new/Prima-1.44/unix/xft.c 2015-05-02 17:28:50.000000000 +0200 @@ -229,7 +229,7 @@ ibl = 128; obl = 128 * sizeof( uint32_t); while ( 1 ) { - int ret = iconv( ii, ( const char **) &iptr, &ibl, ( char **) &optr, &obl); + int ret = iconv( ii, ( char **) &iptr, &ibl, ( char **) &optr, &obl); if ( ret < 0 && errno == EILSEQ) { iptr++; optr++; @@ -690,7 +690,7 @@ FcPatternAddDouble( request, FC_SIZE, *size); XFTdebug("FC_SIZE = %.1f", *size); } else { - FcPatternAddInteger( request, FC_SIZE, requested_font. size); + FcPatternAddDouble( request, FC_SIZE, requested_font. size); XFTdebug("FC_SIZE = %d", requested_font. size); } } else {
