;;;; examples/10-canvas.lisp

(defpackage #:ww.examples/10
  (:use #:cl)
  (:export #:start)
  (:import-from #:defclass-std #:defclass/std))

(in-package #:ww.examples/10)

;;; CLASSES

(defclass/std sneking (ww:application)
  ((sneks snek-pit)
   (population :std 10)))

(defclass/std snek ()
  ((x y)
   (dx dy :std 1)
   (brain :std 0.0)
   (bod :std (list))
   (len :std 4)
   (color :std (list 255 255 255))
   (home :std (list 0 0 100 100))))

(defun snek-is-home-p (snek)
  (with-slots (x y home) snek
    (destructuring-bind (left bottom right top) home
      (and (<= left x (1- right))
           (<= bottom y (1- top))))))

(defun random-between (lo hi)
  (+ lo (random (1+ (- hi lo)))))

(defun snek-change-mind (snek)
  (if (zerop (random 2))
      (setf (dx snek) (random-between -1 1))
      (setf (dy snek) (random-between -1 1))))

(defun advance-snek-pos (snek)
  "Advance a snek's position. Check that the snek remains contained in
its HOME. If it isn't, revert position and have the snek change its
mind about where it wants to go. Finally, update the snek's BOD,
ensuring that its BOD is no longer than LEN, truncating it when
necessary."
  (with-slots (x y dx dy home bod len) snek
    (incf x dx)
    (incf y dy)
    (unless (snek-is-home-p snek)
      (decf y dy)
      (decf x dx)
      (snek-change-mind snek))
    (push y bod)
    (push x bod)
    (when (<= (* 2 len) (length bod)) 
      (setf bod (nreverse (cddr (nreverse bod)))))))

(defun snek-thots (snek)
  "A SNEK will decide to change direction the longer it has been
moving in a particular direction."
  (incf (brain snek) 0.01)
  (when (< (random 1.0) (brain snek))
    (setf (brain snek) 0.0)
    (snek-change-mind snek)))

(defun update-snek (snek)
  (advance-snek-pos snek)
  (snek-thots snek))

(defvar *alpha-step* 10)

(defun draw-snek (snek canvas)
  "Draws a snek to a canvas.  The BOD of a snek is a list of recent
positions that the snek's head had occupied. The body is drawn by
reducing the alpha of the snek's COLOR by 10 for every point in the BOD."
  (with-slots (bod color) snek
    (destructuring-bind (red green blue) color 
      (let ((alpha (max 0 (- 255 (* *alpha-step* (/ (length bod) 2))))))
        (loop
          for (y x . more) on (reverse bod) by #'cddr
          do (ww::with-pixel (r g b a) (ww::pixel canvas x y)
               (setf r red g green b blue a alpha))
             (setf alpha (min 255 (+ alpha  *alpha-step*))))))))

(defun random-snek (&optional (boundx 100) (boundy 100))
  (make-instance 'snek
                 :color (list (random 256) (random 256) (random 256))
                 :dy (random-between -1 1)
                 :dx (random-between -1 1)
                 :len (random-between 50 100)
                 :home (list 0 0 boundx boundy)
                 :x (random boundx)
                 :y (random boundy)))

(ww:defhandler sneks-a-go-go
    (ww::on-perframe (app ticks)
      "Clears cavnas. Moves gives each snek its turn. Draws each
       snek. Updates the screen."
      (with-slots (sneks snek-pit) app
        (ww::clear-canvas snek-pit)
        (dolist (snek sneks)
          (update-snek snek)
          (draw-snek snek snek-pit))
        (ww::blit snek-pit))))

(defmethod ww::boot ((app sneking ))
  "Sets up snek-pit, a canvas to which sneks are drawn. Creates random
sneks. Adds the canvas to the app, and sets up the perframe handler."
  (setf (snek-pit app)
        (make-instance 'ww:canvas :pixel-width 100 :pixel-height 100)
        (sneks app)
        (loop repeat (population app) collect (random-snek 100 100)))
  (setf (ww:width (snek-pit app)) (ww::application-width app)
        (ww:height (snek-pit app)) (ww::application-width app))
  (ww::add-unit (snek-pit app))
  (ww:add-handler app #'sneks-a-go-go))

(defun start (&key (side 800) (population 50))
  (ww::start
   (make-instance
    'sneking    
    :population population
    :fps 60
    :width side
    :height side 
    :refocus-on-mousedown-p nil
    :title "sneks"
    :asset-root
    (merge-pathnames
     "examples/"
     (asdf:system-source-directory :wheelwork)))))