(in-package :cl-smoke.repl)

(defclass highlight-widget (qt:widget)
  ()
  (:metaclass cxx:class)
  (:documentation "A red border."))

(defun make-highligh-mask (rectangle &optional (border 10))
  (let* ((border/2 (/ border 2))
         (mask (make-instance 'qt:region
                              :args (list (cxx:adjusted rectangle
                                                        (- border/2) (- border/2)
                                                        border/2 border/2))))
         (inner (cxx:adjusted rectangle border/2 border/2
                              (- border/2) (- border/2))))
    (cxx:subtracted mask inner)))

(defmethod initialize-instance :after ((widget highlight-widget) &key)
  (cxx:set-window-flags widget (enum-logior
                                qt:+window-stays-on-top-hint+
                                qt:+frameless-window-hint+
                                qt:+x11bypass-window-manager-hint+))
  (cxx:set-palette widget
                   (make-instance 'qt:palette :args '("Red")))
  (cxx:set-auto-fill-background widget t))

(defun blink-and-follow (widget follow times &optional (intervall 0.5))
  (let ((timer (make-instance 'qt:timer :args (list widget))))
    (qt:connect (qt:get-signal timer "timeout()")
                #'(lambda ()
                    (when (<= times 1)
                      (cxx:stop timer))
                    ;; Track the follow widgets geometry
                    (cxx:set-geometry widget (cxx:geometry follow))
                    (cxx:set-mask widget 
                                  (make-highligh-mask (cxx:rect follow)))

                    (if (evenp times)
                        (cxx:show widget)
                        (cxx:hide widget))
                    (decf times)))
    (cxx:start timer (floor (* intervall 1000)))))

(defun locate-widget (widget)
  "Shows the location of WIDGET on the screen."
  (unless (cxx:is-visible widget)
    (cerror "show the widget" "The widget ~A is not visible." widget)
    (cxx:show widget))
  (cxx:raise widget) ;; Focus stealing prevention might intercept this.
  (let ((highlight (make-instance 'highlight-widget)))
    (blink-and-follow highlight widget 5)))