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.61 by root, Fri Jun 15 19:50:56 2012 UTC vs.
Revision 1.63 by root, Tue Jun 19 18:17:56 2012 UTC

… …
138pseudo-transparency, as the image seems to be static while the window is 138pseudo-transparency, as the image seems to be static while the window is
139moved around. 139moved around.
140 140
141=head2 CYCLES AND CACHING 141=head2 CYCLES AND CACHING
142 142
143=head3 C<load> et al.
144
143As has been mentioned before, the expression might be evaluated multiple 145As has been mentioned before, the expression might be evaluated multiple
144times. Each time the expression is reevaluated, a new cycle is said to 146times. Each time the expression is reevaluated, a new cycle is said to
145have begun. Many operators cache their results till the next cycle. 147have begun. Many operators cache their results till the next cycle.
146 148
147For example, the C<load> operator keeps a copy of the image. If it is 149For example, the C<load> operator keeps a copy of the image. If it is
… …
171 173
172Here, a path is selected randomly, and load is only called for one image, 174Here, a path is selected randomly, and load is only called for one image,
173so keeps only one image in memory. If, on the next evaluation, luck 175so keeps only one image in memory. If, on the next evaluation, luck
174decides to use the other path, then it will have to load that image again. 176decides to use the other path, then it will have to load that image again.
175 177
178=head3 C<once { ... }>
179
180Another way to cache expensive operations is to use C<once { ... }>. The
181C<once> operator takes a block of multiple statements enclosed by C<{}>
182and evaluates it only.. once, returning any images the last statement
183returned. Further calls simply produce the values from the cache.
184
185This is most useful for expensive operations, such as C<blur>:
186
187 rootalign once { blur 20, root }
188
189This makes a blurred copy of the root background once, and on subsequent
190calls, just root-aligns it. Since C<blur> is usually quite slow and
191C<rootalign> is quite fast, this trades extra memory (For the cached
192blurred pixmap) with speed (blur only needs to be redone when root
193changes).
194
176=head1 REFERENCE 195=head1 REFERENCE
177 196
178=head2 COMMAND LINE SWITCHES 197=head2 COMMAND LINE SWITCHES
179 198
180=over 4 199=over 4
… …
204 223
205=cut 224=cut
206 225
207our %_IMG_CACHE; 226our %_IMG_CACHE;
208our $HOME; 227our $HOME;
209our ($self, $old, $new); 228our ($self, $frame);
210our ($x, $y, $w, $h); 229our ($x, $y, $w, $h);
211 230
212# enforce at least this interval between updates 231# enforce at least this interval between updates
213our $MIN_INTERVAL = 6/59.951; 232our $MIN_INTERVAL = 6/59.951;
214 233
215{ 234{
216 package urxvt::bgdsl; # background language 235 package urxvt::bgdsl; # background language
236
237 sub FR_PARENT() { 0 } # parent frame, if any - must be #0
238 sub FR_CACHE () { 1 } # cached values
239 sub FR_AGAIN () { 2 } # what this expr is sensitive to
240 sub FR_STATE () { 3 } # watchers etc.
217 241
218 use List::Util qw(min max sum shuffle); 242 use List::Util qw(min max sum shuffle);
219 243
220=head2 PROVIDERS/GENERATORS 244=head2 PROVIDERS/GENERATORS
221 245
… …
231mode. 255mode.
232 256
233Loaded images will be cached for one cycle, and shared between temrinals 257Loaded images will be cached for one cycle, and shared between temrinals
234running in the same process (e.g. in C<urxvtd>). 258running in the same process (e.g. in C<urxvtd>).
235 259
236=item load_uc $path 260#=item load_uc $path
237 261#
238Load uncached - same as load, but does not cache the image. This function 262#Load 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 263#is most useufl if you want to optimise a background expression in some
240way. 264#way.
241 265
242=cut 266=cut
243 267
244 sub load_uc($) { 268 sub load($) {
245 my ($path) = @_; 269 my ($path) = @_;
246 270
247 $_IMG_CACHE{$path} || do { 271 $_IMG_CACHE{$path} || do {
248 my $img = $self->new_img_from_file ($path); 272 my $img = $self->new_img_from_file ($path);
249 Scalar::Util::weaken ($_IMG_CACHE{$path} = $img); 273 Scalar::Util::weaken ($_IMG_CACHE{$path} = $img);
250 $img 274 $img
251 } 275 }
252 } 276 }
253 277
254 sub load($) {
255 my ($path) = @_;
256
257 $new->{load}{$path} = $old->{load}{$path} || load_uc $path;
258 }
259
260=item root 278=item root
261 279
262Returns the root window pixmap, that is, hopefully, the background image 280Returns the root window pixmap, that is, hopefully, the background image
263of your screen. The image is set to extend mode. 281of your screen.
264 282
265This function makes your expression root sensitive, that means it will be 283This function makes your expression root sensitive, that means it will be
266reevaluated when the bg image changes. 284reevaluated when the bg image changes.
267 285
268=cut 286=cut
269 287
270 sub root() { 288 sub root() {
271 $new->{again}{rootpmap} = 1; 289 $frame->[FR_AGAIN]{rootpmap} = 1;
272 $self->new_img_from_root 290 $self->new_img_from_root
273 } 291 }
274 292
275=item solid $colour 293=item solid $colour
276 294
… …
304 } 322 }
305 323
306=item merge $img ... 324=item merge $img ...
307 325
308Takes any number of images and merges them together, creating a single 326Takes any number of images and merges them together, creating a single
309image containing them all. 327image containing them all. The tiling mode of the first image is used as
328the tiling mdoe of the resulting image.
310 329
311This function is called automatically when an expression returns multiple 330This function is called automatically when an expression returns multiple
312images. 331images.
313 332
314=cut 333=cut
… …
335 $x1 = $x if $x1 < $x; 354 $x1 = $x if $x1 < $x;
336 $y1 = $y if $y1 < $y; 355 $y1 = $y if $y1 < $y;
337 } 356 }
338 357
339 my $base = $self->new_img (urxvt::PictStandardARGB32, $x0, $y0, $x1 - $x0, $y1 - $y0); 358 my $base = $self->new_img (urxvt::PictStandardARGB32, $x0, $y0, $x1 - $x0, $y1 - $y0);
359 $base->repeat_mode ($_[0]->repeat_mode);
340 $base->fill ([0, 0, 0, 0]); 360 $base->fill ([0, 0, 0, 0]);
341 361
342 $base->draw ($_) 362 $base->draw ($_)
343 for @_; 363 for @_;
344 364
… …
470 490
471 clip move -TX, -TY, once { blur 5, root } 491 clip move -TX, -TY, once { blur 5, root }
472 492
473=cut 493=cut
474 494
475 sub TX() { $new->{again}{position} = 1; $x } 495 sub TX() { $frame->[FR_AGAIN]{position} = 1; $x }
476 sub TY() { $new->{again}{position} = 1; $y } 496 sub TY() { $frame->[FR_AGAIN]{position} = 1; $y }
477 sub TW() { $new->{again}{size} = 1; $w } 497 sub TW() { $frame->[FR_AGAIN]{size} = 1; $w }
478 sub TH() { $new->{again}{size} = 1; $h } 498 sub TH() { $frame->[FR_AGAIN]{size} = 1; $h }
479 499
480=item now 500=item now
481 501
482Returns the current time as (fractional) seconds since the epoch. 502Returns the current time as (fractional) seconds since the epoch.
483 503
… …
502=cut 522=cut
503 523
504 sub now() { urxvt::NOW } 524 sub now() { urxvt::NOW }
505 525
506 sub again($) { 526 sub again($) {
507 $new->{again}{time} = $_[0]; 527 $frame->[FR_AGAIN]{time} = $_[0];
508 } 528 }
509 529
510 sub counter($) { 530 sub counter($) {
511 $new->{again}{time} = $_[0]; 531 $frame->[FR_AGAIN]{time} = $_[0];
512 $self->{counter} + 0 532 $frame->[FR_STATE]{counter} + 0
513 } 533 }
514 534
515=back 535=back
516 536
517=head2 SHAPE CHANGING OPERATORS 537=head2 SHAPE CHANGING OPERATORS
… …
817 837
818The trick is that this code block is only evaluated once - future calls 838The trick is that this code block is only evaluated once - future calls
819will simply return the original image (yes, it should only be used with 839will simply return the original image (yes, it should only be used with
820images). 840images).
821 841
822This can be extremely useful to avoid redoign the same slow operations 842This can be extremely useful to avoid redoing the same slow operations
823again and again- for example, if your background expression takes the root 843again and again- for example, if your background expression takes the root
824background, blurs it and then root-aligns it it would have to blur the 844background, blurs it and then root-aligns it it would have to blur the
825root background on every window move or resize. 845root background on every window move or resize.
826 846
847In fact, urxvt itself encloses the whole expression in some kind of
848C<once> block so it only is reevaluated as required.
849
827Putting the blur into a C<once> block will make sure the blur is only done 850Putting the blur into a C<once> block will make sure the blur is only done
828once: 851once:
829 852
830 rootlign once { blur 10, root } 853 rootlign once { blur 10, root }
831 854
832This leaves the question of how to force reevaluation of the block, in 855This leaves the question of how to force reevaluation of the block,
833case the root background changes: Right now, all once blocks forget that 856in case the root background changes: If expression inside the block
834they ahve been executed before each time the root background changes (if 857is sensitive to some event (root background changes, window geometry
835the expression is sensitive to that) or when C<once_again> is called. 858changes), then it will be reevaluated automatically as needed.
836 859
837=item once_again 860=item once_again
838 861
839Resets all C<once> block as if they had never been called, i.e. on the 862Resets all C<once> block as if they had never been called, i.e. on the
840next call they will be reevaluated again. 863next call they will be reevaluated again.
841 864
842=cut 865=cut
843 866
844 sub once(&) { 867 sub once(&) {
845 my $once = $self->{once_cache}{$_[0]+0} ||= do { 868 my $id = $_[0]+0;
846 local $new->{again}; 869
847 my @res = $_[0](); 870 local $frame = $self->{frame_cache}{$id} ||= [$frame];
848 [$new->{again}, \@res] 871
872 unless ($frame->[FR_CACHE]) {
873 $frame->[FR_CACHE] = [ $_[0]() ];
874
875 my $self = $self;
876 my $frame = $frame;
877 Scalar::Util::weaken $frame;
878 $self->compile_frame ($frame, sub {
879 # clear this frame cache, also for all parents
880 for (my $frame = $frame; $frame; $frame = $frame->[0]) {
881 undef $frame->[FR_CACHE];
882 }
883
884 unless ($self->{term}) {
885 use Data::Dump;
886 ddx $frame;
887 exit;
888 }
889
890 $self->recalculate;
849 }; 891 });
850
851 $new->{again} = {
852 %{ $new->{again} },
853 %{ $once->[0] }
854 }; 892 };
855 893
856 # in scalar context we always return the first original result, which 894 # in scalar context we always return the first original result, which
857 # is not quite how perl works. 895 # is not quite how perl works.
858 wantarray 896 wantarray
859 ? @{ $once->[1] } 897 ? @{ $frame->[FR_CACHE] }
860 : $once->[1][0] 898 : $frame->[FR_CACHE][0]
861 } 899 }
862 900
863 sub once_again() { 901 sub once_again() {
864 delete $self->{once_cache}; 902 delete $self->{frame_cache};
865 } 903 }
866 904
867=back 905=back
868 906
869=cut 907=cut
870 908
871} 909}
872 910
873sub parse_expr { 911sub parse_expr {
874 my $expr = eval "sub {\npackage urxvt::bgdsl;\n#line 0 'background expression'\n$_[0]\n}"; 912 my $expr = eval
913 "sub {\n"
914 . "package urxvt::bgdsl;\n"
915 . "#line 0 'background expression'\n"
916 . "$_[0]\n"
917 . "}";
875 die if $@; 918 die if $@;
876 $expr 919 $expr
877} 920}
878 921
879# compiles a parsed expression 922# compiles a parsed expression
880sub set_expr { 923sub set_expr {
881 my ($self, $expr) = @_; 924 my ($self, $expr) = @_;
882 925
926 $self->{root} = [];
883 $self->{expr} = $expr; 927 $self->{expr} = $expr;
884 $self->recalculate; 928 $self->recalculate;
929}
930
931# takes a hash of sensitivity indicators and installs watchers
932sub compile_frame {
933 my ($self, $frame, $cb) = @_;
934
935 my $state = $frame->[urxvt::bgdsl::FR_STATE] ||= {};
936 my $again = $frame->[urxvt::bgdsl::FR_AGAIN];
937
938 # don't keep stuff alive
939 Scalar::Util::weaken $state;
940
941 if ($again->{nested}) {
942 $state->{nested} = 1;
943 } else {
944 delete $state->{nested};
945 }
946
947 if (my $interval = $again->{time}) {
948 $state->{time} = [$interval, urxvt::timer->new->after ($interval)->interval ($interval)]
949 if $state->{time}[0] != $interval;
950
951 # callback *might* have changed, although we could just rule that out
952 $state->{time}[1]->cb (sub {
953 ++$state->{counter};
954 $cb->();
955 });
956 } else {
957 delete $state->{time};
958 }
959
960 if ($again->{position}) {
961 $state->{position} = $self->on (position_change => $cb);
962 } else {
963 delete $state->{position};
964 }
965
966 if ($again->{size}) {
967 $state->{size} = $self->on (size_change => $cb);
968 } else {
969 delete $state->{size};
970 }
971
972 if ($again->{rootpmap}) {
973 $state->{rootpmap} = $self->on (rootpmap_change => $cb);
974 } else {
975 delete $state->{rootpmap};
976 }
885} 977}
886 978
887# evaluate the current bg expression 979# evaluate the current bg expression
888sub recalculate { 980sub recalculate {
889 my ($arg_self) = @_; 981 my ($arg_self) = @_;
… …
899 991
900 $arg_self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL; 992 $arg_self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL;
901 993
902 # set environment to evaluate user expression 994 # set environment to evaluate user expression
903 995
904 local $self = $arg_self; 996 local $self = $arg_self;
905
906 local $HOME = $ENV{HOME}; 997 local $HOME = $ENV{HOME};
907 local $old = $self->{state}; 998 local $frame = [];
908 local $new = my $state = $self->{state} = {};
909 999
910 ($x, $y, $w, $h) =
911 $self->background_geometry ($self->{border}); 1000 ($x, $y, $w, $h) = $self->background_geometry ($self->{border});
912 1001
913 # evaluate user expression 1002 # evaluate user expression
914 1003
915 my $img = eval { urxvt::bgdsl::merge $self->{expr}->() }; 1004 my @img = eval { $self->{expr}->() };
916 die $@ if $@; 1005 die $@ if $@;
917 die "background-expr did not return an image.\n" if !UNIVERSAL::isa $img, "urxvt::img"; 1006 die "background-expr did not return anything.\n" unless @img;
1007 die "background-expr: expected image(s), got something else.\n"
1008 if grep { !UNIVERSAL::isa $_, "urxvt::img" } @img;
1009
1010 my $img = urxvt::bgdsl::merge @img;
1011
1012 $frame->[FR_AGAIN]{size} = 1
1013 if $img->repeat_mode != urxvt::RepeatNormal;
918 1014
919 # if the expression is sensitive to external events, prepare reevaluation then 1015 # if the expression is sensitive to external events, prepare reevaluation then
920 1016 $self->compile_frame ($frame, sub { $arg_self->recalculate });
921 my $again = delete $state->{again};
922
923 $again->{size} = 1
924 if $img->repeat_mode != urxvt::RepeatNormal;
925
926 if (my $again = $again->{time}) {
927 my $self = $self;
928 $state->{timer} = $again == $old->{again}
929 ? $old->{timer}
930 : urxvt::timer->new->after ($again)->interval ($again)->cb (sub {
931 ++$self->{counter};
932 $self->recalculate
933 });
934 }
935
936 if ($again->{position}) {
937 $self->enable (position_change => sub { $_[0]->recalculate });
938 } else {
939 $self->disable ("position_change");
940 }
941
942 if ($again->{size}) {
943 $self->enable (size_change => sub { $_[0]->recalculate });
944 } else {
945 $self->disable ("size_change");
946 }
947
948 if ($again->{rootpmap}) {
949 $self->enable (rootpmap_change => sub {
950 delete $_[0]{once_cache}; # this will override once-block values from
951 $_[0]->recalculate;
952 });
953 } else {
954 $self->disable ("rootpmap_change");
955 }
956 1017
957 # clear stuff we no longer need 1018 # clear stuff we no longer need
958 1019
959 %$old = (); 1020# unless (%{ $frame->[FR_STATE] }) {
960
961 unless (%$again) {
962 delete $self->{state}; 1021# delete $self->{state};
963 delete $self->{expr}; 1022# delete $self->{expr};
964 } 1023# }
965 1024
966 # set background pixmap 1025 # set background pixmap
967 1026
968 $self->set_background ($img, $self->{border}); 1027 $self->set_background ($img, $self->{border});
969 $self->scr_recolour (0); 1028 $self->scr_recolour (0);

Diff Legend

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