ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/perl/background
Revision: 1.2
Committed: Tue Jun 5 11:00:40 2012 UTC (12 years ago) by root
Branch: MAIN
Changes since 1.1: +33 -17 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 #! perl
2
3 our $EXPR = 'move load "/root/pix/das_fette_schwein.jpg", &x, &y';
4 #$EXPR = 'blur root, 10, 10'
5 #$EXPR = 'blur move (root, -x, -y), 5, 5'
6 #resize load "/root/pix/das_fette_schwein.jpg", w, h
7
8 use Safe;
9
10 {
11 package urxvt::bgdsl::vars;
12
13 our ($self, $old, $new);
14 our ($x, $y, $w, $h);
15
16 package urxvt::bgdsl; # background language
17
18 *repeat_black = \&urxvt::RepeatNone; #TODO wtf
19 *repeat_wrap = \&urxvt::RepeatNormal;
20 *repeat_pad = \&urxvt::RepeatPad;
21 *repeat_mirror = \&urxvt::RepeatReflect;
22
23 sub load($) {
24 my ($path) = @_;
25
26 $new->{load}{$path} = $old->{load}{$path} || $self->new_img_from_file ($path);
27 }
28
29 sub root() {
30 die "root op not supported, exg, we need you";
31 }
32
33 sub resize($$$) {
34 $_[0]->scale ($_[1], $_[2])
35 }
36
37 sub move($$$) {
38 # TODO: must be simpler
39 $_[0]->transform ($_[0]->w, $_[0]->h, $_[1],
40 1, 0, -$_[2],
41 0, 1, -$_[3],
42 0, 0, 1,
43 )
44 }
45
46 sub rotate($$$$) {
47 $_[0]->rotate ($_[0], $_[1], $_[2], $_[3] * (3.14159265 / 180))
48 }
49
50 sub blur($$$) {
51 my ($img, $rh, $rv) = @_;
52
53 $img = $img->clone;
54 $img->clone->blur ($rh, $rv);
55 $img
56 }
57
58 sub contrast($$;$$;$) {
59 my ($img, $r, $g, $b, $a) = @_;
60 ($g, $b) = ($r, $r) if @_ < 4;
61 $a = 1 if @_ < 5;
62 $img = $img->clone;
63 $img->contrast ($r, $g, $b, $a);
64 $img
65 }
66
67 sub brightness($$;$$;$) {
68 my ($img, $r, $g, $b, $a) = @_;
69 ($g, $b) = ($r, $r) if @_ < 4;
70 $a = 1 if @_ < 5;
71 $img = $img->clone;
72 $img->brightness ($r, $g, $b, $a);
73 $img
74 }
75
76 sub x() { $new->{position_sensitive} = 1; $x }
77 sub y() { $new->{position_sensitive} = 1; $y }
78 sub w() { $new->{size_sensitive} = 1; $w }
79 sub h() { $new->{size_sensitive} = 1; $h }
80 sub now() { urxvt::NOW }
81
82 sub again($) {
83 $new->{again} = $_[0];
84 }
85
86 sub counter($) {
87 $new->{again} = $_[0];
88 $self->{counter}++ + 0
89 }
90 }
91
92 sub parse_expr {
93 my $expr = eval "sub {\npackage urxvt::bgdsl;\n#line 0 'background expression'\n$_[0]\n}";
94 die if $@;
95 $expr
96 }
97
98 # compiles a parsed expression
99 sub set_expr {
100 my ($self, $expr) = @_;
101
102 local $Data::Dumper::Deparse=1; use Data::Dumper; warn Dumper $expr;#d#
103 $self->{expr} = $expr;
104 $self->recalculate;
105 }
106
107 # evaluate the current bg expression
108 sub recalculate {
109 my ($self) = @_;
110
111 local $urxvt::bgdsl::vars::self = $self;
112
113 local $urxvt::bgdsl::vars::old = $self->{state};
114 local $urxvt::bgdsl::vars::new = my $state = $self->{state} = {};
115
116 ($urxvt::bgdsl::vars::x, $urxvt::bgdsl::vars::y, $urxvt::bgdsl::vars::w, $urxvt::bgdsl::vars::h) =
117 $self->get_geometry;
118
119 my $img = eval { $self->{expr}->() };
120 warn $@ if $@;#d#
121
122 my $repeat;
123
124 if (my $again = $state->{again}) {
125 $repeat = 1;
126 $state->{again} = urxvt::timer->new->after ($again)->cb (sub { $self->recalculate });
127 }
128
129 if (delete $state->{position_sensitive}) {
130 $repeat = 1;
131 $self->enable (position_change => sub { $_[0]->recalculate });
132 } else {
133 $self->disable ("position_change");
134 }
135
136 if (delete $state->{size_sensitive}) {
137 $repeat = 1;
138 $self->enable (size_change => sub { $_[0]->recalculate });
139 } else {
140 $self->disable ("size_change");
141 }
142
143 # TODO: install handlers for geometry changes &c
144
145 warn $img;
146 $self->set_background ($img);
147 $self->scr_recolour (0);
148 $self->want_refresh;
149 }
150
151 sub on_start {
152 my ($self) = @_;
153
154 $self->set_expr (parse_expr $EXPR);
155
156 ()
157 }
158