1 ;;; Mudsync --- Live hackable MUD
2 ;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
4 ;;; This file is part of Mudsync.
6 ;;; Mudsync is free software; you can redistribute it and/or modify it
7 ;;; under the terms of the GNU General Public License as published by
8 ;;; the Free Software Foundation; either version 3 of the License, or
9 ;;; (at your option) any later version.
11 ;;; Mudsync is distributed in the hope that it will be useful, but
12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ;;; General Public License for more details.
16 ;;; You should have received a copy of the GNU General Public License
17 ;;; along with Mudsync. If not, see <http://www.gnu.org/licenses/>.
19 (define-module (mudsync command)
20 #:use-module (mudsync parser)
21 #:use-module (8sync actors)
22 #:use-module (8sync rmeta-slot)
23 #:use-module (srfi srfi-1)
24 #:use-module (srfi srfi-9)
25 #:use-module (ice-9 control)
26 #:use-module (ice-9 match)
45 player-gather-command-handlers
51 (define %low-priority 0)
52 (define %default-priority 1)
53 (define %high-priority 2)
55 ;; ;;; Avoiding some annoying issues crossing the continuation barrier
56 ;; ;;; and the "@@" special form
57 ;; (define (make-command verbs matcher should-handle action priority)
58 ;; (list '*command* verbs matcher should-handle action priority))
60 ;; (define command-verbs second)
61 ;; (define command-matcher third)
62 ;; (define command-should-handle fourth)
63 ;; (define command-action fifth)
64 ;; (define command-priority sixth)
66 (define-record-type <command>
67 (make-command verbs matcher should-handle action priority obvious?)
70 (matcher command-matcher)
71 (should-handle command-should-handle)
72 (action command-action)
73 (priority command-priority)
74 (obvious? command-obvious?))
76 (define-syntax %build-command
78 ((_ (verb ...) ((cmd-proc action-sym args ...) ...))
80 (list (cmd-proc (list verb ...)
85 ((_ verb ((cmd-proc action-sym args ...) ...))
87 (list (cmd-proc (list verb)
92 (define-syntax-rule (build-commands (verb-or-verbs cmd-defs ...) ...)
94 (append (%build-command verb-or-verbs cmd-defs ...) ...)))
97 (define* (direct-command verbs action #:key (obvious? #t))
100 ;; @@: Should we allow fancier matching than this?
101 ;; Let the actor itself pass along this whole method?
102 (lambda* (goes-by #:key direct-obj)
103 (member direct-obj goes-by))
108 (define* (loose-direct-command verbs action #:key (obvious? #t))
111 ;; @@: Should we allow fancier matching than this?
112 ;; Let the actor itself pass along this whole method?
119 (define* (prep-indir-command verbs action #:optional prepositions
123 (lambda* (goes-by #:key direct-obj indir-obj preposition)
126 (member indir-obj goes-by)
127 (member preposition prepositions))
128 (member indir-obj goes-by)))
133 (define* (prep-direct-command verbs action #:optional prepositions
137 (lambda* (goes-by #:key direct-obj indir-obj preposition)
140 (member direct-obj goes-by)
141 (member preposition prepositions))
142 (member direct-obj goes-by)))
147 (define* (loose-prep-command verbs action #:optional prepositions
157 (define* (empty-command verbs action
166 (define* (greedy-command verbs action
175 (define* (direct-greedy-command verbs action
177 "greedy commands but which match the direct object"
179 cmatch-direct-obj-greedy
180 (lambda* (goes-by #:key direct-obj rest)
181 (member direct-obj goes-by))
186 ;; @@: We should probably ONLY allow these to go to users!
187 (define* (custom-command verbs matcher should-handle action
188 #:optional (priority %default-priority)
190 "Full-grained customizable command."
191 (make-command verbs matcher should-handle action priority obvious?))