From d93042e52229bd3f700617d223125f98c2f235f5 Mon Sep 17 00:00:00 2001
From: Julian Squires <julian@cipht.net>
Date: Tue, 28 Oct 2008 19:29:30 -0400
Subject: [PATCH] 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