(defpackage "GOBLIN"
  (:use :cl
        :cl-user
        #+(or :digitool :openmcl) :ccl
        #+openmcl :easygui)
  #+ALLEGRO (:export with-profiling))

(in-package goblin)

(declaim (optimize (speed 3) (space 0) (safety 0) (debug 0) (compilation-speed 0)))

(defvar *boardsize* 19)

(defstruct (spot (:print-function spot-printer))
                     (x     0 :type fixnum)
                     (y     0 :type fixnum)
                     (num   0 :type fixnum)
                     (val   0 :type fixnum)
                     (contributions    nil             :type t)
                     (pattern-changers nil             :type list)
                     (pattern          (list 0)        :type cons)
                     (alerts           nil             :type t)
                     (strings          '("@@" "B:@@" "W:@@") :type list)
                     (zobrist          nil             :type list)
                     (edgedistance     10              :type fixnum)
                     (bitmask          0               :type integer)
                     (sectorlines      nil             :type list)
                     (linetracers      nil             :type list)
                     (voidinfo         nil             :type list)
                     (linkbreaker      nil             :type t)
                     (xfloat 0.s0 :type short-float)
                     (yfloat 0.s0 :type short-float)
                     (sgfname "" :type string)
                     )

(defun spot-printer (spot stream depth)
  (declare (ignore depth))
  (format stream "@~a" (first (spot-strings spot))))

(defun build-spot (&key (x 0) (y 0) (num 0)
                       (info (list nil nil 0 nil (make-spot-strings x y *boardsize*)
                                   (cons 0 0) 0 (expt 2 (+ 1 y (* x *boardsize*))) nil nil
                                   nil nil 0.s0 0.s0)))
  ;; Spot bitmasks are calculated as if the board were not fringed.
  ;; Since fringing spots can never be played upon, they do not really need
  ;; bitmasks, so it does not matter that the bitmasks they are given are
  ;; also given to real spots. No two real spots are given the same bitmask.
  ;; The effect is that each bitmask occupies "only" 361 bits, not 441.
  ;; See similar observations in INITIALISE.LISP
  (make-spot :x x :y y :num num :val 0
                     :contributions         (nth 00 info)
                     :pattern-changers      (nth 01 info)
                     :pattern               (nth 02 info)
                     :alerts                (nth 03 info)
                     :strings               (nth 04 info)
                     :zobrist               (nth 05 info)
                     :edgedistance          (nth 06 info)
                     :bitmask               (nth 07 info)
                     :sectorlines           (nth 08 info)
                     :linetracers           (nth 09 info)
                     :voidinfo              (nth 10 info)
                     :linkbreaker           (nth 11 info)
                     :xfloat                (nth 12 info) ; CCL1.4 choked!
                     :yfloat                (nth 13 info)
                     :sgfname               (if (and (<= 1 x *boardsize*) (<= 1 y *boardsize*) (<= *boardsize* 19))
                                              (let ((abc "abcdefghijklmnopqrs"))
                                                (format nil "~a~a" (elt abc (1- x)) (elt abc (1- y))))
                                              "")
                     ;; :bubble nil
                     ))

; ----------------------------------------------------------------------
; Some fields of spots are themselves composites.
; Also the promised print-function, which uses the macro spotinfo-string
; ----------------------------------------------------------------------

(defun make-spot-strings (x y size)
  (let ((basic (format nil "~a~a" (elt "<ABCDEFGHJKLMNOPQRST>" x) (- size y -1))))
    (list basic (format nil "B:~a" basic) (format nil "W:~a" basic))))

; ----------------------------------------------------------------------
; Test driver
; ----------------------------------------------------------------------

(defun test (&aux (size 5))
  (let ((out (make-array (* size size) :element-type t)))
    (setf *boardsize* (- size 2))
    (dotimes (x 5 out)
      (dotimes (y 5)
        (let ((num (+ (* size x) y)))
          (setf (svref out num)
                (build-spot :x x :y y :num num
                            :info (list (nontrivial-list x y size)
                                        nil
                                        (list (nontrivial-fixnum x y size))
                                        nil
                                        (make-spot-strings x y size)
                                        nil
                                        (min (1- x) (- size x) (1- y) (- size y))
                                        0
                                        nil
                                        nil
                                        (list nil nil nil nil)
                                        nil
                                        (float x 1.s0)
                                        (float y 1.s0)))))))))

(defun nontrivial-list (x y size)
  (list (list (cons x y)) size))

(defun nontrivial-fixnum (x y size)
  (max most-positive-fixnum (* (1+ (expt x size)) (1+ (expt y size)))))