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.53 by root, Tue Jun 12 18:25:57 2012 UTC vs.
Revision 1.59 by root, Thu Jun 14 19:31:17 2012 UTC

… …
71 return scale load "$HOME/weekday.png"; 71 return scale load "$HOME/weekday.png";
72 } else { 72 } else {
73 return scale load "$HOME/sunday.png"; 73 return scale load "$HOME/sunday.png";
74 } 74 }
75 75
76This expression gets evaluated once per hour. It will set F<sunday.png> as 76This expression is evaluated once per hour. It will set F<sunday.png> as
77background on Sundays, and F<weekday.png> on all other days. 77background on Sundays, and F<weekday.png> on all other days.
78 78
79Fortunately, we expect that most expressions will be much simpler, with 79Fortunately, we expect that most expressions will be much simpler, with
80little Perl knowledge needed. 80little Perl knowledge needed.
81 81
… …
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
… …
229=item load $path 228=item load $path
230 229
231Loads the image at the given C<$path>. The image is set to plane tiling 230Loads the image at the given C<$path>. The image is set to plane tiling
232mode. 231mode.
233 232
234Loaded images will be cached for one cycle. 233Loaded images will be cached for one cycle, and shared between temrinals
234running in the same process (e.g. in C<urxvtd>).
235 235
236=item load_uc $path
237
238Load uncached - same as load, but does not cache the image. This function
239is most useufl if you want to optimise a background expression in some
240way.
241
236=cut 242=cut
243
244 sub load_uc($) {
245 my ($path) = @_;
246
247 $_IMG_CACHE{$path} || do {
248 my $img = $self->new_img_from_file ($path);
249 Scalar::Util::weaken ($_IMG_CACHE{$path} = $img);
250 $img
251 }
252 }
237 253
238 sub load($) { 254 sub load($) {
239 my ($path) = @_; 255 my ($path) = @_;
240 256
241 $new->{load}{$path} = $old->{load}{$path} || $self->new_img_from_file ($path); 257 $new->{load}{$path} = $old->{load}{$path} || load_uc $path;
242 } 258 }
243 259
244=item root 260=item root
245 261
246Returns the root window pixmap, that is, hopefully, the background image 262Returns the root window pixmap, that is, hopefully, the background image
… …
250reevaluated when the bg image changes. 266reevaluated when the bg image changes.
251 267
252=cut 268=cut
253 269
254 sub root() { 270 sub root() {
255 $new->{rootpmap_sensitive} = 1; 271 $new->{again}{rootpmap} = 1;
256 $self->new_img_from_root 272 $self->new_img_from_root
257 } 273 }
258 274
259=item solid $colour 275=item solid $colour
260 276
… …
269=cut 285=cut
270 286
271 sub solid($;$$) { 287 sub solid($;$$) {
272 my $colour = pop; 288 my $colour = pop;
273 289
274 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);
275 $img->fill ($colour); 291 $img->fill ($colour);
276 $img 292 $img
277 } 293 }
278 294
279=item clone $img 295=item clone $img
… …
283 299
284=cut 300=cut
285 301
286 sub clone($) { 302 sub clone($) {
287 $_[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
311=cut
312
313 sub merge(@) {
314 # rather annoyingly clumsy, but optimisation is for another time
315
316 my $x0 = +1e9;
317 my $y0 = +1e9;
318 my $x1 = -1e9;
319 my $y1 = -1e9;
320
321 for (@_) {
322 my ($x, $y, $w, $h) = $_->geometry;
323
324 $x0 = $x if $x0 > $x;
325 $y0 = $y if $y0 > $y;
326
327 $x += $w;
328 $y += $h;
329
330 $x1 = $x if $x1 < $x;
331 $y1 = $y if $y1 < $y;
332 }
333
334 my $base = $self->new_img (urxvt::PictStandardARGB32, $x0, $y0, $x1 - $x0, $y1 - $y0);
335 $base->fill ([0, 0, 0, 0]);
336
337 $base->draw ($_)
338 for @_;
339
340 $base
288 } 341 }
289 342
290=head2 TILING MODES 343=head2 TILING MODES
291 344
292The following operators modify the tiling mode of an image, that is, the 345The following operators modify the tiling mode of an image, that is, the
… …
408the window size to conserve memory. 461the window size to conserve memory.
409 462
410Example: take the screen background, clip it to the window size, blur it a 463Example: take the screen background, clip it to the window size, blur it a
411bit, align it to the window position and use it as background. 464bit, align it to the window position and use it as background.
412 465
413 clip move -TX, -TY, blur 5, root 466 clip move -TX, -TY, once { blur 5, root }
414 467
415=cut 468=cut
416 469
417 sub TX() { $new->{position_sensitive} = 1; $x } 470 sub TX() { $new->{again}{position} = 1; $x }
418 sub TY() { $new->{position_sensitive} = 1; $y } 471 sub TY() { $new->{again}{position} = 1; $y }
419 sub TW() { $new->{size_sensitive} = 1; $w } 472 sub TW() { $new->{again}{size} = 1; $w }
420 sub TH() { $new->{size_sensitive} = 1; $h } 473 sub TH() { $new->{again}{size} = 1; $h }
421 474
422=item now 475=item now
423 476
424Returns the current time as (fractional) seconds since the epoch. 477Returns the current time as (fractional) seconds since the epoch.
425 478
… …
444=cut 497=cut
445 498
446 sub now() { urxvt::NOW } 499 sub now() { urxvt::NOW }
447 500
448 sub again($) { 501 sub again($) {
449 $new->{again} = $_[0]; 502 $new->{again}{time} = $_[0];
450 } 503 }
451 504
452 sub counter($) { 505 sub counter($) {
453 $new->{again} = $_[0]; 506 $new->{again}{time} = $_[0];
454 $self->{counter} + 0 507 $self->{counter} + 0
455 } 508 }
456 509
457=back 510=back
458 511
… …
745 798
746=back 799=back
747 800
748=head2 OTHER STUFF 801=head2 OTHER STUFF
749 802
750Anything that didn't fit any of the other categories, even after appliyng 803Anything that didn't fit any of the other categories, even after applying
751force and closing our eyes. 804force and closing our eyes.
752 805
753=over 4 806=over 4
754 807
755=item once { ... } 808=item once { ... }
… …
782next call they will be reevaluated again. 835next call they will be reevaluated again.
783 836
784=cut 837=cut
785 838
786 sub once(&) { 839 sub once(&) {
787 $_ONCE_CACHE{$_[0]+0} ||= $_[0]() 840 my $once = $self->{once_cache}{$_[0]+0} ||= do {
841 local $new->{again};
842 my @res = $_[0]();
843 [$new->{again}, \@res]
844 };
845
846 $new->{again} = {
847 %{ $new->{again} },
848 %{ $once->[0] }
849 };
850
851 # in scalar context we always return the first original result, which
852 # is not quite how perl works.
853 wantarray
854 ? @{ $once->[1] }
855 : $once->[1][0]
788 } 856 }
789 857
790 sub once_again() { 858 sub once_again() {
791 %_ONCE_CACHE = (); 859 delete $self->{once_cache};
792 } 860 }
793 861
794=back 862=back
795 863
796=cut 864=cut
… …
841 909
842 my $img = eval { $self->{expr}->() }; 910 my $img = eval { $self->{expr}->() };
843 warn $@ if $@;#d# 911 warn $@ if $@;#d#
844 die "background-expr did not return an image.\n" if !UNIVERSAL::isa $img, "urxvt::img"; 912 die "background-expr did not return an image.\n" if !UNIVERSAL::isa $img, "urxvt::img";
845 913
846 $state->{size_sensitive} = 1 914 # if the expression is sensitive to external events, prepare reevaluation then
915
916 my $again = delete $state->{again};
917
918 $again->{size} = 1
847 if $img->repeat_mode != urxvt::RepeatNormal; 919 if $img->repeat_mode != urxvt::RepeatNormal;
848 920
849 # if the expression is sensitive to external events, prepare reevaluation then
850
851 my $repeat;
852
853 if (my $again = $state->{again}) { 921 if (my $again = $again->{time}) {
854 $repeat = 1;
855 my $self = $self; 922 my $self = $self;
856 $state->{timer} = $again == $old->{again} 923 $state->{timer} = $again == $old->{again}
857 ? $old->{timer} 924 ? $old->{timer}
858 : urxvt::timer->new->after ($again)->interval ($again)->cb (sub { 925 : urxvt::timer->new->after ($again)->interval ($again)->cb (sub {
859 ++$self->{counter}; 926 ++$self->{counter};
860 $self->recalculate 927 $self->recalculate
861 }); 928 });
862 } 929 }
863 930
864 if (delete $state->{position_sensitive}) { 931 if ($again->{position}) {
865 $repeat = 1;
866 $self->enable (position_change => sub { $_[0]->recalculate }); 932 $self->enable (position_change => sub { $_[0]->recalculate });
867 } else { 933 } else {
868 $self->disable ("position_change"); 934 $self->disable ("position_change");
869 } 935 }
870 936
871 if (delete $state->{size_sensitive}) { 937 if ($again->{size}) {
872 $repeat = 1;
873 $self->enable (size_change => sub { $_[0]->recalculate }); 938 $self->enable (size_change => sub { $_[0]->recalculate });
874 } else { 939 } else {
875 $self->disable ("size_change"); 940 $self->disable ("size_change");
876 } 941 }
877 942
878 if (delete $state->{rootpmap_sensitive}) { 943 if ($again->{rootpmap}) {
879 $repeat = 1;
880 $self->enable (rootpmap_change => sub { $_[0]->recalculate }); 944 $self->enable (rootpmap_change => sub {
945 delete $_[0]{once_cache}; # this will override once-block values from
946 $_[0]->recalculate;
947 });
881 } else { 948 } else {
882 $self->disable ("rootpmap_change"); 949 $self->disable ("rootpmap_change");
883 } 950 }
884 951
885 # clear stuff we no longer need 952 # clear stuff we no longer need
886 953
887 %$old = (); 954 %$old = ();
888 955
889 unless ($repeat) { 956 unless (%$again) {
890 delete $self->{state}; 957 delete $self->{state};
891 delete $self->{expr}; 958 delete $self->{expr};
892 } 959 }
893 960
894 # set background pixmap 961 # set background pixmap

Diff Legend

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