;;; 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/>.

;;; Game actor
;;; ==========

(define-module (mudsync gameobj)
  #:use-module (8sync systems actors)
  #:use-module (8sync agenda)
  #:use-module (oop goops)
  #:export (<gameobj>
            gameobj-simple-name-f

            gameobj-loc
            gameobj-gm
            gameobj-name
            gameobj-name-f

            gameobj-actions))

;;; Gameobj
;;; =======


;;; Actions supported by all gameobj
(define gameobj-actions
  (build-actions
   (get-commands (wrap-apply gameobj-get-commands))
   (get-container-commands (wrap-apply gameobj-get-container-commands))
   (get-children (wrap-apply gameobj-get-children))
   (add-occupant! (wrap-apply gameobj-add-child!))
   (remove-occupant! (wrap-apply gameobj-remove-child!))
   (set-loc! (wrap-apply gameobj-set-loc!))))

;;; *all* game components that talk to players should somehow
;;; derive from this class.
;;; And all of them need a GM!

(define-class <gameobj> (<actor>)
  ;; location id
  (loc #:init-value #f
       #:accessor gameobj-loc)
  
  ;; Uses a hash table like a set (values ignored)
  (occupants #:init-thunk make-hash-table
             #:accessor gameobj-occupants)

  ;; game master id
  (gm #:init-keyword #:gm
      #:getter gameobj-gm)
  ;; a name to be known by
  (name #:init-keyword #:name
        #:accessor gameobj-name)

  (desc #:init-value ""
        #:init-keyword #:desc)

  ;; how to print our name
  (name-f #:init-keyword #:name-f
          #:getter gameobj-name-f
          #:init-value (wrap gameobj-simple-name-f))

  ;; Name aliases
  (aliases #:init-keyword #:aliases
           #:init-value '())

  ;; Commands we can handle
  (commands #:init-value '())

  ;; Commands we can handle by being something's container
  (container-commands #:init-value '())
  (message-handler
   #:init-value
   (simple-dispatcher gameobj-actions)))


;;; gameobj message handlers
;;; ========================

(define-mhandler (gameobj-get-commands actor message verb)
  (<-reply actor message #:commands (slot-ref actor 'commands)))

(define-mhandler (gameobj-get-container-commands actor message verb)
  (<-reply actor message #:commands (slot-ref actor 'container-commands)))

(define-mhandler (gameobj-get-children actor message)
  (define children
    (hash-map->list (lambda (key val) key)
                    (gameobj-children actor)))

  (<-reply actor message
           #:children children))

(define-mhandler (gameobj-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 (gameobj-simple-name-f gameobj)
  "Simplest version: return ourselves for our name."
  (gameobj-name gameobj))