[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 #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 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 [gcc]isms 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 [http://andy.junkdrome.org/winamp/avs/] for more in this same vein. While you're at it, try my Winamp SPS presets too [http://andy.junkdrome.org/winamp/sps/]. <> Image Processing | Critcl | Graphics