(in-package "CL-USER")

(require :cocoa)
(require :utilities)

(defun nsstr (s) (make-instance 'gui::ns-lisp-string :string s))

(defparameter +standard-window-style-mask+
  (logior #$NSTitledWindowMask
          #$NSClosableWindowMask
          #$NSMiniaturizableWindowMask
          #$NSResizableWindowMask))

(defun make-ns-window (x y &optional (title "Untitled"))
  (let ((nsw (make-instance 'ns:ns-window
               :with-content-rect (ns:make-ns-rect 0 0 x y)
               :style-mask +standard-window-style-mask+
               :backing #$NSBackingStoreBuffered
               :defer t)))
    ;;(#/setReleasedWhenClosed: nsw nil)
    (#/setTitle: nsw (nsstr title))
    (#/center nsw)
    (#/orderFront: nsw nil)
    ;(#/makeKeyAndOrderFront: nsw nil)
    nsw))

(defmacro with-focused-view (view &body forms)
  `(when (#/lockFocusIfCanDraw ,view)
     (unwind-protect (progn ,@forms)
       (#/unlockFocus ,view)
       (#/flushGraphics (#/currentContext ns:ns-graphics-context))
       (#/flushWindow (#/window ,view)))))

(defgeneric view-draw-contents (v &optional rect))
(defgeneric view-redraw-contents (v &optional rect))

(defmethod view-redraw-contents ((v ns::ns-view) &optional rect)
  (with-focused-view v (view-draw-contents v rect)))

(defun image-size (img)
  (let ( (s (#/size img)) )
    (cons (truncate (pref s :ns-size.width))
          (truncate (pref s :ns-size.height)))))

(defclass image-view (ns:ns-view)
  (image)
  (:metaclass ns:+ns-object))

(objc:defmethod (#/drawRect: :void) ((self image-view) (rect ns:ns-rect))
  (view-redraw-contents self rect))

(define-method (set-content (iv image-view image) img)
  (setf image (#/copy img))
  (#/setNeedsDisplay: iv #$YES))

(define-method (view-draw-contents (iv image-view image) &optional rect)
  (setf rect (or rect (#/bounds iv)))
  (when (and (slot-boundp iv 'image) (typep image 'ns:ns-image))
    (bb
     :db (ix . iy) (image-size image)
     rsize (pref rect ns-rect.size)
     rx (pref rsize ns-size.width)
     ry (pref rsize ns-size.height)
     arr (/ (/ ix iy) (/ rx ry))
     tx (if (> arr 1) rx (* ix (/ ry iy)))
     ty (if (> arr 1) (* iy (/ rx ix)) ry)
     :with ns:ns-rect (trect 0 (- ry ty) tx ty)
     :with ns:ns-rect (z 0 0 0 0)
     (#/drawInRect:fromRect:operation:fraction:
      image trect z #$NSCompositeCopy 1.0))))

(defun show-image (img)
  (bb 
   :db (x . y) (image-size img)
   w (make-ns-window x y "Image")
   v (make 'image-view)
   (#/setContentView: w v)
   (set-content v img)
   w))

(defun image-from-file (filename)
  (make-instance ns:ns-image :init-with-data
    (make-instance ns:ns-data :init-with-contents-of-file (nsstr filename))))

(defun image-from-url (url)
  (make-instance ns:ns-image :init-with-contents-of-url
    (make-instance ns:ns-url :init-with-string (nsstr url))))

(defmacro with-focused-image (img &body forms)
  `(unwind-protect
       (progn (#/lockFocus ,img) ,@forms)
     (#/unlockFocus ,img)))

(defun compose-images-horizontal (images &optional (border 5))
  (bb
   sizes (mapcar 'image-size images)
   x (apply '+ (* border (1+ (length images))) (mapcar 'car sizes))
   y (+ (* 2 border) (apply 'max (mapcar 'cdr sizes)))
   y-positions (for s in sizes collect (round (- y (cdr s)) 2))
   img (#/initWithSize: (#/alloc ns:ns-image) (ns:make-ns-size x y))
   x0 border
   alpha (float 1.0 ns:+cgfloat-zero+)
   :with ns:ns-rect (z 0 0 0 0)
   :with focused-image img
   (for (image yp) in (zip images y-positions) do
        (#/drawAtPoint:fromRect:operation:fraction:
         image (ns:make-ns-point x0 yp) z #$NSCompositeCopy alpha)
        (incf x0 (+ border (car (image-size image)))))
   img))

(defun compose-images-vertical (images &optional (border 5))
  (bb
   sizes (mapcar 'image-size images)
   x (+ (* 2 border) (apply 'max (mapcar 'car sizes)))
   y (apply '+ (* border (1+ (length images))) (mapcar 'cdr sizes))
   img (#/initWithSize: (#/alloc ns:ns-image) (ns:make-ns-size x y))
   y0 border
   alpha (float 1.0 ns:+cgfloat-zero+)
   :with ns:ns-rect (z 0 0 0 0)
   :with focused-image img
   (for image in images do
        (#/drawAtPoint:fromRect:operation:fraction:
         image (ns:make-ns-point border y0) z #$NSCompositeCopy alpha)
        (incf y0 (+ border (cdr (image-size image)))))
   img))

(defun compose-images (images &optional (border 5))
  (compose-images-vertical
   (map1 'compose-images-horizontal (reverse images) border)
   0))

#|
; Example -- try resizing the windows

(setf buzz1
      (image-from-url
       "http://carrielikethemovie.files.wordpress.com/2008/11/buzz-lightyear.jpg"))

(setf buzz2 (image-from-url "http://darrenentwistle.com/caw/Buzz-Lightyear.jpg"))

(setf c (compose-images (list (list buzz1 buzz2 buzz1) (list buzz2 buzz1 buzz2))))

(show-image buzz1)
(show-image buzz2)
(show-image c)
|#