Commits

Paul Sexton committed ef849ad

Tweaked for easier loading under Darwin (Mac OSX).

  • Participants
  • Parent commits f3c9903

Comments (0)

Files changed (1)

-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;;;;;;;;;;;;;;;80
-
-(in-package :cl-user)
-
-;;;; The documentation for this package is generated using the CLOD library.
-;;;;
-;;;; The following command is used: (tcod and clod systems must be
-;;;; loaded into the running lisp image first)
-;;;;
-
-#+nil
-(clod:document-package :tcod "tcod.org"
-                       :title "CL-TCOD"
-                       :internal-symbols? nil
-                       :brief-methods t
-                       :author "Paul Sexton"
-                       :email "eeeickythump@gmail.com")
-
-
-;;;
-;;; Windows users: change the string "libtcod-mingw.dll" to reflect the name
-;;; of your libtcod library (DLL file).
-;;;
-;;; Colours are passed to C as integers. There is also a system mapping
-;;; - make a colour from R, G, B values using COMPOSE-COLOUR.
-;;; - break down a colour into R, G and B values using DECOMPOSE-COLOUR.
-;;; - to start the colour system call START-COLOURS.
-;;; - to make a new colour and associate it with a name, use MAKE-COLOUR.
-
-(declaim (optimize (speed 0) (safety 2) (debug 3)))
-
-#+sbcl (declaim (sb-ext:muffle-conditions sb-ext:compiler-note))
-
-
-(defpackage :tcod
-  (:nicknames :cl-tcod)
-  (:use :cl :cffi :defstar)
-  (:export
-   #:*root*
-   #:+null+
-   ;; [[Colours]] ==========================================================
-   #:start-colours
-   #:start-colors
-   #:colour
-   #:color
-   #:compose-colour
-   #:compose-color
-   #:decompose-colour
-   #:decompose-color
-   #:colour-rgb
-   #:color-rgb
-   #:colour-hsv
-   #:color-hsv
-   #:invert-colour
-   #:invert-color
-   #:colour->grayscale
-   #:color->grayscale
-   #:colour-set-hsv
-   #:colour-get-hsv
-   #:colour-get-hue
-   #:colour-get-saturation
-   #:colour-get-value
-   #:colour-set-hue
-   #:colour-set-saturation
-   #:colour-set-value
-   #:colour-shift-hue
-   #:colour-equals?
-   #:colour-add
-   #:colour-subtract
-   #:colour-multiply
-   #:colour-multiply-scalar
-   #:colour-lerp
-   #:make-colour
-   #:color-set-hsv
-   #:color-get-hsv
-   #:color-get-hue
-   #:color-get-saturation
-   #:color-get-value
-   #:color-set-hue
-   #:color-set-saturation
-   #:color-set-value
-   #:color-shift-hue
-   #:color-equals?
-   #:color-add
-   #:color-subtract
-   #:color-multiply
-   #:color-multiply-scalar
-   #:color-lerp
-   #:make-color
-   #:background-alpha
-   #:background-add-alpha
-   ;; [[Console]] ==========================================================
-   #:console-init-root
-   #:console-set-window-title
-   #:console-is-fullscreen?
-   #:console-set-fullscreen
-   #:console-is-window-closed?
-   #:console-set-custom-font
-   #:console-map-ascii-code-to-font
-   #:console-map-ascii-codes-to-font
-   #:console-map-string-to-font
-   #:console-set-dirty
-   #:console-set-default-foreground
-   #:console-set-default-background
-   #:console-set-char-foreground
-   #:console-set-char-background
-   #:console-set-char
-   #:console-put-char
-   #:console-put-char-ex
-   #:console-set-background-flag
-   #:console-get-background-flag
-   #:console-set-alignment
-   #:console-get-alignment
-   #:console-print
-   #:console-print-ex
-   #:console-print-rect
-   #:console-print-rect-ex
-   #:console-get-height-rect
-   #:console-rect
-   #:console-hline
-   #:console-vline
-   #:console-print-frame
-   #:console-print-double-frame
-   #:console-get-default-foreground
-   #:console-get-default-background
-   #:console-get-char-foreground
-   #:console-get-char-background
-   #:console-get-char
-   #:console-set-fade
-   #:console-get-fade
-   #:console-get-fading-colour
-   #:console-flush
-   #:console-set-colour-control
-   #:console-new
-   #:console-get-height
-   #:console-get-width
-   #:console-set-color-control
-   #:console-get-fading-color
-   #:console-clear
-   #:console-blit
-   #:console-delete
-   #:console-credits
-   #:console-credits-reset
-   #:console-credits-renderer
-   #:legal-console-coordinates?
-   #:console-fill-char
-   #:console-set-key-colour
-   #:console-set-key-color
-   #:drawing-character
-   #:colctrl
-   #:colctrl->char
-   #:background-flag
-   #:console
-   ;; [[Unicode]] =============================================================
-   #:console-map-string-to-font-utf
-   #:console-print-utf
-   #:console-print-ex-utf
-   #:console-print-rect-utf
-   #:console-print-rect-ex-utf
-   #:console-get-rect-height-utf
-   ;; [[Keyboard input]] ======================================================
-   #:key
-   #:console-check-for-keypress
-   #:console-wait-for-keypress
-   #:keycode
-   #:key-p
-   #:key-c
-   #:key-vk
-   #:key-lalt
-   #:key-ralt
-   #:key-lctrl
-   #:key-rctrl
-   #:key-shift
-   #:make-key
-   #:make-simple-key
-   #:same-keys?
-   #:key-state
-   #:key-press
-   #:key-pressed
-   #:is-key-pressed?
-   #:console-set-keyboard-repeat
-   #:console-disable-keyboard-repeat
-   ;; [[Mouse]] ===============================================================
-   #:mouse
-   #:mouse-state
-   #:make-mouse
-   #:mouse-x
-   #:mouse-y
-   #:mouse-cx
-   #:mouse-cy
-   #:mouse-dx
-   #:mouse-dy
-   #:mouse-lbutton
-   #:mouse-mbutton
-   #:mouse-rbutton
-   #:mouse-lbutton-pressed
-   #:mouse-mbutton-pressed
-   #:mouse-rbutton-pressed
-   #:mouse-wheel-up
-   #:mouse-wheel-down
-   #:mouse-move
-   #:mouse-get-status
-   #:mouse-is-cursor-visible?
-   #:mouse-show-cursor
-   #: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-new
-   #:image-from-console
-   #:image-refresh-console
-   #:image-load
-   #:image-clear
-   #:image-invert
-   #:image-hflip
-   #:image-vflip
-   #:image-rotate90
-   #:image-scale
-   #:image-save
-   #:image-get-width                    ; these replace image-get-size
-   #:image-get-height
-   #:image-get-pixel
-   #:image-get-alpha
-   #:image-get-mipmap-pixel
-   #:image-put-pixel
-   #:image-blit
-   #:image-blit-rect
-   #:image-blit-2x
-   #:image-delete
-   #:image-set-key-colour
-   #:image-set-key-color
-   #:image-is-pixel-transparent?
-   ;; [[Random]] ==============================================================
-   #:random-new
-   #:random-get-instance
-   #:random-save
-   #:random-restore
-   #:random-new-from-seed
-   #:random-set-distribution
-   #:random-delete
-   #:random-get-int
-   #:random-get-float
-   #:random-get-double
-   #:random-get-int-mean
-   #:random-get-float-mean
-   #:random-get-double-mean
-   #:random-dice-new ;; not yet mentioned in libtcod docs
-   #:random-dice-roll ;;
-   #:random-dice-roll-s ;;
-   ;; [[Noise]] ===============================================================
-   #:noise-new
-   #:noise-delete
-   #:noise-set-type
-   #:noise-get-ex
-   #:noise-get-fbm-ex
-   #:noise-get-turbulence-ex
-   #:noise-get
-   #:noise-get-fbm
-   #:noise-get-turbulence
-   ;; [[Heightmap]] ===========================================================
-   #:heightmap
-   #:heightmap-new
-   #:heightmap-delete
-   #:heightmap-set-value
-   #:heightmap-add
-   #:heightmap-scale
-   #:heightmap-clear
-   #:heightmap-clamp
-   #:heightmap-copy
-   #:heightmap-normalize
-   #:heightmap-normalise
-   #:heightmap-lerp-hm
-   #:heightmap-add-hm
-   #:heightmap-multiply-hm
-   #:heightmap-add-hill
-   #:heightmap-dig-hill
-   #:heightmap-rain-erosion
-   #:heightmap-kernel-transform
-   #:heightmap-add-voronoi
-   #:heightmap-add-fbm
-   #:heightmap-scale-fbm
-   #:heightmap-dig-bezier
-   #:heightmap-get-value
-   #:heightmap-get-interpolated-value
-   #:heightmap-get-slope
-   #:heightmap-get-normal
-   #:heightmap-count-cells
-   #:heightmap-has-land-on-border?
-   #:heightmap-get-min
-   #:heightmap-get-max
-   #:heightmap-islandify
-   #:heightmap-dig-line    ; defined in cl-tcod
-   ;; [[Field of view]] =======================================================
-   #:fov-algorithm
-   #:mapptr
-   #:map-new
-   #:map-set-properties
-   #:map-clear
-   #:map-copy
-   #:map-delete
-   #:map-compute-fov
-   #:map-is-in-fov?
-   #:map-set-in-fov
-   #:map-is-transparent?
-   #:map-is-walkable?
-   #:map-get-width
-   #:map-get-height
-   #:map-get-nb-cells
-   ;; [[A* pathfinding]] ======================================================
-   #:a*-path
-   #:path-new-using-map
-   #:path-new-using-function
-   #:path-delete
-   #:path-compute
-   #:path-reverse
-   #:path-get
-   #:path-get-origin
-   #:path-get-destination
-   #:path-size
-   #:path-walk
-   #:path-is-empty?
-   ;; [[Dijkstra pathfinding]] ================================================
-   #:dijkstra-path
-   #:dijkstra-new
-   #:dijkstra-new-using-function
-   #:dijkstra-delete
-   #:dijkstra-compute
-   #:dijkstra-reverse
-   #:dijkstra-path-set
-   #:dijkstra-size
-   #:dijkstra-get
-   #:dijkstra-is-empty?
-   #:dijkstra-path-walk
-   #:dijkstra-get-distance
-   ;; [[Bresenham line drawing]] ==============================================
-   #:line-init
-   #:line-step
-   #:line-line
-   ;; [[BSP trees]] ===========================================================
-   #:bsp-new-with-size
-   #:bsp-remove-sons
-   #:bsp-split-once
-   #:bsp-split-recursive
-   #:bsp-delete
-   #:bsp-resize
-   #:bsp-left
-   #:bsp-right
-   #:bsp-father
-   #:bsp-is-leaf?
-   #:bsp-contains?
-   #:bsp-find-node
-   #:bsp-traverse-pre-order
-   #:bsp-traverse-in-order
-   #:bsp-traverse-post-order
-   #:bsp-traverse-level-order
-   #:bsp-traverse-inverted-level-order
-   ;; [[Name generation]] =====================================================
-   #:namegen-parse
-   #:namegen-destroy
-   #:namegen-generate
-   #:namegen-generate-custom
-   ;;#:namegen-get-sets -- not yet implemented as returns a TCOD_list_t type
-   ;; [[Compression toolkit]] =================================================
-   #:zipptr
-   #:zip-new
-   #:zip-delete
-   #:zip-put
-   #:zip-put-char
-   #:zip-put-int
-   #:zip-put-float
-   #:zip-put-string
-   #:zip-put-colour
-   #:zip-put-color
-   #:zip-put-image
-   #:zip-put-console
-   #:zip-put-data
-   #:zip-get-char
-   #:zip-get-int
-   #:zip-get-float
-   #:zip-get-string
-   #:zip-get-image
-   #:zip-get-colour
-   #:zip-get-color
-   #:zip-get-console
-   #:zip-get-data
-   #:zip-get-current-bytes
-   #:zip-get-remaining-bytes
-   #:zip-skip-bytes
-   #:zip-save-to-file
-   #:zip-load-from-file
-   ;; [[System]] ==============================================================
-   #:sys-set-fps
-   #:sys-get-fps
-   #:sys-get-last-frame-length
-   #:sys-sleep-milli
-   #:sys-elapsed-milli
-   #:sys-elapsed-seconds
-   #:sys-save-screenshot
-   #:sys-create-directory ;;
-   #:sys-delete-directory ;;
-   #:sys-get-current-resolution
-   #:sys-force-fullscreen-resolution ;;
-   #:sys-get-fullscreen-offsets ;;
-   #:sys-get-renderer
-   #:sys-set-renderer
-   #:sys-register-sdl-renderer ;;
-   #:sys-get-char-size
-   #:sys-update-char ;;
-   #:sys-check-for-event
-   #:sys-wait-for-event
-   #:sys-get-events
-   #:sys-clipboard-set ;;
-   #:sys-clipboard-get ;;
-   #:sys-flush
-   ;; [[SDL]] =================================================================
-   #:sdl-get-mouse-status
-   ;; [[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.36 on Linux and Windows, Clozure 1.5
-on Linux and Windows, and CLISP on Windows.
-
-**Note** that it has not been used on a Mac; if you do this you may need to
-tell CFFI the name of the compiled libtcod library under MacOS. 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.
-
-* Dependencies
-
-=CL-TCOD= depends on the following libraries:
-1. ASDF: [[http://common-lisp.net/project/asdf/]]
-2. DEFSTAR: [[http://bitbucket.org/eeeickythump/defstar/]]
-3. CFFI: [[http://common-lisp.net/project/cffi/]]
-
-* 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 either [[http://www.quicklisp.org/][Quicklisp]] (recommended) or the
-   ASDF lisp library is installed.
-3. If CFFI or DEFSTAR are not installed, download and install them somewhere
-   ASDF can find them. CFFI requires several third-party lisp libraries -- see
-   the CFFI documentation for more details.  Note that if you have
-   Quicklisp installed, you can install CFFI and its dependencies
-   easily using the command =(ql:quickload \"cffi\")= at the Lisp prompt.
-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 and libSDL
-   dynamically linked libraries (=.DLL= or =.SO= files) are somewhere your lisp
-   system can find them. They probably are, but if CFFI complains about being unable
-   to find the libraries, you can either copy them to an appropriate directory or
-   add their 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, then load CL-TCOD. Using Quicklisp (recommended):
-
-;;;   (ql:quickload :tcod)
-
-   Using ASDF:
-
-;;;   (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 :renderer-sdl)
-;;;   (tcod:console-clear tcod:*root*)
-;;;   (tcod:console-print tcod:*root* 1 1 \"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, most functions exist in both U.S. and non-U.S. spellings, This is
-mainly relevant to those functions with colour/color or centre/center in their
-names.
-
-** 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 (con, x, y, \"Printing at %d, %d\n\", x, y);
-#+END_SRC
-
-becomes:
-
-;;;    (tcod:console-print con x y \"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...)
-
-** Coverage
-
-Does not provide wrappers for:
-- File parser. Using this from lisp would be a very cumbersome way to read
-  values from a file, as the resulting values are not lisp objects. You would
-  be better to either consider using the lisp
-  `read' function, or looking into lisp libraries for parser generation.
-- =namegen-get-sets= -- I haven't yet implemented this as it will have to
-  involve converting from libtcod's bespoke 'linked list' to a lisp list.
-  You may be better to write your random name generator in lisp (fairly trivial).
-- =sys-get-directory-content=, =sys-file-exists=, =sys-is-directory=,
-  =sys-delete-file=: Common Lisp already has functions that do the same thing.
-
-* 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/]]
-
-[[http://www.quicklisp.org/][Quicklisp]] allows you to very easily install
-libraries -- it automatically downloads and installs a library and its
-dependencies, from within Lisp.  If you don't decide to go with Lisp in a
-Box (below), then Quicklisp should be the first thing you install once you have
-your lisp running.
-
-*\"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 (Lisp, Emacs,
-SLIME, and Quicklisp).
-
-- [[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 graphical IDE.
-- 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
-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 available for any programming language.
-
-The downside: 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 (though development is active, 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 through a socket with
-your lisp process...
-
-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
-'trial' versions that can be downloaded for free, and which I recommend you
-use when beginning to learn Common Lisp as they come with integrated
-graphical editors/development environments (although if you have a Mac
-you may wish to investigate Clozure CL's IDE -- see below).
-
-- [[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.
-
-For the title of the best, most robust free multiplatform Common Lisp compiler,
-it is currently a very close call between these two:
-- [[http://www.sbcl.org][Steel Bank Common Lisp (SBCL)]] Compiles to
-  machine code, great on Linux/Mac,
-  still nominally 'experimental' on Windows but actually seems very stable
-  on that platform.
-- [[http://ccl.clozure.com][Clozure CL]] Compiles to machine code; native to
-  Mac but recently ported to Linux and Windows. Formerly known as OpenMCL.
-  The Mac version has a graphical IDE.
-  Not to be confused with [[http://clojure.org][Clojure]], which is a different
-  dialect of lisp from Common Lisp.
-
-Other worthwhile free implementations:
-- [[http://clisp.cons.org][GNU CLISP]] Bytecode compiler, so programs won't run
-  as fast as in the compiled lisps discussed above. However it runs pretty much
-  everywhere, and is easy to install on Windows.
-- [[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 in non-Lisp
-  applications as a scripting language.
-- [[http://common-lisp.net/project/armedbear/][Armed Bear Common Lisp]]
-  Common Lisp compiler running inside the Java virtual machine, so your
-  code will run on any platform and can use all the Java libraries. I doubt
-  you'll be able to use libtcod with this though.
-
-Help & advice with lisp:
-
-    [[http://www.lispforum.com]]
-"))
-
-(in-package :tcod)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (pushnew :tcod *features*))
-
-;;; Comment this out if you want cl-tcod to be 'fast' rather than 'safe and
-;;; maximally debuggable'
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (pushnew :tcod-debug *features*))
-
-
-#+tcod-debug (declaim (optimize (speed 0) (safety 3) (debug 3)))
-#-tcod-debug (declaim (optimize (speed 3) (safety 1) (debug 0)))
-
-
-;;; 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
-;;; Lisp program. To actually pass the literal string to C, we need to change
-;;; the encoding scheme to ISO-8859-1.
-;;;
-
-(setf cffi:*default-foreign-encoding* :iso-8859-1)
-
-;;; If debug mode is on, force compiler to explicitly enforce type declarations
-;;; for function arguments, raising an error when a type mismatch occurs.
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (setf defstar:*check-argument-types-explicitly?*
-        #+tcod-debug t
-        #-tcod-debug nil))
-
-
-;;;; <<Libraries>> ============================================================
-
-
-
-(define-foreign-library libtcod
-	(:unix #+libtcod-debug "libtcod-debug.so"
-               #-libtcod-debug "libtcod.so")
-	(:windows #-libtcod-debug "libtcod-mingw.dll"
-                  #+libtcod-debug "libtcod-mingw-debug.dll")
-	;; (:macintosh "NAME-OF-LIBTCOD-LIBRARY-IN-MACOS")
-	(t (:default "libtcod")))
-
-(defvar *libtcod-loaded* nil
-  "Global variable, set to non-nil once libtcod is loaded. This is to
-avoid crashes which occur in some CL implementations when you load
-an already-loaded foreign library.")
-
-(eval-when (:load-toplevel :execute)
-	(unless *libtcod-loaded*
-		(use-foreign-library libtcod)
-		(setf *libtcod-loaded* t)))
-
-;;; We need direct access to SDL because libtcod 1.5.1rc1 does not report
-;;; mouse buttons correctly (or at least, reading them via CFFI gives
-;;; strange, random results.)
-
-(define-foreign-library libsdl
-  (:unix "libSDL.so")
-  (:windows "SDL.dll")
-  ;; (:macintosh "NAME-OF-SDL-LIBRARY-IN-MACOS")
-  (t (:default "libsdl")))
-
-(defvar *libsdl-loaded* nil)
-
-(eval-when (:load-toplevel :execute)
-  (unless *libsdl-loaded*
-    (use-foreign-library libsdl)
-    (setf *libsdl-loaded* t)))
-
-;; Returns an 8-bit integer.
-;; bit 1: lbutton
-;; bit 2: mbutton
-;; bit 3: rbutton
-;; The arguments xptr and yptr can be null pointers.
-(defcfun ("SDL_GetMouseState" sdl-get-mouse-state) :int
-  (xptr :pointer) (yptr :pointer))
-
-
-;;;; <<Macros>> ===============================================================
-
-
-;;; The following are some wrapper macros to ease the creation
-;;; of `type-safe' CFFI wrappers to C functions.
-
-
-(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)
-    "Given a CFFI foreign type, return an equivalent lisp type."
-    (case c-type
-      (:boolean 'boolean)
-      ((:int :unsigned-int) 'uint)
-      (:char 'signed-char)
-      (:unsigned-char 'uchar)
-      (:uint8 'uint8)
-      (:uint32 'uint32)
-      (:float 'single-float)
-      (:double 'double-float)
-      (:pointer (type-of (null-pointer)))
-      (:string 'string)
-      (:void t)
-      (otherwise
-       (if (simple-type? c-type)
-           c-type
-           (error "In C-TYPE->LISP-TYPE: unrecognised 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:
-1. The function arguments are wrapped in a set of outer parentheses.
-2. Everything after this `arguments' term is considered to be the body
-   of the wrapper function. Within this body, the macro =(call-it)=
-   will call the actual C function. If =call-it= is called with no arguments,
-   it will pass all the arguments given to the wrapper function, to the
-   C function. Otherwise it will pass whatever arguments it is given, to
-   the C function (similar to =call-next-method=).
-3. If there is nothing after the function arguments, then the wrapper function
-   body will automatically consist of a single call to the underlying
-   C function."
-  (let ((args-no-rest (remove '&rest args)))
-    `(progn
-       (cond
-         ((null (cffi:foreign-symbol-pointer ,foreign-fn-name))
-          (warn "Foreign function not found: ~S" ,foreign-fn-name))
-         (t
-          (defcfun (,foreign-fn-name ,(prepend-percent fn-name)) ,return-type
-            ,@args)
-          (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)))))))))
-
-
-
-(defmacro define-c-type (name foreign-type)
-  "Define both a CFFI foreign type, and a corresponding lisp type of the same
-name."
-  `(progn
-     (defctype ,name ,foreign-type)
-     (deftype ,name () ',(c-type->lisp-type foreign-type))))
-
-
-(defmacro clamp (low hi expr)
-  "Return the numeric value of EXPR, constrained to the range [LOW ... HI]."
-  `(min ,hi (max ,low ,expr)))
-
-
-;;;; <<Types>> ================================================================
-
-
-(deftype uint32 () `(unsigned-byte 32))
-(deftype uint24 () `(unsigned-byte 24))
-(deftype uint16 () `(unsigned-byte 16))
-(deftype uint8 () `(unsigned-byte 8))
-(deftype uint () `(unsigned-byte ,(* 8 (foreign-type-size :int))))
-(deftype uchar () `(unsigned-byte ,(* 8 (foreign-type-size :unsigned-char))))
-(deftype signed-char () `(signed-byte ,(* 8 (foreign-type-size :char))))
-
-(deftype sint16 () `(signed-byte 16))
-
-(deftype ucoord () `(integer 0 1000))
-
-
-(define-c-type colournum :unsigned-int)
-
-
-;; TCOD_color_t
-;; This is seldom used -- colournums are used instead (see above).
-(defcstruct colour
-  (r :uint8)
-  (g :uint8)
-  (b :uint8))
-
-
-;; TCOD_renderer_t (enum)
-(define-c-enum renderer
-  :RENDERER-GLSL
-  :RENDERER-OPENGL
-  :RENDERER-SDL)
-
-
-;; TCOD_keycode_t (enum)
-(define-c-enum keycode
-  :NONE
-  :ESCAPE
-  :BACKSPACE
-  :TAB
-  :ENTER
-  :SHIFT
-  :CONTROL
-  :ALT
-  :PAUSE
-  :CAPSLOCK
-  :PAGEUP
-  :PAGEDOWN
-  :END
-  :HOME
-  :UP
-  :LEFT
-  :RIGHT
-  :DOWN
-  :PRINTSCREEN
-  :INSERT
-  :DELETE
-  :LWIN
-  :RWIN
-  :APPS
-  :key-0
-  :key-1
-  :key-2
-  :key-3
-  :key-4
-  :key-5
-  :key-6
-  :key-7
-  :key-8
-  :key-9
-  :KP0
-  :KP1
-  :KP2
-  :KP3
-  :KP4
-  :KP5
-  :KP6
-  :KP7
-  :KP8
-  :KP9
-  :KPADD
-  :KPSUB
-  :KPDIV
-  :KPMUL
-  :KPDEC
-  :KPENTER
-  :F1
-  :F2
-  :F3
-  :F4
-  :F5
-  :F6
-  :F7
-  :F8
-  :F9
-  :F10
-  :F11
-  :F12
-  :NUMLOCK
-  :SCROLLLOCK
-  :SPACE
-  :CHAR)
-
-
-;; TCOD_key_t
-;; This is no longer used -- key structs are converted to a bitfield by
-;; wrapper functions in libtcod.
-(defcstruct key-press
-  (vk keycode)                        ; character if vk == TCODK_CHAR else 0
-  (c :unsigned-char)
-  (flags :uint8))                  ; does this correspond to a key press or key
-                                   ; release event ?
-
-
-(defstruct key
-  "The structure used by CL-TCOD to represent key-press events. Corresponds
-to the structure used by libtcod."
-  (vk :none :type keyword)
-  (c #\null :type character)
-  (pressed nil :type boolean)
-  (lalt nil :type boolean)
-  (lctrl nil :type boolean)
-  (ralt nil :type boolean)
-  (rctrl nil :type boolean)
-  (shift nil :type boolean))
-
-
-(define-c-enum event
-    (:EVENT-NONE 0)
-    (:EVENT-KEY-PRESS 1)
-  (:EVENT-KEY-RELEASE 2)
-  (:EVENT-KEY 3)                        ; PRESS | RELEASE
-  (:EVENT-MOUSE-MOVE 4)
-  (:EVENT-MOUSE-PRESS 8)
-  (:EVENT-MOUSE-RELEASE 16)
-  (:EVENT-MOUSE 28)                     ; MOVE | PRESS | RELEASE
-  (:EVENT-ANY 31))
-
-
-(define-c-enum drawing-character
-  (:CHAR-HLINE 196)
-  (:CHAR-VLINE 179)
-  (:CHAR-NE 191)
-  (:CHAR-NW 218)
-  (:CHAR-SE 217)
-  (:CHAR-SW 192)
-  (:CHAR-TEEW 180)
-  (:CHAR-TEEE 195)
-  (:CHAR-TEEN 193)
-  (:CHAR-TEES 194)
-  (:CHAR-CROSS 197)
-  ;; Double walls
-  (:CHAR-DHLINE 205)
-  (:CHAR-DVLINE 186)
-  (:CHAR-DNE 187)
-  (:CHAR-DNW 201)
-  (:CHAR-DSE 188)
-  (:CHAR-DSW 200)
-  (:CHAR-DTEEW 181)
-  (:CHAR-DTEEE 198)
-  (:CHAR-DTEEN 208)
-  (:CHAR-DTEES 210)
-  (:CHAR-DCROSS 206)
-  ;; Blocks
-  (:CHAR-BLOCK1 178)
-  (:CHAR-BLOCK2 177)
-  (:CHAR-BLOCK3 176)
-  ;; Arrows
-  (:CHAR-ARROW-N 24)
-  (:CHAR-ARROW-S 25)
-  (:CHAR-ARROW-E 26)
-  (:CHAR-ARROW_W 27)
-  ;; Arrows without tail
-  (:CHAR-ARROW2-N 30)
-  (:CHAR-ARROW2-S 31)
-  (:CHAR-ARROW2-E 16)
-  (:CHAR-ARROW2-W 17)
-  ;; Double arrows
-  (:CHAR-DARROW2-H 29)
-  (:CHAR-DARROW2-V 18)
-  ;; GUI stuff
-  (:CHAR-CHECKBOX-UNSET 224)
-  (:CHAR-CHECKBOX-SET 225)
-  (:CHAR-RADIO-UNSET 9)
-  (:CHAR-RADIO-SET 10)
-  ;; Subpixel resolution kit
-  (:CHAR-SUBP-NW 226)
-  (:CHAR-SUBP-NE 227)
-  (:CHAR-SUBP-N 228)
-  (:CHAR-SUBP-SE 229)
-  (:CHAR-SUBP-DIAG 230)
-  (:CHAR-SUBP-E 231)
-  (:CHAR-SUBP-SW 232))
-
-
-;; TCOD_colctrl_t (enum)
-(define-c-enum colctrl
-  (:COLCTRL-1 1)
-  :COLCTRL-2
-  :COLCTRL-3
-  :COLCTRL-4
-  :COLCTRL-5
-  (:COLCTRL-NUMBER 5)
-  :COLCTRL-FORE-RGB
-  :COLCTRL-BACK-RGB
-  :COLCTRL-STOP )
-
-;; TCOD_bkgnd_flag_t (enum)
-(define-c-enum background-flag
-  :NONE
-  :SET
-  :MULTIPLY
-  :LIGHTEN
-  :DARKEN
-  :SCREEN
-  :COLOR-DODGE
-  :COLOR-BURN
-  :ADD
-  :ADDA
-  :BURN
-  :OVERLAY
-  :ALPH)
-
-
-(define-c-enum alignment
-  :LEFT
-  :CENTER
-  :RIGHT)
-
-
-(define-c-bitfield key-state
-  (:KEY-PRESSED 1)
-  (:KEY-RELEASED 2))
-
-
-(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))
-
-
-(define-c-enum noise-type
-  (:NOISE-DEFAULT 0)
-  (:NOISE-PERLIN 1)
-  (:NOISE-SIMPLEX 2)
-  (:NOISE-WAVELET 4))
-
-
-(define-c-enum rng-algorithm            ; TCOD_random_algo_t
-  :RNG-MT
-  :RNG-CMWC)
-
-(define-c-enum rng-distribution         ; TCOD_distribution_t
-  :DISTRIBUTION-LINEAR
-  :DISTRIBUTION-GAUSSIAN
-  :DISTRIBUTION-GAUSSIAN-RANGE
-  :DISTRIBUTION-GAUSSIAN-INVERSE
-  :DISTRIBUTION-GAUSSIAN-RANGE-INVERSE)
-
-
-(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
-(define-c-type console :pointer)
-
-
-;; TCOD_bsp_t = a struct
-;; but all variables pass a pointer to this struct
-(define-c-type bsp-ptr :pointer)
-
-
-;; TCOD_random_t = pointer to void
-(define-c-type randomptr :pointer)
-
-
-;; TCOD_parser_t = pointer to void
-(define-c-type parser :pointer)
-
-
-;; TCOD_zip_t = pointer to void
-(define-c-type zipptr :pointer)
-
-
-;; TCOD_mouse_t
-(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)
-  (wheel-up :boolean)
-  (wheel-down :boolean))
-
-(defstruct mouse
-  "Structure used by CL-TCOD to represent mouse status."
-  (x 0 :type uint16) ;; absolute position
-  (y 0 :type uint16)
-  (dx 0 :type sint16) ;; movement since last update in pixels
-  (dy 0 :type sint16)
-  (cx 0 :type uint16) ;; cell coordinates in the root console
-  (cy 0 :type uint16)
-  (dcx 0 :type sint16)	;; movement since last update in console cells
-  (dcy 0 :type sint16)
-  (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-down nil :type boolean))
-
-;; TCOD_image_t = pointer to void
-(define-c-type image :pointer)
-
-;; TCOD_noise_t = pointer to void
-(define-c-type noise :pointer)
-
-;; TCOD_heightmap_t = a struct
-;; but all functions pass/take pointers to heightmaps
-(define-c-type heightmap-ptr :pointer)
-
-;; TCOD_map_t = pointer to void
-(define-c-type mapptr :pointer)
-
-;; TCOD_path_t = pointer to void
-(define-c-type a*-path :pointer)
-
-;; TCOD_dijkstra_t = pointer to void
-(define-c-type dijkstra-path :pointer)
-
-
-;;;; <<Utilities>> ============================================================
-
-
-(defun* (get-bit -> boolean) ((n integer) (pos uint8))
-  "Return the bit at position POS within the integer N (represented as
-a bitfield). POS = 1 refers to the 1's (rightmost) bit."
-  (/= 0 (logand n (expt 2 (1- pos)))))
-
-
-
-(defvar *root* (null-pointer) "The root console.")
-(defparameter +NULL+ (null-pointer) "The null pointer.")
-(defconstant +NOISE-DEFAULT-HURST+ 0.5
-  "Default Hurst exponent for noise functions.")
-(defconstant +NOISE-DEFAULT-LACUNARITY+ 2.0
-  "Default lacunarity for noise functions.")
-
-
-(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))
-
-
-
-(defun* (make-simple-key -> key) ((ch character))
-  (make-key :vk :char :c ch))
-
-
-(defun* (same-keys? -> boolean) ((key1 key) (key2 key))
-  (and (key-p key1) (key-p key2)
-       (eql (key-vk key1) (key-vk key2))
-       (eql (key-c key1) (key-c key2))
-       (eql (key-shift key1) (key-shift key2))
-       (eql (or (key-lalt key1) (key-ralt key1))
-            (or (key-lalt key2) (key-ralt key2)))
-       (eql (or (key-lctrl key1) (key-rctrl key1))
-            (or (key-lctrl key2) (key-rctrl key2)))))
-
-
-
-;;;; <<Colours>> ==============================================================
-
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defun* (compose-colour -> uint32) ((r uint8) (g uint8) (b uint8))
-    "Given three integer values R, G and B, representing the red, green and
-blue components of a colour, return a 3 byte integer whose value is #xBBGGRR."
-    (+ (ash b 16) (ash g 8) r))
-  (declaim (inline compose-color))
-  (defun compose-color (r g b) (compose-colour r g b)))
-
-
-(defun* (colour-rgb -> uint32) ((r uint8) (g uint8) (b uint8))
-  (compose-colour r g b))
-(defun color-rgb (r g b) (colour-rgb r g b))
-
-
-(defun* (colour-hsv -> uint32) ((hue single-float) (sat single-float)
-                                (val single-float))
-  "Return a new colour with the given HSV (hue, saturation and value)
-components."
-  (cond
-   ((zerop sat)
-    ;; Achromatic grey
-    (compose-colour (truncate (+ 0.5 (* 255.0 val)))
-                    (truncate (+ 0.5 (* 255.0 val)))
-                    (truncate (+ 0.5 (* 255.0 val)))))
-   (t
-    (loop while (minusp hue) do (incf hue 360.0))
-    (loop while (>= hue 360.0) do (decf hue 360.0))
-    (setf hue (/ hue 60.0))
-    (let* ((i (truncate hue))
-           (f (- hue i))
-           (p (* val (- 1 sat)))
-           (q (* val (- 1 (* sat f))))
-           (z (* val (- 1 (* sat (- 1 f)))))) ; variable t renamed to z
-      (compose-colour
-       (truncate
-        (+ 0.5 (* 255.0 (case i
-                          (1 q)
-                          ((2 3) p)
-                          (4 z)
-                          (t val)))))
-       (truncate
-        (+ 0.5 (* 255.0 (case i
-                          ((1 2) val)
-                          (3 q)
-                          (t p)))))
-       (truncate
-        (+ 0.5 (* 255.0 (case i
-                          ((0 1) p) (2 z) ((3 4) val) (t q))))))))))
-(defun color-hsv (hue sat val) (colour-hsv hue sat val))
-
-
-(defun* (decompose-colour -> (values uint8 uint8 uint8)) ((num colournum))
-  "Given a colournum #xBBGGRR, return R, G and B integer values as 3 separate
-return values."
-  (values
-         (logand num #x0000ff)
-         (ash (logand num #x00ff00) -8)
-         (ash (logand num #xff0000) -16)
-         ))
-(declaim (inline decompose-color))
-(defun decompose-color (num) (decompose-colour num))
-
-
-(defun* (invert-colour -> colournum) ((num colournum))
-  (multiple-value-bind (r g b) (decompose-colour num)
-    (compose-colour (- 255 r) (- 255 g) (- 255 b))))
-(declaim (inline invert-color))
-(defun invert-color (num) (invert-colour num))
-
-
-(defvar *colour-table* nil)
-(defvar *initial-colours*
-  `((:true-black        #x00 #x00 #x00)
-    (:true-pink                 #xFF #x00 #xFF)
-    (:true-white        #xFF #xFF #xFF)
-    (:true-red          #xFF #x00 #x00)
-    (:true-green        #x00 #xFF #x00)
-    (:true-blue                 #x00 #x00 #xFF)
-    (:black             #x00 #x00 #x00)
-    (:dark-grey         96 96 96)
-    (:grey              196 196 196)
-    (:white             255 255 255)
-    (:blue              13 103 196)
-    (:dark-blue         40 40 128)
-    (:light-blue        120 120 255)
-    (:dark-red                  128 0 0)
-    (:light-red         255 100 50)
-    (:dark-brown        32 16 0)
-    (:light-yellow      255 255 150)
-    (:yellow            255 255 0)
-    (:dark-yellow       164 164 0)
-    (:green             0 220 0)
-    (:cyan              86 163 205)
-    (:orange            255 150 0)
-    (:red               255 0 0)
-    (:silver            203 203 203)
-    (:gold              255 255 102)
-    (:purple            204 51 153)
-    (:dark-purple       51 0 51)
-    ;; Some colours not defined in TCOD.
-    (:slate-grey        #x80 #x80 #x80)
-    (:umber             #x80 #x40 0)
-    (:pink              #xFF #x00 #xFF)
-    (:chocolate         210 105 30)))
-
-
-;;#define TCOD_BKGND_ALPHA(alpha)
-;;    ((TCOD_bkgnd_flag_t)(TCOD_BKGND_ALPH|(((uint8)(alpha*255))<<8)))
-(defun background-alpha (alpha)
-  (foreign-enum-keyword 'background-flag
-                        (logior (foreign-enum-value 'background-flag :alph)
-                                (ash (mod (* alpha 255) 256) 8))))
-
-;;
-;;#define TCOD_BKGND_ADDALPHA(alpha)
-;;    ((TCOD_bkgnd_flag_t)(TCOD_BKGND_ADDA|(((uint8)(alpha*255))<<8)))
-(defun background-add-alpha (alpha)
-  (foreign-enum-keyword 'background-flag
-                        (logior (foreign-enum-value 'background-flag :adda)
-                                (ash (mod (* alpha 255) 256) 8))))
-
-
-(defun start-colours ()
-  (setf *colour-table* (make-hash-table :test #'eql))
-  (dolist (term *initial-colours*)
-    (destructuring-bind (name r g b) term
-      (make-colour name r g b)))
-  (make-rgb.txt-colours))
-(defun start-colors () (start-colours))
-
-
-(defun make-colour (kwd r g b)
-  (unless (hash-table-p *colour-table*)
-    (start-colours))
-  (setf (gethash kwd *colour-table*)
-        (compose-colour r g b)))
-(defun make-color (kwd r g b) (make-colour kwd r g b))
-
-
-(defun colour->grayscale (col)
-  (multiple-value-bind (r g b) (decompose-colour col)
-    (let ((brightness (round (+ r g b) 3)))
-      (compose-colour brightness brightness brightness))))
-(defun color->grayscale (col) (colour->grayscale col))
-
-
-(defun* (colour -> colournum) ((keywd (or colournum symbol)))
-  "Given a colour keyword such as :GREY, return its corresponding RGB
-value (#xRRGGBB)."
-  (cond
-    ((integerp keywd)
-     keywd)
-    (t
-     (unless *colour-table*
-       (start-colours))
-     (gethash keywd *colour-table*))))
-(declaim (inline color))
-(defun color (keywd) (colour keywd))
-
-
-(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);
-(define-c-function ("TCOD_color_equals_wrapper" colour-equals?) :boolean
-        ((c1 colournum) (c2 colournum)))
-(declaim (inline color-equals?))
-(defun color-equals? (c1 c2)
-  (colour-equals? c1 c2))
-
-
-;;TCODLIB_API TCOD_color_t TCOD_color_add (TCOD_color_t c1, TCOD_color_t c2);
-(define-c-function ("TCOD_color_add_wrapper" colour-add) colournum
-        ((c1 colournum) (c2 colournum)))
-(declaim (inline color-add))
-(defun color-add (c1 c2)
-  (colour-add c1 c2))
-
-
-(define-c-function ("TCOD_color_subtract_wrapper" colour-subtract) colournum
-        ((c1 colournum) (c2 colournum)))
-(declaim (inline color-subtract))
-(defun color-subtract (c1 c2)
-  (colour-subtract c1 c2))
-
-
-;;TCODLIB_API TCOD_color_t TCOD_color_multiply (TCOD_color_t c1,
-;; TCOD_color_t c2);
-(define-c-function ("TCOD_color_multiply_wrapper" colour-multiply) colournum
-        ((c1 colournum) (c2 colournum)))
-(declaim (inline color-multiply))
-(defun color-multiply (c1 c2)
-  (colour-multiply c1 c2))
-
-
-;;TCODLIB_API TCOD_color_t TCOD_color_multiply_scalar (TCOD_color_t c1,
-;; float value);
-(define-c-function ("TCOD_color_multiply_scalar_wrapper" colour-multiply-scalar)
-    colournum
-    ((c1 colournum) (value :float)))
-(declaim (inline color-multiply-scalar))
-(defun color-multiply-scalar (c1 value)
-  (colour-multiply-scalar c1 value))
-
-
-;; TCODLIB_API TCOD_color_t TCOD_color_lerp(TCOD_color_t c1, TCOD_color_t c2,
-;; float coef);
-(define-c-function ("TCOD_color_lerp_wrapper" colour-lerp) colournum
-        ((c1 colournum) (c2 colournum) (coef :float)))
-(declaim (inline color-lerp))
-(defun color-lerp (c1 c2 coef)
-  (colour-lerp c1 c2 coef))
-
-
-;; TCODLIB_API void TCOD_color_set_HSV(TCOD_color_t *c,float h, float s,
-;; float v);
-(define-c-function ("TCOD_color_set_HSV" colour-set-hsv) :void
-        ((con :pointer) (hue :float) (sat :float) (v :float)))
-(declaim (inline color-set-hsv))
-(defun color-set-hsv (con hue sat v)
-  (colour-set-hsv con hue sat v))
-
-
-(define-c-function ("TCOD_color_get_hue_" colour-get-hue) :float
-    ((c colournum)))
-
-(define-c-function ("TCOD_color_get_saturation_" colour-get-saturation) :float
-    ((c colournum)))
-
-(define-c-function ("TCOD_color_get_value_" colour-get-value) :float
-    ((c colournum)))
-
-
-(defun* (colour-get-hsv -> list) ((c colournum))
-  (list (colour-get-hue c)
-        (colour-get-saturation c)
-        (colour-get-value c)))
-
-
-(defun* (colour-set-hue -> colournum) ((colour colournum) (hue single-float))
-  "Return COLOUR with its hue modified to HUE."
-  (let ((sat (colour-get-saturation colour))
-        (val (colour-get-value colour)))
-    (colour-hsv hue sat val)))
-
-
-(defun* (colour-set-saturation -> colournum) ((colour colournum)
-                                              (sat single-float))
-  "Return COLOUR with its saturation modified to SAT."
-  (let ((hue (colour-get-hue colour))
-        (val (colour-get-value colour)))
-    (colour-hsv hue sat val)))
-
-
-(defun* (colour-set-value -> colournum) ((colour colournum) (val single-float))
-  "Return COLOUR with its HSV value modified to VAL."
-  (let ((sat (colour-get-saturation colour))
-        (hue (colour-get-hue colour)))
-    (colour-hsv hue sat val)))
-
-
-(defun* (colour-shift-hue -> colournum) ((colour colournum)
-                                         (hshift single-float))
-  (if (zerop hshift)
-      colour
-      (destructuring-bind (h s v) (colour-get-hsv colour)
-        (colour-hsv (+ h hshift) s v))))
-
-
-(defun* (colour-scale-hsv -> colournum) ((colour colournum) (scoef single-float)
-                                         (vcoef single-float))
-  (destructuring-bind (h s v) (colour-get-hsv colour)
-    (colour-hsv h (clamp 0.0 1.0 (* s scoef)) (clamp 0.0 1.0 (* v vcoef)))))
-
-
-(declaim (inline color-get-hsv color-get-hue color-get-saturation
-                 color-get-value
-                 color-set-hue color-set-saturation
-                 color-set-value
-                 color-shift-hue))
-
-(defun color-get-hsv (colour)
-  (colour-get-hsv colour))
-
-(defun color-get-hue (colour)
-  (colour-get-hue colour))
-
-(defun color-get-saturation (colour)
-  (colour-get-saturation colour))
-
-(defun color-get-value (colour)
-  (colour-get-value colour))
-
-(defun color-set-hue (colour hue)
-  (colour-set-hue colour hue))
-
-(defun color-set-saturation (colour sat)
-  (colour-set-saturation colour sat))
-
-(defun color-set-value (colour val)
-  (colour-set-value colour val))
-
-(defun color-shift-hue (colour hshift)
-  (colour-shift-hue colour hshift))
-
-
-
-;;;; <<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)
-  "Are the relative coordinates X,Y within the bounds of console CON?"
-  `(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);
-(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))
-
-
-;;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);
-(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))
-  (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)))
-
-
-;;TCODLIB_API void TCOD_console_set_window_title(const char *title);
-(define-c-function ("TCOD_console_set_window_title" console-set-window-title)
-    :void
-  ((title :string)))
-
-;;TCODLIB_API void TCOD_console_set_fullscreen(bool fullscreen);
-(define-c-function ("TCOD_console_set_fullscreen" console-set-fullscreen)
-    :void
-  ((full? :boolean)))
-
-;;TCODLIB_API bool TCOD_console_is_fullscreen();
-(define-c-function ("TCOD_console_is_fullscreen" console-is-fullscreen?)
-    :boolean
-    ())
-
-;;TCODLIB_API bool TCOD_console_is_window_closed();
-(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);
-(define-c-function ("TCOD_console_set_default_background_wrapper"
-          console-set-default-background) :void
-        ((con console) (col colournum)))
-(declaim (inline console-set-default-background))
-
-
-;;TCODLIB_API void TCOD_console_set_foreground_color(TCOD_console_t con,
-;;                                                   TCOD_color_t col);
-(define-c-function ("TCOD_console_set_default_foreground_wrapper"
-          console-set-default-foreground) :void
-        ((con console) (col colournum)))
-(declaim (inline console-set-default-foreground))
-
-
-;;TCODLIB_API TCOD_color_t TCOD_console_get_background_color(TCOD_console_t
-;;con);
-(define-c-function ("TCOD_console_get_default_background_wrapper"
-                    console-get-default-background) colournum
-  ((con console)))
-(declaim (inline console-get-default-background))
-
-
-;;TCODLIB_API TCOD_color_t TCOD_console_get_foreground_color(TCOD_console_t con);
-(define-c-function ("TCOD_console_get_default_foreground_wrapper"
-                    console-get-default-foreground) colournum
-  ((con console)))
-(declaim (inline console-get-default-foreground))
-
-
-;;TCODLIB_API void TCOD_console_clear(TCOD_console_t con);
-(define-c-function ("TCOD_console_clear" console-clear) :void
-        ((con console)))
-
-
-;; New in 1.5.0rc1
-;;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 TCOD_color_t TCOD_console_get_back(TCOD_console_t con,int x, int y)
-(define-c-function ("TCOD_console_get_char_background_wrapper"
-                    console-get-char-background) colournum
-  ((con console) (x :int) (y :int))
-  (assert (legal-console-coordinates? con x y))
-  (call-it))
-
-
-;;TCODLIB_API TCOD_color_t TCOD_console_get_fore(TCOD_console_t con,
-;;                                               int x, int y);
-(define-c-function ("TCOD_console_get_char_foreground_wrapper"
-                    console-get-char-foreground) colournum
-  ((con console) (x :int) (y :int))
-  (assert (legal-console-coordinates? con x y))
-  (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);
-(define-c-function ("TCOD_console_set_char_background_wrapper"
-                    console-set-char-background) :void
-    ((con console) (x :int) (y :int) (col colournum) (flag background-flag))
-  (assert (legal-console-coordinates? con x y))
-  (call-it con x y col flag))
-
-
-;;TCODLIB_API void TCOD_console_set_fore(TCOD_console_t con,int x, int y,
-;;                                       TCOD_color_t col);
-(define-c-function ("TCOD_console_set_char_foreground_wrapper"
-                    console-set-char-foreground) :void
-    ((con console) (x :int) (y :int) (col colournum))
-  (assert (legal-console-coordinates? con x y))
-  (call-it 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) (ch :unsigned-char))
-
-
-(defun* console-set-char ((con console) (x integer) (y integer) ch)
-  (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 uchar))
-                                      (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)
-            (console-set-char con x y ch)))))
-
-
-;;TCODLIB_API void TCOD_console_put_char(TCOD_console_t con,int x, int y,
-;;                                       int c, TCOD_bkgnd_flag_t flag);
-(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))
-
-
-;;TCODLIB_API void TCOD_console_print_left(TCOD_console_t con,int x, int y,
-;;                                         TCOD_bkgnd_flag_t flag,
-;;                                         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 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)))
-
-
-(define-c-function ("TCOD_console_set_background_flag"
-                    console-set-background-flag) :void
-    ((con console) (flag background-flag))
-  (call-it))
-
-
-(define-c-function ("TCOD_console_get_background_flag"
-                    console-get-background-flag) background-flag
-    ((con console))
-  (call-it))
-
-
-(define-c-function ("TCOD_console_set_alignment"
-                    console-set-alignment) :void
-    ((con console) (align alignment))
-  (call-it))
-
-
-(define-c-function ("TCOD_console_get_alignment"
-                    console-get-alignment) alignment
-    ((con console))
-  (call-it))
-
-
-(defcfun ("TCOD_console_print" %console-print) :void
-  (con console) (x :int) (y :int) (fmt :string) &rest)
-
-
-(defun* console-print ((con console) (x ucoord) (y ucoord)
-                            (fmt string) &rest args)
-  (assert (legal-console-coordinates? con x y))
-  (%console-print con x y (apply #'format nil fmt args)))
-
-
-(defcfun ("TCOD_console_print_ex" %console-print-ex) :void
-  (con console) (x :int) (y :int) (flag background-flag)
-  (align alignment) (fmt :string) &rest)
-
-
-(defun* console-print-ex ((con console) (x ucoord) (y ucoord)
-                          (flag background-flag) (align alignment)
-                            (fmt string) &rest args)
-  (assert (legal-console-coordinates? con x y))
-  (%console-print-ex con x y flag align
-                     (apply #'format nil fmt args)))
-
-
-;; 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))
-
-
-;;TCODLIB_API void TCOD_console_print_right(TCOD_console_t con,int x, int y,
-;; TCOD_bkgnd_flag_t flag, const char *fmt, ...);
-;; (defcfun ("TCOD_console_print_right" %console-print-right) :void
-;;      (con console) (x :int) (y :int) (flag background-flag) (fmt :string)
-;;      &rest)
-;;
-;; (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
-;;      (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
-;;      (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
-;;      (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)))
-
-
-(defcfun ("TCOD_console_print_rect" %console-print-rect) :int
-        (con console) (x :int) (y :int) (w :int) (h :int)
-        (fmt :string) &rest)
-
-(defun* console-print-rect ((con console) (x ucoord) (y ucoord)
-                                  (w ucoord) (h ucoord)
-                                  (fmt string) &rest args)
-  (assert (legal-console-coordinates? con x y))
-  (%console-print-rect con x y w h (apply #'format nil fmt args)))
-
-
-(defcfun ("TCOD_console_print_rect_ex" %console-print-rect-ex) :int
-        (con console) (x :int) (y :int) (w :int) (h :int)
-        (flag background-flag) (align alignment) (fmt :string) &rest)
-
-(defun* console-print-rect-ex ((con console) (x ucoord) (y ucoord)
-                               (w ucoord) (h ucoord)
-                               (flag background-flag) (align alignment)
-                               (fmt string) &rest args)
-  (assert (legal-console-coordinates? con x y))
-  (%console-print-rect-ex con x y w h flag align
-                          (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);
-(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))
-
-
-
-(defcfun ("TCOD_console_get_height_rect" %console-get-height-rect) :int
-        (con console) (x :int) (y :int) (w :int) (h :int) (fmt :string)
-        &rest)
-
-(defun* console-get-height-rect ((con console) (x ucoord) (y ucoord)
-                                 (w ucoord) (h ucoord) (fmt string) &rest args)
-  (assert (legal-console-coordinates? con x y))
-  (%console-get-height-rect con x y w h (apply #'format nil fmt args)))
-
-
-(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))
-
-
-(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))
-
-(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)
-
-(defun* console-print-frame ((con console) (x ucoord) (y ucoord)
-                             (width ucoord) (height ucoord)
-                             (empty? boolean) (flag background-flag)
-                             (fmt (or string null)) &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
-                        (if fmt (apply #'format nil fmt args)
-                            +NULL+)))
-
-
-;; Added in wrappers.c
-(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)
-
-(defun* console-print-double-frame ((con console) (x ucoord) (y ucoord)
-                                    (width ucoord) (height ucoord)
-                                    (empty? boolean) (flag background-flag)
-                                    (fmt (or string null)) &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
-                               (if fmt (apply #'format nil fmt args)
-                                   +NULL+)))
-
-
-
-;;TCODLIB_API int TCOD_console_get_char(TCOD_console_t con,int x, int y);
-(define-c-function ("TCOD_console_get_char" console-get-char) :int
-  ((con console) (x :int) (y :int))
-  (assert (legal-console-coordinates? con x y))
-  (call-it))
-
-
-;;TCODLIB_API void TCOD_console_set_fade(uint8 val, TCOD_color_t fade);
-(define-c-function ("TCOD_console_set_fade_wrapper" console-set-fade) :void
-  ((val :uint8) (fade colournum)))
-
-;;TCODLIB_API uint8 TCOD_console_get_fade();
-(define-c-function ("TCOD_console_get_fade" console-get-fade) :uint8
-    ())
-
-
-;;TCODLIB_API TCOD_color_t TCOD_console_get_fading_color();
-(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();
-(define-c-function ("TCOD_console_flush" console-flush) :void
-    ())
-
-
-;;TCODLIB_API void TCOD_console_set_color_control(TCOD_colctrl_t con,
-;;     TCOD_color_t fore, TCOD_color_t back);
-;; This is to do with "colour control" strings
-(define-c-function ("TCOD_console_set_color_control_wrapper"
-          console-set-colour-control) :void
-  ((control-num colctrl) (fore colournum) (back colournum)))
-
-(declaim (inline console-set-color-control))
-(defun console-set-color-control (control-num fore back)
-  (console-set-colour-control control-num fore back))
-
-
-
-;;TCODLIB_API TCOD_console_t TCOD_console_new(int w, int h);
-(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))
-
-
-;;TCODLIB_API int TCOD_console_get_width(TCOD_console_t con);
-(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);
-(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);
-(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 ucoord)
-  (check-type ysrc ucoord)
-  (check-type wsrc ucoord)
-  (check-type hsrc ucoord)
-  (check-type xdest ucoord)
-  (check-type ydest ucoord)
-  (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.
-  (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.
-    ;; In libtcod 1.5.1, the whole console is blitted if wsrc and hsrc are 0
-    (assert (and (or (and (zerop wsrc) (zerop hsrc))
-                     (and (plusp wsrc) (plusp hsrc)))
-                 (>= (+ xdest wsrc) 0) (>= (+ ydest hsrc) 0)))
-    (call-it src xsrc ysrc wsrc hsrc dest xdest ydest
-             foreground-alpha background-alpha)))
-
-
-
-;;TCODLIB_API void TCOD_console_delete(TCOD_console_t console);
-(define-c-function ("TCOD_console_delete" console-delete) :void
-    ((con console)))
-
-
-#+nil
-(define-c-function ("TCOD_console_set_key_color_wrapper" console-set-key-colour)
-    :void
-    ((con console) (colour colournum)))
-
-
-;;;; <<Unicode>> ==============================================================
-
-
-
-(define-c-function ("TCOD_console_map_string_to_font_utf"
-                    %console-map-string-to-font-utf) :void
-    ((str :string) (fontchar-x :int) (fontchar-y :int)))
-
-
-(defun* console-map-string-to-font-utf ((str string) (fontchar-x uint)
-                                        (fontchar-y uint))
-  (with-foreign-pointer-as-string (strbuf (length str))
-    (%console-map-string-to-font-utf
-     (lisp-string-to-foreign str strbuf (length str)
-                             :encoding :utf-16)
-     fontchar-x fontchar-y)))
-
-
-(defcfun ("TCOD_console_print_utf" %console-print-utf) :void
-  (con console) (x :int) (y :int) (fmt :string) &rest)
-
-(defun* console-print-utf ((con console) (x ucoord) (y ucoord)
-                           (fmt string) &rest args)
-  (let ((str (apply #'format nil fmt args)))
-    (with-foreign-pointer-as-string (strbuf (length str))
-      (%console-print-utf con x y
-                          (lisp-string-to-foreign str strbuf (length str)
-                                                  :encoding :utf-16)))))
-
-
-(defcfun ("TCOD_console_print_ex_utf" %console-print-ex-utf) :void
-  (con console) (x :int) (y :int) (flag background-flag) (align alignment)
-  (fmt :string) &rest)
-
-
-(defun* console-print-ex-utf ((con console) (x ucoord) (y ucoord)
-                              (flag background-flag) (align alignment)
-                              (fmt string) &rest args)
-  (let ((str (apply #'format nil fmt args)))
-    (with-foreign-pointer-as-string (strbuf (length str))
-      (%console-print-ex-utf con x y flag align
-                             (lisp-string-to-foreign str strbuf (length str)
-                                                     :encoding :utf-16)))))
-