--- rxvt-unicode/src/perl/background 2012/06/12 18:25:57 1.53 +++ rxvt-unicode/src/perl/background 2012/06/14 19:31:17 1.59 @@ -73,7 +73,7 @@ return scale load "$HOME/sunday.png"; } -This expression gets evaluated once per hour. It will set F as +This expression is evaluated once per hour. It will set F as background on Sundays, and F on all other days. Fortunately, we expect that most expressions will be much simpler, with @@ -205,7 +205,6 @@ =cut our %_IMG_CACHE; -our %_ONCE_CACHE; our $HOME; our ($self, $old, $new); our ($x, $y, $w, $h); @@ -231,14 +230,31 @@ Loads the image at the given C<$path>. The image is set to plane tiling mode. -Loaded images will be cached for one cycle. +Loaded images will be cached for one cycle, and shared between temrinals +running in the same process (e.g. in C). + +=item load_uc $path + +Load uncached - same as load, but does not cache the image. This function +is most useufl if you want to optimise a background expression in some +way. =cut + sub load_uc($) { + my ($path) = @_; + + $_IMG_CACHE{$path} || do { + my $img = $self->new_img_from_file ($path); + Scalar::Util::weaken ($_IMG_CACHE{$path} = $img); + $img + } + } + sub load($) { my ($path) = @_; - $new->{load}{$path} = $old->{load}{$path} || $self->new_img_from_file ($path); + $new->{load}{$path} = $old->{load}{$path} || load_uc $path; } =item root @@ -252,7 +268,7 @@ =cut sub root() { - $new->{rootpmap_sensitive} = 1; + $new->{again}{rootpmap} = 1; $self->new_img_from_root } @@ -271,7 +287,7 @@ sub solid($;$$) { my $colour = pop; - my $img = $self->new_img (urxvt::PictStandardARGB32, $_[0] || 1, $_[1] || 1); + my $img = $self->new_img (urxvt::PictStandardARGB32, 0, 0, $_[0] || 1, $_[1] || 1); $img->fill ($colour); $img } @@ -287,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 (urxvt::PictStandardARGB32, $x0, $y0, $x1 - $x0, $y1 - $y0); + $base->fill ([0, 0, 0, 0]); + + $base->draw ($_) + for @_; + + $base + } + =head2 TILING MODES The following operators modify the tiling mode of an image, that is, the @@ -410,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 @@ -446,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 } @@ -747,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 @@ -784,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 @@ -843,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} @@ -861,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"); } @@ -886,7 +953,7 @@ %$old = (); - unless ($repeat) { + unless (%$again) { delete $self->{state}; delete $self->{expr}; }