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

Comparing rxvt-unicode/src/perl/background (file contents):
Revision 1.1 by root, Mon Jun 4 21:39:56 2012 UTC vs.
Revision 1.28 by root, Thu Jun 7 12:56:27 2012 UTC

…		…
1	#! perl	1	#! perl
2		2
3	our $EXPR = 'resize (blur (load "/root/pix/das_fette_schwein.jpg", 1 + (counter 1) % 10, 10), w, h)';	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 = 'border; move -X, -Y, load "argb.png"';
		10	#$EXPR = '
		11	# rotate W, H, 50, 50, counter 1/59.95, repeat_mirror,
		12	# clip X, Y, W, H, repeat_mirror,
		13	# load "/root/pix/das_fette_schwein.jpg"
		14	#';
		15	#$EXPR = 'solid "red"';
4	#$EXPR = 'blur root, 10, 10'	16	#$EXPR = 'blur root, 10, 10'
5	#$EXPR = 'blur move (root, -x, -y), 5, 5'	17	#$EXPR = 'blur move (root, -x, -y), 5, 5'
6	#resize load "/root/pix/das_fette_schwein.jpg", w, h	18	#resize load "/root/pix/das_fette_schwein.jpg", w, h
7		19
8	use Safe;	20	use Safe;
9		21
		22	our $border;
		23	our ($bgdsl_self, $old, $new);
		24	our ($l, $t, $w, $h);
		25
		26	# enforce at least this interval between updates
		27	our $MIN_INTERVAL = 1/100;
		28
