split forest up

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.
 
 
-
-
-
-

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])))
+

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])