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