(ql:quickload '(flare qtools qtgui))

(defpackage #:presenter
  (:use #:cl+qt #:3d-vectors)
  (:shadow #:fill)
  (:export #:define-presentation
           #:present
           #:entity
           #:location
           #:paint
           #:sized-entity
           #:size
           #:box
           #:background
           #:border
           #:text
           #:color
           #:alignment
           #:textbox))
(in-package #:presenter)
(in-readtable :qtools)

(define-widget canvas (QWidget)
  ((progression :initarg :progression :reader progression)
   (scene :initform (make-instance 'flare:scene) :reader scene)
   (background :initform (vec 0 0 0) :accessor background)))

(defmethod initialize-instance :after ((canvas canvas) &key width height)
  (setf (q+:fixed-size canvas) (values width height))
  (flare:start (scene canvas))
  (flare:start (flare:enter (flare:progression-instance (progression canvas)) (scene canvas))))

(define-subwidget (canvas timer) (q+:make-qtimer canvas)
  (setf (q+:single-shot timer) NIL)
  (q+:start timer (round 1000/30)))

(define-slot (canvas update) ()
  (declare (connected timer (timeout)))
  (flare:update (scene canvas))
  (q+:repaint canvas))

(define-override (canvas paint-event) (ev)
  (declare (ignore ev))
  (with-finalizing ((painter (q+:make-qpainter canvas))
                    (back (brush (background canvas))))
    (setf (q+:background painter) back)
    (q+:erase-rect painter (q+:rect canvas))
    (q+:save painter)
    (flare:paint scene painter)
    (q+:restore painter))
  (stop-overriding))

(defmethod flare:call-with-translation (func (target qobject) vec)
  (q+:save target)
  (unwind-protect
       (with-finalizing ((point (q+:make-qpointf (vx vec) (vy vec))))
         (q+:translate target point)
         (funcall func))
    (q+:restore target)))

(defmacro define-presentation (name (width height &rest initargs) &body intervals)
  `(progn
     (define-widget ,name (QWidget canvas)
       ()
       (:default-initargs
         :progression ',name
         :width ,width
         :height ,height
         ,@initargs))
     (flare:define-progression ,name
       ,@intervals)))

(defun present (name)
  (with-main-window (w name)))

(defclass entity (flare:entity)
  ((flare:location :accessor location)))

(defgeneric paint (thing painter)
  (:method-combination progn))

(defmethod paint progn ((entity entity) painter))

(defmethod flare:paint ((entity entity) target)
  (flare:with-translation ((location entity) target)
    (paint entity target)))

(defclass sized-entity (entity)
  ((size :initarg :size :accessor size))
  (:default-initargs
   :size (vec 50 50)))

(defclass box (sized-entity)
  ((background :initarg :background :accessor background)
   (border :initarg :border :accessor border))
  (:default-initargs
   :background (vec 0 0 0 0)
   :border (cons (vec 0 0 0 0) (vec 0 0 0 0))))

(defmethod rect ((rect vec4))
  (q+:make-qrectf (coerce (vx rect) 'single-float)
                  (coerce (vy rect) 'single-float)
                  (coerce (vz rect) 'single-float)
                  (coerce (vw rect) 'single-float)))

(defmethod rect ((rect vec2))
  (q+:make-qrectf 0.0 0.0
                  (coerce (vx rect) 'single-float)
                  (coerce (vy rect) 'single-float)))

(defmethod brush ((color vec4))
  (q+:make-qbrush (q+:make-qcolor (floor (* 255 (vx color)))
                                  (floor (* 255 (vy color)))
                                  (floor (* 255 (vz color)))
                                  (floor (* 255 (vw color))))))

(defmethod brush ((color vec3))
  (q+:make-qbrush (q+:make-qcolor (floor (* 255 (vx color)))
                                  (floor (* 255 (vy color)))
                                  (floor (* 255 (vz color))))))

(defun fill (painter brush rect)
  (with-finalizing ((rect (rect rect)))
    (q+:fill-rect painter rect brush)))

(defmethod paint progn ((box box) painter)
  (let ((size (size box)))
    (destructuring-bind (offset . color) (border box)
      (with-finalizing ((brush (brush color)))
        (fill painter brush (vec (- (vw offset)) (- (vx offset))
                                 (+ (vx size) (vw offset) (vy offset)) (vx offset)))
        (fill painter brush (vec (vx size) (- (vx offset))
                             (vy offset) (+ (vy size) (vx offset) (vz offset))))
        (fill painter brush (vec (- (vw offset)) (vy size)
                                 (+ (vx size) (vw offset) (vy offset)) (vz offset)))
        (fill painter brush (vec (- (vw offset)) (- (vx offset))
                                 (vw offset) (+ (vy size) (vx offset) (vz offset))))))
    (with-finalizing ((brush (brush (background box))))
      (fill painter brush (vec 0 0 (vx size) (vy size))))))

(defclass text (sized-entity)
  ((text :initarg :text :accessor text)
   (color :initarg :color :accessor color)
   (alignment :initarg :align :accessor alignment))
  (:default-initargs
   :text "< >"
   :color (vec 0 0 0 1)
   :align (cons :center :center)))

(defmethod paint progn ((text text) painter)
  (with-finalizing ((brush (brush (color text)))
                    (rect (rect (size text)))
                    (option (q+:make-qtextoption (logior (ecase (car (alignment text))
                                                           (:left (q+:qt.align-left))
                                                           (:right (q+:qt.align-right))
                                                           (:center (q+:qt.align-hcenter))
                                                           (:justify (q+:qt.align-justify)))
                                                         (ecase (cdr (alignment text))
                                                           (:top (q+:qt.align-top))
                                                           (:bottom (q+:qt.align-bottom))
                                                           (:center (q+:qt.align-vcenter)))))))
    (setf (q+:brush painter) brush)
    (q+:draw-text painter rect (text text) option)))

(defclass textbox (box text)
  ())

(define-presentation test (800 600)
  1 1 (T (flare:enter textbox :border (cons (vec 3 3 3 3) (vec 0.8 0 0))
                              :location (vec 50 50)
                              :text "Hi iso"
                              :size (vec 100 30)
                              :name :box))
  0 T (:box (flare:calc location :to (vec (+ 400 (* 400 (sin flare:clock))) 50))))