(local lpeg (require "lib.lulpeg.lulpeg"))
(local {: P : Cc} lpeg)
;; Maximum offset that was reached when parsing. It's updated by the M pattern,
;; which is inserted into other patterns. For the general idea, see
;; https://www.inf.puc-rio.br/~roberto/docs/lpeg-primer.pdf#page=22.
(var max-pos 0)
;; Update max-pos.
(local M (lpeg.P (fn [s i]
(set max-pos (math.max max-pos i))
true)))
;; Space characters. Also updates max-pos.
(local Sp (* M (lpeg.S " \t")))
;; Transform a pattern to match only when there's a word boundary at its
;; beginning and end.
(lambda w [patt]
(* (^ Sp 0) ;; 0 or more space characters,
patt ;; followed by the pattern,
(+ (# Sp) ;; followed by either a space character
(P -1)))) ;; or end of string.
;; Transform a sequence of patterns to match in sequence, and require a word
;; boundary at the beginning and end of each constituent pattern.
(lambda W [...]
(accumulate [patt (P true)
_ p (ipairs [...])]
(* patt (w p))))
;; Transform a pattern to require consuming the full input, with optional
;; leading and trailing space.
(lambda FULL [cap patt]
(* (Cc cap)
(^ Sp 0) ;; Optional leading space.
patt
(^ Sp 0) ;; Optional trailing space.
(P -1))) ;; End of line.
;; Optionally match a pattern, 0 or 1 occurrences of it.
(lambda OPT [patt]
(^ patt -1))
(local Article
(+ (W "a")
(W "an")
(* (+ (W "the")
(W "ye"))
(OPT (+ (W "damned")
(W "damn"))))))
(local Bool
(+ (* (Cc true) (+ (W "on") (W "yes") (W "1")))
(* (Cc false) (+ (W "off") (W "no") (W "0")))))
(local Compass
(+ (* (Cc :N) (+ (W "n") (W "north")))
(* (Cc :E) (+ (W "e") (W "east")))
(* (Cc :S) (+ (W "s") (W "south")))
(* (Cc :W) (+ (W "w") (W "west")))))
(local UpDown
(+ (* (Cc :U) (+ (W "u") (W "up")))
(* (Cc :D) (+ (W "d") (W "down")))))
(local Bearing
(+ Compass
UpDown
(* (Cc :IN) (+ (W "in") (W "enter")))
(* (Cc :OUT) (+ (W "out") (W "exit") (W "leave")))))
(local Knockable
(* (OPT Article)
(Cc :DOOR)
(+ (W "door")
(W "knocker"))))
;; Treat the plywood box and the lock that is on it as the same item.
(local Box
(* (Cc :BOX)
(+ (* (OPT (W "plywood"))
(W "box"))
(* (OPT (+ (W "combination")
(W "electronic")))
(+ (W "lock")
(W "keypad")
(W "key" "pad"))))))
(local Examinable
(* (OPT Article)
Box))
(local Openable
(* (OPT Article)
(+ (* (Cc :DOOR)
(W "door"))
(* (Cc :TRAPDOOR)
(W "trapdoor"))
Box)))
(local Item
(* (OPT Article)
(+ (* (Cc :RADIO)
(OPT (+ (W "battery-powered")
(W "battery" "powered")
(W "portable")))
(+ (W "radio")
(W "receiver")))
(* (Cc :MUSHROOM)
(OPT (W "mysterious"))
(+ (W "mushroom")
(W "toadstool")
(W "fungus")
(W "mush")))
(* (Cc :SPARE-KEY)
(OPT (+ (W "spare")
(W "metal")))
(W "key"))
(* (Cc :CAT-FOOD)
(+ (W "cat" "food")
(W "catfood")
(W "food")))
Box
(* (Cc :CAT)
(OPT (W "my"))
(^ (+ (W "little")
(W "grey")
(W "gray")
(W "feisty")) 0)
(+ (* (OPT (W "kitty"))
(+ (W "cat")
(W "kat")))
(W "kitty")
(W "feline"))))))
;; A numeric code of at least 3 digits, with optional whitespace between them.
(local NumericCode
(W (/ (lpeg.Ct
(^ (* (^ Sp 0)
(lpeg.C (lpeg.R "09")))
3))
table.concat)))
(local RadioStation
(lpeg.Ct (^ (* (^ Sp 0)
(lpeg.C (W (^ (- (P 1) Sp) 1)))) ;; 1 or more non-space characters.
1)))
(local Command
(+ (FULL :GO
(+ (* UpDown (+ (W "ladder")
(W "stairs")
(W "stair")))
(* (+ (W "go")
(W "walk"))
(+ (* (W "to" "the") Compass)
Bearing))
(* (+ (W "climb" "down")
(W "descend"))
(OPT (+ (W "ladder")
(W "stairs")
(W "stair")))
(Cc :D))
(* (+ (W "climb" "up")
(W "climb")
(W "ascend"))
(OPT (+ (W "ladder")
(W "stairs")
(W "stair")))
(Cc :U))
Bearing))
(FULL :INVENTORY
(+ (W "inventory")
(W "i")
(W "take" "inventory")))
(FULL :LOOK
(+ (W "look")
(W "l")))
(FULL :EXAMINE
(* (+ (W "examine")
(W "x")
(* (+ (W "look") (W "gaze") (W "peer")) (OPT (W "at")))
(W "admire")
(W "behold"))
(+ Item
Examinable)))
(FULL :TAKE
(* (+ (W "take")
(W "get")
(W "pick" "up")
(W "grab")
(W "acquire"))
Item))
(FULL :DROP
(* (+ (W "drop")
(W "discard"))
Item))
(FULL :KNOCK
(* (W "knock")
(OPT (* (W "on") Knockable))))
(FULL :ACTIVATE
(+ (* (+ (W "turn" "on")
(W "switch" "on")
(W "activate")
(W "use"))
Item)
(* (OPT (+ (W "turn")
(W "switch")))
(* Item (W "on")))))
(FULL :DEACTIVATE
(+ (* (+ (W "turn" "off")
(W "switch" "off")
(W "deactivate")
(W "douse"))
Item)
(* (OPT (+ (W "turn")
(W "switch")))
(* Item (W "off")))))
;; Listen to the room.
(FULL :LISTEN
(+ (* (W "listen")
(OPT (* (OPT (W "to"))
(OPT Article)
(+ (W "rapids")
(W "room")
(W "sounds")))))
(W "wait")
(W "ponder")
(W "meditate")
(W "pause")
(W "sit")))
;; Listen to an item.
(FULL :LISTEN
(* (+ (* (W "listen") (OPT (W "to")))
(W "hear"))
Item))
(FULL :OPEN
(* (+ (W "open")
(W "unlock"))
Openable))
(FULL :ENTER
(+ NumericCode ;; Just a bare code works as a command.
(* (+ (W "enter")
(W "type"))
(OPT (* (OPT Article) (W "code")))
NumericCode
(OPT (* (+ (W "in")
(W "on")
(W "into"))
Item)))
(/ (* (+ (W "open")
(W "unlock"))
Item
(OPT (+ (W "with")
(W "using")))
(OPT (* (OPT Article) (W "code")))
NumericCode)
#(values $2 $1)))) ;; Swap to put the code first and item second.
(FULL :EAT
(* (+ (W "eat")
(W "nom")
(W "devour")
(W "scarf"))
Item))
(FULL :TUNE
(+ (* (+ (W "tune")
(W "set")
(W "adjust")
(W "change"))
(+ Item
(Cc :RADIO)) ;; Default if no item is given
(OPT (W "station"))
(OPT (* (OPT (W "to")) (OPT Article)
RadioStation)))
(* (OPT (W "radio"))
(Cc :RADIO)
(W "station")
RadioStation)))
(FULL :FEED
(* (+ (W "feed")
(W "offer")
(W "give"))
(+ ;; feed cat food to the cat
(/ (* Item
(W "to")
Item)
#(values $2 $1)) ;; Swap to put the item first and the food second.
;; feed cat cat food
(* Item
(OPT (W "with"))
Item)
;; feed cat
Item)))
(FULL :PET
(* (+ (W "pet")
(* (W "play") (OPT (W "with"))))
Item))
(FULL :QUIT
(+ (* (W "quit") (OPT (* (OPT Article) (W "game"))))
(W "vamoose")
(W "scram")))
(FULL :MUTE
(+ (* (W "mute") (Cc true))
(* (W "unmute") (Cc false))))
(FULL :VOLUME
(* (W "volume")
(OPT (+ (/ (W (^ (lpeg.R "09") 1)) tonumber)
(* (Cc :UP) (W "up"))
(* (Cc :DOWN) (W "down"))))))
(FULL :HELP
(* (+ (W "help")
(W "halp"))
(OPT (W "me"))
(OPT (W "please"))))
(FULL :DEBUG
(* (W "debug")
(OPT Bool)))))
(lambda parse [line]
(set max-pos 0)
;; Return all captures in a sequential table, then the maximum position
;; reached.
(values (lpeg.match (lpeg.Ct Command) (string.lower line))
max-pos))
{: parse}