1. Paul Sexton
  2. cl-tcod


Paul Sexton  committed b3c48ac

The functions 'console-put-char' and 'console-put-char-ex' now accept
an integer argument for the character, allowing use of large font sets and
tiles. (Thanks to acherontus on the libtcod forums).

New function: console-initialised? Returns true if console-init-root has been
called at least once.

If the function 'colour' is passed an unknown colour name, it will now
return grey by default, unless an optional second argument 'error?' is true.

  • Participants
  • Parent commits 647ac84
  • Branches default

Comments (0)

Files changed (2)

File README.md

View file
 ### 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

File tcod.lisp

View file
    ;; [[Console]] ==========================================================
+   #:console-initialised?
 avoid crashes which occur in some CL implementations when you load
 an already-loaded foreign library.")
+(defvar *root-console-initialised?* nil
+  "Set to T once `console-init-root' has been called.")
 (eval-when (:load-toplevel :execute)
 	(unless *libtcod-loaded*
 		(use-foreign-library libtcod)
 (defun color->grayscale (col) (colour->grayscale col))
-(defun* (colour -> colournum) ((keywd (or colournum symbol)))
+(defun* (colour -> colournum) ((keywd (or colournum symbol))
+                               &optional (error? nil))
   "Given a colour keyword such as :GREY, return its corresponding RGB
-value (#xRRGGBB)."
+value (#xRRGGBB). If the keyword is unrecognised, then either return
+a light grey colour, or raise an error (if `error?' is non-nil)."
     ((integerp keywd)
      (unless *colour-table*
-     (gethash keywd *colour-table*))))
+     (or (gethash keywd *colour-table*)
+         (if error? (error "Unrecognised colour name `~S'" keywd))
+         #xD3D3D3))))
 (declaim (inline color))
 (defun color (keywd) (colour keywd))
   (check-type height ucoord)
   (setf (gethash *root* *console-width-table*) width)
   (setf (gethash *root* *console-height-table*) height)
-  (%console-init-root width height title fullscreen? renderer))
+  (%console-init-root width height title fullscreen? renderer)
+  (setf *root-console-initialised?* t)
+  *root*)
+(defun* (console-initialised? -> boolean) ()
+  *root-console-initialised?*)
 ;;TCODLIB_API void TCOD_console_set_custom_font(const char *fontFile, int
 ;;                        char_width, int char_height, int nb_char_horiz, int
 ;;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)
+    ((con console) (x :int) (y :int) (ch :unsigned-int)
      (flag background-flag))
   (assert (legal-console-coordinates? con x y))
 (define-c-function ("TCOD_console_put_char_ex_wrapper" console-put-char-ex)
-    ((con console) (x :int) (y :int) (ch :unsigned-char) (fg colournum)
+    ((con console) (x :int) (y :int) (ch :unsigned-int) (fg colournum)
      (bg colournum))
   (assert (legal-console-coordinates? con x y))
 (defcfun ("TCOD_noise_new" %noise-new) noise
   (dimensions :int) (hurst :float) (lacunarity :float) (randomptr :pointer))
-(defun* (noise-new -> noise) ((dimensions uint8)
+(defun* (noise-new -> noise) ((dimensions (integer 1 4))
                               &key ((hurst float) +NOISE-DEFAULT-HURST+)
                               ((lacunarity float) +NOISE-DEFAULT-LACUNARITY+)
                               ((rng randomptr) +NULL+))