|
|
@ -21,7 +21,7 @@
|
|
|
|
;; ============================================================
|
|
|
|
;; ============================================================
|
|
|
|
;; Overall module:
|
|
|
|
;; Overall module:
|
|
|
|
|
|
|
|
|
|
|
|
(define #'(module-begin _lines ...)
|
|
|
|
(define-macro (module-begin _lines ...)
|
|
|
|
#'(#%module-begin
|
|
|
|
#'(#%module-begin
|
|
|
|
_lines ...
|
|
|
|
_lines ...
|
|
|
|
|
|
|
|
|
|
|
@ -35,46 +35,44 @@
|
|
|
|
;; Process parse trees from the reader:
|
|
|
|
;; Process parse trees from the reader:
|
|
|
|
|
|
|
|
|
|
|
|
(provide txtadv-program)
|
|
|
|
(provide txtadv-program)
|
|
|
|
(define #'txtadv-program #'module-begin)
|
|
|
|
(define-macro txtadv-program #'module-begin)
|
|
|
|
|
|
|
|
|
|
|
|
(provide verb-section)
|
|
|
|
(provide verb-section)
|
|
|
|
(define #'(verb-section
|
|
|
|
(define-macro-cases verb-section
|
|
|
|
((_name0 . _transitive0?)
|
|
|
|
[(_ ((NAME0 . TRANSITIVE0?) (NAME . _) ... DESC) ...)
|
|
|
|
(_name . _transitive?) ... _desc) ...)
|
|
|
|
(mark-as-shared-id
|
|
|
|
(inject-syntax ([#'in-verbs (shared-syntax 'in-verbs)])
|
|
|
|
(in-verbs)
|
|
|
|
#'(define-verbs in-verbs
|
|
|
|
#'(define-verbs in-verbs
|
|
|
|
[_name0 #,@(if (syntax->datum #'_transitive0?) #'(_) #'()) (= _name ...) _desc] ...)))
|
|
|
|
[(NAME0 . TRANSITIVE0?) (= NAME ...) DESC] ...))])
|
|
|
|
|
|
|
|
|
|
|
|
(provide everywhere-section)
|
|
|
|
(provide everywhere-section)
|
|
|
|
(define #'(everywhere-section [_id _desc] ...)
|
|
|
|
(define-macro (everywhere-section [ID DESC] ...)
|
|
|
|
#'(define-everywhere everywhere-actions
|
|
|
|
#'(define-everywhere everywhere-actions
|
|
|
|
([_id _desc] ...)))
|
|
|
|
([ID DESC] ...)))
|
|
|
|
|
|
|
|
|
|
|
|
(provide things-section)
|
|
|
|
(provide things-section)
|
|
|
|
(define #'(things-section (_thingname (_actionname _actiondesc) ...) ...)
|
|
|
|
(define-macro (things-section (THINGNAME (ACTIONNAME ACTIONDESC) ...) ...)
|
|
|
|
#'(begin (define-thing _thingname [_actionname _actiondesc] ...) ...))
|
|
|
|
#'(begin (define-thing THINGNAME [ACTIONNAME ACTIONDESC] ...) ...))
|
|
|
|
|
|
|
|
|
|
|
|
(provide places-section)
|
|
|
|
(provide places-section)
|
|
|
|
(define #'(places-section (_place-id _place-desc [_place-item ...] [_actionname _actiondesc] ...) ...)
|
|
|
|
(define-macro (places-section (PLACE-ID PLACE-DESC [PLACE-ITEM ...] [ACTIONNAME ACTIONDESC] ...) ...)
|
|
|
|
#'(begin (define-place _place-id _place-desc [_place-item ...] ([_actionname _actiondesc] ...)) ...))
|
|
|
|
#'(begin (define-place PLACE-ID PLACE-DESC [PLACE-ITEM ...] ([ACTIONNAME ACTIONDESC] ...)) ...))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; todo: consolidate the game-starters.
|
|
|
|
;; todo: consolidate the game-starters.
|
|
|
|
;; `start-game-at` works with s-exp language,
|
|
|
|
;; `start-game-at` works with s-exp language,
|
|
|
|
;; `start-section` works with text lang.
|
|
|
|
;; `start-section` works with text lang.
|
|
|
|
(provide start-game-at)
|
|
|
|
(provide start-game-at)
|
|
|
|
(define #'(start-game-at _where)
|
|
|
|
(define-macro (start-game-at WHERE)
|
|
|
|
(inject-syntax ([#'in-verbs (shared-syntax 'in-verbs)])
|
|
|
|
#'(init-game WHERE
|
|
|
|
#'(init-game _where
|
|
|
|
in-verbs
|
|
|
|
in-verbs
|
|
|
|
everywhere-actions))
|
|
|
|
everywhere-actions)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(provide start-section)
|
|
|
|
(provide start-section)
|
|
|
|
(define #'(start-section _where)
|
|
|
|
(define-macro (start-section WHERE)
|
|
|
|
(inject-syntax ([#'in-verbs (shared-syntax 'in-verbs)])
|
|
|
|
#'(init-game WHERE
|
|
|
|
#'(init-game _where
|
|
|
|
in-verbs
|
|
|
|
in-verbs
|
|
|
|
everywhere-actions))
|
|
|
|
everywhere-actions)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; ============================================================
|
|
|
|
;; ============================================================
|
|
|
|
;; Model:
|
|
|
|
;; Model:
|
|
|
@ -108,42 +106,42 @@
|
|
|
|
;; ============================================================
|
|
|
|
;; ============================================================
|
|
|
|
;; Macros for constructing and registering elements:
|
|
|
|
;; Macros for constructing and registering elements:
|
|
|
|
|
|
|
|
|
|
|
|
(define #'(define-verbs _all-id [_id _spec ...] ...)
|
|
|
|
(define-macro (define-verbs ALL-ID [(ID . MAYBE-UNDERSCORE) SPEC ...] ...)
|
|
|
|
#'(begin
|
|
|
|
#'(begin
|
|
|
|
(define-one-verb _id _spec ...) ...
|
|
|
|
(define-one-verb (ID . MAYBE-UNDERSCORE) SPEC ...) ...
|
|
|
|
(record-element! '_id _id) ...
|
|
|
|
(record-element! 'ID ID) ...
|
|
|
|
(define _all-id (list _id ...))))
|
|
|
|
(define ALL-ID (list ID ...))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; todo: the underscore arguments in cases 2 & 4 should be literal underscores, not wildcards
|
|
|
|
;; todo: the underscore arguments in cases 2 & 4 should be literal underscores, not wildcards
|
|
|
|
(define-cases #'define-one-verb
|
|
|
|
(define-macro (define-one-verb (ID . MAYBE-UNDERSCORE) . REST)
|
|
|
|
[#'(_ _id (= _alias ...) _desc)
|
|
|
|
(with-pattern
|
|
|
|
#'(define _id (verb (list '_id '_alias ...) _desc #f))]
|
|
|
|
([TRANSITIVE? (equal? '("_") (syntax->datum #'MAYBE-UNDERSCORE))]
|
|
|
|
[#'(_ _id _ (= _alias ...) _desc)
|
|
|
|
[VERB-ARGS (syntax-case #'REST ()
|
|
|
|
#'(define _id (verb (list '_id '_alias ...) _desc #t))]
|
|
|
|
[((= ALIAS ...) DESC)
|
|
|
|
[#'(_ _id)
|
|
|
|
#'((list 'ID 'ALIAS ...) DESC TRANSITIVE?)]
|
|
|
|
#'(define _id (verb (list '_id) (symbol->string '_id) #f))]
|
|
|
|
[else
|
|
|
|
[#'(_ _id _)
|
|
|
|
#'((list 'ID) (symbol->string 'ID) TRANSITIVE?)])])
|
|
|
|
#'(define _id (verb (list '_id) (symbol->string '_id) #t))])
|
|
|
|
#'(define ID (verb . VERB-ARGS))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define #'(define-thing _id [_vrb _expr] ...)
|
|
|
|
(define-macro (define-thing ID [VERB-ARG EXPR] ...)
|
|
|
|
#'(begin
|
|
|
|
#'(begin
|
|
|
|
(define _id
|
|
|
|
(define ID
|
|
|
|
(thing '_id #f (list (cons _vrb (λ () _expr)) ...)))
|
|
|
|
(thing 'ID #f (list (cons VERB-ARG (λ () EXPR)) ...)))
|
|
|
|
(record-element! '_id _id)))
|
|
|
|
(record-element! 'ID ID)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define #'(define-place _id _desc (_thng ...) ([_vrb _expr] ...))
|
|
|
|
(define-macro (define-place ID DESC (THING-ARG ...) ([VERB-ARG EXPR] ...))
|
|
|
|
#'(begin
|
|
|
|
#'(begin
|
|
|
|
(define _id (place _desc
|
|
|
|
(define ID (place DESC
|
|
|
|
(list _thng ...)
|
|
|
|
(list THING-ARG ...)
|
|
|
|
(list (cons _vrb (λ () _expr)) ...)))
|
|
|
|
(list (cons VERB-ARG (λ () EXPR)) ...)))
|
|
|
|
(record-element! '_id _id)))
|
|
|
|
(record-element! 'ID ID)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define #'(define-everywhere _id ([_vrb _expr] ...))
|
|
|
|
(define-macro (define-everywhere ID ([VERB-ARG EXPR] ...))
|
|
|
|
#'(define _id (list (cons _vrb (λ () _expr)) ...)))
|
|
|
|
#'(define ID (list (cons VERB-ARG (λ () EXPR)) ...)))
|
|
|
|
|
|
|
|
|
|
|
|
;; ============================================================
|
|
|
|
;; ============================================================
|
|
|
|
;; Game state
|
|
|
|
;; Game state
|
|
|
|