lfe-presentation/spels/game.lfe

(defmodule game
  (export all))

;; Creates:
;; make-exit
;; exit-direction
;; exit-object
;; exit-destination
;; set-exit
;; set-exit-direction
;; set-exit-object
;; set-exit-destination
;; match-exit
;; ...
(defrecord exit
  direction
  object
  destination)

(defrecord place
  name
  description
  exits)

(defrecord object
  name
  location)

(defrecord goal
  name
  achieved?)

(defrecord state
  objects
  places
  player-location
  goals)

(set objects
     (list (make-object name 'whiskey-bottle location 'living-room)
           (make-object name 'bucket location 'living-room)
           (make-object name 'frog location 'garden)
           (make-object name 'chain location 'garden)))

(set living-room
     (make-place
      name 'living-room
      description (++ "You are in the living-room of a wizard's house. "
                      "There is a wizard snoring loudly on the couch.")
      exits (list
             (make-exit
              direction "west"
              object "door"
              destination 'garden)
             (make-exit
              direction "upstairs"
              object "stairway"
              destination 'attic))))

(set garden
     (make-place
      name 'garden
      description (++ "You are in a beautiful garden. "
                      "There is a well in front of you.")
      exits (list
             (make-exit
              direction "east"
              object "door"
              destination 'living-room))))

(set attic
     (make-place
      name 'attic
      description (++ "You are in the attic of the wizard's house. "
                      "There is a giant welding torch in the corner.")
      exits (list
             (make-exit
              direction "downstairs"
              object "stairway"
              destination 'living-room))))

(set netherworld
     (make-place
      name 'netherworld
      description (++ "Everything is misty and vague. "
                      "You seem to be in the netherworld.\n"
                      "There are no exits.\n"
                      "You could be here for a long, long time ...")
      exits '()))

(set goals
     (list (make-goal name 'weld-chain achieved? 'false)
           (make-goal name 'dunk-bucket achieved? 'false)
           (make-goal name 'splash-wizard achieved? 'false)))

(set state (make-state
               objects objects
               places (list living-room garden attic netherworld)
               player-location 'living-room
               goals goals))

(defun here?
  ((loc (match-place name place-name)) (when (== loc place-name))
   'true)
  ((_ _)
   'false))

(defun get-here
  (((match-state player-location player-loc places locs))
   (car (lists:filter
         (lambda (loc)
           (here? player-loc loc))
         locs))))

(defun describe-location (game-state)
  (++ (place-description (get-here game-state)) "\n"))

(defun describe-exit
  (((match-exit object obj direction dir))
   (++ "There is a " obj " going " dir " from here.")))

(defun describe-exits (game-state)
  (string:join
    (lists:map
      #'describe-exit/1
      (place-exits (get-here game-state)))
    " "))