--- rxvt-unicode/src/perl/background 2012/06/10 19:01:03 1.51 +++ rxvt-unicode/src/perl/background 2012/06/19 18:17:56 1.63 @@ -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 @@ -140,6 +140,8 @@ =head2 CYCLES AND CACHING +=head3 C et al. + As has been mentioned before, the expression might be evaluated multiple times. Each time the expression is reevaluated, a new cycle is said to have begun. Many operators cache their results till the next cycle. @@ -173,6 +175,23 @@ so keeps only one image in memory. If, on the next evaluation, luck decides to use the other path, then it will have to load that image again. +=head3 C + +Another way to cache expensive operations is to use C. The +C operator takes a block of multiple statements enclosed by C<{}> +and evaluates it only.. once, returning any images the last statement +returned. Further calls simply produce the values from the cache. + +This is most useful for expensive operations, such as C: + + rootalign once { blur 20, root } + +This makes a blurred copy of the root background once, and on subsequent +calls, just root-aligns it. Since C is usually quite slow and +C is quite fast, this trades extra memory (For the cached +blurred pixmap) with speed (blur only needs to be redone when root +changes). + =head1 REFERENCE =head2 COMMAND LINE SWITCHES @@ -204,9 +223,9 @@ =cut -our %_IMGCACHE; +our %_IMG_CACHE; our $HOME; -our ($self, $old, $new); +our ($self, $frame); our ($x, $y, $w, $h); # enforce at least this interval between updates @@ -215,6 +234,11 @@ { package urxvt::bgdsl; # background language + sub FR_PARENT() { 0 } # parent frame, if any - must be #0 + sub FR_CACHE () { 1 } # cached values + sub FR_AGAIN () { 2 } # what this expr is sensitive to + sub FR_STATE () { 3 } # watchers etc. + use List::Util qw(min max sum shuffle); =head2 PROVIDERS/GENERATORS @@ -230,20 +254,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($) { my ($path) = @_; - $new->{load}{$path} = $old->{load}{$path} || $self->new_img_from_file ($path); + $_IMG_CACHE{$path} || do { + my $img = $self->new_img_from_file ($path); + Scalar::Util::weaken ($_IMG_CACHE{$path} = $img); + $img + } } =item root Returns the root window pixmap, that is, hopefully, the background image -of your screen. The image is set to extend mode. +of your screen. This function makes your expression root sensitive, that means it will be reevaluated when the bg image changes. @@ -251,8 +286,8 @@ =cut sub root() { - $new->{rootpmap_sensitive} = 1; - die "root op not supported, exg, we need you"; + $frame->[FR_AGAIN]{rootpmap} = 1; + $self->new_img_from_root } =item solid $colour @@ -270,7 +305,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 } @@ -286,7 +321,49 @@ $_[0]->clone } -=back +=item merge $img ... + +Takes any number of images and merges them together, creating a single +image containing them all. The tiling mode of the first image is used as +the tiling mdoe of the resulting image. + +This function is called automatically when an expression returns multiple +images. + +=cut + + sub merge(@) { + return $_[0] unless $#_; + + # 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->repeat_mode ($_[0]->repeat_mode); + $base->fill ([0, 0, 0, 0]); + + $base->draw ($_) + for @_; + + $base + } =head2 TILING MODES @@ -411,14 +488,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() { $frame->[FR_AGAIN]{position} = 1; $x } + sub TY() { $frame->[FR_AGAIN]{position} = 1; $y } + sub TW() { $frame->[FR_AGAIN]{size} = 1; $w } + sub TH() { $frame->[FR_AGAIN]{size} = 1; $h } =item now @@ -435,7 +512,7 @@ Example: load some image and rotate it according to the time of day (as if it were the hour pointer of a clock). Update this image every minute. - again 60; rotate TW, TH, 50, 50, (now % 86400) * -720 / 86400, scale load "myclock.png" + again 60; rotate 50, 50, (now % 86400) * -720 / 86400, scale load "myclock.png" =item counter $seconds @@ -447,12 +524,12 @@ sub now() { urxvt::NOW } sub again($) { - $new->{again} = $_[0]; + $frame->[FR_AGAIN]{time} = $_[0]; } sub counter($) { - $new->{again} = $_[0]; - $self->{counter} + 0 + $frame->[FR_AGAIN]{time} = $_[0]; + $frame->[FR_STATE]{counter} + 0 } =back @@ -632,6 +709,27 @@ move -TX, -TY, $_[0] } +=item rotate $center_x, $center_y, $degrees + +Rotates the image by C<$degrees> degrees, counter-clockwise, around the +pointer at C<$center_x> and C<$center_y> (specified as factor of image +width/height). + +#TODO# new width, height, maybe more operators? + +Example: rotate the image by 90 degrees + +=cut + + sub rotate($$$$) { + my $img = pop; + $img->rotate ( + $_[0] * ($img->w + $img->x), + $_[1] * ($img->h + $img->y), + $_[2] * (3.14159265 / 180), + ) + } + =back =head2 COLOUR MODIFICATIONS @@ -723,28 +821,85 @@ $img->blur ($_[0], @_ >= 2 ? $_[1] : $_[0]) } -=item rotate $new_width, $new_height, $center_x, $center_y, $degrees +=back + +=head2 OTHER STUFF -Rotates the image by C<$degrees> degrees, counter-clockwise, around the -pointer at C<$center_x> and C<$center_y> (specified as factor of image -width/height), generating a new image with width C<$new_width> and height -C<$new_height>. +Anything that didn't fit any of the other categories, even after applying +force and closing our eyes. -#TODO# new width, height, maybe more operators? +=over 4 -Example: rotate the image by 90 degrees +=item once { ... } + +This function takes a code block as argument, that is, one or more +statements enclosed by braces. + +The trick is that this code block is only evaluated once - future calls +will simply return the original image (yes, it should only be used with +images). + +This can be extremely useful to avoid redoing the same slow operations +again and again- for example, if your background expression takes the root +background, blurs it and then root-aligns it it would have to blur the +root background on every window move or resize. + +In fact, urxvt itself encloses the whole expression in some kind of +C block so it only is reevaluated as required. + +Putting the blur into a C block will make sure the blur is only done +once: + + rootlign once { blur 10, root } + +This leaves the question of how to force reevaluation of the block, +in case the root background changes: If expression inside the block +is sensitive to some event (root background changes, window geometry +changes), then it will be reevaluated automatically as needed. + +=item once_again + +Resets all C block as if they had never been called, i.e. on the +next call they will be reevaluated again. =cut - sub rotate($$$$$$) { - my $img = pop; - $img->rotate ( - $_[0], - $_[1], - $_[2] * $img->w, - $_[3] * $img->h, - $_[4] * (3.14159265 / 180), - ) + sub once(&) { + my $id = $_[0]+0; + + local $frame = $self->{frame_cache}{$id} ||= [$frame]; + + unless ($frame->[FR_CACHE]) { + $frame->[FR_CACHE] = [ $_[0]() ]; + + my $self = $self; + my $frame = $frame; + Scalar::Util::weaken $frame; + $self->compile_frame ($frame, sub { + # clear this frame cache, also for all parents + for (my $frame = $frame; $frame; $frame = $frame->[0]) { + undef $frame->[FR_CACHE]; + } + + unless ($self->{term}) { + use Data::Dump; + ddx $frame; + exit; + } + + $self->recalculate; + }); + }; + + # in scalar context we always return the first original result, which + # is not quite how perl works. + wantarray + ? @{ $frame->[FR_CACHE] } + : $frame->[FR_CACHE][0] + } + + sub once_again() { + delete $self->{frame_cache}; } =back @@ -754,7 +909,12 @@ } sub parse_expr { - my $expr = eval "sub {\npackage urxvt::bgdsl;\n#line 0 'background expression'\n$_[0]\n}"; + my $expr = eval + "sub {\n" + . "package urxvt::bgdsl;\n" + . "#line 0 'background expression'\n" + . "$_[0]\n" + . "}"; die if $@; $expr } @@ -763,10 +923,59 @@ sub set_expr { my ($self, $expr) = @_; + $self->{root} = []; $self->{expr} = $expr; $self->recalculate; } +# takes a hash of sensitivity indicators and installs watchers +sub compile_frame { + my ($self, $frame, $cb) = @_; + + my $state = $frame->[urxvt::bgdsl::FR_STATE] ||= {}; + my $again = $frame->[urxvt::bgdsl::FR_AGAIN]; + + # don't keep stuff alive + Scalar::Util::weaken $state; + + if ($again->{nested}) { + $state->{nested} = 1; + } else { + delete $state->{nested}; + } + + if (my $interval = $again->{time}) { + $state->{time} = [$interval, urxvt::timer->new->after ($interval)->interval ($interval)] + if $state->{time}[0] != $interval; + + # callback *might* have changed, although we could just rule that out + $state->{time}[1]->cb (sub { + ++$state->{counter}; + $cb->(); + }); + } else { + delete $state->{time}; + } + + if ($again->{position}) { + $state->{position} = $self->on (position_change => $cb); + } else { + delete $state->{position}; + } + + if ($again->{size}) { + $state->{size} = $self->on (size_change => $cb); + } else { + delete $state->{size}; + } + + if ($again->{rootpmap}) { + $state->{rootpmap} = $self->on (rootpmap_change => $cb); + } else { + delete $state->{rootpmap}; + } +} + # evaluate the current bg expression sub recalculate { my ($arg_self) = @_; @@ -784,68 +993,34 @@ # set environment to evaluate user expression - local $self = $arg_self; - - local $HOME = $ENV{HOME}; - local $old = $self->{state}; - local $new = my $state = $self->{state} = {}; + local $self = $arg_self; + local $HOME = $ENV{HOME}; + local $frame = []; - ($x, $y, $w, $h) = - $self->background_geometry ($self->{border}); + ($x, $y, $w, $h) = $self->background_geometry ($self->{border}); # evaluate user expression - my $img = eval { $self->{expr}->() }; - warn $@ if $@;#d# - die "background-expr did not return an image.\n" if !UNIVERSAL::isa $img, "urxvt::img"; + my @img = eval { $self->{expr}->() }; + die $@ if $@; + die "background-expr did not return anything.\n" unless @img; + die "background-expr: expected image(s), got something else.\n" + if grep { !UNIVERSAL::isa $_, "urxvt::img" } @img; + + my $img = urxvt::bgdsl::merge @img; - $state->{size_sensitive} = 1 + $frame->[FR_AGAIN]{size} = 1 if $img->repeat_mode != urxvt::RepeatNormal; # if the expression is sensitive to external events, prepare reevaluation then - - my $repeat; - - if (my $again = $state->{again}) { - $repeat = 1; - my $self = $self; - $state->{timer} = $again == $old->{again} - ? $old->{timer} - : urxvt::timer->new->after ($again)->interval ($again)->cb (sub { - ++$self->{counter}; - $self->recalculate - }); - } - - if (delete $state->{position_sensitive}) { - $repeat = 1; - $self->enable (position_change => sub { $_[0]->recalculate }); - } else { - $self->disable ("position_change"); - } - - if (delete $state->{size_sensitive}) { - $repeat = 1; - $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 }); - } else { - $self->disable ("rootpmap_change"); - } + $self->compile_frame ($frame, sub { $arg_self->recalculate }); # clear stuff we no longer need - %$old = (); - - unless ($repeat) { - delete $self->{state}; - delete $self->{expr}; - } +# unless (%{ $frame->[FR_STATE] }) { +# delete $self->{state}; +# delete $self->{expr}; +# } # set background pixmap