post/good-story-makeup-behind/

[utterances-bot]

Good Story Makeup Behind | 志不达者智不坚 言不信者行不果

The key to programming is to recognize the patterns in data and processe

https://jueqingsizhe66.github.io/post/good-story-makeup-behind/

[jueqingsizhe66]

#lang scheme
;; Casting SPELs in LISP, scheme version

(define *objects* '(whiskey-bottle bucket frog chain))

(define *map* '((living-room (Your in the living room. Its dusty and dirty.)
                             (west door garden)
                             (upstairs stairway attic))
                (garden (Your in the garden. There stands a well.)
                        (east door living-room))
                (attic (Your in the attic. There is a welding torch in the corner.)
                          (downstairs stairway living-room))))

(define *object-locations* '((whiskey-bottle living-room)
                             (bucket living-room)
                             (frog garden)
                             (chain garden)))

(define *location* 'living-room)

(define *chain-welded* #f)

(define *bucket-filled* #f)

(define (describe-location location map)
  (cadr (assoc location map)))

(define (describe-path path)
  `(There is a ,(cadr path) going ,(car path) from here.))

(define (describe-paths location the-map)
  (apply append (map describe-path (cddr (assoc location the-map)))))

(define (is-at? obj loc obj-loc)
  (eq? (cadr (assoc obj obj-loc)) loc))

(define (describe-floor loc objs obj-loc)
  (apply append (map (lambda (x)
                       `(you see a ,x on the floor.))
                     (filter (lambda (x)
                               (is-at? x loc obj-loc))
                             objs))))

(define (look)
  (append (describe-location *location* *map*)
          (describe-paths *location* *map*)
          (describe-floor *location* *objects* *object-locations*)))

(define (walk-direction direction)
  (let ((next (assoc direction (cddr (assoc *location* *map*)))))
    (cond (next (set! *location* (caddr next)) (look))
          (else '(you cant go that way.)))))

(define-syntax-rule (defspel rest ...)
  (define-syntax-rule rest ...))

(defspel (walk direction)
  (walk-direction 'direction))

(define-syntax-rule (push! object location)
  (set! location (cons object location)))

(define-syntax-rule (pop! location)
  (let ((result (car location)))
    (set! location (cdr location))
    result))

(define (pickup-object object)
  (cond ((is-at? object *location* *object-locations*)
         (push! (list object 'body) *object-locations*)
         `(You are now carrying the ,object))
        (else '(You cannot get that.))))

(defspel (pickup object)
  (pickup-object 'object))

(define (inventory)
  (filter (lambda (x)
            (is-at? x 'body *object-locations*))
          *objects*))

(define (have? object)
  (member object (inventory)))

;(define (weld subject object)
;  (cond ((and (eq? *location* 'attic)
;              (eq? subject 'chain)
;              (eq? object 'bucket)
;              (have? 'chain)
;              (have? 'bucket)
;              (not *chain-welded*))
;         (set! *chain-welded* #t)
;         '(The chain is now securely welded to the bucket.))
;        (else '(You cannot weld like that.))))
;
;(define (dunk subject object)
;  (cond ((and (eq? *location* 'garden)
;              (eq? subject 'bucket)
;              (eq? object 'well)
;              (have? 'bucket)
;              *chain-welded*)
;         (set! *bucket-filled* #t)
;         '(The bucket is now full of water))
;        (else '(You cannot dunk like that.))))

(defspel (game-action command subj obj place rest ...)
  (defspel (command subject object)
    (cond [(and (eq? *location* 'place)
                (eq? 'subject 'subj)
                (eq? 'object 'obj)
                (have 'subj))
           rest ...]
          [else '(i cant command like that.)])))

(game-action weld chain bucket attic
  (cond [(have 'bucket)
         (set! *chain-welded* #t)
         '(the chain is now securely welded to the bucket.)]
        [else '(you do not have a bucket.)]))

(game-action dunk bucket well garden
  (cond [*chain-welded*
         (set! *bucket-filled* #t)
         '(the bucket is now full of water)]
        [else '(the water level is too low to reach.)]))

(game-action splash bucket wizard living-room
  (cond [(not *bucket-filled*) '(the bucket has nothing in it.)]
        [(have 'frog) '(the wizard awakens and sees that you stole his frog. he is so upset he banishes you to the netherworlds- you lose! the end.)]
        [else '(the wizard awakens from his slumber and greets you warmly. he hands you the magic low-carb donut- you win! the end.)]))