[plt-scheme] Re: Casting SPELs in Lisp^H^H^H^H Scheme

Excellent! :D
I do get an error, when trying to run this in DrScheme:
(set! *chain-welded* #t) -> set!: cannot modify a constant: *chain-
welded*

I am using Language : module, so it should use full scheme.

Any hints for a new Schemer? :)

On Jan 12, 3:51 am, Eli Barzilay <e... at barzilay.org> wrote:
> In case someone is interested in translatinghttp://www.lisperati.com/casting.html-- here's the code, translated
> to PLT.
>
> -------------------------------------------------------------------------------
> #lang scheme
>
> (define *objects* '(whiskey-bottle bucket frog chain))
>
> (define *map*
>   '((living-room (you are in the living-room of a wizards house. there is a wizard snoring loudly on the couch.)
>                  (west door garden)
>                  (upstairs stairway attic))
>     (garden (you are in a beautiful garden. there is a well in front of you.)
>             (east door living-room))
>     (attic (you are in the attic of the abandoned house. there is a giant welding torch in the corner.)
>            (downstairs stairway living-room))))
>
> (define *object-locations*
>   '((whiskey-bottle living-room)
>     (bucket living-room)
>     (chain garden)
>     (frog garden)))
>
> (define *location* 'living-room)
>
> (define (describe-location location map)
>   (second (assoc location map)))
>
> (define (describe-path path)
>   `(there is a ,(second path) going ,(first path) from here.))
>
> (define (describe-paths location map)
>   (append-map describe-path (cddr (assoc location map))))
>
> (define (is-at? obj loc obj-loc)
>   (eq? (second (assoc obj obj-loc)) loc))
>
> (define (describe-floor loc objs obj-loc)
>   (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* (third next)) (look)]
>           [else '(you cant go that way.)])))
>
> (define-syntax-rule (defspel rest ...) (define-syntax-rule rest ...))
>
> (defspel (walk direction)
>   (walk-direction 'direction))
>
> (defspel (push! x l) (set! l (cons x l)))
>
> (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 *chain-welded* #f)
>
> (define *bucket-filled* #f)
>
> (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.)]))
>
> -------------------------------------------------------------------------------
>
> --
>           ((lambda (x) (x x)) (lambda (x) (x x)))          Eli Barzilay:
>                    http://barzilay.org/                  Maze is Life!
> _________________________________________________
>   For list-related administrative tasks:
>  http://list.cs.brown.edu/mailman/listinfo/plt-scheme