;;;; Copyright (c) 2007 Jeremy English <jhe@jeremyenglish.org>
;;;;
;;;; Permission to use, copy, modify, distribute, and sell this software and its
;;;; documentation for any purpose is hereby granted without fee, provided that
;;;; the above copyright notice appear in all copies and that both that
;;;; copyright notice and this permission notice appear in supporting
;;;; documentation.  No representations are made about the suitability of this
;;;; software for any purpose.  It is provided "as is" without express or
;;;; implied warranty.
;;;;
;;;; Created: 25-June-2007

(in-package :chess-trace)

(defclass chess-board ()
  ((board :initarg :board
          :accessor board)
   (block-colors :initarg :block-colors
                 :accessor block-colors)
   (pieces :initarg :pieces
           :accessor pieces)
  (data-stream :initarg :data-stream
               :accessor data-stream)
   (height :initarg :height :initform 352 :accessor height)
   (width :initarg :width :initform 352 :accessor width)
   (blocks :initarg :blocks :initform 8 :accessor blocks)
   (block-width :initarg :block-width :accessor block-width)
   (block-height :initarg :block-height :accessor block-height)
   (working-frame :initarg :working-frame :accessor working-frame)))

(defun make-chess-board (&key (chess-pieces (make-chess-pieces)) (blocks 8))
  (let* ((chess-board (make-instance 'chess-board :blocks blocks))
         (height (* blocks (sprite-size chess-pieces)))
         (width height)
         (data-stream (make-data-stream :height width
                                        :width height
                                        :color-table t
                                        :loopingp t
                                        :comment "Made with Chess Trace jhe@jeremyenglish.org"))
         (canvas (make-canvas :height height :width width))
         (white (ensure-color (white-background chess-pieces)
                              (color-table data-stream)))
         (black (ensure-color (black-background chess-pieces)
                             (color-table data-stream)))

         (block-width (/ width (blocks chess-board)))
         (block-height (/ height (blocks chess-board)))
         (block-colors (make-array (list block-width block-height)))
         (color-count 0))

    (dotimes (x blocks)
      (let ((color1 (if (oddp x) black white))
            (color2 (if (oddp x) white  black)))
      (dotimes (y blocks)
        (let* ((color (if (evenp y) color1 color2))
          (color-key (if (equal color black) :black :white)))
        (fill-area canvas
                   color
                 :x (* x block-width)
                 :y (* y block-height))
        (setf (aref block-colors x y) color-key)
        (incf color-count)))))
    (setf (board chess-board) canvas)
    (setf (block-colors chess-board) block-colors)
    (setf (data-stream chess-board) data-stream)
    (setf (block-width chess-board) block-width)
    (setf (block-height chess-board) block-height)
    (setf (height chess-board) height)
    (setf (width chess-board) width)
    (setf (pieces chess-board) chess-pieces)
    (load-pieces-data-file chess-pieces data-stream)
    chess-board))

(defmethod output-board ((cb chess-board) filename)
  (output-data-stream (data-stream cb) filename))


(defun put-piece-xy (chess-board &key (name :king) (x 0) (y 0) (color :white))
"This function treats the chess board as an Cartesian coordinate system. The upper left cell being 0,0.

    0 1 2 3
 0 |_|_|_|_|
 1 |_|_|_|_|
 2 |_|_|_|_|

"

  (let* ((bd (working-frame chess-board))
         (background (aref (block-colors chess-board) x y))
         (sprite (get-piece (pieces chess-board)
                            :name name
                            :foreground color
                            :background background)))
    (unless bd (error "A working frame is needed to add pieces to. Please call start-frame first"))
        (put-sprite-on-canvas sprite bd
                              (* x (block-width chess-board))
                              (* y (block-height chess-board)))))

(defun start-frame (chess-board)
  "Make A clone of the chess-board canvas and store in the class for later operations."
  (setf (working-frame chess-board) (clone (board chess-board))))

(defun end-frame (chess-board &key delay-time)
  "Write the working frame to the image."
  (let ((image (canvas-image (working-frame chess-board))))
    (when delay-time
      (setf (delay-time image) delay-time))
    (add-image image (data-stream chess-board)))
  (setf (working-frame chess-board) nil))

(defun add-frame-delay (delay chess-board)
  (add-delay delay (data-stream chess-board)))
