Commits

Paul Sexton committed 5392687

Extensive changes for increased bug-catching and type safety. Also now keeps use of 'foreign objects' to a minimum.
Now depends on defstar library.
Compatible with latest SVN version of libtcod (pre 1.5.1).

  • Participants
  • Parent commits 25f3b52
  • Tags 1.5.0

Comments (0)

Files changed (2)

     :author "moriarty4@gmail.com"
     :components
     ((:file "tcod") (:file "tcod-colours"))
-    :depends-on ("cffi"))
+    :depends-on ("cffi" "defstar"))
 
 
 (defpackage :tcod
-  (:use :cl :cffi)
+  (:use :cl :cffi :defstar)
   (:export
    #:*root*
    #:+null+
-   ;; (@> "Colour") ===========================================================
+   ;; [[Colours]] ==========================================================
    #:start-colours
    #:start-colors
    #:colour
    #:make-colour
    #:color-set-hsv
    #:color-get-hsv
+   #:color-get-hue
+   #:color-get-saturation
+   #:color-get-value
    #:color-equals?
    #:color-add
    #:color-multiply
    #:color-multiply-scalar
    #:color-lerp
    #:make-color
-   ;; (@> "Console") ==========================================================
+   ;; [[Console]] ==========================================================
    #:console-wait-for-keypress
    #:console-check-for-keypress
    #:console-set-colour-control
    #:console-print-centre-rect
    #:console-print-frame
    #:console-print-double-frame
+   #:console-map-ascii-code-to-font
+   #:console-map-ascii-codes-to-font
+   #:console-map-string-to-font
+   #:console-height-left-rect
+   #:console-height-right-rect
+   #:console-height-centre-rect
+   #:console-height-center-rect
    #:legal-console-coordinates?
    #:console-put-char
    #:console-put-char-ex
    #:console-set-fullscreen
    #:console-is-window-closed?
    #:console-credits
+   #:console-credits-reset
    #:console-credits-render
    #:console-set-custom-font
    #:console-set-window-title
    #:console-rect
-   #:keycode
    #:drawing-character
    #:colctrl
    #:colctrl->char
    #:background-flag
+   #:console
+   #:console-new
+   #:console-delete
+   #:console-get-width
+   #:console-get-height
+   #:console-blit
+   ;; [[Keyboard input]] ======================================================
    #:key
+   #:keycode
    #:key-p
    #:key-c
    #:key-vk
    #:same-keys?
    #:key-state
    #:key-pressed
-   #:console
    #:is-key-pressed?
-   #:console-new
-   #:console-delete
-   #:console-get-width
-   #:console-get-height
-   #:console-blit
+   #:console-set-keyboard-repeat
+   #:console-disable-keyboard-repeat
    ;; == Unicode ==
    ;; todo not yet implemented
-   ;; (@> "Mouse") ============================================================
+   ;; [[Mouse]] ===============================================================
    #:mouse
    #:make-mouse
    #:mouse-x
    #:mouse-lbutton-pressed
    #:mouse-mbutton-pressed
    #:mouse-rbutton-pressed
-   #:mouse-wheel-down
-   #:mouse-wheel-up
-   #:mouse-flags
    #:mouse-move
    #:mouse-get-status
-   ;; (@> "Image") ============================================================
+   #:mouse-get-x
+   #:mouse-get-y
+   #:mouse-get-cx
+   #:mouse-get-cy
+   #:mouse-get-dx
+   #:mouse-get-dy
+   #:mouse-get-dcx
+   #:mouse-get-dcy
+   #:mouse-get-lbutton
+   #:mouse-get-mbutton
+   #:mouse-get-rbutton
+   #:mouse-get-lbutton-pressed
+   #:mouse-get-mbutton-pressed
+   #:mouse-get-rbutton-pressed
+   ;; [[Image]] ===============================================================
    #:image-load
    #:image-save
    #:image-from-console
    #:image-blit
    #:image-set-key-color
    #:image-set-key-colour
-   ;; (@> "Random") ===========================================================
+   ;; [[Random]] ==============================================================
    #:random-new
    #:random-get-instance
    #:random-delete
    #:random-get-int
    #:random-get-float
-   ;; (@> "Noise") ============================================================
+   ;; [[Noise]] ===============================================================
    #:noise-new
    #:noise-perlin
    #:noise-simplex
    #:noise-fbm-perlin
    #:noise-turbulence-perlin
    #:noise-delete
-   ;; (@> "Heightmap") ========================================================
+   ;; [[Heightmap]] ===========================================================
    #:heightmap
    #:heightmap-new
    #:heightmap-get-value
    #:heightmap-dig-bezier
    #:heightmap-dig-line
    #:heightmap-rain-erosion
-   ;; == System layer ==
+   ;; [[Field of view]] =======================================================
+   #:fov-algorithm
+   #:mapptr
+   #:map-new
+   #:map-set-properties
+   #:map-compute-fov
+   #:map-is-in-fov?
+   #:map-is-transparent?
+   #:map-is-walkable?
+   #:map-clear
+   #:map-delete
+   #:map-copy
+   ;; [[A* pathfinding]] ======================================================
+   #:a*-path
+   #:dijkstra-path
+   #:path-new-using-map
+   #:path-new-using-function
+   #:path-delete
+   #:path-compute
+   #:path-get-origin
+   #:path-get-destination
+   #:path-size
+   #:path-get
+   #:path-walk
+   #:path-is-empty?
+   ;; [[Dijkstra pathfinding]] ================================================
+   #:dijkstra-path
+   #:dijkstra-new
+   #:dijkstra-new-using-function
+   #:dijkstra-delete
+   #:dijkstra-compute
+   #:dijkstra-path-set
+   #:dijkstra-size
+   #:dijkstra-get-distance
+   #:dijkstra-get
+   #:dijkstra-is-empty?
+   #:dijkstra-path-walk
+   ;; [[system layer]] ========================================================
    #:sys-save-screenshot
    #:sys-sleep-milli
    #:sys-set-fps
    #:sys-get-fps
    #:sys-get-current-resolution
    #:sys-flush
-   ))
+   ;; [[Testing]] =============================================================
+   )
+  (:documentation
+   "* Introduction
+
+Welcome to CL-TCOD, an interface between Common Lisp and the Doryen Library,
+AKA `libtcod', a portable truecolour console library intended for use with
+roguelike games.
+
+CL-TCOD consists of the following files:
+1. =tcod.lisp=, a lisp file which creates lisp bindings for C functions in the
+   compiled libtcod library, using the =CFFI= lisp foreign function interface.
+2. =tcod.asd=, which allows TCOD to be easily loaded and used as a library by
+   other common lisp programs, via the =ASDF= library-loading facility.
+3. =tcod-colours.lisp=, a lisp file containing definitions for all the colours
+   named in /etc/X11/rgb.txt; autogenerated using 'parse-rgb' (see below)
+4. =parse-rgb.lisp=, a lisp file containing code for parsing =/etc/X11/rgb.txt=
+   and generating tcod-colours.lisp
+5. =parse-rgb.asd=, ASDF system definition file for =parse-rgb.lisp=
+
+CL-TCOD has been tested with SBCL 1.0.32 on Linux, and Clozure 1.4 on Linux
+and Windows XP.
+
+**Note** that it has not been used on a Mac; if you do this you may need to
+tell CFFI what the name of the compiled libtcod library under MacOS is. To do
+this, open tcod.lisp in an editor, find the ='(define-foreign-library...'=
+clause, uncomment the ='(:macintosh...)'= line and change the string on that line
+to the name of the libtcod library file.
+
+* License
+                                               
+The CL-TCOD package is placed in the Public Domain by its author.
+
+* Hints on installation
+
+You need to know your way around your chosen common lisp and how to install and
+load lisp libraries before proceeding. You also need to have a version of
+libtcod newer than 1.4.1rc2, which is the first version that includes the
+'wrappers.c' and 'wrappers.h' source files that allow CL-TCOD to interface with
+libtcod.
+
+1. Ensure you have a working common lisp installation. 
+2. Ensure the ASDF lisp library is installed.
+3. If CFFI is not installed (see above), download and install it somewhere ASDF
+   can find it. CFFI requires several third-party lisp libraries -- see the CFFI
+   documentation for more details.
+4. Put the CL-TCOD files in a directory where ASDF can find them.
+5. Make sure libtcod is installed and compiled. Make sure the libtcod
+   dynamically linked library (=.DLL= or =.SO= file) is somewhere your lisp system
+   can find it. It probably is, but if CFFI complains about being unable to
+   find the library, you can either copy it to an appropriate directory or add
+   its directory to the list variable =cffi:*foreign-library-directories*=
+   e.g. by typing the following in the lisp interpreter:
+
+;;;   (push #P\"/my/libtcod/directory/\" cffi:*foreign-library-directories*)
+
+   *On windows*, DLL files should be put in one of the directories listed in the
+   =PATH= environment variable. You will need to put =SDL.dll= in the same place
+   if you don't already have SDL installed.
+
+   *On Linux*, you can usually put .SO files in =/usr/local/lib/=.
+   Use your package installer to install =libSDL=.
+   Try running the libtcod demo programs to check everything works.
+   
+6. Start lisp. Load ASDF, then CL-TCOD:
+
+;;;   (load \"/path/to/asdf/asdf.lisp\")
+;;;   (asdf:oos 'asdf:load-op :tcod)
+
+7. Type something like the following commands at the lisp prompt to start using TCOD
+   from within Lisp. Alternatively you can type =(tcod:hello-world)=, which
+   is a function containing the code below.
+
+;;;   (tcod:console-set-custom-font \"terminal.png\" '(:font-layout-ascii-in-row) 16 16)
+;;;   (tcod:console-init-root 80 25 \"Test\" nil)
+;;;   (tcod:console-clear tcod:*root*)
+;;;   (tcod:console-print-left tcod:*root* 1 1 :set \"Hello, world!~%\")
+;;;   (tcod:console-wait-for-keypress t)
+
+                                              
+* Differences between CL-TCOD and libtcod
+
+** Naming conventions
+
+The C function =TCOD_foobar= corresponds to the lisp function =foobar=, which is in
+the =tcod= package (and so requires a prefix of =tcod:= to access in most
+situations). Underscores become hyphens. So:
+
+:  TCOD_foobar_function(a, b)     <===>    (tcod:foobar-function a b)
+
+`Predicate functions' are functions whose main job is to return a boolean
+value, true (non =NIL=) or false (=NIL=), that answers a question. These have a
+terminal '?' added to their name:
+
+:  TCOD_console_is_fullscreen()   <===>    (tcod:console-is-fullscreen?)
+
+C enums have generally more succinct names. As they are lisp keywords, their
+names all begin with =':'=. THey are named according to the following pattern:
+
+:  TCODK_BACKSPACE (etc)         <===>  :backspace
+:  TCOD_CHAR_HLINE  (etc)        <===>  :char-hline
+:  TCOD_COLCTRL_1  (etc)         <===>  :colctrl-1
+:  TCOD_BKGND_SET (etc)          <===>  :set
+:  TCOD_FONT_LAYOUT_ASCII_INCOL  <===>  :font-layout-ascii-in-col 
+:  FOV_SHADOW                    <===>  :fov-shadow
+:  TCOD_KEY_PRESSED              <===>  :key-pressed
+:  CENTER                        <===>  :center
+
+In general, all functions exist in both U.S. and non-U.S. spellings, This is
+mainly relevant to those functions with colour/color in their name.
+
+** Colournums
+
+In libtcod, colours are represented as structures containing three integer
+values: *red*, *green* and *blue* (each 0-255). The name of the structure type is
+=TCOD_color_t=.
+
+In CL-TCOD, these colour structs are converted into 3-byte integers using the C
+functions =int_to_color(int)= and =color_to_int(TCOD_color_t)=, both defined in
+=wrappers.c=. The 3 bytes are red, green and blue in order (blue is 1's). ie:
+
+:    /* C */                              ;; lisp ;;
+:   struct TCOD_color_t {r, g, b}  <==>   #x00RRGGBB
+
+So, for example, one way to use the function =TCOD_color_multiply_scalar= from
+lisp is:
+
+;;;  (tcod:color-multiply-scalar (tcod:compose-colour 218 165 32) 0.5)
+
+All C functions that take or return =TCOD_color_t= structs, are wrapped by lisp
+functions that take or return integers as described above.
+
+** Colours by keyword
+
+A lisp keyword is any symbol beginning with ':'. In lisp, keywords (like all
+symbols) are first-class values and can be passed around just like any other
+value. CL-TCOD uses keywords to refer to particular colours, for example the
+keyword =:cyan= refers to the colour #x0056A3CD (or 5678029 in decimal notation).
+
+You can use keywords instead of colournums as arguments to lisp functions, by
+using the function =colour= to return the colournum associated with a keyword:
+
+;;;  (tcod:colour :cyan)    ; returns 5678029
+
+
+You can also define your own colour names, like so:
+
+;;;  (tcod:make-colour :my-goldenrod 218 165 32)
+;;;  (tcod:color-multiply-scalar (tcod:colour :my-goldenrod) 0.5)
+
+CL-TCOD knows all the colour names defined in the 'rgb.txt' file under
+Xwindows, eg =:navajo-white, :honeydew, :mint-cream=, and so on. There is
+nothing special about the fact that rgb.txt comes from Xwindows -- the colours
+are just named R,G,B values and can be used anywhere that CL-TCOD can be
+used. Look in the source file ='tcod-colours.lisp'= to see the available colour
+names. If you are using [[http://www.gnu.org/software/emacs/][GNU Emacs]], the
+king of lisp IDEs, do =M-x list-colors-display= to see a list of all colours.
+
+** Lisp =format= versus C =printf=
+   
+The TCOD functions that accept =printf=-like string-formatting arguments,
+have been modified to instead accept arguments to Common Lisp's =format=
+function.'  For example:
+
+#+BEGIN_SRC c
+  TCOD_console_print_left (con, x, y, TCOD_BKGND_SET,
+      \"Printing at %d, %d\n\", x, y);
+#+END_SRC
+
+becomes:
+
+;;;    (tcod:console-print-left con x y :set \"Printing at ~D, ~D~%\" x y)
+
+** Miscellaneous extra functions
+
+- [[console-print-double-frame]] is like [[console-print-frame]], but
+  but draws using `double-line' characters:
+
+;;;  (tcod:console-print-double-frame CONSOLE X Y W H EMPTY? STRING...)
+  
+
+* Resources
+
+** Specific to CL-TCOD and libtcod
+
+The latest version of CL-TCOD is available at:
+
+    [[http://bitbucket.org/eeeickythump/cl-tcod/]]
+
+Forum for discussion of CL-TCOD and use of lisp in roguelike games:
+
+    [[http://doryen.eptalys.net/forum/index.php?board=33.0][Roguecentral Lisp forum]]
+
+The latest version of libtcod is available at:
+
+    [[http://doryen.eptalys.net/libtcod/]]
+
+This Common Lisp package depends on CFFI, the Common Foreign Function Interface:
+
+    [[http://common-lisp.net/project/cffi/]]
+
+** Learning Common Lisp
+
+Recently written book, 'Practical Common Lisp'. buy hard copy or download free.
+Recommended, especially if coming from non-lisp languages.
+
+- [[http://www.gigamonkeys.com/book/]]
+
+*\"Lisp in a Box\"* -- aims to make it easy to start using Common Lisp by
+providing a single download with everything set up in advance:
+
+- [[http://common-lisp.net/project/lispbox/]]
+
+Lisp editors and IDEs:
+- [[http://www.gnu.org/software/emacs/][GNU Emacs]] (the best; see below)
+  - [[http://common-lisp.net/project/slime/][SLIME]] is the Emacs interface to
+    Common Lisp.
+- [[http://bitfauna.com/projects/cusp/][Cusp]], a common lisp plugin for Eclipse. 
+- The [[http://www.franz.com/products/allegrocl/][Allegro]] and
+  [[http://www.lispworks.com/][LispWorks]] lisp implementations each have a
+  builtin IDE.
+- If you are on a Mac, the free, high-quality [[http://ccl.clozure.com][Clozure CL]]
+  has a builtin IDE called Cocoa.
+- Some editors with good lisp syntax highlighting include jEdit and Notepad++
+
+** A note on editors and IDEs
+
+Emacs is a very powerful program. It is mainly used as a programmers' text and
+source code editor, but it can do -- and plugins exist to make it do -- just
+about anything you can imagine. It is mostly written in a dialect of lisp, and
+this is also its extension language. When combined with SLIME, a plugin (mode)
+that allows it to communicate directly with a running common lisp
+compiler/interpreter, Emacs is not only the best IDE for common lisp, but
+one of the best and most advanced IDEs for any programming language, period.
+
+The downside is that because Emacs + SLIME is so good, common lisp programmers
+have put very little effort into getting other popular programming editors/IDEs
+to support common lisp, at least beyond simple syntax highlighting. Emacs is an
+idiosyncratic program (it is about 34 years old) and despite good efforts to
+modernise/regularise its interface it still has a steeper learning curve than
+many other IDEs, especially when you are also struggling to set up SLIME and
+get it to communicate with your lisp...
+
+My advice is that while all roads lead to Emacs, you don't have to hurry to get
+there. Initially you should concentrate on getting common lisp set up and
+starting to learn the language. Think about using the trial version of one of
+the big commercial implementations (Allegro or LispWorks), as they have
+built-in IDEs. Once you are ready to move on from them, install Emacs and
+SLIME.
+
+** Commercial Common Lisp implementations
+
+These are both high quality but painfully expensive. Luckily they have
+'limited' versions that can be downloaded for free, and which I recommend you
+use when beginning to learn common lisp.
+
+- [[http://www.franz.com/products/allegrocl/][Allegro]] -- starts at $599 USD
+- [[http://www.lispworks.com/][LispWorks]] -- starts at $900 USD for a
+  noncommercial license. The trial version quits automatically after 5 hours.
+
+** Full-featured, free Common Lisp implementations
+
+Move on to one of these if and when you outgrow Allegro or LispWorks.
+
+- [[http://www.sbcl.org]] (compiles to machine code, great on Linux/Mac,
+  still 'experimental' on Windows)
+- [[http://clisp.cons.org][GNU CLISP]] (bytecode compiler, but runs pretty much
+  everywhere)
+- [[http://ccl.clozure.com][Clozure CL]] (compiles to machine code; native to
+  Mac but runs well on Linux and Windows; it has displaced SBCL to become my
+  implementation of choice)
+- [[http://ecls.sourceforge.net/][Embeddable Common Lisp]] Promising, compiles
+  to C and then passes code to your C compiler. Does this 'on the fly' when
+  running as an interpreter. Also designed to be easily embeddable as a
+  scripting language.
+
+Help & advice with lisp:
+
+    [[http://www.lispforum.com]]
+"))
 
 (in-package :tcod)
 
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+
 ;;; CFFI 0.10.0 started using Babel to "encode" strings. This breaks extended
 ;;; ASCII characters when the default encoding scheme of :UTF-8 is used, ie C
 ;;; will receive different characters from those which are sent to it by the
 
 (setf cffi:*default-foreign-encoding* :iso-8859-1)
 
+;;; Force compiler to enforce type declarations for function arguments.
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf defstar:*check-argument-types-explicitly?* t))
+
 ;;; uncomment this form if using pre 1.4.3b1 version of libtcod
 ;;;(eval-when (:compile-toplevel :load-toplevel :execute)
 ;;;  (pushnew :libtcod-old *features*))
 		(setf *libtcod-loaded* t)))
 
 
-;;;; (@> "Utilities") =========================================================
+;;;; <<Utilities>> ============================================================
+
 
 (defun get-bit (n pos)
   "POS = 1 refers to the 1's bit"
 (defconstant +NOISE-DEFAULT-LACUNARITY+ 2.0)
 
 
-
-;;;; (@> "Types") =============================================================
-
-
-(defctype colournum :unsigned-int)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun simple-type? (sym)
+    "* Arguments
+- SYM :: A symbol.
+* Return Value
+Boolean.
+* Description
+Returns =T= if =SYM= names a non-class type, such as can be
+defined by [[deftype]]."
+    (handler-case (typep t sym)
+      (error () (return-from simple-type? nil)))
+    t))
+
+
+(defmacro define-c-enum (name &rest vals)
+  "Defines both the CFFI 'enum' type, and a lisp type of the same
+name which is satisified by any of the values allowed by the enum type."
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
+     (progn
+       (defcenum ,name ,@vals)
+       (deftype ,name ()
+         '(member ,@(mapcar #'(lambda (val)
+                                (if (listp val) (car val) val))
+                            vals))))))
+
+
+(defmacro define-c-bitfield (name &rest clauses)
+  "Defines both the CFFI bitfield, and a lisp type of the same name, which
+is satisfied by a list containing only bitfield keywords as members."
+  (flet ((make-predicate (sym)
+           (intern (concatenate 'string (string sym) "-PREDICATE"))))
+    `(eval-when (:compile-toplevel :load-toplevel :execute)
+       (progn
+         (defbitfield ,name ,@clauses)
+         (defun ,(make-predicate name) (ls)
+           (and (listp ls)
+                (null (set-difference
+                       ls ',(mapcar #'car clauses)))))
+         (deftype ,name ()
+           '(satisfies ,(make-predicate name)))))))
+
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun prepend-percent (sym)
+    (intern (concatenate 'string "%%" (string sym)))))
+
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun c-type->lisp-type (c-type)
+    (case c-type
+      (:boolean 'boolean)
+      ((:int :unsigned-int)
+       `(unsigned-byte ,(* 8 (foreign-type-size :int))))
+      (:unsigned-char '(unsigned-byte 8))
+      (:uint8 '(unsigned-byte 8))
+      (:uint32 '(unsigned-byte 32))
+      (:float 'single-float)
+      (:pointer (type-of (null-pointer)))
+      (:string 'string)
+      (:void t)
+      (otherwise
+       (if (simple-type? c-type)
+           c-type
+           (error "In C-TYPE->LISP-TYPE: unknown c type `~S'." c-type))))))
+
+
+(defmacro define-c-function ((foreign-fn-name fn-name) return-type args
+                             &body body)
+  "Format is similar to CFFI:DEFCFUN, except that the arguments are wrapped in a
+set of parentheses. ach argument specifier
+may contain a third term, which may be a symbol (naming a predicate function)
+or a form. The predicate or form is evaluated before the foreign function is
+actually called. If the result is nil, an error is raised."
+  (let ((args-no-rest (remove '&rest args)))
+    `(progn
+       (defcfun (,foreign-fn-name ,(prepend-percent fn-name)) ,return-type
+         ,@args)
+       #-clozure (declaim (inline ,fn-name))
+       (defun* (,fn-name -> ,(c-type->lisp-type return-type))
+           ,(mapcar #'(lambda (clause)
+                        `(,(first clause) ,(c-type->lisp-type (second clause))
+                           ,@(cddr clause)))
+                    args-no-rest)
+         ,@(if (stringp (car body)) (list (pop body)) nil)
+         ,(if body
+              `(macrolet ((call-it (&rest callargs)
+                            (cons ',(prepend-percent fn-name)
+                                  (or callargs '(,@(mapcar #'car args-no-rest))))))
+                 ,@body)
+              `(,(prepend-percent fn-name) ,@(mapcar #'car args-no-rest)))))))
+
+;; (define-c-function ("TCOD_console_init_root" console-init-root) :void
+;;     ((width :int) (height :int) (title :string) (fullscreen? :boolean))
+;;   (check-type width ucoord)
+;;   (check-type height ucoord)
+;;   (setf (gethash *root* *console-width-table*) width)
+;;   (setf (gethash *root* *console-height-table*) height)
+;;   (call-it))
+
+
+(defmacro define-c-type (name foreign-type)
+  `(progn
+     (defctype ,name ,foreign-type)
+     (deftype ,name () ',(c-type->lisp-type foreign-type))))
+
+
+
+;;;; <<Types>> ================================================================
+
+
+(deftype ucoord () `(integer 0 1000))
+
+
+(define-c-type colournum :unsigned-int)
+
 
 (defcstruct colour  ; TCOD_color_t
 	(r :uint8)
 	(b :uint8))
 
 
+;; TCOD_renderer_t
+(define-c-enum renderer
+  :RENDERER-GLSL
+  :RENDERER-OPENGL
+  :RENDERER-SDL)
+
 
 ;; TCOD_keycode_t
-(defcenum keycode
+(define-c-enum keycode
 	:NONE
 	:ESCAPE
 	:BACKSPACE
        
 
 
-(defcenum drawing-character
+(define-c-enum drawing-character
 	(:CHAR-HLINE 196)
 	(:CHAR-VLINE 179)
 	(:CHAR-NE 191) 
 
 
 ;; TCOD_colctrl_t
-(defcenum colctrl
+(define-c-enum colctrl
 	(:COLCTRL-1 1)
 	:COLCTRL-2
 	:COLCTRL-3
 	:COLCTRL-STOP )
 
 ;; TCOD_bkgnd_flag_t
-(defcenum background-flag
+(define-c-enum background-flag
 	:NONE
 	:SET
 	:MULTIPLY
 	:ALPH)
 
 
-(defcenum alignment
+(define-c-enum alignment
 	:LEFT
 	:CENTER
 	:RIGHT)
 
 
-(defcenum fov-algorithm
-    :FOV-BASIC
-  :FOV-DIAMOND
-  :FOV-SHADOW
-  :FOV-PERMISSIVE-0
-  :FOV-PERMISSIVE-1
-  :FOV-PERMISSIVE-2
-  :FOV-PERMISSIVE-3
-  :FOV-PERMISSIVE-4
-  :FOV-PERMISSIVE-5
-  :FOV-PERMISSIVE-6
-  :FOV-PERMISSIVE-7
-  :FOV-PERMISSIVE-8
-  :FOV-RESTRICTIVE
-  :NB-FOV-ALGORITHMS)
-
-
-(defbitfield key-state
+(define-c-bitfield key-state
 	(:KEY-PRESSED 1)
 	(:KEY-RELEASED 2))
 
-(defbitfield custom-font-flags
+(define-c-bitfield custom-font-flags
 	(:FONT-LAYOUT-ASCII-IN-COL 1)
 	(:FONT-LAYOUT-ASCII-IN-ROW 2)
 	(:FONT-TYPE-GREYSCALE 4)
 	(:FONT-LAYOUT-TCOD 8))
 
 
-(defcenum rng-algorithm
+
+(define-c-enum rng-algorithm
 	:RNG-MT
 	:RNG-CMWC)
 
 
+(define-c-enum fov-algorithm
+    :FOV-BASIC
+    :FOV-DIAMOND
+    :FOV-SHADOW
+    :FOV-PERMISSIVE-0
+    :FOV-PERMISSIVE-1
+    :FOV-PERMISSIVE-2
+    :FOV-PERMISSIVE-3
+    :FOV-PERMISSIVE-4
+    :FOV-PERMISSIVE-5
+    :FOV-PERMISSIVE-6
+    :FOV-PERMISSIVE-7
+    :FOV-PERMISSIVE-8
+    :FOV-RESTRICTIVE)
+
+
 ;; TCOD_console_t
-(defctype console :pointer)
-
-
-
-;;;; (@> "Colour") ============================================================
+(define-c-type console :pointer)
+
+
+;; TCOD_random_t
+(define-c-type randomptr :pointer)
+
+
+;;; mouse.h
+
+(defcstruct mouse-state
+	(x :int)	
+	(y :int)	
+	(dx :int)	
+	(dy :int)
+	(cx :int)	
+	(cy :int)
+	(dcx :int)	
+	(dcy :int)
+        (lbutton :boolean)
+        (rbutton :boolean)
+        (mbutton :boolean)
+        (lbutton-pressed :boolean)
+        (rbutton-pressed :boolean)
+        (mbutton-pressed :boolean))
+
+(defstruct mouse
+	(x 0 :type integer)	;; absolute position
+	(y 0 :type integer)	
+	(dx 0 :type integer)	;; movement since last update in pixels
+	(dy 0 :type integer)
+	(cx 0 :type integer)	;; cell coordinates in the root console 
+	(cy 0 :type integer)
+	(dcx 0 :type integer)	;; movement since last update in console cells
+	(dcy 0 :type integer)
+	(lbutton nil :type boolean)	;; left button status
+	(rbutton nil :type boolean)	;; right button status
+	(mbutton nil :type boolean) ;; middle button status
+	(lbutton-pressed nil :type boolean)	;; left button pressed event
+	(rbutton-pressed nil :type boolean)	;; right button pressed event
+	(mbutton-pressed nil :type boolean))	;; middle button pressed event
+
+
+;; TCOD_image_t
+(define-c-type image :pointer)
+
+(define-c-type noise :pointer)
+
+(define-c-type heightmap :pointer)
+
+(define-c-type mapptr :pointer)
+
+(define-c-type a*-path :pointer)
+
+(define-c-type dijkstra-path :pointer)
+
+
+;;;; <<Colours>> ==============================================================
 
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
 (defun colctrl->char (ctrl)
   (code-char (foreign-enum-value 'colctrl ctrl)))
 
-      
+
+
 ;; TCODLIB_API bool TCOD_color_equals (TCOD_color_t c1, TCOD_color_t c2); 
-(defcfun ("TCOD_color_equals_wrapper" color-equals?) :boolean
-	(c1 colournum) (c2 colournum))
-(defun colour-equals? (c1 c2) (color-equals? c1 c2))
+(define-c-function ("TCOD_color_equals_wrapper" color-equals?) :boolean
+	((c1 colournum) (c2 colournum)))
+(defun colour-equals? (c1 c2)
+  (color-equals? c1 c2))
 
 
 ;;TCODLIB_API TCOD_color_t TCOD_color_add (TCOD_color_t c1, TCOD_color_t c2);
-(defcfun ("TCOD_color_add_wrapper" color-add) colournum
-	(c1 colournum) (c2 colournum))
-(defun colour-add (c1 c2) (color-add c1 c2))
+(define-c-function ("TCOD_color_add_wrapper" color-add) colournum
+	((c1 colournum) (c2 colournum)))
 
 
 ;;TCODLIB_API TCOD_color_t TCOD_color_multiply (TCOD_color_t c1,
 ;; TCOD_color_t c2); 
-(defcfun ("TCOD_color_multiply_wrapper" color-multiply) colournum
-	(c1 colournum) (c2 colournum))
-(defun colour-multiply (c1 c2) (color-multiply c1 c2))
+(define-c-function ("TCOD_color_multiply_wrapper" color-multiply) colournum
+	((c1 colournum) (c2 colournum)))
+(defun colour-multiply (c1 c2)
+  (color-multiply c1 c2))
 
 
 ;;TCODLIB_API TCOD_color_t TCOD_color_multiply_scalar (TCOD_color_t c1,
 ;; float value);
-(defcfun ("TCOD_color_multiply_scalar_wrapper" color-multiply-scalar) colournum
-	(c1 colournum) (value :float))
-(defun colour-multiply-scalar (c1 value) (color-multiply-scalar c1 value))
+(define-c-function ("TCOD_color_multiply_scalar_wrapper" color-multiply-scalar) colournum
+	((c1 colournum) (value :float)))
+(defun colour-multiply-scalar (c1 value)
+  (color-multiply-scalar c1 value))
 
 
 ;; TCODLIB_API TCOD_color_t TCOD_color_lerp(TCOD_color_t c1, TCOD_color_t c2,
 ;; float coef);
-(defcfun ("TCOD_color_lerp_wrapper" color-lerp) colournum
-	(c1 colournum) (c2 colournum) (coef :float))
-(defun colour-lerp (c1 c2 coef) (color-lerp c1 c2 coef))
+(define-c-function ("TCOD_color_lerp_wrapper" color-lerp) colournum
+	((c1 colournum) (c2 colournum) (coef :float)))
+(defun colour-lerp (c1 c2 coef)
+  (color-lerp c1 c2 coef))
 
 
 ;; TCODLIB_API void TCOD_color_set_HSV(TCOD_color_t *c,float h, float s,
 ;; float v);
-(defcfun ("TCOD_color_set_HSV" color-set-hsv) :void
-	(c :pointer) (h :float) (s :float) (v :float))
-(defun colour-set-hsv (c h s v) (color-set-hsv c h s v))
+(define-c-function ("TCOD_color_set_HSV" color-set-hsv) :void
+	((con :pointer) (hue :float) (sat :float) (v :float)))
+(defun colour-set-hsv (con hue sat v)
+  (color-set-hsv con hue sat v))
 
 
 ;; TCODLIB_API void TCOD_color_get_HSV(TCOD_color_t c,float * h, float * s,
 ;; float * v);
 
-(defvar *internal-color-hue-ptr* (foreign-alloc :int))
-(defvar *internal-color-saturation-ptr* (foreign-alloc :int))
-(defvar *internal-color-value-ptr* (foreign-alloc :int))
-
-(defcfun ("TCOD_color_get_HSV_wrapper" %color-get-hsv) :void
-	(c colournum) (h :pointer) (s :pointer) (v :pointer))
-
-(defun color-get-hsv (color)
-    (%color-get-hsv color
-		    *internal-color-hue-ptr*
-		    *internal-color-saturation-ptr*
-		    *internal-color-value-ptr*)
-    (list (mem-ref *internal-color-hue-ptr* :int)
-	  (mem-ref *internal-color-saturation-ptr* :int)
-	  (mem-ref *internal-color-value-ptr* :int)))
-
-(defun colour-get-hsv (colour) (color-get-hsv colour))
-
-
-;;;; (@> "Console") ===========================================================
-
-
-(defcfun ("TCOD_console_credits" console-credits) :void)
-
-(defcfun ("TCOD_console_credits_render" console-credits-render) :boolean
-  (x :int) (y :int) (alpha :boolean))
+;; (defvar *internal-color-hue-ptr* (foreign-alloc :int))
+;; (defvar *internal-color-saturation-ptr* (foreign-alloc :int))
+;; (defvar *internal-color-value-ptr* (foreign-alloc :int))
+
+;; (defcfun ("TCOD_color_get_HSV_wrapper" %color-get-hsv) :void
+;;     (c colournum) (h :pointer) (s :pointer) (v :pointer))
+
+;; (defun* (color-get-hsv -> list) ((color colournum))
+;;   (with-foreign-object (hue :int)
+;;     (with-foreign-object (sat :int)
+;;       (with-foreign-object (val :int)
+;;         (%color-get-hsv color hue sat val)
+;;         (list (mem-ref hue :int)
+;;               (mem-ref sat :int)
+;;               (mem-ref val :int))))))
+
+
+(define-c-function ("TCOD_color_get_hue" color-get-hue) :int
+    ((c colournum)))
+
+(define-c-function ("TCOD_color_get_saturation" color-get-saturation) :int
+    ((c colournum)))
+
+(define-c-function ("TCOD_color_get_value" color-get-value) :int
+    ((c colournum)))
+
+
+(defun* (color-get-hsv -> list) ((c colournum))
+  (list (color-get-hue c)
+        (color-get-saturation c)
+        (color-get-value c)))
+
+(declaim (inline colour-get-hsv colour-get-hue colour-get-saturation
+                 colour-get-value))
+
+(defun colour-get-hsv (colour)
+  (color-get-hsv colour))
+
+(defun colour-get-hue (colour)
+  (color-get-hue colour))
+
+(defun colour-get-saturation (colour)
+  (color-get-hue colour))
+
+(defun colour-get-value (colour)
+  (color-get-hue colour))
+
+
+
+;;;; <<Console>> ==============================================================
+
+
+(defvar *console-width-table* (make-hash-table))
+(defvar *console-height-table* (make-hash-table))
+
+
+;; (defun* (legal-console-coordinates? -> boolean) ((con console) (x fixnum) (y fixnum))
+;;   (and (< x (console-get-width con))
+;;        (< y (console-get-height con))))
+
+(defmacro legal-console-coordinates? (con x y)
+  `(and (< ,x (console-get-width ,con))
+        (< ,y (console-get-height ,con))))
+
+
+(define-c-function ("TCOD_console_credits" console-credits) :void
+    ())
+
+(define-c-function ("TCOD_console_credits_reset" console-credits-reset) :void
+    ())
+
+(define-c-function ("TCOD_console_credits_render" console-credits-render) :boolean
+  ((x :int) (y :int) (alpha :boolean)))
 
 
 ;;TCODLIB_API void TCOD_console_init_root(int w, int h, const char * title,
 ;;                                        bool fullscreen);
-(defcfun ("TCOD_console_init_root" console-init-root) :void
-	(w :int) (h :int) (title :string) (fullscreen :boolean))
-
+(define-c-function ("TCOD_console_init_root" console-init-root) :void
+    ((width :int) (height :int) (title :string) (fullscreen? :boolean)
+     (renderer renderer))
+  (check-type width ucoord)
+  (check-type height ucoord)
+  (setf (gethash *root* *console-width-table*) width)
+  (setf (gethash *root* *console-height-table*) height)
+  (call-it))
+
+;; (define-c-function ("TCOD_console_init_root" console-init-root) :void
+;;     ((width :int) (height :int) (title :string) (fullscreen? :boolean))
+;;   (check-type width ucoord)
+;;   (check-type height ucoord)
+;;   (setf (gethash *root* *console-width-table*) width)
+;;   (setf (gethash *root* *console-height-table*) height)
+;;   (call-it))
+
+
+;; (defun* console-init-root ((w fixnum) (h fixnum) (title string)
+;;                            (fullscreen? boolean))
+;;   (setf (gethash *root* *console-width-table*) w)
+;;   (setf (gethash *root* *console-height-table*) h)
+;;   (%console-init-root w h title fullscreen?))
+
+                           
 ;;TCODLIB_API void TCOD_console_set_custom_font(const char *fontFile,
 ;;                        int char_width, int char_height, int nb_char_horiz,
 ;;                        int nb_char_vertic, bool chars_by_row,
 ;;                        TCOD_color_t key_color);
-(defcfun ("TCOD_console_set_custom_font" %console-set-custom-font) :void
-	(fontfile :string) (flags custom-font-flags)
-	(chars-horizontal :int) (chars-vertical :int)
-	)
-;; (nb-char-vertic :int)
-;; 	(chars-by-row? :boolean) (key-colour colournum))
-
-
-(defun console-set-custom-font (fontfile flags chars-horizontal chars-vertical)
-  "FLAGS accepts a quoted list containing one or more of the symbols
-:FONT-LAYOUT-ASCII-IN-ROW, :FONT-LAYOUT-ASCII-IN-COL, :FONT-TYPE-GREYSCALE,
-or :FONT-LAYOUT-TCOD."
+(define-c-function ("TCOD_console_set_custom_font" console-set-custom-font) :void
+	((fontfile :string) (flags custom-font-flags)
+	(chars-horizontal :int) (chars-vertical :int))
   (assert (probe-file fontfile))
-  (%console-set-custom-font fontfile flags chars-horizontal chars-vertical))
+  (check-type chars-horizontal (unsigned-byte 16))
+  (check-type chars-vertical (unsigned-byte 16))
+  (call-it))
+
+
+;; TCODLIB_API void TCOD_console_map_ascii_code_to_font(int asciiCode,
+;;      int fontCharX, int fontCharY);
+(define-c-function ("TCOD_console_map_ascii_code_to_font"
+                    console-map-ascii-code-to-font) :void
+    ((asciicode :int) (fontchar-x :int) (fontchar-y :int)))
+
+;; TCODLIB_API void TCOD_console_map_ascii_codes_to_font(int asciiCode,
+;;      int nbCodes, int fontCharX, int fontCharY);
+(define-c-function ("TCOD_console_map_ascii_codes_to_font"
+                    console-map-ascii-codes-to-font) :void
+    ((asciicode :int) (num-codes :int) (fontchar-x :int) (fontchar-y :int)))
+
+;; TCODLIB_API void TCOD_console_map_string_to_font(const char *s,
+;;      int fontCharX, int fontCharY);
+(define-c-function ("TCOD_console_map_string_to_font"
+                    console-map-string-to-font) :void
+    ((str :string) (fontchar-x :int) (fontchar-y :int)))
+
+;; (defun* console-set-custom-font ((fontfile string) flags (chars-horizontal fixnum)
+;;                                  (chars-vertical fixnum))
+;;   "FLAGS accepts a quoted list containing one or more of the symbols
+;; :FONT-LAYOUT-ASCII-IN-ROW, :FONT-LAYOUT-ASCII-IN-COL, :FONT-TYPE-GREYSCALE,
+;; or :FONT-LAYOUT-TCOD."
+;;   (assert (probe-file fontfile))
+;;   (%console-set-custom-font fontfile flags chars-horizontal chars-vertical))
 
 
 ;;TCODLIB_API void TCOD_console_set_window_title(const char *title);
-(defcfun ("TCOD_console_set_window_title" console-set-window-title) :void
-  (title :string))
+(define-c-function ("TCOD_console_set_window_title" console-set-window-title) :void
+  ((title :string)))
 
 ;;TCODLIB_API void TCOD_console_set_fullscreen(bool fullscreen);
-(defcfun ("TCOD_console_set_fullscreen" console-set-fullscreen) :void
-  (full? :boolean))
+(define-c-function ("TCOD_console_set_fullscreen" console-set-fullscreen) :void
+  ((full? :boolean)))
 
 ;;TCODLIB_API bool TCOD_console_is_fullscreen();
-(defcfun ("TCOD_console_is_fullscreen" console-is-fullscreen?) :boolean)
+(define-c-function ("TCOD_console_is_fullscreen" console-is-fullscreen?) :boolean
+    ())
 
 ;;TCODLIB_API bool TCOD_console_is_window_closed();
-(defcfun ("TCOD_console_is_window_closed" console-is-window-closed?) :boolean)
+(define-c-function ("TCOD_console_is_window_closed" console-is-window-closed?) :boolean
+    ())
 
 
 ;;TCODLIB_API void TCOD_console_set_background_color(TCOD_console_t con,
 ;; TCOD_color_t col);
-(defcfun ("TCOD_console_set_background_color_wrapper"
+(define-c-function ("TCOD_console_set_background_color_wrapper"
 	  console-set-background-color) :void
-	(con console) (col colournum))
+	((con console) (col colournum)))
+(declaim (inline console-set-background-colour))
 (defun console-set-background-colour (con col)
   (console-set-background-color con col))
 
 
 ;;TCODLIB_API void TCOD_console_set_foreground_color(TCOD_console_t con,
 ;;                                                   TCOD_color_t col);
-(defcfun ("TCOD_console_set_foreground_color_wrapper"
+(define-c-function ("TCOD_console_set_foreground_color_wrapper"
 	  console-set-foreground-color) :void
-	(con console) (col colournum))
+	((con console) (col colournum)))
+(declaim (inline console-set-foreground-colour))
 (defun console-set-foreground-colour (con col)
   (console-set-foreground-color con col))
 
 
 ;;TCODLIB_API void TCOD_console_clear(TCOD_console_t con);
-(defcfun ("TCOD_console_clear" console-clear) :void
-	(con console))
+(define-c-function ("TCOD_console_clear" console-clear) :void
+	((con console)))
 
 
 ;; New in 1.5.0rc1
-(defcfun ("TCOD_console_set_dirty" console-set-dirty) :void
-  (dx :int) (dy :int) (dw :int) (dh :int))
+;;TCODLIB_API void TCOD_console_set_dirty(int dx, int dy, int dw, int dh);
+(define-c-function ("TCOD_console_set_dirty" console-set-dirty) :void
+  ((rootx :int) (rooty :int) (width :int) (height :int))
+  "Declares an area of the =*root*= console to be 'dirty'."
+  (assert (legal-console-coordinates? *root* rootx rooty))
+  (assert (legal-console-coordinates?
+           *root* (+ rootx (1- width)) (+ rooty (1- height))))
+  (call-it))
 
 
 ;;TCODLIB_API void TCOD_console_set_back(TCOD_console_t con,int x, int y,
 ;;                                       TCOD_color_t col,
 ;;                                       TCOD_bkgnd_flag_t flag);
-(defcfun ("TCOD_console_set_back_wrapper" %console-set-back) :void
-  (con console) (x :int) (y :int) (col colournum) (flag background-flag))
-
-
-(defun console-set-back (con x y col flag)
-  ;; Assertion in libtcod
+(define-c-function ("TCOD_console_set_back_wrapper" console-set-back) :void
+    ((con console) (x :int) (y :int) (col colournum) (flag background-flag))
   (assert (legal-console-coordinates? con x y))
-  (%console-set-back con x y col flag))
+  (call-it con x y col flag))
+
+;; (defun* console-set-back ((con console) (x ucoord) (y ucoord)
+;;                           (col colournum) (flag background-flag))
+;;   (assert (legal-console-coordinates? con x y))
+;;   (%console-set-back con x y col flag))
+
+
+;; (defun console-set-back (con x y col flag)
+;;   ;; Assertion in libtcod
+;;   (assert (legal-console-coordinates? con x y))
+;;   (%console-set-back con x y col flag))
 
 
 ;;TCODLIB_API void TCOD_console_set_fore(TCOD_console_t con,int x, int y,
 ;;                                       TCOD_color_t col);
-(defcfun ("TCOD_console_set_fore_wrapper" %console-set-fore) :void
-  (con console) (x :int) (y :int) (col colournum))
-
-
-(defun console-set-fore (con x y col)
-  ;; Assertion in libtcod
+(define-c-function ("TCOD_console_set_fore_wrapper" console-set-fore) :void
+    ((con console) (x :int) (y :int) (col colournum))
   (assert (legal-console-coordinates? con x y))
-  (%console-set-fore con x y col))
+  (call-it con x y col))
+
+;; (defun* console-set-fore ((con console) (x ucoord) (y ucoord)
+;;                           (col colournum) (flag background-flag))
+;;   (assert (legal-console-coordinates? con x y))
+;;   (%console-set-fore con x y col))
+
+
+;; (defun console-set-fore (con x y col)
+;;   ;; Assertion in libtcod
+;;   (assert (legal-console-coordinates? con x y))
+;;   (%console-set-fore con x y col))
 
 
 
 ;;TCODLIB_API void TCOD_console_set_char(TCOD_console_t con,int x, int y,
 ;; int c);
-(defcfun ("TCOD_console_set_char" %console-set-char) :void
-  (con console) (x :int) (y :int) (c :unsigned-char))
-
-
-(defun console-set-char (con x y ch)
-  ;; Assertion in libtcod
+(define-c-function ("TCOD_console_set_char" console-set-char) :void
+    ((con console) (x :int) (y :int) (ch :unsigned-char))
   (assert (legal-console-coordinates? con x y))
   (when (characterp ch)
     (setf ch (char-code ch)))
-  (%console-set-char con x y ch))
-
-
-(defun console-fill-char (con ch fx fy fw fh)
+  (call-it con x y ch))
+
+
+;; (defun* console-set-char ((con console) (x ucoord) (y ucoord)
+;;                           (ch (or character fixnum)))
+;;   ;; Assertion in libtcod
+;;   (assert (legal-console-coordinates? con x y))
+;;   (when (characterp ch)
+;;     (setf ch (char-code ch)))
+;;   (%console-set-char con x y ch))
+
+
+(defun* (console-fill-char -> null)  ((con console) (ch (or character fixnum))
+                                      (fx ucoord) (fy ucoord)
+                                      (fw ucoord) (fh ucoord))
   "Fill a rectangular area with the character CH."
+  (if (characterp ch)
+      (setf ch (char-code ch)))
   (loop for x from fx below (+ fx fw) do
        (loop for y from fy below (+ fy fh) do
             (when (legal-console-coordinates? con x y)
 
 ;;TCODLIB_API void TCOD_console_put_char(TCOD_console_t con,int x, int y,
 ;;                                       int c, TCOD_bkgnd_flag_t flag);
-(defcfun ("TCOD_console_put_char" console-put-char) :void
-	(con console) (x :int) (y :int) (c :unsigned-char)
-	(flag background-flag))
-
-;;TCODLIB_API void TCOD_console_put_char_ex(TCOD_console_t con,int x, int y,
-;;                                          int c, TCOD_bkgnd_flag_t flag);
-#-libtcod-old
-(defcfun ("TCOD_console_put_char_ex_wrapper" %console-put-char-ex) :void
-	(con console) (x :int) (y :int) (c :unsigned-char)
-	(fg colournum) (bg colournum))
-
-;; wrapper to TCOD_console_put_char_ex is currently only in SVN
-#+libtcod-old
-(defun %console-put-char-ex (con x y c fg bg)
-    (console-set-fore con x y fg)
-    (console-set-back con x y bg :set)
-    (console-set-char con x y c))
-
-
-(defun console-put-char-ex (con x y c fg bg)
-  (assert (and (not (null-pointer-p con))
-               (< x (console-get-width con))
-               (< y (console-get-height con))))
-  (%console-put-char-ex con x y c fg bg))
+(define-c-function ("TCOD_console_put_char" console-put-char) :void
+    ((con console) (x :int) (y :int) (ch :unsigned-char)
+     (flag background-flag))
+  (assert (legal-console-coordinates? con x y))
+  (call-it))
+
+
+(define-c-function ("TCOD_console_put_char_ex_wrapper" console-put-char-ex) :void
+    ((con console) (x :int) (y :int) (ch :unsigned-char) (fg colournum)
+     (bg colournum))
+  (assert (legal-console-coordinates? con x y))
+  (call-it))
+
+
+;; (defun* console-put-char-ex ((con console) (x fixnum) (y fixnum)
+;;                              (ch (or character fixnum))
+;;                              (fg colournum) (bg colournum))
+;;   (assert (and (not (null-pointer-p con))
+;;                (< x (console-get-width con))
+;;                (< y (console-get-height con))))
+;;   (%console-put-char-ex con x y ch fg bg))
 
 
 ;;TCODLIB_API void TCOD_console_print_left(TCOD_console_t con,int x, int y,
 ;;                                         TCOD_bkgnd_flag_t flag,
-;;                                         const char *fmt, ...); 
+;;                                         const char *fmt, ...);
+
+;; This has to have a separate lisp wrapper, as we need to be able
+;; to pass 'args' to lisp.
 (defcfun ("TCOD_console_print_left" %console-print-left) :void
-	(con console) (x :int) (y :int) (flag background-flag) (fmt :string)
-	&rest)
-
-(defun console-print-left (con x y flag fmt &rest args)
+  (con console) (x :int) (y :int) (flag background-flag) (fmt :string)
+  &rest)
+
+(defun* console-print-left ((con console) (x ucoord) (y ucoord)
+                            (flag background-flag) (fmt string)
+                            &rest args)
+  (assert (legal-console-coordinates? con x y))
   (%console-print-left con x y flag (apply #'format nil fmt args)))
 
-(defcfun ("TCOD_console_print_return_string"
-	  %console-print-return-string) :string
-	(con console) (x :int) (y :int) (rw :int) (rh :int)
-	(flag background-flag) (align alignment) (msg :string)
-	(can-split? :boolean) (count-only? :boolean))
-
-(defun console-print-return-string (con x y rw rh flag align msg can-split?
-				    count-only?)
-  (%console-print-return-string con x y rw rh flag align msg
-				can-split? count-only?))
+
+;; In wrapper.c
+(define-c-function ("TCOD_console_print_return_string"
+                    console-print-return-string) :string
+    ((con console) (x :int) (y :int) (rw :int) (rh :int)
+     (flag background-flag) (align alignment) (str :string)
+     (can-split? :boolean) (count-only? :boolean))
+  (assert (legal-console-coordinates? con x y))
+  (call-it))
+
+
+;; (defun* (console-print-return-string -> string)
+;;     ((con console) (x fixnum) (y fixnum)
+;;      (rw fixnum) (rh fixnum)
+;;      (flag background-flag)
+;;      (align alignment)
+;;      (msg string) (can-split? boolean)
+;;      (count-only? boolean))
+;;   (%console-print-return-string con x y rw rh flag align msg
+;; 				can-split? count-only?))
 
 ;;TCODLIB_API void TCOD_console_print_right(TCOD_console_t con,int x, int y,
 ;; TCOD_bkgnd_flag_t flag, const char *fmt, ...); 
 	(con console) (x :int) (y :int) (flag background-flag) (fmt :string)
 	&rest)
 
-(defun console-print-right (con x y flag fmt &rest args)
+(defun* console-print-right ((con console) (x ucoord) (y ucoord)
+                             (flag background-flag) (fmt string) &rest args)
+  (assert (legal-console-coordinates? con x y))
   (%console-print-right con x y flag (apply #'format nil fmt args)))
 
 ;;TCODLIB_API void TCOD_console_print_center(TCOD_console_t con,int x, int y,
 ;; TCOD_bkgnd_flag_t flag, const char *fmt, ...); 
-(defcfun ("TCOD_console_print_center" console-print-centre) :void
+(defcfun ("TCOD_console_print_center" %console-print-centre) :void
 	(con console) (x :int) (y :int) (flag background-flag) (fmt :string)
 	&rest)
 
+(defun* console-print-centre ((con console) (x ucoord) (y ucoord)
+                              (flag background-flag) (fmt string)
+                              &rest args)
+  (assert (legal-console-coordinates? con x y))
+  (%console-print-centre con x y flag (apply #'format nil fmt args)))
+
+(declaim (inline console-print-center))
+(defun console-print-center (con x y flag fmt &rest args)
+  (apply #'console-print-centre con x y flag fmt args))
+
+
 ;;TCODLIB_API int TCOD_console_print_left_rect(TCOD_console_t con,int x, int y,
 ;; int w, int h, TCOD_bkgnd_flag_t flag, const char *fmt, ...); 
-(defcfun ("TCOD_console_print_left_rect" console-print-left-rect) :int
+(defcfun ("TCOD_console_print_left_rect" %console-print-left-rect) :int
 	(con console) (x :int) (y :int) (w :int) (h :int)
 	(flag background-flag) (fmt :string)
 	&rest)
 
+(defun* console-print-left-rect ((con console) (x ucoord) (y ucoord)
+                                 (w ucoord) (h ucoord)
+                                 (flag background-flag) (fmt string) &rest args)
+  (assert (legal-console-coordinates? con x y))
+  (%console-print-left-rect con x y w h flag
+                            (apply #'format nil fmt args)))
+
 ;;TCODLIB_API int TCOD_console_print_right_rect(TCOD_console_t con,int x,
 ;; int y, int w, int h, TCOD_bkgnd_flag_t flag, const char *fmt, ...); 
-(defcfun ("TCOD_console_print_right_rect" console-print-right-rect) :int
+(defcfun ("TCOD_console_print_right_rect" %console-print-right-rect) :int
 	(con console) (x :int) (y :int) (w :int) (h :int)
 	(flag background-flag) (fmt :string)
 	&rest)
 
+(defun* console-print-right-rect ((con console) (x ucoord) (y ucoord)
+                                  (w ucoord) (h ucoord)
+                                  (flag background-flag) (fmt string) &rest args)
+  (assert (legal-console-coordinates? con x y))
+  (%console-print-right-rect con x y w h flag
+                             (apply #'format nil fmt args)))
+
 
 ;;TCODLIB_API int TCOD_console_print_center_rect(TCOD_console_t con,int x,
 ;; int y, int w, int h, TCOD_bkgnd_flag_t flag, const char *fmt, ...); 
-(defcfun ("TCOD_console_print_center_rect" console-print-centre-rect) :int
+(defcfun ("TCOD_console_print_center_rect" %console-print-centre-rect) :int
 	(con console) (x :int) (y :int) (w :int) (h :int)
 	(flag background-flag) (fmt :string)
 	&rest)
 
+(defun* console-print-centre-rect ((con console) (x ucoord) (y ucoord)
+                                   (w ucoord) (h ucoord)
+                                   (flag background-flag) (fmt string) &rest args)
+  (assert (legal-console-coordinates? con x y))
+  (%console-print-centre-rect con x y w h flag
+                              (apply #'format nil fmt args)))
+
+
 ;;TCODLIB_API void TCOD_console_rect(TCOD_console_t con,int x, int y, int w,
 ;; int h, bool clear, TCOD_bkgnd_flag_t flag);
-(defcfun ("TCOD_console_rect" console-rect) :void
-  (con console) (x :int) (y :int) (w :int) (h :int) (clear? :boolean)
-  (flag background-flag))
+(define-c-function ("TCOD_console_rect" console-rect) :void
+  ((con console) (x :int) (y :int) (width :int) (height :int) (clear? :boolean)
+   (flag background-flag))
+  (assert (legal-console-coordinates? con x y))
+  (check-type width ucoord)
+  (check-type height ucoord)
+  (call-it))
+
+
+;;TCODLIB_API int TCOD_console_height_left_rect(TCOD_console_t con,
+;;     int x, int y, int w, int h, const char *fmt, ...);
+
+(defcfun ("TCOD_console_height_left_rect" %console-height-left-rect) :int
+	(con console) (x :int) (y :int) (w :int) (h :int) (fmt :string)
+	&rest)
+
+(defun* console-height-left-rect ((con console) (x ucoord) (y ucoord)
+                                 (w ucoord) (h ucoord) (fmt string) &rest args)
+  (assert (legal-console-coordinates? con x y))
+  (%console-height-left-rect con x y w h (apply #'format nil fmt args)))
+
+;;TCODLIB_API int TCOD_console_height_right_rect(TCOD_console_t con,
+;;     int x, int y, int w, int h, const char *fmt, ...);
+
+(defcfun ("TCOD_console_height_right_rect" %console-height-right-rect) :int
+	(con console) (x :int) (y :int) (w :int) (h :int) (fmt :string)
+	&rest)
+
+(defun* console-height-right-rect ((con console) (x ucoord) (y ucoord)
+                                 (w ucoord) (h ucoord) (fmt string) &rest args)
+  (assert (legal-console-coordinates? con x y))
+  (%console-height-right-rect con x y w h (apply #'format nil fmt args)))
+
+;;TCODLIB_API int TCOD_console_height_center_rect(TCOD_console_t con,
+;;     int x, int y, int w, int h, const char *fmt, ...);
+
+(defcfun ("TCOD_console_height_center_rect" %console-height-centre-rect) :int
+	(con console) (x :int) (y :int) (w :int) (h :int) (fmt :string)
+	&rest)
+
+(defun* console-height-centre-rect ((con console) (x ucoord) (y ucoord)
+                                 (w ucoord) (h ucoord) (fmt string) &rest args)
+  (assert (legal-console-coordinates? con x y))
+  (%console-height-centre-rect con x y w h (apply #'format nil fmt args)))
+
+(declaim (inline console-height-center-rect))
+(defun console-height-center-rect (con x y w h fmt &rest args)
+  (apply #'console-height-centre-rect con x y w h fmt args))
+
 
 ;;TCODLIB_API void TCOD_console_hline(TCOD_console_t con,int x,int y, int l,
 ;; TCOD_bkgnd_flag_t flag);
+
+(define-c-function ("TCOD_console_hline" console-hline) :void
+    ((con console) (x :int) (y :int) (len :int) (flag background-flag))
+  (assert (legal-console-coordinates? con x y))
+  (call-it))
+
+
 ;;TCODLIB_API void TCOD_console_vline(TCOD_console_t con,int x,int y, int l,
 ;; TCOD_bkgnd_flag_t flag);
 
+(define-c-function ("TCOD_console_vline" console-vline) :void
+    ((con console) (x :int) (y :int) (len :int) (flag background-flag))
+  (assert (legal-console-coordinates? con x y))
+  (call-it))
+
+
 ;;TCODLIB_API void TCOD_console_print_frame(TCOD_console_t con,int x,int y,
 ;; int w,int h, bool empty, const char *fmt, ...);
 ;;#-libtcod-old
-(defcfun ("TCOD_console_print_frame" console-print-frame) :void
-  (con console) (x :int) (y :int) (w :int) (h :int)
+(defcfun ("TCOD_console_print_frame" %console-print-frame) :void
+  (con console) (x :int) (y :int) (width :int) (height :int)
   (empty? :boolean) (flag background-flag) 
   (fmt :string) &rest)
 
-;; #+libtcod-old
-;; (defcfun ("TCOD_console_print_frame" %console-print-frame) :void
-;;   (con console) (x :int) (y :int) (w :int) (h :int)
-;;   (empty? :boolean) (fmt :string) &rest)
-
+(defun* console-print-frame ((con console) (x ucoord) (y ucoord)
+                             (width ucoord) (height ucoord)
+                             (empty? boolean) (flag background-flag)
+                             (fmt string) &rest args)
+  (assert (legal-console-coordinates? con x y))
+  (check-type width ucoord)
+  (check-type height ucoord)
+  (%console-print-frame con x y width height empty? flag
+                        (apply #'format nil fmt args)))
   
-;; #+libtcod-old
-;; (defun console-print-frame (con x y w h empty? flag fmt &rest args)
-;;   (declare (ignore flag))
-;;   (%console-print-frame con x y w h empty? 
-;;     (if (stringp fmt) (apply #'format nil fmt args) +NULL+)))
-  
 
 ;; Added in wrappers.c
-#-libtcod-old
-(defcfun ("TCOD_console_print_double_frame" console-print-double-frame) :void
-  (con console) (x :int) (y :int) (w :int) (h :int)
+(defcfun ("TCOD_console_print_double_frame" %console-print-double-frame) :void
+  (con console) (x :int) (y :int) (width :int) (height :int)
   (empty? :boolean) (flag background-flag) 
   (fmt :string) &rest)
 
-#+libtcod-old
-(defcfun ("TCOD_console_print_double_frame" %console-print-double-frame) :void
-  (con console) (x :int) (y :int) (w :int) (h :int)
-  (empty? :boolean) (fmt :string) &rest)
+(defun* console-print-double-frame ((con console) (x ucoord) (y ucoord)
+                                    (width ucoord) (height ucoord)
+                                    (empty? boolean) (flag background-flag)
+                                    (fmt string) &rest args)
+  (assert (legal-console-coordinates? con x y))
+  (check-type width ucoord)
+  (check-type height ucoord)
+  (%console-print-double-frame con x y width height empty? flag
+                               (apply #'format nil fmt args)))
+
 
   
-#+libtcod-old
-(defun console-print-double-frame (con x y w h empty? flag fmt &rest args)
-  (declare (ignore flag))
-  (%console-print-double-frame con x y w h empty? 
-    (if (stringp fmt) (apply #'format nil fmt args) +NULL+)))
-
-  
-;;TCODLIB_API TCOD_color_t TCOD_console_get_background_color(TCOD_console_t con);
-(defcfun ("TCOD_console_get_background_color"
-	  console-get-background-color) colournum
-  (con console))
-(defun console-get-background-colour (con)
+;;TCODLIB_API TCOD_color_t TCOD_console_get_background_color(TCOD_console_t
+;;con);
+(define-c-function ("TCOD_console_get_background_color_wrapper"
+                    console-get-background-color) colournum
+  ((con console)))
+(declaim (inline console-get-background-colour))
+(defun* (console-get-background-colour -> colournum) ((con console))
   (console-get-background-color con))
 
 
 ;;TCODLIB_API TCOD_color_t TCOD_console_get_foreground_color(TCOD_console_t con);
-(defcfun ("TCOD_console_get_foreground_color"
-	  console-get-foreground-color) colournum
-  (con console))
-(defun console-get-foreground-colour (con)
+(define-c-function ("TCOD_console_get_foreground_color_wrapper"
+                    console-get-foreground-color) colournum
+  ((con console)))
+(declaim (inline console-get-foreground-colour))
+(defun* (console-get-foreground-colour -> colournum) ((con console))
   (console-get-foreground-color con))
 
 
 ;;TCODLIB_API TCOD_color_t TCOD_console_get_back(TCOD_console_t con,int x, int y)
-(defcfun ("TCOD_console_get_back_wrapper" %console-get-back) colournum
-  (con console) (x :int) (y :int))
-
-
-(defun legal-console-coordinates? (con x y)
-  (and (< x (console-get-width con))
-       (< y (console-get-height con))))
-
-
-(defun console-get-back (con x y)
-  ;; Assertion in libtcod
+(define-c-function ("TCOD_console_get_back_wrapper" console-get-back) colournum
+  ((con console) (x :int) (y :int))
   (assert (legal-console-coordinates? con x y))
-  (%console-get-back con x y))
+  (call-it))
+
+
+;; (defun* (console-get-back -> colournum) ((con console) (x fixnum) (y fixnum))
+;;   ;; Assertion in libtcod
+;;   (assert (legal-console-coordinates? con x y))
+;;   (%console-get-back con x y))
 
 
 ;;TCODLIB_API TCOD_color_t TCOD_console_get_fore(TCOD_console_t con,
 ;;                                               int x, int y);
-(defcfun ("TCOD_console_get_fore_wrapper" %console-get-fore) colournum
-  (con console) (x :int) (y :int))
-
-
-(defun console-get-fore (con x y)
-  ;; Assertion in libtcod
+(define-c-function ("TCOD_console_get_fore_wrapper" console-get-fore) colournum
+  ((con console) (x :int) (y :int))
   (assert (legal-console-coordinates? con x y))
-  (%console-get-fore con x y))
+  (call-it))
+
+
+;; (defun* (console-get-fore -> colournum) ((con console) (x fixnum) (y fixnum))
+;;   ;; Assertion in libtcod
+;;   (assert (legal-console-coordinates? con x y))
+;;   (%console-get-fore con x y))
 
   
 ;;TCODLIB_API int TCOD_console_get_char(TCOD_console_t con,int x, int y);
-(defcfun ("TCOD_console_get_char" %console-get-char) :unsigned-char
-  (con console) (x :int) (y :int))
-
-
-(defun console-get-char (con x y)
-  ;; Assertion in libtcod
+(define-c-function ("TCOD_console_get_char" console-get-char) :int
+  ((con console) (x :int) (y :int))
   (assert (legal-console-coordinates? con x y))
-  (%console-get-char con x y))
+  (call-it))
+
+
+;; (defun* (console-get-char -> fixnum) ((con console) (x fixnum) (y fixnum))
+;;   ;; Assertion in libtcod
+;;   (assert (legal-console-coordinates? con x y))
+;;   (%console-get-char con x y))
 
 
 ;;TCODLIB_API void TCOD_console_set_fade(uint8 val, TCOD_color_t fade);
-(defcfun ("TCOD_console_set_fade_wrapper" console-set-fade) :void
-  (val :uint8) (fade colournum))
+(define-c-function ("TCOD_console_set_fade_wrapper" console-set-fade) :void
+  ((val :uint8) (fade colournum)))
 
 ;;TCODLIB_API uint8 TCOD_console_get_fade();
-(defcfun ("TCOD_console_get_fade" console-get-fade) :uint8)
+(define-c-function ("TCOD_console_get_fade" console-get-fade) :uint8
+    ())
 
 
 ;;TCODLIB_API TCOD_color_t TCOD_console_get_fading_color();
-(defcfun ("TCOD_console_get_fading_color_wrapper"
-	  console-get-fading-color) colournum)
+(define-c-function ("TCOD_console_get_fading_color_wrapper"
+	  console-get-fading-color) colournum
+    ())
+(declaim (inline console-get-fading-colour))
 (defun console-get-fading-colour ()
   (console-get-fading-color))
 
 
 ;;TCODLIB_API void TCOD_console_flush();
-(defcfun ("TCOD_console_flush" console-flush) :void)
+(define-c-function ("TCOD_console_flush" console-flush) :void
+    ())
 
 ;; (sys-flush t) forces an 'update' of the system timer, FPS, etc.
 ;; If render is true, also forces an update of the root console.
-#-libtcod-old
-(defcfun ("TCOD_sys_flush" sys-flush) :void
-	(render :boolean))
+;; However, seems not to be an external symbol in latest libtcod (1.5.0)
+;; #-libtcod-old
+;; (define-c-function ("TCOD_sys_flush" sys-flush) :void
+;; 	(render :boolean))
 
 ;;TCODLIB_API void TCOD_console_set_color_control(TCOD_colctrl_t con,
 ;;     TCOD_color_t fore, TCOD_color_t back);
-(defcfun ("TCOD_console_set_color_control_wrapper"
+;; This is to do with "colour control" strings
+(define-c-function ("TCOD_console_set_color_control_wrapper"
 	  console-set-color-control) :void
-  (con colctrl) (fore colournum) (back colournum))
-(defun console-set-colour-control (con fore back)
-  (console-set-color-control con fore back))
-
-
-;;TCODLIB_API TCOD_key_t TCOD_console_check_for_keypress(int flags);
-(defcfun ("TCOD_console_check_for_keypress_wrapper"
-	  %console-check-for-keypress) :boolean
-	(keyptr key-press) (flags key-state))
-
-
-(defun key->keypress (keyptr)
-  (let ((flags (foreign-slot-value keyptr 'key-press 'flags)))
-    (make-key :vk (foreign-slot-value keyptr 'key-press 'vk)
-	      :c (code-char (foreign-slot-value keyptr 'key-press 'c))
+  ((control-num colctrl) (fore colournum) (back colournum)))
+
+(declaim (inline console-set-colour-control))
+(defun console-set-colour-control (control-num fore back)
+  (console-set-color-control control-num fore back))
+
+
+;;;; <<Keyboard input>> ========================================================
+
+
+;; (defun key->keypress (keyptr)
+;;   (let ((flags (foreign-slot-value keyptr 'key-press 'flags)))
+;;     (make-key :vk (foreign-slot-value keyptr 'key-press 'vk)
+;; 	      :c (code-char (foreign-slot-value keyptr 'key-press 'c))
+;; 	      :pressed (get-bit flags 1)
+;; 	      :lalt (get-bit flags 2)
+;; 	      :lctrl (get-bit flags 3)
+;; 	      :ralt (get-bit flags 4)
+;; 	      :rctrl (get-bit flags 5)
+;; 	      :shift (get-bit flags 6))))
+
+(defmacro and& (a b)
+  "Shorthand for (BOOLE 'BOOLE-AND A B)."
+  `(boole boole-and ,a ,b))
+
+
+(defun* key->keypress ((key-bf (unsigned-byte 32)))
+  (let ((flags (ash key-bf -24)))
+    (make-key :vk (foreign-enum-keyword
+                   'keycode
+                   (and& (ash key-bf -16) #x00FF)) ;;(ldb (byte 8 16) key-bf)
+              :c (code-char (and& key-bf #x0000FFFF))  ;;(ldb (byte 16 0) key-bf)
 	      :pressed (get-bit flags 1)
 	      :lalt (get-bit flags 2)
 	      :lctrl (get-bit flags 3)
 	      :shift (get-bit flags 6))))
 
 
-(defvar *key* nil)
-
-(defun console-check-for-keypress (flags)
-  (unless *key*
-    (setf *key* (foreign-alloc 'key-press)))
-  (%console-check-for-keypress *key* flags)
-  (unless (eql :none (foreign-slot-value *key* 'key-press 'vk))
-    (key->keypress *key*)))
-
-(defun console-wait-for-keypress (flush)
-  (unless *key*
-    (setf *key* (foreign-alloc 'key-press)))
-  (%console-wait-for-keypress *key* flush)
-  (key->keypress *key*))
+;;TCODLIB_API TCOD_key_t TCOD_console_check_for_keypress(int flags);
+(defcfun ("TCOD_console_check_for_keypress_wrapper"
+          %console-check-for-keypress) :int
+    (flags key-state))
+
+
+(defun* (console-check-for-keypress -> (or null key)) ((flags key-state))
+  (let ((key-bf (%console-check-for-keypress flags)))
+    (if (zerop key-bf)
+        nil
+        (key->keypress key-bf))))
+
+
+;; (defun* console-check-for-keypress ((flags key-state))
+;;   ;; (unless *key*
+;;   ;;   (setf *key* (foreign-alloc 'key-press)))
+;;   (with-foreign-object (key 'key-press)
+;;     (%console-check-for-keypress key flags)
+;;     (unless (eql :none (foreign-slot-value key 'key-press 'vk))
+;;       (key->keypress key))))
 
 
 ;;TCODLIB_API TCOD_key_t TCOD_console_wait_for_keypress(bool flush);
 (defcfun ("TCOD_console_wait_for_keypress_wrapper"
-	  %console-wait-for-keypress) :void
-	(keyptr key-press) (flush :boolean))
+          %console-wait-for-keypress) :int
+  (flush? :boolean))
+
+
+(defun* console-wait-for-keypress ((flush? boolean))
+  (key->keypress (%console-wait-for-keypress flush?)))
+
+
+
+;; (defun* console-wait-for-keypress ((flush? boolean))
+;;   ;; (unless *key*
+;;   ;;   (setf *key* (foreign-alloc 'key-press)))
+;;   (with-foreign-object (key 'key-press)
+;;     (%console-wait-for-keypress key flush?)
+;;     (key->keypress key)))
+
 
 ;;TCODLIB_API void TCOD_console_set_keyboard_repeat(int initial_delay,
 ;; int interval);
+(define-c-function ("TCOD_console_set_keyboard_repeat"
+                    console-set-keyboard-repeat) :void
+    ((initial-delay :int) (interval :int)))
+
+
 ;;TCODLIB_API void TCOD_console_disable_keyboard_repeat();
+(define-c-function ("TCOD_console_disable_keyboard_repeat"
+                    console-disable-keyboard-repeat) :void
+    ())
+
+
 ;;TCODLIB_API bool TCOD_console_is_key_pressed(TCOD_keycode_t key);
-(defcfun ("TCOD_console_is_key_pressed" is-key-pressed?) :boolean
-  (code keycode))
+(define-c-function ("TCOD_console_is_key_pressed" is-key-pressed?) :boolean
+  ((code keycode)))
 
 ;;TCODLIB_API TCOD_console_t TCOD_console_new(int w, int h);
-(defcfun ("TCOD_console_new" console-new) console
-  (w :int) (h :int))
+(define-c-function ("TCOD_console_new" console-new) console
+    ((width :int) (height :int))
+  (check-type width ucoord)
+  (check-type height ucoord)
+  (let ((newcon (call-it width height)))
+    (setf (gethash newcon *console-width-table*) width)
+    (setf (gethash newcon *console-height-table*) height)
+    newcon))
+
+
+;; (defun* (console-new -> console) ((width ucoord) (height ucoord))
+;;   (let ((newcon (%console-new width height)))
+;;     (setf (gethash newcon *console-width-table*) width)
+;;     (setf (gethash newcon *console-height-table*) height)
+;;     newcon))
+
 
 ;;TCODLIB_API int TCOD_console_get_width(TCOD_console_t con);
-(defcfun ("TCOD_console_get_width" console-get-width) :int
-  (con console))
+(define-c-function ("TCOD_console_get_width" console-get-width) :int
+  ((con console))
+  (or (gethash con *console-width-table*)
+      (call-it)))
+
+
+;; (defun* (console-get-width -> ucoord) ((con console))
+;;   (or (gethash con *console-width-table*)
+;;       (%console-get-width con)))
+
 
 ;;TCODLIB_API int TCOD_console_get_height(TCOD_console_t con);
-(defcfun ("TCOD_console_get_height" console-get-height) :int
-  (con console))
+(define-c-function ("TCOD_console_get_height" console-get-height) :int
+  ((con console))
+  (or (gethash con *console-height-table*)
+      (call-it)))
+
+
+;; (defun* (console-get-height -> ucoord) ((con console))
+;;   (or (gethash con *console-height-table*)
+;;       (%console-get-height con)))
+
 
 ;;TCODLIB_API void TCOD_console_blit(TCOD_console_t src,int xSrc, int ySrc,
 ;; int wSrc, int hSrc, TCOD_console_t dst, int xDst, int yDst, int fade);
-(defcfun ("TCOD_console_blit" %console-blit) :void
-  (src console)
-  (xsrc :int) (ysrc :int)
-  (wsrc :int) (hsrc :int)
-  (dest console)
-  (xdest :int) (ydest :int)
-  (foreground-alpha :float) (background-alpha :float))
-
-
-(defun console-blit (src xsrc ysrc wsrc hsrc dest xdest ydest
-                     foreground-alpha background-alpha)
+(define-c-function ("TCOD_console_blit" console-blit) :void
+    ((src console)
+     (xsrc :int) (ysrc :int)
+     (wsrc :int) (hsrc :int)
+     (dest console)
+     (xdest :int) (ydest :int)
+     (foreground-alpha :float) (background-alpha :float))
   (check-type xsrc (integer 0))
   (check-type ysrc (integer 0))
   (check-type wsrc (integer 0))
   ;; Blitting a console to a position that lies completely outside the
   ;; destination console's bounds will do nothing, rather than causing
   ;; an error.
-  (unless (or (>= xdest (console-get-width dest))
-              (>= ydest (console-get-height dest)))
-    ;; TCOD_console_blit unceremoniously crashes libtcod if this assertion
-    ;; is not true when it is called. We therefore check the assertion here
-    ;; first, so we have access to debugging facilities if the conditions
-    ;; are not met.
+  (when (legal-console-coordinates? dest xdest ydest)
+    ;; TCOD_console_blit unceremoniously crashes libtcod if this assertion is
+    ;; not true when it is called. We therefore check the assertion here first,
+    ;; so we have access to lisp debugging facilities if the conditions are not
+    ;; met.
     (assert (and (plusp wsrc) (plusp hsrc)
                  (>= (+ xdest wsrc) 0) (>= (+ ydest hsrc) 0)))
-    (%console-blit src xsrc ysrc wsrc hsrc dest xdest ydest
-                   foreground-alpha background-alpha)))
+    (call-it src xsrc ysrc wsrc hsrc dest xdest ydest
+             foreground-alpha background-alpha)))
+    
+  
+
+
+;; (defun* console-blit ((src console)
+;;                       (xsrc fixnum) (ysrc fixnum) (wsrc fixnum) (hsrc fixnum)
+;;                       (dest console)
+;;                       (xdest fixnum) (ydest fixnum)
+;;                       (foreground-alpha float) (background-alpha float))
+;;   (check-type xsrc (integer 0))
+;;   (check-type ysrc (integer 0))
+;;   (check-type wsrc (integer 0))
+;;   (check-type hsrc (integer 0))
+;;   (check-type xdest (integer 0))
+;;   (check-type ydest (integer 0))
+;;   (check-type foreground-alpha (real 0 1.0))
+;;   (check-type background-alpha (real 0 1.0))
+;;   ;; Blitting a console to a position that lies completely outside the
+;;   ;; destination console's bounds will do nothing, rather than causing
+;;   ;; an error.
+;;   (unless (or (>= xdest (console-get-width dest))
+;;               (>= ydest (console-get-height dest)))
+;;     ;; TCOD_console_blit unceremoniously crashes libtcod if this assertion
+;;     ;; is not true when it is called. We therefore check the assertion here
+;;     ;; first, so we have access to debugging facilities if the conditions
+;;     ;; are not met.
+;;     (assert (and (plusp wsrc) (plusp hsrc)
+;;                  (>= (+ xdest wsrc) 0) (>= (+ ydest hsrc) 0)))
+;;     (%console-blit src xsrc ysrc wsrc hsrc dest xdest ydest
+;;                    foreground-alpha background-alpha)))
 
 
 ;;TCODLIB_API void TCOD_console_delete(TCOD_console_t console);
-(defcfun ("TCOD_console_delete" console-delete) :void
-  (con console))
+(define-c-function ("TCOD_console_delete" console-delete) :void
+    ((con console)))
+
+
+;; void TCOD_console_set_key_color(TCOD_console_t con,TCOD_color_t col);
+;; (define-c-function ("TCOD_console_set_key_color" console-set-key-color) :void
+;;     ((con console)))
+
 
 ;;; sys.h
 
 ;;TCODLIB_API uint32 TCOD_sys_elapsed_milli();
 ;;TCODLIB_API float TCOD_sys_elapsed_seconds();
 ;;TCODLIB_API void TCOD_sys_sleep_milli(uint32 val);
-(defcfun ("TCOD_sys_sleep_milli" sys-sleep-milli) :void
-  (val :unsigned-int))
+(define-c-function ("TCOD_sys_sleep_milli" sys-sleep-milli) :void
+    ((val :unsigned-int)))
 
 ;;TCODLIB_API void TCOD_sys_save_screenshot(const char *filename);
 (defcfun ("TCOD_sys_save_screenshot" %sys-save-screenshot) :void
 
 ;;TCODLIB_API void TCOD_sys_force_fullscreen_resolution(int width, int height);
 ;;TCODLIB_API void TCOD_sys_set_fps(int val);
-(defcfun ("TCOD_sys_set_fps" sys-set-fps) :void
-  (val :int))
+(define-c-function ("TCOD_sys_set_fps" sys-set-fps) :void
+    ((val :int)))
 
 ;;TCODLIB_API int TCOD_sys_get_fps();
-(defcfun ("TCOD_sys_get_fps" sys-get-fps) :int)
+(define-c-function ("TCOD_sys_get_fps" sys-get-fps) :int
+    ())
 
 ;;TCODLIB_API float TCOD_sys_get_last_frame_length();
 ;;TCODLIB_API void TCOD_sys_get_current_resolution(int *w, int *h);
-(defvar *internal-width-ptr* (foreign-alloc :int))
-(defvar *internal-height-ptr* (foreign-alloc :int))
-
-(defcfun ("TCOD_sys_get_current_resolution" %sys-get-current-resolution) :void
-  (w-ptr :pointer) (h-ptr :pointer))
+;; (defvar *internal-width-ptr* nil)
+;; (defvar *internal-height-ptr* nil)
+
+;; Lisp wrapper needed because actual function returns nothing, whereas we
+;; want to return resolution.
+(defcfun ("TCOD_sys_get_current_resolution_x" sys-get-current-resolution-x) :int)
+(defcfun ("TCOD_sys_get_current_resolution_y" sys-get-current-resolution-y) :int)
 
 (defun sys-get-current-resolution ()
-  (%sys-get-current-resolution *internal-width-ptr* *internal-height-ptr*)
-  (values (mem-ref *internal-width-ptr* :int)
-	  (mem-ref *internal-height-ptr* :int)))
-
-
-;;;; (@> "Random") ============================================================
+  (values (sys-get-current-resolution-x)
+          (sys-get-current-resolution-y)))
+
+
+  ;; (with-foreign-object (widthptr :int)
+  ;;   (with-foreign-object (heightptr :int)
+  ;;     (%sys-get-current-resolution widthptr heightptr)
+  ;;     (values (mem-ref widthptr :int)
+  ;;             (mem-ref heightptr :int)))))
+
+
+;;;; <<Random>> ===============================================================
 
 
 ;;; mersenne.h
 
-;; TCOD_random_t
-(defctype randomptr :pointer)
-
 ;;TCODLIB_API TCOD_random_t TCOD_random_get_instance();
 ;;TCODLIB_API TCOD_random_t TCOD_random_new();
-(defcfun ("TCOD_random_new" random-new) randomptr
-  (algorithm rng-algorithm))
-(defcfun ("TCOD_random_new_from_seed" random-new-from-seed) randomptr
-  (algorithm rng-algorithm) (seed :uint32))
-(defcfun ("TCOD_random_get_instance" random-get-instance) randomptr)
-(defcfun ("TCOD_random_delete" random-delete) :void
-  (rng randomptr))
+(define-c-function ("TCOD_random_new" random-new) randomptr
+  ((algorithm rng-algorithm)))
+(define-c-function ("TCOD_random_new_from_seed" random-new-from-seed) randomptr
+  ((algorithm rng-algorithm) (seed :uint32)))
+(define-c-function ("TCOD_random_get_instance" random-get-instance) randomptr
+    ())
+(define-c-function ("TCOD_random_delete" random-delete) :void
+  ((rng randomptr)))
 
 ;;TCODLIB_API TCOD_random_t TCOD_random_new_from_seed(uint32 seed);
 ;;TCODLIB_API int TCOD_random_get_int(TCOD_random_t mersenne, int min, int max);
-(defcfun ("TCOD_random_get_int" random-get-int) :int
-  (rng randomptr) (min :int) (max :int))
+(define-c-function ("TCOD_random_get_int" random-get-int) :int
+  ((rng randomptr) (min :int) (max :int)))
 
 ;;TCODLIB_API float TCOD_random_get_float(TCOD_random_t mersenne, float min,
 ;;   float max);
-(defcfun ("TCOD_random_get_float" random-get-float) :float
-  (rng randomptr) (min :float) (max :float))
+(define-c-function ("TCOD_random_get_float" random-get-float) :float
+  ((rng randomptr) (min :float) (max :float)))
 
 ;;TCODLIB_API int TCOD_random_get_int_from_byte_array(int min, int max,
 ;;   const char *data,int len);
 ;;TCODLIB_API void TCOD_random_delete(TCOD_random_t mersenne);
 
 
-;;;; (@> "Mouse") =============================================================
-
-
-;;; mouse.h
-
-(defcstruct mouse-state
-	(x :int)	
-	(y :int)	
-	(dx :int)	
-	(dy :int)
-	(cx :int)	
-	(cy :int)
-	(dcx :int)	
-	(dcy :int)
-	(flags :uint8))
-
-(defstruct mouse
-	(x 0 :type integer)	;; absolute position
-	(y 0 :type integer)	
-	(dx 0 :type integer)	;; movement since last update in pixels
-	(dy 0 :type integer)
-	(cx 0 :type integer)	;; cell coordinates in the root console 
-	(cy 0 :type integer)
-	(dcx 0 :type integer)	;; movement since last update in console cells
-	(dcy 0 :type integer)
-	(lbutton nil :type boolean)	;; left button status
-	(rbutton nil :type boolean)	;; right button status
-	(mbutton nil :type boolean) ;; middle button status
-	(lbutton-pressed nil :type boolean)	;; left button pressed event
-	(rbutton-pressed nil :type boolean)	;; right button pressed event
-	(mbutton-pressed nil :type boolean)	;; middle button pressed event
-	(wheel-up nil :type boolean)		;; wheel up event
-	(wheel-down nil :type boolean)   ;; wheel down event 
-	(flags 0 :type integer))	;; copied from mouse-state
+;;;; <<Mouse>> ================================================================
+
+
+(defcfun ("TCOD_mouse_get_x" mouse-get-x) :int)
+(defcfun ("TCOD_mouse_get_y" mouse-get-y) :int)
+(defcfun ("TCOD_mouse_get_cx" mouse-get-cx) :int)
+(defcfun ("TCOD_mouse_get_cy" mouse-get-cy) :int)
+(defcfun ("TCOD_mouse_get_dx" mouse-get-dx) :int)
+(defcfun ("TCOD_mouse_get_dy" mouse-get-dy) :int)
+(defcfun ("TCOD_mouse_get_dcx" mouse-get-dcx) :int)
+(defcfun ("TCOD_mouse_get_dcy" mouse-get-dcy) :int)
+(defcfun ("TCOD_mouse_get_lbutton" mouse-get-lbutton) :unsigned-int)
+(defcfun ("TCOD_mouse_get_mbutton" mouse-get-mbutton) :unsigned-int)
+(defcfun ("TCOD_mouse_get_rbutton" mouse-get-rbutton) :unsigned-int)
+(defcfun ("TCOD_mouse_get_lbutton_pressed" mouse-get-lbutton-pressed)
+    :unsigned-int)
+(defcfun ("TCOD_mouse_get_mbutton_pressed" mouse-get-mbutton-pressed)
+    :unsigned-int)
+(defcfun ("TCOD_mouse_get_rbutton_pressed" mouse-get-rbutton-pressed)
+    :unsigned-int)
 
 
 (defun mouse-state->mouse (ms)
-  (let ((flags (foreign-slot-value ms 'mouse-state 'flags)))
     (make-mouse :x (foreign-slot-value ms 'mouse-state 'x)
 		:y (foreign-slot-value ms 'mouse-state 'y)
 		:dx (foreign-slot-value ms 'mouse-state 'dx)
 		:cy (foreign-slot-value ms 'mouse-state 'cy)
 		:dcx (foreign-slot-value ms 'mouse-state 'dcx)
 		:dcy (foreign-slot-value ms 'mouse-state 'dcy)
-		:lbutton (get-bit flags 1)
-		:rbutton  (get-bit flags 2)
-		:mbutton (get-bit flags 3)
-		:lbutton-pressed (get-bit flags 4)
-		:rbutton-pressed  (get-bit flags 5)
-		:mbutton-pressed (get-bit flags 6)
-		:wheel-up (get-bit flags 7)
-		:wheel-down (get-bit flags 8)
-		:flags flags)))
+		:lbutton (foreign-slot-value ms 'mouse-state 'lbutton)
+		:rbutton (foreign-slot-value ms 'mouse-state 'rbutton)
+		:mbutton (foreign-slot-value ms 'mouse-state 'mbutton)
+		:lbutton-pressed (foreign-slot-value ms 'mouse-state 'lbutton-pressed)
+		:rbutton-pressed (foreign-slot-value ms 'mouse-state 'rbutton-pressed)
+		:mbutton-pressed (foreign-slot-value ms 'mouse-state 'mbutton-pressed)))
 
 	      
+
+;; (let ((rodent nil))
+;;   (defun mouse-get-status ()
+;;     (unless rodent
+;;       (setf rodent (foreign-alloc 'mouse-state)))
+;;     (%mouse-get-status rodent)
+;;     (mouse-state->mouse rodent)))
+
+
 ;;TCODLIB_API TCOD_mouse_t TCOD_mouse_get_status();
+#+nil
 (defcfun ("TCOD_mouse_get_status_wrapper" %mouse-get-status) :void
-  (mouseptr mouse-state))
-
-(let ((rodent nil))
-  (defun mouse-get-status ()
-    (unless rodent
-      (setf rodent (foreign-alloc 'mouse-state)))
+  (mouseptr :pointer))
+
+;; This causes a crash on Clozure CL on linux.
+#+nil
+(defun mouse-get-status ()
+  (with-foreign-object (rodent 'mouse-state)
     (%mouse-get-status rodent)
     (mouse-state->mouse rodent)))
 
 
+(defun mouse-get-status ()
+  (make-mouse :x (mouse-get-x)
+              :y (mouse-get-y)
+              :dx (mouse-get-dx)
+              :dy (mouse-get-dy)
+              :cx (mouse-get-cx)
+              :cy (mouse-get-cy)
+              :dcx (mouse-get-dcx)
+              :dcy (mouse-get-dcy)
+              :lbutton (plusp (mouse-get-lbutton))
+              :rbutton (plusp (mouse-get-rbutton))
+              :mbutton (plusp (mouse-get-mbutton))
+              :lbutton-pressed (plusp (mouse-get-lbutton-pressed))
+              :rbutton-pressed (plusp (mouse-get-mbutton-pressed))
+              :mbutton-pressed (plusp (mouse-get-rbutton-pressed))))
+
+
+
 ;;TCODLIB_API void TCOD_mouse_show_cursor(bool visible);
 ;;TCODLIB_API bool TCOD_mouse_is_cursor_visible();
 ;;TCODLIB_API void TCOD_mouse_move(int x, int y);
-(defcfun ("TCOD_mouse_move" mouse-move) :void
-  (x :int) (y :int))
-
-
-
-;;;; (@> "Image") =============================================================
+(define-c-function ("TCOD_mouse_move" mouse-move) :void
+  ((pixel-x :int) (pixel-y :int)))
+
+
+
+;;;; <<Image>> ================================================================
 
 
 ;;; image.h
 
-;; TCOD_image_t
-(defctype image :pointer)
 
 ;;TCODLIB_API TCOD_image_t TCOD_image_new(int width, int height);
 ;;TCODLIB_API TCOD_image_t TCOD_image_from_console(TCOD_console_t console);
-(defcfun ("TCOD_image_from_console" image-from-console) image
-  (con console))
+(define-c-function ("TCOD_image_from_console" image-from-console) image
+  ((con console)))
 
 ;;TCODLIB_API TCOD_image_t TCOD_image_load(const char *filename);
-(defcfun ("TCOD_image_load" image-load) image
-  (filename :string))
+(define-c-function ("TCOD_image_load" image-load) image
+  ((filename :string)))
 
 
 ;;TCODLIB_API void TCOD_image_clear(TCOD_image_t image, TCOD_color_t color);
-(defcfun ("TCOD_image_clear_wrapper" image-clear) :void
-  (image image) (color colournum))
+(define-c-function ("TCOD_image_clear_wrapper" image-clear) :void
+  ((image image) (color colournum)))
 
 ;;TCODLIB_API void TCOD_image_save(TCOD_image_t image, const char *filename);
-(defcfun ("TCOD_image_save" image-save) :void
-  (image image) (filename :string))
+(define-c-function ("TCOD_image_save" image-save) :void
+  ((image image) (filename :string)))
 
 
 ;;TCODLIB_API void TCOD_image_get_size(TCOD_image_t image, int *w,int *h);
 ;;TCODLIB_API TCOD_color_t TCOD_image_get_pixel(TCOD_image_t image,int x, int y);
-(defcfun ("TCOD_image_get_pixel_wrapper" image-get-pixel) colournum
-  (image image) (x :int) (y :int))
+(define-c-function ("TCOD_image_get_pixel_wrapper" image-get-pixel) colournum
+  ((image image) (pixel-x :int) (pixel-y :int)))
+
 
 ;;TCODLIB_API TCOD_color_t TCOD_image_get_mipmap_pixel(TCO