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.59 by root, Thu Jun 14 19:31:17 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.
329
330This function is called automatically when an expression returns multiple
331images.
310 332
311=cut 333=cut
312 334
313 sub merge(@) { 335 sub merge(@) {
336 return $_[0] unless $#_;
337
314 # rather annoyingly clumsy, but optimisation is for another time 338 # rather annoyingly clumsy, but optimisation is for another time
315 339
316 my $x0 = +1e9; 340 my $x0 = +1e9;
317 my $y0 = +1e9; 341 my $y0 = +1e9;
318 my $x1 = -1e9; 342 my $x1 = -1e9;
… …
330 $x1 = $x if $x1 < $x; 354 $x1 = $x if $x1 < $x;
331 $y1 = $y if $y1 < $y; 355 $y1 = $y if $y1 < $y;
332 } 356 }
333 357
334 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);
335 $base->fill ([0, 0, 0, 0]); 360 $base->fill ([0, 0, 0, 0]);
336 361
337 $base->draw ($_) 362 $base->draw ($_)
338 for @_; 363 for @_;
339 364
… …
465 490
466 clip move -TX, -TY, once { blur 5, root } 491 clip move -TX, -TY, once { blur 5, root }
467 492
468=cut 493=cut
469 494
470 sub TX() { $new->{again}{position} = 1; $x } 495 sub TX() { $frame->[FR_AGAIN]{position} = 1; $x }
471 sub TY() { $new->{again}{position} = 1; $y } 496 sub TY() { $frame->[FR_AGAIN]{position} = 1; $y }
472 sub TW() { $new->{again}{size} = 1; $w } 497 sub TW() { $frame->[FR_AGAIN]{size} = 1; $w }
473 sub TH() { $new->{again}{size} = 1; $h } 498 sub TH() { $frame->[FR_AGAIN]{size} = 1; $h }
474 499
475=item now 500=item now
476 501
477Returns the current time as (fractional) seconds since the epoch. 502Returns the current time as (fractional) seconds since the epoch.
478 503
… …
497=cut 522=cut
498 523
499 sub now() { urxvt::NOW } 524 sub now() { urxvt::NOW }
500 525
501 sub again($) { 526 sub again($) {
502 $new->{again}{time} = $_[0]; 527 $frame->[FR_AGAIN]{time} = $_[0];
503 } 528 }
504 529
505 sub counter($) { 530 sub counter($) {
506 $new->{again}{time} = $_[0]; 531 $frame->[FR_AGAIN]{time} = $_[0];
507 $self->{counter} + 0 532 $frame->[FR_STATE]{counter} + 0
508 } 533 }
509 534
510=back 535=back
511 536
512=head2 SHAPE CHANGING OPERATORS 537=head2 SHAPE CHANGING OPERATORS
… …
697=cut 722=cut
698 723
699 sub rotate($$$$) { 724 sub rotate($$$$) {
700 my $img = pop; 725 my $img = pop;
701 $img->rotate ( 726 $img->rotate (
702 $_[0] * $img->w, 727 $_[0] * ($img->w + $img->x),
703 $_[1] * $img->h, 728 $_[1] * ($img->h + $img->y),
704 $_[2] * (3.14159265 / 180), 729 $_[2] * (3.14159265 / 180),
705 ) 730 )
706 } 731 }
707 732
708=back 733=back
… …
812 837
813The 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
814will 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
815images). 840images).
816 841
817This can be extremely useful to avoid redoign the same slow operations 842This can be extremely useful to avoid redoing the same slow operations
818again and again- for example, if your background expression takes the root 843again and again- for example, if your background expression takes the root
819background, 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
820root background on every window move or resize. 845root background on every window move or resize.
821 846
847In fact, urxvt itself encloses the whole expression in some kind of
848C<once> block so it only is reevaluated as required.
849
822Putting 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
823once: 851once:
824 852
825 rootlign once { blur 10, root } 853 rootlign once { blur 10, root }
826 854
827This leaves the question of how to force reevaluation of the block, in 855This leaves the question of how to force reevaluation of the block,
828case the root background changes: Right now, all once blocks forget that 856in case the root background changes: If expression inside the block
829they ahve been executed before each time the root background changes (if 857is sensitive to some event (root background changes, window geometry
830the expression is sensitive to that) or when C<once_again> is called. 858changes), then it will be reevaluated automatically as needed.
831 859
832=item once_again 860=item once_again
833 861
834Resets 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
835next call they will be reevaluated again. 863next call they will be reevaluated again.
836 864
837=cut 865=cut
838 866
839 sub once(&) { 867 sub once(&) {
840 my $once = $self->{once_cache}{$_[0]+0} ||= do { 868 my $id = $_[0]+0;
841 local $new->{again}; 869
842 my @res = $_[0](); 870 local $frame = $self->{frame_cache}{$id} ||= [$frame];
843 [$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;
844 }; 891 });
845
846 $new->{again} = {
847 %{ $new->{again} },
848 %{ $once->[0] }
849 }; 892 };
850 893
851 # in scalar context we always return the first original result, which 894 # in scalar context we always return the first original result, which
852 # is not quite how perl works. 895 # is not quite how perl works.
853 wantarray 896 wantarray
854 ? @{ $once->[1] } 897 ? @{ $frame->[FR_CACHE] }
855 : $once->[1][0] 898 : $frame->[FR_CACHE][0]
856 } 899 }
857 900
858 sub once_again() { 901 sub once_again() {
859 delete $self->{once_cache}; 902 delete $self->{frame_cache};
860 } 903 }
861 904
862=back 905=back
863 906
864=cut 907=cut
865 908
866} 909}
867 910
868sub parse_expr { 911sub parse_expr {
869 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 . "}";
870 die if $@; 918 die if $@;
871 $expr 919 $expr
872} 920}
873 921
874# compiles a parsed expression 922# compiles a parsed expression
875sub set_expr { 923sub set_expr {
876 my ($self, $expr) = @_; 924 my ($self, $expr) = @_;
877 925
926 $self->{root} = [];
878 $self->{expr} = $expr; 927 $self->{expr} = $expr;
879 $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 }
880} 977}
881 978
882# evaluate the current bg expression 979# evaluate the current bg expression
883sub recalculate { 980sub recalculate {
884 my ($arg_self) = @_; 981 my ($arg_self) = @_;
… …
894 991
895 $arg_self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL; 992 $arg_self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL;
896 993
897 # set environment to evaluate user expression 994 # set environment to evaluate user expression
898 995
899 local $self = $arg_self; 996 local $self = $arg_self;
900
901 local $HOME = $ENV{HOME}; 997 local $HOME = $ENV{HOME};
902 local $old = $self->{state}; 998 local $frame = [];
903 local $new = my $state = $self->{state} = {};
904 999
905 ($x, $y, $w, $h) =
906 $self->background_geometry ($self->{border}); 1000 ($x, $y, $w, $h) = $self->background_geometry ($self->{border});
907 1001
908 # evaluate user expression 1002 # evaluate user expression
909 1003
910 my $img = eval { $self->{expr}->() }; 1004 my @img = eval { $self->{expr}->() };
911 warn $@ if $@;#d# 1005 die $@ if $@;
912 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;
913 1014
914 # if the expression is sensitive to external events, prepare reevaluation then 1015 # if the expression is sensitive to external events, prepare reevaluation then
915 1016 $self->compile_frame ($frame, sub { $arg_self->recalculate });
916 my $again = delete $state->{again};
917
918 $again->{size} = 1
919 if $img->repeat_mode != urxvt::RepeatNormal;
920
921 if (my $again = $again->{time}) {
922 my $self = $self;
923 $state->{timer} = $again == $old->{again}
924 ? $old->{timer}
925 : urxvt::timer->new->after ($again)->interval ($again)->cb (sub {
926 ++$self->{counter};
927 $self->recalculate
928 });
929 }
930
931 if ($again->{position}) {
932 $self->enable (position_change => sub { $_[0]->recalculate });
933 } else {
934 $self->disable ("position_change");
935 }
936
937 if ($again->{size}) {
938 $self->enable (size_change => sub { $_[0]->recalculate });
939 } else {
940 $self->disable ("size_change");
941 }
942
943 if ($again->{rootpmap}) {
944 $self->enable (rootpmap_change => sub {
945 delete $_[0]{once_cache}; # this will override once-block values from
946 $_[0]->recalculate;
947 });
948 } else {
949 $self->disable ("rootpmap_change");
950 }
951 1017
952 # clear stuff we no longer need 1018 # clear stuff we no longer need
953 1019
954 %$old = (); 1020# unless (%{ $frame->[FR_STATE] }) {
955
956 unless (%$again) {
957 delete $self->{state}; 1021# delete $self->{state};
958 delete $self->{expr}; 1022# delete $self->{expr};
959 } 1023# }
960 1024
961 # set background pixmap 1025 # set background pixmap
962 1026
963 $self->set_background ($img, $self->{border}); 1027 $self->set_background ($img, $self->{border});
964 $self->scr_recolour (0); 1028 $self->scr_recolour (0);

Diff Legend

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