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 (8sync systems actors)
  22   #:use-module (8sync agenda)
  23   #:use-module (ice-9 format)
  24   #:use-module (oop goops)
  25   #:export (<player>))
  26
  27 ;;; Players
  28 ;;; =======
  29
  30 (define-class <player> (<gameobj>)
  31   (username #:init-keyword #:username
  32             #:accessor player-username)
  33   ;; Connection id
  34   (client #:accessor player-client)
  35
  36   (self-commands
  37    #:init-value '()
  38    #:accessor player-self-commands)
  39
  40   (message-handler
  41    #:init-value
  42    (make-action-dispatch
  43     (set-loc! (wrap-apply player-set-loc!))
  44     (init (wrap-apply player-init!)))))
  45
  46 ;;; player message handlers
  47
  48 (define-mhandler (player-set-loc! player message id)
  49   (format #t "DEBUG: Location set to ~s for player ~s\n"
  50           id (actor-id-actor player))
  51   (set! (gameobj-loc player) id))
  52
  53 (define-mhandler (player-init! player message)
  54   (player-look-around player))
  55
  56 ;;; player methods
  57
  58 (define (player-look-around player)
  59   (define room-name
  60     (message-ref
  61      (<-wait player (gameobj-loc player) 'get-name)
  62      'val))
  63   (define room-desc
  64     (message-ref
  65      (<-wait player (gameobj-loc player) 'get-desc)
  66      'val))
  67   (define message-text
  68     (format #f "**~a**\n~a\n" room-name room-desc))
  69
  70   (<- player (gameobj-gm player) 'write-home #:text message-text))