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.56 by root, Thu Jun 14 17:06:57 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
… …
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 image containing them all.
309
310=cut
311
312 sub merge(@) {
313 #TODO
288 } 314 }
289 315
290=head2 TILING MODES 316=head2 TILING MODES
291 317
292The following operators modify the tiling mode of an image, that is, the 318The following operators modify the tiling mode of an image, that is, the
… …
408the window size to conserve memory. 434the window size to conserve memory.
409 435
410Example: take the screen background, clip it to the window size, blur it a 436Example: 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. 437bit, align it to the window position and use it as background.
412 438
413 clip move -TX, -TY, blur 5, root 439 clip move -TX, -TY, once { blur 5, root }
414 440
415=cut 441=cut
416 442
417 sub TX() { $new->{position_sensitive} = 1; $x } 443 sub TX() { $new->{again}{position} = 1; $x }
418 sub TY() { $new->{position_sensitive} = 1; $y } 444 sub TY() { $new->{again}{position} = 1; $y }
419 sub TW() { $new->{size_sensitive} = 1; $w } 445 sub TW() { $new->{again}{size} = 1; $w }
420 sub TH() { $new->{size_sensitive} = 1; $h } 446 sub TH() { $new->{again}{size} = 1; $h }
421 447
422=item now 448=item now
423 449
424Returns the current time as (fractional) seconds since the epoch. 450Returns the current time as (fractional) seconds since the epoch.
425 451
… …
444=cut 470=cut
445 471
446 sub now() { urxvt::NOW } 472 sub now() { urxvt::NOW }
447 473
448 sub again($) { 474 sub again($) {
449 $new->{again} = $_[0]; 475 $new->{again}{time} = $_[0];
450 } 476 }
451 477
452 sub counter($) { 478 sub counter($) {
453 $new->{again} = $_[0]; 479 $new->{again}{time} = $_[0];
454 $self->{counter} + 0 480 $self->{counter} + 0
455 } 481 }
456 482
457=back 483=back
458 484
… …
745 771
746=back 772=back
747 773
748=head2 OTHER STUFF 774=head2 OTHER STUFF
749 775
750Anything that didn't fit any of the other categories, even after appliyng 776Anything that didn't fit any of the other categories, even after applying
751force and closing our eyes. 777force and closing our eyes.
752 778
753=over 4 779=over 4
754 780
755=item once { ... } 781=item once { ... }
… …
782next call they will be reevaluated again. 808next call they will be reevaluated again.
783 809
784=cut 810=cut
785 811
786 sub once(&) { 812 sub once(&) {
787 $_ONCE_CACHE{$_[0]+0} ||= $_[0]() 813 my $once = $self->{once_cache}{$_[0]+0} ||= do {
814 local $new->{again};
815 my @res = $_[0]();
816 [$new->{again}, \@res]
817 };
818
819 $new->{again} = {
820 %{ $new->{again} },
821 %{ $once->[0] }
822 };
823
824 # in scalar context we always return the first original result, which
825 # is not quite how perl works.
826 wantarray
827 ? @{ $once->[1] }
828 : $once->[1][0]
788 } 829 }
789 830
790 sub once_again() { 831 sub once_again() {
791 %_ONCE_CACHE = (); 832 delete $self->{once_cache};
792 } 833 }
793 834
794=back 835=back
795 836
796=cut 837=cut
… …
841 882
842 my $img = eval { $self->{expr}->() }; 883 my $img = eval { $self->{expr}->() };
843 warn $@ if $@;#d# 884 warn $@ if $@;#d#
844 die "background-expr did not return an image.\n" if !UNIVERSAL::isa $img, "urxvt::img"; 885 die "background-expr did not return an image.\n" if !UNIVERSAL::isa $img, "urxvt::img";
845 886
846 $state->{size_sensitive} = 1 887 # if the expression is sensitive to external events, prepare reevaluation then
888
889 my $again = delete $state->{again};
890
891 $again->{size} = 1
847 if $img->repeat_mode != urxvt::RepeatNormal; 892 if $img->repeat_mode != urxvt::RepeatNormal;
848 893
849 # if the expression is sensitive to external events, prepare reevaluation then
850
851 my $repeat;
852
853 if (my $again = $state->{again}) { 894 if (my $again = $again->{time}) {
854 $repeat = 1;
855 my $self = $self; 895 my $self = $self;
856 $state->{timer} = $again == $old->{again} 896 $state->{timer} = $again == $old->{again}
857 ? $old->{timer} 897 ? $old->{timer}
858 : urxvt::timer->new->after ($again)->interval ($again)->cb (sub { 898 : urxvt::timer->new->after ($again)->interval ($again)->cb (sub {
859 ++$self->{counter}; 899 ++$self->{counter};
860 $self->recalculate 900 $self->recalculate
861 }); 901 });
862 } 902 }
863 903
864 if (delete $state->{position_sensitive}) { 904 if ($again->{position}) {
865 $repeat = 1;
866 $self->enable (position_change => sub { $_[0]->recalculate }); 905 $self->enable (position_change => sub { $_[0]->recalculate });
867 } else { 906 } else {
868 $self->disable ("position_change"); 907 $self->disable ("position_change");
869 } 908 }
870 909
871 if (delete $state->{size_sensitive}) { 910 if ($again->{size}) {
872 $repeat = 1;
873 $self->enable (size_change => sub { $_[0]->recalculate }); 911 $self->enable (size_change => sub { $_[0]->recalculate });
874 } else { 912 } else {
875 $self->disable ("size_change"); 913 $self->disable ("size_change");
876 } 914 }
877 915
878 if (delete $state->{rootpmap_sensitive}) { 916 if ($again->{rootpmap}) {
879 $repeat = 1;
880 $self->enable (rootpmap_change => sub { $_[0]->recalculate }); 917 $self->enable (rootpmap_change => sub {
918 delete $_[0]{once_cache}; # this will override once-block values from
919 $_[0]->recalculate;
920 });
881 } else { 921 } else {
882 $self->disable ("rootpmap_change"); 922 $self->disable ("rootpmap_change");
883 } 923 }
884 924
885 # clear stuff we no longer need 925 # clear stuff we no longer need
886 926
887 %$old = (); 927 %$old = ();
888 928
889 unless ($repeat) { 929 unless (%$again) {
890 delete $self->{state}; 930 delete $self->{state};
891 delete $self->{expr}; 931 delete $self->{expr};
892 } 932 }
893 933
894 # set background pixmap 934 # set background pixmap

Diff Legend

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