[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 = 'border; move -X, -Y, 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 $border;
our ($bgdsl_self, $old, $new);
our ($l, $t, $w, $h);

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

{
   package urxvt::bgdsl; # background language

#   *repeat_empty  = \&urxvt::RepeatNone;
#   *repeat_tile   = \&urxvt::RepeatNormal;
#   *repeat_pad    = \&urxvt::RepeatPad;
#   *repeat_mirror = \&urxvt::RepeatReflect;

=head2 PROVIDERS/GENERATORS

=over 4

=item load $path

=cut

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

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

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

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

=back

=head2 VARIABLES

=over 4

=cut

   sub X() { $new->{position_sensitive} = 1; $l }
   sub Y() { $new->{position_sensitive} = 1; $t }
   sub W() { $new->{size_sensitive}     = 1; $w }
   sub H() { $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 || H;
      my $w = pop || W;
      $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 (W, H)
   }

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

   # TODO: ugly
   sub move($$;$) {
      my $img = pop->clone;
      $img->move ($_[0], $_[1]);
      $img
#      my $img = pop;
#      $img->sub_rect (
#         $_[0], $_[1],
#         $img->w, $img->h,
#         $_[2],
#      )
   }

   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

=head2 SETTINGS

=over 4

=item border $respect_border=1

Sets whether the image should respect the terminal border (argument true
or missing), or whether it should fill the whole window (the default).

By default, the image will cover the whole toplevel window. If C<border>
is enabled, then it will only fill the character area and leave a normal
border in the background colour around it and behind the scrollbar.

=cut

   sub border {
      $border = @_ ? $_[0] : 1;
   }

=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 $border;

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

   ($l, $t, $w, $h) =
      $self->get_geometry;

      warn "$l,$t,$w,$h\n";#d#

   # 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.28
Committed:	Thu Jun 7 12:56:27 2012 UTC (11 years, 11 months ago) by root
Branch:	MAIN
Changes since 1.27:	+150 -11 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 = '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"';
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 $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
29	{
30	package urxvt::bgdsl; # background language
31
32	# *repeat_empty = \&urxvt::RepeatNone;
33	# *repeat_tile = \&urxvt::RepeatNormal;
34	# *repeat_pad = \&urxvt::RepeatPad;
35	# *repeat_mirror = \&urxvt::RepeatReflect;
36
37	=head2 PROVIDERS/GENERATORS
38
39	=over 4
40
41	=item load $path
42
43	=cut
44
45	sub load($) {
46	my ($path) = @_;
47
48	$new->{load}{$path} = $old->{load}{$path} \|\| $bgdsl_self->new_img_from_file ($path);
49	}
50
51	sub root() {
52	$new->{rootpmap_sensitive} = 1;
53	die "root op not supported, exg, we need you";
54	}
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
225	sub resize($$$) {
226	my $img = pop;
227	$img->scale ($_[0], $_[1])
228	}
229
230	# TODO: ugly
231	sub move($$;$) {
232	my $img = pop->clone;
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 (
246	$_[0],
247	$_[1],
248	$_[2] * $img->w * .01,
249	$_[3] * $img->h * .01,
250	$_[4] * (3.14159265 / 180),
251	)
252	}
253
254	sub blur($$;$) {
255	my $img = pop;
256
257	$img->blur ($_[0], @_ >= 2 ? $_[1] : $_[0]);
258	}
259
260	sub contrast($$;$$;$) {
261	my $img = pop;
262	my ($r, $g, $b, $a) = @_;
263
264	($g, $b) = ($r, $r) if @_ < 4;
265	$a = 1 if @_ < 5;
266
267	$img = $img->clone;
268	$img->contrast ($r, $g, $b, $a);
269	$img
270	}
271
272	sub brightness($$;$$;$) {
273	my $img = pop;
274	my ($r, $g, $b, $a) = @_;
275
276	($g, $b) = ($r, $r) if @_ < 4;
277	$a = 1 if @_ < 5;
278
279	$img = $img->clone;
280	$img->brightness ($r, $g, $b, $a);
281	$img
282	}
283
284	=back
285
286	=head2 SETTINGS
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
301	sub border {
302	$border = @_ ? $_[0] : 1;
303	}
304
305	=back
306
307	=cut
308
309	}
310
311	sub parse_expr {
312	my $expr = eval "sub {\npackage urxvt::bgdsl;\n#line 0 'background expression'\n$_[0]\n}";
313	die if $@;
314	$expr
315	}
316
317	# compiles a parsed expression
318	sub set_expr {
319	my ($self, $expr) = @_;
320
321	$self->{expr} = $expr;
322	$self->recalculate;
323	}
324
325	# evaluate the current bg expression
326	sub recalculate {
327	my ($self) = @_;
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
342	local $bgdsl_self = $self;
343	local $border;
344
345	local $old = $self->{state};
346	local $new = my $state = $self->{state} = {};
347
348	($l, $t, $w, $h) =
349	$self->get_geometry;
350
351	warn "$l,$t,$w,$h\n";#d#
352
353	# evaluate user expression
354
355	my $img = eval { $self->{expr}->() };
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;
362
363	if (my $again = $state->{again}) {
364	$repeat = 1;
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	});
371	}
372
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	}
379
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
408	$self->set_background ($img, $border);
409	$self->scr_recolour (0);
410	$self->want_refresh;
411	}
412
413	sub on_start {
414	my ($self) = @_;
415
416	$self->set_expr (parse_expr $EXPR);
417
418	()
419	}
420