cyrusharmon.org

Cyrus Harmon's new completely useless blog

 

cyrusharmon.org

  • Blog
  • New entry
  • Archives
  • Syndicate (RSS)
  • Send Comments
  • Login

Recent entries

  • More on the pixel macro and setf-expander
  • opticl: an image processing library for common lisp
  • Neat!
  • k-means clustering of image pixels in opticl
  • TIFF writing in the new retrospectiff
  • Efficient Pixel Access in opticl
  • Argh...
  • More Oopses!
  • Oops!
  • Newly Not-so Neglected nuclblog

Categories

  • Lisp (RSS)
  • SBCL (RSS)
  • Computational Biology (RSS)
  • Computer Vision (RSS)
  • Science (RSS)
  • General (RSS)

More on the pixel macro and setf-expander

posted by cyrus in Lisp

Well, the previous attempts at the pixel setf-expander got most of the way there, but there are a couple of important changes since the last blog post, that I figured I should document for posterity's sake, lest someone run across the old post and attempt to base some future setf-expander off of the almost-but-not-quite-fully-working version contained therein.

First of all, Utz Uwe-Haus provided a number of fixes to get the fast path setf-expander working on Allegro. The first step was to get %get-image-dimensions working via a cltl2-signature-compatible version of variable-information. The second step was to look for types of the form (integer 0 255) instead of (unsigned-byte 8), which is how Allegro apparently reports (unsigned-byte 8)'s. Finally, it turns out that Allegro is finicky about needing things at compile-time in slightly different ways than SBCL is and it needs +max-image-channels+ define at compile-time, which sounds like the right thing to do in any case.

So with those changes in place, we have:

;;; support functions/constants for the pixel setf-expander need to  
;;; exist at compile time  
(eval-when (:compile-toplevel :load-toplevel :execute)  
  (defun %get-array-dimensions-from-type-decl (type-decl)  
    "Extract the array dimension specifier from type declaration TYPE-DECL."  
    #+(or sbcl ccl)  
    (and type-decl  
         ;; here we expect e.g. (TYPE SIMPLE-ARRAY (UNSIGNED-BYTE 8) (* * 3))  
         (listp type-decl)  
         (= (length type-decl) 4)  
         (fourth type-decl))  
    #+allegro  
    (and type-decl  
         ;; here we expect e.g. (TYPE (SIMPLE-ARRAY (INTEGER 0 255) (* * 3)))  
         (listp type-decl)  
         (= (length type-decl) 2)  
         (= (length (second type-decl)) 3)  
         (third (second type-decl))))  
 
  (defun %get-image-dimensions (image-var env)  
    #+(or sbcl ccl allegro)  
    (when (symbolp image-var)  
      (multiple-value-bind (binding-type localp declarations)  
          (opticl-cltl2:variable-information image-var env)  
        (declare (ignore binding-type localp))  
        (let ((type-decl (find 'type declarations :key #'car)))  
          (%get-array-dimensions-from-type-decl type-decl)))))  
 
  (defconstant +max-image-channels+ 4)) 

Ok, enough for the Allegro fixes. Now into the pixel setf-expander itself. There were a couple problems here. First, we weren't expanding image-var itself. This meant things would break if we tried to do:

