[ViewVC] Diff of: cvs/rxvt-unicode/src/perl/background

Comparing rxvt-unicode/src/perl/background (file contents):
Revision 1.56 by root, Thu Jun 14 17:06:57 2012 UTC vs.
Revision 1.63 by root, Tue Jun 19 18:17:56 2012 UTC

…		…
138	pseudo-transparency, as the image seems to be static while the window is	138	pseudo-transparency, as the image seems to be static while the window is
139	moved around.	139	moved around.
140		140
141	=head2 CYCLES AND CACHING	141	=head2 CYCLES AND CACHING
142		142
		143	=head3 C<load> et al.
		144
143	As has been mentioned before, the expression might be evaluated multiple	145	As has been mentioned before, the expression might be evaluated multiple
144	times. Each time the expression is reevaluated, a new cycle is said to	146	times. Each time the expression is reevaluated, a new cycle is said to
145	have begun. Many operators cache their results till the next cycle.	147	have begun. Many operators cache their results till the next cycle.
146		148
147	For example, the C<load> operator keeps a copy of the image. If it is	149	For example, the C<load> operator keeps a copy of the image. If it is
…		…
171		173
172	Here, a path is selected randomly, and load is only called for one image,	174	Here, a path is selected randomly, and load is only called for one image,
173	so keeps only one image in memory. If, on the next evaluation, luck	175	so keeps only one image in memory. If, on the next evaluation, luck
174	decides to use the other path, then it will have to load that image again.	176	decides to use the other path, then it will have to load that image again.
175		177
		178	=head3 C<once { ... }>
		179
		180	Another way to cache expensive operations is to use C<once { ... }>. The
		181	C<once> operator takes a block of multiple statements enclosed by C<{}>
		182	and evaluates it only.. once, returning any images the last statement
		183	returned. Further calls simply produce the values from the cache.
		184
		185	This is most useful for expensive operations, such as C<blur>:
		186
		187	rootalign once { blur 20, root }
		188
		189	This makes a blurred copy of the root background once, and on subsequent
		190	calls, just root-aligns it. Since C<blur> is usually quite slow and
		191	C<rootalign> is quite fast, this trades extra memory (For the cached
		192	blurred pixmap) with speed (blur only needs to be redone when root
		193	changes).
		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
207	our %_IMG_CACHE;	226	our %_IMG_CACHE;
208	our $HOME;	227	our $HOME;
209	our ($self, $old, $new);	228	our ($self, $frame);
210	our ($x, $y, $w, $h);	229	our ($x, $y, $w, $h);
211		230
212	# enforce at least this interval between updates	231	# enforce at least this interval between updates
213	our $MIN_INTERVAL = 6/59.951;	232	our $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
…		…
231	mode.	255	mode.
232		256
233	Loaded images will be cached for one cycle, and shared between temrinals	257	Loaded images will be cached for one cycle, and shared between temrinals
234	running in the same process (e.g. in C<urxvtd>).	258	running in the same process (e.g. in C<urxvtd>).
235		259
236	=item load_uc $path	260	#=item load_uc $path
237		261	#
238	Load 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
239	is 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
240	way.	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
262	Returns the root window pixmap, that is, hopefully, the background image	280	Returns the root window pixmap, that is, hopefully, the background image
263	of your screen. The image is set to extend mode.	281	of your screen.
264		282
265	This function makes your expression root sensitive, that means it will be	283	This function makes your expression root sensitive, that means it will be
266	reevaluated when the bg image changes.	284	reevaluated 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
…		…
303	$_[0]->clone	321	$_[0]->clone
304	}	322	}
305		323
306	=item merge $img ...	324	=item merge $img ...
307		325
308	Takes any number of images and merges them together, creating a single image containing them all.	326	Takes any number of images and merges them together, creating a single
		327	image containing them all. The tiling mode of the first image is used as
		328	the tiling mdoe of the resulting image.
		329
		330	This function is called automatically when an expression returns multiple
		331	images.
