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

Comparing rxvt-unicode/src/perl/background (file contents):
Revision 1.57 by root, Thu Jun 14 18:06:15 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
…		…
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	326	Takes any number of images and merges them together, creating a single
309	image containing them all.	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.
310		332
311	=cut	333	=cut
312		334
313	sub merge(@) {	335	sub merge(@) {
314	#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
315	}	366	}
316		367
317	=head2 TILING MODES	368	=head2 TILING MODES
318		369
319	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
…		…
439		490
440	clip move -TX, -TY, once { blur 5, root }	491	clip move -TX, -TY, once { blur 5, root }
441		492
442	=cut	493	=cut
443		494
444	sub TX() { $new->{again}{position} = 1; $x }	495	sub TX() { $frame->[FR_AGAIN]{position} = 1; $x }
445	sub TY() { $new->{again}{position} = 1; $y }	496	sub TY() { $frame->[FR_AGAIN]{position} = 1; $y }
446	sub TW() { $new->{again}{size} = 1; $w }	497	sub TW() { $frame->[FR_AGAIN]{size} = 1; $w }
447	sub TH() { $new->{again}{size} = 1; $h }	498	sub TH() { $frame->[FR_AGAIN]{size} = 1; $h }
448		499
449	=item now	500	=item now
450		501
451	Returns the current time as (fractional) seconds since the epoch.	502	Returns the current time as (fractional) seconds since the epoch.
452		503
…		…
471	=cut	522	=cut
472		523
473	sub now() { urxvt::NOW }	524	sub now() { urxvt::NOW }
474		525
475	sub again($) {	526	sub again($) {
476	$new->{again}{time} = $_[0];	527	$frame->[FR_AGAIN]{time} = $_[0];
477	}	528	}
478		529
479	sub counter($) {	530	sub counter($) {
480	$new->{again}{time} = $_[0];	531	$frame->[FR_AGAIN]{time} = $_[0];
481	$self->{counter} + 0	532	$frame->[FR_STATE]{counter} + 0
482	}	533	}
483		534
484	=back	535	=back
485		536
486	=head2 SHAPE CHANGING OPERATORS	537	=head2 SHAPE CHANGING OPERATORS
…		…
671	=cut	722	=cut
672		723
673	sub rotate($$$$) {	724	sub rotate($$$$) {
674	my $img = pop;	725	my $img = pop;
675	$img->rotate (	726	$img->rotate (
676	$_[0] * $img->w,	727	$_[0] * ($img->w + $img->x),
677	$_[1] * $img->h,	728	$_[1] * ($img->h + $img->y),
678	$_[2] * (3.14159265 / 180),	729	$_[2] * (3.14159265 / 180),
679	)	730	)
680	}	731	}
681		732
682	=back	733	=back
…		…
786		837
787	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
788	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
789	images).	840	images).
790		841
791	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
792	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
793	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
794	root background on every window move or resize.	845	root background on every window move or resize.
795		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
796	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
797	once:	851	once:
798		852
799	rootlign once { blur 10, root }	853	rootlign once { blur 10, root }
800		854
801	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,
802	case the root background changes: Right now, all once blocks forget that	856	in case the root background changes: If expression inside the block
803	they ahve been executed before each time the root background changes (if	857	is sensitive to some event (root background changes, window geometry
804	the expression is sensitive to that) or when C<once_again> is called.	858	changes), then it will be reevaluated automatically as needed.
805		859
806	=item once_again	860	=item once_again
807		861
808	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
809	next call they will be reevaluated again.	863	next call they will be reevaluated again.
810		864
811	=cut	865	=cut
812		866
813	sub once(&) {	867	sub once(&) {
814	my $once = $self->{once_cache}{$_[0]+0} \|\|= do {	868	my $id = $_[0]+0;
815	local $new->{again};	869
816	my @res = $_[0]();	870	local $frame = $self->{frame_cache}{$id} \|\|= [$frame];
817	[$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;
818	};	891	});
819
820	$new->{again} = {
821	%{ $new->{again} },
822	%{ $once->[0] }
823	};	892	};
824		893
825	# in scalar context we always return the first original result, which	894	# in scalar context we always return the first original result, which
826	# is not quite how perl works.	895	# is not quite how perl works.
827	wantarray	896	wantarray
828	? @{ $once->[1] }	897	? @{ $frame->[FR_CACHE] }
829	: $once->[1][0]	898	: $frame->[FR_CACHE][0]
830	}	899	}
831		900
832	sub once_again() {	901	sub once_again() {
833	delete $self->{once_cache};	902	delete $self->{frame_cache};
834	}	903	}
835		904
836	=back	905	=back
837		906
838	=cut	907	=cut
839		908
840	}	909	}
841		910
842	sub parse_expr {	911	sub parse_expr {
843	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	. "}";
844	die if $@;	918	die if $@;
845	$expr	919	$expr
846	}	920	}
847		921
848	# compiles a parsed expression	922	# compiles a parsed expression
849	sub set_expr {	923	sub set_expr {
850	my ($self, $expr) = @_;	924	my ($self, $expr) = @_;
851		925
		926	$self->{root} = [];
852	$self->{expr} = $expr;	927	$self->{expr} = $expr;
853	$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	}
854	}	977	}
855		978
856	# evaluate the current bg expression	979	# evaluate the current bg expression
857	sub recalculate {	980	sub recalculate {
858	my ($arg_self) = @_;	981	my ($arg_self) = @_;
…		…
868		991
869	$arg_self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL;	992	$arg_self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL;
870		993
871	# set environment to evaluate user expression	994	# set environment to evaluate user expression
872		995
873	local $self = $arg_self;	996	local $self = $arg_self;
874
875	local $HOME = $ENV{HOME};	997	local $HOME = $ENV{HOME};
876	local $old = $self->{state};	998	local $frame = [];
877	local $new = my $state = $self->{state} = {};
878		999
879	($x, $y, $w, $h) =
880	$self->background_geometry ($self->{border});	1000	($x, $y, $w, $h) = $self->background_geometry ($self->{border});
881		1001
882	# evaluate user expression	1002	# evaluate user expression
883		1003
884	my $img = eval { $self->{expr}->() };	1004	my @img = eval { $self->{expr}->() };
885	warn $@ if $@;#d#	1005	die $@ if $@;
886	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;
887		1014
888	# if the expression is sensitive to external events, prepare reevaluation then	1015	# if the expression is sensitive to external events, prepare reevaluation then
889		1016	$self->compile_frame ($frame, sub { $arg_self->recalculate });
890	my $again = delete $state->{again};
891
892	$again->{size} = 1
893	if $img->repeat_mode != urxvt::RepeatNormal;
894
895	if (my $again = $again->{time}) {
896	my $self = $self;
897	$state->{timer} = $again == $old->{again}
898	? $old->{timer}
899	: urxvt::timer->new->after ($again)->interval ($again)->cb (sub {
900	++$self->{counter};
901	$self->recalculate
902	});
903	}
904
905	if ($again->{position}) {
906	$self->enable (position_change => sub { $_[0]->recalculate });
907	} else {
908	$self->disable ("position_change");
909	}
910
911	if ($again->{size}) {
912	$self->enable (size_change => sub { $_[0]->recalculate });
913	} else {
914	$self->disable ("size_change");
915	}
916
917	if ($again->{rootpmap}) {
918	$self->enable (rootpmap_change => sub {
919	delete $_[0]{once_cache}; # this will override once-block values from
920	$_[0]->recalculate;
921	});
922	} else {
923	$self->disable ("rootpmap_change");
924	}
925		1017
926	# clear stuff we no longer need	1018	# clear stuff we no longer need
927		1019
928	%$old = ();	1020	# unless (%{ $frame->[FR_STATE] }) {
929
930	unless (%$again) {
931	delete $self->{state};	1021	# delete $self->{state};
932	delete $self->{expr};	1022	# delete $self->{expr};
933	}	1023	# }
934		1024
935	# set background pixmap	1025	# set background pixmap
936		1026
937	$self->set_background ($img, $self->{border});	1027	$self->set_background ($img, $self->{border});
938	$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.57 by root, Thu Jun 14 18:06:15 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.57 by root, Thu Jun 14 18:06:15 2012 UTC vs.
Revision 1.63 by root, Tue Jun 19 18:17:56 2012 UTC