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

#! perl

#:META:X_RESOURCE:%.expr:string:background expression
#:META:X_RESOURCE:%.enable:boolean:some boolean
#:META:X_RESOURCE:%.extra.:value:extra config

our $EXPR;
#$EXPR = 'move W * 0.1, -H * 0.1, resize W * 0.5, H * 0.5, repeat_none load "opensource.png"';
$EXPR = 'move -TX, -TY, load "argb.png"';
#$EXPR = '
#   rotate W, H, 50, 50, counter 1/59.95, repeat_mirror,
#   clip X, Y, W, H, repeat_mirror,
#   load "/root/pix/das_fette_schwein.jpg"
#';
#$EXPR = 'solid "red"';
#$EXPR = 'blur root, 10, 10'
#$EXPR = 'blur move (root, -x, -y), 5, 5'
#resize load "/root/pix/das_fette_schwein.jpg", w, h

use Safe;

our ($bgdsl_self, $old, $new);
our ($x, $y, $w, $h);

# enforce at least this interval between updates
our $MIN_INTERVAL = 1/100;

{
   package urxvt::bgdsl; # background language

=head2 PROVIDERS/GENERATORS

These functions provide an image, by loading it from disk, grabbing it
from the root screen or by simply generating it. They are used as strating
points to get an image you can play with.

=over 4

=item load $path

Loads the image at the given C<$path>. The image is set to plane tiling
mode.

Loaded images will be cached for one cycle.

=cut

   sub load($) {
      my ($path) = @_;

      $new->{load}{$path} = $old->{load}{$path} || $bgdsl_self->new_img_from_file ($path);
   }

=item root

Returns the root window pixmap, that is, hopefully, the background image
of your screen. The image is set to extend mode.

This function makes your expression root sensitive, that means it will be
reevaluated when the bg image changes.

=cut

   sub root() {
      $new->{rootpmap_sensitive} = 1;
      die "root op not supported, exg, we need you";
   }

=item solid $colour

=item solid $width, $height, $colour

Creates a new image and completely fills it with the given colour. The
image is set to tiling mode.

If <$width> and C<$height> are omitted, it creates a 1x1 image, which is
useful for solid backgrounds or for use in filtering effects.

=cut

   sub solid($$;$) {
      my $colour = pop;

      my $img = $bgdsl_self->new_img (urxvt::PictStandardARGB32, $_[0] || 1, $_[1] || 1);
      $img->fill ($colour);
      $img
   }

=back

=head2 VARIABLES

The following functions provide variable data such as the terminal
widnow dimensions. Most of them make your expression sensitive to some
events, for example using C<TW> (terminal width) means your expression is
evaluated again when the terminal is resized.

=over 4

=item TX

=item TY

Return the X and Y coordinates of the terminal window (the terminal
window is the full window by default, and the character area only when in
border-respect mode).

Using these functions make your expression sensitive to window moves.

These functions are mainly useful to align images to the root window.

Example: load an image and align it so it looks as if anchored to the
background.

   move -TX, -TY, load "mybg.png"

=item TW

Return the width (C<TW>) and height (C<TH>) of the terminal window (the
terminal window is the full window by default, and the character area only
when in border-respect mode).

Using these functions make your expression sensitive to window resizes.

These functions are mainly useful to scale images, or to clip images to
the window size to conserve memory.

Example: take the screen background, clip it to the window size, blur it a
bit, align it to the window position and use it as background.

   clip move -TX, -TY, blur 5, root

=cut

   sub TX() { $new->{position_sensitive} = 1; $x }
   sub TY() { $new->{position_sensitive} = 1; $y }
   sub TW() { $new->{size_sensitive}     = 1; $w }
   sub TH() { $new->{size_sensitive}     = 1; $h }

   sub now() { urxvt::NOW }

   sub again($) {
      $new->{again} = $_[0];
   }

   sub counter($) {
      $new->{again} = $_[0];
      $bgdsl_self->{counter} + 0
   }

=back

=head2 TILING MODES

The following operators modify the tiling mode of an image, that is, the
way that pixels outside the image area are painted when the image is used.

=over 4

=item tile $img

Tiles the whole plane with the image and returns this new image - or in
other words, it returns a copy of the image in plane tiling mode.

=item mirror $img

Similar to tile, but reflects the image each time it uses a new copy, so
that top edges always touch top edges, right edges always touch right
edges and so on (with normal tiling, left edges always touch right edges
and top always touch bottom edges).

=item pad $img

Takes an image and modifies it so that all pixels outside the image area
become transparent. This mode is most useful when you want to place an
image over another image or the background colour while leaving all
background pixels outside the image unchanged.

=item extend $img

Extends the image over the whole plane, using the closest pixel in the
area outside the image. This mode is mostly useful when you more complex
filtering operations and want the pixels outside the image to have the
same values as the pixels near the edge.

=cut

   sub pad($) {
      my $img = $_[0]->clone;
      $img->repeat_mode (urxvt::RepeatNone);
      $img
   }

   sub tile($) {
      my $img = $_[0]->clone;
      $img->repeat_mode (urxvt::RepeatNormal);
      $img
   }

   sub mirror($) {
      my $img = $_[0]->clone;
      $img->repeat_mode (urxvt::RepeatReflect);
      $img
   }

   sub extend($) {
      my $img = $_[0]->clone;
      $img->repeat_mode (urxvt::RepeatPad);
      $img
   }

=back

=head2 PIXEL OPERATORS

The following operators modify the image pixels in various ways.

=over 4

=item clone $img

Returns an exact copy of the image.

=cut

   sub clone($) {
      $_[0]->clone
   }

=item clip $img

=item clip $width, $height, $img

=item clip $x, $y, $width, $height, $img

Clips an image to the given rectangle. If the rectangle is outside the
image area (e.g. when C<$x> or C<$y> are negative) or the rectangle is
larger than the image, then the tiling mode defines how the extra pixels
will be filled.

If C<$x> an C<$y> are missing, then C<0> is assumed for both.

If C<$width> and C<$height> are missing, then the window size will be
assumed.

Example: load an image, blur it, and clip it to the window size to save
memory.

   clip blur 10, load "mybg.png"

=cut

   sub clip($;$$;$$) {
      my $img = pop;
      my $h = pop || TH;
      my $w = pop || TW;
      $img->sub_rect ($_[0], $_[1], $w, $h)
   }

=item scale $img

=item scale $size_percent, $img

=item scale $width_percent, $height_percent, $img

Scales the image by the given percentages in horizontal
(C<$width_percent>) and vertical (C<$height_percent>) direction.

If only one percentage is give, it is used for both directions.

If no percentages are given, scales the image to the window size without
keeping aspect.

=item resize $width, $height, $img

Resizes the image to exactly C<$width> times C<$height> pixels.

=cut

#TODO: maximise, maximise_fill?

   sub scale($$$) {
      my $img = pop;

      @_ == 2 ? $img->scale ($_[0] * $img->w * 0.01, $_[1] * $img->h * 0.01)
      : @_    ? $img->scale ($_[0] * $img->w * 0.01, $_[0] * $img->h * 0.01)
              : $img->scale (TW, TH)
   }

   sub resize($$$) {
      my $img = pop;
      $img->scale ($_[0], $_[1])
   }

   sub move($$;$) {
      my $img = pop->clone;
      $img->move ($_[0], $_[1]);
      $img
   }

   sub rotate($$$$$$) {
      my $img = pop;
      $img->rotate (
         $_[0],
         $_[1],
         $_[2] * $img->w * .01,
         $_[3] * $img->h * .01,
         $_[4] * (3.14159265 / 180),
      )
   }

   sub blur($$;$) {
      my $img = pop;
      $img->blur ($_[0], @_ >= 2 ? $_[1] : $_[0])
   }

   sub contrast($$;$$;$) {
      my $img = pop;
      my ($r, $g, $b, $a) = @_;

      ($g, $b) = ($r, $r) if @_ < 4;
      $a       = 1        if @_ < 5;

      $img = $img->clone;
      $img->contrast ($r, $g, $b, $a);
      $img
   }

   sub brightness($$;$$;$) {
      my $img = pop;
      my ($r, $g, $b, $a) = @_;

      ($g, $b) = ($r, $r) if @_ < 4;
      $a       = 1        if @_ < 5;

      $img = $img->clone;
      $img->brightness ($r, $g, $b, $a);
      $img
   }

=back

=cut

}