309		332
310	=cut	333	=cut
311		334
312	sub merge(@) {	335	sub merge(@) {
313	#TODO	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
314	}	366	}
315		367
316	=head2 TILING MODES	368	=head2 TILING MODES
317		369
318	The following operators modify the tiling mode of an image, that is, the	370	The following operators modify the tiling mode of an image, that is, the
…		…
438		490
439	clip move -TX, -TY, once { blur 5, root }	491	clip move -TX, -TY, once { blur 5, root }
440		492
441	=cut	493	=cut
442		494
443	sub TX() { $new->{again}{position} = 1; $x }	495	sub TX() { $frame->[FR_AGAIN]{position} = 1; $x }
444	sub TY() { $new->{again}{position} = 1; $y }	496	sub TY() { $frame->[FR_AGAIN]{position} = 1; $y }
445	sub TW() { $new->{again}{size} = 1; $w }	497	sub TW() { $frame->[FR_AGAIN]{size} = 1; $w }
446	sub TH() { $new->{again}{size} = 1; $h }	498	sub TH() { $frame->[FR_AGAIN]{size} = 1; $h }
447		499
448	=item now	500	=item now
449		501
450	Returns the current time as (fractional) seconds since the epoch.	502	Returns the current time as (fractional) seconds since the epoch.
451		503
…		…
470	=cut	522	=cut
471		523
472	sub now() { urxvt::NOW }	524	sub now() { urxvt::NOW }
473		525
474	sub again($) {	526	sub again($) {
475	$new->{again}{time} = $_[0];	527	$frame->[FR_AGAIN]{time} = $_[0];
476	}	528	}
477		529
478	sub counter($) {	530	sub counter($) {
479	$new->{again}{time} = $_[0];	531	$frame->[FR_AGAIN]{time} = $_[0];
480	$self->{counter} + 0	532	$frame->[FR_STATE]{counter} + 0
481	}	533	}
482		534
483	=back	535	=back
484		536
485	=head2 SHAPE CHANGING OPERATORS	537	=head2 SHAPE CHANGING OPERATORS
…		…
670	=cut	722	=cut
671		723
672	sub rotate($$$$) {	724	sub rotate($$$$) {
673	my $img = pop;	725	my $img = pop;
674	$img->rotate (	726	$img->rotate (
675	$_[0] * $img->w,	727	$_[0] * ($img->w + $img->x),
676	$_[1] * $img->h,	728	$_[1] * ($img->h + $img->y),
677	$_[2] * (3.14159265 / 180),	729	$_[2] * (3.14159265 / 180),
678	)	730	)
679	}	731	}
680		732
681	=back	733	=back
…		…
785		837
786	The trick is that this code block is only evaluated once - future calls	838	The trick is that this code block is only evaluated once - future calls
787	will simply return the original image (yes, it should only be used with	839	will simply return the original image (yes, it should only be used with
788	images).	840	images).
789		841
790	This can be extremely useful to avoid redoign the same slow operations	842	This can be extremely useful to avoid redoing the same slow operations
791	again and again- for example, if your background expression takes the root	843	again and again- for example, if your background expression takes the root
792	background, blurs it and then root-aligns it it would have to blur the	844	background, blurs it and then root-aligns it it would have to blur the
793	root background on every window move or resize.	845	root background on every window move or resize.
794		846
		847	In fact, urxvt itself encloses the whole expression in some kind of
		848	C<once> block so it only is reevaluated as required.
		849
795	Putting the blur into a C<once> block will make sure the blur is only done	850	Putting the blur into a C<once> block will make sure the blur is only done
796	once:	851	once:
797		852
798	rootlign once { blur 10, root }	853	rootlign once { blur 10, root }
799		854
800	This leaves the question of how to force reevaluation of the block, in	855	This leaves the question of how to force reevaluation of the block,
801	case the root background changes: Right now, all once blocks forget that	856	in case the root background changes: If expression inside the block
802	they ahve been executed before each time the root background changes (if	857	is sensitive to some event (root background changes, window geometry
803	the expression is sensitive to that) or when C<once_again> is called.	858	changes), then it will be reevaluated automatically as needed.
804		859
805	=item once_again	860	=item once_again
806		861
807	Resets all C<once> block as if they had never been called, i.e. on the	862	Resets all C<once> block as if they had never been called, i.e. on the
808	next call they will be reevaluated again.	863	next call they will be reevaluated again.
809		864
810	=cut	865	=cut
811		866
812	sub once(&) {	867	sub once(&) {
813	my $once = $self->{once_cache}{$_[0]+0} \|\|= do {	868	my $id = $_[0]+0;
814	local $new->{again};	869
815	my @res = $_[0]();	870	local $frame = $self->{frame_cache}{$id} \|\|= [$frame];
816	[$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;
817	};	891	});
818
819	$new->{again} = {
820	%{ $new->{again} },
821	%{ $once->[0] }
822	};	892	};
823		893
824	# in scalar context we always return the first original result, which	894	# in scalar context we always return the first original result, which
825	# is not quite how perl works.	895	# is not quite how perl works.
826	wantarray	896	wantarray
827	? @{ $once->[1] }	897	? @{ $frame->[FR_CACHE] }
828	: $once->[1][0]	898	: $frame->[FR_CACHE][0]
829	}	899	}
830		900
831	sub once_again() {	901	sub once_again() {
832	delete $self->{once_cache};	902	delete $self->{frame_cache};
833	}	903	}
834		904
835	=back	905	=back
836		906
837	=cut	907	=cut
838		908
839	}	909	}
840		910
841	sub parse_expr {	911	sub parse_expr {
842	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	. "}";
843	die if $@;	918	die if $@;
844	$expr	919	$expr
845	}	920	}
846		921
847	# compiles a parsed expression	922	# compiles a parsed expression
848	sub set_expr {	923	sub set_expr {
849	my ($self, $expr) = @_;	924	my ($self, $expr) = @_;
850		925
		926	$self->{root} = [];
851	$self->{expr} = $expr;	927	$self->{expr} = $expr;
852	$self->recalculate;	928	$self->recalculate;
		929	}
		930
		931	# takes a hash of sensitivity indicators and installs watchers
		932	sub 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	}
