;;;; Floating drag correctness and hot-path regression on an owned Xvfb.
;;;; Never connects to DISPLAY or moves the user's desktop pointer.
(require :asdf)
(asdf:load-asd (truename (merge-pathnames "../lime.asd" *load-truename*)))
(asdf:load-system "lime/x11")

(let ((server (uiop:launch-program
               '("Xvfb" "-displayfd" "1" "-screen" "0" "1000x622x24" "-nolisten" "tcp")
               :output :stream :error-output :interactive))
      (backend nil) (client-display nil) (checks 0))
  (unwind-protect
       (let* ((number (parse-integer (read-line (uiop:process-info-output server))))
              (name (format nil ":~D" number)))
         (setf client-display (xlib:open-default-display name))
         (let* ((client-root (xlib:screen-root (xlib:display-default-screen client-display)))
                (windows (loop repeat 2 collect
                               (xlib:create-window :parent client-root :x 0 :y 0
                                                   :width 100 :height 100 :background 0))))
           (dolist (window windows) (xlib:map-window window))
           (xlib:display-finish-output client-display)
           (setf backend (lime.x11:start-lime
                          :display-name name :head-discovery :none
                          :config-file (asdf:system-relative-pathname
                                        "lime" "test/x11-appearance-config.lisp")))
           (let* ((display (lime.x11::x11-backend-display backend))
                  (root (lime.x11::x11-backend-root backend))
                  (world (lime.x11::x11-backend-world backend))
                  (head (first (lime.x11:backend-head-ids backend)))
                  (client-id (lime.x11::%backend-client-id backend (first windows)))
                  (wm-window (gethash client-id (lime.x11::x11-backend-client-windows backend)))
                  ;; Some keymaps also expose a non-modifier Super keysym;
                  ;; use a physical key assigned to Mod4 for XTest input.
                  (super (first (nth-value 6 (xlib:modifier-mapping display))))
                  (state (xlib:make-state-mask :mod-4 :button-1)))
             (labels ((check (truth label)
                        (assert truth () "Floating smoke: ~A" label) (incf checks))
                      (current () (lime.core:current-presentation world head))
                      (placement ()
                        (find client-id (lime.core:presentation-placements (current))
                              :key #'lime.core:placement-client-id :test #'equal))
                      (data () (lime.core:placement-data (placement)))
                      (pump ()
                        (let ((turns 0))
                          (lime.x11:run-event-loop
                           backend :timeout 0.001
                           :before-event
                           (lambda (backend)
                             (assert (< (incf turns) 2000) () "Event queue did not settle.")
                             (xlib:display-finish-output display)
                             (unless (xlib:event-listen display)
                               (setf (lime.x11::x11-backend-running-p backend) nil))))))
                      (motion (x y &optional (window wm-window) (modifiers state))
                        (xlib:queue-event display :motion-notify :append-p t
                                          :window window :root root :child nil
                                          :root-x x :root-y y :x 0 :y 0
                                          :state modifiers :hint-p nil :same-screen-p t :time 0))
                      (release (button x y)
                        (xlib:queue-event display :button-release :append-p t
                                          :window wm-window :root root :child nil
                                          :root-x x :root-y y :x 0 :y 0
                                          :state state :code button :same-screen-p t :time 0))
                      (start (&optional (mode :move))
                        (setf (lime.x11::x11-backend-pointer-drag backend)
                              (lime.x11::make-pointer-drag
                               :client-id client-id :head-id head :mode mode
                               :presentation-id (lime.core:presentation-id (current))
                               :initial-root-x 300 :initial-root-y 220
                               :initial-data (copy-list (data)))))
                      (check-pixels ()
                        (xlib:display-finish-output display)
                        (let* ((effect (lime.x11::%floating-client-configure-effect backend (current) client-id))
                               (geometry (lime.x11:x11-effect-geometry effect))
                               (window (first windows)))
                          (check (= (xlib:drawable-x window) (lime.core:geometry-x geometry)) "actual x")
                          (check (= (xlib:drawable-y window) (lime.core:geometry-y geometry)) "actual y")
                          (check (= (xlib:drawable-width window) (lime.core:geometry-width geometry)) "actual width")
                          (check (= (xlib:drawable-height window) (lime.core:geometry-height geometry)) "actual height")
                          (check (= 3 (xlib:drawable-border-width window)) "float retains border"))))
               (lime.x11:backend-toggle-client-floating
                backend client-id :data '(:x 1/4 :y 1/4 :width 1/2 :height 1/2))
               (lime.x11:backend-focus-client backend client-id)
               (pump)
               ;; Actual XTest input exercises the passive grab and production routing.
               (xlib/xtest:fake-motion-event display 300 220)
               (xlib/xtest:fake-key-event display super t)
               (xlib/xtest:fake-button-event display 1 t)
               (pump)
               (check (lime.x11::x11-backend-pointer-drag backend)
                      (format nil "Super+Button1 starts drag (key ~D, pointer ~S, float ~S, window ~D/~D)"
                              super (multiple-value-list (xlib:query-pointer root)) (data)
                              (xlib:drawable-x (first windows)) (xlib:drawable-y (first windows))))
               (xlib/xtest:fake-motion-event display 400 280)
               (pump)
               (check (= 7/20 (getf (data) :x)) "real drag moves 100 pixels horizontally")
               (check (= 7/20 (getf (data) :y)) "real drag moves 60 pixels vertically")
               (xlib/xtest:fake-button-event display 1 nil)
               (xlib/xtest:fake-key-event display super nil)
               (pump)
               (check (null (lime.x11::x11-backend-pointer-drag backend)) "real release ends drag")
               (check-pixels)
               ;; A large motion burst uses a bounded number of geometry updates,
               ;; with no desktop reconciliation, refocus, or root property writes.
               (lime.x11:backend-set-client-floating-geometry backend client-id :x 1/4 :y 1/4)
               (lime.x11:backend-save-view backend "drag-start" "Before dragging")
               (lime.x11:backend-activate-view backend "drag-start")
               (pump)
               (start)
               (let ((updates 0) (bars 0) (syncs 0) (focuses 0)
                     (execute (symbol-function 'lime.x11::%execute-x11-effect))
                     (draw (symbol-function 'lime.x11::render-head-bars))
                     (sync (symbol-function 'lime.x11::ewmh-sync-client-lists))
                     (focus (symbol-function 'lime.x11::icccm-focus-client)))
                 (unwind-protect
                      (progn
                        (setf (symbol-function 'lime.x11::%execute-x11-effect)
                              (lambda (backend effect)
                                (incf updates)
                                (check (and (eq :configure (lime.x11:x11-effect-kind effect))
                                            (equal client-id (lime.x11:x11-effect-client-id effect)))
                                       "drag only configures its own client")
                                (funcall execute backend effect))
                              (symbol-function 'lime.x11::render-head-bars)
                              (lambda (backend) (incf bars) (funcall draw backend))
                              (symbol-function 'lime.x11::ewmh-sync-client-lists)
                              (lambda (backend) (incf syncs) (funcall sync backend))
                              (symbol-function 'lime.x11::icccm-focus-client)
                              (lambda (&rest args) (incf focuses) (apply focus args)))
                        (loop for i from 1 to 600 do (motion (+ 300 (mod i 151)) 280))
                        ;; Release has a newer position than the final motion.
                        (release 1 450 310)
                        ;; Must not coalesce a later event backward across release.
                        (motion 900 600)
                        (pump)
                        (check (<= 2 updates 4) "600 queued motions collapse into bounded batches")
                        (check (= 1 bars) "only the clean-to-dirty transition redraws bars")
                        (check (zerop syncs) "no EWMH list refresh during motion")
                        (check (zerop focuses) "no focus renegotiation during motion")
                        (check (= 2/5 (getf (data) :x)) "release's final x wins")
                        (check (= 2/5 (getf (data) :y)) "release's final y wins")
                        (check (null (lime.x11::x11-backend-pointer-drag backend)) "queued release ends drag")
                        (format t "~&600-motion burst: ~D geometry updates, ~D bar redraw, ~D list syncs, ~D refocuses.~%"
                                updates bars syncs focuses))
                   (setf (symbol-function 'lime.x11::%execute-x11-effect) execute
                         (symbol-function 'lime.x11::render-head-bars) draw
                         (symbol-function 'lime.x11::ewmh-sync-client-lists) sync
                         (symbol-function 'lime.x11::icccm-focus-client) focus)))
               (check-pixels)
               (check (lime.core:validate-world world) "world invariants after burst")
               ;; Saved checkpoints retain their original geometry until updated.
               (lime.x11:backend-activate-view backend "drag-start")
               (check (= 1/4 (getf (data) :x)) "checkpoint geometry was not mutated")
               (pump)
               (start)
               (let ((revision (lime.core:world-revision world)))
                 (lime.x11::%handle-motion-notify backend 300 220 state)
                 (check (= revision (lime.core:world-revision world)) "stationary motion is a no-op")
                 (check (not (lime.core:presentation-dirty-p (current))) "stationary click stays clean"))
               ;; Resize shares the light path and still honors client increments.
               (setf (xlib:wm-normal-hints (first windows))
                     (xlib:make-wm-size-hints :min-width 80 :min-height 60
                                             :width-inc 8 :height-inc 10))
               (xlib:display-finish-output client-display)
               (pump)
               (start :resize)
               (motion 350 250)
               (release 1 355 255)
               (pump)
               (check (lime.x11::x11-backend-pointer-drag backend) "unrelated release does not end resize")
               (release 3 360 260)
               (pump)
               (check (= 14/25 (getf (data) :width)) "resize ends at release width")
               (check (= 17/30 (getf (data) :height)) "resize ends at release height")
               (check-pixels)
               (check (zerop (mod (xlib:drawable-width (first windows)) 8)) "resize respects width increments")
               (check (zerop (mod (xlib:drawable-height (first windows)) 10)) "resize respects height increments")
               ;; Report, rather than assert, wall-clock timing: the stable
               ;; regression above asserts protocol work, not machine speed.
               (lime.x11:backend-set-client-floating-geometry
                backend client-id :x 1/4 :y 1/4 :width 1/2 :height 1/2)
               (flet ((measure (function)
                        (xlib:display-finish-output display)
                        (let ((start (get-internal-real-time)))
                          (dotimes (i 120) (funcall function (/ (+ 200 i) 1000)))
                          (xlib:display-finish-output display)
                          (/ (- (get-internal-real-time) start)
                             (float internal-time-units-per-second)))))
                 (let* ((full (measure
                               (lambda (x)
                                 (lime.core:set-client-floating-geometry
                                  world (lime.core:presentation-id (current)) client-id :x x)
                                 (lime.x11:apply-active-presentation backend))))
                        (delta (measure
                                (lambda (x)
                                  (lime.x11:backend-set-client-floating-geometry backend client-id :x x)))))
                   (format t "~&120 uncoalesced geometry edits: full desktop ~,3Fs; geometry-only ~,3Fs.~%"
                           full delta)))
               (pump)
               ;; Commands/lifecycle events are coalescing boundaries, not discarded.
               (start)
               (motion 310 230)
               (xlib:queue-event display :key-press :append-p t :window root :root root
                                 :child nil :root-x 0 :root-y 0 :x 0 :y 0 :state 0
                                 :code super :same-screen-p t :time 0)
               (motion 320 240)
               (multiple-value-bind (x y)
                   (lime.x11::%coalesce-drag-motion backend wm-window 300 220 state)
                 (check (and (= x 310) (= y 230)) "coalescing stops before key press"))
               (check (eq :key-press
                          (xlib:event-case (display :timeout 0)
                            (:key-press () :key-press) (otherwise () :unexpected)))
                      "key press remains in queue")
               (pump)
               (start)
               (let ((old (current)))
                 (lime.x11:backend-start-activity backend "other" "Other")
                 (let ((revision (lime.core:world-revision world)))
                   (lime.x11::%handle-motion-notify backend 500 400 state)
                   (check (= revision (lime.core:world-revision world)) "switching draft invalidates gesture")
                   (check (null (lime.x11::x11-backend-pointer-drag backend)) "stale draft drag cancelled"))
                 (lime.x11:backend-activate-activity backend (lime.core:presentation-activity-id old)))
               (pump)
               (start)
               (lime.x11:backend-toggle-client-floating backend client-id)
               (lime.x11::%handle-motion-notify backend 500 400 state)
               (check (null (lime.x11::x11-backend-pointer-drag backend)) "unfloating cancels gesture")
               (lime.x11:backend-toggle-client-floating backend client-id)
               (start)
               (xlib:destroy-window (first windows))
               (xlib:display-finish-output client-display)
               (pump)
               (check (null (lime.x11::x11-backend-pointer-drag backend)) "destroyed client cancels gesture")
               (check (lime.core:validate-world world) "world invariants after destruction")
               (check (null (lime.x11::x11-backend-last-command-error backend)) "no swallowed drag errors")
               (format t "~&Live X11 floating: ~D checks passed.~%" checks)))))
    (when backend (lime.x11:stop-backend backend))
    (when client-display (xlib:close-display client-display))
    (uiop:terminate-process server)
    (uiop:wait-process server)))