;;;; 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 canvas-example (ww::application)
  ())

(defun color-clamp ( x)
  (max (min (round x) 255) 0))

(ww:defhandler color-shifts
    (ww:on-perframe ()
      (let ((time-class (1+ (mod time 256))))
        (ww::with-pixels-rect (x y r g b a) (target)
          (if (or (zerop (mod time-class (1+ x)))
                  (zerop (mod time-class (1+ y))))
              
              (setf
               r (mod (* x time) time-class)
               g (mod (* y time) time-class)
               b (mod time time-class)
               a 255)
              (ww::setf-many r g b a 0))))
      (ww::blit target)))

(defmethod ww::boot ((app canvas-example))
  "Adds the intro text and sets up the start button handler."
  (let ((c (make-instance
            'ww::canvas
            :pixel-height 10
            :pixel-width 10)))
    
    (ww::with-pixels-rect (x y r g b a) (c)
      (setf r (- 255 (* 25 x))
            g (- 255 (* 25 y))
            b (color-clamp (* 25 (+ x y)))))
    
    (ww::blit c)
    (setf (ww:width c) 800
          (ww:height c) 600)
    
    (ww:add-unit app c)
    (ww:add-handler c #'color-shifts )))

(defun start (&optional (scale 1.0))
  (ww::start
   (make-instance
    'canvas-example 
    :fps 30
    :width (round (* 800 scale))
    :height (round (* 600 scale))
    :scale scale
    :refocus-on-mousedown-p nil
    :title "canvas demo"
    :asset-root
    (merge-pathnames
     "examples/"
     (asdf:system-source-directory :wheelwork)))))