[ViewVC] Annotation 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 *
#	User	Rev	Content
1	root	1.1	#! perl
2
3	root	1.16	#:META:X_RESOURCE:%.expr:string:background expression
4			#:META:X_RESOURCE:%.enable:boolean:some boolean
5	root	1.18	#:META:X_RESOURCE:%.extra.:value:extra config
6	root	1.12
7	root	1.28	our $EXPR;
8			#$EXPR = 'move W * 0.1, -H * 0.1, resize W * 0.5, H * 0.5, repeat_none load "opensource.png"';
9	root	1.29	$EXPR = 'move -X, -Y, load "argb.png"';
10	root	1.19	#$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	root	1.1	#$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	root	1.3	our ($bgdsl_self, $old, $new);
23	root	1.29	our ($x, $y, $w, $h);
24	root	1.3
25	root	1.16	# enforce at least this interval between updates
26	root	1.10	our $MIN_INTERVAL = 1/100;
27	root	1.9
28	root	1.1	{
29			package urxvt::bgdsl; # background language
30
31	root	1.15	=head2 PROVIDERS/GENERATORS
32
33			=over 4
34
35			=item load $path
36
37	root	1.29	Loads the image at the given C<$path>. The image is set to plane tiling
38			mode.
39
40
41
42	root	1.15	=cut
43
44	root	1.2	sub load($) {
45	root	1.1	my ($path) = @_;
46
47	root	1.3	$new->{load}{$path} = $old->{load}{$path} \|\| $bgdsl_self->new_img_from_file ($path);
48	root	1.1	}
49
50	root	1.2	sub root() {
51	root	1.9	$new->{rootpmap_sensitive} = 1;
52	root	1.1	die "root op not supported, exg, we need you";
53			}
54
55	root	1.15	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	root	1.20	=head2 VARIABLES
64
65			=over 4
66
67			=cut
68
69	root	1.29	sub X() { $new->{position_sensitive} = 1; $x }
70			sub Y() { $new->{position_sensitive} = 1; $y }
71	root	1.20	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	root	1.28	=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	root	1.15
92			=over 4
93
94	root	1.28	=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	root	1.15	=cut
121
122	root	1.28	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	root	1.4
140	root	1.28	sub extend($) {
141	root	1.24	my $img = $_[0]->clone;
142	root	1.28	$img->repeat_mode (urxvt::RepeatPad);
143	root	1.24	$img
144			}
145
146	root	1.28	=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	root	1.20	sub clip($;$$;$$) {
188	root	1.7	my $img = pop;
189	root	1.21	my $h = pop \|\| H;
190			my $w = pop \|\| W;
191			$img->sub_rect ($_[0], $_[1], $w, $h)
192	root	1.4	}
193
194	root	1.28	=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	root	1.2	sub resize($$$) {
225	root	1.7	my $img = pop;
226			$img->scale ($_[0], $_[1])
227	root	1.1	}
228
229	root	1.7	# TODO: ugly
230			sub move($$;$) {
231	root	1.20	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	root	1.1	}
241
242	root	1.20	sub rotate($$$$$$) {
243	root	1.7	my $img = pop;
244			$img->rotate (
245			$_[0],
246	root	1.4	$_[1],
247	root	1.7	$_[2] * $img->w * .01,
248			$_[3] * $img->h * .01,
249			$_[4] * (3.14159265 / 180),
250	root	1.4	)
251	root	1.1	}
252
253	root	1.28	sub blur($$;$) {
254			my $img = pop;
255	root	1.1
256	root	1.28	$img->blur ($_[0], @_ >= 2 ? $_[1] : $_[0]);
257	root	1.1	}
258
259	root	1.2	sub contrast($$;$$;$) {
260	root	1.7	my $img = pop;
261			my ($r, $g, $b, $a) = @_;
262	root	1.4
263	root	1.1	($g, $b) = ($r, $r) if @_ < 4;
264			$a = 1 if @_ < 5;
265	root	1.4
266	root	1.1	$img = $img->clone;
267			$img->contrast ($r, $g, $b, $a);
268			$img
269			}
270
271	root	1.2	sub brightness($$;$$;$) {
272	root	1.7	my $img = pop;
273			my ($r, $g, $b, $a) = @_;
274	root	1.4
275	root	1.1	($g, $b) = ($r, $r) if @_ < 4;
276			$a = 1 if @_ < 5;
277	root	1.4
278	root	1.1	$img = $img->clone;
279			$img->brightness ($r, $g, $b, $a);
280			$img
281			}
282
283	root	1.15	=back
284
285			=cut
286
287	root	1.1	}
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	root	1.10	# rate limit evaluation
308
309	root	1.9	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	root	1.12	return;
314	root	1.9	}
315
316			$self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL;
317
318	root	1.10	# set environment to evaluate user expression
319	root	1.6
320	root	1.3	local $bgdsl_self = $self;
321	root	1.1
322	root	1.3	local $old = $self->{state};
323			local $new = my $state = $self->{state} = {};
324	root	1.1
325	root	1.29	my $border = 0; #d#
326	root	1.1
327	root	1.29	($x, $y, $w, $h) =
328			$self->background_geometry ($border);
329	root	1.22
330	root	1.10	# evaluate user expression
331
332	root	1.1	my $img = eval { $self->{expr}->() };
333			warn $@ if $@;#d#
334	root	1.15	die if !UNIVERSAL::isa $img, "urxvt::img";
335	root	1.1
336	root	1.10	# if the expression is sensitive to external events, prepare reevaluation then
337
338	root	1.2	my $repeat;
339
340	root	1.1	if (my $again = $state->{again}) {
341	root	1.2	$repeat = 1;
342	root	1.6	$state->{timer} = $again == $old->{again}
343			? $old->{timer}
344	root	1.7	: urxvt::timer->new->after ($again)->interval ($again)->cb (sub {
345			++$self->{counter};
346			$self->recalculate
347			});
348	root	1.1	}
349
350	root	1.2	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	root	1.9	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	root	1.10	# clear stuff we no longer need
372
373	root	1.6	%$old = ();
374
375	root	1.5	unless ($repeat) {
376			delete $self->{state};
377			delete $self->{expr};
378			}
379
380	root	1.10	# prepare and set background pixmap
381
382	root	1.4	$img = $img->sub_rect (0, 0, $w, $h)
383			if $img->w != $w \|\| $img->h != $h;
384	root	1.1
385	root	1.28	$self->set_background ($img, $border);
386	root	1.1	$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