Permalink
Browse files

Signal DevIL errors as conditions.

  • Loading branch information...
1 parent 67f708b commit 976b54b620ddda5e2ad5bfa455c581edb4f95980 @Ralith Ralith committed with Josh Marchán Jan 18, 2010
Showing with 83 additions and 45 deletions.
  1. +83 −45 il.lisp
View
128 il.lisp
@@ -75,34 +75,43 @@
(:bgr32 #x0405)
(:bgra32 #x0406))
-(defcenum error
- (:no-error #x0000)
- (:invalid-enum #x0501)
- (:out-of-memory #x0502)
- (:format-not-supported #x0503)
- (:internal-error #x0504)
- (:invalid-value #x0505)
- (:illegal-operation #x0506)
- (:illegal-file-value #x0507)
- (:invalid-file-header #x0508)
- (:invalid-param #x0509)
- (:could-not-open-file #x050A)
- (:invalid-extension #x050B)
- (:file-already-exists #x050C)
- (:out-format-same #x050D)
- (:stack-overflow #x050E)
- (:stack-underflow #x050F)
- (:invalid-conversion #x0510)
- (:bad-dimensions #x0511)
- (:file-read-error #x0512)
- (:file-write-error #x0512)
- (:lib-gif-error #x05E1)
- (:lib-jpeg-error #x05E2)
- (:lib-png-error #x05E3)
- (:lib-tiff-error #x05E4)
- (:lib-mng-error #x05E5)
- (:unknown-error #x05FF))
-
+(define-condition devil-error (cl:error)
+ ((enum-value :initarg :enum-value :reader enum-value)))
+(macrolet ((deferrs (&rest keys)
+ `(progn
+ (defcenum error ,@keys)
+ ,@(loop for (key value) in keys collecting
+ (let ((symbol (intern (symbol-name key))))
+ `(define-condition ,symbol (devil-error) ()
+ (:default-initargs :enum-value ,key)))))))
+ (deferrs
+ (:no-error #x0000)
+ (:invalid-enum #x0501)
+ (:out-of-memory #x0502)
+ (:format-not-supported #x0503)
+ (:internal-error #x0504)
+ (:invalid-value #x0505)
+ (:illegal-operation #x0506)
+ (:illegal-file-value #x0507)
+ (:invalid-file-header #x0508)
+ (:invalid-param #x0509)
+ (:could-not-open-file #x050A)
+ (:invalid-extension #x050B)
+ (:file-already-exists #x050C)
+ (:out-format-same #x050D)
+ (:stack-overflow #x050E)
+ (:stack-underflow #x050F)
+ (:invalid-conversion #x0510)
+ (:bad-dimensions #x0511)
+ (:file-read-error #x0512)
+ (:file-write-error #x0512)
+ (:lib-gif-error #x05E1)
+ (:lib-jpeg-error #x05E2)
+ (:lib-png-error #x05E3)
+ (:lib-tiff-error #x05E4)
+ (:lib-mng-error #x05E5)
+ (:unknown-error #x05FF)))
+
(defcenum mode
(:file-overwrite #x0620)
(:file-mode #x0621)
@@ -149,6 +158,15 @@
`(with-foreign-string (,var (if (pathnamep ,value) (namestring ,value) ,value))
,@body)))
+(defmacro maybe-error (call)
+ `(if ,call
+ (values)
+ (cl:error (make-condition (find-symbol (symbol-name (get-error)) (find-package :il))))))
+
+(defmacro deferrwrap (name &optional args)
+ `(defun ,name ,args
+ (maybe-error (,(symbolicate "%" (symbol-name name)) ,@args))))
+
(defcfun ("ilInit" init) :void)
(defcfun ("ilShutDown" shutdown) :void)
(defcfun ("ilGenImages" %gen-images) :void (num :int) (images :pointer))
@@ -165,28 +183,43 @@
(defun delete-images (images)
(with-foreign-object (array :uint (length images))
(loop for i below (length images)
- do (setf (mem-aref array :uint i) (elt images i)))
+ for image in images
+ do (setf (mem-aref array :uint i) image))
(%delete-images (length images) array)))
-(defcfun ("ilLoadImage" load-image) :boolean (file-name pathname-string))
-(defcfun ("ilLoad" load) :boolean (type image-type) (file-name pathname-string))
-(defcfun ("ilLoadF" load-f) :boolean (type image-type) (file handle))
-(defcfun ("ilLoadL" load-l) :boolean (type image-type) (lump :pointer) (size :uint))
-(defcfun ("ilSaveImage" save-image) :boolean (file-name pathname-string))
-(defcfun ("ilSave" save) :boolean (type image-type) (file-name pathname-string))
-(defcfun ("ilSaveF" save-f) :boolean (type image-type) (file handle))
-(defcfun ("ilSaveL" save-l) :boolean (type image-type) (lump :pointer) (size :uint))
-(defcfun ("ilTexImage" tex-image) :boolean
+(defcfun ("ilLoadImage" %load-image) :boolean (file-name pathname-string))
+(deferrwrap load-image (file-name))
+(defcfun ("ilLoad" %load) :boolean (type image-type) (file-name pathname-string))
+(deferrwrap load (type file-name))
+(defcfun ("ilLoadF" %load-f) :boolean (type image-type) (file handle))
+(deferrwrap load-f (type handle))
+(defcfun ("ilLoadL" %load-l) :boolean (type image-type) (lump :pointer) (size :uint))
+(deferrwrap load-l (type pointer size))
+
+(defcfun ("ilSaveImage" %save-image) :boolean (file-name pathname-string))
+(deferrwrap save-image (file-name))
+(defcfun ("ilSave" %save) :boolean (type image-type) (file-name pathname-string))
+(deferrwrap save (type file-name))
+(defcfun ("ilSaveF" %save-f) :boolean (type image-type) (file handle))
+(deferrwrap save-f (type handle))
+(defcfun ("ilSaveL" %save-l) :boolean (type image-type) (lump :pointer) (size :uint))
+(deferrwrap save-l (type pointer size))
+
+(defcfun ("ilTexImage" %tex-image) :boolean
(width :uint) (height :uint) (depth :uint) (bpp :uint8) (format data-format) (type data-type) (data :pointer))
+(deferrwrap tex-image (width height depth bpp format type data))
(defcfun ("ilGetData" get-data) :pointer)
(defcfun ("ilCopyPixels" copy-pixels) :uint
(x-offset :uint) (y-offset :uint) (z-offset :uint) (width :uint) (height :uint) (depth :uint) (format data-format) (type data-type) (data :pointer))
(defcfun ("ilSetData" set-data) :pointer)
(defcfun ("ilSetPixels" set-pixels) :uint
(x-offset :uint) (y-offset :uint) (z-offset :uint) (width :uint) (height :uint) (depth :uint) (format data-format) (type data-type) (data :pointer))
-(defcfun ("ilCopyImage" copy-image) :boolean (source :uint))
-(defcfun ("ilOverlayImage" overlay-image) :boolean (source :uint) (x-coord :int) (y-coord :int) (z-coord :int))
-(defcfun ("ilBlit" blit) :boolean (source :uint) (dest-x :int) (dest-y :int) (dest-z :int) (src-x :int) (src-y :int) (src-z :int) (width :uint) (height :uint) (depth :uint))
+(defcfun ("ilCopyImage" %copy-image) :boolean (source :uint))
+(deferrwrap copy-image (source))
+(defcfun ("ilOverlayImage" %overlay-image) :boolean (source :uint) (x-coord :int) (y-coord :int) (z-coord :int))
+(deferrwrap overlay-image (source x y z))
+(defcfun ("ilBlit" %blit) :boolean (source :uint) (dest-x :int) (dest-y :int) (dest-z :int) (src-x :int) (src-y :int) (src-z :int) (width :uint) (height :uint) (depth :uint))
+(deferrwrap blit (source dest-x dest-y dest-z src-x src-y src-z width height depth))
(defcfun ("ilGetError" get-error) error)
(defcfun ("ilKeyColour" key-color) :void (red :float) (green :float) (blue :float) (alpha :float))
@@ -195,14 +228,19 @@
(defcfun ("ilGetInteger" get-integer) :uint (mode mode))
(defcfun ("ilSetInteger" set-integer) :void (mode mode) (param :int))
-(defcfun ("ilEnable" enable) :boolean (mode mode))
-(defcfun ("ilDisable" disable) :boolean (mode mode))
+(defcfun ("ilEnable" %enable) :boolean (mode mode))
+(deferrwrap enable (mode))
+(defcfun ("ilDisable" %disable) :boolean (mode mode))
+(deferrwrap disable (mode))
(defcfun ("ilIsEnabled" %is-enabled) :boolean (mode mode))
(defun enabledp (mode)
(%is-enabled mode))
-(defcfun ("ilConvertImage" convert-image) :boolean (format data-format) (type data-type))
+(defcfun ("ilConvertImage" %convert-image) :boolean (format data-format) (type data-type))
+(deferrwrap convert-image (format type))
#-win32
-(defcfun ("ilFlipImage" flip-image) :boolean)
+(progn
+ (defcfun ("ilFlipImage" %flip-image) :boolean)
+ (deferrwrap flip-image))
(defcfun ("ilDetermineType" determine-type) image-type (pathname pathname-string))

0 comments on commit 976b54b

Please sign in to comment.