CRIMP
Changes On Branch ak-experimental
Not logged in
Home Documentation Timeline Branches Tags Tickets Wiki Login
Patch Side-by-Side Diff

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch ak-experimental Excluding Merge-Ins

This is equivalent to a diff from f0cbd36ff3 to 75bee3e229

2011-03-22
17:40
Made branch "ak-experimental" official, merging it over into the trunk aka main-line. Closing the branch. check-in: cbf1f93ff5 user: andreask tags: trunk
2011-03-17
21:00
Simplified package setup and use (demos), by using features from my critcl work (unreleased v2.1). check-in: 13c0452d35 user: andreask tags: work-for-critcl-2.1
21:00
Added buildsystem, brew-style (Derived from critcl). Closed-Leaf check-in: 75bee3e229 user: andreask tags: ak-experimental
2011-02-20
20:50
More work on retinexes. Added demo for color retinex working in HSV, processing V like the greyscale retinex, leaving HS unchanged. After a test run on a known set and comparing against the results of GHE the retinex desaturates the colors quite strongly (I suspect that this is the "graying out" noted in the various papers). check-in: e760560b3b user: andreask tags: ak-experimental
2010-06-25
21:52
Create new branch named "ak-experimental" check-in: bc65f83b3e user: andreask tags: ak-experimental
17:48
AMG crimp initial commit check-in: f0cbd36ff3 user: andreask tags: trunk
17:44
initial empty check-in check-in: 8d18a30642 user: andreask tags: trunk

Added NOTES.txt. 
















































































































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

A bit on the design.
====================

My plan is to implement only the bare functionality at the C level,
with a multitude of simple commands, and each command handling only a
specific image type, or combination of types. The proper API to the
functions is then done in Tcl, making changes to option processing,
automatic selection of a function, etc. easy to code, and change.

See http://wiki.tcl.tk/2520 (A critical mindset about policy), which
summarizes to "No poli-C, please", or, slightly longer, "Policy issues
must be scripted".

As a simple example, consider the operation ot invert images.

	We will have one command for each image type supporting the
	operation. Currently we have three, one each for rgb, rgba,
	and grey8. The API is then a single invert procedure which
	queries the type of its argument and then dispatches to the
	proper low-level command, or throws an error with a nice
	message.

	Now any changes to the error message can be done by easy
	editing of the Tcl layer, without having to recompile the C
	level.

Similarly for importing from and exporting to files/channels/tk,
conversion between types (where sensible or possible), etc.

Side note:
	Writing the Tcl layer should become easier the more uniform
	the syntax of the underlying group of commands.


Operations done and under consideration
=======================================

[]	write - Export a crimp image to other formats.

	[]	write_grey16_tk
	[]	write_grey32_tk
	[done]	write_grey8_tk
	[done]	write_rgb_tk
	[done]	write_rgba_tk

[]	read  - Import crimp images from other formats.

	[done]	read_tk
	[done]	read_tcl	(list of list of grey)

[]	convert - convert between the various crimp image types.

	[]	convert_hsv_grey16
	[]	convert_hsv_grey32
	[]	convert_hsv_grey8
	[done]	convert_hsv_rgb
	[done]	convert_hsv_rgba	- see the notes on rgb_rgba below. essentially apply here as well.

	[]	convert_rgb_grey16
	[]	convert_rgb_grey32
	[done]	convert_rgb_grey8
	[done]	convert_rgb_hsv
	[]	convert_rgb_rgba	- set opaque alpha, or transparent, or via grey image ?
					- could be done as split/join

	[]	convert_rgba_grey16   - Like grey8, or should we expand to cover whole range ?
	[]	convert_rgba_grey32   - S.a.
	[done]	convert_rgba_grey8    - Standard luma transform (ITU-R 601-2)
	[done]	convert_rgba_hsv
	[]	convert_rgba_rgb

[]	invert - invert colors

	[]	invert_grey16
	[]	invert_grey32
	[done]	invert_grey8
	[]	invert_hsv	- How is inversion defined in this colorspace ? (*)
	[done]	invert_rgb
	[done]	invert_rgba

	(*)	I am speculating that the HUE would rotate by 180 degrees.
		I have no idea if VALUE or SAT should change as well,
		in a similar manner.

[]	split - split the input image into its channels, i.e.
		RGBA into 4 images, one each for R, G, B, and A.
		Etc. for the other types.

	[done]	split_rgba
	[done]	split_rgb
	[done]	split_hsv

[]	join - join multiple grey scale images into a multi-channel
	       (colorized) image. Complementary to split.

	[done]	join_hsv
	[done]	join_rgb
	[done]	join_rgba

[]	blank - blank (black, possibly transparent) image of a given size.

	[done]	blank_grey8
	[]	blank_grey16
	[]	blank_grey32
	[]	blank_hsv
	[done]	blank_rgb
	[done]	blank_rgba

[]	over

	Blending foreground and background, based on the foreground's
	alpha.

		Z = TOP*(1-alpha(TOP))+BOTTOM*alpha(TOP) - alpha from top image.

	[done]	alpha_over_rgba_rgba
	[done]	alpha_over_rgba_rgb

[]	blend

	Blending foreground and background, based on a scalar alpha
	value.

		Z = BACK*(1-alpha)+FORE*alpha   - alpha is scalar


	[done]	alpha_blend_grey8_grey8
	[]	alpha_blend_grey8_rgb  - which channel ? luma ?
	[]	alpha_blend_grey8_rgba - which channel ? luma ?
	[done]	alpha_blend_rgb_grey8
	[done]	alpha_blend_rgb_rgb
	[done]	alpha_blend_rgb_rgba
	[done]	alpha_blend_rgba_grey8
	[done]	alpha_blend_rgba_rgb
	[done]	alpha_blend_rgba_rgba

[]	Blending foreground and background, based on an alpha mask
	image.

	This is not a primitive. Can be had by combining 'over' above
	with an operator to set an image's alpha channel.

		compose FORE BACK MASK =
			over [setalpha FORE MASK] BACK

[]	Set/Replace/Extend/Copy an image's alpha channel from a second
	image.

	setalpha

	[done]	setalpha_rgb_grey8
	[done]	setalpha_rgb_rgba
	[done]	setalpha_rgba_grey8
	[done]	setalpha_rgba_rgba

[]
	[done]	lighter	       Z = max(A,B)
	[done]	darker	       Z = min(A,B)
	[done]	difference     Z = |A-B|
	[done]	multiply       Z = (A*B)/255
	[done]	screen	       Z = 1-((1-A)*(1-B))
	[done]	add	       Z = A+B
	[done]	subtract       Z = A-B

	// The above is a group of composition/merge operations

	stencil - apply a mask - could be 'set alpha channel'
			       - but also 'set black outside mask'
			       (blue/green screen techniques)
		=> combination of setalpha, blend, and some blank image.

[]	crop, cut, expand (various border types), solarize
	flip/mirror v/h/, transpose, transverse

	[done]


--- leptonica - look for algorithms ---
--- bit blit (block ops)

## offset (x, y) - shift by (x,y) pixels [torus wrap around].

## enhance: color, brightness, contrast, sharpness

## filter:  blur, contour, detail, edge_enhance, edge_enhance_more, emboss, find_edges, smooth, smooth_more, and sharpen.
## filter:  kernel3, kernel5, rank n, size/ min, max, median, mode(most common)
##         (scale/offset - default: sum kernel/0)

## autocontrast (max contrast, cutoff (%)) => image

## colorize (grayscale, black-color, white-color) => image

## deform - see transform (as basis)
## equalize (image) of hist - non-linear map to create unform distribution of grayscale values.
## posterize (image,bits) - reduce colors to max bits.

## cmyk and back, hsv revers

## stat (image ?mask?) - statistics
##  extrema min/max per channel
##  count - #pixels
##  sum - sum of pixels
## sum2 - squared sum, mean, median, root-mean-square, variance, stddev

## eval (image f) - f applied to each pixel, each channel.
##                  f called at most once per value => at most 255 times.
##                  generators, random-ness not possible

## point table|f -> f converted to table
##                  256 values in table per channel.
##                  table of f => replicated 3x
## (non-)linear mapping.
##
## putalpha -: make data in specified channel the alpha
##
## bbox - region of non-zero pixels.
## getcolors -> dict (color -> count)
## getextrema (per channel) min/max pixel values
## histogram (?mask?) - (per channel) dict (pixel -> count)

## resize (filter), rotate(angle,expand=0,filter)
## filters = interpolation = nearest (default), bilinear 2x2, bicubic 4x4, antialias

## transform extent sz rect (4-tuple)        - crop, stretch, shrink /rectangle to square
##          |affine sz 2x3-matrix (6-tuple)  - scale, translate, rotate, and shear
##          |quad   sz 4-points (8-tuple)    - arbitrary deformation
##          |mesh   sz list of (rect, quads) - s.a.
# quad(rilateral)
# transpose - flip_left_right, flip_top_bottom, rotate_90, rotate_180, or rotate_270


RGB [0..1] --> CIE XYZ [0..1] (Y = luminosity)

|X|      1      |0.49    0.31    0.2    |   |R|
|Y| = ------- * |0.17697 0.81240 0.01063| * |G|
|Z|   0.17697   |0       0.01    0.99   |   |B|

ITU-R BT.709 is different
|X|             |0.412453 0.357580 0.180423|   |R|
|Y| =           |0.212671 0.715160 0.072169| * |G|
|Z|             |0.019334 0.119193 0.950227|   |B|

While the official definition of the CIE XYZ standard has the matrix
normalized so that the Y value corresponding to pure red is 1, a more
commonly used form is to omit the leading fraction, so that the second
row sums up to one, i.e., the RGB triplet (1, 1, 1) maps to a Y value
of 1.

Chromacity:	S = X+y+Z, x=X/S, y=Y/S, z=Z/S

Yxz - Represent luminosity and chromacity.


L*a*b*

L* = 116 * f (Y/Yn)			| scale 0..100
a* = 500 * (f (X/Xn) - f (Y/Yn))	| s.a.
b* = 200 * (f (Y/Yn) - f (Z/Zn))	| s.a.

f(x) = x**(1/3)                   , x > delta**3
       x/(3*delta**2) + 2*delta/3 , else
       delta = 6/29

f = cube root, approximated with finite slope

(Xn,Yn,Zn) = white point

L*u*v*

The BT.709 system uses the daylight illuminant D65 as its reference
white






Added brew.



































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#!/bin/sh
# -*- tcl -*- \
exec tclsh "$0" ${1+"$@"}
package require Tcl 8.5
set me [file normalize [info script]]
proc main {} {
    global argv
    if {![llength $argv]} { set argv help}
    if {[catch {
	eval _$argv
    }]} usage
    exit 0
}
proc usage {{status 1}} {
    #puts stderr $::errorInfo;exit
    global argv0
    puts stderr "Usage: $argv0 ?install ?dst?|starkit ?dst? ?interp?|starpack prefix ?dst?|help|recipes?"
    exit $status
}
proc +x {path} {
    catch { file attributes $path -permissions u+x }
    return
}
proc grep {file pattern} {
    set lines [split [read [set chan [open $file r]]] \n]
    close $chan
    return [lsearch -all -inline -glob $lines $pattern]
}
proc version {file} {
    return [lindex [grep $file {*package provide*}] 0 3]
}
proc _help {} {
    usage 0
    return
}
proc _recipes {} {
    set r {}
    foreach c [info commands _*] {
	lappend r [string range $c 1 end]
    }
    puts [lsort -dict $r]
    return
}
proc _install {{dst {}}} {
    set src     [file dirname $::me]/crimp.tcl
    set version [version $src]

    if {[llength [info level 0]] < 2} {
	set dst [info library]
    }

    # Package: crimp
    package require critcl::app
    critcl::app::main [list -cache [pwd]/BUILD -libdir $dst -pkg $src]
    file delete -force $dst/crimp$version
    file rename        $dst/crimp $dst/crimp$version

    puts "Installed package:     $dst/crimp$version"
    return
}
main






Added c/ahe.c.




































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/*
 * CRIMP :: AHE Definitions (Implementation).
 * (C) 2010.
 */

/*
 * Import declarations.
 */

#include <ahe.h>

/*
 * Definitions :: Core.
 */

int
crimp_ahe_transfer (int histogram [256], int value, int max)
{
    /*
     * (0) max = number of pixels in the histogram, for AHE this is (2r+1)^2.
     * ==> max = sum (i,histogram[i]).
     *
     * (1) CDF(value) =       sum (k <= value,histogram[k]) <a>
     *                = max - sum (k >  value,histogram[k]) <b>
     *
     *     max = sum (k,histogram[k])
     *         = sum (k<=value,histogram[k]) + sum (k>value,histogram[k]). 
     *
     * (2) sum = CDF(value) >=0, <= max
     * ==> sum         in [0-max]
     * ==> sum/max     in [0-1]
     * ==> 255*sum/max in [0-255]. (Stretched, proper pixel value).
     */

    int k, sum;

    if (value > 128) {
	/* <1b> */

	for (k = value+1, sum = 0; k < 256; k++) {
	    sum += histogram [k];
	}
	sum = max - sum;
    } else {
	/* <1a> */

	for (k = 0, sum = 0; k <= value; k++) {
	    sum += histogram [k];
	}
    }

    /* (2) */
    return 255 * sum / max;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added c/ahe.h.




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#ifndef CRIMP_AHE_H
#define CRIMP_AHE_H
/*
 * CRIMP :: Declarations for AHE transfer function via histograms.
 * (C) 2010.
 */

/*
 * API :: Core. 
 */

extern int crimp_ahe_transfer (int histogram [256], int value, int max);


/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
#endif /* CRIMP_AHE_H */






Added c/color.c.



































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/*
 * CRIMP :: Color Conversions (Implementation).
 * (C) 2010.
 */

/*
 * Import declarations.
 */

#include <color.h>
#include <util.h>

/*
 * Definitions :: HSV (Hue, Saturation, Value)
 * References:
 *	http://en.wikipedia.org/wiki/HSL_and_HSV
 *	http://en.literateprograms.org/RGB_to_HSV_color_space_conversion_%28C%29
 *	http://code.activestate.com/recipes/133527-convert-hsv-colorspace-to-rgb/
 */

void
crimp_color_rgb_to_hsv (int r, int g, int b, int* h, int* s, int* v)
{
    int hue, sat, val;
    int max = MAX (r, MAX (g, b));
    int min = MIN (r, MIN (g, b));

    val = max;

    if (max) {
	sat = (255 * (max - min)) / max;
    } else {
	sat = 0;
    }

    if (!sat) {
	/*
	 * This is a grey color, the hue is undefined, we set it to red, for
	 * the sake convenience.
	 */

	hue = 0;
    } else {
	/*
	 * The regular formulas generate a hue in the range 0..360.  We want
	 * one in the range 0..255. Instead of scaling at the end we integrate
	 * it into early calculations, properly slashing common factors. This
	 * keeps rounding errors out of things until the end.
	 */

	int delta = 6 * (max - min);

	if (r == max) {
	    hue =   0 + (255 * (g - b)) / delta;
	} else if (g == max) {
	    hue =  85 + (255 * (b - r)) / delta;
	} else {
	    hue = 170 + (255 * (r - g)) / delta;
	}

	if (hue < 0) {
	    hue += 255;
	}
    }

    *v = val;
    *s = sat;
    *h = hue;
}

void
crimp_color_hsv_to_rgb (int h, int s, int v, int* r, int* g, int* b)
{
    int red, green, blue;

    if (!s) {
	/*
	 * A grey shade. Hue is irrelevant.
	 */

	red = green = blue = v;
    } else {
	int isector, ifrac, p, q, t;

	if (h >= 255) h = 0;
	h *= 10; /* Scale up to have full precision for the 1/6 points */

	isector = h / 425 ; /* <=> *2/850 <=> *6/2550 <=> *(360/2550)/60 */
	ifrac   = h - 425 * isector; /* frac * 425 */

	p = (v * (255       - s))                 / 255;
	q = (v * ((255*425) - s * ifrac))         / (255*425);
	t = (v * ((255*425) - s * (425 - ifrac))) / (255*425);

	switch (isector) {
	case 0: red = v; green = t; blue = p; break;
	case 1: red = q; green = v; blue = p; break;
	case 2: red = p; green = v; blue = t; break;
	case 3: red = p; green = q; blue = v; break;
	case 4: red = t; green = p; blue = v; break;
	case 5: red = v; green = p; blue = q; break;
	}

#if 0 /* Floating calculation with 0..360, 0..1, 0..1 after the initial scaling */
	float fh, fs, fv, fsector;
	int isector, p, q, t;

	fh = h * 360. / 255.;
	fs = s / 255.;
	fv = v / 255.;

	if (fh >= 360) fh = 0;

	fsector = fh / 60. ;
	isector = fsector;
	frac    = fsector - isector;

	p = 256 * fv * (1 - fs);
	q = 256 * fv * (1 - fs * frac);
	t = 256 * fv * (1 - fs * (1 - frac));

	switch (isector) {
	case 0: red = v; green = t; blue = p; break;
	case 1: red = q; green = v; blue = p; break;
	case 2: red = p; green = v; blue = t; break;
	case 3: red = p; green = q; blue = v; break;
	case 4: red = t; green = p; blue = v; break;
	case 5: red = v; green = p; blue = q; break;
	}
#endif
    }

    *r = red;
    *g = green;
    *b = blue;
}

#define T  (0.00885645167903563081) /* = (6/29)^3 */
#define Ti (0.20689655172413793103) /* = (6/29) = sqrt (T) */
#define A  (7.78703703703703703702) /* = (1/3)(29/6)^2 */
#define B  (0.13793103448275862068) /* = 4/29 */

static double
flabforw (double t)
{
    return ((t > T) ? (pow (t, 1./3.)) : (A*t+B));
}

static double
flabback (double t)
{
    return ((t > Ti) ? (t*t*t) : ((t-B)/A));
}

void
crimp_color_xyz_to_cielab (double x, double y, double z, double* l, double* a, double* b)
{
    /*
     * Whitepoint = (1,1,1). To convert XYZ for any other whitepoint predivide
     * the input values by Xn, Yn, Zn, i.e. before calling this function.
     */

    *l = 116 * flabforw (y) - 16;
    *a = 500 * (flabforw(x) - flabforw(y));
    *b = 200 * (flabforw(y) - flabforw(z));
}

void
crimp_color_cielab_to_xyz (double l, double a, double b, double* x, double* y, double* z)
{
    /*
     * Whitepoint = (1,1,1). To convert CIELAB for any other whitepoint post-multiply
     * the output values by Xn, Yn, Zn, i.e. after calling this function.
     */

    double L = (l+16)/116;

    *x = flabback (L);
    *y = flabback (L + a/500);
    *z = flabback (L + b/200);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added c/color.h.












































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#ifndef CRIMP_COLOR_H
#define CRIMP_COLOR_H
/*
 * CRIMP :: Color Conversion Declarations, and API.
 * (C) 2010.
 */

#include <tcl.h>

/*
 * API :: Mapping between various color spaces.
 */

extern void crimp_color_rgb_to_hsv (int r, int g, int b, int* h, int* s, int* v);
extern void crimp_color_hsv_to_rgb (int h, int s, int v, int* r, int* g, int* b);

/*
 * Domain of the XZY, and CIE LAB (L*a*b*) colorspaces ?
 * I.e. range of values ?
 *
 * The functions below assume Xn = Yn = Zn = 1 for the whitepoint. For any
 * other white point going to cielab requires pre-division of the input x, y,
 * and z by the whitepoint, and going to XYZ requires post-multiplication of
 * the output x, y, and z.
 */

extern void crimp_color_xyz_to_cielab (double x, double y, double z, double* l, double* a, double* b);
extern void crimp_color_cielab_to_xyz (double l, double a, double b, double* x, double* y, double* z);


/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
#endif /* CRIMP_COLOR_H */






Added c/fftpack/README.







1

+

The .c files generated via % f2c -a *.f






Added c/fftpack/cfftb.c.








































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* cfftb.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int cfftb_(integer *n, real *c__, real *wsave)
{
    integer iw1, iw2;
    extern /* Subroutine */ int cfftb1_(integer *, real *, real *, real *, 
	    real *);

    /* Parameter adjustments */
    --wsave;
    --c__;

    /* Function Body */
    if (*n == 1) {
	return 0;
    }
    iw1 = *n + *n + 1;
    iw2 = iw1 + *n + *n;
    cfftb1_(n, &c__[1], &wsave[1], &wsave[iw1], &wsave[iw2]);
    return 0;
} /* cfftb_ */







Added c/fftpack/cfftb.f.














1
2
3
4
5
6
7
8

+
+
+
+
+
+
+
+

      SUBROUTINE CFFTB (N,C,WSAVE)
      DIMENSION       C(1)       ,WSAVE(1)
      IF (N .EQ. 1) RETURN
      IW1 = N+N+1
      IW2 = IW1+N+N
      CALL CFFTB1 (N,C,WSAVE,WSAVE(IW1),WSAVE(IW2))
      RETURN
      END






Added c/fftpack/cfftb1.c.





















































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* cfftb1.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int cfftb1_(integer *n, real *c__, real *ch, real *wa, 
	integer *ifac)
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    integer i__, k1, l1, l2, n2, na, nf, ip, iw, ix2, ix3, ix4, nac, ido, 
	    idl1, idot;
    extern /* Subroutine */ int passb_(integer *, integer *, integer *, 
	    integer *, integer *, real *, real *, real *, real *, real *, 
	    real *), passb2_(integer *, integer *, real *, real *, real *), 
	    passb3_(integer *, integer *, real *, real *, real *, real *), 
	    passb4_(integer *, integer *, real *, real *, real *, real *, 
	    real *), passb5_(integer *, integer *, real *, real *, real *, 
	    real *, real *, real *);

    /* Parameter adjustments */
    --ifac;
    --wa;
    --ch;
    --c__;

    /* Function Body */
    nf = ifac[2];
    na = 0;
    l1 = 1;
    iw = 1;
    i__1 = nf;
    for (k1 = 1; k1 <= i__1; ++k1) {
	ip = ifac[k1 + 2];
	l2 = ip * l1;
	ido = *n / l2;
	idot = ido + ido;
	idl1 = idot * l1;
	if (ip != 4) {
	    goto L103;
	}
	ix2 = iw + idot;
	ix3 = ix2 + idot;
	if (na != 0) {
	    goto L101;
	}
	passb4_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
	goto L102;
L101:
	passb4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
L102:
	na = 1 - na;
	goto L115;
L103:
	if (ip != 2) {
	    goto L106;
	}
	if (na != 0) {
	    goto L104;
	}
	passb2_(&idot, &l1, &c__[1], &ch[1], &wa[iw]);
	goto L105;
L104:
	passb2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]);
L105:
	na = 1 - na;
	goto L115;
L106:
	if (ip != 3) {
	    goto L109;
	}
	ix2 = iw + idot;
	if (na != 0) {
	    goto L107;
	}
	passb3_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
	goto L108;
L107:
	passb3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
L108:
	na = 1 - na;
	goto L115;
L109:
	if (ip != 5) {
	    goto L112;
	}
	ix2 = iw + idot;
	ix3 = ix2 + idot;
	ix4 = ix3 + idot;
	if (na != 0) {
	    goto L110;
	}
	passb5_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
		ix4]);
	goto L111;
L110:
	passb5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
		ix4]);
L111:
	na = 1 - na;
	goto L115;
L112:
	if (na != 0) {
	    goto L113;
	}
	passb_(&nac, &idot, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1]
		, &ch[1], &wa[iw]);
	goto L114;
L113:
	passb_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], 
		&c__[1], &wa[iw]);
L114:
	if (nac != 0) {
	    na = 1 - na;
	}
L115:
	l1 = l2;
	iw += (ip - 1) * idot;
/* L116: */
    }
    if (na == 0) {
	return 0;
    }
    n2 = *n + *n;
    i__1 = n2;
    for (i__ = 1; i__ <= i__1; ++i__) {
	c__[i__] = ch[i__];
/* L117: */
    }
    return 0;
} /* cfftb1_ */







Added c/fftpack/cfftb1.f.



































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE CFFTB1 (N,C,CH,WA,IFAC)
      DIMENSION       CH(1)      ,C(1)       ,WA(1)      ,IFAC(1)
      NF = IFAC(2)
      NA = 0
      L1 = 1
      IW = 1
      DO 116 K1=1,NF
         IP = IFAC(K1+2)
         L2 = IP*L1
         IDO = N/L2
         IDOT = IDO+IDO
         IDL1 = IDOT*L1
         IF (IP .NE. 4) GO TO 103
         IX2 = IW+IDOT
         IX3 = IX2+IDOT
         IF (NA .NE. 0) GO TO 101
         CALL PASSB4 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
         GO TO 102
  101    CALL PASSB4 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
  102    NA = 1-NA
         GO TO 115
  103    IF (IP .NE. 2) GO TO 106
         IF (NA .NE. 0) GO TO 104
         CALL PASSB2 (IDOT,L1,C,CH,WA(IW))
         GO TO 105
  104    CALL PASSB2 (IDOT,L1,CH,C,WA(IW))
  105    NA = 1-NA
         GO TO 115
  106    IF (IP .NE. 3) GO TO 109
         IX2 = IW+IDOT
         IF (NA .NE. 0) GO TO 107
         CALL PASSB3 (IDOT,L1,C,CH,WA(IW),WA(IX2))
         GO TO 108
  107    CALL PASSB3 (IDOT,L1,CH,C,WA(IW),WA(IX2))
  108    NA = 1-NA
         GO TO 115
  109    IF (IP .NE. 5) GO TO 112
         IX2 = IW+IDOT
         IX3 = IX2+IDOT
         IX4 = IX3+IDOT
         IF (NA .NE. 0) GO TO 110
         CALL PASSB5 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
         GO TO 111
  110    CALL PASSB5 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4))
  111    NA = 1-NA
         GO TO 115
  112    IF (NA .NE. 0) GO TO 113
         CALL PASSB (NAC,IDOT,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
         GO TO 114
  113    CALL PASSB (NAC,IDOT,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
  114    IF (NAC .NE. 0) NA = 1-NA
  115    L1 = L2
         IW = IW+(IP-1)*IDOT
  116 CONTINUE
      IF (NA .EQ. 0) RETURN
      N2 = N+N
      DO 117 I=1,N2
         C(I) = CH(I)
  117 CONTINUE
      RETURN
      END






Added c/fftpack/cfftf.c.








































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* cfftf.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int cfftf_(integer *n, real *c__, real *wsave)
{
    integer iw1, iw2;
    extern /* Subroutine */ int cfftf1_(integer *, real *, real *, real *, 
	    real *);

    /* Parameter adjustments */
    --wsave;
    --c__;

    /* Function Body */
    if (*n == 1) {
	return 0;
    }
    iw1 = *n + *n + 1;
    iw2 = iw1 + *n + *n;
    cfftf1_(n, &c__[1], &wsave[1], &wsave[iw1], &wsave[iw2]);
    return 0;
} /* cfftf_ */







Added c/fftpack/cfftf.f.














1
2
3
4
5
6
7
8

+
+
+
+
+
+
+
+

      SUBROUTINE CFFTF (N,C,WSAVE)
      DIMENSION       C(1)       ,WSAVE(1)
      IF (N .EQ. 1) RETURN
      IW1 = N+N+1
      IW2 = IW1+N+N
      CALL CFFTF1 (N,C,WSAVE,WSAVE(IW1),WSAVE(IW2))
      RETURN
      END






Added c/fftpack/cfftf1.c.





















































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* cfftf1.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int cfftf1_(integer *n, real *c__, real *ch, real *wa, 
	integer *ifac)
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    integer i__, k1, l1, l2, n2, na, nf, ip, iw, ix2, ix3, ix4, nac, ido, 
	    idl1, idot;
    extern /* Subroutine */ int passf_(integer *, integer *, integer *, 
	    integer *, integer *, real *, real *, real *, real *, real *, 
	    real *), passf2_(integer *, integer *, real *, real *, real *), 
	    passf3_(integer *, integer *, real *, real *, real *, real *), 
	    passf4_(integer *, integer *, real *, real *, real *, real *, 
	    real *), passf5_(integer *, integer *, real *, real *, real *, 
	    real *, real *, real *);

    /* Parameter adjustments */
    --ifac;
    --wa;
    --ch;
    --c__;

    /* Function Body */
    nf = ifac[2];
    na = 0;
    l1 = 1;
    iw = 1;
    i__1 = nf;
    for (k1 = 1; k1 <= i__1; ++k1) {
	ip = ifac[k1 + 2];
	l2 = ip * l1;
	ido = *n / l2;
	idot = ido + ido;
	idl1 = idot * l1;
	if (ip != 4) {
	    goto L103;
	}
	ix2 = iw + idot;
	ix3 = ix2 + idot;
	if (na != 0) {
	    goto L101;
	}
	passf4_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
	goto L102;
L101:
	passf4_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
L102:
	na = 1 - na;
	goto L115;
L103:
	if (ip != 2) {
	    goto L106;
	}
	if (na != 0) {
	    goto L104;
	}
	passf2_(&idot, &l1, &c__[1], &ch[1], &wa[iw]);
	goto L105;
L104:
	passf2_(&idot, &l1, &ch[1], &c__[1], &wa[iw]);
L105:
	na = 1 - na;
	goto L115;
L106:
	if (ip != 3) {
	    goto L109;
	}
	ix2 = iw + idot;
	if (na != 0) {
	    goto L107;
	}
	passf3_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
	goto L108;
L107:
	passf3_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
L108:
	na = 1 - na;
	goto L115;
L109:
	if (ip != 5) {
	    goto L112;
	}
	ix2 = iw + idot;
	ix3 = ix2 + idot;
	ix4 = ix3 + idot;
	if (na != 0) {
	    goto L110;
	}
	passf5_(&idot, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
		ix4]);
	goto L111;
L110:
	passf5_(&idot, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
		ix4]);
L111:
	na = 1 - na;
	goto L115;
L112:
	if (na != 0) {
	    goto L113;
	}
	passf_(&nac, &idot, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1]
		, &ch[1], &wa[iw]);
	goto L114;
L113:
	passf_(&nac, &idot, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], 
		&c__[1], &wa[iw]);
L114:
	if (nac != 0) {
	    na = 1 - na;
	}
L115:
	l1 = l2;
	iw += (ip - 1) * idot;
/* L116: */
    }
    if (na == 0) {
	return 0;
    }
    n2 = *n + *n;
    i__1 = n2;
    for (i__ = 1; i__ <= i__1; ++i__) {
	c__[i__] = ch[i__];
/* L117: */
    }
    return 0;
} /* cfftf1_ */







Added c/fftpack/cfftf1.f.



































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE CFFTF1 (N,C,CH,WA,IFAC)
      DIMENSION       CH(1)      ,C(1)       ,WA(1)      ,IFAC(1)
      NF = IFAC(2)
      NA = 0
      L1 = 1
      IW = 1
      DO 116 K1=1,NF
         IP = IFAC(K1+2)
         L2 = IP*L1
         IDO = N/L2
         IDOT = IDO+IDO
         IDL1 = IDOT*L1
         IF (IP .NE. 4) GO TO 103
         IX2 = IW+IDOT
         IX3 = IX2+IDOT
         IF (NA .NE. 0) GO TO 101
         CALL PASSF4 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
         GO TO 102
  101    CALL PASSF4 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
  102    NA = 1-NA
         GO TO 115
  103    IF (IP .NE. 2) GO TO 106
         IF (NA .NE. 0) GO TO 104
         CALL PASSF2 (IDOT,L1,C,CH,WA(IW))
         GO TO 105
  104    CALL PASSF2 (IDOT,L1,CH,C,WA(IW))
  105    NA = 1-NA
         GO TO 115
  106    IF (IP .NE. 3) GO TO 109
         IX2 = IW+IDOT
         IF (NA .NE. 0) GO TO 107
         CALL PASSF3 (IDOT,L1,C,CH,WA(IW),WA(IX2))
         GO TO 108
  107    CALL PASSF3 (IDOT,L1,CH,C,WA(IW),WA(IX2))
  108    NA = 1-NA
         GO TO 115
  109    IF (IP .NE. 5) GO TO 112
         IX2 = IW+IDOT
         IX3 = IX2+IDOT
         IX4 = IX3+IDOT
         IF (NA .NE. 0) GO TO 110
         CALL PASSF5 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
         GO TO 111
  110    CALL PASSF5 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4))
  111    NA = 1-NA
         GO TO 115
  112    IF (NA .NE. 0) GO TO 113
         CALL PASSF (NAC,IDOT,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
         GO TO 114
  113    CALL PASSF (NAC,IDOT,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
  114    IF (NAC .NE. 0) NA = 1-NA
  115    L1 = L2
         IW = IW+(IP-1)*IDOT
  116 CONTINUE
      IF (NA .EQ. 0) RETURN
      N2 = N+N
      DO 117 I=1,N2
         C(I) = CH(I)
  117 CONTINUE
      RETURN
      END






Added c/fftpack/cffti.c.






































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* cffti.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int cffti_(integer *n, real *wsave)
{
    integer iw1, iw2;
    extern /* Subroutine */ int cffti1_(integer *, real *, real *);

    /* Parameter adjustments */
    --wsave;

    /* Function Body */
    if (*n == 1) {
	return 0;
    }
    iw1 = *n + *n + 1;
    iw2 = iw1 + *n + *n;
    cffti1_(n, &wsave[iw1], &wsave[iw2]);
    return 0;
} /* cffti_ */







Added c/fftpack/cffti.f.














1
2
3
4
5
6
7
8

+
+
+
+
+
+
+
+

      SUBROUTINE CFFTI (N,WSAVE)
      DIMENSION       WSAVE(1)
      IF (N .EQ. 1) RETURN
      IW1 = N+N+1
      IW2 = IW1+N+N
      CALL CFFTI1 (N,WSAVE(IW1),WSAVE(IW2))
      RETURN
      END






Added c/fftpack/cffti1.c.








































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* cffti1.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int cffti1_(integer *n, real *wa, integer *ifac)
{
    /* Initialized data */

    static integer ntryh[4] = { 3,4,2,5 };

    /* System generated locals */
    integer i__1, i__2, i__3;

    /* Builtin functions */
    double cos(doublereal), sin(doublereal);

    /* Local variables */
    integer i__, j, i1, k1, l1, l2, ib;
    real fi;
    integer ld, ii, nf, ip, nl, nq, nr;
    real arg;
    integer ido, ipm;
    real tpi, argh;
    integer idot, ntry;
    real argld;

    /* Parameter adjustments */
    --ifac;
    --wa;

    /* Function Body */
    nl = *n;
    nf = 0;
    j = 0;
L101:
    ++j;
    if (j - 4 <= 0) {
	goto L102;
    } else {
	goto L103;
    }
L102:
    ntry = ntryh[j - 1];
    goto L104;
L103:
    ntry += 2;
L104:
    nq = nl / ntry;
    nr = nl - ntry * nq;
    if (nr != 0) {
	goto L101;
    } else {
	goto L105;
    }
L105:
    ++nf;
    ifac[nf + 2] = ntry;
    nl = nq;
    if (ntry != 2) {
	goto L107;
    }
    if (nf == 1) {
	goto L107;
    }
    i__1 = nf;
    for (i__ = 2; i__ <= i__1; ++i__) {
	ib = nf - i__ + 2;
	ifac[ib + 2] = ifac[ib + 1];
/* L106: */
    }
    ifac[3] = 2;
L107:
    if (nl != 1) {
	goto L104;
    }
    ifac[1] = *n;
    ifac[2] = nf;
    tpi = 6.28318530717959f;
    argh = tpi / (real) (*n);
    i__ = 2;
    l1 = 1;
    i__1 = nf;
    for (k1 = 1; k1 <= i__1; ++k1) {
	ip = ifac[k1 + 2];
	ld = 0;
	l2 = l1 * ip;
	ido = *n / l2;
	idot = ido + ido + 2;
	ipm = ip - 1;
	i__2 = ipm;
	for (j = 1; j <= i__2; ++j) {
	    i1 = i__;
	    wa[i__ - 1] = 1.f;
	    wa[i__] = 0.f;
	    ld += l1;
	    fi = 0.f;
	    argld = (real) ld * argh;
	    i__3 = idot;
	    for (ii = 4; ii <= i__3; ii += 2) {
		i__ += 2;
		fi += 1.f;
		arg = fi * argld;
		wa[i__ - 1] = cos(arg);
		wa[i__] = sin(arg);
/* L108: */
	    }
	    if (ip <= 5) {
		goto L109;
	    }
	    wa[i1 - 1] = wa[i__ - 1];
	    wa[i1] = wa[i__];
L109:
	    ;
	}
	l1 = l2;
/* L110: */
    }
    return 0;
} /* cffti1_ */







Added c/fftpack/cffti1.f.


































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE CFFTI1 (N,WA,IFAC)
      DIMENSION       WA(1)      ,IFAC(1)    ,NTRYH(4)
      DATA NTRYH(1),NTRYH(2),NTRYH(3),NTRYH(4)/3,4,2,5/
      NL = N
      NF = 0
      J = 0
  101 J = J+1
      IF (J-4) 102,102,103
  102 NTRY = NTRYH(J)
      GO TO 104
  103 NTRY = NTRY+2
  104 NQ = NL/NTRY
      NR = NL-NTRY*NQ
      IF (NR) 101,105,101
  105 NF = NF+1
      IFAC(NF+2) = NTRY
      NL = NQ
      IF (NTRY .NE. 2) GO TO 107
      IF (NF .EQ. 1) GO TO 107
      DO 106 I=2,NF
         IB = NF-I+2
         IFAC(IB+2) = IFAC(IB+1)
  106 CONTINUE
      IFAC(3) = 2
  107 IF (NL .NE. 1) GO TO 104
      IFAC(1) = N
      IFAC(2) = NF
      TPI = 6.28318530717959
      ARGH = TPI/FLOAT(N)
      I = 2
      L1 = 1
      DO 110 K1=1,NF
         IP = IFAC(K1+2)
         LD = 0
         L2 = L1*IP
         IDO = N/L2
         IDOT = IDO+IDO+2
         IPM = IP-1
         DO 109 J=1,IPM
            I1 = I
            WA(I-1) = 1.
            WA(I) = 0.
            LD = LD+L1
            FI = 0.
            ARGLD = FLOAT(LD)*ARGH
            DO 108 II=4,IDOT,2
               I = I+2
               FI = FI+1.
               ARG = FI*ARGLD
               WA(I-1) = COS(ARG)
               WA(I) = SIN(ARG)
  108       CONTINUE
            IF (IP .LE. 5) GO TO 109
            WA(I1-1) = WA(I-1)
            WA(I1) = WA(I)
  109    CONTINUE
         L1 = L2
  110 CONTINUE
      RETURN
      END






Added c/fftpack/cosqb.c.


























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* cosqb.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int cosqb_(integer *n, real *x, real *wsave)
{
    /* Initialized data */

    static real tsqrt2 = 2.82842712474619f;

    /* System generated locals */
    integer i__1;

    /* Local variables */
    real x1;
    extern /* Subroutine */ int cosqb1_(integer *, real *, real *, real *);

    /* Parameter adjustments */
    --wsave;
    --x;

    /* Function Body */
    if ((i__1 = *n - 2) < 0) {
	goto L101;
    } else if (i__1 == 0) {
	goto L102;
    } else {
	goto L103;
    }
L101:
    x[1] *= 4.f;
    return 0;
L102:
    x1 = (x[1] + x[2]) * 4.f;
    x[2] = tsqrt2 * (x[1] - x[2]);
    x[1] = x1;
    return 0;
L103:
    cosqb1_(n, &x[1], &wsave[1], &wsave[*n + 1]);
    return 0;
} /* cosqb_ */







Added c/fftpack/cosqb.f.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE COSQB (N,X,WSAVE)
      DIMENSION       X(1)       ,WSAVE(1)
      DATA TSQRT2 /2.82842712474619/
      IF (N-2) 101,102,103
  101 X(1) = 4.*X(1)
      RETURN
  102 X1 = 4.*(X(1)+X(2))
      X(2) = TSQRT2*(X(1)-X(2))
      X(1) = X1
      RETURN
  103 CALL COSQB1 (N,X,WSAVE,WSAVE(N+1))
      RETURN
      END






Added c/fftpack/cosqb1.c.









































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* cosqb1.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int cosqb1_(integer *n, real *x, real *w, real *xh)
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    integer i__, k, kc, np2, ns2;
    real xim1;
    integer modn;
    extern /* Subroutine */ int rfftb_(integer *, real *, real *);

    /* Parameter adjustments */
    --xh;
    --w;
    --x;

    /* Function Body */
    ns2 = (*n + 1) / 2;
    np2 = *n + 2;
    i__1 = *n;
    for (i__ = 3; i__ <= i__1; i__ += 2) {
	xim1 = x[i__ - 1] + x[i__];
	x[i__] -= x[i__ - 1];
	x[i__ - 1] = xim1;
/* L101: */
    }
    x[1] += x[1];
    modn = *n % 2;
    if (modn == 0) {
	x[*n] += x[*n];
    }
    rfftb_(n, &x[1], &xh[1]);
    i__1 = ns2;
    for (k = 2; k <= i__1; ++k) {
	kc = np2 - k;
	xh[k] = w[k - 1] * x[kc] + w[kc - 1] * x[k];
	xh[kc] = w[k - 1] * x[k] - w[kc - 1] * x[kc];
/* L102: */
    }
    if (modn == 0) {
	x[ns2 + 1] = w[ns2] * (x[ns2 + 1] + x[ns2 + 1]);
    }
    i__1 = ns2;
    for (k = 2; k <= i__1; ++k) {
	kc = np2 - k;
	x[k] = xh[k] + xh[kc];
	x[kc] = xh[k] - xh[kc];
/* L103: */
    }
    x[1] += x[1];
    return 0;
} /* cosqb1_ */







Added c/fftpack/cosqb1.f.

































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE COSQB1 (N,X,W,XH)
      DIMENSION       X(1)       ,W(1)       ,XH(1)
      NS2 = (N+1)/2
      NP2 = N+2
      DO 101 I=3,N,2
         XIM1 = X(I-1)+X(I)
         X(I) = X(I)-X(I-1)
         X(I-1) = XIM1
  101 CONTINUE
      X(1) = X(1)+X(1)
      MODN = MOD(N,2)
      IF (MODN .EQ. 0) X(N) = X(N)+X(N)
      CALL RFFTB (N,X,XH)
      DO 102 K=2,NS2
         KC = NP2-K
         XH(K) = W(K-1)*X(KC)+W(KC-1)*X(K)
         XH(KC) = W(K-1)*X(K)-W(KC-1)*X(KC)
  102 CONTINUE
      IF (MODN .EQ. 0) X(NS2+1) = W(NS2)*(X(NS2+1)+X(NS2+1))
      DO 103 K=2,NS2
         KC = NP2-K
         X(K) = XH(K)+XH(KC)
         X(KC) = XH(K)-XH(KC)
  103 CONTINUE
      X(1) = X(1)+X(1)
      RETURN
      END






Added c/fftpack/cosqf.c.
























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* cosqf.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int cosqf_(integer *n, real *x, real *wsave)
{
    /* Initialized data */

    static real sqrt2 = 1.4142135623731f;

    /* System generated locals */
    integer i__1;

    /* Local variables */
    real tsqx;
    extern /* Subroutine */ int cosqf1_(integer *, real *, real *, real *);

    /* Parameter adjustments */
    --wsave;
    --x;

    /* Function Body */
    if ((i__1 = *n - 2) < 0) {
	goto L102;
    } else if (i__1 == 0) {
	goto L101;
    } else {
	goto L103;
    }
L101:
    tsqx = sqrt2 * x[2];
    x[2] = x[1] - tsqx;
    x[1] += tsqx;
L102:
    return 0;
L103:
    cosqf1_(n, &x[1], &wsave[1], &wsave[*n + 1]);
    return 0;
} /* cosqf_ */







Added c/fftpack/cosqf.f.

















1
2
3
4
5
6
7
8
9
10
11

+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE COSQF (N,X,WSAVE)
      DIMENSION       X(1)       ,WSAVE(1)
      DATA SQRT2 /1.4142135623731/
      IF (N-2) 102,101,103
  101 TSQX = SQRT2*X(2)
      X(2) = X(1)-TSQX
      X(1) = X(1)+TSQX
  102 RETURN
  103 CALL COSQF1 (N,X,WSAVE,WSAVE(N+1))
      RETURN
      END






Added c/fftpack/cosqf1.c.







































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* cosqf1.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int cosqf1_(integer *n, real *x, real *w, real *xh)
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    integer i__, k, kc, np2, ns2;
    real xim1;
    integer modn;
    extern /* Subroutine */ int rfftf_(integer *, real *, real *);

    /* Parameter adjustments */
    --xh;
    --w;
    --x;

    /* Function Body */
    ns2 = (*n + 1) / 2;
    np2 = *n + 2;
    i__1 = ns2;
    for (k = 2; k <= i__1; ++k) {
	kc = np2 - k;
	xh[k] = x[k] + x[kc];
	xh[kc] = x[k] - x[kc];
/* L101: */
    }
    modn = *n % 2;
    if (modn == 0) {
	xh[ns2 + 1] = x[ns2 + 1] + x[ns2 + 1];
    }
    i__1 = ns2;
    for (k = 2; k <= i__1; ++k) {
	kc = np2 - k;
	x[k] = w[k - 1] * xh[kc] + w[kc - 1] * xh[k];
	x[kc] = w[k - 1] * xh[k] - w[kc - 1] * xh[kc];
/* L102: */
    }
    if (modn == 0) {
	x[ns2 + 1] = w[ns2] * xh[ns2 + 1];
    }
    rfftf_(n, &x[1], &xh[1]);
    i__1 = *n;
    for (i__ = 3; i__ <= i__1; i__ += 2) {
	xim1 = x[i__ - 1] - x[i__];
	x[i__] = x[i__ - 1] + x[i__];
	x[i__ - 1] = xim1;
/* L103: */
    }
    return 0;
} /* cosqf1_ */







Added c/fftpack/cosqf1.f.































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE COSQF1 (N,X,W,XH)
      DIMENSION       X(1)       ,W(1)       ,XH(1)
      NS2 = (N+1)/2
      NP2 = N+2
      DO 101 K=2,NS2
         KC = NP2-K
         XH(K) = X(K)+X(KC)
         XH(KC) = X(K)-X(KC)
  101 CONTINUE
      MODN = MOD(N,2)
      IF (MODN .EQ. 0) XH(NS2+1) = X(NS2+1)+X(NS2+1)
      DO 102 K=2,NS2
         KC = NP2-K
         X(K) = W(K-1)*XH(KC)+W(KC-1)*XH(K)
         X(KC) = W(K-1)*XH(K)-W(KC-1)*XH(KC)
  102 CONTINUE
      IF (MODN .EQ. 0) X(NS2+1) = W(NS2)*XH(NS2+1)
      CALL RFFTF (N,X,XH)
      DO 103 I=3,N,2
         XIM1 = X(I-1)-X(I)
         X(I) = X(I-1)+X(I)
         X(I-1) = XIM1
  103 CONTINUE
      RETURN
      END






Added c/fftpack/cosqi.c.





















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* cosqi.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int cosqi_(integer *n, real *wsave)
{
    /* Initialized data */

    static real pih = 1.57079632679491f;

    /* System generated locals */
    integer i__1;

    /* Builtin functions */
    double cos(doublereal);

    /* Local variables */
    integer k;
    real fk, dt;
    extern /* Subroutine */ int rffti_(integer *, real *);

    /* Parameter adjustments */
    --wsave;

    /* Function Body */
    dt = pih / (real) (*n);
    fk = 0.f;
    i__1 = *n;
    for (k = 1; k <= i__1; ++k) {
	fk += 1.f;
	wsave[k] = cos(fk * dt);
/* L101: */
    }
    rffti_(n, &wsave[*n + 1]);
    return 0;
} /* cosqi_ */







Added c/fftpack/cosqi.f.


















1
2
3
4
5
6
7
8
9
10
11
12

+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE COSQI (N,WSAVE)
      DIMENSION       WSAVE(1)
      DATA PIH /1.57079632679491/
      DT = PIH/FLOAT(N)
      FK = 0.
      DO 101 K=1,N
         FK = FK+1.
         WSAVE(K) = COS(FK*DT)
  101 CONTINUE
      CALL RFFTI (N,WSAVE(N+1))
      RETURN
      END






Added c/fftpack/cost.c.







































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* cost.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int cost_(integer *n, real *x, real *wsave)
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    integer i__, k;
    real c1, t1, t2;
    integer kc;
    real xi;
    integer nm1, np1;
    real x1h;
    integer ns2;
    real tx2, x1p3, xim2;
    integer modn;
    extern /* Subroutine */ int rfftf_(integer *, real *, real *);

    /* Parameter adjustments */
    --wsave;
    --x;

    /* Function Body */
    nm1 = *n - 1;
    np1 = *n + 1;
    ns2 = *n / 2;
    if ((i__1 = *n - 2) < 0) {
	goto L106;
    } else if (i__1 == 0) {
	goto L101;
    } else {
	goto L102;
    }
L101:
    x1h = x[1] + x[2];
    x[2] = x[1] - x[2];
    x[1] = x1h;
    return 0;
L102:
    if (*n > 3) {
	goto L103;
    }
    x1p3 = x[1] + x[3];
    tx2 = x[2] + x[2];
    x[2] = x[1] - x[3];
    x[1] = x1p3 + tx2;
    x[3] = x1p3 - tx2;
    return 0;
L103:
    c1 = x[1] - x[*n];
    x[1] += x[*n];
    i__1 = ns2;
    for (k = 2; k <= i__1; ++k) {
	kc = np1 - k;
	t1 = x[k] + x[kc];
	t2 = x[k] - x[kc];
	c1 += wsave[kc] * t2;
	t2 = wsave[k] * t2;
	x[k] = t1 - t2;
	x[kc] = t1 + t2;
/* L104: */
    }
    modn = *n % 2;
    if (modn != 0) {
	x[ns2 + 1] += x[ns2 + 1];
    }
    rfftf_(&nm1, &x[1], &wsave[*n + 1]);
    xim2 = x[2];
    x[2] = c1;
    i__1 = *n;
    for (i__ = 4; i__ <= i__1; i__ += 2) {
	xi = x[i__];
	x[i__] = x[i__ - 2] - x[i__ - 1];
	x[i__ - 1] = xim2;
	xim2 = xi;
/* L105: */
    }
    if (modn != 0) {
	x[*n] = xim2;
    }
L106:
    return 0;
} /* cost_ */







Added c/fftpack/cost.f.
















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE COST (N,X,WSAVE)
      DIMENSION       X(1)       ,WSAVE(1)
      NM1 = N-1
      NP1 = N+1
      NS2 = N/2
      IF (N-2) 106,101,102
  101 X1H = X(1)+X(2)
      X(2) = X(1)-X(2)
      X(1) = X1H
      RETURN
  102 IF (N .GT. 3) GO TO 103
      X1P3 = X(1)+X(3)
      TX2 = X(2)+X(2)
      X(2) = X(1)-X(3)
      X(1) = X1P3+TX2
      X(3) = X1P3-TX2
      RETURN
  103 C1 = X(1)-X(N)
      X(1) = X(1)+X(N)
      DO 104 K=2,NS2
         KC = NP1-K
         T1 = X(K)+X(KC)
         T2 = X(K)-X(KC)
         C1 = C1+WSAVE(KC)*T2
         T2 = WSAVE(K)*T2
         X(K) = T1-T2
         X(KC) = T1+T2
  104 CONTINUE
      MODN = MOD(N,2)
      IF (MODN .NE. 0) X(NS2+1) = X(NS2+1)+X(NS2+1)
      CALL RFFTF (NM1,X,WSAVE(N+1))
      XIM2 = X(2)
      X(2) = C1
      DO 105 I=4,N,2
         XI = X(I)
         X(I) = X(I-2)-X(I-1)
         X(I-1) = XIM2
         XIM2 = XI
  105 CONTINUE
      IF (MODN .NE. 0) X(N) = XIM2
  106 RETURN
      END






Added c/fftpack/costi.c.






























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* costi.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int costi_(integer *n, real *wsave)
{
    /* Initialized data */

    static real pi = 3.14159265358979f;

    /* System generated locals */
    integer i__1;

    /* Builtin functions */
    double sin(doublereal), cos(doublereal);

    /* Local variables */
    integer k, kc;
    real fk, dt;
    integer nm1, np1, ns2;
    extern /* Subroutine */ int rffti_(integer *, real *);

    /* Parameter adjustments */
    --wsave;

    /* Function Body */
    if (*n <= 3) {
	return 0;
    }
    nm1 = *n - 1;
    np1 = *n + 1;
    ns2 = *n / 2;
    dt = pi / (real) nm1;
    fk = 0.f;
    i__1 = ns2;
    for (k = 2; k <= i__1; ++k) {
	kc = np1 - k;
	fk += 1.f;
	wsave[k] = sin(fk * dt) * 2.f;
	wsave[kc] = cos(fk * dt) * 2.f;
/* L101: */
    }
    rffti_(&nm1, &wsave[*n + 1]);
    return 0;
} /* costi_ */







Added c/fftpack/costi.f.
























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE COSTI (N,WSAVE)
      DIMENSION       WSAVE(1)
      DATA PI /3.14159265358979/
      IF (N .LE. 3) RETURN
      NM1 = N-1
      NP1 = N+1
      NS2 = N/2
      DT = PI/FLOAT(NM1)
      FK = 0.
      DO 101 K=2,NS2
         KC = NP1-K
         FK = FK+1.
         WSAVE(K) = 2.*SIN(FK*DT)
         WSAVE(KC) = 2.*COS(FK*DT)
  101 CONTINUE
      CALL RFFTI (NM1,WSAVE(N+1))
      RETURN
      END






Added c/fftpack/doc.txt.








































































































































































































































































































































































































































































































































































































































































































































































































































































































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
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


                      FFTPACK

* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

                  version 4  april 1985

     a package of fortran subprograms for the fast fourier
      transform of periodic and other symmetric sequences

                         by

                  paul n swarztrauber

  national center for atmospheric research  boulder,colorado 80307

   which is sponsored by the national science foundation

* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *


this package consists of programs which perform fast fourier
transforms for both complex and real periodic sequences and
certain other symmetric sequences that are listed below.

1.   rffti     initialize  rfftf and rfftb
2.   rfftf     forward transform of a real periodic sequence
3.   rfftb     backward transform of a real coefficient array

4.   ezffti    initialize ezfftf and ezfftb
5.   ezfftf    a simplified real periodic forward transform
6.   ezfftb    a simplified real periodic backward transform

7.   sinti     initialize sint
8.   sint      sine transform of a real odd sequence

9.   costi     initialize cost
10.  cost      cosine transform of a real even sequence

11.  sinqi     initialize sinqf and sinqb
12.  sinqf     forward sine transform with odd wave numbers
13.  sinqb     unnormalized inverse of sinqf

14.  cosqi     initialize cosqf and cosqb
15.  cosqf     forward cosine transform with odd wave numbers
16.  cosqb     unnormalized inverse of cosqf

17.  cffti     initialize cfftf and cfftb
18.  cfftf     forward transform of a complex periodic sequence
19.  cfftb     unnormalized inverse of cfftf


******************************************************************

subroutine rffti(n,wsave)

  ****************************************************************

subroutine rffti initializes the array wsave which is used in
both rfftf and rfftb. the prime factorization of n together with
a tabulation of the trigonometric functions are computed and
stored in wsave.

input parameter

n       the length of the sequence to be transformed.

output parameter

wsave   a work array which must be dimensioned at least 2*n+15.
        the same work array can be used for both rfftf and rfftb
        as long as n remains unchanged. different wsave arrays
        are required for different values of n. the contents of
        wsave must not be changed between calls of rfftf or rfftb.

******************************************************************

subroutine rfftf(n,r,wsave)

******************************************************************

subroutine rfftf computes the fourier coefficients of a real
perodic sequence (fourier analysis). the transform is defined
below at output parameter r.

input parameters

n       the length of the array r to be transformed.  the method
        is most efficient when n is a product of small primes.
        n may change so long as different work arrays are provided

r       a real array of length n which contains the sequence
        to be transformed

wsave   a work array which must be dimensioned at least 2*n+15.
        in the program that calls rfftf. the wsave array must be
        initialized by calling subroutine rffti(n,wsave) and a
        different wsave array must be used for each different
        value of n. this initialization does not have to be
        repeated so long as n remains unchanged thus subsequent
        transforms can be obtained faster than the first.
        the same wsave array can be used by rfftf and rfftb.


output parameters

r       r(1) = the sum from i=1 to i=n of r(i)

        if n is even set l =n/2   , if n is odd set l = (n+1)/2

          then for k = 2,...,l

             r(2*k-2) = the sum from i = 1 to i = n of

                  r(i)*cos((k-1)*(i-1)*2*pi/n)

             r(2*k-1) = the sum from i = 1 to i = n of

                 -r(i)*sin((k-1)*(i-1)*2*pi/n)

        if n is even

             r(n) = the sum from i = 1 to i = n of

                  (-1)**(i-1)*r(i)

 *****  note
             this transform is unnormalized since a call of rfftf
             followed by a call of rfftb will multiply the input
             sequence by n.

wsave   contains results which must not be destroyed between
        calls of rfftf or rfftb.


******************************************************************

subroutine rfftb(n,r,wsave)

******************************************************************

subroutine rfftb computes the real perodic sequence from its
fourier coefficients (fourier synthesis). the transform is defined
below at output parameter r.

input parameters

n       the length of the array r to be transformed.  the method
        is most efficient when n is a product of small primes.
        n may change so long as different work arrays are provided

r       a real array of length n which contains the sequence
        to be transformed

wsave   a work array which must be dimensioned at least 2*n+15.
        in the program that calls rfftb. the wsave array must be
        initialized by calling subroutine rffti(n,wsave) and a
        different wsave array must be used for each different
        value of n. this initialization does not have to be
        repeated so long as n remains unchanged thus subsequent
        transforms can be obtained faster than the first.
        the same wsave array can be used by rfftf and rfftb.


output parameters

r       for n even and for i = 1,...,n

             r(i) = r(1)+(-1)**(i-1)*r(n)

                  plus the sum from k=2 to k=n/2 of

                   2.*r(2*k-2)*cos((k-1)*(i-1)*2*pi/n)

                  -2.*r(2*k-1)*sin((k-1)*(i-1)*2*pi/n)

        for n odd and for i = 1,...,n

             r(i) = r(1) plus the sum from k=2 to k=(n+1)/2 of

                  2.*r(2*k-2)*cos((k-1)*(i-1)*2*pi/n)

                 -2.*r(2*k-1)*sin((k-1)*(i-1)*2*pi/n)

 *****  note
             this transform is unnormalized since a call of rfftf
             followed by a call of rfftb will multiply the input
             sequence by n.

wsave   contains results which must not be destroyed between
        calls of rfftb or rfftf.


******************************************************************

subroutine ezffti(n,wsave)

******************************************************************

subroutine ezffti initializes the array wsave which is used in
both ezfftf and ezfftb. the prime factorization of n together with
a tabulation of the trigonometric functions are computed and
stored in wsave.

input parameter

n       the length of the sequence to be transformed.

output parameter

wsave   a work array which must be dimensioned at least 3*n+15.
        the same work array can be used for both ezfftf and ezfftb
        as long as n remains unchanged. different wsave arrays
        are required for different values of n.


******************************************************************

subroutine ezfftf(n,r,azero,a,b,wsave)

******************************************************************

subroutine ezfftf computes the fourier coefficients of a real
perodic sequence (fourier analysis). the transform is defined
below at output parameters azero,a and b. ezfftf is a simplified
but slower version of rfftf.

input parameters

n       the length of the array r to be transformed.  the method
        is must efficient when n is the product of small primes.

r       a real array of length n which contains the sequence
        to be transformed. r is not destroyed.


wsave   a work array which must be dimensioned at least 3*n+15.
        in the program that calls ezfftf. the wsave array must be
        initialized by calling subroutine ezffti(n,wsave) and a
        different wsave array must be used for each different
        value of n. this initialization does not have to be
        repeated so long as n remains unchanged thus subsequent
        transforms can be obtained faster than the first.
        the same wsave array can be used by ezfftf and ezfftb.

output parameters

azero   the sum from i=1 to i=n of r(i)/n

a,b     for n even b(n/2)=0. and a(n/2) is the sum from i=1 to
        i=n of (-1)**(i-1)*r(i)/n

        for n even define kmax=n/2-1
        for n odd  define kmax=(n-1)/2

        then for  k=1,...,kmax

             a(k) equals the sum from i=1 to i=n of

                  2./n*r(i)*cos(k*(i-1)*2*pi/n)

             b(k) equals the sum from i=1 to i=n of

                  2./n*r(i)*sin(k*(i-1)*2*pi/n)


******************************************************************

subroutine ezfftb(n,r,azero,a,b,wsave)

******************************************************************

subroutine ezfftb computes a real perodic sequence from its
fourier coefficients (fourier synthesis). the transform is
defined below at output parameter r. ezfftb is a simplified
but slower version of rfftb.

input parameters

n       the length of the output array r.  the method is most
        efficient when n is the product of small primes.

azero   the constant fourier coefficient

a,b     arrays which contain the remaining fourier coefficients
        these arrays are not destroyed.

        the length of these arrays depends on whether n is even or
        odd.

        if n is even n/2    locations are required
        if n is odd (n-1)/2 locations are required

wsave   a work array which must be dimensioned at least 3*n+15.
        in the program that calls ezfftb. the wsave array must be
        initialized by calling subroutine ezffti(n,wsave) and a
        different wsave array must be used for each different
        value of n. this initialization does not have to be
        repeated so long as n remains unchanged thus subsequent
        transforms can be obtained faster than the first.
        the same wsave array can be used by ezfftf and ezfftb.


output parameters

r       if n is even define kmax=n/2
        if n is odd  define kmax=(n-1)/2

        then for i=1,...,n

             r(i)=azero plus the sum from k=1 to k=kmax of

             a(k)*cos(k*(i-1)*2*pi/n)+b(k)*sin(k*(i-1)*2*pi/n)

********************* complex notation **************************

        for j=1,...,n

        r(j) equals the sum from k=-kmax to k=kmax of

             c(k)*exp(i*k*(j-1)*2*pi/n)

        where

             c(k) = .5*cmplx(a(k),-b(k))   for k=1,...,kmax

             c(-k) = conjg(c(k))

             c(0) = azero

                  and i=sqrt(-1)

*************** amplitude - phase notation ***********************

        for i=1,...,n

        r(i) equals azero plus the sum from k=1 to k=kmax of

             alpha(k)*cos(k*(i-1)*2*pi/n+beta(k))

        where

             alpha(k) = sqrt(a(k)*a(k)+b(k)*b(k))

             cos(beta(k))=a(k)/alpha(k)

             sin(beta(k))=-b(k)/alpha(k)

******************************************************************

subroutine sinti(n,wsave)

******************************************************************

subroutine sinti initializes the array wsave which is used in
subroutine sint. the prime factorization of n together with
a tabulation of the trigonometric functions are computed and
stored in wsave.

input parameter

n       the length of the sequence to be transformed.  the method
        is most efficient when n+1 is a product of small primes.

output parameter

wsave   a work array with at least int(2.5*n+15) locations.
        different wsave arrays are required for different values
        of n. the contents of wsave must not be changed between
        calls of sint.

******************************************************************

subroutine sint(n,x,wsave)

******************************************************************

subroutine sint computes the discrete fourier sine transform
of an odd sequence x(i). the transform is defined below at
output parameter x.

sint is the unnormalized inverse of itself since a call of sint
followed by another call of sint will multiply the input sequence
x by 2*(n+1).

the array wsave which is used by subroutine sint must be
initialized by calling subroutine sinti(n,wsave).

input parameters

n       the length of the sequence to be transformed.  the method
        is most efficient when n+1 is the product of small primes.

x       an array which contains the sequence to be transformed


wsave   a work array with dimension at least int(2.5*n+15)
        in the program that calls sint. the wsave array must be
        initialized by calling subroutine sinti(n,wsave) and a
        different wsave array must be used for each different
        value of n. this initialization does not have to be
        repeated so long as n remains unchanged thus subsequent
        transforms can be obtained faster than the first.

output parameters

x       for i=1,...,n

             x(i)= the sum from k=1 to k=n

                  2*x(k)*sin(k*i*pi/(n+1))

             a call of sint followed by another call of
             sint will multiply the sequence x by 2*(n+1).
             hence sint is the unnormalized inverse
             of itself.

wsave   contains initialization calculations which must not be
        destroyed between calls of sint.

******************************************************************

subroutine costi(n,wsave)

******************************************************************

subroutine costi initializes the array wsave which is used in
subroutine cost. the prime factorization of n together with
a tabulation of the trigonometric functions are computed and
stored in wsave.

input parameter

n       the length of the sequence to be transformed.  the method
        is most efficient when n-1 is a product of small primes.

output parameter

wsave   a work array which must be dimensioned at least 3*n+15.
        different wsave arrays are required for different values
        of n. the contents of wsave must not be changed between
        calls of cost.

******************************************************************

subroutine cost(n,x,wsave)

******************************************************************

subroutine cost computes the discrete fourier cosine transform
of an even sequence x(i). the transform is defined below at output
parameter x.

cost is the unnormalized inverse of itself since a call of cost
followed by another call of cost will multiply the input sequence
x by 2*(n-1). the transform is defined below at output parameter x

the array wsave which is used by subroutine cost must be
initialized by calling subroutine costi(n,wsave).

input parameters

n       the length of the sequence x. n must be greater than 1.
        the method is most efficient when n-1 is a product of
        small primes.

x       an array which contains the sequence to be transformed

wsave   a work array which must be dimensioned at least 3*n+15
        in the program that calls cost. the wsave array must be
        initialized by calling subroutine costi(n,wsave) and a
        different wsave array must be used for each different
        value of n. this initialization does not have to be
        repeated so long as n remains unchanged thus subsequent
        transforms can be obtained faster than the first.

output parameters

x       for i=1,...,n

            x(i) = x(1)+(-1)**(i-1)*x(n)

             + the sum from k=2 to k=n-1

                 2*x(k)*cos((k-1)*(i-1)*pi/(n-1))

             a call of cost followed by another call of
             cost will multiply the sequence x by 2*(n-1)
             hence cost is the unnormalized inverse
             of itself.

wsave   contains initialization calculations which must not be
        destroyed between calls of cost.

******************************************************************

subroutine sinqi(n,wsave)

******************************************************************

subroutine sinqi initializes the array wsave which is used in
both sinqf and sinqb. the prime factorization of n together with
a tabulation of the trigonometric functions are computed and
stored in wsave.

input parameter

n       the length of the sequence to be transformed. the method
        is most efficient when n is a product of small primes.

output parameter

wsave   a work array which must be dimensioned at least 3*n+15.
        the same work array can be used for both sinqf and sinqb
        as long as n remains unchanged. different wsave arrays
        are required for different values of n. the contents of
        wsave must not be changed between calls of sinqf or sinqb.

******************************************************************

subroutine sinqf(n,x,wsave)

******************************************************************

subroutine sinqf computes the fast fourier transform of quarter
wave data. that is , sinqf computes the coefficients in a sine
series representation with only odd wave numbers. the transform
is defined below at output parameter x.

sinqb is the unnormalized inverse of sinqf since a call of sinqf
followed by a call of sinqb will multiply the input sequence x
by 4*n.

the array wsave which is used by subroutine sinqf must be
initialized by calling subroutine sinqi(n,wsave).


input parameters

n       the length of the array x to be transformed.  the method
        is most efficient when n is a product of small primes.

x       an array which contains the sequence to be transformed

wsave   a work array which must be dimensioned at least 3*n+15.
        in the program that calls sinqf. the wsave array must be
        initialized by calling subroutine sinqi(n,wsave) and a
        different wsave array must be used for each different
        value of n. this initialization does not have to be
        repeated so long as n remains unchanged thus subsequent
        transforms can be obtained faster than the first.

output parameters

x       for i=1,...,n

             x(i) = (-1)**(i-1)*x(n)

                + the sum from k=1 to k=n-1 of

                2*x(k)*sin((2*i-1)*k*pi/(2*n))

             a call of sinqf followed by a call of
             sinqb will multiply the sequence x by 4*n.
             therefore sinqb is the unnormalized inverse
             of sinqf.

wsave   contains initialization calculations which must not
        be destroyed between calls of sinqf or sinqb.

******************************************************************

subroutine sinqb(n,x,wsave)

******************************************************************

subroutine sinqb computes the fast fourier transform of quarter
wave data. that is , sinqb computes a sequence from its
representation in terms of a sine series with odd wave numbers.
the transform is defined below at output parameter x.

sinqf is the unnormalized inverse of sinqb since a call of sinqb
followed by a call of sinqf will multiply the input sequence x
by 4*n.

the array wsave which is used by subroutine sinqb must be
initialized by calling subroutine sinqi(n,wsave).


input parameters

n       the length of the array x to be transformed.  the method
        is most efficient when n is a product of small primes.

x       an array which contains the sequence to be transformed

wsave   a work array which must be dimensioned at least 3*n+15.
        in the program that calls sinqb. the wsave array must be
        initialized by calling subroutine sinqi(n,wsave) and a
        different wsave array must be used for each different
        value of n. this initialization does not have to be
        repeated so long as n remains unchanged thus subsequent
        transforms can be obtained faster than the first.

output parameters

x       for i=1,...,n

             x(i)= the sum from k=1 to k=n of

               4*x(k)*sin((2k-1)*i*pi/(2*n))

             a call of sinqb followed by a call of
             sinqf will multiply the sequence x by 4*n.
             therefore sinqf is the unnormalized inverse
             of sinqb.

wsave   contains initialization calculations which must not
        be destroyed between calls of sinqb or sinqf.

******************************************************************

subroutine cosqi(n,wsave)

******************************************************************

subroutine cosqi initializes the array wsave which is used in
both cosqf and cosqb. the prime factorization of n together with
a tabulation of the trigonometric functions are computed and
stored in wsave.

input parameter

n       the length of the array to be transformed.  the method
        is most efficient when n is a product of small primes.

output parameter

wsave   a work array which must be dimensioned at least 3*n+15.
        the same work array can be used for both cosqf and cosqb
        as long as n remains unchanged. different wsave arrays
        are required for different values of n. the contents of
        wsave must not be changed between calls of cosqf or cosqb.

******************************************************************

subroutine cosqf(n,x,wsave)

******************************************************************

subroutine cosqf computes the fast fourier transform of quarter
wave data. that is , cosqf computes the coefficients in a cosine
series representation with only odd wave numbers. the transform
is defined below at output parameter x

cosqf is the unnormalized inverse of cosqb since a call of cosqf
followed by a call of cosqb will multiply the input sequence x
by 4*n.

the array wsave which is used by subroutine cosqf must be
initialized by calling subroutine cosqi(n,wsave).


input parameters

n       the length of the array x to be transformed.  the method
        is most efficient when n is a product of small primes.

x       an array which contains the sequence to be transformed

wsave   a work array which must be dimensioned at least 3*n+15
        in the program that calls cosqf. the wsave array must be
        initialized by calling subroutine cosqi(n,wsave) and a
        different wsave array must be used for each different
        value of n. this initialization does not have to be
        repeated so long as n remains unchanged thus subsequent
        transforms can be obtained faster than the first.

output parameters

x       for i=1,...,n

             x(i) = x(1) plus the sum from k=2 to k=n of

                2*x(k)*cos((2*i-1)*(k-1)*pi/(2*n))

             a call of cosqf followed by a call of
             cosqb will multiply the sequence x by 4*n.
             therefore cosqb is the unnormalized inverse
             of cosqf.

wsave   contains initialization calculations which must not
        be destroyed between calls of cosqf or cosqb.

******************************************************************

subroutine cosqb(n,x,wsave)

******************************************************************

subroutine cosqb computes the fast fourier transform of quarter
wave data. that is , cosqb computes a sequence from its
representation in terms of a cosine series with odd wave numbers.
the transform is defined below at output parameter x.

cosqb is the unnormalized inverse of cosqf since a call of cosqb
followed by a call of cosqf will multiply the input sequence x
by 4*n.

the array wsave which is used by subroutine cosqb must be
initialized by calling subroutine cosqi(n,wsave).


input parameters

n       the length of the array x to be transformed.  the method
        is most efficient when n is a product of small primes.

x       an array which contains the sequence to be transformed

wsave   a work array that must be dimensioned at least 3*n+15
        in the program that calls cosqb. the wsave array must be
        initialized by calling subroutine cosqi(n,wsave) and a
        different wsave array must be used for each different
        value of n. this initialization does not have to be
        repeated so long as n remains unchanged thus subsequent
        transforms can be obtained faster than the first.

output parameters

x       for i=1,...,n

             x(i)= the sum from k=1 to k=n of

               4*x(k)*cos((2*k-1)*(i-1)*pi/(2*n))

             a call of cosqb followed by a call of
             cosqf will multiply the sequence x by 4*n.
             therefore cosqf is the unnormalized inverse
             of cosqb.

wsave   contains initialization calculations which must not
        be destroyed between calls of cosqb or cosqf.

******************************************************************

subroutine cffti(n,wsave)

******************************************************************

subroutine cffti initializes the array wsave which is used in
both cfftf and cfftb. the prime factorization of n together with
a tabulation of the trigonometric functions are computed and
stored in wsave.

input parameter

n       the length of the sequence to be transformed

output parameter

wsave   a work array which must be dimensioned at least 4*n+15
        the same work array can be used for both cfftf and cfftb
        as long as n remains unchanged. different wsave arrays
        are required for different values of n. the contents of
        wsave must not be changed between calls of cfftf or cfftb.

******************************************************************

subroutine cfftf(n,c,wsave)

******************************************************************

subroutine cfftf computes the forward complex discrete fourier
transform (the fourier analysis). equivalently , cfftf computes
the fourier coefficients of a complex periodic sequence.
the transform is defined below at output parameter c.

the transform is not normalized. to obtain a normalized transform
the output must be divided by n. otherwise a call of cfftf
followed by a call of cfftb will multiply the sequence by n.

the array wsave which is used by subroutine cfftf must be
initialized by calling subroutine cffti(n,wsave).

input parameters


n      the length of the complex sequence c. the method is
       more efficient when n is the product of small primes. n

c      a complex array of length n which contains the sequence

wsave   a real work array which must be dimensioned at least 4n+15
        in the program that calls cfftf. the wsave array must be
        initialized by calling subroutine cffti(n,wsave) and a
        different wsave array must be used for each different
        value of n. this initialization does not have to be
        repeated so long as n remains unchanged thus subsequent
        transforms can be obtained faster than the first.
        the same wsave array can be used by cfftf and cfftb.

output parameters

c      for j=1,...,n

           c(j)=the sum from k=1,...,n of

                 c(k)*exp(-i*(j-1)*(k-1)*2*pi/n)

                       where i=sqrt(-1)

wsave   contains initialization calculations which must not be
        destroyed between calls of subroutine cfftf or cfftb

******************************************************************

subroutine cfftb(n,c,wsave)

******************************************************************

subroutine cfftb computes the backward complex discrete fourier
transform (the fourier synthesis). equivalently , cfftb computes
a complex periodic sequence from its fourier coefficients.
the transform is defined below at output parameter c.

a call of cfftf followed by a call of cfftb will multiply the
sequence by n.

the array wsave which is used by subroutine cfftb must be
initialized by calling subroutine cffti(n,wsave).

input parameters


n      the length of the complex sequence c. the method is
       more efficient when n is the product of small primes.

c      a complex array of length n which contains the sequence

wsave   a real work array which must be dimensioned at least 4n+15
        in the program that calls cfftb. the wsave array must be
        initialized by calling subroutine cffti(n,wsave) and a
        different wsave array must be used for each different
        value of n. this initialization does not have to be
        repeated so long as n remains unchanged thus subsequent
        transforms can be obtained faster than the first.
        the same wsave array can be used by cfftf and cfftb.

output parameters

c      for j=1,...,n

           c(j)=the sum from k=1,...,n of

                 c(k)*exp(i*(j-1)*(k-1)*2*pi/n)

                       where i=sqrt(-1)

wsave   contains initialization calculations which must not be
        destroyed between calls of subroutine cfftf or cfftb



["send index for vfftpk" describes a vectorized version of fftpack]







Added c/fftpack/ezfft1.c.











































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* ezfft1.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int ezfft1_(integer *n, real *wa, integer *ifac)
{
    /* Initialized data */

    static integer ntryh[4] = { 4,2,3,5 };
    static real tpi = 6.28318530717959f;

    /* System generated locals */
    integer i__1, i__2, i__3;

    /* Builtin functions */
    double cos(doublereal), sin(doublereal);

    /* Local variables */
    integer i__, j, k1, l1, l2, ib, ii, nf, ip, nl, is, nq, nr;
    real ch1, sh1;
    integer ido, ipm;
    real dch1, ch1h, arg1, dsh1;
    integer nfm1;
    real argh;
    integer ntry;

    /* Parameter adjustments */
    --ifac;
    --wa;

    /* Function Body */
    nl = *n;
    nf = 0;
    j = 0;
L101:
    ++j;
    if (j - 4 <= 0) {
	goto L102;
    } else {
	goto L103;
    }
L102:
    ntry = ntryh[j - 1];
    goto L104;
L103:
    ntry += 2;
L104:
    nq = nl / ntry;
    nr = nl - ntry * nq;
    if (nr != 0) {
	goto L101;
    } else {
	goto L105;
    }
L105:
    ++nf;
    ifac[nf + 2] = ntry;
    nl = nq;
    if (ntry != 2) {
	goto L107;
    }
    if (nf == 1) {
	goto L107;
    }
    i__1 = nf;
    for (i__ = 2; i__ <= i__1; ++i__) {
	ib = nf - i__ + 2;
	ifac[ib + 2] = ifac[ib + 1];
/* L106: */
    }
    ifac[3] = 2;
L107:
    if (nl != 1) {
	goto L104;
    }
    ifac[1] = *n;
    ifac[2] = nf;
    argh = tpi / (real) (*n);
    is = 0;
    nfm1 = nf - 1;
    l1 = 1;
    if (nfm1 == 0) {
	return 0;
    }
    i__1 = nfm1;
    for (k1 = 1; k1 <= i__1; ++k1) {
	ip = ifac[k1 + 2];
	l2 = l1 * ip;
	ido = *n / l2;
	ipm = ip - 1;
	arg1 = (real) l1 * argh;
	ch1 = 1.f;
	sh1 = 0.f;
	dch1 = cos(arg1);
	dsh1 = sin(arg1);
	i__2 = ipm;
	for (j = 1; j <= i__2; ++j) {
	    ch1h = dch1 * ch1 - dsh1 * sh1;
	    sh1 = dch1 * sh1 + dsh1 * ch1;
	    ch1 = ch1h;
	    i__ = is + 2;
	    wa[i__ - 1] = ch1;
	    wa[i__] = sh1;
	    if (ido < 5) {
		goto L109;
	    }
	    i__3 = ido;
	    for (ii = 5; ii <= i__3; ii += 2) {
		i__ += 2;
		wa[i__ - 1] = ch1 * wa[i__ - 3] - sh1 * wa[i__ - 2];
		wa[i__] = ch1 * wa[i__ - 2] + sh1 * wa[i__ - 3];
/* L108: */
	    }
L109:
	    is += ido;
/* L110: */
	}
	l1 = l2;
/* L111: */
    }
    return 0;
} /* ezfft1_ */







Added c/fftpack/ezfft1.f.




































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE EZFFT1 (N,WA,IFAC)
      DIMENSION       WA(1)      ,IFAC(1)    ,NTRYH(4)
      DATA NTRYH(1),NTRYH(2),NTRYH(3),NTRYH(4)/4,2,3,5/
     1    ,TPI/6.28318530717959/
      NL = N
      NF = 0
      J = 0
  101 J = J+1
      IF (J-4) 102,102,103
  102 NTRY = NTRYH(J)
      GO TO 104
  103 NTRY = NTRY+2
  104 NQ = NL/NTRY
      NR = NL-NTRY*NQ
      IF (NR) 101,105,101
  105 NF = NF+1
      IFAC(NF+2) = NTRY
      NL = NQ
      IF (NTRY .NE. 2) GO TO 107
      IF (NF .EQ. 1) GO TO 107
      DO 106 I=2,NF
         IB = NF-I+2
         IFAC(IB+2) = IFAC(IB+1)
  106 CONTINUE
      IFAC(3) = 2
  107 IF (NL .NE. 1) GO TO 104
      IFAC(1) = N
      IFAC(2) = NF
      ARGH = TPI/FLOAT(N)
      IS = 0
      NFM1 = NF-1
      L1 = 1
      IF (NFM1 .EQ. 0) RETURN
      DO 111 K1=1,NFM1
         IP = IFAC(K1+2)
         L2 = L1*IP
         IDO = N/L2
         IPM = IP-1
         ARG1 = FLOAT(L1)*ARGH
         CH1 = 1.
         SH1 = 0.
         DCH1 = COS(ARG1)
         DSH1 = SIN(ARG1)
         DO 110 J=1,IPM
            CH1H = DCH1*CH1-DSH1*SH1
            SH1 = DCH1*SH1+DSH1*CH1
            CH1 = CH1H
            I = IS+2
            WA(I-1) = CH1
            WA(I) = SH1
            IF (IDO .LT. 5) GO TO 109
            DO 108 II=5,IDO,2
               I = I+2
               WA(I-1) = CH1*WA(I-3)-SH1*WA(I-2)
               WA(I) = CH1*WA(I-2)+SH1*WA(I-3)
  108       CONTINUE
  109       IS = IS+IDO
  110    CONTINUE
         L1 = L2
  111 CONTINUE
      RETURN
      END






Added c/fftpack/ezfftb.c.



































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* ezfftb.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int ezfftb_(integer *n, real *r__, real *azero, real *a, 
	real *b, real *wsave)
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    integer i__, ns2;
    extern /* Subroutine */ int rfftb_(integer *, real *, real *);

    /* Parameter adjustments */
    --wsave;
    --b;
    --a;
    --r__;

    /* Function Body */
    if ((i__1 = *n - 2) < 0) {
	goto L101;
    } else if (i__1 == 0) {
	goto L102;
    } else {
	goto L103;
    }
L101:
    r__[1] = *azero;
    return 0;
L102:
    r__[1] = *azero + a[1];
    r__[2] = *azero - a[1];
    return 0;
L103:
    ns2 = (*n - 1) / 2;
    i__1 = ns2;
    for (i__ = 1; i__ <= i__1; ++i__) {
	r__[i__ * 2] = a[i__] * .5f;
	r__[(i__ << 1) + 1] = b[i__] * -.5f;
/* L104: */
    }
    r__[1] = *azero;
    if (*n % 2 == 0) {
	r__[*n] = a[ns2 + 1];
    }
    rfftb_(n, &r__[1], &wsave[*n + 1]);
    return 0;
} /* ezfftb_ */







Added c/fftpack/ezfftb.f.
























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE EZFFTB (N,R,AZERO,A,B,WSAVE)
      DIMENSION       R(1)       ,A(1)       ,B(1)       ,WSAVE(1)
      IF (N-2) 101,102,103
  101 R(1) = AZERO
      RETURN
  102 R(1) = AZERO+A(1)
      R(2) = AZERO-A(1)
      RETURN
  103 NS2 = (N-1)/2
      DO 104 I=1,NS2
         R(2*I) = .5*A(I)
         R(2*I+1) = -.5*B(I)
  104 CONTINUE
      R(1) = AZERO
      IF (MOD(N,2) .EQ. 0) R(N) = A(NS2+1)
      CALL RFFTB (N,R,WSAVE(N+1))
      RETURN
      END






Added c/fftpack/ezfftf.c.




















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* ezfftf.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int ezfftf_(integer *n, real *r__, real *azero, real *a, 
	real *b, real *wsave)
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    integer i__;
    real cf;
    integer ns2;
    real cfm;
    integer ns2m;
    extern /* Subroutine */ int rfftf_(integer *, real *, real *);


/*                       VERSION 3  JUNE 1979 */

    /* Parameter adjustments */
    --wsave;
    --b;
    --a;
    --r__;

    /* Function Body */
    if ((i__1 = *n - 2) < 0) {
	goto L101;
    } else if (i__1 == 0) {
	goto L102;
    } else {
	goto L103;
    }
L101:
    *azero = r__[1];
    return 0;
L102:
    *azero = (r__[1] + r__[2]) * .5f;
    a[1] = (r__[1] - r__[2]) * .5f;
    return 0;
L103:
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	wsave[i__] = r__[i__];
/* L104: */
    }
    rfftf_(n, &wsave[1], &wsave[*n + 1]);
    cf = 2.f / (real) (*n);
    cfm = -cf;
    *azero = cf * .5f * wsave[1];
    ns2 = (*n + 1) / 2;
    ns2m = ns2 - 1;
    i__1 = ns2m;
    for (i__ = 1; i__ <= i__1; ++i__) {
	a[i__] = cf * wsave[i__ * 2];
	b[i__] = cfm * wsave[(i__ << 1) + 1];
/* L105: */
    }
    if (*n % 2 == 1) {
	return 0;
    }
    a[ns2] = cf * .5f * wsave[*n];
    b[ns2] = 0.f;
    return 0;
} /* ezfftf_ */







Added c/fftpack/ezfftf.f.



































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE EZFFTF (N,R,AZERO,A,B,WSAVE)
C
C                       VERSION 3  JUNE 1979
C
      DIMENSION       R(1)       ,A(1)       ,B(1)       ,WSAVE(1)
      IF (N-2) 101,102,103
  101 AZERO = R(1)
      RETURN
  102 AZERO = .5*(R(1)+R(2))
      A(1) = .5*(R(1)-R(2))
      RETURN
  103 DO 104 I=1,N
         WSAVE(I) = R(I)
  104 CONTINUE
      CALL RFFTF (N,WSAVE,WSAVE(N+1))
      CF = 2./FLOAT(N)
      CFM = -CF
      AZERO = .5*CF*WSAVE(1)
      NS2 = (N+1)/2
      NS2M = NS2-1
      DO 105 I=1,NS2M
         A(I) = CF*WSAVE(2*I)
         B(I) = CFM*WSAVE(2*I+1)
  105 CONTINUE
      IF (MOD(N,2) .EQ. 1) RETURN
      A(NS2) = .5*CF*WSAVE(N)
      B(NS2) = 0.
      RETURN
      END






Added c/fftpack/ezffti.c.



































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* ezffti.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int ezffti_(integer *n, real *wsave)
{
    extern /* Subroutine */ int ezfft1_(integer *, real *, real *);

    /* Parameter adjustments */
    --wsave;

    /* Function Body */
    if (*n == 1) {
	return 0;
    }
    ezfft1_(n, &wsave[(*n << 1) + 1], &wsave[*n * 3 + 1]);
    return 0;
} /* ezffti_ */







Added c/fftpack/ezffti.f.












1
2
3
4
5
6

+
+
+
+
+
+

      SUBROUTINE EZFFTI (N,WSAVE)
      DIMENSION       WSAVE(1)
      IF (N .EQ. 1) RETURN
      CALL EZFFT1 (N,WSAVE(2*N+1),WSAVE(3*N+1))
      RETURN
      END






Added c/fftpack/f2c.h.





































































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* f2c.h  --  Standard Fortran to C header file */

/**  barf  [ba:rf]  2.  "He suggested using FORTRAN, and everybody barfed."

	- From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) */

#ifndef F2C_INCLUDE
#define F2C_INCLUDE

typedef long int integer;
typedef unsigned long int uinteger;
typedef char *address;
typedef short int shortint;
typedef float real;
typedef double doublereal;
typedef struct { real r, i; } complex;
typedef struct { doublereal r, i; } doublecomplex;
typedef long int logical;
typedef short int shortlogical;
typedef char logical1;
typedef char integer1;
#ifdef INTEGER_STAR_8	/* Adjust for integer*8. */
typedef long long longint;		/* system-dependent */
typedef unsigned long long ulongint;	/* system-dependent */
#define qbit_clear(a,b)	((a) & ~((ulongint)1 << (b)))
#define qbit_set(a,b)	((a) |  ((ulongint)1 << (b)))
#endif

#define TRUE_ (1)
#define FALSE_ (0)

/* Extern is for use with -E */
#ifndef Extern
#define Extern extern
#endif

/* I/O stuff */

#ifdef f2c_i2
/* for -i2 */
typedef short flag;
typedef short ftnlen;
typedef short ftnint;
#else
typedef long int flag;
typedef long int ftnlen;
typedef long int ftnint;
#endif

/*external read, write*/
typedef struct
{	flag cierr;
	ftnint ciunit;
	flag ciend;
	char *cifmt;
	ftnint cirec;
} cilist;

/*internal read, write*/
typedef struct
{	flag icierr;
	char *iciunit;
	flag iciend;
	char *icifmt;
	ftnint icirlen;
	ftnint icirnum;
} icilist;

/*open*/
typedef struct
{	flag oerr;
	ftnint ounit;
	char *ofnm;
	ftnlen ofnmlen;
	char *osta;
	char *oacc;
	char *ofm;
	ftnint orl;
	char *oblnk;
} olist;

/*close*/
typedef struct
{	flag cerr;
	ftnint cunit;
	char *csta;
} cllist;

/*rewind, backspace, endfile*/
typedef struct
{	flag aerr;
	ftnint aunit;
} alist;

/* inquire */
typedef struct
{	flag inerr;
	ftnint inunit;
	char *infile;
	ftnlen infilen;
	ftnint	*inex;	/*parameters in standard's order*/
	ftnint	*inopen;
	ftnint	*innum;
	ftnint	*innamed;
	char	*inname;
	ftnlen	innamlen;
	char	*inacc;
	ftnlen	inacclen;
	char	*inseq;
	ftnlen	inseqlen;
	char 	*indir;
	ftnlen	indirlen;
	char	*infmt;
	ftnlen	infmtlen;
	char	*inform;
	ftnint	informlen;
	char	*inunf;
	ftnlen	inunflen;
	ftnint	*inrecl;
	ftnint	*innrec;
	char	*inblank;
	ftnlen	inblanklen;
} inlist;

#define VOID void

union Multitype {	/* for multiple entry points */
	integer1 g;
	shortint h;
	integer i;
	/* longint j; */
	real r;
	doublereal d;
	complex c;
	doublecomplex z;
	};

typedef union Multitype Multitype;

/*typedef long int Long;*/	/* No longer used; formerly in Namelist */

struct Vardesc {	/* for Namelist */
	char *name;
	char *addr;
	ftnlen *dims;
	int  type;
	};
typedef struct Vardesc Vardesc;

struct Namelist {
	char *name;
	Vardesc **vars;
	int nvars;
	};
typedef struct Namelist Namelist;

#define abs(x) ((x) >= 0 ? (x) : -(x))
#define dabs(x) (doublereal)abs(x)
#define min(a,b) ((a) <= (b) ? (a) : (b))
#define max(a,b) ((a) >= (b) ? (a) : (b))
#define dmin(a,b) (doublereal)min(a,b)
#define dmax(a,b) (doublereal)max(a,b)
#define bit_test(a,b)	((a) >> (b) & 1)
#define bit_clear(a,b)	((a) & ~((uinteger)1 << (b)))
#define bit_set(a,b)	((a) |  ((uinteger)1 << (b)))

/* procedure parameter types for -A and -C++ */

#define F2C_proc_par_types 1
#ifdef __cplusplus
typedef int /* Unknown procedure type */ (*U_fp)(...);
typedef shortint (*J_fp)(...);
typedef integer (*I_fp)(...);
typedef real (*R_fp)(...);
typedef doublereal (*D_fp)(...), (*E_fp)(...);
typedef /* Complex */ VOID (*C_fp)(...);
typedef /* Double Complex */ VOID (*Z_fp)(...);
typedef logical (*L_fp)(...);
typedef shortlogical (*K_fp)(...);
typedef /* Character */ VOID (*H_fp)(...);
typedef /* Subroutine */ int (*S_fp)(...);
#else
typedef int /* Unknown procedure type */ (*U_fp)();
typedef shortint (*J_fp)();
typedef integer (*I_fp)();
typedef real (*R_fp)();
typedef doublereal (*D_fp)(), (*E_fp)();
typedef /* Complex */ VOID (*C_fp)();
typedef /* Double Complex */ VOID (*Z_fp)();
typedef logical (*L_fp)();
typedef shortlogical (*K_fp)();
typedef /* Character */ VOID (*H_fp)();
typedef /* Subroutine */ int (*S_fp)();
#endif
/* E_fp is for real functions when -R is not specified */
typedef VOID C_f;	/* complex function */
typedef VOID H_f;	/* character function */
typedef VOID Z_f;	/* double complex function */
typedef doublereal E_f;	/* real function with -R not specified */

/* undef any lower-case symbols that your C compiler predefines, e.g.: */

#ifndef Skip_f2c_Undefs
#undef cray
#undef gcos
#undef mc68010
#undef mc68020
#undef mips
#undef pdp11
#undef sgi
#undef sparc
#undef sun
#undef sun2
#undef sun3
#undef sun4
#undef u370
#undef u3b
#undef u3b2
#undef u3b5
#undef unix
#undef vax
#endif
#endif






Added c/fftpack/passb.c.



































































































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* passb.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int passb_(integer *nac, integer *ido, integer *ip, integer *
	l1, integer *idl1, real *cc, real *c1, real *c2, real *ch, real *ch2, 
	real *wa)
{
    /* System generated locals */
    integer ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
	     c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset, 
	    i__1, i__2, i__3;

    /* Local variables */
    integer i__, j, k, l, jc, lc, ik, nt, idj, idl, inc, idp;
    real wai, war;
    integer ipp2, idij, idlj, idot, ipph;

    /* Parameter adjustments */
    ch_dim1 = *ido;
    ch_dim2 = *l1;
    ch_offset = 1 + ch_dim1 * (1 + ch_dim2);
    ch -= ch_offset;
    c1_dim1 = *ido;
    c1_dim2 = *l1;
    c1_offset = 1 + c1_dim1 * (1 + c1_dim2);
    c1 -= c1_offset;
    cc_dim1 = *ido;
    cc_dim2 = *ip;
    cc_offset = 1 + cc_dim1 * (1 + cc_dim2);
    cc -= cc_offset;
    ch2_dim1 = *idl1;
    ch2_offset = 1 + ch2_dim1;
    ch2 -= ch2_offset;
    c2_dim1 = *idl1;
    c2_offset = 1 + c2_dim1;
    c2 -= c2_offset;
    --wa;

    /* Function Body */
    idot = *ido / 2;
    nt = *ip * *idl1;
    ipp2 = *ip + 2;
    ipph = (*ip + 1) / 2;
    idp = *ip * *ido;

    if (*ido < *l1) {
	goto L106;
    }
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	jc = ipp2 - j;
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    i__3 = *ido;
	    for (i__ = 1; i__ <= i__3; ++i__) {
		ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k * 
			cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) * 
			cc_dim1];
		ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k * 
			cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) * 
			cc_dim1];
/* L101: */
	    }
/* L102: */
	}
/* L103: */
    }
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	i__2 = *ido;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * 
		    cc_dim1];
/* L104: */
	}
/* L105: */
    }
    goto L112;
L106:
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	jc = ipp2 - j;
	i__2 = *ido;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    i__3 = *l1;
	    for (k = 1; k <= i__3; ++k) {
		ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k * 
			cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) * 
			cc_dim1];
		ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k * 
			cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) * 
			cc_dim1];
/* L107: */
	    }
/* L108: */
	}
/* L109: */
    }
    i__1 = *ido;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * 
		    cc_dim1];
/* L110: */
	}
/* L111: */
    }
L112:
    idl = 2 - *ido;
    inc = 0;
    i__1 = ipph;
    for (l = 2; l <= i__1; ++l) {
	lc = ipp2 - l;
	idl += *ido;
	i__2 = *idl1;
	for (ik = 1; ik <= i__2; ++ik) {
	    c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + wa[idl - 1] * ch2[ik 
		    + (ch2_dim1 << 1)];
	    c2[ik + lc * c2_dim1] = wa[idl] * ch2[ik + *ip * ch2_dim1];
/* L113: */
	}
	idlj = idl;
	inc += *ido;
	i__2 = ipph;
	for (j = 3; j <= i__2; ++j) {
	    jc = ipp2 - j;
	    idlj += inc;
	    if (idlj > idp) {
		idlj -= idp;
	    }
	    war = wa[idlj - 1];
	    wai = wa[idlj];
	    i__3 = *idl1;
	    for (ik = 1; ik <= i__3; ++ik) {
		c2[ik + l * c2_dim1] += war * ch2[ik + j * ch2_dim1];
		c2[ik + lc * c2_dim1] += wai * ch2[ik + jc * ch2_dim1];
/* L114: */
	    }
/* L115: */
	}
/* L116: */
    }
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	i__2 = *idl1;
	for (ik = 1; ik <= i__2; ++ik) {
	    ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1];
/* L117: */
	}
/* L118: */
    }
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	jc = ipp2 - j;
	i__2 = *idl1;
	for (ik = 2; ik <= i__2; ik += 2) {
	    ch2[ik - 1 + j * ch2_dim1] = c2[ik - 1 + j * c2_dim1] - c2[ik + 
		    jc * c2_dim1];
	    ch2[ik - 1 + jc * ch2_dim1] = c2[ik - 1 + j * c2_dim1] + c2[ik + 
		    jc * c2_dim1];
	    ch2[ik + j * ch2_dim1] = c2[ik + j * c2_dim1] + c2[ik - 1 + jc * 
		    c2_dim1];
	    ch2[ik + jc * ch2_dim1] = c2[ik + j * c2_dim1] - c2[ik - 1 + jc * 
		    c2_dim1];
/* L119: */
	}
/* L120: */
    }
    *nac = 1;
    if (*ido == 2) {
	return 0;
    }
    *nac = 0;
    i__1 = *idl1;
    for (ik = 1; ik <= i__1; ++ik) {
	c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
/* L121: */
    }
    i__1 = *ip;
    for (j = 2; j <= i__1; ++j) {
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) * 
		    ch_dim1 + 1];
	    c1[(k + j * c1_dim2) * c1_dim1 + 2] = ch[(k + j * ch_dim2) * 
		    ch_dim1 + 2];
/* L122: */
	}
/* L123: */
    }
    if (idot > *l1) {
	goto L127;
    }
    idij = 0;
    i__1 = *ip;
    for (j = 2; j <= i__1; ++j) {
	idij += 2;
	i__2 = *ido;
	for (i__ = 4; i__ <= i__2; i__ += 2) {
	    idij += 2;
	    i__3 = *l1;
	    for (k = 1; k <= i__3; ++k) {
		c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
			i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * 
			ch[i__ + (k + j * ch_dim2) * ch_dim1];
		c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ 
			+ (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ - 
			1 + (k + j * ch_dim2) * ch_dim1];
/* L124: */
	    }
/* L125: */
	}
/* L126: */
    }
    return 0;
L127:
    idj = 2 - *ido;
    i__1 = *ip;
    for (j = 2; j <= i__1; ++j) {
	idj += *ido;
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    idij = idj;
	    i__3 = *ido;
	    for (i__ = 4; i__ <= i__3; i__ += 2) {
		idij += 2;
		c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
			i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * 
			ch[i__ + (k + j * ch_dim2) * ch_dim1];
		c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ 
			+ (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ - 
			1 + (k + j * ch_dim2) * ch_dim1];
/* L128: */
	    }
/* L129: */
	}
/* L130: */
    }
    return 0;
} /* passb_ */







Added c/fftpack/passb.f.


























































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE PASSB (NAC,IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)
      DIMENSION       CH(IDO,L1,IP)          ,CC(IDO,IP,L1)          ,
     1                C1(IDO,L1,IP)          ,WA(1)      ,C2(IDL1,IP),
     2                CH2(IDL1,IP)
      IDOT = IDO/2
      NT = IP*IDL1
      IPP2 = IP+2
      IPPH = (IP+1)/2
      IDP = IP*IDO
C
      IF (IDO .LT. L1) GO TO 106
      DO 103 J=2,IPPH
         JC = IPP2-J
         DO 102 K=1,L1
            DO 101 I=1,IDO
               CH(I,K,J) = CC(I,J,K)+CC(I,JC,K)
               CH(I,K,JC) = CC(I,J,K)-CC(I,JC,K)
  101       CONTINUE
  102    CONTINUE
  103 CONTINUE
      DO 105 K=1,L1
         DO 104 I=1,IDO
            CH(I,K,1) = CC(I,1,K)
  104    CONTINUE
  105 CONTINUE
      GO TO 112
  106 DO 109 J=2,IPPH
         JC = IPP2-J
         DO 108 I=1,IDO
            DO 107 K=1,L1
               CH(I,K,J) = CC(I,J,K)+CC(I,JC,K)
               CH(I,K,JC) = CC(I,J,K)-CC(I,JC,K)
  107       CONTINUE
  108    CONTINUE
  109 CONTINUE
      DO 111 I=1,IDO
         DO 110 K=1,L1
            CH(I,K,1) = CC(I,1,K)
  110    CONTINUE
  111 CONTINUE
  112 IDL = 2-IDO
      INC = 0
      DO 116 L=2,IPPH
         LC = IPP2-L
         IDL = IDL+IDO
         DO 113 IK=1,IDL1
            C2(IK,L) = CH2(IK,1)+WA(IDL-1)*CH2(IK,2)
            C2(IK,LC) = WA(IDL)*CH2(IK,IP)
  113    CONTINUE
         IDLJ = IDL
         INC = INC+IDO
         DO 115 J=3,IPPH
            JC = IPP2-J
            IDLJ = IDLJ+INC
            IF (IDLJ .GT. IDP) IDLJ = IDLJ-IDP
            WAR = WA(IDLJ-1)
            WAI = WA(IDLJ)
            DO 114 IK=1,IDL1
               C2(IK,L) = C2(IK,L)+WAR*CH2(IK,J)
               C2(IK,LC) = C2(IK,LC)+WAI*CH2(IK,JC)
  114       CONTINUE
  115    CONTINUE
  116 CONTINUE
      DO 118 J=2,IPPH
         DO 117 IK=1,IDL1
            CH2(IK,1) = CH2(IK,1)+CH2(IK,J)
  117    CONTINUE
  118 CONTINUE
      DO 120 J=2,IPPH
         JC = IPP2-J
         DO 119 IK=2,IDL1,2
            CH2(IK-1,J) = C2(IK-1,J)-C2(IK,JC)
            CH2(IK-1,JC) = C2(IK-1,J)+C2(IK,JC)
            CH2(IK,J) = C2(IK,J)+C2(IK-1,JC)
            CH2(IK,JC) = C2(IK,J)-C2(IK-1,JC)
  119    CONTINUE
  120 CONTINUE
      NAC = 1
      IF (IDO .EQ. 2) RETURN
      NAC = 0
      DO 121 IK=1,IDL1
         C2(IK,1) = CH2(IK,1)
  121 CONTINUE
      DO 123 J=2,IP
         DO 122 K=1,L1
            C1(1,K,J) = CH(1,K,J)
            C1(2,K,J) = CH(2,K,J)
  122    CONTINUE
  123 CONTINUE
      IF (IDOT .GT. L1) GO TO 127
      IDIJ = 0
      DO 126 J=2,IP
         IDIJ = IDIJ+2
         DO 125 I=4,IDO,2
            IDIJ = IDIJ+2
            DO 124 K=1,L1
               C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)-WA(IDIJ)*CH(I,K,J)
               C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)+WA(IDIJ)*CH(I-1,K,J)
  124       CONTINUE
  125    CONTINUE
  126 CONTINUE
      RETURN
  127 IDJ = 2-IDO
      DO 130 J=2,IP
         IDJ = IDJ+IDO
         DO 129 K=1,L1
            IDIJ = IDJ
            DO 128 I=4,IDO,2
               IDIJ = IDIJ+2
               C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)-WA(IDIJ)*CH(I,K,J)
               C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)+WA(IDIJ)*CH(I-1,K,J)
  128       CONTINUE
  129    CONTINUE
  130 CONTINUE
      RETURN
      END






Added c/fftpack/passb2.c.

















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* passb2.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int passb2_(integer *ido, integer *l1, real *cc, real *ch, 
	real *wa1)
{
    /* System generated locals */
    integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;

    /* Local variables */
    integer i__, k;
    real ti2, tr2;

    /* Parameter adjustments */
    ch_dim1 = *ido;
    ch_dim2 = *l1;
    ch_offset = 1 + ch_dim1 * (1 + ch_dim2);
    ch -= ch_offset;
    cc_dim1 = *ido;
    cc_offset = 1 + cc_dim1 * 3;
    cc -= cc_offset;
    --wa1;

    /* Function Body */
    if (*ido > 2) {
	goto L102;
    }
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] + 
		cc[((k << 1) + 2) * cc_dim1 + 1];
	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 
		+ 1] - cc[((k << 1) + 2) * cc_dim1 + 1];
	ch[(k + ch_dim2) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] + 
		cc[((k << 1) + 2) * cc_dim1 + 2];
	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 
		+ 2] - cc[((k << 1) + 2) * cc_dim1 + 2];
/* L101: */
    }
    return 0;
L102:
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	i__2 = *ido;
	for (i__ = 2; i__ <= i__2; i__ += 2) {
	    ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) + 
		    1) * cc_dim1] + cc[i__ - 1 + ((k << 1) + 2) * cc_dim1];
	    tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
		     1) + 2) * cc_dim1];
	    ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) * 
		    cc_dim1] + cc[i__ + ((k << 1) + 2) * cc_dim1];
	    ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[i__ + ((k << 1) + 2)
		     * cc_dim1];
	    ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ti2 + 
		    wa1[i__] * tr2;
	    ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * tr2 
		    - wa1[i__] * ti2;
/* L103: */
	}
/* L104: */
    }
    return 0;
} /* passb2_ */







Added c/fftpack/passb2.f.





























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE PASSB2 (IDO,L1,CC,CH,WA1)
      DIMENSION       CC(IDO,2,L1)           ,CH(IDO,L1,2)           ,
     1                WA1(1)
      IF (IDO .GT. 2) GO TO 102
      DO 101 K=1,L1
         CH(1,K,1) = CC(1,1,K)+CC(1,2,K)
         CH(1,K,2) = CC(1,1,K)-CC(1,2,K)
         CH(2,K,1) = CC(2,1,K)+CC(2,2,K)
         CH(2,K,2) = CC(2,1,K)-CC(2,2,K)
  101 CONTINUE
      RETURN
  102 DO 104 K=1,L1
         DO 103 I=2,IDO,2
            CH(I-1,K,1) = CC(I-1,1,K)+CC(I-1,2,K)
            TR2 = CC(I-1,1,K)-CC(I-1,2,K)
            CH(I,K,1) = CC(I,1,K)+CC(I,2,K)
            TI2 = CC(I,1,K)-CC(I,2,K)
            CH(I,K,2) = WA1(I-1)*TI2+WA1(I)*TR2
            CH(I-1,K,2) = WA1(I-1)*TR2-WA1(I)*TI2
  103    CONTINUE
  104 CONTINUE
      RETURN
      END






Added c/fftpack/passb3.c.











































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* passb3.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int passb3_(integer *ido, integer *l1, real *cc, real *ch, 
	real *wa1, real *wa2)
{
    /* Initialized data */

    static real taur = -.5f;
    static real taui = .866025403784439f;

    /* System generated locals */
    integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;

    /* Local variables */
    integer i__, k;
    real ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;

    /* Parameter adjustments */
    ch_dim1 = *ido;
    ch_dim2 = *l1;
    ch_offset = 1 + ch_dim1 * (1 + ch_dim2);
    ch -= ch_offset;
    cc_dim1 = *ido;
    cc_offset = 1 + (cc_dim1 << 2);
    cc -= cc_offset;
    --wa1;
    --wa2;

    /* Function Body */
    if (*ido != 2) {
	goto L102;
    }
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	tr2 = cc[(k * 3 + 2) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1];
	cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2;
	ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2;
	ti2 = cc[(k * 3 + 2) * cc_dim1 + 2] + cc[(k * 3 + 3) * cc_dim1 + 2];
	ci2 = cc[(k * 3 + 1) * cc_dim1 + 2] + taur * ti2;
	ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 3 + 1) * cc_dim1 + 2] + ti2;
	cr3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 1] - cc[(k * 3 + 3) * 
		cc_dim1 + 1]);
	ci3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 2] - cc[(k * 3 + 3) * 
		cc_dim1 + 2]);
	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3;
	ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3;
	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr3;
	ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci2 - cr3;
/* L101: */
    }
    return 0;
L102:
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	i__2 = *ido;
	for (i__ = 2; i__ <= i__2; i__ += 2) {
	    tr2 = cc[i__ - 1 + (k * 3 + 2) * cc_dim1] + cc[i__ - 1 + (k * 3 + 
		    3) * cc_dim1];
	    cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2;
	    ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) *
		     cc_dim1] + tr2;
	    ti2 = cc[i__ + (k * 3 + 2) * cc_dim1] + cc[i__ + (k * 3 + 3) * 
		    cc_dim1];
	    ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2;
	    ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) * 
		    cc_dim1] + ti2;
	    cr3 = taui * (cc[i__ - 1 + (k * 3 + 2) * cc_dim1] - cc[i__ - 1 + (
		    k * 3 + 3) * cc_dim1]);
	    ci3 = taui * (cc[i__ + (k * 3 + 2) * cc_dim1] - cc[i__ + (k * 3 + 
		    3) * cc_dim1]);
	    dr2 = cr2 - ci3;
	    dr3 = cr2 + ci3;
	    di2 = ci2 + cr3;
	    di3 = ci2 - cr3;
	    ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 + 
		    wa1[i__] * dr2;
	    ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2 
		    - wa1[i__] * di2;
	    ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 + wa2[
		    i__] * dr3;
	    ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 - 
		    wa2[i__] * di3;
/* L103: */
	}
/* L104: */
    }
    return 0;
} /* passb3_ */







Added c/fftpack/passb3.f.
















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE PASSB3 (IDO,L1,CC,CH,WA1,WA2)
      DIMENSION       CC(IDO,3,L1)           ,CH(IDO,L1,3)           ,
     1                WA1(1)     ,WA2(1)
      DATA TAUR,TAUI /-.5,.866025403784439/
      IF (IDO .NE. 2) GO TO 102
      DO 101 K=1,L1
         TR2 = CC(1,2,K)+CC(1,3,K)
         CR2 = CC(1,1,K)+TAUR*TR2
         CH(1,K,1) = CC(1,1,K)+TR2
         TI2 = CC(2,2,K)+CC(2,3,K)
         CI2 = CC(2,1,K)+TAUR*TI2
         CH(2,K,1) = CC(2,1,K)+TI2
         CR3 = TAUI*(CC(1,2,K)-CC(1,3,K))
         CI3 = TAUI*(CC(2,2,K)-CC(2,3,K))
         CH(1,K,2) = CR2-CI3
         CH(1,K,3) = CR2+CI3
         CH(2,K,2) = CI2+CR3
         CH(2,K,3) = CI2-CR3
  101 CONTINUE
      RETURN
  102 DO 104 K=1,L1
         DO 103 I=2,IDO,2
            TR2 = CC(I-1,2,K)+CC(I-1,3,K)
            CR2 = CC(I-1,1,K)+TAUR*TR2
            CH(I-1,K,1) = CC(I-1,1,K)+TR2
            TI2 = CC(I,2,K)+CC(I,3,K)
            CI2 = CC(I,1,K)+TAUR*TI2
            CH(I,K,1) = CC(I,1,K)+TI2
            CR3 = TAUI*(CC(I-1,2,K)-CC(I-1,3,K))
            CI3 = TAUI*(CC(I,2,K)-CC(I,3,K))
            DR2 = CR2-CI3
            DR3 = CR2+CI3
            DI2 = CI2+CR3
            DI3 = CI2-CR3
            CH(I,K,2) = WA1(I-1)*DI2+WA1(I)*DR2
            CH(I-1,K,2) = WA1(I-1)*DR2-WA1(I)*DI2
            CH(I,K,3) = WA2(I-1)*DI3+WA2(I)*DR3
            CH(I-1,K,3) = WA2(I-1)*DR3-WA2(I)*DI3
  103    CONTINUE
  104 CONTINUE
      RETURN
      END






Added c/fftpack/passb4.c.



























































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* passb4.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int passb4_(integer *ido, integer *l1, real *cc, real *ch, 
	real *wa1, real *wa2, real *wa3)
{
    /* System generated locals */
    integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;

    /* Local variables */
    integer i__, k;
    real ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4;

    /* Parameter adjustments */
    ch_dim1 = *ido;
    ch_dim2 = *l1;
    ch_offset = 1 + ch_dim1 * (1 + ch_dim2);
    ch -= ch_offset;
    cc_dim1 = *ido;
    cc_offset = 1 + cc_dim1 * 5;
    cc -= cc_offset;
    --wa1;
    --wa2;
    --wa3;

    /* Function Body */
    if (*ido != 2) {
	goto L102;
    }
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	ti1 = cc[((k << 2) + 1) * cc_dim1 + 2] - cc[((k << 2) + 3) * cc_dim1 
		+ 2];
	ti2 = cc[((k << 2) + 1) * cc_dim1 + 2] + cc[((k << 2) + 3) * cc_dim1 
		+ 2];
	tr4 = cc[((k << 2) + 4) * cc_dim1 + 2] - cc[((k << 2) + 2) * cc_dim1 
		+ 2];
	ti3 = cc[((k << 2) + 2) * cc_dim1 + 2] + cc[((k << 2) + 4) * cc_dim1 
		+ 2];
	tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[((k << 2) + 3) * cc_dim1 
		+ 1];
	tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1 
		+ 1];
	ti4 = cc[((k << 2) + 2) * cc_dim1 + 1] - cc[((k << 2) + 4) * cc_dim1 
		+ 1];
	tr3 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1 
		+ 1];
	ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3;
	ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3;
	ch[(k + ch_dim2) * ch_dim1 + 2] = ti2 + ti3;
	ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ti2 - ti3;
	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 + tr4;
	ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 - tr4;
	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ti1 + ti4;
	ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ti1 - ti4;
/* L101: */
    }
    return 0;
L102:
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	i__2 = *ido;
	for (i__ = 2; i__ <= i__2; i__ += 2) {
	    ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[i__ + ((k << 2) + 3)
		     * cc_dim1];
	    ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[i__ + ((k << 2) + 3)
		     * cc_dim1];
	    ti3 = cc[i__ + ((k << 2) + 2) * cc_dim1] + cc[i__ + ((k << 2) + 4)
		     * cc_dim1];
	    tr4 = cc[i__ + ((k << 2) + 4) * cc_dim1] - cc[i__ + ((k << 2) + 2)
		     * cc_dim1];
	    tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
		     2) + 3) * cc_dim1];
	    tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[i__ - 1 + ((k <<
		     2) + 3) * cc_dim1];
	    ti4 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] - cc[i__ - 1 + ((k <<
		     2) + 4) * cc_dim1];
	    tr3 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] + cc[i__ - 1 + ((k <<
		     2) + 4) * cc_dim1];
	    ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3;
	    cr3 = tr2 - tr3;
	    ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3;
	    ci3 = ti2 - ti3;
	    cr2 = tr1 + tr4;
	    cr4 = tr1 - tr4;
	    ci2 = ti1 + ti4;
	    ci4 = ti1 - ti4;
	    ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * cr2 
		    - wa1[i__] * ci2;
	    ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ci2 + 
		    wa1[i__] * cr2;
	    ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * cr3 - 
		    wa2[i__] * ci3;
	    ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * ci3 + wa2[
		    i__] * cr3;
	    ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * cr4 
		    - wa3[i__] * ci4;
	    ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * ci4 + 
		    wa3[i__] * cr4;
/* L103: */
	}
/* L104: */
    }
    return 0;
} /* passb4_ */







Added c/fftpack/passb4.f.

























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE PASSB4 (IDO,L1,CC,CH,WA1,WA2,WA3)
      DIMENSION       CC(IDO,4,L1)           ,CH(IDO,L1,4)           ,
     1                WA1(1)     ,WA2(1)     ,WA3(1)
      IF (IDO .NE. 2) GO TO 102
      DO 101 K=1,L1
         TI1 = CC(2,1,K)-CC(2,3,K)
         TI2 = CC(2,1,K)+CC(2,3,K)
         TR4 = CC(2,4,K)-CC(2,2,K)
         TI3 = CC(2,2,K)+CC(2,4,K)
         TR1 = CC(1,1,K)-CC(1,3,K)
         TR2 = CC(1,1,K)+CC(1,3,K)
         TI4 = CC(1,2,K)-CC(1,4,K)
         TR3 = CC(1,2,K)+CC(1,4,K)
         CH(1,K,1) = TR2+TR3
         CH(1,K,3) = TR2-TR3
         CH(2,K,1) = TI2+TI3
         CH(2,K,3) = TI2-TI3
         CH(1,K,2) = TR1+TR4
         CH(1,K,4) = TR1-TR4
         CH(2,K,2) = TI1+TI4
         CH(2,K,4) = TI1-TI4
  101 CONTINUE
      RETURN
  102 DO 104 K=1,L1
         DO 103 I=2,IDO,2
            TI1 = CC(I,1,K)-CC(I,3,K)
            TI2 = CC(I,1,K)+CC(I,3,K)
            TI3 = CC(I,2,K)+CC(I,4,K)
            TR4 = CC(I,4,K)-CC(I,2,K)
            TR1 = CC(I-1,1,K)-CC(I-1,3,K)
            TR2 = CC(I-1,1,K)+CC(I-1,3,K)
            TI4 = CC(I-1,2,K)-CC(I-1,4,K)
            TR3 = CC(I-1,2,K)+CC(I-1,4,K)
            CH(I-1,K,1) = TR2+TR3
            CR3 = TR2-TR3
            CH(I,K,1) = TI2+TI3
            CI3 = TI2-TI3
            CR2 = TR1+TR4
            CR4 = TR1-TR4
            CI2 = TI1+TI4
            CI4 = TI1-TI4
            CH(I-1,K,2) = WA1(I-1)*CR2-WA1(I)*CI2
            CH(I,K,2) = WA1(I-1)*CI2+WA1(I)*CR2
            CH(I-1,K,3) = WA2(I-1)*CR3-WA2(I)*CI3
            CH(I,K,3) = WA2(I-1)*CI3+WA2(I)*CR3
            CH(I-1,K,4) = WA3(I-1)*CR4-WA3(I)*CI4
            CH(I,K,4) = WA3(I-1)*CI4+WA3(I)*CR4
  103    CONTINUE
  104 CONTINUE
      RETURN
      END






Added c/fftpack/passb5.c.


























































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* passb5.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int passb5_(integer *ido, integer *l1, real *cc, real *ch, 
	real *wa1, real *wa2, real *wa3, real *wa4)
{
    /* Initialized data */

    static real tr11 = .309016994374947f;
    static real ti11 = .951056516295154f;
    static real tr12 = -.809016994374947f;
    static real ti12 = .587785252292473f;

    /* System generated locals */
    integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;

    /* Local variables */
    integer i__, k;
    real ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, ti2, ti3,
	     ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;

    /* Parameter adjustments */
    ch_dim1 = *ido;
    ch_dim2 = *l1;
    ch_offset = 1 + ch_dim1 * (1 + ch_dim2);
    ch -= ch_offset;
    cc_dim1 = *ido;
    cc_offset = 1 + cc_dim1 * 6;
    cc -= cc_offset;
    --wa1;
    --wa2;
    --wa3;
    --wa4;

    /* Function Body */
    if (*ido != 2) {
	goto L102;
    }
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	ti5 = cc[(k * 5 + 2) * cc_dim1 + 2] - cc[(k * 5 + 5) * cc_dim1 + 2];
	ti2 = cc[(k * 5 + 2) * cc_dim1 + 2] + cc[(k * 5 + 5) * cc_dim1 + 2];
	ti4 = cc[(k * 5 + 3) * cc_dim1 + 2] - cc[(k * 5 + 4) * cc_dim1 + 2];
	ti3 = cc[(k * 5 + 3) * cc_dim1 + 2] + cc[(k * 5 + 4) * cc_dim1 + 2];
	tr5 = cc[(k * 5 + 2) * cc_dim1 + 1] - cc[(k * 5 + 5) * cc_dim1 + 1];
	tr2 = cc[(k * 5 + 2) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1];
	tr4 = cc[(k * 5 + 3) * cc_dim1 + 1] - cc[(k * 5 + 4) * cc_dim1 + 1];
	tr3 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 4) * cc_dim1 + 1];
	ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2 
		+ tr3;
	ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 5 + 1) * cc_dim1 + 2] + ti2 
		+ ti3;
	cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3;
	ci2 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr11 * ti2 + tr12 * ti3;
	cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3;
	ci3 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr12 * ti2 + tr11 * ti3;
	cr5 = ti11 * tr5 + ti12 * tr4;
	ci5 = ti11 * ti5 + ti12 * ti4;
	cr4 = ti12 * tr5 - ti11 * tr4;
	ci4 = ti12 * ti5 - ti11 * ti4;
	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5;
	ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5;
	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr5;
	ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci3 + cr4;
	ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4;
	ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4;
	ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ci3 - cr4;
	ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ci2 - cr5;
/* L101: */
    }
    return 0;
L102:
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	i__2 = *ido;
	for (i__ = 2; i__ <= i__2; i__ += 2) {
	    ti5 = cc[i__ + (k * 5 + 2) * cc_dim1] - cc[i__ + (k * 5 + 5) * 
		    cc_dim1];
	    ti2 = cc[i__ + (k * 5 + 2) * cc_dim1] + cc[i__ + (k * 5 + 5) * 
		    cc_dim1];
	    ti4 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[i__ + (k * 5 + 4) * 
		    cc_dim1];
	    ti3 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[i__ + (k * 5 + 4) * 
		    cc_dim1];
	    tr5 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] - cc[i__ - 1 + (k * 5 + 
		    5) * cc_dim1];
	    tr2 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] + cc[i__ - 1 + (k * 5 + 
		    5) * cc_dim1];
	    tr4 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[i__ - 1 + (k * 5 + 
		    4) * cc_dim1];
	    tr3 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[i__ - 1 + (k * 5 + 
		    4) * cc_dim1];
	    ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) *
		     cc_dim1] + tr2 + tr3;
	    ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) * 
		    cc_dim1] + ti2 + ti3;
	    cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 * 
		    tr3;
	    ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3;
	    cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 * 
		    tr3;
	    ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3;
	    cr5 = ti11 * tr5 + ti12 * tr4;
	    ci5 = ti11 * ti5 + ti12 * ti4;
	    cr4 = ti12 * tr5 - ti11 * tr4;
	    ci4 = ti12 * ti5 - ti11 * ti4;
	    dr3 = cr3 - ci4;
	    dr4 = cr3 + ci4;
	    di3 = ci3 + cr4;
	    di4 = ci3 - cr4;
	    dr5 = cr2 + ci5;
	    dr2 = cr2 - ci5;
	    di5 = ci2 - cr5;
	    di2 = ci2 + cr5;
	    ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2 
		    - wa1[i__] * di2;
	    ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 + 
		    wa1[i__] * dr2;
	    ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 - 
		    wa2[i__] * di3;
	    ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 + wa2[
		    i__] * dr3;
	    ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * dr4 
		    - wa3[i__] * di4;
	    ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * di4 + 
		    wa3[i__] * dr4;
	    ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * dr5 - 
		    wa4[i__] * di5;
	    ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * di5 + wa4[
		    i__] * dr5;
/* L103: */
	}
/* L104: */
    }
    return 0;
} /* passb5_ */







Added c/fftpack/passb5.f.

















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE PASSB5 (IDO,L1,CC,CH,WA1,WA2,WA3,WA4)
      DIMENSION       CC(IDO,5,L1)           ,CH(IDO,L1,5)           ,
     1                WA1(1)     ,WA2(1)     ,WA3(1)     ,WA4(1)
      DATA TR11,TI11,TR12,TI12 /.309016994374947,.951056516295154,
     1-.809016994374947,.587785252292473/
      IF (IDO .NE. 2) GO TO 102
      DO 101 K=1,L1
         TI5 = CC(2,2,K)-CC(2,5,K)
         TI2 = CC(2,2,K)+CC(2,5,K)
         TI4 = CC(2,3,K)-CC(2,4,K)
         TI3 = CC(2,3,K)+CC(2,4,K)
         TR5 = CC(1,2,K)-CC(1,5,K)
         TR2 = CC(1,2,K)+CC(1,5,K)
         TR4 = CC(1,3,K)-CC(1,4,K)
         TR3 = CC(1,3,K)+CC(1,4,K)
         CH(1,K,1) = CC(1,1,K)+TR2+TR3
         CH(2,K,1) = CC(2,1,K)+TI2+TI3
         CR2 = CC(1,1,K)+TR11*TR2+TR12*TR3
         CI2 = CC(2,1,K)+TR11*TI2+TR12*TI3
         CR3 = CC(1,1,K)+TR12*TR2+TR11*TR3
         CI3 = CC(2,1,K)+TR12*TI2+TR11*TI3
         CR5 = TI11*TR5+TI12*TR4
         CI5 = TI11*TI5+TI12*TI4
         CR4 = TI12*TR5-TI11*TR4
         CI4 = TI12*TI5-TI11*TI4
         CH(1,K,2) = CR2-CI5
         CH(1,K,5) = CR2+CI5
         CH(2,K,2) = CI2+CR5
         CH(2,K,3) = CI3+CR4
         CH(1,K,3) = CR3-CI4
         CH(1,K,4) = CR3+CI4
         CH(2,K,4) = CI3-CR4
         CH(2,K,5) = CI2-CR5
  101 CONTINUE
      RETURN
  102 DO 104 K=1,L1
         DO 103 I=2,IDO,2
            TI5 = CC(I,2,K)-CC(I,5,K)
            TI2 = CC(I,2,K)+CC(I,5,K)
            TI4 = CC(I,3,K)-CC(I,4,K)
            TI3 = CC(I,3,K)+CC(I,4,K)
            TR5 = CC(I-1,2,K)-CC(I-1,5,K)
            TR2 = CC(I-1,2,K)+CC(I-1,5,K)
            TR4 = CC(I-1,3,K)-CC(I-1,4,K)
            TR3 = CC(I-1,3,K)+CC(I-1,4,K)
            CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3
            CH(I,K,1) = CC(I,1,K)+TI2+TI3
            CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3
            CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3
            CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3
            CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3
            CR5 = TI11*TR5+TI12*TR4
            CI5 = TI11*TI5+TI12*TI4
            CR4 = TI12*TR5-TI11*TR4
            CI4 = TI12*TI5-TI11*TI4
            DR3 = CR3-CI4
            DR4 = CR3+CI4
            DI3 = CI3+CR4
            DI4 = CI3-CR4
            DR5 = CR2+CI5
            DR2 = CR2-CI5
            DI5 = CI2-CR5
            DI2 = CI2+CR5
            CH(I-1,K,2) = WA1(I-1)*DR2-WA1(I)*DI2
            CH(I,K,2) = WA1(I-1)*DI2+WA1(I)*DR2
            CH(I-1,K,3) = WA2(I-1)*DR3-WA2(I)*DI3
            CH(I,K,3) = WA2(I-1)*DI3+WA2(I)*DR3
            CH(I-1,K,4) = WA3(I-1)*DR4-WA3(I)*DI4
            CH(I,K,4) = WA3(I-1)*DI4+WA3(I)*DR4
            CH(I-1,K,5) = WA4(I-1)*DR5-WA4(I)*DI5
            CH(I,K,5) = WA4(I-1)*DI5+WA4(I)*DR5
  103    CONTINUE
  104 CONTINUE
      RETURN
      END






Added c/fftpack/passf.c.



































































































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* passf.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int passf_(integer *nac, integer *ido, integer *ip, integer *
	l1, integer *idl1, real *cc, real *c1, real *c2, real *ch, real *ch2, 
	real *wa)
{
    /* System generated locals */
    integer ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
	     c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset, 
	    i__1, i__2, i__3;

    /* Local variables */
    integer i__, j, k, l, jc, lc, ik, nt, idj, idl, inc, idp;
    real wai, war;
    integer ipp2, idij, idlj, idot, ipph;

    /* Parameter adjustments */
    ch_dim1 = *ido;
    ch_dim2 = *l1;
    ch_offset = 1 + ch_dim1 * (1 + ch_dim2);
    ch -= ch_offset;
    c1_dim1 = *ido;
    c1_dim2 = *l1;
    c1_offset = 1 + c1_dim1 * (1 + c1_dim2);
    c1 -= c1_offset;
    cc_dim1 = *ido;
    cc_dim2 = *ip;
    cc_offset = 1 + cc_dim1 * (1 + cc_dim2);
    cc -= cc_offset;
    ch2_dim1 = *idl1;
    ch2_offset = 1 + ch2_dim1;
    ch2 -= ch2_offset;
    c2_dim1 = *idl1;
    c2_offset = 1 + c2_dim1;
    c2 -= c2_offset;
    --wa;

    /* Function Body */
    idot = *ido / 2;
    nt = *ip * *idl1;
    ipp2 = *ip + 2;
    ipph = (*ip + 1) / 2;
    idp = *ip * *ido;

    if (*ido < *l1) {
	goto L106;
    }
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	jc = ipp2 - j;
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    i__3 = *ido;
	    for (i__ = 1; i__ <= i__3; ++i__) {
		ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k * 
			cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) * 
			cc_dim1];
		ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k * 
			cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) * 
			cc_dim1];
/* L101: */
	    }
/* L102: */
	}
/* L103: */
    }
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	i__2 = *ido;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * 
		    cc_dim1];
/* L104: */
	}
/* L105: */
    }
    goto L112;
L106:
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	jc = ipp2 - j;
	i__2 = *ido;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    i__3 = *l1;
	    for (k = 1; k <= i__3; ++k) {
		ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + (j + k * 
			cc_dim2) * cc_dim1] + cc[i__ + (jc + k * cc_dim2) * 
			cc_dim1];
		ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + (j + k * 
			cc_dim2) * cc_dim1] - cc[i__ + (jc + k * cc_dim2) * 
			cc_dim1];
/* L107: */
	    }
/* L108: */
	}
/* L109: */
    }
    i__1 = *ido;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * 
		    cc_dim1];
/* L110: */
	}
/* L111: */
    }
L112:
    idl = 2 - *ido;
    inc = 0;
    i__1 = ipph;
    for (l = 2; l <= i__1; ++l) {
	lc = ipp2 - l;
	idl += *ido;
	i__2 = *idl1;
	for (ik = 1; ik <= i__2; ++ik) {
	    c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + wa[idl - 1] * ch2[ik 
		    + (ch2_dim1 << 1)];
	    c2[ik + lc * c2_dim1] = -wa[idl] * ch2[ik + *ip * ch2_dim1];
/* L113: */
	}
	idlj = idl;
	inc += *ido;
	i__2 = ipph;
	for (j = 3; j <= i__2; ++j) {
	    jc = ipp2 - j;
	    idlj += inc;
	    if (idlj > idp) {
		idlj -= idp;
	    }
	    war = wa[idlj - 1];
	    wai = wa[idlj];
	    i__3 = *idl1;
	    for (ik = 1; ik <= i__3; ++ik) {
		c2[ik + l * c2_dim1] += war * ch2[ik + j * ch2_dim1];
		c2[ik + lc * c2_dim1] -= wai * ch2[ik + jc * ch2_dim1];
/* L114: */
	    }
/* L115: */
	}
/* L116: */
    }
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	i__2 = *idl1;
	for (ik = 1; ik <= i__2; ++ik) {
	    ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1];
/* L117: */
	}
/* L118: */
    }
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	jc = ipp2 - j;
	i__2 = *idl1;
	for (ik = 2; ik <= i__2; ik += 2) {
	    ch2[ik - 1 + j * ch2_dim1] = c2[ik - 1 + j * c2_dim1] - c2[ik + 
		    jc * c2_dim1];
	    ch2[ik - 1 + jc * ch2_dim1] = c2[ik - 1 + j * c2_dim1] + c2[ik + 
		    jc * c2_dim1];
	    ch2[ik + j * ch2_dim1] = c2[ik + j * c2_dim1] + c2[ik - 1 + jc * 
		    c2_dim1];
	    ch2[ik + jc * ch2_dim1] = c2[ik + j * c2_dim1] - c2[ik - 1 + jc * 
		    c2_dim1];
/* L119: */
	}
/* L120: */
    }
    *nac = 1;
    if (*ido == 2) {
	return 0;
    }
    *nac = 0;
    i__1 = *idl1;
    for (ik = 1; ik <= i__1; ++ik) {
	c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
/* L121: */
    }
    i__1 = *ip;
    for (j = 2; j <= i__1; ++j) {
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) * 
		    ch_dim1 + 1];
	    c1[(k + j * c1_dim2) * c1_dim1 + 2] = ch[(k + j * ch_dim2) * 
		    ch_dim1 + 2];
/* L122: */
	}
/* L123: */
    }
    if (idot > *l1) {
	goto L127;
    }
    idij = 0;
    i__1 = *ip;
    for (j = 2; j <= i__1; ++j) {
	idij += 2;
	i__2 = *ido;
	for (i__ = 4; i__ <= i__2; i__ += 2) {
	    idij += 2;
	    i__3 = *l1;
	    for (k = 1; k <= i__3; ++k) {
		c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
			i__ - 1 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * 
			ch[i__ + (k + j * ch_dim2) * ch_dim1];
		c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ 
			+ (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ - 
			1 + (k + j * ch_dim2) * ch_dim1];
/* L124: */
	    }
/* L125: */
	}
/* L126: */
    }
    return 0;
L127:
    idj = 2 - *ido;
    i__1 = *ip;
    for (j = 2; j <= i__1; ++j) {
	idj += *ido;
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    idij = idj;
	    i__3 = *ido;
	    for (i__ = 4; i__ <= i__3; i__ += 2) {
		idij += 2;
		c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
			i__ - 1 + (k + j * ch_dim2) * ch_dim1] + wa[idij] * 
			ch[i__ + (k + j * ch_dim2) * ch_dim1];
		c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ 
			+ (k + j * ch_dim2) * ch_dim1] - wa[idij] * ch[i__ - 
			1 + (k + j * ch_dim2) * ch_dim1];
/* L128: */
	    }
/* L129: */
	}
/* L130: */
    }
    return 0;
} /* passf_ */







Added c/fftpack/passf.f.


























































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE PASSF (NAC,IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)
      DIMENSION       CH(IDO,L1,IP)          ,CC(IDO,IP,L1)          ,
     1                C1(IDO,L1,IP)          ,WA(1)      ,C2(IDL1,IP),
     2                CH2(IDL1,IP)
      IDOT = IDO/2
      NT = IP*IDL1
      IPP2 = IP+2
      IPPH = (IP+1)/2
      IDP = IP*IDO
C
      IF (IDO .LT. L1) GO TO 106
      DO 103 J=2,IPPH
         JC = IPP2-J
         DO 102 K=1,L1
            DO 101 I=1,IDO
               CH(I,K,J) = CC(I,J,K)+CC(I,JC,K)
               CH(I,K,JC) = CC(I,J,K)-CC(I,JC,K)
  101       CONTINUE
  102    CONTINUE
  103 CONTINUE
      DO 105 K=1,L1
         DO 104 I=1,IDO
            CH(I,K,1) = CC(I,1,K)
  104    CONTINUE
  105 CONTINUE
      GO TO 112
  106 DO 109 J=2,IPPH
         JC = IPP2-J
         DO 108 I=1,IDO
            DO 107 K=1,L1
               CH(I,K,J) = CC(I,J,K)+CC(I,JC,K)
               CH(I,K,JC) = CC(I,J,K)-CC(I,JC,K)
  107       CONTINUE
  108    CONTINUE
  109 CONTINUE
      DO 111 I=1,IDO
         DO 110 K=1,L1
            CH(I,K,1) = CC(I,1,K)
  110    CONTINUE
  111 CONTINUE
  112 IDL = 2-IDO
      INC = 0
      DO 116 L=2,IPPH
         LC = IPP2-L
         IDL = IDL+IDO
         DO 113 IK=1,IDL1
            C2(IK,L) = CH2(IK,1)+WA(IDL-1)*CH2(IK,2)
            C2(IK,LC) = -WA(IDL)*CH2(IK,IP)
  113    CONTINUE
         IDLJ = IDL
         INC = INC+IDO
         DO 115 J=3,IPPH
            JC = IPP2-J
            IDLJ = IDLJ+INC
            IF (IDLJ .GT. IDP) IDLJ = IDLJ-IDP
            WAR = WA(IDLJ-1)
            WAI = WA(IDLJ)
            DO 114 IK=1,IDL1
               C2(IK,L) = C2(IK,L)+WAR*CH2(IK,J)
               C2(IK,LC) = C2(IK,LC)-WAI*CH2(IK,JC)
  114       CONTINUE
  115    CONTINUE
  116 CONTINUE
      DO 118 J=2,IPPH
         DO 117 IK=1,IDL1
            CH2(IK,1) = CH2(IK,1)+CH2(IK,J)
  117    CONTINUE
  118 CONTINUE
      DO 120 J=2,IPPH
         JC = IPP2-J
         DO 119 IK=2,IDL1,2
            CH2(IK-1,J) = C2(IK-1,J)-C2(IK,JC)
            CH2(IK-1,JC) = C2(IK-1,J)+C2(IK,JC)
            CH2(IK,J) = C2(IK,J)+C2(IK-1,JC)
            CH2(IK,JC) = C2(IK,J)-C2(IK-1,JC)
  119    CONTINUE
  120 CONTINUE
      NAC = 1
      IF (IDO .EQ. 2) RETURN
      NAC = 0
      DO 121 IK=1,IDL1
         C2(IK,1) = CH2(IK,1)
  121 CONTINUE
      DO 123 J=2,IP
         DO 122 K=1,L1
            C1(1,K,J) = CH(1,K,J)
            C1(2,K,J) = CH(2,K,J)
  122    CONTINUE
  123 CONTINUE
      IF (IDOT .GT. L1) GO TO 127
      IDIJ = 0
      DO 126 J=2,IP
         IDIJ = IDIJ+2
         DO 125 I=4,IDO,2
            IDIJ = IDIJ+2
            DO 124 K=1,L1
               C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)+WA(IDIJ)*CH(I,K,J)
               C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)-WA(IDIJ)*CH(I-1,K,J)
  124       CONTINUE
  125    CONTINUE
  126 CONTINUE
      RETURN
  127 IDJ = 2-IDO
      DO 130 J=2,IP
         IDJ = IDJ+IDO
         DO 129 K=1,L1
            IDIJ = IDJ
            DO 128 I=4,IDO,2
               IDIJ = IDIJ+2
               C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)+WA(IDIJ)*CH(I,K,J)
               C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)-WA(IDIJ)*CH(I-1,K,J)
  128       CONTINUE
  129    CONTINUE
  130 CONTINUE
      RETURN
      END






Added c/fftpack/passf2.c.

















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* passf2.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int passf2_(integer *ido, integer *l1, real *cc, real *ch, 
	real *wa1)
{
    /* System generated locals */
    integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;

    /* Local variables */
    integer i__, k;
    real ti2, tr2;

    /* Parameter adjustments */
    ch_dim1 = *ido;
    ch_dim2 = *l1;
    ch_offset = 1 + ch_dim1 * (1 + ch_dim2);
    ch -= ch_offset;
    cc_dim1 = *ido;
    cc_offset = 1 + cc_dim1 * 3;
    cc -= cc_offset;
    --wa1;

    /* Function Body */
    if (*ido > 2) {
	goto L102;
    }
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] + 
		cc[((k << 1) + 2) * cc_dim1 + 1];
	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 
		+ 1] - cc[((k << 1) + 2) * cc_dim1 + 1];
	ch[(k + ch_dim2) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 + 2] + 
		cc[((k << 1) + 2) * cc_dim1 + 2];
	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = cc[((k << 1) + 1) * cc_dim1 
		+ 2] - cc[((k << 1) + 2) * cc_dim1 + 2];
/* L101: */
    }
    return 0;
L102:
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	i__2 = *ido;
	for (i__ = 2; i__ <= i__2; i__ += 2) {
	    ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) + 
		    1) * cc_dim1] + cc[i__ - 1 + ((k << 1) + 2) * cc_dim1];
	    tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
		     1) + 2) * cc_dim1];
	    ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) * 
		    cc_dim1] + cc[i__ + ((k << 1) + 2) * cc_dim1];
	    ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] - cc[i__ + ((k << 1) + 2)
		     * cc_dim1];
	    ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ti2 - 
		    wa1[i__] * tr2;
	    ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * tr2 
		    + wa1[i__] * ti2;
/* L103: */
	}
/* L104: */
    }
    return 0;
} /* passf2_ */







Added c/fftpack/passf2.f.





























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE PASSF2 (IDO,L1,CC,CH,WA1)
      DIMENSION       CC(IDO,2,L1)           ,CH(IDO,L1,2)           ,
     1                WA1(1)
      IF (IDO .GT. 2) GO TO 102
      DO 101 K=1,L1
         CH(1,K,1) = CC(1,1,K)+CC(1,2,K)
         CH(1,K,2) = CC(1,1,K)-CC(1,2,K)
         CH(2,K,1) = CC(2,1,K)+CC(2,2,K)
         CH(2,K,2) = CC(2,1,K)-CC(2,2,K)
  101 CONTINUE
      RETURN
  102 DO 104 K=1,L1
         DO 103 I=2,IDO,2
            CH(I-1,K,1) = CC(I-1,1,K)+CC(I-1,2,K)
            TR2 = CC(I-1,1,K)-CC(I-1,2,K)
            CH(I,K,1) = CC(I,1,K)+CC(I,2,K)
            TI2 = CC(I,1,K)-CC(I,2,K)
            CH(I,K,2) = WA1(I-1)*TI2-WA1(I)*TR2
            CH(I-1,K,2) = WA1(I-1)*TR2+WA1(I)*TI2
  103    CONTINUE
  104 CONTINUE
      RETURN
      END






Added c/fftpack/passf3.c.











































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* passf3.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int passf3_(integer *ido, integer *l1, real *cc, real *ch, 
	real *wa1, real *wa2)
{
    /* Initialized data */

    static real taur = -.5f;
    static real taui = -.866025403784439f;

    /* System generated locals */
    integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;

    /* Local variables */
    integer i__, k;
    real ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;

    /* Parameter adjustments */
    ch_dim1 = *ido;
    ch_dim2 = *l1;
    ch_offset = 1 + ch_dim1 * (1 + ch_dim2);
    ch -= ch_offset;
    cc_dim1 = *ido;
    cc_offset = 1 + (cc_dim1 << 2);
    cc -= cc_offset;
    --wa1;
    --wa2;

    /* Function Body */
    if (*ido != 2) {
	goto L102;
    }
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	tr2 = cc[(k * 3 + 2) * cc_dim1 + 1] + cc[(k * 3 + 3) * cc_dim1 + 1];
	cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2;
	ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2;
	ti2 = cc[(k * 3 + 2) * cc_dim1 + 2] + cc[(k * 3 + 3) * cc_dim1 + 2];
	ci2 = cc[(k * 3 + 1) * cc_dim1 + 2] + taur * ti2;
	ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 3 + 1) * cc_dim1 + 2] + ti2;
	cr3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 1] - cc[(k * 3 + 3) * 
		cc_dim1 + 1]);
	ci3 = taui * (cc[(k * 3 + 2) * cc_dim1 + 2] - cc[(k * 3 + 3) * 
		cc_dim1 + 2]);
	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3;
	ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3;
	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr3;
	ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci2 - cr3;
/* L101: */
    }
    return 0;
L102:
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	i__2 = *ido;
	for (i__ = 2; i__ <= i__2; i__ += 2) {
	    tr2 = cc[i__ - 1 + (k * 3 + 2) * cc_dim1] + cc[i__ - 1 + (k * 3 + 
		    3) * cc_dim1];
	    cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2;
	    ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) *
		     cc_dim1] + tr2;
	    ti2 = cc[i__ + (k * 3 + 2) * cc_dim1] + cc[i__ + (k * 3 + 3) * 
		    cc_dim1];
	    ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2;
	    ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) * 
		    cc_dim1] + ti2;
	    cr3 = taui * (cc[i__ - 1 + (k * 3 + 2) * cc_dim1] - cc[i__ - 1 + (
		    k * 3 + 3) * cc_dim1]);
	    ci3 = taui * (cc[i__ + (k * 3 + 2) * cc_dim1] - cc[i__ + (k * 3 + 
		    3) * cc_dim1]);
	    dr2 = cr2 - ci3;
	    dr3 = cr2 + ci3;
	    di2 = ci2 + cr3;
	    di3 = ci2 - cr3;
	    ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 - 
		    wa1[i__] * dr2;
	    ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2 
		    + wa1[i__] * di2;
	    ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 - wa2[
		    i__] * dr3;
	    ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 + 
		    wa2[i__] * di3;
/* L103: */
	}
/* L104: */
    }
    return 0;
} /* passf3_ */







Added c/fftpack/passf3.f.
















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE PASSF3 (IDO,L1,CC,CH,WA1,WA2)
      DIMENSION       CC(IDO,3,L1)           ,CH(IDO,L1,3)           ,
     1                WA1(1)     ,WA2(1)
      DATA TAUR,TAUI /-.5,-.866025403784439/
      IF (IDO .NE. 2) GO TO 102
      DO 101 K=1,L1
         TR2 = CC(1,2,K)+CC(1,3,K)
         CR2 = CC(1,1,K)+TAUR*TR2
         CH(1,K,1) = CC(1,1,K)+TR2
         TI2 = CC(2,2,K)+CC(2,3,K)
         CI2 = CC(2,1,K)+TAUR*TI2
         CH(2,K,1) = CC(2,1,K)+TI2
         CR3 = TAUI*(CC(1,2,K)-CC(1,3,K))
         CI3 = TAUI*(CC(2,2,K)-CC(2,3,K))
         CH(1,K,2) = CR2-CI3
         CH(1,K,3) = CR2+CI3
         CH(2,K,2) = CI2+CR3
         CH(2,K,3) = CI2-CR3
  101 CONTINUE
      RETURN
  102 DO 104 K=1,L1
         DO 103 I=2,IDO,2
            TR2 = CC(I-1,2,K)+CC(I-1,3,K)
            CR2 = CC(I-1,1,K)+TAUR*TR2
            CH(I-1,K,1) = CC(I-1,1,K)+TR2
            TI2 = CC(I,2,K)+CC(I,3,K)
            CI2 = CC(I,1,K)+TAUR*TI2
            CH(I,K,1) = CC(I,1,K)+TI2
            CR3 = TAUI*(CC(I-1,2,K)-CC(I-1,3,K))
            CI3 = TAUI*(CC(I,2,K)-CC(I,3,K))
            DR2 = CR2-CI3
            DR3 = CR2+CI3
            DI2 = CI2+CR3
            DI3 = CI2-CR3
            CH(I,K,2) = WA1(I-1)*DI2-WA1(I)*DR2
            CH(I-1,K,2) = WA1(I-1)*DR2+WA1(I)*DI2
            CH(I,K,3) = WA2(I-1)*DI3-WA2(I)*DR3
            CH(I-1,K,3) = WA2(I-1)*DR3+WA2(I)*DI3
  103    CONTINUE
  104 CONTINUE
      RETURN
      END






Added c/fftpack/passf4.c.



























































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* passf4.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int passf4_(integer *ido, integer *l1, real *cc, real *ch, 
	real *wa1, real *wa2, real *wa3)
{
    /* System generated locals */
    integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;

    /* Local variables */
    integer i__, k;
    real ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4;

    /* Parameter adjustments */
    ch_dim1 = *ido;
    ch_dim2 = *l1;
    ch_offset = 1 + ch_dim1 * (1 + ch_dim2);
    ch -= ch_offset;
    cc_dim1 = *ido;
    cc_offset = 1 + cc_dim1 * 5;
    cc -= cc_offset;
    --wa1;
    --wa2;
    --wa3;

    /* Function Body */
    if (*ido != 2) {
	goto L102;
    }
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	ti1 = cc[((k << 2) + 1) * cc_dim1 + 2] - cc[((k << 2) + 3) * cc_dim1 
		+ 2];
	ti2 = cc[((k << 2) + 1) * cc_dim1 + 2] + cc[((k << 2) + 3) * cc_dim1 
		+ 2];
	tr4 = cc[((k << 2) + 2) * cc_dim1 + 2] - cc[((k << 2) + 4) * cc_dim1 
		+ 2];
	ti3 = cc[((k << 2) + 2) * cc_dim1 + 2] + cc[((k << 2) + 4) * cc_dim1 
		+ 2];
	tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[((k << 2) + 3) * cc_dim1 
		+ 1];
	tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1 
		+ 1];
	ti4 = cc[((k << 2) + 4) * cc_dim1 + 1] - cc[((k << 2) + 2) * cc_dim1 
		+ 1];
	tr3 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1 
		+ 1];
	ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3;
	ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3;
	ch[(k + ch_dim2) * ch_dim1 + 2] = ti2 + ti3;
	ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ti2 - ti3;
	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 + tr4;
	ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 - tr4;
	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ti1 + ti4;
	ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ti1 - ti4;
/* L101: */
    }
    return 0;
L102:
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	i__2 = *ido;
	for (i__ = 2; i__ <= i__2; i__ += 2) {
	    ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[i__ + ((k << 2) + 3)
		     * cc_dim1];
	    ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[i__ + ((k << 2) + 3)
		     * cc_dim1];
	    ti3 = cc[i__ + ((k << 2) + 2) * cc_dim1] + cc[i__ + ((k << 2) + 4)
		     * cc_dim1];
	    tr4 = cc[i__ + ((k << 2) + 2) * cc_dim1] - cc[i__ + ((k << 2) + 4)
		     * cc_dim1];
	    tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[i__ - 1 + ((k <<
		     2) + 3) * cc_dim1];
	    tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[i__ - 1 + ((k <<
		     2) + 3) * cc_dim1];
	    ti4 = cc[i__ - 1 + ((k << 2) + 4) * cc_dim1] - cc[i__ - 1 + ((k <<
		     2) + 2) * cc_dim1];
	    tr3 = cc[i__ - 1 + ((k << 2) + 2) * cc_dim1] + cc[i__ - 1 + ((k <<
		     2) + 4) * cc_dim1];
	    ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3;
	    cr3 = tr2 - tr3;
	    ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3;
	    ci3 = ti2 - ti3;
	    cr2 = tr1 + tr4;
	    cr4 = tr1 - tr4;
	    ci2 = ti1 + ti4;
	    ci4 = ti1 - ti4;
	    ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * cr2 
		    + wa1[i__] * ci2;
	    ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * ci2 - 
		    wa1[i__] * cr2;
	    ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * cr3 + 
		    wa2[i__] * ci3;
	    ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * ci3 - wa2[
		    i__] * cr3;
	    ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * cr4 
		    + wa3[i__] * ci4;
	    ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * ci4 - 
		    wa3[i__] * cr4;
/* L103: */
	}
/* L104: */
    }
    return 0;
} /* passf4_ */







Added c/fftpack/passf4.f.

























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE PASSF4 (IDO,L1,CC,CH,WA1,WA2,WA3)
      DIMENSION       CC(IDO,4,L1)           ,CH(IDO,L1,4)           ,
     1                WA1(1)     ,WA2(1)     ,WA3(1)
      IF (IDO .NE. 2) GO TO 102
      DO 101 K=1,L1
         TI1 = CC(2,1,K)-CC(2,3,K)
         TI2 = CC(2,1,K)+CC(2,3,K)
         TR4 = CC(2,2,K)-CC(2,4,K)
         TI3 = CC(2,2,K)+CC(2,4,K)
         TR1 = CC(1,1,K)-CC(1,3,K)
         TR2 = CC(1,1,K)+CC(1,3,K)
         TI4 = CC(1,4,K)-CC(1,2,K)
         TR3 = CC(1,2,K)+CC(1,4,K)
         CH(1,K,1) = TR2+TR3
         CH(1,K,3) = TR2-TR3
         CH(2,K,1) = TI2+TI3
         CH(2,K,3) = TI2-TI3
         CH(1,K,2) = TR1+TR4
         CH(1,K,4) = TR1-TR4
         CH(2,K,2) = TI1+TI4
         CH(2,K,4) = TI1-TI4
  101 CONTINUE
      RETURN
  102 DO 104 K=1,L1
         DO 103 I=2,IDO,2
            TI1 = CC(I,1,K)-CC(I,3,K)
            TI2 = CC(I,1,K)+CC(I,3,K)
            TI3 = CC(I,2,K)+CC(I,4,K)
            TR4 = CC(I,2,K)-CC(I,4,K)
            TR1 = CC(I-1,1,K)-CC(I-1,3,K)
            TR2 = CC(I-1,1,K)+CC(I-1,3,K)
            TI4 = CC(I-1,4,K)-CC(I-1,2,K)
            TR3 = CC(I-1,2,K)+CC(I-1,4,K)
            CH(I-1,K,1) = TR2+TR3
            CR3 = TR2-TR3
            CH(I,K,1) = TI2+TI3
            CI3 = TI2-TI3
            CR2 = TR1+TR4
            CR4 = TR1-TR4
            CI2 = TI1+TI4
            CI4 = TI1-TI4
            CH(I-1,K,2) = WA1(I-1)*CR2+WA1(I)*CI2
            CH(I,K,2) = WA1(I-1)*CI2-WA1(I)*CR2
            CH(I-1,K,3) = WA2(I-1)*CR3+WA2(I)*CI3
            CH(I,K,3) = WA2(I-1)*CI3-WA2(I)*CR3
            CH(I-1,K,4) = WA3(I-1)*CR4+WA3(I)*CI4
            CH(I,K,4) = WA3(I-1)*CI4-WA3(I)*CR4
  103    CONTINUE
  104 CONTINUE
      RETURN
      END






Added c/fftpack/passf5.c.


























































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* passf5.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int passf5_(integer *ido, integer *l1, real *cc, real *ch, 
	real *wa1, real *wa2, real *wa3, real *wa4)
{
    /* Initialized data */

    static real tr11 = .309016994374947f;
    static real ti11 = -.951056516295154f;
    static real tr12 = -.809016994374947f;
    static real ti12 = -.587785252292473f;

    /* System generated locals */
    integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;

    /* Local variables */
    integer i__, k;
    real ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, ti2, ti3,
	     ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;

    /* Parameter adjustments */
    ch_dim1 = *ido;
    ch_dim2 = *l1;
    ch_offset = 1 + ch_dim1 * (1 + ch_dim2);
    ch -= ch_offset;
    cc_dim1 = *ido;
    cc_offset = 1 + cc_dim1 * 6;
    cc -= cc_offset;
    --wa1;
    --wa2;
    --wa3;
    --wa4;

    /* Function Body */
    if (*ido != 2) {
	goto L102;
    }
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	ti5 = cc[(k * 5 + 2) * cc_dim1 + 2] - cc[(k * 5 + 5) * cc_dim1 + 2];
	ti2 = cc[(k * 5 + 2) * cc_dim1 + 2] + cc[(k * 5 + 5) * cc_dim1 + 2];
	ti4 = cc[(k * 5 + 3) * cc_dim1 + 2] - cc[(k * 5 + 4) * cc_dim1 + 2];
	ti3 = cc[(k * 5 + 3) * cc_dim1 + 2] + cc[(k * 5 + 4) * cc_dim1 + 2];
	tr5 = cc[(k * 5 + 2) * cc_dim1 + 1] - cc[(k * 5 + 5) * cc_dim1 + 1];
	tr2 = cc[(k * 5 + 2) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1];
	tr4 = cc[(k * 5 + 3) * cc_dim1 + 1] - cc[(k * 5 + 4) * cc_dim1 + 1];
	tr3 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 4) * cc_dim1 + 1];
	ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2 
		+ tr3;
	ch[(k + ch_dim2) * ch_dim1 + 2] = cc[(k * 5 + 1) * cc_dim1 + 2] + ti2 
		+ ti3;
	cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3;
	ci2 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr11 * ti2 + tr12 * ti3;
	cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3;
	ci3 = cc[(k * 5 + 1) * cc_dim1 + 2] + tr12 * ti2 + tr11 * ti3;
	cr5 = ti11 * tr5 + ti12 * tr4;
	ci5 = ti11 * ti5 + ti12 * ti4;
	cr4 = ti12 * tr5 - ti11 * tr4;
	ci4 = ti12 * ti5 - ti11 * ti4;
	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5;
	ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5;
	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 2] = ci2 + cr5;
	ch[(k + ch_dim2 * 3) * ch_dim1 + 2] = ci3 + cr4;
	ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4;
	ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4;
	ch[(k + (ch_dim2 << 2)) * ch_dim1 + 2] = ci3 - cr4;
	ch[(k + ch_dim2 * 5) * ch_dim1 + 2] = ci2 - cr5;
/* L101: */
    }
    return 0;
L102:
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	i__2 = *ido;
	for (i__ = 2; i__ <= i__2; i__ += 2) {
	    ti5 = cc[i__ + (k * 5 + 2) * cc_dim1] - cc[i__ + (k * 5 + 5) * 
		    cc_dim1];
	    ti2 = cc[i__ + (k * 5 + 2) * cc_dim1] + cc[i__ + (k * 5 + 5) * 
		    cc_dim1];
	    ti4 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[i__ + (k * 5 + 4) * 
		    cc_dim1];
	    ti3 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[i__ + (k * 5 + 4) * 
		    cc_dim1];
	    tr5 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] - cc[i__ - 1 + (k * 5 + 
		    5) * cc_dim1];
	    tr2 = cc[i__ - 1 + (k * 5 + 2) * cc_dim1] + cc[i__ - 1 + (k * 5 + 
		    5) * cc_dim1];
	    tr4 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[i__ - 1 + (k * 5 + 
		    4) * cc_dim1];
	    tr3 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[i__ - 1 + (k * 5 + 
		    4) * cc_dim1];
	    ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) *
		     cc_dim1] + tr2 + tr3;
	    ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) * 
		    cc_dim1] + ti2 + ti3;
	    cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 * 
		    tr3;
	    ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3;
	    cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 * 
		    tr3;
	    ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3;
	    cr5 = ti11 * tr5 + ti12 * tr4;
	    ci5 = ti11 * ti5 + ti12 * ti4;
	    cr4 = ti12 * tr5 - ti11 * tr4;
	    ci4 = ti12 * ti5 - ti11 * ti4;
	    dr3 = cr3 - ci4;
	    dr4 = cr3 + ci4;
	    di3 = ci3 + cr4;
	    di4 = ci3 - cr4;
	    dr5 = cr2 + ci5;
	    dr2 = cr2 - ci5;
	    di5 = ci2 - cr5;
	    di2 = ci2 + cr5;
	    ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * dr2 
		    + wa1[i__] * di2;
	    ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 1] * di2 - 
		    wa1[i__] * dr2;
	    ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * dr3 + 
		    wa2[i__] * di3;
	    ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 1] * di3 - wa2[
		    i__] * dr3;
	    ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * dr4 
		    + wa3[i__] * di4;
	    ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 1] * di4 - 
		    wa3[i__] * dr4;
	    ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * dr5 + 
		    wa4[i__] * di5;
	    ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 1] * di5 - wa4[
		    i__] * dr5;
/* L103: */
	}
/* L104: */
    }
    return 0;
} /* passf5_ */







Added c/fftpack/passf5.f.

















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE PASSF5 (IDO,L1,CC,CH,WA1,WA2,WA3,WA4)
      DIMENSION       CC(IDO,5,L1)           ,CH(IDO,L1,5)           ,
     1                WA1(1)     ,WA2(1)     ,WA3(1)     ,WA4(1)
      DATA TR11,TI11,TR12,TI12 /.309016994374947,-.951056516295154,
     1-.809016994374947,-.587785252292473/
      IF (IDO .NE. 2) GO TO 102
      DO 101 K=1,L1
         TI5 = CC(2,2,K)-CC(2,5,K)
         TI2 = CC(2,2,K)+CC(2,5,K)
         TI4 = CC(2,3,K)-CC(2,4,K)
         TI3 = CC(2,3,K)+CC(2,4,K)
         TR5 = CC(1,2,K)-CC(1,5,K)
         TR2 = CC(1,2,K)+CC(1,5,K)
         TR4 = CC(1,3,K)-CC(1,4,K)
         TR3 = CC(1,3,K)+CC(1,4,K)
         CH(1,K,1) = CC(1,1,K)+TR2+TR3
         CH(2,K,1) = CC(2,1,K)+TI2+TI3
         CR2 = CC(1,1,K)+TR11*TR2+TR12*TR3
         CI2 = CC(2,1,K)+TR11*TI2+TR12*TI3
         CR3 = CC(1,1,K)+TR12*TR2+TR11*TR3
         CI3 = CC(2,1,K)+TR12*TI2+TR11*TI3
         CR5 = TI11*TR5+TI12*TR4
         CI5 = TI11*TI5+TI12*TI4
         CR4 = TI12*TR5-TI11*TR4
         CI4 = TI12*TI5-TI11*TI4
         CH(1,K,2) = CR2-CI5
         CH(1,K,5) = CR2+CI5
         CH(2,K,2) = CI2+CR5
         CH(2,K,3) = CI3+CR4
         CH(1,K,3) = CR3-CI4
         CH(1,K,4) = CR3+CI4
         CH(2,K,4) = CI3-CR4
         CH(2,K,5) = CI2-CR5
  101 CONTINUE
      RETURN
  102 DO 104 K=1,L1
         DO 103 I=2,IDO,2
            TI5 = CC(I,2,K)-CC(I,5,K)
            TI2 = CC(I,2,K)+CC(I,5,K)
            TI4 = CC(I,3,K)-CC(I,4,K)
            TI3 = CC(I,3,K)+CC(I,4,K)
            TR5 = CC(I-1,2,K)-CC(I-1,5,K)
            TR2 = CC(I-1,2,K)+CC(I-1,5,K)
            TR4 = CC(I-1,3,K)-CC(I-1,4,K)
            TR3 = CC(I-1,3,K)+CC(I-1,4,K)
            CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3
            CH(I,K,1) = CC(I,1,K)+TI2+TI3
            CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3
            CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3
            CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3
            CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3
            CR5 = TI11*TR5+TI12*TR4
            CI5 = TI11*TI5+TI12*TI4
            CR4 = TI12*TR5-TI11*TR4
            CI4 = TI12*TI5-TI11*TI4
            DR3 = CR3-CI4
            DR4 = CR3+CI4
            DI3 = CI3+CR4
            DI4 = CI3-CR4
            DR5 = CR2+CI5
            DR2 = CR2-CI5
            DI5 = CI2-CR5
            DI2 = CI2+CR5
            CH(I-1,K,2) = WA1(I-1)*DR2+WA1(I)*DI2
            CH(I,K,2) = WA1(I-1)*DI2-WA1(I)*DR2
            CH(I-1,K,3) = WA2(I-1)*DR3+WA2(I)*DI3
            CH(I,K,3) = WA2(I-1)*DI3-WA2(I)*DR3
            CH(I-1,K,4) = WA3(I-1)*DR4+WA3(I)*DI4
            CH(I,K,4) = WA3(I-1)*DI4-WA3(I)*DR4
            CH(I-1,K,5) = WA4(I-1)*DR5+WA4(I)*DI5
            CH(I,K,5) = WA4(I-1)*DI5-WA4(I)*DR5
  103    CONTINUE
  104 CONTINUE
      RETURN
      END






Added c/fftpack/radb2.c.
































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* radb2.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int radb2_(integer *ido, integer *l1, real *cc, real *ch, 
	real *wa1)
{
    /* System generated locals */
    integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;

    /* Local variables */
    integer i__, k, ic;
    real ti2, tr2;
    integer idp2;

    /* Parameter adjustments */
    ch_dim1 = *ido;
    ch_dim2 = *l1;
    ch_offset = 1 + ch_dim1 * (1 + ch_dim2);
    ch -= ch_offset;
    cc_dim1 = *ido;
    cc_offset = 1 + cc_dim1 * 3;
    cc -= cc_offset;
    --wa1;

    /* Function Body */
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	ch[(k + ch_dim2) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 + 1] + 
		cc[*ido + ((k << 1) + 2) * cc_dim1];
	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cc[((k << 1) + 1) * cc_dim1 
		+ 1] - cc[*ido + ((k << 1) + 2) * cc_dim1];
/* L101: */
    }
    if ((i__1 = *ido - 2) < 0) {
	goto L107;
    } else if (i__1 == 0) {
	goto L105;
    } else {
	goto L102;
    }
L102:
    idp2 = *ido + 2;
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	i__2 = *ido;
	for (i__ = 3; i__ <= i__2; i__ += 2) {
	    ic = idp2 - i__;
	    ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + ((k << 1) + 
		    1) * cc_dim1] + cc[ic - 1 + ((k << 1) + 2) * cc_dim1];
	    tr2 = cc[i__ - 1 + ((k << 1) + 1) * cc_dim1] - cc[ic - 1 + ((k << 
		    1) + 2) * cc_dim1];
	    ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + ((k << 1) + 1) * 
		    cc_dim1] - cc[ic + ((k << 1) + 2) * cc_dim1];
	    ti2 = cc[i__ + ((k << 1) + 1) * cc_dim1] + cc[ic + ((k << 1) + 2) 
		    * cc_dim1];
	    ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * tr2 
		    - wa1[i__ - 1] * ti2;
	    ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * ti2 + 
		    wa1[i__ - 1] * tr2;
/* L103: */
	}
/* L104: */
    }
    if (*ido % 2 == 1) {
	return 0;
    }
L105:
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	ch[*ido + (k + ch_dim2) * ch_dim1] = cc[*ido + ((k << 1) + 1) * 
		cc_dim1] + cc[*ido + ((k << 1) + 1) * cc_dim1];
	ch[*ido + (k + (ch_dim2 << 1)) * ch_dim1] = -(cc[((k << 1) + 2) * 
		cc_dim1 + 1] + cc[((k << 1) + 2) * cc_dim1 + 1]);
/* L106: */
    }
L107:
    return 0;
} /* radb2_ */







Added c/fftpack/radb2.f.

































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE RADB2 (IDO,L1,CC,CH,WA1)
      DIMENSION       CC(IDO,2,L1)           ,CH(IDO,L1,2)           ,
     1                WA1(1)
      DO 101 K=1,L1
         CH(1,K,1) = CC(1,1,K)+CC(IDO,2,K)
         CH(1,K,2) = CC(1,1,K)-CC(IDO,2,K)
  101 CONTINUE
      IF (IDO-2) 107,105,102
  102 IDP2 = IDO+2
      DO 104 K=1,L1
         DO 103 I=3,IDO,2
            IC = IDP2-I
            CH(I-1,K,1) = CC(I-1,1,K)+CC(IC-1,2,K)
            TR2 = CC(I-1,1,K)-CC(IC-1,2,K)
            CH(I,K,1) = CC(I,1,K)-CC(IC,2,K)
            TI2 = CC(I,1,K)+CC(IC,2,K)
            CH(I-1,K,2) = WA1(I-2)*TR2-WA1(I-1)*TI2
            CH(I,K,2) = WA1(I-2)*TI2+WA1(I-1)*TR2
  103    CONTINUE
  104 CONTINUE
      IF (MOD(IDO,2) .EQ. 1) RETURN
  105 DO 106 K=1,L1
         CH(IDO,K,1) = CC(IDO,1,K)+CC(IDO,1,K)
         CH(IDO,K,2) = -(CC(1,2,K)+CC(1,2,K))
  106 CONTINUE
  107 RETURN
      END






Added c/fftpack/radb3.c.






































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* radb3.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int radb3_(integer *ido, integer *l1, real *cc, real *ch, 
	real *wa1, real *wa2)
{
    /* Initialized data */

    static real taur = -.5f;
    static real taui = .866025403784439f;

    /* System generated locals */
    integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;

    /* Local variables */
    integer i__, k, ic;
    real ci2, ci3, di2, di3, cr2, cr3, dr2, dr3, ti2, tr2;
    integer idp2;

    /* Parameter adjustments */
    ch_dim1 = *ido;
    ch_dim2 = *l1;
    ch_offset = 1 + ch_dim1 * (1 + ch_dim2);
    ch -= ch_offset;
    cc_dim1 = *ido;
    cc_offset = 1 + (cc_dim1 << 2);
    cc -= cc_offset;
    --wa1;
    --wa2;

    /* Function Body */
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	tr2 = cc[*ido + (k * 3 + 2) * cc_dim1] + cc[*ido + (k * 3 + 2) * 
		cc_dim1];
	cr2 = cc[(k * 3 + 1) * cc_dim1 + 1] + taur * tr2;
	ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 3 + 1) * cc_dim1 + 1] + tr2;
	ci3 = taui * (cc[(k * 3 + 3) * cc_dim1 + 1] + cc[(k * 3 + 3) * 
		cc_dim1 + 1]);
	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci3;
	ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr2 + ci3;
/* L101: */
    }
    if (*ido == 1) {
	return 0;
    }
    idp2 = *ido + 2;
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	i__2 = *ido;
	for (i__ = 3; i__ <= i__2; i__ += 2) {
	    ic = idp2 - i__;
	    tr2 = cc[i__ - 1 + (k * 3 + 3) * cc_dim1] + cc[ic - 1 + (k * 3 + 
		    2) * cc_dim1];
	    cr2 = cc[i__ - 1 + (k * 3 + 1) * cc_dim1] + taur * tr2;
	    ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 3 + 1) *
		     cc_dim1] + tr2;
	    ti2 = cc[i__ + (k * 3 + 3) * cc_dim1] - cc[ic + (k * 3 + 2) * 
		    cc_dim1];
	    ci2 = cc[i__ + (k * 3 + 1) * cc_dim1] + taur * ti2;
	    ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 3 + 1) * 
		    cc_dim1] + ti2;
	    cr3 = taui * (cc[i__ - 1 + (k * 3 + 3) * cc_dim1] - cc[ic - 1 + (
		    k * 3 + 2) * cc_dim1]);
	    ci3 = taui * (cc[i__ + (k * 3 + 3) * cc_dim1] + cc[ic + (k * 3 + 
		    2) * cc_dim1]);
	    dr2 = cr2 - ci3;
	    dr3 = cr2 + ci3;
	    di2 = ci2 + cr3;
	    di3 = ci2 - cr3;
	    ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * dr2 
		    - wa1[i__ - 1] * di2;
	    ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * di2 + 
		    wa1[i__ - 1] * dr2;
	    ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * dr3 - 
		    wa2[i__ - 1] * di3;
	    ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * di3 + wa2[
		    i__ - 1] * dr3;
/* L102: */
	}
/* L103: */
    }
    return 0;
} /* radb3_ */







Added c/fftpack/radb3.f.











































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE RADB3 (IDO,L1,CC,CH,WA1,WA2)
      DIMENSION       CC(IDO,3,L1)           ,CH(IDO,L1,3)           ,
     1                WA1(1)     ,WA2(1)
      DATA TAUR,TAUI /-.5,.866025403784439/
      DO 101 K=1,L1
         TR2 = CC(IDO,2,K)+CC(IDO,2,K)
         CR2 = CC(1,1,K)+TAUR*TR2
         CH(1,K,1) = CC(1,1,K)+TR2
         CI3 = TAUI*(CC(1,3,K)+CC(1,3,K))
         CH(1,K,2) = CR2-CI3
         CH(1,K,3) = CR2+CI3
  101 CONTINUE
      IF (IDO .EQ. 1) RETURN
      IDP2 = IDO+2
      DO 103 K=1,L1
         DO 102 I=3,IDO,2
            IC = IDP2-I
            TR2 = CC(I-1,3,K)+CC(IC-1,2,K)
            CR2 = CC(I-1,1,K)+TAUR*TR2
            CH(I-1,K,1) = CC(I-1,1,K)+TR2
            TI2 = CC(I,3,K)-CC(IC,2,K)
            CI2 = CC(I,1,K)+TAUR*TI2
            CH(I,K,1) = CC(I,1,K)+TI2
            CR3 = TAUI*(CC(I-1,3,K)-CC(IC-1,2,K))
            CI3 = TAUI*(CC(I,3,K)+CC(IC,2,K))
            DR2 = CR2-CI3
            DR3 = CR2+CI3
            DI2 = CI2+CR3
            DI3 = CI2-CR3
            CH(I-1,K,2) = WA1(I-2)*DR2-WA1(I-1)*DI2
            CH(I,K,2) = WA1(I-2)*DI2+WA1(I-1)*DR2
            CH(I-1,K,3) = WA2(I-2)*DR3-WA2(I-1)*DI3
            CH(I,K,3) = WA2(I-2)*DI3+WA2(I-1)*DR3
  102    CONTINUE
  103 CONTINUE
      RETURN
      END






Added c/fftpack/radb4.c.














































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* radb4.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int radb4_(integer *ido, integer *l1, real *cc, real *ch, 
	real *wa1, real *wa2, real *wa3)
{
    /* Initialized data */

    static real sqrt2 = 1.414213562373095f;

    /* System generated locals */
    integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;

    /* Local variables */
    integer i__, k, ic;
    real ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4;
    integer idp2;

    /* Parameter adjustments */
    ch_dim1 = *ido;
    ch_dim2 = *l1;
    ch_offset = 1 + ch_dim1 * (1 + ch_dim2);
    ch -= ch_offset;
    cc_dim1 = *ido;
    cc_offset = 1 + cc_dim1 * 5;
    cc -= cc_offset;
    --wa1;
    --wa2;
    --wa3;

    /* Function Body */
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	tr1 = cc[((k << 2) + 1) * cc_dim1 + 1] - cc[*ido + ((k << 2) + 4) * 
		cc_dim1];
	tr2 = cc[((k << 2) + 1) * cc_dim1 + 1] + cc[*ido + ((k << 2) + 4) * 
		cc_dim1];
	tr3 = cc[*ido + ((k << 2) + 2) * cc_dim1] + cc[*ido + ((k << 2) + 2) *
		 cc_dim1];
	tr4 = cc[((k << 2) + 3) * cc_dim1 + 1] + cc[((k << 2) + 3) * cc_dim1 
		+ 1];
	ch[(k + ch_dim2) * ch_dim1 + 1] = tr2 + tr3;
	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = tr1 - tr4;
	ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = tr2 - tr3;
	ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = tr1 + tr4;
/* L101: */
    }
    if ((i__1 = *ido - 2) < 0) {
	goto L107;
    } else if (i__1 == 0) {
	goto L105;
    } else {
	goto L102;
    }
L102:
    idp2 = *ido + 2;
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	i__2 = *ido;
	for (i__ = 3; i__ <= i__2; i__ += 2) {
	    ic = idp2 - i__;
	    ti1 = cc[i__ + ((k << 2) + 1) * cc_dim1] + cc[ic + ((k << 2) + 4) 
		    * cc_dim1];
	    ti2 = cc[i__ + ((k << 2) + 1) * cc_dim1] - cc[ic + ((k << 2) + 4) 
		    * cc_dim1];
	    ti3 = cc[i__ + ((k << 2) + 3) * cc_dim1] - cc[ic + ((k << 2) + 2) 
		    * cc_dim1];
	    tr4 = cc[i__ + ((k << 2) + 3) * cc_dim1] + cc[ic + ((k << 2) + 2) 
		    * cc_dim1];
	    tr1 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] - cc[ic - 1 + ((k << 
		    2) + 4) * cc_dim1];
	    tr2 = cc[i__ - 1 + ((k << 2) + 1) * cc_dim1] + cc[ic - 1 + ((k << 
		    2) + 4) * cc_dim1];
	    ti4 = cc[i__ - 1 + ((k << 2) + 3) * cc_dim1] - cc[ic - 1 + ((k << 
		    2) + 2) * cc_dim1];
	    tr3 = cc[i__ - 1 + ((k << 2) + 3) * cc_dim1] + cc[ic - 1 + ((k << 
		    2) + 2) * cc_dim1];
	    ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = tr2 + tr3;
	    cr3 = tr2 - tr3;
	    ch[i__ + (k + ch_dim2) * ch_dim1] = ti2 + ti3;
	    ci3 = ti2 - ti3;
	    cr2 = tr1 - tr4;
	    cr4 = tr1 + tr4;
	    ci2 = ti1 + ti4;
	    ci4 = ti1 - ti4;
	    ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * cr2 
		    - wa1[i__ - 1] * ci2;
	    ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * ci2 + 
		    wa1[i__ - 1] * cr2;
	    ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * cr3 - 
		    wa2[i__ - 1] * ci3;
	    ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * ci3 + wa2[
		    i__ - 1] * cr3;
	    ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * cr4 
		    - wa3[i__ - 1] * ci4;
	    ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * ci4 + 
		    wa3[i__ - 1] * cr4;
/* L103: */
	}
/* L104: */
    }
    if (*ido % 2 == 1) {
	return 0;
    }
L105:
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	ti1 = cc[((k << 2) + 2) * cc_dim1 + 1] + cc[((k << 2) + 4) * cc_dim1 
		+ 1];
	ti2 = cc[((k << 2) + 4) * cc_dim1 + 1] - cc[((k << 2) + 2) * cc_dim1 
		+ 1];
	tr1 = cc[*ido + ((k << 2) + 1) * cc_dim1] - cc[*ido + ((k << 2) + 3) *
		 cc_dim1];
	tr2 = cc[*ido + ((k << 2) + 1) * cc_dim1] + cc[*ido + ((k << 2) + 3) *
		 cc_dim1];
	ch[*ido + (k + ch_dim2) * ch_dim1] = tr2 + tr2;
	ch[*ido + (k + (ch_dim2 << 1)) * ch_dim1] = sqrt2 * (tr1 - ti1);
	ch[*ido + (k + ch_dim2 * 3) * ch_dim1] = ti2 + ti2;
	ch[*ido + (k + (ch_dim2 << 2)) * ch_dim1] = -sqrt2 * (tr1 + ti1);
/* L106: */
    }
L107:
    return 0;
} /* radb4_ */







Added c/fftpack/radb4.f.































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE RADB4 (IDO,L1,CC,CH,WA1,WA2,WA3)
      DIMENSION       CC(IDO,4,L1)           ,CH(IDO,L1,4)           ,
     1                WA1(1)     ,WA2(1)     ,WA3(1)
      DATA SQRT2 /1.414213562373095/
      DO 101 K=1,L1
         TR1 = CC(1,1,K)-CC(IDO,4,K)
         TR2 = CC(1,1,K)+CC(IDO,4,K)
         TR3 = CC(IDO,2,K)+CC(IDO,2,K)
         TR4 = CC(1,3,K)+CC(1,3,K)
         CH(1,K,1) = TR2+TR3
         CH(1,K,2) = TR1-TR4
         CH(1,K,3) = TR2-TR3
         CH(1,K,4) = TR1+TR4
  101 CONTINUE
      IF (IDO-2) 107,105,102
  102 IDP2 = IDO+2
      DO 104 K=1,L1
         DO 103 I=3,IDO,2
            IC = IDP2-I
            TI1 = CC(I,1,K)+CC(IC,4,K)
            TI2 = CC(I,1,K)-CC(IC,4,K)
            TI3 = CC(I,3,K)-CC(IC,2,K)
            TR4 = CC(I,3,K)+CC(IC,2,K)
            TR1 = CC(I-1,1,K)-CC(IC-1,4,K)
            TR2 = CC(I-1,1,K)+CC(IC-1,4,K)
            TI4 = CC(I-1,3,K)-CC(IC-1,2,K)
            TR3 = CC(I-1,3,K)+CC(IC-1,2,K)
            CH(I-1,K,1) = TR2+TR3
            CR3 = TR2-TR3
            CH(I,K,1) = TI2+TI3
            CI3 = TI2-TI3
            CR2 = TR1-TR4
            CR4 = TR1+TR4
            CI2 = TI1+TI4
            CI4 = TI1-TI4
            CH(I-1,K,2) = WA1(I-2)*CR2-WA1(I-1)*CI2
            CH(I,K,2) = WA1(I-2)*CI2+WA1(I-1)*CR2
            CH(I-1,K,3) = WA2(I-2)*CR3-WA2(I-1)*CI3
            CH(I,K,3) = WA2(I-2)*CI3+WA2(I-1)*CR3
            CH(I-1,K,4) = WA3(I-2)*CR4-WA3(I-1)*CI4
            CH(I,K,4) = WA3(I-2)*CI4+WA3(I-1)*CR4
  103    CONTINUE
  104 CONTINUE
      IF (MOD(IDO,2) .EQ. 1) RETURN
  105 CONTINUE
      DO 106 K=1,L1
         TI1 = CC(1,2,K)+CC(1,4,K)
         TI2 = CC(1,4,K)-CC(1,2,K)
         TR1 = CC(IDO,1,K)-CC(IDO,3,K)
         TR2 = CC(IDO,1,K)+CC(IDO,3,K)
         CH(IDO,K,1) = TR2+TR2
         CH(IDO,K,2) = SQRT2*(TR1-TI1)
         CH(IDO,K,3) = TI2+TI2
         CH(IDO,K,4) = -SQRT2*(TR1+TI1)
  106 CONTINUE
  107 RETURN
      END






Added c/fftpack/radb5.c.















































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* radb5.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int radb5_(integer *ido, integer *l1, real *cc, real *ch, 
	real *wa1, real *wa2, real *wa3, real *wa4)
{
    /* Initialized data */

    static real tr11 = .309016994374947f;
    static real ti11 = .951056516295154f;
    static real tr12 = -.809016994374947f;
    static real ti12 = .587785252292473f;

    /* System generated locals */
    integer cc_dim1, cc_offset, ch_dim1, ch_dim2, ch_offset, i__1, i__2;

    /* Local variables */
    integer i__, k, ic;
    real ci2, ci3, ci4, ci5, di3, di4, di5, di2, cr2, cr3, cr5, cr4, ti2, ti3,
	     ti4, ti5, dr3, dr4, dr5, dr2, tr2, tr3, tr4, tr5;
    integer idp2;

    /* Parameter adjustments */
    ch_dim1 = *ido;
    ch_dim2 = *l1;
    ch_offset = 1 + ch_dim1 * (1 + ch_dim2);
    ch -= ch_offset;
    cc_dim1 = *ido;
    cc_offset = 1 + cc_dim1 * 6;
    cc -= cc_offset;
    --wa1;
    --wa2;
    --wa3;
    --wa4;

    /* Function Body */
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	ti5 = cc[(k * 5 + 3) * cc_dim1 + 1] + cc[(k * 5 + 3) * cc_dim1 + 1];
	ti4 = cc[(k * 5 + 5) * cc_dim1 + 1] + cc[(k * 5 + 5) * cc_dim1 + 1];
	tr2 = cc[*ido + (k * 5 + 2) * cc_dim1] + cc[*ido + (k * 5 + 2) * 
		cc_dim1];
	tr3 = cc[*ido + (k * 5 + 4) * cc_dim1] + cc[*ido + (k * 5 + 4) * 
		cc_dim1];
	ch[(k + ch_dim2) * ch_dim1 + 1] = cc[(k * 5 + 1) * cc_dim1 + 1] + tr2 
		+ tr3;
	cr2 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr11 * tr2 + tr12 * tr3;
	cr3 = cc[(k * 5 + 1) * cc_dim1 + 1] + tr12 * tr2 + tr11 * tr3;
	ci5 = ti11 * ti5 + ti12 * ti4;
	ci4 = ti12 * ti5 - ti11 * ti4;
	ch[(k + (ch_dim2 << 1)) * ch_dim1 + 1] = cr2 - ci5;
	ch[(k + ch_dim2 * 3) * ch_dim1 + 1] = cr3 - ci4;
	ch[(k + (ch_dim2 << 2)) * ch_dim1 + 1] = cr3 + ci4;
	ch[(k + ch_dim2 * 5) * ch_dim1 + 1] = cr2 + ci5;
/* L101: */
    }
    if (*ido == 1) {
	return 0;
    }
    idp2 = *ido + 2;
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	i__2 = *ido;
	for (i__ = 3; i__ <= i__2; i__ += 2) {
	    ic = idp2 - i__;
	    ti5 = cc[i__ + (k * 5 + 3) * cc_dim1] + cc[ic + (k * 5 + 2) * 
		    cc_dim1];
	    ti2 = cc[i__ + (k * 5 + 3) * cc_dim1] - cc[ic + (k * 5 + 2) * 
		    cc_dim1];
	    ti4 = cc[i__ + (k * 5 + 5) * cc_dim1] + cc[ic + (k * 5 + 4) * 
		    cc_dim1];
	    ti3 = cc[i__ + (k * 5 + 5) * cc_dim1] - cc[ic + (k * 5 + 4) * 
		    cc_dim1];
	    tr5 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] - cc[ic - 1 + (k * 5 + 
		    2) * cc_dim1];
	    tr2 = cc[i__ - 1 + (k * 5 + 3) * cc_dim1] + cc[ic - 1 + (k * 5 + 
		    2) * cc_dim1];
	    tr4 = cc[i__ - 1 + (k * 5 + 5) * cc_dim1] - cc[ic - 1 + (k * 5 + 
		    4) * cc_dim1];
	    tr3 = cc[i__ - 1 + (k * 5 + 5) * cc_dim1] + cc[ic - 1 + (k * 5 + 
		    4) * cc_dim1];
	    ch[i__ - 1 + (k + ch_dim2) * ch_dim1] = cc[i__ - 1 + (k * 5 + 1) *
		     cc_dim1] + tr2 + tr3;
	    ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * 5 + 1) * 
		    cc_dim1] + ti2 + ti3;
	    cr2 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr11 * tr2 + tr12 * 
		    tr3;
	    ci2 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr11 * ti2 + tr12 * ti3;
	    cr3 = cc[i__ - 1 + (k * 5 + 1) * cc_dim1] + tr12 * tr2 + tr11 * 
		    tr3;
	    ci3 = cc[i__ + (k * 5 + 1) * cc_dim1] + tr12 * ti2 + tr11 * ti3;
	    cr5 = ti11 * tr5 + ti12 * tr4;
	    ci5 = ti11 * ti5 + ti12 * ti4;
	    cr4 = ti12 * tr5 - ti11 * tr4;
	    ci4 = ti12 * ti5 - ti11 * ti4;
	    dr3 = cr3 - ci4;
	    dr4 = cr3 + ci4;
	    di3 = ci3 + cr4;
	    di4 = ci3 - cr4;
	    dr5 = cr2 + ci5;
	    dr2 = cr2 - ci5;
	    di5 = ci2 - cr5;
	    di2 = ci2 + cr5;
	    ch[i__ - 1 + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * dr2 
		    - wa1[i__ - 1] * di2;
	    ch[i__ + (k + (ch_dim2 << 1)) * ch_dim1] = wa1[i__ - 2] * di2 + 
		    wa1[i__ - 1] * dr2;
	    ch[i__ - 1 + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * dr3 - 
		    wa2[i__ - 1] * di3;
	    ch[i__ + (k + ch_dim2 * 3) * ch_dim1] = wa2[i__ - 2] * di3 + wa2[
		    i__ - 1] * dr3;
	    ch[i__ - 1 + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * dr4 
		    - wa3[i__ - 1] * di4;
	    ch[i__ + (k + (ch_dim2 << 2)) * ch_dim1] = wa3[i__ - 2] * di4 + 
		    wa3[i__ - 1] * dr4;
	    ch[i__ - 1 + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 2] * dr5 - 
		    wa4[i__ - 1] * di5;
	    ch[i__ + (k + ch_dim2 * 5) * ch_dim1] = wa4[i__ - 2] * di5 + wa4[
		    i__ - 1] * dr5;
/* L102: */
	}
/* L103: */
    }
    return 0;
} /* radb5_ */







Added c/fftpack/radb5.f.





































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE RADB5 (IDO,L1,CC,CH,WA1,WA2,WA3,WA4)
      DIMENSION       CC(IDO,5,L1)           ,CH(IDO,L1,5)           ,
     1                WA1(1)     ,WA2(1)     ,WA3(1)     ,WA4(1)
      DATA TR11,TI11,TR12,TI12 /.309016994374947,.951056516295154,
     1-.809016994374947,.587785252292473/
      DO 101 K=1,L1
         TI5 = CC(1,3,K)+CC(1,3,K)
         TI4 = CC(1,5,K)+CC(1,5,K)
         TR2 = CC(IDO,2,K)+CC(IDO,2,K)
         TR3 = CC(IDO,4,K)+CC(IDO,4,K)
         CH(1,K,1) = CC(1,1,K)+TR2+TR3
         CR2 = CC(1,1,K)+TR11*TR2+TR12*TR3
         CR3 = CC(1,1,K)+TR12*TR2+TR11*TR3
         CI5 = TI11*TI5+TI12*TI4
         CI4 = TI12*TI5-TI11*TI4
         CH(1,K,2) = CR2-CI5
         CH(1,K,3) = CR3-CI4
         CH(1,K,4) = CR3+CI4
         CH(1,K,5) = CR2+CI5
  101 CONTINUE
      IF (IDO .EQ. 1) RETURN
      IDP2 = IDO+2
      DO 103 K=1,L1
         DO 102 I=3,IDO,2
            IC = IDP2-I
            TI5 = CC(I,3,K)+CC(IC,2,K)
            TI2 = CC(I,3,K)-CC(IC,2,K)
            TI4 = CC(I,5,K)+CC(IC,4,K)
            TI3 = CC(I,5,K)-CC(IC,4,K)
            TR5 = CC(I-1,3,K)-CC(IC-1,2,K)
            TR2 = CC(I-1,3,K)+CC(IC-1,2,K)
            TR4 = CC(I-1,5,K)-CC(IC-1,4,K)
            TR3 = CC(I-1,5,K)+CC(IC-1,4,K)
            CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3
            CH(I,K,1) = CC(I,1,K)+TI2+TI3
            CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3
            CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3
            CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3
            CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3
            CR5 = TI11*TR5+TI12*TR4
            CI5 = TI11*TI5+TI12*TI4
            CR4 = TI12*TR5-TI11*TR4
            CI4 = TI12*TI5-TI11*TI4
            DR3 = CR3-CI4
            DR4 = CR3+CI4
            DI3 = CI3+CR4
            DI4 = CI3-CR4
            DR5 = CR2+CI5
            DR2 = CR2-CI5
            DI5 = CI2-CR5
            DI2 = CI2+CR5
            CH(I-1,K,2) = WA1(I-2)*DR2-WA1(I-1)*DI2
            CH(I,K,2) = WA1(I-2)*DI2+WA1(I-1)*DR2
            CH(I-1,K,3) = WA2(I-2)*DR3-WA2(I-1)*DI3
            CH(I,K,3) = WA2(I-2)*DI3+WA2(I-1)*DR3
            CH(I-1,K,4) = WA3(I-2)*DR4-WA3(I-1)*DI4
            CH(I,K,4) = WA3(I-2)*DI4+WA3(I-1)*DR4
            CH(I-1,K,5) = WA4(I-2)*DR5-WA4(I-1)*DI5
            CH(I,K,5) = WA4(I-2)*DI5+WA4(I-1)*DR5
  102    CONTINUE
  103 CONTINUE
      RETURN
      END






Added c/fftpack/radbg.c.








































































































































































































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* radbg.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int radbg_(integer *ido, integer *ip, integer *l1, integer *
	idl1, real *cc, real *c1, real *c2, real *ch, real *ch2, real *wa)
{
    /* Initialized data */

    static real tpi = 6.28318530717959f;

    /* System generated locals */
    integer ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
	     c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset, 
	    i__1, i__2, i__3;

    /* Builtin functions */
    double cos(doublereal), sin(doublereal);

    /* Local variables */
    integer i__, j, k, l, j2, ic, jc, lc, ik, is;
    real dc2, ai1, ai2, ar1, ar2, ds2;
    integer nbd;
    real dcp, arg, dsp, ar1h, ar2h;
    integer idp2, ipp2, idij, ipph;

    /* Parameter adjustments */
    ch_dim1 = *ido;
    ch_dim2 = *l1;
    ch_offset = 1 + ch_dim1 * (1 + ch_dim2);
    ch -= ch_offset;
    c1_dim1 = *ido;
    c1_dim2 = *l1;
    c1_offset = 1 + c1_dim1 * (1 + c1_dim2);
    c1 -= c1_offset;
    cc_dim1 = *ido;
    cc_dim2 = *ip;
    cc_offset = 1 + cc_dim1 * (1 + cc_dim2);
    cc -= cc_offset;
    ch2_dim1 = *idl1;
    ch2_offset = 1 + ch2_dim1;
    ch2 -= ch2_offset;
    c2_dim1 = *idl1;
    c2_offset = 1 + c2_dim1;
    c2 -= c2_offset;
    --wa;

    /* Function Body */
    arg = tpi / (real) (*ip);
    dcp = cos(arg);
    dsp = sin(arg);
    idp2 = *ido + 2;
    nbd = (*ido - 1) / 2;
    ipp2 = *ip + 2;
    ipph = (*ip + 1) / 2;
    if (*ido < *l1) {
	goto L103;
    }
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	i__2 = *ido;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * 
		    cc_dim1];
/* L101: */
	}
/* L102: */
    }
    goto L106;
L103:
    i__1 = *ido;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    ch[i__ + (k + ch_dim2) * ch_dim1] = cc[i__ + (k * cc_dim2 + 1) * 
		    cc_dim1];
/* L104: */
	}
/* L105: */
    }
L106:
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	jc = ipp2 - j;
	j2 = j + j;
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    ch[(k + j * ch_dim2) * ch_dim1 + 1] = cc[*ido + (j2 - 2 + k * 
		    cc_dim2) * cc_dim1] + cc[*ido + (j2 - 2 + k * cc_dim2) * 
		    cc_dim1];
	    ch[(k + jc * ch_dim2) * ch_dim1 + 1] = cc[(j2 - 1 + k * cc_dim2) *
		     cc_dim1 + 1] + cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1];
/* L107: */
	}
/* L108: */
    }
    if (*ido == 1) {
	goto L116;
    }
    if (nbd < *l1) {
	goto L112;
    }
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	jc = ipp2 - j;
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    i__3 = *ido;
	    for (i__ = 3; i__ <= i__3; i__ += 2) {
		ic = idp2 - i__;
		ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j 
			<< 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic - 1 + ((j 
			<< 1) - 2 + k * cc_dim2) * cc_dim1];
		ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j 
			<< 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic - 1 + ((j 
			<< 1) - 2 + k * cc_dim2) * cc_dim1];
		ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) - 
			1 + k * cc_dim2) * cc_dim1] - cc[ic + ((j << 1) - 2 + 
			k * cc_dim2) * cc_dim1];
		ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) - 
			1 + k * cc_dim2) * cc_dim1] + cc[ic + ((j << 1) - 2 + 
			k * cc_dim2) * cc_dim1];
/* L109: */
	    }
/* L110: */
	}
/* L111: */
    }
    goto L116;
L112:
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	jc = ipp2 - j;
	i__2 = *ido;
	for (i__ = 3; i__ <= i__2; i__ += 2) {
	    ic = idp2 - i__;
	    i__3 = *l1;
	    for (k = 1; k <= i__3; ++k) {
		ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j 
			<< 1) - 1 + k * cc_dim2) * cc_dim1] + cc[ic - 1 + ((j 
			<< 1) - 2 + k * cc_dim2) * cc_dim1];
		ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = cc[i__ - 1 + ((j 
			<< 1) - 1 + k * cc_dim2) * cc_dim1] - cc[ic - 1 + ((j 
			<< 1) - 2 + k * cc_dim2) * cc_dim1];
		ch[i__ + (k + j * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) - 
			1 + k * cc_dim2) * cc_dim1] - cc[ic + ((j << 1) - 2 + 
			k * cc_dim2) * cc_dim1];
		ch[i__ + (k + jc * ch_dim2) * ch_dim1] = cc[i__ + ((j << 1) - 
			1 + k * cc_dim2) * cc_dim1] + cc[ic + ((j << 1) - 2 + 
			k * cc_dim2) * cc_dim1];
/* L113: */
	    }
/* L114: */
	}
/* L115: */
    }
L116:
    ar1 = 1.f;
    ai1 = 0.f;
    i__1 = ipph;
    for (l = 2; l <= i__1; ++l) {
	lc = ipp2 - l;
	ar1h = dcp * ar1 - dsp * ai1;
	ai1 = dcp * ai1 + dsp * ar1;
	ar1 = ar1h;
	i__2 = *idl1;
	for (ik = 1; ik <= i__2; ++ik) {
	    c2[ik + l * c2_dim1] = ch2[ik + ch2_dim1] + ar1 * ch2[ik + (
		    ch2_dim1 << 1)];
	    c2[ik + lc * c2_dim1] = ai1 * ch2[ik + *ip * ch2_dim1];
/* L117: */
	}
	dc2 = ar1;
	ds2 = ai1;
	ar2 = ar1;
	ai2 = ai1;
	i__2 = ipph;
	for (j = 3; j <= i__2; ++j) {
	    jc = ipp2 - j;
	    ar2h = dc2 * ar2 - ds2 * ai2;
	    ai2 = dc2 * ai2 + ds2 * ar2;
	    ar2 = ar2h;
	    i__3 = *idl1;
	    for (ik = 1; ik <= i__3; ++ik) {
		c2[ik + l * c2_dim1] += ar2 * ch2[ik + j * ch2_dim1];
		c2[ik + lc * c2_dim1] += ai2 * ch2[ik + jc * ch2_dim1];
/* L118: */
	    }
/* L119: */
	}
/* L120: */
    }
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	i__2 = *idl1;
	for (ik = 1; ik <= i__2; ++ik) {
	    ch2[ik + ch2_dim1] += ch2[ik + j * ch2_dim1];
/* L121: */
	}
/* L122: */
    }
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	jc = ipp2 - j;
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    ch[(k + j * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) * 
		    c1_dim1 + 1] - c1[(k + jc * c1_dim2) * c1_dim1 + 1];
	    ch[(k + jc * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) * 
		    c1_dim1 + 1] + c1[(k + jc * c1_dim2) * c1_dim1 + 1];
/* L123: */
	}
/* L124: */
    }
    if (*ido == 1) {
	goto L132;
    }
    if (nbd < *l1) {
	goto L128;
    }
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	jc = ipp2 - j;
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    i__3 = *ido;
	    for (i__ = 3; i__ <= i__3; i__ += 2) {
		ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k + 
			j * c1_dim2) * c1_dim1] - c1[i__ + (k + jc * c1_dim2) 
			* c1_dim1];
		ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k 
			+ j * c1_dim2) * c1_dim1] + c1[i__ + (k + jc * 
			c1_dim2) * c1_dim1];
		ch[i__ + (k + j * ch_dim2) * ch_dim1] = c1[i__ + (k + j * 
			c1_dim2) * c1_dim1] + c1[i__ - 1 + (k + jc * c1_dim2) 
			* c1_dim1];
		ch[i__ + (k + jc * ch_dim2) * ch_dim1] = c1[i__ + (k + j * 
			c1_dim2) * c1_dim1] - c1[i__ - 1 + (k + jc * c1_dim2) 
			* c1_dim1];
/* L125: */
	    }
/* L126: */
	}
/* L127: */
    }
    goto L132;
L128:
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	jc = ipp2 - j;
	i__2 = *ido;
	for (i__ = 3; i__ <= i__2; i__ += 2) {
	    i__3 = *l1;
	    for (k = 1; k <= i__3; ++k) {
		ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k + 
			j * c1_dim2) * c1_dim1] - c1[i__ + (k + jc * c1_dim2) 
			* c1_dim1];
		ch[i__ - 1 + (k + jc * ch_dim2) * ch_dim1] = c1[i__ - 1 + (k 
			+ j * c1_dim2) * c1_dim1] + c1[i__ + (k + jc * 
			c1_dim2) * c1_dim1];
		ch[i__ + (k + j * ch_dim2) * ch_dim1] = c1[i__ + (k + j * 
			c1_dim2) * c1_dim1] + c1[i__ - 1 + (k + jc * c1_dim2) 
			* c1_dim1];
		ch[i__ + (k + jc * ch_dim2) * ch_dim1] = c1[i__ + (k + j * 
			c1_dim2) * c1_dim1] - c1[i__ - 1 + (k + jc * c1_dim2) 
			* c1_dim1];
/* L129: */
	    }
/* L130: */
	}
/* L131: */
    }
L132:
    if (*ido == 1) {
	return 0;
    }
    i__1 = *idl1;
    for (ik = 1; ik <= i__1; ++ik) {
	c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
/* L133: */
    }
    i__1 = *ip;
    for (j = 2; j <= i__1; ++j) {
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) * 
		    ch_dim1 + 1];
/* L134: */
	}
/* L135: */
    }
    if (nbd > *l1) {
	goto L139;
    }
    is = -(*ido);
    i__1 = *ip;
    for (j = 2; j <= i__1; ++j) {
	is += *ido;
	idij = is;
	i__2 = *ido;
	for (i__ = 3; i__ <= i__2; i__ += 2) {
	    idij += 2;
	    i__3 = *l1;
	    for (k = 1; k <= i__3; ++k) {
		c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
			i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * 
			ch[i__ + (k + j * ch_dim2) * ch_dim1];
		c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ 
			+ (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ - 
			1 + (k + j * ch_dim2) * ch_dim1];
/* L136: */
	    }
/* L137: */
	}
/* L138: */
    }
    goto L143;
L139:
    is = -(*ido);
    i__1 = *ip;
    for (j = 2; j <= i__1; ++j) {
	is += *ido;
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    idij = is;
	    i__3 = *ido;
	    for (i__ = 3; i__ <= i__3; i__ += 2) {
		idij += 2;
		c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[
			i__ - 1 + (k + j * ch_dim2) * ch_dim1] - wa[idij] * 
			ch[i__ + (k + j * ch_dim2) * ch_dim1];
		c1[i__ + (k + j * c1_dim2) * c1_dim1] = wa[idij - 1] * ch[i__ 
			+ (k + j * ch_dim2) * ch_dim1] + wa[idij] * ch[i__ - 
			1 + (k + j * ch_dim2) * ch_dim1];
/* L140: */
	    }
/* L141: */
	}
/* L142: */
    }
L143:
    return 0;
} /* radbg_ */







Added c/fftpack/radbg.f.






































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE RADBG (IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)
      DIMENSION       CH(IDO,L1,IP)          ,CC(IDO,IP,L1)          ,
     1                C1(IDO,L1,IP)          ,C2(IDL1,IP),
     2                CH2(IDL1,IP)           ,WA(1)
      DATA TPI/6.28318530717959/
      ARG = TPI/FLOAT(IP)
      DCP = COS(ARG)
      DSP = SIN(ARG)
      IDP2 = IDO+2
      NBD = (IDO-1)/2
      IPP2 = IP+2
      IPPH = (IP+1)/2
      IF (IDO .LT. L1) GO TO 103
      DO 102 K=1,L1
         DO 101 I=1,IDO
            CH(I,K,1) = CC(I,1,K)
  101    CONTINUE
  102 CONTINUE
      GO TO 106
  103 DO 105 I=1,IDO
         DO 104 K=1,L1
            CH(I,K,1) = CC(I,1,K)
  104    CONTINUE
  105 CONTINUE
  106 DO 108 J=2,IPPH
         JC = IPP2-J
         J2 = J+J
         DO 107 K=1,L1
            CH(1,K,J) = CC(IDO,J2-2,K)+CC(IDO,J2-2,K)
            CH(1,K,JC) = CC(1,J2-1,K)+CC(1,J2-1,K)
  107    CONTINUE
  108 CONTINUE
      IF (IDO .EQ. 1) GO TO 116
      IF (NBD .LT. L1) GO TO 112
      DO 111 J=2,IPPH
         JC = IPP2-J
         DO 110 K=1,L1
            DO 109 I=3,IDO,2
               IC = IDP2-I
               CH(I-1,K,J) = CC(I-1,2*J-1,K)+CC(IC-1,2*J-2,K)
               CH(I-1,K,JC) = CC(I-1,2*J-1,K)-CC(IC-1,2*J-2,K)
               CH(I,K,J) = CC(I,2*J-1,K)-CC(IC,2*J-2,K)
               CH(I,K,JC) = CC(I,2*J-1,K)+CC(IC,2*J-2,K)
  109       CONTINUE
  110    CONTINUE
  111 CONTINUE
      GO TO 116
  112 DO 115 J=2,IPPH
         JC = IPP2-J
         DO 114 I=3,IDO,2
            IC = IDP2-I
            DO 113 K=1,L1
               CH(I-1,K,J) = CC(I-1,2*J-1,K)+CC(IC-1,2*J-2,K)
               CH(I-1,K,JC) = CC(I-1,2*J-1,K)-CC(IC-1,2*J-2,K)
               CH(I,K,J) = CC(I,2*J-1,K)-CC(IC,2*J-2,K)
               CH(I,K,JC) = CC(I,2*J-1,K)+CC(IC,2*J-2,K)
  113       CONTINUE
  114    CONTINUE
  115 CONTINUE
  116 AR1 = 1.
      AI1 = 0.
      DO 120 L=2,IPPH
         LC = IPP2-L
         AR1H = DCP*AR1-DSP*AI1
         AI1 = DCP*AI1+DSP*AR1
         AR1 = AR1H
         DO 117 IK=1,IDL1
            C2(IK,L) = CH2(IK,1)+AR1*CH2(IK,2)
            C2(IK,LC) = AI1*CH2(IK,IP)
  117    CONTINUE
         DC2 = AR1
         DS2 = AI1
         AR2 = AR1
         AI2 = AI1
         DO 119 J=3,IPPH
            JC = IPP2-J
            AR2H = DC2*AR2-DS2*AI2
            AI2 = DC2*AI2+DS2*AR2
            AR2 = AR2H
            DO 118 IK=1,IDL1
               C2(IK,L) = C2(IK,L)+AR2*CH2(IK,J)
               C2(IK,LC) = C2(IK,LC)+AI2*CH2(IK,JC)
  118       CONTINUE
  119    CONTINUE
  120 CONTINUE
      DO 122 J=2,IPPH
         DO 121 IK=1,IDL1
            CH2(IK,1) = CH2(IK,1)+CH2(IK,J)
  121    CONTINUE
  122 CONTINUE
      DO 124 J=2,IPPH
         JC = IPP2-J
         DO 123 K=1,L1
            CH(1,K,J) = C1(1,K,J)-C1(1,K,JC)
            CH(1,K,JC) = C1(1,K,J)+C1(1,K,JC)
  123    CONTINUE
  124 CONTINUE
      IF (IDO .EQ. 1) GO TO 132
      IF (NBD .LT. L1) GO TO 128
      DO 127 J=2,IPPH
         JC = IPP2-J
         DO 126 K=1,L1
            DO 125 I=3,IDO,2
               CH(I-1,K,J) = C1(I-1,K,J)-C1(I,K,JC)
               CH(I-1,K,JC) = C1(I-1,K,J)+C1(I,K,JC)
               CH(I,K,J) = C1(I,K,J)+C1(I-1,K,JC)
               CH(I,K,JC) = C1(I,K,J)-C1(I-1,K,JC)
  125       CONTINUE
  126    CONTINUE
  127 CONTINUE
      GO TO 132
  128 DO 131 J=2,IPPH
         JC = IPP2-J
         DO 130 I=3,IDO,2
            DO 129 K=1,L1
               CH(I-1,K,J) = C1(I-1,K,J)-C1(I,K,JC)
               CH(I-1,K,JC) = C1(I-1,K,J)+C1(I,K,JC)
               CH(I,K,J) = C1(I,K,J)+C1(I-1,K,JC)
               CH(I,K,JC) = C1(I,K,J)-C1(I-1,K,JC)
  129       CONTINUE
  130    CONTINUE
  131 CONTINUE
  132 CONTINUE
      IF (IDO .EQ. 1) RETURN
      DO 133 IK=1,IDL1
         C2(IK,1) = CH2(IK,1)
  133 CONTINUE
      DO 135 J=2,IP
         DO 134 K=1,L1
            C1(1,K,J) = CH(1,K,J)
  134    CONTINUE
  135 CONTINUE
      IF (NBD .GT. L1) GO TO 139
      IS = -IDO
      DO 138 J=2,IP
         IS = IS+IDO
         IDIJ = IS
         DO 137 I=3,IDO,2
            IDIJ = IDIJ+2
            DO 136 K=1,L1
               C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)-WA(IDIJ)*CH(I,K,J)
               C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)+WA(IDIJ)*CH(I-1,K,J)
  136       CONTINUE
  137    CONTINUE
  138 CONTINUE
      GO TO 143
  139 IS = -IDO
      DO 142 J=2,IP
         IS = IS+IDO
         DO 141 K=1,L1
            IDIJ = IS
            DO 140 I=3,IDO,2
               IDIJ = IDIJ+2
               C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)-WA(IDIJ)*CH(I,K,J)
               C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)+WA(IDIJ)*CH(I-1,K,J)
  140       CONTINUE
  141    CONTINUE
  142 CONTINUE
  143 RETURN
      END






Added c/fftpack/radf2.c.

































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* radf2.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int radf2_(integer *ido, integer *l1, real *cc, real *ch, 
	real *wa1)
{
    /* System generated locals */
    integer ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2;

    /* Local variables */
    integer i__, k, ic;
    real ti2, tr2;
    integer idp2;

    /* Parameter adjustments */
    ch_dim1 = *ido;
    ch_offset = 1 + ch_dim1 * 3;
    ch -= ch_offset;
    cc_dim1 = *ido;
    cc_dim2 = *l1;
    cc_offset = 1 + cc_dim1 * (1 + cc_dim2);
    cc -= cc_offset;
    --wa1;

    /* Function Body */
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	ch[((k << 1) + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + 
		cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1];
	ch[*ido + ((k << 1) + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] 
		- cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1];
/* L101: */
    }
    if ((i__1 = *ido - 2) < 0) {
	goto L107;
    } else if (i__1 == 0) {
	goto L105;
    } else {
	goto L102;
    }
L102:
    idp2 = *ido + 2;
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	i__2 = *ido;
	for (i__ = 3; i__ <= i__2; i__ += 2) {
	    ic = idp2 - i__;
	    tr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1] 
		    + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
	    ti2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] - 
		    wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * 
		    cc_dim1];
	    ch[i__ + ((k << 1) + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) * 
		    cc_dim1] + ti2;
	    ch[ic + ((k << 1) + 2) * ch_dim1] = ti2 - cc[i__ + (k + cc_dim2) *
		     cc_dim1];
	    ch[i__ - 1 + ((k << 1) + 1) * ch_dim1] = cc[i__ - 1 + (k + 
		    cc_dim2) * cc_dim1] + tr2;
	    ch[ic - 1 + ((k << 1) + 2) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2)
		     * cc_dim1] - tr2;
/* L103: */
	}
/* L104: */
    }
    if (*ido % 2 == 1) {
	return 0;
    }
L105:
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	ch[((k << 1) + 2) * ch_dim1 + 1] = -cc[*ido + (k + (cc_dim2 << 1)) * 
		cc_dim1];
	ch[*ido + ((k << 1) + 1) * ch_dim1] = cc[*ido + (k + cc_dim2) * 
		cc_dim1];
/* L106: */
    }
L107:
    return 0;
} /* radf2_ */







Added c/fftpack/radf2.f.

































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE RADF2 (IDO,L1,CC,CH,WA1)
      DIMENSION       CH(IDO,2,L1)           ,CC(IDO,L1,2)           ,
     1                WA1(1)
      DO 101 K=1,L1
         CH(1,1,K) = CC(1,K,1)+CC(1,K,2)
         CH(IDO,2,K) = CC(1,K,1)-CC(1,K,2)
  101 CONTINUE
      IF (IDO-2) 107,105,102
  102 IDP2 = IDO+2
      DO 104 K=1,L1
         DO 103 I=3,IDO,2
            IC = IDP2-I
            TR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
            TI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
            CH(I,1,K) = CC(I,K,1)+TI2
            CH(IC,2,K) = TI2-CC(I,K,1)
            CH(I-1,1,K) = CC(I-1,K,1)+TR2
            CH(IC-1,2,K) = CC(I-1,K,1)-TR2
  103    CONTINUE
  104 CONTINUE
      IF (MOD(IDO,2) .EQ. 1) RETURN
  105 DO 106 K=1,L1
         CH(1,2,K) = -CC(IDO,K,2)
         CH(IDO,1,K) = CC(IDO,K,1)
  106 CONTINUE
  107 RETURN
      END






Added c/fftpack/radf3.c.


































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* radf3.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int radf3_(integer *ido, integer *l1, real *cc, real *ch, 
	real *wa1, real *wa2)
{
    /* Initialized data */

    static real taur = -.5f;
    static real taui = .866025403784439f;

    /* System generated locals */
    integer ch_dim1, ch_offset, cc_dim1, cc_dim2, cc_offset, i__1, i__2;

    /* Local variables */
    integer i__, k, ic;
    real ci2, di2, di3, cr2, dr2, dr3, ti2, ti3, tr2, tr3;
    integer idp2;

    /* Parameter adjustments */
    ch_dim1 = *ido;
    ch_offset = 1 + (ch_dim1 << 2);
    ch -= ch_offset;
    cc_dim1 = *ido;
    cc_dim2 = *l1;
    cc_offset = 1 + cc_dim1 * (1 + cc_dim2);
    cc -= cc_offset;
    --wa1;
    --wa2;

    /* Function Body */
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	cr2 = cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) * 
		cc_dim1 + 1];
	ch[(k * 3 + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cr2;
	ch[(k * 3 + 3) * ch_dim1 + 1] = taui * (cc[(k + cc_dim2 * 3) * 
		cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1]);
	ch[*ido + (k * 3 + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] + 
		taur * cr2;
/* L101: */
    }
    if (*ido == 1) {
	return 0;
    }
    idp2 = *ido + 2;
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	i__2 = *ido;
	for (i__ = 3; i__ <= i__2; i__ += 2) {
	    ic = idp2 - i__;
	    dr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1] 
		    + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
	    di2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] - 
		    wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * 
		    cc_dim1];
	    dr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] + 
		    wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1];
	    di3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[
		    i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1];
	    cr2 = dr2 + dr3;
	    ci2 = di2 + di3;
	    ch[i__ - 1 + (k * 3 + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) *
		     cc_dim1] + cr2;
	    ch[i__ + (k * 3 + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) * 
		    cc_dim1] + ci2;
	    tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + taur * cr2;
	    ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + taur * ci2;
	    tr3 = taui * (di2 - di3);
	    ti3 = taui * (dr3 - dr2);
	    ch[i__ - 1 + (k * 3 + 3) * ch_dim1] = tr2 + tr3;
	    ch[ic - 1 + (k * 3 + 2) * ch_dim1] = tr2 - tr3;
	    ch[i__ + (k * 3 + 3) * ch_dim1] = ti2 + ti3;
	    ch[ic + (k * 3 + 2) * ch_dim1] = ti3 - ti2;
/* L102: */
	}
/* L103: */
    }
    return 0;
} /* radf3_ */







Added c/fftpack/radf3.f.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE RADF3 (IDO,L1,CC,CH,WA1,WA2)
      DIMENSION       CH(IDO,3,L1)           ,CC(IDO,L1,3)           ,
     1                WA1(1)     ,WA2(1)
      DATA TAUR,TAUI /-.5,.866025403784439/
      DO 101 K=1,L1
         CR2 = CC(1,K,2)+CC(1,K,3)
         CH(1,1,K) = CC(1,K,1)+CR2
         CH(1,3,K) = TAUI*(CC(1,K,3)-CC(1,K,2))
         CH(IDO,2,K) = CC(1,K,1)+TAUR*CR2
  101 CONTINUE
      IF (IDO .EQ. 1) RETURN
      IDP2 = IDO+2
      DO 103 K=1,L1
         DO 102 I=3,IDO,2
            IC = IDP2-I
            DR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
            DI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
            DR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
            DI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
            CR2 = DR2+DR3
            CI2 = DI2+DI3
            CH(I-1,1,K) = CC(I-1,K,1)+CR2
            CH(I,1,K) = CC(I,K,1)+CI2
            TR2 = CC(I-1,K,1)+TAUR*CR2
            TI2 = CC(I,K,1)+TAUR*CI2
            TR3 = TAUI*(DI2-DI3)
            TI3 = TAUI*(DR3-DR2)
            CH(I-1,3,K) = TR2+TR3
            CH(IC-1,2,K) = TR2-TR3
            CH(I,3,K) = TI2+TI3
            CH(IC,2,K) = TI3-TI2
  102    CONTINUE
  103 CONTINUE
      RETURN
      END






Added c/fftpack/radf4.c.






































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* radf4.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int radf4_(integer *ido, integer *l1, real *cc, real *ch, 
	real *wa1, real *wa2, real *wa3)
{
    /* Initialized data */

    static real hsqt2 = .7071067811865475f;

    /* System generated locals */
    integer cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2;

    /* Local variables */
    integer i__, k, ic;
    real ci2, ci3, ci4, cr2, cr3, cr4, ti1, ti2, ti3, ti4, tr1, tr2, tr3, tr4;
    integer idp2;

    /* Parameter adjustments */
    ch_dim1 = *ido;
    ch_offset = 1 + ch_dim1 * 5;
    ch -= ch_offset;
    cc_dim1 = *ido;
    cc_dim2 = *l1;
    cc_offset = 1 + cc_dim1 * (1 + cc_dim2);
    cc -= cc_offset;
    --wa1;
    --wa2;
    --wa3;

    /* Function Body */
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	tr1 = cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 2))
		 * cc_dim1 + 1];
	tr2 = cc[(k + cc_dim2) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) * 
		cc_dim1 + 1];
	ch[((k << 2) + 1) * ch_dim1 + 1] = tr1 + tr2;
	ch[*ido + ((k << 2) + 4) * ch_dim1] = tr2 - tr1;
	ch[*ido + ((k << 2) + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] 
		- cc[(k + cc_dim2 * 3) * cc_dim1 + 1];
	ch[((k << 2) + 3) * ch_dim1 + 1] = cc[(k + (cc_dim2 << 2)) * cc_dim1 
		+ 1] - cc[(k + (cc_dim2 << 1)) * cc_dim1 + 1];
/* L101: */
    }
    if ((i__1 = *ido - 2) < 0) {
	goto L107;
    } else if (i__1 == 0) {
	goto L105;
    } else {
	goto L102;
    }
L102:
    idp2 = *ido + 2;
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	i__2 = *ido;
	for (i__ = 3; i__ <= i__2; i__ += 2) {
	    ic = idp2 - i__;
	    cr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1] 
		    + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
	    ci2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] - 
		    wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * 
		    cc_dim1];
	    cr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] + 
		    wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1];
	    ci3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[
		    i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1];
	    cr4 = wa3[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1] 
		    + wa3[i__ - 1] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1];
	    ci4 = wa3[i__ - 2] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1] - 
		    wa3[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * 
		    cc_dim1];
	    tr1 = cr2 + cr4;
	    tr4 = cr4 - cr2;
	    ti1 = ci2 + ci4;
	    ti4 = ci2 - ci4;
	    ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + ci3;
	    ti3 = cc[i__ + (k + cc_dim2) * cc_dim1] - ci3;
	    tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + cr3;
	    tr3 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] - cr3;
	    ch[i__ - 1 + ((k << 2) + 1) * ch_dim1] = tr1 + tr2;
	    ch[ic - 1 + ((k << 2) + 4) * ch_dim1] = tr2 - tr1;
	    ch[i__ + ((k << 2) + 1) * ch_dim1] = ti1 + ti2;
	    ch[ic + ((k << 2) + 4) * ch_dim1] = ti1 - ti2;
	    ch[i__ - 1 + ((k << 2) + 3) * ch_dim1] = ti4 + tr3;
	    ch[ic - 1 + ((k << 2) + 2) * ch_dim1] = tr3 - ti4;
	    ch[i__ + ((k << 2) + 3) * ch_dim1] = tr4 + ti3;
	    ch[ic + ((k << 2) + 2) * ch_dim1] = tr4 - ti3;
/* L103: */
	}
/* L104: */
    }
    if (*ido % 2 == 1) {
	return 0;
    }
L105:
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	ti1 = -hsqt2 * (cc[*ido + (k + (cc_dim2 << 1)) * cc_dim1] + cc[*ido + 
		(k + (cc_dim2 << 2)) * cc_dim1]);
	tr1 = hsqt2 * (cc[*ido + (k + (cc_dim2 << 1)) * cc_dim1] - cc[*ido + (
		k + (cc_dim2 << 2)) * cc_dim1]);
	ch[*ido + ((k << 2) + 1) * ch_dim1] = tr1 + cc[*ido + (k + cc_dim2) * 
		cc_dim1];
	ch[*ido + ((k << 2) + 3) * ch_dim1] = cc[*ido + (k + cc_dim2) * 
		cc_dim1] - tr1;
	ch[((k << 2) + 2) * ch_dim1 + 1] = ti1 - cc[*ido + (k + cc_dim2 * 3) *
		 cc_dim1];
	ch[((k << 2) + 4) * ch_dim1 + 1] = ti1 + cc[*ido + (k + cc_dim2 * 3) *
		 cc_dim1];
/* L106: */
    }
L107:
    return 0;
} /* radf4_ */







Added c/fftpack/radf4.f.



























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE RADF4 (IDO,L1,CC,CH,WA1,WA2,WA3)
      DIMENSION       CC(IDO,L1,4)           ,CH(IDO,4,L1)           ,
     1                WA1(1)     ,WA2(1)     ,WA3(1)
      DATA HSQT2 /.7071067811865475/
      DO 101 K=1,L1
         TR1 = CC(1,K,2)+CC(1,K,4)
         TR2 = CC(1,K,1)+CC(1,K,3)
         CH(1,1,K) = TR1+TR2
         CH(IDO,4,K) = TR2-TR1
         CH(IDO,2,K) = CC(1,K,1)-CC(1,K,3)
         CH(1,3,K) = CC(1,K,4)-CC(1,K,2)
  101 CONTINUE
      IF (IDO-2) 107,105,102
  102 IDP2 = IDO+2
      DO 104 K=1,L1
         DO 103 I=3,IDO,2
            IC = IDP2-I
            CR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
            CI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
            CR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
            CI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
            CR4 = WA3(I-2)*CC(I-1,K,4)+WA3(I-1)*CC(I,K,4)
            CI4 = WA3(I-2)*CC(I,K,4)-WA3(I-1)*CC(I-1,K,4)
            TR1 = CR2+CR4
            TR4 = CR4-CR2
            TI1 = CI2+CI4
            TI4 = CI2-CI4
            TI2 = CC(I,K,1)+CI3
            TI3 = CC(I,K,1)-CI3
            TR2 = CC(I-1,K,1)+CR3
            TR3 = CC(I-1,K,1)-CR3
            CH(I-1,1,K) = TR1+TR2
            CH(IC-1,4,K) = TR2-TR1
            CH(I,1,K) = TI1+TI2
            CH(IC,4,K) = TI1-TI2
            CH(I-1,3,K) = TI4+TR3
            CH(IC-1,2,K) = TR3-TI4
            CH(I,3,K) = TR4+TI3
            CH(IC,2,K) = TR4-TI3
  103    CONTINUE
  104 CONTINUE
      IF (MOD(IDO,2) .EQ. 1) RETURN
  105 CONTINUE
      DO 106 K=1,L1
         TI1 = -HSQT2*(CC(IDO,K,2)+CC(IDO,K,4))
         TR1 = HSQT2*(CC(IDO,K,2)-CC(IDO,K,4))
         CH(IDO,1,K) = TR1+CC(IDO,K,1)
         CH(IDO,3,K) = CC(IDO,K,1)-TR1
         CH(1,2,K) = TI1-CC(IDO,K,3)
         CH(1,4,K) = TI1+CC(IDO,K,3)
  106 CONTINUE
  107 RETURN
      END






Added c/fftpack/radf5.c.









































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* radf5.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int radf5_(integer *ido, integer *l1, real *cc, real *ch, 
	real *wa1, real *wa2, real *wa3, real *wa4)
{
    /* Initialized data */

    static real tr11 = .309016994374947f;
    static real ti11 = .951056516295154f;
    static real tr12 = -.809016994374947f;
    static real ti12 = .587785252292473f;

    /* System generated locals */
    integer cc_dim1, cc_dim2, cc_offset, ch_dim1, ch_offset, i__1, i__2;

    /* Local variables */
    integer i__, k, ic;
    real ci2, di2, ci4, ci5, di3, di4, di5, ci3, cr2, cr3, dr2, dr3, dr4, dr5,
	     cr5, cr4, ti2, ti3, ti5, ti4, tr2, tr3, tr4, tr5;
    integer idp2;

    /* Parameter adjustments */
    ch_dim1 = *ido;
    ch_offset = 1 + ch_dim1 * 6;
    ch -= ch_offset;
    cc_dim1 = *ido;
    cc_dim2 = *l1;
    cc_offset = 1 + cc_dim1 * (1 + cc_dim2);
    cc -= cc_offset;
    --wa1;
    --wa2;
    --wa3;
    --wa4;

    /* Function Body */
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	cr2 = cc[(k + cc_dim2 * 5) * cc_dim1 + 1] + cc[(k + (cc_dim2 << 1)) * 
		cc_dim1 + 1];
	ci5 = cc[(k + cc_dim2 * 5) * cc_dim1 + 1] - cc[(k + (cc_dim2 << 1)) * 
		cc_dim1 + 1];
	cr3 = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] + cc[(k + cc_dim2 * 3) * 
		cc_dim1 + 1];
	ci4 = cc[(k + (cc_dim2 << 2)) * cc_dim1 + 1] - cc[(k + cc_dim2 * 3) * 
		cc_dim1 + 1];
	ch[(k * 5 + 1) * ch_dim1 + 1] = cc[(k + cc_dim2) * cc_dim1 + 1] + cr2 
		+ cr3;
	ch[*ido + (k * 5 + 2) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] + 
		tr11 * cr2 + tr12 * cr3;
	ch[(k * 5 + 3) * ch_dim1 + 1] = ti11 * ci5 + ti12 * ci4;
	ch[*ido + (k * 5 + 4) * ch_dim1] = cc[(k + cc_dim2) * cc_dim1 + 1] + 
		tr12 * cr2 + tr11 * cr3;
	ch[(k * 5 + 5) * ch_dim1 + 1] = ti12 * ci5 - ti11 * ci4;
/* L101: */
    }
    if (*ido == 1) {
	return 0;
    }
    idp2 = *ido + 2;
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	i__2 = *ido;
	for (i__ = 3; i__ <= i__2; i__ += 2) {
	    ic = idp2 - i__;
	    dr2 = wa1[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * cc_dim1] 
		    + wa1[i__ - 1] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1];
	    di2 = wa1[i__ - 2] * cc[i__ + (k + (cc_dim2 << 1)) * cc_dim1] - 
		    wa1[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 1)) * 
		    cc_dim1];
	    dr3 = wa2[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1] + 
		    wa2[i__ - 1] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1];
	    di3 = wa2[i__ - 2] * cc[i__ + (k + cc_dim2 * 3) * cc_dim1] - wa2[
		    i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 3) * cc_dim1];
	    dr4 = wa3[i__ - 2] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * cc_dim1] 
		    + wa3[i__ - 1] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1];
	    di4 = wa3[i__ - 2] * cc[i__ + (k + (cc_dim2 << 2)) * cc_dim1] - 
		    wa3[i__ - 1] * cc[i__ - 1 + (k + (cc_dim2 << 2)) * 
		    cc_dim1];
	    dr5 = wa4[i__ - 2] * cc[i__ - 1 + (k + cc_dim2 * 5) * cc_dim1] + 
		    wa4[i__ - 1] * cc[i__ + (k + cc_dim2 * 5) * cc_dim1];
	    di5 = wa4[i__ - 2] * cc[i__ + (k + cc_dim2 * 5) * cc_dim1] - wa4[
		    i__ - 1] * cc[i__ - 1 + (k + cc_dim2 * 5) * cc_dim1];
	    cr2 = dr2 + dr5;
	    ci5 = dr5 - dr2;
	    cr5 = di2 - di5;
	    ci2 = di2 + di5;
	    cr3 = dr3 + dr4;
	    ci4 = dr4 - dr3;
	    cr4 = di3 - di4;
	    ci3 = di3 + di4;
	    ch[i__ - 1 + (k * 5 + 1) * ch_dim1] = cc[i__ - 1 + (k + cc_dim2) *
		     cc_dim1] + cr2 + cr3;
	    ch[i__ + (k * 5 + 1) * ch_dim1] = cc[i__ + (k + cc_dim2) * 
		    cc_dim1] + ci2 + ci3;
	    tr2 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr11 * cr2 + tr12 * 
		    cr3;
	    ti2 = cc[i__ + (k + cc_dim2) * cc_dim1] + tr11 * ci2 + tr12 * ci3;
	    tr3 = cc[i__ - 1 + (k + cc_dim2) * cc_dim1] + tr12 * cr2 + tr11 * 
		    cr3;
	    ti3 = cc[i__ + (k + cc_dim2) * cc_dim1] + tr12 * ci2 + tr11 * ci3;
	    tr5 = ti11 * cr5 + ti12 * cr4;
	    ti5 = ti11 * ci5 + ti12 * ci4;
	    tr4 = ti12 * cr5 - ti11 * cr4;
	    ti4 = ti12 * ci5 - ti11 * ci4;
	    ch[i__ - 1 + (k * 5 + 3) * ch_dim1] = tr2 + tr5;
	    ch[ic - 1 + (k * 5 + 2) * ch_dim1] = tr2 - tr5;
	    ch[i__ + (k * 5 + 3) * ch_dim1] = ti2 + ti5;
	    ch[ic + (k * 5 + 2) * ch_dim1] = ti5 - ti2;
	    ch[i__ - 1 + (k * 5 + 5) * ch_dim1] = tr3 + tr4;
	    ch[ic - 1 + (k * 5 + 4) * ch_dim1] = tr3 - tr4;
	    ch[i__ + (k * 5 + 5) * ch_dim1] = ti3 + ti4;
	    ch[ic + (k * 5 + 4) * ch_dim1] = ti4 - ti3;
/* L102: */
	}
/* L103: */
    }
    return 0;
} /* radf5_ */







Added c/fftpack/radf5.f.

































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE RADF5 (IDO,L1,CC,CH,WA1,WA2,WA3,WA4)
      DIMENSION       CC(IDO,L1,5)           ,CH(IDO,5,L1)           ,
     1                WA1(1)     ,WA2(1)     ,WA3(1)     ,WA4(1)
      DATA TR11,TI11,TR12,TI12 /.309016994374947,.951056516295154,
     1-.809016994374947,.587785252292473/
      DO 101 K=1,L1
         CR2 = CC(1,K,5)+CC(1,K,2)
         CI5 = CC(1,K,5)-CC(1,K,2)
         CR3 = CC(1,K,4)+CC(1,K,3)
         CI4 = CC(1,K,4)-CC(1,K,3)
         CH(1,1,K) = CC(1,K,1)+CR2+CR3
         CH(IDO,2,K) = CC(1,K,1)+TR11*CR2+TR12*CR3
         CH(1,3,K) = TI11*CI5+TI12*CI4
         CH(IDO,4,K) = CC(1,K,1)+TR12*CR2+TR11*CR3
         CH(1,5,K) = TI12*CI5-TI11*CI4
  101 CONTINUE
      IF (IDO .EQ. 1) RETURN
      IDP2 = IDO+2
      DO 103 K=1,L1
         DO 102 I=3,IDO,2
            IC = IDP2-I
            DR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
            DI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
            DR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
            DI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
            DR4 = WA3(I-2)*CC(I-1,K,4)+WA3(I-1)*CC(I,K,4)
            DI4 = WA3(I-2)*CC(I,K,4)-WA3(I-1)*CC(I-1,K,4)
            DR5 = WA4(I-2)*CC(I-1,K,5)+WA4(I-1)*CC(I,K,5)
            DI5 = WA4(I-2)*CC(I,K,5)-WA4(I-1)*CC(I-1,K,5)
            CR2 = DR2+DR5
            CI5 = DR5-DR2
            CR5 = DI2-DI5
            CI2 = DI2+DI5
            CR3 = DR3+DR4
            CI4 = DR4-DR3
            CR4 = DI3-DI4
            CI3 = DI3+DI4
            CH(I-1,1,K) = CC(I-1,K,1)+CR2+CR3
            CH(I,1,K) = CC(I,K,1)+CI2+CI3
            TR2 = CC(I-1,K,1)+TR11*CR2+TR12*CR3
            TI2 = CC(I,K,1)+TR11*CI2+TR12*CI3
            TR3 = CC(I-1,K,1)+TR12*CR2+TR11*CR3
            TI3 = CC(I,K,1)+TR12*CI2+TR11*CI3
            TR5 = TI11*CR5+TI12*CR4
            TI5 = TI11*CI5+TI12*CI4
            TR4 = TI12*CR5-TI11*CR4
            TI4 = TI12*CI5-TI11*CI4
            CH(I-1,3,K) = TR2+TR5
            CH(IC-1,2,K) = TR2-TR5
            CH(I,3,K) = TI2+TI5
            CH(IC,2,K) = TI5-TI2
            CH(I-1,5,K) = TR3+TR4
            CH(IC-1,4,K) = TR3-TR4
            CH(I,5,K) = TI3+TI4
            CH(IC,4,K) = TI4-TI3
  102    CONTINUE
  103 CONTINUE
      RETURN
      END






Added c/fftpack/radfg.c.














































































































































































































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* radfg.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int radfg_(integer *ido, integer *ip, integer *l1, integer *
	idl1, real *cc, real *c1, real *c2, real *ch, real *ch2, real *wa)
{
    /* Initialized data */

    static real tpi = 6.28318530717959f;

    /* System generated locals */
    integer ch_dim1, ch_dim2, ch_offset, cc_dim1, cc_dim2, cc_offset, c1_dim1,
	     c1_dim2, c1_offset, c2_dim1, c2_offset, ch2_dim1, ch2_offset, 
	    i__1, i__2, i__3;

    /* Builtin functions */
    double cos(doublereal), sin(doublereal);

    /* Local variables */
    integer i__, j, k, l, j2, ic, jc, lc, ik, is;
    real dc2, ai1, ai2, ar1, ar2, ds2;
    integer nbd;
    real dcp, arg, dsp, ar1h, ar2h;
    integer idp2, ipp2, idij, ipph;

    /* Parameter adjustments */
    ch_dim1 = *ido;
    ch_dim2 = *l1;
    ch_offset = 1 + ch_dim1 * (1 + ch_dim2);
    ch -= ch_offset;
    c1_dim1 = *ido;
    c1_dim2 = *l1;
    c1_offset = 1 + c1_dim1 * (1 + c1_dim2);
    c1 -= c1_offset;
    cc_dim1 = *ido;
    cc_dim2 = *ip;
    cc_offset = 1 + cc_dim1 * (1 + cc_dim2);
    cc -= cc_offset;
    ch2_dim1 = *idl1;
    ch2_offset = 1 + ch2_dim1;
    ch2 -= ch2_offset;
    c2_dim1 = *idl1;
    c2_offset = 1 + c2_dim1;
    c2 -= c2_offset;
    --wa;

    /* Function Body */
    arg = tpi / (real) (*ip);
    dcp = cos(arg);
    dsp = sin(arg);
    ipph = (*ip + 1) / 2;
    ipp2 = *ip + 2;
    idp2 = *ido + 2;
    nbd = (*ido - 1) / 2;
    if (*ido == 1) {
	goto L119;
    }
    i__1 = *idl1;
    for (ik = 1; ik <= i__1; ++ik) {
	ch2[ik + ch2_dim1] = c2[ik + c2_dim1];
/* L101: */
    }
    i__1 = *ip;
    for (j = 2; j <= i__1; ++j) {
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    ch[(k + j * ch_dim2) * ch_dim1 + 1] = c1[(k + j * c1_dim2) * 
		    c1_dim1 + 1];
/* L102: */
	}
/* L103: */
    }
    if (nbd > *l1) {
	goto L107;
    }
    is = -(*ido);
    i__1 = *ip;
    for (j = 2; j <= i__1; ++j) {
	is += *ido;
	idij = is;
	i__2 = *ido;
	for (i__ = 3; i__ <= i__2; i__ += 2) {
	    idij += 2;
	    i__3 = *l1;
	    for (k = 1; k <= i__3; ++k) {
		ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[
			i__ - 1 + (k + j * c1_dim2) * c1_dim1] + wa[idij] * 
			c1[i__ + (k + j * c1_dim2) * c1_dim1];
		ch[i__ + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[i__ 
			+ (k + j * c1_dim2) * c1_dim1] - wa[idij] * c1[i__ - 
			1 + (k + j * c1_dim2) * c1_dim1];
/* L104: */
	    }
/* L105: */
	}
/* L106: */
    }
    goto L111;
L107:
    is = -(*ido);
    i__1 = *ip;
    for (j = 2; j <= i__1; ++j) {
	is += *ido;
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    idij = is;
	    i__3 = *ido;
	    for (i__ = 3; i__ <= i__3; i__ += 2) {
		idij += 2;
		ch[i__ - 1 + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[
			i__ - 1 + (k + j * c1_dim2) * c1_dim1] + wa[idij] * 
			c1[i__ + (k + j * c1_dim2) * c1_dim1];
		ch[i__ + (k + j * ch_dim2) * ch_dim1] = wa[idij - 1] * c1[i__ 
			+ (k + j * c1_dim2) * c1_dim1] - wa[idij] * c1[i__ - 
			1 + (k + j * c1_dim2) * c1_dim1];
/* L108: */
	    }
/* L109: */
	}
/* L110: */
    }
L111:
    if (nbd < *l1) {
	goto L115;
    }
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	jc = ipp2 - j;
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    i__3 = *ido;
	    for (i__ = 3; i__ <= i__3; i__ += 2) {
		c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + 
			j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc * 
			ch_dim2) * ch_dim1];
		c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
			 ch_dim2) * ch_dim1] - ch[i__ + (k + jc * ch_dim2) * 
			ch_dim1];
		c1[i__ + (k + j * c1_dim2) * c1_dim1] = ch[i__ + (k + j * 
			ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) * 
			ch_dim1];
		c1[i__ + (k + jc * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + jc 
			* ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + j * ch_dim2)
			 * ch_dim1];
/* L112: */
	    }
/* L113: */
	}
/* L114: */
    }
    goto L121;
L115:
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	jc = ipp2 - j;
	i__2 = *ido;
	for (i__ = 3; i__ <= i__2; i__ += 2) {
	    i__3 = *l1;
	    for (k = 1; k <= i__3; ++k) {
		c1[i__ - 1 + (k + j * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + 
			j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc * 
			ch_dim2) * ch_dim1];
		c1[i__ - 1 + (k + jc * c1_dim2) * c1_dim1] = ch[i__ + (k + j *
			 ch_dim2) * ch_dim1] - ch[i__ + (k + jc * ch_dim2) * 
			ch_dim1];
		c1[i__ + (k + j * c1_dim2) * c1_dim1] = ch[i__ + (k + j * 
			ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) * 
			ch_dim1];
		c1[i__ + (k + jc * c1_dim2) * c1_dim1] = ch[i__ - 1 + (k + jc 
			* ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + j * ch_dim2)
			 * ch_dim1];
/* L116: */
	    }
/* L117: */
	}
/* L118: */
    }
    goto L121;
L119:
    i__1 = *idl1;
    for (ik = 1; ik <= i__1; ++ik) {
	c2[ik + c2_dim1] = ch2[ik + ch2_dim1];
/* L120: */
    }
L121:
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	jc = ipp2 - j;
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    c1[(k + j * c1_dim2) * c1_dim1 + 1] = ch[(k + j * ch_dim2) * 
		    ch_dim1 + 1] + ch[(k + jc * ch_dim2) * ch_dim1 + 1];
	    c1[(k + jc * c1_dim2) * c1_dim1 + 1] = ch[(k + jc * ch_dim2) * 
		    ch_dim1 + 1] - ch[(k + j * ch_dim2) * ch_dim1 + 1];
/* L122: */
	}
/* L123: */
    }

    ar1 = 1.f;
    ai1 = 0.f;
    i__1 = ipph;
    for (l = 2; l <= i__1; ++l) {
	lc = ipp2 - l;
	ar1h = dcp * ar1 - dsp * ai1;
	ai1 = dcp * ai1 + dsp * ar1;
	ar1 = ar1h;
	i__2 = *idl1;
	for (ik = 1; ik <= i__2; ++ik) {
	    ch2[ik + l * ch2_dim1] = c2[ik + c2_dim1] + ar1 * c2[ik + (
		    c2_dim1 << 1)];
	    ch2[ik + lc * ch2_dim1] = ai1 * c2[ik + *ip * c2_dim1];
/* L124: */
	}
	dc2 = ar1;
	ds2 = ai1;
	ar2 = ar1;
	ai2 = ai1;
	i__2 = ipph;
	for (j = 3; j <= i__2; ++j) {
	    jc = ipp2 - j;
	    ar2h = dc2 * ar2 - ds2 * ai2;
	    ai2 = dc2 * ai2 + ds2 * ar2;
	    ar2 = ar2h;
	    i__3 = *idl1;
	    for (ik = 1; ik <= i__3; ++ik) {
		ch2[ik + l * ch2_dim1] += ar2 * c2[ik + j * c2_dim1];
		ch2[ik + lc * ch2_dim1] += ai2 * c2[ik + jc * c2_dim1];
/* L125: */
	    }
/* L126: */
	}
/* L127: */
    }
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	i__2 = *idl1;
	for (ik = 1; ik <= i__2; ++ik) {
	    ch2[ik + ch2_dim1] += c2[ik + j * c2_dim1];
/* L128: */
	}
/* L129: */
    }

    if (*ido < *l1) {
	goto L132;
    }
    i__1 = *l1;
    for (k = 1; k <= i__1; ++k) {
	i__2 = *ido;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    cc[i__ + (k * cc_dim2 + 1) * cc_dim1] = ch[i__ + (k + ch_dim2) * 
		    ch_dim1];
/* L130: */
	}
/* L131: */
    }
    goto L135;
L132:
    i__1 = *ido;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    cc[i__ + (k * cc_dim2 + 1) * cc_dim1] = ch[i__ + (k + ch_dim2) * 
		    ch_dim1];
/* L133: */
	}
/* L134: */
    }
L135:
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	jc = ipp2 - j;
	j2 = j + j;
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    cc[*ido + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[(k + j * ch_dim2)
		     * ch_dim1 + 1];
	    cc[(j2 - 1 + k * cc_dim2) * cc_dim1 + 1] = ch[(k + jc * ch_dim2) *
		     ch_dim1 + 1];
/* L136: */
	}
/* L137: */
    }
    if (*ido == 1) {
	return 0;
    }
    if (nbd < *l1) {
	goto L141;
    }
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	jc = ipp2 - j;
	j2 = j + j;
	i__2 = *l1;
	for (k = 1; k <= i__2; ++k) {
	    i__3 = *ido;
	    for (i__ = 3; i__ <= i__3; i__ += 2) {
		ic = idp2 - i__;
		cc[i__ - 1 + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + 
			(k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc * 
			ch_dim2) * ch_dim1];
		cc[ic - 1 + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + (
			k + j * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + jc * 
			ch_dim2) * ch_dim1];
		cc[i__ + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + j *
			 ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) * 
			ch_dim1];
		cc[ic + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + jc *
			 ch_dim2) * ch_dim1] - ch[i__ + (k + j * ch_dim2) * 
			ch_dim1];
/* L138: */
	    }
/* L139: */
	}
/* L140: */
    }
    return 0;
L141:
    i__1 = ipph;
    for (j = 2; j <= i__1; ++j) {
	jc = ipp2 - j;
	j2 = j + j;
	i__2 = *ido;
	for (i__ = 3; i__ <= i__2; i__ += 2) {
	    ic = idp2 - i__;
	    i__3 = *l1;
	    for (k = 1; k <= i__3; ++k) {
		cc[i__ - 1 + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + 
			(k + j * ch_dim2) * ch_dim1] + ch[i__ - 1 + (k + jc * 
			ch_dim2) * ch_dim1];
		cc[ic - 1 + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ - 1 + (
			k + j * ch_dim2) * ch_dim1] - ch[i__ - 1 + (k + jc * 
			ch_dim2) * ch_dim1];
		cc[i__ + (j2 - 1 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + j *
			 ch_dim2) * ch_dim1] + ch[i__ + (k + jc * ch_dim2) * 
			ch_dim1];
		cc[ic + (j2 - 2 + k * cc_dim2) * cc_dim1] = ch[i__ + (k + jc *
			 ch_dim2) * ch_dim1] - ch[i__ + (k + j * ch_dim2) * 
			ch_dim1];
/* L142: */
	    }
/* L143: */
	}
/* L144: */
    }
    return 0;
} /* radfg_ */







Added c/fftpack/radfg.f.












































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE RADFG (IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)
      DIMENSION       CH(IDO,L1,IP)          ,CC(IDO,IP,L1)          ,
     1                C1(IDO,L1,IP)          ,C2(IDL1,IP),
     2                CH2(IDL1,IP)           ,WA(1)
      DATA TPI/6.28318530717959/
      ARG = TPI/FLOAT(IP)
      DCP = COS(ARG)
      DSP = SIN(ARG)
      IPPH = (IP+1)/2
      IPP2 = IP+2
      IDP2 = IDO+2
      NBD = (IDO-1)/2
      IF (IDO .EQ. 1) GO TO 119
      DO 101 IK=1,IDL1
         CH2(IK,1) = C2(IK,1)
  101 CONTINUE
      DO 103 J=2,IP
         DO 102 K=1,L1
            CH(1,K,J) = C1(1,K,J)
  102    CONTINUE
  103 CONTINUE
      IF (NBD .GT. L1) GO TO 107
      IS = -IDO
      DO 106 J=2,IP
         IS = IS+IDO
         IDIJ = IS
         DO 105 I=3,IDO,2
            IDIJ = IDIJ+2
            DO 104 K=1,L1
               CH(I-1,K,J) = WA(IDIJ-1)*C1(I-1,K,J)+WA(IDIJ)*C1(I,K,J)
               CH(I,K,J) = WA(IDIJ-1)*C1(I,K,J)-WA(IDIJ)*C1(I-1,K,J)
  104       CONTINUE
  105    CONTINUE
  106 CONTINUE
      GO TO 111
  107 IS = -IDO
      DO 110 J=2,IP
         IS = IS+IDO
         DO 109 K=1,L1
            IDIJ = IS
            DO 108 I=3,IDO,2
               IDIJ = IDIJ+2
               CH(I-1,K,J) = WA(IDIJ-1)*C1(I-1,K,J)+WA(IDIJ)*C1(I,K,J)
               CH(I,K,J) = WA(IDIJ-1)*C1(I,K,J)-WA(IDIJ)*C1(I-1,K,J)
  108       CONTINUE
  109    CONTINUE
  110 CONTINUE
  111 IF (NBD .LT. L1) GO TO 115
      DO 114 J=2,IPPH
         JC = IPP2-J
         DO 113 K=1,L1
            DO 112 I=3,IDO,2
               C1(I-1,K,J) = CH(I-1,K,J)+CH(I-1,K,JC)
               C1(I-1,K,JC) = CH(I,K,J)-CH(I,K,JC)
               C1(I,K,J) = CH(I,K,J)+CH(I,K,JC)
               C1(I,K,JC) = CH(I-1,K,JC)-CH(I-1,K,J)
  112       CONTINUE
  113    CONTINUE
  114 CONTINUE
      GO TO 121
  115 DO 118 J=2,IPPH
         JC = IPP2-J
         DO 117 I=3,IDO,2
            DO 116 K=1,L1
               C1(I-1,K,J) = CH(I-1,K,J)+CH(I-1,K,JC)
               C1(I-1,K,JC) = CH(I,K,J)-CH(I,K,JC)
               C1(I,K,J) = CH(I,K,J)+CH(I,K,JC)
               C1(I,K,JC) = CH(I-1,K,JC)-CH(I-1,K,J)
  116       CONTINUE
  117    CONTINUE
  118 CONTINUE
      GO TO 121
  119 DO 120 IK=1,IDL1
         C2(IK,1) = CH2(IK,1)
  120 CONTINUE
  121 DO 123 J=2,IPPH
         JC = IPP2-J
         DO 122 K=1,L1
            C1(1,K,J) = CH(1,K,J)+CH(1,K,JC)
            C1(1,K,JC) = CH(1,K,JC)-CH(1,K,J)
  122    CONTINUE
  123 CONTINUE
C
      AR1 = 1.
      AI1 = 0.
      DO 127 L=2,IPPH
         LC = IPP2-L
         AR1H = DCP*AR1-DSP*AI1
         AI1 = DCP*AI1+DSP*AR1
         AR1 = AR1H
         DO 124 IK=1,IDL1
            CH2(IK,L) = C2(IK,1)+AR1*C2(IK,2)
            CH2(IK,LC) = AI1*C2(IK,IP)
  124    CONTINUE
         DC2 = AR1
         DS2 = AI1
         AR2 = AR1
         AI2 = AI1
         DO 126 J=3,IPPH
            JC = IPP2-J
            AR2H = DC2*AR2-DS2*AI2
            AI2 = DC2*AI2+DS2*AR2
            AR2 = AR2H
            DO 125 IK=1,IDL1
               CH2(IK,L) = CH2(IK,L)+AR2*C2(IK,J)
               CH2(IK,LC) = CH2(IK,LC)+AI2*C2(IK,JC)
  125       CONTINUE
  126    CONTINUE
  127 CONTINUE
      DO 129 J=2,IPPH
         DO 128 IK=1,IDL1
            CH2(IK,1) = CH2(IK,1)+C2(IK,J)
  128    CONTINUE
  129 CONTINUE
C
      IF (IDO .LT. L1) GO TO 132
      DO 131 K=1,L1
         DO 130 I=1,IDO
            CC(I,1,K) = CH(I,K,1)
  130    CONTINUE
  131 CONTINUE
      GO TO 135
  132 DO 134 I=1,IDO
         DO 133 K=1,L1
            CC(I,1,K) = CH(I,K,1)
  133    CONTINUE
  134 CONTINUE
  135 DO 137 J=2,IPPH
         JC = IPP2-J
         J2 = J+J
         DO 136 K=1,L1
            CC(IDO,J2-2,K) = CH(1,K,J)
            CC(1,J2-1,K) = CH(1,K,JC)
  136    CONTINUE
  137 CONTINUE
      IF (IDO .EQ. 1) RETURN
      IF (NBD .LT. L1) GO TO 141
      DO 140 J=2,IPPH
         JC = IPP2-J
         J2 = J+J
         DO 139 K=1,L1
            DO 138 I=3,IDO,2
               IC = IDP2-I
               CC(I-1,J2-1,K) = CH(I-1,K,J)+CH(I-1,K,JC)
               CC(IC-1,J2-2,K) = CH(I-1,K,J)-CH(I-1,K,JC)
               CC(I,J2-1,K) = CH(I,K,J)+CH(I,K,JC)
               CC(IC,J2-2,K) = CH(I,K,JC)-CH(I,K,J)
  138       CONTINUE
  139    CONTINUE
  140 CONTINUE
      RETURN
  141 DO 144 J=2,IPPH
         JC = IPP2-J
         J2 = J+J
         DO 143 I=3,IDO,2
            IC = IDP2-I
            DO 142 K=1,L1
               CC(I-1,J2-1,K) = CH(I-1,K,J)+CH(I-1,K,JC)
               CC(IC-1,J2-2,K) = CH(I-1,K,J)-CH(I-1,K,JC)
               CC(I,J2-1,K) = CH(I,K,J)+CH(I,K,JC)
               CC(IC,J2-2,K) = CH(I,K,JC)-CH(I,K,J)
  142       CONTINUE
  143    CONTINUE
  144 CONTINUE
      RETURN
      END






Added c/fftpack/rfftb.c.





































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* rfftb.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int rfftb_(integer *n, real *r__, real *wsave)
{
    extern /* Subroutine */ int rfftb1_(integer *, real *, real *, real *, 
	    real *);

    /* Parameter adjustments */
    --wsave;
    --r__;

    /* Function Body */
    if (*n == 1) {
	return 0;
    }
    rfftb1_(n, &r__[1], &wsave[1], &wsave[*n + 1], &wsave[(*n << 1) + 1]);
    return 0;
} /* rfftb_ */







Added c/fftpack/rfftb.f.












1
2
3
4
5
6

+
+
+
+
+
+

      SUBROUTINE RFFTB (N,R,WSAVE)
      DIMENSION       R(1)       ,WSAVE(1)
      IF (N .EQ. 1) RETURN
      CALL RFFTB1 (N,R,WSAVE,WSAVE(N+1),WSAVE(2*N+1))
      RETURN
      END






Added c/fftpack/rfftb1.c.


















































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* rfftb1.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int rfftb1_(integer *n, real *c__, real *ch, real *wa, 
	integer *ifac)
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    integer i__, k1, l1, l2, na, nf, ip, iw, ix2, ix3, ix4, ido, idl1;
    extern /* Subroutine */ int radb2_(integer *, integer *, real *, real *, 
	    real *), radb3_(integer *, integer *, real *, real *, real *, 
	    real *), radb4_(integer *, integer *, real *, real *, real *, 
	    real *, real *), radb5_(integer *, integer *, real *, real *, 
	    real *, real *, real *, real *), radbg_(integer *, integer *, 
	    integer *, integer *, real *, real *, real *, real *, real *, 
	    real *);

    /* Parameter adjustments */
    --ifac;
    --wa;
    --ch;
    --c__;

    /* Function Body */
    nf = ifac[2];
    na = 0;
    l1 = 1;
    iw = 1;
    i__1 = nf;
    for (k1 = 1; k1 <= i__1; ++k1) {
	ip = ifac[k1 + 2];
	l2 = ip * l1;
	ido = *n / l2;
	idl1 = ido * l1;
	if (ip != 4) {
	    goto L103;
	}
	ix2 = iw + ido;
	ix3 = ix2 + ido;
	if (na != 0) {
	    goto L101;
	}
	radb4_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
	goto L102;
L101:
	radb4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
L102:
	na = 1 - na;
	goto L115;
L103:
	if (ip != 2) {
	    goto L106;
	}
	if (na != 0) {
	    goto L104;
	}
	radb2_(&ido, &l1, &c__[1], &ch[1], &wa[iw]);
	goto L105;
L104:
	radb2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]);
L105:
	na = 1 - na;
	goto L115;
L106:
	if (ip != 3) {
	    goto L109;
	}
	ix2 = iw + ido;
	if (na != 0) {
	    goto L107;
	}
	radb3_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
	goto L108;
L107:
	radb3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
L108:
	na = 1 - na;
	goto L115;
L109:
	if (ip != 5) {
	    goto L112;
	}
	ix2 = iw + ido;
	ix3 = ix2 + ido;
	ix4 = ix3 + ido;
	if (na != 0) {
	    goto L110;
	}
	radb5_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
		ix4]);
	goto L111;
L110:
	radb5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
		ix4]);
L111:
	na = 1 - na;
	goto L115;
L112:
	if (na != 0) {
	    goto L113;
	}
	radbg_(&ido, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1], &ch[
		1], &wa[iw]);
	goto L114;
L113:
	radbg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1]
		, &wa[iw]);
L114:
	if (ido == 1) {
	    na = 1 - na;
	}
L115:
	l1 = l2;
	iw += (ip - 1) * ido;
/* L116: */
    }
    if (na == 0) {
	return 0;
    }
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	c__[i__] = ch[i__];
/* L117: */
    }
    return 0;
} /* rfftb1_ */







Added c/fftpack/rfftb1.f.

































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE RFFTB1 (N,C,CH,WA,IFAC)
      DIMENSION       CH(1)      ,C(1)       ,WA(1)      ,IFAC(1)
      NF = IFAC(2)
      NA = 0
      L1 = 1
      IW = 1
      DO 116 K1=1,NF
         IP = IFAC(K1+2)
         L2 = IP*L1
         IDO = N/L2
         IDL1 = IDO*L1
         IF (IP .NE. 4) GO TO 103
         IX2 = IW+IDO
         IX3 = IX2+IDO
         IF (NA .NE. 0) GO TO 101
         CALL RADB4 (IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
         GO TO 102
  101    CALL RADB4 (IDO,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
  102    NA = 1-NA
         GO TO 115
  103    IF (IP .NE. 2) GO TO 106
         IF (NA .NE. 0) GO TO 104
         CALL RADB2 (IDO,L1,C,CH,WA(IW))
         GO TO 105
  104    CALL RADB2 (IDO,L1,CH,C,WA(IW))
  105    NA = 1-NA
         GO TO 115
  106    IF (IP .NE. 3) GO TO 109
         IX2 = IW+IDO
         IF (NA .NE. 0) GO TO 107
         CALL RADB3 (IDO,L1,C,CH,WA(IW),WA(IX2))
         GO TO 108
  107    CALL RADB3 (IDO,L1,CH,C,WA(IW),WA(IX2))
  108    NA = 1-NA
         GO TO 115
  109    IF (IP .NE. 5) GO TO 112
         IX2 = IW+IDO
         IX3 = IX2+IDO
         IX4 = IX3+IDO
         IF (NA .NE. 0) GO TO 110
         CALL RADB5 (IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
         GO TO 111
  110    CALL RADB5 (IDO,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4))
  111    NA = 1-NA
         GO TO 115
  112    IF (NA .NE. 0) GO TO 113
         CALL RADBG (IDO,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
         GO TO 114
  113    CALL RADBG (IDO,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
  114    IF (IDO .EQ. 1) NA = 1-NA
  115    L1 = L2
         IW = IW+(IP-1)*IDO
  116 CONTINUE
      IF (NA .EQ. 0) RETURN
      DO 117 I=1,N
         C(I) = CH(I)
  117 CONTINUE
      RETURN
      END






Added c/fftpack/rfftf.c.





































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* rfftf.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int rfftf_(integer *n, real *r__, real *wsave)
{
    extern /* Subroutine */ int rfftf1_(integer *, real *, real *, real *, 
	    real *);

    /* Parameter adjustments */
    --wsave;
    --r__;

    /* Function Body */
    if (*n == 1) {
	return 0;
    }
    rfftf1_(n, &r__[1], &wsave[1], &wsave[*n + 1], &wsave[(*n << 1) + 1]);
    return 0;
} /* rfftf_ */







Added c/fftpack/rfftf.f.












1
2
3
4
5
6

+
+
+
+
+
+

      SUBROUTINE RFFTF (N,R,WSAVE)
      DIMENSION       R(1)       ,WSAVE(1)
      IF (N .EQ. 1) RETURN
      CALL RFFTF1 (N,R,WSAVE,WSAVE(N+1),WSAVE(2*N+1))
      RETURN
      END






Added c/fftpack/rfftf1.c.













































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* rfftf1.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int rfftf1_(integer *n, real *c__, real *ch, real *wa, 
	integer *ifac)
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    integer i__, k1, l1, l2, na, kh, nf, ip, iw, ix2, ix3, ix4, ido, idl1;
    extern /* Subroutine */ int radf2_(integer *, integer *, real *, real *, 
	    real *), radf3_(integer *, integer *, real *, real *, real *, 
	    real *), radf4_(integer *, integer *, real *, real *, real *, 
	    real *, real *), radf5_(integer *, integer *, real *, real *, 
	    real *, real *, real *, real *), radfg_(integer *, integer *, 
	    integer *, integer *, real *, real *, real *, real *, real *, 
	    real *);

    /* Parameter adjustments */
    --ifac;
    --wa;
    --ch;
    --c__;

    /* Function Body */
    nf = ifac[2];
    na = 1;
    l2 = *n;
    iw = *n;
    i__1 = nf;
    for (k1 = 1; k1 <= i__1; ++k1) {
	kh = nf - k1;
	ip = ifac[kh + 3];
	l1 = l2 / ip;
	ido = *n / l2;
	idl1 = ido * l1;
	iw -= (ip - 1) * ido;
	na = 1 - na;
	if (ip != 4) {
	    goto L102;
	}
	ix2 = iw + ido;
	ix3 = ix2 + ido;
	if (na != 0) {
	    goto L101;
	}
	radf4_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3]);
	goto L110;
L101:
	radf4_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3]);
	goto L110;
L102:
	if (ip != 2) {
	    goto L104;
	}
	if (na != 0) {
	    goto L103;
	}
	radf2_(&ido, &l1, &c__[1], &ch[1], &wa[iw]);
	goto L110;
L103:
	radf2_(&ido, &l1, &ch[1], &c__[1], &wa[iw]);
	goto L110;
L104:
	if (ip != 3) {
	    goto L106;
	}
	ix2 = iw + ido;
	if (na != 0) {
	    goto L105;
	}
	radf3_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2]);
	goto L110;
L105:
	radf3_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2]);
	goto L110;
L106:
	if (ip != 5) {
	    goto L108;
	}
	ix2 = iw + ido;
	ix3 = ix2 + ido;
	ix4 = ix3 + ido;
	if (na != 0) {
	    goto L107;
	}
	radf5_(&ido, &l1, &c__[1], &ch[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
		ix4]);
	goto L110;
L107:
	radf5_(&ido, &l1, &ch[1], &c__[1], &wa[iw], &wa[ix2], &wa[ix3], &wa[
		ix4]);
	goto L110;
L108:
	if (ido == 1) {
	    na = 1 - na;
	}
	if (na != 0) {
	    goto L109;
	}
	radfg_(&ido, &ip, &l1, &idl1, &c__[1], &c__[1], &c__[1], &ch[1], &ch[
		1], &wa[iw]);
	na = 1;
	goto L110;
L109:
	radfg_(&ido, &ip, &l1, &idl1, &ch[1], &ch[1], &ch[1], &c__[1], &c__[1]
		, &wa[iw]);
	na = 0;
L110:
	l2 = l1;
/* L111: */
    }
    if (na == 1) {
	return 0;
    }
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	c__[i__] = ch[i__];
/* L112: */
    }
    return 0;
} /* rfftf1_ */







Added c/fftpack/rfftf1.f.

































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE RFFTF1 (N,C,CH,WA,IFAC)
      DIMENSION       CH(1)      ,C(1)       ,WA(1)      ,IFAC(1)
      NF = IFAC(2)
      NA = 1
      L2 = N
      IW = N
      DO 111 K1=1,NF
         KH = NF-K1
         IP = IFAC(KH+3)
         L1 = L2/IP
         IDO = N/L2
         IDL1 = IDO*L1
         IW = IW-(IP-1)*IDO
         NA = 1-NA
         IF (IP .NE. 4) GO TO 102
         IX2 = IW+IDO
         IX3 = IX2+IDO
         IF (NA .NE. 0) GO TO 101
         CALL RADF4 (IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
         GO TO 110
  101    CALL RADF4 (IDO,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
         GO TO 110
  102    IF (IP .NE. 2) GO TO 104
         IF (NA .NE. 0) GO TO 103
         CALL RADF2 (IDO,L1,C,CH,WA(IW))
         GO TO 110
  103    CALL RADF2 (IDO,L1,CH,C,WA(IW))
         GO TO 110
  104    IF (IP .NE. 3) GO TO 106
         IX2 = IW+IDO
         IF (NA .NE. 0) GO TO 105
         CALL RADF3 (IDO,L1,C,CH,WA(IW),WA(IX2))
         GO TO 110
  105    CALL RADF3 (IDO,L1,CH,C,WA(IW),WA(IX2))
         GO TO 110
  106    IF (IP .NE. 5) GO TO 108
         IX2 = IW+IDO
         IX3 = IX2+IDO
         IX4 = IX3+IDO
         IF (NA .NE. 0) GO TO 107
         CALL RADF5 (IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
         GO TO 110
  107    CALL RADF5 (IDO,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4))
         GO TO 110
  108    IF (IDO .EQ. 1) NA = 1-NA
         IF (NA .NE. 0) GO TO 109
         CALL RADFG (IDO,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
         NA = 1
         GO TO 110
  109    CALL RADFG (IDO,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
         NA = 0
  110    L2 = L1
  111 CONTINUE
      IF (NA .EQ. 1) RETURN
      DO 112 I=1,N
         C(I) = CH(I)
  112 CONTINUE
      RETURN
      END






Added c/fftpack/rffti.c.



































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* rffti.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int rffti_(integer *n, real *wsave)
{
    extern /* Subroutine */ int rffti1_(integer *, real *, real *);

    /* Parameter adjustments */
    --wsave;

    /* Function Body */
    if (*n == 1) {
	return 0;
    }
    rffti1_(n, &wsave[*n + 1], &wsave[(*n << 1) + 1]);
    return 0;
} /* rffti_ */







Added c/fftpack/rffti.f.












1
2
3
4
5
6

+
+
+
+
+
+

      SUBROUTINE RFFTI (N,WSAVE)
      DIMENSION       WSAVE(1)
      IF (N .EQ. 1) RETURN
      CALL RFFTI1 (N,WSAVE(N+1),WSAVE(2*N+1))
      RETURN
      END






Added c/fftpack/rffti1.c.






































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* rffti1.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int rffti1_(integer *n, real *wa, integer *ifac)
{
    /* Initialized data */

    static integer ntryh[4] = { 4,2,3,5 };

    /* System generated locals */
    integer i__1, i__2, i__3;

    /* Builtin functions */
    double cos(doublereal), sin(doublereal);

    /* Local variables */
    integer i__, j, k1, l1, l2, ib;
    real fi;
    integer ld, ii, nf, ip, nl, is, nq, nr;
    real arg;
    integer ido, ipm;
    real tpi;
    integer nfm1;
    real argh;
    integer ntry;
    real argld;

    /* Parameter adjustments */
    --ifac;
    --wa;

    /* Function Body */
    nl = *n;
    nf = 0;
    j = 0;
L101:
    ++j;
    if (j - 4 <= 0) {
	goto L102;
    } else {
	goto L103;
    }
L102:
    ntry = ntryh[j - 1];
    goto L104;
L103:
    ntry += 2;
L104:
    nq = nl / ntry;
    nr = nl - ntry * nq;
    if (nr != 0) {
	goto L101;
    } else {
	goto L105;
    }
L105:
    ++nf;
    ifac[nf + 2] = ntry;
    nl = nq;
    if (ntry != 2) {
	goto L107;
    }
    if (nf == 1) {
	goto L107;
    }
    i__1 = nf;
    for (i__ = 2; i__ <= i__1; ++i__) {
	ib = nf - i__ + 2;
	ifac[ib + 2] = ifac[ib + 1];
/* L106: */
    }
    ifac[3] = 2;
L107:
    if (nl != 1) {
	goto L104;
    }
    ifac[1] = *n;
    ifac[2] = nf;
    tpi = 6.28318530717959f;
    argh = tpi / (real) (*n);
    is = 0;
    nfm1 = nf - 1;
    l1 = 1;
    if (nfm1 == 0) {
	return 0;
    }
    i__1 = nfm1;
    for (k1 = 1; k1 <= i__1; ++k1) {
	ip = ifac[k1 + 2];
	ld = 0;
	l2 = l1 * ip;
	ido = *n / l2;
	ipm = ip - 1;
	i__2 = ipm;
	for (j = 1; j <= i__2; ++j) {
	    ld += l1;
	    i__ = is;
	    argld = (real) ld * argh;
	    fi = 0.f;
	    i__3 = ido;
	    for (ii = 3; ii <= i__3; ii += 2) {
		i__ += 2;
		fi += 1.f;
		arg = fi * argld;
		wa[i__ - 1] = cos(arg);
		wa[i__] = sin(arg);
/* L108: */
	    }
	    is += ido;
/* L109: */
	}
	l1 = l2;
/* L110: */
    }
    return 0;
} /* rffti1_ */







Added c/fftpack/rffti1.f.































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE RFFTI1 (N,WA,IFAC)
      DIMENSION       WA(1)      ,IFAC(1)    ,NTRYH(4)
      DATA NTRYH(1),NTRYH(2),NTRYH(3),NTRYH(4)/4,2,3,5/
      NL = N
      NF = 0
      J = 0
  101 J = J+1
      IF (J-4) 102,102,103
  102 NTRY = NTRYH(J)
      GO TO 104
  103 NTRY = NTRY+2
  104 NQ = NL/NTRY
      NR = NL-NTRY*NQ
      IF (NR) 101,105,101
  105 NF = NF+1
      IFAC(NF+2) = NTRY
      NL = NQ
      IF (NTRY .NE. 2) GO TO 107
      IF (NF .EQ. 1) GO TO 107
      DO 106 I=2,NF
         IB = NF-I+2
         IFAC(IB+2) = IFAC(IB+1)
  106 CONTINUE
      IFAC(3) = 2
  107 IF (NL .NE. 1) GO TO 104
      IFAC(1) = N
      IFAC(2) = NF
      TPI = 6.28318530717959
      ARGH = TPI/FLOAT(N)
      IS = 0
      NFM1 = NF-1
      L1 = 1
      IF (NFM1 .EQ. 0) RETURN
      DO 110 K1=1,NFM1
         IP = IFAC(K1+2)
         LD = 0
         L2 = L1*IP
         IDO = N/L2
         IPM = IP-1
         DO 109 J=1,IPM
            LD = LD+L1
            I = IS
            ARGLD = FLOAT(LD)*ARGH
            FI = 0.
            DO 108 II=3,IDO,2
               I = I+2
               FI = FI+1.
               ARG = FI*ARGLD
               WA(I-1) = COS(ARG)
               WA(I) = SIN(ARG)
  108       CONTINUE
            IS = IS+IDO
  109    CONTINUE
         L1 = L2
  110 CONTINUE
      RETURN
      END






Added c/fftpack/sinqb.c.



























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* sinqb.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int sinqb_(integer *n, real *x, real *wsave)
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    integer k, kc, ns2;
    extern /* Subroutine */ int cosqb_(integer *, real *, real *);
    real xhold;

    /* Parameter adjustments */
    --wsave;
    --x;

    /* Function Body */
    if (*n > 1) {
	goto L101;
    }
    x[1] *= 4.f;
    return 0;
L101:
    ns2 = *n / 2;
    i__1 = *n;
    for (k = 2; k <= i__1; k += 2) {
	x[k] = -x[k];
/* L102: */
    }
    cosqb_(n, &x[1], &wsave[1]);
    i__1 = ns2;
    for (k = 1; k <= i__1; ++k) {
	kc = *n - k;
	xhold = x[k];
	x[k] = x[kc + 1];
	x[kc + 1] = xhold;
/* L103: */
    }
    return 0;
} /* sinqb_ */







Added c/fftpack/sinqb.f.
























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE SINQB (N,X,WSAVE)
      DIMENSION       X(1)       ,WSAVE(1)
      IF (N .GT. 1) GO TO 101
      X(1) = 4.*X(1)
      RETURN
  101 NS2 = N/2
      DO 102 K=2,N,2
         X(K) = -X(K)
  102 CONTINUE
      CALL COSQB (N,X,WSAVE)
      DO 103 K=1,NS2
         KC = N-K
         XHOLD = X(K)
         X(K) = X(KC+1)
         X(KC+1) = XHOLD
  103 CONTINUE
      RETURN
      END






Added c/fftpack/sinqf.c.
























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* sinqf.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int sinqf_(integer *n, real *x, real *wsave)
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    integer k, kc, ns2;
    extern /* Subroutine */ int cosqf_(integer *, real *, real *);
    real xhold;

    /* Parameter adjustments */
    --wsave;
    --x;

    /* Function Body */
    if (*n == 1) {
	return 0;
    }
    ns2 = *n / 2;
    i__1 = ns2;
    for (k = 1; k <= i__1; ++k) {
	kc = *n - k;
	xhold = x[k];
	x[k] = x[kc + 1];
	x[kc + 1] = xhold;
/* L101: */
    }
    cosqf_(n, &x[1], &wsave[1]);
    i__1 = *n;
    for (k = 2; k <= i__1; k += 2) {
	x[k] = -x[k];
/* L102: */
    }
    return 0;
} /* sinqf_ */







Added c/fftpack/sinqf.f.






















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE SINQF (N,X,WSAVE)
      DIMENSION       X(1)       ,WSAVE(1)
      IF (N .EQ. 1) RETURN
      NS2 = N/2
      DO 101 K=1,NS2
         KC = N-K
         XHOLD = X(K)
         X(K) = X(KC+1)
         X(KC+1) = XHOLD
  101 CONTINUE
      CALL COSQF (N,X,WSAVE)
      DO 102 K=2,N,2
         X(K) = -X(K)
  102 CONTINUE
      RETURN
      END






Added c/fftpack/sinqi.c.
































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* sinqi.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int sinqi_(integer *n, real *wsave)
{
    extern /* Subroutine */ int cosqi_(integer *, real *);

    /* Parameter adjustments */
    --wsave;

    /* Function Body */
    cosqi_(n, &wsave[1]);
    return 0;
} /* sinqi_ */







Added c/fftpack/sinqi.f.











1
2
3
4
5

+
+
+
+
+

      SUBROUTINE SINQI (N,WSAVE)
      DIMENSION       WSAVE(1)
      CALL COSQI (N,WSAVE)
      RETURN
      END






Added c/fftpack/sint.c.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* sint.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int sint_(integer *n, real *x, real *wsave)
{
    integer np1, iw1, iw2, iw3;
    extern /* Subroutine */ int sint1_(integer *, real *, real *, real *, 
	    real *, real *);

    /* Parameter adjustments */
    --wsave;
    --x;

    /* Function Body */
    np1 = *n + 1;
    iw1 = *n / 2 + 1;
    iw2 = iw1 + np1;
    iw3 = iw2 + np1;
    sint1_(n, &x[1], &wsave[1], &wsave[iw1], &wsave[iw2], &wsave[iw3]);
    return 0;
} /* sint_ */







Added c/fftpack/sint.f.















1
2
3
4
5
6
7
8
9

+
+
+
+
+
+
+
+
+

      SUBROUTINE SINT (N,X,WSAVE)
      DIMENSION       X(1)       ,WSAVE(1)
      NP1 = N+1
      IW1 = N/2+1
      IW2 = IW1+NP1
      IW3 = IW2+NP1
      CALL SINT1(N,X,WSAVE,WSAVE(IW1),WSAVE(IW2),WSAVE(IW3))
      RETURN
      END






Added c/fftpack/sint1.c.










































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* sint1.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int sint1_(integer *n, real *war, real *was, real *xh, real *
	x, integer *ifac)
{
    /* Initialized data */

    static real sqrt3 = 1.73205080756888f;

    /* System generated locals */
    integer i__1;

    /* Local variables */
    integer i__, k;
    real t1, t2;
    integer kc, np1, ns2, modn;
    real xhold;
    extern /* Subroutine */ int rfftf1_(integer *, real *, real *, real *, 
	    integer *);

    /* Parameter adjustments */
    --ifac;
    --x;
    --xh;
    --was;
    --war;

    /* Function Body */
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	xh[i__] = war[i__];
	war[i__] = x[i__];
/* L100: */
    }
    if ((i__1 = *n - 2) < 0) {
	goto L101;
    } else if (i__1 == 0) {
	goto L102;
    } else {
	goto L103;
    }
L101:
    xh[1] += xh[1];
    goto L106;
L102:
    xhold = sqrt3 * (xh[1] + xh[2]);
    xh[2] = sqrt3 * (xh[1] - xh[2]);
    xh[1] = xhold;
    goto L106;
L103:
    np1 = *n + 1;
    ns2 = *n / 2;
    x[1] = 0.f;
    i__1 = ns2;
    for (k = 1; k <= i__1; ++k) {
	kc = np1 - k;
	t1 = xh[k] - xh[kc];
	t2 = was[k] * (xh[k] + xh[kc]);
	x[k + 1] = t1 + t2;
	x[kc + 1] = t2 - t1;
/* L104: */
    }
    modn = *n % 2;
    if (modn != 0) {
	x[ns2 + 2] = xh[ns2 + 1] * 4.f;
    }
    rfftf1_(&np1, &x[1], &xh[1], &war[1], &ifac[1]);
    xh[1] = x[1] * .5f;
    i__1 = *n;
    for (i__ = 3; i__ <= i__1; i__ += 2) {
	xh[i__ - 1] = -x[i__];
	xh[i__] = xh[i__ - 2] + x[i__ - 1];
/* L105: */
    }
    if (modn != 0) {
	goto L106;
    }
    xh[*n] = -x[*n + 1];
L106:
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	x[i__] = war[i__];
	war[i__] = xh[i__];
/* L107: */
    }
    return 0;
} /* sint1_ */







Added c/fftpack/sint1.f.














































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE SINT1(N,WAR,WAS,XH,X,IFAC)
      DIMENSION WAR(1),WAS(1),X(1),XH(1),IFAC(1)
      DATA SQRT3 /1.73205080756888/
      DO 100 I=1,N
      XH(I) = WAR(I)
      WAR(I) = X(I)
  100 CONTINUE
      IF (N-2) 101,102,103
  101 XH(1) = XH(1)+XH(1)
      GO TO 106
  102 XHOLD = SQRT3*(XH(1)+XH(2))
      XH(2) = SQRT3*(XH(1)-XH(2))
      XH(1) = XHOLD
      GO TO 106
  103 NP1 = N+1
      NS2 = N/2
      X(1) = 0.
      DO 104 K=1,NS2
         KC = NP1-K
         T1 = XH(K)-XH(KC)
         T2 = WAS(K)*(XH(K)+XH(KC))
         X(K+1) = T1+T2
         X(KC+1) = T2-T1
  104 CONTINUE
      MODN = MOD(N,2)
      IF (MODN .NE. 0) X(NS2+2) = 4.*XH(NS2+1)
      CALL RFFTF1 (NP1,X,XH,WAR,IFAC)
      XH(1) = .5*X(1)
      DO 105 I=3,N,2
         XH(I-1) = -X(I)
         XH(I) = XH(I-2)+X(I-1)
  105 CONTINUE
      IF (MODN .NE. 0) GO TO 106
      XH(N) = -X(N+1)
  106 DO 107 I=1,N
      X(I) = WAR(I)
      WAR(I) = XH(I)
  107 CONTINUE
      RETURN
      END






Added c/fftpack/sinti.c.

























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* sinti.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Subroutine */ int sinti_(integer *n, real *wsave)
{
    /* Initialized data */

    static real pi = 3.14159265358979f;

    /* System generated locals */
    integer i__1;

    /* Builtin functions */
    double sin(doublereal);

    /* Local variables */
    integer k;
    real dt;
    integer np1, ns2;
    extern /* Subroutine */ int rffti_(integer *, real *);

    /* Parameter adjustments */
    --wsave;

    /* Function Body */
    if (*n <= 1) {
	return 0;
    }
    ns2 = *n / 2;
    np1 = *n + 1;
    dt = pi / (real) np1;
    i__1 = ns2;
    for (k = 1; k <= i__1; ++k) {
	wsave[k] = sin(k * dt) * 2.f;
/* L101: */
    }
    rffti_(&np1, &wsave[ns2 + 1]);
    return 0;
} /* sinti_ */







Added c/fftpack/sinti.f.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

      SUBROUTINE SINTI (N,WSAVE)
      DIMENSION       WSAVE(1)
      DATA PI /3.14159265358979/
      IF (N .LE. 1) RETURN
      NS2 = N/2
      NP1 = N+1
      DT = PI/FLOAT(NP1)
      DO 101 K=1,NS2
         WSAVE(K) = 2.*SIN(K*DT)
  101 CONTINUE
      CALL RFFTI (NP1,WSAVE(NS2+1))
      RETURN
      END






Added c/fftpack/test.c.





































































































































































































































































































































































































































































































































































































































































































































































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
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* test.f -- translated by f2c (version 20050501).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Table of constant values */

static integer c_n1 = -1;
static integer c__1 = 1;

/* Main program */ int MAIN__(void)
{
    /* Initialized data */

    static integer nd[10] = { 120,54,49,32,4,3,2 };

    /* Format strings */
    static char fmt_1001[] = "(\0020N\002,i5,\002 RFFTF  \002,e10.3,\002 RFF"
	    "TB  \002,e10.3,\002 RFFTFB \002,e10.3,\002 SINT   \002,e10.3,"
	    "\002 SINTFB \002,e10.3,\002 COST   \002,e10.3/7x,\002 COSTFB "
	    "\002,e10.3,\002 SINQF  \002,e10.3,\002 SINQB  \002,e10.3,\002 SI"
	    "NQFB \002,e10.3,\002 COSQF  \002,e10.3,\002 COSQB  \002,e10.3/7x,"
	    "\002 COSQFB \002,e10.3,\002 DEZF   \002,e10.3,\002 DEZB   \002,e"
	    "10.3,\002 DEZFB  \002,e10.3,\002 CFFTF  \002,e10.3,\002 CFFTB "
	    " \002,e10.3/7x,\002 CFFTFB \002,e10.3)";

    /* System generated locals */
    integer i__1, i__2, i__3, i__4, i__5, i__6;
    real r__1, r__2, r__3, r__4;
    complex q__1, q__2, q__3;

    /* Builtin functions */
    double sqrt(doublereal), sin(doublereal), cos(doublereal);
    integer pow_ii(integer *, integer *);
    double atan(doublereal), c_abs(complex *);
    integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);

    /* Local variables */
    real a[100], b[100];
    integer i__, j, k, n;
    real w[2000], x[200], y[200], ah[100], bh[100], cf, fn, dt, pi;
    complex cx[200], cy[200];
    real xh[200];
    integer nz, nm1, np1, ns2;
    real arg, tfn, tpi;
    integer nns;
    real sum, arg1, arg2;
    integer ns2m;
    real sum1, sum2, dcfb;
    integer modn;
    real rftb, rftf;
    extern /* Subroutine */ int cost_(integer *, real *, real *), sint_(
	    integer *, real *, real *);
    real dezb1, dezf1, sqrt2;
    extern /* Subroutine */ int cfftb_(integer *, complex *, real *), cfftf_(
	    integer *, complex *, real *);
    real dezfb;
    extern /* Subroutine */ int cffti_(integer *, real *), rfftb_(integer *, 
	    real *, real *);
    real rftfb;
    extern /* Subroutine */ int rfftf_(integer *, real *, real *), cosqb_(
	    integer *, real *, real *), rffti_(integer *, real *), cosqf_(
	    integer *, real *, real *), sinqb_(integer *, real *, real *), 
	    cosqi_(integer *, real *), sinqf_(integer *, real *, real *), 
	    costi_(integer *, real *);
    real azero;
    extern /* Subroutine */ int sinqi_(integer *, real *), sinti_(integer *, 
	    real *);
    real costt, sintt, dcfftb, dcfftf, cosqfb, costfb;
    extern /* Subroutine */ int ezfftb_(integer *, real *, real *, real *, 
	    real *, real *);
    real sinqfb;
    extern /* Subroutine */ int ezfftf_(integer *, real *, real *, real *, 
	    real *, real *);
    real sintfb;
    extern /* Subroutine */ int ezffti_(integer *, real *);
    real azeroh, cosqbt, cosqft, sinqbt, sinqft;

    /* Fortran I/O blocks */
    static cilist io___57 = { 0, 6, 0, fmt_1001, 0 };



/*     * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

/*                       VERSION 4  APRIL 1985 */

/*                         A TEST DRIVER FOR */
/*          A PACKAGE OF FORTRAN SUBPROGRAMS FOR THE FAST FOURIER */
/*           TRANSFORM OF PERIODIC AND OTHER SYMMETRIC SEQUENCES */

/*                              BY */

/*                       PAUL N SWARZTRAUBER */

/*       NATIONAL CENTER FOR ATMOSPHERIC RESEARCH  BOULDER,COLORADO 80307 */

/*        WHICH IS SPONSORED BY THE NATIONAL SCIENCE FOUNDATION */

/*     * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */


/*             THIS PROGRAM TESTS THE PACKAGE OF FAST FOURIER */
/*     TRANSFORMS FOR BOTH COMPLEX AND REAL PERIODIC SEQUENCES AND */
/*     CERTIAN OTHER SYMMETRIC SEQUENCES THAT ARE LISTED BELOW. */

/*     1.   RFFTI     INITIALIZE  RFFTF AND RFFTB */
/*     2.   RFFTF     FORWARD TRANSFORM OF A REAL PERIODIC SEQUENCE */
/*     3.   RFFTB     BACKWARD TRANSFORM OF A REAL COEFFICIENT ARRAY */

/*     4.   EZFFTI    INITIALIZE EZFFTF AND EZFFTB */
/*     5.   EZFFTF    A SIMPLIFIED REAL PERIODIC FORWARD TRANSFORM */
/*     6.   EZFFTB    A SIMPLIFIED REAL PERIODIC BACKWARD TRANSFORM */

/*     7.   SINTI     INITIALIZE SINT */
/*     8.   SINT      SINE TRANSFORM OF A REAL ODD SEQUENCE */

/*     9.   COSTI     INITIALIZE COST */
/*     10.  COST      COSINE TRANSFORM OF A REAL EVEN SEQUENCE */

/*     11.  SINQI     INITIALIZE SINQF AND SINQB */
/*     12.  SINQF     FORWARD SINE TRANSFORM WITH ODD WAVE NUMBERS */
/*     13.  SINQB     UNNORMALIZED INVERSE OF SINQF */

/*     14.  COSQI     INITIALIZE COSQF AND COSQB */
/*     15.  COSQF     FORWARD COSINE TRANSFORM WITH ODD WAVE NUMBERS */
/*     16.  COSQB     UNNORMALIZED INVERSE OF COSQF */

/*     17.  CFFTI     INITIALIZE CFFTF AND CFFTB */
/*     18.  CFFTF     FORWARD TRANSFORM OF A COMPLEX PERIODIC SEQUENCE */
/*     19.  CFFTB     UNNORMALIZED INVERSE OF CFFTF */


    sqrt2 = sqrt(2.f);
    nns = 7;
    i__1 = nns;
    for (nz = 1; nz <= i__1; ++nz) {
	n = nd[nz - 1];
	modn = n % 2;
	fn = (real) n;
	tfn = fn + fn;
	np1 = n + 1;
	nm1 = n - 1;
	i__2 = np1;
	for (j = 1; j <= i__2; ++j) {
	    x[j - 1] = sin((real) j * sqrt2);
	    y[j - 1] = x[j - 1];
	    xh[j - 1] = x[j - 1];
/* L101: */
	}

/*     TEST SUBROUTINES RFFTI,RFFTF AND RFFTB */

	rffti_(&n, w);
	pi = 3.14159265358979f;
	dt = (pi + pi) / fn;
	ns2 = (n + 1) / 2;
	if (ns2 < 2) {
	    goto L104;
	}
	i__2 = ns2;
	for (k = 2; k <= i__2; ++k) {
	    sum1 = 0.f;
	    sum2 = 0.f;
	    arg = (real) (k - 1) * dt;
	    i__3 = n;
	    for (i__ = 1; i__ <= i__3; ++i__) {
		arg1 = (real) (i__ - 1) * arg;
		sum1 += x[i__ - 1] * cos(arg1);
		sum2 += x[i__ - 1] * sin(arg1);
/* L102: */
	    }
	    y[(k << 1) - 3] = sum1;
	    y[(k << 1) - 2] = -sum2;
/* L103: */
	}
L104:
	sum1 = 0.f;
	sum2 = 0.f;
	i__2 = nm1;
	for (i__ = 1; i__ <= i__2; i__ += 2) {
	    sum1 += x[i__ - 1];
	    sum2 += x[i__];
/* L105: */
	}
	if (modn == 1) {
	    sum1 += x[n - 1];
	}
	y[0] = sum1 + sum2;
	if (modn == 0) {
	    y[n - 1] = sum1 - sum2;
	}
	rfftf_(&n, x, w);
	rftf = 0.f;
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
	    r__2 = rftf, r__3 = (r__1 = x[i__ - 1] - y[i__ - 1], dabs(r__1));
	    rftf = dmax(r__2,r__3);
	    x[i__ - 1] = xh[i__ - 1];
/* L106: */
	}
	rftf /= fn;
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    sum = x[0] * .5f;
	    arg = (real) (i__ - 1) * dt;
	    if (ns2 < 2) {
		goto L108;
	    }
	    i__3 = ns2;
	    for (k = 2; k <= i__3; ++k) {
		arg1 = (real) (k - 1) * arg;
		sum = sum + x[(k << 1) - 3] * cos(arg1) - x[(k << 1) - 2] * 
			sin(arg1);
/* L107: */
	    }
L108:
	    if (modn == 0) {
		i__3 = i__ - 1;
		sum += (real) pow_ii(&c_n1, &i__3) * .5f * x[n - 1];
	    }
	    y[i__ - 1] = sum + sum;
/* L109: */
	}
	rfftb_(&n, x, w);
	rftb = 0.f;
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
	    r__2 = rftb, r__3 = (r__1 = x[i__ - 1] - y[i__ - 1], dabs(r__1));
	    rftb = dmax(r__2,r__3);
	    x[i__ - 1] = xh[i__ - 1];
	    y[i__ - 1] = xh[i__ - 1];
/* L110: */
	}
	rfftb_(&n, y, w);
	rfftf_(&n, y, w);
	cf = 1.f / fn;
	rftfb = 0.f;
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
	    r__2 = rftfb, r__3 = (r__1 = cf * y[i__ - 1] - x[i__ - 1], dabs(
		    r__1));
	    rftfb = dmax(r__2,r__3);
/* L111: */
	}

/*     TEST SUBROUTINES SINTI AND SINT */

	dt = pi / fn;
	i__2 = nm1;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    x[i__ - 1] = xh[i__ - 1];
/* L112: */
	}
	i__2 = nm1;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    y[i__ - 1] = 0.f;
	    arg1 = (real) i__ * dt;
	    i__3 = nm1;
	    for (k = 1; k <= i__3; ++k) {
		y[i__ - 1] += x[k - 1] * sin((real) k * arg1);
/* L113: */
	    }
	    y[i__ - 1] += y[i__ - 1];
/* L114: */
	}
	sinti_(&nm1, w);
	sint_(&nm1, x, w);
	cf = .5f / fn;
	sintt = 0.f;
	i__2 = nm1;
	for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
	    r__2 = sintt, r__3 = (r__1 = x[i__ - 1] - y[i__ - 1], dabs(r__1));
	    sintt = dmax(r__2,r__3);
	    x[i__ - 1] = xh[i__ - 1];
	    y[i__ - 1] = x[i__ - 1];
/* L115: */
	}
	sintt = cf * sintt;
	sint_(&nm1, x, w);
	sint_(&nm1, x, w);
	sintfb = 0.f;
	i__2 = nm1;
	for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
	    r__2 = sintfb, r__3 = (r__1 = cf * x[i__ - 1] - y[i__ - 1], dabs(
		    r__1));
	    sintfb = dmax(r__2,r__3);
/* L116: */
	}

/*     TEST SUBROUTINES COSTI AND COST */

	i__2 = np1;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    x[i__ - 1] = xh[i__ - 1];
/* L117: */
	}
	i__2 = np1;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    i__3 = i__ + 1;
	    y[i__ - 1] = (x[0] + (real) pow_ii(&c_n1, &i__3) * x[n]) * .5f;
	    arg = (real) (i__ - 1) * dt;
	    i__3 = n;
	    for (k = 2; k <= i__3; ++k) {
		y[i__ - 1] += x[k - 1] * cos((real) (k - 1) * arg);
/* L118: */
	    }
	    y[i__ - 1] += y[i__ - 1];
/* L119: */
	}
	costi_(&np1, w);
	cost_(&np1, x, w);
	costt = 0.f;
	i__2 = np1;
	for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
	    r__2 = costt, r__3 = (r__1 = x[i__ - 1] - y[i__ - 1], dabs(r__1));
	    costt = dmax(r__2,r__3);
	    x[i__ - 1] = xh[i__ - 1];
	    y[i__ - 1] = xh[i__ - 1];
/* L120: */
	}
	costt = cf * costt;
	cost_(&np1, x, w);
	cost_(&np1, x, w);
	costfb = 0.f;
	i__2 = np1;
	for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
	    r__2 = costfb, r__3 = (r__1 = cf * x[i__ - 1] - y[i__ - 1], dabs(
		    r__1));
	    costfb = dmax(r__2,r__3);
/* L121: */
	}

/*     TEST SUBROUTINES SINQI,SINQF AND SINQB */

	cf = .25f / fn;
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    y[i__ - 1] = xh[i__ - 1];
/* L122: */
	}
	dt = pi / (fn + fn);
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    x[i__ - 1] = 0.f;
	    arg = dt * (real) i__;
	    i__3 = n;
	    for (k = 1; k <= i__3; ++k) {
		x[i__ - 1] += y[k - 1] * sin((real) (k + k - 1) * arg);
/* L123: */
	    }
	    x[i__ - 1] *= 4.f;
/* L124: */
	}
	sinqi_(&n, w);
	sinqb_(&n, y, w);
	sinqbt = 0.f;
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
	    r__2 = sinqbt, r__3 = (r__1 = y[i__ - 1] - x[i__ - 1], dabs(r__1))
		    ;
	    sinqbt = dmax(r__2,r__3);
	    x[i__ - 1] = xh[i__ - 1];
/* L125: */
	}
	sinqbt = cf * sinqbt;
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    arg = (real) (i__ + i__ - 1) * dt;
	    i__3 = i__ + 1;
	    y[i__ - 1] = (real) pow_ii(&c_n1, &i__3) * .5f * x[n - 1];
	    i__3 = nm1;
	    for (k = 1; k <= i__3; ++k) {
		y[i__ - 1] += x[k - 1] * sin((real) k * arg);
/* L126: */
	    }
	    y[i__ - 1] += y[i__ - 1];
/* L127: */
	}
	sinqf_(&n, x, w);
	sinqft = 0.f;
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
	    r__2 = sinqft, r__3 = (r__1 = x[i__ - 1] - y[i__ - 1], dabs(r__1))
		    ;
	    sinqft = dmax(r__2,r__3);
	    y[i__ - 1] = xh[i__ - 1];
	    x[i__ - 1] = xh[i__ - 1];
/* L128: */
	}
	sinqf_(&n, y, w);
	sinqb_(&n, y, w);
	sinqfb = 0.f;
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
	    r__2 = sinqfb, r__3 = (r__1 = cf * y[i__ - 1] - x[i__ - 1], dabs(
		    r__1));
	    sinqfb = dmax(r__2,r__3);
/* L129: */
	}

/*     TEST SUBROUTINES COSQI,COSQF AND COSQB */

	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    y[i__ - 1] = xh[i__ - 1];
/* L130: */
	}
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    x[i__ - 1] = 0.f;
	    arg = (real) (i__ - 1) * dt;
	    i__3 = n;
	    for (k = 1; k <= i__3; ++k) {
		x[i__ - 1] += y[k - 1] * cos((real) (k + k - 1) * arg);
/* L131: */
	    }
	    x[i__ - 1] *= 4.f;
/* L132: */
	}
	cosqi_(&n, w);
	cosqb_(&n, y, w);
	cosqbt = 0.f;
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
	    r__2 = cosqbt, r__3 = (r__1 = x[i__ - 1] - y[i__ - 1], dabs(r__1))
		    ;
	    cosqbt = dmax(r__2,r__3);
	    x[i__ - 1] = xh[i__ - 1];
/* L133: */
	}
	cosqbt = cf * cosqbt;
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    y[i__ - 1] = x[0] * .5f;
	    arg = (real) (i__ + i__ - 1) * dt;
	    i__3 = n;
	    for (k = 2; k <= i__3; ++k) {
		y[i__ - 1] += x[k - 1] * cos((real) (k - 1) * arg);
/* L134: */
	    }
	    y[i__ - 1] += y[i__ - 1];
/* L135: */
	}
	cosqf_(&n, x, w);
	cosqft = 0.f;
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
	    r__2 = cosqft, r__3 = (r__1 = y[i__ - 1] - x[i__ - 1], dabs(r__1))
		    ;
	    cosqft = dmax(r__2,r__3);
	    x[i__ - 1] = xh[i__ - 1];
	    y[i__ - 1] = xh[i__ - 1];
/* L136: */
	}
	cosqft = cf * cosqft;
	cosqb_(&n, x, w);
	cosqf_(&n, x, w);
	cosqfb = 0.f;
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
	    r__2 = cosqfb, r__3 = (r__1 = cf * x[i__ - 1] - y[i__ - 1], dabs(
		    r__1));
	    cosqfb = dmax(r__2,r__3);
/* L137: */
	}

/*     TEST PROGRAMS EZFFTI,EZFFTF,EZFFTB */

	ezffti_(&n, w);
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    x[i__ - 1] = xh[i__ - 1];
/* L138: */
	}
	tpi = atan(1.f) * 8.f;
	dt = tpi / (real) n;
	ns2 = (n + 1) / 2;
	cf = 2.f / (real) n;
	ns2m = ns2 - 1;
	if (ns2m <= 0) {
	    goto L141;
	}
	i__2 = ns2m;
	for (k = 1; k <= i__2; ++k) {
	    sum1 = 0.f;
	    sum2 = 0.f;
	    arg = (real) k * dt;
	    i__3 = n;
	    for (i__ = 1; i__ <= i__3; ++i__) {
		arg1 = (real) (i__ - 1) * arg;
		sum1 += x[i__ - 1] * cos(arg1);
		sum2 += x[i__ - 1] * sin(arg1);
/* L139: */
	    }
	    a[k - 1] = cf * sum1;
	    b[k - 1] = cf * sum2;
/* L140: */
	}
L141:
	nm1 = n - 1;
	sum1 = 0.f;
	sum2 = 0.f;
	i__2 = nm1;
	for (i__ = 1; i__ <= i__2; i__ += 2) {
	    sum1 += x[i__ - 1];
	    sum2 += x[i__];
/* L142: */
	}
	if (modn == 1) {
	    sum1 += x[n - 1];
	}
	azero = cf * .5f * (sum1 + sum2);
	if (modn == 0) {
	    a[ns2 - 1] = cf * .5f * (sum1 - sum2);
	}
	ezfftf_(&n, x, &azeroh, ah, bh, w);
	dezf1 = (r__1 = azeroh - azero, dabs(r__1));
	if (modn == 0) {
/* Computing MAX */
	    r__2 = dezf1, r__3 = (r__1 = a[ns2 - 1] - ah[ns2 - 1], dabs(r__1))
		    ;
	    dezf1 = dmax(r__2,r__3);
	}
	if (ns2m <= 0) {
	    goto L144;
	}
	i__2 = ns2m;
	for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
	    r__3 = dezf1, r__4 = (r__1 = ah[i__ - 1] - a[i__ - 1], dabs(r__1))
		    , r__3 = max(r__3,r__4), r__4 = (r__2 = bh[i__ - 1] - b[
		    i__ - 1], dabs(r__2));
	    dezf1 = dmax(r__3,r__4);
/* L143: */
	}
L144:
	ns2 = n / 2;
	if (modn == 0) {
	    b[ns2 - 1] = 0.f;
	}
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    sum = azero;
	    arg1 = (real) (i__ - 1) * dt;
	    i__3 = ns2;
	    for (k = 1; k <= i__3; ++k) {
		arg2 = (real) k * arg1;
		sum = sum + a[k - 1] * cos(arg2) + b[k - 1] * sin(arg2);
/* L145: */
	    }
	    x[i__ - 1] = sum;
/* L146: */
	}
	ezfftb_(&n, y, &azero, a, b, w);
	dezb1 = 0.f;
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
	    r__2 = dezb1, r__3 = (r__1 = x[i__ - 1] - y[i__ - 1], dabs(r__1));
	    dezb1 = dmax(r__2,r__3);
	    x[i__ - 1] = xh[i__ - 1];
/* L147: */
	}
	ezfftf_(&n, x, &azero, a, b, w);
	ezfftb_(&n, y, &azero, a, b, w);
	dezfb = 0.f;
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
	    r__2 = dezfb, r__3 = (r__1 = x[i__ - 1] - y[i__ - 1], dabs(r__1));
	    dezfb = dmax(r__2,r__3);
/* L148: */
	}

/*     TEST  CFFTI,CFFTF,CFFTB */

	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    i__3 = i__ - 1;
	    r__1 = cos(sqrt2 * (real) i__);
	    r__2 = sin(sqrt2 * (real) (i__ * i__));
	    q__1.r = r__1, q__1.i = r__2;
	    cx[i__3].r = q__1.r, cx[i__3].i = q__1.i;
/* L149: */
	}
	dt = (pi + pi) / fn;
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    arg1 = -((real) (i__ - 1)) * dt;
	    i__3 = i__ - 1;
	    cy[i__3].r = 0.f, cy[i__3].i = 0.f;
	    i__3 = n;
	    for (k = 1; k <= i__3; ++k) {
		arg2 = (real) (k - 1) * arg1;
		i__4 = i__ - 1;
		i__5 = i__ - 1;
		r__1 = cos(arg2);
		r__2 = sin(arg2);
		q__3.r = r__1, q__3.i = r__2;
		i__6 = k - 1;
		q__2.r = q__3.r * cx[i__6].r - q__3.i * cx[i__6].i, q__2.i = 
			q__3.r * cx[i__6].i + q__3.i * cx[i__6].r;
		q__1.r = cy[i__5].r + q__2.r, q__1.i = cy[i__5].i + q__2.i;
		cy[i__4].r = q__1.r, cy[i__4].i = q__1.i;
/* L150: */
	    }
/* L151: */
	}
	cffti_(&n, w);
	cfftf_(&n, cx, w);
	dcfftf = 0.f;
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
	    i__3 = i__ - 1;
	    i__4 = i__ - 1;
	    q__1.r = cx[i__3].r - cy[i__4].r, q__1.i = cx[i__3].i - cy[i__4]
		    .i;
	    r__1 = dcfftf, r__2 = c_abs(&q__1);
	    dcfftf = dmax(r__1,r__2);
	    i__3 = i__ - 1;
	    i__4 = i__ - 1;
	    q__1.r = cx[i__4].r / fn, q__1.i = cx[i__4].i / fn;
	    cx[i__3].r = q__1.r, cx[i__3].i = q__1.i;
/* L152: */
	}
	dcfftf /= fn;
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    arg1 = (real) (i__ - 1) * dt;
	    i__3 = i__ - 1;
	    cy[i__3].r = 0.f, cy[i__3].i = 0.f;
	    i__3 = n;
	    for (k = 1; k <= i__3; ++k) {
		arg2 = (real) (k - 1) * arg1;
		i__4 = i__ - 1;
		i__5 = i__ - 1;
		r__1 = cos(arg2);
		r__2 = sin(arg2);
		q__3.r = r__1, q__3.i = r__2;
		i__6 = k - 1;
		q__2.r = q__3.r * cx[i__6].r - q__3.i * cx[i__6].i, q__2.i = 
			q__3.r * cx[i__6].i + q__3.i * cx[i__6].r;
		q__1.r = cy[i__5].r + q__2.r, q__1.i = cy[i__5].i + q__2.i;
		cy[i__4].r = q__1.r, cy[i__4].i = q__1.i;
/* L153: */
	    }
/* L154: */
	}
	cfftb_(&n, cx, w);
	dcfftb = 0.f;
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
	    i__3 = i__ - 1;
	    i__4 = i__ - 1;
	    q__1.r = cx[i__3].r - cy[i__4].r, q__1.i = cx[i__3].i - cy[i__4]
		    .i;
	    r__1 = dcfftb, r__2 = c_abs(&q__1);
	    dcfftb = dmax(r__1,r__2);
	    i__3 = i__ - 1;
	    i__4 = i__ - 1;
	    cx[i__3].r = cy[i__4].r, cx[i__3].i = cy[i__4].i;
/* L155: */
	}
	cf = 1.f / fn;
	cfftf_(&n, cx, w);
	cfftb_(&n, cx, w);
	dcfb = 0.f;
	i__2 = n;
	for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */
	    i__3 = i__ - 1;
	    q__2.r = cf * cx[i__3].r, q__2.i = cf * cx[i__3].i;
	    i__4 = i__ - 1;
	    q__1.r = q__2.r - cy[i__4].r, q__1.i = q__2.i - cy[i__4].i;
	    r__1 = dcfb, r__2 = c_abs(&q__1);
	    dcfb = dmax(r__1,r__2);
/* L156: */
	}
	s_wsfe(&io___57);
	do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
	do_fio(&c__1, (char *)&rftf, (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&rftb, (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&rftfb, (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&sintt, (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&sintfb, (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&costt, (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&costfb, (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&sinqft, (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&sinqbt, (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&sinqfb, (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&cosqft, (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&cosqbt, (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&cosqfb, (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&dezf1, (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&dezb1, (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&dezfb, (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&dcfftf, (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&dcfftb, (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&dcfb, (ftnlen)sizeof(real));
	e_wsfe();
/* L157: */
    }




    return 0;
} /* MAIN__ */

/* Main program alias */ int tstfft_ () { MAIN__ (); return 0; }






Added c/fftpack/test.f.




























































































































































































































































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

      PROGRAM TSTFFT
C
C     * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C
C                       VERSION 4  APRIL 1985
C
C                         A TEST DRIVER FOR
C          A PACKAGE OF FORTRAN SUBPROGRAMS FOR THE FAST FOURIER
C           TRANSFORM OF PERIODIC AND OTHER SYMMETRIC SEQUENCES
C
C                              BY
C
C                       PAUL N SWARZTRAUBER
C
C       NATIONAL CENTER FOR ATMOSPHERIC RESEARCH  BOULDER,COLORADO 80307
C
C        WHICH IS SPONSORED BY THE NATIONAL SCIENCE FOUNDATION
C
C     * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C
C
C             THIS PROGRAM TESTS THE PACKAGE OF FAST FOURIER
C     TRANSFORMS FOR BOTH COMPLEX AND REAL PERIODIC SEQUENCES AND
C     CERTIAN OTHER SYMMETRIC SEQUENCES THAT ARE LISTED BELOW.
C
C     1.   RFFTI     INITIALIZE  RFFTF AND RFFTB
C     2.   RFFTF     FORWARD TRANSFORM OF A REAL PERIODIC SEQUENCE
C     3.   RFFTB     BACKWARD TRANSFORM OF A REAL COEFFICIENT ARRAY
C
C     4.   EZFFTI    INITIALIZE EZFFTF AND EZFFTB
C     5.   EZFFTF    A SIMPLIFIED REAL PERIODIC FORWARD TRANSFORM
C     6.   EZFFTB    A SIMPLIFIED REAL PERIODIC BACKWARD TRANSFORM
C
C     7.   SINTI     INITIALIZE SINT
C     8.   SINT      SINE TRANSFORM OF A REAL ODD SEQUENCE
C
C     9.   COSTI     INITIALIZE COST
C     10.  COST      COSINE TRANSFORM OF A REAL EVEN SEQUENCE
C
C     11.  SINQI     INITIALIZE SINQF AND SINQB
C     12.  SINQF     FORWARD SINE TRANSFORM WITH ODD WAVE NUMBERS
C     13.  SINQB     UNNORMALIZED INVERSE OF SINQF
C
C     14.  COSQI     INITIALIZE COSQF AND COSQB
C     15.  COSQF     FORWARD COSINE TRANSFORM WITH ODD WAVE NUMBERS
C     16.  COSQB     UNNORMALIZED INVERSE OF COSQF
C
C     17.  CFFTI     INITIALIZE CFFTF AND CFFTB
C     18.  CFFTF     FORWARD TRANSFORM OF A COMPLEX PERIODIC SEQUENCE
C     19.  CFFTB     UNNORMALIZED INVERSE OF CFFTF
C
C
      DIMENSION       ND(10)     ,X(200)     ,Y(200)     ,W(2000)    ,
     1                A(100)     ,B(100)     ,AH(100)    ,BH(100)    ,
     2                XH(200)    ,CX(200)    ,CY(200)
      COMPLEX         CX         ,CY
      DATA ND(1),ND(2),ND(3),ND(4),ND(5),ND(6),ND(7)/120,54,49,32,4,3,2/
      SQRT2 = SQRT(2.)
      NNS = 7
      DO 157 NZ=1,NNS
         N = ND(NZ)
         MODN = MOD(N,2)
         FN = FLOAT(N)
         TFN = FN+FN
         NP1 = N+1
         NM1 = N-1
         DO 101 J=1,NP1
            X(J) = SIN(FLOAT(J)*SQRT2)
            Y(J) = X(J)
            XH(J) = X(J)
  101    CONTINUE
C
C     TEST SUBROUTINES RFFTI,RFFTF AND RFFTB
C
         CALL RFFTI (N,W)
         PI = 3.14159265358979
         DT = (PI+PI)/FN
         NS2 = (N+1)/2
         IF (NS2 .LT. 2) GO TO 104
         DO 103 K=2,NS2
            SUM1 = 0.
            SUM2 = 0.
            ARG = FLOAT(K-1)*DT
            DO 102 I=1,N
               ARG1 = FLOAT(I-1)*ARG
               SUM1 = SUM1+X(I)*COS(ARG1)
               SUM2 = SUM2+X(I)*SIN(ARG1)
  102       CONTINUE
            Y(2*K-2) = SUM1
            Y(2*K-1) = -SUM2
  103    CONTINUE
  104    SUM1 = 0.
         SUM2 = 0.
         DO 105 I=1,NM1,2
            SUM1 = SUM1+X(I)
            SUM2 = SUM2+X(I+1)
  105    CONTINUE
         IF (MODN .EQ. 1) SUM1 = SUM1+X(N)
         Y(1) = SUM1+SUM2
         IF (MODN .EQ. 0) Y(N) = SUM1-SUM2
         CALL RFFTF (N,X,W)
         RFTF = 0.
         DO 106 I=1,N
            RFTF = AMAX1(RFTF,ABS(X(I)-Y(I)))
            X(I) = XH(I)
  106    CONTINUE
         RFTF = RFTF/FN
         DO 109 I=1,N
            SUM = .5*X(1)
            ARG = FLOAT(I-1)*DT
            IF (NS2 .LT. 2) GO TO 108
            DO 107 K=2,NS2
               ARG1 = FLOAT(K-1)*ARG
               SUM = SUM+X(2*K-2)*COS(ARG1)-X(2*K-1)*SIN(ARG1)
  107       CONTINUE
  108       IF (MODN .EQ. 0) SUM = SUM+.5*FLOAT((-1)**(I-1))*X(N)
            Y(I) = SUM+SUM
  109    CONTINUE
         CALL RFFTB (N,X,W)
         RFTB = 0.
         DO 110 I=1,N
            RFTB = AMAX1(RFTB,ABS(X(I)-Y(I)))
            X(I) = XH(I)
            Y(I) = XH(I)
  110    CONTINUE
         CALL RFFTB (N,Y,W)
         CALL RFFTF (N,Y,W)
         CF = 1./FN
         RFTFB = 0.
         DO 111 I=1,N
            RFTFB = AMAX1(RFTFB,ABS(CF*Y(I)-X(I)))
  111    CONTINUE
C
C     TEST SUBROUTINES SINTI AND SINT
C
         DT = PI/FN
         DO 112 I=1,NM1
            X(I) = XH(I)
  112    CONTINUE
         DO 114 I=1,NM1
            Y(I) = 0.
            ARG1 = FLOAT(I)*DT
            DO 113 K=1,NM1
               Y(I) = Y(I)+X(K)*SIN(FLOAT(K)*ARG1)
  113       CONTINUE
            Y(I) = Y(I)+Y(I)
  114    CONTINUE
         CALL SINTI (NM1,W)
         CALL SINT (NM1,X,W)
         CF = .5/FN
         SINTT = 0.
         DO 115 I=1,NM1
            SINTT = AMAX1(SINTT,ABS(X(I)-Y(I)))
            X(I) = XH(I)
            Y(I) = X(I)
  115    CONTINUE
         SINTT = CF*SINTT
         CALL SINT (NM1,X,W)
         CALL SINT (NM1,X,W)
         SINTFB = 0.
         DO 116 I=1,NM1
            SINTFB = AMAX1(SINTFB,ABS(CF*X(I)-Y(I)))
  116    CONTINUE
C
C     TEST SUBROUTINES COSTI AND COST
C
         DO 117 I=1,NP1
            X(I) = XH(I)
  117    CONTINUE
         DO 119 I=1,NP1
            Y(I) = .5*(X(1)+FLOAT((-1)**(I+1))*X(N+1))
            ARG = FLOAT(I-1)*DT
            DO 118 K=2,N
               Y(I) = Y(I)+X(K)*COS(FLOAT(K-1)*ARG)
  118       CONTINUE
            Y(I) = Y(I)+Y(I)
  119    CONTINUE
         CALL COSTI (NP1,W)
         CALL COST (NP1,X,W)
         COSTT = 0.
         DO 120 I=1,NP1
            COSTT = AMAX1(COSTT,ABS(X(I)-Y(I)))
            X(I) = XH(I)
            Y(I) = XH(I)
  120    CONTINUE
         COSTT = CF*COSTT
         CALL COST (NP1,X,W)
         CALL COST (NP1,X,W)
         COSTFB = 0.
         DO 121 I=1,NP1
            COSTFB = AMAX1(COSTFB,ABS(CF*X(I)-Y(I)))
  121    CONTINUE
C
C     TEST SUBROUTINES SINQI,SINQF AND SINQB
C
         CF = .25/FN
         DO 122 I=1,N
            Y(I) = XH(I)
  122    CONTINUE
         DT = PI/(FN+FN)
         DO 124 I=1,N
            X(I) = 0.
            ARG = DT*FLOAT(I)
            DO 123 K=1,N
               X(I) = X(I)+Y(K)*SIN(FLOAT(K+K-1)*ARG)
  123       CONTINUE
            X(I) = 4.*X(I)
  124    CONTINUE
         CALL SINQI (N,W)
         CALL SINQB (N,Y,W)
         SINQBT = 0.
         DO 125 I=1,N
            SINQBT = AMAX1(SINQBT,ABS(Y(I)-X(I)))
            X(I) = XH(I)
  125    CONTINUE
         SINQBT = CF*SINQBT
         DO 127 I=1,N
            ARG = FLOAT(I+I-1)*DT
            Y(I) = .5*FLOAT((-1)**(I+1))*X(N)
            DO 126 K=1,NM1
               Y(I) = Y(I)+X(K)*SIN(FLOAT(K)*ARG)
  126       CONTINUE
            Y(I) = Y(I)+Y(I)
  127    CONTINUE
         CALL SINQF (N,X,W)
         SINQFT = 0.
         DO 128 I=1,N
            SINQFT = AMAX1(SINQFT,ABS(X(I)-Y(I)))
            Y(I) = XH(I)
            X(I) = XH(I)
  128    CONTINUE
         CALL SINQF (N,Y,W)
         CALL SINQB (N,Y,W)
         SINQFB = 0.
         DO 129 I=1,N
            SINQFB = AMAX1(SINQFB,ABS(CF*Y(I)-X(I)))
  129    CONTINUE
C
C     TEST SUBROUTINES COSQI,COSQF AND COSQB
C
         DO 130 I=1,N
            Y(I) = XH(I)
  130    CONTINUE
         DO 132 I=1,N
            X(I) = 0.
            ARG = FLOAT(I-1)*DT
            DO 131 K=1,N
               X(I) = X(I)+Y(K)*COS(FLOAT(K+K-1)*ARG)
  131       CONTINUE
            X(I) = 4.*X(I)
  132    CONTINUE
         CALL COSQI (N,W)
         CALL COSQB (N,Y,W)
         COSQBT = 0.
         DO 133 I=1,N
            COSQBT = AMAX1(COSQBT,ABS(X(I)-Y(I)))
            X(I) = XH(I)
  133    CONTINUE
         COSQBT = CF*COSQBT
         DO 135 I=1,N
            Y(I) = .5*X(1)
            ARG = FLOAT(I+I-1)*DT
            DO 134 K=2,N
               Y(I) = Y(I)+X(K)*COS(FLOAT(K-1)*ARG)
  134       CONTINUE
            Y(I) = Y(I)+Y(I)
  135    CONTINUE
         CALL COSQF (N,X,W)
         COSQFT = 0.
         DO 136 I=1,N
            COSQFT = AMAX1(COSQFT,ABS(Y(I)-X(I)))
            X(I) = XH(I)
            Y(I) = XH(I)
  136    CONTINUE
         COSQFT = CF*COSQFT
         CALL COSQB (N,X,W)
         CALL COSQF (N,X,W)
         COSQFB = 0.
         DO 137 I=1,N
            COSQFB = AMAX1(COSQFB,ABS(CF*X(I)-Y(I)))
  137    CONTINUE
C
C     TEST PROGRAMS EZFFTI,EZFFTF,EZFFTB
C
         CALL EZFFTI(N,W)
         DO 138 I=1,N
            X(I) = XH(I)
  138    CONTINUE
         TPI = 8.*ATAN(1.)
         DT = TPI/FLOAT(N)
         NS2 = (N+1)/2
         CF = 2./FLOAT(N)
         NS2M = NS2-1
         IF (NS2M .LE. 0) GO TO 141
         DO 140 K=1,NS2M
            SUM1 = 0.
            SUM2 = 0.
            ARG = FLOAT(K)*DT
            DO 139 I=1,N
               ARG1 = FLOAT(I-1)*ARG
               SUM1 = SUM1+X(I)*COS(ARG1)
               SUM2 = SUM2+X(I)*SIN(ARG1)
  139       CONTINUE
            A(K) = CF*SUM1
            B(K) = CF*SUM2
  140    CONTINUE
  141    NM1 = N-1
         SUM1 = 0.
         SUM2 = 0.
         DO 142 I=1,NM1,2
            SUM1 = SUM1+X(I)
            SUM2 = SUM2+X(I+1)
  142    CONTINUE
         IF (MODN .EQ. 1) SUM1 = SUM1+X(N)
         AZERO = .5*CF*(SUM1+SUM2)
         IF (MODN .EQ. 0) A(NS2) = .5*CF*(SUM1-SUM2)
         CALL EZFFTF (N,X,AZEROH,AH,BH,W)
         DEZF1 = ABS(AZEROH-AZERO)
         IF (MODN .EQ. 0) DEZF1 = AMAX1(DEZF1,ABS(A(NS2)-AH(NS2)))
         IF (NS2M .LE. 0) GO TO 144
         DO 143 I=1,NS2M
            DEZF1 = AMAX1(DEZF1,ABS(AH(I)-A(I)),ABS(BH(I)-B(I)))
  143    CONTINUE
  144    NS2 = N/2
         IF (MODN .EQ. 0) B(NS2) = 0.
         DO 146 I=1,N
            SUM = AZERO
            ARG1 = FLOAT(I-1)*DT
            DO 145 K=1,NS2
               ARG2 = FLOAT(K)*ARG1
               SUM = SUM+A(K)*COS(ARG2)+B(K)*SIN(ARG2)
  145       CONTINUE
            X(I) = SUM
  146    CONTINUE
         CALL EZFFTB (N,Y,AZERO,A,B,W)
         DEZB1 = 0.
         DO 147 I=1,N
            DEZB1 = AMAX1(DEZB1,ABS(X(I)-Y(I)))
            X(I) = XH(I)
  147    CONTINUE
         CALL EZFFTF (N,X,AZERO,A,B,W)
         CALL EZFFTB (N,Y,AZERO,A,B,W)
         DEZFB = 0.
         DO 148 I=1,N
            DEZFB = AMAX1(DEZFB,ABS(X(I)-Y(I)))
  148    CONTINUE
C
C     TEST  CFFTI,CFFTF,CFFTB
C
         DO 149 I=1,N
            CX(I) = CMPLX(COS(SQRT2*FLOAT(I)),SIN(SQRT2*FLOAT(I*I)))
  149    CONTINUE
         DT = (PI+PI)/FN
         DO 151 I=1,N
            ARG1 = -FLOAT(I-1)*DT
            CY(I) = (0.,0.)
            DO 150 K=1,N
               ARG2 = FLOAT(K-1)*ARG1
               CY(I) = CY(I)+CMPLX(COS(ARG2),SIN(ARG2))*CX(K)
  150       CONTINUE
  151    CONTINUE
         CALL CFFTI (N,W)
         CALL CFFTF (N,CX,W)
         DCFFTF = 0.
         DO 152 I=1,N
            DCFFTF = AMAX1(DCFFTF,CABS(CX(I)-CY(I)))
            CX(I) = CX(I)/FN
  152    CONTINUE
         DCFFTF = DCFFTF/FN
         DO 154 I=1,N
            ARG1 = FLOAT(I-1)*DT
            CY(I) = (0.,0.)
            DO 153 K=1,N
               ARG2 = FLOAT(K-1)*ARG1
               CY(I) = CY(I)+CMPLX(COS(ARG2),SIN(ARG2))*CX(K)
  153       CONTINUE
  154    CONTINUE
         CALL CFFTB (N,CX,W)
         DCFFTB = 0.
         DO 155 I=1,N
            DCFFTB = AMAX1(DCFFTB,CABS(CX(I)-CY(I)))
            CX(I) = CY(I)
  155    CONTINUE
         CF = 1./FN
         CALL CFFTF (N,CX,W)
         CALL CFFTB (N,CX,W)
         DCFB = 0.
         DO 156 I=1,N
            DCFB = AMAX1(DCFB,CABS(CF*CX(I)-CY(I)))
  156    CONTINUE
         WRITE (6,1001) N,RFTF,RFTB,RFTFB,SINTT,SINTFB,COSTT,COSTFB,
     1                  SINQFT,SINQBT,SINQFB,COSQFT,COSQBT,COSQFB,DEZF1,
     2                  DEZB1,DEZFB,DCFFTF,DCFFTB,DCFB
  157 CONTINUE
C
C
C
 1001 FORMAT (2H0N,I5,8H RFFTF  ,E10.3,8H RFFTB  ,E10.3,8H RFFTFB ,
     1        E10.3,8H SINT   ,E10.3,8H SINTFB ,E10.3,8H COST   ,E10.3/
     2        7X,8H COSTFB ,E10.3,8H SINQF  ,E10.3,8H SINQB  ,E10.3,
     3        8H SINQFB ,E10.3,8H COSQF  ,E10.3,8H COSQB  ,E10.3/7X,
     4        8H COSQFB ,E10.3,8H DEZF   ,E10.3,8H DEZB   ,E10.3,
     5        8H DEZFB  ,E10.3,8H CFFTF  ,E10.3,8H CFFTB  ,E10.3/
     6        7X,8H CFFTFB ,E10.3)
C
      END






Added c/geometry.c.
















































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/*
 * CRIMP :: Geometry Definitions (Implementation).
 * (C) 2010.
 */

/*
 * Import declarations.
 */

#include <geometry.h>
#include <linearalgebra.h>

/*
 * Definitions :: Core.
 */

void
crimp_geo_warp_point (crimp_image* matrix, double* x, double* y)
{
    double w = 1.0;
    crimp_la_multiply_matrix_3v (matrix, x, y, &w);

    *x = (*x) / w;
    *y = (*y) / w;
}

crimp_image*
crimp_geo_warp_init (crimp_image* input, crimp_image* forward, int* origx, int* origy)
{
    /*
     * Run the four corners of the input through the forward transformation to
     * get their locations, and use the results to determine dimensions of the
     * output image and the location of its origin point.
     *
     * NOTE: The input image may already come with origin point data. We have
     * to and are taking this into account when computing the input corners.
     */

    double xlu, xru, xld, xrd, left, right;
    double ylu, yru, yld, yrd, up, down;
    int ileft, iright, iup, idown, w, h, iorigx, iorigy, oc;
    Tcl_Obj* meta;
    Tcl_Obj* key1 = Tcl_NewStringObj ("crimp", -1);
    Tcl_Obj* key2 = Tcl_NewStringObj ("origin", -1);
    Tcl_Obj* cmeta;
    Tcl_Obj* corig;
    Tcl_Obj* orig [2];

    if (!input->meta ||
	(Tcl_DictObjGet(NULL, input->meta, key1, &cmeta) != TCL_OK) ||
	(Tcl_DictObjGet(NULL, cmeta, key2, &corig) != TCL_OK) ||
	(Tcl_ListObjGetElements(NULL, corig, &oc, &orig) != TCL_OK) ||
	(Tcl_GetIntFromObj(NULL,orig[0], &iorigx) != TCL_OK) ||
	(Tcl_GetIntFromObj(NULL,orig[1], &iorigy) != TCL_OK)) {
	iorigx = iorigy = 0;
    }

    xlu = - iorigx;
    ylu = - iorigy;
    crimp_geo_warp_point (forward, &xlu, &ylu);

    xru = - iorigx + input->w - 1;
    yru = - iorigy;
    crimp_geo_warp_point (forward, &xru, &yru);

    xld = - iorigx;
    yld = - iorigy + input->h - 1;
    crimp_geo_warp_point (forward, &xld, &yld);

    xrd = - iorigx + input->w - 1;
    yrd = - iorigy + input->h - 1;
    crimp_geo_warp_point (forward, &xrd, &yrd);

    left  = MIN (MIN (xlu,xld), MIN (xru,xrd));
    right = MAX (MAX (xlu,xld), MAX (xru,xrd));
    up    = MIN (MIN (ylu,yld), MIN (yru,yrd));
    down  = MAX (MAX (ylu,yld), MAX (yru,yrd));

    ileft  = left;  if (ileft  > left)  ileft --;
    iright = right; if (iright < right) iright ++;
    iup    = up;    if (iup    > up)    iup --;
    idown  = down;  if (idown  < down)  idown ++;

    w = iright - ileft + 1;
    h = idown  - iup   + 1;

    *origx = ileft;
    *origy = iup;

    orig [0] = Tcl_NewIntObj (ileft);
    orig [1] = Tcl_NewIntObj (iup);

    corig = Tcl_NewListObj (2, orig);
    cmeta = Tcl_NewDictObj (); Tcl_DictObjPut (NULL, cmeta, key2, corig);
    meta  = Tcl_NewDictObj (); Tcl_DictObjPut (NULL, meta,  key1, cmeta);

    return crimp_newm (input->itype, w, h, meta);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added c/geometry.h.

































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#ifndef CRIMP_GEOMETRY_H
#define CRIMP_GEOMETRY_H
/*
 * CRIMP :: Declarations for the functions handling points, vectors,
 * and matrices.
 * (C) 2010.
 */

#include <image.h>

/*
 * API :: Core. 
 */

extern void         crimp_geo_warp_point (crimp_image* matrix, double* x, double* y);
extern crimp_image* crimp_geo_warp_init  (crimp_image* input,
					  crimp_image* forward,
					  int* origx, int* origy);

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
#endif /* CRIMP_GEOMETRY_H */






Added c/image.c.







































































































































































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/*
 * CRIMP :: Image Definitions (Implementation).
 * (C) 2010.
 */

/*
 * Import declarations.
 */

#include <image.h>
#include <util.h>
#include <tcl.h>
#include <string.h>
#include <limits.h> /* HAVE_LIMITS_H check ? */

/*
 * Internal declarations.
 */

static void FreeImage     (Tcl_Obj* imgObjPtr);
static void DupImage      (Tcl_Obj* imgObjPtr,
			   Tcl_Obj* dupObjPtr);
static void StringOfImage (Tcl_Obj* imgObjPtr);
static int  ImageFromAny  (Tcl_Interp* interp,
			   Tcl_Obj* imgObjPtr);

static Tcl_ObjType ImageType = {
    "crimp::image",
    FreeImage,
    DupImage,
    StringOfImage,
    ImageFromAny
};

/*
 * Definitions :: Core.
 */

crimp_image*
crimp_new (const crimp_imagetype* itype, int w, int h)
{
    /*
     * Note: Pixel storage and header describing it are allocated together.
     */

    int          size  = sizeof (crimp_image) + w * h * itype->size;
    crimp_image* image = (crimp_image*) ckalloc (size);

    image->itype = itype;
    image->w     = w;
    image->h     = h;
    image->meta  = NULL;

    return image;
}

crimp_image*
crimp_newm (const crimp_imagetype* itype, int w, int h, Tcl_Obj* meta)
{
    /*
     * Note: Pixel storage and header describing it are allocated together.
     */

    int          size  = sizeof (crimp_image) + w * h * itype->size;
    crimp_image* image = (crimp_image*) ckalloc (size);

    image->itype = itype;
    image->w     = w;
    image->h     = h;
    image->meta  = meta;

    if (meta) {
	Tcl_IncrRefCount (meta);
    }

    return image;
}

crimp_image*
crimp_dup (crimp_image* image)
{
    int          size      = sizeof (crimp_image) + image->w * image->h * image->itype->size;
    crimp_image* new_image = (crimp_image*) ckalloc (size);

    /*
     * Remember the note in function 'crimp_new' above.
     * Pixel storage and header are a single block.
     */

    memcpy (new_image, image, size);
    if (image->meta) {
	Tcl_IncrRefCount (image->meta);
    }

    return new_image;
}

void
crimp_del (crimp_image* image)
{
    /*
     * Remember the note in function 'crimp_new' above.
     * Pixel storage and header are a single block.
     */

    if (image->meta) {
	Tcl_DecrRefCount (image->meta);
    }
    ckfree ((char*) image);
}

/*
 * Definitions :: Tcl.
 */

Tcl_Obj*
crimp_new_image_obj (crimp_image* image)
{
    Tcl_Obj* obj = Tcl_NewObj ();

    Tcl_InvalidateStringRep (obj);
    obj->internalRep.otherValuePtr = image;
    obj->typePtr                   = &ImageType;

    return obj;
}

int
crimp_get_image_from_obj (Tcl_Interp* interp, Tcl_Obj* imageObj, crimp_image** image)
{
    if (imageObj->typePtr != &ImageType) {
	if (ImageFromAny (interp, imageObj) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    *image = (crimp_image*) imageObj->internalRep.otherValuePtr;
    return TCL_OK;
}

/*
 * Definitions :: ObjType Internals.
 */

static void
FreeImage (Tcl_Obj* imgObjPtr)
{
    crimp_del ((crimp_image*) imgObjPtr->internalRep.otherValuePtr);
}

static void
DupImage (Tcl_Obj* imgObjPtr, Tcl_Obj* dupObjPtr)
{
    crimp_image* ci  = (crimp_image*) imgObjPtr->internalRep.otherValuePtr;

    dupObjPtr->internalRep.otherValuePtr = crimp_dup (ci);
    dupObjPtr->typePtr                   = &ImageType;
}

static void
StringOfImage (Tcl_Obj* imgObjPtr)
{
    crimp_image* ci  = (crimp_image*) imgObjPtr->internalRep.otherValuePtr;
    int length;
    Tcl_DString ds;

    Tcl_DStringInit (&ds);

    /* image type */
    Tcl_DStringAppendElement (&ds, ci->itype->name);

    /* image width */
    {
	char wstring [20];
	sprintf (wstring, "%u", ci->w);
	Tcl_DStringAppendElement (&ds, wstring);
    }

    /* image width */
    {
	char hstring [20];
	sprintf (hstring, "%u", ci->h);
	Tcl_DStringAppendElement (&ds, hstring);
    }

    /* image client data */
    if (ci->meta) {
	Tcl_DStringAppendElement (&ds, Tcl_GetString (ci->meta));
    } else {
	Tcl_DStringAppendElement (&ds, "");
    }

    /* image pixels */
    {
	/*
	 * Basic length of the various pieces going into the string, from type
	 * name, formatted width/height numbers, number of pixels.
	 */

	char* tmp;
	char* dst;
	int plen = ci->itype->size * ci->w * ci->h;
	int expanded, i;

	/*
	 * Now correct the length for the pixels. This is binary data, and the
	 * utf8 representation for 0 and anything >128 needs an additional
	 * byte each. Snarfed from UpdateStringOfByteArray in
	 * generic/tclBinary.c
	 */

	expanded = 0;
	for (i = 0; i < (ci->itype->size * ci->w * ci->h) && plen >= 0; i++) {
	    if ((ci->pixel[i] == 0) || (ci->pixel[i] > 127)) {
		plen ++;
		expanded = 1;
	    }
	}

	if (plen < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}

	/*
	 * We need the temporary array because ...AppendElement below expects
	 * a 0-terminated string, and the pixels aren't
	 */

	dst = tmp = NALLOC (plen+1, char);
	if (expanded) {
	    /*
	     * If bytes have to be expanded we have to handle them 1-by-1.
	     */
	    for (i = 0; i < (ci->itype->size * ci->w * ci->h); i++) {
		dst += Tcl_UniCharToUtf(ci->pixel[i], dst);
	    }
	} else {
	    /*
	     * All bytes are represented by single chars. We can copy them as a
	     * block.
	     */
	    memcpy(dst, ci->pixel, (size_t) plen);
	    dst += plen;
	}
	*dst = '\0';

	/*
	 * Note that this adds another layer of quoting to the string:
	 * list quoting.
	 */
	Tcl_DStringAppendElement (&ds, tmp);
	ckfree (tmp);
    }

    length = Tcl_DStringLength (&ds);

    imgObjPtr->bytes  = NALLOC (length+1, char);
    imgObjPtr->length = length;

    memcpy (imgObjPtr->bytes, Tcl_DStringValue (&ds), length+1);

    Tcl_DStringFree (&ds);
}

static int
ImageFromAny (Tcl_Interp* interp, Tcl_Obj* imgObjPtr)
{
    int       objc;
    Tcl_Obj **objv;
    int w, h, length;
    crimp_pixel_array pixel;
    crimp_image* ci;
    crimp_imagetype* ct;
    Tcl_Obj* meta;

    if (Tcl_ListObjGetElements(interp, imgObjPtr, &objc, &objv) != TCL_OK) {
	return TCL_ERROR;
    }

    if (objc != 5) {
    invalid:
	Tcl_SetResult(interp, "invalid image format", TCL_STATIC);
	return TCL_ERROR;
    }

    if ((crimp_get_imagetype_from_obj (interp, objv[0], &ct) != TCL_OK) ||
        (Tcl_GetIntFromObj            (interp, objv[1], &w) != TCL_OK) ||
	(Tcl_GetIntFromObj            (interp, objv[2], &h) != TCL_OK) ||
	(w < 0) || (h < 0))
	goto invalid;

    pixel = Tcl_GetByteArrayFromObj (objv[4], &length);
    if (length != (ct->size * w * h))
	goto invalid;

    meta = objv[3];

    ci = crimp_newm (ct, w, h, meta);
    memcpy(ci->pixel, pixel, length);

    /*
     * Kill the old intrep. This was delayed as much as possible.
     */

    FreeIntRep (imgObjPtr);

    /*
     * Now we can put in our own intrep.
     */

    imgObjPtr->internalRep.otherValuePtr = ci;
    imgObjPtr->typePtr                   = &ImageType;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added c/image.h.
































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#ifndef CRIMP_IMAGE_H
#define CRIMP_IMAGE_H
/*
 * CRIMP :: Image Declarations, and API.
 * (C) 2010.
 */

#include <image_type.h>
#include <util.h>

/*
 * Structures describing images.
 */

typedef unsigned char* crimp_pixel_array;

typedef struct crimp_image {
    Tcl_Obj*               meta;     /* Tcl level client data */
    const crimp_imagetype* itype;    /* Reference to type descriptor */
    int                    w;        /* Image dimension, width  */
    int                    h;        /* Image dimension, height */
    unsigned char          pixel[4]; /* Integrated pixel storage */
} crimp_image;

/*
 * Pixel Access Macros. General access to a 'color' channel.
 */

#define CHAN(iptr,c,x,y) ((c) + SZ(iptr) * ((x) + (y)*(iptr)->w))
#define CH(iptr,c,x,y) (iptr)->pixel [CHAN (iptr,c,x,y)]

/*
 * Pixel Access Macros. RGBA / RGB
 */

/*
 * Manually optimized, factored the pixelsize out of the summands. It
 * is not sure if this is faster (easier to optimize), or if we should
 * precompute the pitch (w*pixelsize), and have the pixel size mult
 * in each x ... As the pixel size is mostly 1, 2, 4, i.e. redundant
 * removed unity, or a power of 2, i.e handled as shift this should be
 * good enough. The only not so sure case is RGB, with pixel size of 3.
 */

#define SZ(iptr) ((iptr)->itype->size)

#define RED(iptr,x,y)   (0 + SZ(iptr) * ((x) + (y)*(iptr)->w))
#define GREEN(iptr,x,y) (1 + SZ(iptr) * ((x) + (y)*(iptr)->w))
#define BLUE(iptr,x,y)  (2 + SZ(iptr) * ((x) + (y)*(iptr)->w))
#define ALPHA(iptr,x,y) (3 + SZ(iptr) * ((x) + (y)*(iptr)->w))

#if 0 /* Unoptimized formulas */
#define RED(iptr,x,y)   (0 + ((x)*SZ (iptr)) + ((y)*SZ (iptr)*(iptr)->w))
#define GREEN(iptr,x,y) (1 + ((x)*SZ (iptr)) + ((y)*SZ (iptr)*(iptr)->w))
#define BLUE(iptr,x,y)  (2 + ((x)*SZ (iptr)) + ((y)*SZ (iptr)*(iptr)->w))
#define ALPHA(iptr,x,y) (3 + ((x)*SZ (iptr)) + ((y)*SZ (iptr)*(iptr)->w))
#endif

#define R(iptr,x,y) (iptr)->pixel [RED   (iptr,x,y)]
#define G(iptr,x,y) (iptr)->pixel [GREEN (iptr,x,y)]
#define B(iptr,x,y) (iptr)->pixel [BLUE  (iptr,x,y)]
#define A(iptr,x,y) (iptr)->pixel [ALPHA (iptr,x,y)]

/*
 * Pixel Access Macros. GREY8, GREY16, GREY32, FLOATP.
 *
 * NOTE: The casts should use standard types where we we know the size in
 *       bytes exactly, by definition.
 */

#define INDEX(iptr,x,y) \
    (((x)*SZ (iptr)) + \
     ((y)*SZ (iptr)*((iptr)->w)))

#define GREY8(iptr,x,y)                        (iptr)->pixel [INDEX (iptr,x,y)]
#define GREY16(iptr,x,y) *((unsigned short*) &((iptr)->pixel [INDEX (iptr,x,y)]))
#define GREY32(iptr,x,y) *((unsigned long*)  &((iptr)->pixel [INDEX (iptr,x,y)]))
#define FLOATP(iptr,x,y) *((float*)          &((iptr)->pixel [INDEX (iptr,x,y)]))

/*
 * Pixel as 2-complement numbers (-128..127, instead of unsigned 0..255).
 */

#define SGREY8(iptr,x,y) *((signed char*)  &((iptr)->pixel [INDEX (iptr,x,y)]))

/*
 * Pixel Access Macros. HSV.
 */

#define HUE(iptr,x,y) (0 + SZ(iptr) * ((x) + (y)*(iptr)->w))
#define SAT(iptr,x,y) (1 + SZ(iptr) * ((x) + (y)*(iptr)->w))
#define VAL(iptr,x,y) (2 + SZ(iptr) * ((x) + (y)*(iptr)->w))

#define H(iptr,x,y) (iptr)->pixel [HUE (iptr,x,y)]
#define S(iptr,x,y) (iptr)->pixel [SAT (iptr,x,y)]
#define V(iptr,x,y) (iptr)->pixel [VAL (iptr,x,y)]

/*
 * Other constants
 */

#define BLACK 0
#define WHITE 255

#define OPAQUE      255
#define TRANSPARENT 0

/*
 * Convenient checking of image types.
 */

#define ASSERT_IMGTYPE(image,imtype) \
    ASSERT ((image)->itype == crimp_imagetype_find ("crimp::image::" STR(imtype)), \
	    "expected image type " STR(imtype))

#define ASSERT_NOTIMGTYPE(image,imtype) \
    ASSERT ((image)->itype != crimp_imagetype_find ("crimp::image::" STR(imtype)), \
	    "unexpected image type " STR(imtype))

/*
 * API :: Core. Image lifecycle management.
 */

extern crimp_image* crimp_new  (const crimp_imagetype* type, int w, int h);
extern crimp_image* crimp_newm (const crimp_imagetype* type, int w, int h, Tcl_Obj* meta);
extern crimp_image* crimp_dup  (crimp_image* image);
extern void         crimp_del  (crimp_image* image);

#define crimp_new_hsv(w,h)    (crimp_new (crimp_imagetype_find ("crimp::image::hsv"),    (w), (h)))
#define crimp_new_rgba(w,h)   (crimp_new (crimp_imagetype_find ("crimp::image::rgba"),   (w), (h)))
#define crimp_new_rgb(w,h)    (crimp_new (crimp_imagetype_find ("crimp::image::rgb"),    (w), (h)))
#define crimp_new_grey8(w,h)  (crimp_new (crimp_imagetype_find ("crimp::image::grey8"),  (w), (h)))
#define crimp_new_grey16(w,h) (crimp_new (crimp_imagetype_find ("crimp::image::grey16"), (w), (h)))
#define crimp_new_grey32(w,h) (crimp_new (crimp_imagetype_find ("crimp::image::grey32"), (w), (h)))
#define crimp_new_float(w,h)  (crimp_new (crimp_imagetype_find ("crimp::image::float"),  (w), (h)))

#define crimp_new_like(image)           (crimp_newm ((image)->itype, (image)->w, (image)->h, (image)->meta))
#define crimp_new_like_transpose(image) (crimp_newm ((image)->itype, (image)->h, (image)->w, (image)->meta))

/*
 * API :: Tcl. Manage Tcl_Obj's of images.
 */

extern Tcl_Obj* crimp_new_image_obj      (crimp_image*  image);
extern int      crimp_get_image_from_obj (Tcl_Interp*   interp,
					  Tcl_Obj*      imageObj,
					  crimp_image** image);

#define crimp_input(objvar,imagevar,itype) \
    if (crimp_get_image_from_obj (interp, (objvar), &(imagevar)) != TCL_OK) { \
	return TCL_ERROR; \
    } \
    ASSERT_IMGTYPE (imagevar, itype)

#define crimp_input_any(objvar,imagevar) \
    if (crimp_get_image_from_obj (interp, (objvar), &(imagevar)) != TCL_OK) { \
	return TCL_ERROR; \
    }

#define crimp_eq_dim(imagea,imageb) \
    (((imagea)->w == (imageb)->w) && ((imagea)->h == (imageb)->h))

#define crimp_eq_height(imagea,imageb) \
    ((imagea)->h == (imageb)->h)

#define crimp_eq_width(imagea,imageb) \
    ((imagea)->w == (imageb)->w)

#define crimp_require_dim(image,rw,rh)					\
    (((image)->w == (rw)) && ((image)->h == (rh)))

#define crimp_require_height(image,rh)					\
    ((image)->h == (rh))

#define crimp_require_width(image,rw)					\
    ((image)->w == (rw))


/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
#endif /* CRIMP_IMAGE_H */






Added c/image_type.c.
































































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/*
 * CRIMP :: Image Type Definitions (Implementation).
 * (C) 2010.
 */

/*
 * Import declarations.
 */

#include <image_type.h>
#include <util.h>
#include <tcl.h>
#include <string.h>

/*
 * Internal declarations.
 *
 * XXX Thread Local Storage. A list.
 * Should be sufficient for now
 * (Less than 10 types).
 */

typedef struct knowntype {
    const crimp_imagetype* type; /* The type to remember */
    struct knowntype*      next; /* Continue the list */
} knowntype;

static knowntype* knowntypes;

static void FreeImageType     (Tcl_Obj* imagetypeObjPtr);
static void DupImageType      (Tcl_Obj* imagetypeObjPtr,
			       Tcl_Obj* dupObjPtr);
static void StringOfImageType (Tcl_Obj* imagetypeObjPtr);
static int  ImageTypeFromAny  (Tcl_Interp* interp,
			       Tcl_Obj* imagetypeObjPtr);

static Tcl_ObjType ImageTypeType = {
    "crimp::imagetype",
    FreeImageType,
    DupImageType,
    StringOfImageType,
    ImageTypeFromAny
};


/*
 * Definitions :: Initialization
 */

void
crimp_imagetype_init (void)
{
    /*
     * Standard image types.
     */

    static const char*     rgba_cname [] = {"red", "green", "blue", "alpha"};
    static crimp_imagetype rgba = { "crimp::image::rgba", 4, 4, &rgba_cname };

    static const char*     rgb_cname [] =  {"red", "green", "blue"};
    static crimp_imagetype rgb = { "crimp::image::rgb", 3, 3, &rgb_cname };

    static const char*     hsv_cname [] = {"hue", "saturation", "value"};
    static crimp_imagetype hsv = { "crimp::image::hsv", 3, 3, &hsv_cname };

    static const char*     grey_cname [] = {"luma"};
    static crimp_imagetype grey8  = { "crimp::image::grey8",  1, 1, &grey_cname };
    static crimp_imagetype grey16 = { "crimp::image::grey16", 2, 1, &grey_cname };
    static crimp_imagetype grey32 = { "crimp::image::grey32", 4, 1, &grey_cname };

    static const char*     bw_cname [] = {"bw"};
    static crimp_imagetype bw = { "crimp::image::bw", 1, 1, &bw_cname };

    static const char*     fp_cname [] = {"value"};
    static crimp_imagetype fp = { "crimp::image::float", sizeof(float), 1, &fp_cname };

    static initialized = 0;

    if (initialized) return;
    initialized = 1;

    /*
     * Register most important last. Search is in reverse order of
     * registration.
     */

    crimp_imagetype_def (&bw);
    crimp_imagetype_def (&grey32);
    crimp_imagetype_def (&grey16);
    crimp_imagetype_def (&fp);
    crimp_imagetype_def (&grey8);
    crimp_imagetype_def (&hsv);
    crimp_imagetype_def (&rgb);
    crimp_imagetype_def (&rgba);
}


/*
 * Definitions :: Core
 */

void
crimp_imagetype_def (const crimp_imagetype* imagetype)
{
    knowntype* kt = ALLOC (knowntype);
    kt->type   = imagetype;
    kt->next   = knowntypes;
    knowntypes = kt;
}

const crimp_imagetype*
crimp_imagetype_find (const char* name)
{
    knowntype* kt;

    for (kt = knowntypes; kt; kt = kt->next) {
	if (strcmp (name, kt->type->name) == 0) {
	    return kt->type;
	}
    }

    return NULL;
}

/*
 * Definitions :: Tcl.
 */

Tcl_Obj*
crimp_new_imagetype_obj (const crimp_imagetype* imagetype)
{
    Tcl_Obj* obj = Tcl_NewObj ();

    Tcl_InvalidateStringRep (obj);
    obj->internalRep.otherValuePtr = (crimp_imagetype*) imagetype;
    obj->typePtr                   = &ImageTypeType;

    return obj;
}

int
crimp_get_imagetype_from_obj (Tcl_Interp*       interp,
			      Tcl_Obj*          imagetypeObj,
			      crimp_imagetype** imagetype)
{
    if (imagetypeObj->typePtr != &ImageTypeType) {
	if (ImageTypeFromAny (interp, imagetypeObj) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    *imagetype = (crimp_imagetype*) imagetypeObj->internalRep.otherValuePtr;
    return TCL_OK;
}

/*
 * Definitions :: ObjType Internals.
 */

static void
FreeImageType (Tcl_Obj* imagetypeObjPtr)
{
    /*
     * Nothing needs to be done, the intrep is not allocated
     */
}

static void
DupImageType (Tcl_Obj* imagetypeObjPtr,
	      Tcl_Obj* dupObjPtr)
{
    crimp_imagetype* cit = (crimp_imagetype*) imagetypeObjPtr->internalRep.otherValuePtr;

    dupObjPtr->internalRep.otherValuePtr = cit;
    dupObjPtr->typePtr                   = &ImageTypeType;
}

static void
StringOfImageType (Tcl_Obj* imagetypeObjPtr)
{
    crimp_imagetype* cit = (crimp_imagetype*) imagetypeObjPtr->internalRep.otherValuePtr;
    int              len = strlen (cit->name);

    imagetypeObjPtr->length = len;
    imagetypeObjPtr->bytes  = NALLOC (len+1,char);
    strcpy (imagetypeObjPtr->bytes, cit->name);
}

static int
ImageTypeFromAny (Tcl_Interp* interp,
		  Tcl_Obj* imagetypeObjPtr)
{
    const char*            name = Tcl_GetString (imagetypeObjPtr);
    const crimp_imagetype* cit  = crimp_imagetype_find (name);

    if (!cit) {
	Tcl_AppendResult (interp, "expected crimp image type, got \"", name, "\"", NULL);
	return TCL_ERROR;
    }

    /*
     * Kill the old intrep. This was delayed as much as possible.
     */

    FreeIntRep (imagetypeObjPtr);

    imagetypeObjPtr->internalRep.otherValuePtr = (crimp_imagetype*) cit;
    imagetypeObjPtr->typePtr                   = &ImageTypeType;
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added c/image_type.h.


























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#ifndef CRIMP_IMAGE_TYPE_H
#define CRIMP_IMAGE_TYPE_H
/*
 * CRIMP :: Image Type Declarations, and API.
 * (C) 2010.
 */

#include <tcl.h>

/*
 * Structures describing crimp image types. They are identified by
 * name. Stored information is the size of a pixel in bytes for all
 * images of that type.
 */

typedef struct crimp_imagetype {
    const char*  name;     /* Image type code     */
    int          size;     /* Pixel size in bytes */
    int          channels; /* Number of 'color' channels */
    const char** cname;    /* Names of the color channels */
} crimp_imagetype;

/*
 * API :: Initialization.
 */

extern void crimp_imagetype_init (void);

/*
 * API :: Core. Manage a mapping of types to names.
 */

extern void                   crimp_imagetype_def  (const crimp_imagetype* imagetype);
extern const crimp_imagetype* crimp_imagetype_find (const char* name);

/*
 * API :: Tcl. Manage Tcl_Obj's references to crimp image types.
 */

extern Tcl_Obj* crimp_new_imagetype_obj      (const crimp_imagetype*  imagetype);
extern int      crimp_get_imagetype_from_obj (Tcl_Interp*       interp,
					      Tcl_Obj*          imagetypeObj,
					      crimp_imagetype** imagetype);

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
#endif /* CRIMP_IMAGE_TYPE_H */






Added c/linearalgebra.c.


























































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/*
 * CRIMP :: Linear algebra Definitions (Implementation).
 * (C) 2010.
 */

/*
 * Import declarations.
 */

#include <linearalgebra.h>

/*
 * Definitions :: Core.
 */

crimp_image*
crimp_la_invert_matrix_3x3 (crimp_image* matrix)
{
    crimp_image* result;
    int x, y;
    double cofactor [3][3];
    double det  = 0;
    double sign = 1;

    ASSERT_IMGTYPE (matrix, float);
    ASSERT (crimp_require_dim(matrix, 3, 3),"Unable to invert matrix, not 3x3");

    result = crimp_new_float (3, 3);

    for (y = 0; y < 3; y++) {
	int y1 = !y;
	int y2 = 2 - !(y - 2);

	for (x = 0; x < 3; x++) {
	    int x1 = !x;
	    int x2 = 2 - !(x - 2);

	    cofactor[y][x] = sign * ((FLOATP (matrix, x1, y1) * FLOATP (matrix, x2, y2)) -
				     (FLOATP (matrix, x2, y1) * FLOATP (matrix, x1, y2)));
	    sign = -sign;
	}

	det += FLOATP (matrix, 0, y) * cofactor[y][0];
    }

    if (det == 0) {
	return NULL;
    }

    for (y = 0; y < 3; y++) {
	for (x = 0; x < 3; x++) {

	    FLOATP (result, x, y) = cofactor[x][y] / det;
	}
    }

    return result;
}

crimp_image*
crimp_la_multiply_matrix (crimp_image* a, crimp_image* b)
{
    crimp_image* result;
    int x, y, w;

    ASSERT_IMGTYPE (a, float);
    ASSERT_IMGTYPE (b, float);
    ASSERT (crimp_require_height(a, b->w),"Unable to multiply matrices, size mismatch");
    ASSERT (crimp_require_height(b, a->w),"Unable to multiply matrices, size mismatch");

    result = crimp_new_float (a->h, a->h);

    for (y = 0; y < a->h; y++) {
	for (x = 0; x < a->h; x++) {

	    FLOATP (result, x, y) = 0;
	    for (w = 0; w < a->w; w++) {
		FLOATP (result, x, y) += FLOATP (a, w, y) * FLOATP (b, x, w);
	    }
	}
    }

    return result;
}

crimp_image*
crimp_la_multiply_matrix_3x3 (crimp_image* a, crimp_image* b)
{
    crimp_image* result;
    int x, y, w;

    ASSERT_IMGTYPE (a, float);
    ASSERT_IMGTYPE (b, float);
    ASSERT (crimp_require_dim(a, 3,3),"Unable to multiply matrices, 3x3 expected");
    ASSERT (crimp_require_dim(b, 3,3),"Unable to multiply matrices, 3x3 expected");

    result = crimp_new_float (3, 3);

    /*
     * Unrolled scalar products, no loops whatsoever. This is possible only
     * because we know the size, and the size is small.
     */

#define SP3(r,x,y) FLOATP (r, x, y) = FLOATP (a,0,y) * FLOATP (b,x,0) + FLOATP (a,1,y) * FLOATP (b,x,1) + FLOATP (a,2,y) * FLOATP (b,x,2)

    SP3 (result, 0, 0);
    SP3 (result, 0, 1);
    SP3 (result, 0, 2);
    SP3 (result, 1, 0);
    SP3 (result, 1, 1);
    SP3 (result, 1, 2);
    SP3 (result, 2, 0);
    SP3 (result, 2, 1);
    SP3 (result, 2, 2);

    return result;
}

void
crimp_la_multiply_matrix_3v (crimp_image* matrix, double* x, double* y, double* w)
{
    /*
     * Inlined multiplication of matrix and vector
     */

    double xo = (*x) * FLOATP (matrix, 0, 0) + (*y) * FLOATP (matrix, 1, 0) + (*w) * FLOATP (matrix, 2, 0);
    double yo = (*x) * FLOATP (matrix, 0, 1) + (*y) * FLOATP (matrix, 1, 1) + (*w) * FLOATP (matrix, 2, 1);
    double wo = (*x) * FLOATP (matrix, 0, 2) + (*y) * FLOATP (matrix, 1, 2) + (*w) * FLOATP (matrix, 2, 2);

    *x = xo;
    *y = yo;
    *w = wo;
}

double
crimp_la_scalar_multiply3 (double* xa, double* ya, double* wa,
			   double* xb, double* yb, double* wb)
{
    return (*xa)*(*xb) + (*ya)*(*yb) + (*wa)*(*wb);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added c/linearalgebra.h.















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#ifndef CRIMP_LINEARALGEBRA_H
#define CRIMP_LINEARALGEBRA_H
/*
 * CRIMP :: Declarations for structures and functions for matrics and vectors.
 * (C) 2010.
 */

/*
 * Requirements. We represent matrices and vectors (which are 1xN, Nx1
 * matrices) as images, of type float. No need to invent additional
 * structures, as these will serve very well.
 */

#include <image.h>

/*
 * API :: Core. 
 */

extern crimp_image* crimp_la_invert_matrix_3x3   (crimp_image* matrix);
extern crimp_image* crimp_la_multiply_matrix     (crimp_image* a, crimp_image* b);
extern crimp_image* crimp_la_multiply_matrix_3x3 (crimp_image* a, crimp_image* b);

/*
 * For convenience, and memory efficiency. Matrix/Vector multiplication
 * without allocating a transient image for the vector.
 */

extern void   crimp_la_multiply_matrix_3v (crimp_image* matrix, double* x, double* y, double* w);
extern double crimp_la_scalar_multiply3   (double* xa, double* ya, double* wa,
					   double* xb, double* yb, double* wb);


/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
#endif /* CRIMP_LINEARALGEBRA_H */






Added c/rank.c.










































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/*
 * CRIMP :: Rank Definitions (Implementation).
 * (C) 2010.
 */

/*
 * Import declarations.
 */

#include <rank.h>

/*
 * Definitions :: Core.
 */

int
crimp_rank (int histogram [256], int percentile, int max)
{
    int k, sum, cut;

    cut = (max*percentile)/10000;

    for (k = 0, sum = 0; k < 256; k++) {
	sum += histogram [k];
	if (sum > cut) { return k; }
    }
    return 255;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added c/rank.h.




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#ifndef CRIMP_RANK_H
#define CRIMP_RANK_H
/*
 * CRIMP :: Declarations for rank search in histograms.
 * (C) 2010.
 */

/*
 * API :: Core. 
 */

extern int crimp_rank (int histogram [256], int percentile, int max);


/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
#endif /* CRIMP_RANK_H */






Added c/util.h.



































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#ifndef CRIMP_UTIL_H
#define CRIMP_UTIL_H
/*
 * CRIMP :: Utility Declarations.
 * (C) 2010.
 */

/*
 * Convenience macros for the allocation of structures and arrays.
 */

#define DUPSTR(str)    ((char *) strcpy (ckalloc (strlen (str)+1), str))
#define DUP(p,type)    ((type *) memcpy (ALLOC (type), p, sizeof (type)))
#define ALLOC(type)    ((type *) ckalloc (sizeof (type)))
#define NALLOC(n,type) ((type *) ckalloc ((n) * sizeof (type)))

#define FreeIntRep(objPtr) \
    if ((objPtr)->typePtr != NULL && \
	    (objPtr)->typePtr->freeIntRepProc != NULL) { \
	(objPtr)->typePtr->freeIntRepProc(objPtr); \
	(objPtr)->typePtr = NULL; \
    }

/*
 * General math support.
 */

#define MIN(a, b) ((a) < (b) ? (a) : (b))
#define MAX(a, b) ((a) > (b) ? (a) : (b))
#define CLAMP(min, v, max) ((v) < (min) ? (min) : (v) < (max) ? (v) : (max))
#define CLAMPT(min, t, v, max) ((v) < (min) ? (min) : (v) < (max) ? ((t) (v)) : (max))

#define RANGEOK(i,n) ((0 <= (i)) && (i < (n)))

/*
 * Assertions support in general, and asserting the proper range of an array
 * index especially.
 */

#undef  CRIMP_DEBUG
#define CRIMP_DEBUG 1

#ifdef CRIMP_DEBUG
#define XSTR(x) #x
#define STR(x) XSTR(x)
#define ASSERT(x,msg) if (!(x)) { Tcl_Panic (msg " (" #x "), in file " __FILE__ " @line " STR(__LINE__));}
#define ASSERT_BOUNDS(i,n) ASSERT (RANGEOK(i,n),"array index out of bounds: " STR(i) " > " STR(n))
#else
#define ASSERT(x,msg)
#define ASSERT_BOUNDS(i,n)
#endif


/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
#endif /* CRIMP_UTIL_H */






Added c/volume.c.



















































































































































































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/*
 * CRIMP :: Volume Definitions (Implementation).
 * (C) 2010.
 */

/*
 * Import declarations.
 */

#include <volume.h>
#include <image.h>
#include <util.h>
#include <tcl.h>
#include <string.h>
#include <limits.h> /* HAVE_LIMITS_H check ? */

/*
 * Internal declarations.
 */

static void FreeVolume     (Tcl_Obj* volObjPtr);
static void DupVolume      (Tcl_Obj* volObjPtr,
			    Tcl_Obj* dupObjPtr);
static void StringOfVolume (Tcl_Obj* volObjPtr);
static int  VolumeFromAny  (Tcl_Interp* interp,
			    Tcl_Obj* volObjPtr);

static Tcl_ObjType VolumeType = {
    "crimp::volume",
    FreeVolume,
    DupVolume,
    StringOfVolume,
    VolumeFromAny
};

/*
 * Definitions :: Core.
 */

crimp_volume*
crimp_vnew (const crimp_imagetype* itype, int w, int h, int d)
{
    /*
     * Note: Pixel storage and header describing it are allocated together.
     */

    int           size  = sizeof (crimp_volume) + w * h * d * itype->size;
    crimp_volume* volume = (crimp_volume*) ckalloc (size);

    volume->itype = itype;
    volume->w     = w;
    volume->h     = h;
    volume->d     = d;
    volume->meta  = NULL;

    return volume;
}

crimp_volume*
crimp_vnewm (const crimp_imagetype* itype, int w, int h, int d, Tcl_Obj* meta)
{
    /*
     * Note: Pixel storage and header describing it are allocated together.
     */

    int           size   = sizeof (crimp_volume) + w * h * d * itype->size;
    crimp_volume* volume = (crimp_volume*) ckalloc (size);

    volume->itype = itype;
    volume->w     = w;
    volume->h     = h;
    volume->d     = d;
    volume->meta  = meta;

    if (meta) {
	Tcl_IncrRefCount (meta);
    }

    return volume;
}

crimp_volume*
crimp_vdup (crimp_volume* volume)
{
    int           size      = sizeof (crimp_volume) + volume->w * volume->h * volume->d * volume->itype->size;
    crimp_volume* new_volume = (crimp_volume*) ckalloc (size);

    /*
     * Remember the note in function 'crimp_new' above.
     * Pixel storage and header are a single block.
     */

    memcpy (new_volume, volume, size);
    if (volume->meta) {
	Tcl_IncrRefCount (volume->meta);
    }

    return new_volume;
}

void
crimp_vdel (crimp_volume* volume)
{
    /*
     * Remember the note in function 'crimp_new' above.
     * Pixel storage and header are a single block.
     */

    if (volume->meta) {
	Tcl_DecrRefCount (volume->meta);
    }
    ckfree ((char*) volume);
}

/*
 * Definitions :: Tcl.
 */

Tcl_Obj*
crimp_new_volume_obj (crimp_volume* volume)
{
    Tcl_Obj* obj = Tcl_NewObj ();

    Tcl_InvalidateStringRep (obj);
    obj->internalRep.otherValuePtr = volume;
    obj->typePtr                   = &VolumeType;

    return obj;
}

int
crimp_get_volume_from_obj (Tcl_Interp* interp, Tcl_Obj* volumeObj, crimp_volume** volume)
{
    if (volumeObj->typePtr != &VolumeType) {
	if (VolumeFromAny (interp, volumeObj) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    *volume = (crimp_volume*) volumeObj->internalRep.otherValuePtr;
    return TCL_OK;
}

/*
 * Definitions :: ObjType Internals.
 */

static void
FreeVolume (Tcl_Obj* volObjPtr)
{
    crimp_vdel ((crimp_volume*) volObjPtr->internalRep.otherValuePtr);
}

static void
DupVolume (Tcl_Obj* volObjPtr, Tcl_Obj* dupObjPtr)
{
    crimp_volume* cv  = (crimp_volume*) volObjPtr->internalRep.otherValuePtr;

    dupObjPtr->internalRep.otherValuePtr = crimp_vdup (cv);
    dupObjPtr->typePtr                   = &VolumeType;
}

static void
StringOfVolume (Tcl_Obj* volObjPtr)
{
    crimp_volume* cv  = (crimp_volume*) volObjPtr->internalRep.otherValuePtr;
    int length;
    Tcl_DString ds;

    Tcl_DStringInit (&ds);

    /* volume type */
    Tcl_DStringAppendElement (&ds, cv->itype->name);

    /* volume width */
    {
	char wstring [20];
	sprintf (wstring, "%u", cv->w);
	Tcl_DStringAppendElement (&ds, wstring);
    }

    /* volume height */
    {
	char hstring [20];
	sprintf (hstring, "%u", cv->h);
	Tcl_DStringAppendElement (&ds, hstring);
    }

    /* volume depth */
    {
	char dstring [20];
	sprintf (dstring, "%u", cv->d);
	Tcl_DStringAppendElement (&ds, dstring);
    }

    /* volume client data */
    if (cv->meta) {
	Tcl_DStringAppendElement (&ds, Tcl_GetString (cv->meta));
    } else {
	Tcl_DStringAppendElement (&ds, "");
    }

    /* volume voxels */
    {
	/*
	 * Basic length of the various pieces going into the string, from type
	 * name, formatted width/height numbers, number of voxels.
	 */

	char* tmp;
	char* dst;
	int sz = cv->itype->size * cv->w * cv->h * cv->d;
	int plen = sz;
	int expanded, i;

	/*
	 * Now correct the length for the voxels. This is binary data, and the
	 * utf8 representation for 0 and anything >128 needs an additional
	 * byte each. Snarfed from UpdateStringOfByteArray in
	 * generic/tclBinary.c
	 */

	expanded = 0;
	for (i = 0; i < sz && plen >= 0; i++) {
	    if ((cv->voxel[i] == 0) || (cv->voxel[i] > 127)) {
		plen ++;
		expanded = 1;
	    }
	}

	if (plen < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}

	/*
	 * We need the temporary array because ...AppendElement below expects
	 * a 0-terminated string, and the voxels aren't
	 */

	dst = tmp = NALLOC (plen+1, char);
	if (expanded) {
	    /*
	     * If bytes have to be expanded we have to handle them 1-by-1.
	     */
	    for (i = 0; i < sz; i++) {
		dst += Tcl_UniCharToUtf(cv->voxel[i], dst);
	    }
	} else {
	    /*
	     * All bytes are represented by single chars. We can copy them as a
	     * block.
	     */
	    memcpy(dst, cv->voxel, (size_t) plen);
	    dst += plen;
	}
	*dst = '\0';

	/*
	 * Note that this adds another layer of quoting to the string:
	 * list quoting.
	 */
	Tcl_DStringAppendElement (&ds, tmp);
	ckfree (tmp);
    }

    length = Tcl_DStringLength (&ds);

    volObjPtr->bytes  = NALLOC (length+1, char);
    volObjPtr->length = length;

    memcpy (volObjPtr->bytes, Tcl_DStringValue (&ds), length+1);

    Tcl_DStringFree (&ds);
}

static int
VolumeFromAny (Tcl_Interp* interp, Tcl_Obj* volObjPtr)
{
    int       objc;
    Tcl_Obj **objv;
    int w, h, d, length;
    crimp_pixel_array voxel;
    crimp_volume* cv;
    crimp_imagetype* ct;
    Tcl_Obj* meta;

    if (Tcl_ListObjGetElements(interp, volObjPtr, &objc, &objv) != TCL_OK) {
	return TCL_ERROR;
    }

    if (objc != 6) {
    invalid:
	Tcl_SetResult(interp, "invalid volume format", TCL_STATIC);
	return TCL_ERROR;
    }

    if ((crimp_get_imagetype_from_obj (interp, objv[0], &ct) != TCL_OK) ||
        (Tcl_GetIntFromObj            (interp, objv[1], &w) != TCL_OK) ||
	(Tcl_GetIntFromObj            (interp, objv[2], &h) != TCL_OK) ||
	(Tcl_GetIntFromObj            (interp, objv[3], &d) != TCL_OK) ||
	(w < 0) || (h < 0))
	goto invalid;

    voxel = Tcl_GetByteArrayFromObj (objv[5], &length);
    if (length != (ct->size * w * h))
	goto invalid;

    meta = objv[4];

    cv = crimp_vnewm (ct, w, h, d, meta);
    memcpy(cv->voxel, voxel, length);

    /*
     * Kill the old intrep. This was delayed as much as possible.
     */

    FreeIntRep (volObjPtr);

    /*
     * Now we can put in our own intrep.
     */

    volObjPtr->internalRep.otherValuePtr = cv;
    volObjPtr->typePtr                   = &VolumeType;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added c/volume.h.


























































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#ifndef CRIMP_VOLUME_H
#define CRIMP_VOLUME_H
/*
 * CRIMP :: Volume Declarations, and API.
 * (C) 2010.
 */

#include <image_type.h>
#include <util.h>

/*
 * Structures describing volumes.
 */

typedef struct crimp_volume {
    Tcl_Obj*               meta;     /* Tcl level client data */
    const crimp_imagetype* itype;    /* Reference to type descriptor */
    int                    w;        /* Volume dimension, width  */
    int                    h;        /* Volume dimension, height */
    int                    d;        /* Volume dimension, depth */
    unsigned char          voxel[4]; /* Integrated voxel storage */
} crimp_volume;

/*
 * Voxel Access Macros.
 */

#define VINDEX(iptr,x,y,z) \
    (((x)*SZ (iptr)) + \
     ((y)*SZ (iptr)*((iptr)->w)) + \
     ((z)*SZ (iptr)*((iptr)->w)*((iptr)->h)))

#define VFLOATP(iptr,x,y,z) *((float*) &((iptr)->voxel [VINDEX (iptr,x,y,z)]))

/*
 * API :: Core. Volume lifecycle management.
 */

extern crimp_volume* crimp_vnew  (const crimp_imagetype* type, int w, int h, int d);
extern crimp_volume* crimp_vnewm (const crimp_imagetype* type, int w, int h, int d, Tcl_Obj* meta);
extern crimp_volume* crimp_vdup  (crimp_volume* volume);
extern void          crimp_vdel  (crimp_volume* volume);

#define crimp_vnew_hsv(w,h,d)    (crimp_vnew (crimp_imagetype_find ("crimp::image::hsv"),    (w), (h), (d)))
#define crimp_vnew_rgba(w,h,d)   (crimp_vnew (crimp_imagetype_find ("crimp::image::rgba"),   (w), (h), (d)))
#define crimp_vnew_rgb(w,h,d)    (crimp_vnew (crimp_imagetype_find ("crimp::image::rgb"),    (w), (h), (d)))
#define crimp_vnew_grey8(w,h,d)  (crimp_vnew (crimp_imagetype_find ("crimp::image::grey8"),  (w), (h), (d)))
#define crimp_vnew_grey16(w,h,d) (crimp_vnew (crimp_imagetype_find ("crimp::image::grey16"), (w), (h), (d)))
#define crimp_vnew_grey32(w,h,d) (crimp_vnew (crimp_imagetype_find ("crimp::image::grey32"), (w), (h), (d)))
#define crimp_vnew_float(w,h,d)  (crimp_vnew (crimp_imagetype_find ("crimp::image::float"),  (w), (h), (d)))

#define crimp_vnew_like(volume)           (crimp_vnewm ((volume)->itype, (volume)->w, (volume)->h, (volume)->d, (volume)->meta))
#define crimp_vnew_like_transpose(volume) (crimp_vnewm ((volume)->itype, (volume)->h, (volume)->w, (volume)->d, (volume)->meta))


/*
 * API :: Tcl. Manage Tcl_Obj's of volumes.
 */

extern Tcl_Obj* crimp_new_volume_obj      (crimp_volume*  volume);
extern int      crimp_get_volume_from_obj (Tcl_Interp*    interp,
					   Tcl_Obj*       volumeObj,
					   crimp_volume** volume);

#define crimp_vinput(objvar,volumevar,itype) \
    if (crimp_get_volume_from_obj (interp, (objvar), &(volumevar)) != TCL_OK) { \
	return TCL_ERROR; \
    } \
    ASSERT_IMGTYPE (volumevar, itype)

#define crimp_vinput_any(objvar,volumevar) \
    if (crimp_get_volume_from_obj (interp, (objvar), &(volumevar)) != TCL_OK) { \
	return TCL_ERROR; \
    }


/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
#endif /* CRIMP_VOLUME_H */






Deleted conformer.png.



cannot compute difference between binary files


Added cop/binop_float_float.c.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crimp_image*     result;
crimp_image*     imageA;
crimp_image*     imageB;
int x, y;

crimp_input (imageAObj, imageA, float);
crimp_input (imageBObj, imageB, float);

if (!crimp_eq_dim (imageA, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageA);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = BINOP (FLOATP (imageA, x, y), FLOATP (imageB, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added cop/binop_float_grey16.c.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crimp_image*     result;
crimp_image*     imageA;
crimp_image*     imageB;
int x, y;

crimp_input (imageAObj, imageA, float);
crimp_input (imageBObj, imageB, grey16);

if (!crimp_eq_dim (imageA, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageA);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = BINOP (FLOATP (imageA, x, y), GREY16 (imageB, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added cop/binop_float_grey32.c.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crimp_image*     result;
crimp_image*     imageA;
crimp_image*     imageB;
int x, y;

crimp_input (imageAObj, imageA, float);
crimp_input (imageBObj, imageB, grey32);

if (!crimp_eq_dim (imageA, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageA);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = BINOP (FLOATP (imageA, x, y), GREY32 (imageB, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added cop/binop_float_grey8.c.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crimp_image*     result;
crimp_image*     imageA;
crimp_image*     imageB;
int x, y;

crimp_input (imageAObj, imageA, float);
crimp_input (imageBObj, imageB, grey8);

if (!crimp_eq_dim (imageA, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageA);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = BINOP (FLOATP (imageA, x, y), GREY8 (imageB, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added cop/binop_grey16_float.c.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crimp_image*     result;
crimp_image*     imageA;
crimp_image*     imageB;
int x, y;

crimp_input (imageAObj, imageA, grey16);
crimp_input (imageBObj, imageB, float);

if (!crimp_eq_dim (imageA, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageA);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = BINOP (GREY16 (imageA, x, y), FLOATP (imageB, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added cop/binop_grey32_float.c.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crimp_image*     result;
crimp_image*     imageA;
crimp_image*     imageB;
int x, y;

crimp_input (imageAObj, imageA, grey32);
crimp_input (imageBObj, imageB, float);

if (!crimp_eq_dim (imageA, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageA);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = BINOP (GREY32 (imageA, x, y), FLOATP (imageB, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added cop/binop_grey8_float.c.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crimp_image*     result;
crimp_image*     imageA;
crimp_image*     imageB;
int x, y;

crimp_input (imageAObj, imageA, grey8);
crimp_input (imageBObj, imageB, float);

if (!crimp_eq_dim (imageA, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageA);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = BINOP (GREY8 (imageA, x, y), FLOATP (imageB, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added cop/binop_grey8_grey8.c.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crimp_image*     result;
crimp_image*     imageA;
crimp_image*     imageB;
int x, y;

crimp_input (imageAObj, imageA, grey8);
crimp_input (imageBObj, imageB, grey8);

if (!crimp_eq_dim (imageA, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageA);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	GREY8 (result, x, y) = BINOP (GREY8 (imageA, x, y), GREY8 (imageB, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added cop/binop_grey8_rgb.c.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crimp_image*     result;
crimp_image*     imageA;
crimp_image*     imageB;
int x, y;

crimp_input (imageAObj, imageA, grey8);
crimp_input (imageBObj, imageB, rgb);

if (!crimp_eq_dim (imageA, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageB);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	R (result, x, y) = BINOP (GREY8 (imageA, x, y), R (imageB, x, y));
	G (result, x, y) = BINOP (GREY8 (imageA, x, y), G (imageB, x, y));
	B (result, x, y) = BINOP (GREY8 (imageA, x, y), B (imageB, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added cop/binop_grey8_rgba.c.










































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crimp_image*     result;
crimp_image*     imageA;
crimp_image*     imageB;
int x, y;

crimp_input (imageAObj, imageA, grey8);
crimp_input (imageBObj, imageB, rgba);

if (!crimp_eq_dim (imageA, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageB);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	R (result, x, y) = BINOP (GREY8 (imageA, x, y), R (imageB, x, y));
	G (result, x, y) = BINOP (GREY8 (imageA, x, y), G (imageB, x, y));
	B (result, x, y) = BINOP (GREY8 (imageA, x, y), B (imageB, x, y));
	A (result, x, y) =                              A (imageB, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added cop/binop_rgb_grey8.c.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crimp_image*     result;
crimp_image*     imageA;
crimp_image*     imageB;
int x, y;

crimp_input (imageAObj, imageA, rgb);
crimp_input (imageBObj, imageB, grey8);

if (!crimp_eq_dim (imageA, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageA);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	R (result, x, y) = BINOP (R (imageA, x, y), GREY8 (imageB, x, y));
	G (result, x, y) = BINOP (G (imageA, x, y), GREY8 (imageB, x, y));
	B (result, x, y) = BINOP (B (imageA, x, y), GREY8 (imageB, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added cop/binop_rgb_rgb.c.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crimp_image*     result;
crimp_image*     imageA;
crimp_image*     imageB;
int x, y;

crimp_input (imageAObj, imageA, rgb);
crimp_input (imageBObj, imageB, rgb);

if (!crimp_eq_dim (imageA, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageA);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	R (result, x, y) = BINOP (R (imageA, x, y), R (imageB, x, y));
	G (result, x, y) = BINOP (G (imageA, x, y), G (imageB, x, y));
	B (result, x, y) = BINOP (B (imageA, x, y), B (imageB, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added cop/binop_rgb_rgba.c.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crimp_image*     result;
crimp_image*     imageA;
crimp_image*     imageB;
int x, y;

crimp_input (imageAObj, imageA, rgb);
crimp_input (imageBObj, imageB, rgba);

if (!crimp_eq_dim (imageA, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageA);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	R (result, x, y) = BINOP (R (imageA, x, y), R (imageB, x, y));
	G (result, x, y) = BINOP (G (imageA, x, y), G (imageB, x, y));
	B (result, x, y) = BINOP (B (imageA, x, y), B (imageB, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added cop/binop_rgba_grey8.c.










































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crimp_image*     result;
crimp_image*     imageA;
crimp_image*     imageB;
int x, y;

crimp_input (imageAObj, imageA, rgba);
crimp_input (imageBObj, imageB, grey8);

if (!crimp_eq_dim (imageA, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageA);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	R (result, x, y) = BINOP (R (imageA, x, y), GREY8 (imageB, x, y));
	G (result, x, y) = BINOP (G (imageA, x, y), GREY8 (imageB, x, y));
	B (result, x, y) = BINOP (B (imageA, x, y), GREY8 (imageB, x, y));
	A (result, x, y) = A (imageA, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added cop/binop_rgba_rgb.c.










































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crimp_image*     result;
crimp_image*     imageA;
crimp_image*     imageB;
int x, y;

crimp_input (imageAObj, imageA, rgba);
crimp_input (imageBObj, imageB, rgb);

if (!crimp_eq_dim (imageA, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageA);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	R (result, x, y) = BINOP (R (imageA, x, y), R (imageB, x, y));
	G (result, x, y) = BINOP (G (imageA, x, y), G (imageB, x, y));
	B (result, x, y) = BINOP (B (imageA, x, y), B (imageB, x, y));
	A (result, x, y) = A (imageA, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added cop/binop_rgba_rgba.c.










































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crimp_image*     result;
crimp_image*     imageA;
crimp_image*     imageB;
int x, y;

crimp_input (imageAObj, imageA, rgba);
crimp_input (imageBObj, imageB, rgba);

if (!crimp_eq_dim (imageA, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageA);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	R (result, x, y) = BINOP (R (imageA, x, y), R (imageB, x, y));
	G (result, x, y) = BINOP (G (imageA, x, y), G (imageB, x, y));
	B (result, x, y) = BINOP (B (imageA, x, y), B (imageB, x, y));
	A (result, x, y) = BINOP (A (imageA, x, y), A (imageB, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added cop/expand_op.c.



































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

{
    /*
     * Border expansion core.
     *
     * Define the macros FILL, FILL_{NW,N,NE,W,E,SW,S,SE} and COPY before
     * including this file.
     */

    crimp_image* result;
    int          xo, yo, xi, yi;

    if ((ww < 0) || (hn < 0) || (we < 0) || (hs < 0)) {
	Tcl_SetResult(interp, "bad image border size, expected non-negative values", TCL_STATIC);
	return TCL_ERROR;
    }

    result = crimp_new (image->itype, image->w + ww + we, image->h + hn + hs);

    /*
     * Nine quadrants to fill:
     *
     * NW N NE
     *  W C E
     * SW S SE
     *
     * The center block is the original image.
     */

#ifndef FILL_NW
#define FILL_NW(x,y) FILL(x,y)
#endif

#ifndef FILL_N
#define FILL_N(x,y) FILL(x,y)
#endif

#ifndef FILL_NE
#define FILL_NE(x,y) FILL(x,y)
#endif

#ifndef FILL_W
#define FILL_W(x,y) FILL(x,y)
#endif

#ifndef FILL_E
#define FILL_E(x,y) FILL(x,y)
#endif

#ifndef FILL_SW
#define FILL_SW(x,y) FILL(x,y)
#endif

#ifndef FILL_S
#define FILL_S(x,y) FILL(x,y)
#endif

#ifndef FILL_SE
#define FILL_SE(x,y) FILL(x,y)
#endif

    /*
     * North West.
     */

    if (hn && ww) {
	for (yo = 0; yo < hn; yo++) {
	    for (xo = 0; xo < ww; xo++) {
		FILL_NW (xo, yo);
	    }
	}
    }

    /*
     * North.
     */

    if (hn) {
	for (yo = 0; yo < hn; yo++) {
	    for (xo = 0; xo < image->w; xo++) {
		FILL_N (xo + ww, yo);
	    }
	}
    }

    /*
     * North East.
     */

    if (hn && we) {
	for (yo = 0; yo < hn; yo++) {
	    for (xo = 0; xo < we; xo++) {
		FILL_NE (xo + image->w + ww, yo);
	    }
	}
    }

    /*
     * West.
     */

    if (ww) {
	for (xo = 0; xo < ww; xo++) {
	    for (yo = 0; yo < image->h; yo++) {
		FILL_W (xo, yo + hn);
	    }
	}
    }

    /*
     * East.
     */

    if (we) {
	for (xo = 0; xo < we; xo++) {
	    for (yo = 0; yo < image->h; yo++) {
		FILL_E (xo + image->w + ww, yo + hn);
	    }
	}
    }

    /*
     * South West.
     */

    if (hs && ww) {
	for (yo = 0; yo < hs; yo++) {
	    for (xo = 0; xo < ww; xo++) {
		FILL_SW (xo, yo + image->h + hn);
	    }
	}
    }

    /*
     * South.
     */

    if (hs) {
	for (yo = 0; yo < hs; yo++) {
	    for (xo = 0; xo < image->w; xo++) {
		FILL_S (xo + ww, yo + image->h + hn);
	    }
	}
    }

    /*
     * South East.
     */

    if (hs && we) {
	for (yo = 0; yo < hs; yo++) {
	    for (xo = 0; xo < we; xo++) {
		FILL_SE (xo + image->w + ww, yo + image->h + hn);
	    }
	}
    }

    /*
     * Central. Copy of the input image.
     */

    for (yo = hn, yi = 0; yi < image->h; yo++, yi++) {
	for (xo = ww, xi = 0; xi < image->w; xo++, xi++) {
	    COPY (xo, yo, xi, yi);
	}
    }

    Tcl_SetObjResult(interp, crimp_new_image_obj (result));
    return TCL_OK;

#undef COPY
#undef FILL
#undef FILL_NW
#undef FILL_N
#undef FILL_NE
#undef FILL_W
#undef FILL_E
#undef FILL_SW
#undef FILL_S
#undef FILL_SE
}

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Changes to crimp.tcl.





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







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

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
+


+
+
+
+
-
-
-
+
+
+
+
+
+
+



+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
+
+
+
-
-
+
-
-
-
-
-
+
+
-
-
-
+
+
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
+
-
-
-
+
-
-
-
+
-
-
-
+
-
-
-
-
-
+
+
+
-
-
+
-
-
+
-
+

+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
-
-
+
+

+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



#!/bin/sh
# The next line restarts with tclsh.\
exec tclsh "$0" ${1+"$@"}

set dir [file dirname [info script]]
lappend auto_path [file join $dir critcl.vfs lib]
# -*- tcl -*-
# CRIMP == C Runtime Image Manipulation Package
#
# (c) 2010 Andrew M. Goth  http://wiki.tcl.tk/andy%20goth
# (c) 2010 Andreas Kupries http://wiki.tcl.tk/andreas%20kupries
#

# # ## ### ##### ######## #############
## Requisites

package require Tk
#package require Tk
package require critcl

if {![critcl::compiling]} {
    error "Unable to build CRIMP, no proper compiler found."
}
#critcl::config keepsrc 1
proc take {varname} {
    upvar 1 $varname var
    return $var[set var ""]

# # ## ### ##### ######## #############
## Implementation.

catch {
    critcl::cheaders -g
    critcl::debug memory symbols
}

critcl::config tk 1
critcl::cheaders c/*.h cop/*.c
critcl::csources c/*.c
critcl::tsources crimp_tcl.tcl
# FFT sources and dependencies.
critcl::cheaders c/fftpack/f2c.h
critcl::csources c/fftpack/radb2.c
critcl::csources c/fftpack/radb3.c
critcl::csources c/fftpack/radb4.c
critcl::csources c/fftpack/radb5.c
critcl::csources c/fftpack/radbg.c
critcl::csources c/fftpack/radf2.c
critcl::csources c/fftpack/radf3.c
critcl::csources c/fftpack/radf4.c
critcl::csources c/fftpack/radf5.c
critcl::csources c/fftpack/radfg.c
critcl::csources c/fftpack/rfftb.c
critcl::csources c/fftpack/rfftb1.c
critcl::csources c/fftpack/rfftf.c
critcl::csources c/fftpack/rfftf1.c
critcl::csources c/fftpack/rffti.c
critcl::csources c/fftpack/rffti1.c

::apply {{here} {
    # image readers and writers implemented
    # as Tcl procedures.
    foreach f [glob -directory $here/reader *.tcl] { critcl::tsources $f }
    foreach f [glob -directory $here/writer *.tcl] { critcl::tsources $f }
}} [file dirname [file normalize [info script]]]

critcl::tsources plot.tcl

critcl::cinit {
    crimp_imagetype_init ();
} {}

critcl::ccode {
    #include <math.h>
    #include <stdlib.h>
    #include <string.h>

    #define MIN(a, b) ((a) < (b) ? (a) : (b))
    #define MAX(a, b) ((a) > (b) ? (a) : (b))
    #include <image_type.h>
    #include <image.h>
    #include <volume.h>
    #define CLAMP(min, v, max) ((v) < (min) ? (min) : (v) < (max) ? (v) : (max))

    #include <ahe.h>
    static int decodeImageObj(Tcl_Interp *interp, Tcl_Obj *imageObj, int *width,
    int *height, unsigned char **pixels)
    {
        int objc;
        Tcl_Obj **objv;
    #include <rank.h>
    #include <linearalgebra.h>
        if (Tcl_ListObjGetElements(interp, imageObj, &objc, &objv) != TCL_OK) {
            return TCL_ERROR;
        } else if (objc != 3) {
    #include <geometry.h>
    #include <color.h>
            Tcl_SetResult(interp, "invalid image format", TCL_STATIC);
            return TCL_ERROR;
        } else if (Tcl_GetIntFromObj(interp, objv[0], width ) != TCL_OK
                || Tcl_GetIntFromObj(interp, objv[1], height) != TCL_OK) {
            return TCL_ERROR;
        }

        int length;
    #include <util.h>
    #include <f2c.h>
        *pixels = Tcl_GetByteArrayFromObj(objv[2], &length);
        if (length != 4 * *width * *height || *width < 0 || *height < 0) {
            Tcl_SetResult(interp, "invalid image format", TCL_STATIC);
            return TCL_ERROR;
        }

        return TCL_OK;
    }

    /* Common declarations to access the FFT functions. */
    static int getUnsharedImageObj(Tcl_Interp *interp, Tcl_Obj *inputObj,
    Tcl_Obj **outputObj, Tcl_Obj **dataObj)
    {

        *outputObj = inputObj;
        if (Tcl_ListObjIndex(interp, *outputObj, 2, dataObj) != TCL_OK) {
            return TCL_ERROR;
    extern int rffti_ (integer *n, real *wsave);
        } else if (Tcl_IsShared(*outputObj) || Tcl_IsShared(*dataObj)) {
            *outputObj = Tcl_DuplicateObj(*outputObj);
            *dataObj = Tcl_DuplicateObj(*dataObj);
            Tcl_ListObjReplace(interp, *outputObj, 2, 1, 1, dataObj);
        }
    extern int rfftf_ (integer *n, real* r, real *wsave);
    extern int rfftb_ (integer *n, real* r, real *wsave);
}
        return TCL_OK;
    }

}

# # ## ### ##### ######## #############
namespace eval crimp {namespace ensemble create}
## Read and execute all .crimp files in the current directory.

::apply {{here} {
foreach filename [lsort [glob -nocomplain [file join $dir *.crimp]]] {
    set chan [open $filename]
    set name [gets $chan]
    set params "Tcl_Interp* interp"
    set number 2
    while {1} {
        incr number
        set line [gets $chan]
        if {$line eq ""} {
            break
        }
        append params " $line"
    }
    set body "\n#line $number \"[file tail $filename]\"\n[read $chan]"
    namespace ensemble configure ::crimp -subcommands [concat\
    foreach filename [lsort [glob -nocomplain -directory [file join $here operator] *.crimp]] {
	set chan [open $filename]
	set name [gets $chan]
	set params "Tcl_Interp* interp"
	set number 2
	while {1} {
	    incr number
	    set line [gets $chan]
	    if {$line eq ""} {
		break
	    }
	    append params " $line"
	}
	set body "\n#line $number \"[file tail $filename]\"\n[read $chan]"
	close $chan
            [namespace ensemble configure crimp -subcommands] [list $name]]
    namespace eval ::crimp [list ::critcl::cproc $name $params ok $body]
	namespace eval ::crimp [list ::critcl::cproc $name $params ok $body]
    close $chan
}
    }
}} [file dirname [file normalize [info script]]]

# # ## ### ##### ######## #############
## Make the C pieces ready. Force build of the binaries and check if ok.
set photo [image create photo -file [file join $dir conformer.png]]
set image [crimp import $photo]
label .l -image $photo
pack .l
scale .s -from -180 -to 180 -orient horizontal -command [list apply {
{photo image angle} {
    set s [expr {sin($angle * 0.017453292519943295769236907684886)}]
    set c [expr {cos($angle * 0.017453292519943295769236907684886)}]
    set matrix [list [list $c $s 0] [list [expr {-$s}] $c 0] [list $s $s 1]]
    crimp export $photo [crimp matrix $image $matrix]
}} $photo $image]
pack .s -fill x

if {[critcl::failed]} {
    error "Building CRIMP failed."
} else {
    # Build OK, force system to load the generated shared library.
    # Required bececause critcl::failed explicitly disables the
    # load phase.
    critcl::cbuild [info script]
}

# # ## ### ##### ######## #############
## Pull in the Tcl layer aggregating the C primitives into useful
## commands.
##
## NOTE: This is for the interactive use of crimp.tcl. When used as
##       plain package the 'tsources' declaration at the top ensures
##       the distribution and use of the Tcl layer.

source [file join [file dirname [file normalize [info script]]] crimp_tcl.tcl]

# This can fail when compiling via 'critcl -pkg', because snit may not
# be a visible package to the starkit. Have to think more about how to
# separate the pieces. Plot should likely be its own package.
catch {
    source [file join [file dirname [file normalize [info script]]] plot.tcl]
}

# # ## ### ##### ######## #############
## Fully Ready. Export.

package provide crimp 0
return

# vim: set sts=4 sw=4 tw=80 et ft=tcl:






Added crimp_tcl.tcl.





































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































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
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

## -*- tcl -*-
# # ## ### ##### ######## #############
## This file defines a number of commands on top of the C primitives
## which are easier to use than directly calling on the latter.

namespace eval ::crimp {}

# # ## ### ##### ######## #############

proc ::crimp::List {pattern} {
    return [info commands ::crimp::$pattern]
}

proc ::crimp::Has {name} {
    return [llength [info commands ::crimp::$name]]
}

proc ::crimp::P {fqn} {
    return [lrange [::split [namespace tail $fqn] _] 1 end]
}

proc ::crimp::ALIGN {image size where fe values} {
    # Do nothing if the image is at the requested size.

    switch -exact -- $where {
	top - center - bottom {
	    set delta [expr {$size - [height $image]}]
	    if {!$delta} { return $image }
	}
	left - middle - right {
	    set delta [expr {$size - [width $image]}]
	    if {!$delta} { return $image }
	}
    }

    # Expand the image to the requested size, with the alignment
    # specifying which border(s) to expand.

    set n 0
    set s 0
    set e 0
    set w 0

    switch -exact -- $where {
	top    { set s $delta }
	bottom { set n $delta }
	left   { set e $delta }
	right  { set w $delta }
	center {
	    # In the centerline. If an even split is not possible move
	    # it one pixel down.
	    set d [expr {$delta/2}]
	    set n $d
	    set s $d
	    if {$delta % 2 == 1} { incr n }
	}
	middle {
	    # In the middle. If an even split is not possible move it
	    # one pixel to the right.
	    set d [expr {$delta/2}]
	    set w $d
	    set e $d
	    if {$delta % 2 == 1} { incr w }
	}
    }

    # Run the expansion.
    return [::crimp::$fe $image $w $n $e $s {*}$values]
}

proc ::crimp::INTERPOLATE {argv} {
    upvar 1 $argv args

    # Default interpolation method. Compromise between accuracy and
    # speed.
    set imethod bilinear

    set at 0
    while {[string match -* [set opt [lindex $args $at]]]} {
	switch -exact -- $opt {
	    -interpolate {
		incr at
		set val [lindex $args $at]
		set legal {nneighbour bilinear bicubic}
		if {$val ni $legal} {
		    return -code error "Expected one of [linsert end [join $legal ,] or], got \"$val\""
		}
		set imethod $val
	    }
	    default {
		return -code error "Expected -interpolate, got \"$opt\""
	    }
	}
	incr at
    }

    set args [lrange $args $at end]
    return $imethod
}

proc ::crimp::BORDER {imagetype spec} {
    set values [lassign $spec bordertype]

    if {![llength [List expand_*_$bordertype]]} {
	# TODO :: Compute/memoize available border types.
	return -code error "Unknown border type \"$bordertype\", expected one of ..."
    }

    set f expand_${imagetype}_$bordertype
    if {![Has $f]} {
	return -code error "Unable to expand images of type \"$type\" by border \"$bordertype\""
    }

    # Process type specific arguments.
    switch -- $bordertype {
	const {
	    # TODO :: Introspect number of color channels from image
	    # type, then extend or reduce the values accordingly.
	    #
	    # FOR NOW :: Hardwired map.
	    # SEE ALSO :: remap, blank.
	    # TODO :: Unify using some higher-order code.

	    switch -- $imagetype {
		hsv - rgb {
		    if {![llength $values]} {
			set values {0 0 0}
		    }
		    while {[llength $values] < 3} {
			lappend values [lindex $values end]
		    }
		    if {[llength $values] > 3} {
			set values [lrange $values 0 2]
		    }
		}
		rgba {
		    if {![llength $values]} {
			set values {0 0 0 255}
		    }
		    while {[llength $values] < 3} {
			lappend values [lindex $values end]
		    }
		    if {[llength $values] < 4} {
			lappend values 255
		    }
		    if {[llength $values] > 4} {
			set values [lrange $values 0 3]
		    }
		}
		float -
		grey32 -
		grey16 -
		grey8 {
		    if {![llength $values]} {
			set values {0}
		    } elseif {[llength $values] > 1} {
			set values [lrange $values 0 0]
		    }
		}
	    }
	}
	default {
	    if {[llength $values]} {
		return -code error "wrong\#args: no values accepted by \"$bordertype\" borders"
	    }
	}
    }

    return [list $f $values]
}

proc ::crimp::GCD {p q} {
    # Taken from http://wiki.tcl.tk/752
    while {1} {
	if {$q == 0} {
	    # Termination case
	    break
	} elseif {$p>$q} {
	    # Swap p and q
	    set t $p
	    set p $q
	    set q $t
	}
	set q [expr {$q%$p}]
    }
    return $p
}

# # ## ### ##### ######## #############

proc ::crimp::meta {cmd image args} {
    # The meta data as exposed through here is a dictionary. Thus we
    # expose all dictionary operations as submethods, with the
    # dictionary value/variable implied by the image.

    switch -exact -- $cmd {
	append - incr - lappend - set - unset {
	    set meta [meta_get $image]
	    dict $cmd meta {*}$args
	    return [meta_set [K $image [unset image]] $meta]
	}
	create {
	    return [meta_set [K $image [unset image]] [dict $cmd {*}$args]]
	}
	merge - remove - replace {
	    return [meta_set [K $image [unset image]] [dict $cmd [meta_get $image] {*}$args]]
	}
	exists - get - info - keys - size - values {
	    return [dict $cmd [meta_get $image] {*}$args]
	}
	for {
	    return [uplevel 1 [list dict $cmd {*}[linsert $args 1 [meta_get $image]]]]
	}
	filter {
	    return [uplevel 1 [list dict $cmd [meta_get $image] {*}$args]]
	}
	default {
	    set x {append create exists filter for get incr info keys lappend merge remove replace set size unset values}
	    return -code error "Unknown method \"$cmd\", expected one of [linsert [::join $x {, }] end-1 or]"
	}
    }
}

# # ## ### ##### ######## #############
## Read is done via sub methods, one per format to read from.
#
## Ditto write, convert, and join, one per destination format. Note
## that for write and convert the input format is determined
## automatically from the image.

namespace eval ::crimp::read {
    namespace export *
    namespace ensemble create
}

::apply {{dir} {
    # Readers implemented as C primitives
    foreach fun [::crimp::List read_*] {
	# Ignore the read_tcl_ primitives. They have their own setup
	# in a moment.
	if {[string match *::read_tcl_* $fun]} continue

	proc [::crimp::P $fun] {detail} [string map [list @ $fun] {
	    @ $detail
	}]
    }

    proc tcl {format detail} {
	set f read_tcl_$format
	if {![::crimp::Has $f]} {
	    return -code error "Unable to generate images of type \"$format\" from Tcl values"
	}
	return [::crimp::$f $detail]
    }

    # Readers implemented as Tcl procedures.
    #
    # Note: This is for the case of crimp getting dynamically
    # compiled.  In the prebuild case no files will match, and the
    # relevant files are sources as part of the package index.

    foreach file [glob -nocomplain -directory $dir/reader *.tcl] {
	source $file
    }
} ::crimp::read} [file dirname [file normalize [info script]]]

# # ## ### ##### ######## #############

namespace eval ::crimp::write {
    namespace export *
    namespace ensemble create
}

::apply {{dir} {
    # Writers implemented as C primitives
    foreach fun [::crimp::List write_*] {
	proc [lindex [::crimp::P $fun] 0] {dst image} \
	    [string map [list @ [lindex [::crimp::P $fun] 0]] {
		set type [::crimp::TypeOf $image]
		set f    write_@_${type}
		if {![::crimp::Has $f]} {
		    return -code error "Unable to write images of type \"$type\" to \"@\""
		}
		return [::crimp::$f $dst $image]
	    }]
    }

    # Writers implemented as Tcl procedures.
    #
    # Note: This is for the case of crimp getting dynamically
    # compiled.  In the prebuild case no files will match, and the
    # relevant files are sources as part of the package index.

    foreach file [glob -nocomplain -directory $dir/writer *.tcl] {
	source $file
    }
} ::crimp::write} [file dirname [file normalize [info script]]]

proc ::crimp::write::2file {format path image} {
    set chan [open $path w]
    fconfigure $chan -encoding binary
    2chan $format $chan $image
    close $chan
    return
}

proc ::crimp::write::2chan {format chan image} {
    set type [::crimp::TypeOf $image]
    set f    writec_${format}_${type}

    if {![::crimp::Has $f]} {
	puts -nonewline $chan [2string $format $image]
	return
    }
    ::crimp::$f $chan $image
    return
}

proc ::crimp::write::2string {format image} {
    set type [::crimp::TypeOf $image]
    set f    writes_${format}_${type}

    if {![::crimp::Has $f]} {
	return -code error "Unable to write images of type \"$type\" to strings for \"$format\""
    }
    return [::crimp::$f $image]
}

# # ## ### ##### ######## #############

namespace eval ::crimp::convert {
    namespace export *
    namespace ensemble create
}

::apply {{} {
    # Converters implemented as C primitives
    foreach fun [::crimp::List convert_*] {

	if {[string match {*_2[rh]*_*} $fun]} {
	    # Conversion from grey8 to the multi-channel types (rgb,
	    # rgba, hsv) needs special handling in the converter to
	    # allow for a conversion with and without a color
	    # gradient.

	    set dst [lindex [::crimp::P $fun] 0]
	    set it  [string range $dst 1 end]

	    switch -exact -- $it {
		hsv  {set b {{0 0 0}}   ; set w {{0 0 255}}}
		rgb  {set b {{0 0 0}}   ; set w {{255 255 255}}}
		rgba {set b {{0 0 0 0}} ; set w {{255 255 255 255}}}
	    }

	    proc $dst {image {gradient {}}} \
		[string map [list @ $dst % $it <W> $w <B> $b] {
		    set type [::crimp::TypeOf $image]
		    # Pass through unchanged if the image is already of
		    # the requested type.
		    if {"2$type" eq "@"} {
			return $image
		    }
		    set f convert_@_${type}
		    if {![::crimp::Has $f]} {
			return -code error "Unable to convert images of type \"$type\" to \"@\""
		    }

		    if {$type eq "grey8"} {
			if {[llength [info level 0]] < 3} {
			    # Standard gradient, plain black to white greyscale
			    set gradient [::crimp::gradient % <B> <W> 256]
			}
			return [::crimp::$f $image $gradient]
		    } else {
			# anything else has no gradient
			if {[llength [info level 0]] == 3} {
			    return -code error "wrong#args: should be \"::crimp::$f imageObj\""
			}
			return [::crimp::$f $image]
		    }
		}]

	} else {
	    # Standard converters not requiring additional arguments
	    # to guide/configure the process.

	    proc [lindex [::crimp::P $fun] 0] {image} \
		[string map [list @ [lindex [::crimp::P $fun] 0]] {
		    set type [::crimp::TypeOf $image]
		    # Pass through unchanged if the image is already of
		    # the requested type.
		    if {"2$type" eq "@"} {
			return $image
		    }
		    set f    convert_@_${type}
		    if {![::crimp::Has $f]} {
			return -code error "Unable to convert images of type \"$type\" to \"@\""
		    }
		    return [::crimp::$f $image]
		}]
	}
    }
} ::crimp::convert}

# # ## ### ##### ######## #############

namespace eval ::crimp::join {
    namespace export *
    namespace ensemble create
}

::apply {{} {
    foreach fun [::crimp::List join_*] {
	proc [::crimp::P $fun] {args} [string map [list @ $fun] {
	    return [@ {*}$args]
	}]
    }
} ::crimp::join}

# # ## ### ##### ######## #############

namespace eval ::crimp::flip {
    namespace export *
    namespace ensemble create
}

::apply {{} {
    foreach fun [::crimp::List flip_*] {
	proc [lindex [::crimp::P $fun] 0] {image} \
	    [string map [list @ [lindex [::crimp::P $fun] 0]] {
		set type [::crimp::TypeOf $image]
		set f    flip_@_$type
		if {![::crimp::Has $f]} {
		    return -code error "Unable to flip @ images of type \"$type\""
		}
		return [::crimp::$f $image]
	    }]
    }
} ::crimp::flip}

# # ## ### ##### ######## #############

namespace eval ::crimp::rotate {
    namespace export *
    namespace ensemble create
}

proc ::crimp::rotate::ccw {image} {
    return [::crimp::flip::vertical [::crimp::flip::transpose $image]]
}

proc ::crimp::rotate::cw {image} {
    return [::crimp::flip::horizontal [::crimp::flip::transpose $image]]
}

proc ::crimp::rotate::half {image} {
    return [::crimp::flip::horizontal [::crimp::flip::vertical $image]]
}

# # ## ### ##### ######## #############

proc ::crimp::resize {args} {
    return [Resize [::crimp::INTERPOLATE args] {*}$args]
}

proc ::crimp::Resize {interpolation image w h} {
    # Resize the image to new width and height.

    # Note that the projective transform can leave the image a bit to
    # large, due to it rounding the west and south borders up (ceil)
    # when going from rational to integral coordinates. This is fixed
    # by cutting the result to the proper dimensions.

    return [cut [warp::Projective $interpolation $image \
		     [transform::scale \
			  [expr {double($w)/[width  $image]}] \
			  [expr {double($h)/[height $image]}]]] \
		0 0 $w $h]
}

# # ## ### ##### ######## #############
## All morphology operations are currently based on a single
## structuring element, the flat 3x3 brick.

namespace eval ::crimp::morph {
    namespace export *
    namespace ensemble create
}

proc ::crimp::morph::erode {image} {
    return [::crimp::filter::rank $image 1 99.99]
}

proc ::crimp::morph::dilate {image} {
    return [::crimp::filter::rank $image 1 0]
}

proc ::crimp::morph::open {image} {
    return [dilate [erode $image]]
}

proc ::crimp::morph::close {image} {
    return [erode [dilate $image]]
}

proc ::crimp::morph::gradient {image} {
    return [::crimp::subtract [dilate $image] [erode $image]]
}

proc ::crimp::morph::igradient {image} {
    return [::crimp::subtract $image [erode $image]]
}

proc ::crimp::morph::egradient {image} {
    return [::crimp::subtract [dilate $image] $image]
}

proc ::crimp::morph::tophatw {image} {
    return [::crimp::subtract $image [open $image]]
}

proc ::crimp::morph::tophatb {image} {
    return [::crimp::subtract [close $image] $image]
}

# # ## ### ##### ######## #############

namespace eval ::crimp::montage {
    namespace export *
    namespace ensemble create
}

proc ::crimp::montage::horizontal {args} {
    # option processing (expansion type, vertical alignment) ...

    # Default settings for border expansion in alignment.
    set border    const
    set alignment center

    set at 0
    while {1} {
	set opt [lindex $args $at]
	if {![string match -* $opt]} break
	incr at
	switch -- $opt {
	    -align {
		set alignment [lindex $args $at]
		if {$alignment ni {top center bottom}} {
		    return -code error "Illegal vertical alignment \"$alignment\", expected bottom, center, or top"
		}
		incr at
	    }
	    -border {
		set border [lindex $args $at]
		incr at
	    }
	    default {
		return -code error "Unknown option \"$opt\", expected -align, or -border"
	    }
	}
    }
    set args [lrange $args $at end]

    if {[llength $args] == 1} {
	# Check border settings. While irrelevant for the single image
	# case we don't wish to accept something bogus even so.

	set image [lindex $args 0]
	crimp::BORDER [::crimp::TypeOf $image] $border
	return $image
    } elseif {[llength $args] == 0} {
	return -code error "No images to montage"
    }

    # Check type, and compute max height, for border expansion.
    set type {}
    set height 0
    foreach image $args {
	set itype [::crimp::TypeOf $image]
	if {($type ne {}) && ($type ne $itype)} {
	    return -code error "Type mismatch, unable to montage $type to $itype"
	}
	set type   $itype
	set height [tcl::mathfunc::max $height [::crimp::height $image]]
    }	

    lassign [::crimp::BORDER $type $border] fe values

    set f montageh_${type}
    if {![::crimp::Has $f]} {
	return -code error "Unable to montage images of type \"$type\""
    }

    # todo: investigate ability of critcl to have typed var-args
    # commands.
    set remainder [lassign $args result]
    set result    [::crimp::ALIGN $result $height $alignment $fe $values]
    foreach image $remainder {
	set image [::crimp::ALIGN $image $height $alignment $fe $values]
	set result [::crimp::$f $result $image]
    }
    return $result
}

proc ::crimp::montage::vertical {args} {
    # option processing (expansion type, vertical alignment) ...

    # Default settings for border expansion in alignment.
    set border    const
    set alignment middle

    set at 0
    while {1} {
	set opt [lindex $args $at]
	if {![string match -* $opt]} break
	incr at
	switch -- $opt {
	    -align {
		set alignment [lindex $args $at]
		if {$alignment ni {left middle right}} {
		    return -code error "Illegal horizontal alignment \"$alignment\", expected left, middle, or right"
		}
		incr at
	    }
	    -border {
		set border [lindex $args $at]
		incr at
	    }
	    default {
		return -code error "Unknown option \"$opt\", expected -align, or -border"
	    }
	}
    }
    set args [lrange $args $at end]

    if {[llength $args] == 1} {
	# Check border settings. While irrelevant for the single image
	# case we don't wish to accept something bogus even so.

	set image [lindex $args 0]
	crimp::BORDER [::crimp::TypeOf $image] $border
	return $image
    } elseif {[llength $args] == 0} {
	return -code error "No images to montage"
    }

    # Check type, and compute max width, for border expansion.
    set type {}
    set width 0
    foreach image $args {
	set itype [::crimp::TypeOf $image]
	if {($type ne {}) && ($type ne $itype)} {
	    return -code error "Type mismatch, unable to montage $type to $itype"
	}
	set type   $itype
	set width [tcl::mathfunc::max $width [::crimp::width $image]]
    }	

    lassign [::crimp::BORDER $type $border] fe values

    set f montagev_${type}
    if {![::crimp::Has $f]} {
	return -code error "Unable to montage images of type \"$type\""
    }

    # todo: investigate ability of critcl to have typed var-args
    # commands.
    set remainder [lassign $args result]
    set result    [::crimp::ALIGN $result $width $alignment $fe $values]
    foreach image $remainder {
	set image [::crimp::ALIGN $image $width $alignment $fe $values]
	set result [::crimp::$f $result $image]
    }
    return $result
}

# # ## ### ##### ######## #############

proc ::crimp::invert {image} {
    remap $image [map invers]
}

proc ::crimp::solarize {image n} {
    remap $image [map solarize $n]
}

# # ## ### ##### ######## #############

namespace eval ::crimp::effect {
    namespace export *
    namespace ensemble create
}

proc ::crimp::effect::sharpen {image} {
    # http://wiki.tcl.tk/9521
    return [::crimp::filter::convolve $image \
		[::crimp::kernel::make {
		    { 0  -1  0}
		    {-1   5 -1}
		    { 0  -1  0}} 1]]
}

proc ::crimp::effect::emboss {image} {
    # http://wiki.tcl.tk/9521 (Suchenwirth)
    return [::crimp::filter::convolve $image \
		[::crimp::kernel::make {
		    {2  0  0}
		    {0 -1  0}
		    {0  0 -1}}]]
}

proc ::crimp::effect::charcoal {image} {
    return [::crimp::morph::gradient \
		[::crimp::convert::2grey8 $image]]
}

# # ## ### ##### ######## #############

namespace eval ::crimp::threshold {
    namespace export *
    namespace ensemble create
    namespace eval global {
	namespace export *
	namespace ensemble create
    }
}

# TODO :: auto-create from the methods of 'table threshold'.
# TODO :: introspect the threshold ensemble !

proc ::crimp::threshold::global::below {image n} {
    return [::crimp::remap $image [::crimp::map threshold below $n]]
}

proc ::crimp::threshold::global::above {image n} {
    return [::crimp::remap $image [::crimp::map threshold above $n]]
}

proc ::crimp::threshold::global::inside {image min max} {
    return [::crimp::remap $image [::crimp::map threshold inside $min $max]]
}

proc ::crimp::threshold::global::outside {image min max} {
    return [::crimp::remap $image [::crimp::map threshold outside $min $max]]
}

proc ::crimp::threshold::global::otsu {image} {
    set maps {}
    set stat [::crimp::statistics::otsu [::crimp::statistics::basic $image]]
    foreach c [dict get $stat channels] {
	lappend maps \
	    [::crimp::map threshold below \
		 [dict get $stat channel $c otsu]]
    }
    return [::crimp::remap $image {*}$maps]
}

proc ::crimp::threshold::global::middle {image} {
    set maps {}
    set stat [::crimp::statistics::basic $image]
    foreach c [dict get $stat channels] {
	lappend maps \
	    [::crimp::map threshold below \
		 [dict get $stat channel $c middle]]
    }
    return [::crimp::remap $image {*}$maps]
}

proc ::crimp::threshold::global::mean {image} {
    set maps {}
    set stat [::crimp::statistics::basic $image]
    foreach c [dict get $stat channels] {
	lappend maps \
	    [::crimp::map threshold below \
		 [dict get $stat channel $c mean]]
    }
    return [::crimp::remap $image {*}$maps]
}

proc ::crimp::threshold::global::median {image} {
    set maps {}
    set stat [::crimp::statistics::basic $image]
    foreach c [dict get $stat channels] {
	lappend maps \
	    [::crimp::map threshold below \
		 [dict get $stat channel $c median]]
    }
    return [::crimp::remap $image {*}$maps]
}

proc ::crimp::threshold::local {image args} {
    if {![llength $args]} {
	return -code error "wrong\#args: expected image map..."
    }

    set itype [::crimp::TypeOf $image]
    set mtype [::crimp::TypeOf [lindex $args 0]]

    foreach map $args {
	set xtype [::crimp::TypeOf $map]
	if {$xtype ne $mtype} {
	    return -code error "Map type mismatch between \"$mtype\" and \"$xtype\", all maps have to have the same type."
	}
    }

    set f threshold_${itype}_$mtype
    if {![::crimp::Has $f]} {
	return -code error "Unable to locally threshold images of type \"$itype\" with maps of type \"$mtype\""
    }

    # Shrink or extend the set of thresholding maps if too many or not
    # enough were specified, the latter by replicating the last map.

    switch -- $itype/$mtype {
	hsv/float - rgb/float -
	hsv/grey8 - rgb/grey8 {
	    if {[llength $args]} {
		while {[llength $args] < 3} {
		    lappend args [lindex $args end]
		}
	    }
	    if {[llength $args] > 3} {
		set args [lrange $args 0 2]
	    }
	}
	rgba/float -
	rgba/grey8 {
	    if {[llength $args]} {
		while {[llength $args] < 4} {
		    lappend args [lindex $args end]
		}
	    }
	    if {[llength $args] > 4} {
		set args [lrange $args 0 3]
	    }
	}
    }

    return [::crimp::$f $image {*}$args]
}

# # ## ### ##### ######## #############

proc ::crimp::gamma {image y} {
    remap $image [map gamma $y]
}

proc ::crimp::degamma {image y} {
    remap $image [map degamma $y]
}

# # ## ### ##### ######## #############

proc ::crimp::remap {image args} {
    set type [TypeOf $image]
    if {![Has map_$type]} {
	return -code error "Unable to re-map images of type \"$type\""
    }

    # Extend the set of maps if not enough were specified, by
    # replicating the last map, except for the alpha channel, where we
    # use identity.

    switch -- $type {
	hsv - rgb {
	    if {[llength $args]} {
		while {[llength $args] < 3} {
		    lappend args [lindex $args end]
		}
	    }
	}
	rgba {
	    if {[llength $args]} {
		while {[llength $args] < 3} {
		    lappend args [lindex $args end]
		}
		if {[llength $args] < 4} {
		    lappend args [map identity]
		}
	    }
	}
    }

    return [map_$type $image {*}$args]
}

# # ## ### ##### ######## #############

namespace eval ::crimp::contrast {
    namespace export {[0-9a-z]*}
    namespace ensemble create
}

proc ::crimp::contrast::normalize {image {percentile 5}} {
    set itype [::crimp::TypeOf $image]
    switch -exact -- $itype {
	rgb - rgba - hsv {
	    set sb [::crimp::statistics::basic $image]
	    set result {}
	    foreach chan [::crimp::split $image] name [dict get $sb channels] {
		if {$name ne "alpha"} {
		    set chan [NORM $chan $percentile [dict get $sb channel $name]]
		}
		lappend result $chan
	    }
	    return [::crimp::join::2$itype {*}$result]
	}
	grey8 {
	    return [NORM $image $percentile [dict get [::crimp::statistics::basic $image] channel luma]]
	}
	default {
	    return -code error "global histogram equalization not supported for image type \"$itype\""
	}
    }
}

proc ::crimp::contrast::NORM {image percentile statistics} {
    # GREY8 normalization (stretching).

    set mint [expr {$percentile*255./100}]
    set maxt [expr {255 - $mint}]
    set cdf  [dict get $statistics cdf255]

    set min 0
    foreach count $cdf {
	if {$count >= $mint} break
	incr min
    }

    set max 0
    foreach count $cdf {
	incr max
	if {$count >= $maxt} break
    }

    return [::crimp::remap $image [::crimp::map stretch $min $max]]
}

namespace eval ::crimp::contrast::equalize {
    namespace export {[0-9a-z]*}
    namespace ensemble create
}

proc ::crimp::contrast::equalize::local {image args} {

    set itype [::crimp::TypeOf $image]
    switch -exact -- $itype {
	rgb {
	    # Recursive invokation with conversion into and out of the
	    # proper type.
	    return [::crimp::convert::2rgb [local [::crimp::convert::2hsv $image] {*}$args]]
	}
	rgba {
	    # Recursive invokation, with conversion into and out of
	    # the proper type, making sure to leave the alpha-channel
	    # untouched.

	    return [crimp::alpha::set \
			[::crimp::convert::2rgb [local [::crimp::convert::2hsv $image] {*}$args]] \
			[lindex [::crimp::split $image] end]]
	}
	hsv {
	    # The equalization is done on the value/luma channel only.
	    lassign [::crimp::split $image] h s v
	    return [::crimp::join::2hsv $h $s [::crimp::filter::ahe $v {*}$args]]
	}
	grey8 {
	    return [::crimp::filter::ahe $image {*}$args]
	}
	default {
	    return -code error "local (adaptive) histogram equalization not supported for image type \"$itype\""
	}
    }
}

proc ::crimp::contrast::equalize::global {image} {
    set itype [::crimp::TypeOf $image]
    switch -exact -- $itype {
	rgb {
	    # Recursive invokation with conversion into and out of the
	    # proper type.
	    return [::crimp::convert::2rgb [global [::crimp::convert::2hsv $image]]]
	}
	rgba {
	    # Recursive invokation, with conversion into and out of
	    # the proper type, making sure to leave the alpha-channel
	    # untouched.

	    return [crimp::alpha::set \
			[::crimp::convert::2rgb [global [::crimp::convert::2hsv $image]]] \
			[lindex [::crimp::split $image] end]]
	}
	hsv {
	    lassign [::crimp::split $image] h s v
	    return [::crimp::join::2hsv $h $s [GLOBAL $v]]
	}
	grey8 {
	    return [GLOBAL $image]
	}
	default {
	    return -code error "global histogram equalization not supported for image type \"$itype\""
	}
    }
}

proc ::crimp::contrast::equalize::GLOBAL {image} {
    # GREY8 equalization.
    return [::crimp::remap $image \
		[crimp::mapof \
		     [::crimp::FIT \
			  [::crimp::CUMULATE \
			       [dict values [dict get [::crimp::histogram $image] luma]]] \
			  255]]]
}

# # ## ### ##### ######## #############

namespace eval ::crimp::color {
    namespace export {[0-9a-z]*}
    namespace ensemble create

    variable typecode crimp/colortransform
}

proc ::crimp::color::mix {image colortransform} {
    set itype [::crimp::TypeOf $image]
    if {$itype ni {rgb rgba hsv}} {
	return -code error "Unable to mix colors for image type $itype"
    }
    return [::crimp::color_mix $image [CHECK $colortransform]]
}

proc ::crimp::color::combine {image wa wb wc} {
    set itype [::crimp::TypeOf $image]
    if {$itype ni {rgb rgba hsv}} {
	return -code error "Unable to recombine colors for image type $itype"
    }

    return [::crimp::color_combine $image \
		[::crimp::read::tcl float [list [list $wa $wb $wc]]]
}

proc ::crimp::color::rgb2xyz {} {
    return [MAKE [XYZ]]
}

namespace eval ::crimp::color::xyz2lms {
    namespace export {[0-9a-z]*}
    namespace ensemble create
}

proc ::crimp::color::xyz2lms::cmccat97 {} {
    return [::crimp::color::MAKE [::crimp::color::LMS::CMCCAT97]]
}

proc ::crimp::color::xyz2lms::rlab {} {
    return [::crimp::color::MAKE [::crimp::color::LMS::RLAB]]
}

proc ::crimp::color::xyz2lms::ciecam97 {} {
    return [::crimp::color::MAKE [::crimp::color::LMS::CIECAM97]]
}

proc ::crimp::color::xyz2lms::ciecam02 {} {
    return [::crimp::color::MAKE [::crimp::color::LMS::CIECAM02]]
}

namespace eval ::crimp::color::rgb2lms {
    namespace export {[0-9a-z]*}
    namespace ensemble create
}

proc ::crimp::color::rgb2lms::cmccat97 {} {
    return [::crimp::color::MAKE \
		[::crimp::matmul3x3_float \
		     [::crimp::color::LMS::CMCCAT97] \
		     [::crimp::color::XYZ]]]
}

proc ::crimp::color::rgb2lms::rlab {} {
    return [::crimp::color::MAKE \
		[::crimp::matmul3x3_float \
		     [::crimp::color::LMS::RLAB] \
		     [::crimp::color::XYZ]]]
}

proc ::crimp::color::rgb2lms::ciecam97 {} {
    return [::crimp::color::MAKE \
		[::crimp::matmul3x3_float \
		     [::crimp::color::LMS::CIECAM97] \
		     [::crimp::color::XYZ]]]
}

proc ::crimp::color::rgb2lms::ciecam02 {} {
    return [::crimp::color::MAKE \
		[::crimp::matmul3x3_float \
		     [::crimp::color::LMS::CIECAM02] \
		     [::crimp::color::XYZ]]]
}

proc ::crimp::color::chain {t args} {
    if {[llength $args] == 0} {
	return $t
    }
    set args [linsert $args 0 $t]
    while {[llength $args] > 1} {
	set args [lreplace $args end-1 end \
		      [MAKE [::crimp::matmul3x3_float \
				 [CHECK [lindex $args end-1]] \
				 [CHECK [lindex $args end]]]]]
    }
    return [lindex $args 0]
}

proc ::crimp::color::make {a b c d e f g h i} {
    # Create the matrix for a color transform (3x3 float) from
    # the nine parameters.
    return [MAKE [::crimp::read::tcl float \
		[list \
		     [list $a $b $c] \
		     [list $d $e $f] \
		     [list $g $h $i]]]]
}

proc ::crimp::color::MAKE {m} {
    variable typecode
    return [list $typecode $m]
}

proc ::crimp::color::CHECK {transform {prefix {}}} {
    variable typecode
    if {
	[catch {llength $transform} len] ||
	($len != 2) ||
	([lindex $transform 0] ne $typecode) ||
	[catch {::crimp::TypeOf [set m [lindex $transform 1]]} t] ||
	($t ne "float") ||
	([::crimp::dimensions $m] ne {3 3})
    } {
	return -code error "${prefix}expected color transform, this is not it."
    }
    return $m
}

proc ::crimp::color::XYZ {} {
    # RGB to XYZ. Core matrix.
    # http://en.wikipedia.org/wiki/CIE_1931_color_space
    # http://en.wikipedia.org/wiki/CIE_1960_color_space
    # http://en.wikipedia.org/wiki/XYZ_color_space

    #    1    | 0.49    0.31    0.20	|   | 2.76883 1.75171 1.13014 |
    # ------- |	0.17697 0.81240 0.01063	| = | 1       4.59061 0.06007 |
    # 0.17697 |	0       0.01    0.99    |   | 0       0.05651 5.59417 |

    return [::crimp::read::tcl float {
	{2.76883087528959710685 1.75170932926484714923 1.13013505113861106402}
	{1                      4.59060857772503814205 0.06006667796801717805}
	{0                      0.05650675255693055320 5.59416850313612476690}
    }]
}

namespace eval ::crimp::color::LMS {}
# http://en.wikipedia.org/wiki/LMS_color_space

proc ::crimp::color::LMS::CMCCAT97 {} {
    # Core matrix XYZ to LMS per CMCCAT97.

    return [::crimp::read::tcl float {
	{ 0.8951  0.2664 -0.1614}
	{-0.7502  1.7135  0.0367}
	{ 0.0389 -0.0685  1.0296}
    }]
}

proc ::crimp::color::LMS::RLAB {} {
    # Core matrix XYZ to LMS per RLAB (D65).

    return [::crimp::read::tcl float {
	{ 0.4002 0.7076 -0.0808}
	{-0.2263 1.1653  0.0457}
	{ 0      0       0.9182}
    }]
}

proc ::crimp::color::LMS::CIECAM97 {} {
    # Core matrix XYZ to LMS per CIECAM97.

    return [::crimp::read::tcl float {
	{ 0.8562  0.3372 -0.1934}
	{-0.8360  1.8327  0.0033}
	{ 0.0357 -0.0469  1.0112}
    }]
}

proc ::crimp::color::LMS::CIECAM02 {} {
    # Core matrix XYZ to LMS per CIECAM02.

    return [::crimp::read::tcl float {
	{ 0.7328 0.4296 -0.1624}
	{-0.7036 1.6975  0.0061}
	{ 0.0030 0.0136  0.9834}
    }]
}

# # ## ### ##### ######## #############

proc ::crimp::integrate {image} {
    set type [TypeOf $image]
    set f integrate_$type
    if {![Has $f]} {
	return -code error "Unable to integrate images of type \"$type\""
    }

    return [$f $image]
}

# # ## ### ##### ######## #############

namespace eval ::crimp::downsample {
    namespace export *
    namespace ensemble create
}

proc ::crimp::downsample::xy {image factor} {
    set type [::crimp::TypeOf $image]
    set f downsample_$type
    if {![::crimp::Has $f]} {
	return -code error "Unable to downsample images of type \"$type\""
    }

    return [::crimp::$f $image $factor]
}

proc ::crimp::downsample::x {image factor} {
    set type [::crimp::TypeOf $image]
    set f downsamplex_$type
    if {![::crimp::Has $f]} {
	return -code error "Unable to downsample (x) images of type \"$type\""
    }

    return [::crimp::$f $image $factor]
}

proc ::crimp::downsample::y {image factor} {
    set type [::crimp::TypeOf $image]
    set f downsampley_$type
    if {![::crimp::Has $f]} {
	return -code error "Unable to downsample (y) images of type \"$type\""
    }

    return [::crimp::$f $image $factor]
}

# # ## ### ##### ######## #############

namespace eval ::crimp::upsample {
    namespace export *
    namespace ensemble create
}

proc ::crimp::upsample::xy {image factor} {
    set type [::crimp::TypeOf $image]
    set f upsample_$type
    if {![::crimp::Has $f]} {
	return -code error "Unable to upsample images of type \"$type\""
    }

    return [::crimp::$f $image $factor]
}

proc ::crimp::upsample::x {image factor} {
    set type [::crimp::TypeOf $image]
    set f upsamplex_$type
    if {![::crimp::Has $f]} {
	return -code error "Unable to upsample (x) images of type \"$type\""
    }

    return [::crimp::$f $image $factor]
}

proc ::crimp::upsample::y {image factor} {
    set type [::crimp::TypeOf $image]
    set f upsampley_$type
    if {![::crimp::Has $f]} {
	return -code error "Unable to upsample (y) images of type \"$type\""
    }

    return [::crimp::$f $image $factor]
}

# # ## ### ##### ######## #############

namespace eval ::crimp::decimate {
    namespace export *
    namespace ensemble create
}

# Combines downsampling with a pre-processing step applying a
# low-pass filter to avoid aliasing of higher image frequencies.

# We assume that the low-pass filter is separable, and the kernel is
# the 1-D horizontal form of it. We compute the vertical form on our
# own, transposing the kernel (if needed).

# NOTE: This implementation, while easy conceptually, is not very
# efficient, because it does the filtering on the input image, before
# downsampling.

# FUTURE: Write a C level primitive integrating the filter and
# sampler, computing the filter only for the pixels which go into the
# result.

proc ::crimp::decimate::xy {image factor kernel} {
    return [::crimp::downsample::xy \
		[::crimp::filter::convolve $image \
		     $kernel [::crimp::kernel::transpose $kernel]] \
		$factor]
}

proc ::crimp::decimate::x {image factor kernel} {
    return [::crimp::downsample::x \
		[::crimp::filter::convolve $image \
		     $kernel] \
		$factor]
}

proc ::crimp::decimate::y {image factor kernel} {
    return [::crimp::downsample::y \
		[::crimp::filter::convolve $image \
		     [::crimp::kernel::transpose $kernel]] \
		$factor]
}

# # ## ### ##### ######## #############

namespace eval ::crimp::interpolate {
    namespace export *
    namespace ensemble create
}

# Combines upsampling with a post-processing step applying a low-pass
# filter to remove copies of the image at higher image frequencies.

# We assume that the low-pass filter is separable, and the kernel is
# the 1-D horizontal form of it. We compute the vertical form on our
# own, transposing the kernel (if needed).

# NOTE: This implementation, while easy conceptually, is not very
# efficient, because it does the filtering on the full output image,
# after upsampling.

# FUTURE: Write a C level primitive integrating the filter and
# sampler, computing the filter only for the actually new pixels, and
# use polyphase restructuring.

# DANGER: This assumes that the filter, applied to the original pixels
# leaves them untouched. I.e. scaled center weight is 1.  The easy
# implementation here does not have this assumption.

proc ::crimp::interpolate::xy {image factor kernel} {
    return [::crimp::filter::convolve \
		[::crimp::upsample::xy $image $factor] \
		$kernel [::crimp::kernel::transpose $kernel]]
}

proc ::crimp::interpolate::x {image factor kernel} {
    return [::crimp::filter::convolve \
		[::crimp::upsample::x $image $factor] \
		$kernel]
}

proc ::crimp::interpolate::y {image factor kernel} {
    return [::crimp::filter::convolve \
		[::crimp::upsample::y $image $factor] \
		[::crimp::kernel::transpose $kernel]]
}

# # ## ### ##### ######## #############

proc ::crimp::split {image} {
    set type [TypeOf $image]
    if {![Has split_$type]} {
	return -code error "Unable to split images of type \"$type\""
    }
    return [split_$type $image]
}

# # ## ### ##### ######## #############

proc ::crimp::blank {type w h args} {
    if {![Has blank_$type]} {
	return -code error "Unable to create blank images of type \"$type\""
    }

    # Extend the set of channel values if not enough were specified,
    # by setting to them to BLACK or TRANSPARENT, respectively.

    switch -- $type {
	hsv - rgb {
	    if {[llength $args]} {
		while {[llength $args] < 3} {
		    lappend args 0
		}
	    }
	}
	rgba {
	    # black and transparent have the same raw value, 0. This
	    # obviates the need to handle the alpha channel
	    # separately.
	    if {[llength $args]} {
		while {[llength $args] < 4} {
		    lappend args 0
		}
	    }
	}
    }

    return [blank_$type $w $h {*}$args]
}

# # ## ### ##### ######## #############

proc ::crimp::expand {bordertype image ww hn we hs args} {
    # args = ?type-specific arguments?
    # currently only for bordertype 'const'. Default to (0 0 0 255).

    set type [TypeOf $image]

    lassign [BORDER $type [list $bordertype {*}$args]] f values

    return [$f $image $ww $hn $we $hs {*}$values]
}

# # ## ### ##### ######## #############

proc ::crimp::crop {image ww hn we hs} {
    set type [TypeOf $image]
    set f    crop_$type
    if {![::crimp::Has $f]} {
	return -code error "Cropping is not supported for images of type \"$type\""
    }
    return [::crimp::$f $image $ww $hn $we $hs]
}

proc ::crimp::cut {image x y w h} {
    lassign [dimensions $image] iw ih

    set south [expr {$y + $h}]
    set east  [expr {$x + $w}]
    if {$south > $ih} { set south $ih }
    if {$east  > $iw} { set east  $iw }
    set dw [expr {$iw - $east}]
    set dh [expr {$ih - $south}]

    return [crop $image $x $y $dw $dh]
}

# # ## ### ##### ######## #############

namespace eval ::crimp::alpha {
    namespace export *
    namespace ensemble create
}

# # ## ### ##### ######## #############
# NOTE: The use of the builtin 'set' command in the alpha namespace
# requires '::set'.

proc ::crimp::alpha::set {image mask} {
    ::set itype [::crimp::TypeOf $image]
    ::set mtype [::crimp::TypeOf $mask]
    ::set f     setalpha_${itype}_$mtype
    if {![::crimp::Has $f]} {
	return -code error "Setting the alpha channel is not supported for images of type \"$itype\" and mask of type \"$mtype\""
    }
    return [::crimp::$f $image $mask]
}

# # ## ### ##### ######## #############

proc ::crimp::alpha::opaque {image} {
    ::set itype [::crimp::TypeOf $image]
    if {$itype ne "rgba"} { return $image }
    # alpha::set
    return [set $image \
		[::crimp::blank grey8 \
		     {*}[::crimp::dimensions $image] 255]]
}

# # ## ### ##### ######## #############

proc ::crimp::alpha::blend {fore back alpha} {
    ::set ftype [::crimp::TypeOf $fore]
    ::set btype [::crimp::TypeOf $back]
    ::set f     alpha_blend_${ftype}_$btype
    if {![::crimp::Has $f]} {
	return -code error "Blend is not supported for a foreground of type \"$ftype\" and a background of type \"$btype\""
    }
    return [::crimp::$f $fore $back [::crimp::table::CLAMP $alpha]]
}

# # ## ### ##### ######## #############

proc ::crimp::alpha::over {fore back} {
    ::set ftype [::crimp::TypeOf $fore]
    ::set btype [::crimp::TypeOf $back]
    ::set f     alpha_over_${ftype}_$btype
    if {![::crimp::Has $f]} {
	return -code error "Over is not supported for a foreground of type \"$ftype\" and a background of type \"$btype\""
    }
    return [::crimp::$f $fore $back]
}

# # ## ### ##### ######## #############

proc ::crimp::add {a b {scale 1} {offset 0}} {
    set atype [TypeOf $a]
    set btype [TypeOf $b]

    set f add_${atype}_$btype
    if {[Has $f]} {
	return [$f $a $b $scale $offset]
    }

    if {$atype ne $btype} {
	set f add_${btype}_$atype
	if {[Has $f]} {
	    return [$f $b $a $scale $offset]
	}
    }

    return -code error "Add is not supported for the combination of \"$atype\" and \"$btype\""
}

# # ## ### ##### ######## #############

proc ::crimp::subtract {a b {scale 1} {offset 0}} {
    set atype [TypeOf $a]
    set btype [TypeOf $b]
    set f     subtract_${atype}_$btype
    if {![Has $f]} {
	return -code error "Subtract is not supported for the combination of \"$atype\" and \"$btype\""
    }
    return [$f $a $b $scale $offset]
}

# # ## ### ##### ######## #############

proc ::crimp::difference {a b} {
    set atype [TypeOf $a]
    set btype [TypeOf $b]

    set f difference_${atype}_$btype
    if {[Has $f]} {
	return [$f $a $b]
    }

    if {$atype ne $btype} {
	set f difference_${btype}_$atype
	if {[Has $f]} {
	    return [$f $b $a]
	}
    }

    return -code error "Difference is not supported for the combination of \"$atype\" and \"$btype\""
}

# # ## ### ##### ######## #############

proc ::crimp::square {a} {
    return [multiply $a $a]
}

proc ::crimp::multiply {a b} {
    set atype [TypeOf $a]
    set btype [TypeOf $b]

    set f multiply_${atype}_$btype
    if {[Has $f]} {
	return [$f $a $b]
    }

    if {$atype ne $btype} {
	set f multiply_${btype}_$atype
	if {[Has $f]} {
	    return [$f $b $a]
	}
    }

    return -code error "Multiply is not supported for the combination of \"$atype\" and \"$btype\""
}

# # ## ### ##### ######## #############

proc ::crimp::hypot {a b} {
    set atype [TypeOf $a]
    set btype [TypeOf $b]

    set f hypot_${atype}_$btype
    if {[Has $f]} {
	return [$f $a $b]
    }

    if {$atype ne $btype} {
	set f hypot_${btype}_$atype
	if {[Has $f]} {
	    return [$f $b $a]
	}
    }

    return -code error "Hypot is not supported for the combination of \"$atype\" and \"$btype\""
}

# # ## ### ##### ######## #############

proc ::crimp::divide {a b {scale 1} {offset 0}} {
    set atype [TypeOf $a]
    set btype [TypeOf $b]
    set f     div_${atype}_$btype
    if {![Has $f]} {
	return -code error "Division is not supported for the combination of \"$atype\" and \"$btype\""
    }
    return [$f $a $b $scale $offset]
}

# # ## ### ##### ######## #############

proc ::crimp::atan2 {a b} {
    set atype [TypeOf $a]
    set btype [TypeOf $b]
    set f     atan2_${atype}_$btype
    if {![Has $f]} {
	return -code error "atan2 is not supported for the combination of \"$atype\" and \"$btype\""
    }
    return [$f $a $b]
}

# # ## ### ##### ######## #############
## min aka 'darker' as the less brighter of each pixel is chosen.

proc ::crimp::min {a b} {
    set atype [TypeOf $a]
    set btype [TypeOf $b]

    set f min_${atype}_$btype
    if {[Has $f]} {
	return [$f $a $b]
    }

    if {$atype ne $btype} {
	set f min_${btype}_$atype
	if {[Has $f]} {
	    return [$f $b $a]
	}
    }

    return -code error "Min is not supported for the combination of \"$atype\" and \"$btype\""
}

# # ## ### ##### ######## #############
## max aka 'lighter' as the brighter of each pixel is chosen.

proc ::crimp::max {a b} {
    set atype [TypeOf $a]
    set btype [TypeOf $b]

    set f max_${atype}_$btype
    if {[Has $f]} {
	return [$f $a $b]
    }

    if {$atype ne $btype} {
	set f max_${btype}_$atype
	if {[Has $f]} {
	    return [$f $b $a]
	}
    }

    return -code error "Max is not supported for the combination of \"$atype\" and \"$btype\""
}

# # ## ### ##### ######## #############
## This operation could be done at this level, using a combination of
## 'multiply' and 'invert'. Doing it in C on the other hand avoids the
## three temporary images of such an implementation.

proc ::crimp::screen {a b} {
    set atype [TypeOf $a]
    set btype [TypeOf $b]

    set f screen_${atype}_$btype
    if {[Has $f]} {
	return [$f $a $b]
    }

    if {$atype ne $btype} {
	set f screen_${btype}_$atype
	if {[Has $f]} {
	    return [$f $b $a]
	}
    }

    return -code error "Screen is not supported for the combination of \"$atype\" and \"$btype\""
}

# # ## ### ##### ######## #############

namespace eval ::crimp::filter {
    namespace export {[a-z]*}
    namespace ensemble create
}

# # ## ### ##### ######## #############

proc ::crimp::filter::convolve {image args} {
    # args = ?-border spec? kernel...

    set type [::crimp::TypeOf $image]
    set fc convolve_*_${type}
    if {![llength [::crimp::List $fc]]} {
	return -code error "Convolution is not supported for image type \"$type\""
    }

    # Default settings for border expansion.
    lassign [::crimp::BORDER $type const] fe values

    set at 0
    while {1} {
	set opt [lindex $args $at]
	if {![string match -* $opt]} break
	incr at
	switch -- $opt {
	    -border {
		set value [lindex $args $at]
		lassign [::crimp::BORDER $type $value] fe values
		incr at
	    }
	    default {
		return -code error "Unknown option \"$opt\", expected -border"
	    }
	}
    }
    set args [lrange $args $at end]
    if {![llength $args]} {
	return -code error "wrong#args: expected image ?-border spec? kernel..."
    }

    # kernel = list (kw kh kernel-image scale)
    # Kernel x in [-kw ... kw], 2*kw+1 values
    # Kernel y in [-kh ... kh], 2*kh+1 values
    # Shrinkage by 2*kw, 2*kh. Compensate using the chosen border type.

    foreach kernel $args {
	lassign $kernel kw kh K scale offset

	set ktype [::crimp::TypeOf $K]
	set fc convolve_${ktype}_${type}
	if {![::crimp::Has $fc]} {
	    return -code error "Convolution kernel type \"$ktype\" is not supported for image type \"$type\""
	}

	set image [::crimp::$fc \
		       [::crimp::$fe $image $kw $kh $kw $kh {*}$values] \
		       $K $scale $offset]
    }

    return $image
}

# # ## ### ##### ######## #############

proc ::crimp::filter::ahe {image args} {
    # args = ?-border spec? ?radius?

    set type [::crimp::TypeOf $image]
    set fc ahe_${type}
    if {![::crimp::Has $fc]} {
	return -code error "AHE filtering is not supported for image type \"$type\""
    }

    # Default settings for border expansion.
    lassign [::crimp::BORDER $type const] fe values

    set at 0
    while {1} {
	set opt [lindex $args $at]
	if {![string match -* $opt]} break
	incr at
	switch -- $opt {
	    -border {
		set value [lindex $args $at]
		lassign [::crimp::BORDER $type $value] fe values
		incr at
	    }
	    default {
		return -code error "Unknown option \"$opt\", expected -border"
	    }
	}
    }
    set args [lrange $args $at end]

    switch -- [llength $args] {
	0 { set radius 3                }
	1 { set radius [lindex $args 0] }
	default {
	    return -code error "wrong#args: expected image ?-border spec? ?radius?"
	}
    }

    # Shrinkage by 2*radius. Compensate using the chosen border type.

    return [::crimp::$fc \
		[::crimp::$fe $image $radius $radius $radius $radius {*}$values] \
		$radius]
}

# # ## ### ##### ######## #############

proc ::crimp::filter::mean {image args} {
    # args = ?-border spec? ?radius?

    set type [::crimp::TypeOf $image]

    # Multi-channel images are handled by splitting them and
    # processing each channel separately (invoking the method
    # recursively).
    switch -exact -- $type {
	rgb - rgba - hsv {
	    set r {}
	    foreach c [::crimp::split $image] {
		lappend r [mean $c {*}$args]
	    }
	    return [::crimp::join 2$type {*}$r]
	}
    }

    # Instead of using the histogram-based framework underlying the
    # rank and ahe filters we implement the mean filter via summed
    # area tables (see method integrate), making the computation
    # independent of the filter radius.

    # Our standard border expansion is also not const, but 'mirror',
    # as this is the only setting which will not warp the mean at the
    # image edges.

    # Default settings for border expansion.
    lassign [::crimp::BORDER $type mirror] fe values

    set at 0
    while {1} {
	set opt [lindex $args $at]
	if {![string match -* $opt]} break
	incr at
	switch -- $opt {
	    -border {
		set value [lindex $args $at]
		lassign [::crimp::BORDER $type $value] fe values
		incr at
	    }
	    default {
		return -code error "Unknown option \"$opt\", expected -border"
	    }
	}
    }
    set args [lrange $args $at end]
    switch -- [llength $args] {
	0 { set radius 3                }
	1 { set radius [lindex $args 0] }
	default {
	    return -code error "wrong#args: expected image ?-border spec? ?radius?"
	}
    }

    # Shrinkage is by 2*(radius+1). Compensate using the chosen border type.
    set expand [expr {$radius + 1}]
    set factor [expr {1./((2*$radius+1)**2)}]

    return [::crimp::convert 2$type \
		[::crimp::scale_float \
		     [::crimp::region_sum \
			  [::crimp::integrate \
			       [::crimp::$fe $image $expand $expand $expand $expand {*}$values]] \
			  $radius] $factor]]
}

# # ## ### ##### ######## #############

proc ::crimp::filter::stddev {image args} {
    # args = ?-border spec? ?radius?

    set type [::crimp::TypeOf $image]

    # Multi-channel images are not handled, because the output is a
    # float, which we cannot join.
    if {[llength [::crimp::channels $image]] > 1} {
	    return -code error "Unable to process multi-channel images"
    }

    # Instead of using the histogram-based framework underlying the
    # rank and ahe filters we implement the stddev filter via summed
    # area tables (see method integrate), making the computation
    # independent of the filter radius.

    # Our standard border expansion is also not const, but 'mirror',
    # as this is the only setting which will not warp the mean at the
    # image edges.

    # Default settings for border expansion.
    lassign [::crimp::BORDER $type mirror] fe values

    set at 0
    while {1} {
	set opt [lindex $args $at]
	if {![string match -* $opt]} break
	incr at
	switch -- $opt {
	    -border {
		set value [lindex $args $at]
		lassign [::crimp::BORDER $type $value] fe values
		incr at
	    }
	    default {
		return -code error "Unknown option \"$opt\", expected -border"
	    }
	}
    }
    set args [lrange $args $at end]
    switch -- [llength $args] {
	0 { set radius 3                }
	1 { set radius [lindex $args 0] }
	default {
	    return -code error "wrong#args: expected image ?-border spec? ?radius?"
	}
    }

    # Compute and return stddev.
    return [lindex [MEAN_STDDEV $image $radius $fe $values] 1]
}

proc ::crimp::filter::MEAN_STDDEV {image radius fe values} {
    # Shrinkage is by 2*(radius+1). Compensate using the chosen border type.
    set expand [expr {$radius + 1}]
    set factor [expr {1./((2*$radius+1)**2)}]

    # Compute mean and stddev ...

    set expanded [::crimp::$fe $image $expand $expand $expand $expand {*}$values]
    set mean     [::crimp::scale_float \
		      [::crimp::region_sum \
			   [::crimp::integrate $expanded] \
			   $radius] \
		      $factor]
    set stddev   [::crimp::sqrt_float \
		      [::crimp::subtract \
			   [::crimp::scale_float \
				[::crimp::region_sum \
				     [::crimp::integrate \
					  [::crimp::square \
					       [::crimp::convert::2float $expanded]]] \
				     $radius] \
				$factor] \
			   [::crimp::square $mean]]]

    return [list $mean $stddev]
}

# # ## ### ##### ######## #############

proc ::crimp::filter::rank {image args} {
    # args = ?-border spec? ?radius ?percentile??

    set type [::crimp::TypeOf $image]
    set fc rof_${type}
    if {![::crimp::Has $fc]} {
	return -code error "Rank filtering is not supported for image type \"$type\""
    }

    # Default settings for border expansion.
    lassign [::crimp::BORDER $type const] fe values

    set at 0
    while {1} {
	set opt [lindex $args $at]
	if {![string match -* $opt]} break
	incr at
	switch -- $opt {
	    -border {
		set value [lindex $args $at]
		lassign [::crimp::BORDER $type $value] fe values
		incr at
	    }
	    default {
		return -code error "Unknown option \"$opt\", expected -border"
	    }
	}
    }
    set args [lrange $args $at end]
    switch -- [llength $args] {
	0 { set radius 3                ; set percentile 50 }
	1 { set radius [lindex $args 0] ; set percentile 50 }
	2 { lassign $args radius percentile }
	default {
	    return -code error "wrong#args: expected image ?-border spec? ?radius ?percentile??"
	}
    }

    # percentile is float. convert to integer, and constrain range.

    set percentile [expr {round(100*$percentile)}]
    if {$percentile < 0     } { set percentile     0 }
    if {$percentile > 10000 } { set percentile 10000 }

    # Shrinkage by 2*radius. Compensate using the chosen border type.

    return [::crimp::$fc \
		[::crimp::$fe $image $radius $radius $radius $radius {*}$values] \
		$radius $percentile]
}

# # ## ### ##### ######## #############

namespace eval ::crimp::filter::gauss {
    namespace export discrete sampled
    namespace ensemble create
}

proc ::crimp::filter::gauss::discrete {image sigma {r {}}} {
    set Kx [::crimp::kernel::fpmake [::crimp::table::fgauss::discrete $sigma $r]]
    set Ky [::crimp::kernel::transpose $Kx]
    return [::crimp::filter::convolve $image $Kx $Ky]
}

proc ::crimp::filter::gauss::sampled {image sigma {r {}}} {
    set Kx [::crimp::kernel::fpmake [::crimp::table::fgauss::sampled $sigma $r]]
    set Ky [::crimp::kernel::transpose $Kx]
    return [::crimp::filter::convolve $image $Kx $Ky]
}

# # ## ### ##### ######## #############
# Related reference:
# http://www.holoborodko.com/pavel/image-processing/edge-detection/

namespace eval ::crimp::filter::sobel {
    namespace export x y
    namespace ensemble create

}

proc ::crimp::filter::sobel::x {image} {
    # |-1 0 1|            |1|
    # |-2 0 2| = |-1 0 1|*|2|
    # |-1 0 1|            |1|

    return [::crimp::filter::convolve $image \
		[::crimp::kernel::fpmake {{-1  0 1}} 0] \
		[::crimp::kernel::fpmake {{{1} {2} {1}}} 0]]
}

proc ::crimp::filter::sobel::y {image} {
    # |-1 -2 -1|   |-1|
    # | 0  0  0| = | 0|*|1 2 1|
    # | 1  2  1|   | 1|

    return [::crimp::filter::convolve $image \
		[::crimp::kernel::transpose [::crimp::kernel::fpmake {{-1 0 1}} 0]] \
		[::crimp::kernel::fpmake {{1 2 1}} 0]]
}

# # ## ### ##### ######## #############

namespace eval ::crimp::filter::scharr {
    namespace export x y
    namespace ensemble create

}

proc ::crimp::filter::scharr::x {image} {
    # | -3 0  3|            | 3|
    # |-10 0 10| = |-1 0 1|*|10|
    # | -3 0  3|            | 3|

    return [::crimp::filter::convolve $image \
		[::crimp::kernel::fpmake {{-1  0 1}} 0] \
		[::crimp::kernel::transpose [::crimp::kernel::fpmake {{3 10 3}} 0]]]
}

proc ::crimp::filter::scharr::y {image} {
    # |-3 -10 -3|   |-1|
    # | 0   0  0| = | 0|*|3 10 3|
    # | 3  10  3|   | 1|

    return [::crimp::filter::convolve $image \
		[::crimp::kernel::transpose [::crimp::kernel::fpmake {{-1 0 1}} 0]] \
		[::crimp::kernel::fpmake {{3 10 3}} 0]]
}

# # ## ### ##### ######## #############

namespace eval ::crimp::filter::prewitt {
    namespace export x y
    namespace ensemble create
}

proc ::crimp::filter::prewitt::x {image} {
    # |-1 0 1|            |1|
    # |-1 0 1| = |-1 0 1|*|1|
    # |-1 0 1|            |1|

    return [::crimp::filter::convolve $image \
		[::crimp::kernel::fpmake {{-1  0 1}} 0] \
		[::crimp::kernel::transpose [::crimp::kernel::fpmake {{1 1 1}} 0]]]
}

proc ::crimp::filter::prewitt::y {image} {
    # |-1 -1 -1|   |-1|
    # | 0  0  0| = | 0|*|1 1 1|
    # | 1  1  1|   | 1|

    return [::crimp::filter::convolve $image \
		[::crimp::kernel::transpose [::crimp::kernel::fpmake {{-1 0 1}} 0]] \
		[::crimp::kernel::fpmake {{1 1 1}} 0]]
}

# # ## ### ##### ######## #############

namespace eval ::crimp::gradient {
    namespace export {[a-z]*}
    namespace ensemble create
}

# TODO gradient via laplace directly, or as difference of gaussians.

proc ::crimp::gradient::sobel {image} {
    return [list \
		[::crimp::filter::sobel::x $image] \
		[::crimp::filter::sobel::y $image]]
}

proc ::crimp::gradient::scharr {image} {
    return [list \
		[::crimp::filter::scharr::x $image] \
		[::crimp::filter::scharr::y $image]]
}

proc ::crimp::gradient::prewitt {image} {
    return [list \
		[::crimp::filter::prewitt::x $image] \
		[::crimp::filter::prewitt::y $image]]
}

proc ::crimp::gradient::polar {cgradient} {
    # cgradient = list (Gx Gy), c for cartesian
    # result = polar = list (magnitude angle) (hypot, atan2 (gy, gx))
    lassign $cgradient x y
    return [list \
		[::crimp::hypot $y $x] \
		[::crimp::atan2 $y $x]]
}

proc ::crimp::gradient::visual {pgradient} {
    # pgradient = list (magnitude angle), p for polar
    # result = HSV encoding magnitude as value, and angle as hue.
    # saturation is full.
    lassign $pgradient m a
    set h [::crimp::FITFLOATRANGE $a 0 360]
    set s [::crimp::blank grey8 {*}[crimp dimensions $m] 255]
    set v [::crimp::FITFLOAT $m]
    return [::crimp::convert::2rgb [::crimp::join::2hsv $h $s $v]]
}

# # ## ### ##### ######## #############
## Commands for the creation and manipulation of transformation
## matrices. We are using 3x3 matrices to allow the full range of
## projective transforms, i.e. perspective.

namespace eval ::crimp::transform {
    namespace export {[a-z]*}
    namespace ensemble create
    namespace import ::tcl::mathfunc::*
    namespace import ::tcl::mathop::*

    variable typecode crimp/transform
}

proc ::crimp::transform::projective {a b c d e f g h} {
    #                   | a b c |
    # Create the matrix | d e f | for a projective transform.
    #		        | g h 1 |

    return [MAKE [::crimp::read::tcl float \
		[list \
		     [list $a $b $c] \
		     [list $d $e $f] \
		     [list $g $h 1]]]]
}

proc ::crimp::transform::affine {a b c d e f} {
    # An affine transform is a special case of the projective, without
    # perspective warping. Its matrix is | a b c |
    #                                    | d e f |
    return [projective $a $b $c $d $e $f 0 0]
}

proc ::crimp::transform::translate {dx dy} {
    # Translate in the x, y directions
    return [affine 1 0 $dx 0 1 $dy]
}

proc ::crimp::transform::scale {sx sy} {
    # Scale in the x, y directions
    return [affine $sx 0 0 0 $sy 0]
}

proc ::crimp::transform::shear {sx sy} {
    # Shear in the x, y directions
    return [affine 1 $sx $sy 1 0 0]
}

namespace eval ::crimp::transform::reflect {
    namespace export line x y
    namespace ensemble create
    # TODO line segment (arbitrary line).
}

proc ::crimp::transform::reflect::line {lx ly} {
    # Reflect along the line (lx, ly) through the origin.
    # This can be handled as a chain of
    # (a) rotation through the origin to map the line to either x- or y-axis
    # (b) reflection along the chosen axis,
    # (c) and rotation back to the chosen line.
    # Here we use the direct approach.
    # See http://en.wikipedia.org/wiki/Transformation_matrix

    # Note: A reflection through an arbitrary line (i.e. not through
    # the origin), needs two additional steps. After the first
    # rotation the line is parallel to an axis, and has to be
    # translated on it. Ditto we have to undo the translation before
    # rotating back. As the rotation is through an arbitray point it
    # also needs translations, which can be combined, by proper choice
    # of the rotation point.

    set a [expr {$lx*$lx-$ly*$ly}]
    set b [expr {2*$lx*$ly}]
    set c [expr {$ly*$ly-$lx*$lx}]
    return [affine $a $b 0 $b $c 0]
}

proc ::crimp::transform::reflect::x {} {
    # Reflect along the x-axis.
    return [affine -1 0 0 1 0 0]
}

proc ::crimp::transform::reflect::y {} {
    # Reflect along the y-axis
    return [affine 1 0 0 -1 0 0]
}

proc ::crimp::transform::rotate {theta {p {0 0}}} {
    # Rotate around around a point, by default (0,0), i.e. the upper
    # left corner. Rotation around any other point is done by
    # translation that point to (0,0), rotating, and then translating
    # everything back.

    # convert angle from degree to radians.
    set s  [sin [* $theta 0.017453292519943295769236907684886]]
    set c  [cos [* $theta 0.017453292519943295769236907684886]]
    set sn [- $s]

    set r [affine $c $s 0 $sn $c 0]
    if {$p ne {0 0}} {
	lassign $p x y
	set dx [- $x]
	set dy [- $y]
	set r [chain [translate $x $y] $r [translate $dx $dy]]
    }

    return $r
}

proc ::crimp::transform::quadrilateral {src dst} {
    # A quadrilateral is a set of 4 arbitrary points connected by
    # lines, convex. It is the most general form of a convex polygon
    # through 4 points.
    #
    # A transform based on quadrilaterals maps from a source quad to a
    # destination quad. This can be captured as perspective, i.e.
    # projective transform.

    return [chain [Q2UNIT $dst] [invert [Q2UNIT $src]]]
    #              ~~~~~~~~~~~   ~~~~~~~~~~~~~~~~
    #         unit rect -> dst   src -> unit rect
}

proc ::crimp::transform::chain {t args} {
    if {[llength $args] == 0} {
	return $t
    }
    set args [linsert $args 0 $t]
    while {[llength $args] > 1} {
	set args [lreplace $args end-1 end \
		      [MAKE [::crimp::matmul3x3_float \
				 [CHECK [lindex $args end-1]] \
				 [CHECK [lindex $args end]]]]]
    }
    return [lindex $args 0]
}

proc ::crimp::transform::invert {a} {
    return [MAKE [::crimp::matinv3x3_float [CHECK $a]]]
}

proc ::crimp::transform::Q2UNIT {quad} {
    # Calculate the transform from the unit rectangle to the specified
    # quad.
    # Derived from the paper.
    # A Planar Perspective Image Matching using Point Correspondences and Rectangle-to-Quadrilateral Mapping
    # Dong-Keun Kim, Byung-Tae Jang, Chi-Jung Hwang
    # http://portal.acm.org/citation.cfm?id=884607
    # http://www.informatik.uni-trier.de/~ley/db/conf/ssiai/ssiai2002.html

    lassign $quad pa pb pc pd
    lassign $pa ax ay
    lassign $pb bx by
    lassign $pc cx cy
    lassign $pd dx dy

    set dxb [expr {$bx - $cx}]
    set dxc [expr {$dx - $cx}]
    set dxd [expr {$ax - $bx + $cx - $dx}]

    set dyb [expr {$by - $cy}]
    set dyc [expr {$dy - $cy}]
    set dyd [expr {$ay - $by + $cy - $dy}]

    set D [expr {($dxb*$dyc - $dyb*$dxc)}]
    set g [expr {($dxd*$dyd - $dxc*$dyd)/double($D)}]
    set h [expr {($dxb*$dyd - $dyb*$dxd)/double($D)}]

    set a [expr {$bx * (1+$g) - $ax}]
    set b [expr {$dx * (1+$h) - $ax}]
    set c $ax

    set d [expr {$by * (1+$g) - $ay}]
    set e [expr {$dy * (1+$h) - $ay}]
    set f $ay

    return [projective $a $b $c $d $e $f $g $h]
}

proc ::crimp::transform::MAKE {m} {
    variable typecode
    return [list $typecode $m]
}

proc ::crimp::transform::CHECK {transform {prefix {}}} {
    variable typecode
    if {
	[catch {llength $transform} len] ||
	($len != 2) ||
	([lindex $transform 0] ne $typecode) ||
	[catch {::crimp::TypeOf [set m [lindex $transform 1]]} t] ||
	($t ne "float") ||
	([::crimp::dimensions $m] ne {3 3})
    } {
	return -code error "${prefix}expected projective transform, this is not it."
    }
    return $m
}

# # ## ### ##### ######## #############
## warping images

namespace eval ::crimp::warp {
    namespace export {[a-z]*}
    namespace ensemble create
}

# Alt syntax: Single vector field, this will require a 2d-float type.
proc ::crimp::warp::field {args} {
    return [Field [::crimp::INTERPOLATE args] {*}$args]
}

proc ::crimp::warp::Field {interpolation image xvec yvec} {
    # General warping. Two images of identical size in all dimensions
    # providing for each pixel of the result the x and y coordinates
    # in the input image to sample from.

    if {[::crimp::dimensions $xvec] ne [::crimp::dimensions $yvec]} {
	return -code error "Unable to warp, expected equally-sized coordinate fields"
    }

    set xvec [::crimp::convert::2float $xvec]
    set yvec [::crimp::convert::2float $yvec]

    set rtype [::crimp::TypeOf $image]
    if {$rtype in {rgb rgba hsv grey8}} {
	set ftype mbyte
    } else {
	set ftype $rtype
    }

    set f warp_${ftype}_field_$interpolation
    if {![::crimp::Has $f]} {
	return -code error "Unable to warp, the image type ${rtype} is not supported for $interpolation interpolation"
    }

    return [::crimp::$f $image $xvec $yvec]
}

proc ::crimp::warp::projective {args} {
    return [Projective [::crimp::INTERPOLATE args] {*}$args]
}

proc ::crimp::warp::Projective {interpolation image transform} {
    # Warping using a projective transform. We could handle this by
    # computing src coordinates, saved into float fields, and then
    # calling on the general 'warp'. However, this is so common that
    # we have a special primitive which does all that in less memory.

    set rtype [::crimp::TypeOf $image]
    if {$rtype in {rgb rgba hsv grey8}} {
	set ftype mbyte
    } else {
	set ftype $rtype
    }

    set f warp_${ftype}_projective_$interpolation
    if {![::crimp::Has $f]} {
	return -code error "Unable to warp, the image type ${rtype} is not supported for $interpolation interpolation"
    }

    return [::crimp::$f $image [::crimp::transform::CHECK $transform "Unable to warp, "]]
}

# # ## ### ##### ######## #############

namespace eval ::crimp::kernel {
    namespace export *
    namespace ensemble create
}

proc ::crimp::kernel::make {kernelmatrix {scale {}} {offset {}}} {
    # The input matrix is signed -128...127. Convert this into the
    # range 0..255, 2-complement notation.

    set tmpmatrix {}
    set tmpscale 0
    foreach r $kernelmatrix {
	set tmprow {}
	foreach v $r {
	    set v [::crimp::table::CLAMPS $v]
	    incr tmpscale $v ; # scale is computed before converting unsigned two-complement.
	    set v [expr {($v >= 0) ? $v : (256+$v)}]
	    lappend tmprow $v
	}
	lappend tmpmatrix $tmprow
    }

    # auto-scale, if needed
    if {$scale eq {}} {
	if {$tmpscale == 0} {
	    set scale 1
	} else {
	    set scale $tmpscale
	}
    }

    # auto-offset, if needed
    if {$offset eq {}} {
	if {$tmpscale == 0} {
	    set offset 128
	} else {
	    set offset 0
	}
    }

    set kernel [::crimp::read::tcl grey8 $tmpmatrix]

    lassign [::crimp::dimensions $kernel] w h

    if {!($w % 2) || !($h % 2)} {
	# Keep in sync with the convolve primitives.
	# FUTURE :: Have an API to set the messages used by the primitives.
	return -code error "bad kernel dimensions, expected odd size"
    }

    set kw [expr {$w/2}]
    set kh [expr {$h/2}]

    return [list $kw $kh $kernel $scale $offset]
}

proc ::crimp::kernel::fpmake {kernelmatrix {offset {}}} {
    set matsum 0
    foreach row $kernelmatrix {
	foreach v $row {
	    set matsum [expr {$matsum + $v}]
	}
    }

    # auto-offset, if needed
    if {$offset eq {}} {
	# TODO :: Check against a suitable epsilon instead of exact zero.
	if {$matsum == 0} {
	    set offset 128
	} else {
	    set offset 0
	}
    }

    set kernel [::crimp::read::tcl float $kernelmatrix]

    lassign [::crimp::dimensions $kernel] w h

    if {!($w % 2) || !($h % 2)} {
	# Keep in sync with the convolve primitives.
	# FUTURE :: Have an API to set the messages used by the primitives.
	return -code error "bad kernel dimensions, expected odd size"
    }

    set kw [expr {$w/2}]
    set kh [expr {$h/2}]

    # The scale is fixed at 1, fp-kernels are assumed to have any
    # scaling built in.
    return [list $kw $kh $kernel 1 $offset]
}


proc ::crimp::kernel::transpose {kernel} {
    lassign $kernel w h K scale offset
    set Kt [::crimp::flip::transpose $K]
    return [list $h $w $Kt $scale $offset]
}

# # ## ### ##### ######## #############
## Image pyramids

namespace eval ::crimp::pyramid {
    namespace export *
    namespace ensemble create
}

proc ::crimp::pyramid::run {image steps stepfun} {
    set     res {}
    lappend res $image

    set iter $image
    while {$steps > 0} {
	lassign [{*}$stepfun $iter] result iter
	lappend res $result
	incr steps -1
    }
    lappend res $iter
    return $res
}

proc ::crimp::pyramid::gauss {image steps} {
    lrange [run $image $steps [list ::apply {{kernel image} {
	set low [::crimp::decimate::xy $image 2 $kernel]
	return [list $low $low]
    }} [::crimp::kernel::make {{1 4 6 4 1}}]]] 0 end-1
}

proc ::crimp::pyramid::laplace {image steps} {
    run $image $steps [list ::apply {{kerneld kerneli image} {
	set low  [::crimp::decimate::xy    $image 2 $kerneld]
	set up   [::crimp::interpolate::xy $low   2 $kerneli]

	# Handle problem with input image size not a multiple of
	# two. Then the interpolated result is smaller by one pixel.
	set dx [expr {[::crimp::width $image] - [::crimp::width $up]}]
	if {$dx > 0} {
	    set up [::crimp::expand const $up 0 0 $dx 0]
	}
	set dy [expr {[::crimp::height $image] - [::crimp::height $up]}]
	if {$dy > 0} {
	    set up [::crimp::expand const $up 0 0 0 $dy]
	}

	set high [::crimp::subtract $image $up]
	return [list $high $low]
    }} [::crimp::kernel::make {{1 4 6 4 1}}] \
       [::crimp::kernel::make {{1 4 6 4 1}} 8]]
}

# # ## ### ##### ######## #############

namespace eval ::crimp::fft {
    namespace export {[a-z]*}
    namespace ensemble create
}

proc ::crimp::fft::forward {image} {
    set type [::crimp::TypeOf $image]
    set f fftx_$type
    if {![::crimp::Has $f]} {
	return -code error "Unable to fourier transform images of type \"$type\""
    }

    # 2d-fft as sequence of 1d-fft's, first horizontal, then vertical.
    # As a shortcut to the implementation the vertical is done by
    # transposing, horizontal fftp, and transposing back.  This
    # sequence will be replaced by a vertical fftp primitive when we
    # have it (And the transpositions will be implicit in its
    # implementation). As the result of the fft is a float-type image
    # we directly call on the appropriate primitives without the need
    # for dynamic dispatch.

    return [::crimp::flip_transpose_float \
		[::crimp::fftx_float \
		     [::crimp::flip_transpose_float \
			  [::crimp::$f $image]]]]
}

proc ::crimp::fft::backward {image} {
    set type [::crimp::TypeOf $image]
    set f ifftx_$type
    if {![::crimp::Has $f]} {
	return -code error "Unable to reverse fourier transform images of type \"$type\""
    }

    # 2d-ifft as sequence of 1d-ifft's, first horizontal, then vertical.
    # As a shortcut to the implementation the vertical is done by
    # transposing, horizontal fftp, and transposing back.  This
    # sequence will be replaced by a vertical fftp primitive when we
    # have it (And the transpositions will be implicit in its
    # implementation). As the result of the fft is a float-type image
    # we directly call on the appropriate primitives without the need
    # for dynamic dispatch.

    return [::crimp::flip_transpose_float \
		[::crimp::ifftx_float \
		     [::crimp::flip_transpose_float \
			  [::crimp::$f $image]]]]
}

# # ## ### ##### ######## #############

namespace eval ::crimp::statistics {
    namespace export {[a-z]*}
    namespace ensemble create
}

proc ::crimp::statistics::basic {image} {
    array set stat {}

    # Basics
    set stat(channels)   [::crimp::channels   $image]
    set stat(dimensions) [::crimp::dimensions $image]
    set stat(height)     [::crimp::height     $image]
    set stat(width)      [::crimp::width      $image]
    set stat(type)       [::crimp::TypeOf     $image]
    set stat(pixels)     [set n [expr {$stat(width) * $stat(height)}]]

    # Type specific statistics primitive available ? If yes, then this
    # has priority over us doing the histogram and pulling the data
    # out of it.

    set f stats_$stat(type)
    if {[::crimp::Has $f]} {
	set stat(channel) [::crimp::$f $image]
	return [array get stat]
    }

    # No primitive, go through the histogram.
    # Histogram and derived data, per channel.

    foreach {c h} [::crimp::histogram $image] {
	#puts <$c>
	set hf     [dict values $h]
	#puts H|[llength $hf]||$hf
	set cdf    [::crimp::CUMULATE $hf]
	#puts C|[llength $cdf]|$cdf
	set cdf255 [::crimp::FIT $cdf 255]

	# Min, max, plus pre-processing for the mean
	set min 255
	set max 0
	set sum 0
	foreach {p count} $h {
	    if {!$count} continue
	    set min [::tcl::mathfunc::min $min $p]
	    set max [::tcl::mathfunc::max $max $p]
	    incr sum [expr {$p * $count}]
	}

	# Arithmetic mean
	set mean [expr {double($sum) / $n}]

	# Median
	if {$min == $max} {
	    set median $min
	    set middle $min
	} else {
	    set median 0
	    foreach {p count} $h s $cdf255 {
		if {$s <= 127} continue
		set median $p
		break
	    }
	    set middle [expr {($min+$max)/2}]
	}

	# Variance
	# http://en.wikipedia.org/wiki/Algorithms_for_calculating_variance#Compensated_variant
	set sum2 0
	set sumc 0
	foreach {p count} $h {
	    if {!$count} continue
	    set x [expr {$p - $mean}]
	    set sum2 [expr {$sum2 + $count * $x * $x}]
	    set sumc [expr {$sumc + $count * $x}]
	}
	set variance [expr {($sum2 - $sumc**2/$n)/($n - 1)}]
	set stddev   [expr {sqrt($variance)}]

	# Save the channel statistics
	lappend stat(channel) $c [dict create        \
			    min       $min  \
			    max       $max   \
			    middle    $middle \
			    median    $median \
			    mean      $mean    \
			    stddev    $stddev   \
			    variance  $variance \
			    histogram $h       \
			    hf        $hf     \
			    cdf       $cdf    \
			    cdf255    $cdf255 \
			  ]
	# geom mean, stddev
    }

    return [array get stat]
}

proc ::crimp::statistics::otsu {basic} {
    foreach c [dict get $basic channels] {
	dict set basic channel $c otsu \
	    [OTSU [dict get $basic channel $c histogram]]
    }
    return $basic
}

proc ::crimp::statistics::OTSU {histogram} {
    # Code based on the explanations at
    # http://www.labbookpages.co.uk/software/imgProc/otsuThreshold.html
    # See also http://en.wikipedia.org/wiki/Otsu%27s_method

    set weightAll 0
    set sumAll    0
    set wlist     {}
    foreach {pixel count} $histogram {
	set w [expr {$pixel * $count}]
	lappend wlist $w
	incr sumAll    $w
	incr weightAll $count
    }

    set sumBg       0
    set sumFg       $sumAll
    set threshold   0          ; # And the associated threshold.
    set varianceMax 0          ; # Maxium of variance found so far.
    set weightBg    0          ; # Weight of background pixels
    set weightFg    $weightAll ; # Weight of foreground pixels

    foreach {pixel count} $histogram w $wlist {
	# update weights.
	incr weightBg  $count ; if {!$weightBg} continue
	incr weightFg -$count ; if {!$weightFg} break

	incr sumBg  $w
	incr sumFg -$w

	# Mean values for current threshold.
	set meanBg [expr {double($sumBg) / $weightBg}]
	set meanFg [expr {double($sumFg) / $weightFg}]

	# Variance between the classes.
	set varianceBetween [expr {$weightBg * $weightFg * ($meanBg - $meanFg)**2}]

	# And update the guess on the threshold.
	if {$varianceBetween > $varianceMax} {
	    set varianceMax $varianceBetween
	    set threshold   $pixel
	}
    }

    return $threshold
}

# # ## ### ##### ######## #############
# # ## ### ##### ######## #############

namespace eval ::crimp::gradient {
    namespace export {[a-z]*}
    namespace ensemble create
}

# TODO :: Force/check proper input ranges for pixel values.

proc ::crimp::gradient::grey8 {s e size} {
    if {$size < 2} {
	return -code error "Minimum size is 2"
    }

    set steps [expr {$size - 1}]

    set d [expr {($e - $s)/double($steps)}]

    for {set t 0} {$steps >= 0} {
	incr steps -1
	incr t
    } {
	lappend pixels [expr {round($s + $t * $d)}]
    }

    return [::crimp::read::tcl grey8 [list $pixels]]
}

proc ::crimp::gradient::rgb {s e size} {
    if {$size < 2} {
	return -code error "Minimum size is 2"
    }

    set steps [expr {$size - 1}]
    lassign $s sr sg sb
    lassign $e er eg eb

    set dr [expr {($er - $sr)/double($steps)}]
    set dg [expr {($eg - $sg)/double($steps)}]
    set db [expr {($eb - $sb)/double($steps)}]

    for {set t 0} {$steps >= 0} {
	incr steps -1
	incr t
    } {
	lappend r [expr {round($sr + $t * $dr)}]
	lappend g [expr {round($sg + $t * $dg)}]
	lappend b [expr {round($sb + $t * $db)}]
    }

    return [::crimp::join::2rgb \
		[::crimp::read::tcl grey8 [list $r]] \
		[::crimp::read::tcl grey8 [list $g]] \
		[::crimp::read::tcl grey8 [list $b]]]
}

proc ::crimp::gradient::rgba {s e size} {
    if {$size < 2} {
	return -code error "Minimum size is 2"
    }

    set steps [expr {$size - 1}]
    lassign $s sr sg sb sa
    lassign $e er eg eb ea

    set dr [expr {($er - $sr)/double($steps)}]
    set dg [expr {($eg - $sg)/double($steps)}]
    set db [expr {($eb - $sb)/double($steps)}]
    set da [expr {($ea - $sa)/double($steps)}]

    for {set t 0} {$steps >= 0} {
	incr steps -1
	incr t
    } {
	lappend r [expr {round($sr + $t * $dr)}]
	lappend g [expr {round($sg + $t * $dg)}]
	lappend b [expr {round($sb + $t * $db)}]
	lappend a [expr {round($sa + $t * $da)}]
    }

    return [::crimp::join::2rgba \
		[::crimp::read::tcl grey8 [list $r]] \
		[::crimp::read::tcl grey8 [list $g]] \
		[::crimp::read::tcl grey8 [list $b]] \
		[::crimp::read::tcl grey8 [list $a]]]
}

proc ::crimp::gradient::hsv {s e steps} {
    if {$size < 2} {
	return -code error "Minimum size is 2"
    }

    set steps [expr {$size - 1}]
    lassign $s sh ss sv
    lassign $e eh es ev

    set dh [expr {($eh - $sh)/double($steps)}]
    set ds [expr {($es - $ss)/double($steps)}]
    set dv [expr {($ev - $sv)/double($steps)}]

    for {set t 0} {$steps >= 0} {
	incr steps -1
	incr t
    } {
	lappend h [expr {round($sh + $t * $dh)}]
	lappend s [expr {round($ss + $t * $ds)}]
	lappend v [expr {round($sv + $t * $dv)}]
    }

    return [::crimp::join::2hsv \
		[::crimp::read::tcl grey8 [list $h]] \
		[::crimp::read::tcl grey8 [list $s]] \
		[::crimp::read::tcl grey8 [list $v]]]
}

# # ## ### ##### ######## #############
## Tables and maps.
## For performance we should memoize results.
## This is not needed to just get things working howver.

proc ::crimp::map {args} {
    return [read::tcl grey8 [list [table {*}$args]]]
}

proc ::crimp::mapof {table} {
    return [read::tcl grey8 [list $table]]
}

namespace eval ::crimp::table {
    namespace export {[a-z]*}
    namespace ensemble create
}

# NOTE: From now on the use of the builtin 'eval' command in the table
# namespace requires '::eval'.

namespace eval ::crimp::table::eval {
    namespace export wrap clamp
    namespace ensemble create
}

proc ::crimp::table::eval::wrap {cmdprefix} {
    for {set i 0} {$i < 256} {incr i} {
	lappend table [::crimp::table::WRAP \
			   [expr {round([uplevel #0 [list {*}$cmdprefix $i]])}]]
    }
    return $table
}

proc ::crimp::table::eval::clamp {cmdprefix} {
    for {set i 0} {$i < 256} {incr i} {
	lappend table [::crimp::table::CLAMP \
			   [expr {round([uplevel #0 [list {*}$cmdprefix $i]])}]]
    }
    return $table
}

proc ::crimp::table::compose {f g} {
    # f and g are tables! representing functions, not command
    # prefixes.
    return [eval [list apply {{f g x} {
	# z = f(g(x))
	return [lindex $f [lindex $g $x]]
    }} $f $g]]
}

proc ::crimp::table::identity {} {
    for {set i 0} {$i < 256} {incr i} {
	lappend table $i
    }
    return $table
}

proc ::crimp::table::invers {} {
    return [lreverse [identity]]
}

proc ::crimp::table::solarize {n} {
    if {$n < 0}   { set n 0   }
    if {$n > 256} { set n 256 }

    # n is the threshold above which we invert the pixel values.
    # Anything less is left untouched. This implies that 256 inverts
    # nothing, as everything is less; and 0 inverts all, as everything
    # is larger or equal.

    set t {}
    for {set i 0} {$i < 256} {incr i} {
	if {$i < $n} {
	    lappend t $i
	} else {
	    lappend t [expr {255 - $i}]
	}
    }
    return $t

    # In terms of existing tables, and joining parts ... When we
    # memoize results in the future the code below should be faster,
    # as it will have quick access to the (invers) identity
    # tables. When computing from scratch the cont. recalc of these
    # should be slower, hence the loop above.

    if {$n == 0} {
	# Full solarization
	return [invers]
    } elseif {$n == 256} {
	# No solarization
	return [identity]
    } else {
	# Take part of identity, and part of invers, as per the chosen
	# threshold.
	set l [expr {$n - 1}]
	set     t    [lrange [identity] 0 $l]
	lappend t {*}[lrange [invers] $n end]
	return $t
    }
}

proc ::crimp::table::gamma {y} {
    # Note: gamma operates in range [0..1], our data is [0..255]. We
    # have to scale down before applying the gamma, then scale back.

    #eval::clamp [list ::apply {{y i} {expr {(($i/255.0) ** $y)*255.0}}} $y]

    for {set i 0} {$i < 256} {incr i} {
	lappend table [CLAMP [expr {round ((($i/255.0) ** $y)*255.0)}]]
    }
    return $table
}

proc ::crimp::table::degamma {y} {
    # Note: gamma operates in range [0..1], our data is [0..255]. We
    # have to scale down before applying the gamma, then scale back.

    set dy [expr {1.0/$y}]
    #eval::clamp [list ::apply {{dy i} {expr {(($i/255.0) ** $dy)*255.0}}} $dy]

    for {set i 0} {$i < 256} {incr i} {
	lappend table [CLAMP [expr {round ((($i/255.0) ** $dy)*255.0)}]]
    }
    return $table
}

proc ::crimp::table::sqrt {{max 255}} {
    # y = r*sqrt(x)
    # ==> 255 = r*sqrt(max)
    # <=> r = 255/sqrt(max)
    # (r == 1) <=> (sqrt(max) == 255)

    set r [expr {255.0/sqrt($max)}]
    #eval::clamp [list ::apply {{r i} {expr {$r*sqrt($i)}}} $r]

    for {set i 0} {$i < 256} {incr i} {
	lappend table [CLAMP [expr {round ($r*sqrt($i))}]]
    }
    return $table
}

proc ::crimp::table::log {{max 255}} {
    #       y = c*log(1+x)
    # ==> 255 = c*log(1+max)
    # <=> c = 255/log(1+max)
    # (c == 1) <=> (log(1+max) == 255)

    set c [expr {255.0/log(1.0+$max)}]
    #eval::clamp [list ::apply {{c i} {expr {$c*log(1+$i)}}} $r]

    # i = 1..256 instead of 0..255 i.e. 1+x is implied by the change
    # in the iteration range.
    for {set i 1} {$i < 257} {incr i} {
	lappend table [CLAMP [expr {round($c*log($i))}]]
    }
    return $table
}

namespace eval ::crimp::table::linear {
    namespace export wrap clamp
    namespace ensemble create
}

proc ::crimp::table::linear::wrap {gain offset} {
    return [::crimp::table::eval::wrap [list ::apply {{gain offset i} {
	expr {double($gain) * $i + double($offset)}
    }} $gain $offset]]
}

proc ::crimp::table::linear::clamp {gain offset} {
    return [::crimp::table::eval::clamp [list ::apply {{gain offset i} {
	expr {double($gain) * $i + double($offset)}
    }} $gain $offset]]
}

proc ::crimp::table::stretch {min max} {
    # min => 0, max => 255, linear interpolation between them.
    #
    #     gain*max+offs = 255
    #     gain*min+offs = 0        <=> gain*min = 0-offs
    # <=> gain(max-min) = 255-0  | <=> offs = -gain*min
    # <=> GAIN = 255/(max-min)
    # 

    set gain   [expr {255.0/($max - $min)}]
    set offset [expr {- ($min * $gain)}]

    return [linear::clamp $gain $offset]
}

namespace eval ::crimp::table::threshold {
    namespace export *
    namespace ensemble create
}

# [below T] <=> (x < T) <=> [invert [above T]]
# [above T] <=> (x >= T)

proc ::crimp::table::threshold::below {threshold} {
    for {set x 0} {$x < 256} {incr x} {
	lappend table [expr {($x < $threshold) ? 0 : 255}]
    }
    return $table
}

proc ::crimp::table::threshold::above {threshold} {
    for {set x 0} {$x < 256} {incr x} {
	lappend table [expr {($x < $threshold) ? 255 : 0}]
    }
    return $table
}

# [inside  Tmin Tmax] <=> (Tmin < x)  && (x < Tmax) <=> [invert [outside Tmin Tmax]],
# [outside Tmin Tmax] <=> (x <= Tmin) || (x >= Tmax)

proc ::crimp::table::threshold::inside {min max} {
    for {set x 0} {$x < 256} {incr x} {
	lappend table [expr {($min < $x) && ($x < $max) ? 0 : 255}]
    }
    return $table
}

proc ::crimp::table::threshold::outside {min max} {
    for {set x 0} {$x < 256} {incr x} {
	lappend table [expr {($min < $x) && ($x < $max) ? 255 : 0}]
    }
    return $table
}

proc ::crimp::table::gauss {sigma} {
    # Sampled gaussian.
    # For the discrete gaussian I need 'modified bessel functions of
    # integer order'. Check if tcllib/math contains them.

    # a*e^(-(((x-b)^2)/(2c^2)))
    # a = 255, b = 127.5, c = sigma

    for {set x 0} {$x < 256} {incr x} {
	lappend table [expr {round(255*exp(-(($x-127.5)**2/(2*$sigma**2))))}]
    }
    return $table
}

# Reference: http://en.wikipedia.org/wiki/Scale_space_implementation
namespace eval ::crimp::table::fgauss {
    namespace export discrete sampled
    namespace ensemble create
}

proc ::crimp::table::fgauss::discrete {sigma {r {}}} {
    # Discrete gaussian.

    # Reference: http://en.wikipedia.org/wiki/Scale_space_implementation#The_discrete_Gaussian_kernel
    # G(x,sigma) = e^(-t)*I_x(t), where t = sigma^2
    # and I_x = Modified Bessel function of Order x
    package require math::special

    if {$sigma <= 0} {
	return -code error -errorCode {ARITH DOMAIN INVALID} {Invalid sigma, expected number > 0}
    }

    # Determine kernel radius from the sigma, if not overriden by the caller.
    if {([llength [info level 0]] < 3) || ($r eq {})} {
	set r [expr {int(ceil(3*$sigma))}]
	if {$r < 1} { set r 1 }
    }

    # Compute the upper half of the kernel (0...3*sigma).
    set table {}
    set t [expr {$sigma ** 2}]

    for {set x 0} {$x <= $r} {incr x} {
        set v [expr {exp(-$t)*[math::special::I_n $x $t]}]
	lappend table $v
    }

    # Then reflect this to get the lower half, and join the two. This
    # also ensures that the generated table is of odd length, as
    # expected for convolution kernels.

    if {[llength $table] > 1} {
	set table [linsert $table 0 {*}[lreverse [lrange $table 1 end]]]
    }

    # Last step, get the sum over the table, and then adjust all
    # elements to make this sum equial to 1.

    set s 0    ; foreach t $table {set s [expr {$s+$t}]}
    set tmp {} ; foreach t $table {lappend tmp [expr {$t/$s}]}

    return $tmp
}

proc ::crimp::table::fgauss::sampled {sigma {r {}}} {
    # Sampled gaussian

    # Reference: http://en.wikipedia.org/wiki/Scale_space_implementation#The_sampled_Gaussian_kernel
    # G(x,sigma) =  1/sqrt(2*t*pi)*e^(-x^2/(2*t))
    # where t = sigma^2
    package require math::constants
    math::constants::constants pi

    if {$sigma <= 0} {
	return -code error -errorCode {ARITH DOMAIN INVALID} {Invalid sigma, expected number > 0}
    }

    # Determine kernel radius from the sigma, if not overriden by the caller.
    if {([llength [info level 0]] < 3) || ($r eq {})} {
	set r [expr {int(ceil(3*$sigma))}]
	if {$r < 1} { set r 1 }
    }

    # Compute upper half of the kernel (0...3*sigma).
    set table {}
    set scale  [expr {1.0 / ($sigma * sqrt(2 * $pi))}]
    set escale [expr {2 * $sigma ** 2}]

    for {set x 0} {$x <= $r} {incr x} {
	lappend table [expr {$scale * exp(-($x**2/$escale))}]
    }

    # Then reflect this to get the lower half, and join the two. This
    # also ensures that the generated table is of odd length, as
    # expected for convolution kernels.

    if {[llength $table] > 1} {
	set table [linsert $table 0 {*}[lreverse [lrange $table 1 end]]]
    }

    # Last step, get the sum over the table, and then adjust all
    # elements to make this sum equial to 1.

    set s 0    ; foreach t $table {set s [expr {$s+$t}]}
    set tmp {} ; foreach t $table {lappend tmp [expr {$t/$s}]}

    return $tmp
}

# # ## ### ##### ######## #############

namespace eval ::crimp::table::quantize {
    namespace export *
    namespace ensemble create

    variable  pmap
    array set pmap {
	low  0   down 0   min 0   median 50
	high 100 up   100 max 100
    }
}

proc ::crimp::table::quantize::histogram {n p h} {
    # Get the histogram as function, integrate it, and scale to the
    # standard range 0...255 before using it to compute a
    # quantization.

    return [::crimp::table::QuantizeCore $n $p \
		[::crimp::FIT \
		     [::crimp::CUMULATE [dict values $h]] \
		     255]]
}

proc ::crimp::table::QuantizeCore {n p cdf} {
    variable pmap

    if {$n < 2} {
	return -code error "Unable to calculate 1-color quantization"
    }

    if {[info exists pmap($p)]} {
	set p $pmap($p)
    }

    # First compute the quantization steps as the (255/n)'th
    # percentiles in the histogram, and the associated high value in
    # the range the final value is chosen from.

    set res 0
    set percentile [expr {255.0/$n}]
    set threshold  $percentile

    set step  {}
    set color {}

    foreach pv [::crimp::table::identity] sum $cdf {
	if {$sum <= $threshold} continue
	lappend step   $pv
	lappend color [expr {round($threshold)}]
	set threshold [expr {$threshold + $percentile}]
	if {[llength $step] == $n} break
    }
    lappend step  256
    lappend color 255

    #puts |$step|
    #puts |$color|

    # As the second and last step compute the remapping table from the
    # steps and color ranges.
    set at 0
    set l  0

    set threshold [lindex $step  $at]
    set h         [lindex $color $at]
    set c [expr {round($l + ($p/100.0)*($h - $l))}]
    #puts =<$threshold|$l|$h|=$c

    set table {}
    for {set pix 0} {$pix < 256} {incr pix} {
	while {$pix >= $threshold} {
	    incr at
	    set  l $h

	    set threshold [lindex $step  $at]
	    set h         [lindex $color $at]
	    set c [expr {round($l + ($p/100.0)*($h - $l))}]
	    #puts +<$threshold|$l|$h|=$c
	}
	# assert (c in (0...255))
	lappend table $c
    }

    #puts [llength $table] (== 256 /assert)
    return $table
}

# # ## ### ##### ######## #############

proc ::crimp::table::CLAMPS {x} {
    if {$x < -128 } { return -128 }
    if {$x >  127 } { return  127 }
    return $x
}

proc ::crimp::table::CLAMP {x} {
    if {$x < 0  } { return 0   }
    if {$x > 255} { return 255 }
    return $x
}

proc ::crimp::table::WRAP {x} {
    while {$x < 0  } {
	incr x 255
    }
    while {$x > 255} {
	incr x -255
    }
    return $x
}
# series(int) --> series (int)
proc ::crimp::CUMULATE {series} {
    set res {}
    set sum 0
    foreach x $series {
	incr sum $x
	lappend res $sum
    }
    return $res
}

# series(int/float) --> series(int), all(x): x <= max
proc ::crimp::FIT {series max} {
    # Assumes that the input is a monotonically increasing
    # series. The maximum value of the series is at the end.
    set top [lindex $series end]

    if {$top == 0} {
	# The inputs fits regardless of maximum.
	return $series
    }

    #puts /$top/
    set f   [expr {double($max) / double($top)}]
    set res {}
    
    foreach x $series {
	lappend res [expr {round(double($x)*$f)}]
    }
    return $res
}

# Compress (or expand) a float image into the full 0...255 range of grey8.
proc ::crimp::FITFLOAT {i} {
    return [FITFLOATRANGE $i {*}[FLOATMINMAX $i]]
}

proc ::crimp::FITFLOATB {i {sigma 1.2}} {
    return [FITFLOATRANGE $i {*}[FLOATMEANSTDDEV $i $sigma]]
}

proc ::crimp::FITFLOATRANGE {i min max} {
    set offset [expr {-1 * $min}]
    set scale  [expr {255.0/($max - $min)}]

    return [crimp::convert_2grey8_float \
		[crimp::scale_float \
		     [crimp::offset_float $i $offset] \
		     $scale]]
}

proc ::crimp::FLOATMINMAX {i} {
    set statistics [crimp statistics basic $i]
    set min        [dict get $statistics channel value min]
    set max        [dict get $statistics channel value max]
    return [list $min $max]
}

proc ::crimp::FLOATMEANSTDDEV {i {sigma 1.2}} {
    set statistics [crimp statistics basic $i]
    set mean       [dict get $statistics channel value mean]
    set var        [dict get $statistics channel value stddev]
    set min        [expr {$mean - $var * $sigma}]
    set max        [expr {$mean + $var * $sigma}]
    return [list $min $max]
}

# # ## ### ##### ######## #############

proc ::crimp::TypeOf {image} {
    return [namespace tail [type $image]]
}

proc ::crimp::K {x y} {
    return $x
}

# # ## ### ##### ######## #############

namespace eval ::crimp {
    namespace export type width height dimensions channels cut color
    namespace export read write convert join flip split table hypot
    namespace export invert solarize gamma degamma remap map atan2
    namespace export wavy psychedelia matrix blank filter crop
    namespace export alpha histogram max min screen add pixel
    namespace export subtract difference multiply pyramid mapof
    namespace export downsample upsample decimate interpolate
    namespace export kernel expand threshold gradient effect
    namespace export statistics rotate montage morph integrate
    namespace export fft square meta resize warp transform contrast
    #
    namespace ensemble create
}

# # ## ### ##### ######## #############
return






Added demos.tcl.















































































































































































































































































































































































































































































































































































































































































































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
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#!/bin/sh
# -*- tcl -*-
# The next line restarts with tclsh.\
exec tclsh "$0" ${1+"$@"}

puts "CRIMP demos"

if {[catch {
    puts "Trying Tcl/Tk 8.6"

    package require Tcl 8.6
    package require Tk  8.6

    puts "Using  Tcl/Tk 8.6"
}]} {
    puts "Trying Tcl/Tk 8.5 + img::png"

    package require Tcl 8.5
    package require Tk  8.5
    package require img::png

    puts "Using  Tcl/Tk 8.5 + img::png"
}

package require widget::scrolledwindow
package require widget::toolbar
package require widget::arrowbutton
package require fileutil

# Self dir
set dir [file dirname [file normalize [info script]]]

puts "In $dir"

set triedprebuilt 0
if {![file exists $dir/lib] ||
    [catch {
	set triedprebuilt 1

	puts "Trying prebuild crimp package"

	# Use crimp as prebuilt package
	lappend auto_path $dir/lib
	package require crimp

	puts "Using prebuilt crimp [package present crimp]"
	puts "At [package ifneeded crimp [package present crimp]]"
    } msg]} {

    if {$triedprebuilt} {
	puts "Trying to use a prebuilt crimp package failed ($msg)."
	puts ==\t[join [split $::errorInfo \n] \n==\t]
	puts "Falling back to dynamic compilation via local critcl package"
    }

    puts "Trying dynamically compiled crimp package"

    set cp [file join [file dirname $dir] lib critcl.vfs lib]

    puts "Looking for critcl in $cp"

    # Access to critcl library from a local unwrapped critcl app.
    lappend auto_path $cp
    package require critcl 2

    puts "Got:           [package ifneeded critcl [package present critcl]]"

    # Directly access the crimp package
    source [file join $dir crimp.tcl]

    puts "Using dynamically compiled crimp package"
}

puts "Starting up ..."

#puts %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n[join [info loaded] \n]
#puts %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

# # ## ### ##### ######## #############

proc images_init {} {
    global dir images
    set images [lsort -dict [glob -tails -directory $dir/images *.png]]
    return
}

proc images_get {index} {
    global dir images

    set name  [lindex $images $index]
    set photo [image create photo -file [file join $dir images $name]]
    set image [crimp read tk $photo]
    image delete $photo

    return $image
}

# # ## ### ##### ######## #############

proc demo_init {} {
    global dir demo dcurrent demo_map
    set dcurrent {}

    array set demo {
	aaaaa {
	    label       Unmodified
	    cmd         demo_close
	    active      {expr {[bases] == 1}}
	    setup       {}
	    setup_image {}
	    shutdown    {}
	}
    }
    foreach f [glob -directory $dir/demos *.tcl] {
	set thedemo {}
	source $f
	set name [dict get $thedemo name]
	#puts <$thedemo>
	set demo($name) $thedemo
	lappend demo($name) cmd [list demo_use $name]
    }

    foreach name [demo_list] {
	set label [demo_label $name]
	set cmd   [demo_cmd   $name]
	set demo_map($label) $cmd
    }
    return
}

proc demo_list {} {
    global demo
    return [lsort -dict [array names demo]]
}

proc demo_cmd {name} {
    global demo
    return [dict get $demo($name) cmd]
}

proc demo_label {name} {
    global demo
    return [dict get $demo($name) label]
}

proc demo_use {name} {
    demo_setup $name
    demo_setup_image
    return
}

proc demo_use_image {} {
    demo_setup_image
    return
}

proc demo_setup {name} {
    global demo dcurrent
    demo_close
    set dcurrent $name
    demo_run_hook "\nsetup $name" [dict get $demo($name) setup]
    return
}

proc demo_setup_image {} {
    global dcurrent demo
    catch { spause }
    demo_run_hook image [dict get $demo($dcurrent) setup_image]
    return
}

proc demo_run_hook {label script} {
    if {[catch {
	namespace eval ::DEMO [list demo_time_hook $label $script]
    }]} {
	set prefix "HOOK ERROR "
	log $prefix[join [split $::errorInfo \n] \n$prefix] error
    }
    return
}

proc demo_time_hook {label script} {
    set x [lindex [uplevel 1 [list time $script 1]] 0]

    log "$label = [expr {double($x)/1E6}] seconds"
    if {![bases]} return
    set n [expr {[crimp width [base]]*[crimp height [base]]}]
    log "\t$n pixels"
    log "\t[expr {double($x)/$n}] uSeconds/pixel"
    return
}

proc demo_isactive {} {
    global dcurrent activedemos
    if {$dcurrent eq {}} {return 0}
    return [expr {[demo_label $dcurrent] in $activedemos}]
}

proc demo_close {} {
    global demo dcurrent

    if {![bases]} {

	if {$dcurrent eq {}} return
	namespace eval   ::DEMO [dict get $demo($dcurrent) shutdown]
	namespace delete ::DEMO
	reframe
	set dcurrent {}

	return
    }

    show_image [base]

    if {$dcurrent eq {}} return
    slide_stop
    reframe

    namespace eval   ::DEMO [dict get $demo($dcurrent) shutdown]
    namespace delete ::DEMO
    set dcurrent {}
    return
}

proc demo_usable {} {
    global demo activedemos
    set activedemos {}
    foreach n [demo_list] {
	set active [namespace eval ::DEMO [dict get $demo($n) active]]
	if {!$active} continue
	lappend activedemos [demo_label $n]
    }
    return
}

proc def {name dict} {
    upvar 1 thedemo thedemo
    lappend thedemo \
	setup       {} \
	setup_image {} \
	shutdown    {} \
	active      {
	    expr {[bases] == 1}
	} \
	{*}$dict name $name
    return
}

# # ## ### ##### ######## #############

proc log {msg {tags {}}} {
    log* $msg\n $tags
    return
}

proc log* {msg {tags {}}} {
    .log configure -state normal
    .log insert end $msg $tags
    .log see end
    .log configure -state disabled
    #update
    return
}

# # ## ### ##### ######## #############

proc reframe {} {
    destroy .left .right .top .bottom .slide

    ttk::frame .slide
    ttk::frame .left
    ttk::frame .top
    ttk::frame .right
    ttk::frame .bottom

    # The slide control is above the paneling
    grid .slide -row 0 -column 1 -sticky swen

    # And this is around the image display in the paneling
    grid .top    -row 0 -column 0 -sticky swen -in .r -columnspan 3
    grid .left   -row 1 -column 0 -sticky swen -in .r
    grid .right  -row 1 -column 2 -sticky swen -in .r
    grid .bottom -row 2 -column 0 -sticky swen -in .r -columnspan 3
    return
}

proc reframe_slide {} {
    destroy    .slide
    ttk::frame .slide

    grid .slide -row 0 -column 2 -columnspan 3 -sticky swen
    return
}

proc tags {tw} {
    $tw tag configure error   -background #EE5555
    $tw tag configure warning -background yellow
    $tw tag configure note \
	-background lightyellow  \
	-borderwidth 1 -relief sunken
    return
}

proc gui {} {
    widgets
    layout
    bindings
    reframe
    wm deiconify .
    return
}

proc widgets {} {
    widget::toolbar .t

    .t add button exit -text Exit -command ::exit -separator 1

    ttk::panedwindow .h -orient horizontal
    ttk::panedwindow .v -orient vertical

    ttk::frame .r
    ttk::frame .l

    widget::scrolledwindow .sl -borderwidth 1 -relief sunken ; # log
    widget::scrolledwindow .sc -borderwidth 1 -relief sunken ; # image canvas
    widget::scrolledwindow .si -borderwidth 1 -relief sunken ; # list (image)
    widget::scrolledwindow .sd -borderwidth 1 -relief sunken ; # list (demo)

    text .log -height 5 -width 10 -font {Helvetica -18}
    tags .log

    canvas   .c -scrollregion {-4000 -4000 4000 4000}
    listbox  .li -width 15 -selectmode extended -listvariable images
    listbox  .ld -width 30 -selectmode single   -listvariable activedemos

    .c create image {0 0} -anchor nw -tags photo
    .c itemconfigure photo -image [image create photo]
    return
}

proc layout {} {
    # Place scrollable parts into their managers.

    .sl setwidget .log
    .si setwidget .li
    .sd setwidget .ld
    .sc setwidget .c

    .h add .v
    .h add .r

    .v add .sl
    .v add .l

    # Toolbar/pseudo-menu @ top, with the paneling below.
    grid .t -row 0 -column 0 -sticky swen
    grid .h -row 1 -column 0 -sticky swen -columnspan 2

    grid rowconfigure    . 0 -weight 0
    grid rowconfigure    . 1 -weight 1
    grid columnconfigure . 0 -weight 1

    # Place the image and demo lists side by side.
    grid .si -row 0 -column 0 -rowspan 3 -sticky swen -in .l
    grid .sd -row 0 -column 1 -rowspan 3 -sticky swen -in .l

    grid rowconfigure    .l 0 -weight 1
    grid columnconfigure .l 0 -weight 1

    # Image display in the center of the right panel
    grid .sc -row 1 -column 1 -sticky swen -in .r

    grid rowconfigure    .r 0 -weight 0
    grid rowconfigure    .r 1 -weight 1
    grid rowconfigure    .r 2 -weight 0
    grid columnconfigure .r 0 -weight 0
    grid columnconfigure .r 1 -weight 1
    grid columnconfigure .r 2 -weight 0

    return
}

proc bindings {} {
    bind .li <<ListboxSelect>> show_selection
    bind .ld <<ListboxSelect>> show_demo

    # Panning via mouse
    bind .c <ButtonPress-2> {%W scan mark   %x %y}
    bind .c <B2-Motion>     {%W scan dragto %x %y}

    # Cross hairs ...
    #.c configure -cursor tcross
    #crosshair::crosshair .c -width 0 -fill \#999999 -dash {.}
    #crosshair::track on  .c TRACK
    return
}

# # ## ### ##### ######## #############

proc show_selection {} {
    set selection [.li curselection]
    #if {![llength $selection]} return
    show $selection
    demo_usable
    if {[demo_isactive]} {
	demo_use_image
    } else {
	demo_close
    }
    return
}

proc show {indices} {
    global base
    set base {}
    foreach index $indices {
	lappend base [images_get $index]
    }
    return
}

proc show_demo {} {
    global demo_map activedemos
    set selection [.ld curselection]
    if {![llength $selection]} return
    set index [lindex $selection 0]

    set label [lindex $activedemos $index]
    set command $demo_map($label)

    uplevel #0 $command
    return

}

# # ## ### ##### ######## #############
## Slide show display and control

proc slide_gui {} {
    if {[winfo exists .slide.pc]} return

    ttk::spinbox        .slide.delay -textvariable ::delay -increment 1 -from 10 -to 5000

    widget::arrowbutton .slide.forw  -orientation right   -command slide_forw
    widget::arrowbutton .slide.backw -orientation left    -command slide_backw

    ttk::button         .slide.pc    -image ::play::pause -command slide_pc
    ttk::button         .slide.prev  -image ::play::prev  -command slide_step_prev
    ttk::button         .slide.next  -image ::play::next  -command slide_step_next

    grid .slide.backw -row 0 -column 0 -sticky swen
    grid .slide.forw  -row 0 -column 1 -sticky swen

    grid .slide.prev  -row 0 -column 2 -sticky swen
    grid .slide.pc    -row 0 -column 3 -sticky swen
    grid .slide.next  -row 0 -column 4 -sticky swen
    grid .slide.delay -row 0 -column 5 -sticky swen
    return
}

proc slide_forw {} {
    global direction slides
    if {$direction > 0} return
    set direction 1
    set slides [lreverse $slides]
    return
}

proc slide_backw {} {
    global direction slides
    if {$direction < 0} return
    set direction -1
    set slides [lreverse $slides]
    return
}

proc slide_pc {} {
    global running
    if {$running} {
	spause
    } else {
	scontinue
    }
    return
}

proc slide_step_next {} {
    global direction
    spause
    if {$direction < 0 } { slide_forw ; snext }
    snext
    return
}

proc slide_step_prev {} {
    global direction
    spause
    if {$direction > 0 } { slide_backw ; snext }
    snext
    return
}

proc spause {} {
    .slide.pc configure -image ::play::continue
    update idletasks
    slide_cycle_off
    return
}

proc scontinue {} {
    .slide.pc configure -image ::play::pause
    update idletasks
    slide_cycle
    return
}

proc snext {} {
    global slides 
    if {![info exists slides] || ![llength $slides]} return
    display [cycle slides]
    return
}

namespace eval ::play {}
image create bitmap ::play::continue -data {
    #define continue_width 11
    #define continue_height 11
    static char continue_bits = {
	0x00, 0x00, 0x00, 0x00, 0x0c, 0x00, 0x3c, 0x00, 0xfc, 0x00, 0xfc,
	0x03, 0xfc, 0x00, 0x3c, 0x00, 0x0c, 0x00, 0x00, 0x00, 0x00, 0x00
    }
}

image create bitmap ::play::pause -data {
    #define pause_width 11
    #define pause_height 11
    static char pause_bits = {
	0x00, 0x00, 0x00, 0x00, 0x9c, 0x03, 0x9c, 0x03, 0x9c, 0x03, 0x9c,
	0x03, 0x9c, 0x03, 0x9c, 0x03, 0x9c, 0x03, 0x00, 0x00, 0x00, 0x00
    }
}

image create bitmap ::play::prev -data {
    #define prev_width 11
    #define prev_height 11
    static char prev_bits = {
	0x00, 0x00, 0x00, 0x00, 0x10, 0x01, 0x98, 0x01, 0xcc, 0x00, 0x66,
	0x00, 0xcc, 0x00, 0x98, 0x01, 0x10, 0x01, 0x00, 0x00, 0x00, 0x00
}
}

image create bitmap ::play::next -data {
    #define next_width 11
    #define next_height 11
    static char next_bits = {
	0x00, 0x00, 0x00, 0x00, 0x44, 0x00, 0xcc, 0x00, 0x98, 0x01, 0x30,
	0x03, 0x98, 0x01, 0xcc, 0x00, 0x44, 0x00, 0x00, 0x00, 0x00, 0x00
    }
}

proc slide_stop {} {
    slide_cycle_off
    reframe_slide
    return
}

global delay direction running
set    delay 1000
set    direction 1
set    running 0

proc slide_cycle {} {
    global token delay running
    set running 1

    if {![string is integer $delay]|| ($delay < 1)} {
	set delay 100
    }

    set token [after $delay ::slide_cycle]

    snext
    return
}

proc slide_cycle_off {} {
    global token running
    set running 0
    catch { after cancel $token }
    return
}

proc cycle {lv} {
    upvar 1 $lv list
    set tail [lassign $list head]
    set list [list {*}$tail $head]
    return $head
}

# # ## ### ##### ######## #############
## DEMO API
##
## base       = Returns the currently selected and loaded input image.
## show_image = Display the image argument
## extendgui  = Extend the GUI with a single widget to the left of the
##              image display.  Multiple widgets can be had via a
##              frame.

proc show_slides {images {run 1}} {
    global slides direction
    if {$direction < 0} {
	set slides [lreverse $images]
    } else {
	set slides $images
    }

    slide_gui
    if {$run} {
	scontinue
    } else {
	spause
    }
    return
}

proc show_image {image} {
    slide_stop
    #display [crimp gamma $image 2.2]
    #display [crimp degamma $image 2.2]
    display $image
    log TYPE=[crimp type       $image]
    log DIM_=[crimp dimensions $image]
    log META=[crimp::meta_get  $image]
    return
}

proc display {image} {
    .c configure -scrollregion [list 0 0 {*}[crimp dimensions $image]]
    crimp write 2tk [.c itemcget photo -image] $image
    return
}

proc base {{i 0}} {
    global base
    return [lindex $base $i]
    #return [crimp degamma [lindex $base $i] 2.2]
    #return [crimp gamma [lindex $base $i] 2.2]
}

proc bases {} {
    global base
    return [llength $base]
}

proc thebases {} {
    global base
    return $base
}

# # ## ### ##### ######## #############

proc main {} {
    images_init
    demo_init
    gui
    after 100 {event generate .li <<ListboxSelect>>}
    return
    after 100 {
	.li selection set 0
	event generate .li <<ListboxSelect>>
	after 100 {
	    .ld selection set 0
	    event generate .ld <<ListboxSelect>>
	}
    }
    return
}

main
vwait forever
# vim: set sts=4 sw=4 tw=80 et ft=tcl:






Added demos/add.tcl.




































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_add {
    label Add
    active {
	expr {
	      ([bases] == 2) &&
	      ([crimp dimensions [base 0]] eq [crimp dimensions [base 1]])
	  }
    }
    setup_image {
	show
    }
    setup {
	variable scale  1
	variable offset 0

	proc show {args} {
	    variable scale
	    variable offset

	    show_image [crimp alpha opaque [crimp add [base 0] [base 1] $scale $offset]]
	    return
	}

	scale .left.s -variable ::DEMO::scale  -from 1 -to 255 -orient vertical -command ::DEMO::show
	scale .left.o -variable ::DEMO::offset -from 0 -to 255 -orient vertical -command ::DEMO::show

	pack .left.s -side left -expand 1 -fill both
	pack .left.o -side left -expand 1 -fill both
    }
}






Added demos/ahe.tcl.























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_ahe {
    label {AHE}
    setup_image {
	# Create a series of AHE images from the luma of
	# the base, with different kernel radii.
	show_slides [apply {{base} {
	    set base [crimp convert 2hsv [base]]
	    return [list \
			[base]\
			[crimp convert 2rgb [crimp filter ahe $base  3]] \
			[crimp convert 2rgb [crimp filter ahe $base 10]] \
			[crimp convert 2rgb [crimp filter ahe $base 20]] \
			[crimp convert 2rgb [crimp filter ahe $base 50]] \
			[crimp convert 2rgb [crimp filter ahe $base 100]]]
	}} [base]]
    }
}






Added demos/ahe_luma.tcl.
























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_ahe_luma {
    label {AHE (Luma)}
    setup_image {
	# Create a series of AHE images from the luma of
	# the base, with different kernel radii.

	show_slides [apply {{base} {
	    set base [crimp convert 2grey8 $base]
	    return [list \
			$base \
			[crimp filter ahe $base  3] \
			[crimp filter ahe $base 10] \
			[crimp filter ahe $base 20] \
			[crimp filter ahe $base 50] \
			[crimp filter ahe $base 100]]
	}} [base]]
    }
}






Added demos/alpha.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def rgba_alpha {
    label Alpha
    setup_image {
	show_image [lindex [crimp split [base]] 3]
    }
}






Added demos/bilateral.tcl.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_bilateral {
    label {Bilteral Filtering}
    setup {
	proc border {i} {
	    crimp expand const $i \
		5 5 5 5 \
		0 0 255
	}

	proc stretch {i} {
	    set s [crimp statistics basic $i]
	    set min [dict get $s channel luma min]
	    set max [dict get $s channel luma max]
	    crimp remap $i [crimp map stretch $min $max]
	}
    }
    setup_image {

	set g  [crimp convert 2grey8 [base]]

	# Filter
	set ba [crimp::bilateral_grey8 $g  5 4]
	set bb [crimp::bilateral_grey8 $g 10 4]

	# Residuals. Scaled to magnify any differences.
	set da [stretch [crimp::difference $g $ba]]
	set db [stretch [crimp::difference $g $bb]]

	set bd  [crimp convert 2rgb [base]]
	set gd  [crimp convert 2rgb $g]
	set bad [crimp convert 2rgb $ba]
	set bbd [crimp convert 2rgb $bb]
	set dad [crimp convert 2rgb $da]
	set dbd [crimp convert 2rgb $db]

	show_image \
	    [crimp montage vertical -align left \
		 [crimp montage horizontal \
		      [border $bd] \
		      [border $gd]] \
		 [crimp montage horizontal \
		      [border $bad] \
		      [border $bbd]] \
		 [crimp montage horizontal \
		      [border $dad] \
		      [border $dbd]]]
    }
}






Added demos/blank.tcl.













































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_blank {
    label Blank
    active {
	expr {[bases] == 0}
    }
    setup {
	variable r 0
	variable g 0
	variable b 0

	proc show {args} {
	    variable r
	    variable g
	    variable b

	    show_image [crimp blank rgba 800 600 $r $g $b 255]
	    return
	}

	scale .left.r -variable ::DEMO::r \
	    -from 0 -to 255 \
	    -orient vertical \
	    -command ::DEMO::show

	scale .left.g -variable ::DEMO::g \
	    -from 0 -to 255 \
	    -orient vertical \
	    -command ::DEMO::show

	scale .left.b -variable ::DEMO::b \
	    -from 0 -to 255 \
	    -orient vertical \
	    -command ::DEMO::show

	grid .left.r -row 0 -column 0 -sticky swen
	grid .left.g -row 0 -column 1 -sticky swen
	grid .left.b -row 0 -column 2 -sticky swen
    }
}






Added demos/blend_cut.tcl.


































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_blend_cut {
    label {Blend Cut}
    active {
	expr {
	      ([bases] == 2) &&
	      ([crimp dimensions [base 0]] eq [crimp dimensions [base 1]])
	  }
    }
    setup_image {
	# Get the images to blend.
	variable left  [base 0]
	variable right [base 1]

	variable w
	variable h
	lassign [crimp dimensions [base 0]] w h
	set w [expr {$w/2}]

	# Should be easier via cut/crop+montage...

	variable result [crimp montage horizontal \
			     [crimp cut $left   0 0 $w $h] \
			     [crimp cut $right $w 0 $w $h]]

	show_image $result
	return
    }
}






Added demos/blend_hsv.tcl.

















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_alpha_blend_hsv {
    label {Blend HSV}
    active {
	expr {
	      ([bases] == 2) &&
	      ([crimp dimensions [base 0]] eq [crimp dimensions [base 1]])
	  }
    }
    setup {
	# We manage a cache of the blended images to make the
	# scrolling of the scale smoother over time. An improvement
	# would be to use timer events to precompute the various
	# blends.
	variable  cache
	array set cache {}
	set cache(255) [base 0]
	set cache(0)   [base 1]
	variable fore  [crimp convert 2hsv [base 0]]
	variable back  [crimp convert 2hsv [base 1]]
	variable alpha 255

	scale .left.s -variable DEMO::alpha \
	    -from 0 -to 255 \
	    -orient vertical \
	    -command [list ::apply {{thealpha} {
		variable cache
		variable fore
		variable back

		if {[info exists cache($thealpha)]} {
		    show_image  $cache($thealpha)
		    return
		}

		set theblend [crimp convert 2rgb [crimp alpha blend $fore $back $thealpha]]
		set cache($thealpha) $theblend
		show_image $theblend
		return
	    } ::DEMO}]

	pack .left.s -side left -fill both -expand 1
    }
}






Added demos/blend_rgb.tcl.













































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_alpha_blend_rgb {
    label {Blend RGB}
    active {
	expr {
	      ([bases] == 2) &&
	      ([crimp dimensions [base 0]] eq [crimp dimensions [base 1]])
	  }
    }
    setup {
	# We manage a cache of the blended images to make the
	# scrolling of the scale smoother over time. An improvement
	# would be to use timer events to precompute the various
	# blends.
	variable  cache
	array set cache {}
	set cache(255) [base 0]
	set cache(0)   [base 1]
	variable alpha 255

	scale .left.s -variable DEMO::alpha \
	    -from 0 -to 255 \
	    -orient vertical \
	    -command [list ::apply {{thealpha} {
		variable cache

		if {[info exists cache($thealpha)]} {
		    show_image  $cache($thealpha)
		    return
		}

		set theblend [crimp alpha blend [base 0] [base 1] $thealpha]
		set cache($thealpha) $theblend
		show_image $theblend
		return
	    } ::DEMO}]

	pack .left.s -side left -fill both -expand 1
    }
}






Added demos/blue.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def rgba_blue {
    label Blue
    setup_image {
	show_image [lindex [crimp split [base]] 2]
    }
}






Added demos/blue_tint.tcl.














1
2
3
4
5
6
7
8

+
+
+
+
+
+
+
+

def rgba_blue_tint {
    label Blue/Tint
    setup_image {
	set c [lindex [crimp split [base]] 2]
	set x [crimp blank grey8 {*}[crimp dimension $c] 0]
	show_image [crimp join 2rgb $x $x $c]
    }
}






Added demos/chain_gauss_solarized.tcl.






























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_sol_gauus {
    label {(Solarize o Gauss) Map}
    setup {
	variable sigma      42
	variable threshold 256

	variable gtable     {}
	variable stable     {}
	variable ctable     {}

	proc showg {thesigma} {
	    variable gtable [crimp table gauss $thesigma]
	    showit
	    return
	}

	proc shows {thethreshold} {
	    variable stable [crimp table solarize $thethreshold]
	    showit
	    return
	}

	proc showit {} {
	    variable gtable
	    variable stable
	    variable ctable

	    # Block the early calls with incompletely initialized tables.
	    if {![llength $gtable]} return
	    if {![llength $stable]} return

	    # Compose and apply.
	    set ctable [crimp table compose $stable $gtable]
	    show_image [crimp remap [base] [crimp mapof $ctable]]
	    return
	}

	plot  .left.pg -variable ::DEMO::gtable -title Sigma
	plot  .left.ps -variable ::DEMO::stable -title Threshold
	plot  .left.pc -variable ::DEMO::ctable -title Composition

	scale .left.sg -variable ::DEMO::sigma     -from 0.1 -to 150 -resolution 0.1 -orient horizontal -command ::DEMO::showg
	scale .left.ss -variable ::DEMO::threshold -from 0   -to 256                 -orient horizontal -command ::DEMO::shows

	grid .left.sg -row 0 -column 0 -sticky swen
	grid .left.pg -row 1 -column 0 -sticky swen

	grid .left.ss -row 2 -column 0 -sticky swen
	grid .left.ps -row 3 -column 0 -sticky swen

	grid .left.pc -row 4 -column 0 -sticky swen
    }
    setup_image {
	showit
    }
}






Added demos/charcoal.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def effect_charcoal {
    label {Charcoal}
    setup_image {
	show_image [crimp morph gradient [crimp convert 2grey8 [base]]]
    }
}






Added demos/color_lms2.tcl.





















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_color_lms2 {
    label {CIE LMS/RLAB from RGB, separate}
    setup {
	proc border {i} {
	    crimp expand const $i \
		5 5 5 5 \
		0 0 255
	}
    }
    setup_image {
	lassign [crimp split [crimp color mix [base] [crimp color rgb2lms rlab]]] \
	    l m s
	show_image [crimp montage vertical [border $l] [border $m] [border $s]]
    }
}






Added demos/color_xyz.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def effect_color_xyz {
    label {CIE XYZ from RGB}
    setup_image {
	show_image [crimp color mix [base] [crimp color rgb2xyz]]
    }
}






Added demos/color_xyz2.tcl.





















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_color_xyz2 {
    label {CIE XYZ from RGB, separate}
    setup {
	proc border {i} {
	    crimp expand const $i \
		5 5 5 5 \
		0 0 255
	}
    }
    setup_image {
	lassign [crimp split [crimp color mix [base] [crimp color rgb2xyz]]] \
	    x y z
	show_image [crimp montage vertical [border $x] [border $y] [border $z]]
    }
}






Added demos/contrast.tcl.







































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_contrast {
    label {Contrast}
    setup_image {
	variable base [base]
	variable grey [crimp convert 2grey8 [base]]
	NORM
    }
    setup {
	proc border {i} {
	    crimp expand const $i \
		5 5 5 5 \
		0 0 255
	}

	proc NORM {} {
	    variable base ; set nb [crimp contrast normalize $base]
	    variable grey ; set ng [crimp contrast normalize $grey]

	    show_image [crimp montage vertical \
			    [crimp montage horizontal \
				 [border $base] \
				 [border $nb]] \
			    [crimp convert 2rgba \
				 [crimp montage horizontal \
				      [border $grey] \
				      [border $ng]]]]
	}

	proc EQG {} {
	    variable base
	    variable grey

	    show_image [crimp montage vertical \
			    [crimp montage horizontal \
				 [border $base] \
				 [border [crimp contrast equalize global $base]]] \
			    [crimp convert 2rgba \
				 [crimp montage horizontal \
				      [border $grey] \
				      [border [crimp contrast equalize global $grey]]]]]
	}

	proc EQL {} {
	    variable base
	    variable grey

	    show_image [crimp montage vertical \
			    [crimp montage horizontal \
				 [border $base] \
				 [border [crimp contrast equalize local $base]]] \
			    [crimp convert 2rgba \
				 [crimp montage horizontal \
				      [border $grey] \
				      [border [crimp contrast equalize local $grey]]]]]
	}

	ttk::button .top.nrm -text Normalized -command ::DEMO::NORM
	ttk::button .top.eqg -text Eq/Global  -command ::DEMO::EQG
	ttk::button .top.eql -text Eq/Local   -command ::DEMO::EQL

	grid .top.nrm -row 0 -column 0 -sticky swen
	grid .top.eqg -row 0 -column 1 -sticky swen
	grid .top.eql -row 0 -column 2 -sticky swen
    }
}






Added demos/convolve_blur_ulis.tcl.


















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_blur_ulis {
    label {Blur (ulis)}
    setup {
	variable coeff 0
	variable K [crimp kernel make {
	    {0  0   0 0 0}
	    {0  0   0 0 0}
	    {0  0 800 0 0}
	    {0  0   0 0 0}
	    {0  0   0 0 0}}]

	proc show {thecoeff} {
	    set m [expr {800*(1-$thecoeff)}]
	    set c $thecoeff

	    variable K [crimp kernel make \
			    [list \
				 [list $c  0  0  0 $c] \
				 [list  0  0 $c  0  0] \
				 [list  0 $c $m $c  0] \
				 [list  0  0 $c  0  0] \
				 [list $c  0  0  0 $c]]]

	    show_image [crimp filter convolve [base] $K]
	    return
	}

	proc showit {} {
	    variable coeff
	    show $coeff
	    return
	}

	scale .left.s -variable ::DEMO::coeff \
	    -from 0 -to 100 -resolution 1 \
	    -orient vertical \
	    -command ::DEMO::show

	grid .left.s -row 0 -column 0 -sticky swen
    }
    setup_image {
	showit
    }
}






Added demos/convolve_box.tcl.








































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_box {
    label {Blur Box}
    setup {
	variable K [crimp kernel make {
	    {1 1 1 1 1}
	    {1 1 1 1 1}
	    {1 1 1 1 1}
	    {1 1 1 1 1}
	    {1 1 1 1 1}}]

	# Separable kernel, compute the horizontal and vertical kernels.
	variable Kx [crimp kernel make {{1 1 1 1 1}}]
	variable Ky [crimp kernel transpose $Kx]
    }
    setup_image {
	# show_image [crimp filter convolve [base] $K]
	# Separable kernel, convolve x and y separately. Same result
	# as for the combined kernel, but faster.
	show_image [crimp filter convolve [base] $Kx $Ky]

	# Convolution times (butterfly 800x600), regular and separated by x/y.
	#             seconds  u-seconds/pixel
	# -----       -------- ---------------------
	# Setup       0.000337 0.0007020833333333333  Kx/Ky
	# Setup Image 0.773904 1.6123
	# -----       -------- ---------------------
	# Setup       0.000333 0.00069375             K
	# Setup Image 1.640612 3.4179416666666667
	# -----       -------- ---------------------

	# Show that the two applications generate the same result.
	#show_image [crimp difference [crimp filter convolve [base] $K] [crimp filter convolve [base] $Kx $Ky]]
    }
}






Added demos/convolve_crisp_ulis.tcl.














































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_crisp_ulis {
    label {Crisp (ulis)}
    setup {
	variable coeff 1
	variable K [crimp kernel make {
	    {0 0 0}
	    {0 8 0}
	    {0 0 0}}]

	proc show {thecoeff} {
	    set c [expr {1-$thecoeff}]
	    set m [expr {8*$thecoeff}]

	    variable K [crimp kernel make \
			    [list \
				 [list $c $c $c] \
				 [list $c $m $c] \
				 [list $c $c $c]]]

	    show_image [crimp filter convolve [base] $K]
	    return
	}

	proc showit {} {
	    variable coeff
	    show $coeff
	    return
	}

	scale .left.s -variable ::DEMO::coeff \
	    -from 0 -to 100 -resolution 1 \
	    -orient vertical \
	    -command ::DEMO::show

	grid .left.s -row 0 -column 0 -sticky swen
    }
    setup_image {
	showit
    }
}






Added demos/convolve_edgeh.tcl.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_edgeh {
    label {Edge Horizontical}
    setup {
	# http://wiki.tcl.tk/9521
	variable K [crimp kernel make {
	    {-1 -1 -1}
	    { 0  0  0}
	    { 1  1  1}}]
    }
    setup_image {
	show_image [crimp alpha opaque [crimp filter convolve [base] $K]]
    }
}






Added demos/convolve_edgehg.tcl.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_edgehg {
    label {Edge Grey/Horizontical}
    setup {
	# http://wiki.tcl.tk/9521
	variable K [crimp kernel make {
	    {-1 -1 -1}
	    { 0  0  0}
	    { 1  1  1}}]
    }
    setup_image {
	show_image [crimp filter convolve [crimp convert 2grey8 [base]] $K]
    }
}






Added demos/convolve_edgehv.tcl.


























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_edgehv {
    label {Edge H+V}
    setup {
	# http://wiki.tcl.tk/9521
	variable Kh [crimp kernel make {
	    {-1 -1 -1}
	    { 0  0  0}
	    { 1  1  1}}]
	variable Kv [crimp kernel make {
	    {-1  0 1}
	    {-1  0 1}
	    {-1  0 1}}]
    }
    setup_image {
	show_image [crimp alpha opaque \
			[crimp add \
			     [crimp filter convolve [base] $Kh] \
			     [crimp filter convolve [base] $Kv]]]
    }
}






Added demos/convolve_edgehvg.tcl.


























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_edgehvg {
    label {Edge Grey/H+V}
    setup {
	# http://wiki.tcl.tk/9521
	variable Kh [crimp kernel make {
	    {-1 -1 -1}
	    { 0  0  0}
	    { 1  1  1}}]
	variable Kv [crimp kernel make {
	    {-1  0 1}
	    {-1  0 1}
	    {-1  0 1}}]
    }
    setup_image {
	set grey [crimp convert 2grey8 [base]]
	show_image [crimp add \
			[crimp filter convolve $grey $Kh] \
			[crimp filter convolve $grey $Kv]]
    }
}






Added demos/convolve_edgev.tcl.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_edgev {
    label {Edge Vertical}
    setup {
	# http://wiki.tcl.tk/9521
	variable K [crimp kernel make {
	    {-1  0 1}
	    {-1  0 1}
	    {-1  0 1}}]
    }
    setup_image {
	show_image [crimp alpha opaque [crimp filter convolve [base] $K]]
    }
}






Added demos/convolve_edgevg.tcl.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_edgevg {
    label {Edge Grey/Vertical}
    setup {
	# http://wiki.tcl.tk/9521
	variable K [crimp kernel make {
	    {-1  0 1}
	    {-1  0 1}
	    {-1  0 1}}]
    }
    setup_image {
	show_image [crimp filter convolve [crimp convert 2grey8 [base]] $K]
    }
}






Added demos/convolve_emboss.tcl.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_emboss {
    label {Emboss (Ulis)}
    setup {
	# http://wiki.tcl.tk/10543
	variable K [crimp kernel make {
	    {-1 -1 1}
	    {-1 -1 1}
	    { 1  1 1}}]
    }
    setup_image {
	show_image [crimp alpha opaque [crimp filter convolve [base] $K]]
    }
}






Added demos/convolve_emboss2.tcl.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_embossb {
    label {Emboss (Suchenwirth)}
    setup {
	# http://wiki.tcl.tk/9521
	variable K [crimp kernel make {
	    {2  0  0}
	    {0 -1  0}
	    {0  0 -1}}]
    }
    setup_image {
	show_image [crimp alpha opaque [crimp filter convolve [base] $K]]
    }
}






Added demos/convolve_gaussian.tcl.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_gaussian {
    label {Blur Gaussian}
    setup {
	variable K [crimp kernel make {
	    {1  2  4  2 1}
	    {2  4  8  4 2}
	    {4  8 16  8 4}
	    {2  4  8  4 2}
	    {1  2  4  2 1}}]

	# Separable kernel, compute the horizontal and vertical kernels.
	variable Kx [crimp kernel make {{1 2 4 2 1}}]
	variable Ky [crimp kernel transpose $Kx]
    }
    setup_image {
	# show_image [crimp filter convolve [base] $K]
	# Separable kernel, convolve x and y separately. Same result
	# as for the combined kernel, but faster.
	show_image [crimp filter convolve [base] $Kx $Ky]
    }
}






Added demos/convolve_gaussian_fp.tcl.












































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_gaussian_fp {
    label {Blur Gaussian FP}
    setup {
	variable sigma 1

	variable tables
	variable Kxs
	variable Kys

	variable tabled
	variable Kxd
	variable Kyd

	proc TABLE {sigma} {
	    TABLEs $sigma
	    TABLEd $sigma
	    return
	}

	# Reference: http://en.wikipedia.org/wiki/Scale_space_implementation

	proc TABLEs {sigma} {
	    variable tables
	    variable Kxs
	    variable Kys

	    set tables [crimp table fgauss sampled $sigma]
	    set Kxs    [crimp kernel fpmake $tables]
	    set Kys    [crimp kernel transpose $Kxs]

	    # Show the kernel...
	    #log [lreplace $Kx 2 2 $table]
	    return
	}

	proc TABLEd {sigma} {
	    variable tabled
	    variable Kxd
	    variable Kyd

	    set tabled [crimp table fgauss discrete $sigma]
	    set Kxd    [crimp kernel fpmake $tabled]
	    set Kyd    [crimp kernel transpose $Kxd]

	    # Show the kernel...
	    #log [lreplace $Kx 2 2 $table]
	    return
	}

	proc showp {} {
	    demo_time_hook g/plain {
		show_image [base]
	    }
	    return
	}

	proc shows {} {
	    demo_time_hook g/sample {
		variable Kxs
		variable Kys

		show_image [crimp filter convolve [base] $Kxs $Kys]
	    }
	    return
	}

	proc showd {} {
	    demo_time_hook g/discrete {
		variable Kxd
		variable Kyd

		show_image [crimp filter convolve [base] $Kxd $Kyd]
	    }
	    return
	}

	TABLE $sigma

	ttk::button .left.pl -text Plain -command ::DEMO::showp

	scale       .left.s -variable ::DEMO::sigma \
	    -from 0.1 -to 10 -resolution 0.1 \
	    -orient horizontal \
	    -command ::DEMO::TABLE

	plot        .left.ps -variable ::DEMO::tables -title {Kernel Sampled} -locked 0 -xlocked 0
	ttk::button .left.as -text Apply -command ::DEMO::shows

	plot        .left.pd -variable ::DEMO::tabled -title {Kernel Discrete} -locked 0 -xlocked 0
	ttk::button .left.ad -text Apply -command ::DEMO::showd

	grid .left.pl -row 0 -column 0 -sticky swen
	grid .left.s  -row 1 -column 0 -sticky swen
	grid .left.ps -row 2 -column 0 -sticky swen
	grid .left.as -row 3 -column 0 -sticky nw
	grid .left.pd -row 4 -column 0 -sticky swen
	grid .left.ad -row 5 -column 0 -sticky nw
    }
    setup_image {
	shows
    }
}






Added demos/convolve_laplace4.tcl.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_laplace4 {
    label {Laplace 4}
    setup {
	# http://wiki.tcl.tk/9521
	variable K [crimp kernel make {
	    { 0  -1  0}
	    {-1   4 -1}
	    { 0  -1  0}}]
    }
    setup_image {
	show_image [crimp alpha opaque [crimp filter convolve [base] $K]]
    }
}






Added demos/convolve_laplace5.tcl.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_laplace5 {
    label {Laplace 4+1}
    setup {
	# http://wiki.tcl.tk/9521
	variable K [crimp kernel make {
	    { 0  -1  0}
	    {-1   5 -1}
	    { 0  -1  0}} 1]
    }
    setup_image {
	show_image [crimp alpha opaque [crimp filter convolve [base] $K]]
    }
}






Added demos/convolve_laplace8.tcl.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_laplace8 {
    label {Laplace 8}
    setup {
	# http://wiki.tcl.tk/9521
	variable K [crimp kernel make {
	    {-1  -1 -1}
	    {-1   8 -1}
	    {-1  -1 -1}}]
    }
    setup_image {
	show_image [crimp alpha opaque [crimp filter convolve [base] $K]]
    }
}






Added demos/convolve_laplace9.tcl.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_laplace9 {
    label {Laplace 8+1}
    setup {
	# http://wiki.tcl.tk/9521
	variable K [crimp kernel make {
	    {-1  -1 -1}
	    {-1   9 -1}
	    {-1  -1 -1}}]
    }
    setup_image {
	show_image [crimp alpha opaque [crimp filter convolve [base] $K]]
    }
}






Added demos/convolve_laplacex.tcl.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_laplacex1 {
    label {Laplace X+1}
    setup {
	# http://wiki.tcl.tk/9521
	variable K [crimp kernel make {
	    { 1  -2  1}
	    {-2   5 -2}
	    { 1  -2  1}}]
    }
    setup_image {
	show_image [crimp alpha opaque [crimp filter convolve [base] $K]]
    }
}






Added demos/convolve_laplacex1.tcl.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_laplacex {
    label {Laplace X}
    setup {
	# http://wiki.tcl.tk/9521
	variable K [crimp kernel make {
	    { 1  -2  1}
	    {-2   4 -2}
	    { 1  -2  1}}]
    }
    setup_image {
	show_image [crimp alpha opaque [crimp filter convolve [base] $K]]
    }
}






Added demos/convolve_pseudoedge.tcl.
































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_pseudoedges {
    label {Pseudo Edges}
    setup {
	variable K [crimp kernel make {
	    {1  2  4  2 1}
	    {2  4  8  4 2}
	    {4  8 16  8 4}
	    {2  4  8  4 2}
	    {1  2  4  2 1}}]

	# Separable kernel, compute the horizontal and vertical kernels.
	variable Kx [crimp kernel make {{1 2 4 2 1}}]
	variable Ky [crimp kernel transpose $Kx]
    }
    setup_image {
	# show_image [crimp filter convolve [base] $K]
	# Separable kernel, convolve x and y separately. Same result
	# as for the combined kernel, but faster.
	show_image [crimp alpha opaque \
			[crimp add \
			     [base] \
			     [crimp difference \
				  [base] \
				  [crimp filter convolve [base] $Kx $Ky]]]]
    }
}






Added demos/convolve_sobelh.tcl.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_sobelh {
    label {Sobel Horizontical}
    setup {
	# http://wiki.tcl.tk/9521
	variable K [crimp kernel make {
	    { 1  2  1}
	    { 0  0  0}
	    {-1 -2 -1}}]
    }
    setup_image {
	show_image [crimp alpha opaque [crimp filter convolve [base] $K]]
    }
}






Added demos/convolve_sobelhg.tcl.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_sobelhg {
    label {Sobel Grey/Horizontical}
    setup {
	# http://wiki.tcl.tk/9521
	variable K [crimp kernel make {
	    { 1  2  1}
	    { 0  0  0}
	    {-1 -2 -1}}]
    }
    setup_image {
	show_image [crimp filter convolve [crimp convert 2grey8 [base]] $K]
    }
}






Added demos/convolve_sobelhv.tcl.


























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_sobelhv {
    label {Sobel H+V}
    setup {
	# http://wiki.tcl.tk/9521
	variable Kv [crimp kernel make {
	    {1  0 -1}
	    {2  0 -2}
	    {1  0 -1}}]
	variable Kh [crimp kernel make {
	    { 1  2  1}
	    { 0  0  0}
	    {-1 -2 -1}}]
    }
    setup_image {
	show_image [crimp alpha opaque \
			[crimp add \
			     [crimp filter convolve [base] $Kh] \
			     [crimp filter convolve [base] $Kv]]]
    }
}






Added demos/convolve_sobelhvg.tcl.


























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_sobelhvg {
    label {Sobel Grey/H+V}
    setup {
	# http://wiki.tcl.tk/9521
	variable Kv [crimp kernel make {
	    {1  0 -1}
	    {2  0 -2}
	    {1  0 -1}}]
	variable Kh [crimp kernel make {
	    { 1  2  1}
	    { 0  0  0}
	    {-1 -2 -1}}]
    }
    setup_image {
	set grey [crimp convert 2grey8 [base]]
	show_image [crimp add \
			     [crimp filter convolve $grey $Kh] \
			     [crimp filter convolve $grey $Kv]]
    }
}






Added demos/convolve_sobelhvgm.tcl.































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_sobelhvgm {
    label {Sobel Grey/H+V/M}
    setup {
	# http://wiki.tcl.tk/9521
	variable Kv [crimp kernel make {
	    {1  0 -1}
	    {2  0 -2}
	    {1  0 -1}}]
	variable Kh [crimp kernel make {
	    { 1  2  1}
	    { 0  0  0}
	    {-1 -2 -1}}]
    }
    setup_image {
	set grey [crimp convert 2grey8 [base]]
	set gx   [crimp filter convolve $grey $Kh]
	set gy   [crimp filter convolve $grey $Kv]

	show_image [crimp remap \
			[crimp add \
			     [crimp multiply $gx $gx] \
			     [crimp multiply $gy $gy]] \
			[crimp map sqrt]]
    }
}






Added demos/convolve_sobelhvm.tcl.































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_sobelhvm {
    label {Sobel H+V/M}
    setup {
	# http://wiki.tcl.tk/9521
	variable Kv [crimp kernel make {
	    {1  0 -1}
	    {2  0 -2}
	    {1  0 -1}}]
	variable Kh [crimp kernel make {
	    { 1  2  1}
	    { 0  0  0}
	    {-1 -2 -1}}]
    }
    setup_image {
	set gx [crimp filter convolve [base] $Kh]
	set gy [crimp filter convolve [base] $Kv]

	show_image [crimp alpha opaque \
			[crimp remap \
			     [crimp add \
				  [crimp multiply $gx $gx] \
				  [crimp multiply $gy $gy]] \
			     [crimp map sqrt]]]
    }
}






Added demos/convolve_sobelv.tcl.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_sobelv {
    label {Sobel Vertical}
    setup {
	# http://wiki.tcl.tk/9521
	variable K [crimp kernel make {
	    {1  0 -1}
	    {2  0 -2}
	    {1  0 -1}}]
    }
    setup_image {
	show_image [crimp alpha opaque [crimp filter convolve [base] $K]]
    }
}






Added demos/convolve_sobelvg.tcl.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

def op_convolve_sobelvg {
    label {Sobel Grey/Vertical}
    setup {
	# http://wiki.tcl.tk/9521
	variable K [crimp kernel make {
	    {1  0 -1}
	    {2  0 -2}
	    {1  0 -1}}]
    }
    setup_image {
	show_image [crimp filter convolve [crimp convert 2grey8 [base]] $K]
    }
}






Added demos/crop.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def crop {
    label {Crop}
    setup_image {
	show_image [crimp crop [base] 50 50 50 50]
    }
}






Added demos/cut.tcl.














1
2
3
4
5
6
7
8

+
+
+
+
+
+
+
+

def cut {
    label {Cut}
    setup_image {
	show_image [crimp cut [base] 50 50 50 50]

	puts [crimp dimensions [crimp cut [base] 50 50 50 50]]
    }
}






Added demos/decimate2.tcl.















1
2
3
4
5
6
7
8
9

+
+
+
+
+
+
+
+
+

def op_decimate2 {
    label Decimate\u21932
    setup {
	set K [crimp kernel make {{1 2 1}}]
    }
    setup_image {
	show_image [crimp alpha opaque [crimp decimate xy [base] 2 $K]]
    }
}






Added demos/decimate4.tcl.


















1
2
3
4
5
6
7
8
9
10
11
12

+
+
+
+
+
+
+
+
+
+
+
+

def op_decimate4 {
    label Decimate\u21934
    setup {
	set K [crimp kernel make {{1 2 1}}]
    }
    setup_image {
	show_image [crimp alpha opaque \
			[crimp decimate xy \
			     [crimp decimate xy [base] 2 $K] \
			     2 $K]]
    }
}






Added demos/decint.tcl.


















1
2
3
4
5
6
7
8
9
10
11
12

+
+
+
+
+
+
+
+
+
+
+
+

def op_decint2 {
    label "Decimate\u21932, Interpolate\u21912"
    setup {
	set KD [crimp kernel make {{1 2 1}}]
	set KI [crimp kernel make {{1 2 1}} 2]
    }
    setup_image {
	show_image [crimp alpha opaque \
			[crimp interpolate xy \
			     [crimp decimate xy [base] 2 $KD] 2 $KI]]
    }
}






Added demos/degamma.tcl.





































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_gamma_invers {
    label Degamma
    setup {
	variable gamma 1
	variable table {}

	proc show {thegamma} {
	    variable table [crimp table degamma  $thegamma]
	    show_image     [crimp degamma [base] $thegamma]
	    return
	}

	proc showit {} {
	    variable gamma
	    show $gamma
	    return
	}

	plot  .left.p -variable ::DEMO::table -title {Invers Gamma}
	scale .left.s -variable ::DEMO::gamma \
	    -from 5 -to 1 -resolution 0.01 \
	    -orient vertical \
	    -command ::DEMO::show

	grid .left.p -row 0 -column 0 -sticky swen
	grid .left.s -row 0 -column 1 -sticky swen
    }
    setup_image {
	showit
    }
}






Added demos/difference.tcl.


















1
2
3
4
5
6
7
8
9
10
11
12

+
+
+
+
+
+
+
+
+
+
+
+

def op_difference {
    label Difference
    active {
	expr {
	      ([bases] == 2) &&
	      ([crimp dimensions [base 0]] eq [crimp dimensions [base 1]])
	  }
    }
    setup_image {
	show_image [crimp alpha opaque [crimp difference [base 0] [base 1]]]
    }
}






Added demos/downsample2.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_downsample2 {
    label Downsample\u21932
    setup_image {
	show_image [crimp downsample xy [base] 2]
    }
}






Added demos/downsample3.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_downsample3 {
    label Downsample\u21933
    setup_image {
	show_image [crimp downsample xy [base] 3]
    }
}






Added demos/downsample4.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_downsample4 {
    label Downsample\u21934
    setup_image {
	show_image [crimp::downsample xy [base] 4]
    }
}






Added demos/equalize_hsv.tcl.








































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_equalize_hsv {
    label {Equalize (HSV)}
    setup_image {
	variable mask [lindex [crimp split [base]] end]
	PLAIN
    }
    setup {
	variable TS {0 1}
	variable TV {0 1}
	variable TL {0 1}

	variable mask

	proc HISTO {image} {
	    variable HL ; variable HH ; variable HS ; variable HV
	    variable TL ;               variable TS ; variable TV 

	    array set TMP [crimp histogram [crimp convert 2grey8 $image]]
	    array set TMP [crimp histogram [crimp convert 2hsv   $image]]

	    set HL [dict values $TMP(luma)]       ; set TL [crimp::CUMULATE $HL]
	    set HH [dict values $TMP(hue)]
	    set HS [dict values $TMP(saturation)] ; set TS [crimp::CUMULATE $HS]
	    set HV [dict values $TMP(value)]      ; set TV [crimp::CUMULATE $HV]


	    # For the sake of the display we cut out the pure white
	    # and black, as they are likely outliers with an extreme
	    # number of pixels using them.
	    
	    lset HL 0 0 ; lset HL 255 0
	    lset HS 0 0 ; lset HS 255 0
	    lset HV 0 0 ; lset HV 255 0
	    return
	}

	proc PLAIN {} {
	    HISTO      [base]
	    show_image [base]
	    return
	}

	proc EQUAL {} {
	    demo_time_hook equalize {
		HISTO [base]
		# H is not stretched. Does not make sense for HUE.
		variable HH ; variable HS ; variable HV
		              variable TS ; variable TV
		variable mask

		set fs [crimp::FIT $TS 255]
		set fv [crimp::FIT $TV 255]

		set h [crimp map identity]
		set s [crimp mapof $fs]
		set v [crimp mapof $fv]

		set new [crimp alpha set \
			     [crimp convert 2rgb \
				  [crimp remap \
				       [crimp convert 2hsv [base]] \
				       $h $s $v]] \
			     $mask]
	    }

	    show_image $new
	    HISTO      $new
	    return
	}

	HISTO [base]

	plot  .left.hl   -variable ::DEMO::HL -locked 0 -title Luma
	plot  .left.tl   -variable ::DEMO::TL -locked 0 -title {CDF Luma}
	plot  .left.hh   -variable ::DEMO::HH -locked 0 -title Hue

	plot  .bottom.hs -variable ::DEMO::HS -locked 0 -title Saturation
	plot  .bottom.hv -variable ::DEMO::HV -locked 0 -title Value

	plot  .bottom.ts -variable ::DEMO::TS -locked 0 -title {CDF Saturation}
	plot  .bottom.tv -variable ::DEMO::TV -locked 0 -title {CDF Value}

	ttk::button .top.equal -text Equalize -command ::DEMO::EQUAL
	ttk::button .top.plain -text Plain    -command ::DEMO::PLAIN

	grid .left.hl -row 0 -column 0 -sticky swen
	grid .left.tl -row 1 -column 0 -sticky swen
	grid .left.hh -row 2 -column 0 -sticky swen

	grid .bottom.hs -row 0 -column 0 -sticky swen
	grid .bottom.ts -row 0 -column 1 -sticky swen
	grid .bottom.hv -row 0 -column 2 -sticky swen
	grid .bottom.tv -row 0 -column 3 -sticky swen

	grid .top.equal -row 0 -column 0 -sticky swen
	grid .top.plain -row 0 -column 1 -sticky swen
    }
}






Added demos/equalize_hsv_simple.tcl.





















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_equalize_hsv_simple {
    label {Equalize/S (HSV)}
    setup_image {
	variable mask [lindex [crimp split [base]] end]
	PLAIN
    }
    setup {
	variable TS {0 1}
	variable TV {0 1}
	variable TL {0 1}

	variable mask

	proc HISTO {image} {
	    variable HL ; variable HH ; variable HS ; variable HV
	    variable TL ;               variable TS ; variable TV 

	    array set TMP [crimp histogram [crimp convert 2grey8 $image]]
	    array set TMP [crimp histogram [crimp convert 2hsv   $image]]

	    set HL [dict values $TMP(luma)]       ; set TL [crimp::CUMULATE $HL]
	    set HH [dict values $TMP(hue)]
	    set HS [dict values $TMP(saturation)] ; set TS [crimp::CUMULATE $HS]
	    set HV [dict values $TMP(value)]      ; set TV [crimp::CUMULATE $HV]


	    # For the sake of the display we cut out the pure white
	    # and black, as they are likely outliers with an extreme
	    # number of pixels using them.
	    
	    lset HL 0 0 ; lset HL 255 0
	    lset HS 0 0 ; lset HS 255 0
	    lset HV 0 0 ; lset HV 255 0
	    return
	}

	proc PLAIN {} {
	    HISTO      [base]
	    show_image [base]
	    return
	}

	proc EQUAL {} {
	    demo_time_hook equalize {
		HISTO [base]
		# H is not stretched. Does not make sense for HUE.
		variable HH ; variable HS ; variable HV
		              variable TS ; variable TV
		variable mask

		set fs [crimp::FIT $TS 255]
		set fv [crimp::FIT $TV 255]

		set h [crimp map identity]
		set s [crimp mapof $fs]
		set v [crimp mapof $fv]

		set new [crimp alpha set \
			     [crimp convert 2rgb \
				  [crimp remap \
				       [crimp convert 2hsv [base]] \
				       $h $s $v]] \
			     $mask]
	    }

	    show_image $new
	    HISTO      $new
	    return
	}

	HISTO [base]

	ttk::button .top.equal -text Equalize -command ::DEMO::EQUAL
	ttk::button .top.plain -text Plain    -command ::DEMO::PLAIN

	grid .top.equal -row 0 -column 0 -sticky swen
	grid .top.plain -row 0 -column 1 -sticky swen
    }
}






Added demos/equalize_luma.tcl.





































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_equalize_luma {
    label {Equalize (luma)}
    setup_image {
	variable base [crimp convert 2grey8 [base]]
	PLAIN
    }
    setup {
	variable base
	variable TL {0 1}

	proc HISTO {image} {
	    variable HL
	    variable TL

	    array set TMP [crimp histogram $image]

	    set HL [dict values $TMP(luma)]
	    set TL [crimp::CUMULATE $HL]

	    # For the sake of the display we cut out the pure white
	    # and black, as they are likely outliers with an extreme
	    # number of pixels using them.
	    
	    lset HL 0 0 ; lset HL 255 0
	    return
	}

	proc PLAIN {} {
	    variable base
	    HISTO      $base
	    show_image $base
	    return
	}

	proc EQUAL {} {
	    variable base
	    HISTO $base
	    variable HL
	    variable TL

	    set fl [crimp::FIT $TL 255]
	    set l  [crimp mapof $fl]

	    set new [crimp remap $base $l]

	    show_image $new
	    HISTO      $new
	    return
	}

	plot  .left.hl   -variable ::DEMO::HL -locked 0 -title Luma
	plot  .left.tl   -variable ::DEMO::TL -locked 0 -title {CDF Luma}

	ttk::button .top.equal -text Equalize -command ::DEMO::EQUAL
	ttk::button .top.plain -text Plain    -command ::DEMO::PLAIN

	grid .left.hl -row 0 -column 0 -sticky swen
	grid .left.tl -row 1 -column 0 -sticky swen

	grid .top.equal -row 0 -column 0 -sticky swen
	grid .top.plain -row 0 -column 1 -sticky swen
    }
}






Added demos/equalize_luma_simple.tcl.































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_equalize_luma_simple {
    label {Equalize/S (luma)}
    setup_image {
	variable base [crimp convert 2grey8 [base]]
	PLAIN
    }
    setup {
	variable base
	variable TL {0 1}

	proc HISTO {image} {
	    variable HL
	    variable TL

	    array set TMP [crimp histogram $image]

	    set HL [dict values $TMP(luma)]
	    set TL [crimp::CUMULATE $HL]

	    # For the sake of the display we cut out the pure white
	    # and black, as they are likely outliers with an extreme
	    # number of pixels using them.
	    
	    lset HL 0 0 ; lset HL 255 0
	    return
	}

	proc PLAIN {} {
	    variable base
	    HISTO      $base
	    show_image $base
	    return
	}

	proc EQUAL {} {
	    variable base
	    HISTO $base
	    variable HL
	    variable TL

	    set fl [crimp::FIT $TL 255]
	    set l  [crimp mapof $fl]

	    set new [crimp remap $base $l]

	    show_image $new
	    HISTO      $new
	    return
	}

	ttk::button .top.equal -text Equalize -command ::DEMO::EQUAL
	ttk::button .top.plain -text Plain    -command ::DEMO::PLAIN

	grid .top.equal -row 0 -column 0 -sticky swen
	grid .top.plain -row 0 -column 1 -sticky swen
    }
}






Added demos/equalize_rgb.tcl.


































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_equalize_rgb {
    label {Equalize (RGB)}
    setup_image {
	PLAIN
    }
    setup {
	variable TR {0 1}
	variable TG {0 1}
	variable TB {0 1}
	variable TL {0 1}

	proc HISTO {image} {
	    variable HL ; variable HR ; variable HG ; variable HB
	    variable TL ; variable TR ; variable TG ; variable TB

	    array set TMP [crimp histogram [crimp convert 2grey8 $image]]
	    array set TMP [crimp histogram $image]

	    set HL [dict values $TMP(luma)]  ; set TL [crimp::CUMULATE $HL]
	    set HR [dict values $TMP(red)]   ; set TR [crimp::CUMULATE $HR]
	    set HG [dict values $TMP(green)] ; set TG [crimp::CUMULATE $HG]
	    set HB [dict values $TMP(blue)]  ; set TB [crimp::CUMULATE $HB]

	    # For the sake of the display we cut out the pure white
	    # and black, as they are likely outliers with an extreme
	    # number of pixels using them.
	    
	    lset HL 0 0 ; lset HL 255 0
	    lset HR 0 0 ; lset HR 255 0
	    lset HG 0 0 ; lset HG 255 0
	    lset HB 0 0 ; lset HB 255 0
	    return
	}

	proc PLAIN {} {
	    HISTO      [base]
	    show_image [base]
	    return
	}

	proc EQUAL {} {
	    demo_time_hook equalize {
		HISTO [base]
		variable HR ; variable HG ; variable HB
		variable TR ; variable TG ; variable TB

		set fr [crimp::FIT $TR 255]
		set fg [crimp::FIT $TG 255]
		set fb [crimp::FIT $TB 255]

		set r [crimp mapof $fr]
		set g [crimp mapof $fg]
		set b [crimp mapof $fb]

		set new [crimp remap [base] $r $g $b]
	    }

	    show_image $new
	    HISTO      $new
	    return
	}

	HISTO [base]

	plot  .left.hl   -variable ::DEMO::HL -locked 0 -title Luma
	plot  .left.tl   -variable ::DEMO::TL -locked 0 -title {CDF Luma}

	plot  .bottom.hr -variable ::DEMO::HR -locked 0 -title Red
	plot  .bottom.hg -variable ::DEMO::HG -locked 0 -title Green
	plot  .bottom.hb -variable ::DEMO::HB -locked 0 -title Blue

	plot  .bottom.tr -variable ::DEMO::TR -locked 0 -title {CDF Red}
	plot  .bottom.tg -variable ::DEMO::TG -locked 0 -title {CDF Green}
	plot  .bottom.tb -variable ::DEMO::TB -locked 0 -title {CDF Blue}

	ttk::button .top.equal -text Equalize -command ::DEMO::EQUAL
	ttk::button .top.plain -text Plain    -command ::DEMO::PLAIN

	grid .left.hl -row 0 -column 0 -sticky swen
	grid .left.tl -row 1 -column 0 -sticky swen

	grid .bottom.hr -row 0 -column 0 -sticky swen
	grid .bottom.tr -row 1 -column 0 -sticky swen
	grid .bottom.hg -row 0 -column 1 -sticky swen
	grid .bottom.tg -row 1 -column 1 -sticky swen
	grid .bottom.hb -row 0 -column 2 -sticky swen
	grid .bottom.tb -row 1 -column 2 -sticky swen

	grid .top.equal -row 0 -column 0 -sticky swen
	grid .top.plain -row 0 -column 1 -sticky swen
    }
}






Added demos/equalize_rgb2.tcl.




























































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_equalize_rgb2 {
    label {Equalize (RGB/2)}
    setup_image {
	PLAIN
    }
    setup {
	variable TR {0 1}
	variable TG {0 1}
	variable TB {0 1}
	variable TL {0 1}

	proc HISTO {image} {
	    variable HL ; variable HR ; variable HG ; variable HB
	    variable TL ; variable TR ; variable TG ; variable TB

	    array set TMP [crimp histogram [crimp convert 2grey8 $image]]
	    array set TMP [crimp histogram $image]

	    set HL [dict values $TMP(luma)]  ; set TL [crimp::CUMULATE $HL]
	    set HR [dict values $TMP(red)]   ; set TR [crimp::CUMULATE $HR]
	    set HG [dict values $TMP(green)] ; set TG [crimp::CUMULATE $HG]
	    set HB [dict values $TMP(blue)]  ; set TB [crimp::CUMULATE $HB]

	    # For the sake of the display we cut out the pure white
	    # and black, as they are likely outliers with an extreme
	    # number of pixels using them.
	    
	    lset HL 0 0 ; lset HL 255 0
	    lset HR 0 0 ; lset HR 255 0
	    lset HG 0 0 ; lset HG 255 0
	    lset HB 0 0 ; lset HB 255 0
	    return
	}

	proc PLAIN {} {
	    HISTO      [base]
	    show_image [base]
	    return
	}

	proc EQUAL {} {
	    demo_time_hook equalize {
		HISTO [base]
		variable TL

		set fl  [crimp::FIT $TL 255]
		set l   [crimp mapof $fl]

		set new [crimp remap [base] $l $l $l]
	    }

	    show_image $new
	    HISTO      $new
	    return
	}

	HISTO [base]

	plot  .left.hl   -variable ::DEMO::HL -locked 0 -title Luma
	plot  .left.tl   -variable ::DEMO::TL -locked 0 -title {CDF Luma}

	plot  .bottom.hr -variable ::DEMO::HR -locked 0 -title Red
	plot  .bottom.hg -variable ::DEMO::HG -locked 0 -title Green
	plot  .bottom.hb -variable ::DEMO::HB -locked 0 -title Blue

	plot  .bottom.tr -variable ::DEMO::TR -locked 0 -title {CDF Red}
	plot  .bottom.tg -variable ::DEMO::TG -locked 0 -title {CDF Green}
	plot  .bottom.tb -variable ::DEMO::TB -locked 0 -title {CDF Blue}

	ttk::button .top.equal -text Equalize -command ::DEMO::EQUAL
	ttk::button .top.plain -text Plain    -command ::DEMO::PLAIN

	grid .left.hl -row 0 -column 0 -sticky swen
	grid .left.tl -row 1 -column 0 -sticky swen

	grid .bottom.hr -row 0 -column 0 -sticky swen
	grid .bottom.tr -row 1 -column 0 -sticky swen
	grid .bottom.hg -row 0 -column 1 -sticky swen
	grid .bottom.tg -row 1 -column 1 -sticky swen
	grid .bottom.hb -row 0 -column 2 -sticky swen
	grid .bottom.tb -row 1 -column 2 -sticky swen

	grid .top.equal -row 0 -column 0 -sticky swen
	grid .top.plain -row 0 -column 1 -sticky swen
    }
}






Added demos/equalize_rgb2_simple.tcl.






























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_equalize_rgb2_simple {
    label {Equalize/S (RGB/2)}
    setup_image {
	variable base [crimp convert 2grey8 [base]]
	PLAIN
    }
    setup {
	variable base
	variable TL {0 1}

	proc HISTO {image} {
	    variable HL
	    variable TL

	    array set TMP [crimp histogram $image]

	    set HL [dict values $TMP(luma)]
	    set TL [crimp::CUMULATE $HL]

	    # For the sake of the display we cut out the pure white
	    # and black, as they are likely outliers with an extreme
	    # number of pixels using them.
	    
	    lset HL 0 0 ; lset HL 255 0
	    return
	}

	proc PLAIN {} {
	    variable base
	    HISTO      $base
	    show_image [base]
	    return
	}

	proc EQUAL {} {
	    variable base
	    HISTO   $base
	    variable HL
	    variable TL

	    set fl [crimp::FIT $TL 255]
	    set l  [crimp mapof $fl]

	    set new [crimp remap [base] $l]

	    show_image $new
	    return
	}

	ttk::button .top.equal -text Equalize -command ::DEMO::EQUAL
	ttk::button .top.plain -text Plain    -command ::DEMO::PLAIN

	grid .top.equal -row 0 -column 0 -sticky swen
	grid .top.plain -row 0 -column 1 -sticky swen
    }
}






Added demos/equalize_rgb_simple.tcl.













































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_equalize_rgb_simple {
    label {Equalize/S (RGB)}
    setup_image {
	PLAIN
    }
    setup {
	variable TR {0 1}
	variable TG {0 1}
	variable TB {0 1}
	variable TL {0 1}

	proc HISTO {image} {
	    variable HL ; variable HR ; variable HG ; variable HB
	    variable TL ; variable TR ; variable TG ; variable TB

	    array set TMP [crimp histogram [crimp convert 2grey8 $image]]
	    array set TMP [crimp histogram $image]

	    set HL [dict values $TMP(luma)]  ; set TL [crimp::CUMULATE $HL]
	    set HR [dict values $TMP(red)]   ; set TR [crimp::CUMULATE $HR]
	    set HG [dict values $TMP(green)] ; set TG [crimp::CUMULATE $HG]
	    set HB [dict values $TMP(blue)]  ; set TB [crimp::CUMULATE $HB]

	    # For the sake of the display we cut out the pure white
	    # and black, as they are likely outliers with an extreme
	    # number of pixels using them.
	    
	    lset HL 0 0 ; lset HL 255 0
	    lset HR 0 0 ; lset HR 255 0
	    lset HG 0 0 ; lset HG 255 0
	    lset HB 0 0 ; lset HB 255 0
	    return
	}

	proc PLAIN {} {
	    HISTO      [base]
	    show_image [base]
	    return
	}

	proc EQUAL {} {
	    demo_time_hook equalize {
		HISTO [base]
		variable HR ; variable HG ; variable HB
		variable TR ; variable TG ; variable TB

		set fr [crimp::FIT $TR 255]
		set fg [crimp::FIT $TG 255]
		set fb [crimp::FIT $TB 255]

		set r [crimp mapof $fr]
		set g [crimp mapof $fg]
		set b [crimp mapof $fb]

		set new [crimp remap [base] $r $g $b]
	    }

	    show_image $new
	    HISTO      $new
	    return
	}

	HISTO [base]

	ttk::button .top.equal -text Equalize -command ::DEMO::EQUAL
	ttk::button .top.plain -text Plain    -command ::DEMO::PLAIN

	grid .top.equal -row 0 -column 0 -sticky swen
	grid .top.plain -row 0 -column 1 -sticky swen
    }
}






Added demos/equalize_simple.tcl.
























































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_equalize_simple {
    label {Equalize/S}
    setup_image {
	variable greybase [crimp convert 2grey8 [base]]
	variable mask     [lindex [crimp split [base]] end]
	PLAIN
    }
    setup {
	variable greybase
	variable TL {0 1}

	proc HISTOG {image} {
	    variable TL
	    array set TMP [crimp histogram $image]
	    set TL [crimp::CUMULATE [dict values $TMP(luma)]]
	    return
	}

	proc PLAIN {} {
	    show_image [base]
	    return
	}

	proc EQUAL_LUMA {} {
	    variable greybase
	    HISTOG  $greybase
	    variable TL
	    show_image [crimp remap $greybase [crimp mapof [crimp::FIT $TL 255]]]
	    return
	}

	proc EQUAL_RGB2 {} {
	    variable greybase
	    HISTOG   $greybase
	    variable TL
	    show_image [crimp remap [base] [crimp mapof [crimp::FIT $TL 255]]]
	    return
	}

	variable TR {0 1}
	variable TG {0 1}
	variable TB {0 1}

	proc HISTORGB {image} {
	    variable TR ; variable TG ; variable TB
	    array set TMP [crimp histogram $image]
	    set TR [crimp::CUMULATE [dict values $TMP(red)]]
	    set TG [crimp::CUMULATE [dict values $TMP(green)]]
	    set TB [crimp::CUMULATE [dict values $TMP(blue)]]
	    return
	}

	proc EQUAL_RGB {} {
	    demo_time_hook equalize {
		HISTORGB [base]
		variable TR ; variable TG ; variable TB

		set r [crimp mapof [crimp::FIT $TR 255]]
		set g [crimp mapof [crimp::FIT $TG 255]]
		set b [crimp mapof [crimp::FIT $TB 255]]

		show_image [crimp remap [base] $r $g $b]
	    }
	    return
	}

	variable TS {0 1}
	variable TV {0 1}
	variable mask

	proc HISTOHSV {image} {
	    variable TS ; variable TV 
	    array set TMP [crimp histogram [crimp convert 2hsv   $image]]
	    set TS [crimp::CUMULATE [dict values $TMP(saturation)]]
	    set TV [crimp::CUMULATE [dict values $TMP(value)]]
	    return
	}

	proc EQUAL_SV {} {
	    demo_time_hook equalize {
		HISTOHSV [base]
		# H is not stretched. Does not make sense for HUE.
		variable TS ; variable TV
		variable mask

		set h [crimp map identity]
		set s [crimp mapof [crimp::FIT $TS 255]]
		set v [crimp mapof [crimp::FIT $TV 255]]

		show_image [crimp alpha set \
				[crimp convert 2rgb \
				     [crimp remap \
					  [crimp convert 2hsv [base]] \
					  $h $s $v]] \
				$mask]
	    }
	    return
	}

	proc EQUAL_V {} {
	    demo_time_hook equalize {
		HISTOHSV [base]
		# H & S are not stretched. Does not make sense for HUE, and not good for Saturation.
		variable TV
		variable mask

		set i [crimp map identity]
		set v [crimp mapof [crimp::FIT $TV 255]]

		show_image [crimp alpha set \
				[crimp convert 2rgb \
				     [crimp remap \
					  [crimp convert 2hsv [base]] \
					  $i $i $v]] \
				$mask]
	    }
	    return
	}

	proc EQUAL_AHE {} {
	    demo_time_hook ahe {
		show_image [crimp convert 2rgb \
				[crimp filter ahe \
				     [crimp convert 2hsv [base]] \
				     100]]
	    }
	    return
	}

	ttk::button .top.plain   -text Plain       -command ::DEMO::PLAIN
	ttk::button .top.equallu -text Eq/Luma     -command ::DEMO::EQUAL_LUMA
	ttk::button .top.equalr2 -text Eq/RGB/Luma -command ::DEMO::EQUAL_RGB2
	ttk::button .top.equalrg -text Eq/RGB      -command ::DEMO::EQUAL_RGB
	ttk::button .top.equalsv -text Eq/SV       -command ::DEMO::EQUAL_SV
	ttk::button .top.equalvv -text Eq/V        -command ::DEMO::EQUAL_V
	ttk::button .top.equalah -text Eq/AHE      -command ::DEMO::EQUAL_AHE

	grid .top.plain   -row 0 -column 0 -sticky swen
	grid .top.equallu -row 0 -column 1 -sticky swen
	grid .top.equalr2 -row 0 -column 2 -sticky swen
	grid .top.equalrg -row 0 -column 3 -sticky swen
	grid .top.equalsv -row 0 -column 4 -sticky swen
	grid .top.equalvv -row 0 -column 5 -sticky swen
	grid .top.equalah -row 0 -column 6 -sticky swen
    }
}






Added demos/equalize_value.tcl.






































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_equalize_value {
    label {Equalize (HSV - Value)}
    setup_image {
	variable mask [lindex [crimp split [base]] end]
	PLAIN
    }
    setup {
	variable TS {0 1}
	variable TV {0 1}
	variable TL {0 1}

	variable mask

	proc HISTO {image} {
	    variable HL ; variable HH ; variable HS ; variable HV
	    variable TL ;               variable TS ; variable TV 

	    array set TMP [crimp histogram [crimp convert 2grey8 $image]]
	    array set TMP [crimp histogram [crimp convert 2hsv   $image]]

	    set HL [dict values $TMP(luma)]       ; set TL [crimp::CUMULATE $HL]
	    set HH [dict values $TMP(hue)]
	    set HS [dict values $TMP(saturation)] ; set TS [crimp::CUMULATE $HS]
	    set HV [dict values $TMP(value)]      ; set TV [crimp::CUMULATE $HV]


	    # For the sake of the display we cut out the pure white
	    # and black, as they are likely outliers with an extreme
	    # number of pixels using them.
	    
	    lset HL 0 0 ; lset HL 255 0
	    lset HS 0 0 ; lset HS 255 0
	    lset HV 0 0 ; lset HV 255 0
	    return
	}

	proc PLAIN {} {
	    HISTO      [base]
	    show_image [base]
	    return
	}

	proc EQUAL {} {
	    demo_time_hook equalize {
		HISTO [base]
		# H & S are not stretched. Does not make sense for HUE, and not good for Saturation.
		variable HH ; variable HV
		              variable TV
		variable mask

		set fv [crimp::FIT $TV 255]

		set i [crimp map identity]
		set v [crimp mapof $fv]

		set new [crimp alpha set \
			     [crimp convert 2rgb \
				  [crimp remap \
				       [crimp convert 2hsv [base]] \
				       $i $i $v]] \
			     $mask]
	    }

	    show_image $new
	    HISTO      $new
	    return
	}

	HISTO [base]

	plot  .left.hl   -variable ::DEMO::HL -locked 0 -title Luma
	plot  .left.tl   -variable ::DEMO::TL -locked 0 -title {CDF Luma}
	plot  .left.hh   -variable ::DEMO::HH -locked 0 -title Hue

	plot  .bottom.hs -variable ::DEMO::HS -locked 0 -title Saturation
	plot  .bottom.hv -variable ::DEMO::HV -locked 0 -title Value

	plot  .bottom.ts -variable ::DEMO::TS -locked 0 -title {CDF Saturation}
	plot  .bottom.tv -variable ::DEMO::TV -locked 0 -title {CDF Value}

	ttk::button .top.equal -text Equalize -command ::DEMO::EQUAL
	ttk::button .top.plain -text Plain    -command ::DEMO::PLAIN

	grid .left.hl -row 0 -column 0 -sticky swen
	grid .left.tl -row 1 -column 0 -sticky swen
	grid .left.hh -row 2 -column 0 -sticky swen

	grid .bottom.hs -row 0 -column 0 -sticky swen
	grid .bottom.ts -row 0 -column 1 -sticky swen
	grid .bottom.hv -row 0 -column 2 -sticky swen
	grid .bottom.tv -row 0 -column 3 -sticky swen

	grid .top.equal -row 0 -column 0 -sticky swen
	grid .top.plain -row 0 -column 1 -sticky swen
    }
}






Added demos/equalize_value_simple.tcl.



















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_equalize_value_simple {
    label {Equalize/S (HSV - Value)}
    setup_image {
	variable mask [lindex [crimp split [base]] end]
	PLAIN
    }
    setup {
	variable TS {0 1}
	variable TV {0 1}
	variable TL {0 1}

	variable mask

	proc HISTO {image} {
	    variable HL ; variable HH ; variable HS ; variable HV
	    variable TL ;               variable TS ; variable TV 

	    array set TMP [crimp histogram [crimp convert 2grey8 $image]]
	    array set TMP [crimp histogram [crimp convert 2hsv   $image]]

	    set HL [dict values $TMP(luma)]       ; set TL [crimp::CUMULATE $HL]
	    set HH [dict values $TMP(hue)]
	    set HS [dict values $TMP(saturation)] ; set TS [crimp::CUMULATE $HS]
	    set HV [dict values $TMP(value)]      ; set TV [crimp::CUMULATE $HV]


	    # For the sake of the display we cut out the pure white
	    # and black, as they are likely outliers with an extreme
	    # number of pixels using them.
	    
	    lset HL 0 0 ; lset HL 255 0
	    lset HS 0 0 ; lset HS 255 0
	    lset HV 0 0 ; lset HV 255 0
	    return
	}

	proc PLAIN {} {
	    HISTO      [base]
	    show_image [base]
	    return
	}

	proc EQUAL {} {
	    demo_time_hook equalize {
		HISTO [base]
		# H & S are not stretched. Does not make sense for HUE, and not good for Saturation.
		variable HH ; variable HV
		              variable TV
		variable mask

		set fv [crimp::FIT $TV 255]

		set i [crimp map identity]
		set v [crimp mapof $fv]

		set new [crimp alpha set \
			     [crimp convert 2rgb \
				  [crimp remap \
				       [crimp convert 2hsv [base]] \
				       $i $i $v]] \
			     $mask]
	    }

	    show_image $new
	    HISTO      $new
	    return
	}

	HISTO [base]

	ttk::button .top.equal -text Equalize -command ::DEMO::EQUAL
	ttk::button .top.plain -text Plain    -command ::DEMO::PLAIN

	grid .top.equal -row 0 -column 0 -sticky swen
	grid .top.plain -row 0 -column 1 -sticky swen
    }
}






Added demos/expand_black.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def expand_black {
    label {Expand Black}
    setup_image {
	show_image [crimp expand const [base] 50 50 50 50]
    }
}






Added demos/expand_const.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def expand_const {
    label {Expand Constant}
    setup_image {
	show_image [crimp expand const [base] 50 50 50 50 0 0 255 255]
    }
}






Added demos/expand_extend.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def expand_extend {
    label {Expand Extend}
    setup_image {
	show_image [crimp alpha opaque [crimp expand extend [base] 50 50 50 50]]
    }
}






Added demos/expand_mirror.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def expand_mirror {
    label {Expand Mirror}
    setup_image {
	show_image [crimp expand mirror [base] 50 50 50 50]
    }
}






Added demos/expand_replicate.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def expand_replicate {
    label {Expand Replicate}
    setup_image {
	show_image [crimp expand replicate [base] 50 50 50 50]
    }
}






Added demos/expand_wrap.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def expand_wrap {
    label {Expand Wrap}
    setup_image {
	show_image [crimp expand wrap [base] 50 50 50 50]
    }
}






Added demos/fft.tcl.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_fft {
    label {Fourier Transform}
    setup {
	variable falsecolor \
	    [crimp gradient rgb {0 255 0} {255 0 0} 256]

	proc border {i} {
	    crimp expand const $i \
		5 5 5 5 \
		0 0 255
	}
    }
    setup_image {
	variable falsecolor

	set g  [crimp convert 2grey8 [base]]
	set f  [crimp fft forward $g]
	set gr [crimp convert 2grey8 [crimp fft backward $f]]
	set d  [crimp difference $g $gr]

	set gd  [crimp convert 2rgb $g]
	set fd  [crimp convert 2rgb [crimp convert 2grey8 $f] $falsecolor]
	set grd [crimp convert 2rgb $gr]
	set dd  [crimp convert 2rgb $d $falsecolor]

	show_image \
	    [crimp montage vertical -align left \
		 [crimp montage horizontal \
		      [border $gd] \
		      [border $fd]] \
		 [crimp montage horizontal \
		      [border $dd] \
		      [border $grd]]]
    }
}






Added demos/flip.tcl.










































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_flip_vertical {
    label {Flip & Rotate}
    setup {
	proc show {} {
	    variable image
	    show_image $image
	}
	proc do {args} {
	    variable image
	    set image [crimp {*}$args $image]
	    show
	    return
	}

	button .left.h  -text \u2191\u2193 -command [list [namespace current]::do flip vertical]
	button .left.v  -text \u2194       -command [list [namespace current]::do flip horizontal]
	button .left.tp -text \\           -command [list [namespace current]::do flip transpose]
	button .left.tv -text /            -command [list [namespace current]::do flip transverse]

	button .left.rl -text 90\u00b0\ \u27f2 -command [list [namespace current]::do rotate ccw]
	button .left.rr -text 90\u00b0\ \u27f3 -command [list [namespace current]::do rotate cw]
	button .left.rh -text 180\u00b0        -command [list [namespace current]::do rotate half]

	grid .left.h  -row 0 -column 0
	grid .left.v  -row 1 -column 0
	grid .left.tp -row 2 -column 0
	grid .left.tv -row 3 -column 0
	grid .left.rl -row 4 -column 0
	grid .left.rr -row 5 -column 0
	grid .left.rh -row 6 -column 0
    }
    setup_image {
	variable image [base]
	show
    }
}






Added demos/flip_horizontal.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_flip_horizontal {
    label \u2194
    setup_image {
	show_image [crimp flip horizontal [base]]
    }
}






Added demos/flip_transpose.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_flip_transpose {
    label \\
    setup_image {
	show_image [crimp flip transpose [base]]
    }
}






Added demos/flip_transverse.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_flip_transverse {
    label /
    setup_image {
	show_image [crimp flip transverse [base]]
    }
}






Added demos/flip_vertical.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_flip_vertical {
    label \u2191\u2193
    setup_image {
	show_image [crimp flip vertical [base]]
    }
}






Added demos/gamma.tcl.





































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_gamma {
    label Gamma
    setup {
	variable gamma 1
	variable table {}

	proc show {thegamma} {
	    variable table [crimp table gamma  $thegamma]
	    show_image     [crimp gamma [base] $thegamma]
	    return
	}

	proc showit {} {
	    variable gamma
	    show $gamma
	    return
	}

	plot  .left.p -variable ::DEMO::table -title Gamma
	scale .left.s -variable ::DEMO::gamma \
	    -from 5 -to 1 -resolution 0.01 \
	    -orient vertical \
	    -command ::DEMO::show

	grid .left.p -row 0 -column 0 -sticky swen
	grid .left.s -row 0 -column 1 -sticky swen
    }
    setup_image {
	showit
    }
}






Added demos/gauss.tcl.





































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_gauss {
    label {Gauss Map}
    setup {
	variable sigma 42
	variable table     {}

	proc show {thesigma} {
	    variable table [crimp table gauss  $thesigma]
	    show_image     [crimp remap [base] [crimp map gauss $thesigma]]
	    return
	}

	proc showit {} {
	    variable sigma
	    show $sigma
	    return
	}

	plot  .left.p -variable ::DEMO::table -title Sigma
	scale .left.s -variable ::DEMO::sigma \
	    -from 0.1 -to 150 -resolution 0.1 \
	    -orient horizontal \
	    -command ::DEMO::show

	grid .left.s -row 0 -column 0 -sticky swen
	grid .left.p -row 1 -column 0 -sticky swen
    }
    setup_image {
	showit
    }
}






Added demos/gauss_luma.tcl.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_gauss_luma {
    label {Gauss Map Luma}
    setup {
	variable sigma 42
	variable table     {}

	proc show {thesigma} {
	    variable L
	    if {![info exists L]} return

	    variable table [crimp table gauss  $thesigma]
	    show_image     [crimp remap $L [crimp map gauss $thesigma]]
	    return
	}

	proc showit {} {
	    variable sigma
	    show $sigma
	    return
	}

	plot  .left.p -variable ::DEMO::table -title Sigma
	scale .left.s -variable ::DEMO::sigma \
	    -from 0.1 -to 150 -resolution 0.1 \
	    -orient horizontal \
	    -command ::DEMO::show

	grid .left.s -row 0 -column 0 -sticky swen
	grid .left.p -row 1 -column 0 -sticky swen
    }
    setup_image {
	variable L [crimp convert 2grey8 [base]]
	showit
    }
}






Added demos/gradient.tcl.




















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_gradient {
    label {Gradient (RGB)}
    active {
	expr {[bases] == 0}
    }
    setup {
	variable sr 0
	variable sg 0
	variable sb 0

	variable er 255
	variable eg 255
	variable eb 255

	proc show {args} {
	    variable sr
	    variable sg
	    variable sb

	    variable er
	    variable eg
	    variable eb

	    set g [crimp gradient rgb \
		       [list $sr $sg $sb] \
		       [list $er $eg $eb] \
		       256]

	    set g [crimp montage vertical $g $g] ;# 2
	    set g [crimp montage vertical $g $g] ;# 4
	    set g [crimp montage vertical $g $g] ;# 8
	    set g [crimp montage vertical $g $g] ;# 16
	    set g [crimp montage vertical $g $g] ;# 32
	    set g [crimp montage vertical $g $g] ;# 64

	    show_image [crimp expand const $g 5 5 5 5]
	    return
	}

	scale .left.sr -variable ::DEMO::sr \
	    -from 0 -to 255 \
	    -orient vertical \
	    -command ::DEMO::show

	scale .left.sg -variable ::DEMO::sg \
	    -from 0 -to 255 \
	    -orient vertical \
	    -command ::DEMO::show

	scale .left.sb -variable ::DEMO::sb \
	    -from 0 -to 255 \
	    -orient vertical \
	    -command ::DEMO::show

	scale .left.er -variable ::DEMO::er \
	    -from 0 -to 255 \
	    -orient vertical \
	    -command ::DEMO::show

	scale .left.eg -variable ::DEMO::eg \
	    -from 0 -to 255 \
	    -orient vertical \
	    -command ::DEMO::show

	scale .left.eb -variable ::DEMO::eb \
	    -from 0 -to 255 \
	    -orient vertical \
	    -command ::DEMO::show

	grid .left.sr -row 0 -column 0 -sticky swen
	grid .left.sg -row 0 -column 1 -sticky swen
	grid .left.sb -row 0 -column 2 -sticky swen

	grid .left.er -row 1 -column 0 -sticky swen
	grid .left.eg -row 1 -column 1 -sticky swen
	grid .left.eb -row 1 -column 2 -sticky swen
    }
}






Added demos/gradient2.tcl.






























































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_gradient2 {
    label {Gradient De-Grey}
    active {
	expr {[bases] == 1}
    }
    setup_image {
	variable grey [crimp convert 2grey8 [base]]
	show
    }
    setup {
	variable sr 0
	variable sg 0
	variable sb 0

	variable er 255
	variable eg 255
	variable eb 255

	proc show {args} {
	    variable grey

	    variable sr
	    variable sg
	    variable sb

	    variable er
	    variable eg
	    variable eb

	    set g [crimp gradient rgb \
		       [list $sr $sg $sb] \
		       [list $er $eg $eb] \
		       256]

	    set gi [crimp flip transpose $g]
	    set gi [crimp montage horizontal $gi $gi] ;# 2
	    set gi [crimp montage horizontal $gi $gi] ;# 4
	    set gi [crimp montage horizontal $gi $gi] ;# 8
	    set gi [crimp montage horizontal $gi $gi] ;# 16
	    set gi [crimp montage horizontal $gi $gi] ;# 32
	    set gi [crimp montage horizontal $gi $gi] ;# 64
	    set gi [crimp expand const $gi 5 5 5 5]

	    show_image [crimp montage horizontal -align top \
			    $gi \
			    [crimp convert 2rgb $grey $g]]
	    return
	}

	scale .left.sr -variable ::DEMO::sr \
	    -from 0 -to 255 \
	    -orient vertical \
	    -command ::DEMO::show

	scale .left.sg -variable ::DEMO::sg \
	    -from 0 -to 255 \
	    -orient vertical \
	    -command ::DEMO::show

	scale .left.sb -variable ::DEMO::sb \
	    -from 0 -to 255 \
	    -orient vertical \
	    -command ::DEMO::show

	scale .left.er -variable ::DEMO::er \
	    -from 0 -to 255 \
	    -orient vertical \
	    -command ::DEMO::show

	scale .left.eg -variable ::DEMO::eg \
	    -from 0 -to 255 \
	    -orient vertical \
	    -command ::DEMO::show

	scale .left.eb -variable ::DEMO::eb \
	    -from 0 -to 255 \
	    -orient vertical \
	    -command ::DEMO::show

	grid .left.sr -row 0 -column 0 -sticky swen
	grid .left.sg -row 0 -column 1 -sticky swen
	grid .left.sb -row 0 -column 2 -sticky swen

	grid .left.er -row 1 -column 0 -sticky swen
	grid .left.eg -row 1 -column 1 -sticky swen
	grid .left.eb -row 1 -column 2 -sticky swen
    }
}






Added demos/gradiente.tcl.













































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_gradient_simple {
    label {Gradient Calculation}
    setup_image {
	variable greybase [crimp convert 2grey8 [base]]
	PLAIN
    }
    setup {
	variable greybase
	variable low  25
	variable high 75

	proc row {args} {
	    crimp montage horizontal {*}$args
	}

	proc stack {args} {
	    crimp montage vertical {*}$args
	}

	proc b {i} {
	    crimp expand const [rgb $i] \
		5 5 5 5 \
		0 0 255
	}

	proc e {i {n 1}} {
	    crimp expand const $i $n $n $n $n
	}

	proc fg {i} {
	    set s [crimp statistics basic $i]
	    set min [dict get $s channel value min]
	    set max [dict get $s channel value max]
	    # Compress (or expand) into the 0...255 range of grey8.
	    set offset [expr {-1 * $min}]
	    set scale  [expr {255.0/($max - $min)}]
	    crimp convert 2grey8 [crimp::scale_float [crimp::offset_float $i $offset] $scale]
	}

	proc % {i} {
	    set s [crimp statistics basic $i]
	    set min [dict get $s channel value min]
	    set max [dict get $s channel value max]
	    # Compress (or expand) into the range 0...100 (percent).
	    set offset [expr {-1 * $min}]
	    set scale  [expr {100.0/($max - $min)}]
	    return [crimp::scale_float [crimp::offset_float $i $offset] $scale]
	}

	proc rgb {i} {
	    crimp convert 2rgb $i
	}

	proc space {i} {
	    crimp blank rgb {*}[crimp dimensions $i] 0 0 255
	}

	proc PLAIN {} {
	    show_image [base]
	    return
	}

	proc GRADIENT {type} {
	    variable no
	    variable gc
	    variable gp
	    variable gv
	    variable greybase
	    set im [crimp convert 2float $greybase]
	    set gc [crimp gradient $type  $im]
	    set gp [crimp gradient polar  $gc]
	    set gv [crimp gradient visual $gp]

	    # Do canny edge detection...
	    lassign $gc x y
	    lassign $gp m a
	    set ca [crimp::non_max_suppression [e $m] [e $a]]
	    set no [% $ca]

	    RETRACE
	    return
	}

	proc RETRACE {args} {
	    variable no
	    variable gc
	    variable gp
	    variable gv
	    variable greybase
	    variable low
	    variable high

	    if {![info exists no]} return

	    set ed [crimp::trace_hysteresis $no $low $high]

	    lassign $gc x y
	    lassign $gp m a
	    show_image \
		[stack \
		     [row [b [base]]  [b $greybase]] \
		     [row [b [fg $x]] [b [fg $y]]] \
		     [row [b [fg $m]] [b [fg $a]]] \
		     [row [b $gv]     [b $ed]]]
	    return
	}

	proc SOBEL   {} { GRADIENT sobel   }
	proc SCHARR  {} { GRADIENT scharr  }
	proc PREWITT {} { GRADIENT prewitt }

	ttk::button .top.plain -text Plain   -command ::DEMO::PLAIN
	ttk::button .top.sobel -text Sobel   -command ::DEMO::SOBEL
	ttk::button .top.schar -text Scharr  -command ::DEMO::SCHARR
	ttk::button .top.prewi -text Prewitt -command ::DEMO::PREWITT

	grid .top.plain -row 0 -column 0 -sticky swen
	grid .top.prewi -row 0 -column 1 -sticky swen
	grid .top.sobel -row 0 -column 2 -sticky swen
	grid .top.schar -row 0 -column 3 -sticky swen

	scale .left.l -variable ::DEMO::low \
	    -from 0 -to 100 -resolution 0.1 \
	    -orient vertical \
	    -command ::DEMO::RETRACE

	scale .left.h -variable ::DEMO::high \
	    -from 0 -to 100 -resolution 0.1 \
	    -orient vertical \
	    -command ::DEMO::RETRACE

	grid .left.l -row 0 -column 0 -sticky swen -rowspan 4
	grid .left.h -row 0 -column 1 -sticky swen -rowspan 4
    }
}






Added demos/green.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def rgba_green {
    label Green
    setup_image {
	show_image [lindex [crimp split [base]] 1]
    }
}






Added demos/green_tint.tcl.














1
2
3
4
5
6
7
8

+
+
+
+
+
+
+
+

def rgba_green_tint {
    label Green/Tint
    setup_image {
	set c [lindex [crimp split [base]] 1]
	set x [crimp blank grey8 {*}[crimp dimension $c] 0]
	show_image [crimp join 2rgb $x $c $x]
    }
}






Added demos/hough.tcl.












































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_hough {
    label {Hough Transform}
    setup {
	variable falsecolor \
	    [crimp gradient rgb {0 255 0} {255 0 0} 256]

	proc border {i} {
	    crimp expand const $i \
		5 5 5 5 \
		0 0 255
	}
    }
    setup_image {
	variable falsecolor

	set g  [crimp convert 2grey8 [base]]
	set h  [crimp::hough_grey8 $g 255]

	array set stat [crimp statistics basic $h]
	array set stat $stat(channel)
	array set stat $stat(value)

	log "min    $stat(min)"
	log "max    $stat(max)"
	log "middle $stat(middle)"
	log "mean   $stat(mean)"
	log "var    $stat(variance)"
	log "stddev $stat(stddev)"

	set gd  [crimp convert 2rgb $g]
	set hd  [crimp convert 2rgb [crimp invert [crimp convert 2grey8 $h]] $falsecolor]

	show_image \
		 [crimp montage horizontal \
		      [border $gd] \
		      [border $hd]]
    }
}






Added demos/hsv_as_rgb.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def effect_hsv_as_rgb {
    label {HSV as RGB}
    setup_image {
	show_image [crimp join 2rgb {*}[crimp split [crimp convert 2hsv [base]]]]
    }
}






Added demos/hue.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def hsv_hue {
    label Hue
    setup_image {
	show_image [lindex [crimp split [crimp convert 2hsv [base]]] 0]
    }
}






Added demos/integrate.tcl.
















1
2
3
4
5
6
7
8
9
10

+
+
+
+
+
+
+
+
+
+

def op_integrate {
    label Integrate
    setup_image {
	show_image \
	    [crimp convert 2grey8 \
		 [crimp integrate \
		      [crimp convert 2grey8 \
			   [base]]]]
    }
}






Added demos/integrate2.tcl.

























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_integrate_fixed {
    label Integrate/Fixed
    active { expr { [bases] == 0} }
    setup {
	proc p {label i} {
	    set t [crimp write 2string pfm-plain $i]
	    set pv [lassign $t _ w h]

	    log* "$label = ${w}x$h \{"
	    set n 0
	    foreach v $pv {
		if {!$n} { log* "\n\t" } else { log* " " }
		log* "$v"
		incr n ; if {$n == $w} { set n 0 }
	    }
	    log "\n\}"
	}

	set i [crimp blank float 5 5  2]
	set s [crimp integrate $i]

	# radius = 1 => 3x3, 2-border for (radius+1)
	set e  [crimp expand mirror $i 2 2 2 2]
	set se [crimp integrate $e]
	set r  [crimp::region_sum $se 1]
	set m1 [crimp::scale_float $r [expr {1./9}]]
	# m1 = 1st-order momentum = mean

	set sq  [crimp multiply $e $e]
	set ssq [crimp integrate $sq]
	set rsq [crimp::region_sum $ssq 1]
	set m2  [crimp::scale_float $rsq [expr {1./9}]]
	set var [crimp subtract $m2 [crimp multiply $m1 $m1]]
	set std [crimp::sqrt_float $var]
	# m1 = 2nd-order momentum = variance

	p I      $i
	p S      $s
	p E      $e
	p SUM    $se
	p SUM/3  $r
	p M1/3   $m1

	p E^2     $sq
	p SUM/E^2 $ssq
	p SUM3/E2 $rsq
	p M2/3    $m2
	p VAR/3   $var
	p STD/3   $std
    }
}






Added demos/integrate3.tcl.
































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_integrate_fixed_b {
    label Integrate/Fixed/2
    active { expr { [bases] == 0} }
    setup {
	proc p {label i} {
	    set t [crimp write 2string pfm-plain $i]
	    set pv [lassign $t _ w h]

	    log* "$label = ${w}x$h \{"
	    set n 0
	    foreach v $pv {
		if {!$n} { log* "\n\t" } else { log* " " }
		log* "$v"
		incr n ; if {$n == $w} { set n 0 }
	    }
	    log "\n\}"
	}

	set i [crimp read tcl float {
	    {0 0 0 0 1}
	    {0 0 0 1 0}
	    {0 0 1 0 0}
	    {0 1 0 0 0}
	    {1 0 0 0 0}
	}]

	set s [crimp integrate $i]

	# radius = 1 => 3x3, 2-border for (radius+1)
	set e  [crimp expand mirror $i 2 2 2 2]
	set se [crimp integrate $e]
	set r  [crimp::region_sum $se 1]
	set m1 [crimp::scale_float $r [expr {1./9}]]
	# m1 = 1st-order momentum = mean

	set sq  [crimp multiply $e $e]
	set ssq [crimp integrate $sq]
	set rsq [crimp::region_sum $ssq 1]
	set m2  [crimp::scale_float $rsq [expr {1./9}]]
	set var [crimp subtract $m2 [crimp multiply $m1 $m1]]
	set std [crimp::sqrt_float $var]
	# m1 = 2nd-order momentum = variance

	p I      $i
	p S      $s
	p E      $e
	p SUM    $se
	p SUM/3  $r
	p M1/3   $m1

	p E^2     $sq
	p SUM/E^2 $ssq
	p SUM3/E2 $rsq
	p M2/3    $m2
	p VAR/3   $var
	p STD/3   $std
    }
}






Added demos/interpolate2.tcl.
















1
2
3
4
5
6
7
8
9
10

+
+
+
+
+
+
+
+
+
+

def op_up_interpolate2 {
    label Interpolate\u21912
    setup {
	# Tent kernel.
	set K [crimp kernel make {{1 2 1}} 2]
    }
    setup_image {
	show_image [crimp alpha opaque [crimp interpolate xy [base] 2 $K]]
    }
}






Added demos/interpolate2_foh.tcl.
















1
2
3
4
5
6
7
8
9
10

+
+
+
+
+
+
+
+
+
+

def op_up_interpolate2foh {
    label Interpolate\u21912/FOH
    setup {
	# First order hold kernel.
	set K [crimp kernel make {{0 1 1}} 1]
    }
    setup_image {
	show_image [crimp alpha opaque [crimp interpolate xy [base] 2 $K]]
    }
}






Added demos/interpolate4.tcl.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

def op_up_interpolate4 {
    label Interpolate\u21914
    setup {
	# Tent kernel.
	set K [crimp kernel make {{1 2 1}} 2]
    }
    setup_image {
	show_image [crimp alpha opaque \
			[crimp interpolate xy \
			     [crimp interpolate xy [base] 2 $K] \
			     2 $K]]
    }
}






Added demos/interpolate8.tcl.






















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_up_interpolate8 {
    label Interpolate\u21918
    setup {
	# Tent kernel.
	set K [crimp kernel make {{1 2 1}} 2]
    }
    setup_image {
	show_image [crimp alpha opaque \
			[crimp interpolate xy \
			     [crimp interpolate xy \
				  [crimp interpolate xy [base] \
				       2 $K] \
				  2 $K] \
			     2 $K]]
    }
}






Added demos/interpolate8_foh.tcl.






















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_up_interpolate8foh {
    label Interpolate\u21918/FOH
    setup {
	# Tent kernel.
	set K [crimp kernel make {{0 1 1}} 1]
    }
    setup_image {
	show_image [crimp alpha opaque \
			[crimp interpolate xy \
			     [crimp interpolate xy \
				  [crimp interpolate xy [base] \
				       2 $K] \
				  2 $K] \
			     2 $K]]
    }
}






Added demos/invert.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_invert {
    label Invert
    setup_image {
	show_image [crimp invert [base]]
    }
}






Added demos/log.tcl.





































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_log {
    label Log-Compression
    setup {
	variable maxvalue 255
	variable table    {}

	proc show {themaxvalue} {
	    variable table [crimp table log    $themaxvalue]
	    show_image     [crimp remap [base] [crimp mapof $table]]
	    return
	}

	proc showit {} {
	    variable maxvalue
	    show $maxvalue
	    return
	}

	plot  .left.p -variable ::DEMO::table -title Maxvalue
	scale .left.s -variable ::DEMO::maxvalue \
	    -from 1 -to 255 \
	    -orient horizontal \
	    -command ::DEMO::show

	grid .left.s -row 0 -column 0 -sticky swen
	grid .left.p -row 1 -column 0 -sticky swen
    }
    setup_image {
	showit
    }
}






Added demos/luma.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_luma {
    label Luma
    setup_image {
	show_image [crimp convert 2grey8 [base]]
    }
}






Added demos/matinv.tcl.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_3x3inverse {
    label {3x3 Matrix Inverse}
    active { expr { [bases] == 0} }
    setup {
	proc p {label i} {
	    set t [crimp write 2string pfm-plain $i]
	    set pv [lassign $t _ w h]

	    log* "$label = ${w}x$h \{"
	    set n 0
	    foreach v $pv {
		if {!$n} { log* "\n\t" } else { log* " " }
		log* "$v"
		incr n ; if {$n == $w} { set n 0 }
	    }
	    log "\n\}"
	}

	set X [crimp read tcl float {
	    {1 3 0}
	    {2 1 4}
	    {0 5 1}
	}]
	set Xinv [crimp::matinv3x3_float $X]

	p X        $X
	p Xinv     $Xinv
	p X*Xinv=I [crimp::matmul3x3_float $X $Xinv] 
	p Xinv*X=I [crimp::matmul3x3_float $Xinv $X] 

	set I [crimp read tcl float {
	    {1 0 0}
	    {0 1 0}
	    {0 0 1}
	}]

	p Iinv=I [crimp::matinv3x3_float $I]

	set T [crimp read tcl float {
	    {1 0 5}
	    {0 1 2}
	    {0 0 1}
	}]

	p T    $T
	p Tinv [crimp::matinv3x3_float $T]
    }
}






Added demos/matmul.tcl.


















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_3x3multiplication {
    label {3x3 Matrix Multiplication}
    active { expr { [bases] == 0} }
    setup {
	proc p {label i} {
	    set t [crimp write 2string pfm-plain $i]
	    set pv [lassign $t _ w h]

	    log* "$label = ${w}x$h \{"
	    set n 0
	    foreach v $pv {
		if {!$n} { log* "\n\t" } else { log* " " }
		log* "$v"
		incr n ; if {$n == $w} { set n 0 }
	    }
	    log "\n\}"
	}

	set I [crimp read tcl float {
	    {1 0 0}
	    {0 1 0}
	    {0 0 1}
	}]
	set T [crimp read tcl float {
	    {0 0 1}
	    {0 1 0}
	    {1 0 0}
	}]
	set X [crimp read tcl float {
	    {0 3 0}
	    {2 0 4}
	    {0 5 0}
	}]

	p I*T=T [crimp::matmul3x3_float $I $T]
	p T*I=T [crimp::matmul3x3_float $T $I]

	p I*X=X [crimp::matmul3x3_float $I $X]
	p X*I=X [crimp::matmul3x3_float $X $I]

	p T*X=? [crimp::matmul3x3_float $T $X]
	p X*T=? [crimp::matmul3x3_float $X $T]
    }
}






Added demos/matrix.tcl.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_matrix {
    label RotMatrix
    setup {
	variable angle 0

	proc show {theangle} {
	    set s [expr {sin($theangle * 0.017453292519943295769236907684886)}]
	    set c [expr {cos($theangle * 0.017453292519943295769236907684886)}]
	    set matrix [list \
			    [list $c           $s 0] \
			    [list [expr {-$s}] $c 0] \
			    [list $s           $s 1]]
	    show_image [crimp matrix [base] $matrix]
	    return
	}

	proc showit {} {
	    variable angle
	    show $angle
	    return
	}

	scale .left.s -variable ::DEMO::angle \
	    -from -180 -to 180 -resolution 0.01 \
	    -orient vertical \
	    -command ::DEMO::show

	pack .left.s -side left -fill both -expand 1
    }
    setup_image {
	showit
    }
}






Added demos/max.tcl.


















1
2
3
4
5
6
7
8
9
10
11
12

+
+
+
+
+
+
+
+
+
+
+
+

def op_max {
    label Max
    active {
	expr {
	      ([bases] == 2) &&
	      ([crimp dimensions [base 0]] eq [crimp dimensions [base 1]])
	  }
    }
    setup_image {
	show_image [crimp max [base 0] [base 1]]
    }
}






Added demos/mean.tcl.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_mean {
    label {Mean Filter}
    setup_image {
	# Create a series of mean-filtered images from the base,
	# with different kernel radii.

	set g [crimp convert 2grey8 [base]]

	# radius => window
	#  1 - 3x3
	#  2 - 5x5
	#  3 - 7x7
	# 10 - 21x21
	# 20 - 41x41

	show_slides [list \
			 $g \
			 [crimp filter mean $g 1] \
			 [crimp filter mean $g 2] \
			 [crimp filter mean $g] \
			 [crimp filter mean $g 10] \
			 [crimp filter mean $g 20]]
    }
}






Added demos/mean_rgb.tcl.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_mean_rgb {
    label {Mean Filter (RGB)}
    setup_image {
	# Create a series of mean-filtered images from the base,
	# with different kernel radii.

	set g [base]

	# radius => window
	#  1 - 3x3
	#  2 - 5x5
	#  3 - 7x7
	# 10 - 21x21
	# 20 - 41x41

	show_slides [list \
			 $g \
			 [crimp filter mean $g 1] \
			 [crimp filter mean $g 2] \
			 [crimp filter mean $g] \
			 [crimp filter mean $g 10] \
			 [crimp filter mean $g 20]]
    }
}






Added demos/meta.tcl.






















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_metadata {
    label {Meta data}
    active {
	expr {[bases] == 0}
    }
    setup {
	variable x [crimp blank grey8 5 5 0]

	log d|[crimp meta get $x]|

	set x [crimp meta lappend $x ppm something]

	log d|[crimp meta get $x]|
	log k|[crimp meta keys $x p*]|
    }
}






Added demos/min.tcl.


















1
2
3
4
5
6
7
8
9
10
11
12

+
+
+
+
+
+
+
+
+
+
+
+

def op_min {
    label Min
    active {
	expr {
	      ([bases] == 2) &&
	      ([crimp dimensions [base 0]] eq [crimp dimensions [base 1]])
	  }
    }
    setup_image {
	show_image [crimp min [base 0] [base 1]]
    }
}






Added demos/montageh.tcl.















1
2
3
4
5
6
7
8
9

+
+
+
+
+
+
+
+
+

def op_montageh {
    label {Montage Left/Right}
    active {
	expr { [bases] > 1 }
    }
    setup_image {
	show_image [crimp montage horizontal {*}[thebases]]
    }
}






Added demos/montagev.tcl.















1
2
3
4
5
6
7
8
9

+
+
+
+
+
+
+
+
+

def op_montagev {
    label {Montage Top/Bottom}
    active {
	expr { [bases] > 1 }
    }
    setup_image {
	show_image [crimp montage vertical {*}[thebases]]
    }
}






Added demos/morph_close.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_morph_close {
    label {Morphology: Close}
    setup_image {
	show_image [crimp alpha opaque [crimp morph close [base]]]
    }
}






Added demos/morph_close_grey.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_morph_close_grey {
    label {Morphology: Close /Grey}
    setup_image {
	show_image [crimp morph close [crimp convert 2grey8 [base]]]
    }
}






Added demos/morph_dilate.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_morph_dilate {
    label {Morphology: Dilate}
    setup_image {
	show_image [crimp alpha opaque [crimp morph dilate [base]]]
    }
}






Added demos/morph_dilate_grey.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_morph_dilate_grey {
    label {Morphology: Dilate /Grey}
    setup_image {
	show_image [crimp morph dilate [crimp convert 2grey8 [base]]]
    }
}






Added demos/morph_egradient.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_morph_egradient {
    label {Morphology: External gradient}
    setup_image {
	show_image [crimp alpha opaque [crimp morph egradient [base]]]
    }
}






Added demos/morph_egradient_grey.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_morph_egradient_grey {
    label {Morphology: External gradient /Grey}
    setup_image {
	show_image [crimp morph egradient [crimp convert 2grey8 [base]]]
    }
}






Added demos/morph_erode.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_morph_erode {
    label {Morphology: Erode}
    setup_image {
	show_image [crimp alpha opaque [crimp morph erode [base]]]
    }
}






Added demos/morph_erode_grey.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_morph_erode_grey {
    label {Morphology: Erode /Grey}
    setup_image {
	show_image [crimp morph erode [crimp convert 2grey8 [base]]]
    }
}






Added demos/morph_gradient.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_morph_gradient {
    label {Morphology: Gradient}
    setup_image {
	show_image [crimp alpha opaque [crimp morph gradient [base]]]
    }
}






Added demos/morph_gradient_grey.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_morph_gradient_grey {
    label {Morphology: Gradient /Grey}
    setup_image {
	show_image [crimp morph gradient [crimp convert 2grey8 [base]]]
    }
}






Added demos/morph_igradient.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_morph_igradient {
    label {Morphology: Internal gradient}
    setup_image {
	show_image [crimp alpha opaque [crimp morph igradient [base]]]
    }
}






Added demos/morph_igradient_grey.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_morph_igradient_grey {
    label {Morphology: Internal gradient /Grey}
    setup_image {
	show_image [crimp morph igradient [crimp convert 2grey8 [base]]]
    }
}






Added demos/morph_open.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_morph_open {
    label {Morphology: Open}
    setup_image {
	show_image [crimp alpha opaque [crimp morph open [base]]]
    }
}






Added demos/morph_open_grey.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_morph_open_grey {
    label {Morphology: Open /Grey}
    setup_image {
	show_image [crimp morph open [crimp convert 2grey8 [base]]]
    }
}






Added demos/morph_tophatb.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_morph_tophatb {
    label {Morphology: Tophat:Black}
    setup_image {
	show_image [crimp alpha opaque [crimp morph tophatb [base]]]
    }
}






Added demos/morph_tophatb_grey.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_morph_tophatb_grey {
    label {Morphology: Tophat:Black /Grey}
    setup_image {
	show_image [crimp morph tophatb [crimp convert 2grey8 [base]]]
    }
}






Added demos/morph_tophatw.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_morph_tophatw {
    label {Morphology: Tophat:White}
    setup_image {
	show_image [crimp alpha opaque [crimp morph tophatw [base]]]
    }
}






Added demos/morph_tophatw_grey.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_morph_tophatw_grey {
    label {Morphology: Tophat:White /Grey}
    setup_image {
	show_image [crimp morph tophatw [crimp convert 2grey8 [base]]]
    }
}






Added demos/multiply.tcl.


















1
2
3
4
5
6
7
8
9
10
11
12

+
+
+
+
+
+
+
+
+
+
+
+

def op_multiply {
    label Multiply
    active {
	expr {
	      ([bases] == 2) &&
	      ([crimp dimensions [base 0]] eq [crimp dimensions [base 1]])
	  }
    }
    setup_image {
	show_image [crimp multiply [base 0] [base 1]]
    }
}






Added demos/over.tcl.




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_alpha_over {
    label Over
    active {
	expr {
	      ([bases] == 2) &&
	      ([crimp dimensions [base 0]] eq [crimp dimensions [base 1]])
	  }
    }
    setup_image {
	# We use the foreground image's luma as opacity (bright =
	# opaque, dark = transparent) to merge it with the background
	# image. At last we force fully opaque to avoid mix effects
	# against the canvas background color.

	show_image [crimp convert 2rgb \
			[crimp alpha over \
			     [crimp alpha set \
				  [base] \
				  [crimp convert 2grey8 [base]]] \
			     [base 1]]]
    }
}






Added demos/overi.tcl.




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_alpha_over_revers {
    label {Over Revers}
    active {
	expr {
	      ([bases] == 2) &&
	      ([crimp dimensions [base 0]] eq [crimp dimensions [base 1]])
	  }
    }
    setup_image {
	# We use the foreground image's luma as opacity (bright =
	# opaque, dark = transparent) to merge it with the background
	# image. At last we force fully opaque to avoid mix effects
	# against the canvas background color.

	show_image [crimp convert 2rgb \
			[crimp alpha over \
			     [crimp alpha set \
				  [base 1] \
				  [crimp convert 2grey8 [base 1]]] \
			     [base 0]]]
    }
}






Added demos/psych.tcl.




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_psychedelia {
    label Psychedelia
    active {
	expr {[bases] == 0}
    }
    setup {
	variable token

	proc next {} {
	    variable token
	    #show_image [crimp psychedelia 320 240 100]
	    show_image [crimp psychedelia 800 600 100]
	    set token [after 100 DEMO::next]
	    return
	}

	next
    }
    shutdown {
	catch {after cancel $token}
    }
}






Added demos/pyramid_blend.tcl.
















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_blend_pyramid {
    label {Blend Pyramid}
    active {
	expr {
	      ([bases] == 2) &&
	      ([crimp dimensions [base 0]] eq [crimp dimensions [base 1]])
	  }
    }
    setup {
	# Define the interpolation kernel for moving up in the chain
	# of results.
	variable ki [crimp kernel make {{1 4 6 4 1}} 8]
    }
    setup_image {

	# Get the images to blend.
	variable left  [base 0]
	variable right [base 1]

	# Compute a simple blending mask.
	variable w
	variable h
	lassign [crimp dimensions [base 0]] w h
	set w [expr {$w/2}]
	variable mask [crimp montage horizontal \
			   [crimp blank grey8 $w $h 255] \
			   [crimp blank grey8 $w $h 0]]

	# Depth of the pyramids. Restricted by the number of proper 2x
	# decimations we can do on the 800x600 images.
	variable depth 3

	# Compute the input pyramids. We drop the unmodified originals.
	# Note that the mask is a gauss pyramid => successive blurring.
	variable pleft  [lrange [crimp pyramid laplace $left  $depth] 1 end]
	variable pright [lrange [crimp pyramid laplace $right $depth] 1 end]
	variable pmask  [crimp pyramid gauss   $mask  $depth]

	# Merge the input pyramids into a blend result pyramid.
	variable pblend {}
	foreach a $pleft b $pright m $pmask {
	    #puts "B wXh = [crimp dimensions $a]|[crimp dimensions $b]|[crimp dimensions $m]"
	    lappend pblend [crimp add \
			    [crimp multiply $a $m] \
			    [crimp multiply $b [crimp invert $m]]]
	}

	# At last, fold the pyramid back into a single image, from the
	# bottom up, interpolating the intermediate results to match
	# the next level.

	variable result [lindex $pblend end]
	foreach dog [lreverse [lrange $pblend 0 end-1]] {
	    #puts "+ wXh = [crimp dimensions $dog]|[crimp dimensions $result]"
	    set result [crimp add $dog [crimp interpolate xy $result 2 $ki]]
	}

	show_image $result
	return

	# Slideshow of inputs and intermediate results for debugging...
	variable slides {}
	lappend  slides $left $right $mask
	foreach i [list {*}$pleft {*}$pright] {
	    lappend slides [crimp alpha opaque $i]
	}
	lappend slides {*}$pmask
	foreach i $pblend {
	    lappend slides [crimp alpha opaque $i]
	}
	lappend slides [crimp alpha opaque $result]
	show_slides $slides
    }
}






Added demos/pyramid_gauss.tcl.















1
2
3
4
5
6
7
8
9

+
+
+
+
+
+
+
+
+

def op_pyramid_gauss {
    label {Gauss pyramid}
    setup_image {
	# Create a gaussian image pyramid and cycle through the
	# results.

	show_slides [crimp pyramid gauss [base] 4]
    }
}






Added demos/pyramid_gauss2.tcl.


































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_pyramid_gauss2 {
    label {Gauss pyramid (normalized)}
    setup_image {
	# Create an image pyramid, and then scale the result back up
	# to match the original one before cycling.

	show_slides [apply {{images} {
	    set res {}
	    foreach \
		i $images \
		s {1 2 4 8 16 32 64} {
		    lappend res [norm $i $s]
		}
	    return $res
	} ::DEMO} [crimp pyramid gauss [base] 6]]
    }
    setup {
	proc norm {image fac} {
	    if {$fac == 1} { return $image }
	    set kernel [crimp kernel make {{1 4 6 4 1}} 8]
	    while {$fac > 1} {
		set image [crimp interpolate xy $image 2 $kernel]
		set fac [expr {$fac/2}]
	    }
	    return $image
	}
    }
}






Added demos/pyramid_laplace.tcl.





















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_pyramid_laplace {
    label {Laplace pyramid}
    setup_image {
	# Create a laplacian image pyramid, aka difference of
	# gaussians and cycle through the results,

	show_slides [apply {{images} {
	    set res {}
	    foreach i $images {
		lappend res [crimp alpha opaque $i]
	    }
	    return $res
	}} [crimp pyramid laplace [base] 3]]
    }
}






Added demos/pyramid_laplace2.tcl.




































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_pyramid_laplace2 {
    label {Laplace pyramid (normalized)}
    setup_image {
	# Create a laplacian image pyramid, aka difference of
	# gaussians. The results are scaled back to the original
	# before cycling.

	show_slides [apply {{images} {
	    set res {}
	    foreach \
		i $images \
		s {1 1 2 4 8 16 32 64} {
		    set i [norm $i $s]
		    lappend res [crimp alpha opaque $i]
		}
	    return $res
	} ::DEMO} [crimp pyramid laplace [base] 6]]
    }
    setup {
	proc norm {image fac} {
	    if {$fac == 1} { return $image }
	    set kernel [crimp kernel make {{1 4 6 4 1}} 8]
	    while {$fac > 1} {
		set image [crimp interpolate xy $image 2 $kernel]
		set fac [expr {$fac/2}]
	    }
	    return $image
	}
    }
}






Added demos/quad.tcl.





































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_quadrilateral {
    label {Quad mapping}
    active { expr { [bases] == 0} }
    setup {
	proc p {label i} {
	    set t [crimp write 2string pfm-plain $i]
	    set pv [lassign $t _ w h]

	    log* "$label = ${w}x$h \{"
	    set n 0
	    foreach v $pv {
		if {!$n} { log* "\n\t" } else { log* " " }
		log* "$v"
		incr n ; if {$n == $w} { set n 0 }
	    }
	    log "\n\}"
	}

	proc P {label t p} {
	    lassign $p x y
	    set pm [crimp read tcl float [list [list $x 0 0] [list $y 0 0] {1 0 0}]]
	    set d [crimp flip transpose [crimp crop [::crimp::matmul3x3_float $t $pm] 0 0 2 0]]

	    lassign [lrange [crimp write 2string pfm-plain $d] 3 end] xd yd w
	    set x [expr {$xd/double($w)}]
	    set y [expr {$yd/double($w)}]

	    log "$label $p = ($x, $y) \[$xd,$yd,$w\]"
	    return
	}

	proc pmap {src dst t} {
	    foreach sp $src dp $dst l {p1 p2 p3 p4} {
		P "MAP $l ($dp)" [lindex $t 1] $sp
	    }
	    return
	}

	set src {{10 10} {20 5} {20 25} {10 20}}
	set dst {{5 10} {20 5} {20 25} {10 25}}
	set unit {{0 0} {1 0} {1 1} {0 1}}

	set t [::crimp::transform::invert [::crimp::transform::Q2UNIT $src]]
	set s [::crimp::transform::Q2UNIT $dst]
	set w [::crimp::transform::chain $s $t]

	log "src  = $src"
	log "dst  = $dst"
	log "unit = $unit"

	log "\nsrc --> unit rectangle"
	p T [lindex $t 1]
	pmap $src $unit $t

	log "\nunit rectangle --> dst"
	p S [lindex $s 1]
	pmap $unit $dst $s

	log "\nsrc --> dst"
	p Q [lindex $w 1]
	pmap $src $dst  $w
    }
}






Added demos/quantize.tcl.



























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_quantize {
    label Quantize
    setup {
	variable bins  2
	variable where 0
	variable table {}

	scale .left.bins  -variable ::DEMO::bins  -from 2 -to 256 -orient vertical -command ::DEMO::showit
	scale .left.where -variable ::DEMO::where -from 0 -to 100 -orient vertical -command ::DEMO::showit
	plot  .left.p     -variable ::DEMO::table -title Quantization

	plot  .left.h     -variable ::DEMO::hist -locked 0 -title Luma
	plot  .left.hl    -variable ::DEMO::HL   -locked 0 -title {Q Luma}
	plot  .left.tl    -variable ::DEMO::TL   -locked 0 -title {Q CDF Luma}

	grid .left.p     -row 0 -column 0 -sticky swen
	grid .left.h     -row 1 -column 0 -sticky swen
	grid .left.hl    -row 2 -column 0 -sticky swen
	grid .left.tl    -row 3 -column 0 -sticky swen

	grid .left.bins  -row 0 -column 1 -rowspan 4 -sticky swen
	grid .left.where -row 0 -column 2 -rowspan 4 -sticky swen

	proc showit {args} {
	    variable bins
	    variable where
	    show $bins $where
	    return
	}

	proc show {n p} {
	    variable hist
	    if {![info exists hist]} return

	    variable base
	    variable table [crimp table quantize histogram $n $p $hist]
	    set      map     [crimp map quantize histogram $n $p $hist]
	    set      image [crimp remap $base $map]

	    show_image $image

	    # Quantized luma and cdf
	    variable HL [dict values [dict get [crimp histogram $image] luma]]
	    variable TL [crimp::CUMULATE $HL]
	    return
	}
    }
    setup_image {
	variable base  [crimp convert 2grey8 [base]]
	variable hist  [dict get [crimp histogram $base] luma]
	showit
    }
}






Added demos/read_pgm.tcl.




















1
2
3
4
5
6
7
8
9
10
11
12
13
14

+
+
+
+
+
+
+
+
+
+
+
+
+
+

def read_pgm {
    label {Read (PGM)}
    active {
	expr {[bases] == 0}
    }
    setup {
	set K [crimp kernel make {{0 1 1}} 1]
	proc 8x {image} {
	    variable K
	    return [crimp interpolate xy [crimp interpolate xy [crimp interpolate xy $image 2 $K] 2 $K] 2 $K]
	}
	show_image [8x [8x [crimp read pgm [fileutil::cat $dir/images/feep.pgm]]]]
    }
}






Added demos/read_pgm2.tcl.




















1
2
3
4
5
6
7
8
9
10
11
12
13
14

+
+
+
+
+
+
+
+
+
+
+
+
+
+

def read_pgm2 {
    label {Read (PGM Raw)}
    active {
	expr {[bases] == 0}
    }
    setup {
	set K [crimp kernel make {{0 1 1}} 1]
	proc 8x {image} {
	    variable K
	    return [crimp interpolate xy [crimp interpolate xy [crimp interpolate xy $image 2 $K] 2 $K] 2 $K]
	}
	show_image [8x [8x [crimp read pgm [fileutil::cat -translation binary $dir/images/feep-raw.pgm]]]]
    }
}






Added demos/read_ppm.tcl.




















1
2
3
4
5
6
7
8
9
10
11
12
13
14

+
+
+
+
+
+
+
+
+
+
+
+
+
+

def read_ppm1 {
    label {Read (PPM 1)}
    active {
	expr {[bases] == 0}
    }
    setup {
	set K [crimp kernel make {{0 1 1}} 1]
	proc 8x {image} {
	    variable K
	    return [crimp interpolate xy [crimp interpolate xy [crimp interpolate xy $image 2 $K] 2 $K] 2 $K]
	}
	show_image [8x [8x [crimp read ppm [fileutil::cat $dir/images/blink.ppm]]]]
    }
}






Added demos/read_ppm2.tcl.




















1
2
3
4
5
6
7
8
9
10
11
12
13
14

+
+
+
+
+
+
+
+
+
+
+
+
+
+

def read_ppm2 {
    label {Read (PPM 2)}
    active {
	expr {[bases] == 0}
    }
    setup {
	set K [crimp kernel make {{0 1 1}} 1]
	proc 8x {image} {
	    variable K
	    return [crimp interpolate xy [crimp interpolate xy [crimp interpolate xy $image 2 $K] 2 $K] 2 $K]
	}
	show_image [8x [8x [crimp read ppm [fileutil::cat $dir/images/colors.ppm]]]]
    }
}






Added demos/read_strimj.tcl.




















1
2
3
4
5
6
7
8
9
10
11
12
13
14

+
+
+
+
+
+
+
+
+
+
+
+
+
+

def read_strimj {
    label {Read (strimj)}
    active {
	expr {[bases] == 0}
    }
    setup {
	set K [crimp kernel make {{0 1 1}} 1]
	proc 8x {image} {
	    variable K
	    return [crimp interpolate xy [crimp interpolate xy [crimp interpolate xy $image 2 $K] 2 $K] 2 $K]
	}
	show_image [8x [8x [crimp read strimj [fileutil::cat $dir/images/hello.strimj]]]]
    }
}






Added demos/red.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def rgba_red {
    label Red
    setup_image {
	show_image [lindex [crimp split [base]] 0]
    }
}






Added demos/red_tint.tcl.














1
2
3
4
5
6
7
8

+
+
+
+
+
+
+
+

def rgba_red_tint {
    label Red/Tint
    setup_image {
	set c [lindex [crimp split [base]] 0]
	set x [crimp blank grey8 {*}[crimp dimension $c] 0]
	show_image [crimp join 2rgb $c $x $x]
    }
}






Added demos/rehsv.tcl.























































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_rehsv {
    label {Change HSV}
    setup {
	variable hsvbase
	variable mask

	variable ghg 1 ; variable gsg 1 ; variable gvg 1
	variable ghb 0 ; variable gsb 0 ; variable gvb 0

	variable th [crimp table linear wrap  $ghg $ghb] ; variable mh [crimp mapof $th]
	variable ts [crimp table linear clamp $gsg $gsb] ; variable ms [crimp mapof $ts]
	variable tv [crimp table linear clamp $gvg $gvb] ; variable mv [crimp mapof $tv]

	proc H {args} {
	    variable ghb
	    variable ghg
	    variable th [crimp table linear wrap $ghg $ghb]
	    variable mh [crimp mapof $th]
	    UPDATE
	    return
	}
	proc S {args} {
	    variable gsb
	    variable gsg
	    variable ts [crimp table linear clamp $gsg $gsb]
	    variable ms [crimp mapof $ts]
	    UPDATE
	    return
	}
	proc V {args} {
	    variable gvb
	    variable gvg
	    variable tv [crimp table linear clamp $gvg $gvb]
	    variable mv [crimp mapof $tv]
	    UPDATE
	    return
	}
	proc UPDATE {} {
	    variable mh
	    variable ms
	    variable mv
	    variable hsvbase
	    variable mask
	    if {![info exists hsvbase]} return

	    show_image [crimp alpha set \
			    [crimp convert 2rgb [crimp remap $hsvbase $mh $ms $mv]] \
			    $mask]
	    return
	}

	scale .left.hg -variable ::DEMO::ghg -from -10 -to 10  -resolution 0.01 -orient vertical -command ::DEMO::H
	scale .left.sg -variable ::DEMO::gsg -from -10 -to 10  -resolution 0.01 -orient vertical -command ::DEMO::S
	scale .left.vg -variable ::DEMO::gvg -from -10 -to 10  -resolution 0.01 -orient vertical -command ::DEMO::V

	scale .left.hb -variable ::DEMO::ghb -from 0 -to 255 -resolution 1    -orient vertical -command ::DEMO::H
	scale .left.sb -variable ::DEMO::gsb -from 0 -to 255 -resolution 1    -orient vertical -command ::DEMO::S
	scale .left.vb -variable ::DEMO::gvb -from 0 -to 255 -resolution 1    -orient vertical -command ::DEMO::V

	plot  .left.ph -variable ::DEMO::th -title Hue
	plot  .left.ps -variable ::DEMO::ts -title Saturation
	plot  .left.pv -variable ::DEMO::tv -title Value

	grid .left.hg -row 0 -column 0 -sticky sen
	grid .left.ph -row 0 -column 1 -sticky swen
	grid .left.hb -row 0 -column 2 -sticky sen

	grid .left.sg -row 1 -column 0 -sticky sen
	grid .left.ps -row 1 -column 1 -sticky swen
	grid .left.sb -row 1 -column 2 -sticky sen

	grid .left.vg -row 2 -column 0 -sticky sen
	grid .left.pv -row 2 -column 1 -sticky swen
	grid .left.vb -row 2 -column 2 -sticky sen
    }
    setup_image {
	variable hsvbase [crimp convert 2hsv [base]]
	variable mask    [lindex [crimp split [base]] end]
	UPDATE
    }
}






Added demos/resize.tcl.















1
2
3
4
5
6
7
8
9

+
+
+
+
+
+
+
+
+

def op_resize {
    label Resize/Thumbnail
    setup {
    }
    setup_image {
	log [crimp type [base]]
	show_image [crimp alpha opaque [crimp resize [base] 160 120]]
    }
}






Added demos/retinex.tcl.
































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_retinex {
    label {Retinex}
    setup_image {
	RETINEX [crimp convert 2grey8 [base]]
    }
    setup {
	proc RETINEX {image} {
	    log near/5...    ; set retinexN [SSR $image  5 smoothN]
	    log medium/27... ; set retinexM [SSR $image 27 smoothM]
	    log wide/84...   ; set retinexW [SSR $image 84 smoothW]

	    log multi-scale...
	    # multi-scale from the single scales. nearly an arithmetic mean.
	    set retinex                                  [crimp::scale_float $retinexN 0.3]
	    set retinex [crimp::add_float_float $retinex [crimp::scale_float $retinexM 0.4] 1 0]
	    set retinex [crimp::add_float_float $retinex [crimp::scale_float $retinexW 0.3] 1 0]

	    # Compress the results for display. We use two different
	    # methods to determine the visible range. One is to show
	    # everything from actual minimum to maximum (B), the other
	    # shows a range around the mean, a multiple of the
	    # standard deviation (A).

	    set retinexNa [crimp::FITFLOATB $retinexN]
	    set retinexMa [crimp::FITFLOATB $retinexM]
	    set retinexWa [crimp::FITFLOATB $retinexW]
	    set retinexA  [crimp::FITFLOATB $retinex]

	    set retinexNb [crimp::FITFLOAT $retinexN]
	    set retinexMb [crimp::FITFLOAT $retinexM]
	    set retinexWb [crimp::FITFLOAT $retinexW]
	    set retinexB  [crimp::FITFLOAT $retinex]

	    log montage...
	    #set retinex [crimp alpha set $retinex [lindex [crimp::split $retinex] end]]
	    show_image [crimp montage vertical \
			    [crimp montage horizontal \
				 [border $image] \
				 [border [crimp::FITFLOAT $smoothN]] \
				 [border $retinexNa] \
				 [border $retinexNb] \
				] \
			    [crimp montage horizontal \
				 [border $image] \
				 [border [crimp::FITFLOAT $smoothM]] \
				 [border $retinexMa] \
				 [border $retinexMb] \
				] \
			    [crimp montage horizontal \
				 [border $image] \
				 [border [crimp::FITFLOAT $smoothW]] \
				 [border $retinexWa] \
				 [border $retinexWb] \
				] \
			    [crimp montage horizontal \
				 [border $image] \
				 [border $image] \
				 [border $retinexA] \
				 [border $retinexB] \
				] \
			    ]
	    return
	}

	proc border {i} {
	    crimp expand const $i \
		5 5 5 5 \
		0 0 255
	}

	proc SSR {image sigma vs} {
	    upvar 1 $vs smooth
	    # SSR = Single Scale Retinex.
	    # This implementation is limited to grey8 images. I.e. no color.

	    # R = log ((1+I)/(1+I*G))
	    #   = log (1+I) - log (1+I*G)
	    # * = convolution, and G a gaussian.
	    # We are using 1+ to avoid log()'s singularity at 0 (i.e. black).

	    set image     [::crimp::convert_2float_grey8           $image]
	    set smooth    [::crimp::filter::gauss::sampled         $image $sigma]
	    set logimage  [::crimp::log_float [crimp::offset_float $image 1]]
	    set logsmooth [::crimp::log_float [crimp::offset_float $smooth 1]]
	    set ssr       [::crimp::subtract_float_float $logimage $logsmooth 1 0]

	    return $ssr
	}
    }
}






Added demos/retinex_hsv.tcl.





































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_retinex_hsv {
    label {Retinex/HSV}
    setup_image {
	RETINEX [base]
    }
    setup {
	proc RETINEX {image} {
	    # color retinex by processing in HSV, working on only the
	    # V (luma) channel.

	    lassign [crimp split [crimp convert 2hsv $image]] h s v

	    log near/5...    ; set retinexN [SSR $v  5 smoothN]
	    log medium/27... ; set retinexM [SSR $v 27 smoothM]
	    log wide/84...   ; set retinexW [SSR $v 84 smoothW]

	    log multi-scale...
	    # multi-scale from the single scales. nearly an arithmetic mean.
	    set retinex                                  [crimp::scale_float $retinexN 0.3]
	    set retinex [crimp::add_float_float $retinex [crimp::scale_float $retinexM 0.4] 1 0]
	    set retinex [crimp::add_float_float $retinex [crimp::scale_float $retinexW 0.3] 1 0]

	    # Compress the results for display. We use two different
	    # methods to determine the visible range. One is to show
	    # everything from actual minimum to maximum (B), the other
	    # shows a range around the mean, a multiple of the
	    # standard deviation (A).

	    set retinexNa [crimp join 2hsv $h $s [crimp::FITFLOATB $retinexN]]
	    set retinexMa [crimp join 2hsv $h $s [crimp::FITFLOATB $retinexM]]
	    set retinexWa [crimp join 2hsv $h $s [crimp::FITFLOATB $retinexW]]
	    set retinexA  [crimp join 2hsv $h $s [crimp::FITFLOATB $retinex]]

	    set retinexNb [crimp join 2hsv $h $s [crimp::FITFLOAT $retinexN]]
	    set retinexMb [crimp join 2hsv $h $s [crimp::FITFLOAT $retinexM]]
	    set retinexWb [crimp join 2hsv $h $s [crimp::FITFLOAT $retinexW]]
	    set retinexB  [crimp join 2hsv $h $s [crimp::FITFLOAT $retinex]]

	    log montage...
	    #set retinex [crimp alpha set $retinex [lindex [crimp::split $retinex] end]]
	    show_image [crimp montage vertical \
			    [crimp montage horizontal \
				 [border $image] \
				 [border [crimp::FITFLOAT $smoothN]] \
				 [border $retinexNa] \
				 [border $retinexNb] \
				] \
			    [crimp montage horizontal \
				 [border $image] \
				 [border [crimp::FITFLOAT $smoothM]] \
				 [border $retinexMa] \
				 [border $retinexMb] \
				] \
			    [crimp montage horizontal \
				 [border $image] \
				 [border [crimp::FITFLOAT $smoothW]] \
				 [border $retinexWa] \
				 [border $retinexWb] \
				] \
			    [crimp montage horizontal \
				 [border $image] \
				 [border $image] \
				 [border $retinexA] \
				 [border $retinexB] \
				] \
			    ]
	    return
	}

	proc border {i} {
	    crimp expand const [crimp convert 2rgb $i] \
		5 5 5 5 \
		0 0 255
	}

	proc SSR {image sigma vs} {
	    upvar 1 $vs smooth
	    # SSR = Single Scale Retinex.
	    # This implementation is limited to grey8 images. I.e. no color.

	    # R = log ((1+I)/(1+I*G))
	    #   = log (1+I) - log (1+I*G)
	    # * = convolution, and G a gaussian.
	    # We are using 1+ to avoid log()'s singularity at 0 (i.e. black).

	    set image     [::crimp::convert_2float_grey8           $image]
	    set smooth    [::crimp::filter::gauss::sampled         $image $sigma]
	    set logimage  [::crimp::log_float [crimp::offset_float $image 1]]
	    set logsmooth [::crimp::log_float [crimp::offset_float $smooth 1]]
	    set ssr       [::crimp::subtract_float_float $logimage $logsmooth 1 0]

	    return $ssr
	}
    }
}






Added demos/rgb2hsv2rgb.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def effect_rgb2hsv2rgb {
    label "RGB \u2192 HSV \u2192 RGB"
    setup_image {
	show_image [crimp convert 2rgba [crimp convert 2hsv [base]]]
    }
}






Added demos/rof_max.tcl.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

def op_rof_max {
    label {Max Filter}
    setup_image {
	# Create a series of max-filtered images from the base,
	# with different kernel radii.

	show_slides [list \
			 [base] \
			 [crimp filter rank [base]  3 99.99] \
			 [crimp filter rank [base] 10 99.99] \
			 [crimp filter rank [base] 20 99.99]]
    }
}






Added demos/rof_max_luma.tcl.






















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_rof_max_luma {
    label {Max Filter (Luma)}
    setup_image {
	# Create a series of max-filtered images from the luma of
	# the base, with different kernel radii.

	show_slides [apply {{base} {
	    set base [crimp convert 2grey8 $base]
	    return [list \
			$base \
			[crimp filter rank $base  3 99.99] \
			[crimp filter rank $base 10 99.99] \
			[crimp filter rank $base 20 99.99]]
	}} [base]]
    }
}






Added demos/rof_median.tcl.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

def op_rof_median {
    label {Median Filter}
    setup_image {
	# Create a series of median-filtered images from the base,
	# with different kernel radii.

	show_slides [list \
			 [base] \
			 [crimp filter rank [base]] \
			 [crimp filter rank [base] 10] \
			 [crimp filter rank [base] 20]]
    }
}






Added demos/rof_median_luma.tcl.






















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_rof_median_luma {
    label {Median Filter (Luma)}
    setup_image {
	# Create a series of median-filtered images from the luma of
	# the base, with different kernel radii.

	show_slides [apply {{base} {
	    set base [crimp convert 2grey8 $base]
	    return [list \
			$base \
			[crimp filter rank $base] \
			[crimp filter rank $base 10] \
			[crimp filter rank $base 20]]
	}} [base]]
    }
}






Added demos/rof_median_subtract.tcl.




















1
2
3
4
5
6
7
8
9
10
11
12
13
14

+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_rof_median_subtract {
    label {Median Filter Bandpass}
    setup_image {
	# Create a series of median-filtered images from the base,
	# with different kernel radii, which are then subtracted from
	# the base, leaving a sort-of band-pass image.

	show_slides [list \
			 [base] \
			 [crimp alpha opaque [crimp subtract [base] [crimp filter rank [base]]]] \
			 [crimp alpha opaque [crimp subtract [base] [crimp filter rank [base] 10]]] \
			 [crimp alpha opaque [crimp subtract [base] [crimp filter rank [base] 20]]]]
    }
}






Added demos/rof_min.tcl.



















1
2
3
4
5
6
7
8
9
10
11
12
13

+
+
+
+
+
+
+
+
+
+
+
+
+

def op_rof_min {
    label {Min Filter}
    setup_image {
	# Create a series of min-filtered images from the base,
	# with different kernel radii.

	show_slides [list \
			 [base] \
			 [crimp filter rank [base]  3 0] \
			 [crimp filter rank [base] 10 0] \
			 [crimp filter rank [base] 20 0]]
    }
}






Added demos/rof_min_luma.tcl.






















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_rof_min_luma {
    label {Min Filter (Luma)}
    setup_image {
	# Create a series of min-filtered images from the luma of
	# the base, with different kernel radii.

	show_slides [apply {{base} {
	    set base [crimp convert 2grey8 $base]
	    return [list \
			$base \
			[crimp filter rank $base  3 0] \
			[crimp filter rank $base 10 0] \
			[crimp filter rank $base 20 0]]
	}} [base]]
    }
}






Added demos/saturation.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def hsv_saturation {
    label Saturation
    setup_image {
	show_image [lindex [crimp split [crimp convert 2hsv [base]]] 1]
    }
}






Added demos/screen.tcl.


















1
2
3
4
5
6
7
8
9
10
11
12

+
+
+
+
+
+
+
+
+
+
+
+

def op_screen {
    label Screen
    active {
	expr {
	      ([bases] == 2) &&
	      ([crimp dimensions [base 0]] eq [crimp dimensions [base 1]])
	  }
    }
    setup_image {
	show_image [crimp screen [base 0] [base 1]]
    }
}






Added demos/shell.tcl.










































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_a_shell {
    label {Interactive Shell}
    setup {
	# TODO : Command history! Result history ?

	namespace eval ::DEMO::EVAL {
	    namespace import ::crimp::*
	    namespace import ::base
	}

	variable cmd {}

	proc showit {} {
	    variable cmd
	    if {$cmd eq {}} return
	    .top.cmd configure -state disabled ; update ; # coroutine?!
	    if {[catch {
		show_image [namespace eval ::DEMO::EVAL $cmd]
	    } msg]} {
		after 0 [list bgerror $msg]
	    }
	    .top.cmd configure -state normal ; update
	}

	ttk::entry .top.cmd
	pack       .top.cmd -side top -expand 1 -fill both

	bind .top.cmd <Return> {::apply {{} {
	    variable cmd [.top.cmd get]
	    showit
	} ::DEMO}}
    }
    setup_image {
	showit
    }
}






Added demos/solarize.tcl.





































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_solarize {
    label Solarize
    setup {
	variable threshold 256
	variable table     {}

	proc show {thethreshold} {
	    variable table [crimp table solarize  $thethreshold]
	    show_image     [crimp solarize [base] $thethreshold]
	    return
	}

	proc showit {} {
	    variable threshold
	    show $threshold
	    return
	}

	plot  .left.p -variable ::DEMO::table -title Threshold
	scale .left.s -variable ::DEMO::threshold \
	    -from 0 -to 256 \
	    -orient horizontal \
	    -command ::DEMO::show

	grid .left.s -row 0 -column 0 -sticky swen
	grid .left.p -row 1 -column 0 -sticky swen
    }
    setup_image {
	showit
    }
}






Added demos/sqrt.tcl.





































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_sqrt {
    label Sqrt-Compression
    setup {
	variable maxvalue 255
	variable table    {}

	proc show {themaxvalue} {
	    variable table [crimp table sqrt   $themaxvalue]
	    show_image     [crimp remap [base] [crimp mapof $table]]
	    return
	}

	proc showit {} {
	    variable maxvalue
	    show $maxvalue
	    return
	}

	plot  .left.p -variable ::DEMO::table -title Maxvalue
	scale .left.s -variable ::DEMO::maxvalue \
	    -from 1 -to 255 \
	    -orient horizontal \
	    -command ::DEMO::show

	grid .left.s -row 0 -column 0 -sticky swen
	grid .left.p -row 1 -column 0 -sticky swen
    }
    setup_image {
	showit
    }
}






Added demos/statistics.tcl.





























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_statistics {
    label Statistics
    setup_image {
	variable stat
	variable hist
	array set stat [crimp statistics basic [base]]

	foreach k [lsort -dict [array names stat]] {
	    if {$k eq "channel"} {
		log "$k"
		foreach {c cdata} $stat($k) {
		    log "\t$c"
		    array set hist $cdata
		    foreach j [lsort -dict [array names hist]] {
			log "\t\t$j = $hist($j)"
		    }
		}
	    } else {
		log "$k = $stat($k)"
	    }
	}
    }
}






Added demos/statistics2.tcl.

























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_statistics_float {
    label {Statistics/Float}
    active { expr { [bases] == 0} }
    setup {
	set X [crimp read tcl float {
	    {1 3 0}
	    {2 1 4}
	    {0 5 1}
	}]

	array set stat [crimp::stats_float $X]
	array set stat $stat(value)
	unset stat(value)

	foreach k [lsort -dict [array names stat]] {
	    log "$k = $stat($k)"
	}
    }
}






Added demos/stddev.tcl.












































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_stddev {
    label {Stddev Filter}
    setup_image {
	# Create a series of stddev-filtered images from the base,
	# with different kernel radii.

	set g [crimp convert 2grey8 [base]]

	proc P {g r} {
	    # NOTE: The std deviation is usually small, and plain
	    # conversion to grey will most likely yield a uniform
	    # black display. So, for the purposes of actually seeing
	    # something we stretch the result to 0..255 (assuming that
	    # the regular result is 0..1. Think about calculating the
	    # basic statistics for float images too, so that we can
	    # use the proper max to compute the stretch factor.
	    crimp convert 2grey8 \
		[crimp::scale_float \
		     [crimp filter stddev $g $r] \
		     255]
	}

	# radius => window
	#  1 - 3x3
	#  2 - 5x5
	#  3 - 7x7
	# 10 - 21x21
	# 20 - 41x41

	show_slides [list \
			 $g \
			 [P $g 1] \
			 [P $g 2] \
			 [P $g 3] \
			 [P $g 10] \
			 [P $g 20]]
    }
}






Added demos/subtract.tcl.





































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_subtract {
    label Subtract
    active {
	expr {
	      ([bases] == 2) &&
	      ([crimp dimensions [base 0]] eq [crimp dimensions [base 1]])
	  }
    }
    setup_image {
	show
    }
    setup {
	variable scale  1
	variable offset 0

	proc show {args} {
	    variable scale
	    variable offset

	    show_image [crimp alpha opaque \
			    [crimp subtract [base 0] [base 1] $scale $offset]]
	    return
	}

	scale .left.s -variable ::DEMO::scale  -from 1 -to 255 -orient vertical -command ::DEMO::show
	scale .left.o -variable ::DEMO::offset -from 0 -to 255 -orient vertical -command ::DEMO::show

	pack .left.s -side left -expand 1 -fill both
	pack .left.o -side left -expand 1 -fill both
    }
}






Added demos/threshold_g.tcl.















1
2
3
4
5
6
7
8
9

+
+
+
+
+
+
+
+
+

def op_threshold_mg {
    label {Threshold Morph Gradient}
    setup_image {
	show_image [crimp alpha opaque \
			     [crimp threshold local [base] \
				  [crimp morph gradient \
				       [crimp convert 2grey8 [base]]]]]
    }
}






Added demos/threshold_ge.tcl.










































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_threshold_ge {
    label "Threshold \u2265"
    setup {
	variable threshold 256
	variable table     {}

	proc show {thethreshold} {
	    # (x >= threshold) ==> black, else white
	    #
	    # (threshold == 0)   ==> all black
	    # (threshold == 256) ==> all white

	    variable table [crimp table threshold above  $thethreshold]
	    show_image     [crimp threshold global above [base] $thethreshold]
	    return
	}

	proc showit {} {
	    variable threshold
	    show $threshold
	    return
	}

	plot  .left.p -variable ::DEMO::table -title Threshold
	scale .left.s -variable ::DEMO::threshold \
	    -from 0 -to 256 \
	    -orient horizontal \
	    -command ::DEMO::show

	grid .left.s -row 0 -column 0 -sticky swen
	grid .left.p -row 1 -column 0 -sticky swen
    }
    setup_image {
	showit
    }
}






Added demos/threshold_global.tcl.






















































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_threshold_global {
    label "Threshold Global"
    setup {
	# Demo various ways of for the automatic calculation of a
	# global threshold.

	proc showbase {} {
	    show_image [base]
	    return
	}

	proc average {} {
	    show_image [crimp threshold global mean [base]]
	    return
	}

	proc median {} {
	    show_image [crimp threshold global median [base]]
	    return
	}

	proc middle {} {
	    show_image [crimp threshold global middle [base]]
	    return
	}

	proc kmeans {} {
	    # TODO
	    set pixels [lsort -uniq [lrange [crimp write 2string pgm-plain [crimp convert 2grey8 [base]]] 5 end]]

	    log "pixels = [llength $pixels]"

	    lassign [km {0 255} $pixels ::DEMO::1dd ::DEMO::1dm] \
		_ plow _ pup

	    # compute upper/lower borders of the lower/upper
	    # partitions.
	    set up  [tcl::mathfunc::max {*}$plow]
	    set low [tcl::mathfunc::min {*}$pup]

	    log "...$up) ... ($low..."

	    if {$up > $low} {
		log "error, border order violation ($up > $low)"
	    }

	    # Put threshold between the borders, in the middle.
	    set t [expr {int (0.5*($up + $low))}]

	    log ".........^ $t"

	    show_image [crimp threshold global below [base] $t]
	    return
	}

	# 1d distance and mean
	proc 1dd {a b} { expr {abs($a - $b)} }
	proc 1dm {set} { expr {[tcl::mathop::+ {*}$set]/double([llength $set])} }

	# TODO: Should have k-means algorithm which operates on an
	# histogram of observations, i.e. a value -> count dictionary.

	proc centerof {o centers deltacmd} {
	    set min {}
	    set minc {}
	    foreach c $centers {
		set d [{*}$deltacmd $o $c]
		if {$min eq {} || $d < $min} {
		    set min $d
		    set minc $c
		}
	    }
	    return $minc
	}

	proc dictsort {dict} {
	    array set a $dict
	    set out [list]
	    foreach key [lsort [array names a]] {
		lappend out $key $a($key)
	    }
	    return $out
	}

	proc km {centers observations deltacmd meancmd} {
	    # centers = initial set of cluster centers
	    # observations = the data points to cluster
	    # deltacmd = compute distance between points
	    # compute mean of a set of points.

	    # http://en.wikipedia.org/wiki/K-means_clustering#Standard_algorithm
	    # aka http://en.wikipedia.org/wiki/Lloyd%27s_algorithm
	    # 'Voronoi iteration'

	    set lastmap {}
	    while {1} {
		log "km = | $centers |"
		# I. Assign observations to centers.
		set map {}
		foreach o $observations {
		    dict lappend map [centerof $o $centers $deltacmd] $o
		}

		# Ia. Check for convergence, i.e. no changes between
		#     the previous and current assignments.
		set smap [dictsort $map]
		if {$smap eq $lastmap} {
		    return $map
		}

		# II. Compute new centers from the partitions.
		set new {}
		foreach {c partition} $map {
		    lappend new [{*}$meancmd $partition]
		}

		set centers $new
		set lastmap $smap
	    }
	}

	proc otsu {} {
	    show_image [crimp threshold global otsu [base]]
	    return
	}

	button .left.base   -text Base    -command ::DEMO::showbase
	button .left.middle -text Middle  -command ::DEMO::middle
	button .left.avg    -text Average -command ::DEMO::average
	button .left.med    -text Median  -command ::DEMO::median
	button .left.otsu   -text Otsu    -command ::DEMO::otsu
	button .left.km     -text 2-Means -command ::DEMO::kmeans

	grid .left.base   -row 2 -column 0 -sticky swen
	grid .left.avg    -row 3 -column 0 -sticky swen
	grid .left.med    -row 4 -column 0 -sticky swen
	grid .left.middle -row 5 -column 0 -sticky swen
	grid .left.otsu   -row 6 -column 0 -sticky swen
	grid .left.km     -row 7 -column 0 -sticky swen
    }
    setup_image {
	showbase
    }
}






Added demos/threshold_ig.tcl.
















1
2
3
4
5
6
7
8
9
10

+
+
+
+
+
+
+
+
+
+

def op_threshold_img {
    label {Threshold Invers Morph Gradient}
    setup_image {
	show_image [crimp alpha opaque \
			     [crimp threshold local [base] \
				  [crimp invert \
				       [crimp morph gradient \
					    [crimp convert 2grey8 [base]]]]]]
    }
}






Added demos/threshold_le.tcl.

















































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_threshold_le {
    label "Threshold \u2264"
    setup {
	variable threshold 256
	variable table     {}

	proc show {thethreshold} {
	    # (x < threshold) ==> black, else white
	    #
	    # (threshold == -1)  ==> all white
	    # (threshold == 256) ==> all black

	    variable table [crimp table threshold below  $thethreshold]
	    show_image     [crimp threshold global below [base] $thethreshold]
	    return
	}

	proc showit {} {
	    variable threshold
	    show $threshold
	    return
	}

	# Demo various ways of for the automatic calculation of a
	# global threshold.

	proc showbase {} {
	    show_image [base]
	    return
	}

	proc average {} {
	    variable threshold
	    array set s [crimp statistics basic [crimp convert 2grey8 [base]]]
	    array set s $s(channel)
	    array set s $s(luma)
	    set threshold $s(mean)
	    showit
	    return
	}

	proc median {} {
	    variable threshold
	    array set s [crimp statistics basic [crimp convert 2grey8 [base]]]
	    array set s $s(channel)
	    array set s $s(luma)
	    set threshold $s(median)
	    showit
	    return
	}

	proc middle {} {
	    variable threshold
	    array set s [crimp statistics basic [crimp convert 2grey8 [base]]]
	    array set s $s(channel)
	    array set s $s(luma)
	    set threshold $s(middle)
	    showit
	    return
	}

	proc k-means {} {
	    variable threshold
	    array set s [crimp statistics basic [crimp convert 2grey8 [base]]]
	    array set s $s(channel)
	    array set s $s(luma)
	    # TODO ... classify $s(histogram) 0 255 ...
	    showit
	    return
	}

	proc kmeans {} {
	    variable threshold
	    set pixels [lsort -uniq [lrange [crimp write 2string pgm-plain [crimp convert 2grey8 [base]]] 5 end]]

	    log "pixels = [llength $pixels]"

	    lassign [km {0 255} $pixels ::DEMO::1dd ::DEMO::1dm] \
		_ plow _ pup

	    # compute upper/lower borders of the lower/upper
	    # partitions.
	    set up  [tcl::mathfunc::max {*}$plow]
	    set low [tcl::mathfunc::min {*}$pup]

	    log "...$up) ... ($low..."

	    if {$up > $low} {
		log "error, border order violation ($up > $low)"
	    }

	    # Put threshold between the borders, in the middle.
	    set threshold [expr {int (0.5*($up + $low))}]

	    log ".........^ $threshold"

	    showit
	    return
	}

	# 1d distance and mean
	proc 1dd {a b} { expr {abs($a - $b)} }
	proc 1dm {set} { expr {[tcl::mathop::+ {*}$set]/double([llength $set])} }

	# TODO: Should have k-means algorithm which operates on an
	# histogram of observations, i.e. a value -> count dictionary.

	proc centerof {o centers deltacmd} {
	    set min {}
	    set minc {}
	    foreach c $centers {
		set d [{*}$deltacmd $o $c]
		if {$min eq {} || $d < $min} {
		    set min $d
		    set minc $c
		}
	    }
	    return $minc
	}

	proc dictsort {dict} {
	    array set a $dict
	    set out [list]
	    foreach key [lsort [array names a]] {
		lappend out $key $a($key)
	    }
	    return $out
	}

	proc km {centers observations deltacmd meancmd} {
	    # centers = initial set of cluster centers
	    # observations = the data points to cluster
	    # deltacmd = compute distance between points
	    # compute mean of a set of points.

	    # http://en.wikipedia.org/wiki/K-means_clustering#Standard_algorithm
	    # aka http://en.wikipedia.org/wiki/Lloyd%27s_algorithm
	    # 'Voronoi iteration'

	    set lastmap {}
	    while {1} {
		log "km = | $centers |"
		# I. Assign observations to centers.
		set map {}
		foreach o $observations {
		    dict lappend map [centerof $o $centers $deltacmd] $o
		}

		# Ia. Check for convergence, i.e. no changes between
		#     the previous and current assignments.
		set smap [dictsort $map]
		if {$smap eq $lastmap} {
		    return $map
		}

		# II. Compute new centers from the partitions.
		set new {}
		foreach {c partition} $map {
		    lappend new [{*}$meancmd $partition]
		}

		set centers $new
		set lastmap $smap
	    }
	}

	proc otsu {} {
	    variable threshold
	    array set s [crimp statistics otsu [crimp statistics basic [crimp convert 2grey8 [base]]]]
	    array set s $s(channel)
	    array set s $s(luma)
	    set threshold $s(otsu)
	    showit
	    return
	}

	plot  .left.p -variable ::DEMO::table -title Threshold
	scale .left.s -variable ::DEMO::threshold \
	    -from -1 -to 256 \
	    -orient horizontal \
	    -command ::DEMO::show

	button .left.base   -text Base    -command ::DEMO::showbase
	button .left.middle -text Middle  -command ::DEMO::middle
	button .left.avg    -text Average -command ::DEMO::average
	button .left.med    -text Median  -command ::DEMO::median
	button .left.otsu   -text Otsu    -command ::DEMO::otsu
	button .left.km     -text 2-Means -command ::DEMO::kmeans

	grid .left.s      -row 0 -column 0 -sticky swen
	grid .left.p      -row 1 -column 0 -sticky swen

	grid .left.base   -row 2 -column 0 -sticky swen
	grid .left.avg    -row 3 -column 0 -sticky swen
	grid .left.med    -row 4 -column 0 -sticky swen
	grid .left.middle -row 5 -column 0 -sticky swen
	grid .left.otsu   -row 6 -column 0 -sticky swen
	grid .left.km     -row 7 -column 0 -sticky swen
    }
    setup_image {
	showit
    }
}






Added demos/threshold_local.tcl.













































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_threshold_local {
    label "Threshold Local"
    setup {
	variable threshold [crimp blank grey8 {*}[crimp dimensions [base]] 0]

	proc show {thethreshold} {
	    # NOTE: thethreshold is an image.
	    #
	    # base[] >= threshold[] => BLACK
	    # base[] <  threshold[] => WHITE

	    show_image [crimp invert \
			    [crimp alpha opaque \
				 [crimp threshold local [base] \
				      $thethreshold]]]
	    return
	}

	proc showbase {} {
	    show_image [base]
	    return
	}

	proc otsu {} {
	    show_image [crimp threshold global otsu [base]]
	    return
	}

	proc showit {} {
	    variable threshold
	    show $threshold
	    return
	}

	# Demo various ways of for the automatic calculation of a
	# local threshold.

	# Compute a median filtered version of the input, use this as
	# threshold. I.e. if a pixel is greater than the median at its
	# location we go black, else white. This has an obvious
	# parameter, the filter radius, i.e. the size of the
	# environment aroiund the a pixel the median is taken from. If
	# this approaches the image size the thresholding will
	# asymptotically converge on a single global threshold. Making
	# the radius smaller on the other hand wil more and more fail
	# to smooth out small-scale fluctuations.
	#
	# Note our use of a mirror border, this avoids problems with a
	# constant border warping the local histograms towards black,
	# white, etc.

	proc median {n} {
	    variable threshold
	    set threshold [crimp filter rank \
			       [crimp convert 2grey8 [base]] \
			       -border mirror $n]
	    showit
	    return
	}

	# Use the local mean as threshold.

	proc mean {n} {
	    variable threshold
	    set threshold [crimp filter mean [crimp convert 2grey8 [base]]]
	    showit
	    return
	}

	# niblack's method: T = M + k*S, k a parameter, M = locval
	# mean, S = local standard deviation. Here k = 0.2. 2nd param
	# is the usual radius.

	proc niblack {n} {
	    variable threshold
	    set k 0.2

	    set i   [crimp convert 2grey8 [base]]
	    lassign [crimp::BORDER grey8 mirror] fe values
	    lassign [crimp::filter::MEAN_STDDEV $i $n $fe $values] m s

	    set threshold [crimp convert 2grey8 [crimp add $m [crimp::scale_float $s $k]]]
	    showit
	    return
	}

	proc niblack2 {n} {
	    variable threshold
	    set k -0.2

	    set i   [crimp convert 2grey8 [base]]
	    lassign [crimp::BORDER grey8 mirror] fe values
	    lassign [crimp::filter::MEAN_STDDEV $i $n $fe $values] m s

	    set threshold [crimp convert 2grey8 [crimp add $m [crimp::scale_float $s $k]]]
	    showit
	    return
	}

	# sauvola's method: T = M * (1 + k*(S/R - 1)).
	#                     = M + M*k*(S/R - 1)
	#                     = M + M*k*S/R - M*k
	#
	# M = local mean, S = local standard deviation.
	# R = dynamic range for S, here 128
	# k = 2nd parameter, here = 0.34

	proc sauvola {n} {
	    variable threshold
	    set k 0.2

	    set i   [crimp convert 2grey8 [base]]
	    lassign [crimp::BORDER grey8 mirror] fe values
	    lassign [crimp::filter::MEAN_STDDEV $i $n $fe $values] m s

	    set sr [crimp::scale_float $s [expr {1./128}]] ;# S/R
	    set mk [crimp::scale_float $m $k]              ;# M*k

	    set threshold [crimp convert 2grey8 [crimp subtract [crimp add $m [crimp multiply $mk $sr]] $mk]]
	    showit
	    return
	}

	proc sauvola2 {n} {
	    variable threshold
	    set k 0.5

	    set i   [crimp convert 2grey8 [base]]
	    lassign [crimp::BORDER grey8 mirror] fe values
	    lassign [crimp::filter::MEAN_STDDEV $i $n $fe $values] m s

	    set sr [crimp::scale_float $s [expr {1./128}]] ;# S/R
	    set mk [crimp::scale_float $m $k]              ;# M*k

	    set threshold [crimp convert 2grey8 [crimp subtract [crimp add $m [crimp multiply $mk $sr]] $mk]]
	    showit
	    return
	}

	# GUI. Grid of buttons.

	button .left.base -text Base -command ::DEMO::showbase -bg lightgreen
	grid   .left.base -row 0 -column 0 -sticky swen

	button .left.otsu -text Otsu -command ::DEMO::otsu -bg lightblue
	grid   .left.otsu -row 0 -column 1 -sticky swen

	foreach {b label cmd col startrow} {
	    med  Median   median   0 1
	    mean Mean     mean     1 1
	    nib  Niblack  niblack  0 10
	    sau  Sauvola  sauvola  1 10
	    nbx  Niblack* niblack2 0 20
	    sax  Sauvola* sauvola2 1 20
	} {
	    set r $startrow
	    foreach n {10 20 50 100 200 300 400 500 1000} {
		button .left.${b}$r -text "$label $n" -command [list ::DEMO::$cmd $n]
		grid .left.${b}$r -row $r -column $col -sticky swen
		incr r
	    }
	}
    }
    setup_image {
	showbase
    }
}






Added demos/threshold_luma_ge.tcl.










































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_threshold_luma_ge {
    label "Threshold Luma \u2265"
    setup {
	variable threshold 256
	variable table     {}

	proc show {thethreshold} {
	    # (x >= threshold) ==> black, else white
	    #
	    # (threshold == 0)   ==> all black
	    # (threshold == 256) ==> all white

	    variable table [crimp table threshold above  $thethreshold]
	    show_image     [crimp threshold global above [crimp convert 2grey8 [base]] $thethreshold]
	    return
	}

	proc showit {} {
	    variable threshold
	    show $threshold
	    return
	}

	plot  .left.p -variable ::DEMO::table -title Threshold
	scale .left.s -variable ::DEMO::threshold \
	    -from 0 -to 256 \
	    -orient horizontal \
	    -command ::DEMO::show

	grid .left.s -row 0 -column 0 -sticky swen
	grid .left.p -row 1 -column 0 -sticky swen
    }
    setup_image {
	showit
    }
}






Added demos/threshold_luma_le.tcl.










































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def op_threshold_luma_le {
    label "Threshold Luma \u2264"
    setup {
	variable threshold 256
	variable table     {}

	proc show {thethreshold} {
	    # (x < threshold) ==> black, else white
	    #
	    # (threshold == -1)  ==> all white
	    # (threshold == 256) ==> all black

	    variable table [crimp table threshold below  $thethreshold]
	    show_image     [crimp threshold global below [crimp convert 2grey8 [base]] $thethreshold]
	    return
	}

	proc showit {} {
	    variable threshold
	    show $threshold
	    return
	}

	plot  .left.p -variable ::DEMO::table -title Threshold
	scale .left.s -variable ::DEMO::threshold \
	    -from -1 -to 256 \
	    -orient horizontal \
	    -command ::DEMO::show

	grid .left.s -row 0 -column 0 -sticky swen
	grid .left.p -row 1 -column 0 -sticky swen
    }
    setup_image {
	showit
    }
}






Added demos/upsample2.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_upsample2 {
    label Upsample\u21912
    setup_image {
	show_image [crimp upsample xy [base] 2]
    }
}






Added demos/upsample3.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_upsample3 {
    label Upsample\u21913
    setup_image {
	show_image [crimp upsample xy [base] 3]
    }
}






Added demos/upsample4.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_upsample4 {
    label Upsample\u21914
    setup_image {
	show_image [crimp upsample xy [base] 4]
    }
}






Added demos/upsample8.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def op_upsample8 {
    label Upsample\u21918
    setup_image {
	show_image [crimp upsample xy [base] 8]
    }
}






Added demos/value.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def hsv_value {
    label Value
    setup_image {
	show_image [lindex [crimp split [crimp convert 2hsv [base]]] 2]
    }
}






Added demos/warp_field.tcl.























































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_warp_field_rgba {
    label {Warp/BiL rgba (Fuzz Field)}
    setup {
	variable fuzz 5
	variable mode bilinear

	proc rand {} {
	    variable fuzz
	    expr {$fuzz*(rand()*2-1)}
	}

	proc field {dim} {
	    variable fuzzf
	    lassign $dim w h
	    # Generate a random fuzzing field, simulating glass with
	    # high random scattering of light going through it.

	    set xv {}
	    set yv {}
	    for {set y 0} {$y < $h} {incr y} {
		set xvr {}
		set yvr {}
		for {set x 0} {$x < $w} {incr x} {
		    lappend xvr [expr {$x + [rand]}]
		    lappend yvr [expr {$y + [rand]}]
		}
		lappend xv $xvr
		lappend yv $yvr
	    }

	    set fuzzf [list \
			   [crimp read tcl float $xv] \
			   [crimp read tcl float $yv]]
	    return
	}

	proc showit {} {
	    variable fuzzf
	    variable mode
	    show_image [crimp warp field -interpolate $mode [base] {*}$fuzzf]
	    return
	}

	proc showf {} {
	    field [crimp dimensions [base]]
	    showit
	    return
	}

	proc show {args} {
	    variable idle
	    catch   { after cancel $idle }
	    set idle [after idle ::DEMO::showf]
	    return
	}

	proc mode {m} {
	    variable mode $m
	    showit
	    return
	}

	scale .left.s -variable ::DEMO::fuzz \
	    -from 0 -to 40 -resolution 1 \
	    -orient vertical \
	    -command ::DEMO::show

	button .top.nn -text nNeighbour -command {::DEMO::mode nneighbour}
	button .top.li -text 2linear    -command {::DEMO::mode bilinear}
	button .top.cu -text 2cubic     -command {::DEMO::mode bicubic}

	pack .left.s -side left -fill both -expand 1

	pack .top.nn -side left -fill y
	pack .top.li -side left -fill y
	pack .top.cu -side left -fill y
    }
    setup_image {
	showf
    }
}






Added demos/warp_quad.tcl.


































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_warp_quad_rgba {
    label {Warp/BiL rgba (Quadrilaterals)}
    setup {
	proc show {} {
	    set src {{10 10} {200 5} {200 250} {10 200}}
	    set dst  {{0  0} {200 5} {150 400} {50 250}}

	    set t [crimp transform quadrilateral $src $dst]

	    log "\nsrc --> dst"
	    p T [lindex $t 1]
	    pmap $src $dst $t

	    lassign [crimp dimensions [base]] w h
	    log "\nCorners"
	    pmap "{0 0} {$w 0} {$w $h} {0 $h}" {? ? ? ?} $t

	    show_image [crimp warp projective -interpolate bilinear [base] $t]
	    return
	}

	proc p {label i} {
	    set t [crimp write 2string pfm-plain $i]
	    set pv [lassign $t _ w h]

	    log* "$label = ${w}x$h \{"
	    set n 0
	    foreach v $pv {
		if {!$n} { log* "\n\t" } else { log* " " }
		log* "$v"
		incr n ; if {$n == $w} { set n 0 }
	    }
	    log "\n\}"
	}

	proc P {label t p} {
	    lassign $p x y
	    set pm [crimp read tcl float [list [list $x 0 0] [list $y 0 0] {1 0 0}]]
	    set d [crimp flip transpose [crimp crop [::crimp::matmul3x3_float $t $pm] 0 0 2 0]]

	    lassign [lrange [crimp write 2string pfm-plain $d] 3 end] xd yd w
	    set x [expr {$xd/double($w)}]
	    set y [expr {$yd/double($w)}]

	    log "$label $p = ($x, $y) \[$xd,$yd,$w\]"
	    return
	}

	proc pmap {src dst t} {
	    foreach sp $src dp $dst l {p1 p2 p3 p4} {
		P "MAP $l ($dp)" [lindex $t 1] $sp
	    }
	    return
	}

    }
    setup_image {
	show
    }
}






Added demos/warp_rc_bicubic.tcl.










































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_warp_rc2_luma {
    label {Warp/BiC luma (Rotate around center)}
    setup {
	variable angle -150

	proc show {theangle} {
	    variable cx
	    variable cy
	    variable i

	    show_image [crimp warp projective -interpolate bicubic $i \
			    [crimp transform rotate $theangle [list $cx $cy]]]
	    return
	}

	proc showit {} {
	    variable angle
	    show $angle
	    return
	}

	scale .left.s -variable ::DEMO::angle \
	    -from -180 -to 180 -resolution 0.01 \
	    -orient vertical \
	    -command ::DEMO::show

	pack .left.s -side left -fill both -expand 1
    }
    setup_image {
	variable i [crimp convert 2grey8 [base]]
	variable cx [expr {[crimp width  $i]/2.}]
	variable cy [expr {[crimp height $i]/2.}]

	showit
    }
}






Added demos/warp_rc_bicubic_rgba.tcl.








































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_warp_rc2_rgba {
    label {Warp/BiC rgba (Rotate around center)}
    setup {
	variable angle -150

	proc show {theangle} {
	    variable cx
	    variable cy

	    show_image [crimp warp projective -interpolate bicubic [base] \
			    [crimp transform rotate $theangle [list $cx $cy]]]
	    return
	}

	proc showit {} {
	    variable angle
	    show $angle
	    return
	}

	scale .left.s -variable ::DEMO::angle \
	    -from -180 -to 180 -resolution 0.01 \
	    -orient vertical \
	    -command ::DEMO::show

	pack .left.s -side left -fill both -expand 1
    }
    setup_image {
	variable cx [expr {[crimp width  [base]]/2.}]
	variable cy [expr {[crimp height [base]]/2.}]

	showit
    }
}






Added demos/warp_rc_bilinear.tcl.










































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_warp_rc3_luma {
    label {Warp/BiL luma (Rotate around center)}
    setup {
	variable angle -150

	proc show {theangle} {
	    variable cx
	    variable cy
	    variable i

	    show_image [crimp warp projective -interpolate bilinear $i \
			    [crimp transform rotate $theangle [list $cx $cy]]]
	    return
	}

	proc showit {} {
	    variable angle
	    show $angle
	    return
	}

	scale .left.s -variable ::DEMO::angle \
	    -from -180 -to 180 -resolution 0.01 \
	    -orient vertical \
	    -command ::DEMO::show

	pack .left.s -side left -fill both -expand 1
    }
    setup_image {
	variable i [crimp convert 2grey8 [base]]
	variable cx [expr {[crimp width  $i]/2.}]
	variable cy [expr {[crimp height $i]/2.}]

	showit
    }
}






Added demos/warp_rc_bilinear_rgba.tcl.








































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_warp_rc3_rgba {
    label {Warp/BiL rgba (Rotate around center)}
    setup {
	variable angle -150

	proc show {theangle} {
	    variable cx
	    variable cy

	    show_image [crimp warp projective -interpolate bilinear [base] \
			    [crimp transform rotate $theangle [list $cx $cy]]]
	    return
	}

	proc showit {} {
	    variable angle
	    show $angle
	    return
	}

	scale .left.s -variable ::DEMO::angle \
	    -from -180 -to 180 -resolution 0.01 \
	    -orient vertical \
	    -command ::DEMO::show

	pack .left.s -side left -fill both -expand 1
    }
    setup_image {
	variable cx [expr {[crimp width  [base]]/2.}]
	variable cy [expr {[crimp height [base]]/2.}]

	showit
    }
}






Added demos/warp_rc_nneighbour.tcl.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_warp_rc_luma {
    label {Warp/NNe luma (Rotate around center)}
    setup {
	variable angle -150

	proc show {theangle} {
	    variable cx
	    variable cy
	    variable i

	    show_image [crimp warp projective -interpolate nneighbour \
			    $i [crimp transform rotate $theangle [list $cx $cy]]]
	    return
	}

	proc showit {} {
	    variable angle
	    show $angle
	    return
	}

	scale .left.s -variable ::DEMO::angle \
	    -from -180 -to 180 -resolution 0.01 \
	    -orient vertical \
	    -command ::DEMO::show

	pack .left.s -side left -fill both -expand 1
    }
    setup_image {
	variable i [crimp convert 2grey8 [base]]
	variable cx [expr {[crimp width  $i]/2.}]
	variable cy [expr {[crimp height $i]/2.}]
	showit
    }
}






Added demos/warp_rc_nneighbour_rgba.tcl.








































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_warp_rc_rgba {
    label {Warp/NNe rgba (Rotate around center)}
    setup {
	set cx [expr {[crimp width  [base]]/2.}]
	set cy [expr {[crimp height [base]]/2.}]

	variable angle -150

	proc show {theangle} {
	    variable cx
	    variable cy

	    show_image [crimp warp projective \
			    [base] [crimp transform rotate $theangle [list $cx $cy]]]
	    return
	}

	proc showit {} {
	    variable angle
	    show $angle
	    return
	}

	scale .left.s -variable ::DEMO::angle \
	    -from -180 -to 180 -resolution 0.01 \
	    -orient vertical \
	    -command ::DEMO::show

	pack .left.s -side left -fill both -expand 1
    }
    setup_image {
	showit
    }
}






Added demos/warp_sc_bicubic.tcl.








































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_warp_sc2_luma {
    label {Warp/BiC luma (Scale X/Y)}
    setup {
	variable sx 1
	variable sy 1

	proc show {args} {
	    variable sx
	    variable sy
	    variable i

	    show_image [crimp warp projective -interpolate bicubic $i \
			    [crimp transform scale $sx $sy]]
	    return
	}

	scale .left.sx -variable ::DEMO::sx \
	    -from 0.01 -to 5 -resolution 0.01 \
	    -orient vertical \
	    -command ::DEMO::show

	scale .left.sy -variable ::DEMO::sy \
	    -from 0.01 -to 5 -resolution 0.01 \
	    -orient vertical \
	    -command ::DEMO::show

	pack .left.sx -side left -fill both -expand 1
	pack .left.sy -side left -fill both -expand 1
    }
    setup_image {
	variable i [crimp convert 2grey8 [base]]
	show
    }
}






Added demos/warp_sc_bicubic_rgba.tcl.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_warp_sc2_rgba {
    label {Warp/BiC rgba (Scale X/Y)}
    setup {
	variable sx 1
	variable sy 1

	proc show {args} {
	    variable sx
	    variable sy
	    variable i

	    show_image [crimp warp projective -interpolate bicubic [base] \
			    [crimp transform scale $sx $sy]]
	    return
	}

	scale .left.sx -variable ::DEMO::sx \
	    -from 0.01 -to 5 -resolution 0.01 \
	    -orient vertical \
	    -command ::DEMO::show

	scale .left.sy -variable ::DEMO::sy \
	    -from 0.01 -to 5 -resolution 0.01 \
	    -orient vertical \
	    -command ::DEMO::show

	pack .left.sx -side left -fill both -expand 1
	pack .left.sy -side left -fill both -expand 1
    }
    setup_image {
	show
    }
}






Added demos/warp_sc_bilinear.tcl.








































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_warp_sc3_luma {
    label {Warp/BiL luma (Scale X/Y)}
    setup {
	variable sx 1
	variable sy 1

	proc show {args} {
	    variable sx
	    variable sy
	    variable i

	    show_image [crimp warp projective -interpolate bilinear $i \
			    [crimp transform scale $sx $sy]]
	    return
	}

	scale .left.sx -variable ::DEMO::sx \
	    -from 0.01 -to 5 -resolution 0.01 \
	    -orient vertical \
	    -command ::DEMO::show

	scale .left.sy -variable ::DEMO::sy \
	    -from 0.01 -to 5 -resolution 0.01 \
	    -orient vertical \
	    -command ::DEMO::show

	pack .left.sx -side left -fill both -expand 1
	pack .left.sy -side left -fill both -expand 1
    }
    setup_image {
	variable i [crimp convert 2grey8 [base]]
	show
    }
}






Added demos/warp_sc_bilinear_rgba.tcl.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_warp_sc3_rgba {
    label {Warp/BiL rgba (Scale X/Y)}
    setup {
	variable sx 1
	variable sy 1

	proc show {args} {
	    variable sx
	    variable sy
	    variable i

	    show_image [crimp warp projective -interpolate bilinear [base] \
			    [crimp transform scale $sx $sy]]
	    return
	}

	scale .left.sx -variable ::DEMO::sx \
	    -from 0.01 -to 5 -resolution 0.01 \
	    -orient vertical \
	    -command ::DEMO::show

	scale .left.sy -variable ::DEMO::sy \
	    -from 0.01 -to 5 -resolution 0.01 \
	    -orient vertical \
	    -command ::DEMO::show

	pack .left.sx -side left -fill both -expand 1
	pack .left.sy -side left -fill both -expand 1
    }
    setup_image {
	show
    }
}






Added demos/warp_sc_nneighbour.tcl.








































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_warp_sc_luma {
    label {Warp/NNe luma (Scale X/Y)}
    setup {
	variable sx 1
	variable sy 1

	proc show {args} {
	    variable sx
	    variable sy
	    variable i

	    show_image [crimp warp projective -interpolate nneighbour \
			    $i [crimp transform scale $sx $sy]]
	    return
	}

	scale .left.sx -variable ::DEMO::sx \
	    -from 0.01 -to 5 -resolution 0.01 \
	    -orient vertical \
	    -command ::DEMO::show

	scale .left.sy -variable ::DEMO::sy \
	    -from 0.01 -to 5 -resolution 0.01 \
	    -orient vertical \
	    -command ::DEMO::show

	pack .left.sx -side left -fill both -expand 1
	pack .left.sy -side left -fill both -expand 1
    }
    setup_image {
	variable i [crimp convert 2grey8 [base]]
	show
    }
}






Added demos/warp_sc_nneighbour_rgba.tcl.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_warp_sc_rgba {
    label {Warp/NNe rgba (Scale X/Y)}
    setup {
	variable sx 1
	variable sy 1

	proc show {args} {
	    variable sx
	    variable sy
	    variable i

	    show_image [crimp warp projective -interpolate nneighbour \
			    [base] [crimp transform scale $sx $sy]]
	    return
	}

	scale .left.sx -variable ::DEMO::sx \
	    -from 0.01 -to 5 -resolution 0.01 \
	    -orient vertical \
	    -command ::DEMO::show

	scale .left.sy -variable ::DEMO::sy \
	    -from 0.01 -to 5 -resolution 0.01 \
	    -orient vertical \
	    -command ::DEMO::show

	pack .left.sx -side left -fill both -expand 1
	pack .left.sy -side left -fill both -expand 1
    }
    setup_image {
	show
    }
}






Added demos/wavy.tcl.































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

def effect_wavy {
    label Wavy
    setup {
	proc show {args} {
	    variable wa
	    variable wb
	    variable wc
	    show_image [crimp wavy [base] $wa $wb $wc]
	    return
	}

	variable wa 1
	variable wb 1
	variable wc 1

	scale .left.wa -variable ::DEMO::wa -from -20 -to 20 -resolution 0.01 -orient vertical -command ::DEMO::show
	scale .left.wb -variable ::DEMO::wb -from -20 -to 20 -resolution 0.01 -orient vertical -command ::DEMO::show
	scale .left.wc -variable ::DEMO::wc -from -20 -to 20 -resolution 0.01 -orient vertical -command ::DEMO::show

	pack .left.wa -side left -expand 1 -fill both
	pack .left.wb -side left -expand 1 -fill both
	pack .left.wc -side left -expand 1 -fill both
    }
    setup_image { show }
}






Added demos/write_pgm.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def write_pgm {
    label {Write (PGM/plain)}
    setup_image {
	crimp write 2file pgm-plain $dir/written.pgm [base]
    }
}






Added demos/write_pgm_raw.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def write_pgmraw {
    label {Write (PGM/raw)}
    setup_image {
	crimp write 2file pgm-raw $dir/written.pgm [base]
    }
}






Added demos/write_ppm.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def write_ppm {
    label {Write (PPM/plain)}
    setup_image {
	crimp write 2file ppm-plain $dir/written.ppm [base]
    }
}






Added demos/write_ppm_raw.tcl.












1
2
3
4
5
6

+
+
+
+
+
+

def write_ppmraw {
    label {Write (PPM/raw)}
    setup_image {
	crimp write 2file ppm-raw $dir/written.ppm [base]
    }
}






Added doc/crimp.man.




































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































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
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

[comment {-*- tcl -*- doctools manpage}]
[manpage_begin crimp n 1.0.1]
[copyright {2010 Andreas Kupries}]
[copyright {2010 Documentation, Andreas Kupries}]
[moddesc   {Image Manipulation}]
[titledesc {Image Manipulation (not yet independent of Tk)}]
[require Tcl 8.5]
[require Tk 8.5]
[require crimp [opt 0]]
[description]

This package provides image manipulation commands which are mostly
independent of Tk. The only parts currently depending on Tk are for
the import and export of images from and to Tk photos, necessary for
display.

[para]

Note that the intended audience of this document are the users of
[package crimp]. Developers wishing to work on the internals of the
package, but unfamiliar with them, should read ... instead.

[section Images]

Images are values. This means that they have a string
representation. It is however strongly recommended to not access this
representation at all, and to only use the accessor commands provided
by crimp to obtain the information stored in the internal
representation of image values.

[para]

The reason behind this is simple: Memory and speed. Images can be
large. Generating the string representation from the internal one
roughly doubles the memory needed to store it, actually a bit more,
due to the necessary quoting of bytes in UTF-8 and list-quting them as
well. Furthermore such a conversion takes time, roughly proportional
to the size of the image itself, in either direction. Properly
accessing the image information without the package's accessor
commands requires list commands. This causes the loss of the internal
representation, thus forcing later a reconversion to the image's
internal represention when it is used as image again. I.e. the
shimmering forces us to convert twice.

[para]

Therefore, to avoid this, use only the crimp commands to access the
images. Even the raw pixel data is accessible in this manner. While
access to that in a Tcl script is, IMHO, highly unusual, there are
situations where it is beneficial. An example of such a situation are
the commands exporting images to raw portable any-maps (PNMs). Our
pixel data fits these formats exactly, and with access to it these
commands could be written in Tcl instead of requiring C level primitives.


[section {Image Types}]

Each image has a [term type], a string implicitly describing features
like the colorspace the image is in, the number of (color) channels,
the domain, i.e. bit-depth, of pixel values in the channels, etc.

[para]

All type strings have the form [const crimp::image::][var foo].

[para]

The package currently knows the following types:

[list_begin definitions]
[def [const rgba]]
	[list_begin definitions]
	[def Colorspace]	RGB also known as Red, Green, and Blue.
	[def Channels]		4, named "red", "green", and "blue",
				plus an "alpha" channel controlling
				pixel opacity.
	[def Bit-depth]		1 byte/channel (8 bit, values 0-255).
	[def Pixel-size]	4 bytes.
	[list_end]
[def [const rgb]]
	[list_begin definitions]
	[def Colorspace]	RGB also known as Red, Green, and Blue.
	[def Channels]		3, named "red", "green", and "blue".
	[def Bit-depth]		1 byte/channel (8 bit, values 0-255).
	[def Pixel-size]	3 bytes.
	[list_end]
[def [const hsv]]
	[list_begin definitions]
	[def Colorspace]	HSV, also known as Hue, Saturation, and Value.
	[def Channels]		3, named "hue", "saturation", and "value".
	[def Bit-depth]		1 byte/channel (8 bit, values 0-255).
	[def Pixel-size]	3 bytes.
	[list_end]
[def [const grey8]]
	[list_begin definitions]
	[def Colorspace]	Greyscale.
	[def Channels]		1, named "luma".
	[def Bit-depth]		1 byte/channel (8 bit, values 0-255).
	[def Pixel-size]	1 byte.
	[list_end]
[def [const grey16]]
	[list_begin definitions]
	[def Colorspace]	Greyscale.
	[def Channels]		1, named "luma".
	[def Bit-depth]		2 byte/channel (16 bit, values 0-65,535).
	[def Pixel-size]	2 bytes.
	[list_end]
[def [const grey32]]
	[list_begin definitions]
	[def Colorspace]	Greyscale.
	[def Channels]		1, named "luma".
	[def Bit-depth]		4 byte/channel (16 bit, values 0-4,294,967,296).
	[def Pixel-size]	4 bytes.
	[list_end]
[def [const bw]]
	[list_begin definitions]
	[def Colorspace]	Binary.
	[def Channels]		1, named "bw".
	[def Bit-depth]		1 bit/channel.
	[def Pixel-size]	1 byte. I.e. 7 bits/channel are wasted.
	[list_end]
[def [const float]]
	[list_begin definitions]
	[def Colorspace]	N.A / Floating Point.
	[def Channels]		1, named "value".
	[def Bit-depth]		4 byte/channel.
	[def Pixel-size]	4 byte.
	[list_end]
[list_end]

Support for the various types varies by operation. The exact image
types supported by each operation are listed the operation's
description. Invoking an operation for a type it doesn't support will
generally cause it to throw an error.


[section {General design}]

All commands operate in a pipeline fashion, taking zero or more image
values, zero or more other arguments, and returning zero or more
images or other values. None are operating in place, i.e. taking an
image variable and writing back to it.

[para]

They fall into five categories, namely:

[para][image organization]

[list_begin definitions]
[def Accessors]

They take one or more images, extract information about them, and
return this information as their result. This can be a simple as
querying the image's height, to something as complex as counting pixel
values for a histogram.

[para]

The list of accessors, their syntax, and detailed meaning can be found
in section [sectref Accessors].


[def Manipulators]

These take an image and transform its contents in some way, leaving
the image type unchanged. Examples of commands in category are
inversion, gamma conversion, etc. They fall into two sub-categories,
manipulation of the image geometry, and of the intensity values or
colors.

[para]

The list of manipulators, their syntax, and detailed meaning can be
found in section [sectref Manipulators].


[def Converters]

Similar to manipulators, except that they change the image's type,
preserving the content instead. Here reside operations like conversion
between the HSV and RGB colorspaces, to greyscale and back, etc.

[para]

The list of converters, their syntax, and detailed meaning can be
found in section [sectref Converters].


[def I/O]

Another variant of the same theme, i.e. akin to converters and
manipulators, yet not the same, these commands read and write images
from and to files or other data structures. I.e. they convert between
different serializations of image content and type.

[para]

The list of I/O commands, their syntax, and detailed meaning can be
found in section [sectref {I/O commands}].


[def Support]

Lastly, but not leastly a number of commands, which, while not image
commands themselves, support the others.

[para]

The list of supporting commands, their syntax, and detailed meaning
can be found in section [sectref Support].


[list_end]


[section API]
[subsection Accessors]
[list_begin definitions]
[call [cmd ::crimp] [method channels] [arg image]]
[keywords channels]

This method returns a list containing the names of the channels in the
[arg image]. The order of channels is the same as expected by the
[method remap] method.

[para] The method supports all image types.


[call [cmd ::crimp] [method dimensions] [arg image]]
[keywords dimensions]

This method returns the width and height of the [arg image] (in
pixels).  The result is a 2-element list containing width and height,
in this order.

[para] The method supports all image types.


[call [cmd ::crimp] [method height] [arg image]]

This method returns the height of the [arg image] (in pixels).

[para] The method supports all image types.


[call [cmd ::crimp] [method histogram] [arg image]]
[keywords histogram]

This method returns a nested dictionary as its result.  The outer
dictionary is indexed by the names of the channels in the [arg image].
Its values, the inner dictionaries, are indexed by pixel value. The
associated values are the number of pixels with that value.

[para] The method supports all image types except "grey32".  Under the
current system the result would be a dictionary with 2^32 keys and
values, taking up, roughly, 192 GiByte of memory in the worst case,
and 96 GiByte in best case (all counter values shared in a single
object).


[call [cmd ::crimp] [method {meta append}] [arg image] [arg key] [opt [arg string]...]]
[call [cmd ::crimp] [method {meta create}] [arg image] [opt "[arg key] [arg value]..."]]
[call [cmd ::crimp] [method {meta exists}] [arg image] [arg key] [opt [arg key]...]]
[call [cmd ::crimp] [method {meta filter}] [arg image] [arg args]...]
[call [cmd ::crimp] [method {meta for}] [arg image] \{[arg keyVar] [arg valueVar]\} [arg body]]
[call [cmd ::crimp] [method {meta get}] [arg image] [opt [arg key]...]]
[call [cmd ::crimp] [method {meta incr}] [arg image] [arg key] [opt [arg increment]]]
[call [cmd ::crimp] [method {meta info}] [arg image]]
[call [cmd ::crimp] [method {meta keys}] [arg image] [opt [arg globPattern]]]
[call [cmd ::crimp] [method {meta lappend}] [arg image] [arg key] [opt [arg value]...]]
[call [cmd ::crimp] [method {meta merge}] [arg image] [opt [arg dictionaryValue]...]]
[call [cmd ::crimp] [method {meta remove}] [arg image] [opt [arg key]...]]
[call [cmd ::crimp] [method {meta replace}] [arg image] [opt "[arg key] [arg value]..."]]
[call [cmd ::crimp] [method {meta set}] [arg image] [arg key] [opt [arg key]...] [arg value]]
[call [cmd ::crimp] [method {meta size}] [arg image]]
[call [cmd ::crimp] [method {meta unset}] [arg image] [arg key] [opt [arg key]...]]
[call [cmd ::crimp] [method {meta values}] [arg image] [opt [arg globPattern]]]

These methods provide access to the meta data slot of images, treating
its contents as a dictionary. As such all the methods provided here
have an appropriate counterpart in the methods of Tcl's builtin
command [cmd dict], with the image's metadata taking the place of the
dictionary value or vqariable.

The converse is not true, as [cmd dict]'s methods [method update] and
[method with] are not supported here.

[para] Please read the documentation of Tcl's [cmd dict] command for reference.

[para] [emph NOTE] that the toplevel key [const crimp] is reserved for
use by CRIMP itself.


[call [cmd ::crimp] [method pixel] [arg image]]

This method returns the raw pixels of the [arg image] as a Tcl ByteArray.

[para] The method supports all image types.


[call [cmd ::crimp] [method {statistics basic}] [arg image]]
[keywords statistics min max median mean average middle stddev variance]

This method returns a nested dictionary as its result. The outer dictionary
contains basic information about the image, see the list of keys below.
The inner dictionaries hold data about each (color) channel in the image,
namely histogram and derived data like minumum pixel value, maximum, etc.

[list_begin definitions]
[def [const dimensions]] 2-element list holding image width and height, in
                         this order.
[def [const height]]     Image height as separate value.
[def [const pixels]]     Number of pixels in the image, the product of
                         its width and height.
[def [const type]]       Type of the image.
[def [const width]]      Image width as separate value.
[def [const channels]]   List of the names for the channels in the image.
[def [const channel]]    A dictionary mapping the names of the image's
                         channels, as listed under key [const channels], to
                         a dictionary holding the statistics for that channel.
[list_begin definitions]
[def [const min]]        The minimal pixel value with a non-zero population.
[def [const max]]        The maximal pixel value with a non-zero population.
[def [const mean]]       The arithmetic mean (aka average) of pixel values.
[def [const middle]]     The arithmetic mean of the min and max pixel values.
[def [const median]]     The median pixel value.
[def [const stddev]]     The standard deviation of pixel values.
[def [const variance]]   The variance of pixel values, square of the standard
                         deviation.
[def [const histogram]]  A dictionary mapping pixel values to population counts.
[def [const hf]]         The histogram reduced to the population counts, sorted
                         by pixel value to direct indexing into the list by
                         pixel values.
[def [const cdf]]        The [term {cumulative density function}] of pixel
                         values. The discrete integral of [const hf].
[def [const cdf255]]     Same as [const cdf], except scaled down so that the
                         last value in the series is 255.
[list_end]
[list_end]

[para] The method supports all image types except "grey32".  Under the
current system the result would contain internal dictionaries with 2^32 keys
and values, taking up, roughly, 192 GiByte of memory in the worst case,
and 96 GiByte in best case (all counter values shared in a single
object).

[call [cmd ::crimp] [method {statistics otsu}] [arg stats]]
[keywords {otsu threshold} threshold binarization]

This method takes a dictionary of basic image statistics as generated
by [cmd {crimp statistics basic}] and returns an extended dictionary
containing a threshold for image binarization computed by Otsu's
method (See [sectref References reference] 2). Note that this
threshold is computed separately for each channel and stored in the
channel specific part of the dictionary, using the key [const otsu].


[call [cmd ::crimp] [method type] [arg image]]

This method returns the type of the [arg image].

[para] The method supports all image types.


[call [cmd ::crimp] [method width] [arg image]]

This method returns the width of the [arg image] (in pixels).

[para] The method supports all image types.

[list_end]


[subsection Manipulators]
[list_begin definitions]


[call [cmd ::crimp] [method add] [arg image1] [arg image2] [opt [arg scale]] [opt [arg offset]]]

This method combines the two input images into a result image by
performing a pixelwise addition (image1 + image2) followed by division
through [arg scale] and addition of the [arg offset]. They default to
[const 1] and [const 0] respectively, if they are not specified.


[call [cmd ::crimp] [method {alpha blend}] [arg foreground] [arg background] [arg alpha]]
[keywords blending {alpha blending}]

This method takes two images of identical dimensions and a blending
factor [arg alpha] and returns an image which is a mix of both, with
each pixel blended per the formula

[para][image blend]
[para]

or, alternatively written

[para][image blend_alt]
[para]

This means that the [arg foreground] is returned as is for
"[arg alpha] == 255", and the [arg background] for
"[arg alpha] == 0".

I.e. the argument [arg alpha] controls the [term opacity] of the
foreground, with [const 1] and [const 0] standing for "fully opaque"
and "fully transparent", respectively.

[para]

The following combinations of fore- and background image types are
supported:

[example {
    Result = Foreground Background 
    ------   ---------- ---------- 
    grey8    grey8      grey8
    hsv      hsv        hsv
    rgb      rgb        grey8
    rgb      rgb        rgb
    rgb      rgb        rgba
    rgba     rgba       grey8
    rgba     rgba       rgb
    rgba     rgba       rgba
    ------   ---------- ----------
}]


[call [cmd ::crimp] [method {alpha set}] [arg image] [arg mask]]
[keywords alpha {alpha channel}]

This command takes two images, the input and a [arg mask], and returns
an image as result in which the mask is the alpha channel of the
input.

The result is therefore always of type [const rgba], as the only type
supporting an alpha channel.

[para] The input image can be of type [const rgb] or [const rgba].  In
case of the latter the existing alpha channel is replaced, in case of
the former an alpha channel is added.

[para] For the mask images of type [const grey8] and [const rgba] are
accepted.  In the case of the latter the mask's alpha channel is used
as the new alpha channel, in case of the former the mask itself is
used.


[call [cmd ::crimp] [method {alpha opaque}] [arg image]]

A convenience method over [method {alpha set}], giving the [arg image]
a mask which makes it fully opaque.


[call [cmd ::crimp] [method {alpha over}] [arg foreground] [arg background]]
[keywords composition {composite blending}]

This method is similar to [method blend] above, except that there is
no global blending parameter. This information is taken from the
"alpha" channel of the [arg foreground] image instead. The blending
formula is the same, except that the alpha parameter is now a
per-pixel value, and not constant across the image.

[para]

Due to the need for an alpha channel the [arg foreground] has to be of
type [const rgba]. For the [arg background] image the types
[const rgb] and [const rgba] are supported.


[call [cmd ::crimp] [method atan2] [arg image1] [arg image2]]
[keywords hypot]

This method combines the two input images into a result image by
computing

[para][image atan2][para]

at each pixel.

[para]
The input is restricted to images of the single-channel types,
i.e. [const float] and [const "grey\{8,16,32\}"]. The result is always
of type [const float].

[para]

An application of this operation is the computation of a gradient's
direction from two images representing a gradient in X and Y directions.

For the full conversion of such cartesian gradients to a polar
representation use the [method {crimp hypot}] operation to compute the
gradient's magnitude at each pixel.


[call [cmd ::crimp] [method blank] [arg type] [arg width] [arg height] [arg value]...]

This method returns a blank image of the given image type and
dimensions.  The [arg value]s after the dimensions are the pixel
values to fill the pixels in the image's channels with, per its type.

[para] This method currently support only the types [const rgb],
[const rgba], and [const grey8].


[call [cmd ::crimp] [method crop] [arg image] [arg ww] [arg hn] [arg we] [arg hs]]
[keywords cropping shrinking resize {edge shrinking}]

This method is the counterpart to the [method expand] family of
methods, shrinking an [arg image] by removing a border.

The size of this border is specified by the four arguments [arg ww],
[arg hn], [arg we], and [arg hs] which provide the number of pixels to
remove from the named edge. See the image below for a graphical
representation.

[para][image border][para]


[call [cmd ::crimp] [method cut] [arg image] [arg x] [arg y] [arg w] [arg h]]
[keywords {cut region} {region cut} {rectangle cut} {rectangle extraction}]
[keywords {extract rectangle} {extract region}]

This method cuts the rectangular region specified throught its [arg x]/[arg y]
position relative to the upper-left corner of the input [arg image] and its
dimensions, and returns it as its own image.


[call [cmd ::crimp] [method {decimate xy}] [arg image] [arg factor] [arg kernel]]
[call [cmd ::crimp] [method {decimate x}] [arg image] [arg factor] [arg kernel]]
[call [cmd ::crimp] [method {decimate y}] [arg image] [arg factor] [arg kernel]]

This is a convenience method combining the two steps of filtering an image
(via [method {filter convolve}]), followed by a [method downsample] step.
See the method [method interpolate] for the complementary operation.

[para] Note that while the [arg kernel] argument for [method {filter convolve}]
is expected to be the 1D form of a separable low-pass filter no checks are made.
The method simply applies both the kernel and its transposed form.

[para] The method [method {pyramid gauss}] is a user of this method.


[call [cmd ::crimp] [method degamma] [arg image] [arg y]]
[keywords {gamma correction}]

This method takes an image, runs it through an
[fun {inverse gamma correction}] with parameter [arg y], and returns
the corrected image as it result.

This is an application of method [method remap], using the mapping
returned by "[method {map degamma}] [arg y]".

This method supports all image types supported by the method
[method remap].


[call [cmd ::crimp] [method difference] [arg image1] [arg image2]]

This method combines the two input images into a result image by
taking the pixelwise absolute difference (|image1 - image2|).


[call [cmd ::crimp] [method {downsample xy}] [arg image] [arg factor]]
[call [cmd ::crimp] [method {downsample x}] [arg image] [arg factor]]
[call [cmd ::crimp] [method {downsample y}] [arg image] [arg factor]]

This method returns an image containing only every [arg factor] pixel of the
input [arg image] (in x, y, or both dimensions). The effect is that the input is
shrunken by [arg factor]. It is the complement of method [method upsample].

[para] Using the method as is is not recommended because the simple subsampling
will cause higher image frequencies to alias into the reduced spectrum, causing
artifacts to appear in the result. This is normally avoided by running a
low-pass filter over the image before doing downsampling, removing the
problematic frequencies.

[para] The [method decimate] method is a convenience method combining these
two steps into one.


[call [cmd ::crimp] [method {effect charcoal}] [arg image]]
[keywords effect charcoal]

This method applies a charcoal effect to the image, i.e. it returns a
[const grey8] image showing the input as if it had been drawn with a
charcoal pencil.


[call [cmd ::crimp] [method {effect emboss}] [arg image]]
[keywords effect emboss]

This method applies an embossing effect to the image, i.e. it returns
an image of the same type as the input showing the input as if it had
been embossed into a metal plate with a stencil of some kind.


[call [cmd ::crimp] [method {effect sharpen}] [arg image]]
[keywords effect sharpen]

This method sharpens the input image, i.e. returns an image of the
same type as the input in which the input's edges are emphasized.


[call [cmd ::crimp] [method {expand const}] [arg image] [arg ww] [arg hn] [arg we] [arg hs] [opt [arg value]...]]
[call [cmd ::crimp] [method {expand extend}] [arg image] [arg ww] [arg hn] [arg we] [arg hs]]
[call [cmd ::crimp] [method {expand mirror}] [arg image] [arg ww] [arg hn] [arg we] [arg hs]]
[call [cmd ::crimp] [method {expand replicate}] [arg image] [arg ww] [arg hn] [arg we] [arg hs]]
[call [cmd ::crimp] [method {expand wrap}] [arg image] [arg ww] [arg hn] [arg we] [arg hs]]
[keywords expansion {const expansion} {extend expansion} {mirror expansion}]
[keywords {replicate edge expansion} {wrap expansion} {cyclic wrap expansion} {toroidal wrap expansion}]

This set of methods takes an image and expands it by adding a border.

The size of this border is specified by the four arguments [arg ww],
[arg hn], [arg we], and [arg hs] which provide the number of pixels to
add at the named edge. See the image below for a graphical
representation.

[para][image border][para]

The contents of the border's pixels are specified via the border type,
the first argument after [method expand], as per the list below.

[list_begin definitions]
[def [method const]]

The additional [arg value]s specify the values to use for the color
channels of the image. Values beyond the number of channels in the
image are ignored.

Missing values are generated by replicating the last value, except for
the alpha channel, which will be set to [const 255]. If no values are
present they default to [const 0].

[def [method extend]]

This is a combination of [method mirror] and [method replicate].  The
outside pixels are the result of subtracting the outside pixel for
[method mirror] from the outside pixel for [method replicate] (and
clamping to the range [lb]0...255[rb]).

[def [method mirror]]

The outside pixels take the value of the associated inside pixels,
found by reflecting its coordinates along the relevant edges.

[def [method replicate]]

The outside pixels take the value of the associated edge pixels, i.e.
replicating them into the border.

[def [method wrap]]

The outside pixels take the value of the associated inside pixels,
found by toroidial (cyclic) wrapping its coordinates along the
relevant edges. This is also called tiling.

[list_end]


[call [cmd ::crimp] [method {fft forward}] [arg image]]
[call [cmd ::crimp] [method {fft backward}] [arg image]]
[keywords fft {fast fourier transform} {fourier transform} {inverse fourier transform}]

These two methods implement 2D FFT (forward) and inverse FFT (backward).

[para]
The input is restricted to images of the single-channel types,
i.e. [const float] and [const "grey\{8,16,32\}"]. The result is always
of type [const float].

[para]
The former means that it is necessary to split [const rgb],
etc. images into their channels before performing an FFT, and that
results of an inverse FFT have to be joined.

See the methods [method split] and [method join] for the relevant
operations and their syntax.

[para]
The latter means that a separate invokation of method
[method {convert 2grey8}] is required when reconstructing an image
by inverting its FFT.


[call [cmd ::crimp] [method {filter ahe}] [arg image] [opt "[option -border] [arg spec]"] [opt [arg radius]]]

This method performs adaptive histogram equalization to enhance the
contrast of the input image. Each pixel undergoes regular histogram
equalization, with the histogram computed from the pixels in the
[var N]x[var N] square centered on it, where
"[var N] = 2*[var radius]+1".

[para]
The default radius is [const 3], for a 7x7 square.


[call [cmd ::crimp] [method {filter convolve}] [arg image] [opt "[option -border] [arg spec]"] [arg kernel]...]
[keywords {convolution filter} filter]

This method runs the series of filters specified by the convolution
[arg kernel]s over the input and returns the filtered result. See the
method [method kernel] and its sub-methods for commands to create and
manipulate suitable kernels.

[para] The border specification determines how the input image is
expanded (see method [method expand]) to compensate for the shrinkage
introduced by the filter itself. The [arg spec] argument is a list
containing the name of the sub-method of [method expand] to use, plus
any additional arguments this method may need, except for the size of
the expansion.

[para] By default a black frame is used as the border, i.e.
"[arg spec] == {const 0}".


[call [cmd ::crimp] [method {filter gauss discrete}] [arg image] [arg sigma] [opt [arg r]]]
[call [cmd ::crimp] [method {filter gauss sampled}] [arg image] [arg sigma] [opt [arg r]]]

These methods apply a discrete or sampled gaussian blur with
parameters [arg sigma] and kernel [arg r]adius to the [arg image]. If
the radius is not specified it defaults to the smallest integer
greater than "3*[arg sigma]".


[call [cmd ::crimp] [method {filter mean}] [arg image] [opt "[option -border] [arg spec]"] [opt [arg radius]]]
[keywords {mean filter} filter]

This method applies a mean filter with [arg radius] to the
image. I.e. each pixel of the result is the mean value of all pixels
in the [var N]x[var N] square centered on it, where
"[var N] = 2*[var radius]+1".

[para]
The default radius is [const 3], for a 7x7 square.

[para]
[emph NOTE]. As the mean is known to be in the range defined by the
channel this method automatically converts float results back to the
channel type. This introduces rounding / quantization errors. As a
result of this price being paid the method is able to handle
multi-channel images, by automatically splitting, processing, and
rejoining its channels.

[para]
The method [method {filter stddev}] on the other makes the reverse
tradeoff, keeping precision, but unable to handle multi-channel
images.

[call [cmd ::crimp] [method {filter rank}] [arg image] [opt "[option -border] [arg spec]"] [opt "[arg radius] [opt [arg percentile]]"]]
[keywords filter {rank-order filter} {max-filter} {min-filter} {median-filter}]

This method runs a rank-filter over the input and returns the filtered
result.

[para] The border specification determines how the input image is
expanded (see method [method expand]) to compensate for the shrinkage
introduced by the filter itself. The [arg spec] argument is a list
containing the name of the sub-method of [method expand] to use, plus
any additional arguments this method may need, except for the size of
the expansion.

[para] By default a black frame is used as the border, i.e.
"[arg spec] == {const 0}".

[para] The [arg radius] specifies the (square) region around each
pixel which is taken into account by the filter, with the pixel value
selected according to the [arg percentile]. The filter region of each
pixel is a square of dimensions "2*[arg radius]+1", centered around
the pixel.

[para] These two values default to [const 3] and [const 50], respectively.

[para] Typical applications of rank-filters are min-, max-, and
median-filters, for percentiles 0, 100, and 50, respectively.

[para] Note that percentiles outside of the range [const 0]...[const 100]
make no sense and are clamped to this range.


[call [cmd ::crimp] [method {filter stddev}] [arg image] [opt "[option -border] [arg spec]"] [opt [arg radius]]]
[keywords {standard deviation filter} filter]

This method applies a stand deviation filter with [arg radius] to the
image. I.e. each pixel of the result is the standard deviation of all
pixel values in the [var N]x[var N] square centered on it, where

"[var N] = 2*[var radius]+1".

[para]
The default radius is [const 3], for a 7x7 square.

[para]

[emph NOTE]. As the standard deviation is often quite small and its
precision important the result of this method is always an image of
type [const float]. Because of this this method is unable to handle
multi-channel images as the results of processing their channels
cannot be joined back together for the proper type.

[para]
The method [method {filter mean}] on the other hand makes the reverse
tradeoff, handling multi-channel images, but dropping precision.


[call [cmd ::crimp] [method {filter sobel x}] [arg image]]
[call [cmd ::crimp] [method {filter sobel y}] [arg image]]
[call [cmd ::crimp] [method {filter scharr x}] [arg image]]
[call [cmd ::crimp] [method {filter scharr y}] [arg image]]
[call [cmd ::crimp] [method {filter prewitt x}] [arg image]]
[call [cmd ::crimp] [method {filter prewitt y}] [arg image]]
[keywords filter sobel scharr prewitt edge-detection gradient]

These methods are convenience methods implementing a number of standard
convolution filters using for edge detection and calculation of image
gradients.

[para]
See the [method {crimp gradient}] methods for users of these filters.

[para]
Also note that the [method x] methods emphasize gradient in the horizontal
direction, and thus highlight [emph vertical] lines, and vice versa for
[method y].


[call [cmd ::crimp] [method gamma] [arg image] [arg y]]

This method takes an image, runs it through a [fun {gamma correction}]
with parameter [arg y], and returns the corrected image as it result.

This is an application of method [method remap], using the mapping
returned by "[method {map gamma}] [arg y]".

This method supports all image types supported by the method
[method remap].


[call [cmd ::crimp] [method {gradient sobel}] [arg image]]
[call [cmd ::crimp] [method {gradient scharr}] [arg image]]
[call [cmd ::crimp] [method {gradient prewitt}] [arg image]]
[keywords sobel scharr prewitt edge-detection gradient]

These methods generate two gradient images for the input image, in the
X- and Y-directions, using different semi-standard filters. I.e. the
result is a cartesian representation of the gradients in the input.
The result is a 2-element list containing the X- and Y-gradient
images, in this order.


[call [cmd ::crimp] [method {gradient polar}] [arg cgradient]]

This method takes a gradient in cartesian representation (as
returned by the above methods) and converts it to polar
representation, i.e. magnitude and angle. The result of the method
is a 2-element list containing two [const float] images, the
magnitude and angle, in this order. The angle is represented
in degrees running from 0 to 360.


[call [cmd ::crimp] [method {gradient visual}] [arg pgradient]]

This method takes a gradient in polar representation (as
returned by method [method {gradient polar}]) and converts it
into a color image ([const rgb]) visualizing the gradient.

[para]
The visualization is easier to understand in HSV space tough,
with the angle mapped to Hue, i.e. color, magnitude to Value,
and Saturation simply at full.


[call [cmd ::crimp] [method hypot] [arg image1] [arg image2]]
[keywords hypot]

This method combines the two input images into a result image by
computing

[para][image hypot][para]

at each pixel.

[para]
The input is restricted to images of the single-channel types,
i.e. [const float] and [const "grey\{8,16,32\}"]. The result is always
of type [const float].

[para]

An application of this operation is the computation of the gradient
magnitude from two images representing a gradient in X and Y directions.

For the full conversion of such cartesian gradients to a polar
representation use the [method {crimp atan2}] operation to compute the
gradient's direction at each pixel.


[call [cmd ::crimp] [method integrate] [arg image]]
[keywords {integral image} {summed area table}]

This method takes any single-channel image, i.e. of types
[const float] and [const "grey\{8,16,32\}"], and returns its integral,
i.e. a summed area table. The type of the result is always of type
[const float].


[call [cmd ::crimp] [method {interpolate xy}] [arg image] [arg factor] [arg kernel]]
[call [cmd ::crimp] [method {interpolate x}] [arg image] [arg factor] [arg kernel]]
[call [cmd ::crimp] [method {interpolate y}] [arg image] [arg factor] [arg kernel]]

This is a convenience method combining the two steps of an [method upsample],
followed by a filter step (via [method {filter convolve}]). See the method
[method decimate] for the complementary operation.

[para] Note that while the [arg kernel] argument for [method {filter convolve}]
is expected to be 1D form of a separable low-pass filter no checks are made.
The method simply applies both the kernel and its transposed form.

[para] The methods [method {pyramid gauss}] and [method {pyramid laplace}] are
users of this method.


[call [cmd ::crimp] [method invert] [arg image]]
[keywords inversion]

This method takes an image, runs it through the [fun inverse]
function, and returns the modified image as it result.

This is an application of method [method remap], using the mapping
returned by "[method {map inverse}]".

This method supports all image types supported by the method
[method remap].


[call [cmd ::crimp] [method matrix] [arg image] [arg matrix]]
[keywords matrix {projective transform} transform {affine transform}]

This method takes an image and a 3x3 matrix specified as nested Tcl
list (row major order), applies the projective transform represented
by the matrix to the image and returns the transformed image as its
result.

[para]

Notes: It is currently unclear how the output pixel is computed
(nearest neighbour, bilinear, etc.) (code inherited from AMG). This
requires more reading, and teasing things apart. The transfomred image
is clipped to the dimensions of the input image, i.e. pixels from the
input may be lost, and pixels in the output may be unset as their
input would come from outside of the input.

[para]

The operation supports only images of type [const rgba], and returns
images of the same type.


[call [cmd ::crimp] [method max] [arg image1] [arg image2]]
[keywords max]

This method combines the two input images into a result image by
taking the pixelwise maximum.


[call [cmd ::crimp] [method min] [arg image1] [arg image2]]
[keywords min]

This method combines the two input images into a result image by
taking the pixelwise minimum.


[call [cmd ::crimp] [method {montage horizontal}] [opt "[option -align] [const top]|[const center]|[const bottom]"] [opt "[option -border] [arg spec]"] [arg image]...]
[call [cmd ::crimp] [method {montage vertical}]   [opt "[option -align] [const left]|[const middle]|[const right]"] [opt "[option -border] [arg spec]"] [arg image]...]
[keywords montage]

The result of these methods is an image where the input images have
been placed adjacent to each from left to right (horizontal), or top
to bottom (vertical). The input images have to have the same type.

[para]
There is no need however for them to have the same height, or width,
respectively. When images of different height (width) are used the
command will expand them to their common height (width), which is the
maximum of all heights (widths). The expansion process is further
governed by the values of the [option -align] and [option -border]
options, with the latter specifying the form of the expansion (see
method [method expand] for details), and the first specifying how the
image is aligned within the expanded space.

[para]
The [arg spec] argument of [option -border] is a list containing the
name of the sub-method of [method expand] to use, plus any additional
arguments this method may need, except for the size of the expansion.

[para]
The default values for [option -align] are [const center] and
[const middle], centering the image in the space. The default for the
[option -border] is a black frame, i.e. "[arg spec] == {const 0}".


[call [cmd ::crimp] [method {morph dilate}] [arg image]]
[call [cmd ::crimp] [method {morph erode}] [arg image]]
[keywords morphology erosion dilation]

These two methods implement the basic set of morphology operations,
[term erosion], and [term dilation] using a flat 3x3 brick as their
structuring element. For grayscale, which we have here, these are,
mathematically, max and min rank-order filters, i.e.

[example {
    dilate = filter rank 1  0.00 (min)
    erode  = filter rank 1 99.99 (max)
}]


[call [cmd ::crimp] [method {morph close}] [arg image]]
[call [cmd ::crimp] [method {morph open}] [arg image]]
[keywords morphology opening closing]

These two methods add to the basic set of morphology operations,
[term opening] and [term closing]. In terms of erosion and dilation:

[example {
    close = erode o dilate 
    open  = dilate o erode
}]


[call [cmd ::crimp] [method {morph gradient}] [arg image]]
[keywords morphology gradient]

The morphological [term gradient] is defined as

[example {
    [dilate $image] - [erode $image]
}]

This can also be expressed as the sum of the external and internal
gradients, see below.


[call [cmd ::crimp] [method {morph igradient}] [arg image]]
[keywords morphology {internal gradient}]

The morphological [term {internal gradient}] is defined as

[example {
    $image - [erode image]
}]


[call [cmd ::crimp] [method {morph egradient}] [arg image]]
[keywords morphology {external gradient}]

The morphological [term {external gradient}] is defined as

[example {
    [dilate $image] - $image
}]


[call [cmd ::crimp] [method {morph tophatw}] [arg image]]
[keywords morphology tophat {white tophat}]

The [term {white tophat}] transformation is defined as

[example {
    $image - [open $image]
}]


[call [cmd ::crimp] [method {morph tophatb}] [arg image]]
[keywords morphology tophat {black tophat}]

The [term {black tophat}] transformation is defined as

[example {
    [close $image] - $image
}]


[call [cmd ::crimp] [method multiply] [arg image1] [arg image2]]

This method combines the two input images into a result image by
performing a pixelwise multiplication. Note that the result of each
multiplication is divided by [const 255] to scale it back into the
range [lb]0...255[rb].


[call [cmd ::crimp] [method psychedelia] [arg width] [arg height] [arg frames]]

This method creates an [const rgba] image of the specified dimensions
according to an algorithm devised by Andrew M. Goth. The [arg frames]
argument specifies how many images are in the series.

[para][emph Attention:] This method keeps internal global state,
ensuring that each call returns a slightly different image. Showing a
series of such images as animation provides an effect similar to a
lava lamp or hallucination.


[call [cmd ::crimp] [method {pyramid run}] [arg image] [arg steps] [arg stepcmd]]

This method provides the core functionality for the generation of image
pyramids. The command prefix [arg stepcmd] is run [arg steps] times,
first on the [arg image], then on the result of the previous step.

[para] The assumed signature of [arg stepcmd] is
[list_begin definitions]
[call [cmd <stepcmd>] [arg image]]

which is expected to return a list of two elements. The first element
([term result]) is added to the pyramid in building, whereas the second
element ([term iter]) is used in the next step as the input of the step
command.

[list_end]

[para] The final result of the method is a list containing the input
[arg image] as its first element, followed by the results of the step
function, followed by the [term iter] element returned by the last step,
"[arg steps]+2" images in total.

[para][image pyramid]


[call [cmd ::crimp] [method {pyramid gauss}] [arg image] [arg steps]]

This method generates a gaussian image pyramid [arg steps] levels deep and
returns it as a list of images.

[para] The first image in the result is the input, followed by [arg steps]
successively smaller images, each [method decimate]d by a factor two
compared to its predecessor, for a total length of "[arg steps]+1" images.

[para] The convolution part of the decimation uses

[example { 1/16 [1 4 6 4 1] }]

as its kernel.

[para][image pyramid_gauss]


[call [cmd ::crimp] [method {pyramid laplace}] [arg image] [arg steps]]

This method generates a laplacian image pyramid [arg steps] levels deep and
returns it as a list of images.

[para] The first image in the result is the input, followed by [arg steps]
band pass images (differences of gaussians). The first band pass has the same
size as the input image, and each successor is [method decimate]d by two. This
is followed by one more image, the gaussian of the last step. This image is
decimated by two compared to the preceding bandpass image. In total the result
contains "[arg steps]+2" images.

[para] The convolution part of the decimation uses

[example { 1/16 [1 4 6 4 1] }]

as its kernel. The internal interpolation used to generate the band pass
images (resynthesis) doubles the weights of this kernel for its convolution
step.

[para][image pyramid_laplace]


[call [cmd ::crimp] [method remap] [arg image] [arg map]...]
[keywords {pixel mapping} remapping]

[comment {one of three core -- remap-conditional, and recolor by 3x3 matrix}]

This method is the core primitive for the per-pixel transformation of
images, with each pixel (and channels within, if any) handled
independently of all others.

Applications of this operator provided by this package are (inverse)
gamma correction, pixel inversion, and solarization. Many more are
possible, especially when considering other colorspaces like
HSV. There, for example, it is possible change the saturation of
pixels, or shift the hue in arbitrary manner.

[para]

Beyond the input [arg image] to transform one or more [term maps] are
specified which define how each pixel value in the input is mapped to
a pixel value in the output. The command will accept at most that many
maps as the input image has channels.  If there are less maps than
channel the last map specified is replicated to cover the other
channels. An exception of this is the handling of the alpha channel,
should the input image have such. There a missing map is handle as
[fun identity], i.e. the channel copied as is, without changes.

[para]

The maps are not Tcl data structures, but images themselves.  They
have to be of type [const grey8], and be of dimension 256x1 (width by
height).

[para]

The [method {crimp map ...}] methods are sources for a number of
predefined maps, whereas the [method mapof] method allows the
construction of maps from Tcl data structures, namely lists of values.

[para] This method supports all image types with one or more
single-byte channels, i.e. all but [const grey16], [const grey32],
[const float], and [const bw].



[call [cmd ::crimp] [method screen] [arg image1] [arg image2]]

This method combines the two input images by inverting the
multiplication of the inverted input images. I.e.

[para][image screen][para]


[call [cmd ::crimp] [method solarize] [arg image] [arg threshold]]
[keywords solarization {sabattier effect}]

This method takes an image, runs it through the [fun solarize]
function with parameter [arg threshold], and returns the modified
image as it result. This is also known as the [term {sabattier effect}].

This is an application of method [method remap], using the mapping
returned by "[method {map solarize}] [arg threshold]".

This method supports all image types supported by the method
[method remap].

[call [cmd ::crimp] [method square] [arg image]]

This is a convenience method equivalent to
"[cmd {crimp multiply}] [arg image] [arg image]".


[call [cmd ::crimp] [method subtract] [arg image1] [arg image2] [opt [arg scale]] [opt [arg offset]]]

This method combines the two input images into a result image by
performing a pixelwise subtraction (image1 - image2) followed by
division through [arg scale] and addition of the [arg offset]. They
default to [const 1] and [const 0] respectively, if they are not
specified.


[call [cmd ::crimp] [method {threshold global above}] [arg image] [arg threshold]]
[keywords thresholding binarization]

This method takes an image, runs it through the [fun {threshold above}]
function with parameter [arg threshold], and returns the modified
image as it result. As the result only contains black and white,
i.e. 2 colors, this process is also called [term binarization] or
foreground/background segmentation.

This is an application of method [method remap], using the mapping
returned by "[method {map threshold above}] [arg threshold]".

This method supports all image types supported by the method
[method remap].


[call [cmd ::crimp] [method {threshold global below}] [arg image] [arg threshold]]
[keywords thresholding binarization]

This method takes an image, runs it through the [fun {threshold below}]
function with parameter [arg threshold], and returns the modified
image as it result. As the result only contains black and white,
i.e. 2 colors, this process is also called [term binarization], or
foreground/background segmentation.

This is an application of method [method remap], using the mapping
returned by "[method {map threshold below}] [arg threshold]".

This method supports all image types supported by the method
[method remap].


[call [cmd ::crimp] [method {threshold global inside}] [arg image] [arg min] [arg max]]
[keywords thresholding binarization]

This method takes an image, runs it through the [fun {threshold inside}]
function with parameters [arg min] and [arg max], and returns the
modified image as it result. As the result only contains black and
white, i.e. 2 colors, this process is also called [term binarization]
or foreground/background segmentation.

This is an application of method [method remap], using the mapping
returned by "[method {map threshold above}] [arg threshold]".

This method supports all image types supported by the method
[method remap].


[call [cmd ::crimp] [method {threshold global outside}] [arg image] [arg min] [arg max]]
[keywords thresholding binarization]

This method takes an image, runs it through the [fun {threshold outside}]
function with parameters [arg min] and [arg max], and returns the
modified image as it result. As the result only contains black and
white, i.e. 2 colors, this process is also called [term binarization],
or foreground/background segmentation.

This is an application of method [method remap], using the mapping
returned by "[method {map threshold below}] [arg threshold]".

This method supports all image types supported by the method
[method remap].


[call [cmd ::crimp] [method {threshold global middle}] [arg image]]
[call [cmd ::crimp] [method {threshold global mean}] [arg image]]
[call [cmd ::crimp] [method {threshold global median}] [arg image]]
[call [cmd ::crimp] [method {threshold global otsu}] [arg image]]
[keywords thresholding binarization]

These four methods are convenience methods layered on top of
[cmd {crimp threshold global below}]. They compute the value(s) to
perform the thresholding with from the global statistics of the input
image, with the element taken named by the method. For reference see
the documentation of method [cmd {crimp statistics ...}]. Note that
they treat each color channel in the image separately.


[call [cmd ::crimp] [method {threshold local}] [arg image] [arg threshold]...]
[keywords thresholding binarization]

This method takes an [arg image] and one or more [arg threshold] maps
and returns an image where all pixels of the input which were larger
or equal to the corresponding pixel in the map are set to black. All
other pixels are set to white. Each map is applied to one color
channel of the input image. If there are too many maps the remainder
is ignored. If there are not enough maps the last map is replicated.

[para] This is the core for all methods of non-global
[term binarization], i.e. foreground/background segmentation. Their
differences are just in the calculation of the maps.

[para] This method supports all image types with one or more
single-byte channels, i.e. all but [const grey16], [const grey32], and
[const bw].


[call [cmd ::crimp] [method {upsample xy}] [arg image] [arg factor]]
[call [cmd ::crimp] [method {upsample x}] [arg image] [arg factor]]
[call [cmd ::crimp] [method {upsample y}] [arg image] [arg factor]]

This method returns an image inserting [arg factor] black pixels between
each pixel of the input [arg image] (in x, y, or both dimensions). The effect is
that the input is expanded by [arg factor]. It is the complement of
method [method downsample].

[para] Using the method as is is not recommended because this simple upsampling
will cause copies of the image to appear at the higher image frequencies in the
expanded spectrum. This is normally avoided by running a low-pass filter over
the image after the upsampling, removing the problematic copies.

[para] The [method interpolate] method is a convenience method combining these
two steps into one.


[call [cmd ::crimp] [method wavy] [arg image] [arg offset] [arg adj1] [arg adjb]]

This method processes the input [arg image] according to an algorithm
devised by Andrew M. Goth, according to the three parameters
[arg offset], [arg adj1], and [arg adjb], and returns the modified
image as its result.

[para]

The operation supports only images of type [const rgba], and returns
images of the same type.


[call [cmd ::crimp] [method {flip horizontal}] [arg image]]
[call [cmd ::crimp] [method {flip transpose}] [arg image]]
[call [cmd ::crimp] [method {flip transverse}] [arg image]]
[call [cmd ::crimp] [method {flip vertical}] [arg image]]
[keywords flip transform warp geometry]

This set of methods performs mirroring along the horizontal, vertical
and diagonal axes of the input [arg image], returning the mirrored
image as their output.  Transpose mirrors along the main diagonal,
transverse along the secondary diagonal.  These two methods also
exchange width and height of the image in the output.

[para] The methods currently support the image types [const rgb],
[const rgba], [const hsv], and [const grey8].


[call [cmd ::crimp] [method resize] [opt "[option -interpolate] [const nneighbour]|[const bilinear]|[const bicubic]"] [arg image] [arg w] [arg h]]
[keywords resize transform warp geometry]

This method takes the input [arg image] and resizes it to the
specified width [arg w] and height [arg h].

In constrast to [method cut] this is not done by taking part of the
image in the specified size, but by scaling it up or down as
needed. In other words, this method is a degenerate case of a
projective transform as created by the [method transform] methods and
used by method [method {warp projective}] (see below).

[para] Like the aforementioned general method this method supports all
the possible interpolation types, i.e. nearest neighbour, bilinear,
and bicubic. By default [const bilinear] interpolation is used, as a
compromise between accuracy and speed.


[call [cmd ::crimp] [method {rotate cw}]  [arg image]]
[call [cmd ::crimp] [method {rotate ccw}] [arg image]]
[keywords rotation clockwise counter-clockwise transform warp geometry]

This set of methods rotates the image in steps of 90 degrees, either
clockwise and counter to it.

[call [cmd ::crimp] [method {rotate half}] [arg image]]
[keywords rotation clockwise counter-clockwise transform warp geometry]

This methods rotates the image a half-turn, i.e. 180 degrees.


[call [cmd ::crimp] [method {warp field}] [opt "[option -interpolate] [const nneighbour]|[const bilinear]|[const bicubic]"] [arg image] [arg xvec] [arg yvec]]
[keywords transform warp geometry vector-field]

This method takes an input image and two images the size of the
expected result which provide for each pixel in the result the
coordinates to sample in the input to determine the result's color.

[para] This allows the specification of any possible geometric
transformation and warping, going beyond even projective
transformations.

[para] The two images providing the coordinate information have to be
of the same size, which is also the size of the returned result. The
type of the result is however specified through the type of the input
image.

[para] The method supports all the possible interpolation types,
i.e. nearest neighbour, bilinear, and bicubic.
By default [const bilinear] interpolation is used, as a compromise
between accuracy and speed.


[call [cmd ::crimp] [method {warp projective}] [opt "[option -interpolate] [const nneighbour]|[const bilinear]|[const bicubic]"] [arg image] [arg transform]]
[keywords transform warp geometry projective perspective affine translate scale rotate rescale]

This method accepts a general projective [arg transform] as created by
the [method transform] methods, applies it to the input [arg image]
and returns the projected result.

[para] Like the [method resize] method above this method supports all
the possible interpolation types, i.e. nearest neighbour, bilinear,
and bicubic. By default [const bilinear] interpolation is used, as a
compromise between accuracy and speed.

[para] [emph Note] that the returned result image is made as large as
necessary to contain the whole of the projected input. Depending on
the transformation this means that parts of the result can be black,
coming from outside of the boundaries of the input. Further, the
origin point of the result may conceptually be inside or outside of
the result instead of at the top left corner, because of pixels in the
input getting projected to negative coordinates. To handle this
situation the result will contain the physical coordinates of the
conceptual origin point in its meta data, under the hierarchical key
[const {crimp origin}].

[list_end]


[subsection Converters]
[list_begin definitions]
[call [cmd ::crimp] [method {convert 2grey8}] [arg image]]
[call [cmd ::crimp] [method {convert 2hsv}] [arg image]]
[call [cmd ::crimp] [method {convert 2rgba}] [arg image]]
[call [cmd ::crimp] [method {convert 2rgb}] [arg image]]

This set of methods all convert their input [arg image] to the
specified type and returns it as their result. All converters accept
an image of the destination type as input and will pass it through
unchanged.

[para]

The converters returning a [const grey8] image support [const rgb] and
[const rgba] as their input, using the ITU-R 601-2 luma transform to
merge the three color channels

[para]

The converters to HSV support [const rgb] and [const rgba] as their
input as well.

[para]

The conversion to [const rgba] accepts only [const hsv] as input,
adding a blank (fully opaque) alpha channel. For more control over the
contents of an image's alpha channel see the methods [method setalpha]
and [method {join rgba}].

[para]

At last, the conversion to [const rgb] accepts both [const rgba] and
[const hsv] images as input.


[call [cmd ::crimp] [method {join 2hsv}] [arg hueImage] [arg satImage] [arg valImage]]
[call [cmd ::crimp] [method {join 2rgba}] [arg redImage] [arg greenImage] [arg blueImage] [arg alphaImage]]
[call [cmd ::crimp] [method {join 2rgb}] [arg redImage] [arg greenImage] [arg blueImage]]

This set of methods is the complement of method [method split]. Each
take a set of [const grey8] images and fuse them together into an
image of the given type, with each input image becoming one channel of
the fusing result, which is returned as the result of the command. All
input images have to have the same dimensions.


[call [cmd ::crimp] [method split] [arg image]]

This method takes an image of one of the multi-channel types, i.e.
[const rgb], const rgba], and [const hsv] and returns a list of
[const grey8] images, each of which contains the contents of one of
the channels found in the input image.

[para]

The channel images in the result are provided in the same order as
they are accepted by the complementary [method join] method, see
above.

[list_end]


[subsection {I/O commands}]
[list_begin definitions]
[call [cmd ::crimp] [method {read pgm}] [arg string]]

This method returns an image of type [const grey8] containing the data
of the portable grey map (PGM) stored in the [arg string]. The method
recognizes images in both plain and raw sub-formats.


[call [cmd ::crimp] [method {read ppm}] [arg string]]

This method returns an image of type [const rgb] containing the data
of the portable pix map (PPM) stored in the [arg string]. The method
recognizes images in both plain and raw sub-formats.


[call [cmd ::crimp] [method {read strimj}] [arg string] [opt [arg colormap]]]

This method returns an image of type [const rgba] containing the data
of the [term strimj] (string image) (See [uri http://wiki.tcl.tk/1846])
stored in the [arg string].

[para] The caller can override the standard mapping from pixel characters
to colors by specifying a [arg colormap]. This argument is interpreted as
dictionary mapping characters to triples of integers in the range
[lb]0...255[rb], specifying the red, green, and blue intensities.

[para] An example of a strimj is:
[example {
@...@.......@.@......
@...@.......@.@......
@...@..@@@..@.@..@@@.
@@@@@.@...@.@.@.@...@
@...@.@@@@@.@.@.@...@
@...@.@.....@.@.@...@
@...@.@...@.@.@.@...@
@...@..@@@..@.@..@@@.
}]


[call [cmd ::crimp] [method {read tcl grey8}] [arg pixelmatrix]]

This method takes the [arg pixelmatrix], a list of rows, with each row
a list of pixel values in the domain [lb]0..255[rb] and returns an
image of type [const grey8] whose height is the number of rows, i.e.
the length of the outer list, and whose width is the maximum length
found among the inner lists. Rows whose inner list is shorter than the
maximum length are padded with black pixels, i.e. a pixel value of
[const 255].


[call [cmd ::crimp] [method {read tcl float}] [arg pixelmatrix]]

This method takes the [arg pixelmatrix], a list of rows, with each row
a list of floating point values for pixel values and returns an image
of type [const float] whose height is the number of rows, i.e.  the
length of the outer list, and whose width is the maximum length found
among the inner lists. Rows whose inner list is shorter than the
maximum length are padded with a pixel value of [const 255].


[call [cmd ::crimp] [method {read tk}] [arg photo]]

This method returns an image of type [const rgba] containing the data
from the specified Tk [arg photo] image.


[call [cmd ::crimp] [method {write 2tk}] [arg photo] [arg image]]

This method writes the input [arg image] to the specified Tk
[arg photo] image.

[para] The method supports the writing of [const rgb], [const rgba],
and [const grey8] images.


[call [cmd ::crimp] [method {write 2string}] [arg format] [arg image]]
[call [cmd ::crimp] [method {write 2chan}]   [arg format] [arg chan] [arg image]]
[call [cmd ::crimp] [method {write 2file}]   [arg format] [arg path] [arg image]]

This family of methods either returns the input [arg image] as a
binary string in the specified [arg format], or writes this string to
the open channel [arg chan], or the named file at [arg path].

[para] The image types accepted for writing are [arg format]
dependent, and listed below, with the supported formats.

[para] The currently supported formats are
[list_begin definitions]
[def [const pgm-plain]]

The plain ASCII format of portable grey maps, as per
[uri http://en.wikipedia.org/wiki/Netpbm_format].

[para] The methods support the writing of [const rgb], [const rgba],
[const hsv], and [const grey8] images.

[def [const pgm-raw]]

The raw binary format of portable grey maps, as per
[uri http://en.wikipedia.org/wiki/Netpbm_format].

[para] The methods support the writing of [const rgb], [const rgba],
[const hsv], and [const grey8] images.

[def [const ppm-plain]]

The plain ASCII format of portable pix maps, as per
[uri http://en.wikipedia.org/wiki/Netpbm_format].

[para] The methods support the writing of [const rgb], [const rgba],
[const hsv], and [const grey8] images.

[def [const ppm-raw]]

The raw binary format of portable pix maps, as per
[uri http://en.wikipedia.org/wiki/Netpbm_format].

[para] The methods support the writing of [const rgb], [const rgba],
[const hsv], and [const grey8] images.

[list_end]
[list_end]


[subsection Support]
[list_begin definitions]

[call [cmd ::crimp] [method {gradient grey8}] [arg from] [arg to] [arg size]]
[call [cmd ::crimp] [method {gradient rgb}] [arg from] [arg to] [arg size]]
[call [cmd ::crimp] [method {gradient rgba}] [arg from] [arg to] [arg size]]
[call [cmd ::crimp] [method {gradient hsv}] [arg from] [arg to] [arg size]]

This set of methods takes two "color" (pixel value) arguments and
returns an image of height 1 and width [arg size] containing a
gradient interpolating between these two colors, with [arg from] in
the pixel at the left (x == 0) and [arg to] at the right
(x == [arg size]-1).

[para] [arg size] has to be greater than or equal to [const 2]. An
error is thrown if that restriction is not met.

[para] The resulting image has the type indicated in the method name.
This also specifies what is expected as the contents of the arguments
[arg from] and [arg to]. For [method grey8] these are simple pixel
values in the range 0...255 whereas for the types [method rgb] and
[method hsv] the arguments are triples (3-element lists) specifying
the R, G, and B (and H, S, and V respectively) values.


[call [cmd ::crimp] [method {kernel make}] [arg matrix] [opt [arg scale]] [opt [arg offset]]]

This method takes a [arg matrix] of weights and an optional
[arg scale] factor and returns a structure containing the associated
convolution kernel, ready for use by method [method {filter convolve}].

[para] If [arg scale] is left unspecified it defaults to the sum of
all weights in the matrix.

[para] If [arg offset] is left unspecified it defaults to 128 if the
sum of weights is 0, and 0 else. In effect zero-sum kernels, like the
basic edge-detectors, are shifted so that results in the range
-128..127 correspond to 0..255.

[para] The [arg matrix] has the same general format as the pixel
matrix for method [method {read tcl grey8}], i.e. a list of lists
(rows) of values, and is treated in the same way, i.e. the number of
columns is the maxium length over the row lists, and shorter lists are
padded with [const 128]. The values are expected to be integer numbers
in the range -128..127.


[call [cmd ::crimp] [method {kernel fpmake}] [arg matrix] [opt [arg offset]]]

This method is like [method {kernel make}] except that the generated
kernel is based on floating-point values. Because of this it is not
accpeting a scale argument either, it is expected that the kernel
weights already have the proper sum.

[para] The [arg matrix] has the same general format as the pixel
matrix for method [method {read tcl float}], i.e. a list of lists
(rows) of values, and is treated in the same way, i.e. the number of
columns is the maxium length over the row lists, and shorter lists are
padded with [const 255].  The values are expected to be floating-point
numbers.


[call [cmd ::crimp] [method {kernel transpose}] [arg kernel]]

This method takes a [arg kernel] as returned by the method
[method {kernel make}] and returns a transposed kernel, i.e. one where
the x- and y-axes are switched.

For example
[para][example {
                    (1)
                    (2)
    {1 2 4 2 1} ==> (4)
                    (2)
                    (1)
}][para]

This method is its own inverse, i.e. application to its result returns
the original input, i.e. [example {
    [transpose [transpose $K]] == $K
}]


[call [cmd ::crimp] [method map] [arg arg]...]

This method accepts the same sub-methods and arguments as are accepted
by the [method table] method below. In contrast to [method table] the
result is not a list of values, but a map image directly suitable as
argument to the [method remap] method.


[call [cmd ::crimp] [method mapof] [arg table]]

This method accepts a list of 256 values, constructs a map image
directly suitable as argument to the [method remap] method, and
returns this map image as its result.


[call [cmd ::crimp] [method {table compose}] [arg f] [arg g]]

This accepts two lookup tables (aka functions) specified as lists of
256 values, constructs the composite function f(g(x)), and then
returns this new function as its result.


[call [cmd ::crimp] [method {table eval wrap}]  [arg cmd]]
[call [cmd ::crimp] [method {table eval clamp}] [arg cmd]]

This method returns a list of 256 values, the result of running the
values 0 to 255 through the function specified by the command prefix
[arg cmd].

The results returned by the command prefix are rounded to the nearest
integer and then forced into the domain [lb]0..255[rb] by either
wrapping them around (modulo 256), or clamping them to the appropriate
border, i.e 0, and 255 respectively.

[para]

The signature of the command prefix is
[list_begin definitions]
[call [cmd <cmd>] [arg x]]

which is expected to return a number in the range
[lb]0..255[rb]. While the result should be an integer number it is
allowed to be a float, the caller takes care to round the result to
the nearest integer.

[list_end]


[call [cmd ::crimp] [method {table degamma}] [arg y]]

This method returns a list of 256 values, the result of running the
values 0 to 255 through the [fun {inverse gamma correction}] with
parameter [arg y].

This inverse correction, defined in the domain of [lb]0..1[rb] for
both argument and result, is defined as:

[para][image gamma_inv][para]

Scaling of argument and result into the domain [lb]0..255[rb] of pixel
values, and rounding results to the nearest integer, causes the actual
definition used to be

[para][image scaled_gamma_inv]


[call [cmd ::crimp] [method {table gamma}] [arg y]]

This method returns a list of 256 values, the result of running the
values 0 to 255 through the [fun {gamma correction}] with parameter
[arg y].

This correction, defined in the domain of [lb]0..1[rb] for both
argument and result, is defined as:

[para][image gamma][para]

Scaling of argument and result into the domain [lb]0..255[rb] of pixel
values, and rounding results to the nearest integer, causes the actual
definition used to be

[para][image scaled_gamma]


[call [cmd ::crimp] [method {table gauss}] [arg sigma]]

This method returns a list of 256 values, the result of running the
values 0 to 255 through the [fun {sampled gauss}] function with
parameter [arg sigma].

This function is defined as:

[para][image gauss][para]


[call [cmd ::crimp] [method {table identity}]]

This method returns a list of 256 values, the result of running the
values 0 to 255 through the [fun identity] function, which is defined
as

[para][image identity]


[call [cmd ::crimp] [method {table invers}]]

This method returns a list of 256 values, the result of running the
values 0 to 255 through the [fun inverse] function, which is defined
as

[para][image inverse]


[call [cmd ::crimp] [method {table linear wrap}]  [arg gain] [arg offset]]
[call [cmd ::crimp] [method {table linear clamp}] [arg gain] [arg offset]]

This method returns a list of 256 values, the result of running the
values 0 to 255 through a simple linear function with parameters

[arg gain] (the slope) and [arg offset]. The results are rounded to
the nearest integer and then forced into the domain [lb]0..255[rb] by
either wrapping them around (modulo 256), or clamping them to the
appropriate border, i.e 0, and 255 respectively.

Thus the relevant definitions are

[para][image linear_wrap]

for the wrapped case, and 

[para][image linear_clamp]

when clamping.


[call [cmd ::crimp] [method {table log}] [opt [arg max]]]
[keywords log-compression]

This method returns a list of 256 values, the result of running the
values 0 to 255 through the [fun {log-compression}] function with
parameter [arg max]. This parameter is the maximum pixel value the
function is for, this value, and all larger will be mapped to 255.

This function is defined as:

[para][image log][para]


[call [cmd ::crimp] [method {table solarize}] [arg threshold]]

This method returns a list of 256 values, the result of running the
values 0 to 255 through the [fun solarize] function, with parameter
[arg threshold]. This function is defined as:

[para][image solarize]
[para]

Note how the function is the [fun identity] for values under the
threshold, and the [fun inverse] for values at and above it. Its
application to an image produces what is known as either
[term solarization] or [term {sabattier effect}].


[call [cmd ::crimp] [method {table sqrt}] [opt [arg max]]]
[keywords sqrt-compression]

This method returns a list of 256 values, the result of running the
values 0 to 255 through the [fun {sqrt-compression}] function with
parameter [arg max]. This parameter is the maximum pixel value the
function is for, this value, and all larger will be mapped to 255.

This function is defined as:

[para][image sqrt][para]


[call [cmd ::crimp] [method {table stretch}] [arg min] [arg max]]

This is a convenience method around [method {table linear}] which maps
[arg min] to 0, and [arg max] to 255, with linear interpolation in
between. Values below [arg min] and above [arg max] are clamped to 0
and 255 respectively.


[call [cmd ::crimp] [method {table threshold above}] [arg threshold]]

This method returns a list of 256 values, the result of running the
values 0 to 255 through a [fun thresholding] (or [term binarization])
function, with parameter [arg threshold]. This function is defined as:

[para][image threshold-ge]
[para]


[call [cmd ::crimp] [method {table threshold below}] [arg threshold]]

This method returns a list of 256 values, the result of running the
values 0 to 255 through a [fun thresholding] (or [term binarization])
function, with parameter [arg threshold]. This function is defined as:

[para][image threshold-le]
[para]


[call [cmd ::crimp] [method {table threshold inside}] [arg min] [arg max]]

This method returns a list of 256 values, the result of running the
values 0 to 255 through a [fun thresholding] (or [term binarization])
function, with parameters [arg min] and [arg max]. This function is
defined as:

[para][image threshold-inside]
[para]


[call [cmd ::crimp] [method {table threshold outside}] [arg min] [arg max]]

This method returns a list of 256 values, the result of running the
values 0 to 255 through a [fun thresholding] (or [term binarization])
function, with parameters [arg min] and [arg max]. This function is
defined as:

[para][image threshold-outside]
[para]


[call [cmd ::crimp] [method {table fgauss discrete}] [arg sigma] [opt [arg r]]]
[call [cmd ::crimp] [method {table fgauss sampled}] [arg sigma] [opt [arg r]]]

This method computes the table for a discrete or sampled gaussian with
parameters [arg sigma] and kernel [arg r]adius. If the radius is not
specified it defaults to the smallest integer greater than
"3*[arg sigma]".


[call [cmd ::crimp] [method {transform affine}] [arg a] [arg b] [arg c] [arg d] [arg e] [arg f]]

This method returns the affine transformation specified by the 2x3
matrix

[example {
    |a b c|
    |d e f|
}]

Note that it is in general easier to use the methods [method rotate],
[method scale], and [method translate] [method scale] to generate the
desired transformation piecemal and then use [method chain] to chain the
pieces together.

[call [cmd ::crimp] [method {transform chain}] [arg transform]...]

This method computes and returns the projective transformation
generated by applying the specified transformations in reverse order,
i.e with the transformation at the end of the argument list applied
first, then the one before it, etc.

[call [cmd ::crimp] [method {transform invert}] [arg transform]]

This method computes and returns the inverse of the specified
projective [arg transform]ation.

[call [cmd ::crimp] [method {transform projective}]  [arg a] [arg b] [arg c] [arg d] [arg e] [arg f] [arg g] [arg h]]

This method returns the projective transformation specified by the 3x3
matrix

[example {
    |a b c|
    |d e f|
    |g h 1|
}]

Note that for the affine subset of projective transformation it is in
general easier to use the methods [method rotate], [method scale], and
[method translate] [method scale] to generate the desired
transformation piecemal and then use [method chain] to chain the pieces
together.

[para] And for a true perspective transformation specification through
[method quadrilateral] should be simpler as well.

[call [cmd ::crimp] [method {transform quadrilateral}] [arg src] [arg dst]]

This method returns the projective transformation which maps the
quadrilateral [arg src] on to the quadrilateral [arg dst].

[para] Each quadrilateral is specified as a list of 4 points, each
point a pair of x- and y-coordinates.

[call [cmd ::crimp] [method {transform rotate}] [arg theta] [opt [arg center]]]

This methods returns the projective transformation which rotates the
image by the anglie [arg theta] around the point [arg center]. If the
latter is not specified {0 0} is assumed. The point, if present, is
specified as pair of x- and y-coordinates.

[para] The angle is specified in degrees, with [const 0] not rotating
the image at all. Positive values cause a counterclockwise rotation,
negative values a clockwise one.

[call [cmd ::crimp] [method {transform scale}] [arg sx] [arg sy]]

This methods returns the projective transformation which scales an
image by factor [arg sx] in width, and [arg sy] in height. Values
larger than [const 1] expand the image along the specified dimension,
while values less than [const 1] shrink it. Negative values flip the
respective axis.

[call [cmd ::crimp] [method {transform translate}] [arg dx] [arg dy]]

This methods returns the projective transformation which translates an
image by [arg dx] pixels along the x-axis, and [arg dx] pixels along
the y-axis. Values larger than [const 0] move the image to the right,
or down, along the specified dimension, while values less than
[const 0] move it to the left, or up.

[list_end]


[section References]
[list_begin enumerated]

[enum] Simon Perreault and Patrick Hebert, "Median Filtering in Constant Time", 2007
       [uri http://nomis80.org/ctmf.html]

[enum] Nobuyuki Otsu, "A threshold selection method from gray-level histograms", 1979
       [uri http://en.wikipedia.org/wiki/Otsu%27s_method]

[list_end]

[keywords photo image]
[manpage_end]







Added doc/figures/border.dia.


































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# -*- tcl -*- tcl.tk//DSL diagram//EN//1.0

set boxheight [1 cm]
set boxwidth  [1 cm]

# center = image
box width [3 cm] height [2 cm] fillcolor grey text image

# corner (diagonal) quadrants
box with se at [1st box nw] text nw
box with sw at [1st box ne] text ne
box with nw at [1st box se] text se
box with ne at [1st box sw] text sw

# lines to close the horizontal/vertical quadrants 
line from [2nd box ne] to [3rd box nw]
line from [3rd box se] to [4th box ne]
line from [4th box sw] to [5th box se]
line from [5th box nw] to [2nd box sw]

# annotations
arrow <-> from [[2nd box nw] by 15 north] to [[2nd box ne] by 15 north] "ww"  above
arrow <-> from [[3rd box nw] by 15 north] to [[3rd box ne] by 15 north] "we"  above
arrow <-> from [[2nd box nw] by 15 west]  to [[2nd box sw] by 15 west]  "hn " rjust
arrow <-> from [[5th box nw] by 15 west]  to [[5th box sw] by 15 west]  "hs " rjust

#arrow <-> from [[1st line start] by 10 north] to [[1st line end] by 10 north] text "width" above
#arrow <-> from [[4th line start] by 10 west] to [[4th line end] by 10 west] text "height " rjust






Added doc/figures/border.png.



cannot compute difference between binary files


Added doc/figures/border.txt.






















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

   |< ww >|           |< we >|

-  +------+-----------+------+
^  |      |           |      |
hn |      |           |      |
V  |      |           |      |
-  +------+-----------+------+
   |      |           |      |
   |      |           |      |
   |      |           |      |
   |      |           |      |
-  +------+-----------+------+
^  |      |           |      |
hs |      |           |      |
V  |      |           |      |
-  +------+-----------+------+






Added doc/figures/math/atan2.png.



cannot compute difference between binary files


Added doc/figures/math/atan2.txt.







1

+

atan2 (x,y) = atan(\frac{x}{y})






Added doc/figures/math/blend.png.



cannot compute difference between binary files


Added doc/figures/math/blend.txt.







1

+

Z = F\alpha + B(1-\alpha)






Added doc/figures/math/blend_alt.png.



cannot compute difference between binary files


Added doc/figures/math/blend_alt.txt.







1

+

Z = (F - B)\alpha + B






Added doc/figures/math/gamma.png.



cannot compute difference between binary files


Added doc/figures/math/gamma.txt.







1

+

gamma_y (x) = x^y






Added doc/figures/math/gamma_inv.png.



cannot compute difference between binary files


Added doc/figures/math/gamma_inv.txt.







1

+

gamma^{-1}_y (x) = x^{\frac{1}{y}}






Added doc/figures/math/gauss.png.



cannot compute difference between binary files


Added doc/figures/math/gauss.txt.







1

+

gauss_\sigma (x) = [255 e^{-\frac{x-127.5}{2\sigma^2}}]






Added doc/figures/math/hypot.png.



cannot compute difference between binary files


Added doc/figures/math/hypot.txt.







1

+

hypot (x,y) = \sqrt{x^2 + y^2}






Added doc/figures/math/identity.png.



cannot compute difference between binary files


Added doc/figures/math/identity.txt.







1

+

identity (x) = x






Added doc/figures/math/inverse.png.



cannot compute difference between binary files


Added doc/figures/math/inverse.txt.







1

+

inverse (x) = 255 - x






Added doc/figures/math/linear_clamp.png.



cannot compute difference between binary files


Added doc/figures/math/linear_clamp.txt.







1

+

linear^{clamp}_{gain,offset} (x) = min (0, max (255, [ gain x + offset ]))






Added doc/figures/math/linear_wrap.png.



cannot compute difference between binary files


Added doc/figures/math/linear_wrap.txt.







1

+

linear^{wrap}_{gain,offset} (x) = [ gain x + offset ] \oplus_{256} 0






Added doc/figures/math/log.png.



cannot compute difference between binary files


Added doc/figures/math/log.txt.







1

+

logcompress_{max} (x) = max(255, \frac{255}{ln(1+max)} ln(1+x))






Added doc/figures/math/scaled_gamma.png.



cannot compute difference between binary files


Added doc/figures/math/scaled_gamma.txt.







1

+

gamma_y (x) = [ 255 (\frac{x}{255})^y ]






Added doc/figures/math/scaled_gamma_inv.png.



cannot compute difference between binary files


Added doc/figures/math/scaled_gamma_inv.txt.







1

+

gamma^{-1}_y (x) = [ 255 (\frac{x}{255})^{\frac{1}{y}} ]






Added doc/figures/math/screen.png.



cannot compute difference between binary files


Added doc/figures/math/screen.txt.







1

+

Z = 1-((1-A)(1-B)) = invert (multiply (invert (A), invert (B)))






Added doc/figures/math/solarize.png.



cannot compute difference between binary files


Added doc/figures/math/solarize.txt.










1
2
3
4

+
+
+
+

solarize_{threshold} (x) = \left\{\begin{eqnarray}
x       & x < threshold \\
255 - x & x \ge threshold \\
\end{eqnarray}\right






Added doc/figures/math/sqrt.png.



cannot compute difference between binary files


Added doc/figures/math/sqrt.txt.







1

+

sqrtcompress_{max} (x) = max(255, \frac{255}{\sqrt{max}} \sqrt{x})






Added doc/figures/math/threshold-ge.png.



cannot compute difference between binary files


Added doc/figures/math/threshold-ge.txt.












1
2
3
4
5
6

+
+
+
+
+
+

f_{threshold} (x) = \left\{\begin{eqnarray}
0   & x \ge threshold \\
255 & x < threshold \\
\end{eqnarray}\right








Added doc/figures/math/threshold-inside.png.



cannot compute difference between binary files


Added doc/figures/math/threshold-inside.txt.













1
2
3
4
5
6
7

+
+
+
+
+
+
+

f_{min,max} (x) = \left\{\begin{eqnarray}
255 & x \le min \\
0   & min < x < max \\
255 & max \le x \\
\end{eqnarray}\right








Added doc/figures/math/threshold-le.png.



cannot compute difference between binary files


Added doc/figures/math/threshold-le.txt.












1
2
3
4
5
6

+
+
+
+
+
+

f_{threshold} (x) = \left\{\begin{eqnarray}
0   & x < threshold \\
255 & x \ge threshold \\
\end{eqnarray}\right








Added doc/figures/math/threshold-outside.png.



cannot compute difference between binary files


Added doc/figures/math/threshold-outside.txt.













1
2
3
4
5
6
7

+
+
+
+
+
+
+

f_{min,max} (x) = \left\{\begin{eqnarray}
0   & x \le min \\
255 & min < x < max \\
0   & max \le x \\
\end{eqnarray}\right








Added doc/figures/objtype.dia.

























































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# -*- tcl -*- tcl.tk//DSL diagram//EN//1.0

proc gap {} { move east 15 }

proc harrow {args} {
    variable movelength
    block {
	set movelength [expr {$movelength / 2.5}]
	arrow
    } {*}$args
}

proc tbox {text args} {
    set b [box {*}$args]
    group { text with w at [last box w] $text }
    return $b
}


set boxheight [7 mm]

text "set image   \{"
gap
box  crimp::image::<type> width [45 mm]
gap
box  <w> width [10 mm]
gap
box  <h> width [10 mm]
gap
box  <meta> width [20 mm]
gap
box  <pixeldata> width [25 mm]
gap
text "\}"

south
arrow from [1st box s] s ; south ; text String
harrow dashed color red
circle "Type DB"
harrow dashed color red
set IT [block {
    set boxwidth [50 mm]
            tbox " size      = \#bytes/pixel"
    set nC [tbox " channels  = \#channels"]
            tbox " cname\[\] = channel names"
}]

arrow from [2nd box s] ; set WT [text Integer]
arrow from [3rd box s] ; set HT [text Integer]
arrow from [4th box s] ; text Dictionary
arrow from [5th box s] ; text ByteArray
harrow dashed color red ; move south [5 mm]
block {
    box wid [4 cm] ht [4 cm]
    box wid [4 mm] ht [4 mm] with nw at [last box nw] color blue

    #arrow from [last box e] east
    #arrow from [last box s] south

    set WD [arrow <-> from [[2nd last box nw] by 15 north] to [[2nd last box ne] by 15 north] "<w>"  above]
    set HD [arrow <-> from [[2nd last box nw] by 15 west]  to [[2nd last box sw] by 15 west]  "<h> " rjust]

    arrow <-> dashed from [last box se] se
    group {
	south
	box wid [4 mm] ht [4 mm]
	text .. ; group { east ; text "  #channels" }
	box wid [4 mm] ht [4 mm]

	set nw [2nd last box nw]
	set se [last box se]
	set cw [expr { 2 + [lindex $se 1 0] - [lindex $nw 1 0] }]
	set ch [expr { 2 + [lindex $se 1 1] - [lindex $nw 1 1] }]

	box with nw at [$nw - [1 1]] wid $cw ht $ch
    }
}
arrow dashed color red from [$WT s] to [[last block WD] start]
arrow dashed color red from [$HT s] to [[last block HD] start]
arrow dashed color red from [0.75 between [[$IT nC] se] [[$IT nC] ne]] \
    east [expr {$movelength * 2.1}]

return






Added doc/figures/objtype.png.



cannot compute difference between binary files


Added doc/figures/organization.dia.









































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# -*- tcl -*- tcl.tk//DSL diagram//EN//1.0

set boxheight [1 cm]

proc tbox {args} {box fillcolor lightblue {*}$args }
proc cbox {args} {box fillcolor orange    {*}$args }

proc top {args} {
    {*}$args \
	with sw at [last nw] \
	width [expr {[lindex [last ne] 1 0] -  [lindex [last nw] 1 0]}]
}

proc bottom {ref args} {
    {*}$args \
	with nw at [$ref sw] \
	width [expr {[lindex [$ref se] 1 0] -  [lindex [$ref sw] 1 0]}]
}

proc right {ref args} {
    {*}$args \
	with nw at [$ref ne] \
	height [expr {[lindex [$ref se] 1 1] -  [lindex [$ref ne] 1 1]}]
}

proc left {ref args} {
    {*}$args \
	with ne at [$ref nw] \
	height [expr {[lindex [$ref sw] 1 1] -  [lindex [$ref nw] 1 1]}]
}

block {
    block {
	set ::I [block {
	    block {
		set ::R [box text Read]
		set ::W [box text Write]
	    }
	    top box text I/O
	}]
	left last box text CRIMP
	set ::C [right $::I box text Convert]
	block {
	    block {
		set ::G [box text Geometry]
		set ::P [box text Color]
	    }
	    top box text Manipulators
	}
	set ::A [right last box text Access]
	set ::S [right last box text Support]
    }
    
}

set ::T [bottom $::R tbox]
set ::X [bottom last cbox]

bottom $::W tbox ; bottom last cbox
bottom $::C tbox ; bottom last cbox
bottom $::G tbox ; bottom last cbox
bottom $::P tbox ; bottom last cbox
bottom $::A tbox ; bottom last cbox
bottom $::S tbox ; bottom last cbox

left $::T tbox Tcl
left $::X cbox C






Added doc/figures/organization.png.



cannot compute difference between binary files


Added doc/figures/organization.txt.























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+-----------------------+-----+---+
| CRIMP                 | Tcl | C |
+-----------------------+-----+---+
| I/O          Read     |     |   |
|             ----------+-----+---+
|              Write    |     |   |
+-----------------------+-----+---+
| Converters            |     |   |
+-----------------------+-----+---+
| Manipulators Geometry |     |   |
|             ----------+-----+---+
|              Color    |     |   |
+-----------------------+-----+---+
| Accessors             |     |   |
+-----------------------+-----+---+
| Support               |     |   |
+-----------------------+-----+---+






Added doc/figures/pyramid.dia.






































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# -*- tcl -*- tcl.tk//DSL diagram//EN//1.0

set boxwidth [25 mm]
set boxheight [1 cm]
set movelength [5 mm]

proc result {n} {
    box fillcolor grey text "R($n)"
}
proc iter {n} {
    box text "I($n)"
}
proc output {n} {
    group { south ; arrow ; result $n }
}
proc stepfun {} {
    ellipse "stepcmd"
}

box "image" ; output 0
arrow
stepfun ; output 1
arrow
iter 1
move
text text ...
move
iter steps-1
arrow
stepfun ; output steps
arrow
iter steps ; output steps+1






Added doc/figures/pyramid.png.



cannot compute difference between binary files


Added doc/figures/pyramid_gauss.dia.





































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# -*- tcl -*- tcl.tk//DSL diagram//EN//1.0

set boxwidth [25 mm]
set boxheight [1 cm]
set movelength [5 mm]

proc result {n} {
    box fillcolor grey text "R($n)"
}
proc output {n} {
    group { south ; arrow ; result $n }
}
proc stepfun {} {
    ellipse "\u21932" width [1 cm]
}

box "image" 
arrow
result 0
arrow
stepfun
arrow
result 1
move
text text ...
move
result steps-1
arrow
stepfun
arrow
result steps






Added doc/figures/pyramid_gauss.png.



cannot compute difference between binary files


Added doc/figures/pyramid_laplace.dia.




























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# -*- tcl -*- tcl.tk//DSL diagram//EN//1.0

set boxwidth [25 mm]
set boxheight [1 cm]
set movelength [5 mm]

proc result {n} {
    box fillcolor grey text "R($n)"
}
proc iter {n} {
    box text "I($n)"
}
proc output {n} {
    group { south ; arrow ; result $n }
}
proc stepfun {} {
    block {
	east ; set W [line] ; line ; line ; ellipse "\u21932" width [1 cm] ; line ; set E [line]

	south ; line from [$E start] ; line ; line

	west ; arrow
	ellipse "\u21912" width [1 cm]
	arrow
	ellipse text "\u2296" width [1 cm] ;#color ""
	group {
	    north
	    arrow <-
	    line
	    circle radius 2 with center fillcolor black
	}
	group { south ; set S [line] }

	circle radius 2 at [$E start] with center fillcolor black

	set west  [$W start]
	set east  [$E end]
	set south [$S end]
    }
}

box "image" ; output 0
arrow
stepfun ; output 1
arrow
iter 1
move
text text ...
move
iter steps-1
arrow
stepfun ; output steps
arrow
iter steps ; output steps+1






Added doc/figures/pyramid_laplace.png.



cannot compute difference between binary files


Added embedded/man/files/crimp.n.




























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































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
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

'\"
'\" Generated from file '/home/aku/Projects/Tcl/Crimp/dev/embedded/man/files/crimp.n' by tcllib/doctools with format 'nroff'
'\" Copyright (c) 2010 Andreas Kupries
'\" Copyright (c) 2010 Documentation, Andreas Kupries
'\"
'\" The definitions below are for supplemental macros used in Tcl/Tk
'\" manual entries.
'\"
'\" .AP type name in/out ?indent?
'\"	Start paragraph describing an argument to a library procedure.
'\"	type is type of argument (int, etc.), in/out is either "in", "out",
'\"	or "in/out" to describe whether procedure reads or modifies arg,
'\"	and indent is equivalent to second arg of .IP (shouldn't ever be
'\"	needed;  use .AS below instead)
'\"
'\" .AS ?type? ?name?
'\"	Give maximum sizes of arguments for setting tab stops.  Type and
'\"	name are examples of largest possible arguments that will be passed
'\"	to .AP later.  If args are omitted, default tab stops are used.
'\"
'\" .BS
'\"	Start box enclosure.  From here until next .BE, everything will be
'\"	enclosed in one large box.
'\"
'\" .BE
'\"	End of box enclosure.
'\"
'\" .CS
'\"	Begin code excerpt.
'\"
'\" .CE
'\"	End code excerpt.
'\"
'\" .VS ?version? ?br?
'\"	Begin vertical sidebar, for use in marking newly-changed parts
'\"	of man pages.  The first argument is ignored and used for recording
'\"	the version when the .VS was added, so that the sidebars can be
'\"	found and removed when they reach a certain age.  If another argument
'\"	is present, then a line break is forced before starting the sidebar.
'\"
'\" .VE
'\"	End of vertical sidebar.
'\"
'\" .DS
'\"	Begin an indented unfilled display.
'\"
'\" .DE
'\"	End of indented unfilled display.
'\"
'\" .SO
'\"	Start of list of standard options for a Tk widget.  The
'\"	options follow on successive lines, in four columns separated
'\"	by tabs.
'\"
'\" .SE
'\"	End of list of standard options for a Tk widget.
'\"
'\" .OP cmdName dbName dbClass
'\"	Start of description of a specific option.  cmdName gives the
'\"	option's name as specified in the class command, dbName gives
'\"	the option's name in the option database, and dbClass gives
'\"	the option's class in the option database.
'\"
'\" .UL arg1 arg2
'\"	Print arg1 underlined, then print arg2 normally.
'\"
'\" RCS: @(#) $Id: man.macros,v 1.1 2009/01/30 04:56:47 andreas_kupries Exp $
'\"
'\"	# Set up traps and other miscellaneous stuff for Tcl/Tk man pages.
.if t .wh -1.3i ^B
.nr ^l \n(.l
.ad b
'\"	# Start an argument description
.de AP
.ie !"\\$4"" .TP \\$4
.el \{\
.   ie !"\\$2"" .TP \\n()Cu
.   el          .TP 15
.\}
.ta \\n()Au \\n()Bu
.ie !"\\$3"" \{\
\&\\$1	\\fI\\$2\\fP	(\\$3)
.\".b
.\}
.el \{\
.br
.ie !"\\$2"" \{\
\&\\$1	\\fI\\$2\\fP
.\}
.el \{\
\&\\fI\\$1\\fP
.\}
.\}
..
'\"	# define tabbing values for .AP
.de AS
.nr )A 10n
.if !"\\$1"" .nr )A \\w'\\$1'u+3n
.nr )B \\n()Au+15n
.\"
.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n
.nr )C \\n()Bu+\\w'(in/out)'u+2n
..
.AS Tcl_Interp Tcl_CreateInterp in/out
'\"	# BS - start boxed text
'\"	# ^y = starting y location
'\"	# ^b = 1
.de BS
.br
.mk ^y
.nr ^b 1u
.if n .nf
.if n .ti 0
.if n \l'\\n(.lu\(ul'
.if n .fi
..
'\"	# BE - end boxed text (draw box now)
.de BE
.nf
.ti 0
.mk ^t
.ie n \l'\\n(^lu\(ul'
.el \{\
.\"	Draw four-sided box normally, but don't draw top of
.\"	box if the box started on an earlier page.
.ie !\\n(^b-1 \{\
\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
.\}
.el \}\
\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
.\}
.\}
.fi
.br
.nr ^b 0
..
'\"	# VS - start vertical sidebar
'\"	# ^Y = starting y location
'\"	# ^v = 1 (for troff;  for nroff this doesn't matter)
.de VS
.if !"\\$2"" .br
.mk ^Y
.ie n 'mc \s12\(br\s0
.el .nr ^v 1u
..
'\"	# VE - end of vertical sidebar
.de VE
.ie n 'mc
.el \{\
.ev 2
.nf
.ti 0
.mk ^t
\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n'
.sp -1
.fi
.ev
.\}
.nr ^v 0
..
'\"	# Special macro to handle page bottom:  finish off current
'\"	# box/sidebar if in box/sidebar mode, then invoked standard
'\"	# page bottom macro.
.de ^B
.ev 2
'ti 0
'nf
.mk ^t
.if \\n(^b \{\
.\"	Draw three-sided box if this is the box's first page,
.\"	draw two sides but no top otherwise.
.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
.\}
.if \\n(^v \{\
.nr ^x \\n(^tu+1v-\\n(^Yu
\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c
.\}
.bp
'fi
.ev
.if \\n(^b \{\
.mk ^y
.nr ^b 2
.\}
.if \\n(^v \{\
.mk ^Y
.\}
..
'\"	# DS - begin display
.de DS
.RS
.nf
.sp
..
'\"	# DE - end display
.de DE
.fi
.RE
.sp
..
'\"	# SO - start of list of standard options
.de SO
.SH "STANDARD OPTIONS"
.LP
.nf
.ta 4c 8c 12c
.ft B
..
'\"	# SE - end of list of standard options
.de SE
.fi
.ft R
.LP
See the \\fBoptions\\fR manual entry for details on the standard options.
..
'\"	# OP - start of full description for a single option
.de OP
.LP
.nf
.ta 4c
Command-Line Name:	\\fB\\$1\\fR
Database Name:	\\fB\\$2\\fR
Database Class:	\\fB\\$3\\fR
.fi
.IP
..
'\"	# CS - begin code excerpt
.de CS
.RS
.nf
.ta .25i .5i .75i 1i
..
'\"	# CE - end code excerpt
.de CE
.fi
.RE
..
.de UL
\\$1\l'|0\(ul'\\$2
..
.TH "crimp" n 1.0.1 doc "Image Manipulation"
.BS
.SH NAME
crimp \- Image Manipulation (not yet independent of Tk)
.SH SYNOPSIS
package require \fBTcl  8.5\fR
.sp
package require \fBTk  8.5\fR
.sp
package require \fBcrimp  ?0?\fR
.sp
\fB::crimp\fR \fBchannels\fR \fIimage\fR
.sp
\fB::crimp\fR \fBdimensions\fR \fIimage\fR
.sp
\fB::crimp\fR \fBheight\fR \fIimage\fR
.sp
\fB::crimp\fR \fBhistogram\fR \fIimage\fR
.sp
\fB::crimp\fR \fBmeta append\fR \fIimage\fR \fIkey\fR ?\fIstring\fR...?
.sp
\fB::crimp\fR \fBmeta create\fR \fIimage\fR ?\fIkey\fR \fIvalue\fR...?
.sp
\fB::crimp\fR \fBmeta exists\fR \fIimage\fR \fIkey\fR ?\fIkey\fR...?
.sp
\fB::crimp\fR \fBmeta filter\fR \fIimage\fR \fIargs\fR...
.sp
\fB::crimp\fR \fBmeta for\fR \fIimage\fR {\fIkeyVar\fR \fIvalueVar\fR} \fIbody\fR
.sp
\fB::crimp\fR \fBmeta get\fR \fIimage\fR ?\fIkey\fR...?
.sp
\fB::crimp\fR \fBmeta incr\fR \fIimage\fR \fIkey\fR ?\fIincrement\fR?
.sp
\fB::crimp\fR \fBmeta info\fR \fIimage\fR
.sp
\fB::crimp\fR \fBmeta keys\fR \fIimage\fR ?\fIglobPattern\fR?
.sp
\fB::crimp\fR \fBmeta lappend\fR \fIimage\fR \fIkey\fR ?\fIvalue\fR...?
.sp
\fB::crimp\fR \fBmeta merge\fR \fIimage\fR ?\fIdictionaryValue\fR...?
.sp
\fB::crimp\fR \fBmeta remove\fR \fIimage\fR ?\fIkey\fR...?
.sp
\fB::crimp\fR \fBmeta replace\fR \fIimage\fR ?\fIkey\fR \fIvalue\fR...?
.sp
\fB::crimp\fR \fBmeta set\fR \fIimage\fR \fIkey\fR ?\fIkey\fR...? \fIvalue\fR
.sp
\fB::crimp\fR \fBmeta size\fR \fIimage\fR
.sp
\fB::crimp\fR \fBmeta unset\fR \fIimage\fR \fIkey\fR ?\fIkey\fR...?
.sp
\fB::crimp\fR \fBmeta values\fR \fIimage\fR ?\fIglobPattern\fR?
.sp
\fB::crimp\fR \fBpixel\fR \fIimage\fR
.sp
\fB::crimp\fR \fBstatistics basic\fR \fIimage\fR
.sp
\fB::crimp\fR \fBstatistics otsu\fR \fIstats\fR
.sp
\fB::crimp\fR \fBtype\fR \fIimage\fR
.sp
\fB::crimp\fR \fBwidth\fR \fIimage\fR
.sp
\fB::crimp\fR \fBadd\fR \fIimage1\fR \fIimage2\fR ?\fIscale\fR? ?\fIoffset\fR?
.sp
\fB::crimp\fR \fBalpha blend\fR \fIforeground\fR \fIbackground\fR \fIalpha\fR
.sp
\fB::crimp\fR \fBalpha set\fR \fIimage\fR \fImask\fR
.sp
\fB::crimp\fR \fBalpha opaque\fR \fIimage\fR
.sp
\fB::crimp\fR \fBalpha over\fR \fIforeground\fR \fIbackground\fR
.sp
\fB::crimp\fR \fBatan2\fR \fIimage1\fR \fIimage2\fR
.sp
\fB::crimp\fR \fBblank\fR \fItype\fR \fIwidth\fR \fIheight\fR \fIvalue\fR...
.sp
\fB::crimp\fR \fBcrop\fR \fIimage\fR \fIww\fR \fIhn\fR \fIwe\fR \fIhs\fR
.sp
\fB::crimp\fR \fBcut\fR \fIimage\fR \fIx\fR \fIy\fR \fIw\fR \fIh\fR
.sp
\fB::crimp\fR \fBdecimate xy\fR \fIimage\fR \fIfactor\fR \fIkernel\fR
.sp
\fB::crimp\fR \fBdecimate x\fR \fIimage\fR \fIfactor\fR \fIkernel\fR
.sp
\fB::crimp\fR \fBdecimate y\fR \fIimage\fR \fIfactor\fR \fIkernel\fR
.sp
\fB::crimp\fR \fBdegamma\fR \fIimage\fR \fIy\fR
.sp
\fB::crimp\fR \fBdifference\fR \fIimage1\fR \fIimage2\fR
.sp
\fB::crimp\fR \fBdownsample xy\fR \fIimage\fR \fIfactor\fR
.sp
\fB::crimp\fR \fBdownsample x\fR \fIimage\fR \fIfactor\fR
.sp
\fB::crimp\fR \fBdownsample y\fR \fIimage\fR \fIfactor\fR
.sp
\fB::crimp\fR \fBeffect charcoal\fR \fIimage\fR
.sp
\fB::crimp\fR \fBeffect emboss\fR \fIimage\fR
.sp
\fB::crimp\fR \fBeffect sharpen\fR \fIimage\fR
.sp
\fB::crimp\fR \fBexpand const\fR \fIimage\fR \fIww\fR \fIhn\fR \fIwe\fR \fIhs\fR ?\fIvalue\fR...?
.sp
\fB::crimp\fR \fBexpand extend\fR \fIimage\fR \fIww\fR \fIhn\fR \fIwe\fR \fIhs\fR
.sp
\fB::crimp\fR \fBexpand mirror\fR \fIimage\fR \fIww\fR \fIhn\fR \fIwe\fR \fIhs\fR
.sp
\fB::crimp\fR \fBexpand replicate\fR \fIimage\fR \fIww\fR \fIhn\fR \fIwe\fR \fIhs\fR
.sp
\fB::crimp\fR \fBexpand wrap\fR \fIimage\fR \fIww\fR \fIhn\fR \fIwe\fR \fIhs\fR
.sp
\fB::crimp\fR \fBfft forward\fR \fIimage\fR
.sp
\fB::crimp\fR \fBfft backward\fR \fIimage\fR
.sp
\fB::crimp\fR \fBfilter ahe\fR \fIimage\fR ?\fB-border\fR \fIspec\fR? ?\fIradius\fR?
.sp
\fB::crimp\fR \fBfilter convolve\fR \fIimage\fR ?\fB-border\fR \fIspec\fR? \fIkernel\fR...
.sp
\fB::crimp\fR \fBfilter gauss discrete\fR \fIimage\fR \fIsigma\fR ?\fIr\fR?
.sp
\fB::crimp\fR \fBfilter gauss sampled\fR \fIimage\fR \fIsigma\fR ?\fIr\fR?
.sp
\fB::crimp\fR \fBfilter mean\fR \fIimage\fR ?\fB-border\fR \fIspec\fR? ?\fIradius\fR?
.sp
\fB::crimp\fR \fBfilter rank\fR \fIimage\fR ?\fB-border\fR \fIspec\fR? ?\fIradius\fR ?\fIpercentile\fR??
.sp
\fB::crimp\fR \fBfilter stddev\fR \fIimage\fR ?\fB-border\fR \fIspec\fR? ?\fIradius\fR?
.sp
\fB::crimp\fR \fBfilter sobel x\fR \fIimage\fR
.sp
\fB::crimp\fR \fBfilter sobel y\fR \fIimage\fR
.sp
\fB::crimp\fR \fBfilter scharr x\fR \fIimage\fR
.sp
\fB::crimp\fR \fBfilter scharr y\fR \fIimage\fR
.sp
\fB::crimp\fR \fBfilter prewitt x\fR \fIimage\fR
.sp
\fB::crimp\fR \fBfilter prewitt y\fR \fIimage\fR
.sp
\fB::crimp\fR \fBgamma\fR \fIimage\fR \fIy\fR
.sp
\fB::crimp\fR \fBgradient sobel\fR \fIimage\fR
.sp
\fB::crimp\fR \fBgradient scharr\fR \fIimage\fR
.sp
\fB::crimp\fR \fBgradient prewitt\fR \fIimage\fR
.sp
\fB::crimp\fR \fBgradient polar\fR \fIcgradient\fR
.sp
\fB::crimp\fR \fBgradient visual\fR \fIpgradient\fR
.sp
\fB::crimp\fR \fBhypot\fR \fIimage1\fR \fIimage2\fR
.sp
\fB::crimp\fR \fBintegrate\fR \fIimage\fR
.sp
\fB::crimp\fR \fBinterpolate xy\fR \fIimage\fR \fIfactor\fR \fIkernel\fR
.sp
\fB::crimp\fR \fBinterpolate x\fR \fIimage\fR \fIfactor\fR \fIkernel\fR
.sp
\fB::crimp\fR \fBinterpolate y\fR \fIimage\fR \fIfactor\fR \fIkernel\fR
.sp
\fB::crimp\fR \fBinvert\fR \fIimage\fR
.sp
\fB::crimp\fR \fBmatrix\fR \fIimage\fR \fImatrix\fR
.sp
\fB::crimp\fR \fBmax\fR \fIimage1\fR \fIimage2\fR
.sp
\fB::crimp\fR \fBmin\fR \fIimage1\fR \fIimage2\fR
.sp
\fB::crimp\fR \fBmontage horizontal\fR ?\fB-align\fR \fBtop\fR|\fBcenter\fR|\fBbottom\fR? ?\fB-border\fR \fIspec\fR? \fIimage\fR...
.sp
\fB::crimp\fR \fBmontage vertical\fR ?\fB-align\fR \fBleft\fR|\fBmiddle\fR|\fBright\fR? ?\fB-border\fR \fIspec\fR? \fIimage\fR...
.sp
\fB::crimp\fR \fBmorph dilate\fR \fIimage\fR
.sp
\fB::crimp\fR \fBmorph erode\fR \fIimage\fR
.sp
\fB::crimp\fR \fBmorph close\fR \fIimage\fR
.sp
\fB::crimp\fR \fBmorph open\fR \fIimage\fR
.sp
\fB::crimp\fR \fBmorph gradient\fR \fIimage\fR
.sp
\fB::crimp\fR \fBmorph igradient\fR \fIimage\fR
.sp
\fB::crimp\fR \fBmorph egradient\fR \fIimage\fR
.sp
\fB::crimp\fR \fBmorph tophatw\fR \fIimage\fR
.sp
\fB::crimp\fR \fBmorph tophatb\fR \fIimage\fR
.sp
\fB::crimp\fR \fBmultiply\fR \fIimage1\fR \fIimage2\fR
.sp
\fB::crimp\fR \fBpsychedelia\fR \fIwidth\fR \fIheight\fR \fIframes\fR
.sp
\fB::crimp\fR \fBpyramid run\fR \fIimage\fR \fIsteps\fR \fIstepcmd\fR
.sp
\fB<stepcmd>\fR \fIimage\fR
.sp
\fB::crimp\fR \fBpyramid gauss\fR \fIimage\fR \fIsteps\fR
.sp
\fB::crimp\fR \fBpyramid laplace\fR \fIimage\fR \fIsteps\fR
.sp
\fB::crimp\fR \fBremap\fR \fIimage\fR \fImap\fR...
.sp
\fB::crimp\fR \fBscreen\fR \fIimage1\fR \fIimage2\fR
.sp
\fB::crimp\fR \fBsolarize\fR \fIimage\fR \fIthreshold\fR
.sp
\fB::crimp\fR \fBsquare\fR \fIimage\fR
.sp
\fB::crimp\fR \fBsubtract\fR \fIimage1\fR \fIimage2\fR ?\fIscale\fR? ?\fIoffset\fR?
.sp
\fB::crimp\fR \fBthreshold global above\fR \fIimage\fR \fIthreshold\fR
.sp
\fB::crimp\fR \fBthreshold global below\fR \fIimage\fR \fIthreshold\fR
.sp
\fB::crimp\fR \fBthreshold global inside\fR \fIimage\fR \fImin\fR \fImax\fR
.sp
\fB::crimp\fR \fBthreshold global outside\fR \fIimage\fR \fImin\fR \fImax\fR
.sp
\fB::crimp\fR \fBthreshold global middle\fR \fIimage\fR
.sp
\fB::crimp\fR \fBthreshold global mean\fR \fIimage\fR
.sp
\fB::crimp\fR \fBthreshold global median\fR \fIimage\fR
.sp
\fB::crimp\fR \fBthreshold global otsu\fR \fIimage\fR
.sp
\fB::crimp\fR \fBthreshold local\fR \fIimage\fR \fIthreshold\fR...
.sp
\fB::crimp\fR \fBupsample xy\fR \fIimage\fR \fIfactor\fR
.sp
\fB::crimp\fR \fBupsample x\fR \fIimage\fR \fIfactor\fR
.sp
\fB::crimp\fR \fBupsample y\fR \fIimage\fR \fIfactor\fR
.sp
\fB::crimp\fR \fBwavy\fR \fIimage\fR \fIoffset\fR \fIadj1\fR \fIadjb\fR
.sp
\fB::crimp\fR \fBflip horizontal\fR \fIimage\fR
.sp
\fB::crimp\fR \fBflip transpose\fR \fIimage\fR
.sp
\fB::crimp\fR \fBflip transverse\fR \fIimage\fR
.sp
\fB::crimp\fR \fBflip vertical\fR \fIimage\fR
.sp
\fB::crimp\fR \fBresize\fR ?\fB-interpolate\fR \fBnneighbour\fR|\fBbilinear\fR|\fBbicubic\fR? \fIimage\fR \fIw\fR \fIh\fR
.sp
\fB::crimp\fR \fBrotate cw\fR \fIimage\fR
.sp
\fB::crimp\fR \fBrotate ccw\fR \fIimage\fR
.sp
\fB::crimp\fR \fBrotate half\fR \fIimage\fR
.sp
\fB::crimp\fR \fBwarp field\fR ?\fB-interpolate\fR \fBnneighbour\fR|\fBbilinear\fR|\fBbicubic\fR? \fIimage\fR \fIxvec\fR \fIyvec\fR
.sp
\fB::crimp\fR \fBwarp projective\fR ?\fB-interpolate\fR \fBnneighbour\fR|\fBbilinear\fR|\fBbicubic\fR? \fIimage\fR \fItransform\fR
.sp
\fB::crimp\fR \fBconvert 2grey8\fR \fIimage\fR
.sp
\fB::crimp\fR \fBconvert 2hsv\fR \fIimage\fR
.sp
\fB::crimp\fR \fBconvert 2rgba\fR \fIimage\fR
.sp
\fB::crimp\fR \fBconvert 2rgb\fR \fIimage\fR
.sp
\fB::crimp\fR \fBjoin 2hsv\fR \fIhueImage\fR \fIsatImage\fR \fIvalImage\fR
.sp
\fB::crimp\fR \fBjoin 2rgba\fR \fIredImage\fR \fIgreenImage\fR \fIblueImage\fR \fIalphaImage\fR
.sp
\fB::crimp\fR \fBjoin 2rgb\fR \fIredImage\fR \fIgreenImage\fR \fIblueImage\fR
.sp
\fB::crimp\fR \fBsplit\fR \fIimage\fR
.sp
\fB::crimp\fR \fBread pgm\fR \fIstring\fR
.sp
\fB::crimp\fR \fBread ppm\fR \fIstring\fR
.sp
\fB::crimp\fR \fBread strimj\fR \fIstring\fR ?\fIcolormap\fR?
.sp
\fB::crimp\fR \fBread tcl grey8\fR \fIpixelmatrix\fR
.sp
\fB::crimp\fR \fBread tcl float\fR \fIpixelmatrix\fR
.sp
\fB::crimp\fR \fBread tk\fR \fIphoto\fR
.sp
\fB::crimp\fR \fBwrite 2tk\fR \fIphoto\fR \fIimage\fR
.sp
\fB::crimp\fR \fBwrite 2string\fR \fIformat\fR \fIimage\fR
.sp
\fB::crimp\fR \fBwrite 2chan\fR \fIformat\fR \fIchan\fR \fIimage\fR
.sp
\fB::crimp\fR \fBwrite 2file\fR \fIformat\fR \fIpath\fR \fIimage\fR
.sp
\fB::crimp\fR \fBgradient grey8\fR \fIfrom\fR \fIto\fR \fIsize\fR
.sp
\fB::crimp\fR \fBgradient rgb\fR \fIfrom\fR \fIto\fR \fIsize\fR
.sp
\fB::crimp\fR \fBgradient rgba\fR \fIfrom\fR \fIto\fR \fIsize\fR
.sp
\fB::crimp\fR \fBgradient hsv\fR \fIfrom\fR \fIto\fR \fIsize\fR
.sp
\fB::crimp\fR \fBkernel make\fR \fImatrix\fR ?\fIscale\fR? ?\fIoffset\fR?
.sp
\fB::crimp\fR \fBkernel fpmake\fR \fImatrix\fR ?\fIoffset\fR?
.sp
\fB::crimp\fR \fBkernel transpose\fR \fIkernel\fR
.sp
\fB::crimp\fR \fBmap\fR \fIarg\fR...
.sp
\fB::crimp\fR \fBmapof\fR \fItable\fR
.sp
\fB::crimp\fR \fBtable compose\fR \fIf\fR \fIg\fR
.sp
\fB::crimp\fR \fBtable eval wrap\fR \fIcmd\fR
.sp
\fB::crimp\fR \fBtable eval clamp\fR \fIcmd\fR
.sp
\fB<cmd>\fR \fIx\fR
.sp
\fB::crimp\fR \fBtable degamma\fR \fIy\fR
.sp
\fB::crimp\fR \fBtable gamma\fR \fIy\fR
.sp
\fB::crimp\fR \fBtable gauss\fR \fIsigma\fR
.sp
\fB::crimp\fR \fBtable identity\fR
.sp
\fB::crimp\fR \fBtable invers\fR
.sp
\fB::crimp\fR \fBtable linear wrap\fR \fIgain\fR \fIoffset\fR
.sp
\fB::crimp\fR \fBtable linear clamp\fR \fIgain\fR \fIoffset\fR
.sp
\fB::crimp\fR \fBtable log\fR ?\fImax\fR?
.sp
\fB::crimp\fR \fBtable solarize\fR \fIthreshold\fR
.sp
\fB::crimp\fR \fBtable sqrt\fR ?\fImax\fR?
.sp
\fB::crimp\fR \fBtable stretch\fR \fImin\fR \fImax\fR
.sp
\fB::crimp\fR \fBtable threshold above\fR \fIthreshold\fR
.sp
\fB::crimp\fR \fBtable threshold below\fR \fIthreshold\fR
.sp
\fB::crimp\fR \fBtable threshold inside\fR \fImin\fR \fImax\fR
.sp
\fB::crimp\fR \fBtable threshold outside\fR \fImin\fR \fImax\fR
.sp
\fB::crimp\fR \fBtable fgauss discrete\fR \fIsigma\fR ?\fIr\fR?
.sp
\fB::crimp\fR \fBtable fgauss sampled\fR \fIsigma\fR ?\fIr\fR?
.sp
\fB::crimp\fR \fBtransform affine\fR \fIa\fR \fIb\fR \fIc\fR \fId\fR \fIe\fR \fIf\fR
.sp
\fB::crimp\fR \fBtransform chain\fR \fItransform\fR...
.sp
\fB::crimp\fR \fBtransform invert\fR \fItransform\fR
.sp
\fB::crimp\fR \fBtransform projective\fR \fIa\fR \fIb\fR \fIc\fR \fId\fR \fIe\fR \fIf\fR \fIg\fR \fIh\fR
.sp
\fB::crimp\fR \fBtransform quadrilateral\fR \fIsrc\fR \fIdst\fR
.sp
\fB::crimp\fR \fBtransform rotate\fR \fItheta\fR ?\fIcenter\fR?
.sp
\fB::crimp\fR \fBtransform scale\fR \fIsx\fR \fIsy\fR
.sp
\fB::crimp\fR \fBtransform translate\fR \fIdx\fR \fIdy\fR
.sp
.BE
.SH DESCRIPTION
This package provides image manipulation commands which are mostly
independent of Tk. The only parts currently depending on Tk are for
the import and export of images from and to Tk photos, necessary for
display.
.PP
Note that the intended audience of this document are the users of
\fBcrimp\fR. Developers wishing to work on the internals of the
package, but unfamiliar with them, should read ... instead.
.SH IMAGES
Images are values. This means that they have a string
representation. It is however strongly recommended to not access this
representation at all, and to only use the accessor commands provided
by crimp to obtain the information stored in the internal
representation of image values.
.PP
The reason behind this is simple: Memory and speed. Images can be
large. Generating the string representation from the internal one
roughly doubles the memory needed to store it, actually a bit more,
due to the necessary quoting of bytes in UTF-8 and list-quting them as
well. Furthermore such a conversion takes time, roughly proportional
to the size of the image itself, in either direction. Properly
accessing the image information without the package's accessor
commands requires list commands. This causes the loss of the internal
representation, thus forcing later a reconversion to the image's
internal represention when it is used as image again. I.e. the
shimmering forces us to convert twice.
.PP
Therefore, to avoid this, use only the crimp commands to access the
images. Even the raw pixel data is accessible in this manner. While
access to that in a Tcl script is, IMHO, highly unusual, there are
situations where it is beneficial. An example of such a situation are
the commands exporting images to raw portable any-maps (PNMs). Our
pixel data fits these formats exactly, and with access to it these
commands could be written in Tcl instead of requiring C level primitives.
.SH "IMAGE TYPES"
Each image has a \fItype\fR, a string implicitly describing features
like the colorspace the image is in, the number of (color) channels,
the domain, i.e. bit-depth, of pixel values in the channels, etc.
.PP
All type strings have the form \fBcrimp::image::\fR\fBfoo\fR.
.PP
The package currently knows the following types:
.TP
\fBrgba\fR
.RS
.TP
Colorspace
RGB also known as Red, Green, and Blue.
.TP
Channels
4, named "red", "green", and "blue",
plus an "alpha" channel controlling
pixel opacity.
.TP
Bit-depth
1 byte/channel (8 bit, values 0-255).
.TP
Pixel-size
4 bytes.
.RE
.TP
\fBrgb\fR
.RS
.TP
Colorspace
RGB also known as Red, Green, and Blue.
.TP
Channels
3, named "red", "green", and "blue".
.TP
Bit-depth
1 byte/channel (8 bit, values 0-255).
.TP
Pixel-size
3 bytes.
.RE
.TP
\fBhsv\fR
.RS
.TP
Colorspace
HSV, also known as Hue, Saturation, and Value.
.TP
Channels
3, named "hue", "saturation", and "value".
.TP
Bit-depth
1 byte/channel (8 bit, values 0-255).
.TP
Pixel-size
3 bytes.
.RE
.TP
\fBgrey8\fR
.RS
.TP
Colorspace
Greyscale.
.TP
Channels
1, named "luma".
.TP
Bit-depth
1 byte/channel (8 bit, values 0-255).
.TP
Pixel-size
1 byte.
.RE
.TP
\fBgrey16\fR
.RS
.TP
Colorspace
Greyscale.
.TP
Channels
1, named "luma".
.TP
Bit-depth
2 byte/channel (16 bit, values 0-65,535).
.TP
Pixel-size
2 bytes.
.RE
.TP
\fBgrey32\fR
.RS
.TP
Colorspace
Greyscale.
.TP
Channels
1, named "luma".
.TP
Bit-depth
4 byte/channel (16 bit, values 0-4,294,967,296).
.TP
Pixel-size
4 bytes.
.RE
.TP
\fBbw\fR
.RS
.TP
Colorspace
Binary.
.TP
Channels
1, named "bw".
.TP
Bit-depth
1 bit/channel.
.TP
Pixel-size
1 byte. I.e. 7 bits/channel are wasted.
.RE
.TP
\fBfloat\fR
.RS
.TP
Colorspace
N.A / Floating Point.
.TP
Channels
1, named "value".
.TP
Bit-depth
4 byte/channel.
.TP
Pixel-size
4 byte.
.RE
.PP
Support for the various types varies by operation. The exact image
types supported by each operation are listed the operation's
description. Invoking an operation for a type it doesn't support will
generally cause it to throw an error.
.SH "GENERAL DESIGN"
All commands operate in a pipeline fashion, taking zero or more image
values, zero or more other arguments, and returning zero or more
images or other values. None are operating in place, i.e. taking an
image variable and writing back to it.
.PP
They fall into five categories, namely:
.PP
.PS
.nf
+-----------------------+-----+---+
| CRIMP                 | Tcl | C |
+-----------------------+-----+---+
| I/O          Read     |     |   |
|             ----------+-----+---+
|              Write    |     |   |
+-----------------------+-----+---+
| Converters            |     |   |
+-----------------------+-----+---+
| Manipulators Geometry |     |   |
|             ----------+-----+---+
|              Color    |     |   |
+-----------------------+-----+---+
| Accessors             |     |   |
+-----------------------+-----+---+
| Support               |     |   |
+-----------------------+-----+---+

.fi
.PE
.TP
Accessors
They take one or more images, extract information about them, and
return this information as their result. This can be a simple as
querying the image's height, to something as complex as counting pixel
values for a histogram.
.sp
The list of accessors, their syntax, and detailed meaning can be found
in section \fBAccessors\fR.
.TP
Manipulators
These take an image and transform its contents in some way, leaving
the image type unchanged. Examples of commands in category are
inversion, gamma conversion, etc. They fall into two sub-categories,
manipulation of the image geometry, and of the intensity values or
colors.
.sp
The list of manipulators, their syntax, and detailed meaning can be
found in section \fBManipulators\fR.
.TP
Converters
Similar to manipulators, except that they change the image's type,
preserving the content instead. Here reside operations like conversion
between the HSV and RGB colorspaces, to greyscale and back, etc.
.sp
The list of converters, their syntax, and detailed meaning can be
found in section \fBConverters\fR.
.TP
I/O
Another variant of the same theme, i.e. akin to converters and
manipulators, yet not the same, these commands read and write images
from and to files or other data structures. I.e. they convert between
different serializations of image content and type.
.sp
The list of I/O commands, their syntax, and detailed meaning can be
found in section \fBI/O commands\fR.
.TP
Support
Lastly, but not leastly a number of commands, which, while not image
commands themselves, support the others.
.sp
The list of supporting commands, their syntax, and detailed meaning
can be found in section \fBSupport\fR.
.PP
.SH API
.SS ACCESSORS
.TP
\fB::crimp\fR \fBchannels\fR \fIimage\fR
This method returns a list containing the names of the channels in the
\fIimage\fR. The order of channels is the same as expected by the
\fBremap\fR method.
.sp
The method supports all image types.
.TP
\fB::crimp\fR \fBdimensions\fR \fIimage\fR
This method returns the width and height of the \fIimage\fR (in
pixels).  The result is a 2-element list containing width and height,
in this order.
.sp
The method supports all image types.
.TP
\fB::crimp\fR \fBheight\fR \fIimage\fR
This method returns the height of the \fIimage\fR (in pixels).
.sp
The method supports all image types.
.TP
\fB::crimp\fR \fBhistogram\fR \fIimage\fR
This method returns a nested dictionary as its result.  The outer
dictionary is indexed by the names of the channels in the \fIimage\fR.
Its values, the inner dictionaries, are indexed by pixel value. The
associated values are the number of pixels with that value.
.sp
The method supports all image types except "grey32".  Under the
current system the result would be a dictionary with 2^32 keys and
values, taking up, roughly, 192 GiByte of memory in the worst case,
and 96 GiByte in best case (all counter values shared in a single
object).
.TP
\fB::crimp\fR \fBmeta append\fR \fIimage\fR \fIkey\fR ?\fIstring\fR...?
.TP
\fB::crimp\fR \fBmeta create\fR \fIimage\fR ?\fIkey\fR \fIvalue\fR...?
.TP
\fB::crimp\fR \fBmeta exists\fR \fIimage\fR \fIkey\fR ?\fIkey\fR...?
.TP
\fB::crimp\fR \fBmeta filter\fR \fIimage\fR \fIargs\fR...
.TP
\fB::crimp\fR \fBmeta for\fR \fIimage\fR {\fIkeyVar\fR \fIvalueVar\fR} \fIbody\fR
.TP
\fB::crimp\fR \fBmeta get\fR \fIimage\fR ?\fIkey\fR...?
.TP
\fB::crimp\fR \fBmeta incr\fR \fIimage\fR \fIkey\fR ?\fIincrement\fR?
.TP
\fB::crimp\fR \fBmeta info\fR \fIimage\fR
.TP
\fB::crimp\fR \fBmeta keys\fR \fIimage\fR ?\fIglobPattern\fR?
.TP
\fB::crimp\fR \fBmeta lappend\fR \fIimage\fR \fIkey\fR ?\fIvalue\fR...?
.TP
\fB::crimp\fR \fBmeta merge\fR \fIimage\fR ?\fIdictionaryValue\fR...?
.TP
\fB::crimp\fR \fBmeta remove\fR \fIimage\fR ?\fIkey\fR...?
.TP
\fB::crimp\fR \fBmeta replace\fR \fIimage\fR ?\fIkey\fR \fIvalue\fR...?
.TP
\fB::crimp\fR \fBmeta set\fR \fIimage\fR \fIkey\fR ?\fIkey\fR...? \fIvalue\fR
.TP
\fB::crimp\fR \fBmeta size\fR \fIimage\fR
.TP
\fB::crimp\fR \fBmeta unset\fR \fIimage\fR \fIkey\fR ?\fIkey\fR...?
.TP
\fB::crimp\fR \fBmeta values\fR \fIimage\fR ?\fIglobPattern\fR?
These methods provide access to the meta data slot of images, treating
its contents as a dictionary. As such all the methods provided here
have an appropriate counterpart in the methods of Tcl's builtin
command \fBdict\fR, with the image's metadata taking the place of the
dictionary value or vqariable.
The converse is not true, as \fBdict\fR's methods \fBupdate\fR and
\fBwith\fR are not supported here.
.sp
Please read the documentation of Tcl's \fBdict\fR command for reference.
.sp
\fINOTE\fR that the toplevel key \fBcrimp\fR is reserved for
use by CRIMP itself.
.TP
\fB::crimp\fR \fBpixel\fR \fIimage\fR
This method returns the raw pixels of the \fIimage\fR as a Tcl ByteArray.
.sp
The method supports all image types.
.TP
\fB::crimp\fR \fBstatistics basic\fR \fIimage\fR
This method returns a nested dictionary as its result. The outer dictionary
contains basic information about the image, see the list of keys below.
The inner dictionaries hold data about each (color) channel in the image,
namely histogram and derived data like minumum pixel value, maximum, etc.
.RS
.TP
\fBdimensions\fR
2-element list holding image width and height, in
this order.
.TP
\fBheight\fR
Image height as separate value.
.TP
\fBpixels\fR
Number of pixels in the image, the product of
its width and height.
.TP
\fBtype\fR
Type of the image.
.TP
\fBwidth\fR
Image width as separate value.
.TP
\fBchannels\fR
List of the names for the channels in the image.
.TP
\fBchannel\fR
A dictionary mapping the names of the image's
channels, as listed under key \fBchannels\fR, to
a dictionary holding the statistics for that channel.
.RS
.TP
\fBmin\fR
The minimal pixel value with a non-zero population.
.TP
\fBmax\fR
The maximal pixel value with a non-zero population.
.TP
\fBmean\fR
The arithmetic mean (aka average) of pixel values.
.TP
\fBmiddle\fR
The arithmetic mean of the min and max pixel values.
.TP
\fBmedian\fR
The median pixel value.
.TP
\fBstddev\fR
The standard deviation of pixel values.
.TP
\fBvariance\fR
The variance of pixel values, square of the standard
deviation.
.TP
\fBhistogram\fR
A dictionary mapping pixel values to population counts.
.TP
\fBhf\fR
The histogram reduced to the population counts, sorted
by pixel value to direct indexing into the list by
pixel values.
.TP
\fBcdf\fR
The \fIcumulative density function\fR of pixel
values. The discrete integral of \fBhf\fR.
.TP
\fBcdf255\fR
Same as \fBcdf\fR, except scaled down so that the
last value in the series is 255.
.RE
.RE
.sp
The method supports all image types except "grey32".  Under the
current system the result would contain internal dictionaries with 2^32 keys
and values, taking up, roughly, 192 GiByte of memory in the worst case,
and 96 GiByte in best case (all counter values shared in a single
object).
.TP
\fB::crimp\fR \fBstatistics otsu\fR \fIstats\fR
This method takes a dictionary of basic image statistics as generated
by \fBcrimp statistics basic\fR and returns an extended dictionary
containing a threshold for image binarization computed by Otsu's
method (See \fBreference\fR 2). Note that this
threshold is computed separately for each channel and stored in the
channel specific part of the dictionary, using the key \fBotsu\fR.
.TP
\fB::crimp\fR \fBtype\fR \fIimage\fR
This method returns the type of the \fIimage\fR.
.sp
The method supports all image types.
.TP
\fB::crimp\fR \fBwidth\fR \fIimage\fR
This method returns the width of the \fIimage\fR (in pixels).
.sp
The method supports all image types.
.PP
.SS MANIPULATORS
.TP
\fB::crimp\fR \fBadd\fR \fIimage1\fR \fIimage2\fR ?\fIscale\fR? ?\fIoffset\fR?
This method combines the two input images into a result image by
performing a pixelwise addition (image1 + image2) followed by division
through \fIscale\fR and addition of the \fIoffset\fR. They default to
\fB1\fR and \fB0\fR respectively, if they are not specified.
.TP
\fB::crimp\fR \fBalpha blend\fR \fIforeground\fR \fIbackground\fR \fIalpha\fR
This method takes two images of identical dimensions and a blending
factor \fIalpha\fR and returns an image which is a mix of both, with
each pixel blended per the formula
.sp
.PS
.nf
Z = F\\alpha + B(1-\\alpha)

.fi
.PE
.sp
or, alternatively written
.sp
.PS
.nf
Z = (F - B)\\alpha + B

.fi
.PE
.sp
This means that the \fIforeground\fR is returned as is for
"\fIalpha\fR == 255", and the \fIbackground\fR for
"\fIalpha\fR == 0".
I.e. the argument \fIalpha\fR controls the \fIopacity\fR of the
foreground, with \fB1\fR and \fB0\fR standing for "fully opaque"
and "fully transparent", respectively.
.sp
The following combinations of fore- and background image types are
supported:
.CS

    Result = Foreground Background
    ------   ---------- ----------
    grey8    grey8      grey8
    hsv      hsv        hsv
    rgb      rgb        grey8
    rgb      rgb        rgb
    rgb      rgb        rgba
    rgba     rgba       grey8
    rgba     rgba       rgb
    rgba     rgba       rgba
    ------   ---------- ----------

.CE
.TP
\fB::crimp\fR \fBalpha set\fR \fIimage\fR \fImask\fR
This command takes two images, the input and a \fImask\fR, and returns
an image as result in which the mask is the alpha channel of the
input.
The result is therefore always of type \fBrgba\fR, as the only type
supporting an alpha channel.
.sp
The input image can be of type \fBrgb\fR or \fBrgba\fR.  In
case of the latter the existing alpha channel is replaced, in case of
the former an alpha channel is added.
.sp
For the mask images of type \fBgrey8\fR and \fBrgba\fR are
accepted.  In the case of the latter the mask's alpha channel is used
as the new alpha channel, in case of the former the mask itself is
used.
.TP
\fB::crimp\fR \fBalpha opaque\fR \fIimage\fR
A convenience method over \fBalpha set\fR, giving the \fIimage\fR
a mask which makes it fully opaque.
.TP
\fB::crimp\fR \fBalpha over\fR \fIforeground\fR \fIbackground\fR
This method is similar to \fBblend\fR above, except that there is
no global blending parameter. This information is taken from the
"alpha" channel of the \fIforeground\fR image instead. The blending
formula is the same, except that the alpha parameter is now a
per-pixel value, and not constant across the image.
.sp
Due to the need for an alpha channel the \fIforeground\fR has to be of
type \fBrgba\fR. For the \fIbackground\fR image the types
\fBrgb\fR and \fBrgba\fR are supported.
.TP
\fB::crimp\fR \fBatan2\fR \fIimage1\fR \fIimage2\fR
This method combines the two input images into a result image by
computing
.sp
.PS
.nf
atan2 (x,y) = atan(\\frac{x}{y})

.fi
.PE
.sp
at each pixel.
.sp
The input is restricted to images of the single-channel types,
i.e. \fBfloat\fR and \fBgrey{8,16,32}\fR. The result is always
of type \fBfloat\fR.
.sp
An application of this operation is the computation of a gradient's
direction from two images representing a gradient in X and Y directions.
For the full conversion of such cartesian gradients to a polar
representation use the \fBcrimp hypot\fR operation to compute the
gradient's magnitude at each pixel.
.TP
\fB::crimp\fR \fBblank\fR \fItype\fR \fIwidth\fR \fIheight\fR \fIvalue\fR...
This method returns a blank image of the given image type and
dimensions.  The \fIvalue\fRs after the dimensions are the pixel
values to fill the pixels in the image's channels with, per its type.
.sp
This method currently support only the types \fBrgb\fR,
\fBrgba\fR, and \fBgrey8\fR.
.TP
\fB::crimp\fR \fBcrop\fR \fIimage\fR \fIww\fR \fIhn\fR \fIwe\fR \fIhs\fR
This method is the counterpart to the \fBexpand\fR family of
methods, shrinking an \fIimage\fR by removing a border.
The size of this border is specified by the four arguments \fIww\fR,
\fIhn\fR, \fIwe\fR, and \fIhs\fR which provide the number of pixels to
remove from the named edge. See the image below for a graphical
representation.
.sp
.PS
.nf
   |< ww >|           |< we >|

-  +------+-----------+------+
^  |      |           |      |
hn |      |           |      |
V  |      |           |      |
-  +------+-----------+------+
   |      |           |      |
   |      |           |      |
   |      |           |      |
   |      |           |      |
-  +------+-----------+------+
^  |      |           |      |
hs |      |           |      |
V  |      |           |      |
-  +------+-----------+------+

.fi
.PE
.sp
.TP
\fB::crimp\fR \fBcut\fR \fIimage\fR \fIx\fR \fIy\fR \fIw\fR \fIh\fR
This method cuts the rectangular region specified throught its \fIx\fR/\fIy\fR
position relative to the upper-left corner of the input \fIimage\fR and its
dimensions, and returns it as its own image.
.TP
\fB::crimp\fR \fBdecimate xy\fR \fIimage\fR \fIfactor\fR \fIkernel\fR
.TP
\fB::crimp\fR \fBdecimate x\fR \fIimage\fR \fIfactor\fR \fIkernel\fR
.TP
\fB::crimp\fR \fBdecimate y\fR \fIimage\fR \fIfactor\fR \fIkernel\fR
This is a convenience method combining the two steps of filtering an image
(via \fBfilter convolve\fR), followed by a \fBdownsample\fR step.
See the method \fBinterpolate\fR for the complementary operation.
.sp
Note that while the \fIkernel\fR argument for \fBfilter convolve\fR
is expected to be the 1D form of a separable low-pass filter no checks are made.
The method simply applies both the kernel and its transposed form.
.sp
The method \fBpyramid gauss\fR is a user of this method.
.TP
\fB::crimp\fR \fBdegamma\fR \fIimage\fR \fIy\fR
This method takes an image, runs it through an
\fBinverse gamma correction\fR with parameter \fIy\fR, and returns
the corrected image as it result.
This is an application of method \fBremap\fR, using the mapping
returned by "\fBmap degamma\fR \fIy\fR".
This method supports all image types supported by the method
\fBremap\fR.
.TP
\fB::crimp\fR \fBdifference\fR \fIimage1\fR \fIimage2\fR
This method combines the two input images into a result image by
taking the pixelwise absolute difference (|image1 - image2|).
.TP
\fB::crimp\fR \fBdownsample xy\fR \fIimage\fR \fIfactor\fR
.TP
\fB::crimp\fR \fBdownsample x\fR \fIimage\fR \fIfactor\fR
.TP
\fB::crimp\fR \fBdownsample y\fR \fIimage\fR \fIfactor\fR
This method returns an image containing only every \fIfactor\fR pixel of the
input \fIimage\fR (in x, y, or both dimensions). The effect is that the input is
shrunken by \fIfactor\fR. It is the complement of method \fBupsample\fR.
.sp
Using the method as is is not recommended because the simple subsampling
will cause higher image frequencies to alias into the reduced spectrum, causing
artifacts to appear in the result. This is normally avoided by running a
low-pass filter over the image before doing downsampling, removing the
problematic frequencies.
.sp
The \fBdecimate\fR method is a convenience method combining these
two steps into one.
.TP
\fB::crimp\fR \fBeffect charcoal\fR \fIimage\fR
This method applies a charcoal effect to the image, i.e. it returns a
\fBgrey8\fR image showing the input as if it had been drawn with a
charcoal pencil.
.TP
\fB::crimp\fR \fBeffect emboss\fR \fIimage\fR
This method applies an embossing effect to the image, i.e. it returns
an image of the same type as the input showing the input as if it had
been embossed into a metal plate with a stencil of some kind.
.TP
\fB::crimp\fR \fBeffect sharpen\fR \fIimage\fR
This method sharpens the input image, i.e. returns an image of the
same type as the input in which the input's edges are emphasized.
.TP
\fB::crimp\fR \fBexpand const\fR \fIimage\fR \fIww\fR \fIhn\fR \fIwe\fR \fIhs\fR ?\fIvalue\fR...?
.TP
\fB::crimp\fR \fBexpand extend\fR \fIimage\fR \fIww\fR \fIhn\fR \fIwe\fR \fIhs\fR
.TP
\fB::crimp\fR \fBexpand mirror\fR \fIimage\fR \fIww\fR \fIhn\fR \fIwe\fR \fIhs\fR
.TP
\fB::crimp\fR \fBexpand replicate\fR \fIimage\fR \fIww\fR \fIhn\fR \fIwe\fR \fIhs\fR
.TP
\fB::crimp\fR \fBexpand wrap\fR \fIimage\fR \fIww\fR \fIhn\fR \fIwe\fR \fIhs\fR
This set of methods takes an image and expands it by adding a border.
The size of this border is specified by the four arguments \fIww\fR,
\fIhn\fR, \fIwe\fR, and \fIhs\fR which provide the number of pixels to
add at the named edge. See the image below for a graphical
representation.
.sp
.PS
.nf
   |< ww >|           |< we >|

-  +------+-----------+------+
^  |      |           |      |
hn |      |           |      |
V  |      |           |      |
-  +------+-----------+------+
   |      |           |      |
   |      |           |      |
   |      |           |      |
   |      |           |      |
-  +------+-----------+------+
^  |      |           |      |
hs |      |           |      |
V  |      |           |      |
-  +------+-----------+------+

.fi
.PE
.sp
The contents of the border's pixels are specified via the border type,
the first argument after \fBexpand\fR, as per the list below.
.RS
.TP
\fBconst\fR
The additional \fIvalue\fRs specify the values to use for the color
channels of the image. Values beyond the number of channels in the
image are ignored.
Missing values are generated by replicating the last value, except for
the alpha channel, which will be set to \fB255\fR. If no values are
present they default to \fB0\fR.
.TP
\fBextend\fR
This is a combination of \fBmirror\fR and \fBreplicate\fR.  The
outside pixels are the result of subtracting the outside pixel for
\fBmirror\fR from the outside pixel for \fBreplicate\fR (and
clamping to the range [0...255]).
.TP
\fBmirror\fR
The outside pixels take the value of the associated inside pixels,
found by reflecting its coordinates along the relevant edges.
.TP
\fBreplicate\fR
The outside pixels take the value of the associated edge pixels, i.e.
replicating them into the border.
.TP
\fBwrap\fR
The outside pixels take the value of the associated inside pixels,
found by toroidial (cyclic) wrapping its coordinates along the
relevant edges. This is also called tiling.
.RE
.TP
\fB::crimp\fR \fBfft forward\fR \fIimage\fR
.TP
\fB::crimp\fR \fBfft backward\fR \fIimage\fR
These two methods implement 2D FFT (forward) and inverse FFT (backward).
.sp
The input is restricted to images of the single-channel types,
i.e. \fBfloat\fR and \fBgrey{8,16,32}\fR. The result is always
of type \fBfloat\fR.
.sp
The former means that it is necessary to split \fBrgb\fR,
etc. images into their channels before performing an FFT, and that
results of an inverse FFT have to be joined.
See the methods \fBsplit\fR and \fBjoin\fR for the relevant
operations and their syntax.
.sp
The latter means that a separate invokation of method
\fBconvert 2grey8\fR is required when reconstructing an image
by inverting its FFT.
.TP
\fB::crimp\fR \fBfilter ahe\fR \fIimage\fR ?\fB-border\fR \fIspec\fR? ?\fIradius\fR?
This method performs adaptive histogram equalization to enhance the
contrast of the input image. Each pixel undergoes regular histogram
equalization, with the histogram computed from the pixels in the
\fBN\fRx\fBN\fR square centered on it, where
"\fBN\fR = 2*\fBradius\fR+1".
.sp
The default radius is \fB3\fR, for a 7x7 square.
.TP
\fB::crimp\fR \fBfilter convolve\fR \fIimage\fR ?\fB-border\fR \fIspec\fR? \fIkernel\fR...
This method runs the series of filters specified by the convolution
\fIkernel\fRs over the input and returns the filtered result. See the
method \fBkernel\fR and its sub-methods for commands to create and
manipulate suitable kernels.
.sp
The border specification determines how the input image is
expanded (see method \fBexpand\fR) to compensate for the shrinkage
introduced by the filter itself. The \fIspec\fR argument is a list
containing the name of the sub-method of \fBexpand\fR to use, plus
any additional arguments this method may need, except for the size of
the expansion.
.sp
By default a black frame is used as the border, i.e.
"\fIspec\fR == {const 0}".
.TP
\fB::crimp\fR \fBfilter gauss discrete\fR \fIimage\fR \fIsigma\fR ?\fIr\fR?
.TP
\fB::crimp\fR \fBfilter gauss sampled\fR \fIimage\fR \fIsigma\fR ?\fIr\fR?
These methods apply a discrete or sampled gaussian blur with
parameters \fIsigma\fR and kernel \fIr\fRadius to the \fIimage\fR. If
the radius is not specified it defaults to the smallest integer
greater than "3*\fIsigma\fR".
.TP
\fB::crimp\fR \fBfilter mean\fR \fIimage\fR ?\fB-border\fR \fIspec\fR? ?\fIradius\fR?
This method applies a mean filter with \fIradius\fR to the
image. I.e. each pixel of the result is the mean value of all pixels
in the \fBN\fRx\fBN\fR square centered on it, where
"\fBN\fR = 2*\fBradius\fR+1".
.sp
The default radius is \fB3\fR, for a 7x7 square.
.sp
\fINOTE\fR. As the mean is known to be in the range defined by the
channel this method automatically converts float results back to the
channel type. This introduces rounding / quantization errors. As a
result of this price being paid the method is able to handle
multi-channel images, by automatically splitting, processing, and
rejoining its channels.
.sp
The method \fBfilter stddev\fR on the other makes the reverse
tradeoff, keeping precision, but unable to handle multi-channel
images.
.TP
\fB::crimp\fR \fBfilter rank\fR \fIimage\fR ?\fB-border\fR \fIspec\fR? ?\fIradius\fR ?\fIpercentile\fR??
This method runs a rank-filter over the input and returns the filtered
result.
.sp
The border specification determines how the input image is
expanded (see method \fBexpand\fR) to compensate for the shrinkage
introduced by the filter itself. The \fIspec\fR argument is a list
containing the name of the sub-method of \fBexpand\fR to use, plus
any additional arguments this method may need, except for the size of
the expansion.
.sp
By default a black frame is used as the border, i.e.
"\fIspec\fR == {const 0}".
.sp
The \fIradius\fR specifies the (square) region around each
pixel which is taken into account by the filter, with the pixel value
selected according to the \fIpercentile\fR. The filter region of each
pixel is a square of dimensions "2*\fIradius\fR+1", centered around
the pixel.
.sp
These two values default to \fB3\fR and \fB50\fR, respectively.
.sp
Typical applications of rank-filters are min-, max-, and
median-filters, for percentiles 0, 100, and 50, respectively.
.sp
Note that percentiles outside of the range \fB0\fR...\fB100\fR
make no sense and are clamped to this range.
.TP
\fB::crimp\fR \fBfilter stddev\fR \fIimage\fR ?\fB-border\fR \fIspec\fR? ?\fIradius\fR?
This method applies a stand deviation filter with \fIradius\fR to the
image. I.e. each pixel of the result is the standard deviation of all
pixel values in the \fBN\fRx\fBN\fR square centered on it, where
"\fBN\fR = 2*\fBradius\fR+1".
.sp
The default radius is \fB3\fR, for a 7x7 square.
.sp
\fINOTE\fR. As the standard deviation is often quite small and its
precision important the result of this method is always an image of
type \fBfloat\fR. Because of this this method is unable to handle
multi-channel images as the results of processing their channels
cannot be joined back together for the proper type.
.sp
The method \fBfilter mean\fR on the other hand makes the reverse
tradeoff, handling multi-channel images, but dropping precision.
.TP
\fB::crimp\fR \fBfilter sobel x\fR \fIimage\fR
.TP
\fB::crimp\fR \fBfilter sobel y\fR \fIimage\fR
.TP
\fB::crimp\fR \fBfilter scharr x\fR \fIimage\fR
.TP
\fB::crimp\fR \fBfilter scharr y\fR \fIimage\fR
.TP
\fB::crimp\fR \fBfilter prewitt x\fR \fIimage\fR
.TP
\fB::crimp\fR \fBfilter prewitt y\fR \fIimage\fR
These methods are convenience methods implementing a number of standard
convolution filters using for edge detection and calculation of image
gradients.
.sp
See the \fBcrimp gradient\fR methods for users of these filters.
.sp
Also note that the \fBx\fR methods emphasize gradient in the horizontal
direction, and thus highlight \fIvertical\fR lines, and vice versa for
\fBy\fR.
.TP
\fB::crimp\fR \fBgamma\fR \fIimage\fR \fIy\fR
This method takes an image, runs it through a \fBgamma correction\fR
with parameter \fIy\fR, and returns the corrected image as it result.
This is an application of method \fBremap\fR, using the mapping
returned by "\fBmap gamma\fR \fIy\fR".
This method supports all image types supported by the method
\fBremap\fR.
.TP
\fB::crimp\fR \fBgradient sobel\fR \fIimage\fR
.TP
\fB::crimp\fR \fBgradient scharr\fR \fIimage\fR
.TP
\fB::crimp\fR \fBgradient prewitt\fR \fIimage\fR
These methods generate two gradient images for the input image, in the
X- and Y-directions, using different semi-standard filters. I.e. the
result is a cartesian representation of the gradients in the input.
The result is a 2-element list containing the X- and Y-gradient
images, in this order.
.TP
\fB::crimp\fR \fBgradient polar\fR \fIcgradient\fR
This method takes a gradient in cartesian representation (as
returned by the above methods) and converts it to polar
representation, i.e. magnitude and angle. The result of the method
is a 2-element list containing two \fBfloat\fR images, the
magnitude and angle, in this order. The angle is represented
in degrees running from 0 to 360.
.TP
\fB::crimp\fR \fBgradient visual\fR \fIpgradient\fR
This method takes a gradient in polar representation (as
returned by method \fBgradient polar\fR) and converts it
into a color image (\fBrgb\fR) visualizing the gradient.
.sp
The visualization is easier to understand in HSV space tough,
with the angle mapped to Hue, i.e. color, magnitude to Value,
and Saturation simply at full.
.TP
\fB::crimp\fR \fBhypot\fR \fIimage1\fR \fIimage2\fR
This method combines the two input images into a result image by
computing
.sp
.PS
.nf
hypot (x,y) = \\sqrt{x^2 + y^2}

.fi
.PE
.sp
at each pixel.
.sp
The input is restricted to images of the single-channel types,
i.e. \fBfloat\fR and \fBgrey{8,16,32}\fR. The result is always
of type \fBfloat\fR.
.sp
An application of this operation is the computation of the gradient
magnitude from two images representing a gradient in X and Y directions.
For the full conversion of such cartesian gradients to a polar
representation use the \fBcrimp atan2\fR operation to compute the
gradient's direction at each pixel.
.TP
\fB::crimp\fR \fBintegrate\fR \fIimage\fR
This method takes any single-channel image, i.e. of types
\fBfloat\fR and \fBgrey{8,16,32}\fR, and returns its integral,
i.e. a summed area table. The type of the result is always of type
\fBfloat\fR.
.TP
\fB::crimp\fR \fBinterpolate xy\fR \fIimage\fR \fIfactor\fR \fIkernel\fR
.TP
\fB::crimp\fR \fBinterpolate x\fR \fIimage\fR \fIfactor\fR \fIkernel\fR
.TP
\fB::crimp\fR \fBinterpolate y\fR \fIimage\fR \fIfactor\fR \fIkernel\fR
This is a convenience method combining the two steps of an \fBupsample\fR,
followed by a filter step (via \fBfilter convolve\fR). See the method
\fBdecimate\fR for the complementary operation.
.sp
Note that while the \fIkernel\fR argument for \fBfilter convolve\fR
is expected to be 1D form of a separable low-pass filter no checks are made.
The method simply applies both the kernel and its transposed form.
.sp
The methods \fBpyramid gauss\fR and \fBpyramid laplace\fR are
users of this method.
.TP
\fB::crimp\fR \fBinvert\fR \fIimage\fR
This method takes an image, runs it through the \fBinverse\fR
function, and returns the modified image as it result.
This is an application of method \fBremap\fR, using the mapping
returned by "\fBmap inverse\fR".
This method supports all image types supported by the method
\fBremap\fR.
.TP
\fB::crimp\fR \fBmatrix\fR \fIimage\fR \fImatrix\fR
This method takes an image and a 3x3 matrix specified as nested Tcl
list (row major order), applies the projective transform represented
by the matrix to the image and returns the transformed image as its
result.
.sp
Notes: It is currently unclear how the output pixel is computed
(nearest neighbour, bilinear, etc.) (code inherited from AMG). This
requires more reading, and teasing things apart. The transfomred image
is clipped to the dimensions of the input image, i.e. pixels from the
input may be lost, and pixels in the output may be unset as their
input would come from outside of the input.
.sp
The operation supports only images of type \fBrgba\fR, and returns
images of the same type.
.TP
\fB::crimp\fR \fBmax\fR \fIimage1\fR \fIimage2\fR
This method combines the two input images into a result image by
taking the pixelwise maximum.
.TP
\fB::crimp\fR \fBmin\fR \fIimage1\fR \fIimage2\fR
This method combines the two input images into a result image by
taking the pixelwise minimum.
.TP
\fB::crimp\fR \fBmontage horizontal\fR ?\fB-align\fR \fBtop\fR|\fBcenter\fR|\fBbottom\fR? ?\fB-border\fR \fIspec\fR? \fIimage\fR...
.TP
\fB::crimp\fR \fBmontage vertical\fR ?\fB-align\fR \fBleft\fR|\fBmiddle\fR|\fBright\fR? ?\fB-border\fR \fIspec\fR? \fIimage\fR...
The result of these methods is an image where the input images have
been placed adjacent to each from left to right (horizontal), or top
to bottom (vertical). The input images have to have the same type.
.sp
There is no need however for them to have the same height, or width,
respectively. When images of different height (width) are used the
command will expand them to their common height (width), which is the
maximum of all heights (widths). The expansion process is further
governed by the values of the \fB-align\fR and \fB-border\fR
options, with the latter specifying the form of the expansion (see
method \fBexpand\fR for details), and the first specifying how the
image is aligned within the expanded space.
.sp
The \fIspec\fR argument of \fB-border\fR is a list containing the
name of the sub-method of \fBexpand\fR to use, plus any additional
arguments this method may need, except for the size of the expansion.
.sp
The default values for \fB-align\fR are \fBcenter\fR and
\fBmiddle\fR, centering the image in the space. The default for the
\fB-border\fR is a black frame, i.e. "\fIspec\fR == {const 0}".
.TP
\fB::crimp\fR \fBmorph dilate\fR \fIimage\fR
.TP
\fB::crimp\fR \fBmorph erode\fR \fIimage\fR
These two methods implement the basic set of morphology operations,
\fIerosion\fR, and \fIdilation\fR using a flat 3x3 brick as their
structuring element. For grayscale, which we have here, these are,
mathematically, max and min rank-order filters, i.e.
.CS

    dilate = filter rank 1  0.00 (min)
    erode  = filter rank 1 99.99 (max)

.CE
.TP
\fB::crimp\fR \fBmorph close\fR \fIimage\fR
.TP
\fB::crimp\fR \fBmorph open\fR \fIimage\fR
These two methods add to the basic set of morphology operations,
\fIopening\fR and \fIclosing\fR. In terms of erosion and dilation:
.CS

    close = erode o dilate
    open  = dilate o erode

.CE
.TP
\fB::crimp\fR \fBmorph gradient\fR \fIimage\fR
The morphological \fIgradient\fR is defined as
.CS

    [dilate $image] - [erode $image]

.CE
This can also be expressed as the sum of the external and internal
gradients, see below.
.TP
\fB::crimp\fR \fBmorph igradient\fR \fIimage\fR
The morphological \fIinternal gradient\fR is defined as
.CS

    $image - [erode image]

.CE
.TP
\fB::crimp\fR \fBmorph egradient\fR \fIimage\fR
The morphological \fIexternal gradient\fR is defined as
.CS

    [dilate $image] - $image

.CE
.TP
\fB::crimp\fR \fBmorph tophatw\fR \fIimage\fR
The \fIwhite tophat\fR transformation is defined as
.CS

    $image - [open $image]

.CE
.TP
\fB::crimp\fR \fBmorph tophatb\fR \fIimage\fR
The \fIblack tophat\fR transformation is defined as
.CS

    [close $image] - $image

.CE
.TP
\fB::crimp\fR \fBmultiply\fR \fIimage1\fR \fIimage2\fR
This method combines the two input images into a result image by
performing a pixelwise multiplication. Note that the result of each
multiplication is divided by \fB255\fR to scale it back into the
range [0...255].
.TP
\fB::crimp\fR \fBpsychedelia\fR \fIwidth\fR \fIheight\fR \fIframes\fR
This method creates an \fBrgba\fR image of the specified dimensions
according to an algorithm devised by Andrew M. Goth. The \fIframes\fR
argument specifies how many images are in the series.
.sp
\fIAttention:\fR This method keeps internal global state,
ensuring that each call returns a slightly different image. Showing a
series of such images as animation provides an effect similar to a
lava lamp or hallucination.
.TP
\fB::crimp\fR \fBpyramid run\fR \fIimage\fR \fIsteps\fR \fIstepcmd\fR
This method provides the core functionality for the generation of image
pyramids. The command prefix \fIstepcmd\fR is run \fIsteps\fR times,
first on the \fIimage\fR, then on the result of the previous step.
.sp
The assumed signature of \fIstepcmd\fR is
.RS
.TP
\fB<stepcmd>\fR \fIimage\fR
which is expected to return a list of two elements. The first element
(\fIresult\fR) is added to the pyramid in building, whereas the second
element (\fIiter\fR) is used in the next step as the input of the step
command.
.RE
.sp
The final result of the method is a list containing the input
\fIimage\fR as its first element, followed by the results of the step
function, followed by the \fIiter\fR element returned by the last step,
"\fIsteps\fR+2" images in total.
.sp
IMAGE: pyramid
.TP
\fB::crimp\fR \fBpyramid gauss\fR \fIimage\fR \fIsteps\fR
This method generates a gaussian image pyramid \fIsteps\fR levels deep and
returns it as a list of images.
.sp
The first image in the result is the input, followed by \fIsteps\fR
successively smaller images, each \fBdecimate\fRd by a factor two
compared to its predecessor, for a total length of "\fIsteps\fR+1" images.
.sp
The convolution part of the decimation uses
.CS
 1/16 [1 4 6 4 1]
.CE
as its kernel.
.sp
IMAGE: pyramid_gauss
.TP
\fB::crimp\fR \fBpyramid laplace\fR \fIimage\fR \fIsteps\fR
This method generates a laplacian image pyramid \fIsteps\fR levels deep and
returns it as a list of images.
.sp
The first image in the result is the input, followed by \fIsteps\fR
band pass images (differences of gaussians). The first band pass has the same
size as the input image, and each successor is \fBdecimate\fRd by two. This
is followed by one more image, the gaussian of the last step. This image is
decimated by two compared to the preceding bandpass image. In total the result
contains "\fIsteps\fR+2" images.
.sp
The convolution part of the decimation uses
.CS
 1/16 [1 4 6 4 1]
.CE
as its kernel. The internal interpolation used to generate the band pass
images (resynthesis) doubles the weights of this kernel for its convolution
step.
.sp
IMAGE: pyramid_laplace
.TP
\fB::crimp\fR \fBremap\fR \fIimage\fR \fImap\fR...
This method is the core primitive for the per-pixel transformation of
images, with each pixel (and channels within, if any) handled
independently of all others.
Applications of this operator provided by this package are (inverse)
gamma correction, pixel inversion, and solarization. Many more are
possible, especially when considering other colorspaces like
HSV. There, for example, it is possible change the saturation of
pixels, or shift the hue in arbitrary manner.
.sp
Beyond the input \fIimage\fR to transform one or more \fImaps\fR are
specified which define how each pixel value in the input is mapped to
a pixel value in the output. The command will accept at most that many
maps as the input image has channels.  If there are less maps than
channel the last map specified is replicated to cover the other
channels. An exception of this is the handling of the alpha channel,
should the input image have such. There a missing map is handle as
\fBidentity\fR, i.e. the channel copied as is, without changes.
.sp
The maps are not Tcl data structures, but images themselves.  They
have to be of type \fBgrey8\fR, and be of dimension 256x1 (width by
height).
.sp
The \fBcrimp map ...\fR methods are sources for a number of
predefined maps, whereas the \fBmapof\fR method allows the
construction of maps from Tcl data structures, namely lists of values.
.sp
This method supports all image types with one or more
single-byte channels, i.e. all but \fBgrey16\fR, \fBgrey32\fR,
\fBfloat\fR, and \fBbw\fR.
.TP
\fB::crimp\fR \fBscreen\fR \fIimage1\fR \fIimage2\fR
This method combines the two input images by inverting the
multiplication of the inverted input images. I.e.
.sp
.PS
.nf
Z = 1-((1-A)(1-B)) = invert (multiply (invert (A), invert (B)))

.fi
.PE
.sp
.TP
\fB::crimp\fR \fBsolarize\fR \fIimage\fR \fIthreshold\fR
This method takes an image, runs it through the \fBsolarize\fR
function with parameter \fIthreshold\fR, and returns the modified
image as it result. This is also known as the \fIsabattier effect\fR.
This is an application of method \fBremap\fR, using the mapping
returned by "\fBmap solarize\fR \fIthreshold\fR".
This method supports all image types supported by the method
\fBremap\fR.
.TP
\fB::crimp\fR \fBsquare\fR \fIimage\fR
This is a convenience method equivalent to
"\fBcrimp multiply\fR \fIimage\fR \fIimage\fR".
.TP
\fB::crimp\fR \fBsubtract\fR \fIimage1\fR \fIimage2\fR ?\fIscale\fR? ?\fIoffset\fR?
This method combines the two input images into a result image by
performing a pixelwise subtraction (image1 - image2) followed by
division through \fIscale\fR and addition of the \fIoffset\fR. They
default to \fB1\fR and \fB0\fR respectively, if they are not
specified.
.TP
\fB::crimp\fR \fBthreshold global above\fR \fIimage\fR \fIthreshold\fR
This method takes an image, runs it through the \fBthreshold above\fR
function with parameter \fIthreshold\fR, and returns the modified
image as it result. As the result only contains black and white,
i.e. 2 colors, this process is also called \fIbinarization\fR or
foreground/background segmentation.
This is an application of method \fBremap\fR, using the mapping
returned by "\fBmap threshold above\fR \fIthreshold\fR".
This method supports all image types supported by the method
\fBremap\fR.
.TP
\fB::crimp\fR \fBthreshold global below\fR \fIimage\fR \fIthreshold\fR
This method takes an image, runs it through the \fBthreshold below\fR
function with parameter \fIthreshold\fR, and returns the modified
image as it result. As the result only contains black and white,
i.e. 2 colors, this process is also called \fIbinarization\fR, or
foreground/background segmentation.
This is an application of method \fBremap\fR, using the mapping
returned by "\fBmap threshold below\fR \fIthreshold\fR".
This method supports all image types supported by the method
\fBremap\fR.
.TP
\fB::crimp\fR \fBthreshold global inside\fR \fIimage\fR \fImin\fR \fImax\fR
This method takes an image, runs it through the \fBthreshold inside\fR
function with parameters \fImin\fR and \fImax\fR, and returns the
modified image as it result. As the result only contains black and
white, i.e. 2 colors, this process is also called \fIbinarization\fR
or foreground/background segmentation.
This is an application of method \fBremap\fR, using the mapping
returned by "\fBmap threshold above\fR \fIthreshold\fR".
This method supports all image types supported by the method
\fBremap\fR.
.TP
\fB::crimp\fR \fBthreshold global outside\fR \fIimage\fR \fImin\fR \fImax\fR
This method takes an image, runs it through the \fBthreshold outside\fR
function with parameters \fImin\fR and \fImax\fR, and returns the
modified image as it result. As the result only contains black and
white, i.e. 2 colors, this process is also called \fIbinarization\fR,
or foreground/background segmentation.
This is an application of method \fBremap\fR, using the mapping
returned by "\fBmap threshold below\fR \fIthreshold\fR".
This method supports all image types supported by the method
\fBremap\fR.
.TP
\fB::crimp\fR \fBthreshold global middle\fR \fIimage\fR
.TP
\fB::crimp\fR \fBthreshold global mean\fR \fIimage\fR
.TP
\fB::crimp\fR \fBthreshold global median\fR \fIimage\fR
.TP
\fB::crimp\fR \fBthreshold global otsu\fR \fIimage\fR
These four methods are convenience methods layered on top of
\fBcrimp threshold global below\fR. They compute the value(s) to
perform the thresholding with from the global statistics of the input
image, with the element taken named by the method. For reference see
the documentation of method \fBcrimp statistics ...\fR. Note that
they treat each color channel in the image separately.
.TP
\fB::crimp\fR \fBthreshold local\fR \fIimage\fR \fIthreshold\fR...
This method takes an \fIimage\fR and one or more \fIthreshold\fR maps
and returns an image where all pixels of the input which were larger
or equal to the corresponding pixel in the map are set to black. All
other pixels are set to white. Each map is applied to one color
channel of the input image. If there are too many maps the remainder
is ignored. If there are not enough maps the last map is replicated.
.sp
This is the core for all methods of non-global
\fIbinarization\fR, i.e. foreground/background segmentation. Their
differences are just in the calculation of the maps.
.sp
This method supports all image types with one or more
single-byte channels, i.e. all but \fBgrey16\fR, \fBgrey32\fR, and
\fBbw\fR.
.TP
\fB::crimp\fR \fBupsample xy\fR \fIimage\fR \fIfactor\fR
.TP
\fB::crimp\fR \fBupsample x\fR \fIimage\fR \fIfactor\fR
.TP
\fB::crimp\fR \fBupsample y\fR \fIimage\fR \fIfactor\fR
This method returns an image inserting \fIfactor\fR black pixels between
each pixel of the input \fIimage\fR (in x, y, or both dimensions). The effect is
that the input is expanded by \fIfactor\fR. It is the complement of
method \fBdownsample\fR.
.sp
Using the method as is is not recommended because this simple upsampling
will cause copies of the image to appear at the higher image frequencies in the
expanded spectrum. This is normally avoided by running a low-pass filter over
the image after the upsampling, removing the problematic copies.
.sp
The \fBinterpolate\fR method is a convenience method combining these
two steps into one.
.TP
\fB::crimp\fR \fBwavy\fR \fIimage\fR \fIoffset\fR \fIadj1\fR \fIadjb\fR
This method processes the input \fIimage\fR according to an algorithm
devised by Andrew M. Goth, according to the three parameters
\fIoffset\fR, \fIadj1\fR, and \fIadjb\fR, and returns the modified
image as its result.
.sp
The operation supports only images of type \fBrgba\fR, and returns
images of the same type.
.TP
\fB::crimp\fR \fBflip horizontal\fR \fIimage\fR
.TP
\fB::crimp\fR \fBflip transpose\fR \fIimage\fR
.TP
\fB::crimp\fR \fBflip transverse\fR \fIimage\fR
.TP
\fB::crimp\fR \fBflip vertical\fR \fIimage\fR
This set of methods performs mirroring along the horizontal, vertical
and diagonal axes of the input \fIimage\fR, returning the mirrored
image as their output.  Transpose mirrors along the main diagonal,
transverse along the secondary diagonal.  These two methods also
exchange width and height of the image in the output.
.sp
The methods currently support the image types \fBrgb\fR,
\fBrgba\fR, \fBhsv\fR, and \fBgrey8\fR.
.TP
\fB::crimp\fR \fBresize\fR ?\fB-interpolate\fR \fBnneighbour\fR|\fBbilinear\fR|\fBbicubic\fR? \fIimage\fR \fIw\fR \fIh\fR
This method takes the input \fIimage\fR and resizes it to the
specified width \fIw\fR and height \fIh\fR.
In constrast to \fBcut\fR this is not done by taking part of the
image in the specified size, but by scaling it up or down as
needed. In other words, this method is a degenerate case of a
projective transform as created by the \fBtransform\fR methods and
used by method \fBwarp projective\fR (see below).
.sp
Like the aforementioned general method this method supports all
the possible interpolation types, i.e. nearest neighbour, bilinear,
and bicubic. By default \fBbilinear\fR interpolation is used, as a
compromise between accuracy and speed.
.TP
\fB::crimp\fR \fBrotate cw\fR \fIimage\fR
.TP
\fB::crimp\fR \fBrotate ccw\fR \fIimage\fR
This set of methods rotates the image in steps of 90 degrees, either
clockwise and counter to it.
.TP
\fB::crimp\fR \fBrotate half\fR \fIimage\fR
This methods rotates the image a half-turn, i.e. 180 degrees.
.TP
\fB::crimp\fR \fBwarp field\fR ?\fB-interpolate\fR \fBnneighbour\fR|\fBbilinear\fR|\fBbicubic\fR? \fIimage\fR \fIxvec\fR \fIyvec\fR
This method takes an input image and two images the size of the
expected result which provide for each pixel in the result the
coordinates to sample in the input to determine the result's color.
.sp
This allows the specification of any possible geometric
transformation and warping, going beyond even projective
transformations.
.sp
The two images providing the coordinate information have to be
of the same size, which is also the size of the returned result. The
type of the result is however specified through the type of the input
image.
.sp
The method supports all the possible interpolation types,
i.e. nearest neighbour, bilinear, and bicubic.
By default \fBbilinear\fR interpolation is used, as a compromise
between accuracy and speed.
.TP
\fB::crimp\fR \fBwarp projective\fR ?\fB-interpolate\fR \fBnneighbour\fR|\fBbilinear\fR|\fBbicubic\fR? \fIimage\fR \fItransform\fR
This method accepts a general projective \fItransform\fR as created by
the \fBtransform\fR methods, applies it to the input \fIimage\fR
and returns the projected result.
.sp
Like the \fBresize\fR method above this method supports all
the possible interpolation types, i.e. nearest neighbour, bilinear,
and bicubic. By default \fBbilinear\fR interpolation is used, as a
compromise between accuracy and speed.
.sp
\fINote\fR that the returned result image is made as large as
necessary to contain the whole of the projected input. Depending on
the transformation this means that parts of the result can be black,
coming from outside of the boundaries of the input. Further, the
origin point of the result may conceptually be inside or outside of
the result instead of at the top left corner, because of pixels in the
input getting projected to negative coordinates. To handle this
situation the result will contain the physical coordinates of the
conceptual origin point in its meta data, under the hierarchical key
\fBcrimp origin\fR.
.PP
.SS CONVERTERS
.TP
\fB::crimp\fR \fBconvert 2grey8\fR \fIimage\fR
.TP
\fB::crimp\fR \fBconvert 2hsv\fR \fIimage\fR
.TP
\fB::crimp\fR \fBconvert 2rgba\fR \fIimage\fR
.TP
\fB::crimp\fR \fBconvert 2rgb\fR \fIimage\fR
This set of methods all convert their input \fIimage\fR to the
specified type and returns it as their result. All converters accept
an image of the destination type as input and will pass it through
unchanged.
.sp
The converters returning a \fBgrey8\fR image support \fBrgb\fR and
\fBrgba\fR as their input, using the ITU-R 601-2 luma transform to
merge the three color channels
.sp
The converters to HSV support \fBrgb\fR and \fBrgba\fR as their
input as well.
.sp
The conversion to \fBrgba\fR accepts only \fBhsv\fR as input,
adding a blank (fully opaque) alpha channel. For more control over the
contents of an image's alpha channel see the methods \fBsetalpha\fR
and \fBjoin rgba\fR.
.sp
At last, the conversion to \fBrgb\fR accepts both \fBrgba\fR and
\fBhsv\fR images as input.
.TP
\fB::crimp\fR \fBjoin 2hsv\fR \fIhueImage\fR \fIsatImage\fR \fIvalImage\fR
.TP
\fB::crimp\fR \fBjoin 2rgba\fR \fIredImage\fR \fIgreenImage\fR \fIblueImage\fR \fIalphaImage\fR
.TP
\fB::crimp\fR \fBjoin 2rgb\fR \fIredImage\fR \fIgreenImage\fR \fIblueImage\fR
This set of methods is the complement of method \fBsplit\fR. Each
take a set of \fBgrey8\fR images and fuse them together into an
image of the given type, with each input image becoming one channel of
the fusing result, which is returned as the result of the command. All
input images have to have the same dimensions.
.TP
\fB::crimp\fR \fBsplit\fR \fIimage\fR
This method takes an image of one of the multi-channel types, i.e.
\fBrgb\fR, const rgba], and \fBhsv\fR and returns a list of
\fBgrey8\fR images, each of which contains the contents of one of
the channels found in the input image.
.sp
The channel images in the result are provided in the same order as
they are accepted by the complementary \fBjoin\fR method, see
above.
.PP
.SS "I/O COMMANDS"
.TP
\fB::crimp\fR \fBread pgm\fR \fIstring\fR
This method returns an image of type \fBgrey8\fR containing the data
of the portable grey map (PGM) stored in the \fIstring\fR. The method
recognizes images in both plain and raw sub-formats.
.TP
\fB::crimp\fR \fBread ppm\fR \fIstring\fR
This method returns an image of type \fBrgb\fR containing the data
of the portable pix map (PPM) stored in the \fIstring\fR. The method
recognizes images in both plain and raw sub-formats.
.TP
\fB::crimp\fR \fBread strimj\fR \fIstring\fR ?\fIcolormap\fR?
This method returns an image of type \fBrgba\fR containing the data
of the \fIstrimj\fR (string image) (See \fIhttp://wiki.tcl.tk/1846\fR)
stored in the \fIstring\fR.
.sp
The caller can override the standard mapping from pixel characters
to colors by specifying a \fIcolormap\fR. This argument is interpreted as
dictionary mapping characters to triples of integers in the range
[0...255], specifying the red, green, and blue intensities.
.sp
An example of a strimj is:
.CS

@...@.......@.@......
@...@.......@.@......
@...@..@@@..@.@..@@@.
@@@@@.@...@.@.@.@...@
@...@.@@@@@.@.@.@...@
@...@.@.....@.@.@...@
@...@.@...@.@.@.@...@
@...@..@@@..@.@..@@@.

.CE
.TP
\fB::crimp\fR \fBread tcl grey8\fR \fIpixelmatrix\fR
This method takes the \fIpixelmatrix\fR, a list of rows, with each row
a list of pixel values in the domain [0..255] and returns an
image of type \fBgrey8\fR whose height is the number of rows, i.e.
the length of the outer list, and whose width is the maximum length
found among the inner lists. Rows whose inner list is shorter than the
maximum length are padded with black pixels, i.e. a pixel value of
\fB255\fR.
.TP
\fB::crimp\fR \fBread tcl float\fR \fIpixelmatrix\fR
This method takes the \fIpixelmatrix\fR, a list of rows, with each row
a list of floating point values for pixel values and returns an image
of type \fBfloat\fR whose height is the number of rows, i.e.  the
length of the outer list, and whose width is the maximum length found
among the inner lists. Rows whose inner list is shorter than the
maximum length are padded with a pixel value of \fB255\fR.
.TP
\fB::crimp\fR \fBread tk\fR \fIphoto\fR
This method returns an image of type \fBrgba\fR containing the data
from the specified Tk \fIphoto\fR image.
.TP
\fB::crimp\fR \fBwrite 2tk\fR \fIphoto\fR \fIimage\fR
This method writes the input \fIimage\fR to the specified Tk
\fIphoto\fR image.
.sp
The method supports the writing of \fBrgb\fR, \fBrgba\fR,
and \fBgrey8\fR images.
.TP
\fB::crimp\fR \fBwrite 2string\fR \fIformat\fR \fIimage\fR
.TP
\fB::crimp\fR \fBwrite 2chan\fR \fIformat\fR \fIchan\fR \fIimage\fR
.TP
\fB::crimp\fR \fBwrite 2file\fR \fIformat\fR \fIpath\fR \fIimage\fR
This family of methods either returns the input \fIimage\fR as a
binary string in the specified \fIformat\fR, or writes this string to
the open channel \fIchan\fR, or the named file at \fIpath\fR.
.sp
The image types accepted for writing are \fIformat\fR
dependent, and listed below, with the supported formats.
.sp
The currently supported formats are
.RS
.TP
\fBpgm-plain\fR
The plain ASCII format of portable grey maps, as per
\fIhttp://en.wikipedia.org/wiki/Netpbm_format\fR.
.sp
The methods support the writing of \fBrgb\fR, \fBrgba\fR,
\fBhsv\fR, and \fBgrey8\fR images.
.TP
\fBpgm-raw\fR
The raw binary format of portable grey maps, as per
\fIhttp://en.wikipedia.org/wiki/Netpbm_format\fR.
.sp
The methods support the writing of \fBrgb\fR, \fBrgba\fR,
\fBhsv\fR, and \fBgrey8\fR images.
.TP
\fBppm-plain\fR
The plain ASCII format of portable pix maps, as per
\fIhttp://en.wikipedia.org/wiki/Netpbm_format\fR.
.sp
The methods support the writing of \fBrgb\fR, \fBrgba\fR,
\fBhsv\fR, and \fBgrey8\fR images.
.TP
\fBppm-raw\fR
The raw binary format of portable pix maps, as per
\fIhttp://en.wikipedia.org/wiki/Netpbm_format\fR.
.sp
The methods support the writing of \fBrgb\fR, \fBrgba\fR,
\fBhsv\fR, and \fBgrey8\fR images.
.RE
.PP
.SS SUPPORT
.TP
\fB::crimp\fR \fBgradient grey8\fR \fIfrom\fR \fIto\fR \fIsize\fR
.TP
\fB::crimp\fR \fBgradient rgb\fR \fIfrom\fR \fIto\fR \fIsize\fR
.TP
\fB::crimp\fR \fBgradient rgba\fR \fIfrom\fR \fIto\fR \fIsize\fR
.TP
\fB::crimp\fR \fBgradient hsv\fR \fIfrom\fR \fIto\fR \fIsize\fR
This set of methods takes two "color" (pixel value) arguments and
returns an image of height 1 and width \fIsize\fR containing a
gradient interpolating between these two colors, with \fIfrom\fR in
the pixel at the left (x == 0) and \fIto\fR at the right
(x == \fIsize\fR-1).
.sp
\fIsize\fR has to be greater than or equal to \fB2\fR. An
error is thrown if that restriction is not met.
.sp
The resulting image has the type indicated in the method name.
This also specifies what is expected as the contents of the arguments
\fIfrom\fR and \fIto\fR. For \fBgrey8\fR these are simple pixel
values in the range 0...255 whereas for the types \fBrgb\fR and
\fBhsv\fR the arguments are triples (3-element lists) specifying
the R, G, and B (and H, S, and V respectively) values.
.TP
\fB::crimp\fR \fBkernel make\fR \fImatrix\fR ?\fIscale\fR? ?\fIoffset\fR?
This method takes a \fImatrix\fR of weights and an optional
\fIscale\fR factor and returns a structure containing the associated
convolution kernel, ready for use by method \fBfilter convolve\fR.
.sp
If \fIscale\fR is left unspecified it defaults to the sum of
all weights in the matrix.
.sp
If \fIoffset\fR is left unspecified it defaults to 128 if the
sum of weights is 0, and 0 else. In effect zero-sum kernels, like the
basic edge-detectors, are shifted so that results in the range
-128..127 correspond to 0..255.
.sp
The \fImatrix\fR has the same general format as the pixel
matrix for method \fBread tcl grey8\fR, i.e. a list of lists
(rows) of values, and is treated in the same way, i.e. the number of
columns is the maxium length over the row lists, and shorter lists are
padded with \fB128\fR. The values are expected to be integer numbers
in the range -128..127.
.TP
\fB::crimp\fR \fBkernel fpmake\fR \fImatrix\fR ?\fIoffset\fR?
This method is like \fBkernel make\fR except that the generated
kernel is based on floating-point values. Because of this it is not
accpeting a scale argument either, it is expected that the kernel
weights already have the proper sum.
.sp
The \fImatrix\fR has the same general format as the pixel
matrix for method \fBread tcl float\fR, i.e. a list of lists
(rows) of values, and is treated in the same way, i.e. the number of
columns is the maxium length over the row lists, and shorter lists are
padded with \fB255\fR.  The values are expected to be floating-point
numbers.
.TP
\fB::crimp\fR \fBkernel transpose\fR \fIkernel\fR
This method takes a \fIkernel\fR as returned by the method
\fBkernel make\fR and returns a transposed kernel, i.e. one where
the x- and y-axes are switched.
For example
.sp
.CS

                    (1)
                    (2)
    {1 2 4 2 1} ==> (4)
                    (2)
                    (1)

.CE
.sp
This method is its own inverse, i.e. application to its result returns
the original input, i.e.
.CS

    [transpose [transpose $K]] == $K

.CE
.TP
\fB::crimp\fR \fBmap\fR \fIarg\fR...
This method accepts the same sub-methods and arguments as are accepted
by the \fBtable\fR method below. In contrast to \fBtable\fR the
result is not a list of values, but a map image directly suitable as
argument to the \fBremap\fR method.
.TP
\fB::crimp\fR \fBmapof\fR \fItable\fR
This method accepts a list of 256 values, constructs a map image
directly suitable as argument to the \fBremap\fR method, and
returns this map image as its result.
.TP
\fB::crimp\fR \fBtable compose\fR \fIf\fR \fIg\fR
This accepts two lookup tables (aka functions) specified as lists of
256 values, constructs the composite function f(g(x)), and then
returns this new function as its result.
.TP
\fB::crimp\fR \fBtable eval wrap\fR \fIcmd\fR
.TP
\fB::crimp\fR \fBtable eval clamp\fR \fIcmd\fR
This method returns a list of 256 values, the result of running the
values 0 to 255 through the function specified by the command prefix
\fIcmd\fR.
The results returned by the command prefix are rounded to the nearest
integer and then forced into the domain [0..255] by either
wrapping them around (modulo 256), or clamping them to the appropriate
border, i.e 0, and 255 respectively.
.sp
The signature of the command prefix is
.RS
.TP
\fB<cmd>\fR \fIx\fR
which is expected to return a number in the range
[0..255]. While the result should be an integer number it is
allowed to be a float, the caller takes care to round the result to
the nearest integer.
.RE
.TP
\fB::crimp\fR \fBtable degamma\fR \fIy\fR
This method returns a list of 256 values, the result of running the
values 0 to 255 through the \fBinverse gamma correction\fR with
parameter \fIy\fR.
This inverse correction, defined in the domain of [0..1] for
both argument and result, is defined as:
.sp
.PS
.nf
gamma^{-1}_y (x) = x^{\\frac{1}{y}}

.fi
.PE
.sp
Scaling of argument and result into the domain [0..255] of pixel
values, and rounding results to the nearest integer, causes the actual
definition used to be
.sp
.PS
.nf
gamma^{-1}_y (x) = [ 255 (\\frac{x}{255})^{\\frac{1}{y}} ]

.fi
.PE
.TP
\fB::crimp\fR \fBtable gamma\fR \fIy\fR
This method returns a list of 256 values, the result of running the
values 0 to 255 through the \fBgamma correction\fR with parameter
\fIy\fR.
This correction, defined in the domain of [0..1] for both
argument and result, is defined as:
.sp
.PS
.nf
gamma_y (x) = x^y

.fi
.PE
.sp
Scaling of argument and result into the domain [0..255] of pixel
values, and rounding results to the nearest integer, causes the actual
definition used to be
.sp
.PS
.nf
gamma_y (x) = [ 255 (\\frac{x}{255})^y ]

.fi
.PE
.TP
\fB::crimp\fR \fBtable gauss\fR \fIsigma\fR
This method returns a list of 256 values, the result of running the
values 0 to 255 through the \fBsampled gauss\fR function with
parameter \fIsigma\fR.
This function is defined as:
.sp
.PS
.nf
gauss_\\sigma (x) = [255 e^{-\\frac{x-127.5}{2\\sigma^2}}]

.fi
.PE
.sp
.TP
\fB::crimp\fR \fBtable identity\fR
This method returns a list of 256 values, the result of running the
values 0 to 255 through the \fBidentity\fR function, which is defined
as
.sp
.PS
.nf
identity (x) = x

.fi
.PE
.TP
\fB::crimp\fR \fBtable invers\fR
This method returns a list of 256 values, the result of running the
values 0 to 255 through the \fBinverse\fR function, which is defined
as
.sp
.PS
.nf
inverse (x) = 255 - x

.fi
.PE
.TP
\fB::crimp\fR \fBtable linear wrap\fR \fIgain\fR \fIoffset\fR
.TP
\fB::crimp\fR \fBtable linear clamp\fR \fIgain\fR \fIoffset\fR
This method returns a list of 256 values, the result of running the
values 0 to 255 through a simple linear function with parameters
\fIgain\fR (the slope) and \fIoffset\fR. The results are rounded to
the nearest integer and then forced into the domain [0..255] by
either wrapping them around (modulo 256), or clamping them to the
appropriate border, i.e 0, and 255 respectively.
Thus the relevant definitions are
.sp
.PS
.nf
linear^{wrap}_{gain,offset} (x) = [ gain x + offset ] \\oplus_{256} 0

.fi
.PE
for the wrapped case, and
.sp
.PS
.nf
linear^{clamp}_{gain,offset} (x) = min (0, max (255, [ gain x + offset ]))

.fi
.PE
when clamping.
.TP
\fB::crimp\fR \fBtable log\fR ?\fImax\fR?
This method returns a list of 256 values, the result of running the
values 0 to 255 through the \fBlog-compression\fR function with
parameter \fImax\fR. This parameter is the maximum pixel value the
function is for, this value, and all larger will be mapped to 255.
This function is defined as:
.sp
.PS
.nf
logcompress_{max} (x) = max(255, \\frac{255}{ln(1+max)} ln(1+x))

.fi
.PE
.sp
.TP
\fB::crimp\fR \fBtable solarize\fR \fIthreshold\fR
This method returns a list of 256 values, the result of running the
values 0 to 255 through the \fBsolarize\fR function, with parameter
\fIthreshold\fR. This function is defined as:
.sp
.PS
.nf
solarize_{threshold} (x) = \\left\\{\\begin{eqnarray}
x       & x < threshold \\\\
255 - x & x \\ge threshold \\\\
\\end{eqnarray}\\right

.fi
.PE
.sp
Note how the function is the \fBidentity\fR for values under the
threshold, and the \fBinverse\fR for values at and above it. Its
application to an image produces what is known as either
\fIsolarization\fR or \fIsabattier effect\fR.
.TP
\fB::crimp\fR \fBtable sqrt\fR ?\fImax\fR?
This method returns a list of 256 values, the result of running the
values 0 to 255 through the \fBsqrt-compression\fR function with
parameter \fImax\fR. This parameter is the maximum pixel value the
function is for, this value, and all larger will be mapped to 255.
This function is defined as:
.sp
.PS
.nf
sqrtcompress_{max} (x) = max(255, \\frac{255}{\\sqrt{max}} \\sqrt{x})

.fi
.PE
.sp
.TP
\fB::crimp\fR \fBtable stretch\fR \fImin\fR \fImax\fR
This is a convenience method around \fBtable linear\fR which maps
\fImin\fR to 0, and \fImax\fR to 255, with linear interpolation in
between. Values below \fImin\fR and above \fImax\fR are clamped to 0
and 255 respectively.
.TP
\fB::crimp\fR \fBtable threshold above\fR \fIthreshold\fR
This method returns a list of 256 values, the result of running the
values 0 to 255 through a \fBthresholding\fR (or \fIbinarization\fR)
function, with parameter \fIthreshold\fR. This function is defined as:
.sp
.PS
.nf
f_{threshold} (x) = \\left\\{\\begin{eqnarray}
0   & x \\ge threshold \\\\
255 & x < threshold \\\\
\\end{eqnarray}\\right



.fi
.PE
.sp
.TP
\fB::crimp\fR \fBtable threshold below\fR \fIthreshold\fR
This method returns a list of 256 values, the result of running the
values 0 to 255 through a \fBthresholding\fR (or \fIbinarization\fR)
function, with parameter \fIthreshold\fR. This function is defined as:
.sp
.PS
.nf
f_{threshold} (x) = \\left\\{\\begin{eqnarray}
0   & x < threshold \\\\
255 & x \\ge threshold \\\\
\\end{eqnarray}\\right



.fi
.PE
.sp
.TP
\fB::crimp\fR \fBtable threshold inside\fR \fImin\fR \fImax\fR
This method returns a list of 256 values, the result of running the
values 0 to 255 through a \fBthresholding\fR (or \fIbinarization\fR)
function, with parameters \fImin\fR and \fImax\fR. This function is
defined as:
.sp
.PS
.nf
f_{min,max} (x) = \\left\\{\\begin{eqnarray}
255 & x \\le min \\\\
0   & min < x < max \\\\
255 & max \\le x \\\\
\\end{eqnarray}\\right



.fi
.PE
.sp
.TP
\fB::crimp\fR \fBtable threshold outside\fR \fImin\fR \fImax\fR
This method returns a list of 256 values, the result of running the
values 0 to 255 through a \fBthresholding\fR (or \fIbinarization\fR)
function, with parameters \fImin\fR and \fImax\fR. This function is
defined as:
.sp
.PS
.nf
f_{min,max} (x) = \\left\\{\\begin{eqnarray}
0   & x \\le min \\\\
255 & min < x < max \\\\
0   & max \\le x \\\\
\\end{eqnarray}\\right



.fi
.PE
.sp
.TP
\fB::crimp\fR \fBtable fgauss discrete\fR \fIsigma\fR ?\fIr\fR?
.TP
\fB::crimp\fR \fBtable fgauss sampled\fR \fIsigma\fR ?\fIr\fR?
This method computes the table for a discrete or sampled gaussian with
parameters \fIsigma\fR and kernel \fIr\fRadius. If the radius is not
specified it defaults to the smallest integer greater than
"3*\fIsigma\fR".
.TP
\fB::crimp\fR \fBtransform affine\fR \fIa\fR \fIb\fR \fIc\fR \fId\fR \fIe\fR \fIf\fR
This method returns the affine transformation specified by the 2x3
matrix
.CS

    |a b c|
    |d e f|

.CE
Note that it is in general easier to use the methods \fBrotate\fR,
\fBscale\fR, and \fBtranslate\fR \fBscale\fR to generate the
desired transformation piecemal and then use \fBchain\fR to chain the
pieces together.
.TP
\fB::crimp\fR \fBtransform chain\fR \fItransform\fR...
This method computes and returns the projective transformation
generated by applying the specified transformations in reverse order,
i.e with the transformation at the end of the argument list applied
first, then the one before it, etc.
.TP
\fB::crimp\fR \fBtransform invert\fR \fItransform\fR
This method computes and returns the inverse of the specified
projective \fItransform\fRation.
.TP
\fB::crimp\fR \fBtransform projective\fR \fIa\fR \fIb\fR \fIc\fR \fId\fR \fIe\fR \fIf\fR \fIg\fR \fIh\fR
This method returns the projective transformation specified by the 3x3
matrix
.CS

    |a b c|
    |d e f|
    |g h 1|

.CE
Note that for the affine subset of projective transformation it is in
general easier to use the methods \fBrotate\fR, \fBscale\fR, and
\fBtranslate\fR \fBscale\fR to generate the desired
transformation piecemal and then use \fBchain\fR to chain the pieces
together.
.sp
And for a true perspective transformation specification through
\fBquadrilateral\fR should be simpler as well.
.TP
\fB::crimp\fR \fBtransform quadrilateral\fR \fIsrc\fR \fIdst\fR
This method returns the projective transformation which maps the
quadrilateral \fIsrc\fR on to the quadrilateral \fIdst\fR.
.sp
Each quadrilateral is specified as a list of 4 points, each
point a pair of x- and y-coordinates.
.TP
\fB::crimp\fR \fBtransform rotate\fR \fItheta\fR ?\fIcenter\fR?
This methods returns the projective transformation which rotates the
image by the anglie \fItheta\fR around the point \fIcenter\fR. If the
latter is not specified {0 0} is assumed. The point, if present, is
specified as pair of x- and y-coordinates.
.sp
The angle is specified in degrees, with \fB0\fR not rotating
the image at all. Positive values cause a counterclockwise rotation,
negative values a clockwise one.
.TP
\fB::crimp\fR \fBtransform scale\fR \fIsx\fR \fIsy\fR
This methods returns the projective transformation which scales an
image by factor \fIsx\fR in width, and \fIsy\fR in height. Values
larger than \fB1\fR expand the image along the specified dimension,
while values less than \fB1\fR shrink it. Negative values flip the
respective axis.
.TP
\fB::crimp\fR \fBtransform translate\fR \fIdx\fR \fIdy\fR
This methods returns the projective transformation which translates an
image by \fIdx\fR pixels along the x-axis, and \fIdx\fR pixels along
the y-axis. Values larger than \fB0\fR move the image to the right,
or down, along the specified dimension, while values less than
\fB0\fR move it to the left, or up.
.PP
.SH REFERENCES
.IP [1]
Simon Perreault and Patrick Hebert, "Median Filtering in Constant Time", 2007
\fIhttp://nomis80.org/ctmf.html\fR
.IP [2]
Nobuyuki Otsu, "A threshold selection method from gray-level histograms", 1979
\fIhttp://en.wikipedia.org/wiki/Otsu%27s_method\fR
.PP
.SH KEYWORDS
affine, affine transform, alpha, alpha blending, alpha channel, average, binarization, black tophat, blending, channels, charcoal, clockwise, closing, composite blending, composition, const expansion, convolution filter, counter-clockwise, cropping, cut region, cyclic wrap expansion, dilation, dimensions, edge shrinking, edge-detection, effect, emboss, erosion, expansion, extend expansion, external gradient, extract rectangle, extract region, fast fourier transform, fft, filter, flip, fourier transform, gamma correction, geometry, gradient, histogram, hypot, image, integral image, internal gradient, inverse fourier transform, inversion, log-compression, matrix, max, max-filter, mean, mean filter, median, median-filter, middle, min, min-filter, mirror expansion, montage, morphology, opening, otsu threshold, perspective, photo, pixel mapping, prewitt, projective, projective transform, rank-order filter, rectangle cut, rectangle extraction, region cut, remapping, replicate edge expansion, rescale, resize, rotate, rotation, sabattier effect, scale, scharr, sharpen, shrinking, sobel, solarization, sqrt-compression, standard deviation filter, statistics, stddev, summed area table, threshold, thresholding, tophat, toroidal wrap expansion, transform, translate, variance, vector-field, warp, white tophat, wrap expansion
.SH COPYRIGHT
.nf
Copyright (c) 2010 Andreas Kupries
Copyright (c) 2010 Documentation, Andreas Kupries

.fi






Added embedded/man/index.n.



































































































































































































































































































































































































































































































































































































































































































































































































































































































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
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

'\"
'\" Generated by tcllib/doctools/idx with format 'nroff'
'\" The definitions below are for supplemental macros used in Tcl/Tk
'\" manual entries.
'\"
'\" .AP type name in/out ?indent?
'\"	Start paragraph describing an argument to a library procedure.
'\"	type is type of argument (int, etc.), in/out is either "in", "out",
'\"	or "in/out" to describe whether procedure reads or modifies arg,
'\"	and indent is equivalent to second arg of .IP (shouldn't ever be
'\"	needed;  use .AS below instead)
'\"
'\" .AS ?type? ?name?
'\"	Give maximum sizes of arguments for setting tab stops.  Type and
'\"	name are examples of largest possible arguments that will be passed
'\"	to .AP later.  If args are omitted, default tab stops are used.
'\"
'\" .BS
'\"	Start box enclosure.  From here until next .BE, everything will be
'\"	enclosed in one large box.
'\"
'\" .BE
'\"	End of box enclosure.
'\"
'\" .CS
'\"	Begin code excerpt.
'\"
'\" .CE
'\"	End code excerpt.
'\"
'\" .VS ?version? ?br?
'\"	Begin vertical sidebar, for use in marking newly-changed parts
'\"	of man pages.  The first argument is ignored and used for recording
'\"	the version when the .VS was added, so that the sidebars can be
'\"	found and removed when they reach a certain age.  If another argument
'\"	is present, then a line break is forced before starting the sidebar.
'\"
'\" .VE
'\"	End of vertical sidebar.
'\"
'\" .DS
'\"	Begin an indented unfilled display.
'\"
'\" .DE
'\"	End of indented unfilled display.
'\"
'\" .SO
'\"	Start of list of standard options for a Tk widget.  The
'\"	options follow on successive lines, in four columns separated
'\"	by tabs.
'\"
'\" .SE
'\"	End of list of standard options for a Tk widget.
'\"
'\" .OP cmdName dbName dbClass
'\"	Start of description of a specific option.  cmdName gives the
'\"	option's name as specified in the class command, dbName gives
'\"	the option's name in the option database, and dbClass gives
'\"	the option's class in the option database.
'\"
'\" .UL arg1 arg2
'\"	Print arg1 underlined, then print arg2 normally.
'\"
'\" RCS: @(#) $Id: man.macros,v 1.1 2009/01/30 04:56:47 andreas_kupries Exp $
'\"
'\"	# Set up traps and other miscellaneous stuff for Tcl/Tk man pages.
.if t .wh -1.3i ^B
.nr ^l \n(.l
.ad b
'\"	# Start an argument description
.de AP
.ie !"\\$4"" .TP \\$4
.el \{\
.   ie !"\\$2"" .TP \\n()Cu
.   el          .TP 15
.\}
.ta \\n()Au \\n()Bu
.ie !"\\$3"" \{\
\&\\$1	\\fI\\$2\\fP	(\\$3)
.\".b
.\}
.el \{\
.br
.ie !"\\$2"" \{\
\&\\$1	\\fI\\$2\\fP
.\}
.el \{\
\&\\fI\\$1\\fP
.\}
.\}
..
'\"	# define tabbing values for .AP
.de AS
.nr )A 10n
.if !"\\$1"" .nr )A \\w'\\$1'u+3n
.nr )B \\n()Au+15n
.\"
.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n
.nr )C \\n()Bu+\\w'(in/out)'u+2n
..
.AS Tcl_Interp Tcl_CreateInterp in/out
'\"	# BS - start boxed text
'\"	# ^y = starting y location
'\"	# ^b = 1
.de BS
.br
.mk ^y
.nr ^b 1u
.if n .nf
.if n .ti 0
.if n \l'\\n(.lu\(ul'
.if n .fi
..
'\"	# BE - end boxed text (draw box now)
.de BE
.nf
.ti 0
.mk ^t
.ie n \l'\\n(^lu\(ul'
.el \{\
.\"	Draw four-sided box normally, but don't draw top of
.\"	box if the box started on an earlier page.
.ie !\\n(^b-1 \{\
\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
.\}
.el \}\
\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
.\}
.\}
.fi
.br
.nr ^b 0
..
'\"	# VS - start vertical sidebar
'\"	# ^Y = starting y location
'\"	# ^v = 1 (for troff;  for nroff this doesn't matter)
.de VS
.if !"\\$2"" .br
.mk ^Y
.ie n 'mc \s12\(br\s0
.el .nr ^v 1u
..
'\"	# VE - end of vertical sidebar
.de VE
.ie n 'mc
.el \{\
.ev 2
.nf
.ti 0
.mk ^t
\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n'
.sp -1
.fi
.ev
.\}
.nr ^v 0
..
'\"	# Special macro to handle page bottom:  finish off current
'\"	# box/sidebar if in box/sidebar mode, then invoked standard
'\"	# page bottom macro.
.de ^B
.ev 2
'ti 0
'nf
.mk ^t
.if \\n(^b \{\
.\"	Draw three-sided box if this is the box's first page,
.\"	draw two sides but no top otherwise.
.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
.\}
.if \\n(^v \{\
.nr ^x \\n(^tu+1v-\\n(^Yu
\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c
.\}
.bp
'fi
.ev
.if \\n(^b \{\
.mk ^y
.nr ^b 2
.\}
.if \\n(^v \{\
.mk ^Y
.\}
..
'\"	# DS - begin display
.de DS
.RS
.nf
.sp
..
'\"	# DE - end display
.de DE
.fi
.RE
.sp
..
'\"	# SO - start of list of standard options
.de SO
.SH "STANDARD OPTIONS"
.LP
.nf
.ta 4c 8c 12c
.ft B
..
'\"	# SE - end of list of standard options
.de SE
.fi
.ft R
.LP
See the \\fBoptions\\fR manual entry for details on the standard options.
..
'\"	# OP - start of full description for a single option
.de OP
.LP
.nf
.ta 4c
Command-Line Name:	\\fB\\$1\\fR
Database Name:	\\fB\\$2\\fR
Database Class:	\\fB\\$3\\fR
.fi
.IP
..
'\"	# CS - begin code excerpt
.de CS
.RS
.nf
.ta .25i .5i .75i 1i
..
'\"	# CE - end code excerpt
.de CE
.fi
.RE
..
.de UL
\\$1\l'|0\(ul'\\$2
..
.TH "Keyword Index" n
.BS
.SH INDEX
doc
.RS
affine
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
affine transform
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
alpha
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
alpha blending
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
alpha channel
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
average
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
binarization
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
black tophat
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
blending
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
channels
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
charcoal
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
clockwise
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
closing
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
composite blending
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
composition
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
const expansion
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
convolution filter
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
counter-clockwise
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
cropping
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
cut region
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
cyclic wrap expansion
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
dilation
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
dimensions
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
edge shrinking
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
edge-detection
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
effect
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
emboss
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
erosion
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
expansion
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
extend expansion
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
external gradient
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
extract rectangle
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
extract region
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
fast fourier transform
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
fft
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
filter
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
flip
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
fourier transform
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
gamma correction
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
geometry
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
gradient
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
histogram
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
hypot
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
image
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
integral image
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
internal gradient
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
inverse fourier transform
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
inversion
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
log-compression
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
matrix
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
max
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
max-filter
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
mean
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
mean filter
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
median
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
median-filter
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
middle
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
min
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
min-filter
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
mirror expansion
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
montage
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
morphology
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
opening
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
otsu threshold
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
perspective
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
photo
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
pixel mapping
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
prewitt
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
projective
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
projective transform
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
rank-order filter
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
rectangle cut
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
rectangle extraction
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
region cut
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
remapping
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
replicate edge expansion
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
rescale
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
resize
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
rotate
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
rotation
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
sabattier effect
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
scale
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
scharr
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
sharpen
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
shrinking
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
sobel
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
solarization
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
sqrt-compression
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
standard deviation filter
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
statistics
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
stddev
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
summed area table
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
threshold
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
thresholding
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
tophat
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
toroidal wrap expansion
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
transform
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
translate
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
variance
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
vector-field
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
warp
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
white tophat
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE
wrap expansion
.RS
.TP
\fBfiles/crimp.n\fR
crimp
.RE






Added embedded/man/toc.n.




























































































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

'\"
'\" Generated by tcllib/doctools/toc with format 'nroff'
'\" The definitions below are for supplemental macros used in Tcl/Tk
'\" manual entries.
'\"
'\" .AP type name in/out ?indent?
'\"	Start paragraph describing an argument to a library procedure.
'\"	type is type of argument (int, etc.), in/out is either "in", "out",
'\"	or "in/out" to describe whether procedure reads or modifies arg,
'\"	and indent is equivalent to second arg of .IP (shouldn't ever be
'\"	needed;  use .AS below instead)
'\"
'\" .AS ?type? ?name?
'\"	Give maximum sizes of arguments for setting tab stops.  Type and
'\"	name are examples of largest possible arguments that will be passed
'\"	to .AP later.  If args are omitted, default tab stops are used.
'\"
'\" .BS
'\"	Start box enclosure.  From here until next .BE, everything will be
'\"	enclosed in one large box.
'\"
'\" .BE
'\"	End of box enclosure.
'\"
'\" .CS
'\"	Begin code excerpt.
'\"
'\" .CE
'\"	End code excerpt.
'\"
'\" .VS ?version? ?br?
'\"	Begin vertical sidebar, for use in marking newly-changed parts
'\"	of man pages.  The first argument is ignored and used for recording
'\"	the version when the .VS was added, so that the sidebars can be
'\"	found and removed when they reach a certain age.  If another argument
'\"	is present, then a line break is forced before starting the sidebar.
'\"
'\" .VE
'\"	End of vertical sidebar.
'\"
'\" .DS
'\"	Begin an indented unfilled display.
'\"
'\" .DE
'\"	End of indented unfilled display.
'\"
'\" .SO
'\"	Start of list of standard options for a Tk widget.  The
'\"	options follow on successive lines, in four columns separated
'\"	by tabs.
'\"
'\" .SE
'\"	End of list of standard options for a Tk widget.
'\"
'\" .OP cmdName dbName dbClass
'\"	Start of description of a specific option.  cmdName gives the
'\"	option's name as specified in the class command, dbName gives
'\"	the option's name in the option database, and dbClass gives
'\"	the option's class in the option database.
'\"
'\" .UL arg1 arg2
'\"	Print arg1 underlined, then print arg2 normally.
'\"
'\" RCS: @(#) $Id: man.macros,v 1.1 2009/01/30 04:56:47 andreas_kupries Exp $
'\"
'\"	# Set up traps and other miscellaneous stuff for Tcl/Tk man pages.
.if t .wh -1.3i ^B
.nr ^l \n(.l
.ad b
'\"	# Start an argument description
.de AP
.ie !"\\$4"" .TP \\$4
.el \{\
.   ie !"\\$2"" .TP \\n()Cu
.   el          .TP 15
.\}
.ta \\n()Au \\n()Bu
.ie !"\\$3"" \{\
\&\\$1	\\fI\\$2\\fP	(\\$3)
.\".b
.\}
.el \{\
.br
.ie !"\\$2"" \{\
\&\\$1	\\fI\\$2\\fP
.\}
.el \{\
\&\\fI\\$1\\fP
.\}
.\}
..
'\"	# define tabbing values for .AP
.de AS
.nr )A 10n
.if !"\\$1"" .nr )A \\w'\\$1'u+3n
.nr )B \\n()Au+15n
.\"
.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n
.nr )C \\n()Bu+\\w'(in/out)'u+2n
..
.AS Tcl_Interp Tcl_CreateInterp in/out
'\"	# BS - start boxed text
'\"	# ^y = starting y location
'\"	# ^b = 1
.de BS
.br
.mk ^y
.nr ^b 1u
.if n .nf
.if n .ti 0
.if n \l'\\n(.lu\(ul'
.if n .fi
..
'\"	# BE - end boxed text (draw box now)
.de BE
.nf
.ti 0
.mk ^t
.ie n \l'\\n(^lu\(ul'
.el \{\
.\"	Draw four-sided box normally, but don't draw top of
.\"	box if the box started on an earlier page.
.ie !\\n(^b-1 \{\
\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
.\}
.el \}\
\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
.\}
.\}
.fi
.br
.nr ^b 0
..
'\"	# VS - start vertical sidebar
'\"	# ^Y = starting y location
'\"	# ^v = 1 (for troff;  for nroff this doesn't matter)
.de VS
.if !"\\$2"" .br
.mk ^Y
.ie n 'mc \s12\(br\s0
.el .nr ^v 1u
..
'\"	# VE - end of vertical sidebar
.de VE
.ie n 'mc
.el \{\
.ev 2
.nf
.ti 0
.mk ^t
\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n'
.sp -1
.fi
.ev
.\}
.nr ^v 0
..
'\"	# Special macro to handle page bottom:  finish off current
'\"	# box/sidebar if in box/sidebar mode, then invoked standard
'\"	# page bottom macro.
.de ^B
.ev 2
'ti 0
'nf
.mk ^t
.if \\n(^b \{\
.\"	Draw three-sided box if this is the box's first page,
.\"	draw two sides but no top otherwise.
.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
.\}
.if \\n(^v \{\
.nr ^x \\n(^tu+1v-\\n(^Yu
\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c
.\}
.bp
'fi
.ev
.if \\n(^b \{\
.mk ^y
.nr ^b 2
.\}
.if \\n(^v \{\
.mk ^Y
.\}
..
'\"	# DS - begin display
.de DS
.RS
.nf
.sp
..
'\"	# DE - end display
.de DE
.fi
.RE
.sp
..
'\"	# SO - start of list of standard options
.de SO
.SH "STANDARD OPTIONS"
.LP
.nf
.ta 4c 8c 12c
.ft B
..
'\"	# SE - end of list of standard options
.de SE
.fi
.ft R
.LP
See the \\fBoptions\\fR manual entry for details on the standard options.
..
'\"	# OP - start of full description for a single option
.de OP
.LP
.nf
.ta 4c
Command-Line Name:	\\fB\\$1\\fR
Database Name:	\\fB\\$2\\fR
Database Class:	\\fB\\$3\\fR
.fi
.IP
..
'\"	# CS - begin code excerpt
.de CS
.RS
.nf
.ta .25i .5i .75i 1i
..
'\"	# CE - end code excerpt
.de CE
.fi
.RE
..
.de UL
\\$1\l'|0\(ul'\\$2
..
.TH "Table Of Contents" n
.BS
.SH CONTENTS
doc
.RS
.TP
\fBcrimp\fR
\fIfiles/crimp.n\fR: Image Manipulation (not yet independent of Tk)






Added embedded/www/files/crimp.html.































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































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
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


<html><head>
<title>crimp - Image Manipulation</title>
<style type="text/css"><!--
    HTML {
	background: 	#FFFFFF;
	color: 		black;
    }
    BODY {
	background: 	#FFFFFF;
	color:	 	black;
    }
    DIV.doctools {
	margin-left:	10%;
	margin-right:	10%;
    }
    DIV.doctools H1,DIV.doctools H2 {
	margin-left:	-5%;
    }
    H1, H2, H3, H4 {
	margin-top: 	1em;
	font-family:	sans-serif;
	font-size:	large;
	color:		#005A9C;
	background: 	transparent;
	text-align:		left;
    }
    H1.title {
	text-align: center;
    }
    UL,OL {
	margin-right: 0em;
	margin-top: 3pt;
	margin-bottom: 3pt;
    }
    UL LI {
	list-style: disc;
    }
    OL LI {
	list-style: decimal;
    }
    DT {
	padding-top: 	1ex;
    }
    UL.toc,UL.toc UL, UL.toc UL UL {
	font:		normal 12pt/14pt sans-serif;
	list-style:	none;
    }
    LI.section, LI.subsection {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding: 	0em;
    }
    PRE {
	display: 	block;
	font-family:	monospace;
	white-space:	pre;
	margin:		0%;
	padding-top:	0.5ex;
	padding-bottom:	0.5ex;
	padding-left:	1ex;
	padding-right:	1ex;
	width:		100%;
    }
    PRE.example {
	color: 		black;
	background: 	#f5dcb3;
	border:		1px solid black;
    }
    UL.requirements LI, UL.syntax LI {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding:	0em;
    }
    DIV.synopsis {
	color: 		black;
	background: 	#80ffff;
	border:		1px solid black;
	font-family:	serif;
	margin-top: 	1em;
	margin-bottom: 	1em;
    }
    UL.syntax {
	margin-top: 	1em;
	border-top:	1px solid black;
    }
    UL.requirements {
	margin-bottom: 	1em;
	border-bottom:	1px solid black;
    }
--></style>
</head>
<! -- Generated from file '/home/aku/Projects/Tcl/Crimp/dev/embedded/www/files/crimp.html' by tcllib/doctools with format 'html'
   -->
<! -- Copyright &copy; 2010 Andreas Kupries   -- Copyright &copy; 2010 Documentation, Andreas Kupries
   -->
<! -- CVS: $Id$ crimp.n
   -->
<body><div class="doctools">
<hr> [
  <a href="../toc.html">Table Of Contents</a>
| <a href="../index.html">Keyword Index</a>
] <hr>
<h1 class="title">crimp(n) 1.0.1 doc &quot;Image Manipulation&quot;</h1>
<div id="name" class="section"><h2><a name="name">Name</a></h2>
<p>crimp - Image Manipulation (not yet independent of Tk)</p>
</div>
<div id="toc" class="section"><h2><a name="toc">Table Of Contents</a></h2>
<ul class="toc">
<li class="section"><a href="#toc">Table Of Contents</a></li>
<li class="section"><a href="#synopsis">Synopsis</a></li>
<li class="section"><a href="#section1">Description</a></li>
<li class="section"><a href="#section2">Images</a></li>
<li class="section"><a href="#section3">Image Types</a></li>
<li class="section"><a href="#section4">General design</a></li>
<li class="section"><a href="#section5">API</a>
<ul>
<li class="subsection"><a href="#subsection1">Accessors</a></li>
<li class="subsection"><a href="#subsection2">Manipulators</a></li>
<li class="subsection"><a href="#subsection3">Converters</a></li>
<li class="subsection"><a href="#subsection4">I/O commands</a></li>
<li class="subsection"><a href="#subsection5">Support</a></li>
</ul>
</li>
<li class="section"><a href="#section6">References</a></li>
<li class="section"><a href="#keywords">Keywords</a></li>
<li class="section"><a href="#copyright">Copyright</a></li>
</ul>
</div>
<div id="synopsis" class="section"><h2><a name="synopsis">Synopsis</a></h2>
<div class="synopsis">
<ul class="requirements">
<li>package require <b class="pkgname">Tcl 8.5</b></li>
<li>package require <b class="pkgname">Tk 8.5</b></li>
<li>package require <b class="pkgname">crimp <span class="opt">?0?</span></b></li>
</ul>
<ul class="syntax">
<li><a href="#1"><b class="cmd">::crimp</b> <b class="method">channels</b> <i class="arg">image</i></a></li>
<li><a href="#2"><b class="cmd">::crimp</b> <b class="method">dimensions</b> <i class="arg">image</i></a></li>
<li><a href="#3"><b class="cmd">::crimp</b> <b class="method">height</b> <i class="arg">image</i></a></li>
<li><a href="#4"><b class="cmd">::crimp</b> <b class="method">histogram</b> <i class="arg">image</i></a></li>
<li><a href="#5"><b class="cmd">::crimp</b> <b class="method">meta append</b> <i class="arg">image</i> <i class="arg">key</i> <span class="opt">?<i class="arg">string</i>...?</span></a></li>
<li><a href="#6"><b class="cmd">::crimp</b> <b class="method">meta create</b> <i class="arg">image</i> <span class="opt">?<i class="arg">key</i> <i class="arg">value</i>...?</span></a></li>
<li><a href="#7"><b class="cmd">::crimp</b> <b class="method">meta exists</b> <i class="arg">image</i> <i class="arg">key</i> <span class="opt">?<i class="arg">key</i>...?</span></a></li>
<li><a href="#8"><b class="cmd">::crimp</b> <b class="method">meta filter</b> <i class="arg">image</i> <i class="arg">args</i>...</a></li>
<li><a href="#9"><b class="cmd">::crimp</b> <b class="method">meta for</b> <i class="arg">image</i> {<i class="arg">keyVar</i> <i class="arg">valueVar</i>} <i class="arg">body</i></a></li>
<li><a href="#10"><b class="cmd">::crimp</b> <b class="method">meta get</b> <i class="arg">image</i> <span class="opt">?<i class="arg">key</i>...?</span></a></li>
<li><a href="#11"><b class="cmd">::crimp</b> <b class="method">meta incr</b> <i class="arg">image</i> <i class="arg">key</i> <span class="opt">?<i class="arg">increment</i>?</span></a></li>
<li><a href="#12"><b class="cmd">::crimp</b> <b class="method">meta info</b> <i class="arg">image</i></a></li>
<li><a href="#13"><b class="cmd">::crimp</b> <b class="method">meta keys</b> <i class="arg">image</i> <span class="opt">?<i class="arg">globPattern</i>?</span></a></li>
<li><a href="#14"><b class="cmd">::crimp</b> <b class="method">meta lappend</b> <i class="arg">image</i> <i class="arg">key</i> <span class="opt">?<i class="arg">value</i>...?</span></a></li>
<li><a href="#15"><b class="cmd">::crimp</b> <b class="method">meta merge</b> <i class="arg">image</i> <span class="opt">?<i class="arg">dictionaryValue</i>...?</span></a></li>
<li><a href="#16"><b class="cmd">::crimp</b> <b class="method">meta remove</b> <i class="arg">image</i> <span class="opt">?<i class="arg">key</i>...?</span></a></li>
<li><a href="#17"><b class="cmd">::crimp</b> <b class="method">meta replace</b> <i class="arg">image</i> <span class="opt">?<i class="arg">key</i> <i class="arg">value</i>...?</span></a></li>
<li><a href="#18"><b class="cmd">::crimp</b> <b class="method">meta set</b> <i class="arg">image</i> <i class="arg">key</i> <span class="opt">?<i class="arg">key</i>...?</span> <i class="arg">value</i></a></li>
<li><a href="#19"><b class="cmd">::crimp</b> <b class="method">meta size</b> <i class="arg">image</i></a></li>
<li><a href="#20"><b class="cmd">::crimp</b> <b class="method">meta unset</b> <i class="arg">image</i> <i class="arg">key</i> <span class="opt">?<i class="arg">key</i>...?</span></a></li>
<li><a href="#21"><b class="cmd">::crimp</b> <b class="method">meta values</b> <i class="arg">image</i> <span class="opt">?<i class="arg">globPattern</i>?</span></a></li>
<li><a href="#22"><b class="cmd">::crimp</b> <b class="method">pixel</b> <i class="arg">image</i></a></li>
<li><a href="#23"><b class="cmd">::crimp</b> <b class="method">statistics basic</b> <i class="arg">image</i></a></li>
<li><a href="#24"><b class="cmd">::crimp</b> <b class="method">statistics otsu</b> <i class="arg">stats</i></a></li>
<li><a href="#25"><b class="cmd">::crimp</b> <b class="method">type</b> <i class="arg">image</i></a></li>
<li><a href="#26"><b class="cmd">::crimp</b> <b class="method">width</b> <i class="arg">image</i></a></li>
<li><a href="#27"><b class="cmd">::crimp</b> <b class="method">add</b> <i class="arg">image1</i> <i class="arg">image2</i> <span class="opt">?<i class="arg">scale</i>?</span> <span class="opt">?<i class="arg">offset</i>?</span></a></li>
<li><a href="#28"><b class="cmd">::crimp</b> <b class="method">alpha blend</b> <i class="arg">foreground</i> <i class="arg">background</i> <i class="arg">alpha</i></a></li>
<li><a href="#29"><b class="cmd">::crimp</b> <b class="method">alpha set</b> <i class="arg">image</i> <i class="arg">mask</i></a></li>
<li><a href="#30"><b class="cmd">::crimp</b> <b class="method">alpha opaque</b> <i class="arg">image</i></a></li>
<li><a href="#31"><b class="cmd">::crimp</b> <b class="method">alpha over</b> <i class="arg">foreground</i> <i class="arg">background</i></a></li>
<li><a href="#32"><b class="cmd">::crimp</b> <b class="method">atan2</b> <i class="arg">image1</i> <i class="arg">image2</i></a></li>
<li><a href="#33"><b class="cmd">::crimp</b> <b class="method">blank</b> <i class="arg">type</i> <i class="arg">width</i> <i class="arg">height</i> <i class="arg">value</i>...</a></li>
<li><a href="#34"><b class="cmd">::crimp</b> <b class="method">crop</b> <i class="arg">image</i> <i class="arg">ww</i> <i class="arg">hn</i> <i class="arg">we</i> <i class="arg">hs</i></a></li>
<li><a href="#35"><b class="cmd">::crimp</b> <b class="method">cut</b> <i class="arg">image</i> <i class="arg">x</i> <i class="arg">y</i> <i class="arg">w</i> <i class="arg">h</i></a></li>
<li><a href="#36"><b class="cmd">::crimp</b> <b class="method">decimate xy</b> <i class="arg">image</i> <i class="arg">factor</i> <i class="arg">kernel</i></a></li>
<li><a href="#37"><b class="cmd">::crimp</b> <b class="method">decimate x</b> <i class="arg">image</i> <i class="arg">factor</i> <i class="arg">kernel</i></a></li>
<li><a href="#38"><b class="cmd">::crimp</b> <b class="method">decimate y</b> <i class="arg">image</i> <i class="arg">factor</i> <i class="arg">kernel</i></a></li>
<li><a href="#39"><b class="cmd">::crimp</b> <b class="method">degamma</b> <i class="arg">image</i> <i class="arg">y</i></a></li>
<li><a href="#40"><b class="cmd">::crimp</b> <b class="method">difference</b> <i class="arg">image1</i> <i class="arg">image2</i></a></li>
<li><a href="#41"><b class="cmd">::crimp</b> <b class="method">downsample xy</b> <i class="arg">image</i> <i class="arg">factor</i></a></li>
<li><a href="#42"><b class="cmd">::crimp</b> <b class="method">downsample x</b> <i class="arg">image</i> <i class="arg">factor</i></a></li>
<li><a href="#43"><b class="cmd">::crimp</b> <b class="method">downsample y</b> <i class="arg">image</i> <i class="arg">factor</i></a></li>
<li><a href="#44"><b class="cmd">::crimp</b> <b class="method">effect charcoal</b> <i class="arg">image</i></a></li>
<li><a href="#45"><b class="cmd">::crimp</b> <b class="method">effect emboss</b> <i class="arg">image</i></a></li>
<li><a href="#46"><b class="cmd">::crimp</b> <b class="method">effect sharpen</b> <i class="arg">image</i></a></li>
<li><a href="#47"><b class="cmd">::crimp</b> <b class="method">expand const</b> <i class="arg">image</i> <i class="arg">ww</i> <i class="arg">hn</i> <i class="arg">we</i> <i class="arg">hs</i> <span class="opt">?<i class="arg">value</i>...?</span></a></li>
<li><a href="#48"><b class="cmd">::crimp</b> <b class="method">expand extend</b> <i class="arg">image</i> <i class="arg">ww</i> <i class="arg">hn</i> <i class="arg">we</i> <i class="arg">hs</i></a></li>
<li><a href="#49"><b class="cmd">::crimp</b> <b class="method">expand mirror</b> <i class="arg">image</i> <i class="arg">ww</i> <i class="arg">hn</i> <i class="arg">we</i> <i class="arg">hs</i></a></li>
<li><a href="#50"><b class="cmd">::crimp</b> <b class="method">expand replicate</b> <i class="arg">image</i> <i class="arg">ww</i> <i class="arg">hn</i> <i class="arg">we</i> <i class="arg">hs</i></a></li>
<li><a href="#51"><b class="cmd">::crimp</b> <b class="method">expand wrap</b> <i class="arg">image</i> <i class="arg">ww</i> <i class="arg">hn</i> <i class="arg">we</i> <i class="arg">hs</i></a></li>
<li><a href="#52"><b class="cmd">::crimp</b> <b class="method">fft forward</b> <i class="arg">image</i></a></li>
<li><a href="#53"><b class="cmd">::crimp</b> <b class="method">fft backward</b> <i class="arg">image</i></a></li>
<li><a href="#54"><b class="cmd">::crimp</b> <b class="method">filter ahe</b> <i class="arg">image</i> <span class="opt">?<b class="option">-border</b> <i class="arg">spec</i>?</span> <span class="opt">?<i class="arg">radius</i>?</span></a></li>
<li><a href="#55"><b class="cmd">::crimp</b> <b class="method">filter convolve</b> <i class="arg">image</i> <span class="opt">?<b class="option">-border</b> <i class="arg">spec</i>?</span> <i class="arg">kernel</i>...</a></li>
<li><a href="#56"><b class="cmd">::crimp</b> <b class="method">filter gauss discrete</b> <i class="arg">image</i> <i class="arg">sigma</i> <span class="opt">?<i class="arg">r</i>?</span></a></li>
<li><a href="#57"><b class="cmd">::crimp</b> <b class="method">filter gauss sampled</b> <i class="arg">image</i> <i class="arg">sigma</i> <span class="opt">?<i class="arg">r</i>?</span></a></li>
<li><a href="#58"><b class="cmd">::crimp</b> <b class="method">filter mean</b> <i class="arg">image</i> <span class="opt">?<b class="option">-border</b> <i class="arg">spec</i>?</span> <span class="opt">?<i class="arg">radius</i>?</span></a></li>
<li><a href="#59"><b class="cmd">::crimp</b> <b class="method">filter rank</b> <i class="arg">image</i> <span class="opt">?<b class="option">-border</b> <i class="arg">spec</i>?</span> <span class="opt">?<i class="arg">radius</i> <span class="opt">?<i class="arg">percentile</i>?</span>?</span></a></li>
<li><a href="#60"><b class="cmd">::crimp</b> <b class="method">filter stddev</b> <i class="arg">image</i> <span class="opt">?<b class="option">-border</b> <i class="arg">spec</i>?</span> <span class="opt">?<i class="arg">radius</i>?</span></a></li>
<li><a href="#61"><b class="cmd">::crimp</b> <b class="method">filter sobel x</b> <i class="arg">image</i></a></li>
<li><a href="#62"><b class="cmd">::crimp</b> <b class="method">filter sobel y</b> <i class="arg">image</i></a></li>
<li><a href="#63"><b class="cmd">::crimp</b> <b class="method">filter scharr x</b> <i class="arg">image</i></a></li>
<li><a href="#64"><b class="cmd">::crimp</b> <b class="method">filter scharr y</b> <i class="arg">image</i></a></li>
<li><a href="#65"><b class="cmd">::crimp</b> <b class="method">filter prewitt x</b> <i class="arg">image</i></a></li>
<li><a href="#66"><b class="cmd">::crimp</b> <b class="method">filter prewitt y</b> <i class="arg">image</i></a></li>
<li><a href="#67"><b class="cmd">::crimp</b> <b class="method">gamma</b> <i class="arg">image</i> <i class="arg">y</i></a></li>
<li><a href="#68"><b class="cmd">::crimp</b> <b class="method">gradient sobel</b> <i class="arg">image</i></a></li>
<li><a href="#69"><b class="cmd">::crimp</b> <b class="method">gradient scharr</b> <i class="arg">image</i></a></li>
<li><a href="#70"><b class="cmd">::crimp</b> <b class="method">gradient prewitt</b> <i class="arg">image</i></a></li>
<li><a href="#71"><b class="cmd">::crimp</b> <b class="method">gradient polar</b> <i class="arg">cgradient</i></a></li>
<li><a href="#72"><b class="cmd">::crimp</b> <b class="method">gradient visual</b> <i class="arg">pgradient</i></a></li>
<li><a href="#73"><b class="cmd">::crimp</b> <b class="method">hypot</b> <i class="arg">image1</i> <i class="arg">image2</i></a></li>
<li><a href="#74"><b class="cmd">::crimp</b> <b class="method">integrate</b> <i class="arg">image</i></a></li>
<li><a href="#75"><b class="cmd">::crimp</b> <b class="method">interpolate xy</b> <i class="arg">image</i> <i class="arg">factor</i> <i class="arg">kernel</i></a></li>
<li><a href="#76"><b class="cmd">::crimp</b> <b class="method">interpolate x</b> <i class="arg">image</i> <i class="arg">factor</i> <i class="arg">kernel</i></a></li>
<li><a href="#77"><b class="cmd">::crimp</b> <b class="method">interpolate y</b> <i class="arg">image</i> <i class="arg">factor</i> <i class="arg">kernel</i></a></li>
<li><a href="#78"><b class="cmd">::crimp</b> <b class="method">invert</b> <i class="arg">image</i></a></li>
<li><a href="#79"><b class="cmd">::crimp</b> <b class="method">matrix</b> <i class="arg">image</i> <i class="arg">matrix</i></a></li>
<li><a href="#80"><b class="cmd">::crimp</b> <b class="method">max</b> <i class="arg">image1</i> <i class="arg">image2</i></a></li>
<li><a href="#81"><b class="cmd">::crimp</b> <b class="method">min</b> <i class="arg">image1</i> <i class="arg">image2</i></a></li>
<li><a href="#82"><b class="cmd">::crimp</b> <b class="method">montage horizontal</b> <span class="opt">?<b class="option">-align</b> <b class="const">top</b>|<b class="const">center</b>|<b class="const">bottom</b>?</span> <span class="opt">?<b class="option">-border</b> <i class="arg">spec</i>?</span> <i class="arg">image</i>...</a></li>
<li><a href="#83"><b class="cmd">::crimp</b> <b class="method">montage vertical</b> <span class="opt">?<b class="option">-align</b> <b class="const">left</b>|<b class="const">middle</b>|<b class="const">right</b>?</span> <span class="opt">?<b class="option">-border</b> <i class="arg">spec</i>?</span> <i class="arg">image</i>...</a></li>
<li><a href="#84"><b class="cmd">::crimp</b> <b class="method">morph dilate</b> <i class="arg">image</i></a></li>
<li><a href="#85"><b class="cmd">::crimp</b> <b class="method">morph erode</b> <i class="arg">image</i></a></li>
<li><a href="#86"><b class="cmd">::crimp</b> <b class="method">morph close</b> <i class="arg">image</i></a></li>
<li><a href="#87"><b class="cmd">::crimp</b> <b class="method">morph open</b> <i class="arg">image</i></a></li>
<li><a href="#88"><b class="cmd">::crimp</b> <b class="method">morph gradient</b> <i class="arg">image</i></a></li>
<li><a href="#89"><b class="cmd">::crimp</b> <b class="method">morph igradient</b> <i class="arg">image</i></a></li>
<li><a href="#90"><b class="cmd">::crimp</b> <b class="method">morph egradient</b> <i class="arg">image</i></a></li>
<li><a href="#91"><b class="cmd">::crimp</b> <b class="method">morph tophatw</b> <i class="arg">image</i></a></li>
<li><a href="#92"><b class="cmd">::crimp</b> <b class="method">morph tophatb</b> <i class="arg">image</i></a></li>
<li><a href="#93"><b class="cmd">::crimp</b> <b class="method">multiply</b> <i class="arg">image1</i> <i class="arg">image2</i></a></li>
<li><a href="#94"><b class="cmd">::crimp</b> <b class="method">psychedelia</b> <i class="arg">width</i> <i class="arg">height</i> <i class="arg">frames</i></a></li>
<li><a href="#95"><b class="cmd">::crimp</b> <b class="method">pyramid run</b> <i class="arg">image</i> <i class="arg">steps</i> <i class="arg">stepcmd</i></a></li>
<li><a href="#96"><b class="cmd">&lt;stepcmd&gt;</b> <i class="arg">image</i></a></li>
<li><a href="#97"><b class="cmd">::crimp</b> <b class="method">pyramid gauss</b> <i class="arg">image</i> <i class="arg">steps</i></a></li>
<li><a href="#98"><b class="cmd">::crimp</b> <b class="method">pyramid laplace</b> <i class="arg">image</i> <i class="arg">steps</i></a></li>
<li><a href="#99"><b class="cmd">::crimp</b> <b class="method">remap</b> <i class="arg">image</i> <i class="arg">map</i>...</a></li>
<li><a href="#100"><b class="cmd">::crimp</b> <b class="method">screen</b> <i class="arg">image1</i> <i class="arg">image2</i></a></li>
<li><a href="#101"><b class="cmd">::crimp</b> <b class="method">solarize</b> <i class="arg">image</i> <i class="arg">threshold</i></a></li>
<li><a href="#102"><b class="cmd">::crimp</b> <b class="method">square</b> <i class="arg">image</i></a></li>
<li><a href="#103"><b class="cmd">::crimp</b> <b class="method">subtract</b> <i class="arg">image1</i> <i class="arg">image2</i> <span class="opt">?<i class="arg">scale</i>?</span> <span class="opt">?<i class="arg">offset</i>?</span></a></li>
<li><a href="#104"><b class="cmd">::crimp</b> <b class="method">threshold global above</b> <i class="arg">image</i> <i class="arg">threshold</i></a></li>
<li><a href="#105"><b class="cmd">::crimp</b> <b class="method">threshold global below</b> <i class="arg">image</i> <i class="arg">threshold</i></a></li>
<li><a href="#106"><b class="cmd">::crimp</b> <b class="method">threshold global inside</b> <i class="arg">image</i> <i class="arg">min</i> <i class="arg">max</i></a></li>
<li><a href="#107"><b class="cmd">::crimp</b> <b class="method">threshold global outside</b> <i class="arg">image</i> <i class="arg">min</i> <i class="arg">max</i></a></li>
<li><a href="#108"><b class="cmd">::crimp</b> <b class="method">threshold global middle</b> <i class="arg">image</i></a></li>
<li><a href="#109"><b class="cmd">::crimp</b> <b class="method">threshold global mean</b> <i class="arg">image</i></a></li>
<li><a href="#110"><b class="cmd">::crimp</b> <b class="method">threshold global median</b> <i class="arg">image</i></a></li>
<li><a href="#111"><b class="cmd">::crimp</b> <b class="method">threshold global otsu</b> <i class="arg">image</i></a></li>
<li><a href="#112"><b class="cmd">::crimp</b> <b class="method">threshold local</b> <i class="arg">image</i> <i class="arg">threshold</i>...</a></li>
<li><a href="#113"><b class="cmd">::crimp</b> <b class="method">upsample xy</b> <i class="arg">image</i> <i class="arg">factor</i></a></li>
<li><a href="#114"><b class="cmd">::crimp</b> <b class="method">upsample x</b> <i class="arg">image</i> <i class="arg">factor</i></a></li>
<li><a href="#115"><b class="cmd">::crimp</b> <b class="method">upsample y</b> <i class="arg">image</i> <i class="arg">factor</i></a></li>
<li><a href="#116"><b class="cmd">::crimp</b> <b class="method">wavy</b> <i class="arg">image</i> <i class="arg">offset</i> <i class="arg">adj1</i> <i class="arg">adjb</i></a></li>
<li><a href="#117"><b class="cmd">::crimp</b> <b class="method">flip horizontal</b> <i class="arg">image</i></a></li>
<li><a href="#118"><b class="cmd">::crimp</b> <b class="method">flip transpose</b> <i class="arg">image</i></a></li>
<li><a href="#119"><b class="cmd">::crimp</b> <b class="method">flip transverse</b> <i class="arg">image</i></a></li>
<li><a href="#120"><b class="cmd">::crimp</b> <b class="method">flip vertical</b> <i class="arg">image</i></a></li>
<li><a href="#121"><b class="cmd">::crimp</b> <b class="method">resize</b> <span class="opt">?<b class="option">-interpolate</b> <b class="const">nneighbour</b>|<b class="const">bilinear</b>|<b class="const">bicubic</b>?</span> <i class="arg">image</i> <i class="arg">w</i> <i class="arg">h</i></a></li>
<li><a href="#122"><b class="cmd">::crimp</b> <b class="method">rotate cw</b> <i class="arg">image</i></a></li>
<li><a href="#123"><b class="cmd">::crimp</b> <b class="method">rotate ccw</b> <i class="arg">image</i></a></li>
<li><a href="#124"><b class="cmd">::crimp</b> <b class="method">rotate half</b> <i class="arg">image</i></a></li>
<li><a href="#125"><b class="cmd">::crimp</b> <b class="method">warp field</b> <span class="opt">?<b class="option">-interpolate</b> <b class="const">nneighbour</b>|<b class="const">bilinear</b>|<b class="const">bicubic</b>?</span> <i class="arg">image</i> <i class="arg">xvec</i> <i class="arg">yvec</i></a></li>
<li><a href="#126"><b class="cmd">::crimp</b> <b class="method">warp projective</b> <span class="opt">?<b class="option">-interpolate</b> <b class="const">nneighbour</b>|<b class="const">bilinear</b>|<b class="const">bicubic</b>?</span> <i class="arg">image</i> <i class="arg">transform</i></a></li>
<li><a href="#127"><b class="cmd">::crimp</b> <b class="method">convert 2grey8</b> <i class="arg">image</i></a></li>
<li><a href="#128"><b class="cmd">::crimp</b> <b class="method">convert 2hsv</b> <i class="arg">image</i></a></li>
<li><a href="#129"><b class="cmd">::crimp</b> <b class="method">convert 2rgba</b> <i class="arg">image</i></a></li>
<li><a href="#130"><b class="cmd">::crimp</b> <b class="method">convert 2rgb</b> <i class="arg">image</i></a></li>
<li><a href="#131"><b class="cmd">::crimp</b> <b class="method">join 2hsv</b> <i class="arg">hueImage</i> <i class="arg">satImage</i> <i class="arg">valImage</i></a></li>
<li><a href="#132"><b class="cmd">::crimp</b> <b class="method">join 2rgba</b> <i class="arg">redImage</i> <i class="arg">greenImage</i> <i class="arg">blueImage</i> <i class="arg">alphaImage</i></a></li>
<li><a href="#133"><b class="cmd">::crimp</b> <b class="method">join 2rgb</b> <i class="arg">redImage</i> <i class="arg">greenImage</i> <i class="arg">blueImage</i></a></li>
<li><a href="#134"><b class="cmd">::crimp</b> <b class="method">split</b> <i class="arg">image</i></a></li>
<li><a href="#135"><b class="cmd">::crimp</b> <b class="method">read pgm</b> <i class="arg">string</i></a></li>
<li><a href="#136"><b class="cmd">::crimp</b> <b class="method">read ppm</b> <i class="arg">string</i></a></li>
<li><a href="#137"><b class="cmd">::crimp</b> <b class="method">read strimj</b> <i class="arg">string</i> <span class="opt">?<i class="arg">colormap</i>?</span></a></li>
<li><a href="#138"><b class="cmd">::crimp</b> <b class="method">read tcl grey8</b> <i class="arg">pixelmatrix</i></a></li>
<li><a href="#139"><b class="cmd">::crimp</b> <b class="method">read tcl float</b> <i class="arg">pixelmatrix</i></a></li>
<li><a href="#140"><b class="cmd">::crimp</b> <b class="method">read tk</b> <i class="arg">photo</i></a></li>
<li><a href="#141"><b class="cmd">::crimp</b> <b class="method">write 2tk</b> <i class="arg">photo</i> <i class="arg">image</i></a></li>
<li><a href="#142"><b class="cmd">::crimp</b> <b class="method">write 2string</b> <i class="arg">format</i> <i class="arg">image</i></a></li>
<li><a href="#143"><b class="cmd">::crimp</b> <b class="method">write 2chan</b> <i class="arg">format</i> <i class="arg">chan</i> <i class="arg">image</i></a></li>
<li><a href="#144"><b class="cmd">::crimp</b> <b class="method">write 2file</b> <i class="arg">format</i> <i class="arg">path</i> <i class="arg">image</i></a></li>
<li><a href="#145"><b class="cmd">::crimp</b> <b class="method">gradient grey8</b> <i class="arg">from</i> <i class="arg">to</i> <i class="arg">size</i></a></li>
<li><a href="#146"><b class="cmd">::crimp</b> <b class="method">gradient rgb</b> <i class="arg">from</i> <i class="arg">to</i> <i class="arg">size</i></a></li>
<li><a href="#147"><b class="cmd">::crimp</b> <b class="method">gradient rgba</b> <i class="arg">from</i> <i class="arg">to</i> <i class="arg">size</i></a></li>
<li><a href="#148"><b class="cmd">::crimp</b> <b class="method">gradient hsv</b> <i class="arg">from</i> <i class="arg">to</i> <i class="arg">size</i></a></li>
<li><a href="#149"><b class="cmd">::crimp</b> <b class="method">kernel make</b> <i class="arg">matrix</i> <span class="opt">?<i class="arg">scale</i>?</span> <span class="opt">?<i class="arg">offset</i>?</span></a></li>
<li><a href="#150"><b class="cmd">::crimp</b> <b class="method">kernel fpmake</b> <i class="arg">matrix</i> <span class="opt">?<i class="arg">offset</i>?</span></a></li>
<li><a href="#151"><b class="cmd">::crimp</b> <b class="method">kernel transpose</b> <i class="arg">kernel</i></a></li>
<li><a href="#152"><b class="cmd">::crimp</b> <b class="method">map</b> <i class="arg">arg</i>...</a></li>
<li><a href="#153"><b class="cmd">::crimp</b> <b class="method">mapof</b> <i class="arg">table</i></a></li>
<li><a href="#154"><b class="cmd">::crimp</b> <b class="method">table compose</b> <i class="arg">f</i> <i class="arg">g</i></a></li>
<li><a href="#155"><b class="cmd">::crimp</b> <b class="method">table eval wrap</b> <i class="arg">cmd</i></a></li>
<li><a href="#156"><b class="cmd">::crimp</b> <b class="method">table eval clamp</b> <i class="arg">cmd</i></a></li>
<li><a href="#157"><b class="cmd">&lt;cmd&gt;</b> <i class="arg">x</i></a></li>
<li><a href="#158"><b class="cmd">::crimp</b> <b class="method">table degamma</b> <i class="arg">y</i></a></li>
<li><a href="#159"><b class="cmd">::crimp</b> <b class="method">table gamma</b> <i class="arg">y</i></a></li>
<li><a href="#160"><b class="cmd">::crimp</b> <b class="method">table gauss</b> <i class="arg">sigma</i></a></li>
<li><a href="#161"><b class="cmd">::crimp</b> <b class="method">table identity</b></a></li>
<li><a href="#162"><b class="cmd">::crimp</b> <b class="method">table invers</b></a></li>
<li><a href="#163"><b class="cmd">::crimp</b> <b class="method">table linear wrap</b> <i class="arg">gain</i> <i class="arg">offset</i></a></li>
<li><a href="#164"><b class="cmd">::crimp</b> <b class="method">table linear clamp</b> <i class="arg">gain</i> <i class="arg">offset</i></a></li>
<li><a href="#165"><b class="cmd">::crimp</b> <b class="method">table log</b> <span class="opt">?<i class="arg">max</i>?</span></a></li>
<li><a href="#166"><b class="cmd">::crimp</b> <b class="method">table solarize</b> <i class="arg">threshold</i></a></li>
<li><a href="#167"><b class="cmd">::crimp</b> <b class="method">table sqrt</b> <span class="opt">?<i class="arg">max</i>?</span></a></li>
<li><a href="#168"><b class="cmd">::crimp</b> <b class="method">table stretch</b> <i class="arg">min</i> <i class="arg">max</i></a></li>
<li><a href="#169"><b class="cmd">::crimp</b> <b class="method">table threshold above</b> <i class="arg">threshold</i></a></li>
<li><a href="#170"><b class="cmd">::crimp</b> <b class="method">table threshold below</b> <i class="arg">threshold</i></a></li>
<li><a href="#171"><b class="cmd">::crimp</b> <b class="method">table threshold inside</b> <i class="arg">min</i> <i class="arg">max</i></a></li>
<li><a href="#172"><b class="cmd">::crimp</b> <b class="method">table threshold outside</b> <i class="arg">min</i> <i class="arg">max</i></a></li>
<li><a href="#173"><b class="cmd">::crimp</b> <b class="method">table fgauss discrete</b> <i class="arg">sigma</i> <span class="opt">?<i class="arg">r</i>?</span></a></li>
<li><a href="#174"><b class="cmd">::crimp</b> <b class="method">table fgauss sampled</b> <i class="arg">sigma</i> <span class="opt">?<i class="arg">r</i>?</span></a></li>
<li><a href="#175"><b class="cmd">::crimp</b> <b class="method">transform affine</b> <i class="arg">a</i> <i class="arg">b</i> <i class="arg">c</i> <i class="arg">d</i> <i class="arg">e</i> <i class="arg">f</i></a></li>
<li><a href="#176"><b class="cmd">::crimp</b> <b class="method">transform chain</b> <i class="arg">transform</i>...</a></li>
<li><a href="#177"><b class="cmd">::crimp</b> <b class="method">transform invert</b> <i class="arg">transform</i></a></li>
<li><a href="#178"><b class="cmd">::crimp</b> <b class="method">transform projective</b> <i class="arg">a</i> <i class="arg">b</i> <i class="arg">c</i> <i class="arg">d</i> <i class="arg">e</i> <i class="arg">f</i> <i class="arg">g</i> <i class="arg">h</i></a></li>
<li><a href="#179"><b class="cmd">::crimp</b> <b class="method">transform quadrilateral</b> <i class="arg">src</i> <i class="arg">dst</i></a></li>
<li><a href="#180"><b class="cmd">::crimp</b> <b class="method">transform rotate</b> <i class="arg">theta</i> <span class="opt">?<i class="arg">center</i>?</span></a></li>
<li><a href="#181"><b class="cmd">::crimp</b> <b class="method">transform scale</b> <i class="arg">sx</i> <i class="arg">sy</i></a></li>
<li><a href="#182"><b class="cmd">::crimp</b> <b class="method">transform translate</b> <i class="arg">dx</i> <i class="arg">dy</i></a></li>
</ul>
</div>
</div>
<div id="section1" class="section"><h2><a name="section1">Description</a></h2>
<p>This package provides image manipulation commands which are mostly
independent of Tk. The only parts currently depending on Tk are for
the import and export of images from and to Tk photos, necessary for
display.</p>
<p>Note that the intended audience of this document are the users of
<b class="package">crimp</b>. Developers wishing to work on the internals of the
package, but unfamiliar with them, should read ... instead.</p>
</div>
<div id="section2" class="section"><h2><a name="section2">Images</a></h2>
<p>Images are values. This means that they have a string
representation. It is however strongly recommended to not access this
representation at all, and to only use the accessor commands provided
by crimp to obtain the information stored in the internal
representation of image values.</p>
<p>The reason behind this is simple: Memory and speed. Images can be
large. Generating the string representation from the internal one
roughly doubles the memory needed to store it, actually a bit more,
due to the necessary quoting of bytes in UTF-8 and list-quting them as
well. Furthermore such a conversion takes time, roughly proportional
to the size of the image itself, in either direction. Properly
accessing the image information without the package's accessor
commands requires list commands. This causes the loss of the internal
representation, thus forcing later a reconversion to the image's
internal represention when it is used as image again. I.e. the
shimmering forces us to convert twice.</p>
<p>Therefore, to avoid this, use only the crimp commands to access the
images. Even the raw pixel data is accessible in this manner. While
access to that in a Tcl script is, IMHO, highly unusual, there are
situations where it is beneficial. An example of such a situation are
the commands exporting images to raw portable any-maps (PNMs). Our
pixel data fits these formats exactly, and with access to it these
commands could be written in Tcl instead of requiring C level primitives.</p>
</div>
<div id="section3" class="section"><h2><a name="section3">Image Types</a></h2>
<p>Each image has a <i class="term">type</i>, a string implicitly describing features
like the colorspace the image is in, the number of (color) channels,
the domain, i.e. bit-depth, of pixel values in the channels, etc.</p>
<p>All type strings have the form <b class="const">crimp::image::</b><b class="variable">foo</b>.</p>
<p>The package currently knows the following types:</p>
<dl class="definitions">
<dt><b class="const">rgba</b></dt>
<dd><dl class="definitions">
	
<dt>Colorspace</dt>
<dd><p>RGB also known as Red, Green, and Blue.</p></dd>
<dt>Channels</dt>
<dd><p>4, named &quot;red&quot;, &quot;green&quot;, and &quot;blue&quot;,
				plus an &quot;alpha&quot; channel controlling
				pixel opacity.</p></dd>
<dt>Bit-depth</dt>
<dd><p>1 byte/channel (8 bit, values 0-255).</p></dd>
<dt>Pixel-size</dt>
<dd><p>4 bytes.</p></dd>
</dl></dd>
<dt><b class="const">rgb</b></dt>
<dd><dl class="definitions">
	
<dt>Colorspace</dt>
<dd><p>RGB also known as Red, Green, and Blue.</p></dd>
<dt>Channels</dt>
<dd><p>3, named &quot;red&quot;, &quot;green&quot;, and &quot;blue&quot;.</p></dd>
<dt>Bit-depth</dt>
<dd><p>1 byte/channel (8 bit, values 0-255).</p></dd>
<dt>Pixel-size</dt>
<dd><p>3 bytes.</p></dd>
</dl></dd>
<dt><b class="const">hsv</b></dt>
<dd><dl class="definitions">
	
<dt>Colorspace</dt>
<dd><p>HSV, also known as Hue, Saturation, and Value.</p></dd>
<dt>Channels</dt>
<dd><p>3, named &quot;hue&quot;, &quot;saturation&quot;, and &quot;value&quot;.</p></dd>
<dt>Bit-depth</dt>
<dd><p>1 byte/channel (8 bit, values 0-255).</p></dd>
<dt>Pixel-size</dt>
<dd><p>3 bytes.</p></dd>
</dl></dd>
<dt><b class="const">grey8</b></dt>
<dd><dl class="definitions">
	
<dt>Colorspace</dt>
<dd><p>Greyscale.</p></dd>
<dt>Channels</dt>
<dd><p>1, named &quot;luma&quot;.</p></dd>
<dt>Bit-depth</dt>
<dd><p>1 byte/channel (8 bit, values 0-255).</p></dd>
<dt>Pixel-size</dt>
<dd><p>1 byte.</p></dd>
</dl></dd>
<dt><b class="const">grey16</b></dt>
<dd><dl class="definitions">
	
<dt>Colorspace</dt>
<dd><p>Greyscale.</p></dd>
<dt>Channels</dt>
<dd><p>1, named &quot;luma&quot;.</p></dd>
<dt>Bit-depth</dt>
<dd><p>2 byte/channel (16 bit, values 0-65,535).</p></dd>
<dt>Pixel-size</dt>
<dd><p>2 bytes.</p></dd>
</dl></dd>
<dt><b class="const">grey32</b></dt>
<dd><dl class="definitions">
	
<dt>Colorspace</dt>
<dd><p>Greyscale.</p></dd>
<dt>Channels</dt>
<dd><p>1, named &quot;luma&quot;.</p></dd>
<dt>Bit-depth</dt>
<dd><p>4 byte/channel (16 bit, values 0-4,294,967,296).</p></dd>
<dt>Pixel-size</dt>
<dd><p>4 bytes.</p></dd>
</dl></dd>
<dt><b class="const">bw</b></dt>
<dd><dl class="definitions">
	
<dt>Colorspace</dt>
<dd><p>Binary.</p></dd>
<dt>Channels</dt>
<dd><p>1, named &quot;bw&quot;.</p></dd>
<dt>Bit-depth</dt>
<dd><p>1 bit/channel.</p></dd>
<dt>Pixel-size</dt>
<dd><p>1 byte. I.e. 7 bits/channel are wasted.</p></dd>
</dl></dd>
<dt><b class="const">float</b></dt>
<dd><dl class="definitions">
	
<dt>Colorspace</dt>
<dd><p>N.A / Floating Point.</p></dd>
<dt>Channels</dt>
<dd><p>1, named &quot;value&quot;.</p></dd>
<dt>Bit-depth</dt>
<dd><p>4 byte/channel.</p></dd>
<dt>Pixel-size</dt>
<dd><p>4 byte.</p></dd>
</dl></dd>
</dl>
<p>Support for the various types varies by operation. The exact image
types supported by each operation are listed the operation's
description. Invoking an operation for a type it doesn't support will
generally cause it to throw an error.</p>
</div>
<div id="section4" class="section"><h2><a name="section4">General design</a></h2>
<p>All commands operate in a pipeline fashion, taking zero or more image
values, zero or more other arguments, and returning zero or more
images or other values. None are operating in place, i.e. taking an
image variable and writing back to it.</p>
<p>They fall into five categories, namely:</p>
<p><img alt="organization" src="../image/organization.png"></p>
<dl class="definitions">
<dt>Accessors</dt>
<dd><p>They take one or more images, extract information about them, and
return this information as their result. This can be a simple as
querying the image's height, to something as complex as counting pixel
values for a histogram.</p>
<p>The list of accessors, their syntax, and detailed meaning can be found
in section <span class="sectref"><a href="#subsection1">Accessors</a></span>.</p></dd>
<dt>Manipulators</dt>
<dd><p>These take an image and transform its contents in some way, leaving
the image type unchanged. Examples of commands in category are
inversion, gamma conversion, etc. They fall into two sub-categories,
manipulation of the image geometry, and of the intensity values or
colors.</p>
<p>The list of manipulators, their syntax, and detailed meaning can be
found in section <span class="sectref"><a href="#subsection2">Manipulators</a></span>.</p></dd>
<dt>Converters</dt>
<dd><p>Similar to manipulators, except that they change the image's type,
preserving the content instead. Here reside operations like conversion
between the HSV and RGB colorspaces, to greyscale and back, etc.</p>
<p>The list of converters, their syntax, and detailed meaning can be
found in section <span class="sectref"><a href="#subsection3">Converters</a></span>.</p></dd>
<dt>I/O</dt>
<dd><p>Another variant of the same theme, i.e. akin to converters and
manipulators, yet not the same, these commands read and write images
from and to files or other data structures. I.e. they convert between
different serializations of image content and type.</p>
<p>The list of I/O commands, their syntax, and detailed meaning can be
found in section <span class="sectref"><a href="#subsection4">I/O commands</a></span>.</p></dd>
<dt>Support</dt>
<dd><p>Lastly, but not leastly a number of commands, which, while not image
commands themselves, support the others.</p>
<p>The list of supporting commands, their syntax, and detailed meaning
can be found in section <span class="sectref"><a href="#subsection5">Support</a></span>.</p></dd>
</dl>
</div>
<div id="section5" class="section"><h2><a name="section5">API</a></h2>
<div id="subsection1" class="subsection"><h3><a name="subsection1">Accessors</a></h3>
<dl class="definitions">
<dt><a name="1"><b class="cmd">::crimp</b> <b class="method">channels</b> <i class="arg">image</i></a></dt>
<dd><p>This method returns a list containing the names of the channels in the
<i class="arg">image</i>. The order of channels is the same as expected by the
<b class="method">remap</b> method.</p>
<p>The method supports all image types.</p></dd>
<dt><a name="2"><b class="cmd">::crimp</b> <b class="method">dimensions</b> <i class="arg">image</i></a></dt>
<dd><p>This method returns the width and height of the <i class="arg">image</i> (in
pixels).  The result is a 2-element list containing width and height,
in this order.</p>
<p>The method supports all image types.</p></dd>
<dt><a name="3"><b class="cmd">::crimp</b> <b class="method">height</b> <i class="arg">image</i></a></dt>
<dd><p>This method returns the height of the <i class="arg">image</i> (in pixels).</p>
<p>The method supports all image types.</p></dd>
<dt><a name="4"><b class="cmd">::crimp</b> <b class="method">histogram</b> <i class="arg">image</i></a></dt>
<dd><p>This method returns a nested dictionary as its result.  The outer
dictionary is indexed by the names of the channels in the <i class="arg">image</i>.
Its values, the inner dictionaries, are indexed by pixel value. The
associated values are the number of pixels with that value.</p>
<p>The method supports all image types except &quot;grey32&quot;.  Under the
current system the result would be a dictionary with 2^32 keys and
values, taking up, roughly, 192 GiByte of memory in the worst case,
and 96 GiByte in best case (all counter values shared in a single
object).</p></dd>
<dt><a name="5"><b class="cmd">::crimp</b> <b class="method">meta append</b> <i class="arg">image</i> <i class="arg">key</i> <span class="opt">?<i class="arg">string</i>...?</span></a></dt>
<dd></dd>
<dt><a name="6"><b class="cmd">::crimp</b> <b class="method">meta create</b> <i class="arg">image</i> <span class="opt">?<i class="arg">key</i> <i class="arg">value</i>...?</span></a></dt>
<dd></dd>
<dt><a name="7"><b class="cmd">::crimp</b> <b class="method">meta exists</b> <i class="arg">image</i> <i class="arg">key</i> <span class="opt">?<i class="arg">key</i>...?</span></a></dt>
<dd></dd>
<dt><a name="8"><b class="cmd">::crimp</b> <b class="method">meta filter</b> <i class="arg">image</i> <i class="arg">args</i>...</a></dt>
<dd></dd>
<dt><a name="9"><b class="cmd">::crimp</b> <b class="method">meta for</b> <i class="arg">image</i> {<i class="arg">keyVar</i> <i class="arg">valueVar</i>} <i class="arg">body</i></a></dt>
<dd></dd>
<dt><a name="10"><b class="cmd">::crimp</b> <b class="method">meta get</b> <i class="arg">image</i> <span class="opt">?<i class="arg">key</i>...?</span></a></dt>
<dd></dd>
<dt><a name="11"><b class="cmd">::crimp</b> <b class="method">meta incr</b> <i class="arg">image</i> <i class="arg">key</i> <span class="opt">?<i class="arg">increment</i>?</span></a></dt>
<dd></dd>
<dt><a name="12"><b class="cmd">::crimp</b> <b class="method">meta info</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="13"><b class="cmd">::crimp</b> <b class="method">meta keys</b> <i class="arg">image</i> <span class="opt">?<i class="arg">globPattern</i>?</span></a></dt>
<dd></dd>
<dt><a name="14"><b class="cmd">::crimp</b> <b class="method">meta lappend</b> <i class="arg">image</i> <i class="arg">key</i> <span class="opt">?<i class="arg">value</i>...?</span></a></dt>
<dd></dd>
<dt><a name="15"><b class="cmd">::crimp</b> <b class="method">meta merge</b> <i class="arg">image</i> <span class="opt">?<i class="arg">dictionaryValue</i>...?</span></a></dt>
<dd></dd>
<dt><a name="16"><b class="cmd">::crimp</b> <b class="method">meta remove</b> <i class="arg">image</i> <span class="opt">?<i class="arg">key</i>...?</span></a></dt>
<dd></dd>
<dt><a name="17"><b class="cmd">::crimp</b> <b class="method">meta replace</b> <i class="arg">image</i> <span class="opt">?<i class="arg">key</i> <i class="arg">value</i>...?</span></a></dt>
<dd></dd>
<dt><a name="18"><b class="cmd">::crimp</b> <b class="method">meta set</b> <i class="arg">image</i> <i class="arg">key</i> <span class="opt">?<i class="arg">key</i>...?</span> <i class="arg">value</i></a></dt>
<dd></dd>
<dt><a name="19"><b class="cmd">::crimp</b> <b class="method">meta size</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="20"><b class="cmd">::crimp</b> <b class="method">meta unset</b> <i class="arg">image</i> <i class="arg">key</i> <span class="opt">?<i class="arg">key</i>...?</span></a></dt>
<dd></dd>
<dt><a name="21"><b class="cmd">::crimp</b> <b class="method">meta values</b> <i class="arg">image</i> <span class="opt">?<i class="arg">globPattern</i>?</span></a></dt>
<dd><p>These methods provide access to the meta data slot of images, treating
its contents as a dictionary. As such all the methods provided here
have an appropriate counterpart in the methods of Tcl's builtin
command <b class="cmd">dict</b>, with the image's metadata taking the place of the
dictionary value or vqariable.
The converse is not true, as <b class="cmd">dict</b>'s methods <b class="method">update</b> and
<b class="method">with</b> are not supported here.</p>
<p>Please read the documentation of Tcl's <b class="cmd">dict</b> command for reference.</p>
<p><em>NOTE</em> that the toplevel key <b class="const">crimp</b> is reserved for
use by CRIMP itself.</p></dd>
<dt><a name="22"><b class="cmd">::crimp</b> <b class="method">pixel</b> <i class="arg">image</i></a></dt>
<dd><p>This method returns the raw pixels of the <i class="arg">image</i> as a Tcl ByteArray.</p>
<p>The method supports all image types.</p></dd>
<dt><a name="23"><b class="cmd">::crimp</b> <b class="method">statistics basic</b> <i class="arg">image</i></a></dt>
<dd><p>This method returns a nested dictionary as its result. The outer dictionary
contains basic information about the image, see the list of keys below.
The inner dictionaries hold data about each (color) channel in the image,
namely histogram and derived data like minumum pixel value, maximum, etc.</p>
<dl class="definitions">
<dt><b class="const">dimensions</b></dt>
<dd><p>2-element list holding image width and height, in
                         this order.</p></dd>
<dt><b class="const">height</b></dt>
<dd><p>Image height as separate value.</p></dd>
<dt><b class="const">pixels</b></dt>
<dd><p>Number of pixels in the image, the product of
                         its width and height.</p></dd>
<dt><b class="const">type</b></dt>
<dd><p>Type of the image.</p></dd>
<dt><b class="const">width</b></dt>
<dd><p>Image width as separate value.</p></dd>
<dt><b class="const">channels</b></dt>
<dd><p>List of the names for the channels in the image.</p></dd>
<dt><b class="const">channel</b></dt>
<dd><p>A dictionary mapping the names of the image's
                         channels, as listed under key <b class="const">channels</b>, to
                         a dictionary holding the statistics for that channel.</p>
<dl class="definitions">
<dt><b class="const">min</b></dt>
<dd><p>The minimal pixel value with a non-zero population.</p></dd>
<dt><b class="const">max</b></dt>
<dd><p>The maximal pixel value with a non-zero population.</p></dd>
<dt><b class="const">mean</b></dt>
<dd><p>The arithmetic mean (aka average) of pixel values.</p></dd>
<dt><b class="const">middle</b></dt>
<dd><p>The arithmetic mean of the min and max pixel values.</p></dd>
<dt><b class="const">median</b></dt>
<dd><p>The median pixel value.</p></dd>
<dt><b class="const">stddev</b></dt>
<dd><p>The standard deviation of pixel values.</p></dd>
<dt><b class="const">variance</b></dt>
<dd><p>The variance of pixel values, square of the standard
                         deviation.</p></dd>
<dt><b class="const">histogram</b></dt>
<dd><p>A dictionary mapping pixel values to population counts.</p></dd>
<dt><b class="const">hf</b></dt>
<dd><p>The histogram reduced to the population counts, sorted
                         by pixel value to direct indexing into the list by
                         pixel values.</p></dd>
<dt><b class="const">cdf</b></dt>
<dd><p>The <i class="term">cumulative density function</i> of pixel
                         values. The discrete integral of <b class="const">hf</b>.</p></dd>
<dt><b class="const">cdf255</b></dt>
<dd><p>Same as <b class="const">cdf</b>, except scaled down so that the
                         last value in the series is 255.</p></dd>
</dl></dd>
</dl>
<p>The method supports all image types except &quot;grey32&quot;.  Under the
current system the result would contain internal dictionaries with 2^32 keys
and values, taking up, roughly, 192 GiByte of memory in the worst case,
and 96 GiByte in best case (all counter values shared in a single
object).</p></dd>
<dt><a name="24"><b class="cmd">::crimp</b> <b class="method">statistics otsu</b> <i class="arg">stats</i></a></dt>
<dd><p>This method takes a dictionary of basic image statistics as generated
by <b class="cmd">crimp statistics basic</b> and returns an extended dictionary
containing a threshold for image binarization computed by Otsu's
method (See <span class="sectref"><a href="#section6">reference</a></span> 2). Note that this
threshold is computed separately for each channel and stored in the
channel specific part of the dictionary, using the key <b class="const">otsu</b>.</p></dd>
<dt><a name="25"><b class="cmd">::crimp</b> <b class="method">type</b> <i class="arg">image</i></a></dt>
<dd><p>This method returns the type of the <i class="arg">image</i>.</p>
<p>The method supports all image types.</p></dd>
<dt><a name="26"><b class="cmd">::crimp</b> <b class="method">width</b> <i class="arg">image</i></a></dt>
<dd><p>This method returns the width of the <i class="arg">image</i> (in pixels).</p>
<p>The method supports all image types.</p></dd>
</dl>
</div>
<div id="subsection2" class="subsection"><h3><a name="subsection2">Manipulators</a></h3>
<dl class="definitions">
<dt><a name="27"><b class="cmd">::crimp</b> <b class="method">add</b> <i class="arg">image1</i> <i class="arg">image2</i> <span class="opt">?<i class="arg">scale</i>?</span> <span class="opt">?<i class="arg">offset</i>?</span></a></dt>
<dd><p>This method combines the two input images into a result image by
performing a pixelwise addition (image1 + image2) followed by division
through <i class="arg">scale</i> and addition of the <i class="arg">offset</i>. They default to
<b class="const">1</b> and <b class="const">0</b> respectively, if they are not specified.</p></dd>
<dt><a name="28"><b class="cmd">::crimp</b> <b class="method">alpha blend</b> <i class="arg">foreground</i> <i class="arg">background</i> <i class="arg">alpha</i></a></dt>
<dd><p>This method takes two images of identical dimensions and a blending
factor <i class="arg">alpha</i> and returns an image which is a mix of both, with
each pixel blended per the formula</p>
<p><img alt="blend" src="../image/blend.png"></p>
<p>or, alternatively written</p>
<p><img alt="blend_alt" src="../image/blend_alt.png"></p>
<p>This means that the <i class="arg">foreground</i> is returned as is for
&quot;<i class="arg">alpha</i> == 255&quot;, and the <i class="arg">background</i> for
&quot;<i class="arg">alpha</i> == 0&quot;.
I.e. the argument <i class="arg">alpha</i> controls the <i class="term">opacity</i> of the
foreground, with <b class="const">1</b> and <b class="const">0</b> standing for &quot;fully opaque&quot;
and &quot;fully transparent&quot;, respectively.</p>
<p>The following combinations of fore- and background image types are
supported:</p>
<pre class="example">
    Result = Foreground Background 
    ------   ---------- ---------- 
    grey8    grey8      grey8
    hsv      hsv        hsv
    rgb      rgb        grey8
    rgb      rgb        rgb
    rgb      rgb        rgba
    rgba     rgba       grey8
    rgba     rgba       rgb
    rgba     rgba       rgba
    ------   ---------- ----------
</pre>
</dd>
<dt><a name="29"><b class="cmd">::crimp</b> <b class="method">alpha set</b> <i class="arg">image</i> <i class="arg">mask</i></a></dt>
<dd><p>This command takes two images, the input and a <i class="arg">mask</i>, and returns
an image as result in which the mask is the alpha channel of the
input.
The result is therefore always of type <b class="const">rgba</b>, as the only type
supporting an alpha channel.</p>
<p>The input image can be of type <b class="const">rgb</b> or <b class="const">rgba</b>.  In
case of the latter the existing alpha channel is replaced, in case of
the former an alpha channel is added.</p>
<p>For the mask images of type <b class="const">grey8</b> and <b class="const">rgba</b> are
accepted.  In the case of the latter the mask's alpha channel is used
as the new alpha channel, in case of the former the mask itself is
used.</p></dd>
<dt><a name="30"><b class="cmd">::crimp</b> <b class="method">alpha opaque</b> <i class="arg">image</i></a></dt>
<dd><p>A convenience method over <b class="method">alpha set</b>, giving the <i class="arg">image</i>
a mask which makes it fully opaque.</p></dd>
<dt><a name="31"><b class="cmd">::crimp</b> <b class="method">alpha over</b> <i class="arg">foreground</i> <i class="arg">background</i></a></dt>
<dd><p>This method is similar to <b class="method">blend</b> above, except that there is
no global blending parameter. This information is taken from the
&quot;alpha&quot; channel of the <i class="arg">foreground</i> image instead. The blending
formula is the same, except that the alpha parameter is now a
per-pixel value, and not constant across the image.</p>
<p>Due to the need for an alpha channel the <i class="arg">foreground</i> has to be of
type <b class="const">rgba</b>. For the <i class="arg">background</i> image the types
<b class="const">rgb</b> and <b class="const">rgba</b> are supported.</p></dd>
<dt><a name="32"><b class="cmd">::crimp</b> <b class="method">atan2</b> <i class="arg">image1</i> <i class="arg">image2</i></a></dt>
<dd><p>This method combines the two input images into a result image by
computing</p>
<p><img alt="atan2" src="../image/atan2.png"></p>
<p>at each pixel.</p>
<p>The input is restricted to images of the single-channel types,
i.e. <b class="const">float</b> and <b class="const">grey{8,16,32}</b>. The result is always
of type <b class="const">float</b>.</p>
<p>An application of this operation is the computation of a gradient's
direction from two images representing a gradient in X and Y directions.
For the full conversion of such cartesian gradients to a polar
representation use the <b class="method">crimp hypot</b> operation to compute the
gradient's magnitude at each pixel.</p></dd>
<dt><a name="33"><b class="cmd">::crimp</b> <b class="method">blank</b> <i class="arg">type</i> <i class="arg">width</i> <i class="arg">height</i> <i class="arg">value</i>...</a></dt>
<dd><p>This method returns a blank image of the given image type and
dimensions.  The <i class="arg">value</i>s after the dimensions are the pixel
values to fill the pixels in the image's channels with, per its type.</p>
<p>This method currently support only the types <b class="const">rgb</b>,
<b class="const">rgba</b>, and <b class="const">grey8</b>.</p></dd>
<dt><a name="34"><b class="cmd">::crimp</b> <b class="method">crop</b> <i class="arg">image</i> <i class="arg">ww</i> <i class="arg">hn</i> <i class="arg">we</i> <i class="arg">hs</i></a></dt>
<dd><p>This method is the counterpart to the <b class="method">expand</b> family of
methods, shrinking an <i class="arg">image</i> by removing a border.
The size of this border is specified by the four arguments <i class="arg">ww</i>,
<i class="arg">hn</i>, <i class="arg">we</i>, and <i class="arg">hs</i> which provide the number of pixels to
remove from the named edge. See the image below for a graphical
representation.</p>
<p><img alt="border" src="../image/border.png"></p></dd>
<dt><a name="35"><b class="cmd">::crimp</b> <b class="method">cut</b> <i class="arg">image</i> <i class="arg">x</i> <i class="arg">y</i> <i class="arg">w</i> <i class="arg">h</i></a></dt>
<dd><p>This method cuts the rectangular region specified throught its <i class="arg">x</i>/<i class="arg">y</i>
position relative to the upper-left corner of the input <i class="arg">image</i> and its
dimensions, and returns it as its own image.</p></dd>
<dt><a name="36"><b class="cmd">::crimp</b> <b class="method">decimate xy</b> <i class="arg">image</i> <i class="arg">factor</i> <i class="arg">kernel</i></a></dt>
<dd></dd>
<dt><a name="37"><b class="cmd">::crimp</b> <b class="method">decimate x</b> <i class="arg">image</i> <i class="arg">factor</i> <i class="arg">kernel</i></a></dt>
<dd></dd>
<dt><a name="38"><b class="cmd">::crimp</b> <b class="method">decimate y</b> <i class="arg">image</i> <i class="arg">factor</i> <i class="arg">kernel</i></a></dt>
<dd><p>This is a convenience method combining the two steps of filtering an image
(via <b class="method">filter convolve</b>), followed by a <b class="method">downsample</b> step.
See the method <b class="method">interpolate</b> for the complementary operation.</p>
<p>Note that while the <i class="arg">kernel</i> argument for <b class="method">filter convolve</b>
is expected to be the 1D form of a separable low-pass filter no checks are made.
The method simply applies both the kernel and its transposed form.</p>
<p>The method <b class="method">pyramid gauss</b> is a user of this method.</p></dd>
<dt><a name="39"><b class="cmd">::crimp</b> <b class="method">degamma</b> <i class="arg">image</i> <i class="arg">y</i></a></dt>
<dd><p>This method takes an image, runs it through an
<b class="function">inverse gamma correction</b> with parameter <i class="arg">y</i>, and returns
the corrected image as it result.
This is an application of method <b class="method">remap</b>, using the mapping
returned by &quot;<b class="method">map degamma</b> <i class="arg">y</i>&quot;.
This method supports all image types supported by the method
<b class="method">remap</b>.</p></dd>
<dt><a name="40"><b class="cmd">::crimp</b> <b class="method">difference</b> <i class="arg">image1</i> <i class="arg">image2</i></a></dt>
<dd><p>This method combines the two input images into a result image by
taking the pixelwise absolute difference (|image1 - image2|).</p></dd>
<dt><a name="41"><b class="cmd">::crimp</b> <b class="method">downsample xy</b> <i class="arg">image</i> <i class="arg">factor</i></a></dt>
<dd></dd>
<dt><a name="42"><b class="cmd">::crimp</b> <b class="method">downsample x</b> <i class="arg">image</i> <i class="arg">factor</i></a></dt>
<dd></dd>
<dt><a name="43"><b class="cmd">::crimp</b> <b class="method">downsample y</b> <i class="arg">image</i> <i class="arg">factor</i></a></dt>
<dd><p>This method returns an image containing only every <i class="arg">factor</i> pixel of the
input <i class="arg">image</i> (in x, y, or both dimensions). The effect is that the input is
shrunken by <i class="arg">factor</i>. It is the complement of method <b class="method">upsample</b>.</p>
<p>Using the method as is is not recommended because the simple subsampling
will cause higher image frequencies to alias into the reduced spectrum, causing
artifacts to appear in the result. This is normally avoided by running a
low-pass filter over the image before doing downsampling, removing the
problematic frequencies.</p>
<p>The <b class="method">decimate</b> method is a convenience method combining these
two steps into one.</p></dd>
<dt><a name="44"><b class="cmd">::crimp</b> <b class="method">effect charcoal</b> <i class="arg">image</i></a></dt>
<dd><p>This method applies a charcoal effect to the image, i.e. it returns a
<b class="const">grey8</b> image showing the input as if it had been drawn with a
charcoal pencil.</p></dd>
<dt><a name="45"><b class="cmd">::crimp</b> <b class="method">effect emboss</b> <i class="arg">image</i></a></dt>
<dd><p>This method applies an embossing effect to the image, i.e. it returns
an image of the same type as the input showing the input as if it had
been embossed into a metal plate with a stencil of some kind.</p></dd>
<dt><a name="46"><b class="cmd">::crimp</b> <b class="method">effect sharpen</b> <i class="arg">image</i></a></dt>
<dd><p>This method sharpens the input image, i.e. returns an image of the
same type as the input in which the input's edges are emphasized.</p></dd>
<dt><a name="47"><b class="cmd">::crimp</b> <b class="method">expand const</b> <i class="arg">image</i> <i class="arg">ww</i> <i class="arg">hn</i> <i class="arg">we</i> <i class="arg">hs</i> <span class="opt">?<i class="arg">value</i>...?</span></a></dt>
<dd></dd>
<dt><a name="48"><b class="cmd">::crimp</b> <b class="method">expand extend</b> <i class="arg">image</i> <i class="arg">ww</i> <i class="arg">hn</i> <i class="arg">we</i> <i class="arg">hs</i></a></dt>
<dd></dd>
<dt><a name="49"><b class="cmd">::crimp</b> <b class="method">expand mirror</b> <i class="arg">image</i> <i class="arg">ww</i> <i class="arg">hn</i> <i class="arg">we</i> <i class="arg">hs</i></a></dt>
<dd></dd>
<dt><a name="50"><b class="cmd">::crimp</b> <b class="method">expand replicate</b> <i class="arg">image</i> <i class="arg">ww</i> <i class="arg">hn</i> <i class="arg">we</i> <i class="arg">hs</i></a></dt>
<dd></dd>
<dt><a name="51"><b class="cmd">::crimp</b> <b class="method">expand wrap</b> <i class="arg">image</i> <i class="arg">ww</i> <i class="arg">hn</i> <i class="arg">we</i> <i class="arg">hs</i></a></dt>
<dd><p>This set of methods takes an image and expands it by adding a border.
The size of this border is specified by the four arguments <i class="arg">ww</i>,
<i class="arg">hn</i>, <i class="arg">we</i>, and <i class="arg">hs</i> which provide the number of pixels to
add at the named edge. See the image below for a graphical
representation.</p>
<p><img alt="border" src="../image/border.png"></p>
<p>The contents of the border's pixels are specified via the border type,
the first argument after <b class="method">expand</b>, as per the list below.</p>
<dl class="definitions">
<dt><b class="method">const</b></dt>
<dd><p>The additional <i class="arg">value</i>s specify the values to use for the color
channels of the image. Values beyond the number of channels in the
image are ignored.
Missing values are generated by replicating the last value, except for
the alpha channel, which will be set to <b class="const">255</b>. If no values are
present they default to <b class="const">0</b>.</p></dd>
<dt><b class="method">extend</b></dt>
<dd><p>This is a combination of <b class="method">mirror</b> and <b class="method">replicate</b>.  The
outside pixels are the result of subtracting the outside pixel for
<b class="method">mirror</b> from the outside pixel for <b class="method">replicate</b> (and
clamping to the range [0...255]).</p></dd>
<dt><b class="method">mirror</b></dt>
<dd><p>The outside pixels take the value of the associated inside pixels,
found by reflecting its coordinates along the relevant edges.</p></dd>
<dt><b class="method">replicate</b></dt>
<dd><p>The outside pixels take the value of the associated edge pixels, i.e.
replicating them into the border.</p></dd>
<dt><b class="method">wrap</b></dt>
<dd><p>The outside pixels take the value of the associated inside pixels,
found by toroidial (cyclic) wrapping its coordinates along the
relevant edges. This is also called tiling.</p></dd>
</dl></dd>
<dt><a name="52"><b class="cmd">::crimp</b> <b class="method">fft forward</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="53"><b class="cmd">::crimp</b> <b class="method">fft backward</b> <i class="arg">image</i></a></dt>
<dd><p>These two methods implement 2D FFT (forward) and inverse FFT (backward).</p>
<p>The input is restricted to images of the single-channel types,
i.e. <b class="const">float</b> and <b class="const">grey{8,16,32}</b>. The result is always
of type <b class="const">float</b>.</p>
<p>The former means that it is necessary to split <b class="const">rgb</b>,
etc. images into their channels before performing an FFT, and that
results of an inverse FFT have to be joined.
See the methods <b class="method">split</b> and <b class="method">join</b> for the relevant
operations and their syntax.</p>
<p>The latter means that a separate invokation of method
<b class="method">convert 2grey8</b> is required when reconstructing an image
by inverting its FFT.</p></dd>
<dt><a name="54"><b class="cmd">::crimp</b> <b class="method">filter ahe</b> <i class="arg">image</i> <span class="opt">?<b class="option">-border</b> <i class="arg">spec</i>?</span> <span class="opt">?<i class="arg">radius</i>?</span></a></dt>
<dd><p>This method performs adaptive histogram equalization to enhance the
contrast of the input image. Each pixel undergoes regular histogram
equalization, with the histogram computed from the pixels in the
<b class="variable">N</b>x<b class="variable">N</b> square centered on it, where
&quot;<b class="variable">N</b> = 2*<b class="variable">radius</b>+1&quot;.</p>
<p>The default radius is <b class="const">3</b>, for a 7x7 square.</p></dd>
<dt><a name="55"><b class="cmd">::crimp</b> <b class="method">filter convolve</b> <i class="arg">image</i> <span class="opt">?<b class="option">-border</b> <i class="arg">spec</i>?</span> <i class="arg">kernel</i>...</a></dt>
<dd><p>This method runs the series of filters specified by the convolution
<i class="arg">kernel</i>s over the input and returns the filtered result. See the
method <b class="method">kernel</b> and its sub-methods for commands to create and
manipulate suitable kernels.</p>
<p>The border specification determines how the input image is
expanded (see method <b class="method">expand</b>) to compensate for the shrinkage
introduced by the filter itself. The <i class="arg">spec</i> argument is a list
containing the name of the sub-method of <b class="method">expand</b> to use, plus
any additional arguments this method may need, except for the size of
the expansion.</p>
<p>By default a black frame is used as the border, i.e.
&quot;<i class="arg">spec</i> == {const 0}&quot;.</p></dd>
<dt><a name="56"><b class="cmd">::crimp</b> <b class="method">filter gauss discrete</b> <i class="arg">image</i> <i class="arg">sigma</i> <span class="opt">?<i class="arg">r</i>?</span></a></dt>
<dd></dd>
<dt><a name="57"><b class="cmd">::crimp</b> <b class="method">filter gauss sampled</b> <i class="arg">image</i> <i class="arg">sigma</i> <span class="opt">?<i class="arg">r</i>?</span></a></dt>
<dd><p>These methods apply a discrete or sampled gaussian blur with
parameters <i class="arg">sigma</i> and kernel <i class="arg">r</i>adius to the <i class="arg">image</i>. If
the radius is not specified it defaults to the smallest integer
greater than &quot;3*<i class="arg">sigma</i>&quot;.</p></dd>
<dt><a name="58"><b class="cmd">::crimp</b> <b class="method">filter mean</b> <i class="arg">image</i> <span class="opt">?<b class="option">-border</b> <i class="arg">spec</i>?</span> <span class="opt">?<i class="arg">radius</i>?</span></a></dt>
<dd><p>This method applies a mean filter with <i class="arg">radius</i> to the
image. I.e. each pixel of the result is the mean value of all pixels
in the <b class="variable">N</b>x<b class="variable">N</b> square centered on it, where
&quot;<b class="variable">N</b> = 2*<b class="variable">radius</b>+1&quot;.</p>
<p>The default radius is <b class="const">3</b>, for a 7x7 square.</p>
<p><em>NOTE</em>. As the mean is known to be in the range defined by the
channel this method automatically converts float results back to the
channel type. This introduces rounding / quantization errors. As a
result of this price being paid the method is able to handle
multi-channel images, by automatically splitting, processing, and
rejoining its channels.</p>
<p>The method <b class="method">filter stddev</b> on the other makes the reverse
tradeoff, keeping precision, but unable to handle multi-channel
images.</p></dd>
<dt><a name="59"><b class="cmd">::crimp</b> <b class="method">filter rank</b> <i class="arg">image</i> <span class="opt">?<b class="option">-border</b> <i class="arg">spec</i>?</span> <span class="opt">?<i class="arg">radius</i> <span class="opt">?<i class="arg">percentile</i>?</span>?</span></a></dt>
<dd><p>This method runs a rank-filter over the input and returns the filtered
result.</p>
<p>The border specification determines how the input image is
expanded (see method <b class="method">expand</b>) to compensate for the shrinkage
introduced by the filter itself. The <i class="arg">spec</i> argument is a list
containing the name of the sub-method of <b class="method">expand</b> to use, plus
any additional arguments this method may need, except for the size of
the expansion.</p>
<p>By default a black frame is used as the border, i.e.
&quot;<i class="arg">spec</i> == {const 0}&quot;.</p>
<p>The <i class="arg">radius</i> specifies the (square) region around each
pixel which is taken into account by the filter, with the pixel value
selected according to the <i class="arg">percentile</i>. The filter region of each
pixel is a square of dimensions &quot;2*<i class="arg">radius</i>+1&quot;, centered around
the pixel.</p>
<p>These two values default to <b class="const">3</b> and <b class="const">50</b>, respectively.</p>
<p>Typical applications of rank-filters are min-, max-, and
median-filters, for percentiles 0, 100, and 50, respectively.</p>
<p>Note that percentiles outside of the range <b class="const">0</b>...<b class="const">100</b>
make no sense and are clamped to this range.</p></dd>
<dt><a name="60"><b class="cmd">::crimp</b> <b class="method">filter stddev</b> <i class="arg">image</i> <span class="opt">?<b class="option">-border</b> <i class="arg">spec</i>?</span> <span class="opt">?<i class="arg">radius</i>?</span></a></dt>
<dd><p>This method applies a stand deviation filter with <i class="arg">radius</i> to the
image. I.e. each pixel of the result is the standard deviation of all
pixel values in the <b class="variable">N</b>x<b class="variable">N</b> square centered on it, where
&quot;<b class="variable">N</b> = 2*<b class="variable">radius</b>+1&quot;.</p>
<p>The default radius is <b class="const">3</b>, for a 7x7 square.</p>
<p><em>NOTE</em>. As the standard deviation is often quite small and its
precision important the result of this method is always an image of
type <b class="const">float</b>. Because of this this method is unable to handle
multi-channel images as the results of processing their channels
cannot be joined back together for the proper type.</p>
<p>The method <b class="method">filter mean</b> on the other hand makes the reverse
tradeoff, handling multi-channel images, but dropping precision.</p></dd>
<dt><a name="61"><b class="cmd">::crimp</b> <b class="method">filter sobel x</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="62"><b class="cmd">::crimp</b> <b class="method">filter sobel y</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="63"><b class="cmd">::crimp</b> <b class="method">filter scharr x</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="64"><b class="cmd">::crimp</b> <b class="method">filter scharr y</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="65"><b class="cmd">::crimp</b> <b class="method">filter prewitt x</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="66"><b class="cmd">::crimp</b> <b class="method">filter prewitt y</b> <i class="arg">image</i></a></dt>
<dd><p>These methods are convenience methods implementing a number of standard
convolution filters using for edge detection and calculation of image
gradients.</p>
<p>See the <b class="method">crimp gradient</b> methods for users of these filters.</p>
<p>Also note that the <b class="method">x</b> methods emphasize gradient in the horizontal
direction, and thus highlight <em>vertical</em> lines, and vice versa for
<b class="method">y</b>.</p></dd>
<dt><a name="67"><b class="cmd">::crimp</b> <b class="method">gamma</b> <i class="arg">image</i> <i class="arg">y</i></a></dt>
<dd><p>This method takes an image, runs it through a <b class="function">gamma correction</b>
with parameter <i class="arg">y</i>, and returns the corrected image as it result.
This is an application of method <b class="method">remap</b>, using the mapping
returned by &quot;<b class="method">map gamma</b> <i class="arg">y</i>&quot;.
This method supports all image types supported by the method
<b class="method">remap</b>.</p></dd>
<dt><a name="68"><b class="cmd">::crimp</b> <b class="method">gradient sobel</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="69"><b class="cmd">::crimp</b> <b class="method">gradient scharr</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="70"><b class="cmd">::crimp</b> <b class="method">gradient prewitt</b> <i class="arg">image</i></a></dt>
<dd><p>These methods generate two gradient images for the input image, in the
X- and Y-directions, using different semi-standard filters. I.e. the
result is a cartesian representation of the gradients in the input.
The result is a 2-element list containing the X- and Y-gradient
images, in this order.</p></dd>
<dt><a name="71"><b class="cmd">::crimp</b> <b class="method">gradient polar</b> <i class="arg">cgradient</i></a></dt>
<dd><p>This method takes a gradient in cartesian representation (as
returned by the above methods) and converts it to polar
representation, i.e. magnitude and angle. The result of the method
is a 2-element list containing two <b class="const">float</b> images, the
magnitude and angle, in this order. The angle is represented
in degrees running from 0 to 360.</p></dd>
<dt><a name="72"><b class="cmd">::crimp</b> <b class="method">gradient visual</b> <i class="arg">pgradient</i></a></dt>
<dd><p>This method takes a gradient in polar representation (as
returned by method <b class="method">gradient polar</b>) and converts it
into a color image (<b class="const">rgb</b>) visualizing the gradient.</p>
<p>The visualization is easier to understand in HSV space tough,
with the angle mapped to Hue, i.e. color, magnitude to Value,
and Saturation simply at full.</p></dd>
<dt><a name="73"><b class="cmd">::crimp</b> <b class="method">hypot</b> <i class="arg">image1</i> <i class="arg">image2</i></a></dt>
<dd><p>This method combines the two input images into a result image by
computing</p>
<p><img alt="hypot" src="../image/hypot.png"></p>
<p>at each pixel.</p>
<p>The input is restricted to images of the single-channel types,
i.e. <b class="const">float</b> and <b class="const">grey{8,16,32}</b>. The result is always
of type <b class="const">float</b>.</p>
<p>An application of this operation is the computation of the gradient
magnitude from two images representing a gradient in X and Y directions.
For the full conversion of such cartesian gradients to a polar
representation use the <b class="method">crimp atan2</b> operation to compute the
gradient's direction at each pixel.</p></dd>
<dt><a name="74"><b class="cmd">::crimp</b> <b class="method">integrate</b> <i class="arg">image</i></a></dt>
<dd><p>This method takes any single-channel image, i.e. of types
<b class="const">float</b> and <b class="const">grey{8,16,32}</b>, and returns its integral,
i.e. a summed area table. The type of the result is always of type
<b class="const">float</b>.</p></dd>
<dt><a name="75"><b class="cmd">::crimp</b> <b class="method">interpolate xy</b> <i class="arg">image</i> <i class="arg">factor</i> <i class="arg">kernel</i></a></dt>
<dd></dd>
<dt><a name="76"><b class="cmd">::crimp</b> <b class="method">interpolate x</b> <i class="arg">image</i> <i class="arg">factor</i> <i class="arg">kernel</i></a></dt>
<dd></dd>
<dt><a name="77"><b class="cmd">::crimp</b> <b class="method">interpolate y</b> <i class="arg">image</i> <i class="arg">factor</i> <i class="arg">kernel</i></a></dt>
<dd><p>This is a convenience method combining the two steps of an <b class="method">upsample</b>,
followed by a filter step (via <b class="method">filter convolve</b>). See the method
<b class="method">decimate</b> for the complementary operation.</p>
<p>Note that while the <i class="arg">kernel</i> argument for <b class="method">filter convolve</b>
is expected to be 1D form of a separable low-pass filter no checks are made.
The method simply applies both the kernel and its transposed form.</p>
<p>The methods <b class="method">pyramid gauss</b> and <b class="method">pyramid laplace</b> are
users of this method.</p></dd>
<dt><a name="78"><b class="cmd">::crimp</b> <b class="method">invert</b> <i class="arg">image</i></a></dt>
<dd><p>This method takes an image, runs it through the <b class="function">inverse</b>
function, and returns the modified image as it result.
This is an application of method <b class="method">remap</b>, using the mapping
returned by &quot;<b class="method">map inverse</b>&quot;.
This method supports all image types supported by the method
<b class="method">remap</b>.</p></dd>
<dt><a name="79"><b class="cmd">::crimp</b> <b class="method">matrix</b> <i class="arg">image</i> <i class="arg">matrix</i></a></dt>
<dd><p>This method takes an image and a 3x3 matrix specified as nested Tcl
list (row major order), applies the projective transform represented
by the matrix to the image and returns the transformed image as its
result.</p>
<p>Notes: It is currently unclear how the output pixel is computed
(nearest neighbour, bilinear, etc.) (code inherited from AMG). This
requires more reading, and teasing things apart. The transfomred image
is clipped to the dimensions of the input image, i.e. pixels from the
input may be lost, and pixels in the output may be unset as their
input would come from outside of the input.</p>
<p>The operation supports only images of type <b class="const">rgba</b>, and returns
images of the same type.</p></dd>
<dt><a name="80"><b class="cmd">::crimp</b> <b class="method">max</b> <i class="arg">image1</i> <i class="arg">image2</i></a></dt>
<dd><p>This method combines the two input images into a result image by
taking the pixelwise maximum.</p></dd>
<dt><a name="81"><b class="cmd">::crimp</b> <b class="method">min</b> <i class="arg">image1</i> <i class="arg">image2</i></a></dt>
<dd><p>This method combines the two input images into a result image by
taking the pixelwise minimum.</p></dd>
<dt><a name="82"><b class="cmd">::crimp</b> <b class="method">montage horizontal</b> <span class="opt">?<b class="option">-align</b> <b class="const">top</b>|<b class="const">center</b>|<b class="const">bottom</b>?</span> <span class="opt">?<b class="option">-border</b> <i class="arg">spec</i>?</span> <i class="arg">image</i>...</a></dt>
<dd></dd>
<dt><a name="83"><b class="cmd">::crimp</b> <b class="method">montage vertical</b> <span class="opt">?<b class="option">-align</b> <b class="const">left</b>|<b class="const">middle</b>|<b class="const">right</b>?</span> <span class="opt">?<b class="option">-border</b> <i class="arg">spec</i>?</span> <i class="arg">image</i>...</a></dt>
<dd><p>The result of these methods is an image where the input images have
been placed adjacent to each from left to right (horizontal), or top
to bottom (vertical). The input images have to have the same type.</p>
<p>There is no need however for them to have the same height, or width,
respectively. When images of different height (width) are used the
command will expand them to their common height (width), which is the
maximum of all heights (widths). The expansion process is further
governed by the values of the <b class="option">-align</b> and <b class="option">-border</b>
options, with the latter specifying the form of the expansion (see
method <b class="method">expand</b> for details), and the first specifying how the
image is aligned within the expanded space.</p>
<p>The <i class="arg">spec</i> argument of <b class="option">-border</b> is a list containing the
name of the sub-method of <b class="method">expand</b> to use, plus any additional
arguments this method may need, except for the size of the expansion.</p>
<p>The default values for <b class="option">-align</b> are <b class="const">center</b> and
<b class="const">middle</b>, centering the image in the space. The default for the
<b class="option">-border</b> is a black frame, i.e. &quot;<i class="arg">spec</i> == {const 0}&quot;.</p></dd>
<dt><a name="84"><b class="cmd">::crimp</b> <b class="method">morph dilate</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="85"><b class="cmd">::crimp</b> <b class="method">morph erode</b> <i class="arg">image</i></a></dt>
<dd><p>These two methods implement the basic set of morphology operations,
<i class="term"><a href="../index.html#key86">erosion</a></i>, and <i class="term"><a href="../index.html#key19">dilation</a></i> using a flat 3x3 brick as their
structuring element. For grayscale, which we have here, these are,
mathematically, max and min rank-order filters, i.e.</p>
<pre class="example">
    dilate = filter rank 1  0.00 (min)
    erode  = filter rank 1 99.99 (max)
</pre>
</dd>
<dt><a name="86"><b class="cmd">::crimp</b> <b class="method">morph close</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="87"><b class="cmd">::crimp</b> <b class="method">morph open</b> <i class="arg">image</i></a></dt>
<dd><p>These two methods add to the basic set of morphology operations,
<i class="term"><a href="../index.html#key88">opening</a></i> and <i class="term"><a href="../index.html#key11">closing</a></i>. In terms of erosion and dilation:</p>
<pre class="example">
    close = erode o dilate 
    open  = dilate o erode
</pre>
</dd>
<dt><a name="88"><b class="cmd">::crimp</b> <b class="method">morph gradient</b> <i class="arg">image</i></a></dt>
<dd><p>The morphological <i class="term"><a href="../index.html#key95">gradient</a></i> is defined as</p>
<pre class="example">
    [dilate $image] - [erode $image]
</pre>
<p>This can also be expressed as the sum of the external and internal
gradients, see below.</p></dd>
<dt><a name="89"><b class="cmd">::crimp</b> <b class="method">morph igradient</b> <i class="arg">image</i></a></dt>
<dd><p>The morphological <i class="term"><a href="../index.html#key17">internal gradient</a></i> is defined as</p>
<pre class="example">
    $image - [erode image]
</pre>
</dd>
<dt><a name="90"><b class="cmd">::crimp</b> <b class="method">morph egradient</b> <i class="arg">image</i></a></dt>
<dd><p>The morphological <i class="term"><a href="../index.html#key1">external gradient</a></i> is defined as</p>
<pre class="example">
    [dilate $image] - $image
</pre>
</dd>
<dt><a name="91"><b class="cmd">::crimp</b> <b class="method">morph tophatw</b> <i class="arg">image</i></a></dt>
<dd><p>The <i class="term"><a href="../index.html#key57">white tophat</a></i> transformation is defined as</p>
<pre class="example">
    $image - [open $image]
</pre>
</dd>
<dt><a name="92"><b class="cmd">::crimp</b> <b class="method">morph tophatb</b> <i class="arg">image</i></a></dt>
<dd><p>The <i class="term"><a href="../index.html#key32">black tophat</a></i> transformation is defined as</p>
<pre class="example">
    [close $image] - $image
</pre>
</dd>
<dt><a name="93"><b class="cmd">::crimp</b> <b class="method">multiply</b> <i class="arg">image1</i> <i class="arg">image2</i></a></dt>
<dd><p>This method combines the two input images into a result image by
performing a pixelwise multiplication. Note that the result of each
multiplication is divided by <b class="const">255</b> to scale it back into the
range [0...255].</p></dd>
<dt><a name="94"><b class="cmd">::crimp</b> <b class="method">psychedelia</b> <i class="arg">width</i> <i class="arg">height</i> <i class="arg">frames</i></a></dt>
<dd><p>This method creates an <b class="const">rgba</b> image of the specified dimensions
according to an algorithm devised by Andrew M. Goth. The <i class="arg">frames</i>
argument specifies how many images are in the series.</p>
<p><em>Attention:</em> This method keeps internal global state,
ensuring that each call returns a slightly different image. Showing a
series of such images as animation provides an effect similar to a
lava lamp or hallucination.</p></dd>
<dt><a name="95"><b class="cmd">::crimp</b> <b class="method">pyramid run</b> <i class="arg">image</i> <i class="arg">steps</i> <i class="arg">stepcmd</i></a></dt>
<dd><p>This method provides the core functionality for the generation of image
pyramids. The command prefix <i class="arg">stepcmd</i> is run <i class="arg">steps</i> times,
first on the <i class="arg">image</i>, then on the result of the previous step.</p>
<p>The assumed signature of <i class="arg">stepcmd</i> is</p>
<dl class="definitions">
<dt><a name="96"><b class="cmd">&lt;stepcmd&gt;</b> <i class="arg">image</i></a></dt>
<dd><p>which is expected to return a list of two elements. The first element
(<i class="term">result</i>) is added to the pyramid in building, whereas the second
element (<i class="term">iter</i>) is used in the next step as the input of the step
command.</p></dd>
</dl>
<p>The final result of the method is a list containing the input
<i class="arg">image</i> as its first element, followed by the results of the step
function, followed by the <i class="term">iter</i> element returned by the last step,
&quot;<i class="arg">steps</i>+2&quot; images in total.</p>
<p><img alt="pyramid" src="../image/pyramid.png"></p></dd>
<dt><a name="97"><b class="cmd">::crimp</b> <b class="method">pyramid gauss</b> <i class="arg">image</i> <i class="arg">steps</i></a></dt>
<dd><p>This method generates a gaussian image pyramid <i class="arg">steps</i> levels deep and
returns it as a list of images.</p>
<p>The first image in the result is the input, followed by <i class="arg">steps</i>
successively smaller images, each <b class="method">decimate</b>d by a factor two
compared to its predecessor, for a total length of &quot;<i class="arg">steps</i>+1&quot; images.</p>
<p>The convolution part of the decimation uses</p>
<pre class="example"> 1/16 [1 4 6 4 1] </pre>
<p>as its kernel.</p>
<p><img alt="pyramid_gauss" src="../image/pyramid_gauss.png"></p></dd>
<dt><a name="98"><b class="cmd">::crimp</b> <b class="method">pyramid laplace</b> <i class="arg">image</i> <i class="arg">steps</i></a></dt>
<dd><p>This method generates a laplacian image pyramid <i class="arg">steps</i> levels deep and
returns it as a list of images.</p>
<p>The first image in the result is the input, followed by <i class="arg">steps</i>
band pass images (differences of gaussians). The first band pass has the same
size as the input image, and each successor is <b class="method">decimate</b>d by two. This
is followed by one more image, the gaussian of the last step. This image is
decimated by two compared to the preceding bandpass image. In total the result
contains &quot;<i class="arg">steps</i>+2&quot; images.</p>
<p>The convolution part of the decimation uses</p>
<pre class="example"> 1/16 [1 4 6 4 1] </pre>
<p>as its kernel. The internal interpolation used to generate the band pass
images (resynthesis) doubles the weights of this kernel for its convolution
step.</p>
<p><img alt="pyramid_laplace" src="../image/pyramid_laplace.png"></p></dd>
<dt><a name="99"><b class="cmd">::crimp</b> <b class="method">remap</b> <i class="arg">image</i> <i class="arg">map</i>...</a></dt>
<dd><p>This method is the core primitive for the per-pixel transformation of
images, with each pixel (and channels within, if any) handled
independently of all others.
Applications of this operator provided by this package are (inverse)
gamma correction, pixel inversion, and solarization. Many more are
possible, especially when considering other colorspaces like
HSV. There, for example, it is possible change the saturation of
pixels, or shift the hue in arbitrary manner.</p>
<p>Beyond the input <i class="arg">image</i> to transform one or more <i class="term">maps</i> are
specified which define how each pixel value in the input is mapped to
a pixel value in the output. The command will accept at most that many
maps as the input image has channels.  If there are less maps than
channel the last map specified is replicated to cover the other
channels. An exception of this is the handling of the alpha channel,
should the input image have such. There a missing map is handle as
<b class="function">identity</b>, i.e. the channel copied as is, without changes.</p>
<p>The maps are not Tcl data structures, but images themselves.  They
have to be of type <b class="const">grey8</b>, and be of dimension 256x1 (width by
height).</p>
<p>The <b class="method">crimp map ...</b> methods are sources for a number of
predefined maps, whereas the <b class="method">mapof</b> method allows the
construction of maps from Tcl data structures, namely lists of values.</p>
<p>This method supports all image types with one or more
single-byte channels, i.e. all but <b class="const">grey16</b>, <b class="const">grey32</b>,
<b class="const">float</b>, and <b class="const">bw</b>.</p></dd>
<dt><a name="100"><b class="cmd">::crimp</b> <b class="method">screen</b> <i class="arg">image1</i> <i class="arg">image2</i></a></dt>
<dd><p>This method combines the two input images by inverting the
multiplication of the inverted input images. I.e.</p>
<p><img alt="screen" src="../image/screen.png"></p></dd>
<dt><a name="101"><b class="cmd">::crimp</b> <b class="method">solarize</b> <i class="arg">image</i> <i class="arg">threshold</i></a></dt>
<dd><p>This method takes an image, runs it through the <b class="function">solarize</b>
function with parameter <i class="arg">threshold</i>, and returns the modified
image as it result. This is also known as the <i class="term"><a href="../index.html#key79">sabattier effect</a></i>.
This is an application of method <b class="method">remap</b>, using the mapping
returned by &quot;<b class="method">map solarize</b> <i class="arg">threshold</i>&quot;.
This method supports all image types supported by the method
<b class="method">remap</b>.</p></dd>
<dt><a name="102"><b class="cmd">::crimp</b> <b class="method">square</b> <i class="arg">image</i></a></dt>
<dd><p>This is a convenience method equivalent to
&quot;<b class="cmd">crimp multiply</b> <i class="arg">image</i> <i class="arg">image</i>&quot;.</p></dd>
<dt><a name="103"><b class="cmd">::crimp</b> <b class="method">subtract</b> <i class="arg">image1</i> <i class="arg">image2</i> <span class="opt">?<i class="arg">scale</i>?</span> <span class="opt">?<i class="arg">offset</i>?</span></a></dt>
<dd><p>This method combines the two input images into a result image by
performing a pixelwise subtraction (image1 - image2) followed by
division through <i class="arg">scale</i> and addition of the <i class="arg">offset</i>. They
default to <b class="const">1</b> and <b class="const">0</b> respectively, if they are not
specified.</p></dd>
<dt><a name="104"><b class="cmd">::crimp</b> <b class="method">threshold global above</b> <i class="arg">image</i> <i class="arg">threshold</i></a></dt>
<dd><p>This method takes an image, runs it through the <b class="function">threshold above</b>
function with parameter <i class="arg">threshold</i>, and returns the modified
image as it result. As the result only contains black and white,
i.e. 2 colors, this process is also called <i class="term"><a href="../index.html#key92">binarization</a></i> or
foreground/background segmentation.
This is an application of method <b class="method">remap</b>, using the mapping
returned by &quot;<b class="method">map threshold above</b> <i class="arg">threshold</i>&quot;.
This method supports all image types supported by the method
<b class="method">remap</b>.</p></dd>
<dt><a name="105"><b class="cmd">::crimp</b> <b class="method">threshold global below</b> <i class="arg">image</i> <i class="arg">threshold</i></a></dt>
<dd><p>This method takes an image, runs it through the <b class="function">threshold below</b>
function with parameter <i class="arg">threshold</i>, and returns the modified
image as it result. As the result only contains black and white,
i.e. 2 colors, this process is also called <i class="term"><a href="../index.html#key92">binarization</a></i>, or
foreground/background segmentation.
This is an application of method <b class="method">remap</b>, using the mapping
returned by &quot;<b class="method">map threshold below</b> <i class="arg">threshold</i>&quot;.
This method supports all image types supported by the method
<b class="method">remap</b>.</p></dd>
<dt><a name="106"><b class="cmd">::crimp</b> <b class="method">threshold global inside</b> <i class="arg">image</i> <i class="arg">min</i> <i class="arg">max</i></a></dt>
<dd><p>This method takes an image, runs it through the <b class="function">threshold inside</b>
function with parameters <i class="arg">min</i> and <i class="arg">max</i>, and returns the
modified image as it result. As the result only contains black and
white, i.e. 2 colors, this process is also called <i class="term"><a href="../index.html#key92">binarization</a></i>
or foreground/background segmentation.
This is an application of method <b class="method">remap</b>, using the mapping
returned by &quot;<b class="method">map threshold above</b> <i class="arg">threshold</i>&quot;.
This method supports all image types supported by the method
<b class="method">remap</b>.</p></dd>
<dt><a name="107"><b class="cmd">::crimp</b> <b class="method">threshold global outside</b> <i class="arg">image</i> <i class="arg">min</i> <i class="arg">max</i></a></dt>
<dd><p>This method takes an image, runs it through the <b class="function">threshold outside</b>
function with parameters <i class="arg">min</i> and <i class="arg">max</i>, and returns the
modified image as it result. As the result only contains black and
white, i.e. 2 colors, this process is also called <i class="term"><a href="../index.html#key92">binarization</a></i>,
or foreground/background segmentation.
This is an application of method <b class="method">remap</b>, using the mapping
returned by &quot;<b class="method">map threshold below</b> <i class="arg">threshold</i>&quot;.
This method supports all image types supported by the method
<b class="method">remap</b>.</p></dd>
<dt><a name="108"><b class="cmd">::crimp</b> <b class="method">threshold global middle</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="109"><b class="cmd">::crimp</b> <b class="method">threshold global mean</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="110"><b class="cmd">::crimp</b> <b class="method">threshold global median</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="111"><b class="cmd">::crimp</b> <b class="method">threshold global otsu</b> <i class="arg">image</i></a></dt>
<dd><p>These four methods are convenience methods layered on top of
<b class="cmd">crimp threshold global below</b>. They compute the value(s) to
perform the thresholding with from the global statistics of the input
image, with the element taken named by the method. For reference see
the documentation of method <b class="cmd">crimp statistics ...</b>. Note that
they treat each color channel in the image separately.</p></dd>
<dt><a name="112"><b class="cmd">::crimp</b> <b class="method">threshold local</b> <i class="arg">image</i> <i class="arg">threshold</i>...</a></dt>
<dd><p>This method takes an <i class="arg">image</i> and one or more <i class="arg">threshold</i> maps
and returns an image where all pixels of the input which were larger
or equal to the corresponding pixel in the map are set to black. All
other pixels are set to white. Each map is applied to one color
channel of the input image. If there are too many maps the remainder
is ignored. If there are not enough maps the last map is replicated.</p>
<p>This is the core for all methods of non-global
<i class="term"><a href="../index.html#key92">binarization</a></i>, i.e. foreground/background segmentation. Their
differences are just in the calculation of the maps.</p>
<p>This method supports all image types with one or more
single-byte channels, i.e. all but <b class="const">grey16</b>, <b class="const">grey32</b>, and
<b class="const">bw</b>.</p></dd>
<dt><a name="113"><b class="cmd">::crimp</b> <b class="method">upsample xy</b> <i class="arg">image</i> <i class="arg">factor</i></a></dt>
<dd></dd>
<dt><a name="114"><b class="cmd">::crimp</b> <b class="method">upsample x</b> <i class="arg">image</i> <i class="arg">factor</i></a></dt>
<dd></dd>
<dt><a name="115"><b class="cmd">::crimp</b> <b class="method">upsample y</b> <i class="arg">image</i> <i class="arg">factor</i></a></dt>
<dd><p>This method returns an image inserting <i class="arg">factor</i> black pixels between
each pixel of the input <i class="arg">image</i> (in x, y, or both dimensions). The effect is
that the input is expanded by <i class="arg">factor</i>. It is the complement of
method <b class="method">downsample</b>.</p>
<p>Using the method as is is not recommended because this simple upsampling
will cause copies of the image to appear at the higher image frequencies in the
expanded spectrum. This is normally avoided by running a low-pass filter over
the image after the upsampling, removing the problematic copies.</p>
<p>The <b class="method">interpolate</b> method is a convenience method combining these
two steps into one.</p></dd>
<dt><a name="116"><b class="cmd">::crimp</b> <b class="method">wavy</b> <i class="arg">image</i> <i class="arg">offset</i> <i class="arg">adj1</i> <i class="arg">adjb</i></a></dt>
<dd><p>This method processes the input <i class="arg">image</i> according to an algorithm
devised by Andrew M. Goth, according to the three parameters
<i class="arg">offset</i>, <i class="arg">adj1</i>, and <i class="arg">adjb</i>, and returns the modified
image as its result.</p>
<p>The operation supports only images of type <b class="const">rgba</b>, and returns
images of the same type.</p></dd>
<dt><a name="117"><b class="cmd">::crimp</b> <b class="method">flip horizontal</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="118"><b class="cmd">::crimp</b> <b class="method">flip transpose</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="119"><b class="cmd">::crimp</b> <b class="method">flip transverse</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="120"><b class="cmd">::crimp</b> <b class="method">flip vertical</b> <i class="arg">image</i></a></dt>
<dd><p>This set of methods performs mirroring along the horizontal, vertical
and diagonal axes of the input <i class="arg">image</i>, returning the mirrored
image as their output.  Transpose mirrors along the main diagonal,
transverse along the secondary diagonal.  These two methods also
exchange width and height of the image in the output.</p>
<p>The methods currently support the image types <b class="const">rgb</b>,
<b class="const">rgba</b>, <b class="const">hsv</b>, and <b class="const">grey8</b>.</p></dd>
<dt><a name="121"><b class="cmd">::crimp</b> <b class="method">resize</b> <span class="opt">?<b class="option">-interpolate</b> <b class="const">nneighbour</b>|<b class="const">bilinear</b>|<b class="const">bicubic</b>?</span> <i class="arg">image</i> <i class="arg">w</i> <i class="arg">h</i></a></dt>
<dd><p>This method takes the input <i class="arg">image</i> and resizes it to the
specified width <i class="arg">w</i> and height <i class="arg">h</i>.
In constrast to <b class="method">cut</b> this is not done by taking part of the
image in the specified size, but by scaling it up or down as
needed. In other words, this method is a degenerate case of a
projective transform as created by the <b class="method">transform</b> methods and
used by method <b class="method">warp projective</b> (see below).</p>
<p>Like the aforementioned general method this method supports all
the possible interpolation types, i.e. nearest neighbour, bilinear,
and bicubic. By default <b class="const">bilinear</b> interpolation is used, as a
compromise between accuracy and speed.</p></dd>
<dt><a name="122"><b class="cmd">::crimp</b> <b class="method">rotate cw</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="123"><b class="cmd">::crimp</b> <b class="method">rotate ccw</b> <i class="arg">image</i></a></dt>
<dd><p>This set of methods rotates the image in steps of 90 degrees, either
clockwise and counter to it.</p></dd>
<dt><a name="124"><b class="cmd">::crimp</b> <b class="method">rotate half</b> <i class="arg">image</i></a></dt>
<dd><p>This methods rotates the image a half-turn, i.e. 180 degrees.</p></dd>
<dt><a name="125"><b class="cmd">::crimp</b> <b class="method">warp field</b> <span class="opt">?<b class="option">-interpolate</b> <b class="const">nneighbour</b>|<b class="const">bilinear</b>|<b class="const">bicubic</b>?</span> <i class="arg">image</i> <i class="arg">xvec</i> <i class="arg">yvec</i></a></dt>
<dd><p>This method takes an input image and two images the size of the
expected result which provide for each pixel in the result the
coordinates to sample in the input to determine the result's color.</p>
<p>This allows the specification of any possible geometric
transformation and warping, going beyond even projective
transformations.</p>
<p>The two images providing the coordinate information have to be
of the same size, which is also the size of the returned result. The
type of the result is however specified through the type of the input
image.</p>
<p>The method supports all the possible interpolation types,
i.e. nearest neighbour, bilinear, and bicubic.
By default <b class="const">bilinear</b> interpolation is used, as a compromise
between accuracy and speed.</p></dd>
<dt><a name="126"><b class="cmd">::crimp</b> <b class="method">warp projective</b> <span class="opt">?<b class="option">-interpolate</b> <b class="const">nneighbour</b>|<b class="const">bilinear</b>|<b class="const">bicubic</b>?</span> <i class="arg">image</i> <i class="arg">transform</i></a></dt>
<dd><p>This method accepts a general projective <i class="arg">transform</i> as created by
the <b class="method">transform</b> methods, applies it to the input <i class="arg">image</i>
and returns the projected result.</p>
<p>Like the <b class="method">resize</b> method above this method supports all
the possible interpolation types, i.e. nearest neighbour, bilinear,
and bicubic. By default <b class="const">bilinear</b> interpolation is used, as a
compromise between accuracy and speed.</p>
<p><em>Note</em> that the returned result image is made as large as
necessary to contain the whole of the projected input. Depending on
the transformation this means that parts of the result can be black,
coming from outside of the boundaries of the input. Further, the
origin point of the result may conceptually be inside or outside of
the result instead of at the top left corner, because of pixels in the
input getting projected to negative coordinates. To handle this
situation the result will contain the physical coordinates of the
conceptual origin point in its meta data, under the hierarchical key
<b class="const">crimp origin</b>.</p></dd>
</dl>
</div>
<div id="subsection3" class="subsection"><h3><a name="subsection3">Converters</a></h3>
<dl class="definitions">
<dt><a name="127"><b class="cmd">::crimp</b> <b class="method">convert 2grey8</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="128"><b class="cmd">::crimp</b> <b class="method">convert 2hsv</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="129"><b class="cmd">::crimp</b> <b class="method">convert 2rgba</b> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="130"><b class="cmd">::crimp</b> <b class="method">convert 2rgb</b> <i class="arg">image</i></a></dt>
<dd><p>This set of methods all convert their input <i class="arg">image</i> to the
specified type and returns it as their result. All converters accept
an image of the destination type as input and will pass it through
unchanged.</p>
<p>The converters returning a <b class="const">grey8</b> image support <b class="const">rgb</b> and
<b class="const">rgba</b> as their input, using the ITU-R 601-2 luma transform to
merge the three color channels</p>
<p>The converters to HSV support <b class="const">rgb</b> and <b class="const">rgba</b> as their
input as well.</p>
<p>The conversion to <b class="const">rgba</b> accepts only <b class="const">hsv</b> as input,
adding a blank (fully opaque) alpha channel. For more control over the
contents of an image's alpha channel see the methods <b class="method">setalpha</b>
and <b class="method">join rgba</b>.</p>
<p>At last, the conversion to <b class="const">rgb</b> accepts both <b class="const">rgba</b> and
<b class="const">hsv</b> images as input.</p></dd>
<dt><a name="131"><b class="cmd">::crimp</b> <b class="method">join 2hsv</b> <i class="arg">hueImage</i> <i class="arg">satImage</i> <i class="arg">valImage</i></a></dt>
<dd></dd>
<dt><a name="132"><b class="cmd">::crimp</b> <b class="method">join 2rgba</b> <i class="arg">redImage</i> <i class="arg">greenImage</i> <i class="arg">blueImage</i> <i class="arg">alphaImage</i></a></dt>
<dd></dd>
<dt><a name="133"><b class="cmd">::crimp</b> <b class="method">join 2rgb</b> <i class="arg">redImage</i> <i class="arg">greenImage</i> <i class="arg">blueImage</i></a></dt>
<dd><p>This set of methods is the complement of method <b class="method">split</b>. Each
take a set of <b class="const">grey8</b> images and fuse them together into an
image of the given type, with each input image becoming one channel of
the fusing result, which is returned as the result of the command. All
input images have to have the same dimensions.</p></dd>
<dt><a name="134"><b class="cmd">::crimp</b> <b class="method">split</b> <i class="arg">image</i></a></dt>
<dd><p>This method takes an image of one of the multi-channel types, i.e.
<b class="const">rgb</b>, const rgba], and <b class="const">hsv</b> and returns a list of
<b class="const">grey8</b> images, each of which contains the contents of one of
the channels found in the input image.</p>
<p>The channel images in the result are provided in the same order as
they are accepted by the complementary <b class="method">join</b> method, see
above.</p></dd>
</dl>
</div>
<div id="subsection4" class="subsection"><h3><a name="subsection4">I/O commands</a></h3>
<dl class="definitions">
<dt><a name="135"><b class="cmd">::crimp</b> <b class="method">read pgm</b> <i class="arg">string</i></a></dt>
<dd><p>This method returns an image of type <b class="const">grey8</b> containing the data
of the portable grey map (PGM) stored in the <i class="arg">string</i>. The method
recognizes images in both plain and raw sub-formats.</p></dd>
<dt><a name="136"><b class="cmd">::crimp</b> <b class="method">read ppm</b> <i class="arg">string</i></a></dt>
<dd><p>This method returns an image of type <b class="const">rgb</b> containing the data
of the portable pix map (PPM) stored in the <i class="arg">string</i>. The method
recognizes images in both plain and raw sub-formats.</p></dd>
<dt><a name="137"><b class="cmd">::crimp</b> <b class="method">read strimj</b> <i class="arg">string</i> <span class="opt">?<i class="arg">colormap</i>?</span></a></dt>
<dd><p>This method returns an image of type <b class="const">rgba</b> containing the data
of the <i class="term">strimj</i> (string image) (See <a href="http://wiki.tcl.tk/1846">http://wiki.tcl.tk/1846</a>)
stored in the <i class="arg">string</i>.</p>
<p>The caller can override the standard mapping from pixel characters
to colors by specifying a <i class="arg">colormap</i>. This argument is interpreted as
dictionary mapping characters to triples of integers in the range
[0...255], specifying the red, green, and blue intensities.</p>
<p>An example of a strimj is:</p>
<pre class="example">
@...@.......@.@......
@...@.......@.@......
@...@..@@@..@.@..@@@.
@@@@@.@...@.@.@.@...@
@...@.@@@@@.@.@.@...@
@...@.@.....@.@.@...@
@...@.@...@.@.@.@...@
@...@..@@@..@.@..@@@.
</pre>
</dd>
<dt><a name="138"><b class="cmd">::crimp</b> <b class="method">read tcl grey8</b> <i class="arg">pixelmatrix</i></a></dt>
<dd><p>This method takes the <i class="arg">pixelmatrix</i>, a list of rows, with each row
a list of pixel values in the domain [0..255] and returns an
image of type <b class="const">grey8</b> whose height is the number of rows, i.e.
the length of the outer list, and whose width is the maximum length
found among the inner lists. Rows whose inner list is shorter than the
maximum length are padded with black pixels, i.e. a pixel value of
<b class="const">255</b>.</p></dd>
<dt><a name="139"><b class="cmd">::crimp</b> <b class="method">read tcl float</b> <i class="arg">pixelmatrix</i></a></dt>
<dd><p>This method takes the <i class="arg">pixelmatrix</i>, a list of rows, with each row
a list of floating point values for pixel values and returns an image
of type <b class="const">float</b> whose height is the number of rows, i.e.  the
length of the outer list, and whose width is the maximum length found
among the inner lists. Rows whose inner list is shorter than the
maximum length are padded with a pixel value of <b class="const">255</b>.</p></dd>
<dt><a name="140"><b class="cmd">::crimp</b> <b class="method">read tk</b> <i class="arg">photo</i></a></dt>
<dd><p>This method returns an image of type <b class="const">rgba</b> containing the data
from the specified Tk <i class="arg">photo</i> image.</p></dd>
<dt><a name="141"><b class="cmd">::crimp</b> <b class="method">write 2tk</b> <i class="arg">photo</i> <i class="arg">image</i></a></dt>
<dd><p>This method writes the input <i class="arg">image</i> to the specified Tk
<i class="arg">photo</i> image.</p>
<p>The method supports the writing of <b class="const">rgb</b>, <b class="const">rgba</b>,
and <b class="const">grey8</b> images.</p></dd>
<dt><a name="142"><b class="cmd">::crimp</b> <b class="method">write 2string</b> <i class="arg">format</i> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="143"><b class="cmd">::crimp</b> <b class="method">write 2chan</b> <i class="arg">format</i> <i class="arg">chan</i> <i class="arg">image</i></a></dt>
<dd></dd>
<dt><a name="144"><b class="cmd">::crimp</b> <b class="method">write 2file</b> <i class="arg">format</i> <i class="arg">path</i> <i class="arg">image</i></a></dt>
<dd><p>This family of methods either returns the input <i class="arg">image</i> as a
binary string in the specified <i class="arg">format</i>, or writes this string to
the open channel <i class="arg">chan</i>, or the named file at <i class="arg">path</i>.</p>
<p>The image types accepted for writing are <i class="arg">format</i>
dependent, and listed below, with the supported formats.</p>
<p>The currently supported formats are</p>
<dl class="definitions">
<dt><b class="const">pgm-plain</b></dt>
<dd><p>The plain ASCII format of portable grey maps, as per
<a href="http://en.wikipedia.org/wiki/Netpbm_format">http://en.wikipedia.org/wiki/Netpbm_format</a>.</p>
<p>The methods support the writing of <b class="const">rgb</b>, <b class="const">rgba</b>,
<b class="const">hsv</b>, and <b class="const">grey8</b> images.</p></dd>
<dt><b class="const">pgm-raw</b></dt>
<dd><p>The raw binary format of portable grey maps, as per
<a href="http://en.wikipedia.org/wiki/Netpbm_format">http://en.wikipedia.org/wiki/Netpbm_format</a>.</p>
<p>The methods support the writing of <b class="const">rgb</b>, <b class="const">rgba</b>,
<b class="const">hsv</b>, and <b class="const">grey8</b> images.</p></dd>
<dt><b class="const">ppm-plain</b></dt>
<dd><p>The plain ASCII format of portable pix maps, as per
<a href="http://en.wikipedia.org/wiki/Netpbm_format">http://en.wikipedia.org/wiki/Netpbm_format</a>.</p>
<p>The methods support the writing of <b class="const">rgb</b>, <b class="const">rgba</b>,
<b class="const">hsv</b>, and <b class="const">grey8</b> images.</p></dd>
<dt><b class="const">ppm-raw</b></dt>
<dd><p>The raw binary format of portable pix maps, as per
<a href="http://en.wikipedia.org/wiki/Netpbm_format">http://en.wikipedia.org/wiki/Netpbm_format</a>.</p>
<p>The methods support the writing of <b class="const">rgb</b>, <b class="const">rgba</b>,
<b class="const">hsv</b>, and <b class="const">grey8</b> images.</p></dd>
</dl></dd>
</dl>
</div>
<div id="subsection5" class="subsection"><h3><a name="subsection5">Support</a></h3>
<dl class="definitions">
<dt><a name="145"><b class="cmd">::crimp</b> <b class="method">gradient grey8</b> <i class="arg">from</i> <i class="arg">to</i> <i class="arg">size</i></a></dt>
<dd></dd>
<dt><a name="146"><b class="cmd">::crimp</b> <b class="method">gradient rgb</b> <i class="arg">from</i> <i class="arg">to</i> <i class="arg">size</i></a></dt>
<dd></dd>
<dt><a name="147"><b class="cmd">::crimp</b> <b class="method">gradient rgba</b> <i class="arg">from</i> <i class="arg">to</i> <i class="arg">size</i></a></dt>
<dd></dd>
<dt><a name="148"><b class="cmd">::crimp</b> <b class="method">gradient hsv</b> <i class="arg">from</i> <i class="arg">to</i> <i class="arg">size</i></a></dt>
<dd><p>This set of methods takes two &quot;color&quot; (pixel value) arguments and
returns an image of height 1 and width <i class="arg">size</i> containing a
gradient interpolating between these two colors, with <i class="arg">from</i> in
the pixel at the left (x == 0) and <i class="arg">to</i> at the right
(x == <i class="arg">size</i>-1).</p>
<p><i class="arg">size</i> has to be greater than or equal to <b class="const">2</b>. An
error is thrown if that restriction is not met.</p>
<p>The resulting image has the type indicated in the method name.
This also specifies what is expected as the contents of the arguments
<i class="arg">from</i> and <i class="arg">to</i>. For <b class="method">grey8</b> these are simple pixel
values in the range 0...255 whereas for the types <b class="method">rgb</b> and
<b class="method">hsv</b> the arguments are triples (3-element lists) specifying
the R, G, and B (and H, S, and V respectively) values.</p></dd>
<dt><a name="149"><b class="cmd">::crimp</b> <b class="method">kernel make</b> <i class="arg">matrix</i> <span class="opt">?<i class="arg">scale</i>?</span> <span class="opt">?<i class="arg">offset</i>?</span></a></dt>
<dd><p>This method takes a <i class="arg">matrix</i> of weights and an optional
<i class="arg">scale</i> factor and returns a structure containing the associated
convolution kernel, ready for use by method <b class="method">filter convolve</b>.</p>
<p>If <i class="arg">scale</i> is left unspecified it defaults to the sum of
all weights in the matrix.</p>
<p>If <i class="arg">offset</i> is left unspecified it defaults to 128 if the
sum of weights is 0, and 0 else. In effect zero-sum kernels, like the
basic edge-detectors, are shifted so that results in the range
-128..127 correspond to 0..255.</p>
<p>The <i class="arg">matrix</i> has the same general format as the pixel
matrix for method <b class="method">read tcl grey8</b>, i.e. a list of lists
(rows) of values, and is treated in the same way, i.e. the number of
columns is the maxium length over the row lists, and shorter lists are
padded with <b class="const">128</b>. The values are expected to be integer numbers
in the range -128..127.</p></dd>
<dt><a name="150"><b class="cmd">::crimp</b> <b class="method">kernel fpmake</b> <i class="arg">matrix</i> <span class="opt">?<i class="arg">offset</i>?</span></a></dt>
<dd><p>This method is like <b class="method">kernel make</b> except that the generated
kernel is based on floating-point values. Because of this it is not
accpeting a scale argument either, it is expected that the kernel
weights already have the proper sum.</p>
<p>The <i class="arg">matrix</i> has the same general format as the pixel
matrix for method <b class="method">read tcl float</b>, i.e. a list of lists
(rows) of values, and is treated in the same way, i.e. the number of
columns is the maxium length over the row lists, and shorter lists are
padded with <b class="const">255</b>.  The values are expected to be floating-point
numbers.</p></dd>
<dt><a name="151"><b class="cmd">::crimp</b> <b class="method">kernel transpose</b> <i class="arg">kernel</i></a></dt>
<dd><p>This method takes a <i class="arg">kernel</i> as returned by the method
<b class="method">kernel make</b> and returns a transposed kernel, i.e. one where
the x- and y-axes are switched.
For example</p>
<pre class="example">
                    (1)
                    (2)
    {1 2 4 2 1} ==&gt; (4)
                    (2)
                    (1)
</pre>
<p>This method is its own inverse, i.e. application to its result returns
the original input, i.e.</p>
<pre class="example">
    [transpose [transpose $K]] == $K
</pre>
</dd>
<dt><a name="152"><b class="cmd">::crimp</b> <b class="method">map</b> <i class="arg">arg</i>...</a></dt>
<dd><p>This method accepts the same sub-methods and arguments as are accepted
by the <b class="method">table</b> method below. In contrast to <b class="method">table</b> the
result is not a list of values, but a map image directly suitable as
argument to the <b class="method">remap</b> method.</p></dd>
<dt><a name="153"><b class="cmd">::crimp</b> <b class="method">mapof</b> <i class="arg">table</i></a></dt>
<dd><p>This method accepts a list of 256 values, constructs a map image
directly suitable as argument to the <b class="method">remap</b> method, and
returns this map image as its result.</p></dd>
<dt><a name="154"><b class="cmd">::crimp</b> <b class="method">table compose</b> <i class="arg">f</i> <i class="arg">g</i></a></dt>
<dd><p>This accepts two lookup tables (aka functions) specified as lists of
256 values, constructs the composite function f(g(x)), and then
returns this new function as its result.</p></dd>
<dt><a name="155"><b class="cmd">::crimp</b> <b class="method">table eval wrap</b> <i class="arg">cmd</i></a></dt>
<dd></dd>
<dt><a name="156"><b class="cmd">::crimp</b> <b class="method">table eval clamp</b> <i class="arg">cmd</i></a></dt>
<dd><p>This method returns a list of 256 values, the result of running the
values 0 to 255 through the function specified by the command prefix
<i class="arg">cmd</i>.
The results returned by the command prefix are rounded to the nearest
integer and then forced into the domain [0..255] by either
wrapping them around (modulo 256), or clamping them to the appropriate
border, i.e 0, and 255 respectively.</p>
<p>The signature of the command prefix is</p>
<dl class="definitions">
<dt><a name="157"><b class="cmd">&lt;cmd&gt;</b> <i class="arg">x</i></a></dt>
<dd><p>which is expected to return a number in the range
[0..255]. While the result should be an integer number it is
allowed to be a float, the caller takes care to round the result to
the nearest integer.</p></dd>
</dl></dd>
<dt><a name="158"><b class="cmd">::crimp</b> <b class="method">table degamma</b> <i class="arg">y</i></a></dt>
<dd><p>This method returns a list of 256 values, the result of running the
values 0 to 255 through the <b class="function">inverse gamma correction</b> with
parameter <i class="arg">y</i>.
This inverse correction, defined in the domain of [0..1] for
both argument and result, is defined as:</p>
<p><img alt="gamma_inv" src="../image/gamma_inv.png"></p>
<p>Scaling of argument and result into the domain [0..255] of pixel
values, and rounding results to the nearest integer, causes the actual
definition used to be</p>
<p><img alt="scaled_gamma_inv" src="../image/scaled_gamma_inv.png"></p></dd>
<dt><a name="159"><b class="cmd">::crimp</b> <b class="method">table gamma</b> <i class="arg">y</i></a></dt>
<dd><p>This method returns a list of 256 values, the result of running the
values 0 to 255 through the <b class="function">gamma correction</b> with parameter
<i class="arg">y</i>.
This correction, defined in the domain of [0..1] for both
argument and result, is defined as:</p>
<p><img alt="gamma" src="../image/gamma.png"></p>
<p>Scaling of argument and result into the domain [0..255] of pixel
values, and rounding results to the nearest integer, causes the actual
definition used to be</p>
<p><img alt="scaled_gamma" src="../image/scaled_gamma.png"></p></dd>
<dt><a name="160"><b class="cmd">::crimp</b> <b class="method">table gauss</b> <i class="arg">sigma</i></a></dt>
<dd><p>This method returns a list of 256 values, the result of running the
values 0 to 255 through the <b class="function">sampled gauss</b> function with
parameter <i class="arg">sigma</i>.
This function is defined as:</p>
<p><img alt="gauss" src="../image/gauss.png"></p></dd>
<dt><a name="161"><b class="cmd">::crimp</b> <b class="method">table identity</b></a></dt>
<dd><p>This method returns a list of 256 values, the result of running the
values 0 to 255 through the <b class="function">identity</b> function, which is defined
as</p>
<p><img alt="identity" src="../image/identity.png"></p></dd>
<dt><a name="162"><b class="cmd">::crimp</b> <b class="method">table invers</b></a></dt>
<dd><p>This method returns a list of 256 values, the result of running the
values 0 to 255 through the <b class="function">inverse</b> function, which is defined
as</p>
<p><img alt="inverse" src="../image/inverse.png"></p></dd>
<dt><a name="163"><b class="cmd">::crimp</b> <b class="method">table linear wrap</b> <i class="arg">gain</i> <i class="arg">offset</i></a></dt>
<dd></dd>
<dt><a name="164"><b class="cmd">::crimp</b> <b class="method">table linear clamp</b> <i class="arg">gain</i> <i class="arg">offset</i></a></dt>
<dd><p>This method returns a list of 256 values, the result of running the
values 0 to 255 through a simple linear function with parameters
<i class="arg">gain</i> (the slope) and <i class="arg">offset</i>. The results are rounded to
the nearest integer and then forced into the domain [0..255] by
either wrapping them around (modulo 256), or clamping them to the
appropriate border, i.e 0, and 255 respectively.
Thus the relevant definitions are</p>
<p><img alt="linear_wrap" src="../image/linear_wrap.png">
for the wrapped case, and</p>
<p><img alt="linear_clamp" src="../image/linear_clamp.png">
when clamping.</p></dd>
<dt><a name="165"><b class="cmd">::crimp</b> <b class="method">table log</b> <span class="opt">?<i class="arg">max</i>?</span></a></dt>
<dd><p>This method returns a list of 256 values, the result of running the
values 0 to 255 through the <b class="function">log-compression</b> function with
parameter <i class="arg">max</i>. This parameter is the maximum pixel value the
function is for, this value, and all larger will be mapped to 255.
This function is defined as:</p>
<p><img alt="log" src="../image/log.png"></p></dd>
<dt><a name="166"><b class="cmd">::crimp</b> <b class="method">table solarize</b> <i class="arg">threshold</i></a></dt>
<dd><p>This method returns a list of 256 values, the result of running the
values 0 to 255 through the <b class="function">solarize</b> function, with parameter
<i class="arg">threshold</i>. This function is defined as:</p>
<p><img alt="solarize" src="../image/solarize.png"></p>
<p>Note how the function is the <b class="function">identity</b> for values under the
threshold, and the <b class="function">inverse</b> for values at and above it. Its
application to an image produces what is known as either
<i class="term"><a href="../index.html#key85">solarization</a></i> or <i class="term"><a href="../index.html#key79">sabattier effect</a></i>.</p></dd>
<dt><a name="167"><b class="cmd">::crimp</b> <b class="method">table sqrt</b> <span class="opt">?<i class="arg">max</i>?</span></a></dt>
<dd><p>This method returns a list of 256 values, the result of running the
values 0 to 255 through the <b class="function">sqrt-compression</b> function with
parameter <i class="arg">max</i>. This parameter is the maximum pixel value the
function is for, this value, and all larger will be mapped to 255.
This function is defined as:</p>
<p><img alt="sqrt" src="../image/sqrt.png"></p></dd>
<dt><a name="168"><b class="cmd">::crimp</b> <b class="method">table stretch</b> <i class="arg">min</i> <i class="arg">max</i></a></dt>
<dd><p>This is a convenience method around <b class="method">table linear</b> which maps
<i class="arg">min</i> to 0, and <i class="arg">max</i> to 255, with linear interpolation in
between. Values below <i class="arg">min</i> and above <i class="arg">max</i> are clamped to 0
and 255 respectively.</p></dd>
<dt><a name="169"><b class="cmd">::crimp</b> <b class="method">table threshold above</b> <i class="arg">threshold</i></a></dt>
<dd><p>This method returns a list of 256 values, the result of running the
values 0 to 255 through a <b class="function">thresholding</b> (or <i class="term"><a href="../index.html#key92">binarization</a></i>)
function, with parameter <i class="arg">threshold</i>. This function is defined as:</p>
<p><img alt="threshold-ge" src="../image/threshold-ge.png"></p></dd>
<dt><a name="170"><b class="cmd">::crimp</b> <b class="method">table threshold below</b> <i class="arg">threshold</i></a></dt>
<dd><p>This method returns a list of 256 values, the result of running the
values 0 to 255 through a <b class="function">thresholding</b> (or <i class="term"><a href="../index.html#key92">binarization</a></i>)
function, with parameter <i class="arg">threshold</i>. This function is defined as:</p>
<p><img alt="threshold-le" src="../image/threshold-le.png"></p></dd>
<dt><a name="171"><b class="cmd">::crimp</b> <b class="method">table threshold inside</b> <i class="arg">min</i> <i class="arg">max</i></a></dt>
<dd><p>This method returns a list of 256 values, the result of running the
values 0 to 255 through a <b class="function">thresholding</b> (or <i class="term"><a href="../index.html#key92">binarization</a></i>)
function, with parameters <i class="arg">min</i> and <i class="arg">max</i>. This function is
defined as:</p>
<p><img alt="threshold-inside" src="../image/threshold-inside.png"></p></dd>
<dt><a name="172"><b class="cmd">::crimp</b> <b class="method">table threshold outside</b> <i class="arg">min</i> <i class="arg">max</i></a></dt>
<dd><p>This method returns a list of 256 values, the result of running the
values 0 to 255 through a <b class="function">thresholding</b> (or <i class="term"><a href="../index.html#key92">binarization</a></i>)
function, with parameters <i class="arg">min</i> and <i class="arg">max</i>. This function is
defined as:</p>
<p><img alt="threshold-outside" src="../image/threshold-outside.png"></p></dd>
<dt><a name="173"><b class="cmd">::crimp</b> <b class="method">table fgauss discrete</b> <i class="arg">sigma</i> <span class="opt">?<i class="arg">r</i>?</span></a></dt>
<dd></dd>
<dt><a name="174"><b class="cmd">::crimp</b> <b class="method">table fgauss sampled</b> <i class="arg">sigma</i> <span class="opt">?<i class="arg">r</i>?</span></a></dt>
<dd><p>This method computes the table for a discrete or sampled gaussian with
parameters <i class="arg">sigma</i> and kernel <i class="arg">r</i>adius. If the radius is not
specified it defaults to the smallest integer greater than
&quot;3*<i class="arg">sigma</i>&quot;.</p></dd>
<dt><a name="175"><b class="cmd">::crimp</b> <b class="method">transform affine</b> <i class="arg">a</i> <i class="arg">b</i> <i class="arg">c</i> <i class="arg">d</i> <i class="arg">e</i> <i class="arg">f</i></a></dt>
<dd><p>This method returns the affine transformation specified by the 2x3
matrix</p>
<pre class="example">
    |a b c|
    |d e f|
</pre>
<p>Note that it is in general easier to use the methods <b class="method">rotate</b>,
<b class="method">scale</b>, and <b class="method">translate</b> <b class="method">scale</b> to generate the
desired transformation piecemal and then use <b class="method">chain</b> to chain the
pieces together.</p></dd>
<dt><a name="176"><b class="cmd">::crimp</b> <b class="method">transform chain</b> <i class="arg">transform</i>...</a></dt>
<dd><p>This method computes and returns the projective transformation
generated by applying the specified transformations in reverse order,
i.e with the transformation at the end of the argument list applied
first, then the one before it, etc.</p></dd>
<dt><a name="177"><b class="cmd">::crimp</b> <b class="method">transform invert</b> <i class="arg">transform</i></a></dt>
<dd><p>This method computes and returns the inverse of the specified
projective <i class="arg">transform</i>ation.</p></dd>
<dt><a name="178"><b class="cmd">::crimp</b> <b class="method">transform projective</b> <i class="arg">a</i> <i class="arg">b</i> <i class="arg">c</i> <i class="arg">d</i> <i class="arg">e</i> <i class="arg">f</i> <i class="arg">g</i> <i class="arg">h</i></a></dt>
<dd><p>This method returns the projective transformation specified by the 3x3
matrix</p>
<pre class="example">
    |a b c|
    |d e f|
    |g h 1|
</pre>
<p>Note that for the affine subset of projective transformation it is in
general easier to use the methods <b class="method">rotate</b>, <b class="method">scale</b>, and
<b class="method">translate</b> <b class="method">scale</b> to generate the desired
transformation piecemal and then use <b class="method">chain</b> to chain the pieces
together.</p>
<p>And for a true perspective transformation specification through
<b class="method">quadrilateral</b> should be simpler as well.</p></dd>
<dt><a name="179"><b class="cmd">::crimp</b> <b class="method">transform quadrilateral</b> <i class="arg">src</i> <i class="arg">dst</i></a></dt>
<dd><p>This method returns the projective transformation which maps the
quadrilateral <i class="arg">src</i> on to the quadrilateral <i class="arg">dst</i>.</p>
<p>Each quadrilateral is specified as a list of 4 points, each
point a pair of x- and y-coordinates.</p></dd>
<dt><a name="180"><b class="cmd">::crimp</b> <b class="method">transform rotate</b> <i class="arg">theta</i> <span class="opt">?<i class="arg">center</i>?</span></a></dt>
<dd><p>This methods returns the projective transformation which rotates the
image by the anglie <i class="arg">theta</i> around the point <i class="arg">center</i>. If the
latter is not specified {0 0} is assumed. The point, if present, is
specified as pair of x- and y-coordinates.</p>
<p>The angle is specified in degrees, with <b class="const">0</b> not rotating
the image at all. Positive values cause a counterclockwise rotation,
negative values a clockwise one.</p></dd>
<dt><a name="181"><b class="cmd">::crimp</b> <b class="method">transform scale</b> <i class="arg">sx</i> <i class="arg">sy</i></a></dt>
<dd><p>This methods returns the projective transformation which scales an
image by factor <i class="arg">sx</i> in width, and <i class="arg">sy</i> in height. Values
larger than <b class="const">1</b> expand the image along the specified dimension,
while values less than <b class="const">1</b> shrink it. Negative values flip the
respective axis.</p></dd>
<dt><a name="182"><b class="cmd">::crimp</b> <b class="method">transform translate</b> <i class="arg">dx</i> <i class="arg">dy</i></a></dt>
<dd><p>This methods returns the projective transformation which translates an
image by <i class="arg">dx</i> pixels along the x-axis, and <i class="arg">dx</i> pixels along
the y-axis. Values larger than <b class="const">0</b> move the image to the right,
or down, along the specified dimension, while values less than
<b class="const">0</b> move it to the left, or up.</p></dd>
</dl>
</div>
</div>
<div id="section6" class="section"><h2><a name="section6">References</a></h2>
<ol class="enumerated">
<li><p>Simon Perreault and Patrick Hebert, &quot;Median Filtering in Constant Time&quot;, 2007
       <a href="http://nomis80.org/ctmf.html">http://nomis80.org/ctmf.html</a></p></li>
<li><p>Nobuyuki Otsu, &quot;A threshold selection method from gray-level histograms&quot;, 1979
       <a href="http://en.wikipedia.org/wiki/Otsu%27s_method">http://en.wikipedia.org/wiki/Otsu%27s_method</a></p></li>
</ol>
</div>
<div id="keywords" class="section"><h2><a name="keywords">Keywords</a></h2>
<p><a href="../index.html#key56">affine</a>, <a href="../index.html#key81">affine transform</a>, <a href="../index.html#key10">alpha</a>, <a href="../index.html#key91">alpha blending</a>, <a href="../index.html#key12">alpha channel</a>, <a href="../index.html#key31">average</a>, <a href="../index.html#key92">binarization</a>, <a href="../index.html#key32">black tophat</a>, <a href="../index.html#key43">blending</a>, <a href="../index.html#key47">channels</a>, <a href="../index.html#key20">charcoal</a>, <a href="../index.html#key44">clockwise</a>, <a href="../index.html#key11">closing</a>, <a href="../index.html#key96">composite blending</a>, <a href="../index.html#key80">composition</a>, <a href="../index.html#key7">const expansion</a>, <a href="../index.html#key83">convolution filter</a>, <a href="../index.html#key89">counter-clockwise</a>, <a href="../index.html#key4">cropping</a>, <a href="../index.html#key13">cut region</a>, <a href="../index.html#key52">cyclic wrap expansion</a>, <a href="../index.html#key19">dilation</a>, <a href="../index.html#key74">dimensions</a>, <a href="../index.html#key30">edge shrinking</a>, <a href="../index.html#key29">edge-detection</a>, <a href="../index.html#key82">effect</a>, <a href="../index.html#key75">emboss</a>, <a href="../index.html#key86">erosion</a>, <a href="../index.html#key21">expansion</a>, <a href="../index.html#key49">extend expansion</a>, <a href="../index.html#key1">external gradient</a>, <a href="../index.html#key26">extract rectangle</a>, <a href="../index.html#key87">extract region</a>, <a href="../index.html#key53">fast fourier transform</a>, <a href="../index.html#key27">fft</a>, <a href="../index.html#key50">filter</a>, <a href="../index.html#key5">flip</a>, <a href="../index.html#key98">fourier transform</a>, <a href="../index.html#key18">gamma correction</a>, <a href="../index.html#key62">geometry</a>, <a href="../index.html#key95">gradient</a>, <a href="../index.html#key69">histogram</a>, <a href="../index.html#key6">hypot</a>, <a href="../index.html#key60">image</a>, <a href="../index.html#key58">integral image</a>, <a href="../index.html#key17">internal gradient</a>, <a href="../index.html#key64">inverse fourier transform</a>, <a href="../index.html#key65">inversion</a>, <a href="../index.html#key28">log-compression</a>, <a href="../index.html#key8">matrix</a>, <a href="../index.html#key51">max</a>, <a href="../index.html#key73">max-filter</a>, <a href="../index.html#key90">mean</a>, <a href="../index.html#key70">mean filter</a>, <a href="../index.html#key23">median</a>, <a href="../index.html#key39">median-filter</a>, <a href="../index.html#key35">middle</a>, <a href="../index.html#key46">min</a>, <a href="../index.html#key97">min-filter</a>, <a href="../index.html#key72">mirror expansion</a>, <a href="../index.html#key42">montage</a>, <a href="../index.html#key25">morphology</a>, <a href="../index.html#key88">opening</a>, <a href="../index.html#key0">otsu threshold</a>, <a href="../index.html#key2">perspective</a>, <a href="../index.html#key100">photo</a>, <a href="../index.html#key9">pixel mapping</a>, <a href="../index.html#key34">prewitt</a>, <a href="../index.html#key77">projective</a>, <a href="../index.html#key33">projective transform</a>, <a href="../index.html#key102">rank-order filter</a>, <a href="../index.html#key59">rectangle cut</a>, <a href="../index.html#key84">rectangle extraction</a>, <a href="../index.html#key71">region cut</a>, <a href="../index.html#key93">remapping</a>, <a href="../index.html#key61">replicate edge expansion</a>, <a href="../index.html#key54">rescale</a>, <a href="../index.html#key76">resize</a>, <a href="../index.html#key24">rotate</a>, <a href="../index.html#key37">rotation</a>, <a href="../index.html#key79">sabattier effect</a>, <a href="../index.html#key55">scale</a>, <a href="../index.html#key101">scharr</a>, <a href="../index.html#key99">sharpen</a>, <a href="../index.html#key48">shrinking</a>, <a href="../index.html#key66">sobel</a>, <a href="../index.html#key85">solarization</a>, <a href="../index.html#key14">sqrt-compression</a>, <a href="../index.html#key40">standard deviation filter</a>, <a href="../index.html#key78">statistics</a>, <a href="../index.html#key16">stddev</a>, <a href="../index.html#key63">summed area table</a>, <a href="../index.html#key67">threshold</a>, <a href="../index.html#key41">thresholding</a>, <a href="../index.html#key38">tophat</a>, <a href="../index.html#key68">toroidal wrap expansion</a>, <a href="../index.html#key45">transform</a>, <a href="../index.html#key22">translate</a>, <a href="../index.html#key15">variance</a>, <a href="../index.html#key94">vector-field</a>, <a href="../index.html#key3">warp</a>, <a href="../index.html#key57">white tophat</a>, <a href="../index.html#key36">wrap expansion</a></p>
</div>
<div id="copyright" class="section"><h2><a name="copyright">Copyright</a></h2>
<p>Copyright &copy; 2010 Andreas Kupries<br>
Copyright &copy; 2010 Documentation, Andreas Kupries</p>
</div>
</div></body></html>






Added embedded/www/image/atan2.png.



cannot compute difference between binary files


Added embedded/www/image/blend.png.



cannot compute difference between binary files


Added embedded/www/image/blend_alt.png.



cannot compute difference between binary files


Added embedded/www/image/border.png.



cannot compute difference between binary files


Added embedded/www/image/gamma.png.



cannot compute difference between binary files


Added embedded/www/image/gamma_inv.png.



cannot compute difference between binary files


Added embedded/www/image/gauss.png.



cannot compute difference between binary files


Added embedded/www/image/hypot.png.



cannot compute difference between binary files


Added embedded/www/image/identity.png.



cannot compute difference between binary files


Added embedded/www/image/inverse.png.



cannot compute difference between binary files


Added embedded/www/image/linear_clamp.png.



cannot compute difference between binary files


Added embedded/www/image/linear_wrap.png.



cannot compute difference between binary files


Added embedded/www/image/log.png.



cannot compute difference between binary files


Added embedded/www/image/organization.png.



cannot compute difference between binary files


Added embedded/www/image/pyramid.png.



cannot compute difference between binary files


Added embedded/www/image/pyramid_gauss.png.



cannot compute difference between binary files


Added embedded/www/image/pyramid_laplace.png.



cannot compute difference between binary files


Added embedded/www/image/scaled_gamma.png.



cannot compute difference between binary files


Added embedded/www/image/scaled_gamma_inv.png.



cannot compute difference between binary files


Added embedded/www/image/screen.png.



cannot compute difference between binary files


Added embedded/www/image/solarize.png.



cannot compute difference between binary files


Added embedded/www/image/sqrt.png.



cannot compute difference between binary files


Added embedded/www/image/threshold-ge.png.



cannot compute difference between binary files


Added embedded/www/image/threshold-inside.png.



cannot compute difference between binary files


Added embedded/www/image/threshold-le.png.



cannot compute difference between binary files


Added embedded/www/image/threshold-outside.png.



cannot compute difference between binary files


Added embedded/www/index.html.


















































































































































































































































































































































































































































































































































































































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
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

<html>
<! -- Generated by tcllib/doctools/idx with format 'html'
   -->
<! -- CVS: $Id$ Keyword Index
   -->
<head>
<title> Keyword Index </title>
</head>
<body>
<hr> [
  <a href="toc.html">Table Of Contents</a>
] <hr>
<h3> Keyword Index -- doc </h3>
<hr><div class="#idxnav">
<a href="#c1"> A </a> &#183; <a href="#c2"> B </a> &#183; <a href="#c3"> C </a> &#183; <a href="#c4"> D </a> &#183; <a href="#c5"> E </a> &#183; <a href="#c6"> F </a> &#183; <a href="#c7"> G </a> &#183; <a href="#c8"> H </a> &#183; <a href="#c9"> I </a> &#183; <a href="#c10"> L </a> &#183; <a href="#c11"> M </a> &#183; <a href="#c12"> O </a> &#183; <a href="#c13"> P </a> &#183; <a href="#c14"> R </a> &#183; <a href="#c15"> S </a> &#183; <a href="#c16"> T </a> &#183; <a href="#c17"> V </a> &#183; <a href="#c18"> W </a>
</div>
<hr><table class="#idx" width="100%">
<tr class="#idxheader"><th colspan="2">
<a name="c1">Keywords: A</a>
</th></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key56"> affine </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key81"> affine transform </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key10"> alpha </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key91"> alpha blending </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key12"> alpha channel </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key31"> average </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxheader"><th colspan="2">
<a name="c2">Keywords: B</a>
</th></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key92"> binarization </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key32"> black tophat </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key43"> blending </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxheader"><th colspan="2">
<a name="c3">Keywords: C</a>
</th></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key47"> channels </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key20"> charcoal </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key44"> clockwise </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key11"> closing </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key96"> composite blending </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key80"> composition </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key7"> const expansion </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key83"> convolution filter </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key89"> counter-clockwise </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key4"> cropping </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key13"> cut region </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key52"> cyclic wrap expansion </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxheader"><th colspan="2">
<a name="c4">Keywords: D</a>
</th></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key19"> dilation </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key74"> dimensions </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxheader"><th colspan="2">
<a name="c5">Keywords: E</a>
</th></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key30"> edge shrinking </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key29"> edge-detection </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key82"> effect </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key75"> emboss </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key86"> erosion </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key21"> expansion </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key49"> extend expansion </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key1"> external gradient </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key26"> extract rectangle </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key87"> extract region </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxheader"><th colspan="2">
<a name="c6">Keywords: F</a>
</th></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key53"> fast fourier transform </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key27"> fft </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key50"> filter </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key5"> flip </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key98"> fourier transform </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxheader"><th colspan="2">
<a name="c7">Keywords: G</a>
</th></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key18"> gamma correction </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key62"> geometry </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key95"> gradient </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxheader"><th colspan="2">
<a name="c8">Keywords: H</a>
</th></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key69"> histogram </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key6"> hypot </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxheader"><th colspan="2">
<a name="c9">Keywords: I</a>
</th></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key60"> image </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key58"> integral image </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key17"> internal gradient </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key64"> inverse fourier transform </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key65"> inversion </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxheader"><th colspan="2">
<a name="c10">Keywords: L</a>
</th></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key28"> log-compression </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxheader"><th colspan="2">
<a name="c11">Keywords: M</a>
</th></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key8"> matrix </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key51"> max </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key73"> max-filter </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key90"> mean </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key70"> mean filter </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key23"> median </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key39"> median-filter </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key35"> middle </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key46"> min </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key97"> min-filter </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key72"> mirror expansion </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key42"> montage </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key25"> morphology </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxheader"><th colspan="2">
<a name="c12">Keywords: O</a>
</th></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key88"> opening </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key0"> otsu threshold </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxheader"><th colspan="2">
<a name="c13">Keywords: P</a>
</th></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key2"> perspective </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key100"> photo </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key9"> pixel mapping </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key34"> prewitt </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key77"> projective </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key33"> projective transform </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxheader"><th colspan="2">
<a name="c14">Keywords: R</a>
</th></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key102"> rank-order filter </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key59"> rectangle cut </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key84"> rectangle extraction </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key71"> region cut </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key93"> remapping </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key61"> replicate edge expansion </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key54"> rescale </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key76"> resize </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key24"> rotate </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key37"> rotation </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxheader"><th colspan="2">
<a name="c15">Keywords: S</a>
</th></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key79"> sabattier effect </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key55"> scale </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key101"> scharr </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key99"> sharpen </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key48"> shrinking </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key66"> sobel </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key85"> solarization </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key14"> sqrt-compression </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key40"> standard deviation filter </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key78"> statistics </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key16"> stddev </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key63"> summed area table </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxheader"><th colspan="2">
<a name="c16">Keywords: T</a>
</th></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key67"> threshold </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key41"> thresholding </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key38"> tophat </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key68"> toroidal wrap expansion </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key45"> transform </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key22"> translate </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxheader"><th colspan="2">
<a name="c17">Keywords: V</a>
</th></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key15"> variance </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key94"> vector-field </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxheader"><th colspan="2">
<a name="c18">Keywords: W</a>
</th></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key3"> warp </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxodd" valign=top>
<td class="#idxleft" width="35%"><a name="key57"> white tophat </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
<tr class="#idxeven" valign=top>
<td class="#idxleft" width="35%"><a name="key36"> wrap expansion </a></td>
<td class="#idxright" width="65%">
<a href="files/crimp.html"> crimp </a>
</td></tr>
</table>
</body></html>






Added embedded/www/toc.html.


























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

<html><head>
<title> Table Of Contents </title>
</head>
<! -- Generated by tcllib/doctools/toc with format 'html'
   -->
<! -- CVS: $Id$ Table Of Contents
   -->
<body>
<hr> [
  <a href="index.html">Keyword Index</a>
] <hr>
<h3> Table Of Contents </h3>
<hr><dl><dt><h2> doc </h2><dd>
<table class="#toc">
<tr class="#toceven" >
<td class="#tocleft" ><a href="files/crimp.html">crimp</a></td>
<td class="#tocright">Image Manipulation (not yet independent of Tk)</td>
</tr>
</table>
</dl><hr></body></html>






Deleted export.crimp.





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
































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

export
char* photo Tcl_Obj* imageObj

Tk_PhotoHandle handle = Tk_FindPhoto(interp, photo);
if (handle == NULL) {
    Tcl_ResetResult(interp);
    Tcl_AppendResult(interp, "image \"", photo, "\" doesn't exist");
    return TCL_ERROR;
}

Tk_PhotoImageBlock pib;
if (decodeImageObj(interp, imageObj, &pib.width, &pib.height,
                   &pib.pixelPtr) != TCL_OK) {
    return TCL_ERROR;
}
pib.pixelSize = 4;
pib.pitch = 4 * pib.width;
pib.offset[0] = 0;
pib.offset[1] = 1;
pib.offset[2] = 2;
pib.offset[3] = 3;

if (Tk_PhotoSetSize(interp, handle, pib.width, pib.height) != TCL_OK
 || Tk_PhotoPutBlock(interp, handle, &pib, 0, 0, pib.width, pib.height,
                     TK_PHOTO_COMPOSITE_SET) != TCL_OK) {
    return TCL_ERROR;
}
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */






Deleted flip.crimp.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

flip
Tcl_Obj* imageObj

int x, y, w, h;
Tcl_Obj *dataObj;
unsigned char *pixels;
if (getUnsharedImageObj(interp, imageObj, &imageObj, &dataObj) != TCL_OK
 || decodeImageObj(interp, imageObj, &w, &h, &pixels) != TCL_OK) {
    return TCL_ERROR;
}

unsigned (*px)[h][w] = (unsigned (*)[h][w])pixels;
for (y = 0; y < h / 2; ++y) {
    for (x = 0; x < w; ++x) {
        unsigned swap = (*px)[y][x];
        (*px)[y][x] = (*px)[h - y - 1][x];
        (*px)[h - y - 1][x] = swap;
    }
}
Tcl_SetObjResult(interp, imageObj);
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */






Added images/Pentagon.png.



cannot compute difference between binary files


Added images/blink.ppm.













1
2
3
4
5
6
7

+
+
+
+
+
+
+

P3
4 4
15
0 0 0 0 0 0 0 0 0 15 0 15
0 0 0 0 15 7 0 0 0 0 0 0
0 0 0 0 0 0 0 15 7 0 0 0
15 0 15 0 0 0 0 0 0 0 0 0






Added images/butterfly.png.



cannot compute difference between binary files


Added images/colors.ppm.












1
2
3
4
5
6

+
+
+
+
+
+

P3
# The P3 means colors are in ASCII, then 3 columns and 2 rows, then 255 for max color, then RGB triplets
3 2
255
255   0   0     0 255   0     0   0 255
255 255   0   255 255 255     0   0   0






Added images/conformer.png.



cannot compute difference between binary files


Added images/duck1.png.



cannot compute difference between binary files


Added images/duckling1.png.



cannot compute difference between binary files


Added images/feep-raw.pgm.



cannot compute difference between binary files


Added images/feep.pgm.

















1
2
3
4
5
6
7
8
9
10
11

+
+
+
+
+
+
+
+
+
+
+

P2
# feep.pgm
24 7
15
0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0
0  3  3  3  3  0  0  7  7  7  7  0  0 11 11 11 11  0  0 15 15 15 15  0
0  3  0  0  0  0  0  7  0  0  0  0  0 11  0  0  0  0  0 15  0  0 15  0
0  3  3  3  0  0  0  7  7  7  0  0  0 11 11 11  0  0  0 15 15 15 15  0
0  3  0  0  0  0  0  7  0  0  0  0  0 11  0  0  0  0  0 15  0  0  0  0
0  3  0  0  0  0  0  7  7  7  7  0  0 11 11 11 11  0  0 15  0  0  0  0
0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0






Added images/hello.strimj.














1
2
3
4
5
6
7
8

+
+
+
+
+
+
+
+

@...@.......@.@......
@...@.......@.@......
@...@..@@@..@.@..@@@.
@@@@@.@...@.@.@.@...@
@...@.@@@@@.@.@.@...@
@...@.@.....@.@.@...@
@...@.@...@.@.@.@...@
@...@..@@@..@.@..@@@.






Added images/plant1.png.



cannot compute difference between binary files


Added images/plant2.png.



cannot compute difference between binary files


Added images/text1-crop.png.



cannot compute difference between binary files


Added images/text1-full.png.



cannot compute difference between binary files


Added images/text1-resize.png.



cannot compute difference between binary files


Added images/text2-crop.png.



cannot compute difference between binary files


Added images/text2-full.png.



cannot compute difference between binary files


Added images/text2-resize.png.



cannot compute difference between binary files


Added images/text3-crop.png.



cannot compute difference between binary files


Added images/text3-full.png.



cannot compute difference between binary files


Added images/text3-resize.png.



cannot compute difference between binary files


Added images/text4-crop.png.



cannot compute difference between binary files


Added images/text4-full.png.



cannot compute difference between binary files


Added images/text4-resize.png.



cannot compute difference between binary files


Added images/text5-crop.png.



cannot compute difference between binary files


Added images/text5-full.png.



cannot compute difference between binary files


Added images/text5-resize.png.



cannot compute difference between binary files


Added images/text6-crop.png.



cannot compute difference between binary files


Added images/text6-full.png.



cannot compute difference between binary files


Added images/text6-resize.png.



cannot compute difference between binary files


Deleted import.crimp.





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




























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

import
char* photo

Tk_PhotoHandle handle = Tk_FindPhoto(interp, photo);
if (handle == NULL) {
    Tcl_ResetResult(interp);
    Tcl_AppendResult(interp, "image \"", photo, "\" doesn't exist");
    return TCL_ERROR;
}

Tk_PhotoImageBlock pib;
Tk_PhotoGetImage(handle, &pib);
if (pib.pixelSize != 4 || pib.pitch != 4 * pib.width || pib.offset[0] != 0
 || pib.offset[1] != 1 || pib.offset[2] != 2 || pib.offset[3] != 3) {
    Tcl_SetResult(interp, "unsupported image format", TCL_STATIC);
    return TCL_ERROR;
}

Tcl_Obj *list[] = {
    Tcl_NewIntObj(pib.width), Tcl_NewIntObj(pib.height),
    Tcl_NewByteArrayObj(pib.pixelPtr, 4 * pib.width * pib.height)
};
Tcl_SetObjResult(interp, Tcl_NewListObj(3, list));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */






Deleted matrix.crimp.





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

































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

matrix
Tcl_Obj* imageObj Tcl_Obj* matrixObj

int objc;
Tcl_Obj **rowv, **colv;
double matrix[3][3];

if (Tcl_ListObjGetElements(interp, matrixObj, &objc, &rowv) != TCL_OK) {
    return TCL_ERROR;
} else if (objc != 3) {
    Tcl_SetResult(interp, "invalid matrix format", TCL_STATIC);
    return TCL_ERROR;
}

int i, j;
for (i = 0; i < 3; ++i) {
    if (Tcl_ListObjGetElements(interp, rowv[i], &objc, &colv) != TCL_OK) {
        return TCL_ERROR;
    } else if (objc != 3) {
        Tcl_SetResult(interp, "invalid matrix format", TCL_STATIC);
        return TCL_ERROR;
    }
    for (j = 0; j < 3; ++j) {
        if (Tcl_GetDoubleFromObj(interp, colv[j], &matrix[i][j]) != TCL_OK) {
            return TCL_ERROR;
        }
    }
}

double cofact[3][3], invert[3][3];
double det = 0;
double sign = 1;
for (i = 0; i < 3; ++i) {
    int i1 = !i, i2 = 2 - !(i - 2);
    for (j = 0; j < 3; ++j) {
        int j1 = !j, j2 = 2 - !(j - 2);
        cofact[i][j] = sign * (matrix[i1][j1] * matrix[i2][j2]
                             - matrix[i1][j2] * matrix[i2][j1]);
        sign = -sign;
    }
    det += matrix[i][0] * cofact[i][0];
}
if (det == 0) {
    Tcl_SetResult(interp, "singular matrix", TCL_STATIC);
    return TCL_ERROR;
}
for (i = 0; i < 3; ++i) {
    for (j = 0; j < 3; ++j) {
        invert[i][j] = cofact[j][i] / det;
    }
}

int w, h;
unsigned char *pixels;
if (decodeImageObj(interp, imageObj, &w, &h, &pixels) != TCL_OK) {
    return TCL_ERROR;
}

Tcl_Obj *dataObj = Tcl_NewByteArrayObj(NULL, 4 * w * h);
unsigned char (*in)[h][w][4] = (unsigned char (*)[h][w][4])pixels;
unsigned char (*out)[h][w][4] = (unsigned char (*)[h][w][4])
        Tcl_GetByteArrayFromObj(dataObj, NULL);

int oy, ox, c, iy, ix;
double oyf, oxf;
for (oy = 0, oyf = -1; oy < h; ++oy, oyf += 2.0 / h) {
    for (ox = 0, oxf = -1; ox < w; ++ox, oxf += 2.0 / w) {
        double ixf = (invert[0][0] * oxf + invert[0][1] * oyf + invert[0][2]);
        double iyf = (invert[1][0] * oxf + invert[1][1] * oyf + invert[1][2]);
        double iwf = (invert[2][0] * oxf + invert[2][1] * oyf + invert[2][2]);
        ixf = ((ixf / iwf) + 1) * w / 2;
        iyf = ((iyf / iwf) + 1) * h / 2;
        int ixw = ixf;
        int iyw = iyf;
        ixf -= ixw;
        iyf -= iyw;
        for (c = 0; c < 4; ++c) {
            float val = 0;
            for (iy = MAX(iyw, 0); iy < MIN(iyw + 2, h); ++iy) {
                iyf = 1 - iyf;
                for (ix = MAX(ixw, 0); ix < MIN(ixw + 2, w); ++ix) {
                    ixf = 1 - ixf;
                    val += (*in)[iy][ix][c] * iyf * ixf;
                }
            }
            (*out)[oy][ox][c] = val;
        }
    }
}

Tcl_Obj *list[] = {Tcl_NewIntObj(w), Tcl_NewIntObj(h), dataObj};
Tcl_SetObjResult(interp, Tcl_NewListObj(3, list));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */






Deleted merge.crimp.





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





















































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

merge
Tcl_Obj* imageListObj

int objc;
Tcl_Obj **objv;
if (Tcl_ListObjGetElements(interp, imageListObj, &objc, &objv) != TCL_OK) {
    return TCL_ERROR;
} else if (objc == 0) {
    Tcl_SetResult(interp, "must have at least one image", TCL_STATIC);
    return TCL_ERROR;
}

unsigned char (*in[objc])[][4];
int w, h, i;
if (decodeImageObj(interp, objv[0], &w, &h,
        (unsigned char **)&in[0]) != TCL_OK) {
    return TCL_ERROR;
}
for (i = 1; i < objc; ++i) {
    int w2, h2;
    if (decodeImageObj(interp, objv[i], &w2, &h2,
            (unsigned char **)&in[i]) != TCL_OK) {
        return TCL_ERROR;
    } else if (w != w2 || h != h2) {
        Tcl_SetResult(interp, "images must have same size", TCL_STATIC);
        return TCL_ERROR;
    }
}

Tcl_Obj *resultObj, *dataObj;
if (getUnsharedImageObj(interp, objv[0], &resultObj, &dataObj) != TCL_OK) {
    return TCL_ERROR;
}

unsigned char (*out)[][4] = (unsigned char (*)[][4])
        Tcl_GetByteArrayFromObj(dataObj, NULL);
int j, c;
for (j = 1; j < objc; ++j) {
    for (i = 0; i < w * h; ++i) {
        for (c = 0; c < 3; ++c) {
            (*out)[i][c] = ((*in[j])[i][c] * (*in[j])[i][3]
                          + (*out)[i][c] * (255 - (*in[j])[i][3])) / 255;
        }
        (*out)[i][3] = (*out)[i][3] + (*in[j])[i][3]
                     - (*out)[i][3] * (*in[j])[i][3] / 255;
    }
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */






Deleted mirror.crimp.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

mirror
Tcl_Obj* imageObj

int x, y, w, h;
Tcl_Obj *dataObj;
unsigned char *pixels;
if (getUnsharedImageObj(interp, imageObj, &imageObj, &dataObj) != TCL_OK
 || decodeImageObj(interp, imageObj, &w, &h, &pixels) != TCL_OK) {
    return TCL_ERROR;
}

unsigned (*px)[h][w] = (unsigned (*)[h][w])pixels;
for (y = 0; y < h; ++y) {
    for (x = 0; x < w / 2; ++x) {
        unsigned swap = (*px)[y][x];
        (*px)[y][x] = (*px)[y][w - x - 1];
        (*px)[y][w - x - 1] = swap;
    }
}
Tcl_SetObjResult(interp, imageObj);
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */






Added operator/add-float-float.crimp.





























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

add_float_float
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased addition of two images. The
 * images have to have equal dimensions.
 */

#define BINOP(a,b) ((((a) + (b)) / scale) + offset)
#include "binop_float_float.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/add-float-grey16.crimp.





























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

add_float_grey16
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased addition of two images. The
 * images have to have equal dimensions.
 */

#define BINOP(a,b) ((((a) + (b)) / scale) + offset)
#include "binop_float_grey16.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/add-float-grey32.crimp.





























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

add_float_grey32
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased addition of two images. The
 * images have to have equal dimensions.
 */

#define BINOP(a,b) ((((a) + (b)) / scale) + offset)
#include "binop_float_grey32.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/add-float-grey8.crimp.





























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

add_float_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased addition of two images. The
 * images have to have equal dimensions.
 */

#define BINOP(a,b) ((((a) + (b)) / scale) + offset)
#include "binop_float_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/add-grey8-grey8.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

add_grey8_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased addition of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) + (b)) / scale) + offset)
#include "binop_grey8_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/add-rgb-grey8.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

add_rgb_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased addition of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) + (b)) / scale) + offset)
#include "binop_rgb_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/add-rgb-rgb.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

add_rgb_rgb
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased addition of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) + (b)) / scale) + offset)
#include "binop_rgb_rgb.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/add-rgba-grey8.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

add_rgba_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased addition of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) + (b)) / scale) + offset)
#include "binop_rgba_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/add-rgba-rgb.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

add_rgba_rgb
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased addition of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) + (b)) / scale) + offset)
#include "binop_rgba_rgb.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/add-rgba-rgba.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

add_rgba_rgba
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased addition of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) + (b)) / scale) + offset)
#include "binop_rgba_rgba.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/ahe-grey8.crimp.























































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

ahe_grey8
Tcl_Obj* imageObj
int radius

/*
 * Adaptive Histrogram Equalization. Based on the rank-order-filter code for
 * fast calc of the histogram at each pixel, with a different transfer
 * function.
 *
 * Note that the implied kernel has dimensions (2r+1)x(2r+1), reducing the
 * result image by 2*radius in each dimension. I.e. the filter doesn't process
 * the 'radius' border pixels along each edge.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, n;
int              rowhistogram [256];
int*             colhistogram;

crimp_input (imageObj, image, grey8);

result = crimp_new (image->itype, image->w - 2*radius, image->h - 2*radius);

/*
 * We are using the method described by Simon Perreault and Patrick Hebert in
 * their paper 'Median Filtering In Constant Time'. This method trades memory
 * for speed by keeping one histogram per column, plus a row histogram of the
 * current 2r+1 columns. When moving from pixel to pixel these histograms are
 * incrementally updated, each in constant time. The trick is that the column
 * histograms keep history between rows.
 *
 * Right now we are not making use of any of the proposed optimizations, like
 * multi-level histograms, conditional updating, or vertical striping for
 * cache friendliness.
 *
 * Relationship between input and result coordinate systems:
 *
 * xi = xo + radius, xo in (0...w-2*radius)
 * yi = yo + radius, yo in (0...w-2*radius)

 * <other paper ref> - talking about the fast histogram via sliding window,
 * unclear if they talk abou this method.
 */

colhistogram = NALLOC (image->w * 256, int);
memset (colhistogram,'\0', image->w * 256 * sizeof(int));

n = (2*radius+1);
n = n * n;

/*
 * TODO :: Test different storage orders for the histograms (row vs column
 *         major order).
 */

/*
 * Access to the column histograms.
 *
 * xi = column index, in the input image coordinate system.
 */
#if 1
#define CHINDEX(xi,value)   ((xi) * 256 + (value))
#else
#define CHINDEX(xi,value)   ((value) * image->w + (xi))
#endif
#define COLHIST(xi,value) colhistogram [CHINDEX (xi, value)]

/*
 * Basic operations on column histograms. Add/remove pixel values.
 */
#define UP(xi,value)   COLHIST (xi, value)++
#define DOWN(xi,value) COLHIST (xi, value)--

/*
 * Basic operations on the row histogram. Add and subtract column histograms
 * to/from it. These operations are vectorizable.
 *
 * xi = column index, in the input image coordinate system.
 */

#define ADD(xi) { int value ; for (value=0;value<256;value++) { rowhistogram[value] += COLHIST (xi,value);}}
#define SUB(xi) { int value ; for (value=0;value<256;value++) { rowhistogram[value] -= COLHIST (xi,value);}}

/*
 * Higher level of column histogram change. Move a column histogram down by
 * one row. yi is the index of the new row, and the histogram contains the
 * data for row yi-1. This is in the input image coordinate system.
 *
 * xi = column index, in the input image coordinate system.
 */

#define SHIFT_DOWN(xi,yi) {				     \
	DOWN ((xi), GREY8 (image, (xi), (yi) - radius - 1)); \
	UP   ((xi), GREY8 (image, (xi), (yi) + radius)); }

/*
 * Higher level of row histogram change. Move the row histogram right by one
 * column. xi is the index of the new column, and the histogram contains the
 * data for column xi-1. This is in the input image coordinate system.
 */

#define SHIFT_RIGHT(xi) { SUB ((xi) - radius - 1); ADD ((xi) + radius); }

/*
 * ==
 * Initialization, and handling of result row 0
 * ==
 */

/*
 * Initialization I.
 * Scan the first 2*radius+1 rows of the input image into the column
 * histograms.
 */

for (yi = 0; yi < 2*radius+1; yi++) {
    for (xi = 0; xi < image->w; xi++) {
	UP (xi, GREY8 (image, xi, yi));
    }
}

/*
 * Initialization II.
 * Add the first 2*radius+1 column histogram into the initial row histogram.
 */

memset (rowhistogram,'\0', 256 * sizeof(int));
for (xi = 0 ; xi < 2*radius+1; xi++) { ADD (xi); }

/*
 * Now we can start the AHE. The initial histogram is already properly set
 * up for (xo,yo) = (0,0). For the remaining pixels of the first row in the
 * output we can sweep through without having to pull the column histograms
 * down.
 */

GREY8 (result, 0, 0) = crimp_ahe_transfer (rowhistogram, GREY8(image,radius,radius), n);
for (xo = 1, xi = radius+1; xo < result->w; xo++, xi++) {
    SHIFT_RIGHT (xi);
    GREY8 (result, xo, 0) = crimp_ahe_transfer (rowhistogram, GREY8(image,xi,radius), n);
}

/*
 * With the first row of the result done we can now sweep the remaining lines.
 */

for (yo = 1, yi = radius+1; yo < result->h; yo++, yi++) {

    /* Re-initialize the row histogram for the line */
    memset (rowhistogram,'\0', 256 * sizeof(int));
    for (xi = 0 ; xi < 2*radius+1; xi++) {
	SHIFT_DOWN (xi,yi);
	ADD (xi);
    }

    GREY8 (result, 0, yo) = crimp_ahe_transfer (rowhistogram, GREY8(image,radius,yi), n);
    for (xo = 1, xi = radius+1; xo < result->w; xo++, xi++) {
	SHIFT_DOWN  (xi+radius,yi);
	SHIFT_RIGHT (xi);
	GREY8 (result, xo, yo) = crimp_ahe_transfer (rowhistogram, GREY8(image,xi,yi), n);
    }
 }

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/ahe-hsv.crimp.































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

ahe_hsv
Tcl_Obj* imageObj
int radius

/*
 * Adaptive Histrogram Equalization. Based on the rank-order-filter code for
 * fast calc of the histogram at each pixel, with a different transfer
 * function.
 *
 * Note that the implied kernel has dimensions (2r+1)x(2r+1), reducing the
 * result image by 2*radius in each dimension. I.e. the filter doesn't process
 * the 'radius' border pixels along each edge.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, n;
int              rowhistogram [256];
int*             colhistogram;

crimp_input (imageObj, image, hsv);

result = crimp_new (image->itype, image->w - 2*radius, image->h - 2*radius);

/*
 * We are using the method described by Simon Perreault and Patrick Hebert in
 * their paper 'Median Filtering In Constant Time'. This method trades memory
 * for speed by keeping one histogram per column, plus a row histogram of the
 * current 2r+1 columns. When moving from pixel to pixel these histograms are
 * incrementally updated, each in constant time. The trick is that the column
 * histograms keep history between rows.
 *
 * Right now we are not making use of any of the proposed optimizations, like
 * multi-level histograms, conditional updating, or vertical striping for
 * cache friendliness.
 *
 * Relationship between input and result coordinate systems:
 *
 * xi = xo + radius, xo in (0...w-2*radius)
 * yi = yo + radius, yo in (0...w-2*radius)

 * <other paper ref> - talking about the fast histogram via sliding window,
 * unclear if they talk abou this method.
 */

colhistogram = NALLOC (image->w * 256, int);
memset (colhistogram,'\0', image->w * 256 * sizeof(int));

n = (2*radius+1);
n = n * n;

/*
 * TODO :: Test different storage orders for the histograms (row vs column
 *         major order).
 */

/*
 * Access to the column histograms.
 *
 * xi = column index, in the input image coordinate system.
 */
#if 1
#define CHINDEX(xi,value)   ((xi) * 256 + (value))
#else
#define CHINDEX(xi,value)   ((value) * image->w + (xi))
#endif
#define COLHIST(xi,value) colhistogram [CHINDEX (xi, value)]

/*
 * Basic operations on column histograms. Add/remove pixel values.
 */
#define UP(xi,value)   COLHIST (xi, value)++
#define DOWN(xi,value) COLHIST (xi, value)--

/*
 * Basic operations on the row histogram. Add and subtract column histograms
 * to/from it. These operations are vectorizable.
 *
 * xi = column index, in the input image coordinate system.
 */

#define ADD(xi) { int value ; for (value=0;value<256;value++) { rowhistogram[value] += COLHIST (xi,value);}}
#define SUB(xi) { int value ; for (value=0;value<256;value++) { rowhistogram[value] -= COLHIST (xi,value);}}

/*
 * Higher level of column histogram change. Move a column histogram down by
 * one row. yi is the index of the new row, and the histogram contains the
 * data for row yi-1. This is in the input image coordinate system.
 *
 * xi = column index, in the input image coordinate system.
 */

#undef  SHIFT_DOWN
#define SHIFT_DOWN(xi,yi) {				     \
	DOWN ((xi), V (image, (xi), (yi) - radius - 1)); \
	UP   ((xi), V (image, (xi), (yi) + radius)); }

/*
 * Higher level of row histogram change. Move the row histogram right by one
 * column. xi is the index of the new column, and the histogram contains the
 * data for column xi-1. This is in the input image coordinate system.
 */

#undef  SHIFT_RIGHT
#define SHIFT_RIGHT(xi) { SUB ((xi) - radius - 1); ADD ((xi) + radius); }

/*
 * ==
 * Initialization, and handling of result row 0
 * ==
 */

/*
 * Initialization I.
 * Scan the first 2*radius+1 rows of the input image into the column
 * histograms.
 */

for (yi = 0; yi < 2*radius+1; yi++) {
    for (xi = 0; xi < image->w; xi++) {
	UP (xi, V (image, xi, yi));
    }
}

/*
 * Initialization II.
 * Add the first 2*radius+1 column histogram into the initial row histogram.
 */

memset (rowhistogram,'\0', 256 * sizeof(int));
for (xi = 0 ; xi < 2*radius+1; xi++) { ADD (xi); }

/*
 * Now we can start the AHE. The initial histogram is already properly set
 * up for (xo,yo) = (0,0). For the remaining pixels of the first row in the
 * output we can sweep through without having to pull the column histograms
 * down.
 */

H (result, 0, 0) = H (image, radius, radius);
S (result, 0, 0) = S (image, radius, radius);
V (result, 0, 0) = crimp_ahe_transfer (rowhistogram, V(image,radius,radius), n);
for (xo = 1, xi = radius+1; xo < result->w; xo++, xi++) {
    SHIFT_RIGHT (xi);
    H (result, xo, 0) = H (image, xi, radius);
    S (result, xo, 0) = S (image, xi, radius);
    V (result, xo, 0) = crimp_ahe_transfer (rowhistogram, V(image,xi,radius), n);
}

/*
 * With the first row of the result done we can now sweep the remaining lines.
 */

for (yo = 1, yi = radius+1; yo < result->h; yo++, yi++) {

    /* Re-initialize the row histogram for the line */
    memset (rowhistogram,'\0', 256 * sizeof(int));
    for (xi = 0 ; xi < 2*radius+1; xi++) {
	SHIFT_DOWN (xi,yi);
	ADD (xi);
    }

    V (result, 0, yo) = crimp_ahe_transfer (rowhistogram, V(image,radius,yi), n);
    for (xo = 1, xi = radius+1; xo < result->w; xo++, xi++) {
	SHIFT_DOWN  (xi+radius,yi);
	SHIFT_RIGHT (xi);
	H (result, xo, yo) = H (image, xi, yi);
	S (result, xo, yo) = S (image, xi, yi);
	V (result, xo, yo) = crimp_ahe_transfer (rowhistogram, V(image,xi,yi), n);
    }
 }

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/ahe-rgb.crimp.



























































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

ahe_rgb
Tcl_Obj* imageObj
int radius

/*
 * Adaptive Histrogram Equalization. Based on the rank-order-filter code for
 * fast calc of the histogram at each pixel, with a different transfer
 * function.
 *
 * Note that the implied kernel has dimensions (2r+1)x(2r+1), reducing the
 * result image by 2*radius in each dimension. I.e. the filter doesn't process
 * the 'radius' border pixels along each edge.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, n;
int              rowhistogramr [256];
int              rowhistogramg [256];
int              rowhistogramb [256];
int*             colhistogramr;
int*             colhistogramg;
int*             colhistogramb;

crimp_input (imageObj, image, rgb);

result = crimp_new (image->itype, image->w - 2*radius, image->h - 2*radius);

/*
 * We are using the method described by Simon Perreault and Patrick Hebert in
 * their paper 'Median Filtering In Constant Time'. This method trades memory
 * for speed by keeping one histogram per column, plus a row histogram of the
 * current 2r+1 columns. When moving from pixel to pixel these histograms are
 * incrementally updated, each in constant time. The trick is that the column
 * histograms keep history between rows.
 *
 * Right now we are not making use of any of the proposed optimizations, like
 * multi-level histograms, conditional updating, or vertical striping for
 * cache friendliness.
 *
 * Relationship between input and result coordinate systems:
 *
 * xi = xo + radius, xo in (0...w-2*radius)
 * yi = yo + radius, yo in (0...w-2*radius)
 */

colhistogramr = NALLOC (image->w * 256, int); memset (colhistogramr,'\0', image->w * 256 * sizeof(int));
colhistogramg = NALLOC (image->w * 256, int); memset (colhistogramg,'\0', image->w * 256 * sizeof(int));
colhistogramb = NALLOC (image->w * 256, int); memset (colhistogramb,'\0', image->w * 256 * sizeof(int));

n = (2*radius+1);
n = n * n;

/*
 * TODO :: Test different storage orders for the histograms (row vs column
 *         major order).
 */

/*
 * Access to the column histograms.
 *
 * xi = column index, in the input image coordinate system.
 */
#if 1
#define CHINDEX(xi,value)   ((xi) * 256 + (value))
#else
#define CHINDEX(xi,value)   ((value) * image->w + (xi))
#endif
#define COLHISTR(xi,value) colhistogramr [CHINDEX (xi, value)]
#define COLHISTG(xi,value) colhistogramg [CHINDEX (xi, value)]
#define COLHISTB(xi,value) colhistogramb [CHINDEX (xi, value)]

/*
 * Basic operations on column histograms. Add/remove pixel values.
 */
#define UPR(xi,value)   COLHISTR (xi, value)++
#define DOWNR(xi,value) COLHISTR (xi, value)--
#define UPG(xi,value)   COLHISTG (xi, value)++
#define DOWNG(xi,value) COLHISTG (xi, value)--
#define UPB(xi,value)   COLHISTB (xi, value)++
#define DOWNB(xi,value) COLHISTB (xi, value)--

/*
 * Basic operations on the row histogram. Add and subtract column histograms
 * to/from it. These operations are vectorizable.
 *
 * xi = column index, in the input image coordinate system.
 */

#define ADDR(xi) { int value ; for (value=0;value<256;value++) { rowhistogramr[value] += COLHISTR (xi,value);}}
#define SUBR(xi) { int value ; for (value=0;value<256;value++) { rowhistogramr[value] -= COLHISTR (xi,value);}}
#define ADDG(xi) { int value ; for (value=0;value<256;value++) { rowhistogramg[value] += COLHISTG (xi,value);}}
#define SUBG(xi) { int value ; for (value=0;value<256;value++) { rowhistogramg[value] -= COLHISTG (xi,value);}}
#define ADDB(xi) { int value ; for (value=0;value<256;value++) { rowhistogramb[value] += COLHISTB (xi,value);}}
#define SUBB(xi) { int value ; for (value=0;value<256;value++) { rowhistogramb[value] -= COLHISTB (xi,value);}}

/*
 * Higher level of column histogram change. Move a column histogram down by
 * one row. yi is the index of the new row, and the histogram contains the
 * data for row yi-1. This is in the input image coordinate system.
 *
 * xi = column index, in the input image coordinate system.
 */

#undef  SHIFT_DOWN
#define SHIFT_DOWN(xi,yi) {			          \
	DOWNR ((xi), R (image, (xi), (yi) - radius - 1)); \
	UPR   ((xi), R (image, (xi), (yi) + radius));     \
	DOWNG ((xi), G (image, (xi), (yi) - radius - 1)); \
	UPG   ((xi), G (image, (xi), (yi) + radius));     \
	DOWNB ((xi), B (image, (xi), (yi) - radius - 1)); \
	UPB   ((xi), B (image, (xi), (yi) + radius));     }

/*
 * Higher level of row histogram change. Move the row histogram right by one
 * column. xi is the index of the new column, and the histogram contains the
 * data for column xi-1. This is in the input image coordinate system.
 */

#undef  SHIFT_RIGHT
#define SHIFT_RIGHT(xi) { \
	SUBR ((xi) - radius - 1); ADDR ((xi) + radius); \
	SUBG ((xi) - radius - 1); ADDG ((xi) + radius); \
	SUBB ((xi) - radius - 1); ADDB ((xi) + radius); }

/*
 * ==
 * Initialization, and handling of result row 0
 * ==
 */

/*
 * Initialization I.
 * Scan the first 2*radius+1 rows of the input image into the column
 * histograms.
 */

for (yi = 0; yi < 2*radius+1; yi++) {
    for (xi = 0; xi < image->w; xi++) {
	UPR (xi, R (image, xi, yi));
	UPG (xi, G (image, xi, yi));
	UPB (xi, B (image, xi, yi));
    }
}

/*
 * Initialization II.
 * Add the first 2*radius+1 column histogram into the initial row histogram.
 */

memset (rowhistogramr,'\0', 256 * sizeof(int)); for (xi = 0 ; xi < 2*radius+1; xi++) { ADDR (xi); }
memset (rowhistogramg,'\0', 256 * sizeof(int)); for (xi = 0 ; xi < 2*radius+1; xi++) { ADDG (xi); }
memset (rowhistogramb,'\0', 256 * sizeof(int)); for (xi = 0 ; xi < 2*radius+1; xi++) { ADDB (xi); }

/*
 * Now we can start filtering. The initial histogram is already properly set
 * up for (xo,yo) = (0,0). For the remaining pixels of the first row in the
 * output we can sweep through without having to pull the column histograms
 * down.
 */

R (result, 0, 0) = crimp_ahe_transfer (rowhistogramr, R (image, radius, radius), n);
G (result, 0, 0) = crimp_ahe_transfer (rowhistogramg, G (image, radius, radius), n);
B (result, 0, 0) = crimp_ahe_transfer (rowhistogramb, B (image, radius, radius), n);
for (xo = 1, xi = radius+1; xo < result->w; xo++, xi++) {
    SHIFT_RIGHT (xi);
    R (result, xo, 0) = crimp_ahe_transfer (rowhistogramr, R (image, xi, radius), n);
    G (result, xo, 0) = crimp_ahe_transfer (rowhistogramg, G (image, xi, radius), n);
    B (result, xo, 0) = crimp_ahe_transfer (rowhistogramb, B (image, xi, radius), n);
}

/*
 * With the first row of the result done we can now sweep the remaining lines.
 */

for (yo = 1, yi = radius+1; yo < result->h; yo++, yi++) {

    /* Re-initialize the row histogram for the line */
    memset (rowhistogramr,'\0', 256 * sizeof(int));
    memset (rowhistogramg,'\0', 256 * sizeof(int));
    memset (rowhistogramb,'\0', 256 * sizeof(int));
    for (xi = 0 ; xi < 2*radius+1; xi++) {
	SHIFT_DOWN (xi,yi);
	ADDR (xi);
	ADDG (xi);
	ADDB (xi);
    }

    R (result, 0, yo) = crimp_ahe_transfer (rowhistogramr, R (image, radius, yi), n);
    G (result, 0, yo) = crimp_ahe_transfer (rowhistogramg, G (image, radius, yi), n);
    B (result, 0, yo) = crimp_ahe_transfer (rowhistogramb, B (image, radius, yi), n);
    for (xo = 1, xi = radius+1; xo < result->w; xo++, xi++) {
	SHIFT_DOWN  (xi+radius,yi);
	SHIFT_RIGHT (xi);
	R (result, xo, yo) = crimp_ahe_transfer (rowhistogramr, R (image, xi, yi), n);
	G (result, xo, yo) = crimp_ahe_transfer (rowhistogramg, R (image, xi, yi), n);
	B (result, xo, yo) = crimp_ahe_transfer (rowhistogramb, R (image, xi, yi), n);
    }
 }

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/ahe-rgba.crimp.















































































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

ahe_rgba
Tcl_Obj* imageObj
int radius

/*
 * Generic rank-order filter. Depending on the chosen rank this a min, max, or
 * median filter, or anything in between.
 *
 * The percentile is 0...10000, i.e. percent with a resolution of 1/100.
 *
 * Note that the implied kernel has dimensions (2r+1)x(2r+1), reducing the
 * result image by 2*radius in each di1mension. I.e. the filter doesn't process
 * the 'radius' border pixels along each edge.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, n;
int              rowhistogramr [256];
int              rowhistogramg [256];
int              rowhistogramb [256];
int              rowhistograma [256];
int*             colhistogramr;
int*             colhistogramg;
int*             colhistogramb;
int*             colhistograma;

crimp_input (imageObj, image, rgba);

result = crimp_new (image->itype, image->w - 2*radius, image->h - 2*radius);

/*
 * We are using the method described by Simon Perreault and Patrick Hebert in
 * their paper 'Median Filtering In Constant Time'. This method trades memory
 * for speed by keeping one histogram per column, plus a row histogram of the
 * current 2r+1 columns. When moving from pixel to pixel these histograms are
 * incrementally updated, each in constant time. The trick is that the column
 * histograms keep history between rows.
 *
 * Right now we are not making use of any of the proposed optimizations, like
 * multi-level histograms, conditional updating, or vertical striping for
 * cache friendliness.
 *
 * Relationship between input and result coordinate systems:
 *
 * xi = xo + radius, xo in (0...w-2*radius)
 * yi = yo + radius, yo in (0...w-2*radius)
 */

colhistogramr = NALLOC (image->w * 256, int); memset (colhistogramr,'\0', image->w * 256 * sizeof(int));
colhistogramg = NALLOC (image->w * 256, int); memset (colhistogramg,'\0', image->w * 256 * sizeof(int));
colhistogramb = NALLOC (image->w * 256, int); memset (colhistogramb,'\0', image->w * 256 * sizeof(int));
colhistograma = NALLOC (image->w * 256, int); memset (colhistograma,'\0', image->w * 256 * sizeof(int));

n = (2*radius+1);
n = n * n;

/*
 * TODO :: Test different storage orders for the histograms (row vs column
 *         major order).
 */

/*
 * Access to the column histograms.
 *
 * xi = column index, in the input image coordinate system.
 */
#if 1
#define CHINDEX(xi,value)   ((xi) * 256 + (value))
#else
#define CHINDEX(xi,value)   ((value) * image->w + (xi))
#endif
#define COLHISTR(xi,value) colhistogramr [CHINDEX (xi, value)]
#define COLHISTG(xi,value) colhistogramg [CHINDEX (xi, value)]
#define COLHISTB(xi,value) colhistogramb [CHINDEX (xi, value)]
#define COLHISTA(xi,value) colhistograma [CHINDEX (xi, value)]

/*
 * Basic operations on column histograms. Add/remove pixel values.
 */
#define UPR(xi,value)   COLHISTR (xi, value)++
#define DOWNR(xi,value) COLHISTR (xi, value)--
#define UPG(xi,value)   COLHISTG (xi, value)++
#define DOWNG(xi,value) COLHISTG (xi, value)--
#define UPB(xi,value)   COLHISTB (xi, value)++
#define DOWNB(xi,value) COLHISTB (xi, value)--
#define UPA(xi,value)   COLHISTA (xi, value)++
#define DOWNA(xi,value) COLHISTA (xi, value)--

/*
 * Basic operations on the row histogram. Add and subtract column histograms
 * to/from it. These operations are vectorizable.
 *
 * xi = column index, in the input image coordinate system.
 */

#define ADDR(xi) { int value ; for (value=0;value<256;value++) { rowhistogramr[value] += COLHISTR (xi,value);}}
#define SUBR(xi) { int value ; for (value=0;value<256;value++) { rowhistogramr[value] -= COLHISTR (xi,value);}}
#define ADDG(xi) { int value ; for (value=0;value<256;value++) { rowhistogramg[value] += COLHISTG (xi,value);}}
#define SUBG(xi) { int value ; for (value=0;value<256;value++) { rowhistogramg[value] -= COLHISTG (xi,value);}}
#define ADDB(xi) { int value ; for (value=0;value<256;value++) { rowhistogramb[value] += COLHISTB (xi,value);}}
#define SUBB(xi) { int value ; for (value=0;value<256;value++) { rowhistogramb[value] -= COLHISTB (xi,value);}}
#define ADDA(xi) { int value ; for (value=0;value<256;value++) { rowhistograma[value] += COLHISTA (xi,value);}}
#define SUBA(xi) { int value ; for (value=0;value<256;value++) { rowhistograma[value] -= COLHISTA (xi,value);}}

/*
 * Higher level of column histogram change. Move a column histogram down by
 * one row. yi is the index of the new row, and the histogram contains the
 * data for row yi-1. This is in the input image coordinate system.
 *
 * xi = column index, in the input image coordinate system.
 */

#undef  SHIFT_DOWN
#define SHIFT_DOWN(xi,yi) {			          \
	DOWNR ((xi), R (image, (xi), (yi) - radius - 1)); \
	UPR   ((xi), R (image, (xi), (yi) + radius));     \
	DOWNG ((xi), G (image, (xi), (yi) - radius - 1)); \
	UPG   ((xi), G (image, (xi), (yi) + radius));     \
	DOWNB ((xi), B (image, (xi), (yi) - radius - 1)); \
	UPB   ((xi), B (image, (xi), (yi) + radius));     \
	DOWNA ((xi), A (image, (xi), (yi) - radius - 1)); \
	UPA   ((xi), A (image, (xi), (yi) + radius));     }

/*
 * Higher level of row histogram change. Move the row histogram right by one
 * column. xi is the index of the new column, and the histogram contains the
 * data for column xi-1. This is in the input image coordinate system.
 */

#undef  SHIFT_RIGHT
#define SHIFT_RIGHT(xi) { \
	SUBR ((xi) - radius - 1); ADDR ((xi) + radius); \
	SUBG ((xi) - radius - 1); ADDG ((xi) + radius); \
	SUBB ((xi) - radius - 1); ADDB ((xi) + radius); \
	SUBA ((xi) - radius - 1); ADDA ((xi) + radius); }

/*
 * ==
 * Initialization, and handling of result row 0
 * ==
 */

/*
 * Initialization I.
 * Scan the first 2*radius+1 rows of the input image into the column
 * histograms.
 */

for (yi = 0; yi < 2*radius+1; yi++) {
    for (xi = 0; xi < image->w; xi++) {
	UPR (xi, R (image, xi, yi));
	UPG (xi, G (image, xi, yi));
	UPB (xi, B (image, xi, yi));
	UPA (xi, A (image, xi, yi));
    }
}

/*
 * Initialization II.
 * Add the first 2*radius+1 column histogram into the initial row histogram.
 */

memset (rowhistogramr,'\0', 256 * sizeof(int)); for (xi = 0 ; xi < 2*radius+1; xi++) { ADDR (xi); }
memset (rowhistogramg,'\0', 256 * sizeof(int)); for (xi = 0 ; xi < 2*radius+1; xi++) { ADDG (xi); }
memset (rowhistogramb,'\0', 256 * sizeof(int)); for (xi = 0 ; xi < 2*radius+1; xi++) { ADDB (xi); }
memset (rowhistograma,'\0', 256 * sizeof(int)); for (xi = 0 ; xi < 2*radius+1; xi++) { ADDA (xi); }

/*
 * Now we can start filtering. The initial histogram is already properly set
 * up for (xo,yo) = (0,0). For the remaining pixels of the first row in the
 * output we can sweep through without having to pull the column histograms
 * down.
 */

R (result, 0, 0) = crimp_ahe_transfer (rowhistogramr, R (image, radius, radius), n);
G (result, 0, 0) = crimp_ahe_transfer (rowhistogramg, G (image, radius, radius), n);
B (result, 0, 0) = crimp_ahe_transfer (rowhistogramb, B (image, radius, radius), n);
A (result, 0, 0) = crimp_ahe_transfer (rowhistograma, A (image, radius, radius), n);
for (xo = 1, xi = radius+1; xo < result->w; xo++, xi++) {
    SHIFT_RIGHT (xi);
    R (result, xo, 0) = crimp_ahe_transfer (rowhistogramr, R (image, xi, radius), n);
    G (result, xo, 0) = crimp_ahe_transfer (rowhistogramg, G (image, xi, radius), n);
    B (result, xo, 0) = crimp_ahe_transfer (rowhistogramb, B (image, xi, radius), n);
    A (result, xo, 0) = crimp_ahe_transfer (rowhistograma, A (image, xi, radius), n);
}

/*
 * With the first row of the result done we can now sweep the remaining lines.
 */

for (yo = 1, yi = radius+1; yo < result->h; yo++, yi++) {

    /* Re-initialize the row histogram for the line */
    memset (rowhistogramr,'\0', 256 * sizeof(int));
    memset (rowhistogramg,'\0', 256 * sizeof(int));
    memset (rowhistogramb,'\0', 256 * sizeof(int));
    memset (rowhistograma,'\0', 256 * sizeof(int));
    for (xi = 0 ; xi < 2*radius+1; xi++) {
	SHIFT_DOWN (xi,yi);
	ADDR (xi);
	ADDG (xi);
	ADDB (xi);
	ADDA (xi);
    }

    R (result, 0, yo) = crimp_ahe_transfer (rowhistogramr, R (image, radius, yi), n);
    G (result, 0, yo) = crimp_ahe_transfer (rowhistogramg, G (image, radius, yi), n);
    B (result, 0, yo) = crimp_ahe_transfer (rowhistogramb, B (image, radius, yi), n);
    A (result, 0, yo) = crimp_ahe_transfer (rowhistograma, A (image, radius, yi), n);
    for (xo = 1, xi = radius+1; xo < result->w; xo++, xi++) {
	SHIFT_DOWN  (xi+radius,yi);
	SHIFT_RIGHT (xi);
	R (result, xo, yo) = crimp_ahe_transfer (rowhistogramr, R (image, xi, yi), n);
	G (result, xo, yo) = crimp_ahe_transfer (rowhistogramg, G (image, xi, yi), n);
	B (result, xo, yo) = crimp_ahe_transfer (rowhistogramb, B (image, xi, yi), n);
	A (result, xo, yo) = crimp_ahe_transfer (rowhistograma, A (image, xi, yi), n);
    }
 }

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/alpha-blend-grey8-grey8.crimp.

























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

alpha_blend_grey8_grey8
Tcl_Obj* imageForeObj
Tcl_Obj* imageBackObj
int alpha

/*
 * Alpha-based blending of two images, foreground, and background, controlled
 * by a scalar (and extern) alpha factor.
 *
 * alpha is Opacity
 * 255 <=> Fully opaque      <=> imageF
 * 0   <=> Fully transparent <=> imageB
 *
 * => OUT = F*alpha + B*(1-alpha)
 */

crimp_image*     result;
crimp_image*     imageF;
crimp_image*     imageB;
int x, y, ralpha;

crimp_input (imageForeObj, imageF, grey8);
crimp_input (imageBackObj, imageB, grey8);

if (!crimp_eq_dim (imageF, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageF);
ralpha = 255 - alpha;

#define MIX(fore,back) ((((fore)*alpha) + ((back)*ralpha))/255)

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	GREY8 (result, x, y) = MIX (GREY8 (imageF, x, y), GREY8 (imageB, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/alpha-blend-hsv-hsv.crimp.








































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

alpha_blend_hsv_hsv
Tcl_Obj* imageForeObj
Tcl_Obj* imageBackObj
int alpha

/*
 * Alpha-based blending of two images, foreground, and background, controlled
 * by a scalar (and extern) alpha factor. The result's alpha is the alpha
 * factor attenuated by the background's alpha.
 *
 * alpha is Opacity
 * 255 <=> Fully opaque      <=> imageF
 * 0   <=> Fully transparent <=> imageB
 *
 * => OUT = F*alpha + B*(1-alpha)
 */

crimp_image*     result;
crimp_image*     imageF;
crimp_image*     imageB;
int x, y, ralpha;

crimp_input (imageForeObj, imageF, hsv);
crimp_input (imageBackObj, imageB, hsv);

if (!crimp_eq_dim (imageF, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

if (alpha == 255) {
    Tcl_SetObjResult(interp, imageForeObj);
    return TCL_OK;
} else if (alpha == 0) {
    Tcl_SetObjResult(interp, imageBackObj);
    return TCL_OK;
}

/*
 * True alpha mixture.
 */

ralpha = 255 - alpha;
result = crimp_new_like (imageF);

#define MIX(fore,back) ((((fore)*alpha) + ((back)*ralpha))/255)

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	H (result, x, y) = MIX (H (imageF, x, y), H (imageB, x, y));
	S (result, x, y) = MIX (S (imageF, x, y), S (imageB, x, y));
	V (result, x, y) = MIX (V (imageF, x, y), V (imageB, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/alpha-blend-rgb-grey8.crimp.



























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

alpha_blend_rgb_grey8
Tcl_Obj* imageForeObj
Tcl_Obj* imageBackObj
int alpha

/*
 * Alpha-based blending of two images, foreground, and background, controlled
 * by a scalar (and extern) alpha factor.
 *
 * alpha is Opacity
 * 255 <=> Fully opaque      <=> imageF
 * 0   <=> Fully transparent <=> imageB
 *
 * => OUT = F*alpha + B*(1-alpha)
 */

crimp_image*     result;
crimp_image*     imageF;
crimp_image*     imageB;
int x, y, ralpha;

crimp_input (imageForeObj, imageF, rgb);
crimp_input (imageBackObj, imageB, grey8);

if (!crimp_eq_dim (imageF, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageF);
ralpha = 255 - alpha;

#define MIX(fore,back) ((((fore)*alpha) + ((back)*ralpha))/255)

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	R (result, x, y) = MIX (R (imageF, x, y), GREY8 (imageB, x, y));
	G (result, x, y) = MIX (G (imageF, x, y), GREY8 (imageB, x, y));
	B (result, x, y) = MIX (B (imageF, x, y), GREY8 (imageB, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/alpha-blend-rgb-rgb.crimp.



























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

alpha_blend_rgb_rgb
Tcl_Obj* imageForeObj
Tcl_Obj* imageBackObj
int alpha

/*
 * Alpha-based blending of two images, foreground, and background, controlled
 * by a scalar (and extern) alpha factor.
 *
 * alpha is Opacity
 * 255 <=> Fully opaque      <=> imageF
 * 0   <=> Fully transparent <=> imageB
 *
 * => OUT = F*alpha + B*(1-alpha)
 */

crimp_image*     result;
crimp_image*     imageF;
crimp_image*     imageB;
int x, y, ralpha;

crimp_input (imageForeObj, imageF, rgb);
crimp_input (imageBackObj, imageB, rgb);

if (!crimp_eq_dim (imageF, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageF);
ralpha = 255 - alpha;

#define MIX(fore,back) ((((fore)*alpha) + ((back)*ralpha))/255)

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	R (result, x, y) = MIX (R (imageF, x, y), R (imageB, x, y));
	G (result, x, y) = MIX (G (imageF, x, y), G (imageB, x, y));
	B (result, x, y) = MIX (B (imageF, x, y), B (imageB, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/alpha-blend-rgb-rgba.crimp.



























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

alpha_blend_rgb_rgba
Tcl_Obj* imageForeObj
Tcl_Obj* imageBackObj
int alpha

/*
 * Alpha-based blending of two images, foreground, and background, controlled
 * by a scalar (and extern) alpha factor.
 *
 * alpha is Opacity
 * 255 <=> Fully opaque      <=> imageF
 * 0   <=> Fully transparent <=> imageB
 *
 * => OUT = F*alpha + B*(1-alpha)
 */

crimp_image*     result;
crimp_image*     imageF;
crimp_image*     imageB;
int x, y, ralpha;

crimp_input (imageForeObj, imageF, rgb);
crimp_input (imageBackObj, imageB, rgba);

if (!crimp_eq_dim (imageF, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageF);
ralpha = 255 - alpha;

#define MIX(fore,back) ((((fore)*alpha) + ((back)*ralpha))/255)

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	R (result, x, y) = MIX (R (imageF, x, y), R (imageB, x, y));
	G (result, x, y) = MIX (G (imageF, x, y), G (imageB, x, y));
	B (result, x, y) = MIX (B (imageF, x, y), B (imageB, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/alpha-blend-rgba-grey8.crimp.






























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

alpha_blend_rgba_grey8
Tcl_Obj* imageForeObj
Tcl_Obj* imageBackObj
int alpha

/*
 * Alpha-based blending of two images, foreground, and background, controlled
 * by a scalar (and extern) alpha factor. The result's alpha is the alpha
 * factor. No attenuation by the background's alpha, as such doesn't
 * exist. Presumed to be TRANSPARENT = No attenuation.
 *
 * alpha is Opacity
 * 255 <=> Fully opaque      <=> imageF
 * 0   <=> Fully transparent <=> imageB
 *
 * => OUT = F*alpha + B*(1-alpha)
 */

crimp_image*     result;
crimp_image*     imageF;
crimp_image*     imageB;
int x, y, ralpha;

crimp_input (imageForeObj, imageF, rgba);
crimp_input (imageBackObj, imageB, grey8);

if (!crimp_eq_dim (imageF, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageF);
ralpha = 255 - alpha;

#define MIX(fore,back) ((((fore)*alpha) + ((back)*ralpha))/255)

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	R (result, x, y) = MIX (R (imageF, x, y), GREY8 (imageB, x, y));
	G (result, x, y) = MIX (G (imageF, x, y), GREY8 (imageB, x, y));
	B (result, x, y) = MIX (B (imageF, x, y), GREY8 (imageB, x, y));
	A (result, x, y) = alpha;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/alpha-blend-rgba-rgb.crimp.






























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

alpha_blend_rgba_rgb
Tcl_Obj* imageForeObj
Tcl_Obj* imageBackObj
int alpha

/*
 * Alpha-based blending of two images, foreground, and background, controlled
 * by a scalar (and extern) alpha factor. The result's alpha is the alpha
 * factor. No attenuation by the background's alpha, as such doesn't
 * exist. Presumed to be TRANSPARENT = No attenuation.
 *
 * alpha is Opacity
 * 255 <=> Fully opaque      <=> imageF
 * 0   <=> Fully transparent <=> imageB
 *
 * => OUT = F*alpha + B*(1-alpha)
 */

crimp_image*     result;
crimp_image*     imageF;
crimp_image*     imageB;
int x, y, ralpha;

crimp_input (imageForeObj, imageF, rgba);
crimp_input (imageBackObj, imageB, rgb);

if (!crimp_eq_dim (imageF, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageF);
ralpha = 255 - alpha;

#define MIX(fore,back) ((((fore)*alpha) + ((back)*ralpha))/255)

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	R (result, x, y) = MIX (R (imageF, x, y), R (imageB, x, y));
	G (result, x, y) = MIX (G (imageF, x, y), G (imageB, x, y));
	B (result, x, y) = MIX (B (imageF, x, y), B (imageB, x, y));
	A (result, x, y) = alpha;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/alpha-blend-rgba-rgba.crimp.









































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

alpha_blend_rgba_rgba
Tcl_Obj* imageForeObj
Tcl_Obj* imageBackObj
int alpha

/*
 * Alpha-based blending of two images, foreground, and background, controlled
 * by a scalar (and extern) alpha factor. The result's alpha is the alpha
 * factor attenuated by the background's alpha.
 *
 * alpha is Opacity
 * 255 <=> Fully opaque      <=> imageF
 * 0   <=> Fully transparent <=> imageB
 *
 * => OUT = F*alpha + B*(1-alpha)
 */

crimp_image*     result;
crimp_image*     imageF;
crimp_image*     imageB;
int x, y, ralpha;

crimp_input (imageForeObj, imageF, rgba);
crimp_input (imageBackObj, imageB, rgba);

if (!crimp_eq_dim (imageF, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

if (alpha == 255) {
    Tcl_SetObjResult(interp, imageForeObj);
    return TCL_OK;
} else if (alpha == 0) {
    Tcl_SetObjResult(interp, imageBackObj);
    return TCL_OK;
}

/*
 * True alpha mixture.
 */

result = crimp_new_like (imageF);
ralpha = 255 - alpha;

#define MIX(fore,back) ((((fore)*alpha) + ((back)*ralpha))/255)

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	R (result, x, y) = MIX (R (imageF, x, y), R (imageB, x, y));
	G (result, x, y) = MIX (G (imageF, x, y), G (imageB, x, y));
	B (result, x, y) = MIX (B (imageF, x, y), B (imageB, x, y));
	A (result, x, y) = MIX (alpha, A (imageB, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/alpha-over-rgba-rgb.crimp.






























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

alpha_over_rgba_rgb
Tcl_Obj* imageForeObj
Tcl_Obj* imageBackObj

/*
 * Alpha-based blending of two images, foreground, and background.  The
 * foreground's alpha channel is used to determine how much of the background
 * is seen. The result's alpha channel is a copy of the input's alpha.
 */

crimp_image*     result;
crimp_image*     imageF;
crimp_image*     imageB;
int x, y;

crimp_input (imageForeObj, imageF, rgba);
crimp_input (imageBackObj, imageB, rgb);

if (!crimp_eq_dim (imageF, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageF);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	int alpha = A (imageF, x, y);

	/*
	 * alpha is Opacity
	 * 255 <=> Fully opaque      <=> imageF
	 * 0   <=> Fully transparent <=> imageB
	 *
	 * => OUT = F*alpha + B*(1-alpha)
	 */

	R (result, x, y) = (R (imageF, x, y) * alpha + (255 - alpha) * R (imageB, x, y)) / 255;
	G (result, x, y) = (G (imageF, x, y) * alpha + (255 - alpha) * G (imageB, x, y)) / 255;
	B (result, x, y) = (B (imageF, x, y) * alpha + (255 - alpha) * B (imageB, x, y)) / 255;
	A (result, x, y) = alpha;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/alpha-over-rgba-rgba.crimp.































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

alpha_over_rgba_rgba
Tcl_Obj* imageForeObj
Tcl_Obj* imageBackObj

/*
 * Alpha-based blending of two images, foreground, and background.  The
 * foreground's alpha channel is used to determine how much of the background
 * is seen. The result's alpha is the input's alpha attenuated by the
 * background's alpha.
 */

crimp_image*     result;
crimp_image*     imageF;
crimp_image*     imageB;
int x, y;

crimp_input (imageForeObj, imageF, rgba);
crimp_input (imageBackObj, imageB, rgba);

if (!crimp_eq_dim (imageF, imageB)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageF);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	int alpha = A (imageF, x, y);

	/*
	 * alpha is Opacity
	 * 255 <=> Fully opaque      <=> imageF
	 * 0   <=> Fully transparent <=> imageB
	 *
	 * => OUT = F*alpha + B*(1-alpha)
	 */

	R (result, x, y) = (R (imageF, x, y) * alpha + (255 - alpha) * R (imageB, x, y)) / 255;
	G (result, x, y) = (G (imageF, x, y) * alpha + (255 - alpha) * G (imageB, x, y)) / 255;
	B (result, x, y) = (B (imageF, x, y) * alpha + (255 - alpha) * B (imageB, x, y)) / 255;
	A (result, x, y) = alpha - (alpha * A (imageB, x, y)) / 255;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/atan2-float-float.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

atan2_float_float
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Atan2 of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, float);
crimp_input (imageYObj, imageY, float);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageX);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	double a = atan2 (FLOATP (imageX, x, y),
			  FLOATP (imageY, x, y)) * 57.29577951308232087679;
	/* a in -180..0..180 */

	if (a < 0) a = 360+a;
	/* a in 0..360 */

	FLOATP (result, x, y) = a;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/atan2-float-grey16.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

atan2_float_grey16
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Atan2 of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, float);
crimp_input (imageYObj, imageY, grey16);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageX);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	double a = atan2 (FLOATP (imageX, x, y),
			  GREY16 (imageY, x, y)) * 57.29577951308232087679;
	/* a in -180..0..180 */

	if (a < 0) a = 360+a;
	/* a in 0..360 */

	FLOATP (result, x, y) = a;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/atan2-float-grey32.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

atan2_float_grey32
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Atan2 of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, float);
crimp_input (imageYObj, imageY, grey32);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageX);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	double a = atan2 (FLOATP (imageX, x, y),
			  GREY32 (imageY, x, y)) * 57.29577951308232087679;
	/* a in -180..0..180 */

	if (a < 0) a = 360+a;
	/* a in 0..360 */

	FLOATP (result, x, y) = a;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/atan2-float-grey8.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

atan2_float_grey8
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Atan2 of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, float);
crimp_input (imageYObj, imageY, grey8);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageX);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	double a = atan2 (FLOATP (imageX, x, y),
			  GREY8  (imageY, x, y)) * 57.29577951308232087679;
	/* a in -180..0..180 */

	if (a < 0) a = 360+a;
	/* a in 0..360 */

	FLOATP (result, x, y) = a;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/atan2-grey16-float.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

atan2_grey16_float
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Atan2 of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, grey16);
crimp_input (imageYObj, imageY, float);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageY);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	double a = atan2 (GREY16 (imageX, x, y),
			  FLOATP (imageY, x, y)) * 57.29577951308232087679;
	/* a in -180..0..180 */

	if (a < 0) a = 360+a;
	/* a in 0..360 */

	FLOATP (result, x, y) = a;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/atan2-grey16-grey16.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

atan2_grey16_grey16
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Atan2 of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, grey16);
crimp_input (imageYObj, imageY, grey16);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_float (imageX->w, imageX->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	double a = atan2 (GREY16 (imageX, x, y),
			  GREY16 (imageY, x, y)) * 57.29577951308232087679;
	/* a in -180..0..180 */

	if (a < 0) a = 360+a;
	/* a in 0..360 */

	FLOATP (result, x, y) = a;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/atan2-grey16-grey32.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

atan2_grey16_grey32
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Atan2 of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, grey16);
crimp_input (imageYObj, imageY, grey32);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_float (imageX->w, imageX->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	double a = atan2 (GREY16 (imageX, x, y),
			  GREY32 (imageY, x, y)) * 57.29577951308232087679;
	/* a in -180..0..180 */

	if (a < 0) a = 360+a;
	/* a in 0..360 */

	FLOATP (result, x, y) = a;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/atan2-grey16-grey8.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

atan2_grey16_grey8
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Atan2 of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, grey16);
crimp_input (imageYObj, imageY, grey8);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_float (imageX->w, imageX->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	double a = atan2 (GREY16 (imageX, x, y),
			  GREY8  (imageY, x, y)) * 57.29577951308232087679;
	/* a in -180..0..180 */

	if (a < 0) a = 360+a;
	/* a in 0..360 */

	FLOATP (result, x, y) = a;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/atan2-grey32-float.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

atan2_grey32_float
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Atan2 of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, grey32);
crimp_input (imageYObj, imageY, float);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageY);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	double a = atan2 (GREY32 (imageX, x, y),
			  FLOATP (imageY, x, y)) * 57.29577951308232087679;
	/* a in -180..0..180 */

	if (a < 0) a = 360+a;
	/* a in 0..360 */

	FLOATP (result, x, y) = a;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/atan2-grey32-grey16.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

atan2_grey32_grey16
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Atan2 of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, grey32);
crimp_input (imageYObj, imageY, grey16);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_float (imageX->w, imageX->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	double a = atan2 (GREY32 (imageX, x, y),
			  GREY16 (imageY, x, y)) * 57.29577951308232087679;
	/* a in -180..0..180 */

	if (a < 0) a = 360+a;
	/* a in 0..360 */

	FLOATP (result, x, y) = a;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/atan2-grey32-grey32.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

atan2_grey32_grey32
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Atan2 of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, grey32);
crimp_input (imageYObj, imageY, grey32);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_float (imageX->w, imageX->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	double a = atan2 (GREY32 (imageX, x, y),
			  GREY32 (imageY, x, y)) * 57.29577951308232087679;
	/* a in -180..0..180 */

	if (a < 0) a = 360+a;
	/* a in 0..360 */

	FLOATP (result, x, y) = a;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/atan2-grey32-grey8.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

atan2_grey32_grey8
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Atan2 of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, grey32);
crimp_input (imageYObj, imageY, grey8);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_float (imageX->w, imageX->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	double a = atan2 (GREY32 (imageX, x, y),
			  GREY8  (imageY, x, y)) * 57.29577951308232087679;
	/* a in -180..0..180 */

	if (a < 0) a = 360+a;
	/* a in 0..360 */

	FLOATP (result, x, y) = a;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/atan2-grey8-float.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

atan2_grey8_float
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Atan2 of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, grey8);
crimp_input (imageYObj, imageY, float);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageY);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	double a = atan2 (GREY8  (imageX, x, y),
			  FLOATP (imageY, x, y)) * 57.29577951308232087679;
	/* a in -180..0..180 */

	if (a < 0) a = 360+a;
	/* a in 0..360 */

	FLOATP (result, x, y) = a;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/atan2-grey8-grey16.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

atan2_grey8_grey16
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Atan2 of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, grey8);
crimp_input (imageYObj, imageY, grey16);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_float (imageX->w, imageX->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	double a = atan2 (GREY8  (imageX, x, y),
			  GREY16 (imageY, x, y)) * 57.29577951308232087679;
	/* a in -180..0..180 */

	if (a < 0) a = 360+a;
	/* a in 0..360 */

	FLOATP (result, x, y) = a;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/atan2-grey8-grey32.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

atan2_grey8_grey32
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Atan2 of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, grey8);
crimp_input (imageYObj, imageY, grey32);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_float (imageX->w, imageX->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	double a = atan2 (GREY8  (imageX, x, y),
			  GREY32 (imageY, x, y)) * 57.29577951308232087679;
	/* a in -180..0..180 */

	if (a < 0) a = 360+a;
	/* a in 0..360 */

	FLOATP (result, x, y) = a;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/atan2-grey8-grey8.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

atan2_grey8_grey8
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Atan2 of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, grey8);
crimp_input (imageYObj, imageY, grey8);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_float (imageX->w, imageX->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	double a = atan2 (GREY8 (imageX, x, y),
			  GREY8 (imageY, x, y)) * 57.29577951308232087679;
	/* a in -180..0..180 */

	if (a < 0) a = 360+a;
	/* a in 0..360 */

	FLOATP (result, x, y) = a;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/bilateral-grey8.crimp.














































































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

bilateral_grey8
Tcl_Obj* imageObj
double sigma_space
double sigma_range

/*
 * Bilateral filter. Uses a bilateral grid downsampled by sigma-s and
 * sigma-r for higher performance, and lesser memory use. A sigma of 1
 * implies 'no downsampling', filtering is on the full grid: high
 * memory use, slow speed.
 */

crimp_image*     result;
crimp_image*     image;
crimp_volume*    wi;    /* Bilateral grid, accumulated pixel intensities */
crimp_volume*    w;     /* Bilateral grid, accumulated pixel counts, = weight factor */
int              x, y, z;
int              bgrid_width, bgrid_height, bgrid_range, bgrid_maxdim;
double* nw;
double* nwi;

/*
 * Process and validate the arguments.
 */

crimp_input (imageObj, image, grey8);

ASSERT (sigma_space >= 1, "Cannot use sigma/s < 1");
ASSERT (sigma_range >= 1, "Cannot use sigma/r < 1");

result = crimp_new_like (image);

/*
 * Determine the size of the bilateral grid.
 * +1 = One more, in case the float->int of the ceil result rounded down.
 * +4 = Borders for the convolution of the grid.
 *
 * TODO NOTE: The SParis BF code obtains the min and max grey levels from the
 * TODO NOTE: image and uses that for the range, instead of a fixed 256 (Also
 * TODO NOTE: assumes that intensity is in [0,1]).
 */

bgrid_width  = 4 + 1 + (int) ceil (image->w/sigma_space);
bgrid_height = 4 + 1 + (int) ceil (image->w/sigma_space);
bgrid_range  = 4 + 1 + (int) ceil (256/sigma_range);
bgrid_maxdim = MAX (bgrid_width, MAX (bgrid_height, bgrid_range));

/*
 * Phase I. Allocate and initialize the bilateral grid (2 volumes).
 */

wi = crimp_vnew_float (bgrid_width, bgrid_height, bgrid_range);
w  = crimp_vnew_float (bgrid_width, bgrid_height, bgrid_range);

for (z = 0; z < bgrid_range; z++) {
    for (y = 0; y < bgrid_height; y++) {
	for (x = 0; x < bgrid_width; x++) {
	    VFLOATP (wi, x, y, z) = 0.0;
	    VFLOATP (w,  x, y, z) = 0.0;
	}
    }
}

/*
 * Phase II. Update the bilateral grid with the downsampled image data.
 */

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	double p = GREY8 (image, x, y);

	/* +2 is the offset to keep the borders empty. */

	int xr = 2 + lrint (((double) x) / sigma_space);
	int yr = 2 + lrint (((double) y) / sigma_space);
	int pr = 2 + lrint (p / sigma_range);

	VFLOATP (wi, xr, yr, pr) += p;
	VFLOATP (w,  xr, yr, pr) += 1;
    }
}

/*
 * Phase III. Convolve the grid using gaussian [1/16 (1 4 6 4 1)] along each
 * of the three axes. The convolution is hard-wired. Note that the grid was
 * allocated with the necessary borders, and the previous phases made sure to
 * keep the borders empty.
 *
 * NOTE: I sort of tried to optimize here, using a buffer just for a single
 * slice through the grid. The SParis code creates a whole duplicate of the
 * grid. It doesn't have to access the grid in strided fashion either, except
 * for the neighbour calculations.
 *
 * It also uses a simpler gaussian (1/4 (1 2 1)), and applies it twice.
 */

nw  = NALLOC (bgrid_maxdim, double); /* Helper arrays to buffer the convolution */
nwi = NALLOC (bgrid_maxdim, double); /* result per scan line. */

/* gauss(a,b,c,d,e) = 1a+4b+6c+4d+1e = a+e+4(b+d)+6c = a+e+4(b+d+c)+2c */

#define GAUSS(a, b, c, d, e) ((((a)+(e)) + 4*((b)+(d)) + 6*(c))/16.)

#define GX(f, x, y, z)		   \
       GAUSS (VFLOATP (f, x-2, y, z), \
	      VFLOATP (f, x-1, y, z), \
	      VFLOATP (f, x  , y, z), \
	      VFLOATP (f, x+1, y, z), \
	      VFLOATP (f, x+2, y, z))

#define GY(f, x, y, z)		   \
       GAUSS (VFLOATP (f, x, y-2, z), \
	      VFLOATP (f, x, y-1, z), \
	      VFLOATP (f, x, y  , z), \
	      VFLOATP (f, x, y+1, z), \
	      VFLOATP (f, x, y+2, z))

#define GZ(f, x, y, z)		   \
       GAUSS (VFLOATP (f, x, y, z-2), \
	      VFLOATP (f, x, y, z-1), \
	      VFLOATP (f, x, y, z  ), \
	      VFLOATP (f, x, y, z+1), \
	      VFLOATP (f, x, y, z+2))

/* Gaussian @ X */

for (z = 2; z < bgrid_range-2; z++) {
    for (y = 2; y < bgrid_height-2; y++) {
	for (x = 2; x < bgrid_width-2; x++) {
	    nw  [x-2] = GX(w,  x, y, z);
	    nwi [x-2] = GX(wi, x, y, z);
	}

	for (x = 2; x < bgrid_width-2; x++) { VFLOATP (w,  x, y, z) = nw [x-2]; }
	for (x = 2; x < bgrid_width-2; x++) { VFLOATP (wi, x, y, z) = nwi[x-2]; }
    }
}

/* Gaussian @ Y */

for (z = 2; z < bgrid_range-2; z++) {
    for (x = 2; x < bgrid_width-2; x++) {
	for (y = 2; y < bgrid_height-2; y++) {
	    nw  [y-2] = GY(w,  x, y, z);
	    nwi [y-2] = GY(wi, x, y, z);
	}

	for (y = 2; y < bgrid_height-2; y++) { VFLOATP (w,  x, y, z) = nw [y-2]; }
	for (y = 2; y < bgrid_height-2; y++) { VFLOATP (wi, x, y, z) = nwi[y-2]; }
    }
}


/* Gaussian @ Z */

for (y = 2; y < bgrid_height-2; y++) {
    for (x = 2; x < bgrid_width-2; x++) {
	for (z = 2; z < bgrid_range-2; z++) {
	    nw  [z-2] = GZ(w,  x, y, z);
	    nwi [z-2] = GZ(wi, x, y, z);
	}

	for (z = 2; z < bgrid_range-2; z++) { VFLOATP (w,  x, y, z) = nw [z-2]; }
	for (z = 2; z < bgrid_range-2; z++) { VFLOATP (wi, x, y, z) = nwi[z-2]; }
    }
}

#undef GX
#undef GY
#undef GZ
#undef GAUSS

/*
 * Phase IV. Resample the image using the updated bilateral grid and trilinear
 * interpolation.
 *
 * #define I(a,b,s) ((b) + ((a)-(b))*(s))
 */

#define BETWEEN(a,b,s) ((a)*(s) + (b)*(1-(s)))

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	double winew, wnew, p = GREY8 (image, x, y);

	/* Continuous grid location */
	double xf = 2 + ((double) x) / sigma_space;
	double yf = 2 + ((double) y) / sigma_space;
	double pf = 2 + p / sigma_range;

	/* Integral grid location */
	int xr = lrint (xf);
	int yr = lrint (yf);
	int pr = lrint (pf);

	/* Fractional grid location from the integral */
	if (xr > xf) { xr -- ; } ; xf = xf - xr;
	if (yr > yf) { yr -- ; } ; yf = yf - yr;
	if (pr > pf) { pr -- ; } ; pf = pf - pr;

	/* Trilinear interpolate over the grid */

	winew = BETWEEN (BETWEEN (BETWEEN (VFLOATP (wi, xr, yr,   pr),   VFLOATP (wi, xr+1, yr,   pr),   xf),
				  BETWEEN (VFLOATP (wi, xr, yr+1, pr),   VFLOATP (wi, xr+1, yr+1, pr),   xf), yf),
			 BETWEEN (BETWEEN (VFLOATP (wi, xr, yr,   pr+1), VFLOATP (wi, xr+1, yr,   pr+1), xf),
				  BETWEEN (VFLOATP (wi, xr, yr+1, pr+1), VFLOATP (wi, xr+1, yr+1, pr+1), xf), yf), pf);

	wnew  = BETWEEN (BETWEEN (BETWEEN (VFLOATP (w, xr, yr,   pr),   VFLOATP (w, xr+1, yr,   pr),   xf),
				  BETWEEN (VFLOATP (w, xr, yr+1, pr),   VFLOATP (w, xr+1, yr+1, pr),   xf), yf),
			 BETWEEN (BETWEEN (VFLOATP (w, xr, yr,   pr+1), VFLOATP (w, xr+1, yr,   pr+1), xf),
				  BETWEEN (VFLOATP (w, xr, yr+1, pr+1), VFLOATP (w, xr+1, yr+1, pr+1), xf), yf), pf);

	GREY8 (result, x, y) = CLAMP (0, (winew / wnew), 255);
    }
}

#undef BETWEEN

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/blank-float.crimp.






































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

blank_float
int w
int h
float value

/*
 * Create a blank float image (all pixels have the specified 'value').
 */

crimp_image*     result;
int              x, y;

result = crimp_new_float (w, h);

for (y = 0; y < h; y++) {
    for (x = 0; x < w; x++) {
	FLOATP (result, x, y) = value;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/blank-grey16.crimp.






































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

blank_grey16
int w
int h
int value

/*
 * Create a blank grey16 image (all pixels have the specified 'value').
 */

crimp_image*     result;
int              x, y;

result = crimp_new_grey16 (w, h);

for (y = 0; y < h; y++) {
    for (x = 0; x < w; x++) {
	GREY16 (result, x, y) = value;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/blank-grey32.crimp.






































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

blank_grey32
int w
int h
int value

/*
 * Create a blank grey32 image (all pixels have the specified 'value').
 */

crimp_image*     result;
int              x, y;

result = crimp_new_grey32 (w, h);

for (y = 0; y < h; y++) {
    for (x = 0; x < w; x++) {
	GREY32 (result, x, y) = value;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/blank-grey8.crimp.






































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

blank_grey8
int w
int h
int value

/*
 * Create a blank grey8 image (all pixels have the specified 'value').
 */

crimp_image*     result;
int              x, y;

result = crimp_new_grey8 (w, h);

for (y = 0; y < h; y++) {
    for (x = 0; x < w; x++) {
	GREY8 (result, x, y) = value;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/blank-rgb.crimp.








































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

blank_rgb
int w
int h
int r int g int b

/*
 * Create a blank rgb image (all pixels have the specified color (rgb value)).
 */

crimp_image*     result;
int              x, y;

result = crimp_new_rgb (w, h);

for (y = 0; y < h; y++) {
    for (x = 0; x < w; x++) {
	R (result, x, y) = r;
	G (result, x, y) = g;
	B (result, x, y) = b;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/blank-rgba.crimp.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

blank_rgba
int w
int h
int r int g int b int a

/*
 * Create a blank rgba image (all pixels have designed color and opacity).
 */

crimp_image*     result;
int              x, y;

result = crimp_new_rgba (w, h);

for (y = 0; y < h; y++) {
    for (x = 0; x < w; x++) {
	R (result, x, y) = r;
	G (result, x, y) = g;
	B (result, x, y) = b;
	A (result, x, y) = a;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/channels.crimp.


































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

channels
Tcl_Obj* imageObj

crimp_image* image;
Tcl_Obj**    listv;
int          i;

crimp_input_any (imageObj, image);

listv = NALLOC (image->itype->channels, Tcl_Obj*);
for (i=0; i < image->itype->channels; i++) {
    listv[i] = Tcl_NewStringObj (image->itype->cname [i], -1);
}

Tcl_SetObjResult (interp, Tcl_NewListObj (image->itype->channels, listv));
ckfree ((char*) listv);

return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/color-combine.crimp.






































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

color_combine
Tcl_Obj* imageObj
Tcl_Obj* combineMatrixObj

/*
 * Taking a color image in either RGB(A) and HSV it combines the color channels
 * by feeding the channels of each pixel through the specified vector. One
 * application of this is conversion to grey scale in various ways.
 */

crimp_image* image;
crimp_image* combine;
crimp_image* result;
int x, y;
double wr, wg, wb;

/*
 * Ensure that the input is of type RGB(A) or HSV
 */

crimp_input_any (imageObj, image);
ASSERT_NOTIMGTYPE (image, float);
ASSERT_NOTIMGTYPE (image, grey8);
ASSERT_NOTIMGTYPE (image, grey16);
ASSERT_NOTIMGTYPE (image, grey32);

crimp_input (combineMatrixObj, combine, float);

if (!crimp_require_dim (combine, 3, 1)) {
    Tcl_SetResult(interp, "bad matrix dimensions, expected 3x1", TCL_STATIC);
    return TCL_ERROR;
}

wr = CH (image, 0, x, y);
wg = CH (image, 1, x, y);
wb = CH (image, 2, x, y);

result = crimp_new_grey8 (image->w, image->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	double r = CH (image, 0, x, y);
	double g = CH (image, 1, x, y);
	double b = CH (image, 2, x, y);

	double c = r*wr + g*wg + b*wb;

	GREY8 (result, x, y) = CLAMP (0, (int) c, 255);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/color-mix.crimp.























































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

color_mix
Tcl_Obj* imageObj
Tcl_Obj* mixMatrixObj

/*
 * Taking a color image in either RGB(A) and HSV it remixes the color channels
 * by feeding the channels of each pixel through the specified matrix. One
 * application of this is whitepoint correction.
 */

crimp_image* image;
crimp_image* mix;
crimp_image* result;
int x, y;

/*
 * Ensure that the input is of type RGB(A) or HSV
 */

crimp_input_any (imageObj, image);
ASSERT_NOTIMGTYPE (image, float);
ASSERT_NOTIMGTYPE (image, grey8);
ASSERT_NOTIMGTYPE (image, grey16);
ASSERT_NOTIMGTYPE (image, grey32);

crimp_input (mixMatrixObj, mix, float);

if (!crimp_require_dim (mix, 3, 3)) {
    Tcl_SetResult(interp, "bad matrix dimensions, expected 3x3", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (image);

if (image->itype->channels == 4) {
    for (y = 0; y < result->h; y++) {
	for (x = 0; x < result->w; x++) {

	    double r = CH (image, 0, x, y);
	    double g = CH (image, 1, x, y);
	    double b = CH (image, 2, x, y);

	    crimp_la_multiply_matrix_3v (mix, &r, &g, &b);

	    CH (result, 0, x, y)= CLAMP (0, (int) r, 255);
	    CH (result, 1, x, y)= CLAMP (0, (int) g, 255);
	    CH (result, 2, x, y)= CLAMP (0, (int) b, 255);

	    /* The alpha channel is simply copied over */
	    CH (result, 3, x, y)= CH (image, 3, x, y);
	}
    }
} else {
    for (y = 0; y < result->h; y++) {
	for (x = 0; x < result->w; x++) {

	    double r = CH (image, 0, x, y);
	    double g = CH (image, 1, x, y);
	    double b = CH (image, 2, x, y);

	    crimp_la_multiply_matrix_3v (mix, &r, &g, &b);

	    CH (result, 0, x, y)= CLAMP (0, (int) r, 255);
	    CH (result, 1, x, y)= CLAMP (0, (int) g, 255);
	    CH (result, 2, x, y)= CLAMP (0, (int) b, 255);
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convert-float-grey16.crimp.





















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convert_2grey16_float
Tcl_Obj* imageObj

/*
 * This converter maps from float to grey16 using identity. Values outside of
 * the destination range are clampled to the maximum and minimum values,
 * respectively. I.e. saturated arithmetic is used.
 *
 * FUTURE: Either extend this converter to take semi-arbitrary mapping
 * functions (concatenation of arbitrary polynomials), or make such
 * transformations a separate primitive we can handle under the 'map'
 * method.
 */

#undef  MINVAL
#undef  MAXVAL

#define MINVAL 0
#define MAXVAL 65535

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, float);

result = crimp_new_grey16 (image->w, image->h);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {
	double f =  FLOATP(image, x, y);
	GREY16 (result, x, y) = CLAMPT (MINVAL, int, f, MAXVAL);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convert-float-grey32.crimp.





















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convert_2grey32_float
Tcl_Obj* imageObj

/*
 * This converter maps from float to grey32 using identity. Values outside of
 * the destination range are clampled to the maximum and minimum values,
 * respectively. I.e. saturated arithmetic is used.
 *
 * FUTURE: Either extend this converter to take semi-arbitrary mapping
 * functions (concatenation of arbitrary polynomials), or make such
 * transformations a separate primitive we can handle under the 'map'
 * method.
 */

#undef  MINVAL
#undef  MAXVAL

#define MINVAL 0
#define MAXVAL 4294967295

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, float);

result = crimp_new_grey32 (image->w, image->h);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {
	double f =  FLOATP(image, x, y);
	GREY32 (result, x, y) = CLAMPT (MINVAL, int, f, MAXVAL);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convert-float-grey8.crimp.





















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convert_2grey8_float
Tcl_Obj* imageObj

/*
 * This converter maps from float to grey8 using identity. Values outside of
 * the destination range are clampled to the maximum and minimum values,
 * respectively. I.e. saturated arithmetic is used.
 *
 * FUTURE: Either extend this converter to take semi-arbitrary mapping
 * functions (concatenation of arbitrary polynomials), or make such
 * transformations a separate primitive we can handle under the 'map'
 * method.
 */

#undef  MINVAL
#undef  MAXVAL

#define MINVAL 0
#define MAXVAL 255

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, float);

result = crimp_new_grey8 (image->w, image->h);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {
	double f =  FLOATP(image, x, y);
	GREY8 (result, x, y) = CLAMPT (MINVAL, int, f, MAXVAL);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convert-grey16-float.crimp.




































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convert_2float_grey16
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, grey16);

result = crimp_new_float (image->w, image->h);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	FLOATP (result, x, y) = GREY16 (image, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convert-grey32-float.crimp.




































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convert_2float_grey32
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, grey32);

result = crimp_new_float (image->w, image->h);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	FLOATP (result, x, y) = GREY32 (image, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convert-grey8-float.crimp.




































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convert_2float_grey8
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, grey8);

result = crimp_new_float (image->w, image->h);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	FLOATP (result, x, y) = GREY8 (image, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convert-grey8-hsv.crimp.

























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convert_2hsv_grey8
Tcl_Obj* imageObj
Tcl_Obj* colorObj

crimp_image* image;
crimp_image* color;
crimp_image* result;
int          x, y, value;

/*
 * This conversion from greyscale to color (HSV) is a general false-color
 * transformation, mapping each pixel value to an arbitrary color, through
 * a lookup table.
 *
 * Important: For the sake of convenience the color map is not provided as a
 * (Tcl) list (of values), or array, but as an _image_ itself, a 256x1 (WxH)
 * hsv. We will have constructors for such images.
 */

crimp_input (imageObj, image, grey8);
crimp_input (colorObj, color, hsv);

if (!crimp_require_dim (color, 256, 1)) {
    Tcl_SetResult(interp, "bad image dimension for color map, expected 256x1", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_hsv (image->w, image->h);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	value = GREY8 (image, x, y);
	H (result, x, y) = H (color, value, 0);
	S (result, x, y) = S (color, value, 0);
	V (result, x, y) = V (color, value, 0);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convert-grey8-rgb.crimp.

























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convert_2rgb_grey8
Tcl_Obj* imageObj
Tcl_Obj* colorObj

crimp_image* image;
crimp_image* color;
crimp_image* result;
int          x, y, value;

/*
 * This conversion from greyscale to color (RGB) is a general false-color
 * transformation, mapping each pixel value to an arbitrary color, through
 * a lookup table.
 *
 * Important: For the sake of convenience the color map is not provided as a
 * (Tcl) list (of values), or array, but as an _image_ itself, a 256x1 (WxH)
 * rgb. We will have constructors for such images.
 */

crimp_input (imageObj, image, grey8);
crimp_input (colorObj, color, rgb);

if (!crimp_require_dim (color, 256, 1)) {
    Tcl_SetResult(interp, "bad image dimension for color map, expected 256x1", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_rgb (image->w, image->h);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	value = GREY8 (image, x, y);
	R (result, x, y) = R (color, value, 0);
	G (result, x, y) = G (color, value, 0);
	B (result, x, y) = B (color, value, 0);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convert-grey8-rgba.crimp.


























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convert_2rgba_grey8
Tcl_Obj* imageObj
Tcl_Obj* colorObj

crimp_image* image;
crimp_image* color;
crimp_image* result;
int          x, y, value;

/*
 * This conversion from greyscale to color (RGBA) is a general false-color
 * transformation, mapping each pixel value to an arbitrary color, through
 * a lookup table.
 *
 * Important: For the sake of convenience the color map is not provided as a
 * (Tcl) list (of values), or array, but as an _image_ itself, a 256x1 (WxH)
 * rgba. We will have constructors for such images.
 */

crimp_input (imageObj, image, grey8);
crimp_input (colorObj, color, rgba);

if (!crimp_require_dim (color, 256, 1)) {
    Tcl_SetResult(interp, "bad image dimension for color map, expected 256x1", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_rgba (image->w, image->h);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	value = GREY8 (image, x, y);
	R (result, x, y) = R (color, value, 0);
	G (result, x, y) = G (color, value, 0);
	B (result, x, y) = B (color, value, 0);
	A (result, x, y) = A (color, value, 0);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convert-hsv-rgb.crimp.











































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convert_2rgb_hsv
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y, r, g, b;

crimp_input (imageObj, image, hsv);

result = crimp_new_rgb (image->w, image->h);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	crimp_color_hsv_to_rgb (H (image, x, y),
				S (image, x, y),
				V (image, x, y),
				&r, &g, &b);

	R (result, x, y) = r;
	G (result, x, y) = g;
	B (result, x, y) = b;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convert-hsv-rgba.crimp.












































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convert_2rgba_hsv
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y, r, g, b;

crimp_input (imageObj, image, hsv);

result = crimp_new_rgba (image->w, image->h);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	crimp_color_hsv_to_rgb (H (image, x, y),
				S (image, x, y),
				V (image, x, y),
				&r, &g, &b);

	R (result, x, y) = r;
	G (result, x, y) = g;
	B (result, x, y) = b;
	A (result, x, y) = OPAQUE;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convert-rgb-grey8.crimp.

















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convert_2grey8_rgb
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, rgb);

result = crimp_new_grey8 (image->w, image->h);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	/*
	 * This conversion to a grey scale is based on the ITU-R 601-2 luma
	 * transform computing the "luminosity" of each pixel.
	 *
	 * Note: The factors for R, G, and B add up to 1000, which means that
	 * after the scaling division the result is in the range 0..255
	 * without requiring clamping.
	 */

	GREY8 (result, x, y) = 
	  (299 * R (image, x, y) +
	   587 * G (image, x, y) +
	   114 * B (image, x, y))/1000;

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convert-rgb-hsv.crimp.











































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convert_2hsv_rgb
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y, h, s, v;

crimp_input (imageObj, image, rgb);

result = crimp_new_hsv (image->w, image->h);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	crimp_color_rgb_to_hsv (R (image, x, y),
				G (image, x, y),
				B (image, x, y),
				&h, &s, &v);

	H (result, x, y) = h;
	S (result, x, y) = s;
	V (result, x, y) = v;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convert-rgba-grey8.crimp.

















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convert_2grey8_rgba
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, rgba);

result = crimp_new_grey8 (image->w, image->h);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	/*
	 * This conversion to a grey scale is based on the ITU-R 601-2 luma
	 * transform computing the "luminosity" of each pixel.
	 *
	 * Note: The factors for R, G, and B add up to 1000, which means that
	 * after the scaling division the result is in the range 0..255
	 * without requiring clamping.
	 */

	GREY8 (result, x, y) = 
	  (299 * R (image, x, y) +
	   587 * G (image, x, y) +
	   114 * B (image, x, y))/1000;

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convert-rgba-hsv.crimp.











































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convert_2hsv_rgba
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y, h, s, v;

crimp_input (imageObj, image, rgba);

result = crimp_new_hsv (image->w, image->h);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	crimp_color_rgb_to_hsv (R (image, x, y),
				G (image, x, y),
				B (image, x, y),
				&h, &s, &v);

	H (result, x, y) = h;
	S (result, x, y) = s;
	V (result, x, y) = v;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convert-rgba-rgb.crimp.











































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convert_2rgb_rgba
Tcl_Obj* imageObj

/*
 * RGBA --> RGB,
 * i.e. this operation removes the input image's alpha channel.
 */

crimp_image* image;
crimp_image* result;
int          x, y, h, s, v;

crimp_input (imageObj, image, rgba);

result = crimp_new_rgb (image->w, image->h);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	R (result, x, y) = R (image, x, y);
	G (result, x, y) = G (image, x, y);
	B (result, x, y) = B (image, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convolve-float-float.crimp.










































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convolve_float_float
Tcl_Obj* imageObj
Tcl_Obj* kernelImageObj
int scale
int offset

/*
 * Generic convolution operator. The kernel to convole with is specified as a
 * floating-point image together with a scaling factor. This way we do not
 * need a separate matrix Tcl_ObjType.
 *
 * This convolver should be used only for small kernels, as it uses direct
 * convolution. For larger kernels it is planned to provide an FFT based
 * convolver.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, xk, yk, dx, dy, kw, kh;

crimp_input (imageObj,         image,    float);
crimp_input (kernelImageObj,   kernel,   float);

if (((kernel->w % 2) == 0) ||
    ((kernel->h % 2) == 0)) {
    Tcl_SetResult(interp, "bad kernel dimensions, expected odd size", TCL_STATIC);
    return TCL_ERROR;
}

kw = kernel->w/2;
kh = kernel->h/2;

result = crimp_new (image->itype, image->w - 2*kw, image->h - 2*kh);

for (yo = 0, yi = kh; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = kw; xo < result->w; xo++, xi++) {

	/*
	 * We convolve all channels with the same kernel, but otherwise
	 * identically
	 */

	double sum = 0;

	for (yk = 0, dy = -kh; yk < kernel->h; yk++, dy++) {
	    for (xk = 0, dx = -kw; xk < kernel->w; xk++, dx++) {

		sum += FLOATP (kernel, xk, yk) * FLOATP (image, xi-dx, yi-dy);
	    }
	}

	sum /= scale; sum += offset; FLOATP (result, xo, yo) = sum;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convolve-float-grey16.crimp.












































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convolve_float_grey16
Tcl_Obj* imageObj
Tcl_Obj* kernelImageObj
int scale
int offset

/*
 * Generic convolution operator. The kernel to convole with is specified as a
 * floating-point image together with a scaling factor. This way we do not
 * need a separate matrix Tcl_ObjType.
 *
 * This convolver should be used only for small kernels, as it uses direct
 * convolution. For larger kernels it is planned to provide an FFT based
 * convolver.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, xk, yk, dx, dy, kw, kh;

crimp_input (imageObj,         image,    grey16);
crimp_input (kernelImageObj,   kernel,   float);

if (((kernel->w % 2) == 0) ||
    ((kernel->h % 2) == 0)) {
    Tcl_SetResult(interp, "bad kernel dimensions, expected odd size", TCL_STATIC);
    return TCL_ERROR;
}

kw = kernel->w/2;
kh = kernel->h/2;

result = crimp_new (image->itype, image->w - 2*kw, image->h - 2*kh);

for (yo = 0, yi = kh; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = kw; xo < result->w; xo++, xi++) {

	/*
	 * We convolve all channels with the same kernel, but otherwise
	 * identically
	 */

	double sum = 0;
	int    isum;

	for (yk = 0, dy = -kh; yk < kernel->h; yk++, dy++) {
	    for (xk = 0, dx = -kw; xk < kernel->w; xk++, dx++) {

		sum += FLOATP (kernel, xk, yk) * GREY16 (image, xi-dx, yi-dy);
	    }
	}

	sum /= scale; sum += offset; isum = sum;
	GREY16 (result, xo, yo) = CLAMP (0, isum, 255);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convolve-float-grey32.crimp.












































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convolve_float_grey32
Tcl_Obj* imageObj
Tcl_Obj* kernelImageObj
int scale
int offset

/*
 * Generic convolution operator. The kernel to convole with is specified as a
 * floating-point image together with a scaling factor. This way we do not
 * need a separate matrix Tcl_ObjType.
 *
 * This convolver should be used only for small kernels, as it uses direct
 * convolution. For larger kernels it is planned to provide an FFT based
 * convolver.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, xk, yk, dx, dy, kw, kh;

crimp_input (imageObj,         image,    grey32);
crimp_input (kernelImageObj,   kernel,   float);

if (((kernel->w % 2) == 0) ||
    ((kernel->h % 2) == 0)) {
    Tcl_SetResult(interp, "bad kernel dimensions, expected odd size", TCL_STATIC);
    return TCL_ERROR;
}

kw = kernel->w/2;
kh = kernel->h/2;

result = crimp_new (image->itype, image->w - 2*kw, image->h - 2*kh);

for (yo = 0, yi = kh; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = kw; xo < result->w; xo++, xi++) {

	/*
	 * We convolve all channels with the same kernel, but otherwise
	 * identically
	 */

	double sum = 0;
	int    isum;

	for (yk = 0, dy = -kh; yk < kernel->h; yk++, dy++) {
	    for (xk = 0, dx = -kw; xk < kernel->w; xk++, dx++) {

		sum += FLOATP (kernel, xk, yk) * GREY32 (image, xi-dx, yi-dy);
	    }
	}

	sum /= scale; sum += offset; isum = sum;
	GREY32 (result, xo, yo) = CLAMP (0, isum, 255);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convolve-float-grey8.crimp.












































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convolve_float_grey8
Tcl_Obj* imageObj
Tcl_Obj* kernelImageObj
int scale
int offset

/*
 * Generic convolution operator. The kernel to convole with is specified as a
 * floating-point image together with a scaling factor. This way we do not
 * need a separate matrix Tcl_ObjType.
 *
 * This convolver should be used only for small kernels, as it uses direct
 * convolution. For larger kernels it is planned to provide an FFT based
 * convolver.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, xk, yk, dx, dy, kw, kh;

crimp_input (imageObj,         image,    grey8);
crimp_input (kernelImageObj,   kernel,   float);

if (((kernel->w % 2) == 0) ||
    ((kernel->h % 2) == 0)) {
    Tcl_SetResult(interp, "bad kernel dimensions, expected odd size", TCL_STATIC);
    return TCL_ERROR;
}

kw = kernel->w/2;
kh = kernel->h/2;

result = crimp_new (image->itype, image->w - 2*kw, image->h - 2*kh);

for (yo = 0, yi = kh; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = kw; xo < result->w; xo++, xi++) {

	/*
	 * We convolve all channels with the same kernel, but otherwise
	 * identically
	 */

	double sum = 0;
	int    isum;

	for (yk = 0, dy = -kh; yk < kernel->h; yk++, dy++) {
	    for (xk = 0, dx = -kw; xk < kernel->w; xk++, dx++) {

		sum += FLOATP (kernel, xk, yk) * GREY8 (image, xi-dx, yi-dy);
	    }
	}

	sum /= scale; sum += offset; isum = sum;
	GREY8 (result, xo, yo) = CLAMP (0, isum, 255);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convolve-float-hsv.crimp.
















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convolve_float_hsv
Tcl_Obj* imageObj
Tcl_Obj* kernelImageObj
int scale
int offset

/*
 * Generic convolution operator. The kernel to convole with is specified as a
 * floating-point image together with a scaling factor. This way we do not
 * need a separate matrix Tcl_ObjType.
 *
 * This convolver should be used only for small kernels, as it uses direct
 * convolution. For larger kernels it is planned to provide an FFT based
 * convolver.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, xk, yk, dx, dy, kw, kh;

crimp_input (imageObj,         image,    hsv);
crimp_input (kernelImageObj,   kernel,   float);

if (((kernel->w % 2) == 0) ||
    ((kernel->h % 2) == 0)) {
    Tcl_SetResult(interp, "bad kernel dimensions, expected odd size", TCL_STATIC);
    return TCL_ERROR;
}

kw = kernel->w/2;
kh = kernel->h/2;

result = crimp_new (image->itype, image->w - 2*kw, image->h - 2*kh);

for (yo = 0, yi = kh; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = kw; xo < result->w; xo++, xi++) {

	/*
	 * We convolve all channels with the same kernel, but otherwise
	 * identically
	 */

	double sumh = 0; int isumh;
	double sums = 0; int isums;
	double sumv = 0; int isumv;

	for (yk = 0, dy = -kh; yk < kernel->h; yk++, dy++) {
	    for (xk = 0, dx = -kw; xk < kernel->w; xk++, dx++) {

		sumh += FLOATP (kernel, xk, yk) * H (image, xi-dx, yi-dy);
		sums += FLOATP (kernel, xk, yk) * S (image, xi-dx, yi-dy);
		sumv += FLOATP (kernel, xk, yk) * V (image, xi-dx, yi-dy);
	    }
	}

	sumh /= scale; sumh += offset; isumh = sumh; H (result, xo, yo) = CLAMP (0, isumh, 255);
	sums /= scale; sums += offset; isums = sums; S (result, xo, yo) = CLAMP (0, isums, 255);
	sumv /= scale; sumv += offset; isumv = sumv; V (result, xo, yo) = CLAMP (0, isumv, 255);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convolve-float-rgb.crimp.
















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convolve_float_rgb
Tcl_Obj* imageObj
Tcl_Obj* kernelImageObj
int scale
int offset

/*
 * Generic convolution operator. The kernel to convole with is specified as a
 * floating-point image together with a scaling factor. This way we do not
 * need a separate matrix Tcl_ObjType.
 *
 * This convolver should be used only for small kernels, as it uses direct
 * convolution. For larger kernels it is planned to provide an FFT based
 * convolver.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, xk, yk, dx, dy, kw, kh;

crimp_input (imageObj,         image,    rgb);
crimp_input (kernelImageObj,   kernel,   float);

if (((kernel->w % 2) == 0) ||
    ((kernel->h % 2) == 0)) {
    Tcl_SetResult(interp, "bad kernel dimensions, expected odd size", TCL_STATIC);
    return TCL_ERROR;
}

kw = kernel->w/2;
kh = kernel->h/2;

result = crimp_new (image->itype, image->w - 2*kw, image->h - 2*kh);

for (yo = 0, yi = kh; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = kw; xo < result->w; xo++, xi++) {

	/*
	 * We convolve all channels with the same kernel, but otherwise
	 * identically
	 */

	double sumr = 0; int isumr;
	double sumg = 0; int isumg;
	double sumb = 0; int isumb;

	for (yk = 0, dy = -kh; yk < kernel->h; yk++, dy++) {
	    for (xk = 0, dx = -kw; xk < kernel->w; xk++, dx++) {

		sumr += FLOATP (kernel, xk, yk) * R (image, xi-dx, yi-dy);
		sumg += FLOATP (kernel, xk, yk) * G (image, xi-dx, yi-dy);
		sumb += FLOATP (kernel, xk, yk) * B (image, xi-dx, yi-dy);
	    }
	}

	sumr /= scale; sumr += offset; isumr = sumr; R (result, xo, yo) = CLAMP (0, isumr, 255);
	sumg /= scale; sumg += offset; isumg = sumg; G (result, xo, yo) = CLAMP (0, isumg, 255);
	sumb /= scale; sumb += offset; isumb = sumb; B (result, xo, yo) = CLAMP (0, isumb, 255);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convolve-float-rgba.crimp.



















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convolve_float_rgba
Tcl_Obj* imageObj
Tcl_Obj* kernelImageObj
int scale
int offset

/*
 * Generic convolution operator. The kernel to convole with is specified as a
 * floating-point image together with a scaling factor. This way we do not need a
 * separate matrix Tcl_ObjType, nor floating point math.
 *
 * This convolver should be used only for small kernels, as it uses direct
 * convolution. For larger kernels it is planned to provide an FFT based
 * convolver.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, xk, yk, dx, dy, kw, kh;

crimp_input (imageObj,         image,    rgba);
crimp_input (kernelImageObj,   kernel,   float);

if (((kernel->w % 2) == 0) ||
    ((kernel->h % 2) == 0)) {
    Tcl_SetResult(interp, "bad kernel dimensions, expected odd size", TCL_STATIC);
    return TCL_ERROR;
}

kw = kernel->w/2;
kh = kernel->h/2;

result = crimp_new (image->itype, image->w - 2*kw, image->h - 2*kh);

for (yo = 0, yi = kh; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = kw; xo < result->w; xo++, xi++) {

	/*
	 * We convolve all channels with the same kernel, but otherwise
	 * identically
	 */

	double sumr = 0; int isumr;
	double sumg = 0; int isumg;
	double sumb = 0; int isumb;
	double suma = 0; int isuma;

	for (yk = 0, dy = -kh; yk < kernel->h; yk++, dy++) {
	    for (xk = 0, dx = -kw; xk < kernel->w; xk++, dx++) {

		sumr += FLOATP (kernel, xk, yk) * R (image, xi-dx, yi-dy);
		sumg += FLOATP (kernel, xk, yk) * G (image, xi-dx, yi-dy);
		sumb += FLOATP (kernel, xk, yk) * B (image, xi-dx, yi-dy);
		suma += FLOATP (kernel, xk, yk) * A (image, xi-dx, yi-dy);
	    }
	}

	sumr /= scale; sumr += offset; isumr = sumr; R (result, xo, yo) = CLAMP (0, isumr, 255);
	sumg /= scale; sumg += offset; isumg = sumg; G (result, xo, yo) = CLAMP (0, isumg, 255);
	sumb /= scale; sumb += offset; isumb = sumb; B (result, xo, yo) = CLAMP (0, isumb, 255);
	suma /= scale; suma += offset; isuma = suma; A (result, xo, yo) = CLAMP (0, isuma, 255);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convolve-sgrey8-float.crimp.










































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convolve_grey8_float
Tcl_Obj* imageObj
Tcl_Obj* kernelImageObj
int scale
int offset

/*
 * Generic convolution operator. The kernel to convole with is specified as a
 * grey8 image together with a scaling factor. This way we do not need a
 * separate matrix Tcl_ObjType, nor floating point math.
 *
 * This convolver should be used only for small kernels, as it uses direct
 * convolution. For larger kernels it is planned to provide an FFT based
 * convolver.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, xk, yk, dx, dy, kw, kh;

crimp_input (imageObj,         image,    float);
crimp_input (kernelImageObj,   kernel,   grey8);

if (((kernel->w % 2) == 0) ||
    ((kernel->h % 2) == 0)) {
    Tcl_SetResult(interp, "bad kernel dimensions, expected odd size", TCL_STATIC);
    return TCL_ERROR;
}

kw = kernel->w/2;
kh = kernel->h/2;

result = crimp_new (image->itype, image->w - 2*kw, image->h - 2*kh);

for (yo = 0, yi = kh; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = kw; xo < result->w; xo++, xi++) {

	/*
	 * We convolve all channels with the same kernel, but otherwise
	 * identically
	 */

	int sum = 0;

	for (yk = 0, dy = -kh; yk < kernel->h; yk++, dy++) {
	    for (xk = 0, dx = -kw; xk < kernel->w; xk++, dx++) {

		sum += SGREY8 (kernel, xk, yk) * FLOATP (image, xi-dx, yi-dy);
	    }
	}

	FLOATP (result, xo, yo) = offset + sum/scale;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convolve-sgrey8-grey16.crimp.










































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convolve_grey8_grey16
Tcl_Obj* imageObj
Tcl_Obj* kernelImageObj
int scale
int offset

/*
 * Generic convolution operator. The kernel to convole with is specified as a
 * grey8 image together with a scaling factor. This way we do not need a
 * separate matrix Tcl_ObjType, nor floating point math.
 *
 * This convolver should be used only for small kernels, as it uses direct
 * convolution. For larger kernels it is planned to provide an FFT based
 * convolver.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, xk, yk, dx, dy, kw, kh;

crimp_input (imageObj,         image,    grey16);
crimp_input (kernelImageObj,   kernel,   grey8);

if (((kernel->w % 2) == 0) ||
    ((kernel->h % 2) == 0)) {
    Tcl_SetResult(interp, "bad kernel dimensions, expected odd size", TCL_STATIC);
    return TCL_ERROR;
}

kw = kernel->w/2;
kh = kernel->h/2;

result = crimp_new (image->itype, image->w - 2*kw, image->h - 2*kh);

for (yo = 0, yi = kh; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = kw; xo < result->w; xo++, xi++) {

	/*
	 * We convolve all channels with the same kernel, but otherwise
	 * identically
	 */

	int sum = 0;

	for (yk = 0, dy = -kh; yk < kernel->h; yk++, dy++) {
	    for (xk = 0, dx = -kw; xk < kernel->w; xk++, dx++) {

		sum += SGREY8 (kernel, xk, yk) * GREY16 (image, xi-dx, yi-dy);
	    }
	}

	sum /= scale; sum += offset; GREY16 (result, xo, yo) = CLAMP (0, sum, 255);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convolve-sgrey8-grey32.crimp.










































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convolve_grey8_grey32
Tcl_Obj* imageObj
Tcl_Obj* kernelImageObj
int scale
int offset

/*
 * Generic convolution operator. The kernel to convole with is specified as a
 * grey8 image together with a scaling factor. This way we do not need a
 * separate matrix Tcl_ObjType, nor floating point math.
 *
 * This convolver should be used only for small kernels, as it uses direct
 * convolution. For larger kernels it is planned to provide an FFT based
 * convolver.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, xk, yk, dx, dy, kw, kh;

crimp_input (imageObj,         image,    grey32);
crimp_input (kernelImageObj,   kernel,   grey8);

if (((kernel->w % 2) == 0) ||
    ((kernel->h % 2) == 0)) {
    Tcl_SetResult(interp, "bad kernel dimensions, expected odd size", TCL_STATIC);
    return TCL_ERROR;
}

kw = kernel->w/2;
kh = kernel->h/2;

result = crimp_new (image->itype, image->w - 2*kw, image->h - 2*kh);

for (yo = 0, yi = kh; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = kw; xo < result->w; xo++, xi++) {

	/*
	 * We convolve all channels with the same kernel, but otherwise
	 * identically
	 */

	int sum = 0;

	for (yk = 0, dy = -kh; yk < kernel->h; yk++, dy++) {
	    for (xk = 0, dx = -kw; xk < kernel->w; xk++, dx++) {

		sum += SGREY8 (kernel, xk, yk) * GREY32 (image, xi-dx, yi-dy);
	    }
	}

	sum /= scale; sum += offset; GREY32 (result, xo, yo) = CLAMP (0, sum, 255);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convolve-sgrey8-grey8.crimp.










































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convolve_grey8_grey8
Tcl_Obj* imageObj
Tcl_Obj* kernelImageObj
int scale
int offset

/*
 * Generic convolution operator. The kernel to convole with is specified as a
 * grey8 image together with a scaling factor. This way we do not need a
 * separate matrix Tcl_ObjType, nor floating point math.
 *
 * This convolver should be used only for small kernels, as it uses direct
 * convolution. For larger kernels it is planned to provide an FFT based
 * convolver.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, xk, yk, dx, dy, kw, kh;

crimp_input (imageObj,         image,    grey8);
crimp_input (kernelImageObj,   kernel,   grey8);

if (((kernel->w % 2) == 0) ||
    ((kernel->h % 2) == 0)) {
    Tcl_SetResult(interp, "bad kernel dimensions, expected odd size", TCL_STATIC);
    return TCL_ERROR;
}

kw = kernel->w/2;
kh = kernel->h/2;

result = crimp_new (image->itype, image->w - 2*kw, image->h - 2*kh);

for (yo = 0, yi = kh; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = kw; xo < result->w; xo++, xi++) {

	/*
	 * We convolve all channels with the same kernel, but otherwise
	 * identically
	 */

	int sum = 0;

	for (yk = 0, dy = -kh; yk < kernel->h; yk++, dy++) {
	    for (xk = 0, dx = -kw; xk < kernel->w; xk++, dx++) {

		sum += SGREY8 (kernel, xk, yk) * GREY8 (image, xi-dx, yi-dy);
	    }
	}

	sum /= scale; sum += offset; GREY8 (result, xo, yo) = CLAMP (0, sum, 255);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convolve-sgrey8-hsv.crimp.
















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convolve_grey8_hsv
Tcl_Obj* imageObj
Tcl_Obj* kernelImageObj
int scale
int offset

/*
 * Generic convolution operator. The kernel to convole with is specified as a
 * grey8 image together with a scaling factor. This way we do not need a
 * separate matrix Tcl_ObjType, nor floating point math.
 *
 * This convolver should be used only for small kernels, as it uses direct
 * convolution. For larger kernels it is planned to provide an FFT based
 * convolver.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, xk, yk, dx, dy, kw, kh;

crimp_input (imageObj,         image,    hsv);
crimp_input (kernelImageObj,   kernel,   grey8);

if (((kernel->w % 2) == 0) ||
    ((kernel->h % 2) == 0)) {
    Tcl_SetResult(interp, "bad kernel dimensions, expected odd size", TCL_STATIC);
    return TCL_ERROR;
}

kw = kernel->w/2;
kh = kernel->h/2;

result = crimp_new (image->itype, image->w - 2*kw, image->h - 2*kh);

for (yo = 0, yi = kh; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = kw; xo < result->w; xo++, xi++) {

	/*
	 * We convolve all channels with the same kernel, but otherwise
	 * identically
	 */

	int sumh = 0;
	int sums = 0;
	int sumv = 0;

	for (yk = 0, dy = -kh; yk < kernel->h; yk++, dy++) {
	    for (xk = 0, dx = -kw; xk < kernel->w; xk++, dx++) {

		sumh += SGREY8 (kernel, xk, yk) * H (image, xi-dx, yi-dy);
		sums += SGREY8 (kernel, xk, yk) * S (image, xi-dx, yi-dy);
		sumv += SGREY8 (kernel, xk, yk) * V (image, xi-dx, yi-dy);
	    }
	}

	sumh /= scale; sumh += offset; H (result, xo, yo) = CLAMP (0, sumh, 255);
	sums /= scale; sums += offset; S (result, xo, yo) = CLAMP (0, sums, 255);
	sumv /= scale; sumv += offset; V (result, xo, yo) = CLAMP (0, sumv, 255);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convolve-sgrey8-rgb.crimp.
















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convolve_grey8_rgb
Tcl_Obj* imageObj
Tcl_Obj* kernelImageObj
int scale
int offset

/*
 * Generic convolution operator. The kernel to convole with is specified as a
 * grey8 image together with a scaling factor. This way we do not need a
 * separate matrix Tcl_ObjType, nor floating point math.
 *
 * This convolver should be used only for small kernels, as it uses direct
 * convolution. For larger kernels it is planned to provide an FFT based
 * convolver.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, xk, yk, dx, dy, kw, kh;

crimp_input (imageObj,         image,    rgb);
crimp_input (kernelImageObj,   kernel,   grey8);

if (((kernel->w % 2) == 0) ||
    ((kernel->h % 2) == 0)) {
    Tcl_SetResult(interp, "bad kernel dimensions, expected odd size", TCL_STATIC);
    return TCL_ERROR;
}

kw = kernel->w/2;
kh = kernel->h/2;

result = crimp_new (image->itype, image->w - 2*kw, image->h - 2*kh);

for (yo = 0, yi = kh; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = kw; xo < result->w; xo++, xi++) {

	/*
	 * We convolve all channels with the same kernel, but otherwise
	 * identically
	 */

	int sumr = 0;
	int sumg = 0;
	int sumb = 0;

	for (yk = 0, dy = -kh; yk < kernel->h; yk++, dy++) {
	    for (xk = 0, dx = -kw; xk < kernel->w; xk++, dx++) {

		sumr += SGREY8 (kernel, xk, yk) * R (image, xi-dx, yi-dy);
		sumg += SGREY8 (kernel, xk, yk) * G (image, xi-dx, yi-dy);
		sumb += SGREY8 (kernel, xk, yk) * B (image, xi-dx, yi-dy);
	    }
	}

	sumr /= scale; sumr += offset; R (result, xo, yo) = CLAMP (0, sumr, 255);
	sumg /= scale; sumg += offset; G (result, xo, yo) = CLAMP (0, sumg, 255);
	sumb /= scale; sumb += offset; B (result, xo, yo) = CLAMP (0, sumb, 255);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/convolve-sgrey8-rgba.crimp.



















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

convolve_grey8_rgba
Tcl_Obj* imageObj
Tcl_Obj* kernelImageObj
int scale
int offset

/*
 * Generic convolution operator. The kernel to convole with is specified as a
 * grey8 image together with a scaling factor. This way we do not need a
 * separate matrix Tcl_ObjType, nor floating point math.
 *
 * This convolver should be used only for small kernels, as it uses direct
 * convolution. For larger kernels it is planned to provide an FFT based
 * convolver.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, xk, yk, dx, dy, kw, kh;

crimp_input (imageObj,         image,    rgba);
crimp_input (kernelImageObj,   kernel,   grey8);

if (((kernel->w % 2) == 0) ||
    ((kernel->h % 2) == 0)) {
    Tcl_SetResult(interp, "bad kernel dimensions, expected odd size", TCL_STATIC);
    return TCL_ERROR;
}

kw = kernel->w/2;
kh = kernel->h/2;

result = crimp_new (image->itype, image->w - 2*kw, image->h - 2*kh);

for (yo = 0, yi = kh; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = kw; xo < result->w; xo++, xi++) {

	/*
	 * We convolve all channels with the same kernel, but otherwise
	 * identically
	 */

	int sumr = 0;
	int sumg = 0;
	int sumb = 0;
	int suma = 0;

	for (yk = 0, dy = -kh; yk < kernel->h; yk++, dy++) {
	    for (xk = 0, dx = -kw; xk < kernel->w; xk++, dx++) {

		sumr += SGREY8 (kernel, xk, yk) * R (image, xi-dx, yi-dy);
		sumg += SGREY8 (kernel, xk, yk) * G (image, xi-dx, yi-dy);
		sumb += SGREY8 (kernel, xk, yk) * B (image, xi-dx, yi-dy);
		suma += SGREY8 (kernel, xk, yk) * A (image, xi-dx, yi-dy);
	    }
	}

	sumr /= scale; sumr += offset; R (result, xo, yo) = CLAMP (0, sumr, 255);
	sumg /= scale; sumg += offset; G (result, xo, yo) = CLAMP (0, sumg, 255);
	sumb /= scale; sumb += offset; B (result, xo, yo) = CLAMP (0, sumb, 255);
	suma /= scale; suma += offset; A (result, xo, yo) = CLAMP (0, suma, 255);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/crop-float.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crop_float
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border cropping.
 */

crimp_image* image;
crimp_image* result;
int          xo, yo, xi, yi;

crimp_input (imageObj, image, float);

if ((ww < 0) || (hn < 0) || (we < 0) || (hs < 0)) {
    Tcl_SetResult(interp, "bad image border size, expected non-negative values", TCL_STATIC);
    return TCL_ERROR;
} else if (((ww + we) > image->w) || ((hn + hs) > image->h)) {
    Tcl_SetResult(interp, "bad image border size, larger than image dimensions", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new (image->itype, image->w - ww - we, image->h - hn - hs);

/*
 * Copy the un-cropped part of the input image.
 */

for (yo = 0, yi = hn; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = ww; xo < result->w; xo++, xi++) {
	FLOATP (result, xo, yo) = FLOATP (image, xi, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/crop-grey16.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crop_grey16
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border cropping.
 */

crimp_image* image;
crimp_image* result;
int          xo, yo, xi, yi;

crimp_input (imageObj, image, grey16);

if ((ww < 0) || (hn < 0) || (we < 0) || (hs < 0)) {
    Tcl_SetResult(interp, "bad image border size, expected non-negative values", TCL_STATIC);
    return TCL_ERROR;
} else if (((ww + we) > image->w) || ((hn + hs) > image->h)) {
    Tcl_SetResult(interp, "bad image border size, larger than image dimensions", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new (image->itype, image->w - ww - we, image->h - hn - hs);

/*
 * Copy the un-cropped part of the input image.
 */

for (yo = 0, yi = hn; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = ww; xo < result->w; xo++, xi++) {
	GREY16 (result, xo, yo) = GREY16 (image, xi, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/crop-grey32.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crop_grey32
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border cropping.
 */

crimp_image* image;
crimp_image* result;
int          xo, yo, xi, yi;

crimp_input (imageObj, image, grey32);

if ((ww < 0) || (hn < 0) || (we < 0) || (hs < 0)) {
    Tcl_SetResult(interp, "bad image border size, expected non-negative values", TCL_STATIC);
    return TCL_ERROR;
} else if (((ww + we) > image->w) || ((hn + hs) > image->h)) {
    Tcl_SetResult(interp, "bad image border size, larger than image dimensions", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new (image->itype, image->w - ww - we, image->h - hn - hs);

/*
 * Copy the un-cropped part of the input image.
 */

for (yo = 0, yi = hn; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = ww; xo < result->w; xo++, xi++) {
	GREY32 (result, xo, yo) = GREY32 (image, xi, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/crop-grey8.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crop_grey8
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border cropping.
 */

crimp_image* image;
crimp_image* result;
int          xo, yo, xi, yi;

crimp_input (imageObj, image, grey8);

if ((ww < 0) || (hn < 0) || (we < 0) || (hs < 0)) {
    Tcl_SetResult(interp, "bad image border size, expected non-negative values", TCL_STATIC);
    return TCL_ERROR;
} else if (((ww + we) > image->w) || ((hn + hs) > image->h)) {
    Tcl_SetResult(interp, "bad image border size, larger than image dimensions", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new (image->itype, image->w - ww - we, image->h - hn - hs);

/*
 * Copy the un-cropped part of the input image.
 */

for (yo = 0, yi = hn; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = ww; xo < result->w; xo++, xi++) {
	GREY8 (result, xo, yo) = GREY8 (image, xi, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/crop-hsv.crimp.
























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crop_hsv
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border cropping.
 */

crimp_image* image;
crimp_image* result;
int          xo, yo, xi, yi;

crimp_input (imageObj, image, hsv);

if ((ww < 0) || (hn < 0) || (we < 0) || (hs < 0)) {
    Tcl_SetResult(interp, "bad image border size, expected non-negative values", TCL_STATIC);
    return TCL_ERROR;
} else if (((ww + we) > image->w) || ((hn + hs) > image->h)) {
    Tcl_SetResult(interp, "bad image border size, larger than image dimensions", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new (image->itype, image->w - ww - we, image->h - hn - hs);

/*
 * Copy the un-cropped part of the input image.
 */

for (yo = 0, yi = hn; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = ww; xo < result->w; xo++, xi++) {
	H (result, xo, yo) = H (image, xi, yi);
	S (result, xo, yo) = S (image, xi, yi);
	V (result, xo, yo) = V (image, xi, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/crop-rgb.crimp.
























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crop_rgb
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border cropping.
 */

crimp_image* image;
crimp_image* result;
int          xo, yo, xi, yi;

crimp_input (imageObj, image, rgb);

if ((ww < 0) || (hn < 0) || (we < 0) || (hs < 0)) {
    Tcl_SetResult(interp, "bad image border size, expected non-negative values", TCL_STATIC);
    return TCL_ERROR;
} else if (((ww + we) > image->w) || ((hn + hs) > image->h)) {
    Tcl_SetResult(interp, "bad image border size, larger than image dimensions", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new (image->itype, image->w - ww - we, image->h - hn - hs);

/*
 * Copy the un-cropped part of the input image.
 */

for (yo = 0, yi = hn; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = ww; xo < result->w; xo++, xi++) {
	R (result, xo, yo) = R (image, xi, yi);
	G (result, xo, yo) = G (image, xi, yi);
	B (result, xo, yo) = B (image, xi, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/crop-rgba.crimp.

























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

crop_rgba
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border cropping.
 */

crimp_image* image;
crimp_image* result;
int          xo, yo, xi, yi;

crimp_input (imageObj, image, rgba);

if ((ww < 0) || (hn < 0) || (we < 0) || (hs < 0)) {
    Tcl_SetResult(interp, "bad image border size, expected non-negative values", TCL_STATIC);
    return TCL_ERROR;
} else if (((ww + we) > image->w) || ((hn + hs) > image->h)) {
    Tcl_SetResult(interp, "bad image border size, larger than image dimensions", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new (image->itype, image->w - ww - we, image->h - hn - hs);

/*
 * Copy the un-cropped part of the input image.
 */

for (yo = 0, yi = hn; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = ww; xo < result->w; xo++, xi++) {
	R (result, xo, yo) = R (image, xi, yi);
	G (result, xo, yo) = G (image, xi, yi);
	B (result, xo, yo) = B (image, xi, yi);
	A (result, xo, yo) = A (image, xi, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/difference-float-float.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

difference_float_float
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise absolute difference of two images. The images have
 * to have equal dimensions.
 */

#define BINOP(a,b) (fabs((a) - (b)))
#include "binop_float_float.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/difference-float-grey16.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

difference_float_grey16
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise absolute difference of two images. The images have
 * to have equal dimensions.
 */

#define BINOP(a,b) (fabs((a) - (b)))
#include "binop_float_grey16.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/difference-float-grey32.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

difference_float_grey32
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise absolute difference of two images. The images have
 * to have equal dimensions.
 */

#define BINOP(a,b) (fabs((a) - (b)))
#include "binop_float_grey32.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/difference-float-grey8.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

difference_float_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise absolute difference of two images. The images have
 * to have equal dimensions.
 */

#define BINOP(a,b) (fabs((a) - (b)))
#include "binop_float_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/difference-grey8-grey8.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

difference_grey8_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise absolute difference of two images. The images have
 * to have equal dimensions.
 */

#define BINOP(a,b) (abs((a) - (b)))
#include "binop_grey8_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/difference-rgb-grey8.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

difference_rgb_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise absolute difference of two images. The images have
 * to have equal dimensions.
 */

#define BINOP(a,b) (abs((a) - (b)))
#include "binop_rgb_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/difference-rgb-rgb.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

difference_rgb_rgb
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise absolute difference of two images. The images have
 * to have equal dimensions.
 */

#define BINOP(a,b) (abs((a) - (b)))
#include "binop_rgb_rgb.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/difference-rgba-grey8.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

difference_rgba_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise absolute difference of two images. The images have
 * to have equal dimensions.
 */

#define BINOP(a,b) (abs((a) - (b)))
#include "binop_rgba_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/difference-rgba-rgb.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

difference_rgba_rgb
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise absolute difference of two images. The images have
 * to have equal dimensions.
 */

#define BINOP(a,b) (abs((a) - (b)))
#include "binop_rgba_rgb.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/difference-rgba-rgba.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

difference_rgba_rgba
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise absolute difference of two images. The images have
 * to have equal dimensions.
 */

#define BINOP(a,b) (abs((a) - (b)))
#include "binop_rgba_rgba.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/dimensions.crimp.





























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

dimensions
Tcl_Obj* imageObj

crimp_image* image;
Tcl_Obj* list [2];

crimp_input_any (imageObj, image);

list [0] = Tcl_NewIntObj (image->w);
list [1] = Tcl_NewIntObj (image->h);

Tcl_SetObjResult (interp, Tcl_NewListObj (2, list));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/div-float-float.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

div_float_float
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
float scale
float offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) (((fabs(b) <= pow(2,-24) ? WHITE : ((a) / (b))) / scale) + offset)
#include "binop_float_float.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/div-float-grey16.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

div_float_grey16
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
float scale
float offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((b) == 0 ? WHITE : ((a) / (b))) / scale) + offset)
#include "binop_float_grey16.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/div-float-grey32.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

div_float_grey32
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
float scale
float offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((b) == 0 ? WHITE : ((a) / (b))) / scale) + offset)
#include "binop_float_grey32.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/div-float-grey8.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

div_float_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
float scale
float offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((b) == 0 ? WHITE : ((a) / (b))) / scale) + offset)
#include "binop_float_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/div-grey16-float.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

div_grey16_float
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
float scale
float offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) (((fabs(b) <= pow(2,-24) ? WHITE : ((a) / (b))) / scale) + offset)
#include "binop_grey16_float.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/div-grey32-float.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

div_grey32_float
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
float scale
float offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) (((fabs(b) <= pow(2,-24) ? WHITE : ((a) / (b))) / scale) + offset)
#include "binop_grey32_float.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/div-grey8-float.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

div_grey8_float
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
float scale
float offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) (((fabs(b) <= pow(2,-24) ? WHITE : ((a) / (b))) / scale) + offset)
#include "binop_grey8_float.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/div-grey8-grey8.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

div_grey8_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((b) == 0 ? WHITE : ((a) / (b))) / scale) + offset)
#include "binop_grey8_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/div-grey8-rgb.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

div_grey8_rgb
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((b) == 0 ? WHITE : ((a) / (b))) / scale) + offset)
#include "binop_grey8_rgb.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/div-grey8-rgba.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

div_grey8_rgba
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((b) == 0 ? WHITE : ((a) / (b))) / scale) + offset)
#include "binop_grey8_rgba.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/div-rgb-grey8.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

div_rgb_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((b) == 0 ? WHITE : ((a) / (b))) / scale) + offset)
#include "binop_rgb_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/div-rgb-rgb.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

div_rgb_rgb
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((b) == 0 ? WHITE : ((a) / (b))) / scale) + offset)
#include "binop_rgb_rgb.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/div-rgb-rgba.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

div_rgb_rgba
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((b) == 0 ? WHITE : ((a) / (b))) / scale) + offset)
#include "binop_rgb_rgba.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/div-rgba-grey8.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

div_rgba_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((b) == 0 ? WHITE : ((a) / (b))) / scale) + offset)
#include "binop_rgba_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/div-rgba-rgb.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

div_rgba_rgb
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((b) == 0 ? WHITE : ((a) / (b))) / scale) + offset)
#include "binop_rgba_rgb.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/div-rgba-rgba.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

div_rgba_rgba
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((b) == 0 ? WHITE : ((a) / (b))) / scale) + offset)
#include "binop_rgba_rgba.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/downsample-float.crimp.


























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

downsample_float
Tcl_Obj* imageObj
int      factor

/*
 * The input image is downsampled by storing only every 'factor' pixel into
 * the result. Note that this method of shrinking an image causes image
 * frequencies above the nyquist threshold of the result to be aliased into
 * the range.
 *
 * The input image has to be convolved with a low-pass filter first, to avoid
 * such artefacts. The integrated combination of such a filter with
 * downsampling is called 'decimation'. This is but one step in the generation
 * of image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, yo, xi, yi;

crimp_input (imageObj, image, float);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w/factor, image->h/factor);

for (yo = 0, yi = 0; yo < result->h; yo++, yi += factor) {
    for (xo = 0, xi = 0; xo < result->w; xo++, xi += factor) {

	FLOATP (result, xo, yo) = FLOATP (image, xi, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/downsample-grey16.crimp.


























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

downsample_grey16
Tcl_Obj* imageObj
int      factor

/*
 * The input image is downsampled by storing only every 'factor' pixel into
 * the result. Note that this method of shrinking an image causes image
 * frequencies above the nyquist threshold of the result to be aliased into
 * the range.
 *
 * The input image has to be convolved with a low-pass filter first, to avoid
 * such artefacts. The integrated combination of such a filter with
 * downsampling is called 'decimation'. This is but one step in the generation
 * of image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, yo, xi, yi;

crimp_input (imageObj, image, grey16);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w/factor, image->h/factor);

for (yo = 0, yi = 0; yo < result->h; yo++, yi += factor) {
    for (xo = 0, xi = 0; xo < result->w; xo++, xi += factor) {

	GREY16 (result, xo, yo) = GREY16 (image, xi, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/downsample-grey32.crimp.


























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

downsample_grey32
Tcl_Obj* imageObj
int      factor

/*
 * The input image is downsampled by storing only every 'factor' pixel into
 * the result. Note that this method of shrinking an image causes image
 * frequencies above the nyquist threshold of the result to be aliased into
 * the range.
 *
 * The input image has to be convolved with a low-pass filter first, to avoid
 * such artefacts. The integrated combination of such a filter with
 * downsampling is called 'decimation'. This is but one step in the generation
 * of image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, yo, xi, yi;

crimp_input (imageObj, image, grey32);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w/factor, image->h/factor);

for (yo = 0, yi = 0; yo < result->h; yo++, yi += factor) {
    for (xo = 0, xi = 0; xo < result->w; xo++, xi += factor) {

	GREY32 (result, xo, yo) = GREY32 (image, xi, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/downsample-grey8.crimp.


























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

downsample_grey8
Tcl_Obj* imageObj
int      factor

/*
 * The input image is downsampled by storing only every 'factor' pixel into
 * the result. Note that this method of shrinking an image causes image
 * frequencies above the nyquist threshold of the result to be aliased into
 * the range.
 *
 * The input image has to be convolved with a low-pass filter first, to avoid
 * such artefacts. The integrated combination of such a filter with
 * downsampling is called 'decimation'. This is but one step in the generation
 * of image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, yo, xi, yi;

crimp_input (imageObj, image, grey8);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w/factor, image->h/factor);

for (yo = 0, yi = 0; yo < result->h; yo++, yi += factor) {
    for (xo = 0, xi = 0; xo < result->w; xo++, xi += factor) {

	GREY8 (result, xo, yo) = GREY8 (image, xi, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/downsample-hsv.crimp.




























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

downsample_hsv
Tcl_Obj* imageObj
int      factor

/*
 * The input image is downsampled by storing only every 'factor' pixel into
 * the result. Note that this method of shrinking an image causes image
 * frequencies above the nyquist threshold of the result to be aliased into
 * the range.
 *
 * The input image has to be convolved with a low-pass filter first, to avoid
 * such artefacts. The integrated combination of such a filter with
 * downsampling is called 'decimation'. This is but one step in the generation
 * of image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, yo, xi, yi;

crimp_input (imageObj, image, hsv);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w/factor, image->h/factor);

for (yo = 0, yi = 0; yo < result->h; yo++, yi += factor) {
    for (xo = 0, xi = 0; xo < result->w; xo++, xi += factor) {

	H (result, xo, yo) = H (image, xi, yi);
	S (result, xo, yo) = S (image, xi, yi);
	V (result, xo, yo) = V (image, xi, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/downsample-rgb.crimp.




























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

downsample_rgb
Tcl_Obj* imageObj
int      factor

/*
 * The input image is downsampled by storing only every 'factor' pixel into
 * the result. Note that this method of shrinking an image causes image
 * frequencies above the nyquist threshold of the result to be aliased into
 * the range.
 *
 * The input image has to be convolved with a low-pass filter first, to avoid
 * such artefacts. The integrated combination of such a filter with
 * downsampling is called 'decimation'. This is but one step in the generation
 * of image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, yo, xi, yi;

crimp_input (imageObj, image, rgb);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w/factor, image->h/factor);

for (yo = 0, yi = 0; yo < result->h; yo++, yi += factor) {
    for (xo = 0, xi = 0; xo < result->w; xo++, xi += factor) {

	R (result, xo, yo) = R (image, xi, yi);
	G (result, xo, yo) = G (image, xi, yi);
	B (result, xo, yo) = B (image, xi, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/downsample-rgba.crimp.





























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

downsample_rgba
Tcl_Obj* imageObj
int      factor

/*
 * The input image is downsampled by storing only every 'factor' pixel into
 * the result. Note that this method of shrinking an image causes image
 * frequencies above the nyquist threshold of the result to be aliased into
 * the range.
 *
 * The input image has to be convolved with a low-pass filter first, to avoid
 * such artefacts. The integrated combination of such a filter with
 * downsampling is called 'decimation'. This is but one step in the generation
 * of image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, yo, xi, yi;

crimp_input (imageObj, image, rgba);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w/factor, image->h/factor);

for (yo = 0, yi = 0; yo < result->h; yo++, yi += factor) {
    for (xo = 0, xi = 0; xo < result->w; xo++, xi += factor) {

	R (result, xo, yo) = R (image, xi, yi);
	G (result, xo, yo) = G (image, xi, yi);
	B (result, xo, yo) = B (image, xi, yi);
	A (result, xo, yo) = A (image, xi, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/downsamplex-float.crimp.


























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

downsamplex_float
Tcl_Obj* imageObj
int      factor

/*
 * The input image is downsampled in the x direction by storing only every
 * 'factor' pixel into the result. Note that this method of shrinking an image
 * causes image frequencies above the nyquist threshold of the result to be
 * aliased into the range.
 *
 * The input image has to be convolved with a low-pass filter first, to avoid
 * such artefacts. The integrated combination of such a filter with
 * downsampling is called 'decimation'. This is but one step in the generation
 * of image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, y, xi;

crimp_input (imageObj, image, float);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w/factor, image->h);

for (y = 0; y < result->h; y++) {
    for (xo = 0, xi = 0; xo < result->w; xo++, xi += factor) {

	FLOATP (result, xo, y) = FLOATP (image, xi, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/downsamplex-grey16.crimp.


























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

downsamplex_grey16
Tcl_Obj* imageObj
int      factor

/*
 * The input image is downsampled in the x direction by storing only every
 * 'factor' pixel into the result. Note that this method of shrinking an image
 * causes image frequencies above the nyquist threshold of the result to be
 * aliased into the range.
 *
 * The input image has to be convolved with a low-pass filter first, to avoid
 * such artefacts. The integrated combination of such a filter with
 * downsampling is called 'decimation'. This is but one step in the generation
 * of image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, y, xi;

crimp_input (imageObj, image, grey16);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w/factor, image->h);

for (y = 0; y < result->h; y++) {
    for (xo = 0, xi = 0; xo < result->w; xo++, xi += factor) {

	GREY16 (result, xo, y) = GREY16 (image, xi, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/downsamplex-grey32.crimp.


























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

downsamplex_grey32
Tcl_Obj* imageObj
int      factor

/*
 * The input image is downsampled in the x direction by storing only every
 * 'factor' pixel into the result. Note that this method of shrinking an image
 * causes image frequencies above the nyquist threshold of the result to be
 * aliased into the range.
 *
 * The input image has to be convolved with a low-pass filter first, to avoid
 * such artefacts. The integrated combination of such a filter with
 * downsampling is called 'decimation'. This is but one step in the generation
 * of image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, y, xi;

crimp_input (imageObj, image, grey32);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w/factor, image->h);

for (y = 0; y < result->h; y++) {
    for (xo = 0, xi = 0; xo < result->w; xo++, xi += factor) {

	GREY32 (result, xo, y) = GREY32 (image, xi, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/downsamplex-grey8.crimp.


























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

downsamplex_grey8
Tcl_Obj* imageObj
int      factor

/*
 * The input image is downsampled in the x direction by storing only every
 * 'factor' pixel into the result. Note that this method of shrinking an image
 * causes image frequencies above the nyquist threshold of the result to be
 * aliased into the range.
 *
 * The input image has to be convolved with a low-pass filter first, to avoid
 * such artefacts. The integrated combination of such a filter with
 * downsampling is called 'decimation'. This is but one step in the generation
 * of image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, y, xi;

crimp_input (imageObj, image, grey8);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w/factor, image->h);

for (y = 0; y < result->h; y++) {
    for (xo = 0, xi = 0; xo < result->w; xo++, xi += factor) {

	GREY8 (result, xo, y) = GREY8 (image, xi, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/downsamplex-hsv.crimp.




























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

downsamplex_hsv
Tcl_Obj* imageObj
int      factor

/*
 * The input image is downsampled in the x direction by storing only every
 * 'factor' pixel into the result. Note that this method of shrinking an image
 * causes image frequencies above the nyquist threshold of the result to be
 * aliased into the range.
 *
 * The input image has to be convolved with a low-pass filter first, to avoid
 * such artefacts. The integrated combination of such a filter with
 * downsampling is called 'decimation'. This is but one step in the generation
 * of image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, y, xi;

crimp_input (imageObj, image, hsv);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w/factor, image->h);

for (y = 0; y < result->h; y++) {
    for (xo = 0, xi = 0; xo < result->w; xo++, xi += factor) {

	H (result, xo, y) = H (image, xi, y);
	S (result, xo, y) = S (image, xi, y);
	V (result, xo, y) = V (image, xi, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/downsamplex-rgb.crimp.




























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

downsamplex_rgb
Tcl_Obj* imageObj
int      factor

/*
 * The input image is downsampled in the x direction by storing only every
 * 'factor' pixel into the result. Note that this method of shrinking an image
 * causes image frequencies above the nyquist threshold of the result to be
 * aliased into the range.
 *
 * The input image has to be convolved with a low-pass filter first, to avoid
 * such artefacts. The integrated combination of such a filter with
 * downsampling is called 'decimation'. This is but one step in the generation
 * of image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, y, xi;

crimp_input (imageObj, image, rgb);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w/factor, image->h);

for (y = 0; y < result->h; y++) {
    for (xo = 0, xi = 0; xo < result->w; xo++, xi += factor) {

	R (result, xo, y) = R (image, xi, y);
	G (result, xo, y) = G (image, xi, y);
	B (result, xo, y) = B (image, xi, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/downsamplex-rgba.crimp.





























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

downsamplex_rgba
Tcl_Obj* imageObj
int      factor

/*
 * The input image is downsampled in the x direction by storing only every
 * 'factor' pixel into the result. Note that this method of shrinking an image
 * causes image frequencies above the nyquist threshold of the result to be
 * aliased into the range.
 *
 * The input image has to be convolved with a low-pass filter first, to avoid
 * such artefacts. The integrated combination of such a filter with
 * downsampling is called 'decimation'. This is but one step in the generation
 * of image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, y, xi;

crimp_input (imageObj, image, rgba);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w/factor, image->h);

for (y = 0; y < result->h; y++) {
    for (xo = 0, xi = 0; xo < result->w; xo++, xi += factor) {

	R (result, xo, y) = R (image, xi, y);
	G (result, xo, y) = G (image, xi, y);
	B (result, xo, y) = B (image, xi, y);
	A (result, xo, y) = A (image, xi, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/downsampley-float.crimp.


























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

downsampley_float
Tcl_Obj* imageObj
int      factor

/*
 * The input image is downsampled in the y direction by storing only every
 * 'factor' pixel into the result. Note that this method of shrinking an image
 * causes image frequencies above the nyquist threshold of the result to be
 * aliased into the range.
 *
 * The input image has to be convolved with a low-pass filter first, to avoid
 * such artefacts. The integrated combination of such a filter with
 * downsampling is called 'decimation'. This is but one step in the generation
 * of image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          x, yo, yi;

crimp_input (imageObj, image, float);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w, image->h/factor);

for (yo = 0, yi = 0; yo < result->h; yo++, yi += factor) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, yo) = FLOATP (image, x, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/downsampley-grey16.crimp.


























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

downsampley_grey16
Tcl_Obj* imageObj
int      factor

/*
 * The input image is downsampled in the y direction by storing only every
 * 'factor' pixel into the result. Note that this method of shrinking an image
 * causes image frequencies above the nyquist threshold of the result to be
 * aliased into the range.
 *
 * The input image has to be convolved with a low-pass filter first, to avoid
 * such artefacts. The integrated combination of such a filter with
 * downsampling is called 'decimation'. This is but one step in the generation
 * of image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          x, yo, yi;

crimp_input (imageObj, image, grey16);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w, image->h/factor);

for (yo = 0, yi = 0; yo < result->h; yo++, yi += factor) {
    for (x = 0; x < result->w; x++) {

	GREY16 (result, x, yo) = GREY16 (image, x, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/downsampley-grey32.crimp.


























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

downsampley_grey32
Tcl_Obj* imageObj
int      factor

/*
 * The input image is downsampled in the y direction by storing only every
 * 'factor' pixel into the result. Note that this method of shrinking an image
 * causes image frequencies above the nyquist threshold of the result to be
 * aliased into the range.
 *
 * The input image has to be convolved with a low-pass filter first, to avoid
 * such artefacts. The integrated combination of such a filter with
 * downsampling is called 'decimation'. This is but one step in the generation
 * of image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          x, yo, yi;

crimp_input (imageObj, image, grey32);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w, image->h/factor);

for (yo = 0, yi = 0; yo < result->h; yo++, yi += factor) {
    for (x = 0; x < result->w; x++) {

	GREY32 (result, x, yo) = GREY32 (image, x, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/downsampley-grey8.crimp.


























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

downsampley_grey8
Tcl_Obj* imageObj
int      factor

/*
 * The input image is downsampled in the y direction by storing only every
 * 'factor' pixel into the result. Note that this method of shrinking an image
 * causes image frequencies above the nyquist threshold of the result to be
 * aliased into the range.
 *
 * The input image has to be convolved with a low-pass filter first, to avoid
 * such artefacts. The integrated combination of such a filter with
 * downsampling is called 'decimation'. This is but one step in the generation
 * of image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          x, yo, yi;

crimp_input (imageObj, image, grey8);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w, image->h/factor);

for (yo = 0, yi = 0; yo < result->h; yo++, yi += factor) {
    for (x = 0; x < result->w; x++) {

	GREY8 (result, x, yo) = GREY8 (image, x, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/downsampley-hsv.crimp.




























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

downsampley_hsv
Tcl_Obj* imageObj
int      factor

/*
 * The input image is downsampled in the y direction by storing only every
 * 'factor' pixel into the result. Note that this method of shrinking an image
 * causes image frequencies above the nyquist threshold of the result to be
 * aliased into the range.
 *
 * The input image has to be convolved with a low-pass filter first, to avoid
 * such artefacts. The integrated combination of such a filter with
 * downsampling is called 'decimation'. This is but one step in the generation
 * of image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          x, yo, yi;

crimp_input (imageObj, image, hsv);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w, image->h/factor);

for (yo = 0, yi = 0; yo < result->h; yo++, yi += factor) {
    for (x = 0; x < result->w; x++) {

	H (result, x, yo) = H (image, x, yi);
	S (result, x, yo) = S (image, x, yi);
	V (result, x, yo) = V (image, x, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/downsampley-rgb.crimp.




























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

downsampley_rgb
Tcl_Obj* imageObj
int      factor

/*
 * The input image is downsampled by in the y direction storing only every
 * 'factor' pixel into the result. Note that this method of shrinking an image
 * causes image frequencies above the nyquist threshold of the result to be
 * aliased into the range.
 *
 * The input image has to be convolved with a low-pass filter first, to avoid
 * such artefacts. The integrated combination of such a filter with
 * downsampling is called 'decimation'. This is but one step in the generation
 * of image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          x, yo, yi;

crimp_input (imageObj, image, rgb);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w, image->h/factor);

for (yo = 0, yi = 0; yo < result->h; yo++, yi += factor) {
    for (x = 0; x < result->w; x++) {

	R (result, x, yo) = R (image, x, yi);
	G (result, x, yo) = G (image, x, yi);
	B (result, x, yo) = B (image, x, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/downsampley-rgba.crimp.





























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

downsampley_rgba
Tcl_Obj* imageObj
int      factor

/*
 * The input image is downsampled in the y direction by storing only every
 * 'factor' pixel into the result. Note that this method of shrinking an image
 * causes image frequencies above the nyquist threshold of the result to be
 * aliased into the range.
 *
 * The input image has to be convolved with a low-pass filter first, to avoid
 * such artefacts. The integrated combination of such a filter with
 * downsampling is called 'decimation'. This is but one step in the generation
 * of image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          x, yo, yi;

crimp_input (imageObj, image, rgba);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w, image->h/factor);

for (yo = 0, yi = 0; yo < result->h; yo++, yi += factor) {
    for (x = 0; x < result->w; x++) {

	R (result, x, yo) = R (image, x, yi);
	G (result, x, yo) = G (image, x, yi);
	B (result, x, yo) = B (image, x, yi);
	A (result, x, yo) = A (image, x, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/exp-float.crimp.








































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

exp_float
Tcl_Obj* imageObj

/*
 * exp() of all pixels of the image.
 */

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, float);

result = crimp_new_like (image);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = exp (FLOATP (image, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-float-const.crimp.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_float_const
Tcl_Obj* imageObj
int ww
int hn
int we
int hs
int value

/*
 * Border expansion by constant pixel value.
 */

crimp_image* image;
crimp_input (imageObj, image, float);

#define FILL(xo,yo) {			\
	FLOATP (result, xo, yo) = value; \
    }

#define COPY(xo,yo,xi,yi) {				\
	FLOATP (result, xo, yo) = FLOATP (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-float-extend.crimp.










































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_float_extend
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by subtracting mirrored pixels from the edge pixel, making
 * this a combination of mirror and replicate.
 */

crimp_image* image;
crimp_input (imageObj, image, float);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 *
 * NOTE: The replicate part can be optimized for the eight outer quadrants.
 */

#define FILL(xo,yo) {						   \
	int xb = xo - ww;					   \
	int yb = yo - hn;					   \
	int xi = xb;						   \
	int yi = yb;						   \
	int tg;							   \
								   \
	if      (xb < 0)         { xb = 0;            }		   \
	else if (xb >= image->w) { xb = (image->w-1); }		   \
								   \
	if      (yb < 0)         { yb = 0;            }		   \
	else if (yb >= image->h) { yb = (image->h-1); }		   \
								   \
	while (1) {						   \
	    if      (xi < 0)         { xi = 0              - xi; } \
	    else if (xi >= image->w) { xi = 2*(image->w-1) - xi; } \
	    else break;						   \
	}							   \
								   \
	while (1) {						   \
	    if      (yi < 0)         { yi = 0              - yi; } \
	    else if (yi >= image->h) { yi = 2*(image->h-1) - yi; } \
	    else break;						   \
	}							   \
								   \
	tg = FLOATP (image, xi, yi) - FLOATP (image, xb, yb);	   \
								   \
	FLOATP (result, xo, yo) = CLAMP (0, tg, 255);		   \
    }

#define COPY(xo,yo,xi,yi) {				\
	FLOATP (result, xo, yo) = FLOATP (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-float-mirror.crimp.




























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_float_mirror
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by mirroring along the edges, also called reflective
 * expansion.
 */

crimp_image* image;
crimp_input (imageObj, image, float);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 */

#define FILL(xo,yo) {						   \
	int xi = xo - ww;					   \
	int yi = yo - hn;					   \
	while (1) {						   \
	    if      (xi < 0)         { xi = 0              - xi; } \
	    else if (xi >= image->w) { xi = 2*(image->w-1) - xi; } \
	    else break;						   \
	}							   \
								   \
	while (1) {						   \
	    if      (yi < 0)         { yi = 0              - yi; } \
	    else if (yi >= image->h) { yi = 2*(image->h-1) - yi; } \
	    else break;						   \
	}							   \
								   \
	FLOATP (result, xo, yo) = FLOATP (image, xi, yi);		   \
    }

#define COPY(xo,yo,xi,yi) {			\
	FLOATP (result, xo, yo) = FLOATP (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-float-replicate.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_float_replicate
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by extending the edges, i.e. replicating the border
 * pixels.
 */

crimp_image* image;
crimp_input (imageObj, image, float);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 */

#define FILL(xo,yo) {					\
	int xi = xo - ww;				\
	int yi = yo - hn;				\
	if      (xi < 0)         { xi = 0;            } \
	else if (xi >= image->w) { xi = (image->w-1); } \
							\
	if      (yi < 0)         { yi = 0;            } \
	else if (yi >= image->h) { yi = (image->h-1); } \
							\
	FLOATP (result, xo, yo) = FLOATP (image, xi, yi);	\
    }

#define COPY(xo,yo,xi,yi) {				\
	FLOATP (result, xo, yo) = FLOATP (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-float-wrap.crimp.




















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_float_wrap
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by toroidal wrapping, also called cyclic expansion.
 */

crimp_image* image;
crimp_input (imageObj, image, float);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 */

#define FILL(xo,yo) {				\
	int xi = xo - ww;			\
	int yi = yo - hn;			\
	while (xi < 0) { xi += image->w; }	\
	while (yi < 0) { yi += image->h; }	\
	xi %= image->w;				\
	yi %= image->h;				\
						\
	FLOATP (result, xo, yo) = FLOATP (image, xi, yi); \
    }

#define COPY(xo,yo,xi,yi) {			\
	FLOATP (result, xo, yo) = FLOATP (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-grey16-const.crimp.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_grey16_const
Tcl_Obj* imageObj
int ww
int hn
int we
int hs
int value

/*
 * Border expansion by constant pixel value.
 */

crimp_image* image;
crimp_input (imageObj, image, grey16);

#define FILL(xo,yo) {			\
	GREY16 (result, xo, yo) = value; \
    }

#define COPY(xo,yo,xi,yi) {				\
	GREY16 (result, xo, yo) = GREY16 (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-grey16-extend.crimp.










































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_grey16_extend
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by subtracting mirrored pixels from the edge pixel, making
 * this a combination of mirror and replicate.
 */

crimp_image* image;
crimp_input (imageObj, image, grey16);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 *
 * NOTE: The replicate part can be optimized for the eight outer quadrants.
 */

#define FILL(xo,yo) {						   \
	int xb = xo - ww;					   \
	int yb = yo - hn;					   \
	int xi = xb;						   \
	int yi = yb;						   \
	int tg;							   \
								   \
	if      (xb < 0)         { xb = 0;            }		   \
	else if (xb >= image->w) { xb = (image->w-1); }		   \
								   \
	if      (yb < 0)         { yb = 0;            }		   \
	else if (yb >= image->h) { yb = (image->h-1); }		   \
								   \
	while (1) {						   \
	    if      (xi < 0)         { xi = 0              - xi; } \
	    else if (xi >= image->w) { xi = 2*(image->w-1) - xi; } \
	    else break;						   \
	}							   \
								   \
	while (1) {						   \
	    if      (yi < 0)         { yi = 0              - yi; } \
	    else if (yi >= image->h) { yi = 2*(image->h-1) - yi; } \
	    else break;						   \
	}							   \
								   \
	tg = GREY16 (image, xi, yi) - GREY16 (image, xb, yb);	   \
								   \
	GREY16 (result, xo, yo) = CLAMP (0, tg, 255);		   \
    }

#define COPY(xo,yo,xi,yi) {				\
	GREY16 (result, xo, yo) = GREY16 (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-grey16-mirror.crimp.




























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_grey16_mirror
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by mirroring along the edges, also called reflective
 * expansion.
 */

crimp_image* image;
crimp_input (imageObj, image, grey16);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 */

#define FILL(xo,yo) {						   \
	int xi = xo - ww;					   \
	int yi = yo - hn;					   \
	while (1) {						   \
	    if      (xi < 0)         { xi = 0              - xi; } \
	    else if (xi >= image->w) { xi = 2*(image->w-1) - xi; } \
	    else break;						   \
	}							   \
								   \
	while (1) {						   \
	    if      (yi < 0)         { yi = 0              - yi; } \
	    else if (yi >= image->h) { yi = 2*(image->h-1) - yi; } \
	    else break;						   \
	}							   \
								   \
	GREY16 (result, xo, yo) = GREY16 (image, xi, yi);		   \
    }

#define COPY(xo,yo,xi,yi) {			\
	GREY16 (result, xo, yo) = GREY16 (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-grey16-replicate.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_grey16_replicate
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by extending the edges, i.e. replicating the border
 * pixels.
 */

crimp_image* image;
crimp_input (imageObj, image, grey16);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 */

#define FILL(xo,yo) {					\
	int xi = xo - ww;				\
	int yi = yo - hn;				\
	if      (xi < 0)         { xi = 0;            } \
	else if (xi >= image->w) { xi = (image->w-1); } \
							\
	if      (yi < 0)         { yi = 0;            } \
	else if (yi >= image->h) { yi = (image->h-1); } \
							\
	GREY16 (result, xo, yo) = GREY16 (image, xi, yi);	\
    }

#define COPY(xo,yo,xi,yi) {				\
	GREY16 (result, xo, yo) = GREY16 (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-grey16-wrap.crimp.




















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_grey16_wrap
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by toroidal wrapping, also called cyclic expansion.
 */

crimp_image* image;
crimp_input (imageObj, image, grey16);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 */

#define FILL(xo,yo) {				\
	int xi = xo - ww;			\
	int yi = yo - hn;			\
	while (xi < 0) { xi += image->w; }	\
	while (yi < 0) { yi += image->h; }	\
	xi %= image->w;				\
	yi %= image->h;				\
						\
	GREY16 (result, xo, yo) = GREY16 (image, xi, yi); \
    }

#define COPY(xo,yo,xi,yi) {			\
	GREY16 (result, xo, yo) = GREY16 (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-grey32-const.crimp.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_grey32_const
Tcl_Obj* imageObj
int ww
int hn
int we
int hs
int value

/*
 * Border expansion by constant pixel value.
 */

crimp_image* image;
crimp_input (imageObj, image, grey32);

#define FILL(xo,yo) {			\
	GREY32 (result, xo, yo) = value; \
    }

#define COPY(xo,yo,xi,yi) {				\
	GREY32 (result, xo, yo) = GREY32 (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-grey32-extend.crimp.










































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_grey32_extend
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by subtracting mirrored pixels from the edge pixel, making
 * this a combination of mirror and replicate.
 */

crimp_image* image;
crimp_input (imageObj, image, grey32);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 *
 * NOTE: The replicate part can be optimized for the eight outer quadrants.
 */

#define FILL(xo,yo) {						   \
	int xb = xo - ww;					   \
	int yb = yo - hn;					   \
	int xi = xb;						   \
	int yi = yb;						   \
	int tg;							   \
								   \
	if      (xb < 0)         { xb = 0;            }		   \
	else if (xb >= image->w) { xb = (image->w-1); }		   \
								   \
	if      (yb < 0)         { yb = 0;            }		   \
	else if (yb >= image->h) { yb = (image->h-1); }		   \
								   \
	while (1) {						   \
	    if      (xi < 0)         { xi = 0              - xi; } \
	    else if (xi >= image->w) { xi = 2*(image->w-1) - xi; } \
	    else break;						   \
	}							   \
								   \
	while (1) {						   \
	    if      (yi < 0)         { yi = 0              - yi; } \
	    else if (yi >= image->h) { yi = 2*(image->h-1) - yi; } \
	    else break;						   \
	}							   \
								   \
	tg = GREY32 (image, xi, yi) - GREY32 (image, xb, yb);	   \
								   \
	GREY32 (result, xo, yo) = CLAMP (0, tg, 255);		   \
    }

#define COPY(xo,yo,xi,yi) {				\
	GREY32 (result, xo, yo) = GREY32 (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-grey32-mirror.crimp.




























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_grey32_mirror
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by mirroring along the edges, also called reflective
 * expansion.
 */

crimp_image* image;
crimp_input (imageObj, image, grey32);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 */

#define FILL(xo,yo) {						   \
	int xi = xo - ww;					   \
	int yi = yo - hn;					   \
	while (1) {						   \
	    if      (xi < 0)         { xi = 0              - xi; } \
	    else if (xi >= image->w) { xi = 2*(image->w-1) - xi; } \
	    else break;						   \
	}							   \
								   \
	while (1) {						   \
	    if      (yi < 0)         { yi = 0              - yi; } \
	    else if (yi >= image->h) { yi = 2*(image->h-1) - yi; } \
	    else break;						   \
	}							   \
								   \
	GREY32 (result, xo, yo) = GREY32 (image, xi, yi);		   \
    }

#define COPY(xo,yo,xi,yi) {			\
	GREY32 (result, xo, yo) = GREY32 (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-grey32-replicate.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_grey32_replicate
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by extending the edges, i.e. replicating the border
 * pixels.
 */

crimp_image* image;
crimp_input (imageObj, image, grey32);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 */

#define FILL(xo,yo) {					\
	int xi = xo - ww;				\
	int yi = yo - hn;				\
	if      (xi < 0)         { xi = 0;            } \
	else if (xi >= image->w) { xi = (image->w-1); } \
							\
	if      (yi < 0)         { yi = 0;            } \
	else if (yi >= image->h) { yi = (image->h-1); } \
							\
	GREY32 (result, xo, yo) = GREY32 (image, xi, yi);	\
    }

#define COPY(xo,yo,xi,yi) {				\
	GREY32 (result, xo, yo) = GREY32 (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-grey32-wrap.crimp.




















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_grey32_wrap
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by toroidal wrapping, also called cyclic expansion.
 */

crimp_image* image;
crimp_input (imageObj, image, grey32);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 */

#define FILL(xo,yo) {				\
	int xi = xo - ww;			\
	int yi = yo - hn;			\
	while (xi < 0) { xi += image->w; }	\
	while (yi < 0) { yi += image->h; }	\
	xi %= image->w;				\
	yi %= image->h;				\
						\
	GREY32 (result, xo, yo) = GREY32 (image, xi, yi); \
    }

#define COPY(xo,yo,xi,yi) {			\
	GREY32 (result, xo, yo) = GREY32 (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-grey8-const.crimp.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_grey8_const
Tcl_Obj* imageObj
int ww
int hn
int we
int hs
int value

/*
 * Border expansion by constant pixel value.
 */

crimp_image* image;
crimp_input (imageObj, image, grey8);

#define FILL(xo,yo) {			\
	GREY8 (result, xo, yo) = value; \
    }

#define COPY(xo,yo,xi,yi) {				\
	GREY8 (result, xo, yo) = GREY8 (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-grey8-extend.crimp.










































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_grey8_extend
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by subtracting mirrored pixels from the edge pixel, making
 * this a combination of mirror and replicate.
 */

crimp_image* image;
crimp_input (imageObj, image, grey8);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 *
 * NOTE: The replicate part can be optimized for the eight outer quadrants.
 */

#define FILL(xo,yo) {						   \
	int xb = xo - ww;					   \
	int yb = yo - hn;					   \
	int xi = xb;						   \
	int yi = yb;						   \
	int tg;							   \
								   \
	if      (xb < 0)         { xb = 0;            }		   \
	else if (xb >= image->w) { xb = (image->w-1); }		   \
								   \
	if      (yb < 0)         { yb = 0;            }		   \
	else if (yb >= image->h) { yb = (image->h-1); }		   \
								   \
	while (1) {						   \
	    if      (xi < 0)         { xi = 0              - xi; } \
	    else if (xi >= image->w) { xi = 2*(image->w-1) - xi; } \
	    else break;						   \
	}							   \
								   \
	while (1) {						   \
	    if      (yi < 0)         { yi = 0              - yi; } \
	    else if (yi >= image->h) { yi = 2*(image->h-1) - yi; } \
	    else break;						   \
	}							   \
								   \
	tg = GREY8 (image, xi, yi) - GREY8 (image, xb, yb);	   \
								   \
	GREY8 (result, xo, yo) = CLAMP (0, tg, 255);		   \
    }

#define COPY(xo,yo,xi,yi) {				\
	GREY8 (result, xo, yo) = GREY8 (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-grey8-mirror.crimp.




























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_grey8_mirror
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by mirroring along the edges, also called reflective
 * expansion.
 */

crimp_image* image;
crimp_input (imageObj, image, grey8);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 */

#define FILL(xo,yo) {						   \
	int xi = xo - ww;					   \
	int yi = yo - hn;					   \
	while (1) {						   \
	    if      (xi < 0)         { xi = 0              - xi; } \
	    else if (xi >= image->w) { xi = 2*(image->w-1) - xi; } \
	    else break;						   \
	}							   \
								   \
	while (1) {						   \
	    if      (yi < 0)         { yi = 0              - yi; } \
	    else if (yi >= image->h) { yi = 2*(image->h-1) - yi; } \
	    else break;						   \
	}							   \
								   \
	GREY8 (result, xo, yo) = GREY8 (image, xi, yi);		   \
    }

#define COPY(xo,yo,xi,yi) {			\
	GREY8 (result, xo, yo) = GREY8 (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-grey8-replicate.crimp.






















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_grey8_replicate
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by extending the edges, i.e. replicating the border
 * pixels.
 */

crimp_image* image;
crimp_input (imageObj, image, grey8);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 */

#define FILL(xo,yo) {					\
	int xi = xo - ww;				\
	int yi = yo - hn;				\
	if      (xi < 0)         { xi = 0;            } \
	else if (xi >= image->w) { xi = (image->w-1); } \
							\
	if      (yi < 0)         { yi = 0;            } \
	else if (yi >= image->h) { yi = (image->h-1); } \
							\
	GREY8 (result, xo, yo) = GREY8 (image, xi, yi);	\
    }

#define COPY(xo,yo,xi,yi) {				\
	GREY8 (result, xo, yo) = GREY8 (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-grey8-wrap.crimp.




















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_grey8_wrap
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by toroidal wrapping, also called cyclic expansion.
 */

crimp_image* image;
crimp_input (imageObj, image, grey8);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 */

#define FILL(xo,yo) {				\
	int xi = xo - ww;			\
	int yi = yo - hn;			\
	while (xi < 0) { xi += image->w; }	\
	while (yi < 0) { yi += image->h; }	\
	xi %= image->w;				\
	yi %= image->h;				\
						\
	GREY8 (result, xo, yo) = GREY8 (image, xi, yi); \
    }

#define COPY(xo,yo,xi,yi) {			\
	GREY8 (result, xo, yo) = GREY8 (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-hsv-const.crimp.













































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_hsv_const
Tcl_Obj* imageObj
int ww
int hn
int we
int hs
int h
int s
int v

/*
 * Border expansion by constant pixel value.
 */

crimp_image* image;
crimp_input (imageObj, image, hsv);

#define FILL(xo,yo) {		\
	H (result, xo, yo) = h; \
	S (result, xo, yo) = s; \
	V (result, xo, yo) = v; \
    }

#define COPY(xo,yo,xi,yi) {			\
	H (result, xo, yo) = H (image, xi, yi); \
	S (result, xo, yo) = S (image, xi, yi); \
	V (result, xo, yo) = V (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-hsv-extend.crimp.
















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_hsv_extend
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by subtracting mirrored pixels from the edge pixel, making
 * this a combination of mirror and replicate.
 */

crimp_image* image;
crimp_input (imageObj, image, hsv);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 *
 * NOTE: The replicate part can be optimized for the eight outer quadrants.
 */

#define FILL(xo,yo) {						   \
	int xb = xo - ww;					   \
	int yb = yo - hn;					   \
	int xi = xb;						   \
	int yi = yb;						   \
	int th, ts, tv;						   \
								   \
	if      (xb < 0)         { xb = 0;            }		   \
	else if (xb >= image->w) { xb = (image->w-1); }		   \
								   \
	if      (yb < 0)         { yb = 0;            }		   \
	else if (yb >= image->h) { yb = (image->h-1); }		   \
								   \
	while (1) {						   \
	    if      (xi < 0)         { xi = 0              - xi; } \
	    else if (xi >= image->w) { xi = 2*(image->w-1) - xi; } \
	    else break;						   \
	}							   \
								   \
	while (1) {						   \
	    if      (yi < 0)         { yi = 0              - yi; } \
	    else if (yi >= image->h) { yi = 2*(image->h-1) - yi; } \
	    else break;						   \
	}							   \
								   \
	th = H (image, xi, yi) - H (image, xb, yb);		   \
	ts = S (image, xi, yi) - S (image, xb, yb);		   \
	tv = V (image, xi, yi) - V (image, xb, yb);		   \
								   \
	H (result, xo, yo) = CLAMP (0, th, 255);		   \
	S (result, xo, yo) = CLAMP (0, ts, 255);		   \
	V (result, xo, yo) = CLAMP (0, tv, 255);		   \
    }

#define COPY(xo,yo,xi,yi) {			\
	H (result, xo, yo) = H (image, xi, yi); \
	S (result, xo, yo) = S (image, xi, yi); \
	V (result, xo, yo) = V (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-hsv-mirror.crimp.
































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_hsv_mirror
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by mirroring along the edges, also called reflective
 * expansion.
 */

crimp_image* image;
crimp_input (imageObj, image, hsv);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 */

#define FILL(xo,yo) {						   \
	int xi = xo - ww;					   \
	int yi = yo - hn;					   \
	while (1) {						   \
	    if      (xi < 0)         { xi = 0              - xi; } \
	    else if (xi >= image->w) { xi = 2*(image->w-1) - xi; } \
	    else break;						   \
	}							   \
								   \
	while (1) {						   \
	    if      (yi < 0)         { yi = 0              - yi; } \
	    else if (yi >= image->h) { yi = 2*(image->h-1) - yi; } \
	    else break;						   \
	}							   \
								   \
	H (result, xo, yo) = H (image, xi, yi);			   \
	S (result, xo, yo) = S (image, xi, yi);			   \
	V (result, xo, yo) = V (image, xi, yi);			   \
    }

#define COPY(xo,yo,xi,yi) {			\
	H (result, xo, yo) = H (image, xi, yi); \
	S (result, xo, yo) = S (image, xi, yi); \
	V (result, xo, yo) = V (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-hsv-replicate.crimp.


























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_hsv_replicate
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by extending the edges, i.e. replicating the border
 * pixels.
 */

crimp_image* image;
crimp_input (imageObj, image, hsv);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 */

#define FILL(xo,yo) {					\
	int xi = xo - ww;				\
	int yi = yo - hn;				\
	if      (xi < 0)         { xi = 0;            } \
	else if (xi >= image->w) { xi = (image->w-1); } \
							\
	if      (yi < 0)         { yi = 0;            } \
	else if (yi >= image->h) { yi = (image->h-1); } \
							\
	H (result, xo, yo) = H (image, xi, yi);		\
	S (result, xo, yo) = S (image, xi, yi);		\
	V (result, xo, yo) = V (image, xi, yi);		\
    }

#define COPY(xo,yo,xi,yi) {			\
	H (result, xo, yo) = H (image, xi, yi); \
	S (result, xo, yo) = S (image, xi, yi); \
	V (result, xo, yo) = V (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-hsv-wrap.crimp.
























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_hsv_wrap
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by toroidal wrapping, also called cyclic expansion.
 */

crimp_image* image;
crimp_input (imageObj, image, hsv);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 */

#define FILL(xo,yo) {				\
	int xi = xo - ww;			\
	int yi = yo - hn;			\
	while (xi < 0) { xi += image->w; }	\
	while (yi < 0) { yi += image->h; }	\
	xi %= image->w;				\
	yi %= image->h;				\
						\
	H (result, xo, yo) = H (image, xi, yi); \
	S (result, xo, yo) = S (image, xi, yi); \
	V (result, xo, yo) = V (image, xi, yi); \
    }

#define COPY(xo,yo,xi,yi) {			\
	H (result, xo, yo) = H (image, xi, yi); \
	S (result, xo, yo) = S (image, xi, yi); \
	V (result, xo, yo) = V (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-rgb-const.crimp.













































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_rgb_const
Tcl_Obj* imageObj
int ww
int hn
int we
int hs
int r
int g
int b

/*
 * Border expansion by constant pixel value.
 */

crimp_image* image;
crimp_input (imageObj, image, rgb);

#define FILL(xo,yo) {		\
	R (result, xo, yo) = r; \
	G (result, xo, yo) = g; \
	B (result, xo, yo) = b; \
    }

#define COPY(xo,yo,xi,yi) {			\
	R (result, xo, yo) = R (image, xi, yi); \
	G (result, xo, yo) = G (image, xi, yi); \
	B (result, xo, yo) = B (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-rgb-extend.crimp.
















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_rgb_extend
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by subtracting mirrored pixels from the edge pixel, making
 * this a combination of mirror and replicate.
 */

crimp_image* image;
crimp_input (imageObj, image, rgb);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 *
 * NOTE: The replicate part can be optimized for the eight outer quadrants.
 */

#define FILL(xo,yo) {						   \
	int xb = xo - ww;					   \
	int yb = yo - hn;					   \
	int xi = xb;						   \
	int yi = yb;						   \
	int tr, tg, tb;						   \
								   \
	if      (xb < 0)         { xb = 0;            }		   \
	else if (xb >= image->w) { xb = (image->w-1); }		   \
								   \
	if      (yb < 0)         { yb = 0;            }		   \
	else if (yb >= image->h) { yb = (image->h-1); }		   \
								   \
	while (1) {						   \
	    if      (xi < 0)         { xi = 0              - xi; } \
	    else if (xi >= image->w) { xi = 2*(image->w-1) - xi; } \
	    else break;						   \
	}							   \
								   \
	while (1) {						   \
	    if      (yi < 0)         { yi = 0              - yi; } \
	    else if (yi >= image->h) { yi = 2*(image->h-1) - yi; } \
	    else break;						   \
	}							   \
								   \
	tr = R (image, xi, yi) - R (image, xb, yb);		   \
	tg = G (image, xi, yi) - G (image, xb, yb);		   \
	tb = B (image, xi, yi) - B (image, xb, yb);		   \
								   \
	R (result, xo, yo) = CLAMP (0, tr, 255);		   \
	G (result, xo, yo) = CLAMP (0, tg, 255);		   \
	B (result, xo, yo) = CLAMP (0, tb, 255);		   \
    }

#define COPY(xo,yo,xi,yi) {			\
	R (result, xo, yo) = R (image, xi, yi); \
	G (result, xo, yo) = G (image, xi, yi); \
	B (result, xo, yo) = B (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-rgb-mirror.crimp.
































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_rgb_mirror
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by mirroring along the edges, also called reflective
 * expansion.
 */

crimp_image* image;
crimp_input (imageObj, image, rgb);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 */

#define FILL(xo,yo) {						   \
	int xi = xo - ww;					   \
	int yi = yo - hn;					   \
	while (1) {						   \
	    if      (xi < 0)         { xi = 0              - xi; } \
	    else if (xi >= image->w) { xi = 2*(image->w-1) - xi; } \
	    else break;						   \
	}							   \
								   \
	while (1) {						   \
	    if      (yi < 0)         { yi = 0              - yi; } \
	    else if (yi >= image->h) { yi = 2*(image->h-1) - yi; } \
	    else break;						   \
	}							   \
								   \
	R (result, xo, yo) = R (image, xi, yi);			   \
	G (result, xo, yo) = G (image, xi, yi);			   \
	B (result, xo, yo) = B (image, xi, yi);			   \
    }

#define COPY(xo,yo,xi,yi) {			\
	R (result, xo, yo) = R (image, xi, yi); \
	G (result, xo, yo) = G (image, xi, yi); \
	B (result, xo, yo) = B (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-rgb-replicate.crimp.


























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_rgb_replicate
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by extending the edges, i.e. replicating the border
 * pixels.
 */

crimp_image* image;
crimp_input (imageObj, image, rgb);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 */

#define FILL(xo,yo) {					\
	int xi = xo - ww;				\
	int yi = yo - hn;				\
	if      (xi < 0)         { xi = 0;            } \
	else if (xi >= image->w) { xi = (image->w-1); } \
							\
	if      (yi < 0)         { yi = 0;            } \
	else if (yi >= image->h) { yi = (image->h-1); } \
							\
	R (result, xo, yo) = R (image, xi, yi);		\
	G (result, xo, yo) = G (image, xi, yi);		\
	B (result, xo, yo) = B (image, xi, yi);		\
    }

#define COPY(xo,yo,xi,yi) {			\
	R (result, xo, yo) = R (image, xi, yi); \
	G (result, xo, yo) = G (image, xi, yi); \
	B (result, xo, yo) = B (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-rgb-wrap.crimp.
























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_rgb_wrap
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by toroidal wrapping, also called cyclic expansion.
 */

crimp_image* image;
crimp_input (imageObj, image, rgb);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 */

#define FILL(xo,yo) {				\
	int xi = xo - ww;			\
	int yi = yo - hn;			\
	while (xi < 0) { xi += image->w; }	\
	while (yi < 0) { yi += image->h; }	\
	xi %= image->w;				\
	yi %= image->h;				\
						\
	R (result, xo, yo) = R (image, xi, yi); \
	G (result, xo, yo) = G (image, xi, yi); \
	B (result, xo, yo) = B (image, xi, yi); \
    }

#define COPY(xo,yo,xi,yi) {			\
	R (result, xo, yo) = R (image, xi, yi); \
	G (result, xo, yo) = G (image, xi, yi); \
	B (result, xo, yo) = B (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-rgba-const.crimp.
















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_rgba_const
Tcl_Obj* imageObj
int ww
int hn
int we
int hs
int r
int g
int b
int a

/*
 * Border expansion by constant pixel value.
 */

crimp_image* image;
crimp_input (imageObj, image, rgba);

#define FILL(xo,yo) {		\
	R (result, xo, yo) = r; \
	G (result, xo, yo) = g; \
	B (result, xo, yo) = b; \
	A (result, xo, yo) = a; \
    }

#define COPY(xo,yo,xi,yi) {			\
	R (result, xo, yo) = R (image, xi, yi); \
	G (result, xo, yo) = G (image, xi, yi); \
	B (result, xo, yo) = B (image, xi, yi); \
	A (result, xo, yo) = A (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-rgba-extend.crimp.



















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_rgba_extend
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by subtracting mirrored pixels from the edge pixel, making
 * this a combination of mirror and replicate.
 */

crimp_image* image;
crimp_input (imageObj, image, rgba);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 *
 * NOTE: The replicate part can be optimized for the eight outer quadrants.
 */

#define FILL(xo,yo) {						   \
	int xb = xo - ww;					   \
	int yb = yo - hn;					   \
	int xi = xb;						   \
	int yi = yb;						   \
	int tr, tg, tb, ta;					   \
								   \
	if      (xb < 0)         { xb = 0;            }		   \
	else if (xb >= image->w) { xb = (image->w-1); }		   \
								   \
	if      (yb < 0)         { yb = 0;            }		   \
	else if (yb >= image->h) { yb = (image->h-1); }		   \
								   \
	while (1) {						   \
	    if      (xi < 0)         { xi = 0              - xi; } \
	    else if (xi >= image->w) { xi = 2*(image->w-1) - xi; } \
	    else break;						   \
	}							   \
								   \
	while (1) {						   \
	    if      (yi < 0)         { yi = 0              - yi; } \
	    else if (yi >= image->h) { yi = 2*(image->h-1) - yi; } \
	    else break;						   \
	}							   \
								   \
	tr = R (image, xi, yi) - R (image, xb, yb);		   \
	tg = G (image, xi, yi) - G (image, xb, yb);		   \
	tb = B (image, xi, yi) - B (image, xb, yb);		   \
	ta = A (image, xi, yi) - A (image, xb, yb);		   \
								   \
	R (result, xo, yo) = CLAMP (0, tr, 255);		   \
	G (result, xo, yo) = CLAMP (0, tg, 255);		   \
	B (result, xo, yo) = CLAMP (0, tb, 255);		   \
	A (result, xo, yo) = CLAMP (0, ta, 255);		   \
    }

#define COPY(xo,yo,xi,yi) {			\
	R (result, xo, yo) = R (image, xi, yi); \
	G (result, xo, yo) = G (image, xi, yi); \
	B (result, xo, yo) = B (image, xi, yi); \
	A (result, xo, yo) = A (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-rgba-mirror.crimp.


































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_rgba_mirror
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by mirroring along the edges, also called reflective
 * expansion.
 */

crimp_image* image;
crimp_input (imageObj, image, rgba);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 */

#define FILL(xo,yo) {						   \
	int xi = xo - ww;					   \
	int yi = yo - hn;					   \
	while (1) {						   \
	    if      (xi < 0)         { xi = 0              - xi; } \
	    else if (xi >= image->w) { xi = 2*(image->w-1) - xi; } \
	    else break;						   \
	}							   \
								   \
	while (1) {						   \
	    if      (yi < 0)         { yi = 0              - yi; } \
	    else if (yi >= image->h) { yi = 2*(image->h-1) - yi; } \
	    else break;						   \
	}							   \
								   \
	R (result, xo, yo) = R (image, xi, yi);			   \
	G (result, xo, yo) = G (image, xi, yi);			   \
	B (result, xo, yo) = B (image, xi, yi);			   \
	A (result, xo, yo) = A (image, xi, yi);			   \
    }

#define COPY(xo,yo,xi,yi) {			\
	R (result, xo, yo) = R (image, xi, yi); \
	G (result, xo, yo) = G (image, xi, yi); \
	B (result, xo, yo) = B (image, xi, yi); \
	A (result, xo, yo) = A (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-rgba-replicate.crimp.




























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_rgba_replicate
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by extending the edges, i.e. replicating the border
 * pixels.
 */

crimp_image* image;
crimp_input (imageObj, image, rgba);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 */

#define FILL(xo,yo) {					\
	int xi = xo - ww;				\
	int yi = yo - hn;				\
	if      (xi < 0)         { xi = 0;            } \
	else if (xi >= image->w) { xi = (image->w-1); } \
							\
	if      (yi < 0)         { yi = 0;            } \
	else if (yi >= image->h) { yi = (image->h-1); } \
							\
	R (result, xo, yo) = R (image, xi, yi);		\
	G (result, xo, yo) = G (image, xi, yi);		\
	B (result, xo, yo) = B (image, xi, yi);		\
	A (result, xo, yo) = A (image, xi, yi);		\
    }

#define COPY(xo,yo,xi,yi) {			\
	R (result, xo, yo) = R (image, xi, yi); \
	G (result, xo, yo) = G (image, xi, yi); \
	B (result, xo, yo) = B (image, xi, yi); \
	A (result, xo, yo) = A (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/expand-rgba-wrap.crimp.


























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

expand_rgba_wrap
Tcl_Obj* imageObj
int ww
int hn
int we
int hs

/*
 * Border expansion by toroidal wrapping, also called cyclic expansion.
 */

crimp_image* image;
crimp_input (imageObj, image, rgba);

/*
 * This is the simple definition. Might be better to generate macros
 * specialized to each quadrant. Except, even they have to perform modulo
 * arithmetic, as the border may be larger than image's width or height,
 * causing muliple wrapping.
 */

#define FILL(xo,yo) {				\
	int xi = xo - ww;			\
	int yi = yo - hn;			\
	while (xi < 0) { xi += image->w; }	\
	while (yi < 0) { yi += image->h; }	\
	xi %= image->w;				\
	yi %= image->h;				\
						\
	R (result, xo, yo) = R (image, xi, yi); \
	G (result, xo, yo) = G (image, xi, yi); \
	B (result, xo, yo) = B (image, xi, yi); \
	A (result, xo, yo) = A (image, xi, yi); \
    }

#define COPY(xo,yo,xi,yi) {			\
	R (result, xo, yo) = R (image, xi, yi); \
	G (result, xo, yo) = G (image, xi, yi); \
	B (result, xo, yo) = B (image, xi, yi); \
	A (result, xo, yo) = A (image, xi, yi); \
    }

#include <expand_op.c>

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/fftx-float.crimp.


















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

fftx_float
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          y;
integer      n;
real*        workspace;

crimp_input (imageObj, image, float);

result = crimp_new_like (image);

n = image->w;
workspace = NALLOC (2*image->w+15, real);
rffti_ (&n, workspace);

for (y = 0; y < image->h; y++) {
    /*
     * FFT on horizontal scan lines.  We copy each line to the result and then
     * run the FFT on it in place.  The copying makes use of the identity
     * between the float and real types to be quick.
     */
    memcpy (&FLOATP (result, 0, y),
	    &FLOATP (image,  0, y),
	    sizeof(float)*image->w);

    rfftf_ (&n, &FLOATP (result, 0, y), workspace);
}

ckfree ((char*) workspace);

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/fftx-grey16.crimp.



















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

fftx_grey16
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;
integer      n;
real*        workspace;

crimp_input (imageObj, image, grey16);

result = crimp_new_float (image->w, image->h);

n = image->w;
workspace = NALLOC (2*image->w+15, real);
rffti_ (&n, workspace);

for (y = 0; y < image->h; y++) {
    /*
     * FFT on horizontal scan lines.  We copy each line to the result and then
     * run the FFT on it in place.  The copying is done with a loop, as we
     * have to cast the greyscale values into proper floats.
     */

    for (x = 0; x < image->w; x++) {
	FLOATP (result, x, y) = GREY16 (image,  x, y);
    }

    rfftf_ (&n, &FLOATP (result, 0, y), workspace);
}

ckfree ((char*) workspace);

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/fftx-grey32.crimp.



















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

fftx_grey32
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;
real*        workspace;
integer      n;

crimp_input (imageObj, image, grey32);

result = crimp_new_float (image->w, image->h);

n = image->w;
workspace = NALLOC (2*image->w+15, real);
rffti_ (&n, workspace);

for (y = 0; y < image->h; y++) {
    /*
     * FFT on horizontal scan lines.  We copy each line to the result and then
     * run the FFT on it in place.  The copying is done with a loop, as we
     * have to cast the greyscale values into proper floats.
     */

    for (x = 0; x < image->w; x++) {
	FLOATP (result, x, y) = GREY32 (image,  x, y);
    }

    rfftf_ (&n, &FLOATP (result, 0, y), workspace);
}

ckfree ((char*) workspace);

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/fftx-grey8.crimp.



















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

fftx_grey8
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;
integer      n;
real*        workspace;

crimp_input (imageObj, image, grey8);

result = crimp_new_float (image->w, image->h);

n = image->w;
workspace = NALLOC (2*image->w+15, real);
rffti_ (&n, workspace);

for (y = 0; y < image->h; y++) {
    /*
     * FFT on horizontal scan lines.  We copy each line to the result and then
     * run the FFT on it in place.  The copying is done with a loop, as we
     * have to cast the greyscale values into proper floats.
     */

    for (x = 0; x < image->w; x++) {
	FLOATP (result, x, y) = GREY8 (image,  x, y);
    }

    rfftf_ (&n, &FLOATP (result, 0, y), workspace);
}

ckfree ((char*) workspace);

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/flip-horizontal-float.crimp.





































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

flip_horizontal_float
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, float);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	FLOATP (result, x, y) = FLOATP (image, image->w - x - 1, y);

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/flip-horizontal-grey8.crimp.





































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

flip_horizontal_grey8
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, grey8);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	GREY8 (result, x, y) = GREY8 (image, image->w - x - 1, y);

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/flip-horizontal-hsv.crimp.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

flip_horizontal_hsv
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, hsv);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	H (result, x, y) = H (image, image->w - x - 1, y);
	S (result, x, y) = S (image, image->w - x - 1, y);
	V (result, x, y) = V (image, image->w - x - 1, y);

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/flip-horizontal-rgb.crimp.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

flip_horizontal_rgb
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, rgb);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	R (result, x, y) = R (image, image->w - x - 1, y);
	G (result, x, y) = G (image, image->w - x - 1, y);
	B (result, x, y) = B (image, image->w - x - 1, y);

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/flip-horizontal-rgba.crimp.








































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

flip_horizontal_rgba
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, rgba);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	R (result, x, y) = R (image, image->w - x - 1, y);
	G (result, x, y) = G (image, image->w - x - 1, y);
	B (result, x, y) = B (image, image->w - x - 1, y);
	A (result, x, y) = A (image, image->w - x - 1, y);

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/flip-transpose-float.crimp.





































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

flip_transpose_float
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, float);

result = crimp_new_like_transpose (image);

for (y = 0; y < image->w; y++) {
    for (x = 0; x < image->h; x++) {

	FLOATP (result, x, y) = FLOATP (image, y, x);

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/flip-transpose-grey8.crimp.





































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

flip_transpose_grey8
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, grey8);

result = crimp_new_like_transpose (image);

for (y = 0; y < image->w; y++) {
    for (x = 0; x < image->h; x++) {

	GREY8 (result, x, y) = GREY8 (image, y, x);

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/flip-transpose-hsv.crimp.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

flip_transpose_hsv
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, hsv);

result = crimp_new_like_transpose (image);

for (y = 0; y < image->w; y++) {
    for (x = 0; x < image->h; x++) {

	H (result, x, y) = H (image, y, x);
	S (result, x, y) = S (image, y, x);
	V (result, x, y) = V (image, y, x);

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/flip-transpose-rgb.crimp.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

flip_transpose_rgb
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, rgb);

result = crimp_new_like_transpose (image);

for (y = 0; y < image->w; y++) {
    for (x = 0; x < image->h; x++) {

	R (result, x, y) = R (image, y, x);
	G (result, x, y) = G (image, y, x);
	B (result, x, y) = B (image, y, x);

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/flip-transpose-rgba.crimp.








































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

flip_transpose_rgba
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, rgba);

result = crimp_new_like_transpose (image);

for (y = 0; y < image->w; y++) {
    for (x = 0; x < image->h; x++) {

	R (result, x, y) = R (image, y, x);
	G (result, x, y) = G (image, y, x);
	B (result, x, y) = B (image, y, x);
	A (result, x, y) = A (image, y, x);

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/flip-transverse-float.crimp.





































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

flip_transverse_float
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, float);

result = crimp_new_like_transpose (image);

for (y = 0; y < image->w; y++) {
    for (x = 0; x < image->h; x++) {

	FLOATP (result, x, y) = FLOATP (image, image->w - y - 1, image->h - x - 1);

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/flip-transverse-grey8.crimp.





































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

flip_transverse_grey8
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, grey8);

result = crimp_new_like_transpose (image);

for (y = 0; y < image->w; y++) {
    for (x = 0; x < image->h; x++) {

	GREY8 (result, x, y) = GREY8 (image, image->w - y - 1, image->h - x - 1);

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/flip-transverse-hsv.crimp.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

flip_transverse_hsv
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, hsv);

result = crimp_new_like_transpose (image);

for (y = 0; y < image->w; y++) {
    for (x = 0; x < image->h; x++) {

	H (result, x, y) = H (image, image->w - y - 1, image->h - x - 1);
	S (result, x, y) = S (image, image->w - y - 1, image->h - x - 1);
	V (result, x, y) = V (image, image->w - y - 1, image->h - x - 1);

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/flip-transverse-rgb.crimp.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

flip_transverse_rgb
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, rgb);

result = crimp_new_like_transpose (image);

for (y = 0; y < image->w; y++) {
    for (x = 0; x < image->h; x++) {

	R (result, x, y) = R (image, image->w - y - 1, image->h - x - 1);
	G (result, x, y) = G (image, image->w - y - 1, image->h - x - 1);
	B (result, x, y) = B (image, image->w - y - 1, image->h - x - 1);

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/flip-transverse-rgba.crimp.








































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

flip_transverse_rgba
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, rgba);

result = crimp_new_like_transpose (image);

for (y = 0; y < image->w; y++) {
    for (x = 0; x < image->h; x++) {

	R (result, x, y) = R (image, image->w - y - 1, image->h - x - 1);
	G (result, x, y) = G (image, image->w - y - 1, image->h - x - 1);
	B (result, x, y) = B (image, image->w - y - 1, image->h - x - 1);
	A (result, x, y) = A (image, image->w - y - 1, image->h - x - 1);

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/flip-vertical-float.crimp.





































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

flip_vertical_float
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, float);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	FLOATP (result, x, y) = FLOATP (image, x, image->h - y - 1);

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/flip-vertical-grey8.crimp.





































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

flip_vertical_grey8
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, grey8);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	GREY8 (result, x, y) = GREY8 (image, x, image->h - y - 1);

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/flip-vertical-hsv.crimp.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

flip_vertical_hsv
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, hsv);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	H (result, x, y) = H (image, x, image->h - y - 1);
	S (result, x, y) = S (image, x, image->h - y - 1);
	V (result, x, y) = V (image, x, image->h - y - 1);

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/flip-vertical-rgb.crimp.







































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

flip_vertical_rgb
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, rgb);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	R (result, x, y) = R (image, x, image->h - y - 1);
	G (result, x, y) = G (image, x, image->h - y - 1);
	B (result, x, y) = B (image, x, image->h - y - 1);

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/flip-vertical-rgba.crimp.








































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

flip_vertical_rgba
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, rgba);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	R (result, x, y) = R (image, x, image->h - y - 1);
	G (result, x, y) = G (image, x, image->h - y - 1);
	B (result, x, y) = B (image, x, image->h - y - 1);
	A (result, x, y) = A (image, x, image->h - y - 1);

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/height.crimp.

























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

height
Tcl_Obj* imageObj

crimp_image* image;

crimp_input_any (imageObj, image);

Tcl_SetObjResult (interp, Tcl_NewIntObj (image->h));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/histogram.crimp.













































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

histogram
Tcl_Obj* imageObj

/*
 * This operation is a general histogram generator
 */

crimp_image*     image;
int              x, y, c, i, count, maxv, largegrey;
int*             histogram;
Tcl_Obj*         d; /* dict of histograms, indexed by channel name */
Tcl_Obj*         h; /* histogram dict, indexed by pixel value */
Tcl_Obj*         k; /* channel name as Tcl_Obj, for the main dict */

crimp_input_any (imageObj, image);
ASSERT_NOTIMGTYPE(image,grey32);
/*
 * Actually NOT any. The code below is not able to handle grey32, as images
 * with these types can have 4G possible values, for which we cannot allocate
 * a full counter array.
 *
 * XXX This needs fixing. Use of a hashtable to allocate only pixel values
 * actually seen. Will still run into trouble for extreme images which do
 * contain all the possible values.
 */

largegrey = image->itype == crimp_imagetype_find ("crimp::image::grey16");
if (largegrey) {
    maxv = 65536;
} else {
    maxv = 256;
}

histogram = NALLOC (maxv * image->itype->channels, int);
memset (histogram, '\0', maxv * image->itype->channels * sizeof (int));

/*
 * Count the pixel values.
 */

#define BUCKET(c,v) histogram [((c) * maxv + (v))]

if (largegrey) {
    for (y = 0; y < image->h; y++) {
	for (x = 0; x < image->w; x++) {
	    BUCKET (0, GREY16 (image, x, y)) ++;
	}
    }
} else {
    for (y = 0; y < image->h; y++) {
	for (x = 0; x < image->w; x++) {
	    for (c = 0; c < image->itype->channels; c++) {
		BUCKET (c, CH (image, c, x, y)) ++;
	    }
	}
    }
}

/*
 * Convert the data into a dictionary to return.
 *
 * XXX: For the very large histograms of grey32 (4GB possible values) it would
 * be sensible to suppress the entries for all pixel values which are not
 * used, i.e. have a count of zero.
 */

d = Tcl_NewDictObj ();

for (c = 0; c < image->itype->channels; c++) {

    k = Tcl_NewStringObj (image->itype->cname [c],-1);
    h = Tcl_NewDictObj ();

    for (i = 0; i < maxv; i++) {
	count = BUCKET (c, i);

	/*
	 * XXX future optimization: keep a hash table of the Int objects, and
	 * share them as much a is possible.
	 */

	Tcl_DictObjPut (interp, h,
			Tcl_NewIntObj (i),
			Tcl_NewIntObj (count));
    }

    Tcl_DictObjPut (interp, d, k, h);
}

ckfree ((char*) histogram);

Tcl_SetObjResult(interp, d);
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/hough-grey8.crimp.































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

hough_grey8
Tcl_Obj* imageObj
int emptyBucketColor

crimp_image* image;
crimp_image* result;
int          rh, rw, rho, theta;

crimp_input (imageObj, image, grey8);

/*
 * Destination size. 360 degrees, and 0.5sqrt(w^2+h^2) slope.
 *
 * FUTURE: Allow x/y factors as parameters, to select more or less buckets,
 * i.e. higher or lower precision.
 */

rw = 360;
rh = hypot (image->w, image->h)/2;

/*
 * Allocate and initialize the buckets.
 */

result = crimp_new_float (rw, rh);

/*
 * Scan the image. For every pixel > 0 we sweep the result in the sinusoid
 * representing the parameters of all lines which can go through it,
 * incrementing the associated buckets.
 *
 * An alternate formulation is to scan the buckets and sweep the input along
 * the line it represents, computing the average greylevel, and saving this in
 * the bucket.
 *
 * The code below uses the alternate formulation, with nearest neighbour
 * interpolation when sampling the input. This alternate phrasing makes things
 * easier, for (1) there is no need for a separate initialization step, and
 * (2) we avoid the need to decide which pixels to count as on a line which is
 * required by the regular implementation (See the 'pixel > 0' condition!). On
 * the other hand, this phrasing needs a color representing empty buckets, the
 * background color of the image, the color not used by pixels on a line.
 */

for (rho = 0; rho < rh; rho++) {
    for (theta = 0; theta < rw; theta++) {
	/* 0.017 = pi/180 */
	float co = cos (theta * 0.017453292519943295769236907684886);
	float si = sin (theta * 0.017453292519943295769236907684886);
	int sum, total, xi, yi, x, y;
	float xf, yf;

	sum = total = 0;

	if ((theta < 45) ||
	    (theta > 315) ||
	    ((theta > 135) && (theta < 225))) {
	    /*
	     * In these 4 octants iterate over y
	     */

	    for (y = 0; y < image->h; y++) {
		xf = image->w/2 + (rho - (image->h/2 - y)*si)/co;

		xi = xf;
		if ((xf - xi) >= 0.5) xi++;

		if ((xi < 0) || (xi >= image->w)) continue;

		total++;
		sum += GREY8 (image, xi, y);
	    }

	} else {
	    /*
	     * In the remaining octants iterate over x.
	     */

	    for (x = 0; x < image->w; x++) {
		yf = image->h/2 - (rho - (x - image->w/2)*co)/si;

		yi = yf;
		if ((yf - yi) >= 0.5) yi++;

		if ((yi < 0) || (yi >= image->h)) continue;

		total++;
		sum += GREY8 (image, x, yi);
	    }
	}

	/*
	 * Convert to the average and save. The specified default color for
	 * empty buckets is used if we were unable to seep a proper line
	 * across the input. It should match the background color of the
	 * input, with the actual lines we are looking for deviating from that
	 * color. For black lines this is usually WHITE. This is this
	 * algorithm's complement to the regular algorithm's need to decide if
	 * a pixel belongs to a line or not.
	 */

	if (total) {
	    FLOATP (result, theta, rho) = ((float)sum)/total;
	} else {
	    FLOATP (result, theta, rho) = emptyBucketColor;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/hypot-float-float.crimp.

















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

hypot_float_float
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Hypot of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, float);
crimp_input (imageYObj, imageY, float);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageX);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = hypot (FLOATP (imageX, x, y),
				       FLOATP (imageY, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/hypot-float-grey16.crimp.

















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

hypot_float_grey16
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Hypot of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, float);
crimp_input (imageYObj, imageY, grey16);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageX);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = hypot (FLOATP (imageX, x, y),
				       GREY16 (imageY, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/hypot-float-grey32.crimp.

















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

hypot_float_grey32
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Hypot of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, float);
crimp_input (imageYObj, imageY, grey32);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageX);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = hypot (FLOATP (imageX, x, y),
				       GREY32 (imageY, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/hypot-float-grey8.crimp.

















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

hypot_float_grey8
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Hypot of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, float);
crimp_input (imageYObj, imageY, grey8);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageX);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = hypot (FLOATP (imageX, x, y),
				       GREY8  (imageY, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/hypot-grey16-grey16.crimp.

















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

hypot_grey16_grey16
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Hypot of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, grey16);
crimp_input (imageYObj, imageY, grey16);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_float (imageX->w, imageX->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = hypot (GREY16 (imageX, x, y),
				       GREY16 (imageY, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/hypot-grey16-grey8.crimp.

















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

hypot_grey16_grey8
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Hypot of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, grey16);
crimp_input (imageYObj, imageY, grey8);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_float (imageX->w, imageX->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = hypot (GREY16 (imageX, x, y),
				       GREY8  (imageY, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/hypot-grey32-grey16.crimp.

















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

hypot_grey32_grey16
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Hypot of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, grey32);
crimp_input (imageYObj, imageY, grey16);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_float (imageX->w, imageX->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = hypot (GREY32 (imageX, x, y),
				       GREY16 (imageY, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/hypot-grey32-grey32.crimp.

















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

hypot_grey32_grey32
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Hypot of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, grey32);
crimp_input (imageYObj, imageY, grey32);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_float (imageX->w, imageX->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = hypot (GREY32 (imageX, x, y),
				       GREY32 (imageY, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/hypot-grey32-grey8.crimp.

















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

hypot_grey32_grey8
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Hypot of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, grey32);
crimp_input (imageYObj, imageY, grey8);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_float (imageX->w, imageX->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = hypot (GREY32 (imageX, x, y),
				       GREY8  (imageY, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/hypot-grey8-grey8.crimp.

















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

hypot_grey8_grey8
Tcl_Obj* imageXObj
Tcl_Obj* imageYObj

/*
 * Hypot of all pixels of the two input images.
 */

crimp_image* imageX;
crimp_image* imageY;
crimp_image* result;
int          x, y;

crimp_input (imageXObj, imageX, grey8);
crimp_input (imageYObj, imageY, grey8);

if (!crimp_eq_dim (imageX, imageY)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_float (imageX->w, imageX->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = hypot (GREY8 (imageX, x, y),
				       GREY8 (imageY, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/ifftx-float.crimp.



























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

ifftx_float
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;
integer      n;
real*        workspace;

crimp_input (imageObj, image, float);

result = crimp_new_like (image);

n = image->w;
workspace = NALLOC (2*image->w+15, real);
rffti_ (&n, workspace);

for (y = 0; y < image->h; y++) {
    /*
     * Inverse FFT on horizontal scan lines.  We copy each line to the result
     * and then run the iFFT on it in place.  The copying makes use of the
     * identity between the float and real types to be quick.
     */
    memcpy (&FLOATP (result, 0, y),
	    &FLOATP (image,  0, y),
	    sizeof(float)*image->w);

    rfftb_ (&n, &FLOATP (result, 0, y), workspace);

    /*
     * Note that we have to divide the result elements by N. This is because
     * the FFT routines do not normalize their results.
     */

    for (x = 0; x < image->w; x++) {
	FLOATP (result, x, y) /= n;
    }
}

ckfree ((char*) workspace);

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/ifftx-grey16.crimp.




























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

ifftx_grey16
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;
integer      n;
real*        workspace;

crimp_input (imageObj, image, grey16);

result = crimp_new_float (image->w, image->h);

n = image->w;
workspace = NALLOC (2*image->w+15, real);
rffti_ (&n, workspace);

for (y = 0; y < image->h; y++) {
    /*
     * Inverse FFT on horizontal scan lines.  We copy each line to the result
     * and then run the iFFT on it in place.  The copying is done with a loop,
     * as we have to cast the greyscale values into proper floats.
     */

    for (x = 0; x < image->w; x++) {
	FLOATP (result, x, y) = GREY16 (image,  x, y);
    }

    rfftb_ (&n, &FLOATP (result, 0, y), workspace);

    /*
     * Note that we have to divide the result elements by N. This is because
     * the FFT routines do not normalize their results.
     */

    for (x = 0; x < image->w; x++) {
	FLOATP (result, x, y) /= n;
    }
}

ckfree ((char*) workspace);

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/ifftx-grey32.crimp.




























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

ifftx_grey32
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;
real*        workspace;
integer      n;

crimp_input (imageObj, image, grey32);

result = crimp_new_float (image->w, image->h);

n = image->w;
workspace = NALLOC (2*image->w+15, real);
rffti_ (&n, workspace);

for (y = 0; y < image->h; y++) {
    /*
     * Inverse FFT on horizontal scan lines.  We copy each line to the result
     * and then run the iFFT on it in place.  The copying is done with a loop,
     * as we have to cast the greyscale values into proper floats.
     */

    for (x = 0; x < image->w; x++) {
	FLOATP (result, x, y) = GREY32 (image,  x, y);
    }

    rfftb_ (&n, &FLOATP (result, 0, y), workspace);

    /*
     * Note that we have to divide the result elements by N. This is because
     * the FFT routines do not normalize their results.
     */

    for (x = 0; x < image->w; x++) {
	FLOATP (result, x, y) /= n;
    }
}

ckfree ((char*) workspace);

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/ifftx-grey8.crimp.




























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

ifftx_grey8
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;
integer      n;
real*        workspace;

crimp_input (imageObj, image, grey8);

result = crimp_new_float (image->w, image->h);

n = image->w;
workspace = NALLOC (2*image->w+15, real);
rffti_ (&n, workspace);

for (y = 0; y < image->h; y++) {
    /*
     * Inverse FFT on horizontal scan lines.  We copy each line to the result
     * and then run the iFFT on it in place.  The copying is done with a loop,
     * as we have to cast the greyscale values into proper floats.
     */

    for (x = 0; x < image->w; x++) {
	FLOATP (result, x, y) = GREY8 (image,  x, y);
    }

    rfftb_ (&n, &FLOATP (result, 0, y), workspace);

    /*
     * Note that we have to divide the result elements by N. This is because
     * the FFT routines do not normalize their results.
     */

    for (x = 0; x < image->w; x++) {
	FLOATP (result, x, y) /= n;
    }
}

ckfree ((char*) workspace);

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/integrate-float.crimp.





































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

integrate_float
Tcl_Obj* imageObj

/*
 * The input image is converted into an integral image, aka summed area table,
 * where each pixel contains the sum of all pixels to the left and above of
 * it, including the pixel itself.
 *
 * To avoid problems with overflow the result is always of type float.
 *
 * Ref: http://en.wikipedia.org/wiki/Summed_area_table
 */

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, float);

result = crimp_new_float (image->w, image->h);

/* Initialize the accumulator */
FLOATP (result, 0, 0) = FLOATP (image, 0, 0);

/*
 * Initialize the first line of the result. Only looking back to results in the same line.
 */
for (x = 1; x < result->w; x++) {
    FLOATP (result, x, 0) = FLOATP (image, x, 0) + FLOATP (result, x-1, 0);
}

/*
 * Remainder of the image, looking back to results on the same line and the
 * previous line.
 */

for (y = 1; y < result->h; y++) {
    /* Initialize first column */
    FLOATP (result, 0, y) = 
	FLOATP (image,  0, y) +
	FLOATP (result, 0, y-1);

    for (x = 1; x < result->w; x++) {
	FLOATP (result, x, y) = 
	    FLOATP (image,  x,   y) +
	    FLOATP (result, x-1, y) +
	    FLOATP (result, x,   y-1) -
	    FLOATP (result, x-1, y-1);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/integrate-grey16.crimp.





































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

integrate_grey16
Tcl_Obj* imageObj

/*
 * The input image is converted into an integral image, aka summed area table,
 * where each pixel contains the sum of all pixels to the left and above of
 * it, including the pixel itself.
 *
 * To avoid problems with overflow the result is always of type float.
 *
 * Ref: http://en.wikipedia.org/wiki/Summed_area_table
 */

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, grey16);

result = crimp_new_float (image->w, image->h);

/* Initialize the accumulator */
FLOATP (result, 0, 0) = GREY16 (image, 0, 0);

/*
 * Initialize the first line of the result. Only looking back to results in the same line.
 */
for (x = 1; x < result->w; x++) {
    FLOATP (result, x, 0) = GREY16 (image, x, 0) + FLOATP (result, x-1, 0);
}

/*
 * Remainder of the image, looking back to results on the same line and the
 * previous line.
 */

for (y = 1; y < result->h; y++) {
    /* Initialize first column */
    FLOATP (result, 0, y) = 
	GREY16 (image,  0, y) +
	FLOATP (result, 0, y-1);

    for (x = 1; x < result->w; x++) {
	FLOATP (result, x, y) = 
	    GREY16 (image,  x,   y) +
	    FLOATP (result, x-1, y) +
	    FLOATP (result, x,   y-1) -
	    FLOATP (result, x-1, y-1);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/integrate-grey32.crimp.





































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

integrate_grey32
Tcl_Obj* imageObj

/*
 * The input image is converted into an integral image, aka summed area table,
 * where each pixel contains the sum of all pixels to the left and above of
 * it, including the pixel itself.
 *
 * To avoid problems with overflow the result is always of type float.
 *
 * Ref: http://en.wikipedia.org/wiki/Summed_area_table
 */

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, grey32);

result = crimp_new_float (image->w, image->h);

/* Initialize the accumulator */
FLOATP (result, 0, 0) = GREY32 (image, 0, 0);

/*
 * Initialize the first line of the result. Only looking back to results in the same line.
 */
for (x = 1; x < result->w; x++) {
    FLOATP (result, x, 0) = GREY32 (image, x, 0) + FLOATP (result, x-1, 0);
}

/*
 * Remainder of the image, looking back to results on the same line and the
 * previous line.
 */

for (y = 1; y < result->h; y++) {
    /* Initialize first column */
    FLOATP (result, 0, y) = 
	GREY32 (image,  0, y) +
	FLOATP (result, 0, y-1);

    for (x = 1; x < result->w; x++) {
	FLOATP (result, x, y) = 
	    GREY32 (image,  x,   y) +
	    FLOATP (result, x-1, y) +
	    FLOATP (result, x,   y-1) -
	    FLOATP (result, x-1, y-1);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/integrate-grey8.crimp.





































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

integrate_grey8
Tcl_Obj* imageObj

/*
 * The input image is converted into an integral image, aka summed area table,
 * where each pixel contains the sum of all pixels to the left and above of
 * it, including the pixel itself.
 *
 * To avoid problems with overflow the result is always of type float.
 *
 * Ref: http://en.wikipedia.org/wiki/Summed_area_table
 */

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, grey8);

result = crimp_new_float (image->w, image->h);

/* Initialize the accumulator */
FLOATP (result, 0, 0) = GREY8 (image, 0, 0);

/*
 * Initialize the first line of the result. Only looking back to results in the same line.
 */
for (x = 1; x < result->w; x++) {
    FLOATP (result, x, 0) = GREY8 (image, x, 0) + FLOATP (result, x-1, 0);
}

/*
 * Remainder of the image, looking back to results on the same line and the
 * previous line.
 */

for (y = 1; y < result->h; y++) {
    /* Initialize first column */
    FLOATP (result, 0, y) = 
	GREY8  (image,  0, y) +
	FLOATP (result, 0, y-1);

    for (x = 1; x < result->w; x++) {
	FLOATP (result, x, y) = 
	    GREY8  (image,  x,   y) +
	    FLOATP (result, x-1, y) +
	    FLOATP (result, x,   y-1) -
	    FLOATP (result, x-1, y-1);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/invert-grey8.crimp.





































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

invert_grey8
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, grey8);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	GREY8 (result, x, y) = WHITE - GREY8 (image, x, y);

    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/invert-rgb.crimp.










































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

invert_rgb
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, rgb);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	/*
	 * We are inverting (only) the color channels.
	 */

	R (result, x, y) = WHITE - R (image, x, y);
	G (result, x, y) = WHITE - G (image, x, y);
	B (result, x, y) = WHITE - B (image, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/invert-rgba.crimp.













































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

invert_rgba
Tcl_Obj* imageObj

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, rgba);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	/*
	 * We are inverting (only) the color channels.
	 * The alpha channel is copied as is.
	 */

	R (result, x, y) = WHITE - R (image, x, y);
	G (result, x, y) = WHITE - G (image, x, y);
	B (result, x, y) = WHITE - B (image, x, y);

	A (result, x, y) = A (image, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/join-hsv.crimp.























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

join_2hsv
Tcl_Obj* hueImageObj
Tcl_Obj* satImageObj
Tcl_Obj* valImageObj

crimp_image*     result;
crimp_image*     hue;
crimp_image*     sat;
crimp_image*     val;
int              x, y;

crimp_input (hueImageObj, hue, grey8);
crimp_input (satImageObj, sat, grey8);
crimp_input (valImageObj, val, grey8);

if (!crimp_eq_dim (hue, sat) ||
    !crimp_eq_dim (hue, val)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_hsv (hue->w, hue->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	/*
	 * Assembling the pixels of each color channel from the associated
	 * input images.
	 */

	H (result, x, y) = GREY8 (hue, x, y);
	S (result, x, y) = GREY8 (sat, x, y);
	V (result, x, y) = GREY8 (val, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/join-rgb.crimp.























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

join_2rgb
Tcl_Obj* redImageObj
Tcl_Obj* greenImageObj
Tcl_Obj* blueImageObj

crimp_image*     result;
crimp_image*     red;
crimp_image*     green;
crimp_image*     blue;
int              x, y;

crimp_input (redImageObj,   red,   grey8);
crimp_input (greenImageObj, green, grey8);
crimp_input (blueImageObj,  blue,  grey8);

if (!crimp_eq_dim (red, green) ||
    !crimp_eq_dim (red, blue)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_rgb (red->w, red->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	/*
	 * Assembling the pixels of each color channel from the associated
	 * input images.
	 */

	R (result, x, y) = GREY8 (red,   x, y);
	G (result, x, y) = GREY8 (green, x, y);
	B (result, x, y) = GREY8 (blue,  x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/join-rgba.crimp.




























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

join_2rgba
Tcl_Obj* redImageObj
Tcl_Obj* greenImageObj
Tcl_Obj* blueImageObj
Tcl_Obj* alphaImageObj

crimp_image*     result;
crimp_image*     red;
crimp_image*     green;
crimp_image*     blue;
crimp_image*     alpha;
int              x, y;

crimp_input (redImageObj,   red,   grey8);
crimp_input (greenImageObj, green, grey8);
crimp_input (blueImageObj,  blue,  grey8);
crimp_input (alphaImageObj, alpha, grey8);

if (!crimp_eq_dim (red, green) ||
    !crimp_eq_dim (red, blue) ||
    !crimp_eq_dim (red, alpha)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_rgba (red->w, red->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	/*
	 * Assembling the pixels of each color channel from the associated
	 * input images.
	 */

	R (result, x, y) = GREY8 (red,   x, y);
	G (result, x, y) = GREY8 (green, x, y);
	B (result, x, y) = GREY8 (blue,  x, y);
	A (result, x, y) = GREY8 (alpha, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/joint_bilateral-grey8.crimp.






























































































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

joint_bilateral_grey8
Tcl_Obj* imageObj
Tcl_Obj* wimageObj
double sigma_space
double sigma_range

/*
 * Joint (or Cross) Bilateral filter. Like a bilateral filter, except that the
 * weight information is pulled from a second image. I.e. we filter image A
 * using the edge information of image B.
 *
 * Uses a bilateral grid downsampled by sigma-s and sigma-r for higher
 * performance, and lesser memory use. A sigma of 1 implies 'no downsampling',
 * filtering is on the full grid: high memory use, slow speed.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     wimage;
crimp_volume*    wi;    /* Bilateral grid, accumulated pixel intensities */
crimp_volume*    w;     /* Bilateral grid, accumulated pixel counts, = weight factor */
int              x, y, z;
int              bgrid_width, bgrid_height, bgrid_range, bgrid_maxdim;
double* nw;
double* nwi;

/*
 * Process and validate the arguments.
 */

crimp_input (imageObj,  image, grey8);
crimp_input (wimageObj, wimage, grey8);

if (!crimp_eq_dim (image, wimage)) {
    Tcl_SetResult(interp, "Unable to  filter, expected equally-sized images", TCL_STATIC);
    return TCL_ERROR;
}

ASSERT (sigma_space >= 1, "Cannot use sigma/s < 1");
ASSERT (sigma_range >= 1, "Cannot use sigma/r < 1");

result = crimp_new_like (image);

/*
 * Determine the size of the bilateral grid.
 * +1 = One more, in case the float->int of the ceil result rounded down.
 * +4 = Borders for the convolution of the grid.
 *
 * TODO NOTE: The SParis BF code obtains the min and max grey levels from the
 * TODO NOTE: image and uses that for the range, instead of a fixed 256 (Also
 * TODO NOTE: assumes that intensity is in [0,1]).
 */

bgrid_width  = 4 + 1 + (int) ceil (image->w/sigma_space);
bgrid_height = 4 + 1 + (int) ceil (image->w/sigma_space);
bgrid_range  = 4 + 1 + (int) ceil (256/sigma_range);
bgrid_maxdim = MAX (bgrid_width, MAX (bgrid_height, bgrid_range));

/*
 * Phase I. Allocate and initialize the bilateral grid (2 volumes).
 */

wi = crimp_vnew_float (bgrid_width, bgrid_height, bgrid_range);
w  = crimp_vnew_float (bgrid_width, bgrid_height, bgrid_range);

for (z = 0; z < bgrid_range; z++) {
    for (y = 0; y < bgrid_height; y++) {
	for (x = 0; x < bgrid_width; x++) {
	    VFLOATP (wi, x, y, z) = 0.0;
	    VFLOATP (w,  x, y, z) = 0.0;
	}
    }
}

/*
 * Phase II. Update the bilateral grid with the downsampled image data.
 */

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	double p = GREY8 (image, x, y);
	double pw = GREY8 (wimage, x, y);

	/* +2 is the offset to keep the borders empty. */

	int xr = 2 + lrint (((double) x) / sigma_space);
	int yr = 2 + lrint (((double) y) / sigma_space);
	int pr = 2 + lrint (pw / sigma_range); /* Edge information = Range distance
						* for the pixel = the Z in the grid
						* comes from the wimage (image B).
						* This is the point of the joint
						* filter.
						*/
	VFLOATP (wi, xr, yr, pr) += p;
	VFLOATP (w,  xr, yr, pr) += 1;
    }
}

/*
 * Phase III. Convolve the grid using gaussian (1 4 6 4 1) along each
 * of the three axes. The convolution is hard-wired. Note that the
 * grid was allocated with the necessary borders, and the previous
 * phases made sure to keep the borders empty.
 *
 * NOTE: I sort of tried to optimize here, using a buffer just for a single
 * slice through the grid. The SParis code creates a whole duplicate of the
 * grid. It doesn't have to access the grid in strided fashion either, except
 * for the neighbour calculations.
 *
 * It also uses a simpler gaussian (1/4 (1 2 1)), and applies it twice.
 */

nw  = NALLOC (bgrid_maxdim, double); /* Helper arrays to buffer the convolution */
nwi = NALLOC (bgrid_maxdim, double); /* result per scan line. */

/* gauss(a,b,c,d,e) = 1a+4b+6c+4d+1e = a+e+4(b+d)+6c = a+e+4(b+d+c)+2c */

#define GAUSS(a, b, c, d, e) ((((a)+(e)) + 4*((b)+(d)) + 6*(c))/16.)

#define GX(f, x, y, z)		   \
       GAUSS (VFLOATP (f, x-2, y, z), \
	      VFLOATP (f, x-1, y, z), \
	      VFLOATP (f, x  , y, z), \
	      VFLOATP (f, x+1, y, z), \
	      VFLOATP (f, x+2, y, z))

#define GY(f, x, y, z)		   \
       GAUSS (VFLOATP (f, x, y-2, z), \
	      VFLOATP (f, x, y-1, z), \
	      VFLOATP (f, x, y  , z), \
	      VFLOATP (f, x, y+1, z), \
	      VFLOATP (f, x, y+2, z))

#define GZ(f, x, y, z)		   \
       GAUSS (VFLOATP (f, x, y, z-2), \
	      VFLOATP (f, x, y, z-1), \
	      VFLOATP (f, x, y, z  ), \
	      VFLOATP (f, x, y, z+1), \
	      VFLOATP (f, x, y, z+2))

/* Gaussian @ X */

for (z = 2; z < bgrid_range-2; z++) {
    for (y = 2; y < bgrid_height-2; y++) {
	for (x = 2; x < bgrid_width-2; x++) {
	    nw  [x-2] = GX(w,  x, y, z);
	    nwi [x-2] = GX(wi, x, y, z);
	}

	for (x = 2; x < bgrid_width-2; x++) { VFLOATP (w,  x, y, z) = nw [x-2]; }
	for (x = 2; x < bgrid_width-2; x++) { VFLOATP (wi, x, y, z) = nwi[x-2]; }
    }
}

/* Gaussian @ Y */

for (z = 2; z < bgrid_range-2; z++) {
    for (x = 2; x < bgrid_width-2; x++) {
	for (y = 2; y < bgrid_height-2; y++) {
	    nw  [y-2] = GY(w,  x, y, z);
	    nwi [y-2] = GY(wi, x, y, z);
	}

	for (y = 2; y < bgrid_height-2; y++) { VFLOATP (w,  x, y, z) = nw [y-2]; }
	for (y = 2; y < bgrid_height-2; y++) { VFLOATP (wi, x, y, z) = nwi[y-2]; }
    }
}


/* Gaussian @ Z */

for (y = 2; y < bgrid_height-2; y++) {
    for (x = 2; x < bgrid_width-2; x++) {
	for (z = 2; z < bgrid_range-2; z++) {
	    nw  [z-2] = GZ(w,  x, y, z);
	    nwi [z-2] = GZ(wi, x, y, z);
	}

	for (z = 2; z < bgrid_range-2; z++) { VFLOATP (w,  x, y, z) = nw [z-2]; }
	for (z = 2; z < bgrid_range-2; z++) { VFLOATP (wi, x, y, z) = nwi[z-2]; }
    }
}

#undef GX
#undef GY
#undef GZ
#undef GAUSS

/*
 * Phase IV. Resample the image using the updated bilateral grid and trilinear
 * interpolation.
 *
 * #define I(a,b,s) ((b) + ((a)-(b))*(s))
 */

#define BETWEEN(a,b,s) ((a)*(s) + (b)*(1-(s)))

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	double winew, wnew, p = GREY8 (image, x, y);

	/* Continuous grid location */
	double xf = 2 + ((double) x) / sigma_space;
	double yf = 2 + ((double) y) / sigma_space;
	double pf = 2 + p / sigma_range;

	/* Integral grid location */
	int xr = lrint (xf);
	int yr = lrint (yf);
	int pr = lrint (pf);

	/* Fractional grid location from the integral */
	if (xr > xf) { xr -- ; } ; xf = xf - xr;
	if (yr > yf) { yr -- ; } ; yf = yf - yr;
	if (pr > pf) { pr -- ; } ; pf = pf - pr;

	/* Trilinear interpolate over the grid */

	winew = BETWEEN (BETWEEN (BETWEEN (VFLOATP (wi, xr, yr,   pr),   VFLOATP (wi, xr+1, yr,   pr),   xf),
				  BETWEEN (VFLOATP (wi, xr, yr+1, pr),   VFLOATP (wi, xr+1, yr+1, pr),   xf), yf),
			 BETWEEN (BETWEEN (VFLOATP (wi, xr, yr,   pr+1), VFLOATP (wi, xr+1, yr,   pr+1), xf),
				  BETWEEN (VFLOATP (wi, xr, yr+1, pr+1), VFLOATP (wi, xr+1, yr+1, pr+1), xf), yf), pf);

	wnew  = BETWEEN (BETWEEN (BETWEEN (VFLOATP (w, xr, yr,   pr),   VFLOATP (w, xr+1, yr,   pr),   xf),
				  BETWEEN (VFLOATP (w, xr, yr+1, pr),   VFLOATP (w, xr+1, yr+1, pr),   xf), yf),
			 BETWEEN (BETWEEN (VFLOATP (w, xr, yr,   pr+1), VFLOATP (w, xr+1, yr,   pr+1), xf),
				  BETWEEN (VFLOATP (w, xr, yr+1, pr+1), VFLOATP (w, xr+1, yr+1, pr+1), xf), yf), pf);

	GREY8 (result, x, y) = CLAMP (0, (winew / wnew), 255);
    }
}

#undef BETWEEN

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/log-float.crimp.








































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

log_float
Tcl_Obj* imageObj

/*
 * Natural logarithm of all pixels of the image.
 */

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, float);

result = crimp_new_like (image);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = log (FLOATP (image, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/log10-float.crimp.








































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

log10_float
Tcl_Obj* imageObj

/*
 * Decimal logarithm of all pixels of the image.
 */

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, float);

result = crimp_new_like (image);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = log10 (FLOATP (image, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/map-grey8.crimp.


































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

map_grey8
Tcl_Obj* imageObj
Tcl_Obj* mapImageObj

/*
 * This operation is a generalized per-pixel transformation, mapping
 * pixel values to other pixel values in a completely arbitrary way.
 * Inversion, partial inversion, histogram equalization, etc. all are
 * possible through this.
 *
 * Important: For the sake of convenience the map is not provided as a
 * (Tcl) list (of values), or array, but as an _image_ itself, a 256x1
 * (WxH) grey8. We will have constructors for such images.
 *
 * The same approach will be used by the conditional mappers where the
 * transformation of one channel in a multi-channel image will be
 * controlled by data in a second channel, this can be represented as
 * a 256x256 grey8 image, each row the map to be used for one of the
 * possible controlling values.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     map;
int              x, y;

crimp_input (imageObj,    image, grey8);
crimp_input (mapImageObj, map,   grey8);

if (!crimp_require_dim (map, 256, 1)) {
    Tcl_SetResult(interp, "bad image dimension for map, expected 256x1", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (image);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	/*
	 * Run the pixel value of the input image through the map to
	 * produce the value for the output.
	 */

      GREY8 (result, x, y) = GREY8 (map, GREY8 (image, x, y), 0);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/map-hsv.crimp.




















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

map_hsv
Tcl_Obj* imageObj
Tcl_Obj* hueMapImageObj
Tcl_Obj* satMapImageObj
Tcl_Obj* valMapImageObj

/*
 * This operation is a generalized per-pixel transformation, mapping
 * pixel values to other pixel values in a completely arbitrary way.
 * Inversion, partial inversion, histogram equalization, etc. all are
 * possible through this.
 *
 * Important: For the sake of convenience the map is not provided as a
 * (Tcl) list (of values), or array, but as an _image_ itself, a 256x1
 * (WxH) grey8. We will have constructors for such images.
 *
 * The same approach will be used by the conditional mappers where the
 * transformation of one channel in a multi-channel image will be
 * controlled by data in a second channel, this can be represented as
 * a 256x256 grey8 image, each row the map to be used for one of the
 * possible controlling values.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     hueMap;
crimp_image*     satMap;
crimp_image*     valMap;
int              x, y;

crimp_input (imageObj,       image,  hsv);
crimp_input (hueMapImageObj, hueMap, grey8);
crimp_input (satMapImageObj, satMap, grey8);
crimp_input (valMapImageObj, valMap, grey8);

if (!crimp_require_dim (hueMap, 256, 1)) {
    Tcl_SetResult(interp, "bad image dimension for hue map, expected 256x1", TCL_STATIC);
    return TCL_ERROR;
}

if (!crimp_require_dim (satMap, 256, 1)) {
    Tcl_SetResult(interp, "bad image dimension for saturation map, expected 256x1", TCL_STATIC);
    return TCL_ERROR;
}

if (!crimp_require_dim (valMap, 256, 1)) {
    Tcl_SetResult(interp, "bad image dimension for value map, expected 256x1", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (image);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	/*
	 * Run the pixel value of the input image through the map to
	 * produce the value for the output.
	 */

      H (result, x, y) = GREY8 (hueMap, H (image, x, y), 0);
      S (result, x, y) = GREY8 (satMap, S (image, x, y), 0);
      V (result, x, y) = GREY8 (valMap, V (image, x, y), 0);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/map-rgb.crimp.




















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

map_rgb
Tcl_Obj* imageObj
Tcl_Obj* redMapImageObj
Tcl_Obj* greenMapImageObj
Tcl_Obj* blueMapImageObj

/*
 * This operation is a generalized per-pixel transformation, mapping
 * pixel values to other pixel values in a completely arbitrary way.
 * Inversion, partial inversion, histogram equalization, etc. all are
 * possible through this.
 *
 * Important: For the sake of convenience the map is not provided as a
 * (Tcl) list (of values), or array, but as an _image_ itself, a 256x1
 * (WxH) grey8. We will have constructors for such images.
 *
 * The same approach will be used by the conditional mappers where the
 * transformation of one channel in a multi-channel image will be
 * controlled by data in a second channel, this can be represented as
 * a 256x256 grey8 image, each row the map to be used for one of the
 * possible controlling values.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     redMap;
crimp_image*     greenMap;
crimp_image*     blueMap;
int              x, y;

crimp_input (imageObj,         image,    rgb);
crimp_input (redMapImageObj,   redMap,   grey8);
crimp_input (greenMapImageObj, greenMap, grey8);
crimp_input (blueMapImageObj,  blueMap,  grey8);

if (!crimp_require_dim (redMap, 256, 1)) {
    Tcl_SetResult(interp, "bad image dimension for red map, expected 256x1", TCL_STATIC);
    return TCL_ERROR;
}

if (!crimp_require_dim (greenMap, 256, 1)) {
    Tcl_SetResult(interp, "bad image dimension for green map, expected 256x1", TCL_STATIC);
    return TCL_ERROR;
}

if (!crimp_require_dim (blueMap, 256, 1)) {
    Tcl_SetResult(interp, "bad image dimension for blue map, expected 256x1", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (image);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	/*
	 * Run the pixel value of the input image through the map to
	 * produce the value for the output.
	 */

      R (result, x, y) = GREY8 (redMap,   R (image, x, y), 0);
      G (result, x, y) = GREY8 (greenMap, G (image, x, y), 0);
      B (result, x, y) = GREY8 (blueMap,  B (image, x, y), 0);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/map-rgba.crimp.





























































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

map_rgba
Tcl_Obj* imageObj
Tcl_Obj* redMapImageObj
Tcl_Obj* greenMapImageObj
Tcl_Obj* blueMapImageObj
Tcl_Obj* alphaMapImageObj

/*
 * This operation is a generalized per-pixel transformation, mapping
 * pixel values to other pixel values in a completely arbitrary way.
 * Inversion, partial inversion, histogram equalization, etc. all are
 * possible through this.
 *
 * Important: For the sake of convenience the map is not provided as a
 * (Tcl) list (of values), or array, but as an _image_ itself, a 256x1
 * (WxH) grey8. We will have constructors for such images.
 *
 * The same approach will be used by the conditional mappers where the
 * transformation of one channel in a multi-channel image will be
 * controlled by data in a second channel, this can be represented as
 * a 256x256 grey8 image, each row the map to be used for one of the
 * possible controlling values.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     redMap;
crimp_image*     greenMap;
crimp_image*     blueMap;
crimp_image*     alphaMap;
int              x, y;

crimp_input (imageObj,         image,    rgba);
crimp_input (redMapImageObj,   redMap,   grey8);
crimp_input (greenMapImageObj, greenMap, grey8);
crimp_input (blueMapImageObj,  blueMap,  grey8);
crimp_input (alphaMapImageObj, alphaMap, grey8);

if (!crimp_require_dim (redMap, 256, 1)) {
    Tcl_SetResult(interp, "bad image dimension for red map, expected 256x1", TCL_STATIC);
    return TCL_ERROR;
}

if (!crimp_require_dim (greenMap, 256, 1)) {
    Tcl_SetResult(interp, "bad image dimension for green map, expected 256x1", TCL_STATIC);
    return TCL_ERROR;
}

if (!crimp_require_dim (blueMap, 256, 1)) {
    Tcl_SetResult(interp, "bad image dimension for blue map, expected 256x1", TCL_STATIC);
    return TCL_ERROR;
}

if (!crimp_require_dim (alphaMap, 256, 1)) {
    Tcl_SetResult(interp, "bad image dimension for alpha map, expected 256x1", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (image);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	/*
	 * Run the pixel value of the input image through the map to
	 * produce the value for the output.
	 */

      R (result, x, y) = GREY8 (redMap,   R (image, x, y), 0);
      G (result, x, y) = GREY8 (greenMap, G (image, x, y), 0);
      B (result, x, y) = GREY8 (blueMap,  B (image, x, y), 0);
      A (result, x, y) = GREY8 (alphaMap, A (image, x, y), 0);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/map2-hsv.crimp.



































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

map2_hsv
Tcl_Obj* imageObj
Tcl_Obj* hueMapImageObj
Tcl_Obj* satMapImageObj
Tcl_Obj* valMapImageObj
int hueControlChannel
int satControlChannel
int valControlChannel

/*
 * This operation is a generalized per-pixel transformation, mapping pixel
 * values to other pixel values in a completely arbitrary way. In contrast to
 * the map_* family of primitives here the mapping for one channel is
 * controlled by the data in a second channel. I.e. instead of a 256x1 table
 * we have 256 of these, in a single 256x256 map, with one channel selecting
 * the map to use for the other. Effects possible with this are hue-dependent
 * changes to saturation or value, value dependent color-shifts, etc.
 *
 * Important: For the sake of convenience the map is not provided as a (Tcl)
 * list (of values), or array, but as an _image_ itself, a 256x256 (WxH)
 * grey8. We have constructors for such images (read-tcl primitive).
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     hueMap;
crimp_image*     satMap;
crimp_image*     valMap;
int              x, y;

crimp_input (imageObj,       image,  hsv);
crimp_input (hueMapImageObj, hueMap, grey8);
crimp_input (satMapImageObj, satMap, grey8);
crimp_input (valMapImageObj, valMap, grey8);

if (!crimp_require_dim (hueMap, 256, 256)) {
    Tcl_SetResult(interp, "bad image dimension for hue map, expected 256x256", TCL_STATIC);
    return TCL_ERROR;
}

if (!crimp_require_dim (satMap, 256, 256)) {
    Tcl_SetResult(interp, "bad image dimension for saturation map, expected 256x256", TCL_STATIC);
    return TCL_ERROR;
}

if (!crimp_require_dim (valMap, 256, 256)) {
    Tcl_SetResult(interp, "bad image dimension for value map, expected 256x256", TCL_STATIC);
    return TCL_ERROR;
}

if (!RANGEOK (hueControlChannel,2)) {
    Tcl_SetResult(interp, "bad control for hue map, expected index in (0...2)", TCL_STATIC);
    return TCL_ERROR;
}

if (!RANGEOK (satControlChannel,2)) {
    Tcl_SetResult(interp, "bad control for saturation map, expected index in (0...2)", TCL_STATIC);
    return TCL_ERROR;
}

if (!RANGEOK (valControlChannel,2)) {
    Tcl_SetResult(interp, "bad control for value map, expected index in (0...2)", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (image);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	/*
	 * Run the pixel value of the input image through the map to
	 * produce the value for the output.
	 */

      H (result, x, y) = GREY8 (hueMap, H (image, x, y), CH (image, hueControlChannel, x, y));
      S (result, x, y) = GREY8 (satMap, S (image, x, y), CH (image, satControlChannel, x, y));
      V (result, x, y) = GREY8 (valMap, V (image, x, y), CH (image, valControlChannel, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/map2-rgb.crimp.



































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

map2_rgb
Tcl_Obj* imageObj
Tcl_Obj* redMapImageObj
Tcl_Obj* greenMapImageObj
Tcl_Obj* blueMapImageObj
int redControlChannel
int greenControlChannel
int blueControlChannel

/*
 * This operation is a generalized per-pixel transformation, mapping pixel
 * values to other pixel values in a completely arbitrary way. In contrast to
 * the map_* family of primitives here the mapping for one channel is
 * controlled by the data in a second channel. I.e. instead of a 256x1 table
 * we have 256 of these, in a single 256x256 map, with one channel selecting
 * the map to use for the other. Effects possible with this are hue-dependent
 * changes to saturation or value, value dependent color-shifts, etc.
 *
 * Important: For the sake of convenience the map is not provided as a (Tcl)
 * list (of values), or array, but as an _image_ itself, a 256x256 (WxH)
 * grey8. We have constructors for such images (read-tcl primitive).
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     redMap;
crimp_image*     greenMap;
crimp_image*     blueMap;
int              x, y;

crimp_input (imageObj,         image,    rgb);
crimp_input (redMapImageObj,   redMap,   grey8);
crimp_input (greenMapImageObj, greenMap, grey8);
crimp_input (blueMapImageObj,  blueMap,  grey8);

if (!crimp_require_dim (redMap, 256, 256)) {
    Tcl_SetResult(interp, "bad image dimension for red map, expected 256x256", TCL_STATIC);
    return TCL_ERROR;
}

if (!crimp_require_dim (greenMap, 256, 256)) {
    Tcl_SetResult(interp, "bad image dimension for green map, expected 256x256", TCL_STATIC);
    return TCL_ERROR;
}

if (!crimp_require_dim (blueMap, 256, 256)) {
    Tcl_SetResult(interp, "bad image dimension for blue map, expected 256x256", TCL_STATIC);
    return TCL_ERROR;
}

if (!RANGEOK (redControlChannel,2)) {
    Tcl_SetResult(interp, "bad control for red map, expected index in (0...2)", TCL_STATIC);
    return TCL_ERROR;
}

if (!RANGEOK (greenControlChannel,2)) {
    Tcl_SetResult(interp, "bad control for green map, expected index in (0...2)", TCL_STATIC);
    return TCL_ERROR;
}

if (!RANGEOK (blueControlChannel,2)) {
    Tcl_SetResult(interp, "bad control for blue map, expected index in (0...2)", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (image);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	/*
	 * Run the pixel value of the input image through the map to
	 * produce the value for the output.
	 */

      R (result, x, y) = GREY8 (redMap,   R (image, x, y), CH (image, redControlChannel,   x, y));
      G (result, x, y) = GREY8 (greenMap, G (image, x, y), CH (image, greenControlChannel, x, y));
      B (result, x, y) = GREY8 (blueMap,  B (image, x, y), CH (image, blueControlChannel,  x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/map2-rgba.crimp.


















































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

map2_rgba
Tcl_Obj* imageObj
Tcl_Obj* redMapImageObj
Tcl_Obj* greenMapImageObj
Tcl_Obj* blueMapImageObj
Tcl_Obj* alphaMapImageObj
int redControlChannel
int greenControlChannel
int blueControlChannel
int alphaControlChannel

/*
 * This operation is a generalized per-pixel transformation, mapping pixel
 * values to other pixel values in a completely arbitrary way. In contrast to
 * the map_* family of primitives here the mapping for one channel is
 * controlled by the data in a second channel. I.e. instead of a 256x1 table
 * we have 256 of these, in a single 256x256 map, with one channel selecting
 * the map to use for the other. Effects possible with this are hue-dependent
 * changes to saturation or value, value dependent color-shifts, etc.
 *
 * Important: For the sake of convenience the map is not provided as a (Tcl)
 * list (of values), or array, but as an _image_ itself, a 256x256 (WxH)
 * grey8. We have constructors for such images (read-tcl primitive).
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     redMap;
crimp_image*     greenMap;
crimp_image*     blueMap;
crimp_image*     alphaMap;
int              x, y;

crimp_input (imageObj,         image,    rgb);
crimp_input (redMapImageObj,   redMap,   grey8);
crimp_input (greenMapImageObj, greenMap, grey8);
crimp_input (blueMapImageObj,  blueMap,  grey8);
crimp_input (alphaMapImageObj, alphaMap, grey8);

if (!crimp_require_dim (redMap, 256, 256)) {
    Tcl_SetResult(interp, "bad image dimension for red map, expected 256x256", TCL_STATIC);
    return TCL_ERROR;
}

if (!crimp_require_dim (greenMap, 256, 256)) {
    Tcl_SetResult(interp, "bad image dimension for green map, expected 256x256", TCL_STATIC);
    return TCL_ERROR;
}

if (!crimp_require_dim (blueMap, 256, 256)) {
    Tcl_SetResult(interp, "bad image dimension for blue map, expected 256x256", TCL_STATIC);
    return TCL_ERROR;
}

if (!crimp_require_dim (alphaMap, 256, 256)) {
    Tcl_SetResult(interp, "bad image dimension for alpha map, expected 256x256", TCL_STATIC);
    return TCL_ERROR;
}

if (!RANGEOK (redControlChannel,3)) {
    Tcl_SetResult(interp, "bad control for red map, expected index in (0...3)", TCL_STATIC);
    return TCL_ERROR;
}

if (!RANGEOK (greenControlChannel,3)) {
    Tcl_SetResult(interp, "bad control for green map, expected index in (0...3)", TCL_STATIC);
    return TCL_ERROR;
}

if (!RANGEOK (blueControlChannel,3)) {
    Tcl_SetResult(interp, "bad control for blue map, expected index in (0...3)", TCL_STATIC);
    return TCL_ERROR;
}

if (!RANGEOK (alphaControlChannel,3)) {
    Tcl_SetResult(interp, "bad control for alpha map, expected index in (0...3)", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (image);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	/*
	 * Run the pixel value of the input image through the map to
	 * produce the value for the output.
	 */

      R (result, x, y) = GREY8 (redMap,   R (image, x, y), CH (image, redControlChannel,   x, y));
      G (result, x, y) = GREY8 (greenMap, G (image, x, y), CH (image, greenControlChannel, x, y));
      B (result, x, y) = GREY8 (blueMap,  B (image, x, y), CH (image, blueControlChannel,  x, y));
      A (result, x, y) = GREY8 (alphaMap, A (image, x, y), CH (image, alphaControlChannel, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/matinv3x3-float.crimp.















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

matinv3x3_float
Tcl_Obj* matObj

/*
 * Invert a 3x3 float matrix A.
 */

crimp_image*     mat;
crimp_image*     result;
int              x, y;

double cofactor [3][3];
double det = 0;
double sign = 1;

crimp_input (matObj, mat, float);

if (!crimp_require_dim (mat, 3, 3)) {
    Tcl_SetResult(interp, "bad matrix dimensions, expected 3x3", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_la_invert_matrix_3x3 (mat);

if (!result) {
    Tcl_SetResult(interp, "Unable to invert singular matrix", TCL_STATIC);
    return TCL_ERROR;
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/matmul3x3-float.crimp.













































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

matmul3x3_float
Tcl_Obj* matAObj
Tcl_Obj* matBObj

/*
 * Multiply two 3x3 float matrices A and B. Returns A*B.
 */

crimp_image*     matA;
crimp_image*     matB;
crimp_image*     result;
int              w, x, y;

crimp_input (matAObj,    matA, float);
crimp_input (matBObj,    matB, float);

if (!crimp_require_dim (matA, 3, 3)) {
    Tcl_SetResult(interp, "bad matrix dimensions, expected 3x3", TCL_STATIC);
    return TCL_ERROR;
}
if (!crimp_require_dim (matB, 3, 3)) {
    Tcl_SetResult(interp, "bad matrix dimensions, expected 3x3", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_la_multiply_matrix (matA, matB);

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/matrix.crimp.


































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

matrix
Tcl_Obj* imageObj Tcl_Obj* matrixObj

int objc;
Tcl_Obj **rowv, **colv;
double matrix[3][3];
int i, j, w, h;
double cofact[3][3], invert[3][3];
double det = 0;
double sign = 1;
crimp_image*     result;
crimp_image*     image;
int oy, ox, c, iy, ix;
double oyf, oxf;

/*
 * Generic image deformation. The result is restricted to the input
 * dimensions.  Consider flag to allow the result to expand to fit all pixels.
 * It is unclear from the math below if this a projective transform, or
 * something else.
 */

/*
 * Decode the matrix (a list of lists of 3 doubles).
 * Would be easier to provide as list of 9 doubles, no nesting.
 * The higher levels would convert between the representations.
 */

if (Tcl_ListObjGetElements(interp, matrixObj, &objc, &rowv) != TCL_OK) {
    return TCL_ERROR;
} else if (objc != 3) {
    Tcl_SetResult(interp, "invalid matrix format", TCL_STATIC);
    return TCL_ERROR;
}

for (i = 0; i < 3; ++i) {
    if (Tcl_ListObjGetElements(interp, rowv[i], &objc, &colv) != TCL_OK) {
        return TCL_ERROR;
    } else if (objc != 3) {
        Tcl_SetResult(interp, "invalid matrix format", TCL_STATIC);
        return TCL_ERROR;
    }
    for (j = 0; j < 3; ++j) {
        if (Tcl_GetDoubleFromObj(interp, colv[j], &matrix[i][j]) != TCL_OK) {
            return TCL_ERROR;
        }
    }
}

/*
 * Invert the matrix.
 */

for (i = 0; i < 3; ++i) {
    int i1 = !i, i2 = 2 - !(i - 2);
    for (j = 0; j < 3; ++j) {
        int j1 = !j, j2 = 2 - !(j - 2);
        cofact[i][j] = sign * (matrix[i1][j1] * matrix[i2][j2]
                             - matrix[i1][j2] * matrix[i2][j1]);
        sign = -sign;
    }
    det += matrix[i][0] * cofact[i][0];
}
if (det == 0) {
    Tcl_SetResult(interp, "singular matrix", TCL_STATIC);
    return TCL_ERROR;
}
for (i = 0; i < 3; ++i) {
    for (j = 0; j < 3; ++j) {
        invert[i][j] = cofact[j][i] / det;
    }
}

crimp_input (imageObj, image, rgba);

w = image->w;
h = image->h;

result = crimp_new_like (image);

for (oy = 0, oyf = -1; oy < h; ++oy, oyf += 2.0 / h) {
    for (ox = 0, oxf = -1; ox < w; ++ox, oxf += 2.0 / w) {
        double ixf = (invert[0][0] * oxf + invert[0][1] * oyf + invert[0][2]);
        double iyf = (invert[1][0] * oxf + invert[1][1] * oyf + invert[1][2]);
        double iwf = (invert[2][0] * oxf + invert[2][1] * oyf + invert[2][2]);
        int ixw;
        int iyw;

        ixf = ((ixf / iwf) + 1) * w / 2;
        iyf = ((iyf / iwf) + 1) * h / 2;

        ixw = ixf;
        iyw = iyf;

        ixf -= ixw;
        iyf -= iyw;

        for (c = 0; c < 4; ++c) {
            float val = 0;
            for (iy = MAX(iyw, 0); iy < MIN(iyw + 2, h); ++iy) {
                iyf = 1 - iyf;
                for (ix = MAX(ixw, 0); ix < MIN(ixw + 2, w); ++ix) {
                    ixf = 1 - ixf;

		    val += CH (image, c, ix, iy) * iyf * ixf;
                }
            }

	    CH (result,c,ox,oy) = val;
        }
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/max-float-float.crimp.






















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

max_float_float
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

#define BINOP(a,b) (MAX((a),(b)))
#include "binop_float_float.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/max-float-grey16.crimp.






















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

max_float_grey16
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

#define BINOP(a,b) (MAX((a),(b)))
#include "binop_float_grey16.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/max-float-grey32.crimp.






















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

max_float_grey32
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

#define BINOP(a,b) (MAX((a),(b)))
#include "binop_float_grey32.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/max-float-grey8.crimp.






















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

max_float_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

#define BINOP(a,b) (MAX((a),(b)))
#include "binop_float_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/max-grey8-grey8.crimp.






















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

max_grey8_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

#define BINOP(a,b) (MAX((a),(b)))
#include "binop_grey8_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/max-rgb-grey8.crimp.






















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

max_rgb_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

#define BINOP(a,b) (MAX((a),(b)))
#include "binop_rgb_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/max-rgb-rgb.crimp.






















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

max_rgb_rgb
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

#define BINOP(a,b) (MAX((a),(b)))
#include "binop_rgb_rgb.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/max-rgba-grey8.crimp.






















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

max_rgba_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

#define BINOP(a,b) (MAX((a),(b)))
#include "binop_rgba_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/max-rgba-rgb.crimp.






















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

max_rgba_rgb
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

#define BINOP(a,b) (MAX((a),(b)))
#include "binop_rgba_rgb.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/max-rgba-rgba.crimp.






















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

max_rgba_rgba
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

#define BINOP(a,b) (MAX((a),(b)))
#include "binop_rgba_rgba.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/meta_get.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

meta_get
Tcl_Obj* imageObj

crimp_image* image;

crimp_input_any (imageObj, image);

if (image->meta) {
    Tcl_SetObjResult (interp, image->meta);
}
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/meta_set.crimp.























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

meta_set
Tcl_Obj* imageObj
Tcl_Obj* metaObj

crimp_image* image;

crimp_input_any (imageObj, image);

/*
 * Nothing to do if the assignment doesn't change anything.
 */

if (metaObj == image->meta) {
    Tcl_SetObjResult (interp, imageObj);
    return TCL_OK;
}

/*
 * For a non-shared image we can replace in-place, avoiding a memory copy.
 */

if (!Tcl_IsShared(imageObj)) {
    Tcl_IncrRefCount (metaObj);
    Tcl_DecrRefCount (image->meta);
    image->meta = metaObj;

    Tcl_SetObjResult (interp, imageObj);
    return TCL_OK;
}

/*
 * Create a new image with the modified meta data reference and otherwise
 * identical.
 */

image = crimp_newm (image->itype, image->w, image->h, metaObj);

Tcl_SetObjResult(interp, crimp_new_image_obj (image));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/min-float-float.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

min_float_float
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise min-combination of two images. The images have to
 * have equal dimensions.
 */

#define BINOP(a,b) (MIN((a),(b)))
#include "binop_float_float.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/min-float-grey16.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

min_float_grey16
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise min-combination of two images. The images have to
 * have equal dimensions.
 */

#define BINOP(a,b) (MIN((a),(b)))
#include "binop_float_grey16.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/min-float-grey32.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

min_float_grey32
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise min-combination of two images. The images have to
 * have equal dimensions.
 */

#define BINOP(a,b) (MIN((a),(b)))
#include "binop_float_grey32.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/min-float-grey8.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

min_float_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise min-combination of two images. The images have to
 * have equal dimensions.
 */

#define BINOP(a,b) (MIN((a),(b)))
#include "binop_float_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/min-grey8-grey8.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

min_grey8_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise min-combination of two images. The images have to
 * have equal dimensions.
 */

#define BINOP(a,b) (MIN((a),(b)))
#include "binop_grey8_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/min-rgb-grey8.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

min_rgb_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise min-combination of two images. The images have to
 * have equal dimensions.
 */

#define BINOP(a,b) (MIN((a),(b)))
#include "binop_rgb_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/min-rgb-rgb.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

min_rgb_rgb
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise min-combination of two images. The images have to
 * have equal dimensions.
 */

#define BINOP(a,b) (MIN((a),(b)))
#include "binop_rgb_rgb.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/min-rgba-grey8.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

min_rgba_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise min-combination of two images. The images have to
 * have equal dimensions.
 */

#define BINOP(a,b) (MIN((a),(b)))
#include "binop_rgba_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/min-rgba-rgb.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

min_rgba_rgb
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise min-combination of two images. The images have to
 * have equal dimensions.
 */

#define BINOP(a,b) (MIN((a),(b)))
#include "binop_rgba_rgb.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/min-rgba-rgba.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

min_rgba_rgba
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise min-combination of two images. The images have to
 * have equal dimensions.
 */

#define BINOP(a,b) (MIN((a),(b)))
#include "binop_rgba_rgba.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/montageh-float.crimp.























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

montageh_float
Tcl_Obj* imageLeftObj
Tcl_Obj* imageRightObj

/*
 * Place the two images adjacent to each other in the result, from left to
 * right. The images have to have the same height.
 */

crimp_image*     result;
crimp_image*     imageLeft;
crimp_image*     imageRight;
int x, y;

crimp_input (imageLeftObj,  imageLeft,  float);
crimp_input (imageRightObj, imageRight, float);

if (!crimp_eq_height (imageLeft, imageRight)) {
    Tcl_SetResult(interp, "image heights do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_float (imageLeft->w + imageRight->w, imageLeft->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < imageLeft->w; x++) {

	FLOATP (result, x, y) = FLOATP (imageLeft, x, y);
    }
}

for (y = 0; y < result->h; y++) {
    for (x = 0; x < imageRight->w; x++) {

	FLOATP (result, imageLeft->w + x, y) = FLOATP (imageRight, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/montageh-grey8.crimp.























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

montageh_grey8
Tcl_Obj* imageLeftObj
Tcl_Obj* imageRightObj

/*
 * Place the two images adjacent to each other in the result, from left to
 * right. The images have to have the same height.
 */

crimp_image*     result;
crimp_image*     imageLeft;
crimp_image*     imageRight;
int x, y;

crimp_input (imageLeftObj,  imageLeft,  grey8);
crimp_input (imageRightObj, imageRight, grey8);

if (!crimp_eq_height (imageLeft, imageRight)) {
    Tcl_SetResult(interp, "image heights do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_grey8 (imageLeft->w + imageRight->w, imageLeft->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < imageLeft->w; x++) {

	GREY8 (result, x, y) = GREY8 (imageLeft, x, y);
    }
}

for (y = 0; y < result->h; y++) {
    for (x = 0; x < imageRight->w; x++) {

	GREY8 (result, imageLeft->w + x, y) = GREY8 (imageRight, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/montageh-hsv.crimp.



























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

montageh_hsv
Tcl_Obj* imageLeftObj
Tcl_Obj* imageRightObj

/*
 * Place the two images adjacent to each other in the result, from left to
 * right. The images have to have the same height.
 */

crimp_image*     result;
crimp_image*     imageLeft;
crimp_image*     imageRight;
int x, y;

crimp_input (imageLeftObj,  imageLeft,  hsv);
crimp_input (imageRightObj, imageRight, hsv);

if (!crimp_eq_height (imageLeft, imageRight)) {
    Tcl_SetResult(interp, "image heights do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_hsv (imageLeft->w + imageRight->w, imageLeft->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < imageLeft->w; x++) {

	H (result, x, y) = H (imageLeft, x, y);
	S (result, x, y) = S (imageLeft, x, y);
	V (result, x, y) = V (imageLeft, x, y);
    }
}

for (y = 0; y < result->h; y++) {
    for (x = 0; x < imageRight->w; x++) {

	H (result, imageLeft->w + x, y) = H (imageRight, x, y);
	S (result, imageLeft->w + x, y) = S (imageRight, x, y);
	V (result, imageLeft->w + x, y) = V (imageRight, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/montageh-rgb.crimp.



























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

montageh_rgb
Tcl_Obj* imageLeftObj
Tcl_Obj* imageRightObj

/*
 * Place the two images adjacent to each other in the result, from left to
 * right. The images have to have the same height.
 */

crimp_image*     result;
crimp_image*     imageLeft;
crimp_image*     imageRight;
int x, y;

crimp_input (imageLeftObj,  imageLeft,  rgb);
crimp_input (imageRightObj, imageRight, rgb);

if (!crimp_eq_height (imageLeft, imageRight)) {
    Tcl_SetResult(interp, "image heights do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_rgb (imageLeft->w + imageRight->w, imageLeft->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < imageLeft->w; x++) {

	R (result, x, y) = R (imageLeft, x, y);
	G (result, x, y) = G (imageLeft, x, y);
	B (result, x, y) = B (imageLeft, x, y);
    }
}

for (y = 0; y < result->h; y++) {
    for (x = 0; x < imageRight->w; x++) {

	R (result, imageLeft->w + x, y) = R (imageRight, x, y);
	G (result, imageLeft->w + x, y) = G (imageRight, x, y);
	B (result, imageLeft->w + x, y) = B (imageRight, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/montageh-rgba.crimp.





























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

montageh_rgba
Tcl_Obj* imageLeftObj
Tcl_Obj* imageRightObj

/*
 * Place the two images adjacent to each other in the result, from left to
 * right. The images have to have the same height.
 */

crimp_image*     result;
crimp_image*     imageLeft;
crimp_image*     imageRight;
int x, y;

crimp_input (imageLeftObj,  imageLeft,  rgba);
crimp_input (imageRightObj, imageRight, rgba);

if (!crimp_eq_height (imageLeft, imageRight)) {
    Tcl_SetResult(interp, "image heights do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_rgba (imageLeft->w + imageRight->w, imageLeft->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < imageLeft->w; x++) {

	R (result, x, y) = R (imageLeft, x, y);
	G (result, x, y) = G (imageLeft, x, y);
	B (result, x, y) = B (imageLeft, x, y);
	A (result, x, y) = A (imageLeft, x, y);
    }
}

for (y = 0; y < result->h; y++) {
    for (x = 0; x < imageRight->w; x++) {

	R (result, imageLeft->w + x, y) = R (imageRight, x, y);
	G (result, imageLeft->w + x, y) = G (imageRight, x, y);
	B (result, imageLeft->w + x, y) = B (imageRight, x, y);
	A (result, imageLeft->w + x, y) = A (imageRight, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/montagev-float.crimp.























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

montagev_float
Tcl_Obj* imageTopObj
Tcl_Obj* imageBottomObj

/*
 * Place the two images adjacent to each other in the result, from left to
 * right. The images have to have the same width.
 */

crimp_image*     result;
crimp_image*     imageTop;
crimp_image*     imageBottom;
int x, y;

crimp_input (imageTopObj,    imageTop,    float);
crimp_input (imageBottomObj, imageBottom, float);

if (!crimp_eq_width (imageTop, imageBottom)) {
    Tcl_SetResult(interp, "image widths do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_float (imageTop->w, imageTop->h + imageBottom->h);

for (y = 0; y < imageTop->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = FLOATP (imageTop, x, y);
    }
}

for (y = 0; y < imageBottom->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, imageTop->h + y) = FLOATP (imageBottom, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/montagev-grey8.crimp.























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

montagev_grey8
Tcl_Obj* imageTopObj
Tcl_Obj* imageBottomObj

/*
 * Place the two images adjacent to each other in the result, from left to
 * right. The images have to have the same width.
 */

crimp_image*     result;
crimp_image*     imageTop;
crimp_image*     imageBottom;
int x, y;

crimp_input (imageTopObj,    imageTop,    grey8);
crimp_input (imageBottomObj, imageBottom, grey8);

if (!crimp_eq_width (imageTop, imageBottom)) {
    Tcl_SetResult(interp, "image widths do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_grey8 (imageTop->w, imageTop->h + imageBottom->h);

for (y = 0; y < imageTop->h; y++) {
    for (x = 0; x < result->w; x++) {

	GREY8 (result, x, y) = GREY8 (imageTop, x, y);
    }
}

for (y = 0; y < imageBottom->h; y++) {
    for (x = 0; x < result->w; x++) {

	GREY8 (result, x, imageTop->h + y) = GREY8 (imageBottom, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/montagev-hsv.crimp.



























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

montagev_hsv
Tcl_Obj* imageTopObj
Tcl_Obj* imageBottomObj

/*
 * Place the two images adjacent to each other in the result, from top to
 * bottom. The images have to have the same width.
 */

crimp_image*     result;
crimp_image*     imageTop;
crimp_image*     imageBottom;
int x, y;

crimp_input (imageTopObj,    imageTop,    hsv);
crimp_input (imageBottomObj, imageBottom, hsv);

if (!crimp_eq_width (imageTop, imageBottom)) {
    Tcl_SetResult(interp, "image widths do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_hsv (imageTop->w, imageTop->h + imageBottom->h);

for (y = 0; y < imageTop->h; y++) {
    for (x = 0; x < result->w; x++) {

	H (result, x, y) = H (imageTop, x, y);
	S (result, x, y) = S (imageTop, x, y);
	V (result, x, y) = V (imageTop, x, y);
    }
}

for (y = 0; y < imageBottom->h; y++) {
    for (x = 0; x < result->w; x++) {

	H (result, x, imageTop->h + y) = H (imageBottom, x, y);
	S (result, x, imageTop->h + y) = S (imageBottom, x, y);
	V (result, x, imageTop->h + y) = V (imageBottom, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/montagev-rgb.crimp.



























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

montagev_rgb
Tcl_Obj* imageTopObj
Tcl_Obj* imageBottomObj

/*
 * Place the two images adjacent to each other in the result, from top to
 * bottom. The images have to have the same width.
 */

crimp_image*     result;
crimp_image*     imageTop;
crimp_image*     imageBottom;
int x, y;

crimp_input (imageTopObj,    imageTop,    rgb);
crimp_input (imageBottomObj, imageBottom, rgb);

if (!crimp_eq_width (imageTop, imageBottom)) {
    Tcl_SetResult(interp, "image widths do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_rgb (imageTop->w, imageTop->h + imageBottom->h);

for (y = 0; y < imageTop->h; y++) {
    for (x = 0; x < result->w; x++) {

	R (result, x, y) = R (imageTop, x, y);
	G (result, x, y) = G (imageTop, x, y);
	B (result, x, y) = B (imageTop, x, y);
    }
}

for (y = 0; y < imageBottom->h; y++) {
    for (x = 0; x < result->w; x++) {

	R (result, x, imageTop->h + y) = R (imageBottom, x, y);
	G (result, x, imageTop->h + y) = G (imageBottom, x, y);
	B (result, x, imageTop->h + y) = B (imageBottom, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/montagev-rgba.crimp.





























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

montagev_rgba
Tcl_Obj* imageTopObj
Tcl_Obj* imageBottomObj

/*
 * Place the two images adjacent to each other in the result, from top to
 * bottom. The images have to have the same width.
 */

crimp_image*     result;
crimp_image*     imageTop;
crimp_image*     imageBottom;
int x, y;

crimp_input (imageTopObj,    imageTop,    rgba);
crimp_input (imageBottomObj, imageBottom, rgba);

if (!crimp_eq_width (imageTop, imageBottom)) {
    Tcl_SetResult(interp, "image widths do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_rgba (imageTop->w, imageTop->h + imageBottom->h);

for (y = 0; y < imageTop->h; y++) {
    for (x = 0; x < result->w; x++) {

	R (result, x, y) = R (imageTop, x, y);
	G (result, x, y) = G (imageTop, x, y);
	B (result, x, y) = B (imageTop, x, y);
	A (result, x, y) = A (imageTop, x, y);
    }
}

for (y = 0; y < imageBottom->h; y++) {
    for (x = 0; x < result->w; x++) {

	R (result, x, imageTop->h + y) = R (imageBottom, x, y);
	G (result, x, imageTop->h + y) = G (imageBottom, x, y);
	B (result, x, imageTop->h + y) = B (imageBottom, x, y);
	A (result, x, imageTop->h + y) = A (imageBottom, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/multiply-float-float.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

multiply_float_float
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise multiplication of two images. The images have to
 * have equal dimensions.
 */

#define BINOP(a,b) ((a)*(b))
#include "binop_float_float.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/multiply-float-grey16.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

multiply_float_grey16
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise multiplication of two images. The images have to
 * have equal dimensions.
 */

#define BINOP(a,b) ((a)*(b))
#include "binop_float_grey16.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/multiply-float-grey32.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

multiply_float_grey32
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise multiplication of two images. The images have to
 * have equal dimensions.
 */

#define BINOP(a,b) ((a)*(b))
#include "binop_float_grey32.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/multiply-float-grey8.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

multiply_float_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise multiplication of two images. The images have to
 * have equal dimensions.
 */

#define BINOP(a,b) ((a)*(b))
#include "binop_float_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/multiply-grey8-grey8.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

multiply_grey8_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise multiplication of two images. The images have to
 * have equal dimensions. The results are scaled into the range.
 */

#define BINOP(a,b) ((a)*(b)/255)
#include "binop_grey8_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/multiply-rgb-grey8.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

multiply_rgb_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise multiplication of two images. The images have to
 * have equal dimensions. The results are scaled into the range.
 */

#define BINOP(a,b) ((a)*(b)/255)
#include "binop_rgb_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/multiply-rgb-rgb.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

multiply_rgb_rgb
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise multiplication of two images. The images have to
 * have equal dimensions. The results are scaled into the range.
 */

#define BINOP(a,b) ((a)*(b)/255)
#include "binop_rgb_rgb.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/multiply-rgba-grey8.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

multiply_rgba_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise multiplication of two images. The images have to
 * have equal dimensions. The results are scaled into the range.
 */

#define BINOP(a,b) ((a)*(b)/255)
#include "binop_rgba_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/multiply-rgba-rgb.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

multiply_rgba_rgb
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise multiplication of two images. The images have to
 * have equal dimensions. The results are scaled into the range.
 */

#define BINOP(a,b) ((a)*(b)/255)
#include "binop_rgba_rgb.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/multiply-rgba-rgba.crimp.



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

multiply_rgba_rgba
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise multiplication of two images. The images have to
 * have equal dimensions. The results are scaled into the range.
 */

#define BINOP(a,b) ((a)*(b)/255)
#include "binop_rgba_rgba.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/non_max_suppression.crimp.










































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

non_max_suppression
Tcl_Obj* imageMObj
Tcl_Obj* imageAObj

/*
 * Non-maximum supression in gradients (polar representation, magnitude and
 * angle). Inputs are expected to be float, result is the same, with the
 * non-maxima set to 0.
 */

crimp_image* imageM;
crimp_image* imageA;
crimp_image* result;
int          x, y, xo, yo;

crimp_input (imageMObj, imageM, float);
crimp_input (imageAObj, imageA, float);

if (!crimp_eq_dim (imageM, imageA)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized gradient fields", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_float (imageM->w - 2, imageM->h - 2);

for (yo = 0, y = 1; yo < result->h; y++, yo++) {
    for (xo = 0, x = 1; xo < result->w; x++, xo++) {

	double mag   = FLOATP(imageM, x, y);
	double angle = FLOATP(imageA, x, y);
	int    keep;

	/* Octants:
	 * [    0 -  22.5) : - horiz  e..w
	 * [ 22.5 -  67.5) : / mdiag  ne..sw
	 * [ 67.5 - 112.5) : | vert   n..s
	 * [112.5 - 157.5) : \ sdiag  nw..se
	 * [157.5 - 202.5) : -
	 * [202.5 - 247.5) : /
	 * [247.5 - 292.5) : |
	 * [292.5 - 337.5) : \
	 * [337.5 - 360.0) : -
	 */

	if (angle <  22.5) {
	horiz: {
		double w  = FLOATP(imageM, x-1, y);
		double e  = FLOATP(imageM, x+1, y);
		keep = (mag > w) && (mag > e);
	    }
	} else if (angle <  67.5) {
	mdiag: {
		double ne  = FLOATP(imageM, x+1, y-1);
		double sw  = FLOATP(imageM, x-1, y+1);
		keep = (mag > ne) && (mag > sw);
	    }
	} else if (angle < 112.5) {
	vert: {
		double n  = FLOATP(imageM, x, y-1);
		double s  = FLOATP(imageM, x, y+1);
		keep = (mag > n) && (mag > s);
	    }
	} else if (angle < 157.5) {
	sdiag: {
		double nw  = FLOATP(imageM, x-1, y-1);
		double se  = FLOATP(imageM, x+1, y+1);
		keep = (mag > nw) && (mag > se);
	    }
	} else if (angle < 202.5) {
	    goto horiz;
	} else if (angle < 247.5) {
	    goto mdiag;
	} else if (angle < 292.5) {
	    goto vert;
	} else if (angle < 337.5) {
	    goto sdiag;
	} else {
	    goto horiz;
	}

	if (keep) {
	    FLOATP(result, xo, yo) = mag;
	} else {
	    FLOATP(result, xo, yo) = 0.0;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/offset-float.crimp.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

offset_float
Tcl_Obj* imageObj
double offset

/*
 * Add the offset to all the pixels of the image.
 */

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, float);

result = crimp_new_like (image);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = offset + FLOATP (image, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/pixel.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

pixel
Tcl_Obj* imageObj

crimp_image*   image;
unsigned char* bytes;
int            length;

crimp_input_any (imageObj, image);

bytes  = image->pixel;
length = image->w * image->h * image->itype->size;

Tcl_SetObjResult (interp, Tcl_NewByteArrayObj (bytes, length));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/pow-float-float.crimp.

















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

pow_float_float
Tcl_Obj* imageBaseObj
Tcl_Obj* imageExpnObj

/*
 * pow() of all pixels of the two input images.
 */

crimp_image* imageBase;
crimp_image* imageExpn;
crimp_image* result;
int          x, y;

crimp_input (imageBaseObj, imageBase, float);
crimp_input (imageExpnObj, imageExpn, float);

if (!crimp_eq_dim (imageBase, imageExpn)) {
    Tcl_SetResult(interp, "Unable to proceed, expected equally-sized inputs", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (imageBase);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = pow (FLOATP (imageBase, x, y),
				     FLOATP (imageExpn, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/psychedelia.crimp.





































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

psychedelia
int width int height int frames

static float prev[4][3], next[4][3];
static int   frame;
static float tweaks[3] = {33, 35, 37};
crimp_image* result;
int          yi, xi, c;
float        t, y, x;

result = crimp_new_rgba (width, height);

if (frame % frames == 0) {
    int i, c;
    if (frame == 0) {
        for (i = 0; i < 4; ++i) {
            for (c = 0; c < 3; ++c) {
                next[i][c] = rand() / (float)RAND_MAX;
            }
        }
    }
    for (i = 0; i < 4; ++i) {
        for (c = 0; c < 3; ++c) {
            prev[i][c] = next[i][c];
            next[i][c] = rand() / (float)RAND_MAX;
        }
    }
}

t = (cosf((frame % frames) / (float)frames * M_PI) + 1) / 2;
for (yi = 0, y = 0; yi < height; ++yi, y += 1. / height) {
    for (xi = 0, x = 0; xi < width; ++xi, x += 1. / width) {
        float i, v[3];
        for (c = 0; c < 3; ++c) {
            v[c] = cosf(frame / tweaks[c] + (
                (prev[0][c] * t + next[0][c] * (1 - t)) * (1 - y) * (1 - x)
              + (prev[1][c] * t + next[1][c] * (1 - t)) * (1 - y) * (    x)
              + (prev[2][c] * t + next[2][c] * (1 - t)) * (    y) * (1 - x)
              + (prev[3][c] * t + next[3][c] * (1 - t)) * (    y) * (    x)
            ) * 7 * M_PI);
        }
        i = (cosf((v[0] + v[1] + v[2] + frame / 17.) * M_PI) + 1) / 2;

	R (result, xi, yi) = CLAMP(0, v[0] * i * 255, 255);
	G (result, xi, yi) = CLAMP(0, v[1] * i * 255, 255);
	B (result, xi, yi) = CLAMP(0, v[2] * i * 255, 255);
	A (result, xi, yi) = OPAQUE;
    }
}

frame ++;

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/read-pgm.crimp.









































































































































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

read_pgm
Tcl_Obj* pgmdata

/*
 * Reader for images in PGM format (Portable Grey Map).
 * See http://en.wikipedia.org/wiki/Netpbm_format
 * Original tcl code derived from http://wiki.tcl.tk/4530, rewritten to C.
 * Handles both raw and plain formats.
*
 * Create a grey8 image from PGM data. Which is pretty much a list of
 * integers, with a bit of heading. The pixels can be coded in binary (bytes),
 * or ASCII decimal numbers. The header tells us which. The code here uses
 * direct string access and splits the data on its own, instead of using Tcl's
 * list functionality.
 */

unsigned char* bytes;
int            length;
int state, lstate, israw, w, h, npix, max, value;
unsigned char* stop;
unsigned char* at;
unsigned char* dst;

crimp_image*     result;

/*
 * Check input, i.e. verify structure and extract dimensions
 */

bytes = Tcl_GetByteArrayFromObj(pgmdata, &length);

at   = bytes;
stop = bytes + length;

/*
 * State machine based parsing of the image header.
 */

#define SKIP (-1) /* In a comment, skipping */
#define GETP  (0) /* Expecting 'P' marker */
#define GETT  (1) /* Expecting type code ('2' or '5') */
#define SEP   (2) /* Expecting separator (spaces) */
#define GETW  (3) /* Read image width */
#define SEPW  (4) /* Expecting separator (spaces) */
#define GETH  (5) /* Read image height */
#define SEPH  (6) /* Expecting separator (spaces) */
#define GETM  (7) /* Read image max value */
#define SEPM  (8) /* Expecting separator (spaces) */
#define STOP  (9) /* End of header */

#define PGM_DIGIT(c) (('0' <= (c)) && ((c) <= '9'))
#define PGM_SPACE(c) (((c) == ' ') || ((c) == '\n') || ((c) == '\r') || ((c) == '\t'))

w = h = max = value = israw = 0;
for (at = bytes, state = GETP; (at < stop) && (state != STOP); at ++) {

    /*fprintf(stderr,"H [%4d] s%d '%c'\n",at-bytes,state,*at);fflush(stderr);*/

    /* In a comment we skip ahead until the next linefeed */
    if ((state == SKIP) && (*at == '\n')) {
	state = lstate;
	continue;
    }
    /* A comment can start anywhere, i.e. in the middle of a number. */
    if (*at == '#') { 
	lstate = state;
	state = SKIP;
	continue;
    }
    switch (state) {
    case GETP:
	if (*at == 'P') { state = GETT ; continue; }
	/*fprintf(stderr,"bad mark\n");fflush(stderr);*/
    notpgm:
	Tcl_SetResult(interp, "Not a PGM image", TCL_STATIC);
	return TCL_ERROR;
	break;
    case GETT:
	if (*at == '2') {             state = SEP ; continue; }
	if (*at == '5') { israw = 1 ; state = SEP ; continue; }
	/*fprintf(stderr,"bad type\n");fflush(stderr);*/
	goto notpgm;
    case SEP:
    case SEPW:
    case SEPH:
    case SEPM:
	if (PGM_SPACE (*at)) continue;
	/*fprintf(stderr,"\tnot space\n");fflush(stderr);*/
	at --;
	state ++; /* SEP -> GETW, SEPW -> GETH, SEPH -> GETM, SEPM -> STOP */
	value = 0;
	break;
    case GETW:
    case GETH:
    case GETM:
	if (PGM_SPACE (*at)) {
	    switch (state) {
	    case GETW: w   = value; value = 0; break;
	    case GETH: h   = value; value = 0; break;
	    case GETM: max = value; value = 0; break;
	    }
	    state ++ ; /* GETW -> SEPW, GETH -> SEPH, GETM -> SEPM */
	    if (state == SEPM) {
		/*
		 * The max value has exactly ONE space after it (which we
		 * found above), and the next byte is the beginning of the
		 * pixel data, regardless of content. No comments, no
		 * whitespace
		 */
		state = STOP;
	    }
	    continue;
	}
	if (PGM_DIGIT (*at)) {
	    value = value*10 + (*at - '0');
	    continue;
	}
	/*fprintf(stderr,"bad number\n");fflush(stderr);*/
	goto notpgm;
    }
}

if (state != STOP) {
    /*fprintf(stderr,"bad state (end of header)\n");fflush(stderr);*/
    goto notpgm;
}

/*fprintf(stderr,"raw=%d, w=%d, h=%d, max=%d\n", israw,w,h,max);fflush(stderr);*/

/*
 * Here 'at' now points to the first byte of the pixel data, which are either,
 * depending on 'israw', bytes, or a series of decimal numbers separated by
 * single spaces. Here, in the raster, comments are NOT allowed anymore. We
 * can now allocate and initialize the result, and then parse/copy the pixel
 * data over into it. We can't do a memcpy even for the single-byte binary
 * data even so, because of the need to rescale the data by the 'max' value :/
 *
 * Right, not to forget, check the 'max' information first for its limits, and
 * in case of the raw sub-format it provides information about pixel width (1
 * versus 2 byte).
 */

if (israw) {
    if (max > 65536) {
	Tcl_SetResult(interp, "Bad PGM image, max out of bounds.", TCL_STATIC);
	return TCL_ERROR;
    } else if (max > 256) {
	israw ++; /* 2-byte mode, bigendian! */
    }
}

result = crimp_new_grey8 (w, h);
npix = w*h;

/*fprintf(stderr,"raw=%d, w=%d, h=%d, max=%d /%d\n", israw,w,h,max,npix);fflush(stderr);*/

if (israw == 2) {

    /*
     * Binary pixel data, 2-byte, bigendian
     */

#define MSB (0)
#define LSB (1)

    value = 0;
    for (state = MSB, dst = &(GREY8 (result,0,0)); (at < stop) && (npix > 1); at ++) {
	switch (state) {
	case MSB:
	    value = *at;
	    state = LSB;
	    break;
	case LSB:
	    value = 256*value + *at;
	    state = MSB;

	    *dst = value*255/max;

	    dst++;
	    npix --;
	    break;
	}
    }

    if (state != MSB) {
	/*fprintf(stderr,"bad 2-byte pixel state\n");fflush(stderr);*/
	goto notpgm;
    }

} else if (israw) {
    /*
     * Binary pixel data, 1-byte. Nearly a memcpy, if not for the re-scaling by 'max'.
     */

    for (dst = &(GREY8 (result,0,0)); (at < stop) && (npix > 0); at ++, dst++, npix--) {
	*dst = (*at)*255/max;
    }
} else {
    /*
     * Text pixel data.
     */

    value = 0;
    for (state = GETW, dst = &(GREY8 (result,0,0)); (at < stop) && (npix > 0); at ++) {
	/*fprintf(stderr,"P [%4d] s%d '%c' /%d\n",at-bytes,state,*at, npix);fflush(stderr);*/

	switch (state) {
	case SEP:
	    if (PGM_SPACE (*at)) continue;
	    at --;
	    state ++; /* SEP -> GETW */
	    value = 0;
	    break;
	case GETW:
	    if (PGM_SPACE (*at)) {
		state -- ; /* GETW -> SEP */

		*dst = value*255/max;
		value = 0;

		/*fprintf(stderr,"\tsaved %d (%d)\n", (int)*dst, npix);fflush(stderr);*/

		dst++;
		npix --;
		continue;
	    }
	    if (PGM_DIGIT (*at)) {
		value = value*10 + (*at - '0');
		continue;
	    }
	    /*fprintf(stderr,"bad number (pixel)\n");fflush(stderr);*/
	    goto notpgm;
	}
    }

    if (npix && (state != GETW)) {
	/*fprintf(stderr,"bad state (end of pixels)\n");fflush(stderr);*/
	goto notpgm;
    }

    /*
     * Complete the last pixel if it had no trailing space
     */

    if (npix) {
	*dst = value*255/max;
	value = 0;

	dst++;
	npix --;
    }
}

if (npix > 0) {
    /*fprintf(stderr,"not enough pixels, %d left @%d\n", npix,at-bytes);fflush(stderr);*/
    goto notpgm;
}

/*
 * Note that (at < stop) is acceptable.  A PGM file may contain multiple
 * images.  We are reading only the first.
 */

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

#undef SKIP
#undef GETP
#undef GETT
#undef SEP 
#undef GETW
#undef SEPW
#undef GETH
#undef SEPH
#undef GETM
#undef SEPM
#undef STOP
#undef MSB
#undef LSB
#undef PGM_DIGIT
#undef PGM_SPACE


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/read-ppm.crimp.










































































































































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

read_ppm
Tcl_Obj* ppmdata

/*
 * Reader for images in PPM format (Portable Grey Map).
 * See http://en.wikipedia.org/wiki/Netpbm_format
 * Original tcl code derived from http://wiki.tcl.tk/4530, rewritten to C.
 * Handles both raw and plain formats.
 *
 * Create a RGB image from PPM data. Which is pretty much a list of integers,
 * with a bit of heading. The pixels can be coded in binary (bytes), or ASCII
 * decimal numbers. The header tells us which. Each pixel consists of _three_
 * numbers, the red, green, and blue components, in this order. The code here
 * uses direct string access and splits the data on its own, instead of using
 * Tcl's list functionality.
 */

unsigned char* bytes;
int            length;
int state, lstate, israw, w, h, npix, max, value;
unsigned char* stop;
unsigned char* at;
unsigned char* dst;

crimp_image*     result;

/*
 * Check input, i.e. verify structure and extract dimensions
 */

bytes = Tcl_GetByteArrayFromObj(ppmdata, &length);

at   = bytes;
stop = bytes + length;

/*
 * State machine based parsing of the image header.
 */

#define SKIP (-1) /* In a comment, skipping */
#define GETP  (0) /* Expecting 'P' marker */
#define GETT  (1) /* Expecting type code ('3' (plain) or '6' (raw)) */
#define SEP   (2) /* Expecting separator (spaces) */
#define GETW  (3) /* Read image width */
#define SEPW  (4) /* Expecting separator (spaces) */
#define GETH  (5) /* Read image height */
#define SEPH  (6) /* Expecting separator (spaces) */
#define GETM  (7) /* Read image max value */
#define SEPM  (8) /* Expecting separator (spaces) */
#define STOP  (9) /* End of header */

#define PPM_DIGIT(c) (('0' <= (c)) && ((c) <= '9'))
#define PPM_SPACE(c) (((c) == ' ') || ((c) == '\n') || ((c) == '\r') || ((c) == '\t'))

w = h = max = value = israw = 0;
for (at = bytes, state = GETP; (at < stop) && (state != STOP); at ++) {

    /*fprintf(stderr,"H [%4d] s%d '%c'\n",at-bytes,state,*at);fflush(stderr);*/

    /* In a comment we skip ahead until the next linefeed */
    if ((state == SKIP) && (*at == '\n')) {
	state = lstate;
	continue;
    }
    /* A comment can start anywhere, i.e. in the middle of a number. */
    if (*at == '#') { 
	lstate = state;
	state = SKIP;
	continue;
    }
    switch (state) {
    case GETP:
	if (*at == 'P') { state = GETT ; continue; }
	/*fprintf(stderr,"bad mark\n");fflush(stderr);*/
    notppm:
	Tcl_SetResult(interp, "Not a PPM image", TCL_STATIC);
	return TCL_ERROR;
	break;
    case GETT:
	if (*at == '3') {             state = SEP ; continue; }
	if (*at == '6') { israw = 1 ; state = SEP ; continue; }
	/*fprintf(stderr,"bad type\n");fflush(stderr);*/
	goto notppm;
    case SEP:
    case SEPW:
    case SEPH:
    case SEPM:
	if (PPM_SPACE (*at)) continue;
	/*fprintf(stderr,"\tnot space\n");fflush(stderr);*/
	at --;
	state ++; /* SEP -> GETW, SEPW -> GETH, SEPH -> GETM, SEPM -> STOP */
	value = 0;
	break;
    case GETW:
    case GETH:
    case GETM:
	if (PPM_SPACE (*at)) {
	    switch (state) {
	    case GETW: w   = value; value = 0; break;
	    case GETH: h   = value; value = 0; break;
	    case GETM: max = value; value = 0; break;
	    }
	    state ++ ; /* GETW -> SEPW, GETH -> SEPH, GETM -> SEPM */
	    if (state == SEPM) {
		/*
		 * The max value has exactly ONE space after it (which we
		 * found above), and the next byte is the beginning of the
		 * pixel data, regardless of content. No comments, no
		 * whitespace
		 */
		state = STOP;
	    }
	    continue;
	}
	if (PPM_DIGIT (*at)) {
	    value = value*10 + (*at - '0');
	    continue;
	}
	/*fprintf(stderr,"bad number\n");fflush(stderr);*/
	goto notppm;
    }
}

if (state != STOP) {
    /*fprintf(stderr,"bad state (end of header)\n");fflush(stderr);*/
    goto notppm;
}

/*fprintf(stderr,"raw=%d, w=%d, h=%d, max=%d\n", israw,w,h,max);fflush(stderr);*/

/*
 * Here 'at' now points to the first byte of the pixel data, which are either,
 * depending on 'israw', bytes, or a series of decimal numbers separated by
 * single spaces. Here, in the raster, comments are NOT allowed anymore. We
 * can now allocate and initialize the result, and then parse/copy the pixel
 * data over into it. We can't do a memcpy even for the single-byte binary
 * data even so, because of the need to rescale the data by the 'max' value :/
 *
 * Right, not to forget, check the 'max' information first for its limits, and
 * in case of the raw sub-format it provides information about pixel width (1
 * versus 2 byte).
 */

if (israw) {
    if (max > 65536) {
	Tcl_SetResult(interp, "Bad PPM image, max out of bounds.", TCL_STATIC);
	return TCL_ERROR;
    } else if (max > 256) {
	israw ++; /* 2-byte mode, bigendian! */
    }
}

result = crimp_new_rgb (w, h);
npix = w*h*3;

/*fprintf(stderr,"raw=%d, w=%d, h=%d, max=%d /%d\n", israw,w,h,max,npix);fflush(stderr);*/

if (israw == 2) {

    /*
     * Binary pixel data, 2-byte, bigendian
     */

#define MSB (0)
#define LSB (1)

    value = 0;
    for (state = MSB, dst = &(GREY8 (result,0,0)); (at < stop) && (npix > 1); at ++) {
	switch (state) {
	case MSB:
	    value = *at;
	    state = LSB;
	    break;
	case LSB:
	    value = 256*value + *at;
	    state = MSB;

	    *dst = value*255/max;

	    dst++;
	    npix --;
	    break;
	}
    }

    if (state != MSB) {
	/*fprintf(stderr,"bad 2-byte pixel state\n");fflush(stderr);*/
	goto notppm;
    }

} else if (israw) {
    /*
     * Binary pixel data, 1-byte. Nearly a memcpy, if not for the re-scaling by 'max'.
     */

    for (dst = &(GREY8 (result,0,0)); (at < stop) && (npix > 0); at ++, dst++, npix--) {
	*dst = (*at)*255/max;
    }
} else {
    /*
     * Text pixel data.
     */

    value = 0;
    for (state = GETW, dst = &(GREY8 (result,0,0)); (at < stop) && (npix > 0); at ++) {
	/*fprintf(stderr,"P [%4d] s%d '%c' /%d\n",at-bytes,state,*at, npix);fflush(stderr);*/

	switch (state) {
	case SEP:
	    if (PPM_SPACE (*at)) continue;
	    at --;
	    state ++; /* SEP -> GETW */
	    value = 0;
	    break;
	case GETW:
	    if (PPM_SPACE (*at)) {
		state -- ; /* GETW -> SEP */

		*dst = value*255/max;
		value = 0;

		/*fprintf(stderr,"\tsaved %d (%d)\n", (int)*dst, npix);fflush(stderr);*/

		dst++;
		npix --;
		continue;
	    }
	    if (PPM_DIGIT (*at)) {
		value = value*10 + (*at - '0');
		continue;
	    }
	    /*fprintf(stderr,"bad number (pixel)\n");fflush(stderr);*/
	    goto notppm;
	}
    }

    if (npix && (state != GETW)) {
	/*fprintf(stderr,"bad state (end of pixels)\n");fflush(stderr);*/
	goto notppm;
    }

    /*
     * Complete the last pixel if it had no trailing space
     */

    if (npix) {
	*dst = value*255/max;
	value = 0;

	dst++;
	npix --;
    }
}

if (npix > 0) {
    /*fprintf(stderr,"not enough pixels, %d left @%d\n", npix,at-bytes);fflush(stderr);*/
    goto notppm;
}

/*
 * Note that (at < stop) is acceptable.  A PPM file may contain multiple
 * images.  We are reading only the first.
 */

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

#undef SKIP
#undef GETP
#undef GETT
#undef SEP 
#undef GETW
#undef SEPW
#undef GETH
#undef SEPH
#undef GETM
#undef SEPM
#undef STOP
#undef MSB
#undef LSB
#undef PPM_DIGIT
#undef PPM_SPACE


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/read-tcl-float.crimp.










































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

read_tcl_float
Tcl_Obj* pixels

/*
 * Create a floating-point image from a list of lists of floating-point
 * numbers. This is, in essence, a read command, just using core Tcl values
 * instead of a Tk photo as input.
 *
 * Using this command should be easier than trying to work with 'list' and
 * 'binary'. This way the result even already has the proper intrep.
 */

Tcl_Obj** rowv;
Tcl_Obj** colv;
crimp_image*     result;
int              x, y, w, h, rowc, colc;
double           value;

/*
 * Check input, i.e. verify structure and extract dimensions
 */

if (Tcl_ListObjGetElements(interp, pixels, &rowc, &rowv) != TCL_OK) {
    return TCL_ERROR;
}
h = rowc;
w = 0;
for (y = 0; y < h; y++) {
    if (Tcl_ListObjGetElements(interp, rowv [y], &colc, &colv) != TCL_OK) {
	return TCL_ERROR;
    }
    if (colc > w) {
	w = colc;
    }
    for (x = 0; x < colc; x++) {
	if (Tcl_GetDoubleFromObj(interp, colv [x], &value) != TCL_OK) {
	    return TCL_ERROR;
	}
    }
}

result = crimp_new_float (w, h);

for (y = 0; y < h; y++) {

    Tcl_ListObjGetElements(interp, rowv [y], &colc, &colv);

    for (x = 0; x < colc; x++) {
	Tcl_GetDoubleFromObj(interp, colv [x], &value);
	FLOATP (result, x, y) = value;
    }
    for (; x < w; x++) {
	FLOATP (result, x, y) = BLACK;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/read-tcl-grey8.crimp.













































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

read_tcl_grey8
Tcl_Obj* pixels

/*
 * Create a grey8 image from a list of lists of integers in the range
 * [0..255]. This is, in essence, a read command, just using core Tcl
 * values instead of a Tk photo as input.
 *
 * Using this command should be easier than trying to work with 'list' and
 * 'binary'. This way the result even already has the proper intrep.
 */

Tcl_Obj** rowv;
Tcl_Obj** colv;
crimp_image*     result;
int              x, y, w, h, rowc, colc, value;

/*
 * Check input, i.e. verify structure and extract dimensions
 */

if (Tcl_ListObjGetElements(interp, pixels, &rowc, &rowv) != TCL_OK) {
    return TCL_ERROR;
}
h = rowc;
w = 0;
for (y = 0; y < h; y++) {
    if (Tcl_ListObjGetElements(interp, rowv [y], &colc, &colv) != TCL_OK) {
	return TCL_ERROR;
    }
    if (colc > w) {
	w = colc;
    }
    for (x = 0; x < colc; x++) {
	if (Tcl_GetIntFromObj(interp, colv [x], &value) != TCL_OK) {
	    return TCL_ERROR;
	}
	if ((value < 0) || (value > 255)) {
	    Tcl_SetResult(interp, "integer out of range 0..255", TCL_STATIC);
	    return TCL_ERROR;
	}
    }
}

result = crimp_new_grey8 (w, h);

for (y = 0; y < h; y++) {

    Tcl_ListObjGetElements(interp, rowv [y], &colc, &colv);

    for (x = 0; x < colc; x++) {
	Tcl_GetIntFromObj(interp, colv [x], &value);
	GREY8 (result, x, y) = value;
    }
    for (; x < w; x++) {
	GREY8 (result, x, y) = BLACK;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/read-tk.crimp.




























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

read_tk
char* photo

Tk_PhotoHandle     handle = Tk_FindPhoto (interp, photo);
Tk_PhotoImageBlock pib;
Tcl_Obj*           imageObj;
crimp_image*       image;

if (!handle) {
    Tcl_ResetResult (interp);
    Tcl_AppendResult(interp, "image \"", photo, "\" doesn't exist", NULL);
    return TCL_ERROR;
}

Tk_PhotoGetImage(handle, &pib);

/*
 * Expect a Tk photo whose internal structure matches that of our RGBA images
 * exactly. This enables us to later copy the data with a straightforward
 * memcpy, instead of having to do it either by line, or even by pixel.
 *
 * XXX, FUTURE: Accept different structures, where more work is required to
 * convert them into one of our formats.
 *
 * XXX: See also the extensive notes in export.crimp regarding possible
 * organization and data structures, import is complementary to export, and
 * should be organized similarly, or even share data structures.
 */

if (pib.pixelSize != 4 ||
    pib.pitch     != (4 * pib.width) ||
    pib.offset[0] != 0 ||
    pib.offset[1] != 1 ||
    pib.offset[2] != 2 ||
    pib.offset[3] != 3) {
    Tcl_SetResult(interp, "unsupported image format", TCL_STATIC);
    return TCL_ERROR;
}

image = crimp_new_rgba (pib.width, pib.height);
memcpy (image->pixel, pib.pixelPtr, 4 * pib.width * pib.height);

Tcl_SetObjResult(interp, crimp_new_image_obj (image));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/region_sum.crimp.

























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

region_sum
Tcl_Obj* imageObj
int radius

/*
 * This primitive assumes that the input image is a summed area table, i.e. an
 * integral of some image. It computes the sum of pixels in the square region
 * with radius r centered at point (x,y) as
 *
 * S(x,y) = I(x+r,y+r) - I(x-r-1,y-r-1) - I(x+r,y-r-1) + I(x-r-1,y+r)
 *
 * The result image is shrunken by radius+1 in all directions.
 */

crimp_image* image;
crimp_image* result;
int          xi, yi, xo, yo, n;

crimp_input (imageObj, image, float);

if (radius <= 0) {
    Tcl_SetResult(interp, "bad radius, expected positive value", TCL_STATIC);
    return TCL_ERROR;
}

n = 2*(radius+1);
result = crimp_new (image->itype, image->w - n, image->h - n);

for (yo = 0, yi = radius+1; yo < result->h; yo++, yi++) {
    for (xo = 0, xi = radius+1; xo < result->w; xo++, xi++) {

	FLOATP (result, xo, yo) = 
	      FLOATP (image, xi+radius,   yi+radius)
	    + FLOATP (image, xi-radius-1, yi-radius-1)
	    - FLOATP (image, xi+radius,   yi-radius-1)
	    - FLOATP (image, xi-radius-1, yi+radius);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/rof-grey8.crimp.





























































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

rof_grey8
Tcl_Obj* imageObj
int radius
int percentile

/*
 * Generic rank-order filter. Depending on the chosen rank this a min, max, or
 * median filter, or anything in between.
 *
 * The percentile is 0...10000, i.e. percent with a resolution of 1/100.
 *
 * Note that the implied kernel has dimensions (2r+1)x(2r+1), reducing the
 * result image by 2*radius in each di1mension. I.e. the filter doesn't process
 * the 'radius' border pixels along each edge.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, n;
int              rowhistogram [256];
int*             colhistogram;

crimp_input (imageObj, image, grey8);

if ((percentile < 0) || (percentile > 10000)) {
    Tcl_SetResult(interp, "bad percentile, expected integer in (0..10000)", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new (image->itype, image->w - 2*radius, image->h - 2*radius);

/*
 * We are using the method described by Simon Perreault and Patrick Hebert in
 * their paper 'Median Filtering In Constant Time'. This method trades memory
 * for speed by keeping one histogram per column, plus a row histogram of the
 * current 2r+1 columns. When moving from pixel to pixel these histograms are
 * incrementally updated, each in constant time. The trick is that the column
 * histograms keep history between rows.
 *
 * Right now we are not making use of any of the proposed optimizations, like
 * multi-level histograms, conditional updating, or vertical striping for
 * cache friendliness.
 *
 * Relationship between input and result coordinate systems:
 *
 * xi = xo + radius, xo in (0...w-2*radius)
 * yi = yo + radius, yo in (0...w-2*radius)
 */

colhistogram = NALLOC (image->w * 256, int);
memset (colhistogram,'\0', image->w * 256 * sizeof(int));

n = (2*radius+1);
n = n * n;

/*
 * TODO :: Test different storage orders for the histograms (row vs column
 *         major order).
 */

/*
 * Access to the column histograms.
 *
 * xi = column index, in the input image coordinate system.
 */
#if 1
#define CHINDEX(xi,value)   ((xi) * 256 + (value))
#else
#define CHINDEX(xi,value)   ((value) * image->w + (xi))
#endif
#define COLHIST(xi,value) colhistogram [CHINDEX (xi, value)]

/*
 * Basic operations on column histograms. Add/remove pixel values.
 */
#define UP(xi,value)   COLHIST (xi, value)++
#define DOWN(xi,value) COLHIST (xi, value)--

/*
 * Basic operations on the row histogram. Add and subtract column histograms
 * to/from it. These operations are vectorizable.
 *
 * xi = column index, in the input image coordinate system.
 */

#define ADD(xi) { int value ; for (value=0;value<256;value++) { rowhistogram[value] += COLHIST (xi,value);}}
#define SUB(xi) { int value ; for (value=0;value<256;value++) { rowhistogram[value] -= COLHIST (xi,value);}}

/*
 * Higher level of column histogram change. Move a column histogram down by
 * one row. yi is the index of the new row, and the histogram contains the
 * data for row yi-1. This is in the input image coordinate system.
 *
 * xi = column index, in the input image coordinate system.
 */

#undef  SHIFT_DOWN
#define SHIFT_DOWN(xi,yi) {				     \
	DOWN ((xi), GREY8 (image, (xi), (yi) - radius - 1)); \
	UP   ((xi), GREY8 (image, (xi), (yi) + radius)); }

/*
 * Higher level of row histogram change. Move the row histogram right by one
 * column. xi is the index of the new column, and the histogram contains the
 * data for column xi-1. This is in the input image coordinate system.
 */

#undef  SHIFT_RIGHT
#define SHIFT_RIGHT(xi) { SUB ((xi) - radius - 1); ADD ((xi) + radius); }

/*
 * ==
 * Initialization, and handling of result row 0
 * ==
 */

/*
 * Initialization I.
 * Scan the first 2*radius+1 rows of the input image into the column
 * histograms.
 */

for (yi = 0; yi < 2*radius+1; yi++) {
    for (xi = 0; xi < image->w; xi++) {
	UP (xi, GREY8 (image, xi, yi));
    }
}

/*
 * Initialization II.
 * Add the first 2*radius+1 column histogram into the initial row histogram.
 */

memset (rowhistogram,'\0', 256 * sizeof(int));
for (xi = 0 ; xi < 2*radius+1; xi++) { ADD (xi); }

/*
 * Now we can start filtering. The initial histogram is already properly set
 * up for (xo,yo) = (0,0). For the remaining pixels of the first row in the
 * output we can sweep through without having to pull the column histograms
 * down.
 */

GREY8 (result, 0, 0) = crimp_rank (rowhistogram, percentile, n);
for (xo = 1, xi = radius+1; xo < result->w; xo++, xi++) {
    SHIFT_RIGHT (xi);
    GREY8 (result, xo, 0) = crimp_rank (rowhistogram, percentile, n);
}

/*
 * With the first row of the result done we can now sweep the remaining lines.
 */

for (yo = 1, yi = radius+1; yo < result->h; yo++, yi++) {

    /* Re-initialize the row histogram for the line */
    memset (rowhistogram,'\0', 256 * sizeof(int));
    for (xi = 0 ; xi < 2*radius+1; xi++) {
	SHIFT_DOWN (xi,yi);
	ADD (xi);
    }

    GREY8 (result, 0, yo) = crimp_rank (rowhistogram, percentile, n);
    for (xo = 1, xi = radius+1; xo < result->w; xo++, xi++) {
	SHIFT_DOWN  (xi+radius,yi);
	SHIFT_RIGHT (xi);
	GREY8 (result, xo, yo) = crimp_rank (rowhistogram, percentile, n);
    }
 }

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/rof-hsv.crimp.


































































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

rof_hsv
Tcl_Obj* imageObj
int radius
int percentile

/*
 * Generic rank-order filter. Depending on the chosen rank this a min, max, or
 * median filter, or anything in between.
 *
 * The percentile is 0...10000, i.e. percent with a resolution of 1/100.
 *
 * Note that the implied kernel has dimensions (2r+1)x(2r+1), reducing the
 * result image by 2*radius in each di1mension. I.e. the filter doesn't process
 * the 'radius' border pixels along each edge.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, n;
int              rowhistogramh [256];
int              rowhistograms [256];
int              rowhistogramv [256];
int*             colhistogramh;
int*             colhistograms;
int*             colhistogramv;

crimp_input (imageObj, image, hsv);

if ((percentile < 0) || (percentile > 10000)) {
    Tcl_SetResult(interp, "bad percentile, expected integer in (0..10000)", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new (image->itype, image->w - 2*radius, image->h - 2*radius);

/*
 * We are using the method described by Simon Perreault and Patrick Hebert in
 * their paper 'Median Filtering In Constant Time'. This method trades memory
 * for speed by keeping one histogram per column, plus a row histogram of the
 * current 2r+1 columns. When moving from pixel to pixel these histograms are
 * incrementally updated, each in constant time. The trick is that the column
 * histograms keep history between rows.
 *
 * Right now we are not making use of any of the proposed optimizations, like
 * multi-level histograms, conditional updating, or vertical striping for
 * cache friendliness.
 *
 * Relationship between input and result coordinate systems:
 *
 * xi = xo + radius, xo in (0...w-2*radius)
 * yi = yo + radius, yo in (0...w-2*radius)
 */

colhistogramh = NALLOC (image->w * 256, int); memset (colhistogramh,'\0', image->w * 256 * sizeof(int));
colhistograms = NALLOC (image->w * 256, int); memset (colhistograms,'\0', image->w * 256 * sizeof(int));
colhistogramv = NALLOC (image->w * 256, int); memset (colhistogramh,'\0', image->w * 256 * sizeof(int));

n = (2*radius+1);
n = n * n;

/*
 * TODO :: Test different storage orders for the histograms (row vs column
 *         major order).
 */

/*
 * Access to the column histograms.
 *
 * xi = column index, in the input image coordinate system.
 */
#if 1
#define CHINDEX(xi,value)   ((xi) * 256 + (value))
#else
#define CHINDEX(xi,value)   ((value) * image->w + (xi))
#endif
#define COLHISTH(xi,value) colhistogramh [CHINDEX (xi, value)]
#define COLHISTS(xi,value) colhistograms [CHINDEX (xi, value)]
#define COLHISTV(xi,value) colhistogramh [CHINDEX (xi, value)]

/*
 * Basic operations on column histograms. Add/remove pixel values.
 */
#define UPH(xi,value)   COLHISTH (xi, value)++
#define DOWNH(xi,value) COLHISTH (xi, value)--
#define UPS(xi,value)   COLHISTS (xi, value)++
#define DOWNS(xi,value) COLHISTS (xi, value)--
#define UPV(xi,value)   COLHISTV (xi, value)++
#define DOWNV(xi,value) COLHISTV (xi, value)--

/*
 * Basic operations on the row histogram. Add and subtract column histograms
 * to/from it. These operations are vectorizable.
 *
 * xi = column index, in the input image coordinate system.
 */

#define ADDH(xi) { int value ; for (value=0;value<256;value++) { rowhistogramh[value] += COLHISTH (xi,value);}}
#define SUBH(xi) { int value ; for (value=0;value<256;value++) { rowhistogramh[value] -= COLHISTH (xi,value);}}
#define ADDS(xi) { int value ; for (value=0;value<256;value++) { rowhistograms[value] += COLHISTS (xi,value);}}
#define SUBS(xi) { int value ; for (value=0;value<256;value++) { rowhistograms[value] -= COLHISTS (xi,value);}}
#define ADDV(xi) { int value ; for (value=0;value<256;value++) { rowhistogramv[value] += COLHISTV (xi,value);}}
#define SUBV(xi) { int value ; for (value=0;value<256;value++) { rowhistogramv[value] -= COLHISTV (xi,value);}}

/*
 * Higher level of column histogram change. Move a column histogram down by
 * one row. yi is the index of the new row, and the histogram contains the
 * data for row yi-1. This is in the input image coordinate system.
 *
 * xi = column index, in the input image coordinate system.
 */

#undef  SHIFT_DOWN
#define SHIFT_DOWN(xi,yi) {			          \
	DOWNH ((xi), H (image, (xi), (yi) - radius - 1)); \
	UPH   ((xi), H (image, (xi), (yi) + radius));     \
	DOWNS ((xi), S (image, (xi), (yi) - radius - 1)); \
	UPS   ((xi), S (image, (xi), (yi) + radius));     \
	DOWNV ((xi), V (image, (xi), (yi) - radius - 1)); \
	UPV   ((xi), V (image, (xi), (yi) + radius));     }

/*
 * Higher level of row histogram change. Move the row histogram right by one
 * column. xi is the index of the new column, and the histogram contains the
 * data for column xi-1. This is in the input image coordinate system.
 */

#undef  SHIFT_RIGHT
#define SHIFT_RIGHT(xi) { \
	SUBH ((xi) - radius - 1); ADDH ((xi) + radius); \
	SUBS ((xi) - radius - 1); ADDS ((xi) + radius); \
	SUBV ((xi) - radius - 1); ADDV ((xi) + radius); }

/*
 * ==
 * Initialization, and handling of result row 0
 * ==
 */

/*
 * Initialization I.
 * Scan the first 2*radius+1 rows of the input image into the column
 * histograms.
 */

for (yi = 0; yi < 2*radius+1; yi++) {
    for (xi = 0; xi < image->w; xi++) {
	UPH (xi, R (image, xi, yi));
	UPS (xi, G (image, xi, yi));
	UPV (xi, B (image, xi, yi));
    }
}

/*
 * Initialization II.
 * Add the first 2*radius+1 column histogram into the initial row histogram.
 */

memset (rowhistogramh,'\0', 256 * sizeof(int)); for (xi = 0 ; xi < 2*radius+1; xi++) { ADDH (xi); }
memset (rowhistograms,'\0', 256 * sizeof(int)); for (xi = 0 ; xi < 2*radius+1; xi++) { ADDS (xi); }
memset (rowhistogramv,'\0', 256 * sizeof(int)); for (xi = 0 ; xi < 2*radius+1; xi++) { ADDV (xi); }

/*
 * Now we can start filtering. The initial histogram is already properly set
 * up for (xo,yo) = (0,0). For the remaining pixels of the first row in the
 * output we can sweep through without having to pull the column histograms
 * down.
 */

H (result, 0, 0) = crimp_rank (rowhistogramh, percentile, n);
S (result, 0, 0) = crimp_rank (rowhistograms, percentile, n);
V (result, 0, 0) = crimp_rank (rowhistogramv, percentile, n);
for (xo = 1, xi = radius+1; xo < result->w; xo++, xi++) {
    SHIFT_RIGHT (xi);
    H (result, xo, 0) = crimp_rank (rowhistogramh, percentile, n);
    S (result, xo, 0) = crimp_rank (rowhistograms, percentile, n);
    V (result, xo, 0) = crimp_rank (rowhistogramv, percentile, n);
}

/*
 * With the first row of the result done we can now sweep the remaining lines.
 */

for (yo = 1, yi = radius+1; yo < result->h; yo++, yi++) {

    /* Re-initialize the row histogram for the line */
    memset (rowhistogramh,'\0', 256 * sizeof(int));
    memset (rowhistograms,'\0', 256 * sizeof(int));
    memset (rowhistogramv,'\0', 256 * sizeof(int));
    for (xi = 0 ; xi < 2*radius+1; xi++) {
	SHIFT_DOWN (xi,yi);
	ADDH (xi);
	ADDS (xi);
	ADDV (xi);
    }

    H (result, 0, yo) = crimp_rank (rowhistogramh, percentile, n);
    S (result, 0, yo) = crimp_rank (rowhistograms, percentile, n);
    V (result, 0, yo) = crimp_rank (rowhistogramv, percentile, n);
    for (xo = 1, xi = radius+1; xo < result->w; xo++, xi++) {
	SHIFT_DOWN  (xi+radius,yi);
	SHIFT_RIGHT (xi);
	H (result, xo, yo) = crimp_rank (rowhistogramh, percentile, n);
	S (result, xo, yo) = crimp_rank (rowhistograms, percentile, n);
	V (result, xo, yo) = crimp_rank (rowhistogramv, percentile, n);
    }
 }

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/rof-rgb.crimp.


































































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

rof_rgb
Tcl_Obj* imageObj
int radius
int percentile

/*
 * Generic rank-order filter. Depending on the chosen rank this a min, max, or
 * median filter, or anything in between.
 *
 * The percentile is 0...10000, i.e. percent with a resolution of 1/100.
 *
 * Note that the implied kernel has dimensions (2r+1)x(2r+1), reducing the
 * result image by 2*radius in each di1mension. I.e. the filter doesn't process
 * the 'radius' border pixels along each edge.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, n;
int              rowhistogramr [256];
int              rowhistogramg [256];
int              rowhistogramb [256];
int*             colhistogramr;
int*             colhistogramg;
int*             colhistogramb;

crimp_input (imageObj, image, rgb);

if ((percentile < 0) || (percentile > 10000)) {
    Tcl_SetResult(interp, "bad percentile, expected integer in (0..10000)", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new (image->itype, image->w - 2*radius, image->h - 2*radius);

/*
 * We are using the method described by Simon Perreault and Patrick Hebert in
 * their paper 'Median Filtering In Constant Time'. This method trades memory
 * for speed by keeping one histogram per column, plus a row histogram of the
 * current 2r+1 columns. When moving from pixel to pixel these histograms are
 * incrementally updated, each in constant time. The trick is that the column
 * histograms keep history between rows.
 *
 * Right now we are not making use of any of the proposed optimizations, like
 * multi-level histograms, conditional updating, or vertical striping for
 * cache friendliness.
 *
 * Relationship between input and result coordinate systems:
 *
 * xi = xo + radius, xo in (0...w-2*radius)
 * yi = yo + radius, yo in (0...w-2*radius)
 */

colhistogramr = NALLOC (image->w * 256, int); memset (colhistogramr,'\0', image->w * 256 * sizeof(int));
colhistogramg = NALLOC (image->w * 256, int); memset (colhistogramg,'\0', image->w * 256 * sizeof(int));
colhistogramb = NALLOC (image->w * 256, int); memset (colhistogramb,'\0', image->w * 256 * sizeof(int));

n = (2*radius+1);
n = n * n;

/*
 * TODO :: Test different storage orders for the histograms (row vs column
 *         major order).
 */

/*
 * Access to the column histograms.
 *
 * xi = column index, in the input image coordinate system.
 */
#if 1
#define CHINDEX(xi,value)   ((xi) * 256 + (value))
#else
#define CHINDEX(xi,value)   ((value) * image->w + (xi))
#endif
#define COLHISTR(xi,value) colhistogramr [CHINDEX (xi, value)]
#define COLHISTG(xi,value) colhistogramg [CHINDEX (xi, value)]
#define COLHISTB(xi,value) colhistogramb [CHINDEX (xi, value)]

/*
 * Basic operations on column histograms. Add/remove pixel values.
 */
#define UPR(xi,value)   COLHISTR (xi, value)++
#define DOWNR(xi,value) COLHISTR (xi, value)--
#define UPG(xi,value)   COLHISTG (xi, value)++
#define DOWNG(xi,value) COLHISTG (xi, value)--
#define UPB(xi,value)   COLHISTB (xi, value)++
#define DOWNB(xi,value) COLHISTB (xi, value)--

/*
 * Basic operations on the row histogram. Add and subtract column histograms
 * to/from it. These operations are vectorizable.
 *
 * xi = column index, in the input image coordinate system.
 */

#define ADDR(xi) { int value ; for (value=0;value<256;value++) { rowhistogramr[value] += COLHISTR (xi,value);}}
#define SUBR(xi) { int value ; for (value=0;value<256;value++) { rowhistogramr[value] -= COLHISTR (xi,value);}}
#define ADDG(xi) { int value ; for (value=0;value<256;value++) { rowhistogramg[value] += COLHISTG (xi,value);}}
#define SUBG(xi) { int value ; for (value=0;value<256;value++) { rowhistogramg[value] -= COLHISTG (xi,value);}}
#define ADDB(xi) { int value ; for (value=0;value<256;value++) { rowhistogramb[value] += COLHISTB (xi,value);}}
#define SUBB(xi) { int value ; for (value=0;value<256;value++) { rowhistogramb[value] -= COLHISTB (xi,value);}}

/*
 * Higher level of column histogram change. Move a column histogram down by
 * one row. yi is the index of the new row, and the histogram contains the
 * data for row yi-1. This is in the input image coordinate system.
 *
 * xi = column index, in the input image coordinate system.
 */

#undef  SHIFT_DOWN
#define SHIFT_DOWN(xi,yi) {			          \
	DOWNR ((xi), R (image, (xi), (yi) - radius - 1)); \
	UPR   ((xi), R (image, (xi), (yi) + radius));     \
	DOWNG ((xi), G (image, (xi), (yi) - radius - 1)); \
	UPG   ((xi), G (image, (xi), (yi) + radius));     \
	DOWNB ((xi), B (image, (xi), (yi) - radius - 1)); \
	UPB   ((xi), B (image, (xi), (yi) + radius));     }

/*
 * Higher level of row histogram change. Move the row histogram right by one
 * column. xi is the index of the new column, and the histogram contains the
 * data for column xi-1. This is in the input image coordinate system.
 */

#undef  SHIFT_RIGHT
#define SHIFT_RIGHT(xi) { \
	SUBR ((xi) - radius - 1); ADDR ((xi) + radius); \
	SUBG ((xi) - radius - 1); ADDG ((xi) + radius); \
	SUBB ((xi) - radius - 1); ADDB ((xi) + radius); }

/*
 * ==
 * Initialization, and handling of result row 0
 * ==
 */

/*
 * Initialization I.
 * Scan the first 2*radius+1 rows of the input image into the column
 * histograms.
 */

for (yi = 0; yi < 2*radius+1; yi++) {
    for (xi = 0; xi < image->w; xi++) {
	UPR (xi, R (image, xi, yi));
	UPG (xi, G (image, xi, yi));
	UPB (xi, B (image, xi, yi));
    }
}

/*
 * Initialization II.
 * Add the first 2*radius+1 column histogram into the initial row histogram.
 */

memset (rowhistogramr,'\0', 256 * sizeof(int)); for (xi = 0 ; xi < 2*radius+1; xi++) { ADDR (xi); }
memset (rowhistogramg,'\0', 256 * sizeof(int)); for (xi = 0 ; xi < 2*radius+1; xi++) { ADDG (xi); }
memset (rowhistogramb,'\0', 256 * sizeof(int)); for (xi = 0 ; xi < 2*radius+1; xi++) { ADDB (xi); }

/*
 * Now we can start filtering. The initial histogram is already properly set
 * up for (xo,yo) = (0,0). For the remaining pixels of the first row in the
 * output we can sweep through without having to pull the column histograms
 * down.
 */

R (result, 0, 0) = crimp_rank (rowhistogramr, percentile, n);
G (result, 0, 0) = crimp_rank (rowhistogramg, percentile, n);
B (result, 0, 0) = crimp_rank (rowhistogramb, percentile, n);
for (xo = 1, xi = radius+1; xo < result->w; xo++, xi++) {
    SHIFT_RIGHT (xi);
    R (result, xo, 0) = crimp_rank (rowhistogramr, percentile, n);
    G (result, xo, 0) = crimp_rank (rowhistogramg, percentile, n);
    B (result, xo, 0) = crimp_rank (rowhistogramb, percentile, n);
}

/*
 * With the first row of the result done we can now sweep the remaining lines.
 */

for (yo = 1, yi = radius+1; yo < result->h; yo++, yi++) {

    /* Re-initialize the row histogram for the line */
    memset (rowhistogramr,'\0', 256 * sizeof(int));
    memset (rowhistogramg,'\0', 256 * sizeof(int));
    memset (rowhistogramb,'\0', 256 * sizeof(int));
    for (xi = 0 ; xi < 2*radius+1; xi++) {
	SHIFT_DOWN (xi,yi);
	ADDR (xi);
	ADDG (xi);
	ADDB (xi);
    }

    R (result, 0, yo) = crimp_rank (rowhistogramr, percentile, n);
    G (result, 0, yo) = crimp_rank (rowhistogramg, percentile, n);
    B (result, 0, yo) = crimp_rank (rowhistogramb, percentile, n);
    for (xo = 1, xi = radius+1; xo < result->w; xo++, xi++) {
	SHIFT_DOWN  (xi+radius,yi);
	SHIFT_RIGHT (xi);
	R (result, xo, yo) = crimp_rank (rowhistogramr, percentile, n);
	G (result, xo, yo) = crimp_rank (rowhistogramg, percentile, n);
	B (result, xo, yo) = crimp_rank (rowhistogramb, percentile, n);
    }
 }

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/rof-rgba.crimp.





















































































































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

rof_rgba
Tcl_Obj* imageObj
int radius
int percentile

/*
 * Generic rank-order filter. Depending on the chosen rank this a min, max, or
 * median filter, or anything in between.
 *
 * The percentile is 0...10000, i.e. percent with a resolution of 1/100.
 *
 * Note that the implied kernel has dimensions (2r+1)x(2r+1), reducing the
 * result image by 2*radius in each di1mension. I.e. the filter doesn't process
 * the 'radius' border pixels along each edge.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     kernel;
int              xo, yo, xi, yi, n;
int              rowhistogramr [256];
int              rowhistogramg [256];
int              rowhistogramb [256];
int              rowhistograma [256];
int*             colhistogramr;
int*             colhistogramg;
int*             colhistogramb;
int*             colhistograma;

crimp_input (imageObj, image, rgba);

if ((percentile < 0) || (percentile > 10000)) {
    Tcl_SetResult(interp, "bad percentile, expected integer in (0..10000)", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new (image->itype, image->w - 2*radius, image->h - 2*radius);

/*
 * We are using the method described by Simon Perreault and Patrick Hebert in
 * their paper 'Median Filtering In Constant Time'. This method trades memory
 * for speed by keeping one histogram per column, plus a row histogram of the
 * current 2r+1 columns. When moving from pixel to pixel these histograms are
 * incrementally updated, each in constant time. The trick is that the column
 * histograms keep history between rows.
 *
 * Right now we are not making use of any of the proposed optimizations, like
 * multi-level histograms, conditional updating, or vertical striping for
 * cache friendliness.
 *
 * Relationship between input and result coordinate systems:
 *
 * xi = xo + radius, xo in (0...w-2*radius)
 * yi = yo + radius, yo in (0...w-2*radius)
 */

colhistogramr = NALLOC (image->w * 256, int); memset (colhistogramr,'\0', image->w * 256 * sizeof(int));
colhistogramg = NALLOC (image->w * 256, int); memset (colhistogramg,'\0', image->w * 256 * sizeof(int));
colhistogramb = NALLOC (image->w * 256, int); memset (colhistogramb,'\0', image->w * 256 * sizeof(int));
colhistograma = NALLOC (image->w * 256, int); memset (colhistograma,'\0', image->w * 256 * sizeof(int));

n = (2*radius+1);
n = n * n;

/*
 * TODO :: Test different storage orders for the histograms (row vs column
 *         major order).
 */

/*
 * Access to the column histograms.
 *
 * xi = column index, in the input image coordinate system.
 */
#if 1
#define CHINDEX(xi,value)   ((xi) * 256 + (value))
#else
#define CHINDEX(xi,value)   ((value) * image->w + (xi))
#endif
#define COLHISTR(xi,value) colhistogramr [CHINDEX (xi, value)]
#define COLHISTG(xi,value) colhistogramg [CHINDEX (xi, value)]
#define COLHISTB(xi,value) colhistogramb [CHINDEX (xi, value)]
#define COLHISTA(xi,value) colhistograma [CHINDEX (xi, value)]

/*
 * Basic operations on column histograms. Add/remove pixel values.
 */
#define UPR(xi,value)   COLHISTR (xi, value)++
#define DOWNR(xi,value) COLHISTR (xi, value)--
#define UPG(xi,value)   COLHISTG (xi, value)++
#define DOWNG(xi,value) COLHISTG (xi, value)--
#define UPB(xi,value)   COLHISTB (xi, value)++
#define DOWNB(xi,value) COLHISTB (xi, value)--
#define UPA(xi,value)   COLHISTA (xi, value)++
#define DOWNA(xi,value) COLHISTA (xi, value)--

/*
 * Basic operations on the row histogram. Add and subtract column histograms
 * to/from it. These operations are vectorizable.
 *
 * xi = column index, in the input image coordinate system.
 */

#define ADDR(xi) { int value ; for (value=0;value<256;value++) { rowhistogramr[value] += COLHISTR (xi,value);}}
#define SUBR(xi) { int value ; for (value=0;value<256;value++) { rowhistogramr[value] -= COLHISTR (xi,value);}}
#define ADDG(xi) { int value ; for (value=0;value<256;value++) { rowhistogramg[value] += COLHISTG (xi,value);}}
#define SUBG(xi) { int value ; for (value=0;value<256;value++) { rowhistogramg[value] -= COLHISTG (xi,value);}}
#define ADDB(xi) { int value ; for (value=0;value<256;value++) { rowhistogramb[value] += COLHISTB (xi,value);}}
#define SUBB(xi) { int value ; for (value=0;value<256;value++) { rowhistogramb[value] -= COLHISTB (xi,value);}}
#define ADDA(xi) { int value ; for (value=0;value<256;value++) { rowhistograma[value] += COLHISTA (xi,value);}}
#define SUBA(xi) { int value ; for (value=0;value<256;value++) { rowhistograma[value] -= COLHISTA (xi,value);}}

/*
 * Higher level of column histogram change. Move a column histogram down by
 * one row. yi is the index of the new row, and the histogram contains the
 * data for row yi-1. This is in the input image coordinate system.
 *
 * xi = column index, in the input image coordinate system.
 */

#undef  SHIFT_DOWN
#define SHIFT_DOWN(xi,yi) {			          \
	DOWNR ((xi), R (image, (xi), (yi) - radius - 1)); \
	UPR   ((xi), R (image, (xi), (yi) + radius));     \
	DOWNG ((xi), G (image, (xi), (yi) - radius - 1)); \
	UPG   ((xi), G (image, (xi), (yi) + radius));     \
	DOWNB ((xi), B (image, (xi), (yi) - radius - 1)); \
	UPB   ((xi), B (image, (xi), (yi) + radius));     \
	DOWNA ((xi), A (image, (xi), (yi) - radius - 1)); \
	UPA   ((xi), A (image, (xi), (yi) + radius));     }

/*
 * Higher level of row histogram change. Move the row histogram right by one
 * column. xi is the index of the new column, and the histogram contains the
 * data for column xi-1. This is in the input image coordinate system.
 */

#undef  SHIFT_RIGHT
#define SHIFT_RIGHT(xi) { \
	SUBR ((xi) - radius - 1); ADDR ((xi) + radius); \
	SUBG ((xi) - radius - 1); ADDG ((xi) + radius); \
	SUBB ((xi) - radius - 1); ADDB ((xi) + radius); \
	SUBA ((xi) - radius - 1); ADDA ((xi) + radius); }

/*
 * ==
 * Initialization, and handling of result row 0
 * ==
 */

/*
 * Initialization I.
 * Scan the first 2*radius+1 rows of the input image into the column
 * histograms.
 */

for (yi = 0; yi < 2*radius+1; yi++) {
    for (xi = 0; xi < image->w; xi++) {
	UPR (xi, R (image, xi, yi));
	UPG (xi, G (image, xi, yi));
	UPB (xi, B (image, xi, yi));
	UPA (xi, A (image, xi, yi));
    }
}

/*
 * Initialization II.
 * Add the first 2*radius+1 column histogram into the initial row histogram.
 */

memset (rowhistogramr,'\0', 256 * sizeof(int)); for (xi = 0 ; xi < 2*radius+1; xi++) { ADDR (xi); }
memset (rowhistogramg,'\0', 256 * sizeof(int)); for (xi = 0 ; xi < 2*radius+1; xi++) { ADDG (xi); }
memset (rowhistogramb,'\0', 256 * sizeof(int)); for (xi = 0 ; xi < 2*radius+1; xi++) { ADDB (xi); }
memset (rowhistograma,'\0', 256 * sizeof(int)); for (xi = 0 ; xi < 2*radius+1; xi++) { ADDA (xi); }

/*
 * Now we can start filtering. The initial histogram is already properly set
 * up for (xo,yo) = (0,0). For the remaining pixels of the first row in the
 * output we can sweep through without having to pull the column histograms
 * down.
 */

R (result, 0, 0) = crimp_rank (rowhistogramr, percentile, n);
G (result, 0, 0) = crimp_rank (rowhistogramg, percentile, n);
B (result, 0, 0) = crimp_rank (rowhistogramb, percentile, n);
A (result, 0, 0) = crimp_rank (rowhistograma, percentile, n);
for (xo = 1, xi = radius+1; xo < result->w; xo++, xi++) {
    SHIFT_RIGHT (xi);
    R (result, xo, 0) = crimp_rank (rowhistogramr, percentile, n);
    G (result, xo, 0) = crimp_rank (rowhistogramg, percentile, n);
    B (result, xo, 0) = crimp_rank (rowhistogramb, percentile, n);
    A (result, xo, 0) = crimp_rank (rowhistograma, percentile, n);
}

/*
 * With the first row of the result done we can now sweep the remaining lines.
 */

for (yo = 1, yi = radius+1; yo < result->h; yo++, yi++) {

    /* Re-initialize the row histogram for the line */
    memset (rowhistogramr,'\0', 256 * sizeof(int));
    memset (rowhistogramg,'\0', 256 * sizeof(int));
    memset (rowhistogramb,'\0', 256 * sizeof(int));
    memset (rowhistograma,'\0', 256 * sizeof(int));
    for (xi = 0 ; xi < 2*radius+1; xi++) {
	SHIFT_DOWN (xi,yi);
	ADDR (xi);
	ADDG (xi);
	ADDB (xi);
	ADDA (xi);
    }

    R (result, 0, yo) = crimp_rank (rowhistogramr, percentile, n);
    G (result, 0, yo) = crimp_rank (rowhistogramg, percentile, n);
    B (result, 0, yo) = crimp_rank (rowhistogramb, percentile, n);
    A (result, 0, yo) = crimp_rank (rowhistograma, percentile, n);
    for (xo = 1, xi = radius+1; xo < result->w; xo++, xi++) {
	SHIFT_DOWN  (xi+radius,yi);
	SHIFT_RIGHT (xi);
	R (result, xo, yo) = crimp_rank (rowhistogramr, percentile, n);
	G (result, xo, yo) = crimp_rank (rowhistogramg, percentile, n);
	B (result, xo, yo) = crimp_rank (rowhistogramb, percentile, n);
	A (result, xo, yo) = crimp_rank (rowhistograma, percentile, n);
    }
 }

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/scale-float.crimp.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

scale_float
Tcl_Obj* imageObj
double factor

/*
 * Multiply all pixels of the image by the factor.
 */

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, float);

result = crimp_new_like (image);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = FLOATP (image, x, y) * factor;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/screen-grey8-grey8.crimp.





























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

screen_grey8_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise 1-(1-A)*(1-B) combination of two images. The images
 * have to have equal dimensions. This could be done at Tcl level using a
 * combination of 'multiply' and 'invert'. Doing it in C on the other hand
 * avoids the three temporary images of that implementation.
 */

#define BINOP(a,b) (255 - (((255-(a))*(255-(b)))/255))
#include "binop_grey8_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/screen-rgb-grey8.crimp.





























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

screen_rgb_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise 1-(1-A)*(1-B) combination of two images. The images
 * have to have equal dimensions. This could be done at Tcl level using a
 * combination of 'multiply' and 'invert'. Doing it in C on the other hand
 * avoids the three temporary images of that implementation.
 */

#define BINOP(a,b) (255 - (((255-(a))*(255-(b)))/255))
#include "binop_rgb_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/screen-rgb-rgb.crimp.





























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

screen_rgb_rgb
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise 1-(1-A)*(1-B) combination of two images. The images
 * have to have equal dimensions. This could be done at Tcl level using a
 * combination of 'multiply' and 'invert'. Doing it in C on the other hand
 * avoids the three temporary images of that implementation.
 */

#define BINOP(a,b) (255 - (((255-(a))*(255-(b)))/255))
#include "binop_rgb_rgb.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/screen-rgba-grey8.crimp.





























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

screen_rgba_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise 1-(1-A)*(1-B) combination of two images. The images
 * have to have equal dimensions. This could be done at Tcl level using a
 * combination of 'multiply' and 'invert'. Doing it in C on the other hand
 * avoids the three temporary images of that implementation.
 */

#define BINOP(a,b) (255 - (((255-(a))*(255-(b)))/255))
#include "binop_rgba_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/screen-rgba-rgb.crimp.





























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

screen_rgba_rgb
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise 1-(1-A)*(1-B) combination of two images. The images
 * have to have equal dimensions. This could be done at Tcl level using a
 * combination of 'multiply' and 'invert'. Doing it in C on the other hand
 * avoids the three temporary images of that implementation.
 */

#define BINOP(a,b) (255 - (((255-(a))*(255-(b)))/255))
#include "binop_rgba_rgb.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/screen-rgba-rgba.crimp.





























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

screen_rgba_rgba
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj

/*
 * Pixel- and channel-wise 1-(1-A)*(1-B) combination of two images. The images
 * have to have equal dimensions. This could be done at Tcl level using a
 * combination of 'multiply' and 'invert'. Doing it in C on the other hand
 * avoids the three temporary images of that implementation.
 */

#define BINOP(a,b) (255 - (((255-(a))*(255-(b)))/255))
#include "binop_rgba_rgba.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/setalpha-rgb-grey8.crimp.


















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

setalpha_rgb_grey8
Tcl_Obj* imageObj
Tcl_Obj* imageAlphaObj

/*
 * Extend the input with an alpha channel holding the data of the second
 * image.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     imageA;
int x, y;

crimp_input (imageObj,      image,  rgb);
crimp_input (imageAlphaObj, imageA, grey8);

if (!crimp_eq_dim (image, imageA)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_rgba (image->w, image->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	R (result, x, y) = R (image, x, y);
	G (result, x, y) = G (image, x, y);
	B (result, x, y) = B (image, x, y);
	A (result, x, y) = GREY8 (imageA, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/setalpha-rgb-rgba.crimp.


















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

setalpha_rgb_rgba
Tcl_Obj* imageObj
Tcl_Obj* imageAlphaObj

/*
 * Extend the input with an alpha channel holding the data of the second
 * image's alpha channel.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     imageA;
int x, y;

crimp_input (imageObj,      image,  rgb);
crimp_input (imageAlphaObj, imageA, rgba);

if (!crimp_eq_dim (image, imageA)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_rgba (image->w, image->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	R (result, x, y) = R (image, x, y);
	G (result, x, y) = G (image, x, y);
	B (result, x, y) = B (image, x, y);
	A (result, x, y) = A (imageA, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/setalpha-rgba-grey8.crimp.

















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

setalpha_rgba_grey8
Tcl_Obj* imageObj
Tcl_Obj* imageAlphaObj

/*
 * Replace the input's alpha channel with the data from the second image.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     imageA;
int x, y;

crimp_input (imageObj,      image,  rgba);
crimp_input (imageAlphaObj, imageA, grey8);

if (!crimp_eq_dim (image, imageA)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (image);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	R (result, x, y) = R (image, x, y);
	G (result, x, y) = G (image, x, y);
	B (result, x, y) = B (image, x, y);
	A (result, x, y) = GREY8 (imageA, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/setalpha-rgba-rgba.crimp.


















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

setalpha_rgba_rgba
Tcl_Obj* imageObj
Tcl_Obj* imageAlphaObj

/*
 * Replace the input's alpha channel with the alpha channel of the second
 * image. IOW, copy the second image's alpha channel over into the first.
 */

crimp_image*     result;
crimp_image*     image;
crimp_image*     imageA;
int x, y;

crimp_input (imageObj,      image,  rgba);
crimp_input (imageAlphaObj, imageA, rgba);

if (!crimp_eq_dim (image, imageA)) {
    Tcl_SetResult(interp, "image dimensions do not match", TCL_STATIC);
    return TCL_ERROR;
}

result = crimp_new_like (image);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	R (result, x, y) = R (image, x, y);
	G (result, x, y) = G (image, x, y);
	B (result, x, y) = B (image, x, y);
	A (result, x, y) = A (imageA, x, y);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/split-hsv.crimp.




















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

split_hsv
Tcl_Obj* imageObj

Tcl_Obj*         list[3];
const crimp_imagetype* grey = crimp_imagetype_find ("crimp::image::grey8");
crimp_image*     image;
crimp_image*     hue;
crimp_image*     sat;
crimp_image*     val;
int              x, y;

crimp_input (imageObj, image, hsv);

hue = crimp_new (grey, image->w, image->h);
sat = crimp_new (grey, image->w, image->h);
val = crimp_new (grey, image->w, image->h);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	/*
	 * Placing the pixels of each color channel into their own images.
	 */

	GREY8 (hue, x, y) = H (image, x, y);
	GREY8 (sat, x, y) = S (image, x, y);
	GREY8 (val, x, y) = V (image, x, y);
    }
}

list [0] = crimp_new_image_obj (hue);
list [1] = crimp_new_image_obj (sat);
list [2] = crimp_new_image_obj (val);

Tcl_SetObjResult(interp, Tcl_NewListObj (3, list));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/split-rgb.crimp.




















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

split_rgb
Tcl_Obj* imageObj

Tcl_Obj*         list[3];
const crimp_imagetype* grey = crimp_imagetype_find ("crimp::image::grey8");
crimp_image*     image;
crimp_image*     red;
crimp_image*     green;
crimp_image*     blue;
int              x, y;

crimp_input (imageObj, image, rgb);

red   = crimp_new (grey, image->w, image->h);
green = crimp_new (grey, image->w, image->h);
blue  = crimp_new (grey, image->w, image->h);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	/*
	 * Placing the pixels of each color channel into their own images.
	 */

	GREY8 (red,   x, y) = R (image, x, y);
	GREY8 (green, x, y) = G (image, x, y);
	GREY8 (blue,  x, y) = B (image, x, y);
    }
}

list [0] = crimp_new_image_obj (red);
list [1] = crimp_new_image_obj (green);
list [2] = crimp_new_image_obj (blue);

Tcl_SetObjResult(interp, Tcl_NewListObj (3, list));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/split-rgba.crimp.

























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

split_rgba
Tcl_Obj* imageObj

Tcl_Obj*         list[4];
const crimp_imagetype* grey = crimp_imagetype_find ("crimp::image::grey8");
crimp_image*     image;
crimp_image*     red;
crimp_image*     green;
crimp_image*     blue;
crimp_image*     alpha;
int              x, y;

crimp_input (imageObj, image, rgba);

red   = crimp_new (grey, image->w, image->h);
green = crimp_new (grey, image->w, image->h);
blue  = crimp_new (grey, image->w, image->h);
alpha = crimp_new (grey, image->w, image->h);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	/*
	 * Placing the pixels of each color channel (and alpha) into
	 * their own images.
	 */

	GREY8 (red,   x, y) = R (image, x, y);
	GREY8 (green, x, y) = G (image, x, y);
	GREY8 (blue,  x, y) = B (image, x, y);
	GREY8 (alpha, x, y) = A (image, x, y);
    }
}

list [0] = crimp_new_image_obj (red);
list [1] = crimp_new_image_obj (green);
list [2] = crimp_new_image_obj (blue);
list [3] = crimp_new_image_obj (alpha);

Tcl_SetObjResult(interp, Tcl_NewListObj (4, list));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/sqrt-float.crimp.








































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

sqrt_float
Tcl_Obj* imageObj

/*
 * Square root of all pixels of the image.
 */

crimp_image* image;
crimp_image* result;
int          x, y;

crimp_input (imageObj, image, float);

result = crimp_new_like (image);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {

	FLOATP (result, x, y) = sqrt (FLOATP (image, x, y));
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/stats-float.crimp.














































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

stats_float
Tcl_Obj* imageObj

crimp_image* image;
Tcl_Obj* result;
Tcl_Obj* cname;
Tcl_Obj* cdata;

int x, y, w, h, n;
double min, max, var, stddev, mean, median, middle, sum, sumsq;

crimp_input (imageObj, image, float);

w = image->w;
h = image->h;
n = w * h;

/* 
 * Scan image
 */

sum = sumsq = 0;
min = max = FLOATP (image, 0, 0);

for (y = 0; y < h; y++) {
    for (x = 0; x < w; x++) {
	double val = FLOATP (image, x, y);

	sum   += val;
	sumsq += val*val;
	min = MIN (min, val);
	max = MAX (max, val);
    }
}

mean   = sum / n;
middle = (min + max)/2;
var    = sumsq/n - mean*mean;
stddev = sqrt (var);

/*
 * Fill the dictonary.
 * NOTES:
 * (1) No histogram, we currently have no efficient way of computing that for floats.
 * (2) No median either, as this is based on the histogram.
 *
 * FUTURE: Some way of sharing the string Tcl_Obj* for the fixed keys.
 */

cdata = Tcl_NewDictObj ();
Tcl_DictObjPut (NULL, cdata, Tcl_NewStringObj ("min",      -1), Tcl_NewDoubleObj (min));
Tcl_DictObjPut (NULL, cdata, Tcl_NewStringObj ("max",      -1), Tcl_NewDoubleObj (max));
Tcl_DictObjPut (NULL, cdata, Tcl_NewStringObj ("mean",     -1), Tcl_NewDoubleObj (mean));
Tcl_DictObjPut (NULL, cdata, Tcl_NewStringObj ("middle",   -1), Tcl_NewDoubleObj (middle));
Tcl_DictObjPut (NULL, cdata, Tcl_NewStringObj ("variance", -1), Tcl_NewDoubleObj (var));
Tcl_DictObjPut (NULL, cdata, Tcl_NewStringObj ("stddev",   -1), Tcl_NewDoubleObj (stddev));

result = Tcl_NewDictObj ();
Tcl_DictObjPut (NULL, result, Tcl_NewStringObj (image->itype->cname[0],-1), cdata);

Tcl_SetObjResult (interp, result);
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/stats-grey16.crimp.














































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

stats_grey16
Tcl_Obj* imageObj

crimp_image* image;
Tcl_Obj* result;
Tcl_Obj* cname;
Tcl_Obj* cdata;

int x, y, w, h, n, min, max;
double var, stddev, mean, median, middle, sum, sumsq;

crimp_input (imageObj, image, grey16);

w = image->w;
h = image->h;
n = w * h;

/* 
 * Scan image
 */

sum = sumsq = 0;
min = max = GREY16 (image, 0, 0);

for (y = 0; y < h; y++) {
    for (x = 0; x < w; x++) {
	int val = GREY16 (image, x, y);

	sum   += val;
	sumsq += val*val;
	min = MIN (min, val);
	max = MAX (max, val);
    }
}

mean   = sum / n;
middle = (min + max)/2.0;
var    = sumsq/n - mean*mean;
stddev = sqrt (var);

/*
 * Fill the dictonary.
 * NOTES:
 * (1) No histogram, we currently have no efficient way of computing that for grey16.
 * (2) No median either, as this is based on the histogram.
 *
 * FUTURE: Some way of sharing the string Tcl_Obj* for the fixed keys.
 */

cdata = Tcl_NewDictObj ();
Tcl_DictObjPut (NULL, cdata, Tcl_NewStringObj ("min",      -1), Tcl_NewIntObj (min));
Tcl_DictObjPut (NULL, cdata, Tcl_NewStringObj ("max",      -1), Tcl_NewIntObj (max));
Tcl_DictObjPut (NULL, cdata, Tcl_NewStringObj ("mean",     -1), Tcl_NewDoubleObj (mean));
Tcl_DictObjPut (NULL, cdata, Tcl_NewStringObj ("middle",   -1), Tcl_NewDoubleObj (middle));
Tcl_DictObjPut (NULL, cdata, Tcl_NewStringObj ("variance", -1), Tcl_NewDoubleObj (var));
Tcl_DictObjPut (NULL, cdata, Tcl_NewStringObj ("stddev",   -1), Tcl_NewDoubleObj (stddev));

result = Tcl_NewDictObj ();
Tcl_DictObjPut (NULL, result, Tcl_NewStringObj (image->itype->cname[0],-1), cdata);

Tcl_SetObjResult (interp, result);
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/stats-grey32.crimp.















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

stats_grey32
Tcl_Obj* imageObj

crimp_image* image;
Tcl_Obj* result;
Tcl_Obj* cname;
Tcl_Obj* cdata;

int x, y, w, h, n;
Tcl_WideInt min, max;
double var, stddev, mean, median, middle, sum, sumsq;

crimp_input (imageObj, image, grey32);

w = image->w;
h = image->h;
n = w * h;

/* 
 * Scan image
 */

sum = sumsq = 0;
min = max = GREY32 (image, 0, 0);

for (y = 0; y < h; y++) {
    for (x = 0; x < w; x++) {
	Tcl_WideInt val = GREY32 (image, x, y);

	sum   += val;
	sumsq += val*val;
	min = MIN (min, val);
	max = MAX (max, val);
    }
}

mean   = sum / n;
middle = (min + max)/2.0;
var    = sumsq/n - mean*mean;
stddev = sqrt (var);

/*
 * Fill the dictonary.
 * NOTES:
 * (1) No histogram, we currently have no efficient way of computing that for grey32.
 * (2) No median either, as this is based on the histogram.
 *
 * FUTURE: Some way of sharing the string Tcl_Obj* for the fixed keys.
 */

cdata = Tcl_NewDictObj ();
Tcl_DictObjPut (NULL, cdata, Tcl_NewStringObj ("min",      -1), Tcl_NewWideIntObj (min));
Tcl_DictObjPut (NULL, cdata, Tcl_NewStringObj ("max",      -1), Tcl_NewWideIntObj (max));
Tcl_DictObjPut (NULL, cdata, Tcl_NewStringObj ("mean",     -1), Tcl_NewDoubleObj (mean));
Tcl_DictObjPut (NULL, cdata, Tcl_NewStringObj ("middle",   -1), Tcl_NewDoubleObj (middle));
Tcl_DictObjPut (NULL, cdata, Tcl_NewStringObj ("variance", -1), Tcl_NewDoubleObj (var));
Tcl_DictObjPut (NULL, cdata, Tcl_NewStringObj ("stddev",   -1), Tcl_NewDoubleObj (stddev));

result = Tcl_NewDictObj ();
Tcl_DictObjPut (NULL, result, Tcl_NewStringObj (image->itype->cname[0],-1), cdata);

Tcl_SetObjResult (interp, result);
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/subtract-float-float.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

subtract_float_float
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
float scale
float offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) - (b)) / scale) + offset)
#include "binop_float_float.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/subtract-float-grey16.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

subtract_float_grey16
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
float scale
float offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) - (b)) / scale) + offset)
#include "binop_float_grey16.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/subtract-float-grey32.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

subtract_float_grey32
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
float scale
float offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) - (b)) / scale) + offset)
#include "binop_float_grey32.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/subtract-float-grey8.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

subtract_float_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
float scale
float offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) - (b)) / scale) + offset)
#include "binop_float_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/subtract-grey16-float.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

subtract_grey16_float
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
float scale
float offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) - (b)) / scale) + offset)
#include "binop_grey16_float.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/subtract-grey32-float.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

subtract_grey32_float
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
float scale
float offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) - (b)) / scale) + offset)
#include "binop_grey32_float.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/subtract-grey8-float.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

subtract_grey8_float
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
float scale
float offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) - (b)) / scale) + offset)
#include "binop_grey8_float.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/subtract-grey8-grey8.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

subtract_grey8_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) - (b)) / scale) + offset)
#include "binop_grey8_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/subtract-grey8-rgb.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

subtract_grey8_rgb
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) - (b)) / scale) + offset)
#include "binop_grey8_rgb.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/subtract-grey8-rgba.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

subtract_grey8_rgba
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) - (b)) / scale) + offset)
#include "binop_grey8_rgba.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/subtract-rgb-grey8.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

subtract_rgb_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) - (b)) / scale) + offset)
#include "binop_rgb_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/subtract-rgb-rgb.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

subtract_rgb_rgb
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) - (b)) / scale) + offset)
#include "binop_rgb_rgb.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/subtract-rgb-rgba.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

subtract_rgb_rgba
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) - (b)) / scale) + offset)
#include "binop_rgb_rgba.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/subtract-rgba-grey8.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

subtract_rgba_grey8
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) - (b)) / scale) + offset)
#include "binop_rgba_grey8.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/subtract-rgba-rgb.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

subtract_rgba_rgb
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) - (b)) / scale) + offset)
#include "binop_rgba_rgb.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/subtract-rgba-rgba.crimp.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

subtract_rgba_rgba
Tcl_Obj* imageAObj
Tcl_Obj* imageBObj
int scale
int offset

/*
 * Pixel- and channel-wise scaled and biased subtraction of two images. The
 * images have to have equal dimensions. Values out of range are wrapped into
 * it (modulo).
 */

#define BINOP(a,b) ((((a) - (b)) / scale) + offset)
#include "binop_rgba_rgba.c"
#undef BINOP

/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/threshold-float-float.crimp.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

threshold_float_float
Tcl_Obj* imageObj
Tcl_Obj* thresholdObj

crimp_image* image;
crimp_image* threshold;
crimp_image* result;
int          x, y;

crimp_input (imageObj,     image,     float);
crimp_input (thresholdObj, threshold, float);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	FLOATP (result, x, y) = FLOATP (image, x, y) >= FLOATP (threshold, x, y) 
	    ? BLACK
	    : WHITE;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/threshold-float-grey16.crimp.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

threshold_float_grey16
Tcl_Obj* imageObj
Tcl_Obj* thresholdObj

crimp_image* image;
crimp_image* threshold;
crimp_image* result;
int          x, y;

crimp_input (imageObj,     image,     float);
crimp_input (thresholdObj, threshold, grey16);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	FLOATP (result, x, y) = FLOATP (image, x, y) >= GREY16 (threshold, x, y) 
	    ? BLACK
	    : WHITE;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/threshold-float-grey32.crimp.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

threshold_float_grey32
Tcl_Obj* imageObj
Tcl_Obj* thresholdObj

crimp_image* image;
crimp_image* threshold;
crimp_image* result;
int          x, y;

crimp_input (imageObj,     image,     float);
crimp_input (thresholdObj, threshold, grey32);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	FLOATP (result, x, y) = FLOATP (image, x, y) >= GREY32 (threshold, x, y) 
	    ? BLACK
	    : WHITE;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/threshold-float-grey8.crimp.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

threshold_float_grey8
Tcl_Obj* imageObj
Tcl_Obj* thresholdObj

crimp_image* image;
crimp_image* threshold;
crimp_image* result;
int          x, y;

crimp_input (imageObj,     image,     float);
crimp_input (thresholdObj, threshold, grey8);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	FLOATP (result, x, y) = FLOATP (image, x, y) >= GREY8 (threshold, x, y) 
	    ? BLACK
	    : WHITE;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/threshold-grey16-float.crimp.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

threshold_grey16_float
Tcl_Obj* imageObj
Tcl_Obj* thresholdObj

crimp_image* image;
crimp_image* threshold;
crimp_image* result;
int          x, y;

crimp_input (imageObj,     image,     grey16);
crimp_input (thresholdObj, threshold, float);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	GREY16 (result, x, y) = GREY16 (image, x, y) >= FLOATP (threshold, x, y) 
	    ? BLACK
	    : WHITE;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/threshold-grey16-grey16.crimp.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

threshold_grey16_grey16
Tcl_Obj* imageObj
Tcl_Obj* thresholdObj

crimp_image* image;
crimp_image* threshold;
crimp_image* result;
int          x, y;

crimp_input (imageObj,     image,     grey16);
crimp_input (thresholdObj, threshold, grey16);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	GREY16 (result, x, y) = GREY16 (image, x, y) >= GREY16 (threshold, x, y) 
	    ? BLACK
	    : WHITE;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/threshold-grey32-float.crimp.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

threshold_grey32_float
Tcl_Obj* imageObj
Tcl_Obj* thresholdObj

crimp_image* image;
crimp_image* threshold;
crimp_image* result;
int          x, y;

crimp_input (imageObj,     image,     grey32);
crimp_input (thresholdObj, threshold, float);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	GREY32 (result, x, y) = GREY32 (image, x, y) >= FLOATP (threshold, x, y) 
	    ? BLACK
	    : WHITE;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/threshold-grey32-grey32.crimp.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

threshold_grey32_grey32
Tcl_Obj* imageObj
Tcl_Obj* thresholdObj

crimp_image* image;
crimp_image* threshold;
crimp_image* result;
int          x, y;

crimp_input (imageObj,     image,     grey32);
crimp_input (thresholdObj, threshold, grey32);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	GREY32 (result, x, y) = GREY32 (image, x, y) >= GREY32 (threshold, x, y) 
	    ? BLACK
	    : WHITE;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/threshold-grey8-float.crimp.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

threshold_grey8_float
Tcl_Obj* imageObj
Tcl_Obj* thresholdObj

crimp_image* image;
crimp_image* threshold;
crimp_image* result;
int          x, y;

crimp_input (imageObj,     image,     grey8);
crimp_input (thresholdObj, threshold, float);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	GREY8 (result, x, y) = GREY8 (image, x, y) >= FLOATP (threshold, x, y) 
	    ? BLACK
	    : WHITE;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/threshold-grey8-grey8.crimp.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

threshold_grey8_grey8
Tcl_Obj* imageObj
Tcl_Obj* thresholdObj

crimp_image* image;
crimp_image* threshold;
crimp_image* result;
int          x, y;

crimp_input (imageObj,     image,     grey8);
crimp_input (thresholdObj, threshold, grey8);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	GREY8 (result, x, y) = GREY8 (image, x, y) >= GREY8 (threshold, x, y) 
	    ? BLACK
	    : WHITE;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/threshold-hsv-float.crimp.















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

threshold_hsv_float
Tcl_Obj* imageObj
Tcl_Obj* thresholdHObj
Tcl_Obj* thresholdSObj
Tcl_Obj* thresholdVObj

crimp_image* image;
crimp_image* thresholdh;
crimp_image* thresholds;
crimp_image* thresholdv;
crimp_image* result;
int          x, y;

crimp_input (imageObj,      image,      hsv);
crimp_input (thresholdHObj, thresholdh, float);
crimp_input (thresholdSObj, thresholds, float);
crimp_input (thresholdVObj, thresholdv, float);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	H (result, x, y) = H (image, x, y) >= FLOATP (thresholdh, x, y) ? BLACK : WHITE;
	S (result, x, y) = S (image, x, y) >= FLOATP (thresholds, x, y) ? BLACK : WHITE;
	V (result, x, y) = V (image, x, y) >= FLOATP (thresholdv, x, y) ? BLACK : WHITE;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/threshold-hsv-grey8.crimp.















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

threshold_hsv_grey8
Tcl_Obj* imageObj
Tcl_Obj* thresholdHObj
Tcl_Obj* thresholdSObj
Tcl_Obj* thresholdVObj

crimp_image* image;
crimp_image* thresholdh;
crimp_image* thresholds;
crimp_image* thresholdv;
crimp_image* result;
int          x, y;

crimp_input (imageObj,      image,      hsv);
crimp_input (thresholdHObj, thresholdh, grey8);
crimp_input (thresholdSObj, thresholds, grey8);
crimp_input (thresholdVObj, thresholdv, grey8);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	H (result, x, y) = H (image, x, y) >= GREY8 (thresholdh, x, y) ? BLACK : WHITE;
	S (result, x, y) = S (image, x, y) >= GREY8 (thresholds, x, y) ? BLACK : WHITE;
	V (result, x, y) = V (image, x, y) >= GREY8 (thresholdv, x, y) ? BLACK : WHITE;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/threshold-hsv-hsv.crimp.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

threshold_hsv_hsv
Tcl_Obj* imageObj
Tcl_Obj* thresholdObj

crimp_image* image;
crimp_image* threshold;
crimp_image* result;
int          x, y;

crimp_input (imageObj,     image,     hsv);
crimp_input (thresholdObj, threshold, hsv);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	H (result, x, y) = H (image, x, y) >= H (threshold, x, y) ? BLACK : WHITE;
	S (result, x, y) = S (image, x, y) >= S (threshold, x, y) ? BLACK : WHITE;
	V (result, x, y) = V (image, x, y) >= V (threshold, x, y) ? BLACK : WHITE;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/threshold-rgb-float.crimp.















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

threshold_rgb_float
Tcl_Obj* imageObj
Tcl_Obj* thresholdRObj
Tcl_Obj* thresholdGObj
Tcl_Obj* thresholdBObj

crimp_image* image;
crimp_image* thresholdr;
crimp_image* thresholdg;
crimp_image* thresholdb;
crimp_image* result;
int          x, y;

crimp_input (imageObj,      image,      rgb);
crimp_input (thresholdRObj, thresholdr, float);
crimp_input (thresholdGObj, thresholdg, float);
crimp_input (thresholdBObj, thresholdb, float);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	R (result, x, y) = R (image, x, y) >= FLOATP (thresholdr, x, y) ? BLACK : WHITE;
	G (result, x, y) = G (image, x, y) >= FLOATP (thresholdg, x, y) ? BLACK : WHITE;
	B (result, x, y) = B (image, x, y) >= FLOATP (thresholdb, x, y) ? BLACK : WHITE;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/threshold-rgb-grey8.crimp.















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

threshold_rgb_grey8
Tcl_Obj* imageObj
Tcl_Obj* thresholdRObj
Tcl_Obj* thresholdGObj
Tcl_Obj* thresholdBObj

crimp_image* image;
crimp_image* thresholdr;
crimp_image* thresholdg;
crimp_image* thresholdb;
crimp_image* result;
int          x, y;

crimp_input (imageObj,      image,      rgb);
crimp_input (thresholdRObj, thresholdr, grey8);
crimp_input (thresholdGObj, thresholdg, grey8);
crimp_input (thresholdBObj, thresholdb, grey8);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	R (result, x, y) = R (image, x, y) >= GREY8 (thresholdr, x, y) ? BLACK : WHITE;
	G (result, x, y) = G (image, x, y) >= GREY8 (thresholdg, x, y) ? BLACK : WHITE;
	B (result, x, y) = B (image, x, y) >= GREY8 (thresholdb, x, y) ? BLACK : WHITE;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/threshold-rgb-rgb.crimp.









































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

threshold_rgb_rgb
Tcl_Obj* imageObj
Tcl_Obj* thresholdObj

crimp_image* image;
crimp_image* threshold;
crimp_image* result;
int          x, y;

crimp_input (imageObj,     image,     rgb);
crimp_input (thresholdObj, threshold, rgb);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	R (result, x, y) = R (image, x, y) >= R (threshold, x, y) ? BLACK : WHITE;
	G (result, x, y) = G (image, x, y) >= G (threshold, x, y) ? BLACK : WHITE;
	B (result, x, y) = B (image, x, y) >= B (threshold, x, y) ? BLACK : WHITE;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/threshold-rgba-float.crimp.



















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

threshold_rgba_float
Tcl_Obj* imageObj
Tcl_Obj* thresholdRObj
Tcl_Obj* thresholdGObj
Tcl_Obj* thresholdBObj
Tcl_Obj* thresholdAObj

crimp_image* image;
crimp_image* thresholdr;
crimp_image* thresholdg;
crimp_image* thresholdb;
crimp_image* thresholda;
crimp_image* result;
int          x, y;

crimp_input (imageObj,      image,      rgba);
crimp_input (thresholdRObj, thresholdr, float);
crimp_input (thresholdGObj, thresholdg, float);
crimp_input (thresholdBObj, thresholdb, float);
crimp_input (thresholdAObj, thresholda, float);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	R (result, x, y) = R (image, x, y) >= FLOATP (thresholdr, x, y) ? BLACK : WHITE;
	G (result, x, y) = G (image, x, y) >= FLOATP (thresholdg, x, y) ? BLACK : WHITE;
	B (result, x, y) = B (image, x, y) >= FLOATP (thresholdb, x, y) ? BLACK : WHITE;
	A (result, x, y) = A (image, x, y) >= FLOATP (thresholda, x, y) ? BLACK : WHITE;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/threshold-rgba-grey8.crimp.



















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

threshold_rgba_grey8
Tcl_Obj* imageObj
Tcl_Obj* thresholdRObj
Tcl_Obj* thresholdGObj
Tcl_Obj* thresholdBObj
Tcl_Obj* thresholdAObj

crimp_image* image;
crimp_image* thresholdr;
crimp_image* thresholdg;
crimp_image* thresholdb;
crimp_image* thresholda;
crimp_image* result;
int          x, y;

crimp_input (imageObj,      image,      rgba);
crimp_input (thresholdRObj, thresholdr, grey8);
crimp_input (thresholdGObj, thresholdg, grey8);
crimp_input (thresholdBObj, thresholdb, grey8);
crimp_input (thresholdAObj, thresholda, grey8);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	R (result, x, y) = R (image, x, y) >= GREY8 (thresholdr, x, y) ? BLACK : WHITE;
	G (result, x, y) = G (image, x, y) >= GREY8 (thresholdg, x, y) ? BLACK : WHITE;
	B (result, x, y) = B (image, x, y) >= GREY8 (thresholdb, x, y) ? BLACK : WHITE;
	A (result, x, y) = A (image, x, y) >= GREY8 (thresholda, x, y) ? BLACK : WHITE;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/threshold-rgba-rgba.crimp.










































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

threshold_rgba_rgba
Tcl_Obj* imageObj
Tcl_Obj* thresholdObj

crimp_image* image;
crimp_image* threshold;
crimp_image* result;
int          x, y;

crimp_input (imageObj,     image,     rgba);
crimp_input (thresholdObj, threshold, rgba);

result = crimp_new_like (image);

for (y = 0; y < image->h; y++) {
    for (x = 0; x < image->w; x++) {

	R (result, x, y) = R (image, x, y) >= R (threshold, x, y) ? BLACK : WHITE;
	G (result, x, y) = G (image, x, y) >= G (threshold, x, y) ? BLACK : WHITE;
	B (result, x, y) = B (image, x, y) >= B (threshold, x, y) ? BLACK : WHITE;
	A (result, x, y) = A (image, x, y) >= A (threshold, x, y) ? BLACK : WHITE;
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/trace_hysteresis.crimp.


























































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

trace_hysteresis
Tcl_Obj* imageObj
double lowT
double highT

/*
 * Hysteresis-based tracing of magnitude ridges. Only ridges starting higher
 * than highT are followed, until they sink below lowT, or join another ridge
 * already traced , whichever comes first.
 */

crimp_image* image;
crimp_image* result;
int          x, y, xo, yo;

crimp_input (imageObj, image, float);

result = crimp_new_grey8 (image->w, image->h);

/*
 * Fill with black
 */

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	GREY8(result, x, y) = BLACK;
    }
}

/*
 * Look for high-threshold ridges, then follow these until they sink below
 * suitability
 */

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	if (!GREY8 (result, x, y)  && FLOATP(image, x,y) >= highT) {
	    /*
	     * Found a good candidate. We now follow neighbours until they are
	     * insignificant or joining a ridge already traced out.
	     */
	    int xi, x0, x2, x1 = x;
	    int yi, y0, y2, y1 = y;
	    do {
	    next:
		GREY8(result, x1, y1) = WHITE;

		x0 = (x1 == 0)             ? x1 : x1 - 1;
		x2 = (x1 == (result->w-1)) ? x1 : x1 + 1;
		y0 = (y1 == 0)             ? y1 : y1 - 1;
		y2 = (y1 == (result->h-1)) ? y1 : y1 + 1;

		for (yi = y0; yi <= y2; yi++) {
		    for (xi = x0; xi <= x2; xi++) {
			if ((yi != y1 || xi != x1) &&
			    !GREY8 (result, xi, yi) &&
			    FLOATP (image, xi, yi) >= lowT) {
			    /*
			     * Tail call the loop with the current sweeper
			     * location as the new spot to check and follow.
			     */
			    x1 = xi;
			    y1 = yi;
			    goto next;
			}
		    }
		}
	    } while (0);
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/type.crimp.

























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

type
Tcl_Obj* imageObj

crimp_image* image;

crimp_input_any (imageObj, image);

Tcl_SetObjResult (interp, crimp_new_imagetype_obj (image->itype));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/upsample-float.crimp.






































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

upsample_float
Tcl_Obj* imageObj
int      factor

/*
 * The input image is upsampled by inserting 'factor-1' 0-pixels after every
 * pixel of the input. Note that this method of expanding an image introduces
 * copies of the input to appear at higher frequencies.
 *
 * The output image has to be convolved with a low-pass filter after expansion
 * to avoid such artefacts. The integrated combination of upsampling and such
 * a filter is called 'interpolation'. This is but one step in the generation
 * of difference image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, yo, xi, yi, dx, dy;

crimp_input (imageObj, image, float);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w*factor, image->h*factor);

for (yo = 0, yi = 0; yi < image->h; yo += factor, yi ++) {
    for (xo = 0, xi = 0; xi < image->w; xo += factor, xi ++) {

	/* Copy the pixel */
	FLOATP (result, xo, yo) = FLOATP (image, xi, yi);

	/* And insert factor black (0) pixels after */
	for (dx = 1; dx < factor; dx++) {
	    FLOATP (result, xo + dx, yo) = BLACK;
	}
    }

    /* And insert factor black lines after the intput line*/
    for (dy = 1; dy < factor; dy++) {
	for (xo = 0; xo < result->w; xo++) {
	    FLOATP (result, xo, yo + dy) = BLACK;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/upsample-grey16.crimp.






































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

upsample_grey16
Tcl_Obj* imageObj
int      factor

/*
 * The input image is upsampled by inserting 'factor-1' 0-pixels after every
 * pixel of the input. Note that this method of expanding an image introduces
 * copies of the input to appear at higher frequencies.
 *
 * The output image has to be convolved with a low-pass filter after expansion
 * to avoid such artefacts. The integrated combination of upsampling and such
 * a filter is called 'interpolation'. This is but one step in the generation
 * of difference image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, yo, xi, yi, dx, dy;

crimp_input (imageObj, image, grey16);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w*factor, image->h*factor);

for (yo = 0, yi = 0; yi < image->h; yo += factor, yi ++) {
    for (xo = 0, xi = 0; xi < image->w; xo += factor, xi ++) {

	/* Copy the pixel */
	GREY16 (result, xo, yo) = GREY16 (image, xi, yi);

	/* And insert factor black (0) pixels after */
	for (dx = 1; dx < factor; dx++) {
	    GREY16 (result, xo + dx, yo) = BLACK;
	}
    }

    /* And insert factor black lines after the intput line*/
    for (dy = 1; dy < factor; dy++) {
	for (xo = 0; xo < result->w; xo++) {
	    GREY16 (result, xo, yo + dy) = BLACK;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/upsample-grey32.crimp.






































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

upsample_grey32
Tcl_Obj* imageObj
int      factor

/*
 * The input image is upsampled by inserting 'factor-1' 0-pixels after every
 * pixel of the input. Note that this method of expanding an image introduces
 * copies of the input to appear at higher frequencies.
 *
 * The output image has to be convolved with a low-pass filter after expansion
 * to avoid such artefacts. The integrated combination of upsampling and such
 * a filter is called 'interpolation'. This is but one step in the generation
 * of difference image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, yo, xi, yi, dx, dy;

crimp_input (imageObj, image, grey32);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w*factor, image->h*factor);

for (yo = 0, yi = 0; yi < image->h; yo += factor, yi ++) {
    for (xo = 0, xi = 0; xi < image->w; xo += factor, xi ++) {

	/* Copy the pixel */
	GREY32 (result, xo, yo) = GREY32 (image, xi, yi);

	/* And insert factor black (0) pixels after */
	for (dx = 1; dx < factor; dx++) {
	    GREY32 (result, xo + dx, yo) = BLACK;
	}
    }

    /* And insert factor black lines after the intput line*/
    for (dy = 1; dy < factor; dy++) {
	for (xo = 0; xo < result->w; xo++) {
	    GREY32 (result, xo, yo + dy) = BLACK;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/upsample-grey8.crimp.






































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

upsample_grey8
Tcl_Obj* imageObj
int      factor

/*
 * The input image is upsampled by inserting 'factor-1' 0-pixels after every
 * pixel of the input. Note that this method of expanding an image introduces
 * copies of the input to appear at higher frequencies.
 *
 * The output image has to be convolved with a low-pass filter after expansion
 * to avoid such artefacts. The integrated combination of upsampling and such
 * a filter is called 'interpolation'. This is but one step in the generation
 * of difference image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, yo, xi, yi, dx, dy;

crimp_input (imageObj, image, grey8);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w*factor, image->h*factor);

for (yo = 0, yi = 0; yi < image->h; yo += factor, yi ++) {
    for (xo = 0, xi = 0; xi < image->w; xo += factor, xi ++) {

	/* Copy the pixel */
	GREY8 (result, xo, yo) = GREY8 (image, xi, yi);

	/* And insert factor black (0) pixels after */
	for (dx = 1; dx < factor; dx++) {
	    GREY8 (result, xo + dx, yo) = BLACK;
	}
    }

    /* And insert factor black lines after the intput line*/
    for (dy = 1; dy < factor; dy++) {
	for (xo = 0; xo < result->w; xo++) {
	    GREY8 (result, xo, yo + dy) = BLACK;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/upsample-hsv.crimp.












































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

upsample_hsv
Tcl_Obj* imageObj
int      factor

/*
 * The input image is upsampled by inserting 'factor-1' 0-pixels after every
 * pixel of the input. Note that this method of expanding an image introduces
 * copies of the input to appear at higher frequencies.
 *
 * The output image has to be convolved with a low-pass filter after expansion
 * to avoid such artefacts. The integrated combination of upsampling and such
 * a filter is called 'interpolation'. This is but one step in the generation
 * of difference image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, yo, xi, yi, dx, dy;

crimp_input (imageObj, image, hsv);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w*factor, image->h*factor);

for (yo = 0, yi = 0; yi < image->h; yo += factor, yi ++) {
    for (xo = 0, xi = 0; xi < image->w; xo += factor, xi ++) {

	/* Copy the pixel */
	H (result, xo, yo) = H (image, xi, yi);
	S (result, xo, yo) = S (image, xi, yi);
	V (result, xo, yo) = V (image, xi, yi);

	/* And insert factor black (0) pixels after */
	for (dx = 1; dx < factor; dx++) {
	    H (result, xo + dx, yo) = BLACK;
	    S (result, xo + dx, yo) = BLACK;
	    V (result, xo + dx, yo) = BLACK;
	}
    }

    /* And insert factor black lines after the intput line*/
    for (dy = 1; dy < factor; dy++) {
	for (xo = 0; xo < result->w; xo++) {
	    H (result, xo, yo + dy) = BLACK;
	    S (result, xo, yo + dy) = BLACK;
	    V (result, xo, yo + dy) = BLACK;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/upsample-rgb.crimp.












































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

upsample_rgb
Tcl_Obj* imageObj
int      factor

/*
 * The input image is upsampled by inserting 'factor-1' 0-pixels after every
 * pixel of the input. Note that this method of expanding an image introduces
 * copies of the input to appear at higher frequencies.
 *
 * The output image has to be convolved with a low-pass filter after expansion
 * to avoid such artefacts. The integrated combination of upsampling and such
 * a filter is called 'interpolation'. This is but one step in the generation
 * of difference image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, yo, xi, yi, dx, dy;

crimp_input (imageObj, image, rgb);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w*factor, image->h*factor);

for (yo = 0, yi = 0; yi < image->h; yo += factor, yi ++) {
    for (xo = 0, xi = 0; xi < image->w; xo += factor, xi ++) {

	/* Copy the pixel */
	R (result, xo, yo) = R (image, xi, yi);
	G (result, xo, yo) = G (image, xi, yi);
	B (result, xo, yo) = B (image, xi, yi);

	/* And insert factor black (0) pixels after */
	for (dx = 1; dx < factor; dx++) {
	    R (result, xo + dx, yo) = BLACK;
	    G (result, xo + dx, yo) = BLACK;
	    B (result, xo + dx, yo) = BLACK;
	}
    }

    /* And insert factor black lines after the intput line*/
    for (dy = 1; dy < factor; dy++) {
	for (xo = 0; xo < result->w; xo++) {
	    R (result, xo, yo + dy) = BLACK;
	    G (result, xo, yo + dy) = BLACK;
	    B (result, xo, yo + dy) = BLACK;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/upsample-rgba.crimp.















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

upsample_rgba
Tcl_Obj* imageObj
int      factor

/*
 * The input image is upsampled by inserting 'factor-1' 0-pixels after every
 * pixel of the input. Note that this method of expanding an image introduces
 * copies of the input to appear at higher frequencies.
 *
 * The output image has to be convolved with a low-pass filter after expansion
 * to avoid such artefacts. The integrated combination of upsampling and such
 * a filter is called 'interpolation'. This is but one step in the generation
 * of difference image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, yo, xi, yi, dx, dy;

crimp_input (imageObj, image, rgba);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w*factor, image->h*factor);

for (yo = 0, yi = 0; yi < image->h; yo += factor, yi ++) {
    for (xo = 0, xi = 0; xi < image->w; xo += factor, xi ++) {

	/* Copy the pixel */
	R (result, xo, yo) = R (image, xi, yi);
	G (result, xo, yo) = G (image, xi, yi);
	B (result, xo, yo) = B (image, xi, yi);
	A (result, xo, yo) = A (image, xi, yi);

	/* And insert factor black (0) pixels after */
	for (dx = 1; dx < factor; dx++) {
	    R (result, xo + dx, yo) = BLACK;
	    G (result, xo + dx, yo) = BLACK;
	    B (result, xo + dx, yo) = BLACK;
	    A (result, xo + dx, yo) = OPAQUE;
	}
    }

    /* And insert factor black lines after the intput line*/
    for (dy = 1; dy < factor; dy++) {
	for (xo = 0; xo < result->w; xo++) {
	    R (result, xo, yo + dy) = BLACK;
	    G (result, xo, yo + dy) = BLACK;
	    B (result, xo, yo + dy) = BLACK;
	    A (result, xo, yo + dy) = OPAQUE;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/upsamplex-float.crimp.































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

upsamplex_float
Tcl_Obj* imageObj
int      factor

/*
 * The input image is upsampled in the x direction by inserting 'factor-1'
 * 0-pixels after every pixel of the input. Note that this method of expanding
 * an image introduces copies of the input to appear at higher frequencies.
 *
 * The output image has to be convolved with a low-pass filter after expansion
 * to avoid such artefacts. The integrated combination of upsampling and such
 * a filter is called 'interpolation'. This is but one step in the generation
 * of difference image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, y, xi, dx;

crimp_input (imageObj, image, float);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w*factor, image->h);

for (y = 0; y < image->h; y ++) {
    for (xo = 0, xi = 0; xi < image->w; xo += factor, xi ++) {

	/* Copy the pixel */
	FLOATP (result, xo, y) = FLOATP (image, xi, y);

	/* And insert factor black (0) pixels after */
	for (dx = 1; dx < factor; dx++) {
	    FLOATP (result, xo + dx, y) = BLACK;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/upsamplex-grey16.crimp.































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

upsamplex_grey16
Tcl_Obj* imageObj
int      factor

/*
 * The input image is upsampled in the x direction by inserting 'factor-1'
 * 0-pixels after every pixel of the input. Note that this method of expanding
 * an image introduces copies of the input to appear at higher frequencies.
 *
 * The output image has to be convolved with a low-pass filter after expansion
 * to avoid such artefacts. The integrated combination of upsampling and such
 * a filter is called 'interpolation'. This is but one step in the generation
 * of difference image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, y, xi, dx;

crimp_input (imageObj, image, grey16);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w*factor, image->h);

for (y = 0; y < image->h; y ++) {
    for (xo = 0, xi = 0; xi < image->w; xo += factor, xi ++) {

	/* Copy the pixel */
	GREY16 (result, xo, y) = GREY16 (image, xi, y);

	/* And insert factor black (0) pixels after */
	for (dx = 1; dx < factor; dx++) {
	    GREY16 (result, xo + dx, y) = BLACK;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/upsamplex-grey32.crimp.































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

upsamplex_grey32
Tcl_Obj* imageObj
int      factor

/*
 * The input image is upsampled in the x direction by inserting 'factor-1'
 * 0-pixels after every pixel of the input. Note that this method of expanding
 * an image introduces copies of the input to appear at higher frequencies.
 *
 * The output image has to be convolved with a low-pass filter after expansion
 * to avoid such artefacts. The integrated combination of upsampling and such
 * a filter is called 'interpolation'. This is but one step in the generation
 * of difference image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, y, xi, dx;

crimp_input (imageObj, image, grey32);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w*factor, image->h);

for (y = 0; y < image->h; y ++) {
    for (xo = 0, xi = 0; xi < image->w; xo += factor, xi ++) {

	/* Copy the pixel */
	GREY32 (result, xo, y) = GREY32 (image, xi, y);

	/* And insert factor black (0) pixels after */
	for (dx = 1; dx < factor; dx++) {
	    GREY32 (result, xo + dx, y) = BLACK;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/upsamplex-grey8.crimp.































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

upsamplex_grey8
Tcl_Obj* imageObj
int      factor

/*
 * The input image is upsampled in the x direction by inserting 'factor-1'
 * 0-pixels after every pixel of the input. Note that this method of expanding
 * an image introduces copies of the input to appear at higher frequencies.
 *
 * The output image has to be convolved with a low-pass filter after expansion
 * to avoid such artefacts. The integrated combination of upsampling and such
 * a filter is called 'interpolation'. This is but one step in the generation
 * of difference image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, y, xi, dx;

crimp_input (imageObj, image, grey8);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w*factor, image->h);

for (y = 0; y < image->h; y ++) {
    for (xo = 0, xi = 0; xi < image->w; xo += factor, xi ++) {

	/* Copy the pixel */
	GREY8 (result, xo, y) = GREY8 (image, xi, y);

	/* And insert factor black (0) pixels after */
	for (dx = 1; dx < factor; dx++) {
	    GREY8 (result, xo + dx, y) = BLACK;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/upsamplex-hsv.crimp.



































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

upsamplex_hsv
Tcl_Obj* imageObj
int      factor

/*
 * The input image is upsampled in the x direction by inserting 'factor-1'
 * 0-pixels after every pixel of the input. Note that this method of expanding
 * an image introduces copies of the input to appear at higher frequencies.
 *
 * The output image has to be convolved with a low-pass filter after expansion
 * to avoid such artefacts. The integrated combination of upsampling and such
 * a filter is called 'interpolation'. This is but one step in the generation
 * of difference image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, y, xi, dx;

crimp_input (imageObj, image, hsv);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w*factor, image->h);

for (y = 0; y < image->h; y ++) {
    for (xo = 0, xi = 0; xi < image->w; xo += factor, xi ++) {

	/* Copy the pixel */
	H (result, xo, y) = H (image, xi, y);
	S (result, xo, y) = S (image, xi, y);
	V (result, xo, y) = V (image, xi, y);

	/* And insert factor black (0) pixels after */
	for (dx = 1; dx < factor; dx++) {
	    H (result, xo + dx, y) = BLACK;
	    S (result, xo + dx, y) = BLACK;
	    V (result, xo + dx, y) = BLACK;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/upsamplex-rgb.crimp.



































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

upsamplex_rgb
Tcl_Obj* imageObj
int      factor

/*
 * The input image is upsampled in the x direction by inserting 'factor-1'
 * 0-pixels after every pixel of the input. Note that this method of expanding
 * an image introduces copies of the input to appear at higher frequencies.
 *
 * The output image has to be convolved with a low-pass filter after expansion
 * to avoid such artefacts. The integrated combination of upsampling and such
 * a filter is called 'interpolation'. This is but one step in the generation
 * of difference image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, y, xi, dx;

crimp_input (imageObj, image, rgb);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w*factor, image->h);

for (y = 0; y < image->h; y ++) {
    for (xo = 0, xi = 0; xi < image->w; xo += factor, xi ++) {

	/* Copy the pixel */
	R (result, xo, y) = R (image, xi, y);
	G (result, xo, y) = G (image, xi, y);
	B (result, xo, y) = B (image, xi, y);

	/* And insert factor black (0) pixels after */
	for (dx = 1; dx < factor; dx++) {
	    R (result, xo + dx, y) = BLACK;
	    G (result, xo + dx, y) = BLACK;
	    B (result, xo + dx, y) = BLACK;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/upsamplex-rgba.crimp.





































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

upsamplex_rgba
Tcl_Obj* imageObj
int      factor

/*
 * The input image is upsampled in the x direction by inserting 'factor-1'
 * 0-pixels after every pixel of the input. Note that this method of expanding
 * an image introduces copies of the input to appear at higher frequencies.
 *
 * The output image has to be convolved with a low-pass filter after expansion
 * to avoid such artefacts. The integrated combination of upsampling and such
 * a filter is called 'interpolation'. This is but one step in the generation
 * of difference image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          xo, y, xi, dx;

crimp_input (imageObj, image, rgba);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w*factor, image->h);

for (y = 0; y < image->h; y ++) {
    for (xo = 0, xi = 0; xi < image->w; xo += factor, xi ++) {

	/* Copy the pixel */
	R (result, xo, y) = R (image, xi, y);
	G (result, xo, y) = G (image, xi, y);
	B (result, xo, y) = B (image, xi, y);
	A (result, xo, y) = A (image, xi, y);

	/* And insert factor black (0) pixels after */
	for (dx = 1; dx < factor; dx++) {
	    R (result, xo + dx, y) = BLACK;
	    G (result, xo + dx, y) = BLACK;
	    B (result, xo + dx, y) = BLACK;
	    A (result, xo + dx, y) = OPAQUE;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/upsampley-float.crimp.

































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

upsampley_float
Tcl_Obj* imageObj
int      factor

/*
 * The input image is upsampled in the y direction by inserting 'factor-1' 0-pixels after every
 * pixel of the input. Note that this method of expanding an image introduces
 * copies of the input to appear at higher frequencies.
 *
 * The output image has to be convolved with a low-pass filter after expansion
 * to avoid such artefacts. The integrated combination of upsampling and such
 * a filter is called 'interpolation'. This is but one step in the generation
 * of difference image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          x, yo, yi, dy;

crimp_input (imageObj, image, float);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w, image->h*factor);

for (yo = 0, yi = 0; yi < image->h; yo += factor, yi ++) {
    for (x = 0; x < image->w; x ++) {

	/* Copy the pixel */
	FLOATP (result, x, yo) = FLOATP (image, x, yi);
    }

    /* And insert factor black lines after the intput line*/
    for (dy = 1; dy < factor; dy++) {
	for (x = 0; x < image->w; x++) {
	    FLOATP (result, x, yo + dy) = BLACK;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/upsampley-grey16.crimp.

































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

upsampley_grey16
Tcl_Obj* imageObj
int      factor

/*
 * The input image is upsampled in the y direction by inserting 'factor-1' 0-pixels after every
 * pixel of the input. Note that this method of expanding an image introduces
 * copies of the input to appear at higher frequencies.
 *
 * The output image has to be convolved with a low-pass filter after expansion
 * to avoid such artefacts. The integrated combination of upsampling and such
 * a filter is called 'interpolation'. This is but one step in the generation
 * of difference image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          x, yo, yi, dy;

crimp_input (imageObj, image, grey16);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w, image->h*factor);

for (yo = 0, yi = 0; yi < image->h; yo += factor, yi ++) {
    for (x = 0; x < image->w; x ++) {

	/* Copy the pixel */
	GREY16 (result, x, yo) = GREY16 (image, x, yi);
    }

    /* And insert factor black lines after the intput line*/
    for (dy = 1; dy < factor; dy++) {
	for (x = 0; x < image->w; x++) {
	    GREY16 (result, x, yo + dy) = BLACK;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/upsampley-grey32.crimp.

































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

upsampley_grey32
Tcl_Obj* imageObj
int      factor

/*
 * The input image is upsampled in the y direction by inserting 'factor-1' 0-pixels after every
 * pixel of the input. Note that this method of expanding an image introduces
 * copies of the input to appear at higher frequencies.
 *
 * The output image has to be convolved with a low-pass filter after expansion
 * to avoid such artefacts. The integrated combination of upsampling and such
 * a filter is called 'interpolation'. This is but one step in the generation
 * of difference image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          x, yo, yi, dy;

crimp_input (imageObj, image, grey32);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w, image->h*factor);

for (yo = 0, yi = 0; yi < image->h; yo += factor, yi ++) {
    for (x = 0; x < image->w; x ++) {

	/* Copy the pixel */
	GREY32 (result, x, yo) = GREY32 (image, x, yi);
    }

    /* And insert factor black lines after the intput line*/
    for (dy = 1; dy < factor; dy++) {
	for (x = 0; x < image->w; x++) {
	    GREY32 (result, x, yo + dy) = BLACK;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/upsampley-grey8.crimp.

































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

upsampley_grey8
Tcl_Obj* imageObj
int      factor

/*
 * The input image is upsampled in the y direction by inserting 'factor-1' 0-pixels after every
 * pixel of the input. Note that this method of expanding an image introduces
 * copies of the input to appear at higher frequencies.
 *
 * The output image has to be convolved with a low-pass filter after expansion
 * to avoid such artefacts. The integrated combination of upsampling and such
 * a filter is called 'interpolation'. This is but one step in the generation
 * of difference image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          x, yo, yi, dy;

crimp_input (imageObj, image, grey8);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w, image->h*factor);

for (yo = 0, yi = 0; yi < image->h; yo += factor, yi ++) {
    for (x = 0; x < image->w; x ++) {

	/* Copy the pixel */
	GREY8 (result, x, yo) = GREY8 (image, x, yi);
    }

    /* And insert factor black lines after the intput line*/
    for (dy = 1; dy < factor; dy++) {
	for (x = 0; x < image->w; x++) {
	    GREY8 (result, x, yo + dy) = BLACK;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/upsampley-hsv.crimp.





































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

upsampley_hsv
Tcl_Obj* imageObj
int      factor

/*
 * The input image is upsampled in the y direction by inserting 'factor-1'
 * 0-pixels after every pixel of the input. Note that this method of expanding
 * an image introduces copies of the input to appear at higher frequencies.
 *
 * The output image has to be convolved with a low-pass filter after expansion
 * to avoid such artefacts. The integrated combination of upsampling and such
 * a filter is called 'interpolation'. This is but one step in the generation
 * of difference image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          x, yo, yi, dy;

crimp_input (imageObj, image, hsv);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w, image->h*factor);

for (yo = 0, yi = 0; yi < image->h; yo += factor, yi ++) {
    for (x = 0; x < image->w; x ++) {

	/* Copy the pixel */
	H (result, x, yo) = H (image, x, yi);
	S (result, x, yo) = S (image, x, yi);
	V (result, x, yo) = V (image, x, yi);
    }

    /* And insert factor black lines after the intput line*/
    for (dy = 1; dy < factor; dy++) {
	for (x = 0; x < image->w; x++) {
	    H (result, x, yo + dy) = BLACK;
	    S (result, x, yo + dy) = BLACK;
	    V (result, x, yo + dy) = BLACK;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/upsampley-rgb.crimp.





































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

upsampley_rgb
Tcl_Obj* imageObj
int      factor

/*
 * The input image is upsampled in the y direction by inserting 'factor-1'
 * 0-pixels after every pixel of the input. Note that this method of expanding
 * an image introduces copies of the input to appear at higher frequencies.
 *
 * The output image has to be convolved with a low-pass filter after expansion
 * to avoid such artefacts. The integrated combination of upsampling and such
 * a filter is called 'interpolation'. This is but one step in the generation
 * of difference image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          x, yo, yi, dy;

crimp_input (imageObj, image, rgb);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w, image->h*factor);

for (yo = 0, yi = 0; yi < image->h; yo += factor, yi ++) {
    for (x = 0; x < image->w; x ++) {

	/* Copy the pixel */
	R (result, x, yo) = R (image, x, yi);
	G (result, x, yo) = G (image, x, yi);
	B (result, x, yo) = B (image, x, yi);
    }

    /* And insert factor black lines after the intput line*/
    for (dy = 1; dy < factor; dy++) {
	for (x = 0; x < image->w; x++) {
	    R (result, x, yo + dy) = BLACK;
	    G (result, x, yo + dy) = BLACK;
	    B (result, x, yo + dy) = BLACK;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/upsampley-rgba.crimp.








































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

upsampley_rgba
Tcl_Obj* imageObj
int      factor

/*
 * The input image is upsampled in the y direction by inserting 'factor-1'
 * 0-pixels after every pixel of the input. Note that this method of expanding
 * an image introduces copies of the input to appear at higher frequencies.
 *
 * The output image has to be convolved with a low-pass filter after expansion
 * to avoid such artefacts. The integrated combination of upsampling and such
 * a filter is called 'interpolation'. This is but one step in the generation
 * of difference image pyramids.
 */

crimp_image* image;
crimp_image* result;
int          x, yo, yi, dy;

crimp_input (imageObj, image, rgba);
if (factor < 1) {
    Tcl_SetResult(interp, "bad sampling factor, expected integer > 0", TCL_STATIC);
    return TCL_ERROR;
}

if (factor == 1) {
    Tcl_SetObjResult(interp, imageObj);
    return TCL_OK;
}

result = crimp_new (image->itype, image->w, image->h*factor);

for (yo = 0, yi = 0; yi < image->h; yo += factor, yi ++) {
    for (x = 0; x < image->w; x ++) {

	/* Copy the pixel */
	R (result, x, yo) = R (image, x, yi);
	G (result, x, yo) = G (image, x, yi);
	B (result, x, yo) = B (image, x, yi);
	A (result, x, yo) = A (image, x, yi);

    }

    /* And insert factor black lines after the intput line*/
    for (dy = 1; dy < factor; dy++) {
	for (x = 0; x < image->w; x++) {
	    R (result, x, yo + dy) = BLACK;
	    G (result, x, yo + dy) = BLACK;
	    B (result, x, yo + dy) = BLACK;
	    A (result, x, yo + dy) = OPAQUE;
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-float-field-bicubic.crimp.































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_float_field_bicubic
Tcl_Obj* imageObj
Tcl_Obj* xvecObj
Tcl_Obj* yvecObj

/*
 * Warp image using the given vector field.
 */

crimp_image* image;
crimp_image* xvector;
crimp_image* yvector;
crimp_image* result;
int x, y;
double xf, yf;

crimp_input (imageObj, image,   float);
crimp_input (xvecObj,  xvector, float);
crimp_input (yvecObj,  yvector, float);

if (!crimp_eq_dim (xvector, yvector)) {
    Tcl_SetResult(interp, "Unable to warp, expected equally-sized coordinate fields", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Create result and scan through it, sampling the input under the guidance of
 * the coordinate fields.
 */

result = crimp_new (image->itype, xvector->w, xvector->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	int ixw, iyw;

	xf = FLOATP (xvector, x, y);
	yf = FLOATP (yvector, x, y);

	/*
	 * Perform bicubic interpolation (1,2) using the nearest 4x4 pixels
	 * around the sampling location.
	 *
	 * (Ad 1) http://en.wikipedia.org/wiki/Bicubic_interpolation
	 * (Ad 2) http://www.paulinternet.nl/?page=bicubic
	 */

        ixw = xf;  xf -= ixw;
        iyw = yf;  yf -= iyw;

	ixw --; xf += 1.; xf /= 3.;
	iyw --; yf += 1.; yf /= 3.;

#undef  SAMPLE
#define SAMPLE(dx,dy) ((((ixw+(dx)) < 0) || ((ixw+(dx)) >= image->w) || ((iyw+(dy)) < 0) || ((iyw+(dy)) >= image->h)) ? BLACK : (FLOATP (image, (ixw+(dx)), (iyw+(dy)))))

	{
	    double p00 = SAMPLE(0,0);
	    double p01 = SAMPLE(0,1);
	    double p02 = SAMPLE(0,2);
	    double p03 = SAMPLE(0,3);
	    double p10 = SAMPLE(1,0);
	    double p11 = SAMPLE(1,1);
	    double p12 = SAMPLE(1,2);
	    double p13 = SAMPLE(1,3);
	    double p20 = SAMPLE(2,0);
	    double p21 = SAMPLE(2,1);
	    double p22 = SAMPLE(2,2);
	    double p23 = SAMPLE(2,3);
	    double p30 = SAMPLE(3,0);
	    double p31 = SAMPLE(3,1);
	    double p32 = SAMPLE(3,2);
	    double p33 = SAMPLE(3,3);

	    double a00 =      p11;
	    double a01 = -.50*p10 +  .50*p12;
	    double a02 =      p10 - 2.50*p11 + 2.00*p12 -  .50*p13;
	    double a03 = -.50*p10 + 1.50*p11 - 1.50*p12 +  .50*p13;
	    double a10 = -.50*p01 +  .50*p21;
	    double a11 =  .25*p00 -  .25*p02 -  .25*p20 +  .25*p22;
	    double a12 = -.50*p00 + 1.25*p01 -      p02 +  .25*p03 +  .50*p20 - 1.25*p21 +      p22 -  .25*p23;
	    double a13 =  .25*p00 -  .75*p01 +  .75*p02 -  .25*p03 -  .25*p20 +  .75*p21 -  .75*p22 +  .25*p23;
	    double a20 =      p01 - 2.50*p11 + 2.00*p21 -  .50*p31;
	    double a21 = -.50*p00 +  .50*p02 + 1.25*p10 - 1.25*p12 -      p20 +      p22 +  .25*p30 -  .25*p32;
	    double a22 =      p00 - 2.50*p01 + 2.00*p02 -  .50*p03 - 2.50*p10 + 6.25*p11 - 5.00*p12 + 1.25*p13 +
		2.00*p20 - 5.00*p21 + 4.00*p22 -     p23 - .50*p30 + 1.25*p31 -     p32 + .25*p33;
	    double a23 = -.50*p00 + 1.50*p01 - 1.50*p02 +  .50*p03 + 1.25*p10 - 3.75*p11 + 3.75*p12 - 1.25*p13 -
		p20 + 3.00*p21 - 3.00*p22 +     p23 + .25*p30 -  .75*p31 + .75*p32 - .25*p33;
	    double a30 = -.50*p01 + 1.50*p11 - 1.50*p21 +  .50*p31;
	    double a31 =  .25*p00 -  .25*p02 -  .75*p10 +  .75*p12 +  .75*p20 -  .75*p22 -  .25*p30 +  .25*p32;
	    double a32 = -.50*p00 + 1.25*p01 -      p02 +  .25*p03 + 1.50*p10 - 3.75*p11 + 3.00*p12 -  .75*p13 -
		1.50*p20 + 3.75*p21 - 3.00*p22 + .75*p23 + .50*p30 - 1.25*p31 +     p32 - .25*p33;
	    double a33 =  .25*p00 -  .75*p01 +  .75*p02 -  .25*p03 -  .75*p10 + 2.25*p11 - 2.25*p12 +  .75*p13 +
		.75*p20 - 2.25*p21 + 2.25*p22 - .75*p23 - .25*p30 +  .75*p31 - .75*p32 + .25*p33;

	    double x2 = xf * xf;
	    double x3 = x2 * xf;
	    double y2 = yf * yf;
	    double y3 = y2 * yf;

	    FLOATP (result, x, y) = 
		(a00 + a01 * yf + a02 * y2 + a03 * y3)      +
		(a10 + a11 * yf + a12 * y2 + a13 * y3) * xf +
		(a20 + a21 * yf + a22 * y2 + a23 * y3) * x2 +
		(a30 + a31 * yf + a32 * y2 + a33 * y3) * x3;	    
        }
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-float-field-bilinear.crimp.























































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_float_field_bilinear
Tcl_Obj* imageObj
Tcl_Obj* xvecObj
Tcl_Obj* yvecObj

/*
 * Warp image using the given vector field.
 */

crimp_image* image;
crimp_image* xvector;
crimp_image* yvector;
crimp_image* result;
int x, y;
double xf, yf;

crimp_input (imageObj, image,   float);
crimp_input (xvecObj,  xvector, float);
crimp_input (yvecObj,  yvector, float);

if (!crimp_eq_dim (xvector, yvector)) {
    Tcl_SetResult(interp, "Unable to warp, expected equally-sized coordinate fields", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Create result and scan through it, sampling the input under the guidance of
 * the coordinate fields.
 */

result = crimp_new (image->itype, xvector->w, xvector->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	int ixw, iyw;

	xf = FLOATP (xvector, x, y);
	yf = FLOATP (yvector, x, y);

	/*
	 * Perform bilinear interpolation (1) using the nearest 2x2 pixels
	 * around the sampling location.
	 *
	 * (Ad 1) http://en.wikipedia.org/wiki/Bilinear_interpolation
	 */

        ixw = xf;
        iyw = yf;

        xf -= ixw;
        yf -= iyw;

	{
            float val = 0;
	    int ix, iy;
            for (iy = MAX(iyw, 0); iy < MIN(iyw + 2, image->h); iy++) {
                yf = 1 - yf;
                for (ix = MAX(ixw, 0); ix < MIN(ixw + 2, image->w); ix++) {
                    xf = 1 - xf;

		    val += FLOATP (image, ix, iy) * yf * xf;
                }
            }

	    FLOATP (result, x, y) = val;
        }
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-float-field-nneighbour.crimp.




































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_float_field_nneighbour
Tcl_Obj* imageObj
Tcl_Obj* xvecObj
Tcl_Obj* yvecObj

/*
 * Warp image using the given vector field.
 */

crimp_image* image;
crimp_image* xvector;
crimp_image* yvector;
crimp_image* result;
int x, y;
double xf, yf;

crimp_input (imageObj, image,   float);
crimp_input (xvecObj,  xvector, float);
crimp_input (yvecObj,  yvector, float);

if (!crimp_eq_dim (xvector, yvector)) {
    Tcl_SetResult(interp, "Unable to warp, expected equally-sized coordinate fields", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Create result and scan through it, sampling the input under the guidance of
 * the coordinate fields.
 */

result = crimp_new (image->itype, xvector->w, xvector->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	int xi, yi, outside;

	xf = FLOATP (xvector, x, y);
	yf = FLOATP (yvector, x, y);

	xi = xf;
	yi = yf;
	if ((xf - xi) >= 0.5) xi++;
	if ((yf - yi) >= 0.5) yi++;

	outside = (xi < 0) || (xi >= image->w) || (yi < 0) || (yi >= image->h);

	FLOATP (result, x, y) = outside ? BLACK : FLOATP (image, xi, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-float-projective-bicubic.crimp.










































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_float_projective_bicubic
Tcl_Obj* imageObj
Tcl_Obj* forwardObj

/*
 * Warp image using the given specified transform. The result is made large
 * enough to contain all of the warped image, and will contain meta data about
 * the location of the actual (0,0) origin point relative to the physical top
 * left corner of the result. This last is required because translations in
 * the transform may move pixels to negative positions which we cannot express
 * with the regular memory grid.
 */

crimp_image* image;
crimp_image* forward;
crimp_image* backward;
crimp_image* result;
int x, y, xt, yt, origx, origy, pixel, xl, xr, yu, yd;
double xf, yf;

crimp_input (imageObj,   image,   float);
crimp_input (forwardObj, forward, float);

if (!crimp_require_dim (forward, 3, 3)) {
    Tcl_SetResult(interp, "bad matrix dimensions, expected 3x3", TCL_STATIC);
    return TCL_ERROR;
}

backward = crimp_la_invert_matrix_3x3 (forward);
if (!backward) {
    Tcl_SetResult(interp, "Unable to invert singular matrix", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Determine size of the result, and the location of the origin point inside
 * based on the four corners of the input image and the forward transformation.
 */

result = crimp_geo_warp_init (image, forward, &origx, &origy);

for (y = 0, yt = origy; y < result->h; y++, yt++) {
    for (x = 0, xt = origx; x < result->w; x++, xt++) {
	int ixw, iyw;

	xf = xt;
	yf = yt;
	crimp_geo_warp_point (backward, &xf, &yf);

	/*
	 * Perform bicubic interpolation (1,2) using the nearest 4x4 pixels
	 * around the sampling location.
	 *
	 * (Ad 1) http://en.wikipedia.org/wiki/Bicubic_interpolation
	 * (Ad 2) http://www.paulinternet.nl/?page=bicubic
	 */

        ixw = xf;  xf -= ixw;
        iyw = yf;  yf -= iyw;

	ixw --; xf += 1.; xf /= 3.;
	iyw --; yf += 1.; yf /= 3.;

#undef  SAMPLE
#define SAMPLE(dx,dy) ((((ixw+(dx)) < 0) || ((ixw+(dx)) >= image->w) || ((iyw+(dy)) < 0) || ((iyw+(dy)) >= image->h)) ? BLACK : (FLOATP (image,(ixw+(dx)), (iyw+(dy)))))

	{
	    double p00 = SAMPLE(0,0);
	    double p01 = SAMPLE(0,1);
	    double p02 = SAMPLE(0,2);
	    double p03 = SAMPLE(0,3);
	    double p10 = SAMPLE(1,0);
	    double p11 = SAMPLE(1,1);
	    double p12 = SAMPLE(1,2);
	    double p13 = SAMPLE(1,3);
	    double p20 = SAMPLE(2,0);
	    double p21 = SAMPLE(2,1);
	    double p22 = SAMPLE(2,2);
	    double p23 = SAMPLE(2,3);
	    double p30 = SAMPLE(3,0);
	    double p31 = SAMPLE(3,1);
	    double p32 = SAMPLE(3,2);
	    double p33 = SAMPLE(3,3);

	    double a00 =      p11;
	    double a01 = -.50*p10 +  .50*p12;
	    double a02 =      p10 - 2.50*p11 + 2.00*p12 -  .50*p13;
	    double a03 = -.50*p10 + 1.50*p11 - 1.50*p12 +  .50*p13;
	    double a10 = -.50*p01 +  .50*p21;
	    double a11 =  .25*p00 -  .25*p02 -  .25*p20 +  .25*p22;
	    double a12 = -.50*p00 + 1.25*p01 -      p02 +  .25*p03 +  .50*p20 - 1.25*p21 +      p22 -  .25*p23;
	    double a13 =  .25*p00 -  .75*p01 +  .75*p02 -  .25*p03 -  .25*p20 +  .75*p21 -  .75*p22 +  .25*p23;
	    double a20 =      p01 - 2.50*p11 + 2.00*p21 -  .50*p31;
	    double a21 = -.50*p00 +  .50*p02 + 1.25*p10 - 1.25*p12 -      p20 +      p22 +  .25*p30 -  .25*p32;
	    double a22 =      p00 - 2.50*p01 + 2.00*p02 -  .50*p03 - 2.50*p10 + 6.25*p11 - 5.00*p12 + 1.25*p13 +
		2.00*p20 - 5.00*p21 + 4.00*p22 -     p23 - .50*p30 + 1.25*p31 -     p32 + .25*p33;
	    double a23 = -.50*p00 + 1.50*p01 - 1.50*p02 +  .50*p03 + 1.25*p10 - 3.75*p11 + 3.75*p12 - 1.25*p13 -
		p20 + 3.00*p21 - 3.00*p22 +     p23 + .25*p30 -  .75*p31 + .75*p32 - .25*p33;
	    double a30 = -.50*p01 + 1.50*p11 - 1.50*p21 +  .50*p31;
	    double a31 =  .25*p00 -  .25*p02 -  .75*p10 +  .75*p12 +  .75*p20 -  .75*p22 -  .25*p30 +  .25*p32;
	    double a32 = -.50*p00 + 1.25*p01 -      p02 +  .25*p03 + 1.50*p10 - 3.75*p11 + 3.00*p12 -  .75*p13 -
		1.50*p20 + 3.75*p21 - 3.00*p22 + .75*p23 + .50*p30 - 1.25*p31 +     p32 - .25*p33;
	    double a33 =  .25*p00 -  .75*p01 +  .75*p02 -  .25*p03 -  .75*p10 + 2.25*p11 - 2.25*p12 +  .75*p13 +
		.75*p20 - 2.25*p21 + 2.25*p22 - .75*p23 - .25*p30 +  .75*p31 - .75*p32 + .25*p33;

	    double x2 = xf * xf;
	    double x3 = x2 * xf;
	    double y2 = yf * yf;
	    double y3 = y2 * yf;

	    FLOATP (result, x, y) = 
		(a00 + a01 * yf + a02 * y2 + a03 * y3)      +
		(a10 + a11 * yf + a12 * y2 + a13 * y3) * xf +
		(a20 + a21 * yf + a22 * y2 + a23 * y3) * x2 +
		(a30 + a31 * yf + a32 * y2 + a33 * y3) * x3;	    
        }
    }
}

crimp_del (backward);
Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-float-projective-bilinear.crimp.


































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_float_projective_bilinear
Tcl_Obj* imageObj
Tcl_Obj* forwardObj

/*
 * Warp image using the given specified transform. The result is made large
 * enough to contain all of the warped image, and will contain meta data about
 * the location of the actual (0,0) origin point relative to the physical top
 * left corner of the result. This last is required because translations in
 * the transform may move pixels to negative positions which we cannot express
 * with the regular memory grid.
 */

crimp_image* image;
crimp_image* forward;
crimp_image* backward;
crimp_image* result;
int x, y, xt, yt, origx, origy, pixel, xl, xr, yu, yd, c;
double xf, yf;

crimp_input (imageObj,   image,   float);
crimp_input (forwardObj, forward, float);

if (!crimp_require_dim (forward, 3, 3)) {
    Tcl_SetResult(interp, "bad matrix dimensions, expected 3x3", TCL_STATIC);
    return TCL_ERROR;
}

backward = crimp_la_invert_matrix_3x3 (forward);
if (!backward) {
    Tcl_SetResult(interp, "Unable to invert singular matrix", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Determine size of the result, and the location of the origin point inside
 * based on the four corners of the input image and the forward transformation.
 */

result = crimp_geo_warp_init (image, forward, &origx, &origy);

for (y = 0, yt = origy; y < result->h; y++, yt++) {
    for (x = 0, xt = origx; x < result->w; x++, xt++) {
	int ixw, iyw;

	xf = xt;
	yf = yt;
	crimp_geo_warp_point (backward, &xf, &yf);

	/*
	 * Perform bilinear interpolation (1) using the nearest 2x2 pixels
	 * around the sampling location.
	 *
	 * (Ad 1) http://en.wikipedia.org/wiki/Bilinear_interpolation
	 */

        ixw = xf;
        iyw = yf;

        xf -= ixw;
        yf -= iyw;

	{
            float val = 0;
	    int ix, iy;
            for (iy = MAX(iyw, 0); iy < MIN(iyw + 2, image->h); iy++) {
                yf = 1 - yf;
                for (ix = MAX(ixw, 0); ix < MIN(ixw + 2, image->w); ix++) {
                    xf = 1 - xf;

		    val += FLOATP (image, ix, iy) * yf * xf;
                }
            }

	    FLOATP (result, x, y) = val;
        }
    }
}

crimp_del (backward);
Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-float-projective-nneighbour.crimp.



















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_float_projective_nneighbour
Tcl_Obj* imageObj
Tcl_Obj* forwardObj

/*
 * Warp the image using the specified transform. The result is made large
 * enough to contain all of the warped image, and will contain meta data about
 * the location of the actual (0,0) origin point relative to the physical top
 * left corner of the result. This last is required because translations in
 * the transform may move result pixels to negative positions which we cannot
 * express with the regular memory grid.
 */

crimp_image* image;
crimp_image* forward;
crimp_image* backward;
crimp_image* result;
int x, y, xt, yt, origx, origy, pixel, xi, yi, outside, c;
double xf, yf;

crimp_input (imageObj,   image,   float);
crimp_input (forwardObj, forward, float);

if (!crimp_require_dim (forward, 3, 3)) {
    Tcl_SetResult(interp, "bad matrix dimensions, expected 3x3", TCL_STATIC);
    return TCL_ERROR;
}

backward = crimp_la_invert_matrix_3x3 (forward);
if (!backward) {
    Tcl_SetResult(interp, "Unable to invert singular matrix", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Determine size of the result, and the location of the origin point inside
 * based on the four corners of the input image and the forward transformation.
 */

result = crimp_geo_warp_init (image, forward, &origx, &origy);

for (y = 0, yt = origy; y < result->h; y++, yt++) {
    for (x = 0, xt = origx; x < result->w; x++, xt++) {
	xf = xt;
	yf = yt;
	crimp_geo_warp_point (backward, &xf, &yf);

	/*
	 * Choose the nearest neighbour in x and y to the sampling location as
	 * the source of the pixel.  Use black for when we moved outside the
	 * boundaries of the input.
	 */

	xi = xf;
	yi = yf;
	if ((xf - xi) >= 0.5) xi++;
	if ((yf - yi) >= 0.5) yi++;

	outside = (xi < 0) || (xi >= image->w) || (yi < 0) || (yi >= image->h);

	FLOATP (result, x, y) = outside ? BLACK : FLOATP (image, xi, yi);
    }
}

crimp_del (backward);
Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-grey16-field-bicubic.crimp.































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_grey16_field_bicubic
Tcl_Obj* imageObj
Tcl_Obj* xvecObj
Tcl_Obj* yvecObj

/*
 * Warp image using the given vector field.
 */

crimp_image* image;
crimp_image* xvector;
crimp_image* yvector;
crimp_image* result;
int x, y;
double xf, yf;

crimp_input (imageObj, image,   grey16);
crimp_input (xvecObj,  xvector, float);
crimp_input (yvecObj,  yvector, float);

if (!crimp_eq_dim (xvector, yvector)) {
    Tcl_SetResult(interp, "Unable to warp, expected equally-sized coordinate fields", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Create result and scan through it, sampling the input under the guidance of
 * the coordinate fields.
 */

result = crimp_new (image->itype, xvector->w, xvector->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	int ixw, iyw;

	xf = FLOATP (xvector, x, y);
	yf = FLOATP (yvector, x, y);

	/*
	 * Perform bicubic interpolation (1,2) using the nearest 4x4 pixels
	 * around the sampling location.
	 *
	 * (Ad 1) http://en.wikipedia.org/wiki/Bicubic_interpolation
	 * (Ad 2) http://www.paulinternet.nl/?page=bicubic
	 */

        ixw = xf;  xf -= ixw;
        iyw = yf;  yf -= iyw;

	ixw --; xf += 1.; xf /= 3.;
	iyw --; yf += 1.; yf /= 3.;

#undef  SAMPLE
#define SAMPLE(dx,dy) ((((ixw+(dx)) < 0) || ((ixw+(dx)) >= image->w) || ((iyw+(dy)) < 0) || ((iyw+(dy)) >= image->h)) ? BLACK : (GREY16 (image, (ixw+(dx)), (iyw+(dy)))))

	{
	    double p00 = SAMPLE(0,0);
	    double p01 = SAMPLE(0,1);
	    double p02 = SAMPLE(0,2);
	    double p03 = SAMPLE(0,3);
	    double p10 = SAMPLE(1,0);
	    double p11 = SAMPLE(1,1);
	    double p12 = SAMPLE(1,2);
	    double p13 = SAMPLE(1,3);
	    double p20 = SAMPLE(2,0);
	    double p21 = SAMPLE(2,1);
	    double p22 = SAMPLE(2,2);
	    double p23 = SAMPLE(2,3);
	    double p30 = SAMPLE(3,0);
	    double p31 = SAMPLE(3,1);
	    double p32 = SAMPLE(3,2);
	    double p33 = SAMPLE(3,3);

	    double a00 =      p11;
	    double a01 = -.50*p10 +  .50*p12;
	    double a02 =      p10 - 2.50*p11 + 2.00*p12 -  .50*p13;
	    double a03 = -.50*p10 + 1.50*p11 - 1.50*p12 +  .50*p13;
	    double a10 = -.50*p01 +  .50*p21;
	    double a11 =  .25*p00 -  .25*p02 -  .25*p20 +  .25*p22;
	    double a12 = -.50*p00 + 1.25*p01 -      p02 +  .25*p03 +  .50*p20 - 1.25*p21 +      p22 -  .25*p23;
	    double a13 =  .25*p00 -  .75*p01 +  .75*p02 -  .25*p03 -  .25*p20 +  .75*p21 -  .75*p22 +  .25*p23;
	    double a20 =      p01 - 2.50*p11 + 2.00*p21 -  .50*p31;
	    double a21 = -.50*p00 +  .50*p02 + 1.25*p10 - 1.25*p12 -      p20 +      p22 +  .25*p30 -  .25*p32;
	    double a22 =      p00 - 2.50*p01 + 2.00*p02 -  .50*p03 - 2.50*p10 + 6.25*p11 - 5.00*p12 + 1.25*p13 +
		2.00*p20 - 5.00*p21 + 4.00*p22 -     p23 - .50*p30 + 1.25*p31 -     p32 + .25*p33;
	    double a23 = -.50*p00 + 1.50*p01 - 1.50*p02 +  .50*p03 + 1.25*p10 - 3.75*p11 + 3.75*p12 - 1.25*p13 -
		p20 + 3.00*p21 - 3.00*p22 +     p23 + .25*p30 -  .75*p31 + .75*p32 - .25*p33;
	    double a30 = -.50*p01 + 1.50*p11 - 1.50*p21 +  .50*p31;
	    double a31 =  .25*p00 -  .25*p02 -  .75*p10 +  .75*p12 +  .75*p20 -  .75*p22 -  .25*p30 +  .25*p32;
	    double a32 = -.50*p00 + 1.25*p01 -      p02 +  .25*p03 + 1.50*p10 - 3.75*p11 + 3.00*p12 -  .75*p13 -
		1.50*p20 + 3.75*p21 - 3.00*p22 + .75*p23 + .50*p30 - 1.25*p31 +     p32 - .25*p33;
	    double a33 =  .25*p00 -  .75*p01 +  .75*p02 -  .25*p03 -  .75*p10 + 2.25*p11 - 2.25*p12 +  .75*p13 +
		.75*p20 - 2.25*p21 + 2.25*p22 - .75*p23 - .25*p30 +  .75*p31 - .75*p32 + .25*p33;

	    double x2 = xf * xf;
	    double x3 = x2 * xf;
	    double y2 = yf * yf;
	    double y3 = y2 * yf;

	    GREY16 (result, x, y) = 
		(a00 + a01 * yf + a02 * y2 + a03 * y3)      +
		(a10 + a11 * yf + a12 * y2 + a13 * y3) * xf +
		(a20 + a21 * yf + a22 * y2 + a23 * y3) * x2 +
		(a30 + a31 * yf + a32 * y2 + a33 * y3) * x3;	    
        }
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-grey16-field-bilinear.crimp.























































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_grey16_field_bilinear
Tcl_Obj* imageObj
Tcl_Obj* xvecObj
Tcl_Obj* yvecObj

/*
 * Warp image using the given vector field.
 */

crimp_image* image;
crimp_image* xvector;
crimp_image* yvector;
crimp_image* result;
int x, y;
double xf, yf;

crimp_input (imageObj, image,   grey16);
crimp_input (xvecObj,  xvector, float);
crimp_input (yvecObj,  yvector, float);

if (!crimp_eq_dim (xvector, yvector)) {
    Tcl_SetResult(interp, "Unable to warp, expected equally-sized coordinate fields", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Create result and scan through it, sampling the input under the guidance of
 * the coordinate fields.
 */

result = crimp_new (image->itype, xvector->w, xvector->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	int ixw, iyw;

	xf = FLOATP (xvector, x, y);
	yf = FLOATP (yvector, x, y);

	/*
	 * Perform bilinear interpolation (1) using the nearest 2x2 pixels
	 * around the sampling location.
	 *
	 * (Ad 1) http://en.wikipedia.org/wiki/Bilinear_interpolation
	 */

        ixw = xf;
        iyw = yf;

        xf -= ixw;
        yf -= iyw;

	{
            float val = 0;
	    int ix, iy;
            for (iy = MAX(iyw, 0); iy < MIN(iyw + 2, image->h); iy++) {
                yf = 1 - yf;
                for (ix = MAX(ixw, 0); ix < MIN(ixw + 2, image->w); ix++) {
                    xf = 1 - xf;

		    val += GREY16 (image, ix, iy) * yf * xf;
                }
            }

	    GREY16 (result, x, y) = val;
        }
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-grey16-field-nneighbour.crimp.




































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_grey16_field_nneighbour
Tcl_Obj* imageObj
Tcl_Obj* xvecObj
Tcl_Obj* yvecObj

/*
 * Warp image using the given vector field.
 */

crimp_image* image;
crimp_image* xvector;
crimp_image* yvector;
crimp_image* result;
int x, y;
double xf, yf;

crimp_input (imageObj, image,   grey16);
crimp_input (xvecObj,  xvector, float);
crimp_input (yvecObj,  yvector, float);

if (!crimp_eq_dim (xvector, yvector)) {
    Tcl_SetResult(interp, "Unable to warp, expected equally-sized coordinate fields", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Create result and scan through it, sampling the input under the guidance of
 * the coordinate fields.
 */

result = crimp_new (image->itype, xvector->w, xvector->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	int xi, yi, outside;

	xf = FLOATP (xvector, x, y);
	yf = FLOATP (yvector, x, y);

	xi = xf;
	yi = yf;
	if ((xf - xi) >= 0.5) xi++;
	if ((yf - yi) >= 0.5) yi++;

	outside = (xi < 0) || (xi >= image->w) || (yi < 0) || (yi >= image->h);

	GREY16 (result, x, y) = outside ? BLACK : GREY16 (image, xi, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-grey16-projective-bicubic.crimp.










































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_grey16_projective_bicubic
Tcl_Obj* imageObj
Tcl_Obj* forwardObj

/*
 * Warp image using the given specified transform. The result is made large
 * enough to contain all of the warped image, and will contain meta data about
 * the location of the actual (0,0) origin point relative to the physical top
 * left corner of the result. This last is required because translations in
 * the transform may move pixels to negative positions which we cannot express
 * with the regular memory grid.
 */

crimp_image* image;
crimp_image* forward;
crimp_image* backward;
crimp_image* result;
int x, y, xt, yt, origx, origy, pixel, xl, xr, yu, yd;
double xf, yf;

crimp_input (imageObj,   image,   grey16);
crimp_input (forwardObj, forward, float);

if (!crimp_require_dim (forward, 3, 3)) {
    Tcl_SetResult(interp, "bad matrix dimensions, expected 3x3", TCL_STATIC);
    return TCL_ERROR;
}

backward = crimp_la_invert_matrix_3x3 (forward);
if (!backward) {
    Tcl_SetResult(interp, "Unable to invert singular matrix", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Determine size of the result, and the location of the origin point inside
 * based on the four corners of the input image and the forward transformation.
 */

result = crimp_geo_warp_init (image, forward, &origx, &origy);

for (y = 0, yt = origy; y < result->h; y++, yt++) {
    for (x = 0, xt = origx; x < result->w; x++, xt++) {
	int ixw, iyw;

	xf = xt;
	yf = yt;
	crimp_geo_warp_point (backward, &xf, &yf);

	/*
	 * Perform bicubic interpolation (1,2) using the nearest 4x4 pixels
	 * around the sampling location.
	 *
	 * (Ad 1) http://en.wikipedia.org/wiki/Bicubic_interpolation
	 * (Ad 2) http://www.paulinternet.nl/?page=bicubic
	 */

        ixw = xf;  xf -= ixw;
        iyw = yf;  yf -= iyw;

	ixw --; xf += 1.; xf /= 3.;
	iyw --; yf += 1.; yf /= 3.;

#undef  SAMPLE
#define SAMPLE(dx,dy) ((((ixw+(dx)) < 0) || ((ixw+(dx)) >= image->w) || ((iyw+(dy)) < 0) || ((iyw+(dy)) >= image->h)) ? BLACK : (GREY16 (image,(ixw+(dx)), (iyw+(dy)))))

	{
	    double p00 = SAMPLE(0,0);
	    double p01 = SAMPLE(0,1);
	    double p02 = SAMPLE(0,2);
	    double p03 = SAMPLE(0,3);
	    double p10 = SAMPLE(1,0);
	    double p11 = SAMPLE(1,1);
	    double p12 = SAMPLE(1,2);
	    double p13 = SAMPLE(1,3);
	    double p20 = SAMPLE(2,0);
	    double p21 = SAMPLE(2,1);
	    double p22 = SAMPLE(2,2);
	    double p23 = SAMPLE(2,3);
	    double p30 = SAMPLE(3,0);
	    double p31 = SAMPLE(3,1);
	    double p32 = SAMPLE(3,2);
	    double p33 = SAMPLE(3,3);

	    double a00 =      p11;
	    double a01 = -.50*p10 +  .50*p12;
	    double a02 =      p10 - 2.50*p11 + 2.00*p12 -  .50*p13;
	    double a03 = -.50*p10 + 1.50*p11 - 1.50*p12 +  .50*p13;
	    double a10 = -.50*p01 +  .50*p21;
	    double a11 =  .25*p00 -  .25*p02 -  .25*p20 +  .25*p22;
	    double a12 = -.50*p00 + 1.25*p01 -      p02 +  .25*p03 +  .50*p20 - 1.25*p21 +      p22 -  .25*p23;
	    double a13 =  .25*p00 -  .75*p01 +  .75*p02 -  .25*p03 -  .25*p20 +  .75*p21 -  .75*p22 +  .25*p23;
	    double a20 =      p01 - 2.50*p11 + 2.00*p21 -  .50*p31;
	    double a21 = -.50*p00 +  .50*p02 + 1.25*p10 - 1.25*p12 -      p20 +      p22 +  .25*p30 -  .25*p32;
	    double a22 =      p00 - 2.50*p01 + 2.00*p02 -  .50*p03 - 2.50*p10 + 6.25*p11 - 5.00*p12 + 1.25*p13 +
		2.00*p20 - 5.00*p21 + 4.00*p22 -     p23 - .50*p30 + 1.25*p31 -     p32 + .25*p33;
	    double a23 = -.50*p00 + 1.50*p01 - 1.50*p02 +  .50*p03 + 1.25*p10 - 3.75*p11 + 3.75*p12 - 1.25*p13 -
		p20 + 3.00*p21 - 3.00*p22 +     p23 + .25*p30 -  .75*p31 + .75*p32 - .25*p33;
	    double a30 = -.50*p01 + 1.50*p11 - 1.50*p21 +  .50*p31;
	    double a31 =  .25*p00 -  .25*p02 -  .75*p10 +  .75*p12 +  .75*p20 -  .75*p22 -  .25*p30 +  .25*p32;
	    double a32 = -.50*p00 + 1.25*p01 -      p02 +  .25*p03 + 1.50*p10 - 3.75*p11 + 3.00*p12 -  .75*p13 -
		1.50*p20 + 3.75*p21 - 3.00*p22 + .75*p23 + .50*p30 - 1.25*p31 +     p32 - .25*p33;
	    double a33 =  .25*p00 -  .75*p01 +  .75*p02 -  .25*p03 -  .75*p10 + 2.25*p11 - 2.25*p12 +  .75*p13 +
		.75*p20 - 2.25*p21 + 2.25*p22 - .75*p23 - .25*p30 +  .75*p31 - .75*p32 + .25*p33;

	    double x2 = xf * xf;
	    double x3 = x2 * xf;
	    double y2 = yf * yf;
	    double y3 = y2 * yf;

	    GREY16 (result, x, y) = 
		(a00 + a01 * yf + a02 * y2 + a03 * y3)      +
		(a10 + a11 * yf + a12 * y2 + a13 * y3) * xf +
		(a20 + a21 * yf + a22 * y2 + a23 * y3) * x2 +
		(a30 + a31 * yf + a32 * y2 + a33 * y3) * x3;	    
        }
    }
}

crimp_del (backward);
Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-grey16-projective-bilinear.crimp.


































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_grey16_projective_bilinear
Tcl_Obj* imageObj
Tcl_Obj* forwardObj

/*
 * Warp image using the given specified transform. The result is made large
 * enough to contain all of the warped image, and will contain meta data about
 * the location of the actual (0,0) origin point relative to the physical top
 * left corner of the result. This last is required because translations in
 * the transform may move pixels to negative positions which we cannot express
 * with the regular memory grid.
 */

crimp_image* image;
crimp_image* forward;
crimp_image* backward;
crimp_image* result;
int x, y, xt, yt, origx, origy, pixel, xl, xr, yu, yd, c;
double xf, yf;

crimp_input (imageObj,   image,   grey16);
crimp_input (forwardObj, forward, float);

if (!crimp_require_dim (forward, 3, 3)) {
    Tcl_SetResult(interp, "bad matrix dimensions, expected 3x3", TCL_STATIC);
    return TCL_ERROR;
}

backward = crimp_la_invert_matrix_3x3 (forward);
if (!backward) {
    Tcl_SetResult(interp, "Unable to invert singular matrix", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Determine size of the result, and the location of the origin point inside
 * based on the four corners of the input image and the forward transformation.
 */

result = crimp_geo_warp_init (image, forward, &origx, &origy);

for (y = 0, yt = origy; y < result->h; y++, yt++) {
    for (x = 0, xt = origx; x < result->w; x++, xt++) {
	int ixw, iyw;

	xf = xt;
	yf = yt;
	crimp_geo_warp_point (backward, &xf, &yf);

	/*
	 * Perform bilinear interpolation (1) using the nearest 2x2 pixels
	 * around the sampling location.
	 *
	 * (Ad 1) http://en.wikipedia.org/wiki/Bilinear_interpolation
	 */

        ixw = xf;
        iyw = yf;

        xf -= ixw;
        yf -= iyw;

	{
            float val = 0;
	    int ix, iy;
            for (iy = MAX(iyw, 0); iy < MIN(iyw + 2, image->h); iy++) {
                yf = 1 - yf;
                for (ix = MAX(ixw, 0); ix < MIN(ixw + 2, image->w); ix++) {
                    xf = 1 - xf;

		    val += GREY16 (image, ix, iy) * yf * xf;
                }
            }

	    GREY16 (result, x, y) = val;
        }
    }
}

crimp_del (backward);
Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-grey16-projective-nneighbour.crimp.



















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_grey16_projective_nneighbour
Tcl_Obj* imageObj
Tcl_Obj* forwardObj

/*
 * Warp the image using the specified transform. The result is made large
 * enough to contain all of the warped image, and will contain meta data about
 * the location of the actual (0,0) origin point relative to the physical top
 * left corner of the result. This last is required because translations in
 * the transform may move result pixels to negative positions which we cannot
 * express with the regular memory grid.
 */

crimp_image* image;
crimp_image* forward;
crimp_image* backward;
crimp_image* result;
int x, y, xt, yt, origx, origy, pixel, xi, yi, outside, c;
double xf, yf;

crimp_input (imageObj,   image,   grey16);
crimp_input (forwardObj, forward, float);

if (!crimp_require_dim (forward, 3, 3)) {
    Tcl_SetResult(interp, "bad matrix dimensions, expected 3x3", TCL_STATIC);
    return TCL_ERROR;
}

backward = crimp_la_invert_matrix_3x3 (forward);
if (!backward) {
    Tcl_SetResult(interp, "Unable to invert singular matrix", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Determine size of the result, and the location of the origin point inside
 * based on the four corners of the input image and the forward transformation.
 */

result = crimp_geo_warp_init (image, forward, &origx, &origy);

for (y = 0, yt = origy; y < result->h; y++, yt++) {
    for (x = 0, xt = origx; x < result->w; x++, xt++) {
	xf = xt;
	yf = yt;
	crimp_geo_warp_point (backward, &xf, &yf);

	/*
	 * Choose the nearest neighbour in x and y to the sampling location as
	 * the source of the pixel.  Use black for when we moved outside the
	 * boundaries of the input.
	 */

	xi = xf;
	yi = yf;
	if ((xf - xi) >= 0.5) xi++;
	if ((yf - yi) >= 0.5) yi++;

	outside = (xi < 0) || (xi >= image->w) || (yi < 0) || (yi >= image->h);

	GREY16 (result, x, y) = outside ? BLACK : GREY16 (image, xi, yi);
    }
}

crimp_del (backward);
Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-grey32-field-bicubic.crimp.































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_grey32_field_bicubic
Tcl_Obj* imageObj
Tcl_Obj* xvecObj
Tcl_Obj* yvecObj

/*
 * Warp image using the given vector field.
 */

crimp_image* image;
crimp_image* xvector;
crimp_image* yvector;
crimp_image* result;
int x, y;
double xf, yf;

crimp_input (imageObj, image,   grey32);
crimp_input (xvecObj,  xvector, float);
crimp_input (yvecObj,  yvector, float);

if (!crimp_eq_dim (xvector, yvector)) {
    Tcl_SetResult(interp, "Unable to warp, expected equally-sized coordinate fields", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Create result and scan through it, sampling the input under the guidance of
 * the coordinate fields.
 */

result = crimp_new (image->itype, xvector->w, xvector->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	int ixw, iyw;

	xf = FLOATP (xvector, x, y);
	yf = FLOATP (yvector, x, y);

	/*
	 * Perform bicubic interpolation (1,2) using the nearest 4x4 pixels
	 * around the sampling location.
	 *
	 * (Ad 1) http://en.wikipedia.org/wiki/Bicubic_interpolation
	 * (Ad 2) http://www.paulinternet.nl/?page=bicubic
	 */

        ixw = xf;  xf -= ixw;
        iyw = yf;  yf -= iyw;

	ixw --; xf += 1.; xf /= 3.;
	iyw --; yf += 1.; yf /= 3.;

#undef  SAMPLE
#define SAMPLE(dx,dy) ((((ixw+(dx)) < 0) || ((ixw+(dx)) >= image->w) || ((iyw+(dy)) < 0) || ((iyw+(dy)) >= image->h)) ? BLACK : (GREY32 (image, (ixw+(dx)), (iyw+(dy)))))

	{
	    double p00 = SAMPLE(0,0);
	    double p01 = SAMPLE(0,1);
	    double p02 = SAMPLE(0,2);
	    double p03 = SAMPLE(0,3);
	    double p10 = SAMPLE(1,0);
	    double p11 = SAMPLE(1,1);
	    double p12 = SAMPLE(1,2);
	    double p13 = SAMPLE(1,3);
	    double p20 = SAMPLE(2,0);
	    double p21 = SAMPLE(2,1);
	    double p22 = SAMPLE(2,2);
	    double p23 = SAMPLE(2,3);
	    double p30 = SAMPLE(3,0);
	    double p31 = SAMPLE(3,1);
	    double p32 = SAMPLE(3,2);
	    double p33 = SAMPLE(3,3);

	    double a00 =      p11;
	    double a01 = -.50*p10 +  .50*p12;
	    double a02 =      p10 - 2.50*p11 + 2.00*p12 -  .50*p13;
	    double a03 = -.50*p10 + 1.50*p11 - 1.50*p12 +  .50*p13;
	    double a10 = -.50*p01 +  .50*p21;
	    double a11 =  .25*p00 -  .25*p02 -  .25*p20 +  .25*p22;
	    double a12 = -.50*p00 + 1.25*p01 -      p02 +  .25*p03 +  .50*p20 - 1.25*p21 +      p22 -  .25*p23;
	    double a13 =  .25*p00 -  .75*p01 +  .75*p02 -  .25*p03 -  .25*p20 +  .75*p21 -  .75*p22 +  .25*p23;
	    double a20 =      p01 - 2.50*p11 + 2.00*p21 -  .50*p31;
	    double a21 = -.50*p00 +  .50*p02 + 1.25*p10 - 1.25*p12 -      p20 +      p22 +  .25*p30 -  .25*p32;
	    double a22 =      p00 - 2.50*p01 + 2.00*p02 -  .50*p03 - 2.50*p10 + 6.25*p11 - 5.00*p12 + 1.25*p13 +
		2.00*p20 - 5.00*p21 + 4.00*p22 -     p23 - .50*p30 + 1.25*p31 -     p32 + .25*p33;
	    double a23 = -.50*p00 + 1.50*p01 - 1.50*p02 +  .50*p03 + 1.25*p10 - 3.75*p11 + 3.75*p12 - 1.25*p13 -
		p20 + 3.00*p21 - 3.00*p22 +     p23 + .25*p30 -  .75*p31 + .75*p32 - .25*p33;
	    double a30 = -.50*p01 + 1.50*p11 - 1.50*p21 +  .50*p31;
	    double a31 =  .25*p00 -  .25*p02 -  .75*p10 +  .75*p12 +  .75*p20 -  .75*p22 -  .25*p30 +  .25*p32;
	    double a32 = -.50*p00 + 1.25*p01 -      p02 +  .25*p03 + 1.50*p10 - 3.75*p11 + 3.00*p12 -  .75*p13 -
		1.50*p20 + 3.75*p21 - 3.00*p22 + .75*p23 + .50*p30 - 1.25*p31 +     p32 - .25*p33;
	    double a33 =  .25*p00 -  .75*p01 +  .75*p02 -  .25*p03 -  .75*p10 + 2.25*p11 - 2.25*p12 +  .75*p13 +
		.75*p20 - 2.25*p21 + 2.25*p22 - .75*p23 - .25*p30 +  .75*p31 - .75*p32 + .25*p33;

	    double x2 = xf * xf;
	    double x3 = x2 * xf;
	    double y2 = yf * yf;
	    double y3 = y2 * yf;

	    GREY32 (result, x, y) = 
		(a00 + a01 * yf + a02 * y2 + a03 * y3)      +
		(a10 + a11 * yf + a12 * y2 + a13 * y3) * xf +
		(a20 + a21 * yf + a22 * y2 + a23 * y3) * x2 +
		(a30 + a31 * yf + a32 * y2 + a33 * y3) * x3;	    
        }
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-grey32-field-bilinear.crimp.























































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_grey32_field_bilinear
Tcl_Obj* imageObj
Tcl_Obj* xvecObj
Tcl_Obj* yvecObj

/*
 * Warp image using the given vector field.
 */

crimp_image* image;
crimp_image* xvector;
crimp_image* yvector;
crimp_image* result;
int x, y;
double xf, yf;

crimp_input (imageObj, image,   grey32);
crimp_input (xvecObj,  xvector, float);
crimp_input (yvecObj,  yvector, float);

if (!crimp_eq_dim (xvector, yvector)) {
    Tcl_SetResult(interp, "Unable to warp, expected equally-sized coordinate fields", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Create result and scan through it, sampling the input under the guidance of
 * the coordinate fields.
 */

result = crimp_new (image->itype, xvector->w, xvector->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	int ixw, iyw;

	xf = FLOATP (xvector, x, y);
	yf = FLOATP (yvector, x, y);

	/*
	 * Perform bilinear interpolation (1) using the nearest 2x2 pixels
	 * around the sampling location.
	 *
	 * (Ad 1) http://en.wikipedia.org/wiki/Bilinear_interpolation
	 */

        ixw = xf;
        iyw = yf;

        xf -= ixw;
        yf -= iyw;

	{
            float val = 0;
	    int ix, iy;
            for (iy = MAX(iyw, 0); iy < MIN(iyw + 2, image->h); iy++) {
                yf = 1 - yf;
                for (ix = MAX(ixw, 0); ix < MIN(ixw + 2, image->w); ix++) {
                    xf = 1 - xf;

		    val += GREY32 (image, ix, iy) * yf * xf;
                }
            }

	    GREY32 (result, x, y) = val;
        }
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-grey32-field-nneighbour.crimp.




































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_grey32_field_nneighbour
Tcl_Obj* imageObj
Tcl_Obj* xvecObj
Tcl_Obj* yvecObj

/*
 * Warp image using the given vector field.
 */

crimp_image* image;
crimp_image* xvector;
crimp_image* yvector;
crimp_image* result;
int x, y;
double xf, yf;

crimp_input (imageObj, image,   grey32);
crimp_input (xvecObj,  xvector, float);
crimp_input (yvecObj,  yvector, float);

if (!crimp_eq_dim (xvector, yvector)) {
    Tcl_SetResult(interp, "Unable to warp, expected equally-sized coordinate fields", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Create result and scan through it, sampling the input under the guidance of
 * the coordinate fields.
 */

result = crimp_new (image->itype, xvector->w, xvector->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	int xi, yi, outside;

	xf = FLOATP (xvector, x, y);
	yf = FLOATP (yvector, x, y);

	xi = xf;
	yi = yf;
	if ((xf - xi) >= 0.5) xi++;
	if ((yf - yi) >= 0.5) yi++;

	outside = (xi < 0) || (xi >= image->w) || (yi < 0) || (yi >= image->h);

	GREY32 (result, x, y) = outside ? BLACK : GREY32 (image, xi, yi);
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-grey32-projective-bicubic.crimp.










































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_grey32_projective_bicubic
Tcl_Obj* imageObj
Tcl_Obj* forwardObj

/*
 * Warp image using the given specified transform. The result is made large
 * enough to contain all of the warped image, and will contain meta data about
 * the location of the actual (0,0) origin point relative to the physical top
 * left corner of the result. This last is required because translations in
 * the transform may move pixels to negative positions which we cannot express
 * with the regular memory grid.
 */

crimp_image* image;
crimp_image* forward;
crimp_image* backward;
crimp_image* result;
int x, y, xt, yt, origx, origy, pixel, xl, xr, yu, yd;
double xf, yf;

crimp_input (imageObj,   image,   grey32);
crimp_input (forwardObj, forward, float);

if (!crimp_require_dim (forward, 3, 3)) {
    Tcl_SetResult(interp, "bad matrix dimensions, expected 3x3", TCL_STATIC);
    return TCL_ERROR;
}

backward = crimp_la_invert_matrix_3x3 (forward);
if (!backward) {
    Tcl_SetResult(interp, "Unable to invert singular matrix", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Determine size of the result, and the location of the origin point inside
 * based on the four corners of the input image and the forward transformation.
 */

result = crimp_geo_warp_init (image, forward, &origx, &origy);

for (y = 0, yt = origy; y < result->h; y++, yt++) {
    for (x = 0, xt = origx; x < result->w; x++, xt++) {
	int ixw, iyw;

	xf = xt;
	yf = yt;
	crimp_geo_warp_point (backward, &xf, &yf);

	/*
	 * Perform bicubic interpolation (1,2) using the nearest 4x4 pixels
	 * around the sampling location.
	 *
	 * (Ad 1) http://en.wikipedia.org/wiki/Bicubic_interpolation
	 * (Ad 2) http://www.paulinternet.nl/?page=bicubic
	 */

        ixw = xf;  xf -= ixw;
        iyw = yf;  yf -= iyw;

	ixw --; xf += 1.; xf /= 3.;
	iyw --; yf += 1.; yf /= 3.;

#undef  SAMPLE
#define SAMPLE(dx,dy) ((((ixw+(dx)) < 0) || ((ixw+(dx)) >= image->w) || ((iyw+(dy)) < 0) || ((iyw+(dy)) >= image->h)) ? BLACK : (GREY32 (image,(ixw+(dx)), (iyw+(dy)))))

	{
	    double p00 = SAMPLE(0,0);
	    double p01 = SAMPLE(0,1);
	    double p02 = SAMPLE(0,2);
	    double p03 = SAMPLE(0,3);
	    double p10 = SAMPLE(1,0);
	    double p11 = SAMPLE(1,1);
	    double p12 = SAMPLE(1,2);
	    double p13 = SAMPLE(1,3);
	    double p20 = SAMPLE(2,0);
	    double p21 = SAMPLE(2,1);
	    double p22 = SAMPLE(2,2);
	    double p23 = SAMPLE(2,3);
	    double p30 = SAMPLE(3,0);
	    double p31 = SAMPLE(3,1);
	    double p32 = SAMPLE(3,2);
	    double p33 = SAMPLE(3,3);

	    double a00 =      p11;
	    double a01 = -.50*p10 +  .50*p12;
	    double a02 =      p10 - 2.50*p11 + 2.00*p12 -  .50*p13;
	    double a03 = -.50*p10 + 1.50*p11 - 1.50*p12 +  .50*p13;
	    double a10 = -.50*p01 +  .50*p21;
	    double a11 =  .25*p00 -  .25*p02 -  .25*p20 +  .25*p22;
	    double a12 = -.50*p00 + 1.25*p01 -      p02 +  .25*p03 +  .50*p20 - 1.25*p21 +      p22 -  .25*p23;
	    double a13 =  .25*p00 -  .75*p01 +  .75*p02 -  .25*p03 -  .25*p20 +  .75*p21 -  .75*p22 +  .25*p23;
	    double a20 =      p01 - 2.50*p11 + 2.00*p21 -  .50*p31;
	    double a21 = -.50*p00 +  .50*p02 + 1.25*p10 - 1.25*p12 -      p20 +      p22 +  .25*p30 -  .25*p32;
	    double a22 =      p00 - 2.50*p01 + 2.00*p02 -  .50*p03 - 2.50*p10 + 6.25*p11 - 5.00*p12 + 1.25*p13 +
		2.00*p20 - 5.00*p21 + 4.00*p22 -     p23 - .50*p30 + 1.25*p31 -     p32 + .25*p33;
	    double a23 = -.50*p00 + 1.50*p01 - 1.50*p02 +  .50*p03 + 1.25*p10 - 3.75*p11 + 3.75*p12 - 1.25*p13 -
		p20 + 3.00*p21 - 3.00*p22 +     p23 + .25*p30 -  .75*p31 + .75*p32 - .25*p33;
	    double a30 = -.50*p01 + 1.50*p11 - 1.50*p21 +  .50*p31;
	    double a31 =  .25*p00 -  .25*p02 -  .75*p10 +  .75*p12 +  .75*p20 -  .75*p22 -  .25*p30 +  .25*p32;
	    double a32 = -.50*p00 + 1.25*p01 -      p02 +  .25*p03 + 1.50*p10 - 3.75*p11 + 3.00*p12 -  .75*p13 -
		1.50*p20 + 3.75*p21 - 3.00*p22 + .75*p23 + .50*p30 - 1.25*p31 +     p32 - .25*p33;
	    double a33 =  .25*p00 -  .75*p01 +  .75*p02 -  .25*p03 -  .75*p10 + 2.25*p11 - 2.25*p12 +  .75*p13 +
		.75*p20 - 2.25*p21 + 2.25*p22 - .75*p23 - .25*p30 +  .75*p31 - .75*p32 + .25*p33;

	    double x2 = xf * xf;
	    double x3 = x2 * xf;
	    double y2 = yf * yf;
	    double y3 = y2 * yf;

	    GREY32 (result, x, y) = 
		(a00 + a01 * yf + a02 * y2 + a03 * y3)      +
		(a10 + a11 * yf + a12 * y2 + a13 * y3) * xf +
		(a20 + a21 * yf + a22 * y2 + a23 * y3) * x2 +
		(a30 + a31 * yf + a32 * y2 + a33 * y3) * x3;	    
        }
    }
}

crimp_del (backward);
Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-grey32-projective-bilinear.crimp.


































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_grey32_projective_bilinear
Tcl_Obj* imageObj
Tcl_Obj* forwardObj

/*
 * Warp image using the given specified transform. The result is made large
 * enough to contain all of the warped image, and will contain meta data about
 * the location of the actual (0,0) origin point relative to the physical top
 * left corner of the result. This last is required because translations in
 * the transform may move pixels to negative positions which we cannot express
 * with the regular memory grid.
 */

crimp_image* image;
crimp_image* forward;
crimp_image* backward;
crimp_image* result;
int x, y, xt, yt, origx, origy, pixel, xl, xr, yu, yd, c;
double xf, yf;

crimp_input (imageObj,   image,   grey32);
crimp_input (forwardObj, forward, float);

if (!crimp_require_dim (forward, 3, 3)) {
    Tcl_SetResult(interp, "bad matrix dimensions, expected 3x3", TCL_STATIC);
    return TCL_ERROR;
}

backward = crimp_la_invert_matrix_3x3 (forward);
if (!backward) {
    Tcl_SetResult(interp, "Unable to invert singular matrix", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Determine size of the result, and the location of the origin point inside
 * based on the four corners of the input image and the forward transformation.
 */

result = crimp_geo_warp_init (image, forward, &origx, &origy);

for (y = 0, yt = origy; y < result->h; y++, yt++) {
    for (x = 0, xt = origx; x < result->w; x++, xt++) {
	int ixw, iyw;

	xf = xt;
	yf = yt;
	crimp_geo_warp_point (backward, &xf, &yf);

	/*
	 * Perform bilinear interpolation (1) using the nearest 2x2 pixels
	 * around the sampling location.
	 *
	 * (Ad 1) http://en.wikipedia.org/wiki/Bilinear_interpolation
	 */

        ixw = xf;
        iyw = yf;

        xf -= ixw;
        yf -= iyw;

	{
            float val = 0;
	    int ix, iy;
            for (iy = MAX(iyw, 0); iy < MIN(iyw + 2, image->h); iy++) {
                yf = 1 - yf;
                for (ix = MAX(ixw, 0); ix < MIN(ixw + 2, image->w); ix++) {
                    xf = 1 - xf;

		    val += GREY32 (image, ix, iy) * yf * xf;
                }
            }

	    GREY32 (result, x, y) = val;
        }
    }
}

crimp_del (backward);
Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-grey32-projective-nneighbour.crimp.



















































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_grey32_projective_nneighbour
Tcl_Obj* imageObj
Tcl_Obj* forwardObj

/*
 * Warp the image using the specified transform. The result is made large
 * enough to contain all of the warped image, and will contain meta data about
 * the location of the actual (0,0) origin point relative to the physical top
 * left corner of the result. This last is required because translations in
 * the transform may move result pixels to negative positions which we cannot
 * express with the regular memory grid.
 */

crimp_image* image;
crimp_image* forward;
crimp_image* backward;
crimp_image* result;
int x, y, xt, yt, origx, origy, pixel, xi, yi, outside, c;
double xf, yf;

crimp_input (imageObj,   image,   grey32);
crimp_input (forwardObj, forward, float);

if (!crimp_require_dim (forward, 3, 3)) {
    Tcl_SetResult(interp, "bad matrix dimensions, expected 3x3", TCL_STATIC);
    return TCL_ERROR;
}

backward = crimp_la_invert_matrix_3x3 (forward);
if (!backward) {
    Tcl_SetResult(interp, "Unable to invert singular matrix", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Determine size of the result, and the location of the origin point inside
 * based on the four corners of the input image and the forward transformation.
 */

result = crimp_geo_warp_init (image, forward, &origx, &origy);

for (y = 0, yt = origy; y < result->h; y++, yt++) {
    for (x = 0, xt = origx; x < result->w; x++, xt++) {
	xf = xt;
	yf = yt;
	crimp_geo_warp_point (backward, &xf, &yf);

	/*
	 * Choose the nearest neighbour in x and y to the sampling location as
	 * the source of the pixel.  Use black for when we moved outside the
	 * boundaries of the input.
	 */

	xi = xf;
	yi = yf;
	if ((xf - xi) >= 0.5) xi++;
	if ((yf - yi) >= 0.5) yi++;

	outside = (xi < 0) || (xi >= image->w) || (yi < 0) || (yi >= image->h);

	GREY32 (result, x, y) = outside ? BLACK : GREY32 (image, xi, yi);
    }
}

crimp_del (backward);
Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-mbyte-field-bicubic.crimp.



































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_mbyte_field_bicubic
Tcl_Obj* imageObj
Tcl_Obj* xvecObj
Tcl_Obj* yvecObj

/*
 * Warp image using the given vector field.
 */

crimp_image* image;
crimp_image* xvector;
crimp_image* yvector;
crimp_image* result;
int x, y, c;
double xf, yf;

crimp_input_any (imageObj, image);
ASSERT_NOTIMGTYPE (image, float);
ASSERT_NOTIMGTYPE (image, grey16);
ASSERT_NOTIMGTYPE (image, grey32);

crimp_input (xvecObj, xvector, float);
crimp_input (yvecObj, yvector, float);

if (!crimp_eq_dim (xvector, yvector)) {
    Tcl_SetResult(interp, "Unable to warp, expected equally-sized coordinate fields", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Create result and scan through it, sampling the input under the guidance of
 * the coordinate fields.
 */

result = crimp_new (image->itype, xvector->w, xvector->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	int ixw, iyw;

	xf = FLOATP (xvector, x, y);
	yf = FLOATP (yvector, x, y);

	/*
	 * Perform bicubic interpolation (1,2) using the nearest 4x4 pixels
	 * around the sampling location.
	 *
	 * (Ad 1) http://en.wikipedia.org/wiki/Bicubic_interpolation
	 * (Ad 2) http://www.paulinternet.nl/?page=bicubic
	 */

        ixw = xf;  xf -= ixw;
        iyw = yf;  yf -= iyw;

	ixw --; xf += 1.; xf /= 3.;
	iyw --; yf += 1.; yf /= 3.;

#undef  SAMPLE
#define SAMPLE(dx,dy) ((((ixw+(dx)) < 0) || ((ixw+(dx)) >= image->w) || ((iyw+(dy)) < 0) || ((iyw+(dy)) >= image->h)) ? BLACK : (CH (image, c, (ixw+(dx)), (iyw+(dy)))))

        for (c = 0; c < 4; ++c) {
	    double p00 = SAMPLE(0,0);
	    double p01 = SAMPLE(0,1);
	    double p02 = SAMPLE(0,2);
	    double p03 = SAMPLE(0,3);
	    double p10 = SAMPLE(1,0);
	    double p11 = SAMPLE(1,1);
	    double p12 = SAMPLE(1,2);
	    double p13 = SAMPLE(1,3);
	    double p20 = SAMPLE(2,0);
	    double p21 = SAMPLE(2,1);
	    double p22 = SAMPLE(2,2);
	    double p23 = SAMPLE(2,3);
	    double p30 = SAMPLE(3,0);
	    double p31 = SAMPLE(3,1);
	    double p32 = SAMPLE(3,2);
	    double p33 = SAMPLE(3,3);

	    double a00 =      p11;
	    double a01 = -.50*p10 +  .50*p12;
	    double a02 =      p10 - 2.50*p11 + 2.00*p12 -  .50*p13;
	    double a03 = -.50*p10 + 1.50*p11 - 1.50*p12 +  .50*p13;
	    double a10 = -.50*p01 +  .50*p21;
	    double a11 =  .25*p00 -  .25*p02 -  .25*p20 +  .25*p22;
	    double a12 = -.50*p00 + 1.25*p01 -      p02 +  .25*p03 +  .50*p20 - 1.25*p21 +      p22 -  .25*p23;
	    double a13 =  .25*p00 -  .75*p01 +  .75*p02 -  .25*p03 -  .25*p20 +  .75*p21 -  .75*p22 +  .25*p23;
	    double a20 =      p01 - 2.50*p11 + 2.00*p21 -  .50*p31;
	    double a21 = -.50*p00 +  .50*p02 + 1.25*p10 - 1.25*p12 -      p20 +      p22 +  .25*p30 -  .25*p32;
	    double a22 =      p00 - 2.50*p01 + 2.00*p02 -  .50*p03 - 2.50*p10 + 6.25*p11 - 5.00*p12 + 1.25*p13 +
		2.00*p20 - 5.00*p21 + 4.00*p22 -     p23 - .50*p30 + 1.25*p31 -     p32 + .25*p33;
	    double a23 = -.50*p00 + 1.50*p01 - 1.50*p02 +  .50*p03 + 1.25*p10 - 3.75*p11 + 3.75*p12 - 1.25*p13 -
		p20 + 3.00*p21 - 3.00*p22 +     p23 + .25*p30 -  .75*p31 + .75*p32 - .25*p33;
	    double a30 = -.50*p01 + 1.50*p11 - 1.50*p21 +  .50*p31;
	    double a31 =  .25*p00 -  .25*p02 -  .75*p10 +  .75*p12 +  .75*p20 -  .75*p22 -  .25*p30 +  .25*p32;
	    double a32 = -.50*p00 + 1.25*p01 -      p02 +  .25*p03 + 1.50*p10 - 3.75*p11 + 3.00*p12 -  .75*p13 -
		1.50*p20 + 3.75*p21 - 3.00*p22 + .75*p23 + .50*p30 - 1.25*p31 +     p32 - .25*p33;
	    double a33 =  .25*p00 -  .75*p01 +  .75*p02 -  .25*p03 -  .75*p10 + 2.25*p11 - 2.25*p12 +  .75*p13 +
		.75*p20 - 2.25*p21 + 2.25*p22 - .75*p23 - .25*p30 +  .75*p31 - .75*p32 + .25*p33;

	    double x2 = xf * xf;
	    double x3 = x2 * xf;
	    double y2 = yf * yf;
	    double y3 = y2 * yf;

	    CH (result, c, x, y) = 
		(a00 + a01 * yf + a02 * y2 + a03 * y3)      +
		(a10 + a11 * yf + a12 * y2 + a13 * y3) * xf +
		(a20 + a21 * yf + a22 * y2 + a23 * y3) * x2 +
		(a30 + a31 * yf + a32 * y2 + a33 * y3) * x3;	    
        }
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-mbyte-field-bilinear.crimp.



























































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_mbyte_field_bilinear
Tcl_Obj* imageObj
Tcl_Obj* xvecObj
Tcl_Obj* yvecObj

/*
 * Warp image using the given vector field.
 */

crimp_image* image;
crimp_image* xvector;
crimp_image* yvector;
crimp_image* result;
int x, y, c;
double xf, yf;

crimp_input_any (imageObj, image);
ASSERT_NOTIMGTYPE (image, float);
ASSERT_NOTIMGTYPE (image, grey16);
ASSERT_NOTIMGTYPE (image, grey32);

crimp_input (xvecObj, xvector, float);
crimp_input (yvecObj, yvector, float);

if (!crimp_eq_dim (xvector, yvector)) {
    Tcl_SetResult(interp, "Unable to warp, expected equally-sized coordinate fields", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Create result and scan through it, sampling the input under the guidance of
 * the coordinate fields.
 */

result = crimp_new (image->itype, xvector->w, xvector->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	int ixw, iyw;

	xf = FLOATP (xvector, x, y);
	yf = FLOATP (yvector, x, y);

	/*
	 * Perform bilinear interpolation (1) using the nearest 2x2 pixels
	 * around the sampling location.
	 *
	 * (Ad 1) http://en.wikipedia.org/wiki/Bilinear_interpolation
	 */

        ixw = xf;
        iyw = yf;

        xf -= ixw;
        yf -= iyw;

        for (c = 0; c < 4; ++c) {
            float val = 0;
	    int ix, iy;
            for (iy = MAX(iyw, 0); iy < MIN(iyw + 2, image->h); iy++) {
                yf = 1 - yf;
                for (ix = MAX(ixw, 0); ix < MIN(ixw + 2, image->w); ix++) {
                    xf = 1 - xf;

		    val += CH (image, c, ix, iy) * yf * xf;
                }
            }

	    CH (result, c, x, y) = val;
        }
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-mbyte-field-nneighbour.crimp.










































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_mbyte_field_nneighbour
Tcl_Obj* imageObj
Tcl_Obj* xvecObj
Tcl_Obj* yvecObj

/*
 * Warp image using the given vector field.
 */

crimp_image* image;
crimp_image* xvector;
crimp_image* yvector;
crimp_image* result;
int x, y, c;
double xf, yf;

crimp_input_any (imageObj, image);
ASSERT_NOTIMGTYPE (image, float);
ASSERT_NOTIMGTYPE (image, grey16);
ASSERT_NOTIMGTYPE (image, grey32);

crimp_input (xvecObj, xvector, float);
crimp_input (yvecObj, yvector, float);

if (!crimp_eq_dim (xvector, yvector)) {
    Tcl_SetResult(interp, "Unable to warp, expected equally-sized coordinate fields", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Create result and scan through it, sampling the input under the guidance of
 * the coordinate fields.
 */

result = crimp_new (image->itype, xvector->w, xvector->h);

for (y = 0; y < result->h; y++) {
    for (x = 0; x < result->w; x++) {
	int xi, yi, outside;

	xf = FLOATP (xvector, x, y);
	yf = FLOATP (yvector, x, y);

	xi = xf;
	yi = yf;
	if ((xf - xi) >= 0.5) xi++;
	if ((yf - yi) >= 0.5) yi++;

	outside = (xi < 0) || (xi >= image->w) || (yi < 0) || (yi >= image->h);

	for (c = 0; c < image->itype->channels; c++) {
	    CH (result, c, x, y) = outside ? BLACK : CH (image, c, xi, yi);
	}
    }
}

Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-mbyte-projective-bicubic.crimp.














































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_mbyte_projective_bicubic
Tcl_Obj* imageObj
Tcl_Obj* forwardObj

/*
 * Warp image using the given specified transform. The result is made large
 * enough to contain all of the warped image, and will contain meta data about
 * the location of the actual (0,0) origin point relative to the physical top
 * left corner of the result. This last is required because translations in
 * the transform may move pixels to negative positions which we cannot express
 * with the regular memory grid.
 */

crimp_image* image;
crimp_image* forward;
crimp_image* backward;
crimp_image* result;
int x, y, xt, yt, origx, origy, pixel, xl, xr, yu, yd, c;
double xf, yf;

crimp_input_any (imageObj, image);
ASSERT_NOTIMGTYPE (image, float);
ASSERT_NOTIMGTYPE (image, grey16);
ASSERT_NOTIMGTYPE (image, grey32);

crimp_input (forwardObj,  forward,  float);

if (!crimp_require_dim (forward, 3, 3)) {
    Tcl_SetResult(interp, "bad matrix dimensions, expected 3x3", TCL_STATIC);
    return TCL_ERROR;
}

backward = crimp_la_invert_matrix_3x3 (forward);
if (!backward) {
    Tcl_SetResult(interp, "Unable to invert singular matrix", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Determine size of the result, and the location of the origin point inside
 * based on the four corners of the input image and the forward transformation.
 */

result = crimp_geo_warp_init (image, forward, &origx, &origy);

for (y = 0, yt = origy; y < result->h; y++, yt++) {
    for (x = 0, xt = origx; x < result->w; x++, xt++) {
	int ixw, iyw;

	xf = xt;
	yf = yt;
	crimp_geo_warp_point (backward, &xf, &yf);

	/*
	 * Perform bicubic interpolation (1,2) using the nearest 4x4 pixels
	 * around the sampling location.
	 *
	 * (Ad 1) http://en.wikipedia.org/wiki/Bicubic_interpolation
	 * (Ad 2) http://www.paulinternet.nl/?page=bicubic
	 */

        ixw = xf;  xf -= ixw;
        iyw = yf;  yf -= iyw;

	ixw --; xf += 1.; xf /= 3.;
	iyw --; yf += 1.; yf /= 3.;

#undef  SAMPLE
#define SAMPLE(dx,dy) ((((ixw+(dx)) < 0) || ((ixw+(dx)) >= image->w) || ((iyw+(dy)) < 0) || ((iyw+(dy)) >= image->h)) ? BLACK : (CH (image, c, (ixw+(dx)), (iyw+(dy)))))

        for (c = 0; c < 4; ++c) {
	    double p00 = SAMPLE(0,0);
	    double p01 = SAMPLE(0,1);
	    double p02 = SAMPLE(0,2);
	    double p03 = SAMPLE(0,3);
	    double p10 = SAMPLE(1,0);
	    double p11 = SAMPLE(1,1);
	    double p12 = SAMPLE(1,2);
	    double p13 = SAMPLE(1,3);
	    double p20 = SAMPLE(2,0);
	    double p21 = SAMPLE(2,1);
	    double p22 = SAMPLE(2,2);
	    double p23 = SAMPLE(2,3);
	    double p30 = SAMPLE(3,0);
	    double p31 = SAMPLE(3,1);
	    double p32 = SAMPLE(3,2);
	    double p33 = SAMPLE(3,3);

	    double a00 =      p11;
	    double a01 = -.50*p10 +  .50*p12;
	    double a02 =      p10 - 2.50*p11 + 2.00*p12 -  .50*p13;
	    double a03 = -.50*p10 + 1.50*p11 - 1.50*p12 +  .50*p13;
	    double a10 = -.50*p01 +  .50*p21;
	    double a11 =  .25*p00 -  .25*p02 -  .25*p20 +  .25*p22;
	    double a12 = -.50*p00 + 1.25*p01 -      p02 +  .25*p03 +  .50*p20 - 1.25*p21 +      p22 -  .25*p23;
	    double a13 =  .25*p00 -  .75*p01 +  .75*p02 -  .25*p03 -  .25*p20 +  .75*p21 -  .75*p22 +  .25*p23;
	    double a20 =      p01 - 2.50*p11 + 2.00*p21 -  .50*p31;
	    double a21 = -.50*p00 +  .50*p02 + 1.25*p10 - 1.25*p12 -      p20 +      p22 +  .25*p30 -  .25*p32;
	    double a22 =      p00 - 2.50*p01 + 2.00*p02 -  .50*p03 - 2.50*p10 + 6.25*p11 - 5.00*p12 + 1.25*p13 +
		2.00*p20 - 5.00*p21 + 4.00*p22 -     p23 - .50*p30 + 1.25*p31 -     p32 + .25*p33;
	    double a23 = -.50*p00 + 1.50*p01 - 1.50*p02 +  .50*p03 + 1.25*p10 - 3.75*p11 + 3.75*p12 - 1.25*p13 -
		p20 + 3.00*p21 - 3.00*p22 +     p23 + .25*p30 -  .75*p31 + .75*p32 - .25*p33;
	    double a30 = -.50*p01 + 1.50*p11 - 1.50*p21 +  .50*p31;
	    double a31 =  .25*p00 -  .25*p02 -  .75*p10 +  .75*p12 +  .75*p20 -  .75*p22 -  .25*p30 +  .25*p32;
	    double a32 = -.50*p00 + 1.25*p01 -      p02 +  .25*p03 + 1.50*p10 - 3.75*p11 + 3.00*p12 -  .75*p13 -
		1.50*p20 + 3.75*p21 - 3.00*p22 + .75*p23 + .50*p30 - 1.25*p31 +     p32 - .25*p33;
	    double a33 =  .25*p00 -  .75*p01 +  .75*p02 -  .25*p03 -  .75*p10 + 2.25*p11 - 2.25*p12 +  .75*p13 +
		.75*p20 - 2.25*p21 + 2.25*p22 - .75*p23 - .25*p30 +  .75*p31 - .75*p32 + .25*p33;

	    double x2 = xf * xf;
	    double x3 = x2 * xf;
	    double y2 = yf * yf;
	    double y3 = y2 * yf;

	    CH (result, c, x, y) = 
		(a00 + a01 * yf + a02 * y2 + a03 * y3)      +
		(a10 + a11 * yf + a12 * y2 + a13 * y3) * xf +
		(a20 + a21 * yf + a22 * y2 + a23 * y3) * x2 +
		(a30 + a31 * yf + a32 * y2 + a33 * y3) * x3;	    
        }
    }
}

crimp_del (backward);
Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-mbyte-projective-bilinear.crimp.






































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_mbyte_projective_bilinear
Tcl_Obj* imageObj
Tcl_Obj* forwardObj

/*
 * Warp image using the given specified transform. The result is made large
 * enough to contain all of the warped image, and will contain meta data about
 * the location of the actual (0,0) origin point relative to the physical top
 * left corner of the result. This last is required because translations in
 * the transform may move pixels to negative positions which we cannot express
 * with the regular memory grid.
 */

crimp_image* image;
crimp_image* forward;
crimp_image* backward;
crimp_image* result;
int x, y, xt, yt, origx, origy, pixel, xl, xr, yu, yd, c;
double xf, yf;

crimp_input_any (imageObj, image);
ASSERT_NOTIMGTYPE (image, float);
ASSERT_NOTIMGTYPE (image, grey16);
ASSERT_NOTIMGTYPE (image, grey32);

crimp_input (forwardObj,  forward,  float);

if (!crimp_require_dim (forward, 3, 3)) {
    Tcl_SetResult(interp, "bad matrix dimensions, expected 3x3", TCL_STATIC);
    return TCL_ERROR;
}

backward = crimp_la_invert_matrix_3x3 (forward);
if (!backward) {
    Tcl_SetResult(interp, "Unable to invert singular matrix", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Determine size of the result, and the location of the origin point inside
 * based on the four corners of the input image and the forward transformation.
 */

result = crimp_geo_warp_init (image, forward, &origx, &origy);

for (y = 0, yt = origy; y < result->h; y++, yt++) {
    for (x = 0, xt = origx; x < result->w; x++, xt++) {
	int ixw, iyw;

	xf = xt;
	yf = yt;
	crimp_geo_warp_point (backward, &xf, &yf);

	/*
	 * Perform bilinear interpolation (1) using the nearest 2x2 pixels
	 * around the sampling location.
	 *
	 * (Ad 1) http://en.wikipedia.org/wiki/Bilinear_interpolation
	 */

        ixw = xf;
        iyw = yf;

        xf -= ixw;
        yf -= iyw;

        for (c = 0; c < 4; ++c) {
            float val = 0;
	    int ix, iy;
            for (iy = MAX(iyw, 0); iy < MIN(iyw + 2, image->h); iy++) {
                yf = 1 - yf;
                for (ix = MAX(ixw, 0); ix < MIN(ixw + 2, image->w); ix++) {
                    xf = 1 - xf;

		    val += CH (image, c, ix, iy) * yf * xf;
                }
            }

	    CH (result, c, x, y) = val;
        }
    }
}

crimp_del (backward);
Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/warp-mbyte-projective-nneighbour.crimp.

























































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

warp_mbyte_projective_nneighbour
Tcl_Obj* imageObj
Tcl_Obj* forwardObj

/*
 * Warp the image using the specified transform. The result is made large
 * enough to contain all of the warped image, and will contain meta data about
 * the location of the actual (0,0) origin point relative to the physical top
 * left corner of the result. This last is required because translations in
 * the transform may move result pixels to negative positions which we cannot
 * express with the regular memory grid.
 */

crimp_image* image;
crimp_image* forward;
crimp_image* backward;
crimp_image* result;
int x, y, xt, yt, origx, origy, pixel, xi, yi, outside, c;
double xf, yf;

crimp_input_any (imageObj, image);
ASSERT_NOTIMGTYPE (image, float);
ASSERT_NOTIMGTYPE (image, grey16);
ASSERT_NOTIMGTYPE (image, grey32);

crimp_input (forwardObj, forward, float);

if (!crimp_require_dim (forward, 3, 3)) {
    Tcl_SetResult(interp, "bad matrix dimensions, expected 3x3", TCL_STATIC);
    return TCL_ERROR;
}

backward = crimp_la_invert_matrix_3x3 (forward);
if (!backward) {
    Tcl_SetResult(interp, "Unable to invert singular matrix", TCL_STATIC);
    return TCL_ERROR;
}

/*
 * Determine size of the result, and the location of the origin point inside
 * based on the four corners of the input image and the forward transformation.
 */

result = crimp_geo_warp_init (image, forward, &origx, &origy);

for (y = 0, yt = origy; y < result->h; y++, yt++) {
    for (x = 0, xt = origx; x < result->w; x++, xt++) {
	xf = xt;
	yf = yt;
	crimp_geo_warp_point (backward, &xf, &yf);

	/*
	 * Choose the nearest neighbour in x and y to the sampling location as
	 * the source of the pixel.  Use black for when we moved outside the
	 * boundaries of the input.
	 */

	xi = xf;
	yi = yf;
	if ((xf - xi) >= 0.5) xi++;
	if ((yf - yi) >= 0.5) yi++;

	outside = (xi < 0) || (xi >= image->w) || (yi < 0) || (yi >= image->h);

	for (c = 0; c < image->itype->channels; c++) {
	    CH (result, c, x, y) = outside ? BLACK : CH (image, c, xi, yi);
	}
    }
}

crimp_del (backward);
Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/wavy.crimp.














































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

wavy
Tcl_Obj* imageObj float offset float adj1 float adj2

crimp_image*     result;
crimp_image*     image;
int              x, y, w, h;

int              oy, ox, c, iy, ix;

crimp_input (imageObj, image, rgba);

w = image->w;
h = image->h;

result = crimp_new_like (image);


for (oy = 0; oy < h; ++oy) {
    for (ox = 0; ox < w; ++ox) {

	/*
	 * The output coordinates (ox, oy) are converted into the coordinates
	 * in the input image from which to pull the pixel(s). I.e. this is a
	 * special geometry deformation.
	 */

        float r = sinf(hypotf(oy - h/2, ox - w/2) * adj1/w + offset)/adj2 + 1;
        float iyf = (oy - h / 2) * r + h/2;
        float ixf = (ox - w / 2) * r + w/2;
        int   iyw = iyf;
        int   ixw = ixf;
	float val;

        iyf -= iyw;
        ixf -= ixw;

	/*
	 * All channels in the image are handled in the same way.  A rectangle
	 * around the chosen location in the input is scanned and the colors
	 * added together in some weighted scheme.
	 */

        for (c = 0; c < 4; ++c) {

            val = 0;

            for (iy = MAX(iyw, 0); iy < MIN(iyw + 2, h); ++iy) {
                iyf = 1 - iyf;
                for (ix = MAX(ixw, 0); ix < MIN(ixw + 2, w); ++ix) {
                    ixf = 1 - ixf;
		    val += CH (image, c, ix, iy) * iyf * ixf;
                }
            }

	    CH (result, c, ox, oy) = val;
        }
    }
}


Tcl_SetObjResult(interp, crimp_new_image_obj (result));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/width.crimp.

























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

width
Tcl_Obj* imageObj

crimp_image* image;

crimp_input_any (imageObj, image);

Tcl_SetObjResult (interp, Tcl_NewIntObj (image->w));
return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/write-grey8-tk.crimp.
























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

write_2tk_grey8
char* photo Tcl_Obj* imageObj

Tk_PhotoHandle     handle = Tk_FindPhoto(interp, photo);
Tk_PhotoImageBlock pib;
crimp_image*       image;

if (!handle) {
    Tcl_ResetResult (interp);
    Tcl_AppendResult(interp, "image \"", photo, "\" doesn't exist", NULL);
    return TCL_ERROR;
}

crimp_input (imageObj, image, grey8);

/*
 * Fill the Tk image block to match our structure.
 */

pib.pixelPtr  = image->pixel;
pib.width     = image->w;
pib.height    = image->h;
pib.pixelSize = 1;
pib.pitch     = pib.width;
pib.offset[0] = 0;
pib.offset[1] = 0;
pib.offset[2] = 0;
pib.offset[3] = 0;

/*
 * ... and push into the destination tk photo
 */

if (Tk_PhotoSetSize (interp, handle, pib.width, pib.height) != TCL_OK ||
    Tk_PhotoPutBlock(interp, handle, &pib, 0, 0, pib.width, pib.height,
                     TK_PHOTO_COMPOSITE_SET) != TCL_OK) {
    return TCL_ERROR;
}

return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/write-rgb-tk.crimp.
























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

write_2tk_rgb
char* photo Tcl_Obj* imageObj

Tk_PhotoHandle     handle = Tk_FindPhoto(interp, photo);
Tk_PhotoImageBlock pib;
crimp_image*       image;

if (!handle) {
    Tcl_ResetResult (interp);
    Tcl_AppendResult(interp, "image \"", photo, "\" doesn't exist", NULL);
    return TCL_ERROR;
}

crimp_input (imageObj, image, rgb);

/*
 * Fill the Tk image block to match our structure.
 */

pib.pixelPtr  = image->pixel;
pib.width     = image->w;
pib.height    = image->h;
pib.pixelSize = 3;
pib.pitch     = 3 * pib.width;
pib.offset[0] = 0;
pib.offset[1] = 1;
pib.offset[2] = 2;
pib.offset[3] = 0;

/*
 * ... and push into the destination tk photo
 */

if (Tk_PhotoSetSize (interp, handle, pib.width, pib.height) != TCL_OK ||
    Tk_PhotoPutBlock(interp, handle, &pib, 0, 0, pib.width, pib.height,
                     TK_PHOTO_COMPOSITE_SET) != TCL_OK) {
    return TCL_ERROR;
}

return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added operator/write-rgba-tk.crimp.
























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

write_2tk_rgba
char* photo Tcl_Obj* imageObj

Tk_PhotoHandle     handle = Tk_FindPhoto(interp, photo);
Tk_PhotoImageBlock pib;
crimp_image*       image;

if (!handle) {
    Tcl_ResetResult (interp);
    Tcl_AppendResult(interp, "image \"", photo, "\" doesn't exist", NULL);
    return TCL_ERROR;
}

crimp_input (imageObj, image, rgba);

/*
 * Fill the Tk image block to match our structure.
 */

pib.pixelPtr  = image->pixel;
pib.width     = image->w;
pib.height    = image->h;
pib.pixelSize = 4;
pib.pitch     = 4 * pib.width;
pib.offset[0] = 0;
pib.offset[1] = 1;
pib.offset[2] = 2;
pib.offset[3] = 3;

/*
 * ... and push into the destination tk photo
 */

if (Tk_PhotoSetSize (interp, handle, pib.width, pib.height) != TCL_OK ||
    Tk_PhotoPutBlock(interp, handle, &pib, 0, 0, pib.width, pib.height,
                     TK_PHOTO_COMPOSITE_SET) != TCL_OK) {
    return TCL_ERROR;
}

return TCL_OK;


/* vim: set sts=4 sw=4 tw=80 et ft=c: */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */






Added plot.tcl.




































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# # ## ### ##### ######## ############# #####################
## -*- tcl *-

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require Tk
package require snit          ; # Tcllib
package require Plotchart 1.9 ; # Tklib

# # ## ### ##### ######## ############# #####################
## Implementation

snit::widget plot {
    # # ## ### ##### ######## ############# #####################
    constructor {args} {
	canvas $win.c -bg white
	pack   $win.c -side top -expand 1 -fill both
        $self configurelist $args
	return
    }


    # # ## ### ##### ######## ############# #####################
    option  -variable -configuremethod C-variable
    method C-variable {o value} {
	if {$options($o) ne {}} {
	    trace remove variable $options($o) write [mymethod UpdateData]
	}
	set options($o) $value
	if {$options($o) ne {}} {
	    trace add variable $options($o) write [mymethod Refresh]

	    # Force update now, to handle pre-existing data in the
	    # variable, if any, as such does not invoke the trace.
	    $self Refresh
	}
	return
    }
    # # ## ### ##### ######## ############# #####################
    # # ## ### ##### ######## ############# #####################

    method Refresh {args} {
	catch { after cancel $myupdate }
	set myupdate [after idle [mymethod UpdateData]]
	return
    }

    method UpdateData {} {
	upvar #0 $options(-variable) series
	if {![info exists series]} return

	if {!$options(-locked)} {
	    set  yscale [::Plotchart::determineScaleFromList $series]
	    lset yscale 0 0
	} else {
	    set yscale {0 255 64}
	}

	if {!$options(-xlocked)} {
	    set  xscale [::Plotchart::determineScaleFromList [list 0 [llength $series]]]
	    lset xscale 0 0
	} else {
	    set xscale {0 255 64}
	}

	$win.c delete all

	set myplot [Plotchart::createXYPlot $win.c $xscale $yscale]
	$myplot title $options(-title)
	$myplot dataconfig series -color $options(-color)
	$myplot xconfig -format %d

	set x 0
	foreach y $series {
	    $myplot plot series $x $y
	    incr x
	}
	return
    }

    # # ## ### ##### ######## ############# #####################

    option  -color -default blue -configuremethod C-color
    method C-color {o value} {
	set options($o) $value
	catch {
	    $myplot dataconfig series -color $value
	}
	return
    }

    option  -title -default {} -configuremethod C-title
    method C-title {o value} {
	set options($o) $value
	catch {
	    $myplot title $value
	}
	return
    }

    # # ## ### ##### ######## ############# #####################

    option -locked -default 1 -configuremethod C-locked
    method C-locked {o value} {
	set options($o) $value
	$self Refresh
	return
    }

    option -xlocked -default 1 -configuremethod C-locked

    # # ## ### ##### ######## ############# #####################

    variable myplot   {} ; # plotchar xyplot for the series
    variable myupdate {} ; # idle token for defered update

    # # ## ### ##### ######## ############# #####################
}

# # ## ### ##### ######## ############# #####################
## ready

package provide plot 1
return






Deleted psychedelia.crimp.





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



























































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

psychedelia
int width int height int frames

static float prev[4][3], next[4][3];
static int frame;
static float tweaks[3] = {33, 35, 37};

Tcl_Obj *dataObj = Tcl_NewByteArrayObj(NULL, 4 * width * height);
unsigned char (*pixels)[height][width][4] =
        (unsigned char (*)[height][width][4])
        Tcl_GetByteArrayFromObj(dataObj, NULL);

if (frame % frames == 0) {
    int i, c;
    if (frame == 0) {
        for (i = 0; i < 4; ++i) {
            for (c = 0; c < 3; ++c) {
                next[i][c] = rand() / (float)RAND_MAX;
            }
        }
    }
    for (i = 0; i < 4; ++i) {
        for (c = 0; c < 3; ++c) {
            prev[i][c] = next[i][c];
            next[i][c] = rand() / (float)RAND_MAX;
        }
    }
}

float t = (cosf((frame % frames) / (float)frames * M_PI) + 1) / 2;
int yi, xi, c;
float y, x;
for (yi = 0, y = 0; yi < height; ++yi, y += 1. / height) {
    for (xi = 0, x = 0; xi < width; ++xi, x += 1. / width) {
        float v[3];
        for (c = 0; c < 3; ++c) {
            v[c] = cosf(frame / tweaks[c] + (
                (prev[0][c] * t + next[0][c] * (1 - t)) * (1 - y) * (1 - x)
              + (prev[1][c] * t + next[1][c] * (1 - t)) * (1 - y) * (    x)
              + (prev[2][c] * t + next[2][c] * (1 - t)) * (    y) * (1 - x)
              + (prev[3][c] * t + next[3][c] * (1 - t)) * (    y) * (    x)
            ) * 7 * M_PI);
        }
        float i = (cosf((v[0] + v[1] + v[2] + frame / 17.) * M_PI) + 1) / 2;
        for (c = 0; c < 3; ++c) {
            (*pixels)[yi][xi][c] = CLAMP(0, v[c] * i * 255, 255);
        }
        (*pixels)[yi][xi][3] = 255;
    }
}
++frame;

Tcl_Obj *list[] = {Tcl_NewIntObj(width), Tcl_NewIntObj(height), dataObj};
Tcl_SetObjResult(interp, Tcl_NewListObj(3, list));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */






Added reader/r_strimj.tcl.





























































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# -*- tcl -*- 
# # ## ### ##### ######## #############
# Reader for strimj formatted images.
# See http://wiki.tcl.tk/_//search?S=strimj
# Code derived from http://wiki.tcl.tk/15325

namespace eval ::crimp::read::strimj {
    variable colors {
	{ } {0   0   0   0}
	@   {0   0   0   255}
	b   {0   0   255 255}
	g   {0   255 0   255}
	c   {0   255 255 255}
	r   {255 0   0   255}
	m   {255 0   255 255}
	o   {255 165 0   255}
	y   {255 255 0   255}
	.   {255 255 255 255}
    }
}

proc ::crimp::read::strimj {text {colormap {}}} {
    variable strimj::colors
    array set map $colors
    array set map $colormap

    set rr {} ; set ri {}
    set gr {} ; set gi {}
    set br {} ; set bi {}
    set ar {} ; set ai {}

    foreach line [split [string trimright $text \n] \n] {
	foreach pixel [split $line {}] {
	    lassign $map($pixel) r g b a
	    lappend rr $r
	    lappend gr $g
	    lappend br $b
	    lappend ar $a
	}

	lappend ri $rr ; set rr {}
	lappend gi $gr ; set gr {}
	lappend bi $br ; set br {}
	lappend ai $ar ; set ar {}
    }

   return [crimp join 2rgba \
	       [tcl grey8 $ri] \
	       [tcl grey8 $gi] \
	       [tcl grey8 $bi] \
	       [tcl grey8 $ai]]
}

# # ## ### ##### ######## #############
return






Added specs/pgm.txt.



































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

PGM Format Specification
Updated: 03 October 2003

pgm - Netpbm grayscale image format

DESCRIPTION

This program is part of Netpbm.

The PGM format is a lowest common denominator grayscale file format.
It is designed to be extremely easy to learn and write programs for.
(It's so simple that most people will simply reverse engineer it
because it's easier than reading this specification).

A PGM image represents a grayscale graphic image.  There are many
psueudo-PGM formats in use where everything is as specified herein
except for the meaning of individual pixel values.  For most purposes,
a PGM image can just be thought of an array of arbitrary integers, and
all the programs in the world that think they're processing a
grayscale image can easily be tricked into processing something else.

The name "PGM" is an acronym derived from "Portable Gray Map."

One official variant of PGM is the transparency mask.  A transparency
mask in Netpbm is represented by a PGM image, except that in place of
pixel intensities, there are opaqueness values.  See below.

The format definition is as follows.  You can use the libnetpbm C
subroutine library to conveniently and accurately read and interpret
the format.

A PGM file consists of a sequence of one or more PGM images. There are
no data, delimiters, or padding before, after, or between images.

Each PGM image consists of the following:
  
1.	A "magic number" for identifying the file type. A pgm image's
	magic number is the two characters "P5".

2.	Whitespace (blanks, TABs, CRs, LFs).

3.	A width, formatted as ASCII characters in decimal.

4.	Whitespace.

5.	A height, again in ASCII decimal.

6.	Whitespace.

7.	The maximum gray value (Maxval), again in ASCII decimal.  Must
	be less than 65536, and more than zero.

8.	A single whitespace character (usually a newline).

9.	A raster of Height rows, in order from top to bottom.  Each
	row consists of Width gray values, in order from left to
	right.  Each gray value is a number from 0 through Maxval,
	with 0 being black and Maxval being white.  Each gray value is
	represented in pure binary by either 1 or 2 bytes.  If the
	Maxval is less than 256, it is 1 byte.  Otherwise, it is 2
	bytes.  The most significant byte is first.

	A row of an image is horizontal.  A column is vertical.  The
	pixels in the image are square and contiguous.

	Each gray value is a number proportional to the intensity of
	the pixel, adjusted by the ITU-R Recommendation BT.709 gamma
	transfer function.  (That transfer function specifies a gamma
	number of 2.2 and has a linear section for small intensities).
	A value of zero is therefore black.  A value of Maxval
	represents CIE D65 white and the most intense value in the
	image and any other image to which the image might be
	compared.

	Note that a common variation on the PGM format is to have the
	gray value be "linear," i.e. as specified above except without
	the gamma adjustment.  pnmgamma takes such a PGM variant as
	input and produces a true PGM as output.

	In the transparency mask variation on PGM, the value
	represents opaqueness.  It is proportional to the fraction of
	intensity of a pixel that would show in place of an underlying
	pixel.  So what normally means white represents total
	opaqueness and what normally means black represents total
	transparency.  In between, you would compute the intensity of
	a composite pixel of an "under" and "over" pixel as under *
	(1-(alpha/alpha_maxval)) + over * (alpha/alpha_maxval).  Note
	that there is no gamma transfer function in the transparency
	mask.

Strings starting with "#" may be comments, the same as with PBM.

Note that you can use pamdepth to convert between the format with 1
byte per gray value and the one with 2 bytes per gray value.

There is actually another version of the PGM format that is fairly
rare: "plain" PGM format.  The format above, which generally
considered the normal one, is known as the "raw" PGM format.  See pbm
for some commentary on how plain and raw formats relate to one another
and how to use them.

The difference in the plain format is:

-	There is exactly one image in a file.

-	The magic number is P2 instead of P5.

-	Each pixel in the raster is represented as an ASCII decimal
	number (of arbitrary size).

-	Each pixel in the raster has white space before and after it.
	There must be at least one character of white space between
	any two pixels, but there is no maximum.

-	No line should be longer than 70 characters.

Here is an example of a small image in the plain PGM format.

P2
# feep.pgm
24 7
15
0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0
0  3  3  3  3  0  0  7  7  7  7  0  0 11 11 11 11  0  0 15 15 15 15  0
0  3  0  0  0  0  0  7  0  0  0  0  0 11  0  0  0  0  0 15  0  0 15  0
0  3  3  3  0  0  0  7  7  7  0  0  0 11 11 11  0  0  0 15 15 15 15  0
0  3  0  0  0  0  0  7  0  0  0  0  0 11  0  0  0  0  0 15  0  0  0  0
0  3  0  0  0  0  0  7  7  7  7  0  0 11 11 11 11  0  0 15  0  0  0  0
0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0

There is a newline character at the end of each of these lines.

Programs that read this format should be as lenient as possible,
accepting anything that looks remotely like a PGM.

All characters referred to herein are encoded in ASCII.  "newline"
refers the the character known in ASCII as Line Feed or LF.  A "white
space" character is space, CR, LF, TAB, VT, or FF (I.e. what the ANSI
standard C isspace() function calls white space).

COMPATIBILITY

Before April 2000, a raw format PGM file could not have a maxval
greater than 255.  Hence, it could not have more than one byte per
sample.  Old programs may depend on this.

Before July 2000, there could be at most one image in a PGM file.  As
a result, most tools to process PGM files ignore (and don't read) any
data after the first image.

SEE ALSO

pnm, pbm, ppm, pam, libnetpbm, programs that process PGM,

AUTHOR

Copyright (C) 1989, 1991 by Jef Poskanzer.






Added specs/ppm.txt.







































































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

PPM Format Specification
Updated: 03 October 2003

PPM - Netpbm color image format

DESCRIPTION

This program is part of Netpbm.

The PPM format is a lowest common denominator color image file format.

It should be noted that this format is egregiously inefficient.  It is
highly redundant, while containing a lot of information that the human
eye can't even discern.  Furthermore, the format allows very little
information about the image besides basic color, which means you may
have to couple a file in this format with other independent
information to get any decent use out of it.  However, it is very easy
to write and analyze programs to process this format, and that is the
point.

It should also be noted that files often conform to this format in
every respect except the precise semantics of the sample values.
These files are useful because of the way PPM is used as an
intermediary format.  They are informally called PPM files, but to be
absolutely precise, you should indicate the variation from true PPM.
For example, "PPM using the red, green, and blue colors that the
scanner in question uses."

The name "PPM" is an acronym derived from "Portable Pixel Map."
Images in this format (or a precursor of it) were once also called
"portable pixmaps."

The format definition is as follows.  You can use the libnetpbm C
subroutine library to read and interpret the format conveniently and
accurately.

A PPM file consists of a sequence of one or more PPM images. There are
no data, delimiters, or padding before, after, or between images.

Each PPM image consists of the following:

1.	A "magic number" for identifying the file type.  A ppm image's
	magic number is the two characters "P6".

2.	Whitespace (blanks, TABs, CRs, LFs).

3.	A width, formatted as ASCII characters in decimal.

4.	Whitespace.

5.	A height, again in ASCII decimal.

6.	Whitespace.

7.	The maximum color value (Maxval), again in ASCII decimal.
	Must be less than 65536 and more than zero.

8.	A single whitespace character (usually a newline).

9.	A raster of Height rows, in order from top to bottom.  Each
	row consists of Width pixels, in order from left to right.
	Each pixel is a triplet of red, green, and blue samples, in
	that order.  Each sample is represented in pure binary by
	either 1 or 2 bytes.  If the Maxval is less than 256, it is 1
	byte.  Otherwise, it is 2 bytes.  The most significant byte is
	first.

	A row of an image is horizontal.  A column is vertical.  The
	pixels in the image are square and contiguous.
     
	In the raster, the sample values are "nonlinear." They are
	proportional to the intensity of the ITU-R Recommendation
	BT.709 red, green, and blue in the pixel, adjusted by the
	BT.709 gamma transfer function.  (That transfer function
	specifies a gamma number of 2.2 and has a linear section for
	small intensities).  A value of Maxval for all three samples
	represents CIE D65 white and the most intense color in the
	color universe of which the image is part (the color universe
	is all the colors in all images to which this image might be
	compared).

	ITU-R Recommendation BT.709 is a renaming of the former CCIR
	Recommendation 709.  When CCIR was absorbed into its parent
	organization, the ITU, ca. 2000, the standard was renamed.
	This document once referred to the standard as CIE Rec. 709,
	but it isn't clear now that CIE ever sponsored such a
	standard.

	Note that another popular color space is the newer sRGB.  A
	common variation on PPM is to substitute this color space for
	the one specified.

	Note that a common variation on the PPM format is to have the
	sample values be "linear," i.e. as specified above except
	without the gamma adjustment.  pnmgamma takes such a PPM
	variant as input and produces a true PPM as output.

Strings starting with "#" may be comments, the same as with PBM.

Note that you can use pamdepth to convert between the format with 1
byte per sample and the one with 2 bytes per sample.

There is actually another version of the PPM format that is fairly
rare: "plain" PPM format.  The format above, which is generally
considered the normal one, is known as the "raw" PPM format.  See pbm
for some commentary on how plain and raw formats relate to one another
and how to use them.

The difference in the plain format is:

-	There is exactly one image in a file.

-	The magic number is P3 instead of P6.

-	Each sample in the raster is represented as an ASCII decimal
	number (of arbitrary size).

-	Each sample in the raster has white space before and after it.
	There must be at least one character of white space between
	any two samples, but there is no maximum.  There is no
	particular separation of one pixel from another -- just the
	required separation between the blue sample of one pixel from
	the red sample of the next pixel.

-	No line should be longer than 70 characters.

Here is an example of a small image in this format.

P3
# feep.ppm
4 4
15
 0  0  0    0  0  0    0  0  0   15  0 15
 0  0  0    0 15  7    0  0  0    0  0  0
 0  0  0    0  0  0    0 15  7    0  0  0
15  0 15    0  0  0    0  0  0    0  0  0

There is a newline character at the end of each of these lines.

Programs that read this format should be as lenient as possible,
accepting anything that looks remotely like a PPM image.

All characters referred to herein are encoded in ASCII.  "newline"
refers the the character known in ASCII as Line Feed or LF.  A "white
space" character is space, CR, LF, TAB, VT, or FF (I.e. what the ANSI
standard C isspace() function calls white space).


COMPATIBILITY

Before April 2000, a raw format PPM file could not have a maxval
greater than 255.  Hence, it could not have more than one byte per
sample.  Old programs may depend on this.

Before July 2000, there could be at most one image in a PPM file.  As
a result, most tools to process PPM files ignore (and don't read) any
data after the first image.

SEE ALSO

pnm, pgm, pbm, pam, programs that process PPM






Added time.tcl.





































































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#!/bin/sh
# -*- tcl -*-
# The next line restarts with tclsh.\
exec tclsh "$0" ${1+"$@"}

if {[catch {
    package require Tcl 8.6
    package require Tk  8.6

    puts "Using Tcl/Tk 8.6"
}]} {
    package require Tcl 8.5
    package require Tk  8.5
    package require img::png

    puts "Using Tcl/Tk 8.5 + img::png"
}
#package require widget::scrolledwindow
#package require widget::toolbar
package require fileutil

# Self dir
set dir [file dirname [file normalize [info script]]]

puts "In $dir"

set triedprebuilt 0
if {![file exists $dir/lib] ||
    [catch {
	set triedprebuilt 1

	puts "Trying prebuild crimp package"

	# Use crimp as prebuilt package
	lappend auto_path $dir/lib
	package require crimp

	puts "Using prebuilt crimp [package present crimp]"
	puts "At [package ifneeded crimp [package present crimp]]"
    } msg]} {

    if {$triedprebuilt} {
	puts "Trying to use a prebuilt crimp package failed ($msg)."
	puts ==\t[join [split $::errorInfo \n] \n==\t]
	puts "Falling back to dynamic compilation via local critcl package"
    }

    puts "Trying dynamically compiled crimp package"

    set cp [file join [file dirname $dir] lib critcl.vfs lib]

    puts "Looking for critcl in $cp"

    # Access to critcl library from a local unwrapped critcl app.
    lappend auto_path $cp
    package require critcl 2

    puts "Got:           [package ifneeded critcl [package present critcl]]"

    # Directly access the crimp package
    source         [file join $dir crimp.tcl]

    # and then force the compilation and loading of the C-level
    # primitives, instead of defering until use.
    critcl::cbuild [file join $dir crimp.tcl]

    puts "Using dynamically compiled crimp package"
}

puts "Starting up ..."

# # ## ### ##### ######## #############
## Definitions to help with timing ...

proc s {usec} { expr {double($usec)/1e6} }

# # ## ### ##### ######## #############
## Time an operation

foreach image $argv {
    puts ""
    puts "[file tail $image]:"

    set sz [file size $image]

    set usec [lindex [time {
	set data [fileutil::cat -translation binary $image]
    }] 0]

    puts ""
    puts "R\t$usec microseconds to read $sz bytes"
    puts "\t[s $usec] seconds to read $sz bytes"
    puts "\t[expr {double($usec)/$sz}] microseconds/byte"

    set usec [lindex [time {
	set image [crimp read pgm $data]
    }] 0]

    puts ""
    puts "C\t$usec microseconds to convert $sz bytes"
    puts "\t[s $usec] seconds to convert $sz bytes"
    puts "\t[expr {double($usec)/$sz}] microseconds/byte"

    set npixels [expr {[crimp width $image] * [crimp height $image]}]

    puts ""
    puts "\t$usec microseconds to convert $npixels pixels"
    puts "\t[s $usec] seconds to convert $npixels pixels"
    puts "\t[expr {double($usec)/$npixels}] microseconds/pixel"

    set usec [lindex [time {
	set stats [crimp statistics basic $image]
    }] 0]

    puts ""
    puts "S\t$usec microseconds for statistics of $npixels pixels"
    puts "\t[s $usec] seconds for statistics of $npixels pixels"
    puts "\t[expr {double($usec)/$npixels}] microseconds/pixel"

    unset image
}

# # ## ### ##### ######## #############
# # ## ### ##### ######## #############
# # ## ### ##### ######## #############
exit
# vim: set sts=4 sw=4 tw=80 et ft=tcl:






Added tools/makedoc.sh.
















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#!/bin/sh
# tools
# % generate the embedded documentation.
# % the images required by it as well.

# 1. math formulas               -> png	/requires mimetex + imagemagick convert.
# 2. tklib/diagram based figures -> png	/requires tklib dia application.
# 3. html + images from the doctools
# 4. nroff from the doctools

(   cd doc
    (   cd figures
	(   cd math
	    echo ___ MATH _________
	    rm -rf *.png
	    for figure in *.txt ; do
		echo $figure

		mimetex -f $figure -e $$.gif
		convert $$.gif $(basename $figure .txt).png
		rm $$.gif
	    done
	)
	echo ___ DIA _________
	dia convert -t -o . png *.dia
    )

    echo ___ MAN _________
    rm -rf     ../embedded/man
    mkdir      ../embedded/man
    dtplite -ext n -o ../embedded/man nroff .

    echo ___ WWW _________
    rm -rf     ../embedded/www
    mkdir      ../embedded/www
    dtplite -o ../embedded/www html  .
)

echo ___ MAN /show _________
less embedded/man/files/crimp.n

exit






Deleted wavy.crimp.





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














































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

wavy
Tcl_Obj* imageObj float offset float adj1 float adj2

int w, h;
unsigned char *pixels;
if (decodeImageObj(interp, imageObj, &w, &h, &pixels) != TCL_OK) {
    return TCL_ERROR;
}

Tcl_Obj *dataObj = Tcl_NewByteArrayObj(NULL, 4 * w * h);
unsigned char (*in)[h][w][4] = (unsigned char (*)[h][w][4])pixels;
unsigned char (*out)[h][w][4] = (unsigned char (*)[h][w][4])
        Tcl_GetByteArrayFromObj(dataObj, NULL);

int oy, ox, c, iy, ix;
for (oy = 0; oy < h; ++oy) {
    for (ox = 0; ox < w; ++ox) {
        float r = sinf(
            hypotf(oy - h / 2, ox - w / 2) * adj1 / w + offset) / adj2 + 1;
        float iyf = (oy - h / 2) * r + h / 2;
        float ixf = (ox - w / 2) * r + w / 2;
        int iyw = iyf;
        int ixw = ixf;
        iyf -= iyw;
        ixf -= ixw;
        for (c = 0; c < 4; ++c) {
            float val = 0;
            for (iy = MAX(iyw, 0); iy < MIN(iyw + 2, h); ++iy) {
                iyf = 1 - iyf;
                for (ix = MAX(ixw, 0); ix < MIN(ixw + 2, w); ++ix) {
                    ixf = 1 - ixf;
                    val += (*in)[iy][ix][c] * iyf * ixf;
                }
            }
            (*out)[oy][ox][c] = val;
        }
    }
}

Tcl_Obj *list[] = {Tcl_NewIntObj(w), Tcl_NewIntObj(h), dataObj};
Tcl_SetObjResult(interp, Tcl_NewListObj(3, list));
return TCL_OK;

/* vim: set sts=4 sw=4 tw=80 et ft=c: */






Added writer/w_pfm.tcl.


















































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# -*- tcl -*- 
# # ## ### ##### ######## #############
# Writing images as portable float map, in analogy to Portable Grey Maps, aka PGM.
# See http://en.wikipedia.org/wiki/Netpbm_format
# The type codes used for PFM are FAKE, i.e. made up.

namespace eval ::crimp {}

proc ::crimp::writes_pfm-plain_float {image} {
    # assert TypeOf (image) == float
    set res "F2 [crimp dimensions $image]"

    binary scan [crimp pixel $image] f* values
    foreach v $values {
	append res " " $v
    }
    return $res
}

proc ::crimp::writes_pfm-raw_float {image} {
    # assert TypeOf (image) == float
    return "F5 [crimp dimensions $image] [crimp pixel $image]"
}

proc ::crimp::writec_pfm-plain_float {chan image} {
    # assert TypeOf (image) == float
    puts -nonewline $chan "F2 [crimp dimensions $image] "

    binary scan [crimp pixel $image] f* values
    foreach v $values {
	puts -nonewline $chan " $v"
    }
    return
}

proc ::crimp::writec_pfm-raw_float {chan image} {
    # assert TypeOf (image) == float
    puts -nonewline $chan "F5 [crimp dimensions $image] "
    puts -nonewline $chan [crimp pixel $image]
    return
}

# # ## ### ##### ######## #############
return






Added writer/w_pgm.tcl.
























































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# -*- tcl -*- 
# # ## ### ##### ######## #############
# Writing images in the PGM format (Portable Grey Map).
# See http://en.wikipedia.org/wiki/Netpbm_format

namespace eval ::crimp {}

proc ::crimp::writes_pgm-plain_grey8 {image} {
    # assert TypeOf (image) == grey8
    set res "P2 [crimp dimensions $image] 255"
    foreach c [::split [crimp pixel $image] {}] {
	binary scan $c cu g
	append res " " $g
    }
    return $res
}

proc ::crimp::writes_pgm-raw_grey8 {image} {
    # assert TypeOf (image) == grey8
    return "P5 [crimp dimensions $image] 255 [crimp pixel $image]"
}

proc ::crimp::writec_pgm-plain_grey8 {chan image} {
    # assert TypeOf (image) == grey8
    puts -nonewline $chan "P2 [crimp dimensions $image] 255"
    foreach c [::split [crimp pixel $image] {}] {
	binary scan $c cu g
	puts -nonewline $chan " $g"
    }
    puts $chan ""
    return
}

proc ::crimp::writec_pgm-raw_grey8 {chan image} {
    # assert TypeOf (image) == grey8
    puts -nonewline $chan "P5 [crimp dimensions $image] 255 "
    puts -nonewline $chan [crimp pixel $image]
    return
}

# # ## ### ##### ######## #############

proc ::crimp::writes_pgm-plain_rgb {image} {
    # assert TypeOf (image) == rgb
    return [writes_pgm-plain_grey8 [crimp convert 2grey8 $image]]
}

proc ::crimp::writes_pgm-raw_rgb {image} {
    # assert TypeOf (image) == rgb
    return [writes_pgm-raw_grey8 [crimp convert 2grey8 $image]]
}

proc ::crimp::writec_pgm-plain_rgb {chan image} {
    # assert TypeOf (image) == rgb
    writec_pgm-plain_grey8 $chan [crimp convert 2grey8 $image]
    return
}

proc ::crimp::writec_pgm-raw_rgb {chan image} {
    # assert TypeOf (image) == rgb
    writec_pgm-raw_grey8 $chan [crimp convert 2grey8 $image]
    return
}

# # ## ### ##### ######## #############

proc ::crimp::writes_pgm-plain_rgba {image} {
    # assert TypeOf (image) == rgba
    return [writes_pgm-plain_grey8 [crimp convert 2grey8 $image]]
}

proc ::crimp::writes_pgm-raw_rgba {image} {
    # assert TypeOf (image) == rgba
    return [writes_pgm-raw_grey8 [crimp convert 2grey8 $image]]
}

proc ::crimp::writec_pgm-plain_rgba {chan image} {
    # assert TypeOf (image) == rgba
    writec_pgm-plain_grey8 $chan [crimp convert 2grey8 $image]
    return
}

proc ::crimp::writec_pgm-raw_rgba {chan image} {
    # assert TypeOf (image) == rgba
    writec_pgm-raw_grey8 $chan [crimp convert 2grey8 $image]
    return
}

# # ## ### ##### ######## #############

proc ::crimp::writes_pgm-plain_hsv {image} {
    # assert TypeOf (image) == hsv
    return [writes_pgm-plain_grey8 [crimp convert 2grey8 [crimp convert 2rgb $image]]]
}

proc ::crimp::writes_pgm-raw_hsv {image} {
    # assert TypeOf (image) == hsv
    return [writes_pgm-raw_grey8 [crimp convert 2grey8 [crimp convert 2rgb $image]]]
}

proc ::crimp::writec_pgm-plain_hsv {chan image} {
    # assert TypeOf (image) == hsv
    writec_pgm-plain_grey8 $chan [crimp convert 2grey8 [crimp convert 2rgb $image]]
    return
}

proc ::crimp::writec_pgm-raw_hsv {chan image} {
    # assert TypeOf (image) == hsv
    writec_pgm-raw_grey8 $chan [crimp convert 2grey8 [crimp convert 2rgb $image]]
    return
}

# # ## ### ##### ######## #############
return






Added writer/w_ppm.tcl.























































































































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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# -*- tcl -*- 
# # ## ### ##### ######## #############
# Writing images in the PPM format (Portable Pix Map).
# See http://en.wikipedia.org/wiki/Netpbm_format

namespace eval ::crimp {}

proc ::crimp::writes_ppm-plain_rgb {image} {
    # assert TypeOf (image) == rgb
    set res "P3 [crimp dimensions $image] 255"
    foreach c [::split [crimp pixel $image] {}] {
	binary scan $c cu g
	append res " " $g
    }
    return $res
}

proc ::crimp::writes_ppm-raw_rgb {image} {
    # assert TypeOf (image) == rgb
    return "P6 [crimp dimensions $image] 255 [crimp pixel $image]"
}

proc ::crimp::writec_ppm-plain_rgb {chan image} {
    # assert TypeOf (image) == rgb
    puts -nonewline $chan "P3 [crimp dimensions $image] 255"
    foreach c [::split [crimp pixel $image] {}] {
	binary scan $c cu g
	puts -nonewline $chan " $g"
    }
    return
}

proc ::crimp::writec_ppm-raw_rgb {chan image} {
    # assert TypeOf (image) == rgb
    puts -nonewline $chan "P6 [crimp dimensions $image] 255 "
    puts -nonewline $chan [crimp pixel $image]
    return
}

# # ## ### ##### ######## #############

proc ::crimp::writes_ppm-plain_rgba {image} {
    # assert TypeOf (image) == rgba
    return [writes_ppm-plain_rgb [crimp convert 2rgb $image]]
}

proc ::crimp::writes_ppm-raw_rgba {image} {
    # assert TypeOf (image) == rgba
    return [writes_ppm-raw_rgb [crimp convert 2rgb $image]]
}

proc ::crimp::writec_ppm-plain_rgba {chan image} {
    # assert TypeOf (image) == rgba
    writec_ppm-plain_rgb $chan [crimp convert 2rgb $image]
    return
}

proc ::crimp::writec_ppm-raw_rgba {chan image} {
    # assert TypeOf (image) == rgba
    writec_ppm-raw_rgb $chan [crimp convert 2rgb $image]
    return
}

# # ## ### ##### ######## #############

proc ::crimp::writes_ppm-plain_hsv {image} {
    # assert TypeOf (image) == hsv
    return [writes_ppm-plain_rgb [crimp convert 2rgb $image]]
}

proc ::crimp::writes_ppm-raw_hsv {image} {
    # assert TypeOf (image) == hsv
    return [writes_ppm-raw_rgb [crimp convert 2rgb $image]]
}

proc ::crimp::writec_ppm-plain_hsv {chan image} {
    # assert TypeOf (image) == hsv
    writec_ppm-plain_rgb $chan [crimp convert 2rgb $image]
    return
}

proc ::crimp::writec_ppm-raw_hsv {chan image} {
    # assert TypeOf (image) == hsv
    writec_ppm-raw_rgb $chan [crimp convert 2rgb $image]
    return
}

# # ## ### ##### ######## #############

proc ::crimp::writes_ppm-plain_grey8 {image} {
    # assert TypeOf (image) == grey8
    return [writes_ppm-plain_rgb [crimp convert 2rgb $image]]
}

proc ::crimp::writes_ppm-raw_grey8 {image} {
    # assert TypeOf (image) == grey8
    return [writes_ppm-raw_rgb [crimp convert 2rgb $image]]
}

proc ::crimp::writec_ppm-plain_grey8 {chan image} {
    # assert TypeOf (image) == grey8
    writec_ppm-plain_rgb $chan [crimp convert 2rgb $image]
    return
}

proc ::crimp::writec_ppm-raw_grey8 {chan image} {
    # assert TypeOf (image) == grey8
    writec_ppm-raw_rgb $chan [crimp convert 2rgb $image]
    return
}

# # ## ### ##### ######## #############
return