From d93042e52229bd3f700617d223125f98c2f235f5 Mon Sep 17 00:00:00 2001 From: Julian Squires Date: Tue, 28 Oct 2008 19:29:30 -0400 Subject: [PATCH 01/11] Initial commit. Basic IL bindings and a couple of ILUT ones. --- cl-devil.asd | 15 ++++++ il.lisp | 155 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ilut.lisp | 52 +++++++++++++++++++ package.lisp | 54 ++++++++++++++++++++ utilities.lisp | 29 +++++++++++ 5 files changed, 305 insertions(+) create mode 100644 cl-devil.asd create mode 100644 il.lisp create mode 100644 ilut.lisp create mode 100644 package.lisp create mode 100644 utilities.lisp diff --git a/cl-devil.asd b/cl-devil.asd new file mode 100644 index 0000000..35fb32f --- /dev/null +++ b/cl-devil.asd @@ -0,0 +1,15 @@ +;;;; -*- Lisp -*- +;;;; cl-devil -- DevIL binding for CL. See README for licensing information. + +(defpackage #:cl-devil-system (:use #:cl #:asdf)) +(in-package #:cl-devil-system) + +(defsystem cl-devil + :depends-on (:cffi) + :components + ((:file "package") + (:file "il" :depends-on ("package")) + #+(or)(:file "ilu" :depends-on ("package" "il")) + #+(or)(:file "ilut" :depends-on ("package" "ilu")) + (:file "utilities" :depends-on ("package" "il")))) + diff --git a/il.lisp b/il.lisp new file mode 100644 index 0000000..c93f76c --- /dev/null +++ b/il.lisp @@ -0,0 +1,155 @@ +;;;; cl-devil -- DevIL binding for CL. See README for licensing information. + +(in-package :il) + +(define-foreign-library il + (:unix (:or "libIL" "libIL.so.1")) + (t (:default "libIL"))) +(use-foreign-library il) + +(defctype handle :pointer) +(defcenum image-type + (:unknown #x0000) + (:bmp #x0420) + (:cut #x0421) + (:doom #x0422) + (:doom-flat #x0423) + (:ico #x0424) + (:jpg #x0425) + (:jfif #x0425) + (:lbm #x0426) + (:pcd #x0427) + (:pcx #x0428) + (:pic #x0429) + (:png #x042A) + (:pnm #x042B) + (:sgi #x042C) + (:tga #x042D) + (:tif #x042E) + (:chead #x042F) + (:raw #x0430) + (:mdl #x0431) + (:wal #x0432) + (:lif #x0434) + (:mng #x0435) + (:jng #x0435) + (:gif #x0436) + (:dds #x0437) + (:dcx #x0438) + (:psd #x0439) + (:exif #x043A) + (:psp #x043B) + (:pix #x043C) + (:pxr #x043D) + (:xpm #x043E) + (:hdr #x043F) + (:jasc-pal #x0475)) + +(defcenum data-format + (:colour-index #x1900) + (:color-index #x1900) + (:rgb #x1907) + (:rgba #x1908) + (:bgr #x80E0) + (:bgra #x80E1) + (:luminance #x1909) + (:luminance-alpha #x190A)) + +(defcenum data-type + (:byte #x1400) + (:unsigned-byte #x1401) + (:short #x1402) + (:unsigned-short #x1403) + (:int #x1404) + (:unsigned-int #x1405) + (:float #x1406) + (:double #x140A)) + +(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)) + +(defcenum mode ; there are some awfully + (:version-num #x0DE2) ; non-descript names in + (:image-width #x0DE4) ; DevIL... + (:image-height #x0DE5) + (:image-depth #x0DE6) + (:image-size-of-data #x0DE7) + (:image-bpp #x0DE8) + (:image-bytes-per-pixel #x0DE8) + (:image-bits-per-pixel #x0DE9) + (:image-format #x0DEA) + (:image-type #x0DEB) + (:palette-type #x0DEC) + (:palette-size #x0DED) + (:palette-bpp #x0DEE) + (:palette-num-cols #x0DEF) + (:palette-base-type #x0DF0) + (:num-images #x0DF1) + (:num-mipmaps #x0DF2) + (:num-layers #x0DF3) + (:active-image #x0DF4) + (:active-mipmap #x0DF5) + (:active-layer #x0DF6) + (:cur-image #x0DF7) + (:image-duration #x0DF8) + (:image-planesize #x0DF9) + (:image-bpc #x0DFA) + (:image-offx #x0DFB) + (:image-offy #x0DFC) + (:image-cubeflags #x0DFD) + (:image-origin #x0DFE) + (:image-channels #x0DFF)) + + +(defcfun ("ilInit" init) :void) +(defcfun ("ilShutDown" shutdown) :void) +(defcfun ("ilGenImages" gen-images) :void (num :int) (images :pointer)) +(defcfun ("ilBindImage" bind-image) :void (image :int)) +(defcfun ("ilDeleteImages" delete-images) :void (num :int) (images :pointer)) +(defcfun ("ilLoadImage" load-image) :boolean (file-name :string)) +(defcfun ("ilLoad" load) :boolean (type image-type) (file-name :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 :string)) +(defcfun ("ilSave" save) :boolean (type image-type) (file-name :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 + (width :uint) (height :uint) (depth :uint) (bpp :uint8) (format data-format) (type data-type) (data :pointer)) +(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 ("ilGetError" get-error) error) + +(defcfun ("ilGetInteger" get-integer) :uint (mode mode)) \ No newline at end of file diff --git a/ilut.lisp b/ilut.lisp new file mode 100644 index 0000000..0a28a02 --- /dev/null +++ b/ilut.lisp @@ -0,0 +1,52 @@ +;;;; cl-devil -- DevIL binding for CL. See README for licensing information. + +(in-package :ilut) + +(define-foreign-library ilut + (:unix (:or "libILUT" "libILUT.so.1")) + (t (:default "libILUT"))) +(use-foreign-library ilut) + +(defcenum state-definition + (:palette-mode #x0600) + (:opengl-conv #x0610) + (:d3d-miplevels #x0620) + (:maxtex-width #x0630) + (:maxtex-height #x0631) + (:maxtex-depth #x0632) + (:gl-use-s3tc #x0634) + (:d3d-use-dxtc #x0634) + (:gl-gen-s3tc #x0635) + (:d3d-gen-dxtc #x0635) + (:s3tc-format #x0705) + (:dxtc-format #x0705) + (:d3d-pool #x0706) + (:d3d-alpha-key-color #x0707) + (:d3d-alpha-key-colour #x0707)) + +(defcenum renderer + (:opengl 0) + (:allegro 1) + (:win32 2) + (:direct3d8 3) + (:direct3d9 4)) + +(defcfun ("ilutRenderer" renderer) :boolean (renderer renderer)) +(defcfun ("ilutEnable" enable) :boolean (state state-definition)) +(defcfun ("ilutDisable" disable) :boolean (state state-definition)) +(defcfun ("ilutGetBoolean" get-boolean) :boolean (state state-definition)) +;;; OpenGL +(defcfun ("ilutGLBindTexImage" gl-bind-tex-image) :uint) +(defcfun ("ilutGLBindMipmaps" gl-bind-mipmaps) :uint) +(defcfun ("ilutGLBuildMipmaps" gl-build-mipmaps) :boolean) +(defcfun ("ilutGLLoadImage" gl-load-image) :uint (file-name :string)) +(defcfun ("ilutGLScreen" gl-screen) :boolean) +(defcfun ("ilutGLScreenie" gl-screenie) :boolean) +(defcfun ("ilutGLSaveImage" gl-save-image) :boolean (file-name :string) (tex-id :uint)) +(defcfun ("ilutGLSetTex" gl-set-tex) :boolean (tex-id :uint)) +(defcfun ("ilutGLTexImage" gl-tex-image) :boolean (level :uint)) +(defcfun ("ilutGLSubTex" gl-sub-tex) :boolean (tex-id :uint) (x-offset :uint) (y-offset :uint)) +;;; SDL +(defcfun ("ilutConvertToSDLSurface" convert-to-sdl-surface) :pointer (flags :uint)) +(defcfun ("ilutSDLSurfaceLoadImage" sdl-surface-load-image) :pointer (file-name :string)) +(defcfun ("ilutSDLSurfaceFromBitmap" sdl-surface-from-bitmap) :boolean (surface :pointer)) diff --git a/package.lisp b/package.lisp new file mode 100644 index 0000000..81d663b --- /dev/null +++ b/package.lisp @@ -0,0 +1,54 @@ + +(defpackage #:cl-devil + (:nicknames #:il) + (:use #:cl #:cffi :anaphora) + (:shadow #:load #:error) + (:export + #:with-images + ;; bindings + #:BIND-IMAGE + #:BLIT + #:COPY-IMAGE + #:COPY-PIXELS + #:DELETE-IMAGES + #:GEN-IMAGES + #:GET-DATA + #:GET-ERROR + #:GET-INTEGER + #:INIT + #:LOAD + #:LOAD-F + #:LOAD-IMAGE + #:LOAD-L + #:OVERLAY-IMAGE + #:SAVE + #:SAVE-F + #:SAVE-IMAGE + #:SAVE-L + #:SET-DATA + #:SET-PIXELS + #:SHUTDOWN + #:TEX-IMAGE + )) + +(defpackage #:ilut + (:use #:cl #:cffi) + (:export + #:CONVERT-TO-SDL-SURFACE + #:DISABLE + #:ENABLE + #:GET-BOOLEAN + #:GL-BIND-MIPMAPS + #:GL-BIND-TEX-IMAGE + #:GL-BUILD-MIPMAPS + #:GL-LOAD-IMAGE + #:GL-SAVE-IMAGE + #:GL-SCREEN + #:GL-SCREENIE + #:GL-SET-TEX + #:GL-SUB-TEX + #:GL-TEX-IMAGE + #:RENDERER + #:SDL-SURFACE-FROM-BITMAP + #:SDL-SURFACE-LOAD-IMAGE + )) diff --git a/utilities.lisp b/utilities.lisp new file mode 100644 index 0000000..c89890e --- /dev/null +++ b/utilities.lisp @@ -0,0 +1,29 @@ + +(in-package :cl-devil) + +(defun w-i-args-helper (args) + (when args + `((bind-image it) + ,(cons + (cond ((= 1 (length args)) 'il:load-image) + ((= 3 (length args)) 'il:load-l) + ((stringp (second args)) 'il:load) + (t 'il:load-f)) + args)))) + +(defmacro with-images ((&rest images) &body body) + "Generates an IL image for each of IMAGES, binding and loading if a parameter is supplied. BODY is executed, and the images are freed thereafter." + (let ((ids (gensym)) + (count (length images))) + `(cffi:with-foreign-object (,ids :uint ,count) + (il:gen-images ,count ,ids) + (unwind-protect + (let (,@(loop for x in images + for (var . args) = (if (listp x) x (list x)) + for i from 0 + collect `(,var (anaphora:aprog1 (cffi:mem-ref ,ids :uint ,i) + ,@(w-i-args-helper args))))) + ,@body) + (il:delete-images ,count ,ids))))) + +(il:with-images (urp arp (exit "/home/julian/exit.pcx")) (format t "~&~A ~A ~A" urp arp exit)) \ No newline at end of file -- 2.11.4.GIT From 1829fe9b78343d41fd7c3618e43ea17721b1cd0d Mon Sep 17 00:00:00 2001 From: Julian Squires Date: Tue, 28 Oct 2008 20:00:30 -0400 Subject: [PATCH 02/11] Added more utilities: WITH-INIT, WIDTH-OF, HEIGHT-OF, and WITH-BOUND-IMAGE. --- package.lisp | 4 ++++ utilities.lisp | 25 ++++++++++++++++++++++++- 2 files changed, 28 insertions(+), 1 deletion(-) diff --git a/package.lisp b/package.lisp index 81d663b..10e3d46 100644 --- a/package.lisp +++ b/package.lisp @@ -4,7 +4,11 @@ (:use #:cl #:cffi :anaphora) (:shadow #:load #:error) (:export + #:with-bound-image #:with-images + #:with-init + #:width-of + #:height-of ;; bindings #:BIND-IMAGE #:BLIT diff --git a/utilities.lisp b/utilities.lisp index c89890e..093eff5 100644 --- a/utilities.lisp +++ b/utilities.lisp @@ -11,6 +11,9 @@ (t 'il:load-f)) args)))) +;;; XXX I don't like the potential confusion between WITH-BOUND-IMAGE +;;; and WITH-IMAGES, but WITH-NEW-IMAGES and WITH-LOADED-IMAGES all +;;; give the wrong impression, alas. (defmacro with-images ((&rest images) &body body) "Generates an IL image for each of IMAGES, binding and loading if a parameter is supplied. BODY is executed, and the images are freed thereafter." (let ((ids (gensym)) @@ -26,4 +29,24 @@ ,@body) (il:delete-images ,count ,ids))))) -(il:with-images (urp arp (exit "/home/julian/exit.pcx")) (format t "~&~A ~A ~A" urp arp exit)) \ No newline at end of file +(defmacro with-init (&body body) + `(progn (init) + (unwind-protect (progn ,@body) + (shutdown)))) + +(defun width-of (id) + (bind-image id) + (get-integer :image-width)) + +(defun height-of (id) + (bind-image id) + (get-integer :image-height)) + + +(defmacro with-bound-image ((id) &body body) + "Binds ID for the duration of BODY, returning to the previously bound image thereafter." + (let ((old-image (gensym))) + `(let ((,old-image (il:get-integer :cur-image))) + (il:bind-image ,id) + (unwind-protect (progn ,@body) + (il:bind-image ,old-image))))) \ No newline at end of file -- 2.11.4.GIT From 52de2eaac64a41e42108f256adf08f8acc6a24f3 Mon Sep 17 00:00:00 2001 From: Julian Squires Date: Wed, 29 Oct 2008 12:23:00 -0400 Subject: [PATCH 03/11] Forgot to update ASDF system for ILUT. --- cl-devil.asd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cl-devil.asd b/cl-devil.asd index 35fb32f..277d810 100644 --- a/cl-devil.asd +++ b/cl-devil.asd @@ -10,6 +10,6 @@ ((:file "package") (:file "il" :depends-on ("package")) #+(or)(:file "ilu" :depends-on ("package" "il")) - #+(or)(:file "ilut" :depends-on ("package" "ilu")) + (:file "ilut" :depends-on ("package" "il")) (:file "utilities" :depends-on ("package" "il")))) -- 2.11.4.GIT From 5898e1d4dca6bf9ded6611c5b1968adea1667129 Mon Sep 17 00:00:00 2001 From: Julian Squires Date: Sun, 2 Nov 2008 22:44:18 -0500 Subject: [PATCH 04/11] Improved GEN-IMAGES interface; fixed load problems. --- cl-devil.asd | 2 +- il.lisp | 2 +- utilities.lisp | 9 +++++++-- 3 files changed, 9 insertions(+), 4 deletions(-) diff --git a/cl-devil.asd b/cl-devil.asd index 277d810..11f6460 100644 --- a/cl-devil.asd +++ b/cl-devil.asd @@ -5,7 +5,7 @@ (in-package #:cl-devil-system) (defsystem cl-devil - :depends-on (:cffi) + :depends-on (:cffi :anaphora) :components ((:file "package") (:file "il" :depends-on ("package")) diff --git a/il.lisp b/il.lisp index c93f76c..0884051 100644 --- a/il.lisp +++ b/il.lisp @@ -128,7 +128,7 @@ (defcfun ("ilInit" init) :void) (defcfun ("ilShutDown" shutdown) :void) -(defcfun ("ilGenImages" gen-images) :void (num :int) (images :pointer)) +(defcfun ("ilGenImages" %gen-images) :void (num :int) (images :pointer)) (defcfun ("ilBindImage" bind-image) :void (image :int)) (defcfun ("ilDeleteImages" delete-images) :void (num :int) (images :pointer)) (defcfun ("ilLoadImage" load-image) :boolean (file-name :string)) diff --git a/utilities.lisp b/utilities.lisp index 093eff5..d0b5a9e 100644 --- a/utilities.lisp +++ b/utilities.lisp @@ -24,7 +24,7 @@ (let (,@(loop for x in images for (var . args) = (if (listp x) x (list x)) for i from 0 - collect `(,var (anaphora:aprog1 (cffi:mem-ref ,ids :uint ,i) + collect `(,var (anaphora:aprog1 (cffi:mem-aref ,ids :uint ,i) ,@(w-i-args-helper args))))) ,@body) (il:delete-images ,count ,ids))))) @@ -43,7 +43,12 @@ (get-integer :image-height)) -(defmacro with-bound-image ((id) &body body) +(defun gen-images (n) + (with-foreign-object (ids :uint n) + (%gen-images n ids) + (loop for i to n collect (mem-aref ids :uint i)))) + +(defmacro with-bound-image (id &body body) "Binds ID for the duration of BODY, returning to the previously bound image thereafter." (let ((old-image (gensym))) `(let ((,old-image (il:get-integer :cur-image))) -- 2.11.4.GIT From afb30d3222b6b975a1f96c0664678bbbc779bc86 Mon Sep 17 00:00:00 2001 From: Julian Squires Date: Mon, 3 Nov 2008 15:41:15 -0500 Subject: [PATCH 05/11] Added automatic translation of pathnames via namestring. --- .gitignore | 3 +++ il.lisp | 16 ++++++++++++---- 2 files changed, 15 insertions(+), 4 deletions(-) create mode 100644 .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..c0ca3e9 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +*.fasl +*~ +*.pfsl diff --git a/il.lisp b/il.lisp index 0884051..5be79ea 100644 --- a/il.lisp +++ b/il.lisp @@ -125,18 +125,26 @@ (:image-origin #x0DFE) (:image-channels #x0DFF)) +(define-foreign-type pathname-string-type () + () + (:actual-type :string) + (:simple-parser pathname-string)) +(eval-when (:compile-toplevel :load-toplevel) + (defmethod expand-to-foreign-dyn (value var body (type pathname-string-type)) + `(with-foreign-string (,var (if (pathnamep ,value) (namestring ,value) ,value)) + ,@body))) (defcfun ("ilInit" init) :void) (defcfun ("ilShutDown" shutdown) :void) (defcfun ("ilGenImages" %gen-images) :void (num :int) (images :pointer)) (defcfun ("ilBindImage" bind-image) :void (image :int)) (defcfun ("ilDeleteImages" delete-images) :void (num :int) (images :pointer)) -(defcfun ("ilLoadImage" load-image) :boolean (file-name :string)) -(defcfun ("ilLoad" load) :boolean (type image-type) (file-name :string)) +(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 :string)) -(defcfun ("ilSave" save) :boolean (type image-type) (file-name :string)) +(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 -- 2.11.4.GIT From 7a5fc2088b0d4c96a0bea573e2c7a16f7c9551d7 Mon Sep 17 00:00:00 2001 From: Julian Squires Date: Tue, 11 Nov 2008 11:26:38 -0500 Subject: [PATCH 06/11] Trivial fix of WITH-IMAGES. --- utilities.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utilities.lisp b/utilities.lisp index d0b5a9e..6da42f0 100644 --- a/utilities.lisp +++ b/utilities.lisp @@ -19,7 +19,7 @@ (let ((ids (gensym)) (count (length images))) `(cffi:with-foreign-object (,ids :uint ,count) - (il:gen-images ,count ,ids) + (%gen-images ,count ,ids) (unwind-protect (let (,@(loop for x in images for (var . args) = (if (listp x) x (list x)) -- 2.11.4.GIT From b6fc738e9cf9a85253af27c8d2fc69427f079537 Mon Sep 17 00:00:00 2001 From: Julian Squires Date: Thu, 13 Nov 2008 12:14:43 -0500 Subject: [PATCH 07/11] ILUT:INIT is pretty important. --- ilut.lisp | 1 + package.lisp | 1 + 2 files changed, 2 insertions(+) diff --git a/ilut.lisp b/ilut.lisp index 0a28a02..336dd2b 100644 --- a/ilut.lisp +++ b/ilut.lisp @@ -35,6 +35,7 @@ (defcfun ("ilutEnable" enable) :boolean (state state-definition)) (defcfun ("ilutDisable" disable) :boolean (state state-definition)) (defcfun ("ilutGetBoolean" get-boolean) :boolean (state state-definition)) +(defcfun ("ilutInit" init) :boolean) ;;; OpenGL (defcfun ("ilutGLBindTexImage" gl-bind-tex-image) :uint) (defcfun ("ilutGLBindMipmaps" gl-bind-mipmaps) :uint) diff --git a/package.lisp b/package.lisp index 10e3d46..0c461de 100644 --- a/package.lisp +++ b/package.lisp @@ -52,6 +52,7 @@ #:GL-SET-TEX #:GL-SUB-TEX #:GL-TEX-IMAGE + #:INIT #:RENDERER #:SDL-SURFACE-FROM-BITMAP #:SDL-SURFACE-LOAD-IMAGE -- 2.11.4.GIT From d21c023333221b5a3090d8d7b4cd0b251073dacf Mon Sep 17 00:00:00 2001 From: Julian Squires Date: Mon, 13 Apr 2009 15:39:45 -0400 Subject: [PATCH 08/11] Gensym tweak. --- utilities.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utilities.lisp b/utilities.lisp index 6da42f0..5a1917f 100644 --- a/utilities.lisp +++ b/utilities.lisp @@ -16,7 +16,7 @@ ;;; give the wrong impression, alas. (defmacro with-images ((&rest images) &body body) "Generates an IL image for each of IMAGES, binding and loading if a parameter is supplied. BODY is executed, and the images are freed thereafter." - (let ((ids (gensym)) + (let ((ids (gensym "IDS")) (count (length images))) `(cffi:with-foreign-object (,ids :uint ,count) (%gen-images ,count ,ids) -- 2.11.4.GIT From 0c4dbd8972ac82133ae6bb7b660f45a39e4c2768 Mon Sep 17 00:00:00 2001 From: Julian Squires Date: Mon, 13 Apr 2009 15:51:20 -0400 Subject: [PATCH 09/11] Temporarily remove ILUT. --- cl-devil.asd | 2 +- il.lisp | 16 ++++++++++++++-- package.lisp | 8 ++++++++ 3 files changed, 23 insertions(+), 3 deletions(-) diff --git a/cl-devil.asd b/cl-devil.asd index 11f6460..f3e1a3e 100644 --- a/cl-devil.asd +++ b/cl-devil.asd @@ -10,6 +10,6 @@ ((:file "package") (:file "il" :depends-on ("package")) #+(or)(:file "ilu" :depends-on ("package" "il")) - (:file "ilut" :depends-on ("package" "il")) + ;;(:file "ilut" :depends-on ("package" "il")) (:file "utilities" :depends-on ("package" "il")))) diff --git a/il.lisp b/il.lisp index 5be79ea..61d200a 100644 --- a/il.lisp +++ b/il.lisp @@ -123,7 +123,9 @@ (:image-offy #x0DFC) (:image-cubeflags #x0DFD) (:image-origin #x0DFE) - (:image-channels #x0DFF)) + (:image-channels #x0DFF) + (:use-key-color #x0635) + (:png-alpha-index #x0724)) (define-foreign-type pathname-string-type () () @@ -160,4 +162,14 @@ (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 ("ilGetError" get-error) error) -(defcfun ("ilGetInteger" get-integer) :uint (mode mode)) \ No newline at end of file +(defcfun ("ilKeyColour" key-color) :void (red :float) (green :float) (blue :float) (alpha :float)) +(defcfun ("ilGetPalette" get-palette) :pointer) + +(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 ("ilIsEnabled" enabled-p) :boolean (mode mode)) + +(defcfun ("ilConvertImage" convert-image) :boolean (format data-format) (type data-type)) +(defcfun ("ilFlipImage" flip-image) :boolean) diff --git a/package.lisp b/package.lisp index 0c461de..a77f8c4 100644 --- a/package.lisp +++ b/package.lisp @@ -12,14 +12,21 @@ ;; bindings #:BIND-IMAGE #:BLIT + #:CONVERT-IMAGE #:COPY-IMAGE #:COPY-PIXELS #:DELETE-IMAGES + #:DISABLE + #:ENABLE + #:FLIP-IMAGE #:GEN-IMAGES #:GET-DATA #:GET-ERROR #:GET-INTEGER + #:GET-PALETTE #:INIT + #:IS-ENABLED + #:KEY-COLOR #:LOAD #:LOAD-F #:LOAD-IMAGE @@ -30,6 +37,7 @@ #:SAVE-IMAGE #:SAVE-L #:SET-DATA + #:SET-INTEGER #:SET-PIXELS #:SHUTDOWN #:TEX-IMAGE -- 2.11.4.GIT From eda6f192738a92f6ee3ee7876b2a0b841afa3185 Mon Sep 17 00:00:00 2001 From: Julian Squires Date: Wed, 13 May 2009 17:42:51 -0400 Subject: [PATCH 10/11] Added DETERMINE-TYPE; exported ENABLED-P. --- cl-devil.asd | 2 +- il.lisp | 17 +++++++++++------ package.lisp | 2 ++ 3 files changed, 14 insertions(+), 7 deletions(-) diff --git a/cl-devil.asd b/cl-devil.asd index f3e1a3e..11f6460 100644 --- a/cl-devil.asd +++ b/cl-devil.asd @@ -10,6 +10,6 @@ ((:file "package") (:file "il" :depends-on ("package")) #+(or)(:file "ilu" :depends-on ("package" "il")) - ;;(:file "ilut" :depends-on ("package" "il")) + (:file "ilut" :depends-on ("package" "il")) (:file "utilities" :depends-on ("package" "il")))) diff --git a/il.lisp b/il.lisp index 61d200a..c31d3f7 100644 --- a/il.lisp +++ b/il.lisp @@ -93,9 +93,14 @@ (:lib-mng-error #x05E5) (:unknown-error #x05FF)) -(defcenum mode ; there are some awfully - (:version-num #x0DE2) ; non-descript names in - (:image-width #x0DE4) ; DevIL... +(defcenum mode + (:file-overwrite #x0620) + (:file-mode #x0621) + (:conv-pal #x0630) + (:use-key-color #x0635) + (:png-alpha-index #x0724) + (:version-num #x0DE2) + (:image-width #x0DE4) (:image-height #x0DE5) (:image-depth #x0DE6) (:image-size-of-data #x0DE7) @@ -123,9 +128,7 @@ (:image-offy #x0DFC) (:image-cubeflags #x0DFD) (:image-origin #x0DFE) - (:image-channels #x0DFF) - (:use-key-color #x0635) - (:png-alpha-index #x0724)) + (:image-channels #x0DFF)) (define-foreign-type pathname-string-type () () @@ -173,3 +176,5 @@ (defcfun ("ilConvertImage" convert-image) :boolean (format data-format) (type data-type)) (defcfun ("ilFlipImage" flip-image) :boolean) + +(defcfun ("ilDetermineType" determine-type) image-type (pathname pathname-string)) \ No newline at end of file diff --git a/package.lisp b/package.lisp index a77f8c4..af0c509 100644 --- a/package.lisp +++ b/package.lisp @@ -16,8 +16,10 @@ #:COPY-IMAGE #:COPY-PIXELS #:DELETE-IMAGES + #:DETERMINE-TYPE #:DISABLE #:ENABLE + #:ENABLED-P #:FLIP-IMAGE #:GEN-IMAGES #:GET-DATA -- 2.11.4.GIT From f4749c96ca3771e0d1717493098c6af47e304967 Mon Sep 17 00:00:00 2001 From: Julian Squires Date: Sat, 19 Dec 2009 18:16:12 -0500 Subject: [PATCH 11/11] Added some palette-related functions and a couple of simple accessor utilities. --- il.lisp | 13 ++++++++++++- package.lisp | 5 +++++ utilities.lisp | 20 ++++++++++++++++++++ 3 files changed, 37 insertions(+), 1 deletion(-) diff --git a/il.lisp b/il.lisp index c31d3f7..7c24f54 100644 --- a/il.lisp +++ b/il.lisp @@ -65,6 +65,15 @@ (:float #x1406) (:double #x140A)) +(defcenum palette-type + (:none #x0400) + (:rgb24 #x0401) + (:rgb32 #x0402) + (:rgba32 #x0403) + (:bgr24 #x0404) + (:bgr32 #x0405) + (:bgra32 #x0406)) + (defcenum error (:no-error #x0000) (:invalid-enum #x0501) @@ -167,6 +176,7 @@ (defcfun ("ilKeyColour" key-color) :void (red :float) (green :float) (blue :float) (alpha :float)) (defcfun ("ilGetPalette" get-palette) :pointer) +(defcfun ("ilRegisterPal" register-palette) :void (palette :pointer) (size :uint) (type palette-type)) (defcfun ("ilGetInteger" get-integer) :uint (mode mode)) (defcfun ("ilSetInteger" set-integer) :void (mode mode) (param :int)) @@ -177,4 +187,5 @@ (defcfun ("ilConvertImage" convert-image) :boolean (format data-format) (type data-type)) (defcfun ("ilFlipImage" flip-image) :boolean) -(defcfun ("ilDetermineType" determine-type) image-type (pathname pathname-string)) \ No newline at end of file +(defcfun ("ilDetermineType" determine-type) image-type (pathname pathname-string)) + diff --git a/package.lisp b/package.lisp index af0c509..a2cb81b 100644 --- a/package.lisp +++ b/package.lisp @@ -9,6 +9,10 @@ #:with-init #:width-of #:height-of + #:pixel-format-of + #:element-type-of + #:bytes-per-pixel-of + #:copy-palette ;; bindings #:BIND-IMAGE #:BLIT @@ -26,6 +30,7 @@ #:GET-ERROR #:GET-INTEGER #:GET-PALETTE + #:REGISTER-PALETTE #:INIT #:IS-ENABLED #:KEY-COLOR diff --git a/utilities.lisp b/utilities.lisp index 5a1917f..c14303f 100644 --- a/utilities.lisp +++ b/utilities.lisp @@ -42,6 +42,26 @@ (bind-image id) (get-integer :image-height)) +(defun pixel-format-of (id) + (bind-image id) + (foreign-enum-keyword 'data-format (get-integer :image-format))) + +(defun element-type-of (id) + (bind-image id) + (foreign-enum-keyword 'data-type (get-integer :image-type))) + +(defun bytes-per-pixel-of (id) + (bind-image id) + (get-integer :image-bytes-per-pixel)) + +(defun copy-palette (dest src) + (bind-image src) + (let ((type (get-integer :palette-type)) + (ncols (get-integer :palette-num-cols)) + (bpp (get-integer :palette-bpp)) + (pointer (get-palette))) + (bind-image dest) + (register-palette pointer (* ncols bpp) type))) (defun gen-images (n) (with-foreign-object (ids :uint n) -- 2.11.4.GIT