add parsing for actions
This commit is contained in:
parent
cface5b7f9
commit
e9f392b51f
|
@ -21,22 +21,18 @@
|
||||||
;; ============================================================
|
;; ============================================================
|
||||||
;; Overall module:
|
;; Overall module:
|
||||||
|
|
||||||
(define #'(module-begin _arg ...)
|
(define #'(module-begin (txtadv-program _section ...))
|
||||||
#'(#%module-begin
|
#'(#%module-begin
|
||||||
'_arg ...))
|
_section ...))
|
||||||
|
|
||||||
(provide txtadv-program)
|
|
||||||
(define-inverting #'(txtadv-program _verb-section ...)
|
|
||||||
#'(_verb-section ...))
|
|
||||||
|
|
||||||
(provide verb-section)
|
(provide verb-section)
|
||||||
(define-inverting #'(verb-section _heading _verb-entry ...)
|
(define-inverting #'(verb-section _heading _verb-entry ...)
|
||||||
#'(define-verbs all-verbs
|
#''(define-verbs all-verbs
|
||||||
_verb-entry ...))
|
_verb-entry ...))
|
||||||
|
|
||||||
(provide verb-entry)
|
(provide verb-entry)
|
||||||
(define-inverting #'(verb-entry (_name0 _transitive0?) (_name _transitive?) ... _desc)
|
(define-inverting #'(verb-entry (_name0 _transitive0?) (_name _transitive?) ... _desc)
|
||||||
#`[_name0 #,@(if #'transitive0? #'(_) #'()) (= _name ...) _desc])
|
#`[_name0 #,@(if (syntax->datum #'_transitive0?) #'(_) #'()) (= _name ...) _desc])
|
||||||
|
|
||||||
(provide verb-name)
|
(provide verb-name)
|
||||||
(define-cases #'verb-name
|
(define-cases #'verb-name
|
||||||
|
@ -46,13 +42,23 @@
|
||||||
[#'(_ _id) #'(_id #f)]
|
[#'(_ _id) #'(_id #f)]
|
||||||
[#'(_ _id _underscore) #'(_id #t)])
|
[#'(_ _id _underscore) #'(_id #t)])
|
||||||
|
|
||||||
(provide s-exp)
|
(provide everywhere-section)
|
||||||
(define #'(s-exp _sx)
|
(define-inverting #'(everywhere-section _heading [_name _desc] ...)
|
||||||
#'_sx)
|
#''(define-everywhere everywhere-actions
|
||||||
|
([_name _desc] ...)))
|
||||||
|
|
||||||
|
(provide everywhere-action)
|
||||||
|
(define-inverting #'(everywhere-action _name _desc)
|
||||||
|
#'(_name _desc))
|
||||||
|
|
||||||
(provide desc)
|
(provide desc)
|
||||||
(define #'(desc _d)
|
(define #'(desc _d) #'_d)
|
||||||
#'_d)
|
|
||||||
|
(provide s-exp)
|
||||||
|
(define-cases-inverting #'s-exp
|
||||||
|
[#'(_ "(" _sx ... ")") #'(_sx ...)]
|
||||||
|
[#'(_ _sx) #'_sx])
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
#;(define #'(module-begin (define-verbs _all-verbs _cmd ...)
|
#;(define #'(module-begin (define-verbs _all-verbs _cmd ...)
|
||||||
|
|
|
@ -1,15 +1,17 @@
|
||||||
#lang ragg
|
#lang ragg
|
||||||
|
|
||||||
txtadv-program : [verb-section]
|
txtadv-program : [verb-section] [everywhere-section]
|
||||||
|
|
||||||
verb-section : verb-heading verb-entry+
|
verb-section : "===VERBS===" verb-entry+
|
||||||
|
|
||||||
verb-heading : "===VERBS==="
|
|
||||||
|
|
||||||
verb-entry : verb-name+ desc
|
verb-entry : verb-name+ desc
|
||||||
|
|
||||||
verb-name : [","] ID ["_"]
|
verb-name : [","] ID ["_"]
|
||||||
|
|
||||||
|
everywhere-section : "===EVERYWHERE===" everywhere-action+
|
||||||
|
|
||||||
|
everywhere-action : ID desc
|
||||||
|
|
||||||
desc : s-exp
|
desc : s-exp
|
||||||
|
|
||||||
s-exp : ID | STRING | "(" s-exp* ")"
|
s-exp : ID | STRING | "(" s-exp* ")"
|
|
@ -2,5 +2,5 @@
|
||||||
|
|
||||||
(require br/reader-utils "parser.rkt" "tokenizer.rkt")
|
(require br/reader-utils "parser.rkt" "tokenizer.rkt")
|
||||||
(define-read-and-read-syntax (source-path input-port)
|
(define-read-and-read-syntax (source-path input-port)
|
||||||
#`(module txtadv-mod br/demo/txtadv/expander
|
#`(module world br/demo/txtadv/expander
|
||||||
#,(parse source-path (tokenize input-port))))
|
#,(parse source-path (tokenize input-port))))
|
||||||
|
|
|
@ -16,7 +16,7 @@
|
||||||
[(union #\tab #\space #\newline) (get-token input-port)]
|
[(union #\tab #\space #\newline) (get-token input-port)]
|
||||||
[(repetition 1 +inf.0 (union upper-case (char-set "="))) lexeme]
|
[(repetition 1 +inf.0 (union upper-case (char-set "="))) lexeme]
|
||||||
[(seq "\"" (complement (seq any-string "\"" any-string)) "\"") (token 'STRING lexeme)]
|
[(seq "\"" (complement (seq any-string "\"" any-string)) "\"") (token 'STRING lexeme)]
|
||||||
[(char-set ",_") lexeme]
|
[(char-set "()[]{},_") lexeme]
|
||||||
[(repetition 1 +inf.0 (union alphabetic numeric (char-set "-.")))
|
[(repetition 1 +inf.0 (union alphabetic numeric (char-set "-.")))
|
||||||
(token 'ID (string->symbol lexeme))]))
|
(token 'ID (string->symbol lexeme))]))
|
||||||
(get-token input-port))
|
(get-token input-port))
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
#lang reader "reader.rkt"
|
#lang reader "reader.rkt"
|
||||||
|
|
||||||
|
/*
|
||||||
===VERBS===
|
===VERBS===
|
||||||
|
|
||||||
north, n
|
north, n
|
||||||
|
@ -9,8 +9,6 @@ north, n
|
||||||
south, s
|
south, s
|
||||||
"go south"
|
"go south"
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
east, e
|
east, e
|
||||||
"go east"
|
"go east"
|
||||||
|
|
||||||
|
@ -42,6 +40,7 @@ close _, lock _
|
||||||
"close"
|
"close"
|
||||||
|
|
||||||
knock _
|
knock _
|
||||||
|
"" // change: don't leave a blank line, makes grammar simpler
|
||||||
|
|
||||||
quit, exit
|
quit, exit
|
||||||
"quit"
|
"quit"
|
||||||
|
@ -52,7 +51,7 @@ look, show
|
||||||
inventory
|
inventory
|
||||||
"check inventory"
|
"check inventory"
|
||||||
|
|
||||||
/*
|
|
||||||
|
|
||||||
===EVERYWHERE===
|
===EVERYWHERE===
|
||||||
|
|
||||||
|
@ -67,6 +66,7 @@ look
|
||||||
inventory
|
inventory
|
||||||
(show-inventory)
|
(show-inventory)
|
||||||
|
|
||||||
|
*/
|
||||||
|
|
||||||
|
|
||||||
===THINGS===
|
===THINGS===
|
||||||
|
@ -115,6 +115,7 @@ get
|
||||||
"You win!")
|
"You win!")
|
||||||
|
|
||||||
|
|
||||||
|
/*
|
||||||
===PLACES===
|
===PLACES===
|
||||||
|
|
||||||
---meadow---
|
---meadow---
|
||||||
|
|
Loading…
Reference in New Issue
Block a user