Add basic game loop with movement

NOTES.org

@@ -3,4 +3,21 @@ http://foo.wyrd.name/en:bearlibterminal:reference
 http://www.utf8-chartable.de/unicode-utf8-table.pl?utf8=0x
 
 * Tasks
-** TODO Get bearlibterminal autowrapped and basic window working.
+** DONE Get bearlibterminal autowrapped and basic window working.
+CLOSED: [2016-01-01 Fri 22:52]
+** High Priority
+*** TODO Create player character
+**** Health (no regeneration)
+**** Mana (regenerates per turn)
+**** Ranged attack (takes mana)
+**** Melee attack (weak, no mana cost)
+**** Ability to summon special corpses as undead
+*** TODO Create static map
+*** TODO Create Undead ally characters
+*** TODO Create enemy characters (human knights?) with basic UI
+*** TODO Figure out an interesting way to integrate "Darkness"
+*** TODO Figure out how to get messages in exact center.
+** Medium priority
+*** TODO Create map -> graphics layer so that isn't manual. (consider generalizing this)
+*** TODO Create generalized input command dispatch. (consider generalizing this)
+*** TODO Create configuration system that can control display and keybindings.

crypts-and-corpses.lisp

@@ -2,5 +2,99 @@
 
 (in-package #:crypts-and-corpses)
 
-;;; "crypts-and-corpses" goes here. Hacks and glory await!
+(defclass tile-entity ()
+  ((codepoint :initarg :codepoint :initform #x3f)
+   (location :initarg :location :initform 0)))
 
+(defclass mobile (tile-entity)
+  ((health :initarg :health)
+   (mana :initarg :mana)))
+
+(defclass player-character (mobile) ())
+
+(defclass enemy (mobile) ())
+
+(defclass minion (mobile) ())
+
+(defun calc-location (x y)
+  (+ (* 100 (cdr y)) (car x)))
+
+(defgeneric set-location (object x y))
+(defmethod set-location ((object tile-entity) x y)
+  (setf (slot-value object 'location) (calc-location x y)))
+
+(defgeneric move-left (object map))
+(defgeneric move-right (object map))
+(defgeneric move-up (object map))
+(defgeneric move-down (object map))
+
+(defun update-location (object map old-location new-location)
+  (setf (slot-value object 'location) new-location)
+  (setf (gethash new-location map) object)
+  (remhash old-location map))
+
+(defmethod move-left ((object mobile) map)
+  (let ((old-location (slot-value object 'location))
+        (new-location (1- (slot-value object 'location))))
+    (update-location object map old-location new-location)))
+
+(defmethod move-up ((object mobile) map)
+  (let ((old-location (slot-value object 'location))
+        (new-location (- (slot-value object 'location) 100)))
+    (update-location object map old-location new-location)))
+
+(defmethod move-down ((object mobile) map)
+  (let ((old-location (slot-value object 'location))
+        (new-location (+ (slot-value object 'location) 100)))
+    (update-location object map old-location new-location)))
+
+(defmethod move-right ((object mobile) map)
+  (let ((old-location (slot-value object 'location))
+        (new-location (1+ (slot-value object 'location))))
+    (update-location object map old-location new-location)))
+
+(defun intro-message ()
+  (loop as key = (terminal-read) do
+    (terminal-print 40 21  "Crypts and Corpses")
+    (terminal-print 39 22 "Press enter to start")
+    (terminal-refresh)
+        until (= key bearlibterminal-ffi:+tk-enter+)))
+
+(defun write-cell (key tile)
+  (terminal-put (mod key 100) (floor (/ key 100)) (slot-value tile 'codepoint)))
+
+(defun write-map-to-terminal (map)
+  (maphash #'write-cell map))
+
+(defun initialize-map (map player)
+  (setf (gethash (slot-value player 'location) map) player)
+  map)
+
+(defun handle-input (key map player)
+  (cond
+    ((= key bearlibterminal-ffi:+tk-up+) (move-up player map))
+    ((= key bearlibterminal-ffi:+tk-down+) (move-down player map))
+    ((= key bearlibterminal-ffi:+tk-right+) (move-right player map))
+    ((= key bearlibterminal-ffi:+tk-left+) (move-left player map))))
+
+(defun main-loop ()
+  (let ((player (make-instance
+                 'player-character
+                 :codepoint #x263a
+                 :location 0)))
+    (loop with map = (initialize-map (make-hash-table) player)
+          as key = (terminal-read) do
+            (handle-input key map player)
+            (terminal-clear)
+            (write-map-to-terminal map)
+            (terminal-refresh)
+          until (or (= key bearlibterminal-ffi:+tk-close+)
+                    (= key bearlibterminal-ffi:+tk-escape+)))))
+
+(defun start ()
+  (terminal-open)
+  (terminal-set "window: size=100x50, title='Crypts and Corpses'")
+  (terminal-set "font: ./fonts/DejaVuSansMono.ttf, size=12")
+  (intro-message)
+  (main-loop)
+  (terminal-close))