Version 2 of Critcl image processing

Updated 2010-06-23 18:25:50 by AMG

AMG: Here's some image processing code I wrote for use with Critcl, plus a very trippy animated demo.

Critcl image processing screenshot 1 Critcl image processing screenshot 2


#!/bin/sh
# The next line restarts with tclsh.\
exec tclsh "$0" ${1+"$@"}

lappend auto_path C:/msys/home/andy/critcl.vfs/lib

package require Tk
package require critcl

critcl::config tk 1

critcl::ccode {
    #include <math.h>
    #include <stdlib.h>
    #include <string.h>

    #define MIN(a, b) ((a) < (b) ? (a) : (b))
    #define MAX(a, b) ((a) > (b) ? (a) : (b))
    #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 manip {
    namespace ensemble create -subcommands {
        export import psychedelia wavy merge mirror flip
    }

critcl::cproc export {Tcl_Interp* interp char* photo Tcl_Obj* imageObj} ok {
    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;
}

critcl::cproc import {Tcl_Interp* interp char* photo} ok {
    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;
}

critcl::cproc psychedelia {Tcl_Interp* interp int width int height
int frames} ok {
    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;
}

critcl::cproc wavy {Tcl_Interp* interp Tcl_Obj* imageObj float offset float adj1
float adj2} ok {
    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;
}

critcl::cproc merge {Tcl_Interp* interp Tcl_Obj* imageListObj} ok {
    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;
}

critcl::cproc mirror {Tcl_Interp* interp Tcl_Obj* imageObj} ok {
    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;
}

critcl::cproc flip {Tcl_Interp* interp Tcl_Obj* imageObj} ok {
    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;
}

}

set photo1 [image create photo -file $tk_library/images/lamp.png]
set photo2 [image create photo]
set photo3 [image create photo]
set photo4 [image create photo]
set image [manip import $photo1]
lassign $image width height
canvas .c -highlightthickness 0 -width [expr {2 * $width}]\
        -height [expr {2 * $height}]
.c create image 0 0 -anchor nw -image $photo1
.c create image $width 0 -anchor nw -image $photo2
.c create image 0 $height -anchor nw -image $photo3
.c create image $width $height -anchor nw -image $photo4
scale .adj1 -orient horizontal -variable adj1 -from 0 -to 30 -resolution 0.01
scale .adj2 -orient horizontal -variable adj2 -from 1 -to 30 -resolution 0.01
scale .frames -orient horizontal -variable frames -from 10 -to 100
pack .c .adj1 .adj2 .frames -fill both
wm resizable . 0 0
set off 0
set adj1 25
set adj2 9
set frames 70
proc tick {} {
    global photo1 photo2 photo3 photo4 image off adj1 adj2 frames
    lassign $image width height
    set result [manip merge [list\
        [manip psychedelia $width $height $frames]\
        [manip wavy $image $off $adj1 $adj2]]]
    set mirrored [manip mirror $result]
    manip export $photo1 $result
    manip export $photo2 $mirrored
    manip export $photo3 [manip flip $result]
    manip export $photo4 [manip flip $mirrored]
    set off [expr {fmod($off + acos(-1) / 10, 2 * acos(-1))}]
    after idle {after 0 tick}
}
tick

# vim: set sts=4 sw=4 tw=80 et ft=tcl:

An image is simply a three-element list. The first element is the width, the second element is the height, and the third element is the pixel data. The pixel data is a binary array of pixels in row-major order. Each pixel is composed of red, green, blue, and alpha components, where each component is a byte value ranging from 0 to 255. Pretty straightforward.

Yes, there are evil gccisms in the code. No, there aren't any comments. Yes, I incorrectly assume linear gamma. And yes, there is a dynamically sized array of pointers to two-dimensional arrays of partially specified size. I'll clean up this code eventually; for now, I just want to dump it on the Wiki so you all can have fun with it. I plan to add a lot more functionality, since I'm doing this for an art project.

The "psychedelia" image generation formulas are my creation, by the way. Ditto "wavy". See my Winamp AVS presets [L1 ] for more in this same vein. While you're at it, try my Winamp SPS presets too [L2 ].