sub parse_expr {
   my $expr = eval "sub {\npackage urxvt::bgdsl;\n#line 0 'background expression'\n$_[0]\n}";
   die if $@;
   $expr
}

# compiles a parsed expression
sub set_expr {
   my ($self, $expr) = @_;

   $self->{expr} = $expr;
   $self->recalculate;
}

# evaluate the current bg expression
sub recalculate {
   my ($self) = @_;

   # rate limit evaluation

   if ($self->{next_refresh} > urxvt::NOW) {
      $self->{next_refresh_timer} = urxvt::timer->new->after ($self->{next_refresh} - urxvt::NOW)->cb (sub {
         $self->recalculate;
      });
      return;
   }

   $self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL;

   # set environment to evaluate user expression

   local $bgdsl_self = $self;

   local $old = $self->{state};
   local $new = my $state = $self->{state} = {};

   my $border = 0; #d#

   ($x, $y, $w, $h) =
      $self->background_geometry ($border);

   # evaluate user expression

   my $img = eval { $self->{expr}->() };
   warn $@ if $@;#d#
   die if !UNIVERSAL::isa $img, "urxvt::img";

   # if the expression is sensitive to external events, prepare reevaluation then

   my $repeat;

   if (my $again = $state->{again}) {
      $repeat = 1;
      $state->{timer} = $again == $old->{again}
                        ? $old->{timer}
                        : urxvt::timer->new->after ($again)->interval ($again)->cb (sub {
                             ++$self->{counter};
                             $self->recalculate
                          });
   }

   if (delete $state->{position_sensitive}) {
      $repeat = 1;
      $self->enable (position_change => sub { $_[0]->recalculate });
   } else {
      $self->disable ("position_change");
   }

   if (delete $state->{size_sensitive}) {
      $repeat = 1;
      $self->enable (size_change => sub { $_[0]->recalculate });
   } else {
      $self->disable ("size_change");
   }

   if (delete $state->{rootpmap_sensitive}) {
      $repeat = 1;
      $self->enable (rootpmap_change => sub { $_[0]->recalculate });
   } else {
      $self->disable ("rootpmap_change");
   }

   # clear stuff we no longer need

   %$old = ();

   unless ($repeat) {
      delete $self->{state};
      delete $self->{expr};
   }

   # prepare and set background pixmap

   $img = $img->sub_rect (0, 0, $w, $h)
      if $img->w != $w || $img->h != $h;

   $self->set_background ($img, $border);
   $self->scr_recolour (0);
   $self->want_refresh;
}

