Critcl image processing
AMG: Here's some image processing code I wrote for use with Critcl, plus a very trippy animated demo.
See CRIMP for similar code maintained by AK.
#!/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 ].
AMG: I'm thinking of calling this "crimp", for "Critcl Image Manipulation Package". Does anyone have any better ideas? I've done quite a bit of development since posting the above code; I just haven't updated this page.
AKgnome - 2010-06-23 17:53:33
He. In the last few days I started on the IX (image eXtension) aka TIM (Tcl IMaging), using your code as initial base, plus using ideas for commands from the PIL. And today you may have seen me going through the Image pages on this wiki, looking for more things to draw in.
AMG: In that case, I really should put up the new code! I don't think it's in shape for this wiki, so instead I will email it to you when I get home from work.
AKgnome - 2010-06-23 18:25:33
Sure, no problem, and thanks. You might have seen mail from me to you, containing my code.
Kroc - LRIPhoto is another open source critcl package for very fast image processing (to rotate, scale, etc.).