[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 -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 ($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

=over 4

=item load $path

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


=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; $x }
   sub Y() { $new->{position_sensitive} = 1; $y }
   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

=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.29
Committed:	Thu Jun 7 13:12:08 2012 UTC (11 years, 11 months ago) by root
Branch:	MAIN
Changes since 1.28:	+12 -35 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 -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 ($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	=over 4
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
43
44	sub load($) {
45	my ($path) = @_;
46
47	$new->{load}{$path} = $old->{load}{$path} \|\| $bgdsl_self->new_img_from_file ($path);
48	}
49
50	sub root() {
51	$new->{rootpmap_sensitive} = 1;
52	die "root op not supported, exg, we need you";
53	}
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
224	sub resize($$$) {
225	my $img = pop;
226	$img->scale ($_[0], $_[1])
227	}
228
229	# TODO: ugly
230	sub move($$;$) {
231	my $img = pop->clone;
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 (
245	$_[0],
246	$_[1],
247	$_[2] * $img->w * .01,
248	$_[3] * $img->h * .01,
249	$_[4] * (3.14159265 / 180),
250	)
251	}
252
253	sub blur($$;$) {
254	my $img = pop;
255
256	$img->blur ($_[0], @_ >= 2 ? $_[1] : $_[0]);
257	}
258
259	sub contrast($$;$$;$) {
260	my $img = pop;
261	my ($r, $g, $b, $a) = @_;
262
263	($g, $b) = ($r, $r) if @_ < 4;
264	$a = 1 if @_ < 5;
265
266	$img = $img->clone;
267	$img->contrast ($r, $g, $b, $a);
268	$img
269	}
270
271	sub brightness($$;$$;$) {
272	my $img = pop;
273	my ($r, $g, $b, $a) = @_;
274
275	($g, $b) = ($r, $r) if @_ < 4;
276	$a = 1 if @_ < 5;
277
278	$img = $img->clone;
279	$img->brightness ($r, $g, $b, $a);
280	$img
281	}
282
283	=back
284
285	=cut
286
287	}
288
289	sub parse_expr {
290	my $expr = eval "sub {\npackage urxvt::bgdsl;\n#line 0 'background expression'\n$_[0]\n}";
291	die if $@;
292	$expr
293	}
294
295	# compiles a parsed expression
296	sub set_expr {
297	my ($self, $expr) = @_;
298
299	$self->{expr} = $expr;
300	$self->recalculate;
301	}
302
303	# evaluate the current bg expression
304	sub recalculate {
305	my ($self) = @_;
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
320	local $bgdsl_self = $self;
321
322	local $old = $self->{state};
323	local $new = my $state = $self->{state} = {};
324
325	my $border = 0; #d#
326
327	($x, $y, $w, $h) =
328	$self->background_geometry ($border);
329
330	# evaluate user expression
331
332	my $img = eval { $self->{expr}->() };
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
337
338	my $repeat;
339
340	if (my $again = $state->{again}) {
341	$repeat = 1;
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	});
348	}
349
350	if (delete $state->{position_sensitive}) {
351	$repeat = 1;
352	$self->enable (position_change => sub { $_[0]->recalculate });
353	} else {
354	$self->disable ("position_change");
355	}
356
357	if (delete $state->{size_sensitive}) {
358	$repeat = 1;
359	$self->enable (size_change => sub { $_[0]->recalculate });
360	} else {
361	$self->disable ("size_change");
362	}
363
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	}
370
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
385	$self->set_background ($img, $border);
386	$self->scr_recolour (0);
387	$self->want_refresh;
388	}
389
390	sub on_start {
391	my ($self) = @_;
392
393	$self->set_expr (parse_expr $EXPR);
394
395	()
396	}
397