sub on_start {
   my ($self) = @_;

   $self->set_expr (parse_expr $EXPR);

   ()
}

Revision:	1.31
Committed:	Thu Jun 7 13:48:15 2012 UTC (11 years, 11 months ago) by root
Branch:	MAIN
Changes since 1.30:	+70 -4 lines
Log Message:	* empty log message *
#	Content
1	#! perl
2
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"';
16	#$EXPR = 'blur root, 10, 10'
17	#$EXPR = 'blur move (root, -x, -y), 5, 5'
18	#resize load "/root/pix/das_fette_schwein.jpg", w, h
19
20	use Safe;
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
28	{
29	package urxvt::bgdsl; # background language
30
31	=head2 PROVIDERS/GENERATORS
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 strating
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
48	sub load($) {
49	my ($path) = @_;
50
51	$new->{load}{$path} = $old->{load}{$path} \|\| $bgdsl_self->new_img_from_file ($path);
52	}
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
64	sub root() {
65	$new->{rootpmap_sensitive} = 1;
66	die "root op not supported, exg, we need you";
67	}
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	widnow 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
290	sub resize($$$) {
291	my $img = pop;
292	$img->scale ($_[0], $_[1])
293	}
294
295	sub move($$;$) {
296	my $img = pop->clone;
297	$img->move ($_[0], $_[1]);
298	$img
299	}
300
301	sub rotate($$$$$$) {
302	my $img = pop;
303	$img->rotate (
304	$_[0],
305	$_[1],
306	$_[2] * $img->w * .01,
307	$_[3] * $img->h * .01,
308	$_[4] * (3.14159265 / 180),
309	)
310	}
311
312	sub blur($$;$) {
313	my $img = pop;
314	$img->blur ($_[0], @_ >= 2 ? $_[1] : $_[0])
315	}
316
317	sub contrast($$;$$;$) {
318	my $img = pop;
319	my ($r, $g, $b, $a) = @_;
320
321	($g, $b) = ($r, $r) if @_ < 4;
322	$a = 1 if @_ < 5;
323
324	$img = $img->clone;
325	$img->contrast ($r, $g, $b, $a);
326	$img
327	}
328
329	sub brightness($$;$$;$) {
330	my $img = pop;
331	my ($r, $g, $b, $a) = @_;
332
333	($g, $b) = ($r, $r) if @_ < 4;
334	$a = 1 if @_ < 5;
335
336	$img = $img->clone;
337	$img->brightness ($r, $g, $b, $a);
338	$img
339	}
340
341	=back
342
343	=cut
344
345	}
346
347	sub parse_expr {
348	my $expr = eval "sub {\npackage urxvt::bgdsl;\n#line 0 'background expression'\n$_[0]\n}";
349	die if $@;
350	$expr
351	}
352
353	# compiles a parsed expression
354	sub set_expr {
355	my ($self, $expr) = @_;
356
357	$self->{expr} = $expr;
358	$self->recalculate;
359	}
360
361	# evaluate the current bg expression
362	sub recalculate {
363	my ($self) = @_;
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
378	local $bgdsl_self = $self;
379
380	local $old = $self->{state};
381	local $new = my $state = $self->{state} = {};
382
383	my $border = 0; #d#
384
385	($x, $y, $w, $h) =
386	$self->background_geometry ($border);
387
388	# evaluate user expression
389
390	my $img = eval { $self->{expr}->() };
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;
397
398	if (my $again = $state->{again}) {
399	$repeat = 1;
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	});
406	}
407
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	}
414
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
443	$self->set_background ($img, $border);
444	$self->scr_recolour (0);
445	$self->want_refresh;
446	}
447
448	sub on_start {
449	my ($self) = @_;
450
451	$self->set_expr (parse_expr $EXPR);
452
453	()
454	}
455