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

Comparing rxvt-unicode/src/perl/background (file contents):
Revision 1.2 by root, Tue Jun 5 11:00:40 2012 UTC vs.
Revision 1.29 by root, Thu Jun 7 13:12:08 2012 UTC

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

Diff Legend

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

Comparing rxvt-unicode/src/perl/background (file contents): Revision 1.2 by root, Tue Jun 5 11:00:40 2012 UTC vs. Revision 1.29 by root, Thu Jun 7 13:12:08 2012 UTC

Diff Legend

Comparing rxvt-unicode/src/perl/background (file contents):
Revision 1.2 by root, Tue Jun 5 11:00:40 2012 UTC vs.
Revision 1.29 by root, Thu Jun 7 13:12:08 2012 UTC