--- rxvt-unicode/src/perl/background 2012/06/14 16:22:20 1.54 +++ rxvt-unicode/src/perl/background 2012/06/14 18:13:19 1.58 @@ -205,7 +205,6 @@ =cut our %_IMG_CACHE; -our %_ONCE_CACHE; our $HOME; our ($self, $old, $new); our ($x, $y, $w, $h); @@ -269,7 +268,7 @@ =cut sub root() { - $new->{rootpmap_sensitive} = 1; + $new->{again}{rootpmap} = 1; $self->new_img_from_root } @@ -304,6 +303,43 @@ $_[0]->clone } +=item merge $img ... + +Takes any number of images and merges them together, creating a single +image containing them all. + +=cut + + sub merge(@) { + # rather annoyingly clumsy, but optimisation is for another time + + my $x0 = 1e9; + my $y0 = 1e9; + my $x1 = -1e9; + my $y1 = -1e9; + + for (@_) { + my ($x, $y, $w, $h) = $_->geometry; + + $x0 = $x if $x0 > $x; + $y0 = $y if $y0 > $y; + + $x += $w; + $y += $h; + + $x1 = $x if $x1 > $x; + $y1 = $y if $y1 > $y; + } + + my $base = $self->new_img ($x0, $y0, $x1 - $x0, $y1 - $y0); + $base->fill ([0, 0, 0, 0]); + + $base->blend (1., $_) + for @_; + + $base + } + =head2 TILING MODES The following operators modify the tiling mode of an image, that is, the @@ -427,14 +463,14 @@ Example: take the screen background, clip it to the window size, blur it a bit, align it to the window position and use it as background. - clip move -TX, -TY, blur 5, root + clip move -TX, -TY, once { blur 5, root } =cut - sub TX() { $new->{position_sensitive} = 1; $x } - sub TY() { $new->{position_sensitive} = 1; $y } - sub TW() { $new->{size_sensitive} = 1; $w } - sub TH() { $new->{size_sensitive} = 1; $h } + sub TX() { $new->{again}{position} = 1; $x } + sub TY() { $new->{again}{position} = 1; $y } + sub TW() { $new->{again}{size} = 1; $w } + sub TH() { $new->{again}{size} = 1; $h } =item now @@ -463,11 +499,11 @@ sub now() { urxvt::NOW } sub again($) { - $new->{again} = $_[0]; + $new->{again}{time} = $_[0]; } sub counter($) { - $new->{again} = $_[0]; + $new->{again}{time} = $_[0]; $self->{counter} + 0 } @@ -764,7 +800,7 @@ =head2 OTHER STUFF -Anything that didn't fit any of the other categories, even after appliyng +Anything that didn't fit any of the other categories, even after applying force and closing our eyes. =over 4 @@ -801,11 +837,26 @@ =cut sub once(&) { - $_ONCE_CACHE{$_[0]+0} ||= $_[0]() + my $once = $self->{once_cache}{$_[0]+0} ||= do { + local $new->{again}; + my @res = $_[0](); + [$new->{again}, \@res] + }; + + $new->{again} = { + %{ $new->{again} }, + %{ $once->[0] } + }; + + # in scalar context we always return the first original result, which + # is not quite how perl works. + wantarray + ? @{ $once->[1] } + : $once->[1][0] } sub once_again() { - %_ONCE_CACHE = (); + delete $self->{once_cache}; } =back @@ -860,15 +911,14 @@ warn $@ if $@;#d# die "background-expr did not return an image.\n" if !UNIVERSAL::isa $img, "urxvt::img"; - $state->{size_sensitive} = 1 - if $img->repeat_mode != urxvt::RepeatNormal; - # if the expression is sensitive to external events, prepare reevaluation then - my $repeat; + my $again = delete $state->{again}; - if (my $again = $state->{again}) { - $repeat = 1; + $again->{size} = 1 + if $img->repeat_mode != urxvt::RepeatNormal; + + if (my $again = $again->{time}) { my $self = $self; $state->{timer} = $again == $old->{again} ? $old->{timer} @@ -878,23 +928,23 @@ }); } - if (delete $state->{position_sensitive}) { - $repeat = 1; + if ($again->{position}) { $self->enable (position_change => sub { $_[0]->recalculate }); } else { $self->disable ("position_change"); } - if (delete $state->{size_sensitive}) { - $repeat = 1; + if ($again->{size}) { $self->enable (size_change => sub { $_[0]->recalculate }); } else { $self->disable ("size_change"); } - if (delete $state->{rootpmap_sensitive}) { - $repeat = 1; - $self->enable (rootpmap_change => sub { $_[0]->recalculate }); + if ($again->{rootpmap}) { + $self->enable (rootpmap_change => sub { + delete $_[0]{once_cache}; # this will override once-block values from + $_[0]->recalculate; + }); } else { $self->disable ("rootpmap_change"); } @@ -903,7 +953,7 @@ %$old = (); - unless ($repeat) { + unless (%$again) { delete $self->{state}; delete $self->{expr}; }