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

Comparing rxvt-unicode/src/perl/background (file contents):
Revision 1.8 by root, Tue Jun 5 14:07:47 2012 UTC vs.
Revision 1.32 by sf-exg, Thu Jun 7 13:56:27 2012 UTC

…		…
1	#! perl	1	#! perl
2		2
3	our $EXPR = 'move load "/root/pix/das_fette_schwein.jpg", repeat_wrap, X, Y';	3	#:META:X_RESOURCE:%.expr:string:background expression
		4	#:META:X_RESOURCE:%.enable:boolean:some boolean
		5	#:META:X_RESOURCE:%.extra.:value:extra config
		6
		7	our $EXPR;
		8	#$EXPR = 'move W * 0.1, -H * 0.1, resize W * 0.5, H * 0.5, repeat_none load "opensource.png"';
		9	$EXPR = 'move -TX, -TY, load "argb.png"';
4	$EXPR = '	10	#$EXPR = '
5	blur 10, 10,
6	rotate W, H, 50, 50, counter 1/60, repeat_mirror,	11	# rotate W, H, 50, 50, counter 1/59.95, repeat_mirror,
7	clip X, Y, W, H, repeat_mirror,	12	# clip X, Y, W, H, repeat_mirror,
8	load "/root/pix/das_fette_schwein.jpg"	13	# load "/root/pix/das_fette_schwein.jpg"
9	';	14	#';
		15	#$EXPR = 'solid "red"';
10	#$EXPR = 'blur root, 10, 10'	16	#$EXPR = 'blur root, 10, 10'
11	#$EXPR = 'blur move (root, -x, -y), 5, 5'	17	#$EXPR = 'blur move (root, -x, -y), 5, 5'
12	#resize load "/root/pix/das_fette_schwein.jpg", w, h	18	#resize load "/root/pix/das_fette_schwein.jpg", w, h
13		19
14	use Safe;	20	use Safe;
15		21
16	our ($bgdsl_self, $old, $new);	22	our ($bgdsl_self, $old, $new);
17	our ($l, $t, $w, $h);	23	our ($x, $y, $w, $h);
		24
		25	# enforce at least this interval between updates
		26	our $MIN_INTERVAL = 1/100;
