1 | #! perl |
1 | #! perl |
2 | |
2 | |
3 | #:META:X_RESOURCE:%.expr:string:background expression |
3 | #:META:X_RESOURCE:%.expr:string:background expression |
4 | #:META:X_RESOURCE:%.enable:boolean:some boolean |
4 | #:META:X_RESOURCE:%.border.:boolean:respect the terminal border |
5 | #:META:X_RESOURCE:%.extra.:value:extra config |
5 | |
|
|
6 | =head1 background - manage terminal background |
|
|
7 | |
|
|
8 | =head2 SYNOPSIS |
|
|
9 | |
|
|
10 | rxvt -background-expr 'background expression' |
|
|
11 | -background-border |
|
|
12 | |
|
|
13 | =head2 DESCRIPTION |
|
|
14 | |
|
|
15 | =head2 REFERENCE |
|
|
16 | |
|
|
17 | =cut |
6 | |
18 | |
7 | our $EXPR; |
19 | our $EXPR; |
8 | #$EXPR = 'move W * 0.1, -H * 0.1, resize W * 0.5, H * 0.5, repeat_none load "opensource.png"'; |
20 | #$EXPR = 'move W * 0.1, -H * 0.1, resize W * 0.5, H * 0.5, repeat_none load "opensource.png"'; |
9 | $EXPR = 'move -TX, -TY, load "argb.png"'; |
21 | $EXPR = 'move -TX, -TY, load "argb.png"'; |
10 | #$EXPR = ' |
22 | #$EXPR = ' |
… | |
… | |
15 | #$EXPR = 'solid "red"'; |
27 | #$EXPR = 'solid "red"'; |
16 | #$EXPR = 'blur root, 10, 10' |
28 | #$EXPR = 'blur root, 10, 10' |
17 | #$EXPR = 'blur move (root, -x, -y), 5, 5' |
29 | #$EXPR = 'blur move (root, -x, -y), 5, 5' |
18 | #resize load "/root/pix/das_fette_schwein.jpg", w, h |
30 | #resize load "/root/pix/das_fette_schwein.jpg", w, h |
19 | |
31 | |
20 | use Safe; |
|
|
21 | |
|
|
22 | our ($bgdsl_self, $old, $new); |
32 | our ($self, $old, $new); |
23 | our ($x, $y, $w, $h); |
33 | our ($x, $y, $w, $h); |
24 | |
34 | |
25 | # enforce at least this interval between updates |
35 | # enforce at least this interval between updates |
26 | our $MIN_INTERVAL = 1/100; |
36 | our $MIN_INTERVAL = 1/100; |
27 | |
37 | |
… | |
… | |
46 | =cut |
56 | =cut |
47 | |
57 | |
48 | sub load($) { |
58 | sub load($) { |
49 | my ($path) = @_; |
59 | my ($path) = @_; |
50 | |
60 | |
51 | $new->{load}{$path} = $old->{load}{$path} || $bgdsl_self->new_img_from_file ($path); |
61 | $new->{load}{$path} = $old->{load}{$path} || $self->new_img_from_file ($path); |
52 | } |
62 | } |
53 | |
63 | |
54 | =item root |
64 | =item root |
55 | |
65 | |
56 | Returns the root window pixmap, that is, hopefully, the background image |
66 | Returns the root window pixmap, that is, hopefully, the background image |
… | |
… | |
79 | =cut |
89 | =cut |
80 | |
90 | |
81 | sub solid($$;$) { |
91 | sub solid($$;$) { |
82 | my $colour = pop; |
92 | my $colour = pop; |
83 | |
93 | |
84 | my $img = $bgdsl_self->new_img (urxvt::PictStandardARGB32, $_[0] || 1, $_[1] || 1); |
94 | my $img = $self->new_img (urxvt::PictStandardARGB32, $_[0] || 1, $_[1] || 1); |
85 | $img->fill ($colour); |
95 | $img->fill ($colour); |
86 | $img |
96 | $img |
87 | } |
97 | } |
88 | |
98 | |
89 | =back |
99 | =back |
… | |
… | |
135 | sub TX() { $new->{position_sensitive} = 1; $x } |
145 | sub TX() { $new->{position_sensitive} = 1; $x } |
136 | sub TY() { $new->{position_sensitive} = 1; $y } |
146 | sub TY() { $new->{position_sensitive} = 1; $y } |
137 | sub TW() { $new->{size_sensitive} = 1; $w } |
147 | sub TW() { $new->{size_sensitive} = 1; $w } |
138 | sub TH() { $new->{size_sensitive} = 1; $h } |
148 | sub TH() { $new->{size_sensitive} = 1; $h } |
139 | |
149 | |
|
|
150 | =item now |
|
|
151 | |
|
|
152 | Returns the current time as (fractional) seconds since the epoch. |
|
|
153 | |
|
|
154 | Using this expression does I<not> make your expression sensitive to time, |
|
|
155 | but the next two functions do. |
|
|
156 | |
|
|
157 | =item again $seconds |
|
|
158 | |
|
|
159 | When this function is used the expression will be reevaluated again in |
|
|
160 | C<$seconds> seconds. |
|
|
161 | |
|
|
162 | Example: load some image and rotate it according to the time of day (as if it were |
|
|
163 | the hour pointer of a clock). update this image every minute. |
|
|
164 | |
|
|
165 | again 60; rotate TW, TH, 50, 50, (now % 86400) * -720 / 86400, scale load "myclock.png" |
|
|
166 | |
|
|
167 | =item counter $seconds |
|
|
168 | |
|
|
169 | Like C<again>, but also returns an increasing counter value, starting at |
|
|
170 | 0, which might be useful for some simple animation effects. |
|
|
171 | |
|
|
172 | =cut |
|
|
173 | |
140 | sub now() { urxvt::NOW } |
174 | sub now() { urxvt::NOW } |
141 | |
175 | |
142 | sub again($) { |
176 | sub again($) { |
143 | $new->{again} = $_[0]; |
177 | $new->{again} = $_[0]; |
144 | } |
178 | } |
145 | |
179 | |
146 | sub counter($) { |
180 | sub counter($) { |
147 | $new->{again} = $_[0]; |
181 | $new->{again} = $_[0]; |
148 | $bgdsl_self->{counter} + 0 |
182 | $self->{counter} + 0 |
149 | } |
183 | } |
150 | |
184 | |
151 | =back |
185 | =back |
152 | |
186 | |
153 | =head2 TILING MODES |
187 | =head2 TILING MODES |
… | |
… | |
277 | |
311 | |
278 | =cut |
312 | =cut |
279 | |
313 | |
280 | #TODO: maximise, maximise_fill? |
314 | #TODO: maximise, maximise_fill? |
281 | |
315 | |
282 | sub scale($$$) { |
316 | sub scale($;$;$) { |
283 | my $img = pop; |
317 | my $img = pop; |
284 | |
318 | |
285 | @_ == 2 ? $img->scale ($_[0] * $img->w * 0.01, $_[1] * $img->h * 0.01) |
319 | @_ == 2 ? $img->scale ($_[0] * $img->w * 0.01, $_[1] * $img->h * 0.01) |
286 | : @_ ? $img->scale ($_[0] * $img->w * 0.01, $_[0] * $img->h * 0.01) |
320 | : @_ ? $img->scale ($_[0] * $img->w * 0.01, $_[0] * $img->h * 0.01) |
287 | : $img->scale (TW, TH) |
321 | : $img->scale (TW, TH) |
… | |
… | |
358 | $self->recalculate; |
392 | $self->recalculate; |
359 | } |
393 | } |
360 | |
394 | |
361 | # evaluate the current bg expression |
395 | # evaluate the current bg expression |
362 | sub recalculate { |
396 | sub recalculate { |
363 | my ($self) = @_; |
397 | my ($arg_self) = @_; |
364 | |
398 | |
365 | # rate limit evaluation |
399 | # rate limit evaluation |
366 | |
400 | |
367 | if ($self->{next_refresh} > urxvt::NOW) { |
401 | if ($arg_self->{next_refresh} > urxvt::NOW) { |
368 | $self->{next_refresh_timer} = urxvt::timer->new->after ($self->{next_refresh} - urxvt::NOW)->cb (sub { |
402 | $arg_self->{next_refresh_timer} = urxvt::timer->new->after ($arg_self->{next_refresh} - urxvt::NOW)->cb (sub { |
369 | $self->recalculate; |
403 | $arg_self->recalculate; |
370 | }); |
404 | }); |
371 | return; |
405 | return; |
372 | } |
406 | } |
373 | |
407 | |
374 | $self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL; |
408 | $arg_self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL; |
375 | |
409 | |
376 | # set environment to evaluate user expression |
410 | # set environment to evaluate user expression |
377 | |
411 | |
378 | local $bgdsl_self = $self; |
412 | local $self = $arg_self; |
379 | |
413 | |
380 | local $old = $self->{state}; |
414 | local $old = $self->{state}; |
381 | local $new = my $state = $self->{state} = {}; |
415 | local $new = my $state = $self->{state} = {}; |
382 | |
416 | |
383 | my $border = 0; #d# |
|
|
384 | |
|
|
385 | ($x, $y, $w, $h) = |
417 | ($x, $y, $w, $h) = |
386 | $self->background_geometry ($border); |
418 | $self->background_geometry ($self->{border}); |
387 | |
419 | |
388 | # evaluate user expression |
420 | # evaluate user expression |
389 | |
421 | |
390 | my $img = eval { $self->{expr}->() }; |
422 | my $img = eval { $self->{expr}->() }; |
391 | warn $@ if $@;#d# |
423 | warn $@ if $@;#d# |
… | |
… | |
438 | # prepare and set background pixmap |
470 | # prepare and set background pixmap |
439 | |
471 | |
440 | $img = $img->sub_rect (0, 0, $w, $h) |
472 | $img = $img->sub_rect (0, 0, $w, $h) |
441 | if $img->w != $w || $img->h != $h; |
473 | if $img->w != $w || $img->h != $h; |
442 | |
474 | |
443 | $self->set_background ($img, $border); |
475 | $self->set_background ($img, $self->{border}); |
444 | $self->scr_recolour (0); |
476 | $self->scr_recolour (0); |
445 | $self->want_refresh; |
477 | $self->want_refresh; |
446 | } |
478 | } |
447 | |
479 | |
448 | sub on_start { |
480 | sub on_start { |
449 | my ($self) = @_; |
481 | my ($self) = @_; |
450 | |
482 | |
|
|
483 | my $expr = $self->x_resource ("background.expr") |
|
|
484 | or return; |
|
|
485 | |
451 | $self->set_expr (parse_expr $EXPR); |
486 | $self->set_expr (parse_expr $expr); |
|
|
487 | $self->{border} = $self->x_resource_boolean ("background.border"); |
452 | |
488 | |
453 | () |
489 | () |
454 | } |
490 | } |
455 | |
491 | |