|
(load "~/lisp/qmark.cl") |
|
|
|
(setf (fdefinition (quote prepend)) (function cons)) |
|
|
|
(setf (fdefinition (quote alist/get-pair)) (function assoc)) |
|
|
|
(defun alist/get (key alist) |
|
(second (alist/get-pair key alist))) |
|
|
|
; (defparameter *nodes* (quote ( |
|
; (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.))))) |
|
|
|
; (assoc (quote garden) *nodes*) |
|
|
|
; (describe-location (quote garden) *nodes*) |
|
|
|
(defun alist/new (alist) alist) |
|
|
|
(defun alist/push (alist key value) |
|
(cons (cons key value) alist)) |
|
|
|
(defun alist/get (alist key) |
|
(cond ((null alist) alist) |
|
((eq (first (first alist)) key) (cdr (first alist))) |
|
(:else (alist/get (cdr alist) key)))) |
|
|
|
; (alist/get (quote ((a . 1) (b . 2))) (quote b)) |
|
|
|
; (defmacro alist/get) |
|
; input: (alist/get alist key) |
|
; output: (alist/get alist (quote key)) |
|
|
|
; (defparameter n (alist/new (quote ((a . 1) (b . 2))))) |
|
|
|
(defparameter *nodes* (alist/new (quote ( |
|
(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.)))))) |
|
|
|
(defun describe-location (location nodes) |
|
(alist/get location nodes)) |
|
|
|
(defparameter *edges* (alist/new (quote ( |
|
(living-room . ((garden west door) (attic upstairs ladder))) |
|
(garden . ((living-room east door))) |
|
(attic . ((living-room downstairs ladder))))))) |
|
|
|
(defun describe-path (edge) |
|
`(there is a ,(third edge) going ,(second edge) from here.)) |
|
|
|
; (describe-path '(garden west door)) |
|
;; (THERE IS A DOOR GOING WEST FROM HERE.) |
|
|
|
(defun describe-paths (location edges) |
|
(let ((descriptions (mapcar (function describe-path) (alist/get edges location)))) |
|
(apply (function append) descriptions))) |
|
|
|
; (describe-paths (quote living-room) *edges*) |
|
;; (THERE IS A DOOR GOING WEST FROM HERE. THERE IS A LADDER GOING UPSTAIRS FROM HERE.) |
|
|
|
(defparameter *objects* (quote (whiskey bucket frog chain))) |
|
|
|
(defparameter *object-locations* (alist/new (quote ( |
|
(whiskey . living-room) |
|
(bucket . living-room) |
|
(chain . gargen) |
|
(frog . garden))))) |
|
|
|
(defun objects-at (loc objs obj-locs) |
|
(labels ((at-loc? (obj) |
|
(eq (alist/get obj-locs obj) loc))) |
|
(remove-if-not (function at-loc?) objs))) |
|
|
|
(objects-at (quote living-room) *objects* *object-locations*) |
|
|
|
; hmm, this appears to be broken, returning (frog) instead of (chain frog) |
|
(objects-at (quote garden) *objects* *object-locations*) |
setfmakes me question my understanding of what exactly values are. are they values, or pointers? e.g.(setf (cdr thing) 42), see p. 111setqa new global var? don't needdefparameter?pushis not the same ascons-- it modifies a "place" http://clhs.lisp.se/Body/m_push.htm