;;; Mudsync --- Live hackable MUD ;;; Copyright © 2016 Christopher Allan Webber ;;; ;;; This file is part of Mudsync. ;;; ;;; Mudsync is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or ;;; (at your option) any later version. ;;; ;;; Mudsync is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with Mudsync. If not, see . (define-module (mudsync player) #:use-module (mudsync command) #:use-module (mudsync gameobj) #:use-module (mudsync game-master) #:use-module (mudsync parser) #:use-module (8sync systems actors) #:use-module (8sync agenda) #:use-module (ice-9 format) #:use-module (oop goops) #:use-module (srfi srfi-1) #:export ( player-self-commands)) ;;; Players ;;; ======= (define-class () (username #:init-keyword #:username #:accessor player-username) ;; Connection id (client #:accessor player-client) (self-commands #:init-value '() #:accessor player-self-commands) (message-handler #:init-value ;; @@: We're gonna need action inheritance real awful soon, huh? (make-action-dispatch (set-loc! (wrap-apply player-set-loc!)) (init (wrap-apply player-init!)) (handle-input (wrap-apply player-handle-input))))) ;;; player message handlers (define-mhandler (player-set-loc! player message id) (format #t "DEBUG: Location set to ~s for player ~s\n" id (actor-id-actor player)) (set! (gameobj-loc player) id)) (define-mhandler (player-init! player message) (player-look-around player)) (define-mhandler (player-handle-input player message input) (define split-input (split-verb-and-rest input)) (define input-verb (pk 'input-verb (car split-input))) (define input-rest (pk 'input-rest (cdr split-input))) (define command-candidates (pk 'candidates (player-gather-command-handlers player input-verb))) (define winner (pk 'winner (find-command-winner command-candidates input-rest))) (<- player (gameobj-gm player) 'write-home #:text (format #f "<~a>: ~s\n" (player-username player) input))) ;;; player methods (define (player-look-around player) (define room-name (message-ref (<-wait player (gameobj-loc player) 'get-name) 'val)) (define room-desc (message-ref (<-wait player (gameobj-loc player) 'get-desc) 'val)) (define message-text (format #f "**~a**\n~a\n" room-name room-desc)) (<- player (gameobj-gm player) 'write-home #:text message-text))