Permalink
Browse files

once again clean up the type system, this time getting rid of the red…

…undant and slightly-misleading (but, thankfully, not exported) integer-image and float-image
  • Loading branch information...
1 parent 1849630 commit 1e9006dbd3eff15e1c93e2efcb554693e2b463dc @slyrus committed Mar 25, 2011
Showing with 26 additions and 39 deletions.
  1. +26 −39 opticl.lisp
View
@@ -20,54 +20,41 @@
(deftype rgba-image (&key element-type)
`(simple-array ,element-type (* * 4)))
-(deftype integer-image (&key (channels 1) element-type)
- `(simple-array ,element-type
- ,(if (numberp channels)
- (if (= channels 1)
- `(* *)
- `(* * ,channels))
- channels)))
-
-(deftype float-image (&key (channels 1) element-type)
- `(simple-array ,element-type
- ,(if (numberp channels)
- (if (= channels 1)
- `(* *)
- `(* * ,channels))
- channels)))
-
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *image-types*
- '((1-bit-gray-image integer-image :element-type (unsigned-byte 1))
- (2-bit-gray-image integer-image :element-type (unsigned-byte 2))
- (4-bit-gray-image integer-image :element-type (unsigned-byte 4))
- (8-bit-gray-image integer-image :element-type (unsigned-byte 8))
- (16-bit-gray-image integer-image :element-type (unsigned-byte 16))
- (32-bit-gray-image integer-image :element-type (unsigned-byte 32))
- (fixnum-gray-image integer-image :element-type fixnum)
- (single-float-gray-image float-image :element-type single-float)
- (double-float-gray-image float-image :element-type double-float)
+ '((single-float-image :element-type single-float)
+ (double-float-image :element-type double-float)
+
+ (1-bit-gray-image :channels 1 :element-type (unsigned-byte 1))
+ (2-bit-gray-image :channels 1 :element-type (unsigned-byte 2))
+ (4-bit-gray-image :channels 1 :element-type (unsigned-byte 4))
+ (8-bit-gray-image :channels 1 :element-type (unsigned-byte 8))
+ (16-bit-gray-image :channels 1 :element-type (unsigned-byte 16))
+ (32-bit-gray-image :channels 1 :element-type (unsigned-byte 32))
+ (fixnum-gray-image :channels 1 :element-type fixnum)
+ (single-float-gray-image :channels 1 :element-type single-float)
+ (double-float-gray-image :channels 1 :element-type double-float)
- (4-bit-rgb-image integer-image :channels 3 :element-type (unsigned-byte 4))
- (8-bit-rgb-image integer-image :channels 3 :element-type (unsigned-byte 8))
- (16-bit-rgb-image integer-image :channels 3 :element-type (unsigned-byte 16))
- (single-float-rgb-image float-image :channels 3 :element-type single-float)
- (double-float-rgb-image float-image :channels 3 :element-type double-float)
+ (4-bit-rgb-image :channels 3 :element-type (unsigned-byte 4))
+ (8-bit-rgb-image :channels 3 :element-type (unsigned-byte 8))
+ (16-bit-rgb-image :channels 3 :element-type (unsigned-byte 16))
+ (single-float-rgb-image :channels 3 :element-type single-float)
+ (double-float-rgb-image :channels 3 :element-type double-float)
- (4-bit-rgba-image integer-image :channels 4 :element-type (unsigned-byte 4))
- (8-bit-rgba-image integer-image :channels 4 :element-type (unsigned-byte 8))
- (16-bit-rgba-image integer-image :channels 4 :element-type (unsigned-byte 16))
- (single-float-rgba-image float-image :channels 4 :element-type single-float)
- (double-float-rgba-image float-image :channels 4 :element-type double-float)
+ (4-bit-rgba-image :channels 4 :element-type (unsigned-byte 4))
+ (8-bit-rgba-image :channels 4 :element-type (unsigned-byte 8))
+ (16-bit-rgba-image :channels 4 :element-type (unsigned-byte 16))
+ (single-float-rgba-image :channels 4 :element-type single-float)
+ (double-float-rgba-image :channels 4 :element-type double-float)
)))
(macrolet
- ((frob-image (name image-type &key channels element-type)
+ ((frob-image (name &key channels element-type)
(let ((type (read-from-string (format nil "~A" name))))
(let ((ctor-function
(read-from-string (format nil "make-~A" type))))
`(progn
- (deftype ,type () ',(list* image-type
+ (deftype ,type () ',(list* 'image
(append
(when channels
`(:channels ,channels))
@@ -90,9 +77,9 @@
`(progn
,@(loop for image-spec in *image-types*
collect
- (destructuring-bind (name image-type &key channels element-type)
+ (destructuring-bind (name &key channels element-type)
image-spec
- `(frob-image ,name ,image-type
+ `(frob-image ,name
,@(if channels
`(:channels ,channels))
,@(if element-type

0 comments on commit 1e9006d

Please sign in to comment.