ADDED NOTES.txt Index: NOTES.txt ================================================================== --- /dev/null +++ NOTES.txt @@ -0,0 +1,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 Index: brew ================================================================== --- /dev/null +++ brew @@ -0,0 +1,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 Index: c/ahe.c ================================================================== --- /dev/null +++ c/ahe.c @@ -0,0 +1,62 @@ +/* + * CRIMP :: AHE Definitions (Implementation). + * (C) 2010. + */ + +/* + * Import declarations. + */ + +#include + +/* + * 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]) + * = max - sum (k > value,histogram[k]) + * + * 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 Index: c/ahe.h ================================================================== --- /dev/null +++ c/ahe.h @@ -0,0 +1,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 Index: c/color.c ================================================================== --- /dev/null +++ c/color.c @@ -0,0 +1,189 @@ +/* + * CRIMP :: Color Conversions (Implementation). + * (C) 2010. + */ + +/* + * Import declarations. + */ + +#include +#include + +/* + * 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 Index: c/color.h ================================================================== --- /dev/null +++ c/color.h @@ -0,0 +1,38 @@ +#ifndef CRIMP_COLOR_H +#define CRIMP_COLOR_H +/* + * CRIMP :: Color Conversion Declarations, and API. + * (C) 2010. + */ + +#include + +/* + * 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 Index: c/fftpack/README ================================================================== --- /dev/null +++ c/fftpack/README @@ -0,0 +1,1 @@ +The .c files generated via % f2c -a *.f ADDED c/fftpack/cfftb.c Index: c/fftpack/cfftb.c ================================================================== --- /dev/null +++ c/fftpack/cfftb.c @@ -0,0 +1,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 Index: c/fftpack/cfftb.f ================================================================== --- /dev/null +++ c/fftpack/cfftb.f @@ -0,0 +1,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 Index: c/fftpack/cfftb1.c ================================================================== --- /dev/null +++ c/fftpack/cfftb1.c @@ -0,0 +1,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 Index: c/fftpack/cfftb1.f ================================================================== --- /dev/null +++ c/fftpack/cfftb1.f @@ -0,0 +1,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 Index: c/fftpack/cfftf.c ================================================================== --- /dev/null +++ c/fftpack/cfftf.c @@ -0,0 +1,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 Index: c/fftpack/cfftf.f ================================================================== --- /dev/null +++ c/fftpack/cfftf.f @@ -0,0 +1,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 Index: c/fftpack/cfftf1.c ================================================================== --- /dev/null +++ c/fftpack/cfftf1.c @@ -0,0 +1,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 Index: c/fftpack/cfftf1.f ================================================================== --- /dev/null +++ c/fftpack/cfftf1.f @@ -0,0 +1,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 Index: c/fftpack/cffti.c ================================================================== --- /dev/null +++ c/fftpack/cffti.c @@ -0,0 +1,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 Index: c/fftpack/cffti.f ================================================================== --- /dev/null +++ c/fftpack/cffti.f @@ -0,0 +1,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 Index: c/fftpack/cffti1.c ================================================================== --- /dev/null +++ c/fftpack/cffti1.c @@ -0,0 +1,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 Index: c/fftpack/cffti1.f ================================================================== --- /dev/null +++ c/fftpack/cffti1.f @@ -0,0 +1,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 Index: c/fftpack/cosqb.c ================================================================== --- /dev/null +++ c/fftpack/cosqb.c @@ -0,0 +1,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 Index: c/fftpack/cosqb.f ================================================================== --- /dev/null +++ c/fftpack/cosqb.f @@ -0,0 +1,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 Index: c/fftpack/cosqb1.c ================================================================== --- /dev/null +++ c/fftpack/cosqb1.c @@ -0,0 +1,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 Index: c/fftpack/cosqb1.f ================================================================== --- /dev/null +++ c/fftpack/cosqb1.f @@ -0,0 +1,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 Index: c/fftpack/cosqf.c ================================================================== --- /dev/null +++ c/fftpack/cosqf.c @@ -0,0 +1,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 Index: c/fftpack/cosqf.f ================================================================== --- /dev/null +++ c/fftpack/cosqf.f @@ -0,0 +1,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 Index: c/fftpack/cosqf1.c ================================================================== --- /dev/null +++ c/fftpack/cosqf1.c @@ -0,0 +1,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 Index: c/fftpack/cosqf1.f ================================================================== --- /dev/null +++ c/fftpack/cosqf1.f @@ -0,0 +1,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 Index: c/fftpack/cosqi.c ================================================================== --- /dev/null +++ c/fftpack/cosqi.c @@ -0,0 +1,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 Index: c/fftpack/cosqi.f ================================================================== --- /dev/null +++ c/fftpack/cosqi.f @@ -0,0 +1,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 Index: c/fftpack/cost.c ================================================================== --- /dev/null +++ c/fftpack/cost.c @@ -0,0 +1,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 Index: c/fftpack/cost.f ================================================================== --- /dev/null +++ c/fftpack/cost.f @@ -0,0 +1,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 Index: c/fftpack/costi.c ================================================================== --- /dev/null +++ c/fftpack/costi.c @@ -0,0 +1,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 Index: c/fftpack/costi.f ================================================================== --- /dev/null +++ c/fftpack/costi.f @@ -0,0 +1,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 Index: c/fftpack/doc.txt ================================================================== --- /dev/null +++ c/fftpack/doc.txt @@ -0,0 +1,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 Index: c/fftpack/ezfft1.c ================================================================== --- /dev/null +++ c/fftpack/ezfft1.c @@ -0,0 +1,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 Index: c/fftpack/ezfft1.f ================================================================== --- /dev/null +++ c/fftpack/ezfft1.f @@ -0,0 +1,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 Index: c/fftpack/ezfftb.c ================================================================== --- /dev/null +++ c/fftpack/ezfftb.c @@ -0,0 +1,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 Index: c/fftpack/ezfftb.f ================================================================== --- /dev/null +++ c/fftpack/ezfftb.f @@ -0,0 +1,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 Index: c/fftpack/ezfftf.c ================================================================== --- /dev/null +++ c/fftpack/ezfftf.c @@ -0,0 +1,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 Index: c/fftpack/ezfftf.f ================================================================== --- /dev/null +++ c/fftpack/ezfftf.f @@ -0,0 +1,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 Index: c/fftpack/ezffti.c ================================================================== --- /dev/null +++ c/fftpack/ezffti.c @@ -0,0 +1,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 Index: c/fftpack/ezffti.f ================================================================== --- /dev/null +++ c/fftpack/ezffti.f @@ -0,0 +1,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 Index: c/fftpack/f2c.h ================================================================== --- /dev/null +++ c/fftpack/f2c.h @@ -0,0 +1,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 Index: c/fftpack/passb.c ================================================================== --- /dev/null +++ c/fftpack/passb.c @@ -0,0 +1,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 Index: c/fftpack/passb.f ================================================================== --- /dev/null +++ c/fftpack/passb.f @@ -0,0 +1,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 Index: c/fftpack/passb2.c ================================================================== --- /dev/null +++ c/fftpack/passb2.c @@ -0,0 +1,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 Index: c/fftpack/passb2.f ================================================================== --- /dev/null +++ c/fftpack/passb2.f @@ -0,0 +1,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 Index: c/fftpack/passb3.c ================================================================== --- /dev/null +++ c/fftpack/passb3.c @@ -0,0 +1,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 Index: c/fftpack/passb3.f ================================================================== --- /dev/null +++ c/fftpack/passb3.f @@ -0,0 +1,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 Index: c/fftpack/passb4.c ================================================================== --- /dev/null +++ c/fftpack/passb4.c @@ -0,0 +1,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 Index: c/fftpack/passb4.f ================================================================== --- /dev/null +++ c/fftpack/passb4.f @@ -0,0 +1,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 Index: c/fftpack/passb5.c ================================================================== --- /dev/null +++ c/fftpack/passb5.c @@ -0,0 +1,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 Index: c/fftpack/passb5.f ================================================================== --- /dev/null +++ c/fftpack/passb5.f @@ -0,0 +1,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 Index: c/fftpack/passf.c ================================================================== --- /dev/null +++ c/fftpack/passf.c @@ -0,0 +1,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 Index: c/fftpack/passf.f ================================================================== --- /dev/null +++ c/fftpack/passf.f @@ -0,0 +1,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 Index: c/fftpack/passf2.c ================================================================== --- /dev/null +++ c/fftpack/passf2.c @@ -0,0 +1,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 Index: c/fftpack/passf2.f ================================================================== --- /dev/null +++ c/fftpack/passf2.f @@ -0,0 +1,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 Index: c/fftpack/passf3.c ================================================================== --- /dev/null +++ c/fftpack/passf3.c @@ -0,0 +1,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 Index: c/fftpack/passf3.f ================================================================== --- /dev/null +++ c/fftpack/passf3.f @@ -0,0 +1,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 Index: c/fftpack/passf4.c ================================================================== --- /dev/null +++ c/fftpack/passf4.c @@ -0,0 +1,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 Index: c/fftpack/passf4.f ================================================================== --- /dev/null +++ c/fftpack/passf4.f @@ -0,0 +1,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 Index: c/fftpack/passf5.c ================================================================== --- /dev/null +++ c/fftpack/passf5.c @@ -0,0 +1,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 Index: c/fftpack/passf5.f ================================================================== --- /dev/null +++ c/fftpack/passf5.f @@ -0,0 +1,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 Index: c/fftpack/radb2.c ================================================================== --- /dev/null +++ c/fftpack/radb2.c @@ -0,0 +1,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 Index: c/fftpack/radb2.f ================================================================== --- /dev/null +++ c/fftpack/radb2.f @@ -0,0 +1,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 Index: c/fftpack/radb3.c ================================================================== --- /dev/null +++ c/fftpack/radb3.c @@ -0,0 +1,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 Index: c/fftpack/radb3.f ================================================================== --- /dev/null +++ c/fftpack/radb3.f @@ -0,0 +1,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 Index: c/fftpack/radb4.c ================================================================== --- /dev/null +++ c/fftpack/radb4.c @@ -0,0 +1,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 Index: c/fftpack/radb4.f ================================================================== --- /dev/null +++ c/fftpack/radb4.f @@ -0,0 +1,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 Index: c/fftpack/radb5.c ================================================================== --- /dev/null +++ c/fftpack/radb5.c @@ -0,0 +1,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 Index: c/fftpack/radb5.f ================================================================== --- /dev/null +++ c/fftpack/radb5.f @@ -0,0 +1,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 Index: c/fftpack/radbg.c ================================================================== --- /dev/null +++ c/fftpack/radbg.c @@ -0,0 +1,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 Index: c/fftpack/radbg.f ================================================================== --- /dev/null +++ c/fftpack/radbg.f @@ -0,0 +1,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 Index: c/fftpack/radf2.c ================================================================== --- /dev/null +++ c/fftpack/radf2.c @@ -0,0 +1,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 Index: c/fftpack/radf2.f ================================================================== --- /dev/null +++ c/fftpack/radf2.f @@ -0,0 +1,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 Index: c/fftpack/radf3.c ================================================================== --- /dev/null +++ c/fftpack/radf3.c @@ -0,0 +1,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 Index: c/fftpack/radf3.f ================================================================== --- /dev/null +++ c/fftpack/radf3.f @@ -0,0 +1,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 Index: c/fftpack/radf4.c ================================================================== --- /dev/null +++ c/fftpack/radf4.c @@ -0,0 +1,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 Index: c/fftpack/radf4.f ================================================================== --- /dev/null +++ c/fftpack/radf4.f @@ -0,0 +1,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 Index: c/fftpack/radf5.c ================================================================== --- /dev/null +++ c/fftpack/radf5.c @@ -0,0 +1,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 Index: c/fftpack/radf5.f ================================================================== --- /dev/null +++ c/fftpack/radf5.f @@ -0,0 +1,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 Index: c/fftpack/radfg.c ================================================================== --- /dev/null +++ c/fftpack/radfg.c @@ -0,0 +1,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 Index: c/fftpack/radfg.f ================================================================== --- /dev/null +++ c/fftpack/radfg.f @@ -0,0 +1,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 Index: c/fftpack/rfftb.c ================================================================== --- /dev/null +++ c/fftpack/rfftb.c @@ -0,0 +1,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 Index: c/fftpack/rfftb.f ================================================================== --- /dev/null +++ c/fftpack/rfftb.f @@ -0,0 +1,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 Index: c/fftpack/rfftb1.c ================================================================== --- /dev/null +++ c/fftpack/rfftb1.c @@ -0,0 +1,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 Index: c/fftpack/rfftb1.f ================================================================== --- /dev/null +++ c/fftpack/rfftb1.f @@ -0,0 +1,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 Index: c/fftpack/rfftf.c ================================================================== --- /dev/null +++ c/fftpack/rfftf.c @@ -0,0 +1,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 Index: c/fftpack/rfftf.f ================================================================== --- /dev/null +++ c/fftpack/rfftf.f @@ -0,0 +1,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 Index: c/fftpack/rfftf1.c ================================================================== --- /dev/null +++ c/fftpack/rfftf1.c @@ -0,0 +1,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 Index: c/fftpack/rfftf1.f ================================================================== --- /dev/null +++ c/fftpack/rfftf1.f @@ -0,0 +1,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 Index: c/fftpack/rffti.c ================================================================== --- /dev/null +++ c/fftpack/rffti.c @@ -0,0 +1,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 Index: c/fftpack/rffti.f ================================================================== --- /dev/null +++ c/fftpack/rffti.f @@ -0,0 +1,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 Index: c/fftpack/rffti1.c ================================================================== --- /dev/null +++ c/fftpack/rffti1.c @@ -0,0 +1,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 Index: c/fftpack/rffti1.f ================================================================== --- /dev/null +++ c/fftpack/rffti1.f @@ -0,0 +1,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 Index: c/fftpack/sinqb.c ================================================================== --- /dev/null +++ c/fftpack/sinqb.c @@ -0,0 +1,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 Index: c/fftpack/sinqb.f ================================================================== --- /dev/null +++ c/fftpack/sinqb.f @@ -0,0 +1,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 Index: c/fftpack/sinqf.c ================================================================== --- /dev/null +++ c/fftpack/sinqf.c @@ -0,0 +1,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 Index: c/fftpack/sinqf.f ================================================================== --- /dev/null +++ c/fftpack/sinqf.f @@ -0,0 +1,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 Index: c/fftpack/sinqi.c ================================================================== --- /dev/null +++ c/fftpack/sinqi.c @@ -0,0 +1,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 Index: c/fftpack/sinqi.f ================================================================== --- /dev/null +++ c/fftpack/sinqi.f @@ -0,0 +1,5 @@ + SUBROUTINE SINQI (N,WSAVE) + DIMENSION WSAVE(1) + CALL COSQI (N,WSAVE) + RETURN + END ADDED c/fftpack/sint.c Index: c/fftpack/sint.c ================================================================== --- /dev/null +++ c/fftpack/sint.c @@ -0,0 +1,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 Index: c/fftpack/sint.f ================================================================== --- /dev/null +++ c/fftpack/sint.f @@ -0,0 +1,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 Index: c/fftpack/sint1.c ================================================================== --- /dev/null +++ c/fftpack/sint1.c @@ -0,0 +1,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 Index: c/fftpack/sint1.f ================================================================== --- /dev/null +++ c/fftpack/sint1.f @@ -0,0 +1,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 Index: c/fftpack/sinti.c ================================================================== --- /dev/null +++ c/fftpack/sinti.c @@ -0,0 +1,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 Index: c/fftpack/sinti.f ================================================================== --- /dev/null +++ c/fftpack/sinti.f @@ -0,0 +1,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 Index: c/fftpack/test.c ================================================================== --- /dev/null +++ c/fftpack/test.c @@ -0,0 +1,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 Index: c/fftpack/test.f ================================================================== --- /dev/null +++ c/fftpack/test.f @@ -0,0 +1,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 Index: c/geometry.c ================================================================== --- /dev/null +++ c/geometry.c @@ -0,0 +1,106 @@ +/* + * CRIMP :: Geometry Definitions (Implementation). + * (C) 2010. + */ + +/* + * Import declarations. + */ + +#include +#include + +/* + * 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 Index: c/geometry.h ================================================================== --- /dev/null +++ c/geometry.h @@ -0,0 +1,27 @@ +#ifndef CRIMP_GEOMETRY_H +#define CRIMP_GEOMETRY_H +/* + * CRIMP :: Declarations for the functions handling points, vectors, + * and matrices. + * (C) 2010. + */ + +#include + +/* + * 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 Index: c/image.c ================================================================== --- /dev/null +++ c/image.c @@ -0,0 +1,321 @@ +/* + * CRIMP :: Image Definitions (Implementation). + * (C) 2010. + */ + +/* + * Import declarations. + */ + +#include +#include +#include +#include +#include /* 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 Index: c/image.h ================================================================== --- /dev/null +++ c/image.h @@ -0,0 +1,186 @@ +#ifndef CRIMP_IMAGE_H +#define CRIMP_IMAGE_H +/* + * CRIMP :: Image Declarations, and API. + * (C) 2010. + */ + +#include +#include + +/* + * 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 Index: c/image_type.c ================================================================== --- /dev/null +++ c/image_type.c @@ -0,0 +1,218 @@ +/* + * CRIMP :: Image Type Definitions (Implementation). + * (C) 2010. + */ + +/* + * Import declarations. + */ + +#include +#include +#include +#include + +/* + * 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 Index: c/image_type.h ================================================================== --- /dev/null +++ c/image_type.h @@ -0,0 +1,52 @@ +#ifndef CRIMP_IMAGE_TYPE_H +#define CRIMP_IMAGE_TYPE_H +/* + * CRIMP :: Image Type Declarations, and API. + * (C) 2010. + */ + +#include + +/* + * 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 Index: c/linearalgebra.c ================================================================== --- /dev/null +++ c/linearalgebra.c @@ -0,0 +1,148 @@ +/* + * CRIMP :: Linear algebra Definitions (Implementation). + * (C) 2010. + */ + +/* + * Import declarations. + */ + +#include + +/* + * 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 Index: c/linearalgebra.h ================================================================== --- /dev/null +++ c/linearalgebra.h @@ -0,0 +1,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 + +/* + * 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 Index: c/rank.c ================================================================== --- /dev/null +++ c/rank.c @@ -0,0 +1,36 @@ +/* + * CRIMP :: Rank Definitions (Implementation). + * (C) 2010. + */ + +/* + * Import declarations. + */ + +#include + +/* + * 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 Index: c/rank.h ================================================================== --- /dev/null +++ c/rank.h @@ -0,0 +1,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 Index: c/util.h ================================================================== --- /dev/null +++ c/util.h @@ -0,0 +1,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 Index: c/volume.c ================================================================== --- /dev/null +++ c/volume.c @@ -0,0 +1,333 @@ +/* + * CRIMP :: Volume Definitions (Implementation). + * (C) 2010. + */ + +/* + * Import declarations. + */ + +#include +#include +#include +#include +#include +#include /* 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 Index: c/volume.h ================================================================== --- /dev/null +++ c/volume.h @@ -0,0 +1,84 @@ +#ifndef CRIMP_VOLUME_H +#define CRIMP_VOLUME_H +/* + * CRIMP :: Volume Declarations, and API. + * (C) 2010. + */ + +#include +#include + +/* + * 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 Index: conformer.png ================================================================== --- conformer.png +++ /dev/null cannot compute difference between binary files ADDED cop/binop_float_float.c Index: cop/binop_float_float.c ================================================================== --- /dev/null +++ cop/binop_float_float.c @@ -0,0 +1,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 Index: cop/binop_float_grey16.c ================================================================== --- /dev/null +++ cop/binop_float_grey16.c @@ -0,0 +1,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 Index: cop/binop_float_grey32.c ================================================================== --- /dev/null +++ cop/binop_float_grey32.c @@ -0,0 +1,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 Index: cop/binop_float_grey8.c ================================================================== --- /dev/null +++ cop/binop_float_grey8.c @@ -0,0 +1,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 Index: cop/binop_grey16_float.c ================================================================== --- /dev/null +++ cop/binop_grey16_float.c @@ -0,0 +1,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 Index: cop/binop_grey32_float.c ================================================================== --- /dev/null +++ cop/binop_grey32_float.c @@ -0,0 +1,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 Index: cop/binop_grey8_float.c ================================================================== --- /dev/null +++ cop/binop_grey8_float.c @@ -0,0 +1,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 Index: cop/binop_grey8_grey8.c ================================================================== --- /dev/null +++ cop/binop_grey8_grey8.c @@ -0,0 +1,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 Index: cop/binop_grey8_rgb.c ================================================================== --- /dev/null +++ cop/binop_grey8_rgb.c @@ -0,0 +1,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 Index: cop/binop_grey8_rgba.c ================================================================== --- /dev/null +++ cop/binop_grey8_rgba.c @@ -0,0 +1,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 Index: cop/binop_rgb_grey8.c ================================================================== --- /dev/null +++ cop/binop_rgb_grey8.c @@ -0,0 +1,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 Index: cop/binop_rgb_rgb.c ================================================================== --- /dev/null +++ cop/binop_rgb_rgb.c @@ -0,0 +1,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 Index: cop/binop_rgb_rgba.c ================================================================== --- /dev/null +++ cop/binop_rgb_rgba.c @@ -0,0 +1,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 Index: cop/binop_rgba_grey8.c ================================================================== --- /dev/null +++ cop/binop_rgba_grey8.c @@ -0,0 +1,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 Index: cop/binop_rgba_rgb.c ================================================================== --- /dev/null +++ cop/binop_rgba_rgb.c @@ -0,0 +1,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 Index: cop/binop_rgba_rgba.c ================================================================== --- /dev/null +++ cop/binop_rgba_rgba.c @@ -0,0 +1,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 Index: cop/expand_op.c ================================================================== --- /dev/null +++ cop/expand_op.c @@ -0,0 +1,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: + */ Index: crimp.tcl ================================================================== --- crimp.tcl +++ crimp.tcl @@ -1,101 +1,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] - -package require Tk +# -*- 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 critcl -proc take {varname} { - upvar 1 $varname var - return $var[set var ""] +if {![critcl::compiling]} { + error "Unable to build CRIMP, no proper compiler found." +} +#critcl::config keepsrc 1 + +# # ## ### ##### ######## ############# +## 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 #include #include - - #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)) - - static int decodeImageObj(Tcl_Interp *interp, Tcl_Obj *imageObj, int *width, - int *height, unsigned char **pixels) - { - int objc; - Tcl_Obj **objv; - if (Tcl_ListObjGetElements(interp, imageObj, &objc, &objv) != TCL_OK) { - return TCL_ERROR; - } else if (objc != 3) { - 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; - *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; - } - - 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; - } else if (Tcl_IsShared(*outputObj) || Tcl_IsShared(*dataObj)) { - *outputObj = Tcl_DuplicateObj(*outputObj); - *dataObj = Tcl_DuplicateObj(*dataObj); - Tcl_ListObjReplace(interp, *outputObj, 2, 1, 1, dataObj); - } - return TCL_OK; - } -} - -namespace eval crimp {namespace ensemble create} - -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\ - [namespace ensemble configure crimp -subcommands] [list $name]] - namespace eval ::crimp [list ::critcl::cproc $name $params ok $body] - close $chan -} - -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 + #include + #include + #include + #include + #include + #include + #include + #include + #include + #include + + /* Common declarations to access the FFT functions. */ + + extern int rffti_ (integer *n, real *wsave); + extern int rfftf_ (integer *n, real* r, real *wsave); + extern int rfftb_ (integer *n, real* r, real *wsave); +} + +# # ## ### ##### ######## ############# +## Read and execute all .crimp files in the current directory. + +::apply {{here} { + 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 eval ::crimp [list ::critcl::cproc $name $params ok $body] + } +}} [file dirname [file normalize [info script]]] + +# # ## ### ##### ######## ############# +## Make the C pieces ready. Force build of the binaries and check if ok. + +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 Index: crimp_tcl.tcl ================================================================== --- /dev/null +++ crimp_tcl.tcl @@ -0,0 +1,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 $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 % 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 Index: demos.tcl ================================================================== --- /dev/null +++ demos.tcl @@ -0,0 +1,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 <> show_selection + bind .ld <> show_demo + + # Panning via mouse + bind .c {%W scan mark %x %y} + bind .c {%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 <>} + return + after 100 { + .li selection set 0 + event generate .li <> + after 100 { + .ld selection set 0 + event generate .ld <> + } + } + return +} + +main +vwait forever +# vim: set sts=4 sw=4 tw=80 et ft=tcl: ADDED demos/add.tcl Index: demos/add.tcl ================================================================== --- /dev/null +++ demos/add.tcl @@ -0,0 +1,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 Index: demos/ahe.tcl ================================================================== --- /dev/null +++ demos/ahe.tcl @@ -0,0 +1,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 Index: demos/ahe_luma.tcl ================================================================== --- /dev/null +++ demos/ahe_luma.tcl @@ -0,0 +1,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 Index: demos/alpha.tcl ================================================================== --- /dev/null +++ demos/alpha.tcl @@ -0,0 +1,6 @@ +def rgba_alpha { + label Alpha + setup_image { + show_image [lindex [crimp split [base]] 3] + } +} ADDED demos/bilateral.tcl Index: demos/bilateral.tcl ================================================================== --- /dev/null +++ demos/bilateral.tcl @@ -0,0 +1,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 Index: demos/blank.tcl ================================================================== --- /dev/null +++ demos/blank.tcl @@ -0,0 +1,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 Index: demos/blend_cut.tcl ================================================================== --- /dev/null +++ demos/blend_cut.tcl @@ -0,0 +1,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 Index: demos/blend_hsv.tcl ================================================================== --- /dev/null +++ demos/blend_hsv.tcl @@ -0,0 +1,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 Index: demos/blend_rgb.tcl ================================================================== --- /dev/null +++ demos/blend_rgb.tcl @@ -0,0 +1,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 Index: demos/blue.tcl ================================================================== --- /dev/null +++ demos/blue.tcl @@ -0,0 +1,6 @@ +def rgba_blue { + label Blue + setup_image { + show_image [lindex [crimp split [base]] 2] + } +} ADDED demos/blue_tint.tcl Index: demos/blue_tint.tcl ================================================================== --- /dev/null +++ demos/blue_tint.tcl @@ -0,0 +1,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 Index: demos/chain_gauss_solarized.tcl ================================================================== --- /dev/null +++ demos/chain_gauss_solarized.tcl @@ -0,0 +1,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 Index: demos/charcoal.tcl ================================================================== --- /dev/null +++ demos/charcoal.tcl @@ -0,0 +1,6 @@ +def effect_charcoal { + label {Charcoal} + setup_image { + show_image [crimp morph gradient [crimp convert 2grey8 [base]]] + } +} ADDED demos/color_lms2.tcl Index: demos/color_lms2.tcl ================================================================== --- /dev/null +++ demos/color_lms2.tcl @@ -0,0 +1,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 Index: demos/color_xyz.tcl ================================================================== --- /dev/null +++ demos/color_xyz.tcl @@ -0,0 +1,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 Index: demos/color_xyz2.tcl ================================================================== --- /dev/null +++ demos/color_xyz2.tcl @@ -0,0 +1,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 Index: demos/contrast.tcl ================================================================== --- /dev/null +++ demos/contrast.tcl @@ -0,0 +1,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 Index: demos/convolve_blur_ulis.tcl ================================================================== --- /dev/null +++ demos/convolve_blur_ulis.tcl @@ -0,0 +1,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 Index: demos/convolve_box.tcl ================================================================== --- /dev/null +++ demos/convolve_box.tcl @@ -0,0 +1,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 Index: demos/convolve_crisp_ulis.tcl ================================================================== --- /dev/null +++ demos/convolve_crisp_ulis.tcl @@ -0,0 +1,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 Index: demos/convolve_edgeh.tcl ================================================================== --- /dev/null +++ demos/convolve_edgeh.tcl @@ -0,0 +1,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 Index: demos/convolve_edgehg.tcl ================================================================== --- /dev/null +++ demos/convolve_edgehg.tcl @@ -0,0 +1,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 Index: demos/convolve_edgehv.tcl ================================================================== --- /dev/null +++ demos/convolve_edgehv.tcl @@ -0,0 +1,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 Index: demos/convolve_edgehvg.tcl ================================================================== --- /dev/null +++ demos/convolve_edgehvg.tcl @@ -0,0 +1,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 Index: demos/convolve_edgev.tcl ================================================================== --- /dev/null +++ demos/convolve_edgev.tcl @@ -0,0 +1,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 Index: demos/convolve_edgevg.tcl ================================================================== --- /dev/null +++ demos/convolve_edgevg.tcl @@ -0,0 +1,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 Index: demos/convolve_emboss.tcl ================================================================== --- /dev/null +++ demos/convolve_emboss.tcl @@ -0,0 +1,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 Index: demos/convolve_emboss2.tcl ================================================================== --- /dev/null +++ demos/convolve_emboss2.tcl @@ -0,0 +1,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 Index: demos/convolve_gaussian.tcl ================================================================== --- /dev/null +++ demos/convolve_gaussian.tcl @@ -0,0 +1,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 Index: demos/convolve_gaussian_fp.tcl ================================================================== --- /dev/null +++ demos/convolve_gaussian_fp.tcl @@ -0,0 +1,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 Index: demos/convolve_laplace4.tcl ================================================================== --- /dev/null +++ demos/convolve_laplace4.tcl @@ -0,0 +1,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 Index: demos/convolve_laplace5.tcl ================================================================== --- /dev/null +++ demos/convolve_laplace5.tcl @@ -0,0 +1,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 Index: demos/convolve_laplace8.tcl ================================================================== --- /dev/null +++ demos/convolve_laplace8.tcl @@ -0,0 +1,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 Index: demos/convolve_laplace9.tcl ================================================================== --- /dev/null +++ demos/convolve_laplace9.tcl @@ -0,0 +1,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 Index: demos/convolve_laplacex.tcl ================================================================== --- /dev/null +++ demos/convolve_laplacex.tcl @@ -0,0 +1,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 Index: demos/convolve_laplacex1.tcl ================================================================== --- /dev/null +++ demos/convolve_laplacex1.tcl @@ -0,0 +1,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 Index: demos/convolve_pseudoedge.tcl ================================================================== --- /dev/null +++ demos/convolve_pseudoedge.tcl @@ -0,0 +1,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 Index: demos/convolve_sobelh.tcl ================================================================== --- /dev/null +++ demos/convolve_sobelh.tcl @@ -0,0 +1,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 Index: demos/convolve_sobelhg.tcl ================================================================== --- /dev/null +++ demos/convolve_sobelhg.tcl @@ -0,0 +1,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 Index: demos/convolve_sobelhv.tcl ================================================================== --- /dev/null +++ demos/convolve_sobelhv.tcl @@ -0,0 +1,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 Index: demos/convolve_sobelhvg.tcl ================================================================== --- /dev/null +++ demos/convolve_sobelhvg.tcl @@ -0,0 +1,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 Index: demos/convolve_sobelhvgm.tcl ================================================================== --- /dev/null +++ demos/convolve_sobelhvgm.tcl @@ -0,0 +1,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 Index: demos/convolve_sobelhvm.tcl ================================================================== --- /dev/null +++ demos/convolve_sobelhvm.tcl @@ -0,0 +1,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 Index: demos/convolve_sobelv.tcl ================================================================== --- /dev/null +++ demos/convolve_sobelv.tcl @@ -0,0 +1,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 Index: demos/convolve_sobelvg.tcl ================================================================== --- /dev/null +++ demos/convolve_sobelvg.tcl @@ -0,0 +1,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 Index: demos/crop.tcl ================================================================== --- /dev/null +++ demos/crop.tcl @@ -0,0 +1,6 @@ +def crop { + label {Crop} + setup_image { + show_image [crimp crop [base] 50 50 50 50] + } +} ADDED demos/cut.tcl Index: demos/cut.tcl ================================================================== --- /dev/null +++ demos/cut.tcl @@ -0,0 +1,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 Index: demos/decimate2.tcl ================================================================== --- /dev/null +++ demos/decimate2.tcl @@ -0,0 +1,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 Index: demos/decimate4.tcl ================================================================== --- /dev/null +++ demos/decimate4.tcl @@ -0,0 +1,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 Index: demos/decint.tcl ================================================================== --- /dev/null +++ demos/decint.tcl @@ -0,0 +1,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 Index: demos/degamma.tcl ================================================================== --- /dev/null +++ demos/degamma.tcl @@ -0,0 +1,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 Index: demos/difference.tcl ================================================================== --- /dev/null +++ demos/difference.tcl @@ -0,0 +1,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 Index: demos/downsample2.tcl ================================================================== --- /dev/null +++ demos/downsample2.tcl @@ -0,0 +1,6 @@ +def op_downsample2 { + label Downsample\u21932 + setup_image { + show_image [crimp downsample xy [base] 2] + } +} ADDED demos/downsample3.tcl Index: demos/downsample3.tcl ================================================================== --- /dev/null +++ demos/downsample3.tcl @@ -0,0 +1,6 @@ +def op_downsample3 { + label Downsample\u21933 + setup_image { + show_image [crimp downsample xy [base] 3] + } +} ADDED demos/downsample4.tcl Index: demos/downsample4.tcl ================================================================== --- /dev/null +++ demos/downsample4.tcl @@ -0,0 +1,6 @@ +def op_downsample4 { + label Downsample\u21934 + setup_image { + show_image [crimp::downsample xy [base] 4] + } +} ADDED demos/equalize_hsv.tcl Index: demos/equalize_hsv.tcl ================================================================== --- /dev/null +++ demos/equalize_hsv.tcl @@ -0,0 +1,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 Index: demos/equalize_hsv_simple.tcl ================================================================== --- /dev/null +++ demos/equalize_hsv_simple.tcl @@ -0,0 +1,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 Index: demos/equalize_luma.tcl ================================================================== --- /dev/null +++ demos/equalize_luma.tcl @@ -0,0 +1,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 Index: demos/equalize_luma_simple.tcl ================================================================== --- /dev/null +++ demos/equalize_luma_simple.tcl @@ -0,0 +1,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 Index: demos/equalize_rgb.tcl ================================================================== --- /dev/null +++ demos/equalize_rgb.tcl @@ -0,0 +1,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 Index: demos/equalize_rgb2.tcl ================================================================== --- /dev/null +++ demos/equalize_rgb2.tcl @@ -0,0 +1,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 Index: demos/equalize_rgb2_simple.tcl ================================================================== --- /dev/null +++ demos/equalize_rgb2_simple.tcl @@ -0,0 +1,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 Index: demos/equalize_rgb_simple.tcl ================================================================== --- /dev/null +++ demos/equalize_rgb_simple.tcl @@ -0,0 +1,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 Index: demos/equalize_simple.tcl ================================================================== --- /dev/null +++ demos/equalize_simple.tcl @@ -0,0 +1,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 Index: demos/equalize_value.tcl ================================================================== --- /dev/null +++ demos/equalize_value.tcl @@ -0,0 +1,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 Index: demos/equalize_value_simple.tcl ================================================================== --- /dev/null +++ demos/equalize_value_simple.tcl @@ -0,0 +1,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 Index: demos/expand_black.tcl ================================================================== --- /dev/null +++ demos/expand_black.tcl @@ -0,0 +1,6 @@ +def expand_black { + label {Expand Black} + setup_image { + show_image [crimp expand const [base] 50 50 50 50] + } +} ADDED demos/expand_const.tcl Index: demos/expand_const.tcl ================================================================== --- /dev/null +++ demos/expand_const.tcl @@ -0,0 +1,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 Index: demos/expand_extend.tcl ================================================================== --- /dev/null +++ demos/expand_extend.tcl @@ -0,0 +1,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 Index: demos/expand_mirror.tcl ================================================================== --- /dev/null +++ demos/expand_mirror.tcl @@ -0,0 +1,6 @@ +def expand_mirror { + label {Expand Mirror} + setup_image { + show_image [crimp expand mirror [base] 50 50 50 50] + } +} ADDED demos/expand_replicate.tcl Index: demos/expand_replicate.tcl ================================================================== --- /dev/null +++ demos/expand_replicate.tcl @@ -0,0 +1,6 @@ +def expand_replicate { + label {Expand Replicate} + setup_image { + show_image [crimp expand replicate [base] 50 50 50 50] + } +} ADDED demos/expand_wrap.tcl Index: demos/expand_wrap.tcl ================================================================== --- /dev/null +++ demos/expand_wrap.tcl @@ -0,0 +1,6 @@ +def expand_wrap { + label {Expand Wrap} + setup_image { + show_image [crimp expand wrap [base] 50 50 50 50] + } +} ADDED demos/fft.tcl Index: demos/fft.tcl ================================================================== --- /dev/null +++ demos/fft.tcl @@ -0,0 +1,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 Index: demos/flip.tcl ================================================================== --- /dev/null +++ demos/flip.tcl @@ -0,0 +1,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 Index: demos/flip_horizontal.tcl ================================================================== --- /dev/null +++ demos/flip_horizontal.tcl @@ -0,0 +1,6 @@ +def op_flip_horizontal { + label \u2194 + setup_image { + show_image [crimp flip horizontal [base]] + } +} ADDED demos/flip_transpose.tcl Index: demos/flip_transpose.tcl ================================================================== --- /dev/null +++ demos/flip_transpose.tcl @@ -0,0 +1,6 @@ +def op_flip_transpose { + label \\ + setup_image { + show_image [crimp flip transpose [base]] + } +} ADDED demos/flip_transverse.tcl Index: demos/flip_transverse.tcl ================================================================== --- /dev/null +++ demos/flip_transverse.tcl @@ -0,0 +1,6 @@ +def op_flip_transverse { + label / + setup_image { + show_image [crimp flip transverse [base]] + } +} ADDED demos/flip_vertical.tcl Index: demos/flip_vertical.tcl ================================================================== --- /dev/null +++ demos/flip_vertical.tcl @@ -0,0 +1,6 @@ +def op_flip_vertical { + label \u2191\u2193 + setup_image { + show_image [crimp flip vertical [base]] + } +} ADDED demos/gamma.tcl Index: demos/gamma.tcl ================================================================== --- /dev/null +++ demos/gamma.tcl @@ -0,0 +1,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 Index: demos/gauss.tcl ================================================================== --- /dev/null +++ demos/gauss.tcl @@ -0,0 +1,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 Index: demos/gauss_luma.tcl ================================================================== --- /dev/null +++ demos/gauss_luma.tcl @@ -0,0 +1,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 Index: demos/gradient.tcl ================================================================== --- /dev/null +++ demos/gradient.tcl @@ -0,0 +1,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 Index: demos/gradient2.tcl ================================================================== --- /dev/null +++ demos/gradient2.tcl @@ -0,0 +1,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 Index: demos/gradiente.tcl ================================================================== --- /dev/null +++ demos/gradiente.tcl @@ -0,0 +1,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 Index: demos/green.tcl ================================================================== --- /dev/null +++ demos/green.tcl @@ -0,0 +1,6 @@ +def rgba_green { + label Green + setup_image { + show_image [lindex [crimp split [base]] 1] + } +} ADDED demos/green_tint.tcl Index: demos/green_tint.tcl ================================================================== --- /dev/null +++ demos/green_tint.tcl @@ -0,0 +1,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 Index: demos/hough.tcl ================================================================== --- /dev/null +++ demos/hough.tcl @@ -0,0 +1,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 Index: demos/hsv_as_rgb.tcl ================================================================== --- /dev/null +++ demos/hsv_as_rgb.tcl @@ -0,0 +1,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 Index: demos/hue.tcl ================================================================== --- /dev/null +++ demos/hue.tcl @@ -0,0 +1,6 @@ +def hsv_hue { + label Hue + setup_image { + show_image [lindex [crimp split [crimp convert 2hsv [base]]] 0] + } +} ADDED demos/integrate.tcl Index: demos/integrate.tcl ================================================================== --- /dev/null +++ demos/integrate.tcl @@ -0,0 +1,10 @@ +def op_integrate { + label Integrate + setup_image { + show_image \ + [crimp convert 2grey8 \ + [crimp integrate \ + [crimp convert 2grey8 \ + [base]]]] + } +} ADDED demos/integrate2.tcl Index: demos/integrate2.tcl ================================================================== --- /dev/null +++ demos/integrate2.tcl @@ -0,0 +1,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 Index: demos/integrate3.tcl ================================================================== --- /dev/null +++ demos/integrate3.tcl @@ -0,0 +1,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 Index: demos/interpolate2.tcl ================================================================== --- /dev/null +++ demos/interpolate2.tcl @@ -0,0 +1,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 Index: demos/interpolate2_foh.tcl ================================================================== --- /dev/null +++ demos/interpolate2_foh.tcl @@ -0,0 +1,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 Index: demos/interpolate4.tcl ================================================================== --- /dev/null +++ demos/interpolate4.tcl @@ -0,0 +1,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 Index: demos/interpolate8.tcl ================================================================== --- /dev/null +++ demos/interpolate8.tcl @@ -0,0 +1,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 Index: demos/interpolate8_foh.tcl ================================================================== --- /dev/null +++ demos/interpolate8_foh.tcl @@ -0,0 +1,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 Index: demos/invert.tcl ================================================================== --- /dev/null +++ demos/invert.tcl @@ -0,0 +1,6 @@ +def op_invert { + label Invert + setup_image { + show_image [crimp invert [base]] + } +} ADDED demos/log.tcl Index: demos/log.tcl ================================================================== --- /dev/null +++ demos/log.tcl @@ -0,0 +1,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 Index: demos/luma.tcl ================================================================== --- /dev/null +++ demos/luma.tcl @@ -0,0 +1,6 @@ +def op_luma { + label Luma + setup_image { + show_image [crimp convert 2grey8 [base]] + } +} ADDED demos/matinv.tcl Index: demos/matinv.tcl ================================================================== --- /dev/null +++ demos/matinv.tcl @@ -0,0 +1,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 Index: demos/matmul.tcl ================================================================== --- /dev/null +++ demos/matmul.tcl @@ -0,0 +1,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 Index: demos/matrix.tcl ================================================================== --- /dev/null +++ demos/matrix.tcl @@ -0,0 +1,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 Index: demos/max.tcl ================================================================== --- /dev/null +++ demos/max.tcl @@ -0,0 +1,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 Index: demos/mean.tcl ================================================================== --- /dev/null +++ demos/mean.tcl @@ -0,0 +1,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 Index: demos/mean_rgb.tcl ================================================================== --- /dev/null +++ demos/mean_rgb.tcl @@ -0,0 +1,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 Index: demos/meta.tcl ================================================================== --- /dev/null +++ demos/meta.tcl @@ -0,0 +1,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 Index: demos/min.tcl ================================================================== --- /dev/null +++ demos/min.tcl @@ -0,0 +1,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 Index: demos/montageh.tcl ================================================================== --- /dev/null +++ demos/montageh.tcl @@ -0,0 +1,9 @@ +def op_montageh { + label {Montage Left/Right} + active { + expr { [bases] > 1 } + } + setup_image { + show_image [crimp montage horizontal {*}[thebases]] + } +} ADDED demos/montagev.tcl Index: demos/montagev.tcl ================================================================== --- /dev/null +++ demos/montagev.tcl @@ -0,0 +1,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 Index: demos/morph_close.tcl ================================================================== --- /dev/null +++ demos/morph_close.tcl @@ -0,0 +1,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 Index: demos/morph_close_grey.tcl ================================================================== --- /dev/null +++ demos/morph_close_grey.tcl @@ -0,0 +1,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 Index: demos/morph_dilate.tcl ================================================================== --- /dev/null +++ demos/morph_dilate.tcl @@ -0,0 +1,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 Index: demos/morph_dilate_grey.tcl ================================================================== --- /dev/null +++ demos/morph_dilate_grey.tcl @@ -0,0 +1,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 Index: demos/morph_egradient.tcl ================================================================== --- /dev/null +++ demos/morph_egradient.tcl @@ -0,0 +1,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 Index: demos/morph_egradient_grey.tcl ================================================================== --- /dev/null +++ demos/morph_egradient_grey.tcl @@ -0,0 +1,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 Index: demos/morph_erode.tcl ================================================================== --- /dev/null +++ demos/morph_erode.tcl @@ -0,0 +1,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 Index: demos/morph_erode_grey.tcl ================================================================== --- /dev/null +++ demos/morph_erode_grey.tcl @@ -0,0 +1,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 Index: demos/morph_gradient.tcl ================================================================== --- /dev/null +++ demos/morph_gradient.tcl @@ -0,0 +1,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 Index: demos/morph_gradient_grey.tcl ================================================================== --- /dev/null +++ demos/morph_gradient_grey.tcl @@ -0,0 +1,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 Index: demos/morph_igradient.tcl ================================================================== --- /dev/null +++ demos/morph_igradient.tcl @@ -0,0 +1,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 Index: demos/morph_igradient_grey.tcl ================================================================== --- /dev/null +++ demos/morph_igradient_grey.tcl @@ -0,0 +1,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 Index: demos/morph_open.tcl ================================================================== --- /dev/null +++ demos/morph_open.tcl @@ -0,0 +1,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 Index: demos/morph_open_grey.tcl ================================================================== --- /dev/null +++ demos/morph_open_grey.tcl @@ -0,0 +1,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 Index: demos/morph_tophatb.tcl ================================================================== --- /dev/null +++ demos/morph_tophatb.tcl @@ -0,0 +1,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 Index: demos/morph_tophatb_grey.tcl ================================================================== --- /dev/null +++ demos/morph_tophatb_grey.tcl @@ -0,0 +1,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 Index: demos/morph_tophatw.tcl ================================================================== --- /dev/null +++ demos/morph_tophatw.tcl @@ -0,0 +1,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 Index: demos/morph_tophatw_grey.tcl ================================================================== --- /dev/null +++ demos/morph_tophatw_grey.tcl @@ -0,0 +1,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 Index: demos/multiply.tcl ================================================================== --- /dev/null +++ demos/multiply.tcl @@ -0,0 +1,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 Index: demos/over.tcl ================================================================== --- /dev/null +++ demos/over.tcl @@ -0,0 +1,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 Index: demos/overi.tcl ================================================================== --- /dev/null +++ demos/overi.tcl @@ -0,0 +1,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 Index: demos/psych.tcl ================================================================== --- /dev/null +++ demos/psych.tcl @@ -0,0 +1,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 Index: demos/pyramid_blend.tcl ================================================================== --- /dev/null +++ demos/pyramid_blend.tcl @@ -0,0 +1,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 Index: demos/pyramid_gauss.tcl ================================================================== --- /dev/null +++ demos/pyramid_gauss.tcl @@ -0,0 +1,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 Index: demos/pyramid_gauss2.tcl ================================================================== --- /dev/null +++ demos/pyramid_gauss2.tcl @@ -0,0 +1,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 Index: demos/pyramid_laplace.tcl ================================================================== --- /dev/null +++ demos/pyramid_laplace.tcl @@ -0,0 +1,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 Index: demos/pyramid_laplace2.tcl ================================================================== --- /dev/null +++ demos/pyramid_laplace2.tcl @@ -0,0 +1,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 Index: demos/quad.tcl ================================================================== --- /dev/null +++ demos/quad.tcl @@ -0,0 +1,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 Index: demos/quantize.tcl ================================================================== --- /dev/null +++ demos/quantize.tcl @@ -0,0 +1,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 Index: demos/read_pgm.tcl ================================================================== --- /dev/null +++ demos/read_pgm.tcl @@ -0,0 +1,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 Index: demos/read_pgm2.tcl ================================================================== --- /dev/null +++ demos/read_pgm2.tcl @@ -0,0 +1,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 Index: demos/read_ppm.tcl ================================================================== --- /dev/null +++ demos/read_ppm.tcl @@ -0,0 +1,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 Index: demos/read_ppm2.tcl ================================================================== --- /dev/null +++ demos/read_ppm2.tcl @@ -0,0 +1,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 Index: demos/read_strimj.tcl ================================================================== --- /dev/null +++ demos/read_strimj.tcl @@ -0,0 +1,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 Index: demos/red.tcl ================================================================== --- /dev/null +++ demos/red.tcl @@ -0,0 +1,6 @@ +def rgba_red { + label Red + setup_image { + show_image [lindex [crimp split [base]] 0] + } +} ADDED demos/red_tint.tcl Index: demos/red_tint.tcl ================================================================== --- /dev/null +++ demos/red_tint.tcl @@ -0,0 +1,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 Index: demos/rehsv.tcl ================================================================== --- /dev/null +++ demos/rehsv.tcl @@ -0,0 +1,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 Index: demos/resize.tcl ================================================================== --- /dev/null +++ demos/resize.tcl @@ -0,0 +1,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 Index: demos/retinex.tcl ================================================================== --- /dev/null +++ demos/retinex.tcl @@ -0,0 +1,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 Index: demos/retinex_hsv.tcl ================================================================== --- /dev/null +++ demos/retinex_hsv.tcl @@ -0,0 +1,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 Index: demos/rgb2hsv2rgb.tcl ================================================================== --- /dev/null +++ demos/rgb2hsv2rgb.tcl @@ -0,0 +1,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 Index: demos/rof_max.tcl ================================================================== --- /dev/null +++ demos/rof_max.tcl @@ -0,0 +1,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 Index: demos/rof_max_luma.tcl ================================================================== --- /dev/null +++ demos/rof_max_luma.tcl @@ -0,0 +1,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 Index: demos/rof_median.tcl ================================================================== --- /dev/null +++ demos/rof_median.tcl @@ -0,0 +1,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 Index: demos/rof_median_luma.tcl ================================================================== --- /dev/null +++ demos/rof_median_luma.tcl @@ -0,0 +1,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 Index: demos/rof_median_subtract.tcl ================================================================== --- /dev/null +++ demos/rof_median_subtract.tcl @@ -0,0 +1,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 Index: demos/rof_min.tcl ================================================================== --- /dev/null +++ demos/rof_min.tcl @@ -0,0 +1,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 Index: demos/rof_min_luma.tcl ================================================================== --- /dev/null +++ demos/rof_min_luma.tcl @@ -0,0 +1,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 Index: demos/saturation.tcl ================================================================== --- /dev/null +++ demos/saturation.tcl @@ -0,0 +1,6 @@ +def hsv_saturation { + label Saturation + setup_image { + show_image [lindex [crimp split [crimp convert 2hsv [base]]] 1] + } +} ADDED demos/screen.tcl Index: demos/screen.tcl ================================================================== --- /dev/null +++ demos/screen.tcl @@ -0,0 +1,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 Index: demos/shell.tcl ================================================================== --- /dev/null +++ demos/shell.tcl @@ -0,0 +1,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 {::apply {{} { + variable cmd [.top.cmd get] + showit + } ::DEMO}} + } + setup_image { + showit + } +} ADDED demos/solarize.tcl Index: demos/solarize.tcl ================================================================== --- /dev/null +++ demos/solarize.tcl @@ -0,0 +1,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 Index: demos/sqrt.tcl ================================================================== --- /dev/null +++ demos/sqrt.tcl @@ -0,0 +1,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 Index: demos/statistics.tcl ================================================================== --- /dev/null +++ demos/statistics.tcl @@ -0,0 +1,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 Index: demos/statistics2.tcl ================================================================== --- /dev/null +++ demos/statistics2.tcl @@ -0,0 +1,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 Index: demos/stddev.tcl ================================================================== --- /dev/null +++ demos/stddev.tcl @@ -0,0 +1,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 Index: demos/subtract.tcl ================================================================== --- /dev/null +++ demos/subtract.tcl @@ -0,0 +1,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 Index: demos/threshold_g.tcl ================================================================== --- /dev/null +++ demos/threshold_g.tcl @@ -0,0 +1,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 Index: demos/threshold_ge.tcl ================================================================== --- /dev/null +++ demos/threshold_ge.tcl @@ -0,0 +1,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 Index: demos/threshold_global.tcl ================================================================== --- /dev/null +++ demos/threshold_global.tcl @@ -0,0 +1,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 Index: demos/threshold_ig.tcl ================================================================== --- /dev/null +++ demos/threshold_ig.tcl @@ -0,0 +1,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 Index: demos/threshold_le.tcl ================================================================== --- /dev/null +++ demos/threshold_le.tcl @@ -0,0 +1,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 Index: demos/threshold_local.tcl ================================================================== --- /dev/null +++ demos/threshold_local.tcl @@ -0,0 +1,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 Index: demos/threshold_luma_ge.tcl ================================================================== --- /dev/null +++ demos/threshold_luma_ge.tcl @@ -0,0 +1,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 Index: demos/threshold_luma_le.tcl ================================================================== --- /dev/null +++ demos/threshold_luma_le.tcl @@ -0,0 +1,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 Index: demos/upsample2.tcl ================================================================== --- /dev/null +++ demos/upsample2.tcl @@ -0,0 +1,6 @@ +def op_upsample2 { + label Upsample\u21912 + setup_image { + show_image [crimp upsample xy [base] 2] + } +} ADDED demos/upsample3.tcl Index: demos/upsample3.tcl ================================================================== --- /dev/null +++ demos/upsample3.tcl @@ -0,0 +1,6 @@ +def op_upsample3 { + label Upsample\u21913 + setup_image { + show_image [crimp upsample xy [base] 3] + } +} ADDED demos/upsample4.tcl Index: demos/upsample4.tcl ================================================================== --- /dev/null +++ demos/upsample4.tcl @@ -0,0 +1,6 @@ +def op_upsample4 { + label Upsample\u21914 + setup_image { + show_image [crimp upsample xy [base] 4] + } +} ADDED demos/upsample8.tcl Index: demos/upsample8.tcl ================================================================== --- /dev/null +++ demos/upsample8.tcl @@ -0,0 +1,6 @@ +def op_upsample8 { + label Upsample\u21918 + setup_image { + show_image [crimp upsample xy [base] 8] + } +} ADDED demos/value.tcl Index: demos/value.tcl ================================================================== --- /dev/null +++ demos/value.tcl @@ -0,0 +1,6 @@ +def hsv_value { + label Value + setup_image { + show_image [lindex [crimp split [crimp convert 2hsv [base]]] 2] + } +} ADDED demos/warp_field.tcl Index: demos/warp_field.tcl ================================================================== --- /dev/null +++ demos/warp_field.tcl @@ -0,0 +1,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 Index: demos/warp_quad.tcl ================================================================== --- /dev/null +++ demos/warp_quad.tcl @@ -0,0 +1,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 Index: demos/warp_rc_bicubic.tcl ================================================================== --- /dev/null +++ demos/warp_rc_bicubic.tcl @@ -0,0 +1,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 Index: demos/warp_rc_bicubic_rgba.tcl ================================================================== --- /dev/null +++ demos/warp_rc_bicubic_rgba.tcl @@ -0,0 +1,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 Index: demos/warp_rc_bilinear.tcl ================================================================== --- /dev/null +++ demos/warp_rc_bilinear.tcl @@ -0,0 +1,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 Index: demos/warp_rc_bilinear_rgba.tcl ================================================================== --- /dev/null +++ demos/warp_rc_bilinear_rgba.tcl @@ -0,0 +1,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 Index: demos/warp_rc_nneighbour.tcl ================================================================== --- /dev/null +++ demos/warp_rc_nneighbour.tcl @@ -0,0 +1,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 Index: demos/warp_rc_nneighbour_rgba.tcl ================================================================== --- /dev/null +++ demos/warp_rc_nneighbour_rgba.tcl @@ -0,0 +1,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 Index: demos/warp_sc_bicubic.tcl ================================================================== --- /dev/null +++ demos/warp_sc_bicubic.tcl @@ -0,0 +1,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 Index: demos/warp_sc_bicubic_rgba.tcl ================================================================== --- /dev/null +++ demos/warp_sc_bicubic_rgba.tcl @@ -0,0 +1,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 Index: demos/warp_sc_bilinear.tcl ================================================================== --- /dev/null +++ demos/warp_sc_bilinear.tcl @@ -0,0 +1,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 Index: demos/warp_sc_bilinear_rgba.tcl ================================================================== --- /dev/null +++ demos/warp_sc_bilinear_rgba.tcl @@ -0,0 +1,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 Index: demos/warp_sc_nneighbour.tcl ================================================================== --- /dev/null +++ demos/warp_sc_nneighbour.tcl @@ -0,0 +1,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 Index: demos/warp_sc_nneighbour_rgba.tcl ================================================================== --- /dev/null +++ demos/warp_sc_nneighbour_rgba.tcl @@ -0,0 +1,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 Index: demos/wavy.tcl ================================================================== --- /dev/null +++ demos/wavy.tcl @@ -0,0 +1,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 Index: demos/write_pgm.tcl ================================================================== --- /dev/null +++ demos/write_pgm.tcl @@ -0,0 +1,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 Index: demos/write_pgm_raw.tcl ================================================================== --- /dev/null +++ demos/write_pgm_raw.tcl @@ -0,0 +1,6 @@ +def write_pgmraw { + label {Write (PGM/raw)} + setup_image { + crimp write 2file pgm-raw $dir/written.pgm [base] + } +} ADDED demos/write_ppm.tcl Index: demos/write_ppm.tcl ================================================================== --- /dev/null +++ demos/write_ppm.tcl @@ -0,0 +1,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 Index: demos/write_ppm_raw.tcl ================================================================== --- /dev/null +++ demos/write_ppm_raw.tcl @@ -0,0 +1,6 @@ +def write_ppmraw { + label {Write (PPM/raw)} + setup_image { + crimp write 2file ppm-raw $dir/written.ppm [base] + } +} ADDED doc/crimp.man Index: doc/crimp.man ================================================================== --- /dev/null +++ doc/crimp.man @@ -0,0 +1,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 ] [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 ] [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 Index: doc/figures/border.dia ================================================================== --- /dev/null +++ doc/figures/border.dia @@ -0,0 +1,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 Index: doc/figures/border.png ================================================================== --- /dev/null +++ doc/figures/border.png cannot compute difference between binary files ADDED doc/figures/border.txt Index: doc/figures/border.txt ================================================================== --- /dev/null +++ doc/figures/border.txt @@ -0,0 +1,16 @@ + |< ww >| |< we >| + +- +------+-----------+------+ +^ | | | | +hn | | | | +V | | | | +- +------+-----------+------+ + | | | | + | | | | + | | | | + | | | | +- +------+-----------+------+ +^ | | | | +hs | | | | +V | | | | +- +------+-----------+------+ ADDED doc/figures/math/atan2.png Index: doc/figures/math/atan2.png ================================================================== --- /dev/null +++ doc/figures/math/atan2.png cannot compute difference between binary files ADDED doc/figures/math/atan2.txt Index: doc/figures/math/atan2.txt ================================================================== --- /dev/null +++ doc/figures/math/atan2.txt @@ -0,0 +1,1 @@ +atan2 (x,y) = atan(\frac{x}{y}) ADDED doc/figures/math/blend.png Index: doc/figures/math/blend.png ================================================================== --- /dev/null +++ doc/figures/math/blend.png cannot compute difference between binary files ADDED doc/figures/math/blend.txt Index: doc/figures/math/blend.txt ================================================================== --- /dev/null +++ doc/figures/math/blend.txt @@ -0,0 +1,1 @@ +Z = F\alpha + B(1-\alpha) ADDED doc/figures/math/blend_alt.png Index: doc/figures/math/blend_alt.png ================================================================== --- /dev/null +++ doc/figures/math/blend_alt.png cannot compute difference between binary files ADDED doc/figures/math/blend_alt.txt Index: doc/figures/math/blend_alt.txt ================================================================== --- /dev/null +++ doc/figures/math/blend_alt.txt @@ -0,0 +1,1 @@ +Z = (F - B)\alpha + B ADDED doc/figures/math/gamma.png Index: doc/figures/math/gamma.png ================================================================== --- /dev/null +++ doc/figures/math/gamma.png cannot compute difference between binary files ADDED doc/figures/math/gamma.txt Index: doc/figures/math/gamma.txt ================================================================== --- /dev/null +++ doc/figures/math/gamma.txt @@ -0,0 +1,1 @@ +gamma_y (x) = x^y ADDED doc/figures/math/gamma_inv.png Index: doc/figures/math/gamma_inv.png ================================================================== --- /dev/null +++ doc/figures/math/gamma_inv.png cannot compute difference between binary files ADDED doc/figures/math/gamma_inv.txt Index: doc/figures/math/gamma_inv.txt ================================================================== --- /dev/null +++ doc/figures/math/gamma_inv.txt @@ -0,0 +1,1 @@ +gamma^{-1}_y (x) = x^{\frac{1}{y}} ADDED doc/figures/math/gauss.png Index: doc/figures/math/gauss.png ================================================================== --- /dev/null +++ doc/figures/math/gauss.png cannot compute difference between binary files ADDED doc/figures/math/gauss.txt Index: doc/figures/math/gauss.txt ================================================================== --- /dev/null +++ doc/figures/math/gauss.txt @@ -0,0 +1,1 @@ +gauss_\sigma (x) = [255 e^{-\frac{x-127.5}{2\sigma^2}}] ADDED doc/figures/math/hypot.png Index: doc/figures/math/hypot.png ================================================================== --- /dev/null +++ doc/figures/math/hypot.png cannot compute difference between binary files ADDED doc/figures/math/hypot.txt Index: doc/figures/math/hypot.txt ================================================================== --- /dev/null +++ doc/figures/math/hypot.txt @@ -0,0 +1,1 @@ +hypot (x,y) = \sqrt{x^2 + y^2} ADDED doc/figures/math/identity.png Index: doc/figures/math/identity.png ================================================================== --- /dev/null +++ doc/figures/math/identity.png cannot compute difference between binary files ADDED doc/figures/math/identity.txt Index: doc/figures/math/identity.txt ================================================================== --- /dev/null +++ doc/figures/math/identity.txt @@ -0,0 +1,1 @@ +identity (x) = x ADDED doc/figures/math/inverse.png Index: doc/figures/math/inverse.png ================================================================== --- /dev/null +++ doc/figures/math/inverse.png cannot compute difference between binary files ADDED doc/figures/math/inverse.txt Index: doc/figures/math/inverse.txt ================================================================== --- /dev/null +++ doc/figures/math/inverse.txt @@ -0,0 +1,1 @@ +inverse (x) = 255 - x ADDED doc/figures/math/linear_clamp.png Index: doc/figures/math/linear_clamp.png ================================================================== --- /dev/null +++ doc/figures/math/linear_clamp.png cannot compute difference between binary files ADDED doc/figures/math/linear_clamp.txt Index: doc/figures/math/linear_clamp.txt ================================================================== --- /dev/null +++ doc/figures/math/linear_clamp.txt @@ -0,0 +1,1 @@ +linear^{clamp}_{gain,offset} (x) = min (0, max (255, [ gain x + offset ])) ADDED doc/figures/math/linear_wrap.png Index: doc/figures/math/linear_wrap.png ================================================================== --- /dev/null +++ doc/figures/math/linear_wrap.png cannot compute difference between binary files ADDED doc/figures/math/linear_wrap.txt Index: doc/figures/math/linear_wrap.txt ================================================================== --- /dev/null +++ doc/figures/math/linear_wrap.txt @@ -0,0 +1,1 @@ +linear^{wrap}_{gain,offset} (x) = [ gain x + offset ] \oplus_{256} 0 ADDED doc/figures/math/log.png Index: doc/figures/math/log.png ================================================================== --- /dev/null +++ doc/figures/math/log.png cannot compute difference between binary files ADDED doc/figures/math/log.txt Index: doc/figures/math/log.txt ================================================================== --- /dev/null +++ doc/figures/math/log.txt @@ -0,0 +1,1 @@ +logcompress_{max} (x) = max(255, \frac{255}{ln(1+max)} ln(1+x)) ADDED doc/figures/math/scaled_gamma.png Index: doc/figures/math/scaled_gamma.png ================================================================== --- /dev/null +++ doc/figures/math/scaled_gamma.png cannot compute difference between binary files ADDED doc/figures/math/scaled_gamma.txt Index: doc/figures/math/scaled_gamma.txt ================================================================== --- /dev/null +++ doc/figures/math/scaled_gamma.txt @@ -0,0 +1,1 @@ +gamma_y (x) = [ 255 (\frac{x}{255})^y ] ADDED doc/figures/math/scaled_gamma_inv.png Index: doc/figures/math/scaled_gamma_inv.png ================================================================== --- /dev/null +++ doc/figures/math/scaled_gamma_inv.png cannot compute difference between binary files ADDED doc/figures/math/scaled_gamma_inv.txt Index: doc/figures/math/scaled_gamma_inv.txt ================================================================== --- /dev/null +++ doc/figures/math/scaled_gamma_inv.txt @@ -0,0 +1,1 @@ +gamma^{-1}_y (x) = [ 255 (\frac{x}{255})^{\frac{1}{y}} ] ADDED doc/figures/math/screen.png Index: doc/figures/math/screen.png ================================================================== --- /dev/null +++ doc/figures/math/screen.png cannot compute difference between binary files ADDED doc/figures/math/screen.txt Index: doc/figures/math/screen.txt ================================================================== --- /dev/null +++ doc/figures/math/screen.txt @@ -0,0 +1,1 @@ +Z = 1-((1-A)(1-B)) = invert (multiply (invert (A), invert (B))) ADDED doc/figures/math/solarize.png Index: doc/figures/math/solarize.png ================================================================== --- /dev/null +++ doc/figures/math/solarize.png cannot compute difference between binary files ADDED doc/figures/math/solarize.txt Index: doc/figures/math/solarize.txt ================================================================== --- /dev/null +++ doc/figures/math/solarize.txt @@ -0,0 +1,4 @@ +solarize_{threshold} (x) = \left\{\begin{eqnarray} +x & x < threshold \\ +255 - x & x \ge threshold \\ +\end{eqnarray}\right ADDED doc/figures/math/sqrt.png Index: doc/figures/math/sqrt.png ================================================================== --- /dev/null +++ doc/figures/math/sqrt.png cannot compute difference between binary files ADDED doc/figures/math/sqrt.txt Index: doc/figures/math/sqrt.txt ================================================================== --- /dev/null +++ doc/figures/math/sqrt.txt @@ -0,0 +1,1 @@ +sqrtcompress_{max} (x) = max(255, \frac{255}{\sqrt{max}} \sqrt{x}) ADDED doc/figures/math/threshold-ge.png Index: doc/figures/math/threshold-ge.png ================================================================== --- /dev/null +++ doc/figures/math/threshold-ge.png cannot compute difference between binary files ADDED doc/figures/math/threshold-ge.txt Index: doc/figures/math/threshold-ge.txt ================================================================== --- /dev/null +++ doc/figures/math/threshold-ge.txt @@ -0,0 +1,6 @@ +f_{threshold} (x) = \left\{\begin{eqnarray} +0 & x \ge threshold \\ +255 & x < threshold \\ +\end{eqnarray}\right + + ADDED doc/figures/math/threshold-inside.png Index: doc/figures/math/threshold-inside.png ================================================================== --- /dev/null +++ doc/figures/math/threshold-inside.png cannot compute difference between binary files ADDED doc/figures/math/threshold-inside.txt Index: doc/figures/math/threshold-inside.txt ================================================================== --- /dev/null +++ doc/figures/math/threshold-inside.txt @@ -0,0 +1,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 Index: doc/figures/math/threshold-le.png ================================================================== --- /dev/null +++ doc/figures/math/threshold-le.png cannot compute difference between binary files ADDED doc/figures/math/threshold-le.txt Index: doc/figures/math/threshold-le.txt ================================================================== --- /dev/null +++ doc/figures/math/threshold-le.txt @@ -0,0 +1,6 @@ +f_{threshold} (x) = \left\{\begin{eqnarray} +0 & x < threshold \\ +255 & x \ge threshold \\ +\end{eqnarray}\right + + ADDED doc/figures/math/threshold-outside.png Index: doc/figures/math/threshold-outside.png ================================================================== --- /dev/null +++ doc/figures/math/threshold-outside.png cannot compute difference between binary files ADDED doc/figures/math/threshold-outside.txt Index: doc/figures/math/threshold-outside.txt ================================================================== --- /dev/null +++ doc/figures/math/threshold-outside.txt @@ -0,0 +1,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 Index: doc/figures/objtype.dia ================================================================== --- /dev/null +++ doc/figures/objtype.dia @@ -0,0 +1,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:: width [45 mm] +gap +box width [10 mm] +gap +box width [10 mm] +gap +box width [20 mm] +gap +box 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] "" above] + set HD [arrow <-> from [[2nd last box nw] by 15 west] to [[2nd last box sw] by 15 west] " " 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 Index: doc/figures/objtype.png ================================================================== --- /dev/null +++ doc/figures/objtype.png cannot compute difference between binary files ADDED doc/figures/organization.dia Index: doc/figures/organization.dia ================================================================== --- /dev/null +++ doc/figures/organization.dia @@ -0,0 +1,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 Index: doc/figures/organization.png ================================================================== --- /dev/null +++ doc/figures/organization.png cannot compute difference between binary files ADDED doc/figures/organization.txt Index: doc/figures/organization.txt ================================================================== --- /dev/null +++ doc/figures/organization.txt @@ -0,0 +1,17 @@ ++-----------------------+-----+---+ +| CRIMP | Tcl | C | ++-----------------------+-----+---+ +| I/O Read | | | +| ----------+-----+---+ +| Write | | | ++-----------------------+-----+---+ +| Converters | | | ++-----------------------+-----+---+ +| Manipulators Geometry | | | +| ----------+-----+---+ +| Color | | | ++-----------------------+-----+---+ +| Accessors | | | ++-----------------------+-----+---+ +| Support | | | ++-----------------------+-----+---+ ADDED doc/figures/pyramid.dia Index: doc/figures/pyramid.dia ================================================================== --- /dev/null +++ doc/figures/pyramid.dia @@ -0,0 +1,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 Index: doc/figures/pyramid.png ================================================================== --- /dev/null +++ doc/figures/pyramid.png cannot compute difference between binary files ADDED doc/figures/pyramid_gauss.dia Index: doc/figures/pyramid_gauss.dia ================================================================== --- /dev/null +++ doc/figures/pyramid_gauss.dia @@ -0,0 +1,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 Index: doc/figures/pyramid_gauss.png ================================================================== --- /dev/null +++ doc/figures/pyramid_gauss.png cannot compute difference between binary files ADDED doc/figures/pyramid_laplace.dia Index: doc/figures/pyramid_laplace.dia ================================================================== --- /dev/null +++ doc/figures/pyramid_laplace.dia @@ -0,0 +1,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 Index: doc/figures/pyramid_laplace.png ================================================================== --- /dev/null +++ doc/figures/pyramid_laplace.png cannot compute difference between binary files ADDED embedded/man/files/crimp.n Index: embedded/man/files/crimp.n ================================================================== --- /dev/null +++ embedded/man/files/crimp.n @@ -0,0 +1,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\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\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\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\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 Index: embedded/man/index.n ================================================================== --- /dev/null +++ embedded/man/index.n @@ -0,0 +1,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 Index: embedded/man/toc.n ================================================================== --- /dev/null +++ embedded/man/toc.n @@ -0,0 +1,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 Index: embedded/www/files/crimp.html ================================================================== --- /dev/null +++ embedded/www/files/crimp.html @@ -0,0 +1,1785 @@ + + +crimp - Image Manipulation + + + + + + ADDED embedded/www/image/atan2.png Index: embedded/www/image/atan2.png ================================================================== --- /dev/null +++ embedded/www/image/atan2.png cannot compute difference between binary files ADDED embedded/www/image/blend.png Index: embedded/www/image/blend.png ================================================================== --- /dev/null +++ embedded/www/image/blend.png cannot compute difference between binary files ADDED embedded/www/image/blend_alt.png Index: embedded/www/image/blend_alt.png ================================================================== --- /dev/null +++ embedded/www/image/blend_alt.png cannot compute difference between binary files ADDED embedded/www/image/border.png Index: embedded/www/image/border.png ================================================================== --- /dev/null +++ embedded/www/image/border.png cannot compute difference between binary files ADDED embedded/www/image/gamma.png Index: embedded/www/image/gamma.png ================================================================== --- /dev/null +++ embedded/www/image/gamma.png cannot compute difference between binary files ADDED embedded/www/image/gamma_inv.png Index: embedded/www/image/gamma_inv.png ================================================================== --- /dev/null +++ embedded/www/image/gamma_inv.png cannot compute difference between binary files ADDED embedded/www/image/gauss.png Index: embedded/www/image/gauss.png ================================================================== --- /dev/null +++ embedded/www/image/gauss.png cannot compute difference between binary files ADDED embedded/www/image/hypot.png Index: embedded/www/image/hypot.png ================================================================== --- /dev/null +++ embedded/www/image/hypot.png cannot compute difference between binary files ADDED embedded/www/image/identity.png Index: embedded/www/image/identity.png ================================================================== --- /dev/null +++ embedded/www/image/identity.png cannot compute difference between binary files ADDED embedded/www/image/inverse.png Index: embedded/www/image/inverse.png ================================================================== --- /dev/null +++ embedded/www/image/inverse.png cannot compute difference between binary files ADDED embedded/www/image/linear_clamp.png Index: embedded/www/image/linear_clamp.png ================================================================== --- /dev/null +++ embedded/www/image/linear_clamp.png cannot compute difference between binary files ADDED embedded/www/image/linear_wrap.png Index: embedded/www/image/linear_wrap.png ================================================================== --- /dev/null +++ embedded/www/image/linear_wrap.png cannot compute difference between binary files ADDED embedded/www/image/log.png Index: embedded/www/image/log.png ================================================================== --- /dev/null +++ embedded/www/image/log.png cannot compute difference between binary files ADDED embedded/www/image/organization.png Index: embedded/www/image/organization.png ================================================================== --- /dev/null +++ embedded/www/image/organization.png cannot compute difference between binary files ADDED embedded/www/image/pyramid.png Index: embedded/www/image/pyramid.png ================================================================== --- /dev/null +++ embedded/www/image/pyramid.png cannot compute difference between binary files ADDED embedded/www/image/pyramid_gauss.png Index: embedded/www/image/pyramid_gauss.png ================================================================== --- /dev/null +++ embedded/www/image/pyramid_gauss.png cannot compute difference between binary files ADDED embedded/www/image/pyramid_laplace.png Index: embedded/www/image/pyramid_laplace.png ================================================================== --- /dev/null +++ embedded/www/image/pyramid_laplace.png cannot compute difference between binary files ADDED embedded/www/image/scaled_gamma.png Index: embedded/www/image/scaled_gamma.png ================================================================== --- /dev/null +++ embedded/www/image/scaled_gamma.png cannot compute difference between binary files ADDED embedded/www/image/scaled_gamma_inv.png Index: embedded/www/image/scaled_gamma_inv.png ================================================================== --- /dev/null +++ embedded/www/image/scaled_gamma_inv.png cannot compute difference between binary files ADDED embedded/www/image/screen.png Index: embedded/www/image/screen.png ================================================================== --- /dev/null +++ embedded/www/image/screen.png cannot compute difference between binary files ADDED embedded/www/image/solarize.png Index: embedded/www/image/solarize.png ================================================================== --- /dev/null +++ embedded/www/image/solarize.png cannot compute difference between binary files ADDED embedded/www/image/sqrt.png Index: embedded/www/image/sqrt.png ================================================================== --- /dev/null +++ embedded/www/image/sqrt.png cannot compute difference between binary files ADDED embedded/www/image/threshold-ge.png Index: embedded/www/image/threshold-ge.png ================================================================== --- /dev/null +++ embedded/www/image/threshold-ge.png cannot compute difference between binary files ADDED embedded/www/image/threshold-inside.png Index: embedded/www/image/threshold-inside.png ================================================================== --- /dev/null +++ embedded/www/image/threshold-inside.png cannot compute difference between binary files ADDED embedded/www/image/threshold-le.png Index: embedded/www/image/threshold-le.png ================================================================== --- /dev/null +++ embedded/www/image/threshold-le.png cannot compute difference between binary files ADDED embedded/www/image/threshold-outside.png Index: embedded/www/image/threshold-outside.png ================================================================== --- /dev/null +++ embedded/www/image/threshold-outside.png cannot compute difference between binary files ADDED embedded/www/index.html Index: embedded/www/index.html ================================================================== --- /dev/null +++ embedded/www/index.html @@ -0,0 +1,588 @@ + + + + + Keyword Index + + +
[ + Table Of Contents +]
+

