[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.32 by sf-exg, Thu Jun 7 13: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 = 'move -TX, -TY, 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;
20	*repeat_pad = \&urxvt::RepeatPad;
21	*repeat_mirror = \&urxvt::RepeatReflect;
22		32
		33	These functions provide an image, by loading it from disk, grabbing it
		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
		47
23	sub load {	48	sub load($) {
24	my ($path) = @_;	49	my ($path) = @_;
25		50
26	$new->{load}{$path} = $old->{load}{$path} \|\| $self->new_img_from_file ($path);	51	$new->{load}{$path} = $old->{load}{$path} \|\| $bgdsl_self->new_img_from_file ($path);
27	}	52	}
28		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
29	sub root {	64	sub root() {
		65	$new->{rootpmap_sensitive} = 1;
30	die "root op not supported, exg, we need you";	66	die "root op not supported, exg, we need you";
31	}	67	}
32		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
		226	sub clone($) {
		227	$_[0]->clone
		228	}
		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
		253	sub clip($;$$;$$) {
		254	my $img = pop;
		255	my $h = pop \|\| TH;
		256	my $w = pop \|\| TW;
		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)
		288	}
		289
33	sub resize {	290	sub resize($$$) {
34	$_[0]->scale ($_[1], $_[2])	291	my $img = pop;
		292	$img->scale ($_[0], $_[1])
35	}	293	}
36		294
37	sub move {	295	sub move($$;$) {
38	# TODO: must be simpler	296	my $img = pop->clone;
39	$_[0]->transform ($_[0]->w, $_[0]->h, $_[1],	297	$img->move ($_[0], $_[1]);
		298	$img
		299	}
		300
		301	sub rotate($$$$$$) {
		302	my $img = pop;
		303	$img->rotate (
40	1, 0, -$_[2],	304	$_[0],
41	0, 1, -$_[3],	305	$_[1],
42	0, 0, 1,	306	$_[2] * $img->w * .01,
		307	$_[3] * $img->h * .01,
		308	$_[4] * (3.14159265 / 180),
43	)	309	)
44	}	310	}
45		311
46	sub rotate {
47	$_[0]->rotate ($_[0], $_[1], $_[2], $_[3] * (3.14159265 / 180))
48	}
49
50	sub blur {	312	sub blur($$;$) {
51	my ($img, $rh, $rv) = @_;	313	my $img = pop;
52		314	$img->blur ($_[0], @_ >= 2 ? $_[1] : $_[0])
53	$img = $img->clone;
54	$img->clone->blur ($rh, $rv);
55	$img
56	}	315	}
57		316
58	sub contrast {	317	sub contrast($$;$$;$) {
		318	my $img = pop;
59	my ($img, $r, $g, $b, $a) = @_;	319	my ($r, $g, $b, $a) = @_;
		320
60	($g, $b) = ($r, $r) if @_ < 4;	321	($g, $b) = ($r, $r) if @_ < 4;
61	$a = 1 if @_ < 5;	322	$a = 1 if @_ < 5;
		323
62	$img = $img->clone;	324	$img = $img->clone;
63	$img->contrast ($r, $g, $b, $a);	325	$img->contrast ($r, $g, $b, $a);
64	$img	326	$img
65	}	327	}
66		328
67	sub brightness {	329	sub brightness($$;$$;$) {
		330	my $img = pop;
68	my ($img, $r, $g, $b, $a) = @_;	331	my ($r, $g, $b, $a) = @_;
		332
69	($g, $b) = ($r, $r) if @_ < 4;	333	($g, $b) = ($r, $r) if @_ < 4;
70	$a = 1 if @_ < 5;	334	$a = 1 if @_ < 5;
		335
71	$img = $img->clone;	336	$img = $img->clone;
72	$img->brightness ($r, $g, $b, $a);	337	$img->brightness ($r, $g, $b, $a);
73	$img	338	$img
74	}	339	}
75		340
76	sub x { $new->{position_sensitive} = 1; $x }	341	=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		342
82	sub again {	343	=cut
83	$new->{again} = $_[0];
84	}
85		344
86	sub counter {
87	$new->{again} = $_[0];
88	$self->{counter}++ + 0
89	}
90	}	345	}
91		346
92	sub parse_expr {	347	sub parse_expr {
93	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}";
94	die if $@;	349	die if $@;
97		352
98	# compiles a parsed expression	353	# compiles a parsed expression
99	sub set_expr {	354	sub set_expr {
100	my ($self, $expr) = @_;	355	my ($self, $expr) = @_;
101		356
102	local $Data::Dumper::Deparse=1; use Data::Dumper; warn Dumper $expr;#d#
103	$self->{expr} = $expr;	357	$self->{expr} = $expr;
104	$self->recalculate;	358	$self->recalculate;
105	}	359	}
106		360
107	# evaluate the current bg expression	361	# evaluate the current bg expression
108	sub recalculate {	362	sub recalculate {
109	my ($self) = @_;	363	my ($self) = @_;
110		364
		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
		377
111	local $urxvt::bgdsl::vars::self = $self;	378	local $bgdsl_self = $self;
112		379
113	local $urxvt::bgdsl::vars::old = $self->{state};	380	local $old = $self->{state};
114	local $urxvt::bgdsl::vars::new = my $state = $self->{state} = {};	381	local $new = my $state = $self->{state} = {};
115		382
116	($urxvt::bgdsl::vars::x, $urxvt::bgdsl::vars::y, $urxvt::bgdsl::vars::w, $urxvt::bgdsl::vars::h) =	383	my $border = 0; #d#
117	$self->get_geometry;	384
		385	($x, $y, $w, $h) =
		386	$self->background_geometry ($border);
		387
		388	# evaluate user expression
118		389
119	my $img = eval { $self->{expr}->() };	390	my $img = eval { $self->{expr}->() };
120	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
		395
		396	my $repeat;
121		397
122	if (my $again = $state->{again}) {	398	if (my $again = $state->{again}) {
123	warn $again;#d#	399	$repeat = 1;
124	$state->{again} = urxvt::timer->new->after ($again)->cb (sub { $self->recalculate });	400	$state->{timer} = $again == $old->{again}
		401	? $old->{timer}
		402	: urxvt::timer->new->after ($again)->interval ($again)->cb (sub {
		403	++$self->{counter};
		404	$self->recalculate
		405	});
125	}	406	}
126		407
127	# TODO: install handlers for geometry changes &c	408	if (delete $state->{position_sensitive}) {
		409	$repeat = 1;
		410	$self->enable (position_change => sub { $_[0]->recalculate });
		411	} else {
		412	$self->disable ("position_change");
		413	}
128		414
129	warn $img;	415	if (delete $state->{size_sensitive}) {
		416	$repeat = 1;
		417	$self->enable (size_change => sub { $_[0]->recalculate });
		418	} else {
		419	$self->disable ("size_change");
		420	}
		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
		431	%$old = ();
		432
		433	unless ($repeat) {
		434	delete $self->{state};
		435	delete $self->{expr};
		436	}
		437
		438	# prepare and set background pixmap
		439
		440	$img = $img->sub_rect (0, 0, $w, $h)
		441	if $img->w != $w \|\| $img->h != $h;
		442
130	$self->set_background ($img);	443	$self->set_background ($img, $border);
131	$self->scr_recolour (0);	444	$self->scr_recolour (0);
132	$self->want_refresh;	445	$self->want_refresh;
133	}	446	}
134		447
135	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.1 by root, Mon Jun 4 21:39:56 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.1 by root, Mon Jun 4 21:39:56 2012 UTC vs.
Revision 1.32 by sf-exg, Thu Jun 7 13:56:27 2012 UTC