10	{	29	{
11	package urxvt::bgdsl::vars;
12
13	our ($self, $old, $new);
14	our ($x, $y, $w, $h);
15
16	package urxvt::bgdsl; # background language	30	package urxvt::bgdsl; # background language
17		31
18	*repeat_black = \&urxvt::RepeatNone; #TODO wtf	32	# *repeat_empty = \&urxvt::RepeatNone;
19	*repeat_wrap = \&urxvt::RepeatNormal;	33	# *repeat_tile = \&urxvt::RepeatNormal;
20	*repeat_pad = \&urxvt::RepeatPad;	34	# *repeat_pad = \&urxvt::RepeatPad;
21	*repeat_mirror = \&urxvt::RepeatReflect;	35	# *repeat_mirror = \&urxvt::RepeatReflect;
22		36
		37	=head2 PROVIDERS/GENERATORS
		38
		39	=over 4
		40
		41	=item load $path
		42
		43	=cut
		44
23	sub load {	45	sub load($) {
24	my ($path) = @_;	46	my ($path) = @_;
25		47
26	$new->{load}{$path} = $old->{load}{$path} \|\| $self->new_img_from_file ($path);	48	$new->{load}{$path} = $old->{load}{$path} \|\| $bgdsl_self->new_img_from_file ($path);
27	}	49	}
28		50
29	sub root {	51	sub root() {
		52	$new->{rootpmap_sensitive} = 1;
30	die "root op not supported, exg, we need you";	53	die "root op not supported, exg, we need you";
31	}	54	}
32		55
		56	sub solid($;$$) {
		57	my $img = $bgdsl_self->new_img (urxvt::PictStandardARGB32, $_[1] \|\| 1, $_[2] \|\| 1);
		58	$img->fill ($_[0]);
		59	$img
		60	}
		61
		62	=back
		63
		64	=head2 VARIABLES
		65
		66	=over 4
		67
		68	=cut
		69
		70	sub X() { $new->{position_sensitive} = 1; $l }
		71	sub Y() { $new->{position_sensitive} = 1; $t }
		72	sub W() { $new->{size_sensitive} = 1; $w }
		73	sub H() { $new->{size_sensitive} = 1; $h }
		74
		75	sub now() { urxvt::NOW }
		76
		77	sub again($) {
		78	$new->{again} = $_[0];
		79	}
		80
		81	sub counter($) {
		82	$new->{again} = $_[0];
		83	$bgdsl_self->{counter} + 0
		84	}
		85
		86	=back
		87
		88	=head2 TILING MODES
		89
		90	The following operators modify the tiling mode of an image, that is, the
		91	way that pixels outside the image area are painted when the image is used.
		92
		93	=over 4
		94
		95	=item tile $img
		96
		97	Tiles the whole plane with the image and returns this new image - or in
		98	other words, it returns a copy of the image in plane tiling mode.
		99
		100	=item mirror $img
		101
		102	Similar to tile, but reflects the image each time it uses a new copy, so
		103	that top edges always touch top edges, right edges always touch right
		104	edges and so on (with normal tiling, left edges always touch right edges
		105	and top always touch bottom edges).
		106
		107	=item pad $img
		108
		109	Takes an image and modifies it so that all pixels outside the image area
		110	become transparent. This mode is most useful when you want to place an
		111	image over another image or the background colour while leaving all
		112	background pixels outside the image unchanged.
		113
		114	=item extend $img
		115
		116	Extends the image over the whole plane, using the closest pixel in the
		117	area outside the image. This mode is mostly useful when you more complex
		118	filtering operations and want the pixels outside the image to have the
		119	same values as the pixels near the edge.
		120
		121	=cut
		122
		123	sub pad($) {
		124	my $img = $_[0]->clone;
		125	$img->repeat_mode (urxvt::RepeatNone);
		126	$img
		127	}
		128
		129	sub tile($) {
		130	my $img = $_[0]->clone;
		131	$img->repeat_mode (urxvt::RepeatNormal);
		132	$img
		133	}
		134
		135	sub mirror($) {
		136	my $img = $_[0]->clone;
		137	$img->repeat_mode (urxvt::RepeatReflect);
		138	$img
		139	}
		140
		141	sub extend($) {
		142	my $img = $_[0]->clone;
		143	$img->repeat_mode (urxvt::RepeatPad);
		144	$img
		145	}
		146
		147	=back
		148
		149	=head2 PIXEL OPERATORS
		150
		151	The following operators modify the image pixels in various ways.
		152
		153	=over 4
		154
		155	=item clone $img
		156
		157	Returns an exact copy of the image.
		158
		159	=cut
		160
		161	sub clone($) {
		162	$_[0]->clone
		163	}
		164
		165	=item clip $img
		166
		167	=item clip $width, $height, $img
		168
		169	=item clip $x, $y, $width, $height, $img
		170
		171	Clips an image to the given rectangle. If the rectangle is outside the
		172	image area (e.g. when C<$x> or C<$y> are negative) or the rectangle is
		173	larger than the image, then the tiling mode defines how the extra pixels
		174	will be filled.
		175
		176	If C<$x> an C<$y> are missing, then C<0> is assumed for both.
		177
		178	If C<$width> and C<$height> are missing, then the window size will be
		179	assumed.
		180
		181	Example: load an image, blur it, and clip it to the window size to save
		182	memory.
		183
		184	clip blur 10, load "mybg.png"
		185
		186	=cut
		187
		188	sub clip($;$$;$$) {
		189	my $img = pop;
		190	my $h = pop \|\| H;
		191	my $w = pop \|\| W;
		192	$img->sub_rect ($_[0], $_[1], $w, $h)
		193	}
		194
		195	=item scale $img
		196
		197	=item scale $size_percent, $img
		198
		199	=item scale $width_percent, $height_percent, $img
		200
		201	Scales the image by the given percentages in horizontal
		202	(C<$width_percent>) and vertical (C<$height_percent>) direction.
		203
		204	If only one percentage is give, it is used for both directions.
		205
		206	If no percentages are given, scales the image to the window size without
		207	keeping aspect.
		208
		209	=item resize $width, $height, $img
		210
		211	Resizes the image to exactly C<$width> times C<$height> pixels.
		212
		213	=cut
		214
		215	#TODO: maximise, maximise_fill?
		216
		217	sub scale($$$) {
		218	my $img = pop;
		219
		220	@_ == 2 ? $img->scale ($_[0] * $img->w * 0.01, $_[1] * $img->h * 0.01)
		221	: @_ ? $img->scale ($_[0] * $img->w * 0.01, $_[0] * $img->h * 0.01)
		222	: $img->scale (W, H)
		223	}
		224
33	sub resize {	225	sub resize($$$) {
34	$_[0]->scale ($_[1], $_[2])	226	my $img = pop;
		227	$img->scale ($_[0], $_[1])
35	}	228	}
36		229
		230	# TODO: ugly
37	sub move {	231	sub move($$;$) {
38	# TODO: must be simpler	232	my $img = pop->clone;
39	$_[0]->transform ($_[0]->w, $_[0]->h, $_[1],	233	$img->move ($_[0], $_[1]);
		234	$img
		235	# my $img = pop;
		236	# $img->sub_rect (
		237	# $_[0], $_[1],
		238	# $img->w, $img->h,
		239	# $_[2],
		240	# )
		241	}
		242
		243	sub rotate($$$$$$) {
		244	my $img = pop;
		245	$img->rotate (
40	1, 0, -$_[2],	246	$_[0],
41	0, 1, -$_[3],	247	$_[1],
42	0, 0, 1,	248	$_[2] * $img->w * .01,
		249	$_[3] * $img->h * .01,
		250	$_[4] * (3.14159265 / 180),
43	)	251	)
44	}	252	}
45		253
46	sub rotate {
47	$_[0]->rotate ($_[0], $_[1], $_[2], $_[3] * (3.14159265 / 180))
48	}
49
50	sub blur {	254	sub blur($$;$) {
51	my ($img, $rh, $rv) = @_;	255	my $img = pop;
52		256
53	$img = $img->clone;	257	$img->blur ($_[0], @_ >= 2 ? $_[1] : $_[0]);
54	$img->clone->blur ($rh, $rv);
55	$img
56	}	258	}
57		259
58	sub contrast {	260	sub contrast($$;$$;$) {
		261	my $img = pop;
59	my ($img, $r, $g, $b, $a) = @_;	262	my ($r, $g, $b, $a) = @_;
		263
60	($g, $b) = ($r, $r) if @_ < 4;	264	($g, $b) = ($r, $r) if @_ < 4;
61	$a = 1 if @_ < 5;	265	$a = 1 if @_ < 5;
		266
62	$img = $img->clone;	267	$img = $img->clone;
63	$img->contrast ($r, $g, $b, $a);	268	$img->contrast ($r, $g, $b, $a);
64	$img	269	$img
65	}	270	}
66		271
67	sub brightness {	272	sub brightness($$;$$;$) {
		273	my $img = pop;
68	my ($img, $r, $g, $b, $a) = @_;	274	my ($r, $g, $b, $a) = @_;
		275
69	($g, $b) = ($r, $r) if @_ < 4;	276	($g, $b) = ($r, $r) if @_ < 4;
70	$a = 1 if @_ < 5;	277	$a = 1 if @_ < 5;
		278
71	$img = $img->clone;	279	$img = $img->clone;
72	$img->brightness ($r, $g, $b, $a);	280	$img->brightness ($r, $g, $b, $a);
73	$img	281	$img
74	}	282	}
75		283
76	sub x { $new->{position_sensitive} = 1; $x }	284	=back
77	sub y { $new->{position_sensitive} = 1; $y }
78	sub w { $new->{size_sensitive} = 1; $w }
79	sub h { $new->{size_sensitive} = 1; $h }
80	sub now { urxvt::NOW }
81		285
82	sub again {	286	=head2 SETTINGS
83	$new->{again} = $_[0];
84	}
85		287
		288	=over 4
		289
		290	=item border $respect_border=1
		291
		292	Sets whether the image should respect the terminal border (argument true
		293	or missing), or whether it should fill the whole window (the default).
		294
		295	By default, the image will cover the whole toplevel window. If C<border>
		296	is enabled, then it will only fill the character area and leave a normal
		297	border in the background colour around it and behind the scrollbar.
		298
		299	=cut
		300
86	sub counter {	301	sub border {
87	$new->{again} = $_[0];	302	$border = @_ ? $_[0] : 1;
88	$self->{counter}++ + 0
89	}	303	}
		304
		305	=back
		306
		307	=cut
		308
90	}	309	}
91		310
92	sub parse_expr {	311	sub parse_expr {
93	my $expr = eval "sub {\npackage urxvt::bgdsl;\n#line 0 'background expression'\n$_[0]\n}";	312	my $expr = eval "sub {\npackage urxvt::bgdsl;\n#line 0 'background expression'\n$_[0]\n}";
94	die if $@;	313	die if $@;
97		316
98	# compiles a parsed expression	317	# compiles a parsed expression
99	sub set_expr {	318	sub set_expr {
100	my ($self, $expr) = @_;	319	my ($self, $expr) = @_;
101		320
102	local $Data::Dumper::Deparse=1; use Data::Dumper; warn Dumper $expr;#d#
103	$self->{expr} = $expr;	321	$self->{expr} = $expr;
104	$self->recalculate;	322	$self->recalculate;
105	}	323	}
106		324
107	# evaluate the current bg expression	325	# evaluate the current bg expression
108	sub recalculate {	326	sub recalculate {
109	my ($self) = @_;	327	my ($self) = @_;
110		328
		329	# rate limit evaluation
		330
		331	if ($self->{next_refresh} > urxvt::NOW) {
		332	$self->{next_refresh_timer} = urxvt::timer->new->after ($self->{next_refresh} - urxvt::NOW)->cb (sub {
		333	$self->recalculate;
		334	});
		335	return;
		336	}
		337
		338	$self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL;
		339
		340	# set environment to evaluate user expression
		341
111	local $urxvt::bgdsl::vars::self = $self;	342	local $bgdsl_self = $self;
		343	local $border;
112		344
113	local $urxvt::bgdsl::vars::old = $self->{state};	345	local $old = $self->{state};
114	local $urxvt::bgdsl::vars::new = my $state = $self->{state} = {};	346	local $new = my $state = $self->{state} = {};
115		347
116	($urxvt::bgdsl::vars::x, $urxvt::bgdsl::vars::y, $urxvt::bgdsl::vars::w, $urxvt::bgdsl::vars::h) =	348	($l, $t, $w, $h) =
117	$self->get_geometry;	349	$self->get_geometry;
		350
		351	warn "$l,$t,$w,$h\n";#d#
		352
		353	# evaluate user expression
118		354
119	my $img = eval { $self->{expr}->() };	355	my $img = eval { $self->{expr}->() };
120	warn $@ if $@;#d#	356	warn $@ if $@;#d#
		357	die if !UNIVERSAL::isa $img, "urxvt::img";
		358
		359	# if the expression is sensitive to external events, prepare reevaluation then
		360
		361	my $repeat;
121		362
122	if (my $again = $state->{again}) {	363	if (my $again = $state->{again}) {
123	warn $again;#d#	364	$repeat = 1;
124	$state->{again} = urxvt::timer->new->after ($again)->cb (sub { $self->recalculate });	365	$state->{timer} = $again == $old->{again}
		366	? $old->{timer}
		367	: urxvt::timer->new->after ($again)->interval ($again)->cb (sub {
		368	++$self->{counter};
		369	$self->recalculate
		370	});
125	}	371	}
126		372
127	# TODO: install handlers for geometry changes &c	373	if (delete $state->{position_sensitive}) {
		374	$repeat = 1;
		375	$self->enable (position_change => sub { $_[0]->recalculate });
		376	} else {
		377	$self->disable ("position_change");
		378	}
128		379
129	warn $img;	380	if (delete $state->{size_sensitive}) {
		381	$repeat = 1;
		382	$self->enable (size_change => sub { $_[0]->recalculate });
		383	} else {
		384	$self->disable ("size_change");
		385	}
		386
		387	if (delete $state->{rootpmap_sensitive}) {
		388	$repeat = 1;
		389	$self->enable (rootpmap_change => sub { $_[0]->recalculate });
		390	} else {
		391	$self->disable ("rootpmap_change");
		392	}
		393
		394	# clear stuff we no longer need
		395
		396	%$old = ();
		397
		398	unless ($repeat) {
		399	delete $self->{state};
		400	delete $self->{expr};
		401	}
		402
		403	# prepare and set background pixmap
		404
		405	$img = $img->sub_rect (0, 0, $w, $h)
		406	if $img->w != $w \|\| $img->h != $h;
		407
130	$self->set_background ($img);	408	$self->set_background ($img, $border);
131	$self->scr_recolour (0);	409	$self->scr_recolour (0);
132	$self->want_refresh;	410	$self->want_refresh;
133	}	411	}
134		412
135	sub on_start {	413	sub on_start {

Diff Legend

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

Comparing rxvt-unicode/src/perl/background (file contents): Revision 1.1 by root, Mon Jun 4 21:39:56 2012 UTC vs. Revision 1.28 by root, Thu Jun 7 12:56:27 2012 UTC

Diff Legend

Comparing rxvt-unicode/src/perl/background (file contents):
Revision 1.1 by root, Mon Jun 4 21:39:56 2012 UTC vs.
Revision 1.28 by root, Thu Jun 7 12:56:27 2012 UTC