;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                      Single Player Mode                          ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Classes

;;; Single player, should not have more than one of these.
(defclass <single-player> (<player>))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Interface

;;; Read a player name and return one of the <player> objects.
;;; (define (make-player) ...)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Implementation

;;; Creation methods

;;; Creating player objects, the *players* global list is used to
;;; restrict instances.
(define (make-player <player-type> nick+name)
  (let ((length (length nick+name)))
    (cond
     ((= length 2)
      (make <player-type>
            :nick (list (first nick+name))
            :name (second nick+name)))
     ((= length 7)
      (let ((state empty))
        (when (second nick+name)
          (set! state
                (cons (list 'firstname (second nick+name)) state)))
        (when (third nick+name)
          (set! state (cons (list 'lastname (third nick+name)) state)))
        (when (fifth nick+name)
          (set! state (cons (list 'address (fifth nick+name)) state)))
        (when (sixth nick+name)
          (set! state (cons (list 'phone (sixth nick+name)) state)))
        (when (seventh nick+name)
          (set! state (cons (list 'project (seventh nick+name)) state)))
        (make <player-type>
              :nick  (list (first nick+name))
              :name  (or (fourth  nick+name) (second  nick+name))
              :state state)))
     (else
      (error 'make-player "unexpected init list")))))

;;; Specialize the way that <player> objects are created and give
;;; them an initial do-something
(defmethod (initialize (p <single-player>) initargs)
  (define (player-loop)
    (let ((t (and (player-exists? p) (do-something p))))
      (when t
        ;; technically, this should be a number but there's been
        ;; a few errors with t being #<void> (still unknown why)
        ;; so just test to see that t is a number
        (when (number? t) (sleep t))
        (player-loop))))
  (call-next-method)                 ; must call this
  (greet p)
  (set! *players* (cons p *players*))
  (thread player-loop))

;;; Force the event handler thread to perform the do-command.
;;; This prevents the player thread from having to lock data
(defmethod (do-command (p <single-player>) (inp <string>))
  (let ((r 0))
    (insert-immediate-event
     (thunk (set! r (call-next-method))
            (semaphore-post (player-mutex p))))
    (semaphore-wait (player-mutex p))
    r))


;;; Destruction methods

;;; Announces that the player left the game and destroys the object
(defmethod (logoff (p <single-player>))
  (tell p "Good bye!")
  (destroy p)
  (terminate-game))

;;; Game initiation method

;;; Start a game in a single-player mode.
(define (single-game)
  ;; set this so local versions of the game don't get double spaces
  (set! *return-chars* (string #\linefeed))
  ;; reset the initial time, so the game start time appears accurate
  (set! *initial-time* (current-milliseconds))
  ;; make a thread that will gc every 10 seconds to prevent memory
  ;; blowout.
  (letrec ((gc (lambda () (sleep 10) (collect-garbage) (gc))))
    (thread gc))
  ;; Fill the event-queue...
  (for-each (lambda (x) (apply insert-event x)) *first-events*)
  ;; create the player object and add him to the game
  (if (null? *players*)
    (make-player <single-player> (read-player-nick+name))
    (error 'single-game "you can only create one player"))
  ;; define the game
  (define-game)
  ;; this loop now runs forever - use a thread so the game clock
  ;; advances in real time.
  (event-loop))