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.54 by root, Thu Jun 14 16:22:20 2012 UTC vs.
Revision 1.61 by root, Fri Jun 15 19:50:56 2012 UTC

203=back 203=back
204 204
205=cut 205=cut
206 206
207our %_IMG_CACHE; 207our %_IMG_CACHE;
208our %_ONCE_CACHE;
209our $HOME; 208our $HOME;
210our ($self, $old, $new); 209our ($self, $old, $new);
211our ($x, $y, $w, $h); 210our ($x, $y, $w, $h);
212 211
213# enforce at least this interval between updates 212# enforce at least this interval between updates
267reevaluated when the bg image changes. 266reevaluated when the bg image changes.
268 267
269=cut 268=cut
270 269
271 sub root() { 270 sub root() {
272 $new->{rootpmap_sensitive} = 1; 271 $new->{again}{rootpmap} = 1;
273 $self->new_img_from_root 272 $self->new_img_from_root
274 } 273 }
275 274
276=item solid $colour 275=item solid $colour
277 276
286=cut 285=cut
287 286
288 sub solid($;$$) { 287 sub solid($;$$) {
289 my $colour = pop; 288 my $colour = pop;
290 289
291 my $img = $self->new_img (urxvt::PictStandardARGB32, $_[0] || 1, $_[1] || 1); 290 my $img = $self->new_img (urxvt::PictStandardARGB32, 0, 0, $_[0] || 1, $_[1] || 1);
292 $img->fill ($colour); 291 $img->fill ($colour);
293 $img 292 $img
294 } 293 }
295 294
296=item clone $img 295=item clone $img
300 299
301=cut 300=cut
302 301
303 sub clone($) { 302 sub clone($) {
304 $_[0]->clone 303 $_[0]->clone
304 }
305
306=item merge $img ...
307
308Takes any number of images and merges them together, creating a single
309image containing them all.
310
311This function is called automatically when an expression returns multiple
312images.
313
314=cut
315
316 sub merge(@) {
317 return $_[0] unless $#_;
318
319 # rather annoyingly clumsy, but optimisation is for another time
320
321 my $x0 = +1e9;
322 my $y0 = +1e9;
323 my $x1 = -1e9;
324 my $y1 = -1e9;
325
326 for (@_) {
327 my ($x, $y, $w, $h) = $_->geometry;
328
329 $x0 = $x if $x0 > $x;
330 $y0 = $y if $y0 > $y;
331
332 $x += $w;
333 $y += $h;
334
335 $x1 = $x if $x1 < $x;
336 $y1 = $y if $y1 < $y;
337 }
338
339 my $base = $self->new_img (urxvt::PictStandardARGB32, $x0, $y0, $x1 - $x0, $y1 - $y0);
340 $base->fill ([0, 0, 0, 0]);
341
342 $base->draw ($_)
343 for @_;
344
345 $base
305 } 346 }
306 347
307=head2 TILING MODES 348=head2 TILING MODES
308 349
309The following operators modify the tiling mode of an image, that is, the 350The following operators modify the tiling mode of an image, that is, the
425the window size to conserve memory. 466the window size to conserve memory.
426 467
427Example: take the screen background, clip it to the window size, blur it a 468Example: take the screen background, clip it to the window size, blur it a
428bit, align it to the window position and use it as background. 469bit, align it to the window position and use it as background.
429 470
430 clip move -TX, -TY, blur 5, root 471 clip move -TX, -TY, once { blur 5, root }
431 472
432=cut 473=cut
433 474
434 sub TX() { $new->{position_sensitive} = 1; $x } 475 sub TX() { $new->{again}{position} = 1; $x }
435 sub TY() { $new->{position_sensitive} = 1; $y } 476 sub TY() { $new->{again}{position} = 1; $y }
436 sub TW() { $new->{size_sensitive} = 1; $w } 477 sub TW() { $new->{again}{size} = 1; $w }
437 sub TH() { $new->{size_sensitive} = 1; $h } 478 sub TH() { $new->{again}{size} = 1; $h }
438 479
439=item now 480=item now
440 481
441Returns the current time as (fractional) seconds since the epoch. 482Returns the current time as (fractional) seconds since the epoch.
442 483
461=cut 502=cut
462 503
463 sub now() { urxvt::NOW } 504 sub now() { urxvt::NOW }
464 505
465 sub again($) { 506 sub again($) {
466 $new->{again} = $_[0]; 507 $new->{again}{time} = $_[0];
467 } 508 }
468 509
469 sub counter($) { 510 sub counter($) {
470 $new->{again} = $_[0]; 511 $new->{again}{time} = $_[0];
471 $self->{counter} + 0 512 $self->{counter} + 0
472 } 513 }
473 514
474=back 515=back
475 516
661=cut 702=cut
662 703
663 sub rotate($$$$) { 704 sub rotate($$$$) {
664 my $img = pop; 705 my $img = pop;
665 $img->rotate ( 706 $img->rotate (
666 $_[0] * $img->w, 707 $_[0] * ($img->w + $img->x),
667 $_[1] * $img->h, 708 $_[1] * ($img->h + $img->y),
668 $_[2] * (3.14159265 / 180), 709 $_[2] * (3.14159265 / 180),
669 ) 710 )
670 } 711 }
671 712
672=back 713=back
762 803
763=back 804=back
764 805
765=head2 OTHER STUFF 806=head2 OTHER STUFF
766 807
767Anything that didn't fit any of the other categories, even after appliyng 808Anything that didn't fit any of the other categories, even after applying
768force and closing our eyes. 809force and closing our eyes.
769 810
770=over 4 811=over 4
771 812
772=item once { ... } 813=item once { ... }
799next call they will be reevaluated again. 840next call they will be reevaluated again.
800 841
801=cut 842=cut
802 843
803 sub once(&) { 844 sub once(&) {
804 $_ONCE_CACHE{$_[0]+0} ||= $_[0]() 845 my $once = $self->{once_cache}{$_[0]+0} ||= do {
846 local $new->{again};
847 my @res = $_[0]();
848 [$new->{again}, \@res]
849 };
850
851 $new->{again} = {
852 %{ $new->{again} },
853 %{ $once->[0] }
854 };
855
856 # in scalar context we always return the first original result, which
857 # is not quite how perl works.
858 wantarray
859 ? @{ $once->[1] }
860 : $once->[1][0]
805 } 861 }
806 862
807 sub once_again() { 863 sub once_again() {
808 %_ONCE_CACHE = (); 864 delete $self->{once_cache};
809 } 865 }
810 866
811=back 867=back
812 868
813=cut 869=cut
854 ($x, $y, $w, $h) = 910 ($x, $y, $w, $h) =
855 $self->background_geometry ($self->{border}); 911 $self->background_geometry ($self->{border});
856 912
857 # evaluate user expression 913 # evaluate user expression
858 914
859 my $img = eval { $self->{expr}->() }; 915 my $img = eval { urxvt::bgdsl::merge $self->{expr}->() };
860 warn $@ if $@;#d# 916 die $@ if $@;
861 die "background-expr did not return an image.\n" if !UNIVERSAL::isa $img, "urxvt::img"; 917 die "background-expr did not return an image.\n" if !UNIVERSAL::isa $img, "urxvt::img";
862 918
863 $state->{size_sensitive} = 1 919 # if the expression is sensitive to external events, prepare reevaluation then
920
921 my $again = delete $state->{again};
922
923 $again->{size} = 1
864 if $img->repeat_mode != urxvt::RepeatNormal; 924 if $img->repeat_mode != urxvt::RepeatNormal;
865 925
866 # if the expression is sensitive to external events, prepare reevaluation then
867
868 my $repeat;
869
870 if (my $again = $state->{again}) { 926 if (my $again = $again->{time}) {
871 $repeat = 1;
872 my $self = $self; 927 my $self = $self;
873 $state->{timer} = $again == $old->{again} 928 $state->{timer} = $again == $old->{again}
874 ? $old->{timer} 929 ? $old->{timer}
875 : urxvt::timer->new->after ($again)->interval ($again)->cb (sub { 930 : urxvt::timer->new->after ($again)->interval ($again)->cb (sub {
876 ++$self->{counter}; 931 ++$self->{counter};
877 $self->recalculate 932 $self->recalculate
878 }); 933 });
879 } 934 }
880 935
881 if (delete $state->{position_sensitive}) { 936 if ($again->{position}) {
882 $repeat = 1;
883 $self->enable (position_change => sub { $_[0]->recalculate }); 937 $self->enable (position_change => sub { $_[0]->recalculate });
884 } else { 938 } else {
885 $self->disable ("position_change"); 939 $self->disable ("position_change");
886 } 940 }
887 941
888 if (delete $state->{size_sensitive}) { 942 if ($again->{size}) {
889 $repeat = 1;
890 $self->enable (size_change => sub { $_[0]->recalculate }); 943 $self->enable (size_change => sub { $_[0]->recalculate });
891 } else { 944 } else {
892 $self->disable ("size_change"); 945 $self->disable ("size_change");
893 } 946 }
894 947
895 if (delete $state->{rootpmap_sensitive}) { 948 if ($again->{rootpmap}) {
896 $repeat = 1;
897 $self->enable (rootpmap_change => sub { $_[0]->recalculate }); 949 $self->enable (rootpmap_change => sub {
950 delete $_[0]{once_cache}; # this will override once-block values from
951 $_[0]->recalculate;
952 });
898 } else { 953 } else {
899 $self->disable ("rootpmap_change"); 954 $self->disable ("rootpmap_change");
900 } 955 }
901 956
902 # clear stuff we no longer need 957 # clear stuff we no longer need
903 958
904 %$old = (); 959 %$old = ();
905 960
906 unless ($repeat) { 961 unless (%$again) {
907 delete $self->{state}; 962 delete $self->{state};
908 delete $self->{expr}; 963 delete $self->{expr};
909 } 964 }
910 965
911 # set background pixmap 966 # set background pixmap

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines