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)
70 (matcher command-matcher)
71 (should-handle command-should-handle)
72 (action command-action)
73 (priority command-priority))
75 (define-syntax %build-command
77 ((_ (verb ...) ((cmd-proc action-sym args ...) ...))
79 (list (cmd-proc (list verb ...)
84 ((_ verb ((cmd-proc action-sym args ...) ...))
86 (list (cmd-proc (list verb)
91 (define-syntax-rule (build-commands (verb-or-verbs cmd-defs ...) ...)
93 (append (%build-command verb-or-verbs cmd-defs ...) ...)))
96 (define (direct-command verbs action)
99 ;; @@: Should we allow fancier matching than this?
100 ;; Let the actor itself pass along this whole method?
101 (lambda* (goes-by #:key direct-obj)
102 (member direct-obj goes-by))
106 (define (loose-direct-command verbs action)
109 ;; @@: Should we allow fancier matching than this?
110 ;; Let the actor itself pass along this whole method?
116 (define* (prep-indir-command verbs action #:optional prepositions)
119 (lambda* (goes-by #:key direct-obj indir-obj preposition)
122 (member indir-obj goes-by)
123 (member preposition prepositions))
124 (member indir-obj goes-by)))
128 (define* (prep-direct-command verbs action #:optional prepositions)
131 (lambda* (goes-by #:key direct-obj indir-obj preposition)
134 (member direct-obj goes-by)
135 (member preposition prepositions))
136 (member direct-obj goes-by)))
140 (define* (loose-prep-command verbs action #:optional prepositions)
148 (define (empty-command verbs action)
155 (define (greedy-command verbs action)
162 (define (direct-greedy-command verbs action)
163 "greedy commands but which match the direct object"
165 cmatch-direct-obj-greedy
166 (lambda* (goes-by #:key direct-obj rest)
167 (member direct-obj goes-by))
171 ;; @@: We should probably ONLY allow these to go to users!
172 (define* (custom-command verbs matcher should-handle action
173 #:optional (priority %default-priority))
174 "Full-grained customizable command."
175 (make-command verbs matcher should-handle action priority))