(defmacro foo ()  
  `(make-8-bit-gray-image 4 4 :initial-element 32))  
 
(let ((moose))  
  (setf (pixel (setf moose (foo)) 0 0) 4)  
  moose) 

It turns out that we need to expand image-var itself with get-setf-expansion and deal with the 5 return values as appropriate. I think, that I can ignore the storing form, since I'm not actually, changing the value referred to by image-var and that I can just use the accessing form in the (setf (aref ...)) calls in the expander. If any language lawyers have any input here, it would be appreciated. Also, it's important to keep in mind that we need to return the temporary variables and their value forms from the get-setf-expansion. Ugh... This is all kind of a mess, but the end product is pretty neat! A non-consing idiomatic way to set pixel values, assuming we've declared the type of the image, but at least we can do so using the languages own (declare ...) mechanism rather than resorting to some sort of (with-fast-pixels ...) macro around all of the pixel/setf pixel calls.

Here's the final product:

(define-setf-expander pixel (image-var y x &environment env)  
  (multiple-value-bind (dummies vals newval setter getter)  
      (get-setf-expansion image-var env)  
    (declare (ignore newval setter))  
    (let ((image-dimensions (%get-image-dimensions getter env)))  
      (if image-dimensions  
          (let ((arity (or (and (= (length image-dimensions) 3)  
                                (third image-dimensions))  
                           1))  
                (temp-y (gensym))  
                (temp-x (gensym)))  
            (if (= arity 1)  
                (let ((store (gensym)))  
                  (values `(,@dummies ,temp-y ,temp-x)  
                          `(,@vals ,y ,x)  
                          `(,store)  
                          `(setf (aref ,getter ,temp-y ,temp-x) ,store)  
                          `(aref ,getter ,temp-y ,temp-x)))  
                (let ((stores (map-into (make-list arity) #'gensym)))  
                  (values `(,@dummies ,temp-y ,temp-x)  
                          `(,@vals ,y ,x)  
                          stores  
                          `(progn (setf ,@(loop for i from 0  
                                             for store in stores  
                                             collect `(aref ,getter ,temp-y ,temp-x ,i)  
                                             collect store))  
                                  (values ,@stores))  
                          `(values ,@(loop for i from 0 below (length stores)  
                                        collect `(aref ,getter ,temp-y ,temp-x ,i)))))))  
          (let ((syms (map-into (make-list +max-image-channels+) #'gensym)))  
            (let ((temp-y (gensym))  
                  (temp-x (gensym)))  
              (values `(,@dummies ,temp-y ,temp-x)  
                      `(,@vals ,y ,x)  
                      syms  
                      `(ecase (array-rank ,getter)  
                         (3 (let ((d (array-dimension ,getter 2)))  
                              (case d  
                                (1  
                                 (values  
                                  (setf (aref ,getter ,temp-y ,temp-x 0) ,(elt syms 0))))  
                                (2  
                                 (values  
                                  (setf (aref ,getter ,temp-y ,temp-x 0) ,(elt syms 0))  
                                  (setf (aref ,getter ,temp-y ,temp-x 1) ,(elt syms 1))))  
                                (3  
                                 (values  
                                  (setf (aref ,getter ,temp-y ,temp-x 0) ,(elt syms 0))  
                                  (setf (aref ,getter ,temp-y ,temp-x 1) ,(elt syms 1))  
                                  (setf (aref ,getter ,temp-y ,temp-x 2) ,(elt syms 2))))  
                                (4  
                                 (values  
                                  (setf (aref ,getter ,temp-y ,temp-x 0) ,(elt syms 0))  
                                  (setf (aref ,getter ,temp-y ,temp-x 1) ,(elt syms 1))  
                                  (setf (aref ,getter ,temp-y ,temp-x 2) ,(elt syms 2))  
                                  (setf (aref ,getter ,temp-y ,temp-x 3) ,(elt syms 3))))  
                                (t (loop for i below d  
                                      collect (setf (aref ,getter ,temp-y ,temp-x i) (elt (list ,@syms) i)))))))  
                         (2 (setf (aref ,getter ,temp-y ,temp-x) ,(elt syms 0))))  
                      `(ecase (array-rank ,getter)  
                         (3  
                          (let ((d (array-dimension ,getter 2)))  
                            (case d  
                              (1  
                               (values  
                                (aref ,getter ,temp-y ,temp-x 0)))  
                              (2  
                               (values  
                                (aref ,getter ,temp-y ,temp-x 0)  
                                (aref ,getter ,temp-y ,temp-x 1)))  
                              (3  
                               (values  
                                (aref ,getter ,temp-y ,temp-x 0)  
                                (aref ,getter ,temp-y ,temp-x 1)  
                                (aref ,getter ,temp-y ,temp-x 2)))  
                              (4  
                               (values  
                                (aref ,getter ,temp-y ,temp-x 0)  
                                (aref ,getter ,temp-y ,temp-x 1)  
                                (aref ,getter ,temp-y ,temp-x 2)  
                                (aref ,getter ,temp-y ,temp-x 3)))  
                              (t (values-list  
                                  (loop for i below d  
                                     collect (aref ,getter ,temp-y ,temp-x i)))))))  
                         (2 (aref ,getter ,temp-y ,temp-x))))))))))  
 
