/
Transform.pm
534 lines (478 loc) · 12.1 KB
/
Transform.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
package Imager::Transform;
use strict;
use Imager;
use Imager::Expr::Assem;
use vars qw($VERSION);
$VERSION = "1.004";
my %funcs =
(
mandel=>
{
desc=>"Mandelbrot set",
type=>'assem',
assem=><<EOS,
# x treated as in range minx..maxx
# y treated as in range miny..maxy
var nx:n ; var ny:n
var diffx:n ; var diffy:n
# conx/y are x/y adjusted to min..max ranges
var conx:n ; var cony:n
diffx = subtract maxx minx
conx = div x w
conx = mult conx diffx
conx = add conx minx
diffy = subtract maxy miny
cony = div y h
cony = mult cony diffy
cony = add cony miny
nx = 0
ny = 0
var count:n
count = 0
loop:
# calculate (nx,ny)**2 +(x,y)->
# (nx*nx-ny*ny+x, 2.nx.ny+y)
var wx:n ; var wy:n ; var work:n
wx = mult nx nx
wy = mult ny ny
wx = subtract wx wy
ny = mult ny nx
ny = mult ny 2
nx = wx
nx = add nx conx
ny = add ny cony
work = distance nx ny 0 0
work = gt work 2
jumpnz work docol
count = add count 1
work = lt count maxcount
jumpnz work loop
jumpnz insideangle doinang
var workp:p
workp = rgb 0 0 0
ret workp
doinang:
var ang:n
ang = atan2 ny nx
ang = mult ang 360
ang = div ang pi
workp = hsv ang 255 0.5
ret workp
docol:
var outvalue:n
outvalue = mult outsidevaluestep count
outvalue = add outvalue outsidevalue
outvalue = mod outvalue 1.01
jumpnz outsideangle do_outang
work = mult count huestep
work = add work huebase
work = mod work 360
workp = hsv work 1 outvalue
ret workp
do_outang:
ang = atan2 ny nx
ang = mult ang 360
ang = div ang pi
ang = add ang outsidebase
workp = hsv ang outsidesat outvalue
ret workp
EOS
constants=>
{
minx=>{ default=>-2, desc=>'Left of rendered area', },
miny=>{ default=>-1.5, desc=>'Top of rendered area', },
maxx=>{ default=>1, desc=>'Right of rendered area', },
maxy=>{ default=>1.5, desc=>'Bottom of rendered area', },
maxcount=>{ default=>100, desc=>'Maximum iterations', },
huestep=>{ default=>21.1, desc=>'Hue step for number of iterations', },
huebase=>{ default=>0, desc=>'Base hue for number of iterations', },
insideangle=>
{
default=>0,
desc=>'Non-zero to use angle of final as hue for inside',
},
insidebase=>
{
default=>0,
desc=>'Base angle for inside colours if insideangle is non-zero',
},
outsideangle=>
{
default=>0,
desc=>'Non-zero to use angle of final as hue for outside',
},
outsidebase=>
{
default=>0,
desc=>'Base angle if outsideangle is true',
},
outsidevalue=>
{
default=>1,
desc=>'Brightness for outside pixels',
},
outsidevaluestep=>
{
default=>0,
desc=>'Brightness step for each count for outside pixels',
},
outsidesat=>
{
default=>1,
desc=>'Saturation for outside pixels',
},
},
inputs=>[],
},
julia=>
{
desc=>"Julia set",
type=>'assem',
assem=><<EOS,
# print x
# x treated as in range minx..maxx
# y treated as in range miny..maxy
var nx:n ; var ny:n
var diffx:n ; var diffy:n
# conx/y are x/y adjusted to min..max ranges
var conx:n ; var cony:n
diffx = subtract maxx minx
conx = div x w
conx = mult conx diffx
conx = add conx minx
diffy = subtract maxy miny
cony = div y h
cony = mult cony diffy
cony = add cony miny
nx = conx
ny = cony
var count:n
count = 0
loop:
# calculate (nx,ny)**2 +(x,y)->
# (nx*nx-ny*ny+x, 2.nx.ny+y)
var wx:n ; var wy:n ; var work:n
wx = mult nx nx
wy = mult ny ny
wx = subtract wx wy
ny = mult ny nx
ny = mult ny 2
nx = wx
nx = add nx zx
ny = add ny zy
work = distance nx ny 0 0
work = gt work 2
jumpnz work docol
count = add count 1
work = lt count maxcount
jumpnz work loop
jumpnz insideangle doinang
var workp:p
workp = rgb 0 0 0
ret workp
doinang:
var ang:n
ang = atan2 ny nx
ang = mult ang 360
ang = div ang pi
workp = hsv ang 255 0.5
ret workp
docol:
var outvalue:n
outvalue = mult outsidevaluestep count
outvalue = add outvalue outsidevalue
outvalue = mod outvalue 1.01
jumpnz outsideangle do_outang
work = mult count huestep
work = add work huebase
work = mod work 360
workp = hsv work 1 outvalue
ret workp
do_outang:
ang = atan2 ny nx
ang = mult ang 360
ang = div ang pi
ang = add ang outsidebase
workp = hsv ang outsidesat outvalue
ret workp
EOS
constants=>
{
zx=>{default=>0.7, desc=>'Real part of initial Z', },
zy=>{default=>0.2, desc=>'Imaginary part of initial Z', },
minx=>{ default=>-1.5, desc=>'Left of rendered area', },
miny=>{ default=>-1.5, desc=>'Top of rendered area', },
maxx=>{ default=>1.5, desc=>'Right of rendered area', },
maxy=>{ default=>1.5, desc=>'Bottom of rendered area', },
maxcount=>{ default=>100, desc=>'Maximum iterations', },
huestep=>{ default=>21.1, desc=>'Hue step for number of iterations', },
huebase=>{ default=>0, desc=>'Base hue for number of iterations', },
insideangle=>
{
default=>0,
desc=>'Non-zero to use angle of final as hue for inside',
},
insidebase=>
{
default=>0,
desc=>'Base angle for inside colours if insideangle is non-zero',
},
outsideangle=>
{
default=>0,
desc=>'Non-zero to use angle of final as hue for outside',
},
outsidebase=>
{
default=>0,
desc=>'Base angle if outsideangle is true',
},
outsidevalue=>
{
default=>1,
desc=>'Brightness for outside pixels',
},
outsidevaluestep=>
{
default=>0,
desc=>'Brightness step for each count for outside pixels',
},
outsidesat=>
{
default=>1,
desc=>'Saturation for outside pixels',
},
},
inputs=>[],
},
circleripple=>
{
type=>'rpnexpr',
desc=>'Adds a circular ripple effect',
rpnexpr=><<'EOS',
x y cx cy distance !dist
@dist freq / sin !scale
@scale depth * @dist + !adj
y cy - x cx - atan2 !ang
cx @ang cos @adj * + cy @ang sin @adj * + getp1 @scale shadow + shadow 1 + / *
EOS
constants=>
{
freq=> { desc=>'Frequency of ripples', default=>5 },
depth=> { desc=>'Depth of ripples', default=>10 },
shadow=> { desc=>'Fraction of shadow', default=>20 },
},
inputs=>
[
{ desc=>'Image to ripple' }
],
},
spiral=>
{
type=>'rpnexpr',
desc=>'Render a colorful spiral',
rpnexpr=><<'EOS',
x y cx cy distance !d y cy - x cx - atan2 !a
@d spacing / @a + pi 2 * % !a2
@a 180 * pi / 1 @a2 sin 1 + 2 / hsv
EOS
constants=>
{
spacing=>{ desc=>'Spacing between arms', default=>10 },
},
inputs=>[],
},
diagripple=>
{
type=>'rpnexpr',
desc=>'Adds diagonal ripples to an image',
rpnexpr=><<'EOS',
x y + !dist @dist freq / sin !scale
@scale depth * !adj
x @adj + y @adj + getp1 @scale shadow + shadow 1 + / *
EOS
constants=>
{
freq=>{ desc=>'Frequency of ripples', default=>5, },
depth=>{desc=>'Depth of ripples', default=>3,},
shadow=>
{
desc=>'Fraction of brightness to remove for shadows',
default=>20,
},
},
inputs=>
[
{ desc=>'Image to add ripples to' }
],
},
twist=>
{
type=>'rpnexpr',
desc=>'Twist an image',
rpnexpr=><<'EOS',
x y cx cy distance !dist
y cy - x cx - atan2 @dist twist / + !ang
cx @ang cos @dist * + cy @ang sin @dist * + getp1
EOS
constants=>
{
twist=>{ desc=>'Amount of twist', default=>2.5, },
},
inputs=>
[
{ desc=>'Image to twist' },
],
},
# any other functions can wait until Imager::Expr::Infix supports
# jumps
);
sub new {
my ($class, $name) = @_;
exists $funcs{$name} or return;
bless { func=>$funcs{$name}, name=>$name }, $class;
}
sub inputs {
my ($self) = @_;
return @{$self->{func}{inputs}}
}
sub constants {
my $self = shift;
if (@_) {
return @{$self->{func}{constants}}{@_};
}
else {
return keys %{$self->{func}{constants}};
}
}
sub transform {
my ($self, $opts, $constants, @in) = @_;
my $func = $self->{func};
my %opts = %$opts;
$opts{$func->{type}} = $func->{$func->{type}};
my %con = %$constants;
for my $name (keys %{$func->{'constants'}}) {
unless (exists $con{$name}) {
if (exists $func->{'constants'}{$name}{default}) {
$con{$name} = $func->{'constants'}{$name}{default};
}
else {
$self->{error} = "No value or default for constant $name";
return;
}
}
}
$opts{'constants'} = \%con;
unless (@in == @{$func->{'inputs'}}) {
$self->{error} = @in." input images given, ".
@{$func->{'inputs'}}." supplied";
return;
}
my $out = Imager::transform2(\%opts, @in);
unless ($out) {
$self->{error} = $Imager::ERRSTR;
return;
}
return $out;
}
sub errstr {
return $_[0]{error};
}
sub list {
return keys %funcs;
}
sub describe {
my ($class, $name) = @_;
my $func;
if (ref $class && !$name) {
$func = $class->{func};
$name = $class->{name}
}
else {
$func = $funcs{$name}
or return undef;
}
my $desc = <<EOS;
Function : $name
Description: $func->{desc}
EOS
if ($func->{'inputs'} && @{$func->{'inputs'}}) {
$desc .= "Input images:\n";
my $i = 1;
for my $in (@{$func->{'inputs'}}) {
$desc .= " $i: $in->{desc}\n";
}
}
else {
$desc .= "There are no input images\n";
}
if ($func->{'constants'} && keys %{$func->{'constants'}}) {
$desc .= "Input constants:\n";
for my $key (keys %{$func->{'constants'}}) {
$desc .= " $key: $func->{'constants'}{$key}{desc}\n";
$desc .= " Default: $func->{'constants'}{$key}{default}\n";
}
}
else {
$desc .= "There are no constants\n";
}
return $desc;
}
1;
__END__
=head1 NAME
Imager::Transform - a library of register machine image transformations
=head1 SYNOPSIS
# get a list of transformations
my @funcs = Imager::Transform->list;
# create a transformation object
my $tran = Imager::Transform->new($name);
# describe it
print $tran->describe;
# a list of constant names
my @constants = $tran->constants;
# information about some of the constants
my @info = $tran->constants(@constants);
=head1 DESCRIPTION
This module provides a library of transformations that use the Imager
transform2() function.
The aim is to provide a place to collect these transformations.
At some point there might be an interface to add new functions, but
there's not a whole lot of point to that.
The interface is a little sparse as yet.
=head1 METHODS
=over 4
=item my @names = Imager::Transform->list
Returns a list of the transformations.
=item my $desc = Imager::Transform->describe($name);
=item my $desc = $tran->describe()
Describes a transformation specified either by name (as a class
method) or by reference (as an instance method).
The class method returns undef if there is no such transformation.
=item my $tran = Imager::Transform->new($name)
Create a new transformation object. Returns undef if there is no such
transformation.
=item my @inputs = $tran->inputs;
=item my $inputs = $tran->inputs;
Returns a list of input image descriptions, or the number of them,
depending on content.
The list contains hashrefs, which current contain only one member,
desc, a description of the use of the input image.
=item $tran->constants
Return's a list of names of constants that can be set for the
transformation.
=item $tran->constants($name, $name, ...)
Returns a hashref for each named constant, which contains the default
in key C<default> and a description in key C<desc>.
=item my $out = $tran->transform(\%opts, \%constants, @imgs)
Perform the image transformation.
Returns the new image on success, or undef on failure, in which case
you can use $tran->errstr to get an error message.
=item $tran->errstr
The error message, if any from the last image transformation.
=back
=head1 BUGS
Needs more transformations.
=head1 SEE ALSO
Imager(3), transform.perl
=cut