ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/perl/background
(Generate patch)

Comparing rxvt-unicode/src/perl/background (file contents):
Revision 1.3 by root, Tue Jun 5 12:08:23 2012 UTC vs.
Revision 1.33 by root, Thu Jun 7 16:30:58 2012 UTC

1#! perl 1#! perl
2 2
3our $EXPR = 'move load "/root/pix/das_fette_schwein.jpg", left, top'; 3#:META:X_RESOURCE:%.expr:string:background expression
4#:META:X_RESOURCE:%.border.:boolean:respect the terminal border
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
18
19our $EXPR;
20#$EXPR = 'move W * 0.1, -H * 0.1, resize W * 0.5, H * 0.5, repeat_none load "opensource.png"';
21$EXPR = 'move -TX, -TY, load "argb.png"';
22#$EXPR = '
23# rotate W, H, 50, 50, counter 1/59.95, repeat_mirror,
24# clip X, Y, W, H, repeat_mirror,
25# load "/root/pix/das_fette_schwein.jpg"
26#';
27#$EXPR = 'solid "red"';
4#$EXPR = 'blur root, 10, 10' 28#$EXPR = 'blur root, 10, 10'
5#$EXPR = 'blur move (root, -x, -y), 5, 5' 29#$EXPR = 'blur move (root, -x, -y), 5, 5'
6#resize load "/root/pix/das_fette_schwein.jpg", w, h 30#resize load "/root/pix/das_fette_schwein.jpg", w, h
7 31
8use Safe;
9
10our ($bgdsl_self, $old, $new); 32our ($self, $old, $new);
11our ($l, $t, $w, $h); 33our ($x, $y, $w, $h);
34
35# enforce at least this interval between updates
36our $MIN_INTERVAL = 1/100;
12 37
13{ 38{
14 package urxvt::bgdsl; # background language 39 package urxvt::bgdsl; # background language
15 40
16 *repeat_black = \&urxvt::RepeatNone; #TODO wtf 41=head2 PROVIDERS/GENERATORS
17 *repeat_wrap = \&urxvt::RepeatNormal; 42
18 *repeat_pad = \&urxvt::RepeatPad; 43These functions provide an image, by loading it from disk, grabbing it
19 *repeat_mirror = \&urxvt::RepeatReflect; 44from the root screen or by simply generating it. They are used as starting
45points to get an image you can play with.
46
47=over 4
48
49=item load $path
50
51Loads the image at the given C<$path>. The image is set to plane tiling
52mode.
53
54Loaded images will be cached for one cycle.
55
56=cut
20 57
21 sub load($) { 58 sub load($) {
22 my ($path) = @_; 59 my ($path) = @_;
23 60
24 $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);
25 } 62 }
63
64=item root
65
66Returns the root window pixmap, that is, hopefully, the background image
67of your screen. The image is set to extend mode.
68
69This function makes your expression root sensitive, that means it will be
70reevaluated when the bg image changes.
71
72=cut
26 73
27 sub root() { 74 sub root() {
75 $new->{rootpmap_sensitive} = 1;
28 die "root op not supported, exg, we need you"; 76 die "root op not supported, exg, we need you";
29 } 77 }
30 78
79=item solid $colour
80
81=item solid $width, $height, $colour
82
83Creates a new image and completely fills it with the given colour. The
84image is set to tiling mode.
85
86If <$width> and C<$height> are omitted, it creates a 1x1 image, which is
87useful for solid backgrounds or for use in filtering effects.
88
89=cut
90
91 sub solid($$;$) {
92 my $colour = pop;
93
94 my $img = $self->new_img (urxvt::PictStandardARGB32, $_[0] || 1, $_[1] || 1);
95 $img->fill ($colour);
96 $img
97 }
98
99=back
100
101=head2 VARIABLES
102
103The following functions provide variable data such as the terminal
104window dimensions. Most of them make your expression sensitive to some
105events, for example using C<TW> (terminal width) means your expression is
106evaluated again when the terminal is resized.
107
108=over 4
109
110=item TX
111
112=item TY
113
114Return the X and Y coordinates of the terminal window (the terminal
115window is the full window by default, and the character area only when in
116border-respect mode).
117
118Using these functions make your expression sensitive to window moves.
119
120These functions are mainly useful to align images to the root window.
121
122Example: load an image and align it so it looks as if anchored to the
123background.
124
125 move -TX, -TY, load "mybg.png"
126
127=item TW
128
129Return the width (C<TW>) and height (C<TH>) of the terminal window (the
130terminal window is the full window by default, and the character area only
131when in border-respect mode).
132
133Using these functions make your expression sensitive to window resizes.
134
135These functions are mainly useful to scale images, or to clip images to
136the window size to conserve memory.
137
138Example: take the screen background, clip it to the window size, blur it a
139bit, align it to the window position and use it as background.
140
141 clip move -TX, -TY, blur 5, root
142
143=cut
144
145 sub TX() { $new->{position_sensitive} = 1; $x }
146 sub TY() { $new->{position_sensitive} = 1; $y }
147 sub TW() { $new->{size_sensitive} = 1; $w }
148 sub TH() { $new->{size_sensitive} = 1; $h }
149
150=item now
151
152Returns the current time as (fractional) seconds since the epoch.
153
154Using this expression does I<not> make your expression sensitive to time,
155but the next two functions do.
156
157=item again $seconds
158
159When this function is used the expression will be reevaluated again in
160C<$seconds> seconds.
161
162Example: load some image and rotate it according to the time of day (as if it were
163the 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
169Like C<again>, but also returns an increasing counter value, starting at
1700, which might be useful for some simple animation effects.
171
172=cut
173
174 sub now() { urxvt::NOW }
175
176 sub again($) {
177 $new->{again} = $_[0];
178 }
179
180 sub counter($) {
181 $new->{again} = $_[0];
182 $self->{counter} + 0
183 }
184
185=back
186
187=head2 TILING MODES
188
189The following operators modify the tiling mode of an image, that is, the
190way that pixels outside the image area are painted when the image is used.
191
192=over 4
193
194=item tile $img
195
196Tiles the whole plane with the image and returns this new image - or in
197other words, it returns a copy of the image in plane tiling mode.
198
199=item mirror $img
200
201Similar to tile, but reflects the image each time it uses a new copy, so
202that top edges always touch top edges, right edges always touch right
203edges and so on (with normal tiling, left edges always touch right edges
204and top always touch bottom edges).
205
206=item pad $img
207
208Takes an image and modifies it so that all pixels outside the image area
209become transparent. This mode is most useful when you want to place an
210image over another image or the background colour while leaving all
211background pixels outside the image unchanged.
212
213=item extend $img
214
215Extends the image over the whole plane, using the closest pixel in the
216area outside the image. This mode is mostly useful when you more complex
217filtering operations and want the pixels outside the image to have the
218same values as the pixels near the edge.
219
220=cut
221
222 sub pad($) {
223 my $img = $_[0]->clone;
224 $img->repeat_mode (urxvt::RepeatNone);
225 $img
226 }
227
228 sub tile($) {
229 my $img = $_[0]->clone;
230 $img->repeat_mode (urxvt::RepeatNormal);
231 $img
232 }
233
234 sub mirror($) {
235 my $img = $_[0]->clone;
236 $img->repeat_mode (urxvt::RepeatReflect);
237 $img
238 }
239
240 sub extend($) {
241 my $img = $_[0]->clone;
242 $img->repeat_mode (urxvt::RepeatPad);
243 $img
244 }
245
246=back
247
248=head2 PIXEL OPERATORS
249
250The following operators modify the image pixels in various ways.
251
252=over 4
253
254=item clone $img
255
256Returns an exact copy of the image.
257
258=cut
259
260 sub clone($) {
261 $_[0]->clone
262 }
263
264=item clip $img
265
266=item clip $width, $height, $img
267
268=item clip $x, $y, $width, $height, $img
269
270Clips an image to the given rectangle. If the rectangle is outside the
271image area (e.g. when C<$x> or C<$y> are negative) or the rectangle is
272larger than the image, then the tiling mode defines how the extra pixels
273will be filled.
274
275If C<$x> an C<$y> are missing, then C<0> is assumed for both.
276
277If C<$width> and C<$height> are missing, then the window size will be
278assumed.
279
280Example: load an image, blur it, and clip it to the window size to save
281memory.
282
283 clip blur 10, load "mybg.png"
284
285=cut
286
287 sub clip($;$$;$$) {
288 my $img = pop;
289 my $h = pop || TH;
290 my $w = pop || TW;
291 $img->sub_rect ($_[0], $_[1], $w, $h)
292 }
293
294=item scale $img
295
296=item scale $size_percent, $img
297
298=item scale $width_percent, $height_percent, $img
299
300Scales the image by the given percentages in horizontal
301(C<$width_percent>) and vertical (C<$height_percent>) direction.
302
303If only one percentage is give, it is used for both directions.
304
305If no percentages are given, scales the image to the window size without
306keeping aspect.
307
308=item resize $width, $height, $img
309
310Resizes the image to exactly C<$width> times C<$height> pixels.
311
312=cut
313
314#TODO: maximise, maximise_fill?
315
316 sub scale($;$;$) {
317 my $img = pop;
318
319 @_ == 2 ? $img->scale ($_[0] * $img->w * 0.01, $_[1] * $img->h * 0.01)
320 : @_ ? $img->scale ($_[0] * $img->w * 0.01, $_[0] * $img->h * 0.01)
321 : $img->scale (TW, TH)
322 }
323
31 sub resize($$$) { 324 sub resize($$$) {
32 $_[0]->scale ($_[1], $_[2]) 325 my $img = pop;
326 $img->scale ($_[0], $_[1])
33 } 327 }
34 328
35 sub move($$$) { 329 sub move($$;$) {
36 # TODO: must be simpler 330 my $img = pop->clone;
37 $_[0]->transform ($_[0]->w, $_[0]->h, $_[1], 331 $img->move ($_[0], $_[1]);
332 $img
333 }
334
335 sub rotate($$$$$$) {
336 my $img = pop;
337 $img->rotate (
38 1, 0, -$_[2], 338 $_[0],
39 0, 1, -$_[3], 339 $_[1],
40 0, 0, 1, 340 $_[2] * $img->w * .01,
341 $_[3] * $img->h * .01,
342 $_[4] * (3.14159265 / 180),
41 ) 343 )
42 } 344 }
43 345
44 sub rotate($$$$) {
45 $_[0]->rotate ($_[0], $_[1], $_[2], $_[3] * (3.14159265 / 180))
46 }
47
48 sub blur($$$) { 346 sub blur($$;$) {
49 my ($img, $rh, $rv) = @_; 347 my $img = pop;
50 348 $img->blur ($_[0], @_ >= 2 ? $_[1] : $_[0])
51 $img = $img->clone;
52 $img->clone->blur ($rh, $rv);
53 $img
54 } 349 }
55 350
56 sub contrast($$;$$;$) { 351 sub contrast($$;$$;$) {
352 my $img = pop;
57 my ($img, $r, $g, $b, $a) = @_; 353 my ($r, $g, $b, $a) = @_;
354
58 ($g, $b) = ($r, $r) if @_ < 4; 355 ($g, $b) = ($r, $r) if @_ < 4;
59 $a = 1 if @_ < 5; 356 $a = 1 if @_ < 5;
357
60 $img = $img->clone; 358 $img = $img->clone;
61 $img->contrast ($r, $g, $b, $a); 359 $img->contrast ($r, $g, $b, $a);
62 $img 360 $img
63 } 361 }
64 362
65 sub brightness($$;$$;$) { 363 sub brightness($$;$$;$) {
364 my $img = pop;
66 my ($img, $r, $g, $b, $a) = @_; 365 my ($r, $g, $b, $a) = @_;
366
67 ($g, $b) = ($r, $r) if @_ < 4; 367 ($g, $b) = ($r, $r) if @_ < 4;
68 $a = 1 if @_ < 5; 368 $a = 1 if @_ < 5;
369
69 $img = $img->clone; 370 $img = $img->clone;
70 $img->brightness ($r, $g, $b, $a); 371 $img->brightness ($r, $g, $b, $a);
71 $img 372 $img
72 } 373 }
73 374
74 sub left () { $new->{position_sensitive} = 1; $l } 375=back
75 sub top () { $new->{position_sensitive} = 1; $t }
76 sub width () { $new->{size_sensitive} = 1; $w }
77 sub height() { $new->{size_sensitive} = 1; $h }
78 376
79 sub now() { urxvt::NOW } 377=cut
80 378
81 sub again($) {
82 $new->{again} = $_[0];
83 }
84
85 sub counter($) {
86 $new->{again} = $_[0];
87 $bgdsl_self->{counter}++ + 0
88 }
89} 379}
90 380
91sub parse_expr { 381sub parse_expr {
92 my $expr = eval "sub {\npackage urxvt::bgdsl;\n#line 0 'background expression'\n$_[0]\n}"; 382 my $expr = eval "sub {\npackage urxvt::bgdsl;\n#line 0 'background expression'\n$_[0]\n}";
93 die if $@; 383 die if $@;
… …
96 386
97# compiles a parsed expression 387# compiles a parsed expression
98sub set_expr { 388sub set_expr {
99 my ($self, $expr) = @_; 389 my ($self, $expr) = @_;
100 390
101 local $Data::Dumper::Deparse=1; use Data::Dumper; warn Dumper $expr;#d#
102 $self->{expr} = $expr; 391 $self->{expr} = $expr;
103 $self->recalculate; 392 $self->recalculate;
104} 393}
105 394
106# evaluate the current bg expression 395# evaluate the current bg expression
107sub recalculate { 396sub recalculate {
108 my ($self) = @_; 397 my ($arg_self) = @_;
109 398
110 local $bgdsl_self = $self; 399 # rate limit evaluation
400
401 if ($arg_self->{next_refresh} > urxvt::NOW) {
402 $arg_self->{next_refresh_timer} = urxvt::timer->new->after ($arg_self->{next_refresh} - urxvt::NOW)->cb (sub {
403 $arg_self->recalculate;
404 });
405 return;
406 }
407
408 $arg_self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL;
409
410 # set environment to evaluate user expression
411
412 local $self = $arg_self;
111 413
112 local $old = $self->{state}; 414 local $old = $self->{state};
113 local $new = my $state = $self->{state} = {}; 415 local $new = my $state = $self->{state} = {};
114 416
115 ($l, $t, $w, $h) = 417 ($x, $y, $w, $h) =
116 $self->get_geometry; 418 $self->background_geometry ($self->{border});
117 419
118 warn "$l, $t";#d# 420 # evaluate user expression
119 421
120 my $img = eval { $self->{expr}->() }; 422 my $img = eval { $self->{expr}->() };
121 warn $@ if $@;#d# 423 warn $@ if $@;#d#
424 die if !UNIVERSAL::isa $img, "urxvt::img";
425
426 # if the expression is sensitive to external events, prepare reevaluation then
122 427
123 my $repeat; 428 my $repeat;
124 429
125 if (my $again = $state->{again}) { 430 if (my $again = $state->{again}) {
126 $repeat = 1; 431 $repeat = 1;
127 $state->{again} = urxvt::timer->new->after ($again)->cb (sub { $self->recalculate }); 432 $state->{timer} = $again == $old->{again}
433 ? $old->{timer}
434 : urxvt::timer->new->after ($again)->interval ($again)->cb (sub {
435 ++$self->{counter};
436 $self->recalculate
437 });
128 } 438 }
129 439
130 if (delete $state->{position_sensitive}) { 440 if (delete $state->{position_sensitive}) {
131 $repeat = 1; 441 $repeat = 1;
132 $self->enable (position_change => sub { $_[0]->recalculate }); 442 $self->enable (position_change => sub { $_[0]->recalculate });
… …
139 $self->enable (size_change => sub { $_[0]->recalculate }); 449 $self->enable (size_change => sub { $_[0]->recalculate });
140 } else { 450 } else {
141 $self->disable ("size_change"); 451 $self->disable ("size_change");
142 } 452 }
143 453
144 # TODO: install handlers for geometry changes &c 454 if (delete $state->{rootpmap_sensitive}) {
455 $repeat = 1;
456 $self->enable (rootpmap_change => sub { $_[0]->recalculate });
457 } else {
458 $self->disable ("rootpmap_change");
459 }
145 460
146 warn $img; 461 # clear stuff we no longer need
462
463 %$old = ();
464
465 unless ($repeat) {
466 delete $self->{state};
467 delete $self->{expr};
468 }
469
470 # prepare and set background pixmap
471
472 $img = $img->sub_rect (0, 0, $w, $h)
473 if $img->w != $w || $img->h != $h;
474
147 $self->set_background ($img); 475 $self->set_background ($img, $self->{border});
148 $self->scr_recolour (0); 476 $self->scr_recolour (0);
149 $self->want_refresh; 477 $self->want_refresh;
150} 478}
151 479
152sub on_start { 480sub on_start {
153 my ($self) = @_; 481 my ($self) = @_;
154 482
483 my $expr = $self->x_resource ("background.expr")
484 or return;
485
155 $self->set_expr (parse_expr $EXPR); 486 $self->set_expr (parse_expr $expr);
487 $self->{border} = $self->x_resource_boolean ("background.border");
156 488
157 () 489 ()
158} 490}
159 491

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines