Skip to content

Play Wizard's Adventure

Jacques Nomssi edited this page Nov 25, 2018 · 2 revisions

Text Game Engine

Adapted from Chapter 5 of Land of Lisp by Conrad Barski

What can you do?

  • Look around: (look)

  • Walk to a different location (directions in the text, e.g. west, upstairs) (walk 'east)

  • Pick up object, e.g. (pickup chain)

  • Check your items (inventory)

  • Possible actions:

    (look)
    (pickup 'bucket)
    (pickup 'whiskey)
    (inventory)
    (walk 'upstairs)
    (walk 'east)
    (walk 'downstairs)
    (walk 'west)
    
  • TO DO: perform action on the objects picked

Game Logic

;; filter - memory efficient
(define (filter pred lst)
(reverse (filter-help pred lst '())))

(define (filter-help pred lst res)
(cond ((null? lst) res)
        ((pred (car lst)) 
        (filter-help pred (cdr lst)  (cons (car lst) res)))
        (else 
        (filter-help pred (cdr lst)  res))))

;; find-dir 
(define (find-dir x lst)
  (if (null? lst)
      #f
      (if (eqv? x (car (cdar lst)))
         (car lst)
         (find-dir x (cdr lst)) )))

;;; Game World
;; use an Association list for the Scenery
(define *nodes* '((living-room (you are in the living-room. a wizard is snoring loudly on the couch.))
                (garden (you are in a beautiful garden. there is a well in front of you.))
                (attic (you are in the attic. there is a giant welding torch in the corner.))))

; test: Describe the location
(assoc 'garden *nodes*)

;; new function 
(define (describe-location location nodes)
  (cadr (assoc location nodes)))

; test
(describe-location 'living-room *nodes*)

;; Describe the Paths
(define *edges* '((living-room (garden west door)
                            (attic upstairs ladder))
                (garden (living-room east door))
                (attic (living-room downstairs ladder))))

;; new function using quasiquoting
(define (describe-path edge)
  `(there is a ,(caddr edge) going ,(cadr edge) from here.))

; try it
(describe-path '(garden west door))

;; describe multiple paths at once
(define (describe-paths location edges)
  (apply append (map describe-path                 ; convert edges to descriptions
                (cdr (assoc location edges)))))    ; find relevant edges

; try it
(describe-paths 'living-room *edges*)

;; List of visible objects
(define *objects* '(whiskey bucket frog chain))

;; Location of each object 
(define *object-locations* '((whiskey living-room)
                            (bucket living-room)
                            (chain garden)
                            (frog garden)))

;; function lists objects visible at a given location
;; using the filter function defined above
(define (objects-at loc objs obj-locs)
    (define (at-loc? obj)                      ; local function
        (eq? (cadr (assoc obj obj-locs)) loc))
    (filter at-loc? objs))

; try it
(objects-at 'living-room *objects* *object-locations*)

;; description of visible objects
(define (describe-objects loc objs obj-loc)
  (define (describe-obj obj)
        `(you see a ,obj on the floor.))
  (apply append (map describe-obj (objects-at loc objs obj-loc))))

; try
(describe-objects 'living-room *objects* *object-locations*)

;; Track the current player's position
(define *location* 'living-room)

;; describe it all
(define (look)
(append (describe-location *location* *nodes*)
        (describe-paths *location* *edges*)
        (describe-objects *location* *objects* *object-locations*)))

;; Walking around
(define (walk direction)
  (let ((next (find-dir direction
                (cdr (assoc *location* *edges*))  )))
  (if next
      (begin (set! *location* (car next))
          (look))
      `(you cannot go that way.))))

;; Picking Up Objects
(define (pickup object)
(cond ((member object
            (objects-at *location* *objects* *object-locations*))
        ;; prepend to list
        (set! *object-locations* (cons (list object 'body) *object-locations*) )
        `(you are now carrying the ,object))
        (else '(you cannot get that.))))

;; Checking Our Inventory
(define (inventory)
  (cons 'items- (objects-at 'body *objects* *object-locations*)))