Keyword Index -- doc

+
+ A · B · C · D · E · F · G · H · I · L · M · O · P · R · S · T · V · W +
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+Keywords: A +
affine + crimp +
affine transform + crimp +
alpha + crimp +
alpha blending + crimp +
alpha channel + crimp +
average + crimp +
+Keywords: B +
binarization + crimp +
black tophat + crimp +
blending + crimp +
+Keywords: C +
channels + crimp +
charcoal + crimp +
clockwise + crimp +
closing + crimp +
composite blending + crimp +
composition + crimp +
const expansion + crimp +
convolution filter + crimp +
counter-clockwise + crimp +
cropping + crimp +
cut region + crimp +
cyclic wrap expansion + crimp +
+Keywords: D +
dilation + crimp +
dimensions + crimp +
+Keywords: E +
edge shrinking + crimp +
edge-detection + crimp +
effect + crimp +
emboss + crimp +
erosion + crimp +
expansion + crimp +
extend expansion + crimp +
external gradient + crimp +
extract rectangle + crimp +
extract region + crimp +
+Keywords: F +
fast fourier transform + crimp +
fft + crimp +
filter + crimp +
flip + crimp +
fourier transform + crimp +
+Keywords: G +
gamma correction + crimp +
geometry + crimp +
gradient + crimp +
+Keywords: H +
histogram + crimp +
hypot + crimp +
+Keywords: I +
image + crimp +
integral image + crimp +
internal gradient + crimp +
inverse fourier transform + crimp +
inversion + crimp +
+Keywords: L +
log-compression + crimp +
+Keywords: M +
matrix + crimp +
max + crimp +
max-filter + crimp +
mean + crimp +
mean filter + crimp +
median + crimp +
median-filter + crimp +
middle + crimp +
min + crimp +
min-filter + crimp +
mirror expansion + crimp +
montage + crimp +
morphology + crimp +
+Keywords: O +
opening + crimp +
otsu threshold + crimp +
+Keywords: P +
perspective + crimp +
photo + crimp +
pixel mapping + crimp +
prewitt + crimp +
projective + crimp +
projective transform + crimp +
+Keywords: R +
rank-order filter + crimp +
rectangle cut + crimp +
rectangle extraction + crimp +
region cut + crimp +
remapping + crimp +
replicate edge expansion + crimp +
rescale + crimp +
resize + crimp +
rotate + crimp +
rotation + crimp +
+Keywords: S +
sabattier effect + crimp +
scale + crimp +
scharr + crimp +
sharpen + crimp +
shrinking + crimp +
sobel + crimp +
solarization + crimp +
sqrt-compression + crimp +
standard deviation filter + crimp +
statistics + crimp +
stddev + crimp +
summed area table + crimp +
+Keywords: T +
threshold + crimp +
thresholding + crimp +
tophat + crimp +
toroidal wrap expansion + crimp +
transform + crimp +
translate + crimp +
+Keywords: V +
variance + crimp +
vector-field + crimp +
+Keywords: W +
warp + crimp +
white tophat + crimp +
wrap expansion + crimp +
+ ADDED embedded/www/toc.html Index: embedded/www/toc.html ================================================================== --- /dev/null +++ embedded/www/toc.html @@ -0,0 +1,20 @@ + + Table Of Contents + + + + +
[ + Keyword Index +]
+

