Skip to content

Commit

Permalink
Signal DevIL errors as conditions.
Browse files Browse the repository at this point in the history
  • Loading branch information
@Ralith @zkat
Ralith authored and zkat committed Jul 1, 2010
1 parent 612cd71 commit ba08a91
Showing 1 changed file with 83 additions and 45 deletions.
128 changes: 83 additions & 45 deletions il.lisp
View file
Expand Up @@ -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)
Expand Down Expand Up @@ -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))
Expand All @@ -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))
Expand All @@ -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 ba08a91

Please sign in to comment.