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.55 by root, Thu Jun 14 16:48:57 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
… …
285=cut 303=cut
286 304
287 sub solid($;$$) { 305 sub solid($;$$) {
288 my $colour = pop; 306 my $colour = pop;
289 307
290 my $img = $self->new_img (urxvt::PictStandardARGB32, $_[0] || 1, $_[1] || 1); 308 my $img = $self->new_img (urxvt::PictStandardARGB32, 0, 0, $_[0] || 1, $_[1] || 1);
291 $img->fill ($colour); 309 $img->fill ($colour);
292 $img 310 $img
293 } 311 }
294 312
295=item clone $img 313=item clone $img
… …
299 317
300=cut 318=cut
301 319
302 sub clone($) { 320 sub clone($) {
303 $_[0]->clone 321 $_[0]->clone
322 }
323
324=item merge $img ...
325
326Takes any number of images and merges them together, creating a single
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.
332
333=cut
334
335 sub merge(@) {
336 return $_[0] unless $#_;
337
338 # rather annoyingly clumsy, but optimisation is for another time
339
340 my $x0 = +1e9;
341 my $y0 = +1e9;
342 my $x1 = -1e9;
343 my $y1 = -1e9;
344
345 for (@_) {
346 my ($x, $y, $w, $h) = $_->geometry;
347
348 $x0 = $x if $x0 > $x;
349 $y0 = $y if $y0 > $y;
350
351 $x += $w;
352 $y += $h;
353
354 $x1 = $x if $x1 < $x;
355 $y1 = $y if $y1 < $y;
356 }
357
358 my $base = $self->new_img (urxvt::PictStandardARGB32, $x0, $y0, $x1 - $x0, $y1 - $y0);
359 $base->repeat_mode ($_[0]->repeat_mode);
360 $base->fill ([0, 0, 0, 0]);
361
362 $base->draw ($_)
363 for @_;
364
365 $base
304 } 366 }
305 367
306=head2 TILING MODES 368=head2 TILING MODES
307 369
308The following operators modify the tiling mode of an image, that is, the 370The following operators modify the tiling mode of an image, that is, the
… …
428 490
429 clip move -TX, -TY, once { blur 5, root } 491 clip move -TX, -TY, once { blur 5, root }
430 492
431=cut 493=cut
432 494
433 sub TX() { $new->{again}{position} = 1; $x } 495 sub TX() { $frame->[FR_AGAIN]{position} = 1; $x }
434 sub TY() { $new->{again}{position} = 1; $y } 496 sub TY() { $frame->[FR_AGAIN]{position} = 1; $y }
435 sub TW() { $new->{again}{size} = 1; $w } 497 sub TW() { $frame->[FR_AGAIN]{size} = 1; $w }
436 sub TH() { $new->{again}{size} = 1; $h } 498 sub TH() { $frame->[FR_AGAIN]{size} = 1; $h }
437 499
438=item now 500=item now
439 501
440Returns the current time as (fractional) seconds since the epoch. 502Returns the current time as (fractional) seconds since the epoch.
441 503
… …
460=cut 522=cut
461 523
462 sub now() { urxvt::NOW } 524 sub now() { urxvt::NOW }
463 525
464 sub again($) { 526 sub again($) {
465 $new->{again}{time} = $_[0]; 527 $frame->[FR_AGAIN]{time} = $_[0];
466 } 528 }
467 529
468 sub counter($) { 530 sub counter($) {
469 $new->{again}{time} = $_[0]; 531 $frame->[FR_AGAIN]{time} = $_[0];
470 $self->{counter} + 0 532 $frame->[FR_STATE]{counter} + 0
471 } 533 }
472 534
473=back 535=back
474 536
475=head2 SHAPE CHANGING OPERATORS 537=head2 SHAPE CHANGING OPERATORS
… …
660=cut 722=cut
661 723
662 sub rotate($$$$) { 724 sub rotate($$$$) {
663 my $img = pop; 725 my $img = pop;
664 $img->rotate ( 726 $img->rotate (
665 $_[0] * $img->w, 727 $_[0] * ($img->w + $img->x),
666 $_[1] * $img->h, 728 $_[1] * ($img->h + $img->y),
667 $_[2] * (3.14159265 / 180), 729 $_[2] * (3.14159265 / 180),
668 ) 730 )
669 } 731 }
670 732
671=back 733=back
… …
761 823
762=back 824=back
763 825
764=head2 OTHER STUFF 826=head2 OTHER STUFF
765 827
766Anything that didn't fit any of the other categories, even after appliyng 828Anything that didn't fit any of the other categories, even after applying
767force and closing our eyes. 829force and closing our eyes.
768 830
769=over 4 831=over 4
770 832
771=item once { ... } 833=item once { ... }
… …
775 837
776The 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
777will 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
778images). 840images).
779 841
780This can be extremely useful to avoid redoign the same slow operations 842This can be extremely useful to avoid redoing the same slow operations
781again and again- for example, if your background expression takes the root 843again and again- for example, if your background expression takes the root
782background, 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
783root background on every window move or resize. 845root background on every window move or resize.
784 846
847In fact, urxvt itself encloses the whole expression in some kind of
848C<once> block so it only is reevaluated as required.
849
785Putting 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
786once: 851once:
787 852
788 rootlign once { blur 10, root } 853 rootlign once { blur 10, root }
789 854
790This leaves the question of how to force reevaluation of the block, in 855This leaves the question of how to force reevaluation of the block,
791case the root background changes: Right now, all once blocks forget that 856in case the root background changes: If expression inside the block
792they ahve been executed before each time the root background changes (if 857is sensitive to some event (root background changes, window geometry
793the expression is sensitive to that) or when C<once_again> is called. 858changes), then it will be reevaluated automatically as needed.
794 859
795=item once_again 860=item once_again
796 861
797Resets 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
798next call they will be reevaluated again. 863next call they will be reevaluated again.
799 864
800=cut 865=cut
801 866
802 sub once(&) { 867 sub once(&) {
803 my $once = $self->{once_cache}{$_[0]+0} ||= do { 868 my $id = $_[0]+0;
804 local $new->{again}; 869
805 my @res = $_[0](); 870 local $frame = $self->{frame_cache}{$id} ||= [$frame];
806 [$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;
807 }; 891 });
808
809 $new->{again} = {
810 %{ $new->{again} },
811 %{ $once->[0] }
812 }; 892 };
813 893
814 # in scalar context we always return the first original result, which 894 # in scalar context we always return the first original result, which
815 # is not quite how perl works. 895 # is not quite how perl works.
816 wantarray 896 wantarray
817 ? @{ $once->[1] } 897 ? @{ $frame->[FR_CACHE] }
818 : $once->[1][0] 898 : $frame->[FR_CACHE][0]
819 } 899 }
820 900
821 sub once_again() { 901 sub once_again() {
822 delete $self->{once_cache}; 902 delete $self->{frame_cache};
823 } 903 }
824 904
825=back 905=back
826 906
827=cut 907=cut
828 908
829} 909}
830 910
831sub parse_expr { 911sub parse_expr {
832 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 . "}";
833 die if $@; 918 die if $@;
834 $expr 919 $expr
835} 920}
836 921
837# compiles a parsed expression 922# compiles a parsed expression
838sub set_expr { 923sub set_expr {
839 my ($self, $expr) = @_; 924 my ($self, $expr) = @_;
840 925
926 $self->{root} = [];
841 $self->{expr} = $expr; 927 $self->{expr} = $expr;
842 $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 }
843} 977}
844 978
845# evaluate the current bg expression 979# evaluate the current bg expression
846sub recalculate { 980sub recalculate {
847 my ($arg_self) = @_; 981 my ($arg_self) = @_;
… …
857 991
858 $arg_self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL; 992 $arg_self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL;
859 993
860 # set environment to evaluate user expression 994 # set environment to evaluate user expression
861 995
862 local $self = $arg_self; 996 local $self = $arg_self;
863
864 local $HOME = $ENV{HOME}; 997 local $HOME = $ENV{HOME};
865 local $old = $self->{state}; 998 local $frame = [];
866 local $new = my $state = $self->{state} = {};
867 999
868 ($x, $y, $w, $h) =
869 $self->background_geometry ($self->{border}); 1000 ($x, $y, $w, $h) = $self->background_geometry ($self->{border});
870 1001
871 # evaluate user expression 1002 # evaluate user expression
872 1003
873 my $img = eval { $self->{expr}->() }; 1004 my @img = eval { $self->{expr}->() };
874 warn $@ if $@;#d# 1005 die $@ if $@;
875 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;
876 1014
877 # if the expression is sensitive to external events, prepare reevaluation then 1015 # if the expression is sensitive to external events, prepare reevaluation then
878 1016 $self->compile_frame ($frame, sub { $arg_self->recalculate });
879 my $again = delete $state->{again};
880
881 $again->{size} = 1
882 if $img->repeat_mode != urxvt::RepeatNormal;
883
884 if (my $again = $again->{time}) {
885 my $self = $self;
886 $state->{timer} = $again == $old->{again}
887 ? $old->{timer}
888 : urxvt::timer->new->after ($again)->interval ($again)->cb (sub {
889 ++$self->{counter};
890 $self->recalculate
891 });
892 }
893
894 if ($again->{position}) {
895 $self->enable (position_change => sub { $_[0]->recalculate });
896 } else {
897 $self->disable ("position_change");
898 }
899
900 if ($again->{size}) {
901 $self->enable (size_change => sub { $_[0]->recalculate });
902 } else {
903 $self->disable ("size_change");
904 }
905
906 if ($again->{rootpmap}) {
907 $self->enable (rootpmap_change => sub {
908 delete $_[0]{once_cache}; # this will override once-block values from
909 $_[0]->recalculate;
910 });
911 } else {
912 $self->disable ("rootpmap_change");
913 }
914 1017
915 # clear stuff we no longer need 1018 # clear stuff we no longer need
916 1019
917 %$old = (); 1020# unless (%{ $frame->[FR_STATE] }) {
918
919 unless (%$again) {
920 delete $self->{state}; 1021# delete $self->{state};
921 delete $self->{expr}; 1022# delete $self->{expr};
922 } 1023# }
923 1024
924 # set background pixmap 1025 # set background pixmap
925 1026
926 $self->set_background ($img, $self->{border}); 1027 $self->set_background ($img, $self->{border});
927 $self->scr_recolour (0); 1028 $self->scr_recolour (0);

Diff Legend

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