853	}	977	}
854		978
855	# evaluate the current bg expression	979	# evaluate the current bg expression
856	sub recalculate {	980	sub recalculate {
857	my ($arg_self) = @_;	981	my ($arg_self) = @_;
…		…
867		991
868	$arg_self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL;	992	$arg_self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL;
869		993
870	# set environment to evaluate user expression	994	# set environment to evaluate user expression
871		995
872	local $self = $arg_self;	996	local $self = $arg_self;
873
874	local $HOME = $ENV{HOME};	997	local $HOME = $ENV{HOME};
875	local $old = $self->{state};	998	local $frame = [];
876	local $new = my $state = $self->{state} = {};
877		999
878	($x, $y, $w, $h) =
879	$self->background_geometry ($self->{border});	1000	($x, $y, $w, $h) = $self->background_geometry ($self->{border});
880		1001
881	# evaluate user expression	1002	# evaluate user expression
882		1003
883	my $img = eval { $self->{expr}->() };	1004	my @img = eval { $self->{expr}->() };
884	warn $@ if $@;#d#	1005	die $@ if $@;
885	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;
886		1014
887	# if the expression is sensitive to external events, prepare reevaluation then	1015	# if the expression is sensitive to external events, prepare reevaluation then
888		1016	$self->compile_frame ($frame, sub { $arg_self->recalculate });
889	my $again = delete $state->{again};
890
891	$again->{size} = 1
892	if $img->repeat_mode != urxvt::RepeatNormal;
893
894	if (my $again = $again->{time}) {
895	my $self = $self;
896	$state->{timer} = $again == $old->{again}
897	? $old->{timer}
898	: urxvt::timer->new->after ($again)->interval ($again)->cb (sub {
899	++$self->{counter};
900	$self->recalculate
901	});
902	}
903
904	if ($again->{position}) {
905	$self->enable (position_change => sub { $_[0]->recalculate });
906	} else {
907	$self->disable ("position_change");
908	}
909
910	if ($again->{size}) {
911	$self->enable (size_change => sub { $_[0]->recalculate });
912	} else {
913	$self->disable ("size_change");
914	}
915
916	if ($again->{rootpmap}) {
917	$self->enable (rootpmap_change => sub {
918	delete $_[0]{once_cache}; # this will override once-block values from
919	$_[0]->recalculate;
920	});
921	} else {
922	$self->disable ("rootpmap_change");
923	}
924		1017
925	# clear stuff we no longer need	1018	# clear stuff we no longer need
926		1019
927	%$old = ();	1020	# unless (%{ $frame->[FR_STATE] }) {
928
929	unless (%$again) {
930	delete $self->{state};	1021	# delete $self->{state};
931	delete $self->{expr};	1022	# delete $self->{expr};
932	}	1023	# }
933		1024
934	# set background pixmap	1025	# set background pixmap
935		1026
936	$self->set_background ($img, $self->{border});	1027	$self->set_background ($img, $self->{border});
937	$self->scr_recolour (0);	1028	$self->scr_recolour (0);

Diff Legend

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

Comparing rxvt-unicode/src/perl/background (file contents): Revision 1.56 by root, Thu Jun 14 17:06:57 2012 UTC vs. Revision 1.63 by root, Tue Jun 19 18:17:56 2012 UTC

Diff Legend

Comparing rxvt-unicode/src/perl/background (file contents):
Revision 1.56 by root, Thu Jun 14 17:06:57 2012 UTC vs.
Revision 1.63 by root, Tue Jun 19 18:17:56 2012 UTC