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

Diff Legend

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