mudsync/player.scm

   1 ;;; Mudsync --- Live hackable MUD
   2 ;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
   3 ;;;
   4 ;;; This file is part of Mudsync.
   5 ;;;
   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.
  10 ;;;
  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.
  15 ;;;
  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/>.
  18
  19 (define-module (mudsync player)
  20   #:use-module (mudsync gameobj)
  21   #:use-module (mudsync game-master)
  22   #:use-module (8sync systems actors)
  23   #:use-module (8sync agenda)
  24   #:use-module (ice-9 format)
  25   #:use-module (oop goops)
  26   #:export (<player>))
  27
  28 ;;; Players
  29 ;;; =======
  30
  31 (define-class <player> (<gameobj>)
  32   (username #:init-keyword #:username
  33             #:accessor player-username)
  34   ;; Connection id
  35   (client #:accessor player-client)
  36
  37   (self-commands
  38    #:init-value '()
  39    #:accessor player-self-commands)
  40
  41   (message-handler
  42    #:init-value
  43    ;; @@: We're gonna need action inheritance real awful soon, huh?
  44    (make-action-dispatch
  45     (set-loc! (wrap-apply player-set-loc!))
  46     (init (wrap-apply player-init!))
  47     (handle-input (wrap-apply player-handle-input)))))
  48
  49 ;;; player message handlers
  50
  51 (define-mhandler (player-set-loc! player message id)
  52   (format #t "DEBUG: Location set to ~s for player ~s\n"
  53           id (actor-id-actor player))
  54   (set! (gameobj-loc player) id))
  55
  56 (define-mhandler (player-init! player message)
  57   (player-look-around player))
  58
  59
  60 (define-mhandler (player-handle-input player message input)
  61   (<- player (gameobj-gm player) 'write-home
  62       #:text
  63       (format #f "<~a>: ~s\n"
  64               (player-username player)
  65               input)))
  66
  67
  68 ;;; player methods
  69
  70 (define (player-look-around player)
  71   (define room-name
  72     (message-ref
  73      (<-wait player (gameobj-loc player) 'get-name)
  74      'val))
  75   (define room-desc
  76     (message-ref
  77      (<-wait player (gameobj-loc player) 'get-desc)
  78      'val))
  79   (define message-text
  80     (format #f "**~a**\n~a\n" room-name room-desc))
  81
  82   (<- player (gameobj-gm player) 'write-home #:text message-text))