;;;; 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)
  (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 (< len (length bod)) 
      (setf bod (nreverse (cddr (nreverse bod)))))))

(defun snek-thots (snek)
  (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))

(defun draw-snek (snek canvas)
  (with-slots (bod color) snek
    (destructuring-bind (red green blue) color 
      (let ((alpha 255))
        (loop
          for (x y . more) on 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 (max 0 (- alpha  10))))))))

(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)
      (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 ))
  "Adds the intro text and sets up the start button 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 app (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)))))