Welcome to the CHICKEN Scheme pasting service

;;; tadv.commands
;;;
;;; Defines the command the interface which is used to interpret
;;; player interactions with the world.

(module tadv.commands (make-command execute-command)
  (import scheme)
  (import chicken.base)
  (import chicken.irregex)
  (import bindings)

  ;;; make-command
  ;;;
  ;;; Creates an alist with the format required for execute command.
  ;;;    NAME is the name of command, it's only used for debugging
  ;;;    purposes
  ;;;
  ;;;    IRX is a regular expression. Use named capture groups to
  ;;;    capture arguments from the command text. They will be passed
  ;;;    to HANDLER-PROC handler-proc should take WORLD and ARGS
  ;;;    parameters
  ;;;
  ;;;    HANDLER-PROC is a procedure which accepts two parameters,
  ;;;    WORLD and ARGS. WORLD will be an instance of a WORLD data
  ;;;    structure. The command should make any modifications to the
  ;;;    world data that are needed and return a new WORLD instance.
  ;;;
  ;;; Example:
  ;;;
  ;;;    (make-command "go" "go\\s(?<exit-name>.+)"
  ;;;                  (lambda (world args)
  ;;;                  (display (assoc 'exit-name args)))
  
  (define (make-command name irx handler-proc)
    (list (cons 'name name)
          (cons 'irx irx)
          (cons 'handler-proc handler-proc)))

  ;;; execute-command
  ;;;
  ;;; Attempts to match TEXT against one of the commands in
  ;;; COMMAND-LIST. If a match is found, the HANDLER-PROC of the
  ;;; matched command will be called and passed WORLD and an alist of
  ;;; any captures found in the match. Only the first matching command
  ;;; is called.
  ;;;
  ;;;     WORLD is a list created by calling make-world found in the
  ;;;     tadv.db module.
  ;;;
  ;;;     COMMAND-LIST is a list of commands created with
  ;;;     make-command.
  ;;;
  ;;;     TEXT is the raw command text that should be matched
  ;;;     again. This is most likely typed by the player.
  
  (define (execute-command world command-list text)
    (define executed? #f)
    (let loop ((command-list command-list))
      (when (and (not executed?)
               (not (null? command-list)))
          ((bind-lambda
            ((_ . name) (_ . irx) (_ . handler-proc))
            (let ((m (irregex-match irx text)))
              (when m
                (handler-proc world (map
				     (lambda (pair)
				       (cons (car pair) (irregex-match-substring m (cdr pair))))
				     (irregex-match-names m)))
                (set! executed? #t))))
           (car command-list))
          (loop (cdr command-list))))
    executed?)
)