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

Comparing rxvt-unicode/src/perl/background (file contents):
Revision 1.7 by root, Tue Jun 5 14:04:58 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	rotate W, H, 50, 50, counter 1/60, repeat_mirror,	11	# rotate W, H, 50, 50, counter 1/59.95, repeat_mirror,
6	clip X, Y, W, H, repeat_mirror,	12	# clip X, Y, W, H, repeat_mirror,
7	load "/root/pix/das_fette_schwein.jpg"	13	# load "/root/pix/das_fette_schwein.jpg"
8	';	14	#';
		15	#$EXPR = 'solid "red"';
9	#$EXPR = 'blur root, 10, 10'	16	#$EXPR = 'blur root, 10, 10'
10	#$EXPR = 'blur move (root, -x, -y), 5, 5'	17	#$EXPR = 'blur move (root, -x, -y), 5, 5'
11	#resize load "/root/pix/das_fette_schwein.jpg", w, h	18	#resize load "/root/pix/das_fette_schwein.jpg", w, h
12		19
13	use Safe;	20	use Safe;
14		21
15	our ($bgdsl_self, $old, $new);	22	our ($bgdsl_self, $old, $new);
16	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;
17		27
18	{	28	{
19	package urxvt::bgdsl; # background language	29	package urxvt::bgdsl; # background language
20		30
21	*repeat_black = \&urxvt::RepeatNone; #TODO wtf	31	=head2 PROVIDERS/GENERATORS
22	*repeat_wrap = \&urxvt::RepeatNormal;	32
23	*repeat_pad = \&urxvt::RepeatPad;	33	These functions provide an image, by loading it from disk, grabbing it
24	*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
25		47
26	sub load($) {	48	sub load($) {
27	my ($path) = @_;	49	my ($path) = @_;
28		50
29	$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);
30	}	52	}
31		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
32	sub root() {	64	sub root() {
		65	$new->{rootpmap_sensitive} = 1;
33	die "root op not supported, exg, we need you";	66	die "root op not supported, exg, we need you";
34	}	67	}
35		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
36	# sub clone($) {	226	sub clone($) {
37	# $_[0]->clone	227	$_[0]->clone
38	# }	228	}
39		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
40	sub clip($$$$$;$) {	253	sub clip($;$$;$$) {
		254	my $img = pop;
41	my $img = pop;	255	my $h = pop \|\| TH;
		256	my $w = pop \|\| TW;
42	$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)
43	}	288	}
44		289
45	sub resize($$$) {	290	sub resize($$$) {
46	my $img = pop;	291	my $img = pop;
47	$img->scale ($_[0], $_[1])	292	$img->scale ($_[0], $_[1])
48	}	293	}
49		294
50	# TODO: ugly
51	sub move($$;$) {	295	sub move($$;$) {
52	my $img = pop;	296	my $img = pop->clone;
53	$img->sub_rect (	297	$img->move ($_[0], $_[1]);
54	$_[0], $_[1],	298	$img
55	$img->w, $img->h,
56	$_[2],
57	)
58	}	299	}
59		300
60	sub rotate($$$$$$;$) {	301	sub rotate($$$$$$) {
61	my $img = pop;	302	my $img = pop;
62	$img->rotate (	303	$img->rotate (
63	$_[0],	304	$_[0],
64	$_[1],	305	$_[1],
65	$_[2] * $img->w * .01,	306	$_[2] * $img->w * .01,
66	$_[3] * $img->h * .01,	307	$_[3] * $img->h * .01,
67	$_[4] * (3.14159265 / 180),	308	$_[4] * (3.14159265 / 180),
68	$_[5],
69	)	309	)
70	}	310	}
71		311
72	sub blur($$$) {	312	sub blur($$;$) {
73	my ($rh, $rv, $img) = @_;	313	my $img = pop;
74		314	$img->blur ($_[0], @_ >= 2 ? $_[1] : $_[0])
75	$img = $img->clone;
76	$img->blur ($rh, $rv);
77	$img
78	}	315	}
79		316
80	sub contrast($$;$$;$) {	317	sub contrast($$;$$;$) {
81	my $img = pop;	318	my $img = pop;
82	my ($r, $g, $b, $a) = @_;	319	my ($r, $g, $b, $a) = @_;
99	$img = $img->clone;	336	$img = $img->clone;
100	$img->brightness ($r, $g, $b, $a);	337	$img->brightness ($r, $g, $b, $a);
101	$img	338	$img
102	}	339	}
103		340
104	sub X() { $new->{position_sensitive} = 1; $l }	341	=back
105	sub Y() { $new->{position_sensitive} = 1; $t }
106	sub W() { $new->{size_sensitive} = 1; $w }
107	sub H() { $new->{size_sensitive} = 1; $h }
108		342
109	sub now() { urxvt::NOW }	343	=cut
110		344
111	sub again($) {
112	$new->{again} = $_[0];
113	}
114
115	sub counter($) {
116	$new->{again} = $_[0];
117	$bgdsl_self->{counter} + 0
118	}
119	}	345	}
120		346
121	sub parse_expr {	347	sub parse_expr {
122	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}";
123	die if $@;	349	die if $@;
…		…
134		360
135	# evaluate the current bg expression	361	# evaluate the current bg expression
136	sub recalculate {	362	sub recalculate {
137	my ($self) = @_;	363	my ($self) = @_;
138		364
139	#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
140		377
141	local $bgdsl_self = $self;	378	local $bgdsl_self = $self;
142		379
143	local $old = $self->{state};	380	local $old = $self->{state};
144	local $new = my $state = $self->{state} = {};	381	local $new = my $state = $self->{state} = {};
145		382
		383	my $border = 0; #d#
		384
146	($l, $t, $w, $h) =	385	($x, $y, $w, $h) =
147	$self->get_geometry;	386	$self->background_geometry ($border);
		387
		388	# evaluate user expression
148		389
149	my $img = eval { $self->{expr}->() };	390	my $img = eval { $self->{expr}->() };
150	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
151		395
152	my $repeat;	396	my $repeat;
153		397
154	if (my $again = $state->{again}) {	398	if (my $again = $state->{again}) {
155	$repeat = 1;	399	$repeat = 1;
…		…
173	$self->enable (size_change => sub { $_[0]->recalculate });	417	$self->enable (size_change => sub { $_[0]->recalculate });
174	} else {	418	} else {
175	$self->disable ("size_change");	419	$self->disable ("size_change");
176	}	420	}
177		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
178	%$old = ();	431	%$old = ();
179		432
180	unless ($repeat) {	433	unless ($repeat) {
181	delete $self->{state};	434	delete $self->{state};
182	delete $self->{expr};	435	delete $self->{expr};
183	}	436	}
184		437
		438	# prepare and set background pixmap
		439
185	$img = $img->sub_rect (0, 0, $w, $h)	440	$img = $img->sub_rect (0, 0, $w, $h)
186	if $img->w != $w \|\| $img->h != $h;	441	if $img->w != $w \|\| $img->h != $h;
187		442
188	$self->set_background ($img);	443	$self->set_background ($img, $border);
189	$self->scr_recolour (0);	444	$self->scr_recolour (0);
190	$self->want_refresh;	445	$self->want_refresh;
191	}	446	}
192		447
193	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.7 by root, Tue Jun 5 14:04:58 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.7 by root, Tue Jun 5 14:04:58 2012 UTC vs.
Revision 1.32 by sf-exg, Thu Jun 7 13:56:27 2012 UTC