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

=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 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.30
Committed:	Thu Jun 7 13:22:06 2012 UTC (11 years, 11 months ago) by root
Branch:	MAIN
Changes since 1.29:	+9 -17 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.30	$EXPR = 'move -TX, -TY, 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.30	sub TX() { $new->{position_sensitive} = 1; $x }
70			sub TY() { $new->{position_sensitive} = 1; $y }
71			sub TW() { $new->{size_sensitive} = 1; $w }
72			sub TH() { $new->{size_sensitive} = 1; $h }
73	root	1.20
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.30	my $h = pop \|\| TH;
190			my $w = pop \|\| TW;
191	root	1.21	$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	root	1.30	: $img->scale (TW, TH)
222	root	1.28	}
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	sub move($$;$) {
230	root	1.20	my $img = pop->clone;
231			$img->move ($_[0], $_[1]);
232			$img
233	root	1.1	}
234
235	root	1.20	sub rotate($$$$$$) {
236	root	1.7	my $img = pop;
237			$img->rotate (
238			$_[0],
239	root	1.4	$_[1],
240	root	1.7	$_[2] * $img->w * .01,
241			$_[3] * $img->h * .01,
242			$_[4] * (3.14159265 / 180),
243	root	1.4	)
244	root	1.1	}
245
246	root	1.28	sub blur($$;$) {
247			my $img = pop;
248	root	1.30	$img->blur ($_[0], @_ >= 2 ? $_[1] : $_[0])
249	root	1.1	}
250
251	root	1.2	sub contrast($$;$$;$) {
252	root	1.7	my $img = pop;
253			my ($r, $g, $b, $a) = @_;
254	root	1.4
255	root	1.1	($g, $b) = ($r, $r) if @_ < 4;
256			$a = 1 if @_ < 5;
257	root	1.4
258	root	1.1	$img = $img->clone;
259			$img->contrast ($r, $g, $b, $a);
260			$img
261			}
262
263	root	1.2	sub brightness($$;$$;$) {
264	root	1.7	my $img = pop;
265			my ($r, $g, $b, $a) = @_;
266	root	1.4
267	root	1.1	($g, $b) = ($r, $r) if @_ < 4;
268			$a = 1 if @_ < 5;
269	root	1.4
270	root	1.1	$img = $img->clone;
271			$img->brightness ($r, $g, $b, $a);
272			$img
273			}
274
275	root	1.15	=back
276
277			=cut
278
279	root	1.1	}
280
281			sub parse_expr {
282			my $expr = eval "sub {\npackage urxvt::bgdsl;\n#line 0 'background expression'\n$_[0]\n}";
283			die if $@;
284			$expr
285			}
286
287			# compiles a parsed expression
288			sub set_expr {
289			my ($self, $expr) = @_;
290
291			$self->{expr} = $expr;
292			$self->recalculate;
293			}
294
295			# evaluate the current bg expression
296			sub recalculate {
297			my ($self) = @_;
298
299	root	1.10	# rate limit evaluation
300
301	root	1.9	if ($self->{next_refresh} > urxvt::NOW) {
302			$self->{next_refresh_timer} = urxvt::timer->new->after ($self->{next_refresh} - urxvt::NOW)->cb (sub {
303			$self->recalculate;
304			});
305	root	1.12	return;
306	root	1.9	}
307
308			$self->{next_refresh} = urxvt::NOW + $MIN_INTERVAL;
309
310	root	1.10	# set environment to evaluate user expression
311	root	1.6
312	root	1.3	local $bgdsl_self = $self;
313	root	1.1
314	root	1.3	local $old = $self->{state};
315			local $new = my $state = $self->{state} = {};
316	root	1.1
317	root	1.29	my $border = 0; #d#
318	root	1.1
319	root	1.29	($x, $y, $w, $h) =
320			$self->background_geometry ($border);
321	root	1.22
322	root	1.10	# evaluate user expression
323
324	root	1.1	my $img = eval { $self->{expr}->() };
325			warn $@ if $@;#d#
326	root	1.15	die if !UNIVERSAL::isa $img, "urxvt::img";
327	root	1.1
328	root	1.10	# if the expression is sensitive to external events, prepare reevaluation then
329
330	root	1.2	my $repeat;
331
332	root	1.1	if (my $again = $state->{again}) {
333	root	1.2	$repeat = 1;
334	root	1.6	$state->{timer} = $again == $old->{again}
335			? $old->{timer}
336	root	1.7	: urxvt::timer->new->after ($again)->interval ($again)->cb (sub {
337			++$self->{counter};
338			$self->recalculate
339			});
340	root	1.1	}
341
342	root	1.2	if (delete $state->{position_sensitive}) {
343			$repeat = 1;
344			$self->enable (position_change => sub { $_[0]->recalculate });
345			} else {
346			$self->disable ("position_change");
347			}
348
349			if (delete $state->{size_sensitive}) {
350			$repeat = 1;
351			$self->enable (size_change => sub { $_[0]->recalculate });
352			} else {
353			$self->disable ("size_change");
354			}
355
356	root	1.9	if (delete $state->{rootpmap_sensitive}) {
357			$repeat = 1;
358			$self->enable (rootpmap_change => sub { $_[0]->recalculate });
359			} else {
360			$self->disable ("rootpmap_change");
361			}
362
363	root	1.10	# clear stuff we no longer need
364
365	root	1.6	%$old = ();
366
367	root	1.5	unless ($repeat) {
368			delete $self->{state};
369			delete $self->{expr};
370			}
371
372	root	1.10	# prepare and set background pixmap
373
374	root	1.4	$img = $img->sub_rect (0, 0, $w, $h)
375			if $img->w != $w \|\| $img->h != $h;
376	root	1.1
377	root	1.28	$self->set_background ($img, $border);
378	root	1.1	$self->scr_recolour (0);
379			$self->want_refresh;
380			}
381
382			sub on_start {
383			my ($self) = @_;
384
385			$self->set_expr (parse_expr $EXPR);
386
387			()
388			}
389