1 ;;; Mudsync --- Live hackable MUD
2 ;;; Copyright © 2016 Christine Lemmer-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 (mudsync utils)
22 #:use-module (8sync actors)
23 #:use-module (8sync rmeta-slot)
24 #:use-module (srfi srfi-1)
25 #:use-module (srfi srfi-9)
26 #:use-module (ice-9 control)
27 #:use-module (ice-9 match)
46 player-gather-command-handlers
52 (define %low-priority 0)
53 (define %default-priority 1)
54 (define %high-priority 2)
56 ;; ;;; Avoiding some annoying issues crossing the continuation barrier
57 ;; ;;; and the "@@" special form
58 ;; (define (make-command verbs matcher should-handle action priority)
59 ;; (list '*command* verbs matcher should-handle action priority))
61 ;; (define command-verbs second)
62 ;; (define command-matcher third)
63 ;; (define command-should-handle fourth)
64 ;; (define command-action fifth)
65 ;; (define command-priority sixth)
67 (define-record-type <command>
68 (make-command verbs matcher should-handle action priority obvious?)
71 (matcher command-matcher)
72 (should-handle command-should-handle)
73 (action command-action)
74 (priority command-priority)
75 (obvious? command-obvious?))
77 (define-syntax %build-command
79 ((_ (verb ...) ((cmd-proc action-sym args ...) ...))
81 (list (cmd-proc (list verb ...)
86 ((_ verb ((cmd-proc action-sym args ...) ...))
88 (list (cmd-proc (list verb)
93 (define-syntax-rule (build-commands (verb-or-verbs cmd-defs ...) ...)
95 (append (%build-command verb-or-verbs cmd-defs ...) ...)))
98 (define* (direct-command verbs action #:key (obvious? #t))
101 ;; @@: Should we allow fancier matching than this?
102 ;; Let the actor itself pass along this whole method?
103 (lambda* (goes-by #:key direct-obj)
104 (ci-member direct-obj goes-by))
109 (define* (loose-direct-command verbs action #:key (obvious? #t))
112 ;; @@: Should we allow fancier matching than this?
113 ;; Let the actor itself pass along this whole method?
120 (define* (prep-indir-command verbs action #:optional prepositions
124 (lambda* (goes-by #:key direct-obj indir-obj preposition)
127 (ci-member indir-obj goes-by)
128 (ci-member preposition prepositions))
129 (ci-member indir-obj goes-by)))
134 (define* (prep-direct-command verbs action #:optional prepositions
138 (lambda* (goes-by #:key direct-obj indir-obj preposition)
141 (ci-member direct-obj goes-by)
142 (ci-member preposition prepositions))
143 (ci-member direct-obj goes-by)))
148 (define* (loose-prep-command verbs action #:optional prepositions
158 (define* (empty-command verbs action
167 (define* (greedy-command verbs action
176 (define* (direct-greedy-command verbs action
178 "greedy commands but which match the direct object"
180 cmatch-direct-obj-greedy
181 (lambda* (goes-by #:key direct-obj rest)
182 (ci-member direct-obj goes-by))
187 ;; @@: We should probably ONLY allow these to go to users!
188 (define* (custom-command verbs matcher should-handle action
189 #:optional (priority %default-priority)
191 "Full-grained customizable command."
192 (make-command verbs matcher should-handle action priority obvious?))