(in-package :kde.examples)
(declaim (optimize (debug 3)))
(defun zoom-in-factor ()
  0.8)
(defun zoom-out-factor ()
  (/ (zoom-in-factor)))
(defclass mandelbrotwidget (qt:widget)
  ((pixmap :accessor pixmap :initform nil)
   (pixmap-scale :accessor pixmap-scale)
   (pixmap-offset :accessor pixmap-offset)
   (center :accessor center :initform #C(-0.5d0 0d0))
   (scale :accessor scale :initform 0.007d0)
   (update-pixmap-slot :accessor update-pixmap-slot)
   (render :accessor render-thread)
   (last-drag-pos :accessor last-drag-pos :initform nil))
  (:metaclass cxx:class))
(defun update-pixmap (mandelbrotwidget image scale)
  (when (null (last-drag-pos mandelbrotwidget))
    (setf (pixmap mandelbrotwidget)
          (qt:pixmap.from-image image))
    (setf (pixmap-offset mandelbrotwidget) #c(0 0))
    (setf (pixmap-scale mandelbrotwidget) scale)
    (cxx:update mandelbrotwidget)))
  
(defparameter *render-control* (make-instance 'render-control))
(defun setup-slot (mandelbrotwidget)
  (setf (update-pixmap-slot mandelbrotwidget)
        (qt:make-slot #'(lambda (image scale)
                           (update-pixmap mandelbrotwidget image scale))
                       (mapcar #'find-class 
                               '(qt:image double-float))))
  (qt:connect (done-signal *render-control*)
               (update-pixmap-slot mandelbrotwidget)
               qt:+queued-connection+))
(defun draw-rendering (painter widget)
  (cxx:set-pen painter (make-instance 'qt:color
                                     :args (list qt:+white+)))
  (cxx:draw-text painter (cxx:rect widget)
                 (value qt:+align-center+)
                 "Rendering initial image, please wait..."))
(defun complex-floor (complex)
  "Applys FLOOR to the real and imaginary part of COMPLEX."
  (complex (floor (realpart complex)
                  (imagpart complex))))
(defun draw-scaled-pixmap (painter widget)
  (cxx:save painter) ;; FIXME make with- macro
  (let* ((scale-factor (/ (pixmap-scale widget)
                          (scale widget)))
         (pixmap-size (complex (cxx:width (pixmap widget))
                               (cxx:height (pixmap widget))))
         (new-size (* scale-factor pixmap-size))
         (new-center (+ (pixmap-offset widget) (/ (- pixmap-size new-size) 2))))
    (cxx:translate painter (realpart new-center) (imagpart new-center))
    (cxx:scale painter scale-factor scale-factor)
    (let ((exposed (cxx:adjusted (cxx:map-rect (cxx:inverted (cxx:matrix painter))
                                               (cxx:rect widget))
                                 -1 -1 1 1)))
      (cxx:draw-pixmap painter exposed (pixmap widget) exposed)))
  (cxx:restore painter))
   
  
(defun draw-pixmap (painter widget)
  (if (= (scale widget) (pixmap-scale widget))
      (cxx:draw-pixmap painter 
                      (floor (realpart (pixmap-offset widget)))
                      (floor (imagpart (pixmap-offset widget)))
                      (pixmap widget))
      (draw-scaled-pixmap painter widget)))
(defmethod cxx:paint-event ((widget mandelbrotwidget) &rest args)
  (declare (ignore args))
  (qt:with-painter (painter widget)
    (cxx:fill-rect painter (cxx:rect widget)
                  (make-instance 'qt:brush :args (list
                  (make-instance 'qt:color :args (list qt:+black+)))))
    (if (null (pixmap widget))
        (draw-rendering painter widget)
        (draw-pixmap painter widget))))
(defmethod cxx:resize-event ((widget mandelbrotwidget) &rest args)
  (declare (ignore args))
  (when (slot-boundp widget 'render)
    (setf (stop-p *render-control*) t)
    (join-thread (slot-value widget 'render)))
  (queue-image widget))
(defmethod cxx:key-press-event ((widget mandelbrotwidget) &rest args
                                &aux (event (first args)))
  (enum-cases (cxx:key event)
    (qt:+key-up+
     (scroll widget #C(0d0 -5d0)))
    (qt:+key-down+
     (scroll widget #C(0d0 5d0)))
    (qt:+key-left+
     (scroll widget #C(-5d0 0d0)))
    (qt:+key-right+
     (scroll widget #C(5d0 0d0)))
    (qt:+key-plus+
     (zoom widget (zoom-in-factor)))
    (qt:+key-minus+
     (zoom widget (zoom-out-factor)))))
(defmethod cxx:mouse-press-event ((widget mandelbrotwidget) &rest args
                              &aux (event (first args)))
  (when (enum= (cxx:button event) qt:+left-button+)
    (setf (last-drag-pos widget) (complex (cxx:x event)
                                          (cxx:y event)))))
(defmethod cxx:wheel-event ((widget mandelbrotwidget) &rest args
                                      &aux (event (first args)))
  (zoom widget (expt (zoom-in-factor) (/ (cxx:delta event) (* 8 15.0)))))
(defmethod cxx:mouse-move-event ((widget mandelbrotwidget) &rest args
                               &aux (event (first args)))
  (when (logand (cxx:buttons event) (value qt:+left-button+))
    (incf (pixmap-offset widget)
          (- (complex (cxx:x event)
                      (cxx:y event))
             (last-drag-pos widget)))
    (setf (last-drag-pos widget) (complex (cxx:x event)
                                          (cxx:y event)))
    (cxx:update widget)))
(defmethod cxx:mouse-release-event ((widget mandelbrotwidget) &rest args
                                  &aux (event (first args)))
  (when (enum= (cxx:button event) qt:+left-button+)
    (incf (pixmap-offset widget)
          (- (complex (cxx:x event)
                      (cxx:y event))
             (last-drag-pos widget)))
    (setf (last-drag-pos widget) nil)
    (let ((pixmap-size (complex (cxx:width (pixmap widget))
                                (cxx:height (pixmap widget))))
          (size (complex (cxx:width widget)
                         (cxx:height widget))))
      (scroll widget (- (/ (- size pixmap-size) 2) (pixmap-offset widget))))))
(defun queue-image (widget)
  (setf (stop-p *render-control*) nil)
  ;; FIXME do not creating a new thread on every invokation
  (setf (render-thread widget)
        (make-thread (make-render-function (center widget)
                                           (scale widget)
                                           (cxx:width widget)
                                           (cxx:height widget)
                                           *render-control*))))
(defun zoom (widget factor)
  (setf (scale widget) (* (scale widget) factor))
  (cxx:update widget)
  (queue-image widget))
(defun scroll (widget delta)
  (incf (center widget) (* (scale widget) delta))
  (cxx:update widget)
  (queue-image widget))