diff --git a/forest/README b/forest/README
index 86aa463..b154825 100644
--- a/forest/README
+++ b/forest/README
@@ -1,5 +1,11 @@
 Welcome to Sanctuary, a Novella Rogue-like in Common Lisp.
 
+This is the help screen. Press F2 to if you wish to return to playing
+the game. Press N and P (for "next" and "previous", respectively) to
+scroll through the document.
+
+STORY
+
 You are an archer and initiate monk of the Sanctuary Order. Humanity
 and the four continents of the Known World have fallen into a dark
 age, where undead horrors from the deeps of the earth have scoured the
@@ -18,9 +24,25 @@ wilderness toward your destination, Valisade Monastery. You've been
 summoned to Valisade for unknown reasons, and commanded to make haste
 through the mountains instead of the safer route to the southwest.
 
+GAMEPLAY
+
+Your monk and his surroundings are viewed from a top-down perspective,
+with North at the top of the screen. You can move in any of the eight
+directions (north, northeast, east, southeast, south, southwest, west,
+and northwest) by pressing the corresponding key in one of the two
+options below:				    
+					     
+  Q  W  E        7  8  9       	       	       North
+   \ | /   	  \ | /	      	      		 |     
+  A -+- D   or 	 4 -+- 6      with     	  West  -+-  East     
+   / | \       	  / | \	       	       	       	 |     
+  Z  X 	C      	 1  2  3	  	       South   			   
+      				  					   
+There are four inventory slots, activated by pressing 1, 2, 3, or 4.
+One may equip items such as a bow and arrows, or consume healing herbs
+and such, by pressing the corresponding digit for the item's inventory
+slot. Firing the bow is permitted only straight up, down, left, or
+right, and the arrows take time to travel. Firing the bow is
+accomplished with SHIFT-direction.
 
 
-
-
-	    
-
diff --git a/forest/base.lisp b/forest/base.lisp
new file mode 100644
index 0000000..ac93747
--- /dev/null
+++ b/forest/base.lisp
@@ -0,0 +1,119 @@
+(in-package :forest)
+
+;;; Status widget
+
+(defvar *status* nil)
+
+;;; Turn on timing after SDL init
+
+(add-hook 'xe2:*initialization-hook*
+	  #'(lambda ()
+	      (xe2:enable-timer)
+	      (xe2:set-frame-rate 15)
+	      (xe2:set-timer-interval 0)
+	      (xe2:enable-held-keys 1 3)))
+
+;;; The World addresses of the levels in the game.
+
+(defun generate-level-address (n)
+  (ecase n 
+    (1 (list '=forest= 
+	     :description 
+"You are outside of Nothbess town, heading south toward the
+Monastery. It is cold and rainy."
+	     :level n
+	     :sequence-number (xe2:genseq) 
+	     :height *forest-height*
+	     :width *forest-width*
+	     :fireflies 200
+	     :graveyards 2
+	     :ruins 3
+	     :raining t
+	     :tree-grain 0.5
+	     :tree-density 30
+	     :water-grain 0.2
+	     :water-density 0
+	     :water-cutoff 0.2))
+    (2 (list '=forest= 
+	     :level n
+	     :description 
+"The river has swelled beyond its banks with meltwaters, and flooded
+an old hamlet whose name is forgotten. 
+It has begun to snow."
+	     :sequence-number (xe2:genseq) 
+	     :height *forest-height*
+	     :width *forest-width*
+	     :fireflies 100
+	     :graveyards 4
+	     :ruins 10
+	     :snowing t
+	     :tree-grain 0.2
+	     :tree-density 30
+	     :water-grain 0.2
+	     :water-density 90
+	     :water-cutoff 0.2))
+    (3 (list '=passage=))
+    (4 (list '=monastery=))))
+    
+;;; Text overlay balloons
+
+(defcell balloon 
+  (categories :initform '(:drawn :actor :balloon))
+  text timeout following
+  (stroke-color :initform ".white")
+  (background-color :initform ".gray40"))
+
+(define-method initialize balloon (&key text (stroke-color ".white") (background-color ".blue")
+					(style :balloon) (timeout nil) following)
+  (setf <text> text)
+  (setf <stroke-color> stroke-color)
+  (setf <following> following)
+  (setf <background-color> background-color)
+  (setf <style> style)
+  (setf <timeout> (if (floatp timeout)
+		      ;; specify in (roughly) seconds if floating
+		      (truncate (* 15 timeout))
+		      ;; leave as frames if integer
+		      timeout)))
+  
+(define-method follow balloon (cell)
+  (setf <following> cell))
+
+(define-method draw balloon (x y image)
+  (clon:with-field-values (text style) self
+    (let* ((offset (ecase style
+		     (:balloon 16)
+		     (:flat 0)))
+	   (x0 (+ x offset))
+	   (y0 (+ y offset))
+	   (x1 nil)
+	   (y1 nil)
+	   (margin 4)
+	   (height (+ (* 2 margin) (apply #'+ (mapcar #'formatted-line-height text))))
+	   (width (+ (* 2 margin) (apply #'max (mapcar #'formatted-line-width text)))))
+      (setf x0 (min x0 (- *room-window-width* width)))
+      (setf y0 (min y0 (- *room-window-height* height)))
+      (setf x1 (+ x0 offset))
+      (setf y1 (+ y0 offset))
+      (draw-box x1 y1 width height 
+		:stroke-color <stroke-color>
+		:color <background-color>
+		:destination image)
+      (when (eq style :balloon)
+	(draw-line x0 y0 x1 y1 :destination image))
+      (let ((x2 (+ margin x1))
+	    (y2 (+ margin y1)))
+	(dolist (line text)
+	  (render-formatted-line line x2 y2 :destination image)
+	  (incf y2 (formatted-line-height line)))))))
+
+(define-method run balloon ()
+  [expend-default-action-points self]
+  (when <following>
+    (multiple-value-bind (r c) [grid-coordinates <following>]
+      ;; follow emoter
+      [move-to self r c]))
+  (when (integerp <timeout>)
+    (when (minusp (decf <timeout>))
+      [die self])))
+
diff --git a/forest/enemy.lisp b/forest/enemy.lisp
new file mode 100644
index 0000000..43e4794
--- /dev/null
+++ b/forest/enemy.lisp
@@ -0,0 +1,178 @@
+(in-package :forest)
+
+;;; Skeletons haunt the woods, coming from gravestones
+
+(defcell gravestone 
+  (tile :initform "gravestone")
+  (description :initform "The epitaph is no longer legible.")
+  (contains-body :initform (percent-of-time 25 t))
+  (categories :initform '(:obstacle :actor))
+  (generated :initform nil))
+
+(define-method run gravestone ()
+  (when (and <contains-body>
+	     (< [distance-to-player self] 10)
+	     [line-of-sight *world* <row> <column> 
+			    [player-row *world*]
+			    [player-column *world*]])
+    (percent-of-time 40
+      (when (not <generated>)
+	(setf <generated> t)
+	(let ((skeleton (clone =skeleton=)))
+	  [drop self skeleton]
+	  [loadout skeleton])))))
+	  
+(defcell dagger 
+  (name :initform "dagger")
+  (categories :initform '(:item :weapon :equipment))
+  (tile :initform "dagger")
+  (attack-power :initform (make-stat :base 15))
+  (attack-cost :initform (make-stat :base 6))
+  (accuracy :initform (make-stat :base 90))
+  (stepping :initform t)
+  (weight :initform 3000)
+  (equip-for :initform '(:left-hand :right-hand)))
+
+(defcell skeleton 
+  (name :initform "Skeleton")
+  (description :initform "A foul spirit animates this dagger-wielding skeleton.")
+  (strength :initform (make-stat :base 20 :min 0 :max 50))
+  (dexterity :initform (make-stat :base 20 :min 0 :max 30))
+  (intelligence :initform (make-stat :base 13 :min 0 :max 30))
+  (categories :initform '(:actor :target :obstacle :opaque :enemy :equipper))
+  (equipment-slots :initform '(:left-hand))
+  (max-items :initform (make-stat :base 3))
+  (stepping :initform t)
+  (speed :initform (make-stat :base 1))
+  (movement-cost :initform (make-stat :base 5))
+  (attacking-with :initform :left-hand)
+  (equipment-slots :initform '(:left-hand :right-hand :belt :extension :feet))
+  (max-weight :initform (make-stat :base 25))
+  (max-items :initform (make-stat :base 20))
+  (hit-points :initform (make-stat :base 5 :min 0 :max 5))
+  (tile :initform "skeleton"))
+
+(define-method loadout skeleton ()
+  [make-inventory self]
+  [make-equipment self]
+  (let ((dagger (clone =dagger=)))
+    [equip self [add-item self dagger]]))
+
+(define-method run skeleton ()
+  (clon:with-field-values (row column) self
+    (let* ((world *world*)
+	   (direction [direction-to-player *world* row column]))
+      (when (< [distance-to-player self] 8)
+	(percent-of-time 40 [play-sample self "grak"]))
+      (if [adjacent-to-player world row column]
+	  (progn [say self "The skeleton stabs at you with its dagger."]
+		 [play-sample self "groar"]
+		 [expend-action-points self 10]
+		 (percent-of-time 80
+		   [say self "You are hit!"]
+		   [damage [get-player *world*] 7]))
+	  (progn	
+	    [expend-action-points self 10]
+	    (if [obstacle-in-direction-p world row column direction]
+		(let ((target [target-in-direction-p world row column direction]))
+		  (if (and target (not [in-category target :enemy]))
+		      [move self (random-direction)]
+		      (progn (setf <direction> (random-direction))
+			     [>>move self direction])))
+		(progn (when (< 7 (random 10))
+			 (setf <direction> (random-direction)))
+		       [>>move self direction])))))))
+
+(define-method die skeleton ()
+  [play-sample self "dead"]
+  [parent>>die self])
+	   
+;;; Wolves are the most difficult enemies. 
+
+(defcell wolf 
+  (categories :initform '(:actor :target :obstacle :opaque :enemy))
+  (dexterity :initform (make-stat :base 20))
+  (max-items :initform (make-stat :base 1))
+  (speed :initform (make-stat :base 2))
+  (chase-distance :initform 14)
+  (stepping :initform t)
+  (behavior :initform :seeking)
+  (clock :initform 0)
+  (last-direction :initform :north)
+  (strength :initform (make-stat :base 50))
+  (movement-cost :initform (make-stat :base 10))
+  (tile :initform "wolf")
+  (target :initform nil)
+  (hit-points :initform (make-stat :base 6 :min 0 :max 40))
+  (description :initform 
+"These undead wolves will devour your flesh if they get the chance."))
+
+(define-method run wolf ()
+  (ecase <behavior>
+    (:seeking [seek self])
+    (:fleeing [flee self])))
+
+(define-method seek wolf ()
+  (clon:with-field-values (row column) self
+    (when (< [distance-to-player *world* row column] <chase-distance>)
+      (let ((direction [direction-to-player *world* row column])
+	    (world *world*))
+	(percent-of-time 5 [play-sample self (car (one-of '("growl-1" "growl-2")))])
+	(if [adjacent-to-player world row column]
+	    (progn
+	      (percent-of-time 80 
+		[say self "The undead wolf bites you."]
+		[damage [get-player *world*] 4])
+	      (setf <clock> 6
+		    <behavior> :fleeing))
+	    (if [obstacle-in-direction-p world row column direction]
+		(let ((target [target-in-direction-p world row column direction]))
+		  (if (and target (not [in-category target :enemy]))
+		      (progn nil)
+		      (progn (setf <direction> (random-direction))
+			     [>>move self direction])))
+		(progn (when (< 7 (random 10))
+			 (setf <direction> (random-direction)))
+		       [>>move self direction])))))))
+
+(define-method damage wolf (points)
+  [play-sample self "bark"]
+  [parent>>damage self points])
+
+(define-method die wolf ()
+  [play-sample self "yelp"]
+  [parent>>die self])
+
+(define-method flee wolf ()
+  (decf <clock>)
+  ;; are we done fleeing? then begin seeking. 
+  (if (<= <clock> 0)
+      (setf <behavior> :seeking)
+      ;; otherwise, flee
+      (clon:with-field-values (row column) self
+	(let ((player-row [player-row *world*])
+	      (player-column [player-column *world*]))
+	  (labels ((neighbor (r c direction)
+		     (multiple-value-bind (r0 c0)
+			 (step-in-direction r c direction)
+		       (list r0 c0)))
+		   (all-neighbors (r c)
+		     (let (ns)
+		       (dolist (dir *compass-directions*)
+			 (push (neighbor r c dir) ns))
+		       ns))
+		   (score (r c)
+		     (distance player-column player-row c r)))
+	    (let* ((neighbors (all-neighbors row column))
+		   (scores (mapcar #'(lambda (pair)
+				       (apply #'score pair))
+				   neighbors))
+		   (farthest (apply #'max scores))
+		   (square (nth (position farthest scores)
+				neighbors)))
+	      (destructuring-bind (r c) square
+		  [move self (xe2:direction-to row column r c)])))))))
+
+(define-method move wolf (direction)
+  (setf <last-direction> direction)
+  [parent>>move self direction])
diff --git a/forest/forest.fasl b/forest/forest.fasl
index 56030c0..5358a8d 100644
Binary files a/forest/forest.fasl and b/forest/forest.fasl differ
diff --git a/forest/forest.lisp b/forest/forest.lisp
index 4aee464..b169844 100644
--- a/forest/forest.lisp
+++ b/forest/forest.lisp
@@ -1,162 +1,5 @@
-;;; forest.lisp --- forest exploration story
-
-;; Copyright (C) 2009  David O'Toole
-
-;; Author: David O'Toole <dto@gnu.org>
-;; Keywords: games
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-;; You should have received a copy of the GNU General Public License
-;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary 
-
-;; See also http://dto.github.com/notebook/developers-guide.html
-
-;;; Packaging
-
-(defpackage :forest
-  (:documentation "Forest xe2 game.")
-  (:use :xe2 :common-lisp)
-  (:export forest))
-
 (in-package :forest)
 
-(defvar *status* nil)
-
-;;; Turn on timing after SDL init
-
-(add-hook 'xe2:*initialization-hook*
-	  #'(lambda ()
-	      (xe2:enable-timer)
-	      (xe2:set-frame-rate 15)
-	      (xe2:set-timer-interval 0)
-	      (xe2:enable-held-keys 1 3)))
-
-;;; A map of the journey
-
-(defcell sanctuary-map 
-  (name :initform "Map")
-  (tile :initform "tiny-map")
-  (description :initform "This map was given to you by Wythorn before you left town.")
-  (categories :initform '(:item)))
-
-(define-method use sanctuary-map (user)
-  (prog1 nil
-    [emote user '(((nil :image "sanctuary-map"))) :background-color ".white"]))
-	 
-(define-method step sanctuary-map (stepper)
-  (when [is-player stepper]
-    [say self "You don't need this map; you've memorized the way."]))
-
-;;; The World addresses of the levels in the game.
-
-(defun generate-level-address (n)
-  (ecase n 
-    (1 (list '=forest= 
-	     :description 
-"You are outside of Nothbess town, heading south toward the
-Monastery. It is cold and rainy."
-	     :level n
-	     :sequence-number (xe2:genseq) 
-	     :height *forest-height*
-	     :width *forest-width*
-	     :fireflies 200
-	     :graveyards 2
-	     :ruins 3
-	     :raining t
-	     :tree-grain 0.5
-	     :tree-density 30
-	     :water-grain 0.2
-	     :water-density 0
-	     :water-cutoff 0.2))
-    (2 (list '=forest= 
-	     :level n
-	     :description 
-"The river has swelled beyond its banks with meltwaters, and flooded
-an old hamlet whose name is forgotten. 
-It has begun to snow."
-	     :sequence-number (xe2:genseq) 
-	     :height *forest-height*
-	     :width *forest-width*
-	     :fireflies 100
-	     :graveyards 4
-	     :ruins 10
-	     :snowing t
-	     :tree-grain 0.2
-	     :tree-density 30
-	     :water-grain 0.2
-	     :water-density 90
-	     :water-cutoff 0.2))
-    (3 (list '=passage=))
-    (4 (list '=monastery=))))
-    
-;;; Text overlay balloons
-
-(defcell balloon 
-  (categories :initform '(:drawn :actor :balloon))
-  text timeout following
-  (stroke-color :initform ".white")
-  (background-color :initform ".gray40"))
-
-(define-method initialize balloon (&key text (stroke-color ".white") (background-color ".blue")
-					(style :balloon) (timeout nil) following)
-  (setf <text> text)
-  (setf <stroke-color> stroke-color)
-  (setf <following> following)
-  (setf <background-color> background-color)
-  (setf <style> style)
-  (setf <timeout> (if (floatp timeout)
-		      ;; specify in (roughly) seconds if floating
-		      (truncate (* 15 timeout))
-		      ;; leave as frames if integer
-		      timeout)))
-  
-(define-method follow balloon (cell)
-  (setf <following> cell))
-
-(define-method draw balloon (x y image)
-  (clon:with-field-values (text style) self
-    (let* ((offset (ecase style
-		     (:balloon 16)
-		     (:flat 0)))
-	   (x0 (+ x offset))
-	   (y0 (+ y offset))
-	   (x1 (+ x0 offset))
-	   (y1 (+ y0 offset))
-	   (margin 4)
-	   (height (+ (* 2 margin) (apply #'+ (mapcar #'formatted-line-height text))))
-	   (width (+ (* 2 margin) (apply #'max (mapcar #'formatted-line-width text)))))
-      (draw-box x1 y1 width height 
-		:stroke-color <stroke-color>
-		:color <background-color>
-		:destination image)
-      (when (eq style :balloon)
-	(draw-line x0 y0 x1 y1 :destination image))
-      (let ((x2 (+ margin x1))
-	    (y2 (+ margin y1)))
-	(dolist (line text)
-	  (render-formatted-line line x2 y2 :destination image)
-	  (incf y2 (formatted-line-height line)))))))
-
-(define-method run balloon ()
-  [expend-default-action-points self]
-  (when <following>
-    (multiple-value-bind (r c) [grid-coordinates <following>]
-      ;; follow emoter
-      [move-to self r c]))
-  (when (integerp <timeout>)
-    (when (minusp (decf <timeout>))
-      [die self])))
-
 ;;; Water
 
 (defcell foam 
@@ -298,49 +141,6 @@ It has begun to snow."
 				  (setf <clock> *earth-rain-clock*))
 			   (decf <clock>)))
 		     "floor"))))
-
-;;; Icy tundra
-
-(defparameter *tundra-tiles* '("tundra-1" 
-			      "tundra-2"
-			      "tundra-3"
-			      "tundra-4"
-			      "tundra-5"
-			      "tundra-6"
-			      "floor"))
-
-(defparameter *tundra-light-radius* 14)
-
-
-(defcell tundra 
-  (tile :initform "floor")
-  (description :initform "This frozen surface is treacherous.")
-  (categories :initform '(:actor :reflective)))
-
-(define-method blow tundra (dark)
-  (let ((snow [category-at-p *world* <row> <column> :snow]))
-    (when snow
-      [update-tile snow dark])
-    (if (minusp <snow-clock>)
-	(progn (setf <snow-clock> *snow-clock*)
-	       (if (null snow)
-		   (percent-of-time 3
-		     (setf snow (clone =snow=))
-		     [drop self snow])
-		   (percent-of-time 10 
-		     [collect snow 1 dark])))
-	(decf <snow-clock>))))
-    
-(define-method run tundra ()
-  (let* ((dist [distance-to-player self]))
-    (setf <tile> (if (< dist *tundra-light-radius*)
-		     (nth (truncate (/ dist 2)) *tundra-tiles*)
-		     "floor"))))
-
-(defcell mountain 
-  (tile :initform "mountain")
-  (description :initform "The walls of the passageway are slick with ice.")
-  (categories :initform '(:obstacle :opaque)))
     
 ;;; The stone wall
 
@@ -357,201 +157,6 @@ It has begun to snow."
   (description :initform "I wonder whose house this was.")
   (tile :initform "ruin-floor"))
 
-;;; The player
-	     
-(defparameter *arrow-tiles* '(:north "arrow-north"
-			      :south "arrow-south"
-			      :east "arrow-east"
-			      :west "arrow-west"))
-
-(defcell arrow 
-  (name :initform "arrow")
-  (speed :initform (make-stat :base 25))
-  (categories :initform '(:actor))
-  (clock :initform 8)
-  (direction :initform nil))
-
-(define-method impel arrow (direction)
-  (assert (member direction '(:north :south :east :west)))
-  (setf <direction> direction))
-
-(define-method run arrow ()
-  [expend-default-action-points self]
-  (if (and <direction> (not (eq <direction> :here)))
-      (progn (setf <tile> (getf *arrow-tiles* <direction>))
-	     (let ((target [category-in-direction-p *world* <row> <column> <direction> :target]))
-	       (when target 
-		 [damage target 3]
-		 [die self])
-	       (if [obstacle-in-direction-p *world* <row> <column> <direction>]
-		   [die self]
-		   [move self <direction>]))
-	     (setf <clock> (max 0 (decf <clock>)))
-	     (when (zerop <clock>)
-	       [die self])
-	     (when [obstacle-in-direction-p *world* <row> <column> <direction>]
-	       (setf <clock> 0)))
-      [die self]))
-
-(define-method step arrow (stepper)
-  (when [is-player stepper]
-    (assert [is-located self])
-    [say self "This arrow is still good. You add it to your quiver."]
-    [stat-effect stepper :arrows 1]
-    [die self]))
-
-(defcell wooden-bow 
-  (name :initform "Wooden bow")
-  (categories :initform '(:item :weapon :equipment))
-  (tile :initform "wooden-bow")
-  (attack-power :initform (make-stat :base 5))
-  (attack-cost :initform (make-stat :base 6))
-  (accuracy :initform (make-stat :base 90))
-  (weight :initform 3000)
-  (equip-for :initform '(:left-hand)))
-
-(define-method fire wooden-bow (direction)
-  (if (plusp [stat-value <equipper> :arrows])
-      (let ((arrow (clone =arrow=)))
-	[stat-effect <equipper> :arrows -1]
-	[drop <equipper> arrow]
-	[impel arrow direction]
-	[play-sample <equipper> "bow"])
-      [say self "You are out of arrows!" :foreground ".red"]))
-
-(defparameter *hunger-warn* 700)
-
-(defparameter *hunger-warn-2* 850)
-
-(defparameter *hunger-max* 1000)
-
-(defcell player 
-  (tile :initform "player")
-  (description :initform "You are an archer and initiate monk of the Sanctuary Order.")
-  (name :initform "Monk")
-  (dead :initform nil)
-  (hit-points :initform (make-stat :base 30 :min 0 :max 30))
-  (hunger :initform (make-stat :base 0 :min 0 :max 1000))
-  (hunger-damage-clock :initform 0)
-  (hearing-range :initform 1000)
-  (firing-with :initform :left-hand)
-  (arrows :initform (make-stat :base 20 :min 0 :max 40))
-  (rations :initform (make-stat :base 5 :min 0 :max 20))
-  (speed :initform (make-stat :base 10 :min 0 :max 10))
-  (strength :initform (make-stat :base 15 :min 0 :max 50))
-  (defense :initform (make-stat :base 15 :min 0 :max 50))
-  (dexterity :initform (make-stat :base 15 :min 0 :max 30))
-  (intelligence :initform (make-stat :base 13 :min 0 :max 30))
-  (equipment-slots :initform '(:right-hand :left-hand))
-  (max-items :initform (make-stat :base 20))
-  (movement-cost :initform (make-stat :base 10))
-  (stepping :initform t)
-  (categories :initform '(:actor :player :obstacle :target)))
-
-(define-method eat player ()
-  (if (zerop [stat-value self :rations])
-      [say self "You don't have any rations to eat."]
-      (progn 
-	[say self "You eat a bread ration. You feel full."]
-	[stat-effect self :hunger -900]
-	[stat-effect self :rations -1])))
-
-(define-method use-item player (n)
-  (assert (integerp n))
-  (let ((object [item-at self n]))
-    (if object
-	(if [in-category object :equipment]
-	    [equip self n]
-	    (when [use object self]
-	      [remove-item self object]))
-	[say self "There is nothing to use there."])))
- 
-(define-method enter player ()
-  (let ((gateway [category-at-p *world* <row> <column> :gateway]))
-    (if (null gateway)
-	[>>say :narrator "No gateway to enter."]
-	[activate gateway])))
-
-(define-method emote player (text &key (timeout 20) (background-color ".blue"))
-  (let ((balloon (clone =balloon= :text text :timeout timeout :background-color background-color))
-	(other-balloon [category-at-p *world* <row> <column> :balloon]))
-    (when other-balloon
-      [die other-balloon])
-    [play-sample self "talk"]
-    [follow balloon self]
-    [drop self balloon]))
-
-(define-method quit player ()
-  (xe2:quit :shutdown))
-
-(define-method run player ()
-  [stat-effect self :hunger 1]
-  (let ((hunger [stat-value self :hunger]))
-    (when (= *hunger-warn* hunger)
-      [say self "You are getting hungry. Press E to eat a ration."])
-    (when (= *hunger-warn-2* hunger)
-      [emote self '((("I'm very hungry.")))]
-      [say self "You are getting extremely hungry! Press E to eat a ration."])
-    (when (= *hunger-max* hunger)
-      (if (minusp <hunger-damage-clock>)
-	  (progn 
-	    [say self "You are starving! You will die if you do not eat soon."]
-	    [say self "Press E to eat a ration."]
-	    (setf <hunger-damage-clock> 20)
-	    [damage self 1])
-	  (decf <hunger-damage-clock>))))
-  (when (zerop [stat-value self :hit-points])
-    [die self])
-  (when (and *status* <inventory>) [update *status*]))
-
-(define-method restart player ()
-  (let ((player (clone =player=)))
-    [destroy *universe*]
-    [set-player *universe* player]
-    [set-character *status* player]
-    [play *universe*
-	  :address (generate-level-address 1)]
-    [loadout player]))
-
-(define-method damage player (points)
-  [say self "You take ~A hit ~A of damage."
-       points (if (= 1 points) "point" "points")]
-  (percent-of-time 70 [play-sample self (car (one-of '("unh-1" "unh-2" "unh-3")))])
-  [stat-effect self :hit-points (- points)])
-
-(define-method die player ()
-  (unless <dead>
-    (setf <tile> "skull")
-    [play-sample self "death"]
-    [say self "You died. Press ESCAPE to try again."]
-    (setf <dead> t)))
-
-(define-method loadout player ()
-  [make-inventory self]
-  [make-equipment self]
-  [equip self [add-item self (clone =wooden-bow=)]]
-  [add-item self (clone =sanctuary-map=)]
-  [emote self '((("I'd better get moving.")) (("The monastery is to the south.")))])
-
-;;; Dandelion seeds
-
-(defsprite dandelion
-  (image :initform "dandelion")
-  (speed :initform (make-stat :base 10))
-  (categories :initform '(:actor))
-  (speed :initform (make-stat :base 10))
-  (movement-cost :initform (make-stat :base 10))
-  (movement-distance :initform 2)
-  (clock :initform 10))
-
-(define-method run dandelion ()
-  (clon:with-fields (clock) self
-    (if (plusp clock) 
-	(progn 
-	  (decf clock)
-	  [move self (car (one-of '(:southeast :east :east))) 2])
-	[die self])))
-
 ;;; Rain and snow
 
 (defsprite raindrop 
@@ -605,182 +210,6 @@ It has begun to snow."
 	      (setf clock (+ 5 (random 5)))))))
     [move self (random-direction)]))
 
-;;; Skeletons haunt the woods, coming from gravestones
-
-(defcell gravestone 
-  (tile :initform "gravestone")
-  (description :initform "The epitaph is no longer legible.")
-  (contains-body :initform (percent-of-time 25 t))
-  (categories :initform '(:obstacle :actor))
-  (generated :initform nil))
-
-(define-method run gravestone ()
-  (when (and <contains-body>
-	     (< [distance-to-player self] 10)
-	     [line-of-sight *world* <row> <column> 
-			    [player-row *world*]
-			    [player-column *world*]])
-    (percent-of-time 40
-      (when (not <generated>)
-	(setf <generated> t)
-	(let ((skeleton (clone =skeleton=)))
-	  [drop self skeleton]
-	  [loadout skeleton])))))
-	  
-(defcell dagger 
-  (name :initform "dagger")
-  (categories :initform '(:item :weapon :equipment))
-  (tile :initform "dagger")
-  (attack-power :initform (make-stat :base 15))
-  (attack-cost :initform (make-stat :base 6))
-  (accuracy :initform (make-stat :base 90))
-  (stepping :initform t)
-  (weight :initform 3000)
-  (equip-for :initform '(:left-hand :right-hand)))
-
-(defcell skeleton 
-  (name :initform "Skeleton")
-  (description :initform "A foul spirit animates this dagger-wielding skeleton.")
-  (strength :initform (make-stat :base 20 :min 0 :max 50))
-  (dexterity :initform (make-stat :base 20 :min 0 :max 30))
-  (intelligence :initform (make-stat :base 13 :min 0 :max 30))
-  (categories :initform '(:actor :target :obstacle :opaque :enemy :equipper))
-  (equipment-slots :initform '(:left-hand))
-  (max-items :initform (make-stat :base 3))
-  (stepping :initform t)
-  (speed :initform (make-stat :base 1))
-  (movement-cost :initform (make-stat :base 5))
-  (attacking-with :initform :left-hand)
-  (equipment-slots :initform '(:left-hand :right-hand :belt :extension :feet))
-  (max-weight :initform (make-stat :base 25))
-  (max-items :initform (make-stat :base 20))
-  (hit-points :initform (make-stat :base 5 :min 0 :max 5))
-  (tile :initform "skeleton"))
-
-(define-method loadout skeleton ()
-  [make-inventory self]
-  [make-equipment self]
-  (let ((dagger (clone =dagger=)))
-    [equip self [add-item self dagger]]))
-
-(define-method run skeleton ()
-  (clon:with-field-values (row column) self
-    (let* ((world *world*)
-	   (direction [direction-to-player *world* row column]))
-      (when (< [distance-to-player self] 8)
-	(percent-of-time 40 [play-sample self "grak"]))
-      (if [adjacent-to-player world row column]
-	  (progn [say self "The skeleton stabs at you with its dagger."]
-		 [play-sample self "groar"]
-		 [expend-action-points self 10]
-		 (percent-of-time 80
-		   [say self "You are hit!"]
-		   [damage [get-player *world*] 7]))
-	  (progn	
-	    [expend-action-points self 10]
-	    (if [obstacle-in-direction-p world row column direction]
-		(let ((target [target-in-direction-p world row column direction]))
-		  (if (and target (not [in-category target :enemy]))
-		      [move self (random-direction)]
-		      (progn (setf <direction> (random-direction))
-			     [>>move self direction])))
-		(progn (when (< 7 (random 10))
-			 (setf <direction> (random-direction)))
-		       [>>move self direction])))))))
-
-(define-method die skeleton ()
-  [play-sample self "dead"]
-  [parent>>die self])
-	   
-;;; Wolves are the most difficult enemies. 
-
-(defcell wolf 
-  (categories :initform '(:actor :target :obstacle :opaque :enemy))
-  (dexterity :initform (make-stat :base 20))
-  (max-items :initform (make-stat :base 1))
-  (speed :initform (make-stat :base 2))
-  (chase-distance :initform 14)
-  (stepping :initform t)
-  (behavior :initform :seeking)
-  (clock :initform 0)
-  (last-direction :initform :north)
-  (strength :initform (make-stat :base 50))
-  (movement-cost :initform (make-stat :base 10))
-  (tile :initform "wolf")
-  (target :initform nil)
-  (hit-points :initform (make-stat :base 6 :min 0 :max 40))
-  (description :initform 
-"These undead wolves will devour your flesh if they get the chance."))
-
-(define-method run wolf ()
-  (ecase <behavior>
-    (:seeking [seek self])
-    (:fleeing [flee self])))
-
-(define-method seek wolf ()
-  (clon:with-field-values (row column) self
-    (when (< [distance-to-player *world* row column] <chase-distance>)
-      (let ((direction [direction-to-player *world* row column])
-	    (world *world*))
-	(percent-of-time 5 [play-sample self (car (one-of '("growl-1" "growl-2")))])
-	(if [adjacent-to-player world row column]
-	    (progn
-	      (percent-of-time 80 
-		[say self "The undead wolf bites you."]
-		[damage [get-player *world*] 4])
-	      (setf <clock> 6
-		    <behavior> :fleeing))
-	    (if [obstacle-in-direction-p world row column direction]
-		(let ((target [target-in-direction-p world row column direction]))
-		  (if (and target (not [in-category target :enemy]))
-		      (progn nil)
-		      (progn (setf <direction> (random-direction))
-			     [>>move self direction])))
-		(progn (when (< 7 (random 10))
-			 (setf <direction> (random-direction)))
-		       [>>move self direction])))))))
-
-(define-method damage wolf (points)
-  [play-sample self "bark"]
-  [parent>>damage self points])
-
-(define-method die wolf ()
-  [play-sample self "yelp"]
-  [parent>>die self])
-
-(define-method flee wolf ()
-  (decf <clock>)
-  ;; are we done fleeing? then begin seeking. 
-  (if (<= <clock> 0)
-      (setf <behavior> :seeking)
-      ;; otherwise, flee
-      (clon:with-field-values (row column) self
-	(let ((player-row [player-row *world*])
-	      (player-column [player-column *world*]))
-	  (labels ((neighbor (r c direction)
-		     (multiple-value-bind (r0 c0)
-			 (step-in-direction r c direction)
-		       (list r0 c0)))
-		   (all-neighbors (r c)
-		     (let (ns)
-		       (dolist (dir *compass-directions*)
-			 (push (neighbor r c dir) ns))
-		       ns))
-		   (score (r c)
-		     (distance player-column player-row c r)))
-	    (let* ((neighbors (all-neighbors row column))
-		   (scores (mapcar #'(lambda (pair)
-				       (apply #'score pair))
-				   neighbors))
-		   (farthest (apply #'max scores))
-		   (square (nth (position farthest scores)
-				neighbors)))
-	      (destructuring-bind (r c) square
-		  [move self (xe2:direction-to row column r c)])))))))
-
-(define-method move wolf (direction)
-  (setf <last-direction> direction)
-  [parent>>move self direction])
 
 ;;; Bodies of other adventurers
 
@@ -1036,437 +465,3 @@ It has begun to snow."
   (play-sample "lutey")
   (play-music "nightbird" :loop t))
 
-;;; Monastery approach world
-
-(defcell hill-1
-  (description :initform "This gentle slope heads down toward the Monastery.")
-  (tile :initform "hill-1"))
-
-(defcell hill-2
-  (description :initform "This gentle slope heads down toward the Monastery.")
-  (tile :initform "hill-2"))
-
-(defcell hill-3 
-  (description :initform "This gentle slope heads down toward the Monastery.")
-  (tile :initform "hill-3"))
-
-(defcell flowers-1
-  (description :initform "Gorgeous wildflowers.")
-  (tile :initform "flowers-1"))
-
-(define-prototype flowers-2 (:parent =flowers-1=)
-  (description :initform "Wildflowers of every description.")
-  (tile :initform "flowers-2")
-  (categories :initform '(:actor)))
-
-(define-method run flowers-2 ()
-  (percent-of-time 1
-    (multiple-value-bind (x y) [xy-coordinates self]
-      [drop-sprite self (clone =dandelion=) x y])))
-
-(define-prototype monastery-gateway (:parent =gateway=)
-  (tile :initform "monastery-gateway")
-  (description :initform "The mountain pass opens here to the foothills by the Monastery.")
-  (sequence-number :initform (genseq))
-  (address :initform (generate-level-address 4)))
-
-(define-method step monastery-gateway (stepper)
-  [say self "The mountain pass opens to the foothills by the Monastery here."]
-  [say self "Press ENTER to continue on."])
-
-(define-prototype monastery (:parent xe2:=world=)
-  (height :initform *forest-height*)
-  (width :initform *forest-width*)
-  (ambient-light :initform :total)
-  (description :initform 
-"Morning has broken, and Valisade Monastery has come into view to the
-south. You can hear the monks singing in the distance.")
-  (edge-condition :initform :block))
-
-(define-method drop-hill monastery (&key (graininess 0.3)
-				       (density 60)
-				       distance
-				       (cutoff 0.3))
-  (clon:with-field-values (height width) self
-    (let ((plasma (xe2:render-plasma height width :graininess graininess))
-	  (plasma2 (xe2:render-plasma height width :graininess graininess))
-	  (value nil))
-      (dotimes (i height)
-	(dotimes (j width)
-	  [drop-cell self (clone =hill-3=) i j]))
-      (dotimes (i height)
-	(dotimes (j width)
-	  (setf value (aref plasma i j))
-	  (when (or (null distance)
-		    (< (distance j i row column) distance))
-	    (percent-of-time density
-	      [drop-cell self (if (< cutoff value)
-				  (clone =hill-1=)
-				  (clone =hill-2=))
-			 i j :no-collisions t]))))
-      (dotimes (i height)
-	(dotimes (j width)
-	  (setf value (aref plasma i j))
-	  (when (or (null distance)
-		    (< (distance (+ j r0) (+ c0 i) row column) distance))
-	    (percent-of-time density
-	      [drop-cell self (if (< cutoff value)
-				  (clone =flowers-1=)
-				  (clone =flowers-2=))
-			 i j :no-collisions t])))))))
-
-(define-method generate monastery (&key (height *forest-height*)
-				      (width *forest-width*)
-				      sequence-number)
-  (setf <height> height)
-  (setf <width> width)
-  (setf <sequence-number> sequence-number)
-  [create-default-grid self]
-  [drop-hill self]
-  (let ((row (1+ (random 10)) )
-	  (column (+ 15 (random 6))))
-      [drop-cell self (clone =drop-point=) row column
-		 :exclusive t :probe t]))
-
-(define-method begin-ambient-loop monastery ()
-  (play-music "rain" :loop t)
-  (play-sample "monks"))
-
-;;; Mountain passage world
-
-(defparameter *passage-width* 49)
-(defparameter *passage-height* 100)
-
-(define-prototype passage (:parent xe2:=world=)
-  (height :initform *passage-height*)
-  (width :initform *passage-width*)
-  (ambient-light :initform *earth-light-radius*)
-  (description :initform "The air is oddly still in this pass between the crags.")
-  (edge-condition :initform :block))
-
-(define-method drop-tundra passage ()
-  (dotimes (i <height>)
-    (dotimes (j <width>)
-      [drop-cell self (clone =tundra=) i j])))
-
-(define-method drop-mountains passage ()
-  (let* ((offset 10)
-	 (right (- <width> 17 )))
-    (dotimes (i <height>)
-      (setf offset (min right (max 0 (incf offset (if (= 0 (random 2))
-						      1 -1)))))
-      (labels ((drop-mountain (r c)
-		 (prog1 nil
-		   [drop-cell *world* (clone =mountain=) r c])))
-	(trace-row #'drop-mountain i 0 (+ offset (random 4)))
-	(percent-of-time 10 [drop-cell self (clone =wolf=) i (+ offset (random 4))])
-	(trace-row #'drop-mountain i (+ offset (random 4) 20) <width>)))
-    ;; drop monastery gateway
-    (let ((column (+ offset (random 10)))
-	  (row (- <height> 2)))
-      [drop-cell self (clone =monastery-gateway=) row column])))
-
-(define-method drop-trees passage (&optional &key (object =tree=)
-					    distance 
-					    (row 0) (column 0)
-					    (graininess 0.3)
-					    (density 100)
-					    (cutoff 0))
-  (clon:with-field-values (height width) self
-    (let* ((h0 (or distance height))
-	   (w0 (or distance width))
-	   (r0 (- row (truncate (/ h0 2))))
-	   (c0 (- column (truncate (/ w0 2))))
-	   (plasma (xe2:render-plasma h0 w0 :graininess graininess))
-	   (value nil))
-      (dotimes (i h0)
-	(dotimes (j w0)
-	  (setf value (aref plasma i j))
-	  (when (< cutoff value)
-	    (when (or (null distance)
-		      (< (distance (+ j r0) (+ c0 i) row column) distance))
-	      (percent-of-time density
-		[drop-cell self (clone object) i j :no-collisions t]))))))))
-
-(define-method begin-ambient-loop passage ()
-  (play-music "passageway" :loop t)
-  (play-sample "howl")
-  (play-sample "thunder-big"))
-
-(define-method generate passage (&key (height *forest-height*)
-				      (width *forest-width*)
-				      sequence-number)
-  (setf <height> height)
-  (setf <width> width)
-  (setf <sequence-number> sequence-number)
-  [create-default-grid self]
-  [drop-tundra self]
-  [drop-mountains self]
-    (let ((row (1+ (random 10)) )
-	  (column (+ 15 (random 6))))
-      [drop-cell self (clone =drop-point=) row column
-		 :exclusive t :probe t]))
-
-
-;;; Controlling the game
-
-(define-prototype room-prompt (:parent xe2:=prompt=))
-
-(defparameter *numpad-keybindings* 
-  '(("KP7" nil "move :northwest .")
-    ("KP8" nil "move :north .")
-    ("KP9" nil "move :northeast .")
-    ("KP4" nil "move :west .")
-    ("KP6" nil "move :east .")
-    ("KP1" nil "move :southwest .")
-    ("KP2" nil "move :south .")
-    ("KP3" nil "move :southeast .")
-    ;;
-    ("KP8" (:control) "fire :north .")
-    ("KP4" (:control) "fire :west .")
-    ("KP6" (:control) "fire :east .")
-    ("KP2" (:control) "fire :south .")))
-
-(defparameter *qwerty-keybindings*
-  (append *numpad-keybindings*
-	  '(("Y" nil "move :northwest .")
-	    ("K" nil "move :north .")
-	    ("U" nil "move :northeast .")
-	    ("H" nil "move :west .")
-	    ("L" nil "move :east .")
-	    ("B" nil "move :southwest .")
-	    ("J" nil "move :south .")
-	    ("N" nil "move :southeast .")
-	    ;;
-	    ("K" (:control) "fire :north .")
-	    ("H" (:control) "fire :west .")
-	    ("L" (:control) "fire :east .")
-	    ("J" (:control) "fire :south .")
-	    ;;
-	    ("1" nil "use-item 0 .")
-	    ("2" nil "use-item 1 .")
-	    ("1" (:control) "drop-item 0 .")
-	    ("2" (:control) "drop-item 1 .")
-	    ;;
-	    ("P" (:control) "pause .")
-	    ("E" nil "eat .")
-	    ("PAUSE" nil "pause .")
-	    ("ESCAPE" nil "restart .")
-	    ("RETURN" nil "enter .")
-	    ;;
-	    ("Q" (:control) "quit ."))))
-
-(define-method install-keybindings room-prompt ()
-  (dolist (k (append *numpad-keybindings* *qwerty-keybindings*))
-    (apply #'bind-key-to-prompt-insertion self k))
-  ;; we also want to respond to timer events. this is how. 
-  [define-key self nil '(:timer) (lambda ()
-				   [run-cpu-phase *world* :timer])])
-
-;;; A character status widget.
-
-(define-prototype status (:parent xe2:=formatter=)
-  (character :documentation "The character cell."))
-
-(define-method set-character status (character)
-  (setf <character> character))
-
-(define-method print-stat status (stat-name &key warn-below)
-  (let* ((stat (field-value stat-name <character>))
-	 (value [stat-value <character> stat-name]))
-    (destructuring-bind (&key min max base delta unit) stat
-      (let ((color (if (and (numberp warn-below)
-			    (< value warn-below))
-		       ".red"
-		       ".gray20")))
-	[print self (symbol-name stat-name)
-	       :foreground ".white"]
-	[print self " "]
-	[print self (format nil "~S" value) 
-	       :foreground ".yellow"
-	       :background color]
-	[print self " "]))))
-
-(defparameter *status-bar-character* " ")
-
-(define-method print-stat-bar status (stat &key 
-					   (color ".yellow")
-					   (background-color ".gray40"))
-  (let ((value (truncate [stat-value <character> stat]))
-	(max (truncate [stat-value <character> stat :max])))
-    (dotimes (i max)
-      [print self *status-bar-character*
-	     :foreground ".yellow"
-	     :background (if (< i value)
-			     color
-			   background-color)])))
-
-(define-method print-equipment-slot status (slot-name)
-  [print self (symbol-name slot-name)]
-  [print self ": "]
-  (let* ((item [equipment-slot <character> slot-name]))
-    (if item
-	(clon:with-field-values (name tile) item
-	  [print self nil :image tile]
-	  [print self " "]
-	  [print self name]
-	  [print self "  "])
-	[print self "EMPTY  "])))
-
-(define-method print-inventory-slot status (slot-number &key show-as)
-  [print self (format nil "[~D]: " (or show-as slot-number))]
-  (let ((item [item-at <character> slot-number]))
-    (if item
-	(clon:with-field-values (name tile) item
-				[print self nil :image tile]
-				[print self " "]
-				[print self (get-some-object-name item)]
-				[print self "  "])
-	[print self "EMPTY  "])))
-
-(define-method update status ()
-  [delete-all-lines self]
-  (let ((char <character>))
-    [print self "  Statistics:  "]
-    [print-stat self :hit-points :warn-below 12]
-    [print-stat-bar self :hit-points :color ".red" :background-color ".gray30"]
-    [print self " "]
-    [print-stat self :strength :warn-below 10]
-    [print self " "]
-    [print-stat self :defense :warn-below 10]
-    [print self " "]
-    [print-stat self :speed :warn-below 2]
-    [println self " "]
-    [print self "  Equipment:  "]
-    [print-equipment-slot self :right-hand]
-    [print-equipment-slot self :left-hand]
-    [print self (format nil "  ARROWS: ~S " [stat-value char :arrows])]
-    [print self nil :image "arrows"]
-    [print self (format nil "  RATIONS: ~S " [stat-value char :rations])]
-    [println self nil :image "ration"]
-    [newline self]
-    [print self "  Inventory:  "]
-    [print-inventory-slot self 0 :show-as 1]
-    [print-inventory-slot self 1 :show-as 2]
-    [newline self]))
-
-;;; Pager and splash screen
-
-(defvar *pager* nil)
-
-(define-prototype splash (:parent =widget=))
-
-(define-method render splash ()
-  (xe2:draw-resource-image "splash" 0 0 
-			   :destination <image>))
-
-(defvar *space-bar-function*)
-
-(define-method dismiss splash ()
-  [select *pager* :game]
-  (when (functionp *space-bar-function*)
-    (funcall *space-bar-function*))
-  ;; TODO ugh this is a hack!
-  (xe2:show-widgets))
-
-(define-prototype splash-prompt (:parent =prompt=)
-  (default-keybindings :initform '(("SPACE" nil "dismiss ."))))
-
-;;; Help prompt
-
-(define-prototype help-prompt (:parent =prompt=)
-  (default-keybindings :initform '(("N" nil "page-down .")
-				   ("P" nil "page-up ."))))
-
-;;; Main program. 
-
-(defparameter *pager-height* 16)
-
-(defparameter *room-window-width* 800)
-(defparameter *room-window-height* 600)
-
-(defparameter *start-level* 1)
-
-(defun init-forest ()
-  (xe2:message "Initializing Forest...")
-  (clon:initialize)
-  (xe2:set-screen-height *room-window-height*)
-  (xe2:set-screen-width *room-window-width*)
-  (let* ((prompt (clone =room-prompt=))
-	 (universe (clone =universe=))
-	 (narrator (clone =narrator=))
-	 (help (clone =textbox=))
-	 (quickhelp (clone =formatter=))
-	 (splash (clone =splash=))
-	 (splash-prompt (clone =splash-prompt=))
-	 (help-prompt (clone =help-prompt=))
-	 (player (clone =player=))
-	 (status (clone =status=))
-	 (viewport (clone =viewport=)))
-    ;;
-    [resize splash :height (- *room-window-height* 20 *pager-height*) :width *room-window-width*]
-    [move splash :x 0 :y 0]
-    [resize splash-prompt :width 10 :height 10]
-    [move splash-prompt :x 0 :y 0]
-    [hide splash-prompt]
-    [set-receiver splash-prompt splash]
-    ;;
-    [resize help-prompt :width 10 :height 10]
-    [move help-prompt :x 0 :y 0]
-    [hide help-prompt]
-    [set-receiver help-prompt help]
-    ;;
-    (labels ((spacebar ()
-	       (setf *status* status)
-	       [resize status :height 60 :width 800]
-	       [move status :x 5 :y 0]
-	       [set-character status player]
-	       ;;
-	       [resize prompt :height 20 :width 100]
-	       [move prompt :x 0 :y 0]
-	       [hide prompt]
-	       [install-keybindings prompt]
-	       ;;
-	       [resize narrator :height 80 :width *room-window-width*]
-	       [move narrator :x 0 :y (- *room-window-height* 100 *pager-height*)]
-	       [set-verbosity narrator 0]
-	       ;;
-	       [resize quickhelp :height 85 :width 280] 
-	       [move quickhelp :y (- *room-window-height* 100 *pager-height*) :x (- *room-window-width* 280)]
-	       (let ((text	(find-resource-object "quickhelp-message")))
-		 (dolist (line text)
-		   (dolist (string line)
-		     (funcall #'send nil :print-formatted-string quickhelp string))
-		   [newline quickhelp]))
-	       ;;
-	       [play universe
-		     :address (generate-level-address *start-level*)
-		     :player player
-		     :narrator narrator
-		     :prompt prompt
-		     :viewport viewport]
-	       [set-tile-size viewport 16]
-	       [resize viewport :height 470 :width *room-window-width*]
-	       [move viewport :x 0 :y 60]
-	       [set-origin viewport :x 0 :y 0 
-			   :height (truncate (/ (- *room-window-height* 200) 16))
-			   :width (truncate (/ *room-window-width* 16))]
-	       [adjust viewport] 
-	       [select *pager* 2]
-	       [loadout player]))
-      (setf *space-bar-function* #'spacebar))
-    ;;
-    [resize help :height 540 :width 800] 
-    [move help :x 0 :y 0]
-    (let ((text	(find-resource-object "help-message")))
-      [set-buffer help text])
-    ;;
-   ;;
-    (setf *pager* (clone =pager=))
-    [auto-position *pager*]
-    (xe2:install-widgets splash-prompt splash)
-    [add-page *pager* :map prompt viewport narrator status quickhelp]
-    [add-page *pager* :help help-prompt help]))
-
-
-(init-forest)
diff --git a/forest/forest.org b/forest/forest.org
index 6993ad6..fab984e 100644
--- a/forest/forest.org
+++ b/forest/forest.org
@@ -1,4 +1,3 @@
-** TODO Split file
 ** TODO [#A] WXAD controls
 ** TODO [#A] add 8-way firing
 *** TODO diagonal arrow tile
diff --git a/forest/forest.pak b/forest/forest.pak
index f1ce161..34d6102 100644
--- a/forest/forest.pak
+++ b/forest/forest.pak
@@ -114,5 +114,12 @@
  (:name "bip" :type :sample :file "bip.wav" :properties (:volume 10))
  (:name "serve" :type :sample :file "serve.wav" :properties (:volume 10))
  (:name "help-message" :type :text :file "README")
- (:name ".startup" :type :lisp :file "forest.lisp" :properties (:autoload t))
+ (:name "package-lisp" :type :lisp :file "package.lisp" :properties (:autoload t))
+ (:name "base-lisp" :type :lisp :file "base.lisp" :properties (:autoload t))
+ (:name "player-lisp" :type :lisp :file "player.lisp" :properties (:autoload t))
+ (:name "enemy-lisp" :type :lisp :file "enemy.lisp" :properties (:autoload t))
+ (:name "forest-lisp" :type :lisp :file "forest.lisp" :properties (:autoload t))
+ (:name "mountain-lisp" :type :lisp :file "mountain.lisp" :properties (:autoload t))
+ (:name "monastery-lisp" :type :lisp :file "monastery.lisp" :properties (:autoload t))
+ (:name ".startup" :type :lisp :file "startup.lisp" :properties (:autoload t))
 )
diff --git a/forest/monastery.lisp b/forest/monastery.lisp
new file mode 100644
index 0000000..5980e6a
--- /dev/null
+++ b/forest/monastery.lisp
@@ -0,0 +1,117 @@
+(in-package :forest)
+
+;;; Dandelion seeds
+
+(defsprite dandelion
+  (image :initform "dandelion")
+  (speed :initform (make-stat :base 10))
+  (categories :initform '(:actor))
+  (speed :initform (make-stat :base 10))
+  (movement-cost :initform (make-stat :base 10))
+  (movement-distance :initform 2)
+  (clock :initform 10))
+
+(define-method run dandelion ()
+  (clon:with-fields (clock) self
+    (if (plusp clock) 
+	(progn 
+	  (decf clock)
+	  [move self (car (one-of '(:southeast :east :east))) 2])
+	[die self])))
+
+;;; Monastery approach world
+
+(defcell hill-1
+  (description :initform "This gentle slope heads down toward the Monastery.")
+  (tile :initform "hill-1"))
+
+(defcell hill-2
+  (description :initform "This gentle slope heads down toward the Monastery.")
+  (tile :initform "hill-2"))
+
+(defcell hill-3 
+  (description :initform "This gentle slope heads down toward the Monastery.")
+  (tile :initform "hill-3"))
+
+(defcell flowers-1
+  (description :initform "Gorgeous wildflowers.")
+  (tile :initform "flowers-1"))
+
+(define-prototype flowers-2 (:parent =flowers-1=)
+  (description :initform "Wildflowers of every description.")
+  (tile :initform "flowers-2")
+  (categories :initform '(:actor)))
+
+(define-method run flowers-2 ()
+  (percent-of-time 1
+    (multiple-value-bind (x y) [xy-coordinates self]
+      [drop-sprite self (clone =dandelion=) x y])))
+
+(define-prototype monastery-gateway (:parent =gateway=)
+  (tile :initform "monastery-gateway")
+  (description :initform "The mountain pass opens here to the foothills by the Monastery.")
+  (sequence-number :initform (genseq))
+  (address :initform (generate-level-address 4)))
+
+(define-method step monastery-gateway (stepper)
+  [say self "The mountain pass opens to the foothills by the Monastery here."]
+  [say self "Press ENTER to continue on."])
+
+(define-prototype monastery (:parent xe2:=world=)
+  (height :initform *forest-height*)
+  (width :initform *forest-width*)
+  (ambient-light :initform :total)
+  (description :initform 
+"Morning has broken, and Valisade Monastery has come into view to the
+south. You can hear the monks singing in the distance.")
+  (edge-condition :initform :block))
+
+(define-method drop-hill monastery (&key (graininess 0.3)
+				       (density 60)
+				       distance
+				       (cutoff 0.3))
+  (clon:with-field-values (height width) self
+    (let ((plasma (xe2:render-plasma height width :graininess graininess))
+	  (plasma2 (xe2:render-plasma height width :graininess graininess))
+	  (value nil))
+      (dotimes (i height)
+	(dotimes (j width)
+	  [drop-cell self (clone =hill-3=) i j]))
+      (dotimes (i height)
+	(dotimes (j width)
+	  (setf value (aref plasma i j))
+	  (when (or (null distance)
+		    (< (distance j i row column) distance))
+	    (percent-of-time density
+	      [drop-cell self (if (< cutoff value)
+				  (clone =hill-1=)
+				  (clone =hill-2=))
+			 i j :no-collisions t]))))
+      (dotimes (i height)
+	(dotimes (j width)
+	  (setf value (aref plasma i j))
+	  (when (or (null distance)
+		    (< (distance (+ j r0) (+ c0 i) row column) distance))
+	    (percent-of-time density
+	      [drop-cell self (if (< cutoff value)
+				  (clone =flowers-1=)
+				  (clone =flowers-2=))
+			 i j :no-collisions t])))))))
+
+(define-method generate monastery (&key (height *forest-height*)
+				      (width *forest-width*)
+				      sequence-number)
+  (setf <height> height)
+  (setf <width> width)
+  (setf <sequence-number> sequence-number)
+  [create-default-grid self]
+  [drop-hill self]
+  (let ((row (1+ (random 10)) )
+	  (column (+ 15 (random 6))))
+      [drop-cell self (clone =drop-point=) row column
+		 :exclusive t :probe t]))
+
+(define-method begin-ambient-loop monastery ()
+  (play-music "rain" :loop t)
+  (play-sample "monks"))
+
diff --git a/forest/mountain.lisp b/forest/mountain.lisp
new file mode 100644
index 0000000..bffa9e4
--- /dev/null
+++ b/forest/mountain.lisp
@@ -0,0 +1,121 @@
+(in-package :forest)
+
+;;; Icy tundra
+
+(defparameter *tundra-tiles* '("tundra-1" 
+			      "tundra-2"
+			      "tundra-3"
+			      "tundra-4"
+			      "tundra-5"
+			      "tundra-6"
+			      "floor"))
+
+(defparameter *tundra-light-radius* 14)
+
+
+(defcell tundra 
+  (tile :initform "floor")
+  (description :initform "This frozen surface is treacherous.")
+  (categories :initform '(:actor :reflective)))
+
+(define-method blow tundra (dark)
+  (let ((snow [category-at-p *world* <row> <column> :snow]))
+    (when snow
+      [update-tile snow dark])
+    (if (minusp <snow-clock>)
+	(progn (setf <snow-clock> *snow-clock*)
+	       (if (null snow)
+		   (percent-of-time 3
+		     (setf snow (clone =snow=))
+		     [drop self snow])
+		   (percent-of-time 10 
+		     [collect snow 1 dark])))
+	(decf <snow-clock>))))
+    
+(define-method run tundra ()
+  (let* ((dist [distance-to-player self]))
+    (setf <tile> (if (< dist *tundra-light-radius*)
+		     (nth (truncate (/ dist 2)) *tundra-tiles*)
+		     "floor"))))
+
+(defcell mountain 
+  (tile :initform "mountain")
+  (description :initform "The walls of the passageway are slick with ice.")
+  (categories :initform '(:obstacle :opaque)))
+
+;;; Mountain passage world
+
+(defparameter *passage-width* 49)
+(defparameter *passage-height* 100)
+
+(define-prototype passage (:parent xe2:=world=)
+  (height :initform *passage-height*)
+  (width :initform *passage-width*)
+  (ambient-light :initform *earth-light-radius*)
+  (description :initform "The air is oddly still in this pass between the crags.")
+  (edge-condition :initform :block))
+
+(define-method drop-tundra passage ()
+  (dotimes (i <height>)
+    (dotimes (j <width>)
+      [drop-cell self (clone =tundra=) i j])))
+
+(define-method drop-mountains passage ()
+  (let* ((offset 10)
+	 (right (- <width> 17 )))
+    (dotimes (i <height>)
+      (setf offset (min right (max 0 (incf offset (if (= 0 (random 2))
+						      1 -1)))))
+      (labels ((drop-mountain (r c)
+		 (prog1 nil
+		   [drop-cell *world* (clone =mountain=) r c])))
+	(trace-row #'drop-mountain i 0 (+ offset (random 4)))
+	(percent-of-time 10 [drop-cell self (clone =wolf=) i (+ offset (random 4))])
+	(trace-row #'drop-mountain i (+ offset (random 4) 20) <width>)))
+    ;; drop monastery gateway
+    (let ((column (+ offset (random 10)))
+	  (row (- <height> 2)))
+      [drop-cell self (clone =monastery-gateway=) row column])))
+
+(define-method drop-trees passage (&optional &key (object =tree=)
+					    distance 
+					    (row 0) (column 0)
+					    (graininess 0.3)
+					    (density 100)
+					    (cutoff 0))
+  (clon:with-field-values (height width) self
+    (let* ((h0 (or distance height))
+	   (w0 (or distance width))
+	   (r0 (- row (truncate (/ h0 2))))
+	   (c0 (- column (truncate (/ w0 2))))
+	   (plasma (xe2:render-plasma h0 w0 :graininess graininess))
+	   (value nil))
+      (dotimes (i h0)
+	(dotimes (j w0)
+	  (setf value (aref plasma i j))
+	  (when (< cutoff value)
+	    (when (or (null distance)
+		      (< (distance (+ j r0) (+ c0 i) row column) distance))
+	      (percent-of-time density
+		[drop-cell self (clone object) i j :no-collisions t]))))))))
+
+(define-method begin-ambient-loop passage ()
+  (play-music "passageway" :loop t)
+  (play-sample "howl")
+  (play-sample "thunder-big"))
+
+(define-method generate passage (&key (height *forest-height*)
+				      (width *forest-width*)
+				      sequence-number)
+  (setf <height> height)
+  (setf <width> width)
+  (setf <sequence-number> sequence-number)
+  [create-default-grid self]
+  [drop-tundra self]
+  [drop-mountains self]
+    (let ((row (1+ (random 10)) )
+	  (column (+ 15 (random 6))))
+      [drop-cell self (clone =drop-point=) row column
+		 :exclusive t :probe t]))
+
+
diff --git a/forest/package.lisp b/forest/package.lisp
new file mode 100644
index 0000000..ab81ba9
--- /dev/null
+++ b/forest/package.lisp
@@ -0,0 +1,4 @@
+(defpackage :forest
+  (:documentation "Sanctuary.")
+  (:use :xe2 :common-lisp)
+  (:export forest))
diff --git a/forest/player.lisp b/forest/player.lisp
new file mode 100644
index 0000000..599f508
--- /dev/null
+++ b/forest/player.lisp
@@ -0,0 +1,223 @@
+(in-package :forest)
+
+;;; Supplies
+
+(defcell arrows 
+  (tile :initform "arrows")
+  (count :initform (+ 6 (random 18))))
+
+(define-method step arrows (stepper)
+  (when [is-player stepper]
+    [say self "You found ~S arrows." <count>]
+    [stat-effect stepper :arrows <count>]
+    [die self]))
+     
+(defcell herb 
+  (tile :initform "herb")
+  (description :initform "This healing herb will restore some of your health.")
+  (categories :initform '(:item))
+  (equip-for :initform '(:right-hand :left-hand)))
+
+(define-method step herb (stepper)
+  (when [is-player stepper]
+    (if [take stepper :direction :here :category :item]
+      [say self "You found a healing herb."]
+      [say self "Your satchel is full."])))
+
+(define-method use herb (user)
+ (when (and user (has-field :hit-points user))
+    (prog1 t
+      [stat-effect user :hit-points 12]
+      [say self "You consume the healing herb and quickly feel better."])))
+
+;;; A map of the journey
+
+(defcell sanctuary-map 
+  (name :initform "Map")
+  (tile :initform "tiny-map")
+  (description :initform "This map was given to you by Wythorn before you left town.")
+  (categories :initform '(:item)))
+
+(define-method use sanctuary-map (user)
+  (prog1 nil
+    [emote user '(((nil :image "sanctuary-map"))) :background-color ".white"]))
+	 
+(define-method step sanctuary-map (stepper)
+  (when [is-player stepper]
+    [say self "You don't need this map; you've memorized the way."]))
+
+;;; The player
+	     
+(defparameter *arrow-tiles* '(:north "arrow-north"
+			      :south "arrow-south"
+			      :east "arrow-east"
+			      :west "arrow-west"))
+
+(defcell arrow 
+  (name :initform "arrow")
+  (speed :initform (make-stat :base 25))
+  (categories :initform '(:actor))
+  (clock :initform 8)
+  (direction :initform nil))
+
+(define-method impel arrow (direction)
+  (assert (member direction '(:north :south :east :west)))
+  (setf <direction> direction))
+
+(define-method run arrow ()
+  [expend-default-action-points self]
+  (if (and <direction> (not (eq <direction> :here)))
+      (progn (setf <tile> (getf *arrow-tiles* <direction>))
+	     (let ((target [category-in-direction-p *world* <row> <column> <direction> :target]))
+	       (when target 
+		 [damage target 3]
+		 [die self])
+	       (if [obstacle-in-direction-p *world* <row> <column> <direction>]
+		   [die self]
+		   [move self <direction>]))
+	     (setf <clock> (max 0 (decf <clock>)))
+	     (when (zerop <clock>)
+	       [die self])
+	     (when [obstacle-in-direction-p *world* <row> <column> <direction>]
+	       (setf <clock> 0)))
+      [die self]))
+
+(define-method step arrow (stepper)
+  (when [is-player stepper]
+    (assert [is-located self])
+    [say self "This arrow is still good. You add it to your quiver."]
+    [stat-effect stepper :arrows 1]
+    [die self]))
+
+(defcell wooden-bow 
+  (name :initform "Wooden bow")
+  (categories :initform '(:item :weapon :equipment))
+  (tile :initform "wooden-bow")
+  (attack-power :initform (make-stat :base 5))
+  (attack-cost :initform (make-stat :base 6))
+  (accuracy :initform (make-stat :base 90))
+  (weight :initform 3000)
+  (equip-for :initform '(:left-hand)))
+
+(define-method fire wooden-bow (direction)
+  (if (plusp [stat-value <equipper> :arrows])
+      (let ((arrow (clone =arrow=)))
+	[stat-effect <equipper> :arrows -1]
+	[drop <equipper> arrow]
+	[impel arrow direction]
+	[play-sample <equipper> "bow"])
+      [say self "You are out of arrows!" :foreground ".red"]))
+
+(defparameter *hunger-warn* 700)
+
+(defparameter *hunger-warn-2* 850)
+
+(defparameter *hunger-max* 1000)
+
+(defcell player 
+  (tile :initform "player")
+  (description :initform "You are an archer and initiate monk of the Sanctuary Order.")
+  (name :initform "Monk")
+  (dead :initform nil)
+  (hit-points :initform (make-stat :base 30 :min 0 :max 30))
+  (hunger :initform (make-stat :base 0 :min 0 :max 1000))
+  (hunger-damage-clock :initform 0)
+  (hearing-range :initform 1000)
+  (firing-with :initform :left-hand)
+  (arrows :initform (make-stat :base 20 :min 0 :max 40))
+  (rations :initform (make-stat :base 5 :min 0 :max 20))
+  (speed :initform (make-stat :base 10 :min 0 :max 10))
+  (strength :initform (make-stat :base 15 :min 0 :max 50))
+  (defense :initform (make-stat :base 15 :min 0 :max 50))
+  (dexterity :initform (make-stat :base 15 :min 0 :max 30))
+  (intelligence :initform (make-stat :base 13 :min 0 :max 30))
+  (equipment-slots :initform '(:right-hand :left-hand))
+  (max-items :initform (make-stat :base 20))
+  (movement-cost :initform (make-stat :base 10))
+  (stepping :initform t)
+  (categories :initform '(:actor :player :obstacle :target)))
+
+(define-method eat player ()
+  (if (zerop [stat-value self :rations])
+      [say self "You don't have any rations to eat."]
+      (progn 
+	[say self "You eat a bread ration. You feel full."]
+	[stat-effect self :hunger -900]
+	[stat-effect self :rations -1])))
+
+(define-method use-item player (n)
+  (assert (integerp n))
+  (let ((object [item-at self n]))
+    (if object
+	(if [in-category object :equipment]
+	    [equip self n]
+	    (when [use object self]
+	      [remove-item self object]))
+	[say self "There is nothing to use there."])))
+ 
+(define-method enter player ()
+  (let ((gateway [category-at-p *world* <row> <column> :gateway]))
+    (if (null gateway)
+	[>>say :narrator "No gateway to enter."]
+	[activate gateway])))
+
+(define-method emote player (text &key (timeout 20) (background-color ".blue"))
+  (let ((balloon (clone =balloon= :text text :timeout timeout :background-color background-color))
+	(other-balloon [category-at-p *world* <row> <column> :balloon]))
+    (when other-balloon
+      [die other-balloon])
+    [play-sample self "talk"]
+    [follow balloon self]
+    [drop self balloon]))
+
+(define-method quit player ()
+  (xe2:quit :shutdown))
+
+(define-method run player ()
+  [stat-effect self :hunger 1]
+  (let ((hunger [stat-value self :hunger]))
+    (when (= *hunger-warn* hunger)
+      [say self "You are getting hungry. Press Control-E to eat a ration."])
+    (when (= *hunger-warn-2* hunger)
+      [emote self '((("I'm very hungry.")))]
+      [say self "You are getting extremely hungry! Press Control-E to eat a ration."])
+    (when (= *hunger-max* hunger)
+      (if (minusp <hunger-damage-clock>)
+	  (progn 
+	    [say self "You are starving! You will die if you do not eat soon."]
+	    [say self "Press Control-E to eat a ration."]
+	    (setf <hunger-damage-clock> 20)
+	    [damage self 1])
+	  (decf <hunger-damage-clock>))))
+  (when (zerop [stat-value self :hit-points])
+    [die self])
+  (when (and *status* <inventory>) [update *status*]))
+
+(define-method restart player ()
+  (let ((player (clone =player=)))
+    [destroy *universe*]
+    [set-player *universe* player]
+    [set-character *status* player]
+    [play *universe*
+	  :address (generate-level-address 1)]
+    [loadout player]))
+
+(define-method damage player (points)
+  [say self "You take ~A hit ~A of damage."
+       points (if (= 1 points) "point" "points")]
+  (percent-of-time 70 [play-sample self (car (one-of '("unh-1" "unh-2" "unh-3")))])
+  [stat-effect self :hit-points (- points)])
+
+(define-method die player ()
+  (unless <dead>
+    (setf <tile> "skull")
+    [play-sample self "death"]
+    [say self "You died. Press ESCAPE to try again."]
+    (setf <dead> t)))
+
+(define-method loadout player ()
+  [make-inventory self]
+  [make-equipment self]
+  [equip self [add-item self (clone =wooden-bow=)]]
+  [add-item self (clone =sanctuary-map=)]
+  [emote self '((("I'd better get moving.")) (("The monastery is to the south.")))])
diff --git a/forest/quickhelp.text b/forest/quickhelp.text
index 63c68a8..9d05f8f 100644
--- a/forest/quickhelp.text
+++ b/forest/quickhelp.text
@@ -1,7 +1,7 @@
-((("CONTROLS:                             " :background ".blue" :foreground ".white"))
- (("movement: arrowkeys / numpad / hjkl   " :background ".gray20" :foreground ".gray80"))
- (("shooting: CTRL-DIRECTION              "  :background ".gray14" :foreground ".gray80"))
- (("inventory: 1/2 to use, CTRL-# to drop "  :background ".gray20" :foreground ".gray80"))	
- (("pausing: Pause key or Control-P       "  :background ".gray14" :foreground ".gray80"))
- (("help: F1 / Pause and click objects    "  :background ".gray20" :foreground ".gray80")))
+((("CONTROLS:                              " :background ".blue" :foreground ".white"))
+ (("movement: Numeric keypad or QWE/AD/ZXC " :background ".gray20" :foreground ".gray80"))
+ (("shooting: SHIFT-DIRECTION              "  :background ".gray14" :foreground ".gray80"))
+ (("inventory: 1-4 to use, CTRL-# to drop  "  :background ".gray20" :foreground ".gray80"))	
+ (("pausing: Pause key or Control-P        "  :background ".gray14" :foreground ".gray80"))
+ (("help: F1 or Pause and click objects    "  :background ".gray20" :foreground ".gray80")))
 		     
diff --git a/forest/startup.lisp b/forest/startup.lisp
new file mode 100644
index 0000000..e55dce5
--- /dev/null
+++ b/forest/startup.lisp
@@ -0,0 +1,326 @@
+;;; startup.lisp --- Sanctuary startup file
+
+;; Copyright (C) 2009  David O'Toole
+
+;; Author: David O'Toole <dto@gnu.org>
+;; Keywords: games
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary 
+
+;; See also http://dto.github.com/notebook/developers-guide.html
+
+(in-package :forest)
+
+;;; Custom bordered viewport
+
+(define-prototype view (:parent xe2:=viewport=))
+
+(define-method render view ()
+  [parent>>render self]
+  (xe2:draw-rectangle 0 0 
+		      <width>
+		      <height>
+		      :color ".blue" :destination <image>)
+  [message *pager* (list "")])
+
+(defvar *view* (clone =view=))
+
+;;; Controlling the game
+
+(define-prototype room-prompt (:parent xe2:=prompt=))
+
+(defparameter *numpad-keybindings* 
+  '(("KP7" nil "move :northwest .")
+    ("KP8" nil "move :north .")
+    ("KP9" nil "move :northeast .")
+    ("KP4" nil "move :west .")
+    ("KP6" nil "move :east .")
+    ("KP1" nil "move :southwest .")
+    ("KP2" nil "move :south .")
+    ("KP3" nil "move :southeast .")
+    ;;
+    ("KP8" (:control) "fire :north .")
+    ("KP4" (:control) "fire :west .")
+    ("KP6" (:control) "fire :east .")
+    ("KP2" (:control) "fire :south .")
+    ("KP7" (:control) "fire :northwest .")
+    ("KP9" (:control) "fire :northeast .")
+    ("KP1" (:control) "fire :southwest .")
+    ("KP3" (:control) "fire :southeast .")))
+
+(defparameter *qwerty-keybindings*
+  (append *numpad-keybindings*
+	  '(("Q" nil "move :northwest .")
+	    ("W" nil "move :north .")
+	    ("E" nil "move :northeast .")
+	    ("A" nil "move :west .")
+	    ("D" nil "move :east .")
+	    ("Z" nil "move :southwest .")
+	    ("X" nil "move :south .")
+	    ("C" nil "move :southeast .")
+	    ;;
+	    ("Q" (:shift) "fire :northwest .")
+	    ("W" (:shift) "fire :north .")
+	    ("E" (:shift) "fire :northeast .")
+	    ("A" (:shift) "fire :west .")
+	    ("D" (:shift) "fire :east .")
+	    ("Z" (:shift) "fire :southwest .")
+	    ("X" (:shift) "fire :south .")
+	    ("C" (:shift) "fire :southeast .")
+	    ;;
+	    ;;
+	    ("1" nil "use-item 0 .")
+	    ("2" nil "use-item 1 .")
+	    ("1" (:control) "drop-item 0 .")
+	    ("2" (:control) "drop-item 1 .")
+	    ("3" nil "use-item 2 .")
+	    ("4" nil "use-item 3 .")
+	    ("3" (:control) "drop-item 2 .")
+	    ("4" (:control) "drop-item 3 .")
+	    ;;
+	    ("P" (:control) "pause .")
+	    ("E" (:control) "eat .")
+	    ("PAUSE" nil "pause .")
+	    ("ESCAPE" nil "restart .")
+	    ("RETURN" nil "enter .")
+	    ;;
+	    ("Q" (:control) "quit ."))))
+
+(define-method install-keybindings room-prompt ()
+  (dolist (k (append *numpad-keybindings* *qwerty-keybindings*))
+    (apply #'bind-key-to-prompt-insertion self k))
+  ;; we also want to respond to timer events. this is how. 
+  [define-key self nil '(:timer) (lambda ()
+				   [run-cpu-phase *world* :timer])])
+
+;;; A character status widget.
+
+(define-prototype status (:parent xe2:=formatter=)
+  (character :documentation "The character cell."))
+
+(define-method set-character status (character)
+  (setf <character> character))
+
+(define-method print-stat status (stat-name &key warn-below)
+  (let* ((stat (field-value stat-name <character>))
+	 (value [stat-value <character> stat-name]))
+    (destructuring-bind (&key min max base delta unit) stat
+      (let ((color (if (and (numberp warn-below)
+			    (< value warn-below))
+		       ".red"
+		       ".gray20")))
+	[print self (symbol-name stat-name)
+	       :foreground ".white"]
+	[print self " "]
+	[print self (format nil "~S" value) 
+	       :foreground ".yellow"
+	       :background color]
+	[print self " "]))))
+
+(defparameter *status-bar-character* " ")
+
+(define-method print-stat-bar status (stat &key 
+					   (color ".yellow")
+					   (background-color ".gray40"))
+  (let ((value (truncate [stat-value <character> stat]))
+	(max (truncate [stat-value <character> stat :max])))
+    (dotimes (i max)
+      [print self *status-bar-character*
+	     :foreground ".yellow"
+	     :background (if (< i value)
+			     color
+			   background-color)])))
+
+(define-method print-equipment-slot status (slot-name)
+  [print self (symbol-name slot-name)]
+  [print self ": "]
+  (let* ((item [equipment-slot <character> slot-name]))
+    (if item
+	(clon:with-field-values (name tile) item
+	  [print self nil :image tile]
+	  [print self " "]
+	  [print self name]
+	  [print self "  "])
+	[print self "EMPTY  "])))
+
+(define-method print-inventory-slot status (slot-number &key show-as)
+  [print self (format nil "[~D]: " (or show-as slot-number))]
+  (let ((item [item-at <character> slot-number]))
+    (if item
+	(clon:with-field-values (name tile) item
+				[print self nil :image tile]
+				[print self " "]
+				[print self (get-some-object-name item)]
+				[print self "  "])
+	[print self "EMPTY  "])))
+
+(define-method update status ()
+  [delete-all-lines self]
+  (let ((char <character>))
+    [print self "  Statistics:  "]
+    [print-stat self :hit-points :warn-below 12]
+    [print-stat-bar self :hit-points :color ".red" :background-color ".gray30"]
+    [print self " "]
+    [print-stat self :strength :warn-below 10]
+    [print self " "]
+    [print-stat self :defense :warn-below 10]
+    [print self " "]
+    [print-stat self :speed :warn-below 2]
+    [println self " "]
+    [print self "  Equipment:  "]
+    [print-equipment-slot self :right-hand]
+    [print-equipment-slot self :left-hand]
+    [print self (format nil "  ARROWS: ~S " [stat-value char :arrows])]
+    [print self nil :image "arrows"]
+    [print self (format nil "  RATIONS: ~S " [stat-value char :rations])]
+    [println self nil :image "ration"]
+    [newline self]
+    [print self "  Inventory:  "]
+    [print-inventory-slot self 0 :show-as 1]
+    [print-inventory-slot self 1 :show-as 2]
+    [print-inventory-slot self 2 :show-as 3]
+    [print-inventory-slot self 3 :show-as 4]
+    [newline self]))
+
+;;; Pager and splash screen
+
+(defvar *pager* nil)
+
+(define-prototype splash (:parent =widget=))
+
+(define-method render splash ()
+  (xe2:draw-resource-image "splash" 0 0 
+			   :destination <image>))
+
+(defvar *space-bar-function*)
+
+(define-method dismiss splash ()
+  [select *pager* :game]
+  (when (functionp *space-bar-function*)
+    (funcall *space-bar-function*))
+  ;; TODO ugh this is a hack!
+  (xe2:show-widgets))
+
+(define-prototype splash-prompt (:parent =prompt=)
+  (default-keybindings :initform '(("SPACE" nil "dismiss ."))))
+
+;;; Help prompt and textbox
+
+(define-prototype help-prompt (:parent =prompt=)
+  (default-keybindings :initform '(("N" nil "page-down .")
+				   ("P" nil "page-up ."))))
+
+(define-prototype help-textbox (:parent =textbox=))
+
+(define-method render help-textbox ()
+  [parent>>render self]
+  [message *pager* 
+	   (list (format nil " --- Line ~A of ~A. Use N (NEXT) and P (PREVIOUS) to scroll the text." 
+			 <point-row> (length <buffer>)))])
+
+
+;;; Main program. 
+
+(defparameter *pager-height* 16)
+
+(defparameter *room-window-width* 800)
+(defparameter *room-window-height* 600)
+
+(defparameter *start-level* 1)
+
+(defun init-forest ()
+  (xe2:message "Initializing Forest...")
+  (clon:initialize)
+  (xe2:set-screen-height *room-window-height*)
+  (xe2:set-screen-width *room-window-width*)
+  (let* ((prompt (clone =room-prompt=))
+	 (universe (clone =universe=))
+	 (narrator (clone =narrator=))
+	 (help (clone =help-textbox=))
+	 (quickhelp (clone =formatter=))
+	 (splash (clone =splash=))
+	 (splash-prompt (clone =splash-prompt=))
+	 (help-prompt (clone =help-prompt=))
+	 (player (clone =player=))
+	 (status (clone =status=))
+	 (viewport (clone =view=)))
+    ;;
+    [resize splash :height (- *room-window-height* 20 *pager-height*) :width *room-window-width*]
+    [move splash :x 0 :y 0]
+    [resize splash-prompt :width 10 :height 10]
+    [move splash-prompt :x 0 :y 0]
+    [hide splash-prompt]
+    [set-receiver splash-prompt splash]
+    ;;
+    [resize help-prompt :width 10 :height 10]
+    [move help-prompt :x 0 :y 0]
+    [hide help-prompt]
+    [set-receiver help-prompt help]
+    ;;
+    (labels ((spacebar ()
+	       (setf *status* status)
+	       [resize status :height 60 :width 800]
+	       [move status :x 5 :y 0]
+	       [set-character status player]
+	       ;;
+	       [resize prompt :height 20 :width 100]
+	       [move prompt :x 0 :y 0]
+	       [hide prompt]
+	       [install-keybindings prompt]
+	       ;;
+	       [resize narrator :height 80 :width *room-window-width*]
+	       [move narrator :x 0 :y (- *room-window-height* 100 *pager-height*)]
+	       [set-verbosity narrator 0]
+	       ;;
+	       [resize quickhelp :height 85 :width 280] 
+	       [move quickhelp :y (- *room-window-height* 100 *pager-height*) :x (- *room-window-width* 280)]
+	       (let ((text	(find-resource-object "quickhelp-message")))
+		 (dolist (line text)
+		   (dolist (string line)
+		     (funcall #'send nil :print-formatted-string quickhelp string))
+		   [newline quickhelp]))
+	       ;;
+	       [play universe
+		     :address (generate-level-address *start-level*)
+		     :player player
+		     :narrator narrator
+		     :prompt prompt
+		     :viewport viewport]
+	       [set-tile-size viewport 16]
+	       [resize viewport :height 470 :width *room-window-width*]
+	       [move viewport :x 0 :y 60]
+	       [set-origin viewport :x 0 :y 0 
+			   :height (truncate (/ (- *room-window-height* 200) 16))
+			   :width (truncate (/ *room-window-width* 16))]
+	       [adjust viewport] 
+	       [select *pager* 2]
+	       [loadout player]))
+      (setf *space-bar-function* #'spacebar))
+    ;;
+    [resize-to-scroll help :height 540 :width 800] 
+    [move help :x 0 :y 0]
+    (let ((text	(find-resource-object "help-message")))
+      [set-buffer help text])
+    ;;
+   ;;
+    (setf *pager* (clone =pager=))
+    [auto-position *pager*]
+    (xe2:install-widgets splash-prompt splash)
+    [add-page *pager* :map prompt viewport narrator status quickhelp]
+    [add-page *pager* :help help-prompt help]))
+
+
+(init-forest)
+
diff --git a/widgets.lisp b/widgets.lisp
index 54e12e3..88980a8 100644
--- a/widgets.lisp
+++ b/widgets.lisp
@@ -613,6 +613,7 @@ normally."
       (setf <x> (- center-x (truncate (/ width 2)))
 	    <y> (- center-y (truncate (/ height 2)))))))
 
+
 (define-method resize-to-scroll textbox (&key width height)
   "Resize the textbox to WIDTH * HEIGHT and enable scrolling of contents.
 This method allocates a new SDL surface."
@@ -686,6 +687,8 @@ This method allocates a new SDL surface when necessary."
   (pages :initform nil)
   (current-page :initform nil
 		:documentation "Keyword name of current page.")
+  (pager-message :initform nil
+		 :documentation "Formatted string to be displayed to right of tabs.")
   (pager-height :initform 20
 		:documentation "Height in pixels of the pager")
   (background-color :initform ".gray18")
@@ -727,6 +730,9 @@ This method allocates a new SDL surface when necessary."
 (define-method get-page-names pager ()
   (remove-duplicates (mapcar #'car <pages>)))
 
+(define-method message pager (formatted-string)
+  (setf <pager-message> formatted-string))
+
 (define-method render pager ()
   ;; calculate geometry. always draw
   [clear self <background-color>]
@@ -746,6 +752,8 @@ This method allocates a new SDL surface when necessary."
 			<highlighted-style> <style>))
 	      line))
       (incf n))
+    (when <pager-message> 
+      (push <pager-message> line))
     ;; draw the string
     (render-formatted-line (nreverse line) 0 0 :destination <image>)))