Table Of Contents

+

doc

+ + + + + +
crimpImage Manipulation (not yet independent of Tk)
+
DELETED export.crimp Index: export.crimp ================================================================== --- export.crimp +++ /dev/null @@ -1,30 +0,0 @@ -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 Index: flip.crimp ================================================================== --- flip.crimp +++ /dev/null @@ -1,23 +0,0 @@ -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 Index: images/Pentagon.png ================================================================== --- /dev/null +++ images/Pentagon.png cannot compute difference between binary files ADDED images/blink.ppm Index: images/blink.ppm ================================================================== --- /dev/null +++ images/blink.ppm @@ -0,0 +1,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 Index: images/butterfly.png ================================================================== --- /dev/null +++ images/butterfly.png cannot compute difference between binary files ADDED images/colors.ppm Index: images/colors.ppm ================================================================== --- /dev/null +++ images/colors.ppm @@ -0,0 +1,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 Index: images/conformer.png ================================================================== --- /dev/null +++ images/conformer.png cannot compute difference between binary files ADDED images/duck1.png Index: images/duck1.png ================================================================== --- /dev/null +++ images/duck1.png cannot compute difference between binary files ADDED images/duckling1.png Index: images/duckling1.png ================================================================== --- /dev/null +++ images/duckling1.png cannot compute difference between binary files ADDED images/feep-raw.pgm Index: images/feep-raw.pgm ================================================================== --- /dev/null +++ images/feep-raw.pgm cannot compute difference between binary files ADDED images/feep.pgm Index: images/feep.pgm ================================================================== --- /dev/null +++ images/feep.pgm @@ -0,0 +1,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 Index: images/hello.strimj ================================================================== --- /dev/null +++ images/hello.strimj @@ -0,0 +1,8 @@ +@...@.......@.@...... +@...@.......@.@...... +@...@..@@@..@.@..@@@. +@@@@@.@...@.@.@.@...@ +@...@.@@@@@.@.@.@...@ +@...@.@.....@.@.@...@ +@...@.@...@.@.@.@...@ +@...@..@@@..@.@..@@@. ADDED images/plant1.png Index: images/plant1.png ================================================================== --- /dev/null +++ images/plant1.png cannot compute difference between binary files ADDED images/plant2.png Index: images/plant2.png ================================================================== --- /dev/null +++ images/plant2.png cannot compute difference between binary files ADDED images/text1-crop.png Index: images/text1-crop.png ================================================================== --- /dev/null +++ images/text1-crop.png cannot compute difference between binary files ADDED images/text1-full.png Index: images/text1-full.png ================================================================== --- /dev/null +++ images/text1-full.png cannot compute difference between binary files ADDED images/text1-resize.png Index: images/text1-resize.png ================================================================== --- /dev/null +++ images/text1-resize.png cannot compute difference between binary files ADDED images/text2-crop.png Index: images/text2-crop.png ================================================================== --- /dev/null +++ images/text2-crop.png cannot compute difference between binary files ADDED images/text2-full.png Index: images/text2-full.png ================================================================== --- /dev/null +++ images/text2-full.png cannot compute difference between binary files ADDED images/text2-resize.png Index: images/text2-resize.png ================================================================== --- /dev/null +++ images/text2-resize.png cannot compute difference between binary files ADDED images/text3-crop.png Index: images/text3-crop.png ================================================================== --- /dev/null +++ images/text3-crop.png cannot compute difference between binary files ADDED images/text3-full.png Index: images/text3-full.png ================================================================== --- /dev/null +++ images/text3-full.png cannot compute difference between binary files ADDED images/text3-resize.png Index: images/text3-resize.png ================================================================== --- /dev/null +++ images/text3-resize.png cannot compute difference between binary files ADDED images/text4-crop.png Index: images/text4-crop.png ================================================================== --- /dev/null +++ images/text4-crop.png cannot compute difference between binary files ADDED images/text4-full.png Index: images/text4-full.png ================================================================== --- /dev/null +++ images/text4-full.png cannot compute difference between binary files ADDED images/text4-resize.png Index: images/text4-resize.png ================================================================== --- /dev/null +++ images/text4-resize.png cannot compute difference between binary files ADDED images/text5-crop.png Index: images/text5-crop.png ================================================================== --- /dev/null +++ images/text5-crop.png cannot compute difference between binary files ADDED images/text5-full.png Index: images/text5-full.png ================================================================== --- /dev/null +++ images/text5-full.png cannot compute difference between binary files ADDED images/text5-resize.png Index: images/text5-resize.png ================================================================== --- /dev/null +++ images/text5-resize.png cannot compute difference between binary files ADDED images/text6-crop.png Index: images/text6-crop.png ================================================================== --- /dev/null +++ images/text6-crop.png cannot compute difference between binary files ADDED images/text6-full.png Index: images/text6-full.png ================================================================== --- /dev/null +++ images/text6-full.png cannot compute difference between binary files ADDED images/text6-resize.png Index: images/text6-resize.png ================================================================== --- /dev/null +++ images/text6-resize.png cannot compute difference between binary files DELETED import.crimp Index: import.crimp ================================================================== --- import.crimp +++ /dev/null @@ -1,26 +0,0 @@ -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 Index: matrix.crimp ================================================================== --- matrix.crimp +++ /dev/null @@ -1,95 +0,0 @@ -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 Index: merge.crimp ================================================================== --- merge.crimp +++ /dev/null @@ -1,51 +0,0 @@ -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 Index: mirror.crimp ================================================================== --- mirror.crimp +++ /dev/null @@ -1,23 +0,0 @@ -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 Index: operator/add-float-float.crimp ================================================================== --- /dev/null +++ operator/add-float-float.crimp @@ -0,0 +1,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 Index: operator/add-float-grey16.crimp ================================================================== --- /dev/null +++ operator/add-float-grey16.crimp @@ -0,0 +1,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 Index: operator/add-float-grey32.crimp ================================================================== --- /dev/null +++ operator/add-float-grey32.crimp @@ -0,0 +1,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 Index: operator/add-float-grey8.crimp ================================================================== --- /dev/null +++ operator/add-float-grey8.crimp @@ -0,0 +1,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 Index: operator/add-grey8-grey8.crimp ================================================================== --- /dev/null +++ operator/add-grey8-grey8.crimp @@ -0,0 +1,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 Index: operator/add-rgb-grey8.crimp ================================================================== --- /dev/null +++ operator/add-rgb-grey8.crimp @@ -0,0 +1,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 Index: operator/add-rgb-rgb.crimp ================================================================== --- /dev/null +++ operator/add-rgb-rgb.crimp @@ -0,0 +1,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 Index: operator/add-rgba-grey8.crimp ================================================================== --- /dev/null +++ operator/add-rgba-grey8.crimp @@ -0,0 +1,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 Index: operator/add-rgba-rgb.crimp ================================================================== --- /dev/null +++ operator/add-rgba-rgb.crimp @@ -0,0 +1,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 Index: operator/add-rgba-rgba.crimp ================================================================== --- /dev/null +++ operator/add-rgba-rgba.crimp @@ -0,0 +1,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 Index: operator/ahe-grey8.crimp ================================================================== --- /dev/null +++ operator/ahe-grey8.crimp @@ -0,0 +1,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) + + * - 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 Index: operator/ahe-hsv.crimp ================================================================== --- /dev/null +++ operator/ahe-hsv.crimp @@ -0,0 +1,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) + + * - 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 Index: operator/ahe-rgb.crimp ================================================================== --- /dev/null +++ operator/ahe-rgb.crimp @@ -0,0 +1,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 Index: operator/ahe-rgba.crimp ================================================================== --- /dev/null +++ operator/ahe-rgba.crimp @@ -0,0 +1,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 Index: operator/alpha-blend-grey8-grey8.crimp ================================================================== --- /dev/null +++ operator/alpha-blend-grey8-grey8.crimp @@ -0,0 +1,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 Index: operator/alpha-blend-hsv-hsv.crimp ================================================================== --- /dev/null +++ operator/alpha-blend-hsv-hsv.crimp @@ -0,0 +1,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 Index: operator/alpha-blend-rgb-grey8.crimp ================================================================== --- /dev/null +++ operator/alpha-blend-rgb-grey8.crimp @@ -0,0 +1,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 Index: operator/alpha-blend-rgb-rgb.crimp ================================================================== --- /dev/null +++ operator/alpha-blend-rgb-rgb.crimp @@ -0,0 +1,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 Index: operator/alpha-blend-rgb-rgba.crimp ================================================================== --- /dev/null +++ operator/alpha-blend-rgb-rgba.crimp @@ -0,0 +1,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 Index: operator/alpha-blend-rgba-grey8.crimp ================================================================== --- /dev/null +++ operator/alpha-blend-rgba-grey8.crimp @@ -0,0 +1,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 Index: operator/alpha-blend-rgba-rgb.crimp ================================================================== --- /dev/null +++ operator/alpha-blend-rgba-rgb.crimp @@ -0,0 +1,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 Index: operator/alpha-blend-rgba-rgba.crimp ================================================================== --- /dev/null +++ operator/alpha-blend-rgba-rgba.crimp @@ -0,0 +1,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 Index: operator/alpha-over-rgba-rgb.crimp ================================================================== --- /dev/null +++ operator/alpha-over-rgba-rgb.crimp @@ -0,0 +1,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 Index: operator/alpha-over-rgba-rgba.crimp ================================================================== --- /dev/null +++ operator/alpha-over-rgba-rgba.crimp @@ -0,0 +1,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 Index: operator/atan2-float-float.crimp ================================================================== --- /dev/null +++ operator/atan2-float-float.crimp @@ -0,0 +1,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 Index: operator/atan2-float-grey16.crimp ================================================================== --- /dev/null +++ operator/atan2-float-grey16.crimp @@ -0,0 +1,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 Index: operator/atan2-float-grey32.crimp ================================================================== --- /dev/null +++ operator/atan2-float-grey32.crimp @@ -0,0 +1,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 Index: operator/atan2-float-grey8.crimp ================================================================== --- /dev/null +++ operator/atan2-float-grey8.crimp @@ -0,0 +1,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 Index: operator/atan2-grey16-float.crimp ================================================================== --- /dev/null +++ operator/atan2-grey16-float.crimp @@ -0,0 +1,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 Index: operator/atan2-grey16-grey16.crimp ================================================================== --- /dev/null +++ operator/atan2-grey16-grey16.crimp @@ -0,0 +1,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 Index: operator/atan2-grey16-grey32.crimp ================================================================== --- /dev/null +++ operator/atan2-grey16-grey32.crimp @@ -0,0 +1,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 Index: operator/atan2-grey16-grey8.crimp ================================================================== --- /dev/null +++ operator/atan2-grey16-grey8.crimp @@ -0,0 +1,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 Index: operator/atan2-grey32-float.crimp ================================================================== --- /dev/null +++ operator/atan2-grey32-float.crimp @@ -0,0 +1,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 Index: operator/atan2-grey32-grey16.crimp ================================================================== --- /dev/null +++ operator/atan2-grey32-grey16.crimp @@ -0,0 +1,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 Index: operator/atan2-grey32-grey32.crimp ================================================================== --- /dev/null +++ operator/atan2-grey32-grey32.crimp @@ -0,0 +1,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 Index: operator/atan2-grey32-grey8.crimp ================================================================== --- /dev/null +++ operator/atan2-grey32-grey8.crimp @@ -0,0 +1,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 Index: operator/atan2-grey8-float.crimp ================================================================== --- /dev/null +++ operator/atan2-grey8-float.crimp @@ -0,0 +1,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 Index: operator/atan2-grey8-grey16.crimp ================================================================== --- /dev/null +++ operator/atan2-grey8-grey16.crimp @@ -0,0 +1,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 Index: operator/atan2-grey8-grey32.crimp ================================================================== --- /dev/null +++ operator/atan2-grey8-grey32.crimp @@ -0,0 +1,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 Index: operator/atan2-grey8-grey8.crimp ================================================================== --- /dev/null +++ operator/atan2-grey8-grey8.crimp @@ -0,0 +1,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 Index: operator/bilateral-grey8.crimp ================================================================== --- /dev/null +++ operator/bilateral-grey8.crimp @@ -0,0 +1,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 Index: operator/blank-float.crimp ================================================================== --- /dev/null +++ operator/blank-float.crimp @@ -0,0 +1,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 Index: operator/blank-grey16.crimp ================================================================== --- /dev/null +++ operator/blank-grey16.crimp @@ -0,0 +1,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 Index: operator/blank-grey32.crimp ================================================================== --- /dev/null +++ operator/blank-grey32.crimp @@ -0,0 +1,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 Index: operator/blank-grey8.crimp ================================================================== --- /dev/null +++ operator/blank-grey8.crimp @@ -0,0 +1,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 Index: operator/blank-rgb.crimp ================================================================== --- /dev/null +++ operator/blank-rgb.crimp @@ -0,0 +1,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 Index: operator/blank-rgba.crimp ================================================================== --- /dev/null +++ operator/blank-rgba.crimp @@ -0,0 +1,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 Index: operator/channels.crimp ================================================================== --- /dev/null +++ operator/channels.crimp @@ -0,0 +1,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 Index: operator/color-combine.crimp ================================================================== --- /dev/null +++ operator/color-combine.crimp @@ -0,0 +1,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 Index: operator/color-mix.crimp ================================================================== --- /dev/null +++ operator/color-mix.crimp @@ -0,0 +1,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 Index: operator/convert-float-grey16.crimp ================================================================== --- /dev/null +++ operator/convert-float-grey16.crimp @@ -0,0 +1,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 Index: operator/convert-float-grey32.crimp ================================================================== --- /dev/null +++ operator/convert-float-grey32.crimp @@ -0,0 +1,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 Index: operator/convert-float-grey8.crimp ================================================================== --- /dev/null +++ operator/convert-float-grey8.crimp @@ -0,0 +1,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 Index: operator/convert-grey16-float.crimp ================================================================== --- /dev/null +++ operator/convert-grey16-float.crimp @@ -0,0 +1,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 Index: operator/convert-grey32-float.crimp ================================================================== --- /dev/null +++ operator/convert-grey32-float.crimp @@ -0,0 +1,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 Index: operator/convert-grey8-float.crimp ================================================================== --- /dev/null +++ operator/convert-grey8-float.crimp @@ -0,0 +1,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 Index: operator/convert-grey8-hsv.crimp ================================================================== --- /dev/null +++ operator/convert-grey8-hsv.crimp @@ -0,0 +1,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 Index: operator/convert-grey8-rgb.crimp ================================================================== --- /dev/null +++ operator/convert-grey8-rgb.crimp @@ -0,0 +1,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 Index: operator/convert-grey8-rgba.crimp ================================================================== --- /dev/null +++ operator/convert-grey8-rgba.crimp @@ -0,0 +1,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 Index: operator/convert-hsv-rgb.crimp ================================================================== --- /dev/null +++ operator/convert-hsv-rgb.crimp @@ -0,0 +1,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 Index: operator/convert-hsv-rgba.crimp ================================================================== --- /dev/null +++ operator/convert-hsv-rgba.crimp @@ -0,0 +1,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 Index: operator/convert-rgb-grey8.crimp ================================================================== --- /dev/null +++ operator/convert-rgb-grey8.crimp @@ -0,0 +1,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 Index: operator/convert-rgb-hsv.crimp ================================================================== --- /dev/null +++ operator/convert-rgb-hsv.crimp @@ -0,0 +1,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 Index: operator/convert-rgba-grey8.crimp ================================================================== --- /dev/null +++ operator/convert-rgba-grey8.crimp @@ -0,0 +1,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 Index: operator/convert-rgba-hsv.crimp ================================================================== --- /dev/null +++ operator/convert-rgba-hsv.crimp @@ -0,0 +1,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 Index: operator/convert-rgba-rgb.crimp ================================================================== --- /dev/null +++ operator/convert-rgba-rgb.crimp @@ -0,0 +1,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 Index: operator/convolve-float-float.crimp ================================================================== --- /dev/null +++ operator/convolve-float-float.crimp @@ -0,0 +1,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 Index: operator/convolve-float-grey16.crimp ================================================================== --- /dev/null +++ operator/convolve-float-grey16.crimp @@ -0,0 +1,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 Index: operator/convolve-float-grey32.crimp ================================================================== --- /dev/null +++ operator/convolve-float-grey32.crimp @@ -0,0 +1,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 Index: operator/convolve-float-grey8.crimp ================================================================== --- /dev/null +++ operator/convolve-float-grey8.crimp @@ -0,0 +1,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 Index: operator/convolve-float-hsv.crimp ================================================================== --- /dev/null +++ operator/convolve-float-hsv.crimp @@ -0,0 +1,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 Index: operator/convolve-float-rgb.crimp ================================================================== --- /dev/null +++ operator/convolve-float-rgb.crimp @@ -0,0 +1,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 Index: operator/convolve-float-rgba.crimp ================================================================== --- /dev/null +++ operator/convolve-float-rgba.crimp @@ -0,0 +1,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 Index: operator/convolve-sgrey8-float.crimp ================================================================== --- /dev/null +++ operator/convolve-sgrey8-float.crimp @@ -0,0 +1,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 Index: operator/convolve-sgrey8-grey16.crimp ================================================================== --- /dev/null +++ operator/convolve-sgrey8-grey16.crimp @@ -0,0 +1,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 Index: operator/convolve-sgrey8-grey32.crimp ================================================================== --- /dev/null +++ operator/convolve-sgrey8-grey32.crimp @@ -0,0 +1,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 Index: operator/convolve-sgrey8-grey8.crimp ================================================================== --- /dev/null +++ operator/convolve-sgrey8-grey8.crimp @@ -0,0 +1,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 Index: operator/convolve-sgrey8-hsv.crimp ================================================================== --- /dev/null +++ operator/convolve-sgrey8-hsv.crimp @@ -0,0 +1,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 Index: operator/convolve-sgrey8-rgb.crimp ================================================================== --- /dev/null +++ operator/convolve-sgrey8-rgb.crimp @@ -0,0 +1,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 Index: operator/convolve-sgrey8-rgba.crimp ================================================================== --- /dev/null +++ operator/convolve-sgrey8-rgba.crimp @@ -0,0 +1,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 Index: operator/crop-float.crimp ================================================================== --- /dev/null +++ operator/crop-float.crimp @@ -0,0 +1,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 Index: operator/crop-grey16.crimp ================================================================== --- /dev/null +++ operator/crop-grey16.crimp @@ -0,0 +1,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 Index: operator/crop-grey32.crimp ================================================================== --- /dev/null +++ operator/crop-grey32.crimp @@ -0,0 +1,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 Index: operator/crop-grey8.crimp ================================================================== --- /dev/null +++ operator/crop-grey8.crimp @@ -0,0 +1,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 Index: operator/crop-hsv.crimp ================================================================== --- /dev/null +++ operator/crop-hsv.crimp @@ -0,0 +1,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 Index: operator/crop-rgb.crimp ================================================================== --- /dev/null +++ operator/crop-rgb.crimp @@ -0,0 +1,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 Index: operator/crop-rgba.crimp ================================================================== --- /dev/null +++ operator/crop-rgba.crimp @@ -0,0 +1,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 Index: operator/difference-float-float.crimp ================================================================== --- /dev/null +++ operator/difference-float-float.crimp @@ -0,0 +1,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 Index: operator/difference-float-grey16.crimp ================================================================== --- /dev/null +++ operator/difference-float-grey16.crimp @@ -0,0 +1,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 Index: operator/difference-float-grey32.crimp ================================================================== --- /dev/null +++ operator/difference-float-grey32.crimp @@ -0,0 +1,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 Index: operator/difference-float-grey8.crimp ================================================================== --- /dev/null +++ operator/difference-float-grey8.crimp @@ -0,0 +1,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 Index: operator/difference-grey8-grey8.crimp ================================================================== --- /dev/null +++ operator/difference-grey8-grey8.crimp @@ -0,0 +1,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 Index: operator/difference-rgb-grey8.crimp ================================================================== --- /dev/null +++ operator/difference-rgb-grey8.crimp @@ -0,0 +1,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 Index: operator/difference-rgb-rgb.crimp ================================================================== --- /dev/null +++ operator/difference-rgb-rgb.crimp @@ -0,0 +1,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 Index: operator/difference-rgba-grey8.crimp ================================================================== --- /dev/null +++ operator/difference-rgba-grey8.crimp @@ -0,0 +1,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 Index: operator/difference-rgba-rgb.crimp ================================================================== --- /dev/null +++ operator/difference-rgba-rgb.crimp @@ -0,0 +1,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 Index: operator/difference-rgba-rgba.crimp ================================================================== --- /dev/null +++ operator/difference-rgba-rgba.crimp @@ -0,0 +1,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 Index: operator/dimensions.crimp ================================================================== --- /dev/null +++ operator/dimensions.crimp @@ -0,0 +1,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 Index: operator/div-float-float.crimp ================================================================== --- /dev/null +++ operator/div-float-float.crimp @@ -0,0 +1,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 Index: operator/div-float-grey16.crimp ================================================================== --- /dev/null +++ operator/div-float-grey16.crimp @@ -0,0 +1,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 Index: operator/div-float-grey32.crimp ================================================================== --- /dev/null +++ operator/div-float-grey32.crimp @@ -0,0 +1,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 Index: operator/div-float-grey8.crimp ================================================================== --- /dev/null +++ operator/div-float-grey8.crimp @@ -0,0 +1,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 Index: operator/div-grey16-float.crimp ================================================================== --- /dev/null +++ operator/div-grey16-float.crimp @@ -0,0 +1,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 Index: operator/div-grey32-float.crimp ================================================================== --- /dev/null +++ operator/div-grey32-float.crimp @@ -0,0 +1,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 Index: operator/div-grey8-float.crimp ================================================================== --- /dev/null +++ operator/div-grey8-float.crimp @@ -0,0 +1,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 Index: operator/div-grey8-grey8.crimp ================================================================== --- /dev/null +++ operator/div-grey8-grey8.crimp @@ -0,0 +1,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 Index: operator/div-grey8-rgb.crimp ================================================================== --- /dev/null +++ operator/div-grey8-rgb.crimp @@ -0,0 +1,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 Index: operator/div-grey8-rgba.crimp ================================================================== --- /dev/null +++ operator/div-grey8-rgba.crimp @@ -0,0 +1,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 Index: operator/div-rgb-grey8.crimp ================================================================== --- /dev/null +++ operator/div-rgb-grey8.crimp @@ -0,0 +1,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 Index: operator/div-rgb-rgb.crimp ================================================================== --- /dev/null +++ operator/div-rgb-rgb.crimp @@ -0,0 +1,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 Index: operator/div-rgb-rgba.crimp ================================================================== --- /dev/null +++ operator/div-rgb-rgba.crimp @@ -0,0 +1,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 Index: operator/div-rgba-grey8.crimp ================================================================== --- /dev/null +++ operator/div-rgba-grey8.crimp @@ -0,0 +1,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 Index: operator/div-rgba-rgb.crimp ================================================================== --- /dev/null +++ operator/div-rgba-rgb.crimp @@ -0,0 +1,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 Index: operator/div-rgba-rgba.crimp ================================================================== --- /dev/null +++ operator/div-rgba-rgba.crimp @@ -0,0 +1,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 Index: operator/downsample-float.crimp ================================================================== --- /dev/null +++ operator/downsample-float.crimp @@ -0,0 +1,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 Index: operator/downsample-grey16.crimp ================================================================== --- /dev/null +++ operator/downsample-grey16.crimp @@ -0,0 +1,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 Index: operator/downsample-grey32.crimp ================================================================== --- /dev/null +++ operator/downsample-grey32.crimp @@ -0,0 +1,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 Index: operator/downsample-grey8.crimp ================================================================== --- /dev/null +++ operator/downsample-grey8.crimp @@ -0,0 +1,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 Index: operator/downsample-hsv.crimp ================================================================== --- /dev/null +++ operator/downsample-hsv.crimp @@ -0,0 +1,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 Index: operator/downsample-rgb.crimp ================================================================== --- /dev/null +++ operator/downsample-rgb.crimp @@ -0,0 +1,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 Index: operator/downsample-rgba.crimp ================================================================== --- /dev/null +++ operator/downsample-rgba.crimp @@ -0,0 +1,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 Index: operator/downsamplex-float.crimp ================================================================== --- /dev/null +++ operator/downsamplex-float.crimp @@ -0,0 +1,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 Index: operator/downsamplex-grey16.crimp ================================================================== --- /dev/null +++ operator/downsamplex-grey16.crimp @@ -0,0 +1,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 Index: operator/downsamplex-grey32.crimp ================================================================== --- /dev/null +++ operator/downsamplex-grey32.crimp @@ -0,0 +1,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 Index: operator/downsamplex-grey8.crimp ================================================================== --- /dev/null +++ operator/downsamplex-grey8.crimp @@ -0,0 +1,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 Index: operator/downsamplex-hsv.crimp ================================================================== --- /dev/null +++ operator/downsamplex-hsv.crimp @@ -0,0 +1,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 Index: operator/downsamplex-rgb.crimp ================================================================== --- /dev/null +++ operator/downsamplex-rgb.crimp @@ -0,0 +1,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 Index: operator/downsamplex-rgba.crimp ================================================================== --- /dev/null +++ operator/downsamplex-rgba.crimp @@ -0,0 +1,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 Index: operator/downsampley-float.crimp ================================================================== --- /dev/null +++ operator/downsampley-float.crimp @@ -0,0 +1,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 Index: operator/downsampley-grey16.crimp ================================================================== --- /dev/null +++ operator/downsampley-grey16.crimp @@ -0,0 +1,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 Index: operator/downsampley-grey32.crimp ================================================================== --- /dev/null +++ operator/downsampley-grey32.crimp @@ -0,0 +1,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 Index: operator/downsampley-grey8.crimp ================================================================== --- /dev/null +++ operator/downsampley-grey8.crimp @@ -0,0 +1,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 Index: operator/downsampley-hsv.crimp ================================================================== --- /dev/null +++ operator/downsampley-hsv.crimp @@ -0,0 +1,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 Index: operator/downsampley-rgb.crimp ================================================================== --- /dev/null +++ operator/downsampley-rgb.crimp @@ -0,0 +1,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 Index: operator/downsampley-rgba.crimp ================================================================== --- /dev/null +++ operator/downsampley-rgba.crimp @@ -0,0 +1,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 Index: operator/exp-float.crimp ================================================================== --- /dev/null +++ operator/exp-float.crimp @@ -0,0 +1,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 Index: operator/expand-float-const.crimp ================================================================== --- /dev/null +++ operator/expand-float-const.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-float-extend.crimp ================================================================== --- /dev/null +++ operator/expand-float-extend.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-float-mirror.crimp ================================================================== --- /dev/null +++ operator/expand-float-mirror.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-float-replicate.crimp ================================================================== --- /dev/null +++ operator/expand-float-replicate.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-float-wrap.crimp ================================================================== --- /dev/null +++ operator/expand-float-wrap.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-grey16-const.crimp ================================================================== --- /dev/null +++ operator/expand-grey16-const.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-grey16-extend.crimp ================================================================== --- /dev/null +++ operator/expand-grey16-extend.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-grey16-mirror.crimp ================================================================== --- /dev/null +++ operator/expand-grey16-mirror.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-grey16-replicate.crimp ================================================================== --- /dev/null +++ operator/expand-grey16-replicate.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-grey16-wrap.crimp ================================================================== --- /dev/null +++ operator/expand-grey16-wrap.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-grey32-const.crimp ================================================================== --- /dev/null +++ operator/expand-grey32-const.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-grey32-extend.crimp ================================================================== --- /dev/null +++ operator/expand-grey32-extend.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-grey32-mirror.crimp ================================================================== --- /dev/null +++ operator/expand-grey32-mirror.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-grey32-replicate.crimp ================================================================== --- /dev/null +++ operator/expand-grey32-replicate.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-grey32-wrap.crimp ================================================================== --- /dev/null +++ operator/expand-grey32-wrap.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-grey8-const.crimp ================================================================== --- /dev/null +++ operator/expand-grey8-const.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-grey8-extend.crimp ================================================================== --- /dev/null +++ operator/expand-grey8-extend.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-grey8-mirror.crimp ================================================================== --- /dev/null +++ operator/expand-grey8-mirror.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-grey8-replicate.crimp ================================================================== --- /dev/null +++ operator/expand-grey8-replicate.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-grey8-wrap.crimp ================================================================== --- /dev/null +++ operator/expand-grey8-wrap.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-hsv-const.crimp ================================================================== --- /dev/null +++ operator/expand-hsv-const.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-hsv-extend.crimp ================================================================== --- /dev/null +++ operator/expand-hsv-extend.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-hsv-mirror.crimp ================================================================== --- /dev/null +++ operator/expand-hsv-mirror.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-hsv-replicate.crimp ================================================================== --- /dev/null +++ operator/expand-hsv-replicate.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-hsv-wrap.crimp ================================================================== --- /dev/null +++ operator/expand-hsv-wrap.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-rgb-const.crimp ================================================================== --- /dev/null +++ operator/expand-rgb-const.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-rgb-extend.crimp ================================================================== --- /dev/null +++ operator/expand-rgb-extend.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-rgb-mirror.crimp ================================================================== --- /dev/null +++ operator/expand-rgb-mirror.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-rgb-replicate.crimp ================================================================== --- /dev/null +++ operator/expand-rgb-replicate.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-rgb-wrap.crimp ================================================================== --- /dev/null +++ operator/expand-rgb-wrap.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-rgba-const.crimp ================================================================== --- /dev/null +++ operator/expand-rgba-const.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-rgba-extend.crimp ================================================================== --- /dev/null +++ operator/expand-rgba-extend.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-rgba-mirror.crimp ================================================================== --- /dev/null +++ operator/expand-rgba-mirror.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-rgba-replicate.crimp ================================================================== --- /dev/null +++ operator/expand-rgba-replicate.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/expand-rgba-wrap.crimp ================================================================== --- /dev/null +++ operator/expand-rgba-wrap.crimp @@ -0,0 +1,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 + +/* vim: 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 Index: operator/fftx-float.crimp ================================================================== --- /dev/null +++ operator/fftx-float.crimp @@ -0,0 +1,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 Index: operator/fftx-grey16.crimp ================================================================== --- /dev/null +++ operator/fftx-grey16.crimp @@ -0,0 +1,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 Index: operator/fftx-grey32.crimp ================================================================== --- /dev/null +++ operator/fftx-grey32.crimp @@ -0,0 +1,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 Index: operator/fftx-grey8.crimp ================================================================== --- /dev/null +++ operator/fftx-grey8.crimp @@ -0,0 +1,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 Index: operator/flip-horizontal-float.crimp ================================================================== --- /dev/null +++ operator/flip-horizontal-float.crimp @@ -0,0 +1,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 Index: operator/flip-horizontal-grey8.crimp ================================================================== --- /dev/null +++ operator/flip-horizontal-grey8.crimp @@ -0,0 +1,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 Index: operator/flip-horizontal-hsv.crimp ================================================================== --- /dev/null +++ operator/flip-horizontal-hsv.crimp @@ -0,0 +1,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 Index: operator/flip-horizontal-rgb.crimp ================================================================== --- /dev/null +++ operator/flip-horizontal-rgb.crimp @@ -0,0 +1,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 Index: operator/flip-horizontal-rgba.crimp ================================================================== --- /dev/null +++ operator/flip-horizontal-rgba.crimp @@ -0,0 +1,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 Index: operator/flip-transpose-float.crimp ================================================================== --- /dev/null +++ operator/flip-transpose-float.crimp @@ -0,0 +1,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 Index: operator/flip-transpose-grey8.crimp ================================================================== --- /dev/null +++ operator/flip-transpose-grey8.crimp @@ -0,0 +1,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 Index: operator/flip-transpose-hsv.crimp ================================================================== --- /dev/null +++ operator/flip-transpose-hsv.crimp @@ -0,0 +1,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 Index: operator/flip-transpose-rgb.crimp ================================================================== --- /dev/null +++ operator/flip-transpose-rgb.crimp @@ -0,0 +1,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 Index: operator/flip-transpose-rgba.crimp ================================================================== --- /dev/null +++ operator/flip-transpose-rgba.crimp @@ -0,0 +1,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 Index: operator/flip-transverse-float.crimp ================================================================== --- /dev/null +++ operator/flip-transverse-float.crimp @@ -0,0 +1,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 Index: operator/flip-transverse-grey8.crimp ================================================================== --- /dev/null +++ operator/flip-transverse-grey8.crimp @@ -0,0 +1,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 Index: operator/flip-transverse-hsv.crimp ================================================================== --- /dev/null +++ operator/flip-transverse-hsv.crimp @@ -0,0 +1,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 Index: operator/flip-transverse-rgb.crimp ================================================================== --- /dev/null +++ operator/flip-transverse-rgb.crimp @@ -0,0 +1,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 Index: operator/flip-transverse-rgba.crimp ================================================================== --- /dev/null +++ operator/flip-transverse-rgba.crimp @@ -0,0 +1,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 Index: operator/flip-vertical-float.crimp ================================================================== --- /dev/null +++ operator/flip-vertical-float.crimp @@ -0,0 +1,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 Index: operator/flip-vertical-grey8.crimp ================================================================== --- /dev/null +++ operator/flip-vertical-grey8.crimp @@ -0,0 +1,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 Index: operator/flip-vertical-hsv.crimp ================================================================== --- /dev/null +++ operator/flip-vertical-hsv.crimp @@ -0,0 +1,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 Index: operator/flip-vertical-rgb.crimp ================================================================== --- /dev/null +++ operator/flip-vertical-rgb.crimp @@ -0,0 +1,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 Index: operator/flip-vertical-rgba.crimp ================================================================== --- /dev/null +++ operator/flip-vertical-rgba.crimp @@ -0,0 +1,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 Index: operator/height.crimp ================================================================== --- /dev/null +++ operator/height.crimp @@ -0,0 +1,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 Index: operator/histogram.crimp ================================================================== --- /dev/null +++ operator/histogram.crimp @@ -0,0 +1,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 Index: operator/hough-grey8.crimp ================================================================== --- /dev/null +++ operator/hough-grey8.crimp @@ -0,0 +1,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 Index: operator/hypot-float-float.crimp ================================================================== --- /dev/null +++ operator/hypot-float-float.crimp @@ -0,0 +1,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 Index: operator/hypot-float-grey16.crimp ================================================================== --- /dev/null +++ operator/hypot-float-grey16.crimp @@ -0,0 +1,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 Index: operator/hypot-float-grey32.crimp ================================================================== --- /dev/null +++ operator/hypot-float-grey32.crimp @@ -0,0 +1,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 Index: operator/hypot-float-grey8.crimp ================================================================== --- /dev/null +++ operator/hypot-float-grey8.crimp @@ -0,0 +1,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 Index: operator/hypot-grey16-grey16.crimp ================================================================== --- /dev/null +++ operator/hypot-grey16-grey16.crimp @@ -0,0 +1,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 Index: operator/hypot-grey16-grey8.crimp ================================================================== --- /dev/null +++ operator/hypot-grey16-grey8.crimp @@ -0,0 +1,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 Index: operator/hypot-grey32-grey16.crimp ================================================================== --- /dev/null +++ operator/hypot-grey32-grey16.crimp @@ -0,0 +1,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 Index: operator/hypot-grey32-grey32.crimp ================================================================== --- /dev/null +++ operator/hypot-grey32-grey32.crimp @@ -0,0 +1,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 Index: operator/hypot-grey32-grey8.crimp ================================================================== --- /dev/null +++ operator/hypot-grey32-grey8.crimp @@ -0,0 +1,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 Index: operator/hypot-grey8-grey8.crimp ================================================================== --- /dev/null +++ operator/hypot-grey8-grey8.crimp @@ -0,0 +1,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 Index: operator/ifftx-float.crimp ================================================================== --- /dev/null +++ operator/ifftx-float.crimp @@ -0,0 +1,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 Index: operator/ifftx-grey16.crimp ================================================================== --- /dev/null +++ operator/ifftx-grey16.crimp @@ -0,0 +1,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 Index: operator/ifftx-grey32.crimp ================================================================== --- /dev/null +++ operator/ifftx-grey32.crimp @@ -0,0 +1,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 Index: operator/ifftx-grey8.crimp ================================================================== --- /dev/null +++ operator/ifftx-grey8.crimp @@ -0,0 +1,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 Index: operator/integrate-float.crimp ================================================================== --- /dev/null +++ operator/integrate-float.crimp @@ -0,0 +1,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 Index: operator/integrate-grey16.crimp ================================================================== --- /dev/null +++ operator/integrate-grey16.crimp @@ -0,0 +1,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 Index: operator/integrate-grey32.crimp ================================================================== --- /dev/null +++ operator/integrate-grey32.crimp @@ -0,0 +1,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 Index: operator/integrate-grey8.crimp ================================================================== --- /dev/null +++ operator/integrate-grey8.crimp @@ -0,0 +1,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 Index: operator/invert-grey8.crimp ================================================================== --- /dev/null +++ operator/invert-grey8.crimp @@ -0,0 +1,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 Index: operator/invert-rgb.crimp ================================================================== --- /dev/null +++ operator/invert-rgb.crimp @@ -0,0 +1,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 Index: operator/invert-rgba.crimp ================================================================== --- /dev/null +++ operator/invert-rgba.crimp @@ -0,0 +1,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 Index: operator/join-hsv.crimp ================================================================== --- /dev/null +++ operator/join-hsv.crimp @@ -0,0 +1,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 Index: operator/join-rgb.crimp ================================================================== --- /dev/null +++ operator/join-rgb.crimp @@ -0,0 +1,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 Index: operator/join-rgba.crimp ================================================================== --- /dev/null +++ operator/join-rgba.crimp @@ -0,0 +1,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 Index: operator/joint_bilateral-grey8.crimp ================================================================== --- /dev/null +++ operator/joint_bilateral-grey8.crimp @@ -0,0 +1,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 Index: operator/log-float.crimp ================================================================== --- /dev/null +++ operator/log-float.crimp @@ -0,0 +1,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 Index: operator/log10-float.crimp ================================================================== --- /dev/null +++ operator/log10-float.crimp @@ -0,0 +1,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 Index: operator/map-grey8.crimp ================================================================== --- /dev/null +++ operator/map-grey8.crimp @@ -0,0 +1,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 Index: operator/map-hsv.crimp ================================================================== --- /dev/null +++ operator/map-hsv.crimp @@ -0,0 +1,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 Index: operator/map-rgb.crimp ================================================================== --- /dev/null +++ operator/map-rgb.crimp @@ -0,0 +1,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 Index: operator/map-rgba.crimp ================================================================== --- /dev/null +++ operator/map-rgba.crimp @@ -0,0 +1,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 Index: operator/map2-hsv.crimp ================================================================== --- /dev/null +++ operator/map2-hsv.crimp @@ -0,0 +1,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 Index: operator/map2-rgb.crimp ================================================================== --- /dev/null +++ operator/map2-rgb.crimp @@ -0,0 +1,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 Index: operator/map2-rgba.crimp ================================================================== --- /dev/null +++ operator/map2-rgba.crimp @@ -0,0 +1,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 Index: operator/matinv3x3-float.crimp ================================================================== --- /dev/null +++ operator/matinv3x3-float.crimp @@ -0,0 +1,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 Index: operator/matmul3x3-float.crimp ================================================================== --- /dev/null +++ operator/matmul3x3-float.crimp @@ -0,0 +1,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 Index: operator/matrix.crimp ================================================================== --- /dev/null +++ operator/matrix.crimp @@ -0,0 +1,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 Index: operator/max-float-float.crimp ================================================================== --- /dev/null +++ operator/max-float-float.crimp @@ -0,0 +1,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 Index: operator/max-float-grey16.crimp ================================================================== --- /dev/null +++ operator/max-float-grey16.crimp @@ -0,0 +1,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 Index: operator/max-float-grey32.crimp ================================================================== --- /dev/null +++ operator/max-float-grey32.crimp @@ -0,0 +1,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 Index: operator/max-float-grey8.crimp ================================================================== --- /dev/null +++ operator/max-float-grey8.crimp @@ -0,0 +1,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 Index: operator/max-grey8-grey8.crimp ================================================================== --- /dev/null +++ operator/max-grey8-grey8.crimp @@ -0,0 +1,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 Index: operator/max-rgb-grey8.crimp ================================================================== --- /dev/null +++ operator/max-rgb-grey8.crimp @@ -0,0 +1,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 Index: operator/max-rgb-rgb.crimp ================================================================== --- /dev/null +++ operator/max-rgb-rgb.crimp @@ -0,0 +1,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 Index: operator/max-rgba-grey8.crimp ================================================================== --- /dev/null +++ operator/max-rgba-grey8.crimp @@ -0,0 +1,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 Index: operator/max-rgba-rgb.crimp ================================================================== --- /dev/null +++ operator/max-rgba-rgb.crimp @@ -0,0 +1,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 Index: operator/max-rgba-rgba.crimp ================================================================== --- /dev/null +++ operator/max-rgba-rgba.crimp @@ -0,0 +1,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 Index: operator/meta_get.crimp ================================================================== --- /dev/null +++ operator/meta_get.crimp @@ -0,0 +1,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 Index: operator/meta_set.crimp ================================================================== --- /dev/null +++ operator/meta_set.crimp @@ -0,0 +1,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 Index: operator/min-float-float.crimp ================================================================== --- /dev/null +++ operator/min-float-float.crimp @@ -0,0 +1,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 Index: operator/min-float-grey16.crimp ================================================================== --- /dev/null +++ operator/min-float-grey16.crimp @@ -0,0 +1,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 Index: operator/min-float-grey32.crimp ================================================================== --- /dev/null +++ operator/min-float-grey32.crimp @@ -0,0 +1,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 Index: operator/min-float-grey8.crimp ================================================================== --- /dev/null +++ operator/min-float-grey8.crimp @@ -0,0 +1,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 Index: operator/min-grey8-grey8.crimp ================================================================== --- /dev/null +++ operator/min-grey8-grey8.crimp @@ -0,0 +1,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 Index: operator/min-rgb-grey8.crimp ================================================================== --- /dev/null +++ operator/min-rgb-grey8.crimp @@ -0,0 +1,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 Index: operator/min-rgb-rgb.crimp ================================================================== --- /dev/null +++ operator/min-rgb-rgb.crimp @@ -0,0 +1,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 Index: operator/min-rgba-grey8.crimp ================================================================== --- /dev/null +++ operator/min-rgba-grey8.crimp @@ -0,0 +1,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 Index: operator/min-rgba-rgb.crimp ================================================================== --- /dev/null +++ operator/min-rgba-rgb.crimp @@ -0,0 +1,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 Index: operator/min-rgba-rgba.crimp ================================================================== --- /dev/null +++ operator/min-rgba-rgba.crimp @@ -0,0 +1,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 Index: operator/montageh-float.crimp ================================================================== --- /dev/null +++ operator/montageh-float.crimp @@ -0,0 +1,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 Index: operator/montageh-grey8.crimp ================================================================== --- /dev/null +++ operator/montageh-grey8.crimp @@ -0,0 +1,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 Index: operator/montageh-hsv.crimp ================================================================== --- /dev/null +++ operator/montageh-hsv.crimp @@ -0,0 +1,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 Index: operator/montageh-rgb.crimp ================================================================== --- /dev/null +++ operator/montageh-rgb.crimp @@ -0,0 +1,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 Index: operator/montageh-rgba.crimp ================================================================== --- /dev/null +++ operator/montageh-rgba.crimp @@ -0,0 +1,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 Index: operator/montagev-float.crimp ================================================================== --- /dev/null +++ operator/montagev-float.crimp @@ -0,0 +1,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 Index: operator/montagev-grey8.crimp ================================================================== --- /dev/null +++ operator/montagev-grey8.crimp @@ -0,0 +1,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 Index: operator/montagev-hsv.crimp ================================================================== --- /dev/null +++ operator/montagev-hsv.crimp @@ -0,0 +1,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 Index: operator/montagev-rgb.crimp ================================================================== --- /dev/null +++ operator/montagev-rgb.crimp @@ -0,0 +1,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 Index: operator/montagev-rgba.crimp ================================================================== --- /dev/null +++ operator/montagev-rgba.crimp @@ -0,0 +1,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 Index: operator/multiply-float-float.crimp ================================================================== --- /dev/null +++ operator/multiply-float-float.crimp @@ -0,0 +1,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 Index: operator/multiply-float-grey16.crimp ================================================================== --- /dev/null +++ operator/multiply-float-grey16.crimp @@ -0,0 +1,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 Index: operator/multiply-float-grey32.crimp ================================================================== --- /dev/null +++ operator/multiply-float-grey32.crimp @@ -0,0 +1,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 Index: operator/multiply-float-grey8.crimp ================================================================== --- /dev/null +++ operator/multiply-float-grey8.crimp @@ -0,0 +1,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 Index: operator/multiply-grey8-grey8.crimp ================================================================== --- /dev/null +++ operator/multiply-grey8-grey8.crimp @@ -0,0 +1,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 Index: operator/multiply-rgb-grey8.crimp ================================================================== --- /dev/null +++ operator/multiply-rgb-grey8.crimp @@ -0,0 +1,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 Index: operator/multiply-rgb-rgb.crimp ================================================================== --- /dev/null +++ operator/multiply-rgb-rgb.crimp @@ -0,0 +1,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 Index: operator/multiply-rgba-grey8.crimp ================================================================== --- /dev/null +++ operator/multiply-rgba-grey8.crimp @@ -0,0 +1,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 Index: operator/multiply-rgba-rgb.crimp ================================================================== --- /dev/null +++ operator/multiply-rgba-rgb.crimp @@ -0,0 +1,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 Index: operator/multiply-rgba-rgba.crimp ================================================================== --- /dev/null +++ operator/multiply-rgba-rgba.crimp @@ -0,0 +1,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 Index: operator/non_max_suppression.crimp ================================================================== --- /dev/null +++ operator/non_max_suppression.crimp @@ -0,0 +1,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 Index: operator/offset-float.crimp ================================================================== --- /dev/null +++ operator/offset-float.crimp @@ -0,0 +1,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 Index: operator/pixel.crimp ================================================================== --- /dev/null +++ operator/pixel.crimp @@ -0,0 +1,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 Index: operator/pow-float-float.crimp ================================================================== --- /dev/null +++ operator/pow-float-float.crimp @@ -0,0 +1,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 Index: operator/psychedelia.crimp ================================================================== --- /dev/null +++ operator/psychedelia.crimp @@ -0,0 +1,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 Index: operator/read-pgm.crimp ================================================================== --- /dev/null +++ operator/read-pgm.crimp @@ -0,0 +1,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 Index: operator/read-ppm.crimp ================================================================== --- /dev/null +++ operator/read-ppm.crimp @@ -0,0 +1,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 Index: operator/read-tcl-float.crimp ================================================================== --- /dev/null +++ operator/read-tcl-float.crimp @@ -0,0 +1,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 Index: operator/read-tcl-grey8.crimp ================================================================== --- /dev/null +++ operator/read-tcl-grey8.crimp @@ -0,0 +1,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 Index: operator/read-tk.crimp ================================================================== --- /dev/null +++ operator/read-tk.crimp @@ -0,0 +1,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 Index: operator/region_sum.crimp ================================================================== --- /dev/null +++ operator/region_sum.crimp @@ -0,0 +1,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 Index: operator/rof-grey8.crimp ================================================================== --- /dev/null +++ operator/rof-grey8.crimp @@ -0,0 +1,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 Index: operator/rof-hsv.crimp ================================================================== --- /dev/null +++ operator/rof-hsv.crimp @@ -0,0 +1,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 Index: operator/rof-rgb.crimp ================================================================== --- /dev/null +++ operator/rof-rgb.crimp @@ -0,0 +1,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 Index: operator/rof-rgba.crimp ================================================================== --- /dev/null +++ operator/rof-rgba.crimp @@ -0,0 +1,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 Index: operator/scale-float.crimp ================================================================== --- /dev/null +++ operator/scale-float.crimp @@ -0,0 +1,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 Index: operator/screen-grey8-grey8.crimp ================================================================== --- /dev/null +++ operator/screen-grey8-grey8.crimp @@ -0,0 +1,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 Index: operator/screen-rgb-grey8.crimp ================================================================== --- /dev/null +++ operator/screen-rgb-grey8.crimp @@ -0,0 +1,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 Index: operator/screen-rgb-rgb.crimp ================================================================== --- /dev/null +++ operator/screen-rgb-rgb.crimp @@ -0,0 +1,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 Index: operator/screen-rgba-grey8.crimp ================================================================== --- /dev/null +++ operator/screen-rgba-grey8.crimp @@ -0,0 +1,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 Index: operator/screen-rgba-rgb.crimp ================================================================== --- /dev/null +++ operator/screen-rgba-rgb.crimp @@ -0,0 +1,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 Index: operator/screen-rgba-rgba.crimp ================================================================== --- /dev/null +++ operator/screen-rgba-rgba.crimp @@ -0,0 +1,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 Index: operator/setalpha-rgb-grey8.crimp ================================================================== --- /dev/null +++ operator/setalpha-rgb-grey8.crimp @@ -0,0 +1,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 Index: operator/setalpha-rgb-rgba.crimp ================================================================== --- /dev/null +++ operator/setalpha-rgb-rgba.crimp @@ -0,0 +1,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 Index: operator/setalpha-rgba-grey8.crimp ================================================================== --- /dev/null +++ operator/setalpha-rgba-grey8.crimp @@ -0,0 +1,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 Index: operator/setalpha-rgba-rgba.crimp ================================================================== --- /dev/null +++ operator/setalpha-rgba-rgba.crimp @@ -0,0 +1,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 Index: operator/split-hsv.crimp ================================================================== --- /dev/null +++ operator/split-hsv.crimp @@ -0,0 +1,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 Index: operator/split-rgb.crimp ================================================================== --- /dev/null +++ operator/split-rgb.crimp @@ -0,0 +1,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 Index: operator/split-rgba.crimp ================================================================== --- /dev/null +++ operator/split-rgba.crimp @@ -0,0 +1,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 Index: operator/sqrt-float.crimp ================================================================== --- /dev/null +++ operator/sqrt-float.crimp @@ -0,0 +1,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 Index: operator/stats-float.crimp ================================================================== --- /dev/null +++ operator/stats-float.crimp @@ -0,0 +1,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 Index: operator/stats-grey16.crimp ================================================================== --- /dev/null +++ operator/stats-grey16.crimp @@ -0,0 +1,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 Index: operator/stats-grey32.crimp ================================================================== --- /dev/null +++ operator/stats-grey32.crimp @@ -0,0 +1,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 Index: operator/subtract-float-float.crimp ================================================================== --- /dev/null +++ operator/subtract-float-float.crimp @@ -0,0 +1,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 Index: operator/subtract-float-grey16.crimp ================================================================== --- /dev/null +++ operator/subtract-float-grey16.crimp @@ -0,0 +1,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 Index: operator/subtract-float-grey32.crimp ================================================================== --- /dev/null +++ operator/subtract-float-grey32.crimp @@ -0,0 +1,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 Index: operator/subtract-float-grey8.crimp ================================================================== --- /dev/null +++ operator/subtract-float-grey8.crimp @@ -0,0 +1,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 Index: operator/subtract-grey16-float.crimp ================================================================== --- /dev/null +++ operator/subtract-grey16-float.crimp @@ -0,0 +1,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 Index: operator/subtract-grey32-float.crimp ================================================================== --- /dev/null +++ operator/subtract-grey32-float.crimp @@ -0,0 +1,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 Index: operator/subtract-grey8-float.crimp ================================================================== --- /dev/null +++ operator/subtract-grey8-float.crimp @@ -0,0 +1,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 Index: operator/subtract-grey8-grey8.crimp ================================================================== --- /dev/null +++ operator/subtract-grey8-grey8.crimp @@ -0,0 +1,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 Index: operator/subtract-grey8-rgb.crimp ================================================================== --- /dev/null +++ operator/subtract-grey8-rgb.crimp @@ -0,0 +1,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 Index: operator/subtract-grey8-rgba.crimp ================================================================== --- /dev/null +++ operator/subtract-grey8-rgba.crimp @@ -0,0 +1,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 Index: operator/subtract-rgb-grey8.crimp ================================================================== --- /dev/null +++ operator/subtract-rgb-grey8.crimp @@ -0,0 +1,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 Index: operator/subtract-rgb-rgb.crimp ================================================================== --- /dev/null +++ operator/subtract-rgb-rgb.crimp @@ -0,0 +1,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 Index: operator/subtract-rgb-rgba.crimp ================================================================== --- /dev/null +++ operator/subtract-rgb-rgba.crimp @@ -0,0 +1,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 Index: operator/subtract-rgba-grey8.crimp ================================================================== --- /dev/null +++ operator/subtract-rgba-grey8.crimp @@ -0,0 +1,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 Index: operator/subtract-rgba-rgb.crimp ================================================================== --- /dev/null +++ operator/subtract-rgba-rgb.crimp @@ -0,0 +1,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 Index: operator/subtract-rgba-rgba.crimp ================================================================== --- /dev/null +++ operator/subtract-rgba-rgba.crimp @@ -0,0 +1,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 Index: operator/threshold-float-float.crimp ================================================================== --- /dev/null +++ operator/threshold-float-float.crimp @@ -0,0 +1,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 Index: operator/threshold-float-grey16.crimp ================================================================== --- /dev/null +++ operator/threshold-float-grey16.crimp @@ -0,0 +1,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 Index: operator/threshold-float-grey32.crimp ================================================================== --- /dev/null +++ operator/threshold-float-grey32.crimp @@ -0,0 +1,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 Index: operator/threshold-float-grey8.crimp ================================================================== --- /dev/null +++ operator/threshold-float-grey8.crimp @@ -0,0 +1,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 Index: operator/threshold-grey16-float.crimp ================================================================== --- /dev/null +++ operator/threshold-grey16-float.crimp @@ -0,0 +1,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 Index: operator/threshold-grey16-grey16.crimp ================================================================== --- /dev/null +++ operator/threshold-grey16-grey16.crimp @@ -0,0 +1,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 Index: operator/threshold-grey32-float.crimp ================================================================== --- /dev/null +++ operator/threshold-grey32-float.crimp @@ -0,0 +1,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 Index: operator/threshold-grey32-grey32.crimp ================================================================== --- /dev/null +++ operator/threshold-grey32-grey32.crimp @@ -0,0 +1,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 Index: operator/threshold-grey8-float.crimp ================================================================== --- /dev/null +++ operator/threshold-grey8-float.crimp @@ -0,0 +1,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 Index: operator/threshold-grey8-grey8.crimp ================================================================== --- /dev/null +++ operator/threshold-grey8-grey8.crimp @@ -0,0 +1,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 Index: operator/threshold-hsv-float.crimp ================================================================== --- /dev/null +++ operator/threshold-hsv-float.crimp @@ -0,0 +1,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 Index: operator/threshold-hsv-grey8.crimp ================================================================== --- /dev/null +++ operator/threshold-hsv-grey8.crimp @@ -0,0 +1,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 Index: operator/threshold-hsv-hsv.crimp ================================================================== --- /dev/null +++ operator/threshold-hsv-hsv.crimp @@ -0,0 +1,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 Index: operator/threshold-rgb-float.crimp ================================================================== --- /dev/null +++ operator/threshold-rgb-float.crimp @@ -0,0 +1,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 Index: operator/threshold-rgb-grey8.crimp ================================================================== --- /dev/null +++ operator/threshold-rgb-grey8.crimp @@ -0,0 +1,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 Index: operator/threshold-rgb-rgb.crimp ================================================================== --- /dev/null +++ operator/threshold-rgb-rgb.crimp @@ -0,0 +1,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 Index: operator/threshold-rgba-float.crimp ================================================================== --- /dev/null +++ operator/threshold-rgba-float.crimp @@ -0,0 +1,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 Index: operator/threshold-rgba-grey8.crimp ================================================================== --- /dev/null +++ operator/threshold-rgba-grey8.crimp @@ -0,0 +1,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 Index: operator/threshold-rgba-rgba.crimp ================================================================== --- /dev/null +++ operator/threshold-rgba-rgba.crimp @@ -0,0 +1,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 Index: operator/trace_hysteresis.crimp ================================================================== --- /dev/null +++ operator/trace_hysteresis.crimp @@ -0,0 +1,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 Index: operator/type.crimp ================================================================== --- /dev/null +++ operator/type.crimp @@ -0,0 +1,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 Index: operator/upsample-float.crimp ================================================================== --- /dev/null +++ operator/upsample-float.crimp @@ -0,0 +1,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 Index: operator/upsample-grey16.crimp ================================================================== --- /dev/null +++ operator/upsample-grey16.crimp @@ -0,0 +1,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 Index: operator/upsample-grey32.crimp ================================================================== --- /dev/null +++ operator/upsample-grey32.crimp @@ -0,0 +1,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 Index: operator/upsample-grey8.crimp ================================================================== --- /dev/null +++ operator/upsample-grey8.crimp @@ -0,0 +1,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 Index: operator/upsample-hsv.crimp ================================================================== --- /dev/null +++ operator/upsample-hsv.crimp @@ -0,0 +1,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 Index: operator/upsample-rgb.crimp ================================================================== --- /dev/null +++ operator/upsample-rgb.crimp @@ -0,0 +1,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 Index: operator/upsample-rgba.crimp ================================================================== --- /dev/null +++ operator/upsample-rgba.crimp @@ -0,0 +1,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 Index: operator/upsamplex-float.crimp ================================================================== --- /dev/null +++ operator/upsamplex-float.crimp @@ -0,0 +1,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 Index: operator/upsamplex-grey16.crimp ================================================================== --- /dev/null +++ operator/upsamplex-grey16.crimp @@ -0,0 +1,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 Index: operator/upsamplex-grey32.crimp ================================================================== --- /dev/null +++ operator/upsamplex-grey32.crimp @@ -0,0 +1,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 Index: operator/upsamplex-grey8.crimp ================================================================== --- /dev/null +++ operator/upsamplex-grey8.crimp @@ -0,0 +1,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 Index: operator/upsamplex-hsv.crimp ================================================================== --- /dev/null +++ operator/upsamplex-hsv.crimp @@ -0,0 +1,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 Index: operator/upsamplex-rgb.crimp ================================================================== --- /dev/null +++ operator/upsamplex-rgb.crimp @@ -0,0 +1,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 Index: operator/upsamplex-rgba.crimp ================================================================== --- /dev/null +++ operator/upsamplex-rgba.crimp @@ -0,0 +1,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 Index: operator/upsampley-float.crimp ================================================================== --- /dev/null +++ operator/upsampley-float.crimp @@ -0,0 +1,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 Index: operator/upsampley-grey16.crimp ================================================================== --- /dev/null +++ operator/upsampley-grey16.crimp @@ -0,0 +1,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 Index: operator/upsampley-grey32.crimp ================================================================== --- /dev/null +++ operator/upsampley-grey32.crimp @@ -0,0 +1,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 Index: operator/upsampley-grey8.crimp ================================================================== --- /dev/null +++ operator/upsampley-grey8.crimp @@ -0,0 +1,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 Index: operator/upsampley-hsv.crimp ================================================================== --- /dev/null +++ operator/upsampley-hsv.crimp @@ -0,0 +1,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 Index: operator/upsampley-rgb.crimp ================================================================== --- /dev/null +++ operator/upsampley-rgb.crimp @@ -0,0 +1,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 Index: operator/upsampley-rgba.crimp ================================================================== --- /dev/null +++ operator/upsampley-rgba.crimp @@ -0,0 +1,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 Index: operator/warp-float-field-bicubic.crimp ================================================================== --- /dev/null +++ operator/warp-float-field-bicubic.crimp @@ -0,0 +1,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 Index: operator/warp-float-field-bilinear.crimp ================================================================== --- /dev/null +++ operator/warp-float-field-bilinear.crimp @@ -0,0 +1,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 Index: operator/warp-float-field-nneighbour.crimp ================================================================== --- /dev/null +++ operator/warp-float-field-nneighbour.crimp @@ -0,0 +1,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 Index: operator/warp-float-projective-bicubic.crimp ================================================================== --- /dev/null +++ operator/warp-float-projective-bicubic.crimp @@ -0,0 +1,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 Index: operator/warp-float-projective-bilinear.crimp ================================================================== --- /dev/null +++ operator/warp-float-projective-bilinear.crimp @@ -0,0 +1,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 Index: operator/warp-float-projective-nneighbour.crimp ================================================================== --- /dev/null +++ operator/warp-float-projective-nneighbour.crimp @@ -0,0 +1,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 Index: operator/warp-grey16-field-bicubic.crimp ================================================================== --- /dev/null +++ operator/warp-grey16-field-bicubic.crimp @@ -0,0 +1,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 Index: operator/warp-grey16-field-bilinear.crimp ================================================================== --- /dev/null +++ operator/warp-grey16-field-bilinear.crimp @@ -0,0 +1,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 Index: operator/warp-grey16-field-nneighbour.crimp ================================================================== --- /dev/null +++ operator/warp-grey16-field-nneighbour.crimp @@ -0,0 +1,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 Index: operator/warp-grey16-projective-bicubic.crimp ================================================================== --- /dev/null +++ operator/warp-grey16-projective-bicubic.crimp @@ -0,0 +1,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 Index: operator/warp-grey16-projective-bilinear.crimp ================================================================== --- /dev/null +++ operator/warp-grey16-projective-bilinear.crimp @@ -0,0 +1,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 Index: operator/warp-grey16-projective-nneighbour.crimp ================================================================== --- /dev/null +++ operator/warp-grey16-projective-nneighbour.crimp @@ -0,0 +1,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 Index: operator/warp-grey32-field-bicubic.crimp ================================================================== --- /dev/null +++ operator/warp-grey32-field-bicubic.crimp @@ -0,0 +1,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 Index: operator/warp-grey32-field-bilinear.crimp ================================================================== --- /dev/null +++ operator/warp-grey32-field-bilinear.crimp @@ -0,0 +1,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 Index: operator/warp-grey32-field-nneighbour.crimp ================================================================== --- /dev/null +++ operator/warp-grey32-field-nneighbour.crimp @@ -0,0 +1,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 Index: operator/warp-grey32-projective-bicubic.crimp ================================================================== --- /dev/null +++ operator/warp-grey32-projective-bicubic.crimp @@ -0,0 +1,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 Index: operator/warp-grey32-projective-bilinear.crimp ================================================================== --- /dev/null +++ operator/warp-grey32-projective-bilinear.crimp @@ -0,0 +1,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 Index: operator/warp-grey32-projective-nneighbour.crimp ================================================================== --- /dev/null +++ operator/warp-grey32-projective-nneighbour.crimp @@ -0,0 +1,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 Index: operator/warp-mbyte-field-bicubic.crimp ================================================================== --- /dev/null +++ operator/warp-mbyte-field-bicubic.crimp @@ -0,0 +1,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 Index: operator/warp-mbyte-field-bilinear.crimp ================================================================== --- /dev/null +++ operator/warp-mbyte-field-bilinear.crimp @@ -0,0 +1,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 Index: operator/warp-mbyte-field-nneighbour.crimp ================================================================== --- /dev/null +++ operator/warp-mbyte-field-nneighbour.crimp @@ -0,0 +1,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 Index: operator/warp-mbyte-projective-bicubic.crimp ================================================================== --- /dev/null +++ operator/warp-mbyte-projective-bicubic.crimp @@ -0,0 +1,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 Index: operator/warp-mbyte-projective-bilinear.crimp ================================================================== --- /dev/null +++ operator/warp-mbyte-projective-bilinear.crimp @@ -0,0 +1,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 Index: operator/warp-mbyte-projective-nneighbour.crimp ================================================================== --- /dev/null +++ operator/warp-mbyte-projective-nneighbour.crimp @@ -0,0 +1,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 Index: operator/wavy.crimp ================================================================== --- /dev/null +++ operator/wavy.crimp @@ -0,0 +1,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 Index: operator/width.crimp ================================================================== --- /dev/null +++ operator/width.crimp @@ -0,0 +1,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 Index: operator/write-grey8-tk.crimp ================================================================== --- /dev/null +++ operator/write-grey8-tk.crimp @@ -0,0 +1,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 Index: operator/write-rgb-tk.crimp ================================================================== --- /dev/null +++ operator/write-rgb-tk.crimp @@ -0,0 +1,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 Index: operator/write-rgba-tk.crimp ================================================================== --- /dev/null +++ operator/write-rgba-tk.crimp @@ -0,0 +1,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 Index: plot.tcl ================================================================== --- /dev/null +++ plot.tcl @@ -0,0 +1,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 Index: psychedelia.crimp ================================================================== --- psychedelia.crimp +++ /dev/null @@ -1,57 +0,0 @@ -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 Index: reader/r_strimj.tcl ================================================================== --- /dev/null +++ reader/r_strimj.tcl @@ -0,0 +1,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 Index: specs/pgm.txt ================================================================== --- /dev/null +++ specs/pgm.txt @@ -0,0 +1,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 Index: specs/ppm.txt ================================================================== --- /dev/null +++ specs/ppm.txt @@ -0,0 +1,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 Index: time.tcl ================================================================== --- /dev/null +++ time.tcl @@ -0,0 +1,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 Index: tools/makedoc.sh ================================================================== --- /dev/null +++ tools/makedoc.sh @@ -0,0 +1,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 Index: wavy.crimp ================================================================== --- wavy.crimp +++ /dev/null @@ -1,44 +0,0 @@ -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 Index: writer/w_pfm.tcl ================================================================== --- /dev/null +++ writer/w_pfm.tcl @@ -0,0 +1,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 Index: writer/w_pgm.tcl ================================================================== --- /dev/null +++ writer/w_pgm.tcl @@ -0,0 +1,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 Index: writer/w_ppm.tcl ================================================================== --- /dev/null +++ writer/w_ppm.tcl @@ -0,0 +1,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
+
[ + Table Of Contents +| Keyword Index +]
+

crimp(n) 1.0.1 doc "Image Manipulation"

+

Name

+

crimp - Image Manipulation (not yet independent of Tk)

+
+ +

Synopsis

+
+
    +
  • package require Tcl 8.5
    • +
  • package require Tk 8.5
    • +
  • package require crimp ?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.

+

Note that the intended audience of this document are the users of +crimp. Developers wishing to work on the internals of the +package, but unfamiliar with them, should read ... instead.

+
+

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.

+

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.

+

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.

+
+

Image Types

+

Each image has a 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.

+

All type strings have the form crimp::image::foo.

+

The package currently knows the following types:

+
+
rgba
+
+ +
Colorspace
+

RGB also known as Red, Green, and Blue.

+
Channels
+

4, named "red", "green", and "blue", + plus an "alpha" channel controlling + pixel opacity.

+
Bit-depth
+

1 byte/channel (8 bit, values 0-255).

+
Pixel-size
+

4 bytes.

+
+
rgb
+
+ +
Colorspace
+

RGB also known as Red, Green, and Blue.

+
Channels
+

3, named "red", "green", and "blue".

+
Bit-depth
+

1 byte/channel (8 bit, values 0-255).

+
Pixel-size
+

3 bytes.

+
+
hsv
+
+ +
Colorspace
+

HSV, also known as Hue, Saturation, and Value.

+
Channels
+

3, named "hue", "saturation", and "value".

+
Bit-depth
+

1 byte/channel (8 bit, values 0-255).

+
Pixel-size
+

3 bytes.

+
+
grey8
+
+ +
Colorspace
+

Greyscale.

+
Channels
+

1, named "luma".

+
Bit-depth
+

1 byte/channel (8 bit, values 0-255).

+
Pixel-size
+

1 byte.

+
+
grey16
+
+ +
Colorspace
+

Greyscale.

+
Channels
+

1, named "luma".

+
Bit-depth
+

2 byte/channel (16 bit, values 0-65,535).

+
Pixel-size
+

2 bytes.

+
+
grey32
+
+ +
Colorspace
+

Greyscale.

+
Channels
+

1, named "luma".

+
Bit-depth
+

4 byte/channel (16 bit, values 0-4,294,967,296).

+
Pixel-size
+

4 bytes.

+
+
bw
+
+ +
Colorspace
+

Binary.

+
Channels
+

1, named "bw".

+
Bit-depth
+

1 bit/channel.

+
Pixel-size
+

1 byte. I.e. 7 bits/channel are wasted.

+
+
float
+
+ +
Colorspace
+

N.A / Floating Point.

+
Channels
+

1, named "value".

+
Bit-depth
+

4 byte/channel.

+
Pixel-size
+

4 byte.

+
+
+

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.

+
+

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.

+

They fall into five categories, namely:

+

organization

+
+
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.

+

The list of accessors, their syntax, and detailed meaning can be found +in section Accessors.

+
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.

+

The list of manipulators, their syntax, and detailed meaning can be +found in section Manipulators.

+
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.

+

The list of converters, their syntax, and detailed meaning can be +found in section Converters.

+
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.

+

The list of I/O commands, their syntax, and detailed meaning can be +found in section I/O commands.

+
Support
+

Lastly, but not leastly a number of commands, which, while not image +commands themselves, support the others.

+

The list of supporting commands, their syntax, and detailed meaning +can be found in section Support.

+
+
+

API

+

Accessors

+
+
::crimp channels image
+

This method returns a list containing the names of the channels in the +image. The order of channels is the same as expected by the +remap method.

+

The method supports all image types.

+
::crimp dimensions image
+

This method returns the width and height of the image (in +pixels). The result is a 2-element list containing width and height, +in this order.

+

The method supports all image types.

+
::crimp height image
+

This method returns the height of the image (in pixels).

+

The method supports all image types.

+
::crimp histogram image
+

This method returns a nested dictionary as its result. The outer +dictionary is indexed by the names of the channels in the image. +Its values, the inner dictionaries, are indexed by pixel value. The +associated values are the number of pixels with that value.

+

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).

+
::crimp meta append image key ?string...?
+
+
::crimp meta create image ?key value...?
+
+
::crimp meta exists image key ?key...?
+
+
::crimp meta filter image args...
+
+
::crimp meta for image {keyVar valueVar} body
+
+
::crimp meta get image ?key...?
+
+
::crimp meta incr image key ?increment?
+
+
::crimp meta info image
+
+
::crimp meta keys image ?globPattern?
+
+
::crimp meta lappend image key ?value...?
+
+
::crimp meta merge image ?dictionaryValue...?
+
+
::crimp meta remove image ?key...?
+
+
::crimp meta replace image ?key value...?
+
+
::crimp meta set image key ?key...? value
+
+
::crimp meta size image
+
+
::crimp meta unset image key ?key...?
+
+
::crimp meta values image ?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 dict, with the image's metadata taking the place of the +dictionary value or vqariable. +The converse is not true, as dict's methods update and +with are not supported here.

+

Please read the documentation of Tcl's dict command for reference.

+

NOTE that the toplevel key crimp is reserved for +use by CRIMP itself.

+
::crimp pixel image
+

This method returns the raw pixels of the image as a Tcl ByteArray.

+

The method supports all image types.

+
::crimp statistics basic image
+

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.

+
+
dimensions
+

2-element list holding image width and height, in + this order.

+
height
+

Image height as separate value.

+
pixels
+

Number of pixels in the image, the product of + its width and height.

+
type
+

Type of the image.

+
width
+

Image width as separate value.

+
channels
+

List of the names for the channels in the image.

+
channel
+

A dictionary mapping the names of the image's + channels, as listed under key channels, to + a dictionary holding the statistics for that channel.

+
+
min
+

The minimal pixel value with a non-zero population.

+
max
+

The maximal pixel value with a non-zero population.

+
mean
+

The arithmetic mean (aka average) of pixel values.

+
middle
+

The arithmetic mean of the min and max pixel values.

+
median
+

The median pixel value.

+
stddev
+

The standard deviation of pixel values.

+
variance
+

The variance of pixel values, square of the standard + deviation.

+
histogram
+

A dictionary mapping pixel values to population counts.

+
hf
+

The histogram reduced to the population counts, sorted + by pixel value to direct indexing into the list by + pixel values.

+
cdf
+

The cumulative density function of pixel + values. The discrete integral of hf.

+
cdf255
+

Same as cdf, except scaled down so that the + last value in the series is 255.

+
+
+

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).

+
::crimp statistics otsu stats
+

This method takes a dictionary of basic image statistics as generated +by crimp statistics basic and returns an extended dictionary +containing a threshold for image binarization computed by Otsu's +method (See 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 otsu.

+
::crimp type image
+

This method returns the type of the image.

+

The method supports all image types.

+
::crimp width image
+

This method returns the width of the image (in pixels).

+

The method supports all image types.

+
+
+

Manipulators

+
+
::crimp add image1 image2 ?scale? ?offset?
+

This method combines the two input images into a result image by +performing a pixelwise addition (image1 + image2) followed by division +through scale and addition of the offset. They default to +1 and 0 respectively, if they are not specified.

+
::crimp alpha blend foreground background alpha
+

This method takes two images of identical dimensions and a blending +factor alpha and returns an image which is a mix of both, with +each pixel blended per the formula

+

blend

+

or, alternatively written

+

blend_alt

+

This means that the foreground is returned as is for +"alpha == 255", and the background for +"alpha == 0". +I.e. the argument alpha controls the opacity of the +foreground, with 1 and 0 standing for "fully opaque" +and "fully transparent", respectively.

+

The following combinations of fore- and background image types are +supported:

+
+    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
+    ------   ---------- ----------
+
+
+
::crimp alpha set image mask
+

This command takes two images, the input and a 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 rgba, as the only type +supporting an alpha channel.

+

The input image can be of type rgb or rgba. In +case of the latter the existing alpha channel is replaced, in case of +the former an alpha channel is added.

+

For the mask images of type grey8 and 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.

+
::crimp alpha opaque image
+

A convenience method over alpha set, giving the image +a mask which makes it fully opaque.

+
::crimp alpha over foreground background
+

This method is similar to blend above, except that there is +no global blending parameter. This information is taken from the +"alpha" channel of the 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.

+

Due to the need for an alpha channel the foreground has to be of +type rgba. For the background image the types +rgb and rgba are supported.

+
::crimp atan2 image1 image2
+

This method combines the two input images into a result image by +computing

+

atan2

+

at each pixel.

+

The input is restricted to images of the single-channel types, +i.e. float and grey{8,16,32}. The result is always +of type float.

+

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 crimp hypot operation to compute the +gradient's magnitude at each pixel.

+
::crimp blank type width height value...
+

This method returns a blank image of the given image type and +dimensions. The values after the dimensions are the pixel +values to fill the pixels in the image's channels with, per its type.

+

This method currently support only the types rgb, +rgba, and grey8.

+
::crimp crop image ww hn we hs
+

This method is the counterpart to the expand family of +methods, shrinking an image by removing a border. +The size of this border is specified by the four arguments ww, +hn, we, and hs which provide the number of pixels to +remove from the named edge. See the image below for a graphical +representation.

+

border

+
::crimp cut image x y w h
+

This method cuts the rectangular region specified throught its x/y +position relative to the upper-left corner of the input image and its +dimensions, and returns it as its own image.

+
::crimp decimate xy image factor kernel
+
+
::crimp decimate x image factor kernel
+
+
::crimp decimate y image factor kernel
+

This is a convenience method combining the two steps of filtering an image +(via filter convolve), followed by a downsample step. +See the method interpolate for the complementary operation.

+

Note that while the kernel argument for 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.

+

The method pyramid gauss is a user of this method.

+
::crimp degamma image y
+

This method takes an image, runs it through an +inverse gamma correction with parameter y, and returns +the corrected image as it result. +This is an application of method remap, using the mapping +returned by "map degamma y". +This method supports all image types supported by the method +remap.

+
::crimp difference image1 image2
+

This method combines the two input images into a result image by +taking the pixelwise absolute difference (|image1 - image2|).

+
::crimp downsample xy image factor
+
+
::crimp downsample x image factor
+
+
::crimp downsample y image factor
+

This method returns an image containing only every factor pixel of the +input image (in x, y, or both dimensions). The effect is that the input is +shrunken by factor. It is the complement of method upsample.

+

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.

+

The decimate method is a convenience method combining these +two steps into one.

+
::crimp effect charcoal image
+

This method applies a charcoal effect to the image, i.e. it returns a +grey8 image showing the input as if it had been drawn with a +charcoal pencil.

+
::crimp effect emboss image
+

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.

+
::crimp effect sharpen image
+

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.

+
::crimp expand const image ww hn we hs ?value...?
+
+
::crimp expand extend image ww hn we hs
+
+
::crimp expand mirror image ww hn we hs
+
+
::crimp expand replicate image ww hn we hs
+
+
::crimp expand wrap image ww hn we hs
+

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 ww, +hn, we, and hs which provide the number of pixels to +add at the named edge. See the image below for a graphical +representation.

+

border

+

The contents of the border's pixels are specified via the border type, +the first argument after expand, as per the list below.

+
+
const
+

The additional values 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 255. If no values are +present they default to 0.

+
extend
+

This is a combination of mirror and replicate. The +outside pixels are the result of subtracting the outside pixel for +mirror from the outside pixel for replicate (and +clamping to the range [0...255]).

+
mirror
+

The outside pixels take the value of the associated inside pixels, +found by reflecting its coordinates along the relevant edges.

+
replicate
+

The outside pixels take the value of the associated edge pixels, i.e. +replicating them into the border.

+
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.

+
+
::crimp fft forward image
+
+
::crimp fft backward image
+

These two methods implement 2D FFT (forward) and inverse FFT (backward).

+

The input is restricted to images of the single-channel types, +i.e. float and grey{8,16,32}. The result is always +of type float.

+

The former means that it is necessary to split rgb, +etc. images into their channels before performing an FFT, and that +results of an inverse FFT have to be joined. +See the methods split and join for the relevant +operations and their syntax.

+

The latter means that a separate invokation of method +convert 2grey8 is required when reconstructing an image +by inverting its FFT.

+
::crimp filter ahe image ?-border spec? ?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 +NxN square centered on it, where +"N = 2*radius+1".

+

The default radius is 3, for a 7x7 square.

+
::crimp filter convolve image ?-border spec? kernel...
+

This method runs the series of filters specified by the convolution +kernels over the input and returns the filtered result. See the +method kernel and its sub-methods for commands to create and +manipulate suitable kernels.

+

The border specification determines how the input image is +expanded (see method expand) to compensate for the shrinkage +introduced by the filter itself. The spec argument is a list +containing the name of the sub-method of expand to use, plus +any additional arguments this method may need, except for the size of +the expansion.

+

By default a black frame is used as the border, i.e. +"spec == {const 0}".

+
::crimp filter gauss discrete image sigma ?r?
+
+
::crimp filter gauss sampled image sigma ?r?
+

These methods apply a discrete or sampled gaussian blur with +parameters sigma and kernel radius to the image. If +the radius is not specified it defaults to the smallest integer +greater than "3*sigma".

+
::crimp filter mean image ?-border spec? ?radius?
+

This method applies a mean filter with radius to the +image. I.e. each pixel of the result is the mean value of all pixels +in the NxN square centered on it, where +"N = 2*radius+1".

+

The default radius is 3, for a 7x7 square.

+

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.

+

The method filter stddev on the other makes the reverse +tradeoff, keeping precision, but unable to handle multi-channel +images.

+
::crimp filter rank image ?-border spec? ?radius ?percentile??
+

This method runs a rank-filter over the input and returns the filtered +result.

+

The border specification determines how the input image is +expanded (see method expand) to compensate for the shrinkage +introduced by the filter itself. The spec argument is a list +containing the name of the sub-method of expand to use, plus +any additional arguments this method may need, except for the size of +the expansion.

+

By default a black frame is used as the border, i.e. +"spec == {const 0}".

+

The radius specifies the (square) region around each +pixel which is taken into account by the filter, with the pixel value +selected according to the percentile. The filter region of each +pixel is a square of dimensions "2*radius+1", centered around +the pixel.

+

These two values default to 3 and 50, respectively.

+

Typical applications of rank-filters are min-, max-, and +median-filters, for percentiles 0, 100, and 50, respectively.

+

Note that percentiles outside of the range 0...100 +make no sense and are clamped to this range.

+
::crimp filter stddev image ?-border spec? ?radius?
+

This method applies a stand deviation filter with radius to the +image. I.e. each pixel of the result is the standard deviation of all +pixel values in the NxN square centered on it, where +"N = 2*radius+1".

+

The default radius is 3, for a 7x7 square.

+

NOTE. As the standard deviation is often quite small and its +precision important the result of this method is always an image of +type 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.

+

The method filter mean on the other hand makes the reverse +tradeoff, handling multi-channel images, but dropping precision.

+
::crimp filter sobel x image
+
+
::crimp filter sobel y image
+
+
::crimp filter scharr x image
+
+
::crimp filter scharr y image
+
+
::crimp filter prewitt x image
+
+
::crimp filter prewitt y image
+

These methods are convenience methods implementing a number of standard +convolution filters using for edge detection and calculation of image +gradients.

+

See the crimp gradient methods for users of these filters.

+

Also note that the x methods emphasize gradient in the horizontal +direction, and thus highlight vertical lines, and vice versa for +y.

+
::crimp gamma image y
+

This method takes an image, runs it through a gamma correction +with parameter y, and returns the corrected image as it result. +This is an application of method remap, using the mapping +returned by "map gamma y". +This method supports all image types supported by the method +remap.

+
::crimp gradient sobel image
+
+
::crimp gradient scharr image
+
+
::crimp gradient prewitt image
+

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.

+
::crimp gradient polar 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 float images, the +magnitude and angle, in this order. The angle is represented +in degrees running from 0 to 360.

+
::crimp gradient visual pgradient
+

This method takes a gradient in polar representation (as +returned by method gradient polar) and converts it +into a color image (rgb) visualizing the gradient.

+

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.

+
::crimp hypot image1 image2
+

This method combines the two input images into a result image by +computing

+

hypot

+

at each pixel.

+

The input is restricted to images of the single-channel types, +i.e. float and grey{8,16,32}. The result is always +of type float.

+

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 crimp atan2 operation to compute the +gradient's direction at each pixel.

+
::crimp integrate image
+

This method takes any single-channel image, i.e. of types +float and grey{8,16,32}, and returns its integral, +i.e. a summed area table. The type of the result is always of type +float.

+
::crimp interpolate xy image factor kernel
+
+
::crimp interpolate x image factor kernel
+
+
::crimp interpolate y image factor kernel
+

This is a convenience method combining the two steps of an upsample, +followed by a filter step (via filter convolve). See the method +decimate for the complementary operation.

+

Note that while the kernel argument for 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.

+

The methods pyramid gauss and pyramid laplace are +users of this method.

+
::crimp invert image
+

This method takes an image, runs it through the inverse +function, and returns the modified image as it result. +This is an application of method remap, using the mapping +returned by "map inverse". +This method supports all image types supported by the method +remap.

+
::crimp matrix image matrix
+

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.

+

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.

+

The operation supports only images of type rgba, and returns +images of the same type.

+
::crimp max image1 image2
+

This method combines the two input images into a result image by +taking the pixelwise maximum.

+
::crimp min image1 image2
+

This method combines the two input images into a result image by +taking the pixelwise minimum.

+
::crimp montage horizontal ?-align top|center|bottom? ?-border spec? image...
+
+
::crimp montage vertical ?-align left|middle|right? ?-border spec? image...
+

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.

+

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 -align and -border +options, with the latter specifying the form of the expansion (see +method expand for details), and the first specifying how the +image is aligned within the expanded space.

+

The spec argument of -border is a list containing the +name of the sub-method of expand to use, plus any additional +arguments this method may need, except for the size of the expansion.

+

The default values for -align are center and +middle, centering the image in the space. The default for the +-border is a black frame, i.e. "spec == {const 0}".

+
::crimp morph dilate image
+
+
::crimp morph erode image
+

These two methods implement the basic set of morphology operations, +erosion, and 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.

+
+    dilate = filter rank 1  0.00 (min)
+    erode  = filter rank 1 99.99 (max)
+
+
+
::crimp morph close image
+
+
::crimp morph open image
+

These two methods add to the basic set of morphology operations, +opening and closing. In terms of erosion and dilation:

+
+    close = erode o dilate 
+    open  = dilate o erode
+
+
+
::crimp morph gradient image
+

The morphological gradient is defined as

+
+    [dilate $image] - [erode $image]
+
+

This can also be expressed as the sum of the external and internal +gradients, see below.

+
::crimp morph igradient image
+

The morphological internal gradient is defined as

+
+    $image - [erode image]
+
+
+
::crimp morph egradient image
+

The morphological external gradient is defined as

+
+    [dilate $image] - $image
+
+
+
::crimp morph tophatw image
+

The white tophat transformation is defined as

+
+    $image - [open $image]
+
+
+
::crimp morph tophatb image
+

The black tophat transformation is defined as

+
+    [close $image] - $image
+
+
+
::crimp multiply image1 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 255 to scale it back into the +range [0...255].

+
::crimp psychedelia width height frames
+

This method creates an rgba image of the specified dimensions +according to an algorithm devised by Andrew M. Goth. The frames +argument specifies how many images are in the series.

+

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.

+
::crimp pyramid run image steps stepcmd
+

This method provides the core functionality for the generation of image +pyramids. The command prefix stepcmd is run steps times, +first on the image, then on the result of the previous step.

+

The assumed signature of stepcmd is

+
+
<stepcmd> image
+

which is expected to return a list of two elements. The first element +(result) is added to the pyramid in building, whereas the second +element (iter) is used in the next step as the input of the step +command.

+
+

The final result of the method is a list containing the input +image as its first element, followed by the results of the step +function, followed by the iter element returned by the last step, +"steps+2" images in total.

+

pyramid

+
::crimp pyramid gauss image steps
+

This method generates a gaussian image pyramid steps levels deep and +returns it as a list of images.

+

The first image in the result is the input, followed by steps +successively smaller images, each decimated by a factor two +compared to its predecessor, for a total length of "steps+1" images.

+

The convolution part of the decimation uses

+
 1/16 [1 4 6 4 1]
+

as its kernel.

+

pyramid_gauss

+
::crimp pyramid laplace image steps
+

This method generates a laplacian image pyramid steps levels deep and +returns it as a list of images.

+

The first image in the result is the input, followed by steps +band pass images (differences of gaussians). The first band pass has the same +size as the input image, and each successor is decimated 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 "steps+2" images.

+

The convolution part of the decimation uses

+
 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.

+

pyramid_laplace

+
::crimp remap image map...
+

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.

+

Beyond the input image to transform one or more 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 +identity, i.e. the channel copied as is, without changes.

+

The maps are not Tcl data structures, but images themselves. They +have to be of type grey8, and be of dimension 256x1 (width by +height).

+

The crimp map ... methods are sources for a number of +predefined maps, whereas the mapof method allows the +construction of maps from Tcl data structures, namely lists of values.

+

This method supports all image types with one or more +single-byte channels, i.e. all but grey16, grey32, +float, and bw.

+
::crimp screen image1 image2
+

This method combines the two input images by inverting the +multiplication of the inverted input images. I.e.

+

screen

+
::crimp solarize image threshold
+

This method takes an image, runs it through the solarize +function with parameter threshold, and returns the modified +image as it result. This is also known as the sabattier effect. +This is an application of method remap, using the mapping +returned by "map solarize threshold". +This method supports all image types supported by the method +remap.

+
::crimp square image
+

This is a convenience method equivalent to +"crimp multiply image image".

+
::crimp subtract image1 image2 ?scale? ?offset?
+

This method combines the two input images into a result image by +performing a pixelwise subtraction (image1 - image2) followed by +division through scale and addition of the offset. They +default to 1 and 0 respectively, if they are not +specified.

+
::crimp threshold global above image threshold
+

This method takes an image, runs it through the threshold above +function with parameter 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 binarization or +foreground/background segmentation. +This is an application of method remap, using the mapping +returned by "map threshold above threshold". +This method supports all image types supported by the method +remap.

+
::crimp threshold global below image threshold
+

This method takes an image, runs it through the threshold below +function with parameter 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 binarization, or +foreground/background segmentation. +This is an application of method remap, using the mapping +returned by "map threshold below threshold". +This method supports all image types supported by the method +remap.

+
::crimp threshold global inside image min max
+

This method takes an image, runs it through the threshold inside +function with parameters min and 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 binarization +or foreground/background segmentation. +This is an application of method remap, using the mapping +returned by "map threshold above threshold". +This method supports all image types supported by the method +remap.

+
::crimp threshold global outside image min max
+

This method takes an image, runs it through the threshold outside +function with parameters min and 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 binarization, +or foreground/background segmentation. +This is an application of method remap, using the mapping +returned by "map threshold below threshold". +This method supports all image types supported by the method +remap.

+
::crimp threshold global middle image
+
+
::crimp threshold global mean image
+
+
::crimp threshold global median image
+
+
::crimp threshold global otsu image
+

These four methods are convenience methods layered on top of +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 crimp statistics .... Note that +they treat each color channel in the image separately.

+
::crimp threshold local image threshold...
+

This method takes an image and one or more 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.

+

This is the core for all methods of non-global +binarization, i.e. foreground/background segmentation. Their +differences are just in the calculation of the maps.

+

This method supports all image types with one or more +single-byte channels, i.e. all but grey16, grey32, and +bw.

+
::crimp upsample xy image factor
+
+
::crimp upsample x image factor
+
+
::crimp upsample y image factor
+

This method returns an image inserting factor black pixels between +each pixel of the input image (in x, y, or both dimensions). The effect is +that the input is expanded by factor. It is the complement of +method downsample.

+

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.

+

The interpolate method is a convenience method combining these +two steps into one.

+
::crimp wavy image offset adj1 adjb
+

This method processes the input image according to an algorithm +devised by Andrew M. Goth, according to the three parameters +offset, adj1, and adjb, and returns the modified +image as its result.

+

The operation supports only images of type rgba, and returns +images of the same type.

+
::crimp flip horizontal image
+
+
::crimp flip transpose image
+
+
::crimp flip transverse image
+
+
::crimp flip vertical image
+

This set of methods performs mirroring along the horizontal, vertical +and diagonal axes of the input 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.

+

The methods currently support the image types rgb, +rgba, hsv, and grey8.

+
::crimp resize ?-interpolate nneighbour|bilinear|bicubic? image w h
+

This method takes the input image and resizes it to the +specified width w and height h. +In constrast to 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 transform methods and +used by method warp projective (see below).

+

Like the aforementioned general method this method supports all +the possible interpolation types, i.e. nearest neighbour, bilinear, +and bicubic. By default bilinear interpolation is used, as a +compromise between accuracy and speed.

+
::crimp rotate cw image
+
+
::crimp rotate ccw image
+

This set of methods rotates the image in steps of 90 degrees, either +clockwise and counter to it.

+
::crimp rotate half image
+

This methods rotates the image a half-turn, i.e. 180 degrees.

+
::crimp warp field ?-interpolate nneighbour|bilinear|bicubic? image xvec yvec
+

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.

+

This allows the specification of any possible geometric +transformation and warping, going beyond even projective +transformations.

+

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.

+

The method supports all the possible interpolation types, +i.e. nearest neighbour, bilinear, and bicubic. +By default bilinear interpolation is used, as a compromise +between accuracy and speed.

+
::crimp warp projective ?-interpolate nneighbour|bilinear|bicubic? image transform
+

This method accepts a general projective transform as created by +the transform methods, applies it to the input image +and returns the projected result.

+

Like the resize method above this method supports all +the possible interpolation types, i.e. nearest neighbour, bilinear, +and bicubic. By default bilinear interpolation is used, as a +compromise between accuracy and speed.

+

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 +crimp origin.

+
+
+

Converters

+
+
::crimp convert 2grey8 image
+
+
::crimp convert 2hsv image
+
+
::crimp convert 2rgba image
+
+
::crimp convert 2rgb image
+

This set of methods all convert their input 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.

+

The converters returning a grey8 image support rgb and +rgba as their input, using the ITU-R 601-2 luma transform to +merge the three color channels

+

The converters to HSV support rgb and rgba as their +input as well.

+

The conversion to rgba accepts only 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 setalpha +and join rgba.

+

At last, the conversion to rgb accepts both rgba and +hsv images as input.

+
::crimp join 2hsv hueImage satImage valImage
+
+
::crimp join 2rgba redImage greenImage blueImage alphaImage
+
+
::crimp join 2rgb redImage greenImage blueImage
+

This set of methods is the complement of method split. Each +take a set of 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.

+
::crimp split image
+

This method takes an image of one of the multi-channel types, i.e. +rgb, const rgba], and hsv and returns a list of +grey8 images, each of which contains the contents of one of +the channels found in the input image.

+

The channel images in the result are provided in the same order as +they are accepted by the complementary join method, see +above.

+
+
+

I/O commands

+
+
::crimp read pgm string
+

This method returns an image of type grey8 containing the data +of the portable grey map (PGM) stored in the string. The method +recognizes images in both plain and raw sub-formats.

+
::crimp read ppm string
+

This method returns an image of type rgb containing the data +of the portable pix map (PPM) stored in the string. The method +recognizes images in both plain and raw sub-formats.

+
::crimp read strimj string ?colormap?
+

This method returns an image of type rgba containing the data +of the strimj (string image) (See http://wiki.tcl.tk/1846) +stored in the string.

+

The caller can override the standard mapping from pixel characters +to colors by specifying a colormap. This argument is interpreted as +dictionary mapping characters to triples of integers in the range +[0...255], specifying the red, green, and blue intensities.

+

An example of a strimj is:

+
+@...@.......@.@......
+@...@.......@.@......
+@...@..@@@..@.@..@@@.
+@@@@@.@...@.@.@.@...@
+@...@.@@@@@.@.@.@...@
+@...@.@.....@.@.@...@
+@...@.@...@.@.@.@...@
+@...@..@@@..@.@..@@@.
+
+
+
::crimp read tcl grey8 pixelmatrix
+

This method takes the pixelmatrix, a list of rows, with each row +a list of pixel values in the domain [0..255] and returns an +image of type 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 +255.

+
::crimp read tcl float pixelmatrix
+

This method takes the pixelmatrix, a list of rows, with each row +a list of floating point values for pixel values and returns an image +of type 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 255.

+
::crimp read tk photo
+

This method returns an image of type rgba containing the data +from the specified Tk photo image.

+
::crimp write 2tk photo image
+

This method writes the input image to the specified Tk +photo image.

+

The method supports the writing of rgb, rgba, +and grey8 images.

+
::crimp write 2string format image
+
+
::crimp write 2chan format chan image
+
+
::crimp write 2file format path image
+

This family of methods either returns the input image as a +binary string in the specified format, or writes this string to +the open channel chan, or the named file at path.

+

The image types accepted for writing are format +dependent, and listed below, with the supported formats.

+

The currently supported formats are

+
+
pgm-plain
+

The plain ASCII format of portable grey maps, as per +http://en.wikipedia.org/wiki/Netpbm_format.

+

The methods support the writing of rgb, rgba, +hsv, and grey8 images.

+
pgm-raw
+

The raw binary format of portable grey maps, as per +http://en.wikipedia.org/wiki/Netpbm_format.

+

The methods support the writing of rgb, rgba, +hsv, and grey8 images.

+
ppm-plain
+

The plain ASCII format of portable pix maps, as per +http://en.wikipedia.org/wiki/Netpbm_format.

+

The methods support the writing of rgb, rgba, +hsv, and grey8 images.

+
ppm-raw
+

The raw binary format of portable pix maps, as per +http://en.wikipedia.org/wiki/Netpbm_format.

+

The methods support the writing of rgb, rgba, +hsv, and grey8 images.

+
+
+
+

Support

+
+
::crimp gradient grey8 from to size
+
+
::crimp gradient rgb from to size
+
+
::crimp gradient rgba from to size
+
+
::crimp gradient hsv from to size
+

This set of methods takes two "color" (pixel value) arguments and +returns an image of height 1 and width size containing a +gradient interpolating between these two colors, with from in +the pixel at the left (x == 0) and to at the right +(x == size-1).

+

size has to be greater than or equal to 2. An +error is thrown if that restriction is not met.

+

The resulting image has the type indicated in the method name. +This also specifies what is expected as the contents of the arguments +from and to. For grey8 these are simple pixel +values in the range 0...255 whereas for the types rgb and +hsv the arguments are triples (3-element lists) specifying +the R, G, and B (and H, S, and V respectively) values.

+
::crimp kernel make matrix ?scale? ?offset?
+

This method takes a matrix of weights and an optional +scale factor and returns a structure containing the associated +convolution kernel, ready for use by method filter convolve.

+

If scale is left unspecified it defaults to the sum of +all weights in the matrix.

+

If 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.

+

The matrix has the same general format as the pixel +matrix for 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 128. The values are expected to be integer numbers +in the range -128..127.

+
::crimp kernel fpmake matrix ?offset?
+

This method is like 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.

+

The matrix has the same general format as the pixel +matrix for 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 255. The values are expected to be floating-point +numbers.

+
::crimp kernel transpose kernel
+

This method takes a kernel as returned by the method +kernel make and returns a transposed kernel, i.e. one where +the x- and y-axes are switched. +For example

+
+                    (1)
+                    (2)
+    {1 2 4 2 1} ==> (4)
+                    (2)
+                    (1)
+
+

This method is its own inverse, i.e. application to its result returns +the original input, i.e.

+
+    [transpose [transpose $K]] == $K
+
+
+
::crimp map arg...
+

This method accepts the same sub-methods and arguments as are accepted +by the table method below. In contrast to table the +result is not a list of values, but a map image directly suitable as +argument to the remap method.

+
::crimp mapof table
+

This method accepts a list of 256 values, constructs a map image +directly suitable as argument to the remap method, and +returns this map image as its result.

+
::crimp table compose f 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.

+
::crimp table eval wrap cmd
+
+
::crimp table eval clamp 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 +cmd. +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.

+

The signature of the command prefix is

+
+
<cmd> x
+

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.

+
+
::crimp table degamma y
+

This method returns a list of 256 values, the result of running the +values 0 to 255 through the inverse gamma correction with +parameter y. +This inverse correction, defined in the domain of [0..1] for +both argument and result, is defined as:

+

gamma_inv

+

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

+

scaled_gamma_inv

+
::crimp table gamma y
+

This method returns a list of 256 values, the result of running the +values 0 to 255 through the gamma correction with parameter +y. +This correction, defined in the domain of [0..1] for both +argument and result, is defined as:

+

gamma

+

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

+

scaled_gamma

+
::crimp table gauss sigma
+

This method returns a list of 256 values, the result of running the +values 0 to 255 through the sampled gauss function with +parameter sigma. +This function is defined as:

+

gauss

+
::crimp table identity
+

This method returns a list of 256 values, the result of running the +values 0 to 255 through the identity function, which is defined +as

+

identity

+
::crimp table invers
+

This method returns a list of 256 values, the result of running the +values 0 to 255 through the inverse function, which is defined +as

+

inverse

+
::crimp table linear wrap gain offset
+
+
::crimp table linear clamp gain 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 +gain (the slope) and offset. 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

+

linear_wrap +for the wrapped case, and

+

linear_clamp +when clamping.

+
::crimp table log ?max?
+

This method returns a list of 256 values, the result of running the +values 0 to 255 through the log-compression function with +parameter 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:

+

log

+
::crimp table solarize threshold
+

This method returns a list of 256 values, the result of running the +values 0 to 255 through the solarize function, with parameter +threshold. This function is defined as:

+

solarize

+

Note how the function is the identity for values under the +threshold, and the inverse for values at and above it. Its +application to an image produces what is known as either +solarization or sabattier effect.

+
::crimp table sqrt ?max?
+

This method returns a list of 256 values, the result of running the +values 0 to 255 through the sqrt-compression function with +parameter 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:

+

sqrt

+
::crimp table stretch min max
+

This is a convenience method around table linear which maps +min to 0, and max to 255, with linear interpolation in +between. Values below min and above max are clamped to 0 +and 255 respectively.

+
::crimp table threshold above threshold
+

This method returns a list of 256 values, the result of running the +values 0 to 255 through a thresholding (or binarization) +function, with parameter threshold. This function is defined as:

+

threshold-ge

+
::crimp table threshold below threshold
+

This method returns a list of 256 values, the result of running the +values 0 to 255 through a thresholding (or binarization) +function, with parameter threshold. This function is defined as:

+

threshold-le

+
::crimp table threshold inside min max
+

This method returns a list of 256 values, the result of running the +values 0 to 255 through a thresholding (or binarization) +function, with parameters min and max. This function is +defined as:

+

threshold-inside

+
::crimp table threshold outside min max
+

This method returns a list of 256 values, the result of running the +values 0 to 255 through a thresholding (or binarization) +function, with parameters min and max. This function is +defined as:

+

threshold-outside

+
::crimp table fgauss discrete sigma ?r?
+
+
::crimp table fgauss sampled sigma ?r?
+

This method computes the table for a discrete or sampled gaussian with +parameters sigma and kernel radius. If the radius is not +specified it defaults to the smallest integer greater than +"3*sigma".

+
::crimp transform affine a b c d e f
+

This method returns the affine transformation specified by the 2x3 +matrix

+
+    |a b c|
+    |d e f|
+
+

Note that it is in general easier to use the methods rotate, +scale, and translate scale to generate the +desired transformation piecemal and then use chain to chain the +pieces together.

+
::crimp transform chain 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.

+
::crimp transform invert transform
+

This method computes and returns the inverse of the specified +projective transformation.

+
::crimp transform projective a b c d e f g h
+

This method returns the projective transformation specified by the 3x3 +matrix

+
+    |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 rotate, scale, and +translate scale to generate the desired +transformation piecemal and then use chain to chain the pieces +together.

+

And for a true perspective transformation specification through +quadrilateral should be simpler as well.

+
::crimp transform quadrilateral src dst
+

This method returns the projective transformation which maps the +quadrilateral src on to the quadrilateral dst.

+

Each quadrilateral is specified as a list of 4 points, each +point a pair of x- and y-coordinates.

+
::crimp transform rotate theta ?center?
+

This methods returns the projective transformation which rotates the +image by the anglie theta around the point center. If the +latter is not specified {0 0} is assumed. The point, if present, is +specified as pair of x- and y-coordinates.

+

The angle is specified in degrees, with 0 not rotating +the image at all. Positive values cause a counterclockwise rotation, +negative values a clockwise one.

+
::crimp transform scale sx sy
+

This methods returns the projective transformation which scales an +image by factor sx in width, and sy in height. Values +larger than 1 expand the image along the specified dimension, +while values less than 1 shrink it. Negative values flip the +respective axis.

+
::crimp transform translate dx dy
+

This methods returns the projective transformation which translates an +image by dx pixels along the x-axis, and dx pixels along +the y-axis. Values larger than 0 move the image to the right, +or down, along the specified dimension, while values less than +0 move it to the left, or up.

+
+
+
+

References

+
    +

  1. Simon Perreault and Patrick Hebert, "Median Filtering in Constant Time", 2007 + http://nomis80.org/ctmf.html

    2. +

  2. Nobuyuki Otsu, "A threshold selection method from gray-level histograms", 1979 + http://en.wikipedia.org/wiki/Otsu%27s_method

    3. +
+
+ + +