18		27
19	{	28	{
20	package urxvt::bgdsl; # background language	29	package urxvt::bgdsl; # background language
21		30
22	*repeat_black = \&urxvt::RepeatNone; #TODO wtf	31	=head2 PROVIDERS/GENERATORS
23	*repeat_wrap = \&urxvt::RepeatNormal;	32
24	*repeat_pad = \&urxvt::RepeatPad;	33	These functions provide an image, by loading it from disk, grabbing it
25	*repeat_mirror = \&urxvt::RepeatReflect;	34	from the root screen or by simply generating it. They are used as starting
		35	points to get an image you can play with.
		36
		37	=over 4
		38
		39	=item load $path
		40
		41	Loads the image at the given C<$path>. The image is set to plane tiling
		42	mode.
		43
		44	Loaded images will be cached for one cycle.
		45
		46	=cut
26		47
27	sub load($) {	48	sub load($) {
28	my ($path) = @_;	49	my ($path) = @_;
29		50
30	$new->{load}{$path} = $old->{load}{$path} \|\| $bgdsl_self->new_img_from_file ($path);	51	$new->{load}{$path} = $old->{load}{$path} \|\| $bgdsl_self->new_img_from_file ($path);
31	}	52	}
32		53
		54	=item root
		55
		56	Returns the root window pixmap, that is, hopefully, the background image
		57	of your screen. The image is set to extend mode.
		58
		59	This function makes your expression root sensitive, that means it will be
		60	reevaluated when the bg image changes.
		61
		62	=cut
		63
33	sub root() {	64	sub root() {
		65	$new->{rootpmap_sensitive} = 1;
34	die "root op not supported, exg, we need you";	66	die "root op not supported, exg, we need you";
35	}	67	}
36		68
		69	=item solid $colour
		70
		71	=item solid $width, $height, $colour
		72
		73	Creates a new image and completely fills it with the given colour. The
		74	image is set to tiling mode.
		75
		76	If <$width> and C<$height> are omitted, it creates a 1x1 image, which is
		77	useful for solid backgrounds or for use in filtering effects.
		78
		79	=cut
		80
		81	sub solid($$;$) {
		82	my $colour = pop;
		83
		84	my $img = $bgdsl_self->new_img (urxvt::PictStandardARGB32, $_[0] \|\| 1, $_[1] \|\| 1);
		85	$img->fill ($colour);
		86	$img
		87	}
		88
		89	=back
		90
		91	=head2 VARIABLES
		92
		93	The following functions provide variable data such as the terminal
		94	window dimensions. Most of them make your expression sensitive to some
		95	events, for example using C<TW> (terminal width) means your expression is
		96	evaluated again when the terminal is resized.
		97
		98	=over 4
		99
		100	=item TX
		101
		102	=item TY
		103
		104	Return the X and Y coordinates of the terminal window (the terminal
		105	window is the full window by default, and the character area only when in
		106	border-respect mode).
		107
		108	Using these functions make your expression sensitive to window moves.
		109
		110	These functions are mainly useful to align images to the root window.
		111
		112	Example: load an image and align it so it looks as if anchored to the
		113	background.
		114
		115	move -TX, -TY, load "mybg.png"
		116
		117	=item TW
		118
		119	Return the width (C<TW>) and height (C<TH>) of the terminal window (the
		120	terminal window is the full window by default, and the character area only
		121	when in border-respect mode).
		122
		123	Using these functions make your expression sensitive to window resizes.
		124
		125	These functions are mainly useful to scale images, or to clip images to
		126	the window size to conserve memory.
		127
		128	Example: take the screen background, clip it to the window size, blur it a
		129	bit, align it to the window position and use it as background.
		130
		131	clip move -TX, -TY, blur 5, root
		132
		133	=cut
		134
		135	sub TX() { $new->{position_sensitive} = 1; $x }
		136	sub TY() { $new->{position_sensitive} = 1; $y }
		137	sub TW() { $new->{size_sensitive} = 1; $w }
		138	sub TH() { $new->{size_sensitive} = 1; $h }
		139
		140	sub now() { urxvt::NOW }
		141
		142	sub again($) {
		143	$new->{again} = $_[0];
		144	}
		145
		146	sub counter($) {
		147	$new->{again} = $_[0];
		148	$bgdsl_self->{counter} + 0
		149	}
		150
		151	=back
		152
		153	=head2 TILING MODES
		154
		155	The following operators modify the tiling mode of an image, that is, the
		156	way that pixels outside the image area are painted when the image is used.
		157
		158	=over 4
		159
		160	=item tile $img
		161
		162	Tiles the whole plane with the image and returns this new image - or in
		163	other words, it returns a copy of the image in plane tiling mode.
		164
		165	=item mirror $img
		166
		167	Similar to tile, but reflects the image each time it uses a new copy, so
		168	that top edges always touch top edges, right edges always touch right
		169	edges and so on (with normal tiling, left edges always touch right edges
		170	and top always touch bottom edges).
		171
		172	=item pad $img
		173
		174	Takes an image and modifies it so that all pixels outside the image area
		175	become transparent. This mode is most useful when you want to place an
		176	image over another image or the background colour while leaving all
		177	background pixels outside the image unchanged.
		178
		179	=item extend $img
		180
		181	Extends the image over the whole plane, using the closest pixel in the
		182	area outside the image. This mode is mostly useful when you more complex
		183	filtering operations and want the pixels outside the image to have the
		184	same values as the pixels near the edge.
		185
		186	=cut
		187
		188	sub pad($) {
		189	my $img = $_[0]->clone;
		190	$img->repeat_mode (urxvt::RepeatNone);
		191	$img
		192	}
		193
		194	sub tile($) {
		195	my $img = $_[0]->clone;
		196	$img->repeat_mode (urxvt::RepeatNormal);
		197	$img
		198	}
		199
		200	sub mirror($) {
		201	my $img = $_[0]->clone;
		202	$img->repeat_mode (urxvt::RepeatReflect);
		203	$img
		204	}
		205
		206	sub extend($) {
		207	my $img = $_[0]->clone;
		208	$img->repeat_mode (urxvt::RepeatPad);
		209	$img
		210	}
		211
		212	=back
		213
		214	=head2 PIXEL OPERATORS
		215
		216	The following operators modify the image pixels in various ways.
		217
		218	=over 4
		219
		220	=item clone $img
		221
		222	Returns an exact copy of the image.
		223
		224	=cut
		225
37	# sub clone($) {	226	sub clone($) {
38	# $_[0]->clone	227	$_[0]->clone
39	# }	228	}
40		229
		230	=item clip $img
		231
		232	=item clip $width, $height, $img
		233
		234	=item clip $x, $y, $width, $height, $img
		235
		236	Clips an image to the given rectangle. If the rectangle is outside the
		237	image area (e.g. when C<$x> or C<$y> are negative) or the rectangle is
		238	larger than the image, then the tiling mode defines how the extra pixels
		239	will be filled.
		240
		241	If C<$x> an C<$y> are missing, then C<0> is assumed for both.
		242
		243	If C<$width> and C<$height> are missing, then the window size will be
		244	assumed.
		245
		246	Example: load an image, blur it, and clip it to the window size to save
		247	memory.
		248
		249	clip blur 10, load "mybg.png"
		250
		251	=cut
		252
41	sub clip($$$$$;$) {	253	sub clip($;$$;$$) {
		254	my $img = pop;
42	my $img = pop;	255	my $h = pop \|\| TH;
		256	my $w = pop \|\| TW;
43	$img->sub_rect ($_[0], $_[1], $_[2], $_[3], $_[4])	257	$img->sub_rect ($_[0], $_[1], $w, $h)
		258	}
		259
		260	=item scale $img
		261
		262	=item scale $size_percent, $img
		263
		264	=item scale $width_percent, $height_percent, $img
		265
		266	Scales the image by the given percentages in horizontal
		267	(C<$width_percent>) and vertical (C<$height_percent>) direction.
		268
		269	If only one percentage is give, it is used for both directions.
		270
		271	If no percentages are given, scales the image to the window size without
		272	keeping aspect.
		273
		274	=item resize $width, $height, $img
		275
		276	Resizes the image to exactly C<$width> times C<$height> pixels.
		277
		278	=cut
		279
		280	#TODO: maximise, maximise_fill?
		281
		282	sub scale($$$) {
		283	my $img = pop;
		284
		285	@_ == 2 ? $img->scale ($_[0] * $img->w * 0.01, $_[1] * $img->h * 0.01)
		286	: @_ ? $img->scale ($_[0] * $img->w * 0.01, $_[0] * $img->h * 0.01)
		287	: $img->scale (TW, TH)
44	}	288	}
45		289
46	sub resize($$$) {	290	sub resize($$$) {
47	my $img = pop;	291	my $img = pop;
48	$img->scale ($_[0], $_[1])	292	$img->scale ($_[0], $_[1])
49	}	293	}
50		294
51	# TODO: ugly
52	sub move($$;$) {	295	sub move($$;$) {
53	my $img = pop;	296	my $img = pop->clone;
54	$img->sub_rect (	297	$img->move ($_[0], $_[1]);
55	$_[0], $_[1],	298	$img
56	$img->w, $img->h,
57	$_[2],
58	)
59	}	299	}
60		300
61	sub rotate($$$$$$;$) {	301	sub rotate($$$$$$) {
62	my $img = pop;	302	my $img = pop;
63	$img->rotate (	303	$img->rotate (
64	$_[0],	304	$_[0],
65	$_[1],	305	$_[1],
66	$_[2] * $img->w * .01,	306	$_[2] * $img->w * .01,
67	$_[3] * $img->h * .01,	307	$_[3] * $img->h * .01,
68	$_[4] * (3.14159265 / 180),	308	$_[4] * (3.14159265 / 180),
69	$_[5],
70	)	309	)
71	}	310	}
72		311
73	sub blur($$$) {	312	sub blur($$;$) {
74	my ($rh, $rv, $img) = @_;	313	my $img = pop;
75		314	$img->blur ($_[0], @_ >= 2 ? $_[1] : $_[0])
76	$img = $img->clone;
77	$img->blur ($rh, $rv);
78	$img
79	}	315	}
80		316
81	sub contrast($$;$$;$) {	317	sub contrast($$;$$;$) {
82	my $img = pop;	318	my $img = pop;
83	my ($r, $g, $b, $a) = @_;	319	my ($r, $g, $b, $a) = @_;
100	$img = $img->clone;	336	$img = $img->clone;
101	$img->brightness ($r, $g, $b, $a);	337	$img->brightness ($r, $g, $b, $a);
102	$img	338	$img
103	}	339	}
104		340
105	sub X() { $new->{position_sensitive} = 1; $l }	341	=back
106	sub Y() { $new->{position_sensitive} = 1; $t }
107	sub W() { $new->{size_sensitive} = 1; $w }
108	sub H() { $new->{size_sensitive} = 1; $h }
109		342
110	sub now() { urxvt::NOW }	343	=cut
111		344
112	sub again($) {
113	$new->{again} = $_[0];
114	}
115
116	sub counter($) {
117	$new->{again} = $_[0];
118	$bgdsl_self->{counter} + 0
119	}
120	}	345	}
121		346
122	sub parse_expr {	347	sub parse_expr {
123	my $expr = eval "sub {\npackage urxvt::bgdsl;\n#line 0 'background expression'\n$_[0]\n}";	348	my $expr = eval "sub {\npackage urxvt::bgdsl;\n#line 0 'background expression'\n$_[0]\n}";
124	die if $@;	349	die if $@;
…		…
135		360
136	# evaluate the current bg expression	361	# evaluate the current bg expression
137	sub recalculate {	362	sub recalculate {
138	my ($self) = @_;	363	my ($self) = @_;
139		364
140	#TODO: rate limit calls	365	# rate limit evaluation
		366
		367	if ($self->{next_refresh} > urxvt::NOW) {
		368	$self->{next_refresh_timer} = urxvt::timer->new->after ($self->{next_refresh} - urxvt::NOW)->cb (sub {
		369	$self->recalculate;
		370	});
		371	return;
		372	}
		373
		374	$self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL;
		375
		376	# set environment to evaluate user expression
141		377
142	local $bgdsl_self = $self;	378	local $bgdsl_self = $self;
143		379
144	local $old = $self->{state};	380	local $old = $self->{state};
145	local $new = my $state = $self->{state} = {};	381	local $new = my $state = $self->{state} = {};
146		382
		383	my $border = 0; #d#
		384
147	($l, $t, $w, $h) =	385	($x, $y, $w, $h) =
148	$self->get_geometry;	386	$self->background_geometry ($border);
		387
		388	# evaluate user expression
149		389
150	my $img = eval { $self->{expr}->() };	390	my $img = eval { $self->{expr}->() };
151	warn $@ if $@;#d#	391	warn $@ if $@;#d#
		392	die if !UNIVERSAL::isa $img, "urxvt::img";
		393
		394	# if the expression is sensitive to external events, prepare reevaluation then
152		395
153	my $repeat;	396	my $repeat;
154		397
155	if (my $again = $state->{again}) {	398	if (my $again = $state->{again}) {
156	$repeat = 1;	399	$repeat = 1;
…		…
174	$self->enable (size_change => sub { $_[0]->recalculate });	417	$self->enable (size_change => sub { $_[0]->recalculate });
175	} else {	418	} else {
176	$self->disable ("size_change");	419	$self->disable ("size_change");
177	}	420	}
178		421
		422	if (delete $state->{rootpmap_sensitive}) {
		423	$repeat = 1;
		424	$self->enable (rootpmap_change => sub { $_[0]->recalculate });
		425	} else {
		426	$self->disable ("rootpmap_change");
		427	}
		428
		429	# clear stuff we no longer need
		430
179	%$old = ();	431	%$old = ();
180		432
181	unless ($repeat) {	433	unless ($repeat) {
182	delete $self->{state};	434	delete $self->{state};
183	delete $self->{expr};	435	delete $self->{expr};
184	}	436	}
185		437
		438	# prepare and set background pixmap
		439
186	$img = $img->sub_rect (0, 0, $w, $h)	440	$img = $img->sub_rect (0, 0, $w, $h)
187	if $img->w != $w \|\| $img->h != $h;	441	if $img->w != $w \|\| $img->h != $h;
188		442
189	$self->set_background ($img);	443	$self->set_background ($img, $border);
190	$self->scr_recolour (0);	444	$self->scr_recolour (0);
191	$self->want_refresh;	445	$self->want_refresh;
192	}	446	}
193		447
194	sub on_start {	448	sub on_start {

Diff Legend

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

Comparing rxvt-unicode/src/perl/background (file contents): Revision 1.8 by root, Tue Jun 5 14:07:47 2012 UTC vs. Revision 1.32 by sf-exg, Thu Jun 7 13:56:27 2012 UTC

Diff Legend

Comparing rxvt-unicode/src/perl/background (file contents):
Revision 1.8 by root, Tue Jun 5 14:07:47 2012 UTC vs.
Revision 1.32 by sf-exg, Thu Jun 7 13:56:27 2012 UTC