diff --git a/beautiful-racket/br/demo/txtadv.rkt b/beautiful-racket/br/demo/txtadv.rkt
new file mode 100644
index 0000000..6859b19
--- /dev/null
+++ b/beautiful-racket/br/demo/txtadv.rkt
@@ -0,0 +1,5 @@
+#lang br
+
+(module+ reader
+  (require "txtadv/reader.rkt")
+  (provide (all-from-out "txtadv/reader.rkt")))
diff --git a/beautiful-racket/br/demo/txtadv/color.rkt b/beautiful-racket/br/demo/txtadv/color.rkt
new file mode 100644
index 0000000..0e475f1
--- /dev/null
+++ b/beautiful-racket/br/demo/txtadv/color.rkt
@@ -0,0 +1,196 @@
+#lang racket/base
+(require parser-tools/lex
+         syntax-color/scheme-lexer
+         (prefix-in : parser-tools/lex-sre))
+
+(provide color-lexer)
+
+(define-lex-abbrevs 
+  [id (:: (:/ #\A #\Z #\a #\z) (:* (:or (:/ #\A #\Z #\a #\z #\0 #\9) #\-)))]
+
+  [digit8 (:/ "0" "7")]
+  [digit16 (:/ "af" "AF" "09")]
+
+  [unicode  (:or (:: "u" (:** 1 4 digit16))
+                 (:: "U" (:** 1 6 digit16)))]
+   
+  [str (:: "\"" (:* string-element (:: "\\" unicode)) "\"")]
+  [string-element (:or (:~ "\"" "\\")
+                       "\\\""
+                       "\\\\"
+                       "\\a"
+                       "\\b"
+                       "\\t"
+                       "\\n"
+                       "\\v"
+                       "\\f"
+                       "\\r"
+                       "\\e"
+                       "\\'"
+                       (:: "\\" (:** 1 3 digit8))
+                       (:: "\\x" (:** 1 2 digit16))
+                       (:: "\\" #\newline))])
+
+(define errors
+  (lexer
+   [any-char
+    (values lexeme 'error #f (position-offset start-pos) (position-offset end-pos) 
+            1 (list inc-errors 1))]
+   [(eof)
+    (values lexeme 'eof #f #f #f 0 #f)]))
+
+(define (inc-errors in back)
+  (define-values (lexeme type data new-token-start new-token-end backup mode) 
+    (errors in))
+  (values lexeme type data new-token-start new-token-end 
+          (+ 1 (car back))
+          (list inc-errors (+ 1 (car back)))))
+
+(define-syntax-rule (lexer/error [pat (_values kind next)] ...)
+  (lexer
+   [pat
+    (values lexeme kind #f (position-offset start-pos) (position-offset end-pos) 0 next)]
+   ...
+   [any-char
+    (values lexeme 'error #f (position-offset start-pos) (position-offset end-pos) 0 errors)]
+   [(eof)
+    (values lexeme 'eof #f #f #f 0 #f)]))
+
+(define-syntax-rule (lexer/whitespace ws clause ...)
+  (lexer/error
+   [(:+ whitespace)
+    (values lexeme ws)]
+   clause ...))
+
+(define section-color 'other)
+(define id-color 'symbol)
+
+(define start
+  (lexer/whitespace
+   #f
+   ["===VERBS===" (values section-color verbs)]))
+
+(define verbs
+  (lexer/whitespace
+   verbs
+   [id (values id-color verb-trans)]
+   ["===EVERYWHERE===" (values section-color everywhere)]))
+
+(define verb-trans
+  (lexer/whitespace
+   verb-body
+   [" _" (values 'symbol verb-comma)]
+   [", " (values 'other verbs)]))
+
+(define verb-comma
+  (lexer/whitespace
+   verb-body
+   [", " (values 'other verbs)]))
+
+(define verb-body
+  (lexer/whitespace
+   verb-body
+   [str (values 'string verbs)]
+   [id (values id-color verb-trans)]
+   ["===EVERYWHERE===" (values section-color everywhere)]))
+
+(define everywhere
+  (lexer/whitespace
+   everywhere
+   [id (values id-color (list global-action))]
+   ["===THINGS===" (values section-color things)]))
+
+(define things
+  (lexer/whitespace
+   things
+   [(:: "---" id "---") (values id-color thing-operations)]
+   ["===PLACES===" (values section-color places)]))
+
+(define thing-operations
+  (lexer/whitespace
+   thing-operations
+   [id (values id-color (list thing-action))]
+   [(:: "---" id "---") (values id-color thing-operations)]
+   ["===PLACES===" (values section-color places)]))
+
+(define places
+  (lexer/whitespace
+   places
+   [(:: "---" id "---") (values id-color place)]))
+
+(define place
+  (lexer/whitespace
+   place
+   [str (values 'string place-things)]))
+
+(define place-things
+  (lexer/whitespace
+   place-things
+   ["[" (values 'string place-thing-seq)]))
+
+(define place-thing-seq
+  (lexer/whitespace
+   errors
+   [id (values id-color place-thing-seq-next)]
+   ["]" (values 'string place-operations)]))
+
+(define place-thing-seq-next
+  (lexer/whitespace
+   errors
+   [", " (values 'other place-thing-seq)]
+   ["]" (values 'string place-operations)]))
+
+(define place-operations
+  (lexer/whitespace
+   place-operations
+   [(:: "---" id "---") (values id-color place)]
+   [id (values id-color (list place-action))]))
+
+(define (global-action in mode)
+  (action in mode global-action everywhere))
+
+(define (thing-action in mode)
+  (action in mode thing-action thing-operations))
+
+(define (place-action in mode)
+  (action in mode place-action place-operations))
+
+(define (action in mode self next)
+  (define-values (lexeme type data new-token-start new-token-end status) 
+    (scheme-lexer/status in))
+  (let ([mode (next-mode mode type data status)])
+    (values lexeme 
+            (if (eq? mode 'error) 'error type)
+            data new-token-start new-token-end 0 
+            (cond
+             [(list? mode) (cons self mode)]
+             [(eq? mode 'error) errors]
+             [else next]))))
+
+(define (next-mode mode type data status)
+  (case type 
+    [(parenthesis)
+     (case data
+       [(|(|) (cons '|)| mode)]
+       [(|[|) (cons '|]| mode)]
+       [(|{|) (cons '|}| mode)]
+       [else (if (and (pair? mode)
+                      (eq? (car mode) data))
+                 (if (and (null? (cdr mode))
+                          (not (eq? status 'continue)))
+                     'done
+                     (cdr mode))
+                 'error)])]
+    [(white-space comment) mode]
+    [else (if (and (null? mode)
+                   (not (eq? status 'continue)))
+              'done
+              mode)]))
+
+(define (color-lexer in offset mode)
+  (cond
+   [(not mode) (start in)]
+   [(pair? mode)
+    ((car mode) in (cdr mode))]
+   [else
+    (mode in)]))
diff --git a/beautiful-racket/br/demo/txtadv/expander.rkt b/beautiful-racket/br/demo/txtadv/expander.rkt
new file mode 100644
index 0000000..677d843
--- /dev/null
+++ b/beautiful-racket/br/demo/txtadv/expander.rkt
@@ -0,0 +1,347 @@
+#lang racket
+
+(provide define-verbs
+         define-thing
+         define-place
+         define-everywhere
+         
+         show-current-place
+         show-inventory
+         save-game
+         load-game
+         show-help
+         
+         have-thing?
+         take-thing!
+         drop-thing!
+         thing-state
+         set-thing-state!
+         
+         (except-out (all-from-out racket) #%module-begin)
+         (rename-out [module-begin #%module-begin]))
+
+;; ============================================================
+;; Overall module:
+
+(define-syntax module-begin
+  (syntax-rules (define-verbs define-everywhere)
+    [(_ (define-verbs all-verbs cmd ...)
+        (define-everywhere everywhere-actions act ...)
+        decl ...
+        id)
+     (#%module-begin
+      (define-verbs all-verbs cmd ...)
+      (define-everywhere everywhere-actions act ...)
+      decl ...
+      (init-game (check-type id "place")
+                 all-verbs
+                 everywhere-actions)
+      (provide do-verb do-place)
+      (module+ main
+        (cmd-line-mode? #t)
+        (do-place)))]))
+
+;; ============================================================
+;; Model:
+
+;; Elements of the world:
+(struct verb (aliases       ; list of symbols
+              desc          ; string
+              transitive?)) ; boolean
+(struct thing (name         ; symbol
+               [state #:mutable] ; any value
+               actions))    ; list of verb--thunk pairs
+(struct place (desc         ; string
+               [things #:mutable] ; list of things
+               actions))    ; list of verb--thunk pairs
+
+;; Tables mapping names<->things for save and load
+(define names (make-hash))
+(define elements (make-hash))
+
+(define (record-element! name val)
+  (hash-set! names name val)
+  (hash-set! elements val name))
+
+(define (name->element name) (hash-ref names name #f))
+(define (element->name obj) (hash-ref elements obj #f))
+
+;; ============================================================
+;; Simple type layer:
+
+(begin-for-syntax 
+  (struct typed (id type) 
+    #:property prop:procedure (λ (self stx) (typed-id self))
+    #:omit-define-syntaxes))
+
+(define-syntax (check-type stx)
+  (syntax-case stx ()
+    [(_ id type)
+     (let ([v (and (identifier? #'id)
+                   (syntax-local-value #'id (λ _ #f)))])
+       (unless (and (typed? v)
+                    (equal? (syntax-e #'type) (typed-type v)))
+         (raise-syntax-error
+          #f
+          (format "not defined as ~a" (syntax-e #'type))
+          #'id))
+       #'id)]))
+
+;; ============================================================
+;; Macros for constructing and registering elements:
+
+(define-syntax-rule (define-verbs all-id
+                      [id spec ...] ...)
+  (begin
+    (define-one-verb id spec ...) ...
+    (record-element! 'id id) ...
+    (define all-id (list id ...))))
+
+(define-syntax define-one-verb
+  (syntax-rules (= _)
+    [(define-one-verb id (= alias ...) desc)
+     (begin
+       (define gen-id (verb (list 'id 'alias ...) desc #f))
+       (define-syntax id (typed #'gen-id "intransitive verb")))]
+    [(define-one-verb id _ (= alias ...) desc)
+     (begin
+       (define gen-id (verb (list 'id 'alias ...) desc #t))
+       (define-syntax id (typed #'gen-id "transitive verb")))]
+    [(define-one-verb id)
+     (define-one-verb id (=) (symbol->string 'id))]
+    [(define-one-verb id _)
+     (define-one-verb id _ (=) (symbol->string 'id))]))
+
+(define-syntax-rule (define-thing id 
+                      [vrb expr] ...)
+  (begin
+    (define gen-id 
+      (thing 'id #f (list (cons (check-type vrb "transitive verb")
+                                (λ _ expr)) ...)))
+    (define-syntax id (typed #'gen-id "thing"))
+    (record-element! 'id id)))
+
+
+(define-syntax-rule (define-place id 
+                      desc 
+                      (thng ...) 
+                      ([vrb expr] ...))
+  (begin
+    (define gen-id 
+      (place desc
+             (list (check-type thng "thing") ...)
+             (list (cons (check-type vrb "intransitive verb")
+                         (λ _ expr)) 
+                   ...)))
+    (define-syntax id (typed #'gen-id "place"))
+    (record-element! 'id id)))
+
+
+(define-syntax-rule (define-everywhere id ([vrb expr] ...))
+  (define id (list (cons (check-type vrb "intransitive verb")
+                         (λ _ expr)) 
+                   ...)))
+
+;; ============================================================
+;; Game state
+
+(define cmd-line-mode? (make-parameter #f))
+;; Initialized on startup:
+(define all-verbs null)          ; list of verbs
+(define everywhere-actions null) ; list of verb--thunk pairs
+
+;; Things carried by the player:
+(define stuff null) ; list of things
+
+;; Current location:
+(define current-place #f) ; place (or #f until started)
+
+;; Fuctions to be used by verb responses:
+(define (have-thing? t)
+  (memq t stuff))
+(define (take-thing! t) 
+  (set-place-things! current-place (remq t (place-things current-place)))
+  (set! stuff (cons t stuff)))
+(define (drop-thing! t) 
+  (set-place-things! current-place (cons t (place-things current-place)))
+  (set! stuff (remq t stuff)))
+
+;; ============================================================
+;; Game execution
+
+;; Show the player the current place, then get a command:
+(define (do-place)
+  (show-current-place)
+  (when (cmd-line-mode?)
+    (do-verb)))
+
+;; Show the current place:
+(define (show-current-place)
+  (printf "~a\n" (place-desc current-place))
+  (for-each (λ (thing)
+              (printf "There is a ~a here.\n" (thing-name thing)))
+            (place-things current-place)))
+
+;; Get and handle a command:
+
+(define (get-line)
+  (printf "> ")
+  (flush-output)
+  (read-line))
+
+(define (do-verb [line (and (cmd-line-mode?) (get-line))])
+  (define input (if (eof-object? line)
+                    '(quit)
+                    (let ([port (open-input-string line)])
+                      (for/list ([v (in-port read port)]) v))))  
+  (if (and (list? input)
+           (andmap symbol? input)
+           (<= 1 (length input) 2))
+      (let* ([vrb (car input)]
+             [response
+              (cond
+                [(= 2 (length input))
+                 (handle-transitive-verb vrb (cadr input))]
+                [(= 1 (length input))
+                 (handle-intransitive-verb vrb)])]
+             [result (response)])
+        (cond
+          [(place? result)
+           (set! current-place result)
+           (do-place)]
+          [(string? result)
+           (printf "~a\n" result)
+           (when (cmd-line-mode?) (do-verb))]
+          [else (when (cmd-line-mode?) (do-verb))]))
+      (begin
+        (printf "I don't undertand what you mean.\n")
+        (when (cmd-line-mode?) (do-verb)))))
+
+;; Handle an intransitive-verb command:
+(define (handle-intransitive-verb verb)
+  (or
+   (find-verb verb (place-actions current-place))
+   (find-verb verb everywhere-actions)
+   (using-verb 
+    verb all-verbs
+    (λ (verb)
+      (λ _ (if (verb-transitive? verb)
+               (format "~a what?" (string-titlecase (verb-desc verb)))
+               (format "Can't ~a here." (verb-desc verb))))))
+   (λ _ (format "I don't know how to ~a." verb))))
+
+;; Handle a transitive-verb command:
+(define (handle-transitive-verb vrb obj)
+  (or (using-verb 
+       vrb all-verbs
+       (λ (verb)
+         (and 
+          (verb-transitive? verb)
+          (cond
+            [(ormap (λ (thing)
+                      (and (eq? (thing-name thing) obj)
+                           thing))
+                    (append (place-things current-place)
+                            stuff))
+             => (λ (thing)
+                  (or (find-verb vrb (thing-actions thing))
+                      (λ _
+                        (format "Don't know how to ~a ~a."
+                                (verb-desc verb) obj))))]
+            [else
+             (λ _ (format "There's no ~a here to ~a." obj 
+                          (verb-desc verb)))]))))
+      (λ _ (format "I don't know how to ~a ~a." vrb obj))))
+
+;; Show what the player is carrying:
+(define (show-inventory)
+  (printf "You have")
+  (if (null? stuff)
+      (printf " no items.")
+      (for-each (λ (thing)
+                  (printf "\n  a ~a" (thing-name thing)))
+                stuff))
+  (printf "\n"))
+
+;; Look for a command match in a list of verb--response pairs,
+;; and returns the response thunk if a match is found:
+(define (find-verb cmd actions)
+  (ormap (λ (a)
+           (and (memq cmd (verb-aliases (car a)))
+                (cdr a)))
+         actions))
+
+;; Looks for a command in a list of verbs, and
+;; applies `success-k' to the verb if one is found:
+(define (using-verb cmd verbs success-k)
+  (ormap (λ (vrb)
+           (and (memq cmd (verb-aliases vrb))
+                (success-k vrb)))
+         verbs))
+
+;; Print help information:
+(define (show-help)
+  (printf "Use `look' to look around.\n")
+  (printf "Use `inventory' to see what you have.\n")
+  (printf "Use `save' or `load' to save or restore your game.\n")
+  (printf "There are some other verbs, and you can name a thing after some verbs.\n"))
+
+;; ============================================================
+;; Save and load
+
+;; Prompt the user for a filename and apply `proc' to it,
+;; catching errors to report a reasonably nice message:
+(define (with-filename proc)
+  (printf "File name: ")
+  (flush-output)
+  (let ([v (read-line)])
+    (unless (eof-object? v)
+      (with-handlers ([exn? (λ (exn)
+                              (printf "~a\n" (exn-message exn)))])
+        (unless (path-string? v)
+          (raise-user-error "bad filename"))
+        (proc v)))))
+
+;; Save the current game state:
+(define (save-game)
+  (with-filename
+   (λ (v)
+     (with-output-to-file v
+       (λ _
+         (write
+          (list
+           (map element->name stuff)
+           (element->name current-place)
+           (hash-map names
+                     (λ (k v)
+                       (cons k
+                             (cond
+                               [(place? v) (map element->name (place-things v))]
+                               [(thing? v) (thing-state v)]
+                               [else #f])))))))))))
+
+;; Restore a game state:
+(define (load-game)
+  (with-filename
+   (λ (v)
+     (let ([v (with-input-from-file v read)])
+       (set! stuff (map name->element (car v)))
+       (set! current-place (name->element (cadr v)))
+       (for-each
+        (λ (p)
+          (let ([v (name->element (car p))]
+                [state (cdr p)])
+            (cond
+              [(place? v) (set-place-things! v (map name->element state))]
+              [(thing? v) (set-thing-state! v state)])))
+        (caddr v))))))
+
+;; ============================================================
+;; To go:
+
+(define (init-game in-place
+                   in-all-verbs
+                   in-everywhere-actions)
+  (set! current-place in-place)
+  (set! all-verbs in-all-verbs)
+  (set! everywhere-actions in-everywhere-actions))
diff --git a/beautiful-racket/br/demo/txtadv/main.rkt b/beautiful-racket/br/demo/txtadv/main.rkt
new file mode 100644
index 0000000..71f1a98
--- /dev/null
+++ b/beautiful-racket/br/demo/txtadv/main.rkt
@@ -0,0 +1,5 @@
+#lang br
+
+(module+ reader
+  (require "reader.rkt")
+  (provide (all-from-out "reader.rkt")))
diff --git a/beautiful-racket/br/demo/txtadv/reader.rkt b/beautiful-racket/br/demo/txtadv/reader.rkt
new file mode 100644
index 0000000..aac2996
--- /dev/null
+++ b/beautiful-racket/br/demo/txtadv/reader.rkt
@@ -0,0 +1,160 @@
+#lang racket
+(require syntax/readerr)
+
+(provide (rename-out [txtadv-read-syntax read-syntax])
+         ;; added at the end to link syntax to colorer:
+         get-info)
+
+(define (txtadv-read-syntax src in)
+  (expect-section src in "VERBS")
+  (define verbs (in-section src in read-verb))
+  (expect-section src in "EVERYWHERE")
+  (define actions (in-section src in read-action))
+  (expect-section src in "THINGS")
+  (define things (in-section src in read-thing))
+  (expect-section src in "PLACES")
+  (define places (in-section src in read-place))
+  (datum->syntax
+   #f
+   `(module world br/demo/txtadv/expander
+      (define-verbs all-verbs
+        ,@verbs)
+      (define-everywhere everywhere-actions
+        ,actions)
+      ,@things
+      ,@places
+      ,(if (null? places)
+           (complain src in "no places defined")
+           (cadar places)))))
+
+(define (complain src in msg)
+  (define-values (line col pos) (port-next-location in))
+  (raise-read-error msg src line col pos 1))
+
+(define (skip-whitespace in)
+  (regexp-try-match #px"^\\s+" in))
+      
+(define (expect-section src in name)
+  (skip-whitespace in)
+  (unless (regexp-match-peek (pregexp (format "^===~a===\\s" name))
+                             in)
+    (complain src in (format "expected a ===~a=== section" name)))
+  (read-line in)
+  (read-line in))
+
+(define (in-section src in reader)
+  (skip-whitespace in)
+  (if (or (regexp-match-peek #rx"^===" in)
+          (eof-object? (peek-byte in)))
+      null
+      (cons (reader src in)
+            (in-section src in reader))))
+
+(define (in-defn src in reader)
+  (skip-whitespace in)
+  (if (or (regexp-match-peek #rx"^(===|---)" in)
+          (eof-object? (peek-byte in)))
+      null
+      (cons (reader src in)
+            (in-defn src in reader))))
+
+(define (read-name src in)
+  (if (regexp-match-peek #px"^[A-Za-z-]+(?=:$|\\s|[],])" in)
+      (read-syntax src in)
+      (complain src in "expected a name")))
+
+(define (read-name-sequence src in transitive)
+  (let loop ([names null] [transitive transitive])
+    (define s (read-name src in))
+    (define is-trans?
+      (cond
+       [(regexp-match-peek #rx"^ _" in)
+        (if (or (eq? transitive 'unknown)
+                (eq? transitive #t))
+            (begin
+              (read-char in)
+              (read-char in)
+              #t)
+            (begin
+              (read-char in)
+              (complain src in "unexpected underscore")))]
+       [else
+        (if (eq? transitive #t)
+            (complain src in "inconsistent transitivity")
+            #f)]))
+    (if (regexp-match-peek #rx"^, " in)
+        (begin
+          (read-char in)
+          (read-char in)
+          (loop (cons s names) is-trans?))
+        (values (reverse (cons s names)) is-trans?))))
+
+(define (read-verb src in)
+  (skip-whitespace in)
+  (define-values (names is-transitive?)
+    (read-name-sequence src in 'unknown))
+  (skip-whitespace in)
+  (define desc
+    (if (regexp-match-peek #rx"^\"" in)
+        (read-syntax src in)
+        (symbol->string (syntax-e (car names)))))
+  `[,(car names) 
+    ,@(if is-transitive? '(_) '())
+    (= ,@(cdr names))
+    ,desc])
+
+(define (read-action src in)
+  (skip-whitespace in)
+  (define name (read-name src in))
+  (define expr (read-syntax src in))
+  `[,name ,expr])
+
+(define (read-defn-name src in what)
+  (skip-whitespace in)
+  (unless (regexp-match-peek #px"^---[A-Za-z][A-Za-z0-9-]*---\\s"
+                             in)
+    (complain src in (format "expected a ~a definition of the form ---name---" what)))
+  (read-string 3 in)
+  (define-values (line col pos) (port-next-location in))
+  (define name-str (bytes->string/utf-8 (cadr (regexp-match #px"^(.*?)---\\s" in))))
+  (datum->syntax #f
+                 (string->symbol name-str)
+                 (vector src line col pos (string-length name-str))
+                 orig-props))
+(define orig-props (read-syntax 'src (open-input-string "orig")))
+
+(define (read-thing src in)
+  (define name (read-defn-name src in "thing"))
+  (define actions (in-defn src in read-action))
+  `(define-thing ,name
+     ,@actions))
+
+(define (read-place src in)
+  (define name (read-defn-name src in "place"))
+  (skip-whitespace in)
+  (define desc (if (regexp-match-peek #rx"^\"" in)
+                   (read-syntax src in)
+                   (complain src in "expected description string")))
+  (skip-whitespace in)
+  (unless (regexp-match-peek #rx"^[[]" in)
+    (complain src in "expected a square bracket to start a list of things for a place"))
+  (read-char in)
+  (define-values (things _) 
+    (if (regexp-match-peek #rx"^[]]" in)
+        (values null #f)
+        (read-name-sequence src in #f)))
+  (unless (regexp-match-peek #rx"^[]]" in)
+    (complain src in "expected a square bracket to end a list of things for a place"))
+  (read-char in)
+  (define actions (in-defn src in read-action))
+  `(define-place ,name ,desc ,things ,actions))
+
+;; DrRacket asks `get-info' for a 'color-lexer module:
+(require racket/runtime-path)
+(define-runtime-path color-lexer-path "color.rkt")
+(define (get-info in mod line col pos)
+  (lambda (key default)
+    (case key
+      [(color-lexer)
+       (dynamic-require color-lexer-path 'color-lexer)]
+      [else default])))
diff --git a/beautiful-racket/br/demo/txtadv/world-test.rkt b/beautiful-racket/br/demo/txtadv/world-test.rkt
new file mode 100644
index 0000000..c5c6edf
--- /dev/null
+++ b/beautiful-racket/br/demo/txtadv/world-test.rkt
@@ -0,0 +1,41 @@
+#lang at-exp racket
+(require rackunit)
+(require "world.rkt")
+
+(check-equal? (with-output-to-string (λ _ (do-place)))
+              "You're standing in a meadow. There is a house to the north.\n")
+
+(define-syntax-rule (check-cmd? cmd result)
+  (check-equal? (with-output-to-string (λ _ (do-verb cmd))) result))
+
+(check-cmd?
+ "s"
+ "You're in a desert. There is nothing for miles around.\nThere is a cactus here.\nThere is a key here.\n")
+
+(check-cmd?
+ "get cactus"
+ "Ouch!\n")
+
+(check-cmd?
+ "get key"
+ "You now have the key.\n")
+
+(check-cmd?
+ "n"
+ "You're standing in a meadow. There is a house to the north.\n")
+
+(check-cmd?
+ "n"
+ "You are standing in front of a house.\nThere is a door here.\n")
+
+(check-cmd?
+ "open door"
+ "The door is now unlocked and open.\n")
+
+(check-cmd?
+ "enter"
+ "You're in the house.\nThere is a trophy here.\n")
+
+(check-cmd?
+ "get trophy"
+ "You win!\n")
\ No newline at end of file
diff --git a/beautiful-racket/br/demo/txtadv/world.rkt b/beautiful-racket/br/demo/txtadv/world.rkt
new file mode 100644
index 0000000..ca75116
--- /dev/null
+++ b/beautiful-racket/br/demo/txtadv/world.rkt
@@ -0,0 +1,176 @@
+#lang br/demo/txtadv
+
+===VERBS===
+
+north, n
+ "go north"
+
+south, s
+ "go south"
+
+east, e
+ "go east"
+
+west, w
+ "go west"
+
+up
+ "go up"
+
+down
+ "go down"
+
+in, enter
+ "enter"
+
+out, leave
+ "leave"
+
+get _, grab _, take _
+ "take"
+
+put _, drop _, leave _
+ "drop"
+
+open _, unlock _
+ "open"
+
+close _, lock _
+ "close"
+
+knock _
+
+quit, exit
+ "quit"
+
+look, show
+ "look"
+
+inventory
+ "check inventory"
+
+help
+
+save
+
+load
+
+
+===EVERYWHERE===
+
+quit 
+ (begin
+  (printf "Bye!\n")
+  (exit))
+
+look 
+ (show-current-place)
+
+inventory 
+ (show-inventory)
+
+save
+ (save-game)
+
+load
+ (load-game)
+
+help
+ (show-help)
+
+
+===THINGS===
+
+---cactus---
+get
+  "Ouch!"
+
+---door---
+open 
+  (if (have-thing? key)
+      (begin
+        (set-thing-state! door 'open)
+        "The door is now unlocked and open.")
+      "The door is locked.")
+
+close
+  (begin
+   (set-thing-state! door #f)
+   "The door is now closed.")
+
+knock
+  "No one is home."
+
+---key---
+
+get
+  (if (have-thing? key)
+      "You already have the key."
+      (begin
+        (take-thing! key)
+        "You now have the key."))
+
+put
+  (if (have-thing? key)
+      (begin
+        (drop-thing! key)
+        "You have dropped the key.")
+      "You don't have the key.")
+
+---trophy---
+
+get
+  (begin
+   (take-thing! trophy)
+   "You win!")
+
+
+===PLACES===
+
+---meadow---
+"You're standing in a meadow. There is a house to the north."
+[]
+
+north
+ house-front
+
+south
+ desert
+
+
+---house-front---
+"You are standing in front of a house."
+[door]
+
+in 
+  (if (eq? (thing-state door) 'open)
+      room
+      "The door is not open.")
+
+south
+  meadow
+
+
+---desert---
+"You're in a desert. There is nothing for miles around."
+[cactus, key]
+
+north
+  meadow
+
+south
+  desert
+
+east
+  desert
+
+west
+  desert
+
+
+---room---
+"You're in the house."
+[trophy]
+
+out
+  house-front