;;;; cl-aa -- Antialiasing stuff for Common Lisp
;;;; Copyright (C) 2006  Frederic Jolliton  <frederic@jolliton.com>
;;;;
;;;; URL: http://tuxee.net/cl-aa.lisp
;;;;      http://tuxee.net/cl-aa-sample.lisp
;;;;
;;;; Some example of usage of the cl-aa.lisp code.
;;;;
;;;; I will rewrite this file entirely, because it is really badly
;;;; written.

(defpackage #:net.tuxee.aa-sample
  (:use #:common-lisp #:net.tuxee.aa)
  (:export #:test-full))

(in-package #:net.tuxee.aa-sample)

;;; Quick hack to dump an image (TODO: use a library to write PNG
;;; directly.)
(defun save-image (filename image)
  (with-open-file (file filename
                        :element-type '(unsigned-byte 8)
                        :direction :output
                        :if-does-not-exist :create
                        :if-exists :overwrite)
    (labels ((write-ascii-integer (n stream)
               (when (minusp n)
                 (write-byte 45 stream) ; #\-
                 (setf n (- n)))
               (write-sequence (nreverse (loop for num = n then (floor num 10)
                                            for digit = (mod num 10)
                                            collect (+ 48 digit)
                                            while (plusp num)))
                               stream)))
      ;; "P6"
      (write-sequence #(80 54 10) file)
      ;; <width> <height>
      (write-ascii-integer (array-dimension image 0) file)
      (write-byte 32 file)
      (write-ascii-integer (array-dimension image 1) file)
      (write-byte 10 file)              ; line separator
      ;; <depth>
      (write-ascii-integer 255 file)
      (write-byte 10 file)
      (loop for y below (array-dimension image 1)
         do (loop for x below (array-dimension image 0)
               do (loop for rgb below 3
                     do (write-byte (aref image x y rgb) file))))))
  (format t "Image saved~%"))

;;; WARNING: Run external program.
;;; Ugh.
#+sbcl
(defun show-image (image)
  (let ((temp-filename "cl-aa-latest.pnm"))
    (save-image temp-filename image)
    (sb-ext:run-program "/usr/bin/xv" (list temp-filename))
    #+nil(delete-file temp-filename)))

(defun draw-circle (state cx cy radius &key n inverted)
  (let* ((n (or n (max 32 radius)))
         (x (+ cx radius))
         (y cy))
    (loop for i below (1- n)
       for angle = (/ (* 2 pi (1+ i)) n)
       do (let ((nx (+ cx (* radius (cos angle))))
                (ny (+ cy (* (if inverted -1 1) (* radius (sin angle))))))
            (line-f state x y nx ny)
            (setf x nx
                  y ny))
       finally (line-f state x y (+ cx radius) cy))))

(defun draw-line (state x1 y1 x2 y2 thickness)
  (when (or (/= x1 x2)
            (/= y1 y2))
    (let* ((dx (- x2 x1))
           (dy (- y2 y1))
           (norm (sqrt (+ (* dx dx) (* dy dy))))
           (ddx (* 0.5 thickness (/ dx norm)))
           (ddy (* 0.5 thickness (/ dy norm))))
      (let ((ax (+ x1 (- ddx) (- ddy)))
            (ay (+ y1 (- ddy) ddx))
            (bx (+ x2 ddx (- ddy)))
            (by (+ y2 ddy ddx))
            (cx (+ x2 ddx ddy))
            (cy (+ y2 ddy (- ddx)))
            (dx (+ x1 (- ddx) ddy))
            (dy (+ y1 (- ddy) (- ddx))))
        (line-f state ax ay bx by)
        (line-f state bx by cx cy)
        (line-f state cx cy dx dy)
        (line-f state dx dy ax ay)))))

(defun test-full ()
  (let* ((width 800)
         (height 600)
         (image (make-array (list width height 3)
                            :element-type '(unsigned-byte 8)
                            :initial-element 255))
         (state (make-state)))
    (labels ( ;; blend a and b accordingly to alpha value. Note that
             ;; normal value for alpha is in range (0,256), but if
             ;; polygons overlaps, the value can be outside the range.
             ;; Clamp the result in range (0-255)
             (blend (a b alpha)
               (min 255 (max 0 (floor (+ (* (- 256 alpha) a)
                                         (* alpha b))
                                      256))))
             ;; Draw a single pixel
             (draw-pixel (x y alpha color)
               (when (and (<= 0 x (1- (array-dimension image 0)))
                          (<= 0 y (1- (array-dimension image 1))))
                 (loop for rgb below 3
                    do (setf (aref image x y rgb)
                             (blend (aref image x y rgb)
                                    (aref color rgb)
                                    (abs alpha))))))
             ;; flush the cells buffer to the image
             (flush (color)
               (cells-sweep state (lambda (x y alpha) (draw-pixel x y alpha color)))
               (setf state (make-state)))
             ;; draw a single triangle, with the given color
             (triangle (x1 y1 x2 y2 x3 y3 color)
               (line-f state x1 y1 x2 y2)
               (line-f state x2 y2 x3 y3)
               (line-f state x3 y3 x1 y1)
               (flush color))
             (circle/1 (cx cy radius &key n inverted)
               (let* ((n (or n (max 32 radius)))
                      (x (+ cx radius))
                      (y cy))
                 (loop for i below (1- n)
                    for angle = (/ (* 2 pi (1+ i)) n)
                    do (let ((nx (+ cx (* radius (cos angle))))
                             (ny (+ cy (* (if inverted -1 1) (* radius (sin angle))))))
                         (line-f state x y nx ny)
                         (setf x nx
                               y ny))
                    finally (line-f state x y (+ cx radius) cy))))
             ;; circle
             (circle (cx cy radius color)
               (circle/1 cx cy radius)
               (flush color))
             ;; ring
             (ring (cx cy radius width color &optional border)
               (when border
                 (circle/1 cx cy (+ radius border))
                 (circle/1 cx cy (- radius width border) :inverted t)
                 (flush #(0 0 0)))
               (circle/1 cx cy radius)
               (circle/1 cx cy (- radius width) :inverted t)
               (flush color))
             ;; Naive graph drawing. Stroke is approximated.
             (graph (function color &optional (thickness 1.0))
               (let ((delta (/ thickness 2.0)))
                 (let ((y (funcall function 0.0)))
                   (line-f state 0 (- y delta) 0 (+ y delta)))
                 (let ((y (funcall function (coerce width 'float))))
                   (line-f state width (+ y delta) width (- y delta)))
                 (loop for n from 1 upto width
                    with x = 0
                    with y = (funcall function 0.0)
                    do (let ((ny (funcall function (coerce n 'float))))
                         (line-f state x (+ y delta) n (+ ny delta))
                         (line-f state n (- ny delta) x (- y delta))
                         (setf x n
                               y ny))))
               (flush color))
             ;; Another naive approach. Better but still not correct
             ;; stroking.
             (graph-line (function color &optional (thickness 1.0))
               (loop with step = 3
                  for n from 0.0 below width by step
                  do (draw-line state
                                n (funcall function n)
                                (+ n step) (funcall function (+ n step))
                                thickness)
                  (flush color)))
             ;; give a random X coordinate
             (random-x ()
               (/ (random (* 1000 width)) 1000.0))
             ;; give a random Y coordinate
             (random-y ()
               (/ (random (* 1000 height)) 1000.0))
             ;; give a random color
             (random-color ()
               (make-array 3 :initial-contents (loop repeat 3 collect (random 256)))))
      (loop repeat 20
         do
         ;; draw line
         (draw-line state (random-x) (random-y) (random-x) (random-y) 15.0)
         (flush (random-color))
         ;; draw triangle
         (triangle (random-x) (random-y)
                   (random-x) (random-y)
                   (random-x) (random-y) 
                   (random-color))
         ;; draw circle
         (circle (random-x) (random-y) (+ 5 (random 100)) (random-color))
         ;; draw function
         (let ((period (+ 40.0 (random 60)))
               (phase (random width))
               (offset (random-y)))
           (graph-line (lambda (n) (+ offset (* 0.15 height (sin (/ (+ phase n) period)))))
                       (random-color)
                       12.)))
      ;; Draw a picture similar to http://antigrain.com/doc/introduction/subpixel_accuracy1.gif
      ;; (on page http://antigrain.com/doc/introduction/introduction.agdoc.html)
      (loop for n below 500
         for angle = (* pi (/ n 30.))
         for radius = (/ n 90.)
         for distance = (+ 30.0 (/ n 4.0))
         do (let ((cx (+ (floor width 2) (* distance (sin angle))))
                  (cy (+ (floor height 2) (* distance (cos angle)))))
              (circle cx cy radius #(0 0 0))))
      (save-image "test.pnm" image)
      #+nil(show-image image))))

;; Generate animated GIF image
#+skippy-test
(defun test-with-skippy ()
  (let* ((width 120)
         (height 120)
         (color-table (skippy:make-color-table))
         (data-stream (skippy:make-data-stream :height height
                                               :width width
                                               :color-table color-table))
         (palette (make-array
                   256
                   :initial-contents (loop for n below 256
                                        collect (skippy:ensure-color
                                                 (* #x010101 n)
                                                 color-table))))
         data)
    (labels ((blend (a b alpha)
               (min 255 (max 0 (floor (+ (* (- 256 alpha) a)
                                         (* alpha b))
                                      256))))
             (put-pixel (x y alpha color)
               (when (and (<= 0 x (1- width))
                          (<= 0 y (1- height)))
                 (setf (aref data (+ x (* y width)))
                       (blend (aref data (+ x (* y width)))
                              (aref palette color)
                              (min (max 0 (abs alpha)) 255)))))
             (render (state color)
               (cells-sweep state (lambda (x y a) (put-pixel x y a color)))))
      (loop for m below 200
         do (setf data (skippy:make-image-data
                        height width
                        :initial-element (aref palette 255)))
         do (let* ((image (skippy:make-image
                           :data-stream data-stream
                           :image-data data
                           :delay-time 5))
                   (state (make-state)))
              (loop for n below 300
                 for factor = (/ (+ 2.0 (sin (/ m 10.))) 2.0)
                 for angle = (* pi (/ (- (* 3 n) m) 90.))
                 for radius = (* factor (/ n 180.))
                 for distance = (* factor (+ 15.0 (/ n 8.0)))
                 do (let ((cx (+ (floor width 2) (* distance (sin angle))))
                          (cy (+ (floor height 2) (* distance (cos angle)))))
                      (draw-circle state cx cy (+ radius (/ (+ 1.0 (cos (/ (+ n m) 4.0))) 2.0)))))
              (render state 0)
              (skippy:add-image image data-stream))))
    (skippy:output-data-stream data-stream "cl-aa-skippy-latest.gif")))