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.54 by root, Thu Jun 14 16:22:20 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
… …
203=back 222=back
204 223
205=cut 224=cut
206 225
207our %_IMG_CACHE; 226our %_IMG_CACHE;
208our %_ONCE_CACHE;
209our $HOME; 227our $HOME;
210our ($self, $old, $new); 228our ($self, $frame);
211our ($x, $y, $w, $h); 229our ($x, $y, $w, $h);
212 230
213# enforce at least this interval between updates 231# enforce at least this interval between updates
214our $MIN_INTERVAL = 6/59.951; 232our $MIN_INTERVAL = 6/59.951;
215 233
216{ 234{
217 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.
218 241
219 use List::Util qw(min max sum shuffle); 242 use List::Util qw(min max sum shuffle);
220 243
221=head2 PROVIDERS/GENERATORS 244=head2 PROVIDERS/GENERATORS
222 245
… …
232mode. 255mode.
233 256
234Loaded images will be cached for one cycle, and shared between temrinals 257Loaded images will be cached for one cycle, and shared between temrinals
235running in the same process (e.g. in C<urxvtd>). 258running in the same process (e.g. in C<urxvtd>).
236 259
237=item load_uc $path 260#=item load_uc $path
238 261#
239Load 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
240is 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
241way. 264#way.
242 265
243=cut 266=cut
244 267
245 sub load_uc($) { 268 sub load($) {
246 my ($path) = @_; 269 my ($path) = @_;
247 270
248 $_IMG_CACHE{$path} || do { 271 $_IMG_CACHE{$path} || do {
249 my $img = $self->new_img_from_file ($path); 272 my $img = $self->new_img_from_file ($path);
250 Scalar::Util::weaken ($_IMG_CACHE{$path} = $img); 273 Scalar::Util::weaken ($_IMG_CACHE{$path} = $img);
251 $img 274 $img
252 } 275 }
253 } 276 }
254 277
255 sub load($) {
256 my ($path) = @_;
257
258 $new->{load}{$path} = $old->{load}{$path} || load_uc $path;
259 }
260
261=item root 278=item root
262 279
263Returns the root window pixmap, that is, hopefully, the background image 280Returns the root window pixmap, that is, hopefully, the background image
264of your screen. The image is set to extend mode. 281of your screen.
265 282
266This function makes your expression root sensitive, that means it will be 283This function makes your expression root sensitive, that means it will be
267reevaluated when the bg image changes. 284reevaluated when the bg image changes.
268 285
269=cut 286=cut
270 287
271 sub root() { 288 sub root() {
272 $new->{rootpmap_sensitive} = 1; 289 $frame->[FR_AGAIN]{rootpmap} = 1;
273 $self->new_img_from_root 290 $self->new_img_from_root
274 } 291 }
275 292
276=item solid $colour 293=item solid $colour
277 294
… …
286=cut 303=cut
287 304
288 sub solid($;$$) { 305 sub solid($;$$) {
289 my $colour = pop; 306 my $colour = pop;
290 307
291 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);
292 $img->fill ($colour); 309 $img->fill ($colour);
293 $img 310 $img
294 } 311 }
295 312
296=item clone $img 313=item clone $img
… …
300 317
301=cut 318=cut
302 319
303 sub clone($) { 320 sub clone($) {
304 $_[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
305 } 366 }
306 367
307=head2 TILING MODES 368=head2 TILING MODES
308 369
309The 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
… …
425the window size to conserve memory. 486the window size to conserve memory.
426 487
427Example: take the screen background, clip it to the window size, blur it a 488Example: take the screen background, clip it to the window size, blur it a
428bit, align it to the window position and use it as background. 489bit, align it to the window position and use it as background.
429 490
430 clip move -TX, -TY, blur 5, root 491 clip move -TX, -TY, once { blur 5, root }
431 492
432=cut 493=cut
433 494
434 sub TX() { $new->{position_sensitive} = 1; $x } 495 sub TX() { $frame->[FR_AGAIN]{position} = 1; $x }
435 sub TY() { $new->{position_sensitive} = 1; $y } 496 sub TY() { $frame->[FR_AGAIN]{position} = 1; $y }
436 sub TW() { $new->{size_sensitive} = 1; $w } 497 sub TW() { $frame->[FR_AGAIN]{size} = 1; $w }
437 sub TH() { $new->{size_sensitive} = 1; $h } 498 sub TH() { $frame->[FR_AGAIN]{size} = 1; $h }
438 499
439=item now 500=item now
440 501
441Returns the current time as (fractional) seconds since the epoch. 502Returns the current time as (fractional) seconds since the epoch.
442 503
… …
461=cut 522=cut
462 523
463 sub now() { urxvt::NOW } 524 sub now() { urxvt::NOW }
464 525
465 sub again($) { 526 sub again($) {
466 $new->{again} = $_[0]; 527 $frame->[FR_AGAIN]{time} = $_[0];
467 } 528 }
468 529
469 sub counter($) { 530 sub counter($) {
470 $new->{again} = $_[0]; 531 $frame->[FR_AGAIN]{time} = $_[0];
471 $self->{counter} + 0 532 $frame->[FR_STATE]{counter} + 0
472 } 533 }
473 534
474=back 535=back
475 536
476=head2 SHAPE CHANGING OPERATORS 537=head2 SHAPE CHANGING OPERATORS
… …
661=cut 722=cut
662 723
663 sub rotate($$$$) { 724 sub rotate($$$$) {
664 my $img = pop; 725 my $img = pop;
665 $img->rotate ( 726 $img->rotate (
666 $_[0] * $img->w, 727 $_[0] * ($img->w + $img->x),
667 $_[1] * $img->h, 728 $_[1] * ($img->h + $img->y),
668 $_[2] * (3.14159265 / 180), 729 $_[2] * (3.14159265 / 180),
669 ) 730 )
670 } 731 }
671 732
672=back 733=back
… …
762 823
763=back 824=back
764 825
765=head2 OTHER STUFF 826=head2 OTHER STUFF
766 827
767Anything 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
768force and closing our eyes. 829force and closing our eyes.
769 830
770=over 4 831=over 4
771 832
772=item once { ... } 833=item once { ... }
… …
776 837
777The 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
778will 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
779images). 840images).
780 841
781This can be extremely useful to avoid redoign the same slow operations 842This can be extremely useful to avoid redoing the same slow operations
782again and again- for example, if your background expression takes the root 843again and again- for example, if your background expression takes the root
783background, 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
784root background on every window move or resize. 845root background on every window move or resize.
785 846
847In fact, urxvt itself encloses the whole expression in some kind of
848C<once> block so it only is reevaluated as required.
849
786Putting 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
787once: 851once:
788 852
789 rootlign once { blur 10, root } 853 rootlign once { blur 10, root }
790 854
791This leaves the question of how to force reevaluation of the block, in 855This leaves the question of how to force reevaluation of the block,
792case the root background changes: Right now, all once blocks forget that 856in case the root background changes: If expression inside the block
793they ahve been executed before each time the root background changes (if 857is sensitive to some event (root background changes, window geometry
794the expression is sensitive to that) or when C<once_again> is called. 858changes), then it will be reevaluated automatically as needed.
795 859
796=item once_again 860=item once_again
797 861
798Resets 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
799next call they will be reevaluated again. 863next call they will be reevaluated again.
800 864
801=cut 865=cut
802 866
803 sub once(&) { 867 sub once(&) {
804 $_ONCE_CACHE{$_[0]+0} ||= $_[0]() 868 my $id = $_[0]+0;
869
870 local $frame = $self->{frame_cache}{$id} ||= [$frame];
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;
891 });
892 };
893
894 # in scalar context we always return the first original result, which
895 # is not quite how perl works.
896 wantarray
897 ? @{ $frame->[FR_CACHE] }
898 : $frame->[FR_CACHE][0]
805 } 899 }
806 900
807 sub once_again() { 901 sub once_again() {
808 %_ONCE_CACHE = (); 902 delete $self->{frame_cache};
809 } 903 }
810 904
811=back 905=back
812 906
813=cut 907=cut
814 908
815} 909}
816 910
817sub parse_expr { 911sub parse_expr {
818 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 . "}";
819 die if $@; 918 die if $@;
820 $expr 919 $expr
821} 920}
822 921
823# compiles a parsed expression 922# compiles a parsed expression
824sub set_expr { 923sub set_expr {
825 my ($self, $expr) = @_; 924 my ($self, $expr) = @_;
826 925
926 $self->{root} = [];
827 $self->{expr} = $expr; 927 $self->{expr} = $expr;
828 $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 }
829} 977}
830 978
831# evaluate the current bg expression 979# evaluate the current bg expression
832sub recalculate { 980sub recalculate {
833 my ($arg_self) = @_; 981 my ($arg_self) = @_;
… …
843 991
844 $arg_self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL; 992 $arg_self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL;
845 993
846 # set environment to evaluate user expression 994 # set environment to evaluate user expression
847 995
848 local $self = $arg_self; 996 local $self = $arg_self;
849
850 local $HOME = $ENV{HOME}; 997 local $HOME = $ENV{HOME};
851 local $old = $self->{state}; 998 local $frame = [];
852 local $new = my $state = $self->{state} = {};
853 999
854 ($x, $y, $w, $h) =
855 $self->background_geometry ($self->{border}); 1000 ($x, $y, $w, $h) = $self->background_geometry ($self->{border});
856 1001
857 # evaluate user expression 1002 # evaluate user expression
858 1003
859 my $img = eval { $self->{expr}->() }; 1004 my @img = eval { $self->{expr}->() };
860 warn $@ if $@;#d# 1005 die $@ if $@;
861 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;
862 1009
863 $state->{size_sensitive} = 1 1010 my $img = urxvt::bgdsl::merge @img;
1011
1012 $frame->[FR_AGAIN]{size} = 1
864 if $img->repeat_mode != urxvt::RepeatNormal; 1013 if $img->repeat_mode != urxvt::RepeatNormal;
865 1014
866 # if the expression is sensitive to external events, prepare reevaluation then 1015 # if the expression is sensitive to external events, prepare reevaluation then
867 1016 $self->compile_frame ($frame, sub { $arg_self->recalculate });
868 my $repeat;
869
870 if (my $again = $state->{again}) {
871 $repeat = 1;
872 my $self = $self;
873 $state->{timer} = $again == $old->{again}
874 ? $old->{timer}
875 : urxvt::timer->new->after ($again)->interval ($again)->cb (sub {
876 ++$self->{counter};
877 $self->recalculate
878 });
879 }
880
881 if (delete $state->{position_sensitive}) {
882 $repeat = 1;
883 $self->enable (position_change => sub { $_[0]->recalculate });
884 } else {
885 $self->disable ("position_change");
886 }
887
888 if (delete $state->{size_sensitive}) {
889 $repeat = 1;
890 $self->enable (size_change => sub { $_[0]->recalculate });
891 } else {
892 $self->disable ("size_change");
893 }
894
895 if (delete $state->{rootpmap_sensitive}) {
896 $repeat = 1;
897 $self->enable (rootpmap_change => sub { $_[0]->recalculate });
898 } else {
899 $self->disable ("rootpmap_change");
900 }
901 1017
902 # clear stuff we no longer need 1018 # clear stuff we no longer need
903 1019
904 %$old = (); 1020# unless (%{ $frame->[FR_STATE] }) {
905
906 unless ($repeat) {
907 delete $self->{state}; 1021# delete $self->{state};
908 delete $self->{expr}; 1022# delete $self->{expr};
909 } 1023# }
910 1024
911 # set background pixmap 1025 # set background pixmap
912 1026
913 $self->set_background ($img, $self->{border}); 1027 $self->set_background ($img, $self->{border});
914 $self->scr_recolour (0); 1028 $self->scr_recolour (0);

Diff Legend

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