;;; Mudsync --- Live hackable MUD
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;;
;;; 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 <http://www.gnu.org/licenses/>.

(define-module (mudsync player)
  #:use-module (mudsync gameobj)
  #:use-module (8sync systems actors)
  #:use-module (8sync agenda)
  #:use-module (ice-9 format)
  #:use-module (oop goops)
  #:export (<player>))

;;; Players
;;; =======

(define-class <player> (<gameobj>)
  (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
   (make-action-dispatch
    (set-loc! (wrap-apply player-set-loc!))
    (init (wrap-apply player-init!)))))

;;; 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))

;;; 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))