--- rxvt-unicode/src/perl/background 2012/06/05 14:04:58 1.7 +++ rxvt-unicode/src/perl/background 2012/06/05 19:32:29 1.13 @@ -1,8 +1,10 @@ #! perl +#:META:RESOURCE:$$:string:background expression + our $EXPR = 'move load "/root/pix/das_fette_schwein.jpg", repeat_wrap, X, Y'; $EXPR = ' - rotate W, H, 50, 50, counter 1/60, repeat_mirror, + rotate W, H, 50, 50, counter 1/59.95, repeat_mirror, clip X, Y, W, H, repeat_mirror, load "/root/pix/das_fette_schwein.jpg" '; @@ -15,6 +17,9 @@ our ($bgdsl_self, $old, $new); our ($l, $t, $w, $h); +# enforce at leats this time between updates +our $MIN_INTERVAL = 1/100; + { package urxvt::bgdsl; # background language @@ -30,6 +35,7 @@ } sub root() { + $new->{rootpmap_sensitive} = 1; die "root op not supported, exg, we need you"; } @@ -72,9 +78,7 @@ sub blur($$$) { my ($rh, $rv, $img) = @_; - $img = $img->clone; $img->blur ($rh, $rv); - $img } sub contrast($$;$$;$) { @@ -136,7 +140,18 @@ sub recalculate { my ($self) = @_; - #TODO: rate limit calls + # rate limit evaluation + + if ($self->{next_refresh} > urxvt::NOW) { + $self->{next_refresh_timer} = urxvt::timer->new->after ($self->{next_refresh} - urxvt::NOW)->cb (sub { + $self->recalculate; + }); + return; + } + + $self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL; + + # set environment to evaluate user expression local $bgdsl_self = $self; @@ -146,9 +161,13 @@ ($l, $t, $w, $h) = $self->get_geometry; + # evaluate user expression + my $img = eval { $self->{expr}->() }; warn $@ if $@;#d# + # if the expression is sensitive to external events, prepare reevaluation then + my $repeat; if (my $again = $state->{again}) { @@ -175,6 +194,15 @@ $self->disable ("size_change"); } + if (delete $state->{rootpmap_sensitive}) { + $repeat = 1; + $self->enable (rootpmap_change => sub { $_[0]->recalculate }); + } else { + $self->disable ("rootpmap_change"); + } + + # clear stuff we no longer need + %$old = (); unless ($repeat) { @@ -182,6 +210,8 @@ delete $self->{expr}; } + # prepare and set background pixmap + $img = $img->sub_rect (0, 0, $w, $h) if $img->w != $w || $img->h != $h;