(defmacro pixel (image-var y x &environment env)  
  (let ((image-dimensions (%get-image-dimensions image-var env)))  
    (if image-dimensions  
        (progn  
          (ecase (length image-dimensions)  
            (2 `(aref ,image-var ,y ,x))  
            (3 `(values ,@(loop for i below (third image-dimensions)  
                             collect `(aref ,image-var ,y ,x ,i))))))  
        `(ecase (array-rank ,image-var)  
           (2 (aref ,image-var ,y ,x))  
           (3 (ecase (array-dimension ,image-var 2)  
                (1 (values  
                    (aref ,image-var ,y ,x 0)))  
                (2 (values  
                    (aref ,image-var ,y ,x 0)  
                    (aref ,image-var ,y ,x 1)))  
                (3 (values  
                    (aref ,image-var ,y ,x 0)  
                    (aref ,image-var ,y ,x 1)  
                    (aref ,image-var ,y ,x 2)))  
                (4 (values  
                    (aref ,image-var ,y ,x 0)  
                    (aref ,image-var ,y ,x 1)  
                    (aref ,image-var ,y ,x 2)  
                    (aref ,image-var ,y ,x 3))))))))) 

Finally, if you've gotten this far and you want to see opticl in action, check out spectacle a CLIM application for viewing images that uses opticl for the image loading, representation, etc... On SBCL, and presumably Allegro, it has nice responsive scrolling/zooming/rotating/etc..., but if the pixel stuff conses (as it seems to do on CCL), it can be a bit sluggish.

More on the pixel macro and setf-expander

opticl: an image processing library for common lisp

posted by cyrus in Lisp

I'd like to officially announce the availability (and perhaps more importantly, the quicklisp-installability) of opticl, a new image processing library for Common Lisp with a BSD-style license.

Opticl can be found on the opticl github page. To install opticl from quicklisp, do:

(ql:quickload 'opticl) 

from a suitable lisp with quicklisp installed. Opticl has been mostly developed on SBCL, but should work on any Common Lisp, and has seen some limited testing on CCL and ABCL. Patches to more fully support other lisps would be most welcome, should they be needed.

Opticl picks up many of the ideas and concepts from my earlier ch-image image processing library and Matthieu Villenueve's IMAGO library, but offers some advantages over both packages, such as the direct use of common lisp arrays for images and the efficient access to both getting and setting pixel values using mulitple-values, a setf-exapnder and, where available, CLtL2-style variable information to provide hints to the compiler to generate efficient code using standard lisp type declaration expressions.

Some of the core features of opticl are:

  • representation of various types of 2-d images in common lisp arrays and routines for making the appropriate arrays
  • routines for efficiently performing affine transformations of images providing for operations such as resizing, scaling, rotating and skewing images
  • support for discrete convolution with arbitrary kernels, with built-in kernels for blurring and sharpening images
  • support for morphological operations with arbitrary kernels, with built-in kernels for dilating and eroding images
  • simple drawing primitives
  • performing gamma computations on images
  • I/O routines to read and write from various file formats; currently supported filetypes are JPEG, PNG, TIFF, PBM, PGM, PPM and GIF.
  • routines for converting between various image types
  • k-means clustering of pixels in images

More details about opticl can be found in the README, and in the opticl-test and opticl-examples packages. Note that these packages have been broken out into their own repositories in order to keep the size of a core opticl installation to a minimum. Currently opticl checks in around 3,500 lines of lisp code and the code compiles to approximately 900k of fasl files on SBCL/x86-64.

opticl: an image processing library for common lisp

Neat!

posted by cyrus in Lisp

darcs-to-git is a rather handy tool.

Neat!

k-means clustering of image pixels in opticl

posted by cyrus in Lisp

There's a new function, k-means-cluster-image-pixels, in opticl that does k-means clustering of the pixels in an image. It can be invoked thusly:

(in-package :opticl-test)  
 
(write-image-file  
 (output-image "fish-clusters.png")  
 (let ((in (read-image-file (test-image "fish.png"))))  
   (with-image-bounds (height width) in  
     (let ((img (make-8-bit-rgb-image height width)))  
       (let ((k 24))  
         (multiple-value-bind (means assignments)  
             (time (k-means-cluster-image-pixels  
                    (dilate (blur-image in)  
                            (make-8-bit-rgb-image 3 3 :initial-element 1))  
                    k))  
           (set-pixels (i j) img  
             (let ((m (aref assignments i j)))  
               (pixel means m 0)))))  
       img)))) 

That takes an image that looks like this:

spacer

and yields an image such as this:

spacer

k-means clustering of image pixels in opticl

TIFF writing in the new retrospectiff

posted by cyrus in Lisp

Just wanted to announce that retrospectiff now supports both reading and writing TIFF files, using gigamonkey's binary-data library. Unlike the old retrospectiff, both big-endian and little-endian formats are properly supported for both reading and writing.

opticl uses retrospectiff for reading and writing TIFF files and now supports writing images as TIFF files (along with with PNG, JPEG and PNM).

TIFF writing in the new retrospectiff

Efficient Pixel Access in opticl

posted by cyrus in Lisp

Efficient Access to Pixel Information in Images

We want a way to efficiently (using few processor cycles and minimally consing) access information about individual pixes in images. Multiple values allow for a non-consing way to get and set more than one value at a time using the lisp implementation's argument passing and value returning facilities without having to explicitly place values in or retrieve values from a list.

Reading pixel values is pretty straightforward:

(defmacro pixel (image-var y x &environment env)  
  (let ((image-dimensions (get-image-dimensions image-var env)))  
    (if image-dimensions  
        (progn  
          (case (length image-dimensions)  
            (2 `(aref ,image-var ,y ,x))  
            (3 `(values ,@(loop for i below (third image-dimensions)  
                             collect `(aref ,image-var ,y ,x ,i))))))  
        `(case (array-rank ,image-var)  
           (2 (aref ,image-var ,y ,x))  
           (3 (case (array-dimension ,image-var 2)  
                (2 (values  
                    (aref ,image-var ,y ,x 0)  
                    (aref ,image-var ,y ,x 1)))  
                (3 (values  
                    (aref ,image-var ,y ,x 0)  
                    (aref ,image-var ,y ,x 1)  
                    (aref ,image-var ,y ,x 2)))  
                (4 (values  
                    (aref ,image-var ,y ,x 0)  
                    (aref ,image-var ,y ,x 1)  
                    (aref ,image-var ,y ,x 2)  
                    (aref ,image-var ,y ,x 3))))))))) 

This handles both single-channel (grayscale) and multi-channel (RGB and RGBA) pixels, returning the number of values as appropriate.

Setting pixels, on the other hand, is a bit tricker. We want a form that allows us to (setf (pixel img y x) ...) and take the number of values as appropriate for the particular image, but we also want this setting to be non-consing and efficient. CL has a define-setf-expander that can be used for just such a thing. Turns out it's fairly tricky to get this right, so I have included my intermediate attempts, followed by the final version.

My original define-setf-expander approach

(defconstant +max-image-channels+ 4)  
 
(define-setf-expander pixel (img y x &environment env)  
  (multiple-value-bind (temps subforms store-vars setter getter)  
      (get-setf-expansion img env)  
    (declare (ignore store-vars setter))  
    (let ((syms (map-into (make-list +max-image-channels+) #'gensym)))  
      (values temps  
              subforms  
              syms  
              `(check-bounds (,img ,y ,x)  
                 (case (array-rank ,getter)  
                   (3 (let ((d (array-dimension ,getter 2)))  
                        (case d  
                          (1  
                           (values  
                            (setf (aref ,getter ,y ,x 0) ,(elt syms 0))))  
                          (2  
                           (values  
                            (setf (aref ,getter ,y ,x 0) ,(elt syms 0))  
                            (setf (aref ,getter ,y ,x 1) ,(elt syms 1))))  
                          (3  
                           (values  
                            (setf (aref ,getter ,y ,x 0) ,(elt syms 0))  
                            (setf (aref ,getter ,y ,x 1) ,(elt syms 1))  
                            (setf (aref ,getter ,y ,x 2) ,(elt syms 2))))  
                          (4  
                           (values  
                            (setf (aref ,getter ,y ,x 0) ,(elt syms 0))  
                            (setf (aref ,getter ,y ,x 1) ,(elt syms 1))  
                            (setf (aref ,getter ,y ,x 2) ,(elt syms 2))  
                            (setf (aref ,getter ,y ,x 3) ,(elt syms 3))))  
                          (t (loop for i below d  
                                collect (setf (aref ,getter ,y ,x i) (elt (list ,@syms) i)))))))  
                   (2 (setf (aref ,getter ,y ,x) ,(elt syms 0))))  
                 (values))  
              `(check-bounds (,img ,y ,x)  
                 (case (array-rank ,getter)  
                   (3  
                    (let ((d (array-dimension ,getter 2)))  
                      (case d  
                        (1  
                         (values  
                          (aref ,getter ,y ,x 0)))  
                        (2  
                         (values  
                          (aref ,getter ,y ,x 0)  
                          (aref ,getter ,y ,x 1)))  
                        (3  
                         (values  
                          (aref ,getter ,y ,x 0)  
                          (aref ,getter ,y ,x 1)  
                          (aref ,getter ,y ,x 2)))  
                        (4  
                         (values  
                          (aref ,getter ,y ,x 0)  
                          (aref ,getter ,y ,x 1)  
                          (aref ,getter ,y ,x 2)  
                          (aref ,getter ,y ,x 3)))  
                        (t (values-list  
                            (loop for i below d  
                               collect (aref ,getter ,y ,x i)))))))  
                   (2 (aref ,getter ,y ,x)))  
                 (values)))))) 

Robert Strandh's with-image macro:

Robert Strandh proposed a with-image macro that would squirrel away the height, witdth and depth of the image such that the setf-expander could grab this information from the lexical environment.

(defmacro with-image ((image-var height width &optional (depth 1)) &body body &environment env)  
  (let* ((old-info (if (eq (macroexpand-1 'image-info env) 'image-info)  
                       '()  
                       (macroexpand-1 'image-info env)))  
         (new-info (cons (list image-var height width depth) old-info)))  
    `(symbol-macrolet ((image-info ,new-info))  
       ,@body)))  
 
(define-setf-expander pixel** (image-var y x &environment env)  
  (let ((arity (fourth (assoc image-var (macroexpand-1 'image-info env))))  
        (temp-y (gensym))  
        (temp-x (gensym)))  
    (if (= arity 1)  
        (let ((store (gensym)))  
          (values `(,temp-y ,temp-x)  
                  `(,y ,x)  
                  `(,store)  
                  `(setf (aref ,image-var ,temp-y ,temp-x) ,store)  
                  `(aref ,image-var ,temp-y ,temp-x)))  
        (let ((stores (map-into (make-list arity) #'gensym)))  
          (values `(,temp-y ,temp-x)  
                  `(,y ,x)  
                  stores  
                  `(progn (setf ,@(loop for i from 0  
                                        for store in stores  
                                        collect `(aref ,image-var ,temp-y ,temp-x ,i)  
                                        collect store))  
                          (values ,@stores))  
                  `(values ,@(loop for i from 0  
                                   for store in stores  
                                   collect `(aref ,image-var ,temp-y ,temp-x ,i))))))))  

An improved setf-expander

It would be nice if we could use standard CL declaration forms to yield this information. It turns out that CLtL2 has a facility that we can use to do this, the variable-information facility. Using this we can use the following function to grab information about the declared type of an image (if present):

#+sbcl  
(require :sb-cltl2)  
 
(defpackage :opticl-cltl2  
  #+sbcl (:import-from :sb-cltl2 :variable-information)  
  #+ccl (:import-from :ccl :variable-information)  
  #+(or sbcl ccl) (:export :variable-information))  
 
(defun get-image-dimensions (image-var env)  
  #+(or sbcl ccl)  
  (multiple-value-bind (binding-type localp declarations)  
      (opticl-cltl2:variable-information image-var env)  
    (declare (ignore binding-type localp))  
    (let ((type-decl (find 'type declarations :key #'car)))  
      (and type-decl  
           (listp type-decl)  
           (= (length type-decl) 4)  
           (fourth type-decl)))))  

Now we can use the following define-setf-expander:

(define-setf-expander pixel (image-var y x &environment env)  
  (let ((image-dimensions (get-image-dimensions image-var env)))  
    (let ((arity (or (and (= (length image-dimensions) 3)  
                          (third image-dimensions))  
                     1))  
          (temp-y (gensym))  
          (temp-x (gensym)))  
      (if (= arity 1)  
          (let ((store (gensym)))  
            (values `(,temp-y ,temp-x)  
                    `(,y ,x)  
                    `(,store)  
                    `(setf (aref ,image-var ,temp-y ,temp-x) ,store)  
                    `(aref ,image-var ,temp-y ,temp-x)))  
          (let ((stores (map-into (make-list arity) #'gensym)))  
            (values `(,temp-y ,temp-x)  
                    `(,y ,x)  
                    stores  
                    `(progn (setf ,@(loop for i from 0  
                                       for store in stores  
                                       collect `(aref ,image-var ,temp-y ,temp-x ,i)  
                                       collect store))  
                            (values ,@stores))  
                    `(values ,@(loop for i from 0 below (length stores)  
                                  collect `(aref ,image-var ,temp-y ,temp-x ,i))))))))) 

Of course we still want this to work in the case where we don't have the type information, so we have a fallback path, and we need to reintroduce the +max-image-channels+ constant, yielding:

(defconstant +max-image-channels+ 4)  
 
(define-setf-expander pixel (image-var y x &environment env)  
  (let ((image-dimensions (get-image-dimensions image-var env)))  
    (if image-dimensions  
        (let ((arity (or (and (= (length image-dimensions) 3)  
                              (third image-dimensions))  
                         1))  
              (temp-y (gensym))  
              (temp-x (gensym)))  
          (if (= arity 1)  
              (let ((store (gensym)))  
                (values `(,temp-y ,temp-x)  
                        `(,y ,x)  
                        `(,store)  
                        `(setf (aref ,image-var ,temp-y ,temp-x) ,store)  
                        `(aref ,image-var ,temp-y ,temp-x)))  
              (let ((stores (map-into (make-list arity) #'gensym)))  
                (values `(,temp-y ,temp-x)  
                        `(,y ,x)  
                        stores  
                        `(progn (setf ,@(loop for i from 0  
                                           for store in stores  
                                           collect `(aref ,image-var ,temp-y ,temp-x ,i)  
                                           collect store))  
                                (values ,@stores))  
                        `(values ,@(loop for i from 0 below (length stores)  
                                      collect `(aref ,image-var ,temp-y ,temp-x ,i)))))))  
        (let ((syms (map-into (make-list +max-image-channels+) #'gensym)))  
          (let ((temp-y (gensym))  
                (temp-x (gensym)))  
            (values `(,temp-y ,temp-x)  
                    `(,y ,x)  
                    syms  
                    `(case (array-rank ,image-var)  
                       (3 (let ((d (array-dimension ,image-var 2)))  
                            (case d  
                              (1  
                               (values  
                                (setf (aref ,image-var ,temp-y ,temp-x 0) ,(elt syms 0))))  
                              (2  
                               (values  
                                (setf (aref ,image-var ,temp-y ,temp-x 0) ,(elt syms 0))  
                                (setf (aref ,image-var ,temp-y ,temp-x 1) ,(elt syms 1))))  
                              (3  
                               (values  
                                (setf (aref ,image-var ,temp-y ,temp-x 0) ,(elt syms 0))  
                                (setf (aref ,image-var ,temp-y ,temp-x 1) ,(elt syms 1))  
                                (setf (aref ,image-var ,temp-y ,temp-x 2) ,(elt syms 2))))  
                              (4  
                               (values  
                                (setf (aref ,image-var ,temp-y ,temp-x 0) ,(elt syms 0))  
                                (setf (aref ,image-var ,temp-y ,temp-x 1) ,(elt syms 1))  
                                (setf (aref ,image-var ,temp-y ,temp-x 2) ,(elt syms 2))  
                                (setf (aref ,image-var ,temp-y ,temp-x 3) ,(elt syms 3))))  
                              (t (loop for i below d  
                                    collect (setf (aref ,image-var ,temp-y ,temp-x i) (elt (list ,@syms) i)))))))  
                       (2 (setf (aref ,image-var ,temp-y ,temp-x) ,(elt syms 0))))  
                    `(case (array-rank ,image-var)  
                       (3  
                        (let ((d (array-dimension ,image-var 2)))  
                          (case d  
                            (1  
                             (values  
                              (aref ,image-var ,temp-y ,temp-x 0)))  
                            (2  
                             (values  
                              (aref ,image-var ,temp-y ,temp-x 0)  
                              (aref ,image-var ,temp-y ,temp-x 1)))  
                            (3  
                             (values  
                              (aref ,image-var ,temp-y ,temp-x 0)  
                              (aref ,image-var ,temp-y ,temp-x 1)  
                              (aref ,image-var ,temp-y ,temp-x 2)))  
                            (4  
                             (values  
                              (aref ,image-var ,temp-y ,temp-x 0)  
                              (aref ,image-var ,temp-y ,temp-x 1)  
                              (aref ,image-var ,temp-y ,temp-x 2)  
                              (aref ,image-var ,temp-y ,temp-x 3)))  
                            (t (values-list  
                                (loop for i below d  
                                   collect (aref ,image-var ,temp-y ,temp-x i)))))))  
                       (2 (aref ,image-var ,temp-y ,temp-x))))))))) 

This gives us non-consing pixel value setting for multiple- (and single-) channel images.

Questions:

  • Should grayscale images have be 3-dimensional arrays with a 3-rd dimension of 1 instead of 2-d images? It would simplify some code in that we would know that there would always be three indices for arrays -- I think we can get away with variable rank.

  • Should we use the with-image macro for establishing compile-time information about arrays -- I think cltl2:variable-information is a better way to go, but we use the ugly fallback mechanism on non-(SBCL or CCL) platforms. What about ABCL, CMUCL, clisp, ECL and Allegro? At least some of these should support cltl2.
Efficient Pixel Access in opticl

Argh...

posted by cyrus in Lisp

Well, I was hoping that moving my blog to a more mainstream OS (linux) might address some of the periodic crashing issues. Alas, that doesn't seem to be the case. Perhaps upgrading to a new version of hunchentoot will motivate me to spend some more time trying to track down the source(s) of the problem.

Argh...

More Oopses!

posted by cyrus in Lisp

Well, it looks like I was calling (who:escape-string (str ...)) instead of (str (escape-string ...)) which was messing up my RSS feeds. Hopefully fixing this will improve things.

More Oopses!

Oops!

posted by cyrus in Science

I guess this isn't too surprising, but it's a bit troubling.

Nice smackdown by Richard Gibbs: "I don't know of any good scientific work that has been compromised by cross-species contamination..."

Oops!

Newly Not-so Neglected nuclblog

posted by cyrus in Lisp

After a ridiculously long hiatus, nuclblog is finally getting a little love. It now uses cl-markdown, and has hooks for extending posts such that things like disqus comments can be added without hacking up the core nuclblog code.

If anyone wants to see the source on github, let me know.

Oh, and if you want to see the disqus comments in action, click on the link for a blog entry to bring it up on its own page.

Newly Not-so Neglected nuclblog
gipoco.com is neither affiliated with the authors of this page nor responsible for its contents. This is a safe-cache copy of the original web site.