(define-module (mudsync command) #:use-module (mudsync parser) #:use-module (8sync systems actors) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (ice-9 control) #:use-module (ice-9 match) #:export (command? command-verbs command-matcher command-should-handle command-action command-priority direct-command indir-command loose-direct-command loose-indir-command empty-command direct-greedy-command greedy-command player-gather-command-handlers find-command-winner)) ;;; Commands ;;; ======== (define %low-priority 0) (define %default-priority 1) (define %high-priority 2) ;; ;;; Avoiding some annoying issues crossing the continuation barrier ;; ;;; and the "@@" special form ;; (define (make-command verbs matcher should-handle action priority) ;; (list '*command* verbs matcher should-handle action priority)) ;; (define command-verbs second) ;; (define command-matcher third) ;; (define command-should-handle fourth) ;; (define command-action fifth) ;; (define command-priority sixth) (define-record-type (make-command verbs matcher should-handle action priority) command? (verbs command-verbs) (matcher command-matcher) (should-handle command-should-handle) (action command-action) (priority command-priority)) (define (direct-command verbs action) (make-command verbs cmatch-direct-obj ;; @@: Should we allow fancier matching than this? ;; Let the actor itself pass along this whole method? (lambda* (goes-by #:key direct-obj) (member direct-obj goes-by)) action %default-priority)) (define (loose-direct-command verbs action) (make-command verbs cmatch-direct-obj ;; @@: Should we allow fancier matching than this? ;; Let the actor itself pass along this whole method? (const #t) action %default-priority)) (define* (indir-command verbs action #:optional prepositions) (make-command verbs cmatch-indir-obj (lambda* (goes-by #:key direct-obj indir-obj preposition) (if prepositions (and (member indir-obj goes-by) (member preposition prepositions)) (member indir-obj goes-by))) action %high-priority)) (define* (loose-indir-command verbs action #:optional prepositions) (make-command verbs cmatch-indir-obj (const #t) action %high-priority)) (define (empty-command verbs action) (make-command verbs cmatch-empty (const #t) action %low-priority)) (define (greedy-command verbs action) (make-command verbs cmatch-greedy (const #t) action %low-priority)) (define (direct-greedy-command verbs action) "greedy commands but which match the direct object" (make-command verbs cmatch-direct-obj-greedy (lambda* (goes-by #:key direct-obj rest) (member direct-obj goes-by)) action %low-priority)) ;; @@: We should probably ONLY allow these to go to users! (define* (custom-command verbs matcher should-handle action #:optional (priority %default-priority)) "Full-grained customizable command." (make-command verbs matcher should-handle action priority))