--- rxvt-unicode/src/perl/background 2012/06/05 12:08:23 1.3 +++ rxvt-unicode/src/perl/background 2012/06/05 22:23:07 1.14 @@ -1,6 +1,14 @@ #! perl -our $EXPR = 'move load "/root/pix/das_fette_schwein.jpg", left, top'; +#:META:RESOURCE:$$:string:background expression +#:META:RESOURCE:$$-enable:boolean:some boolean + +our $EXPR = 'move load "/root/pix/das_fette_schwein.jpg", repeat_wrap, X, Y'; +$EXPR = ' + 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" +'; #$EXPR = 'blur root, 10, 10' #$EXPR = 'blur move (root, -x, -y), 5, 5' #resize load "/root/pix/das_fette_schwein.jpg", w, h @@ -10,6 +18,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 @@ -25,56 +36,80 @@ } sub root() { + $new->{rootpmap_sensitive} = 1; die "root op not supported, exg, we need you"; } +# sub clone($) { +# $_[0]->clone +# } + + sub clip($$$$$;$) { + my $img = pop; + $img->sub_rect ($_[0], $_[1], $_[2], $_[3], $_[4]) + } + sub resize($$$) { - $_[0]->scale ($_[1], $_[2]) + my $img = pop; + $img->scale ($_[0], $_[1]) } - sub move($$$) { - # TODO: must be simpler - $_[0]->transform ($_[0]->w, $_[0]->h, $_[1], - 1, 0, -$_[2], - 0, 1, -$_[3], - 0, 0, 1, + # TODO: ugly + sub move($$;$) { + my $img = pop; + $img->sub_rect ( + $_[0], $_[1], + $img->w, $img->h, + $_[2], ) } - sub rotate($$$$) { - $_[0]->rotate ($_[0], $_[1], $_[2], $_[3] * (3.14159265 / 180)) + sub rotate($$$$$$;$) { + my $img = pop; + $img->rotate ( + $_[0], + $_[1], + $_[2] * $img->w * .01, + $_[3] * $img->h * .01, + $_[4] * (3.14159265 / 180), + $_[5], + ) } sub blur($$$) { - my ($img, $rh, $rv) = @_; + my ($rh, $rv, $img) = @_; - $img = $img->clone; - $img->clone->blur ($rh, $rv); - $img + $img->blur ($rh, $rv); } sub contrast($$;$$;$) { - my ($img, $r, $g, $b, $a) = @_; + my $img = pop; + my ($r, $g, $b, $a) = @_; + ($g, $b) = ($r, $r) if @_ < 4; $a = 1 if @_ < 5; + $img = $img->clone; $img->contrast ($r, $g, $b, $a); $img } sub brightness($$;$$;$) { - my ($img, $r, $g, $b, $a) = @_; + my $img = pop; + my ($r, $g, $b, $a) = @_; + ($g, $b) = ($r, $r) if @_ < 4; $a = 1 if @_ < 5; + $img = $img->clone; $img->brightness ($r, $g, $b, $a); $img } - sub left () { $new->{position_sensitive} = 1; $l } - sub top () { $new->{position_sensitive} = 1; $t } - sub width () { $new->{size_sensitive} = 1; $w } - sub height() { $new->{size_sensitive} = 1; $h } + sub X() { $new->{position_sensitive} = 1; $l } + sub Y() { $new->{position_sensitive} = 1; $t } + sub W() { $new->{size_sensitive} = 1; $w } + sub H() { $new->{size_sensitive} = 1; $h } sub now() { urxvt::NOW } @@ -84,7 +119,7 @@ sub counter($) { $new->{again} = $_[0]; - $bgdsl_self->{counter}++ + 0 + $bgdsl_self->{counter} + 0 } } @@ -98,7 +133,6 @@ sub set_expr { my ($self, $expr) = @_; - local $Data::Dumper::Deparse=1; use Data::Dumper; warn Dumper $expr;#d# $self->{expr} = $expr; $self->recalculate; } @@ -107,6 +141,19 @@ sub recalculate { my ($self) = @_; + # 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; local $old = $self->{state}; @@ -115,16 +162,23 @@ ($l, $t, $w, $h) = $self->get_geometry; - warn "$l, $t";#d# + # 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}) { $repeat = 1; - $state->{again} = urxvt::timer->new->after ($again)->cb (sub { $self->recalculate }); + $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}) { @@ -141,9 +195,27 @@ $self->disable ("size_change"); } - # TODO: install handlers for geometry changes &c + 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) { + delete $self->{state}; + delete $self->{expr}; + } + + # prepare and set background pixmap + + $img = $img->sub_rect (0, 0, $w, $h) + if $img->w != $w || $img->h != $h; - warn $img; $self->set_background ($img); $self->scr_recolour (0); $self->want_refresh;