;;; capture-lib.el --- Deterministic frame capture for the QA runner -*- lexical-binding: t; -*-
;;
;; Loaded BEFORE a category's test.el:
;;   QA_OUT=/path/out QA_SIDE=gpu emacs -Q -l runner/capture-lib.el -l NN-cat/test.el
;;
;; Environment:
;;   QA_OUT    directory where <side>.png is written (required)
;;   QA_SIDE   "gpu" or "vanilla" (file name; required)
;;   QA_SETTLE seconds to wait after the scenario is ready (default 1.0)
;;   QA_ACTION optional elisp form evaluated before capturing (e.g. a
;;             function the category's test.el defines)
;;
;; The capture is taken BY THIS EMACS PROCESS (shell-command to
;; screencapture on macOS / ImageMagick import on X11): on macOS the
;; Screen Recording permission belongs to the app bundle, so an outer
;; script cannot capture, but the installed Emacs GPU app can.
;;
;; Determinism rules baked in: fixed frame size and position, no
;; blinking cursor, no tool bar, (message nil) before the shot, and
;; sleep-for rather than sit-for (sit-for returns instantly inside
;; window-setup-hook when input is pending).

(setq inhibit-startup-screen t)
(blink-cursor-mode -1)

(defun qa-capture--region ()
  "Inner frame rectangle as (X Y W H) in native units."
  (let* ((edges (frame-edges nil 'inner-edges))
         (x (nth 0 edges)) (y (nth 1 edges)))
    (list x y (- (nth 2 edges) x) (- (nth 3 edges) y))))

(defun qa-capture--shot (file)
  "Capture the frame region into FILE. Return t on success."
  (pcase-let* ((`(,x ,y ,w ,h) (qa-capture--region))
               (code (cond
                      ((eq system-type 'darwin)
                       (call-process "screencapture" nil nil nil
                                     "-x" "-R" (format "%d,%d,%d,%d" x y w h)
                                     file))
                      (t
                       (call-process "import" nil nil nil
                                     "-window" "root" "-silent"
                                     "-crop" (format "%dx%d+%d+%d" w h x y)
                                     file)))))
    (with-temp-file (concat file ".log")
      (insert (format "region=%d,%d,%d,%d exit=%S\n" x y w h code)))
    (eql code 0)))

(defun qa-capture-run ()
  (let* ((out (getenv "QA_OUT"))
         (side (getenv "QA_SIDE"))
         (settle (string-to-number (or (getenv "QA_SETTLE") "1.0")))
         (action (getenv "QA_ACTION"))
         (file (expand-file-name (concat side ".png") out))
         (ok nil))
    (condition-case err
        (progn
          (sleep-for 0.5)
          (when (fboundp 'tool-bar-mode) (tool-bar-mode -1))
          (set-frame-size nil 100 35)
          (set-frame-position nil 60 60)
          ;; Float above everything: the shot is a screen region, so any
          ;; overlapping window (even a video overlay) would pollute it.
          (set-frame-parameter nil 'z-group 'above)
          (raise-frame)
          (when (and action (not (string-empty-p action)))
            (eval (car (read-from-string action)) t))
          (message nil)
          (redisplay t)
          (sleep-for settle)
          (message nil)
          (redisplay t)
          (setq ok (qa-capture--shot file)))
      (error
       (ignore-errors
         (with-temp-file (expand-file-name (concat side ".error") out)
           (insert (format "%S" err))))))
    (kill-emacs (if (and ok (file-exists-p file)) 0 1))))

;; Depth 99: the GPU auto-enable hook is prepended to window-setup-hook,
;; and the capture must run after it.
(add-hook 'window-setup-hook #'qa-capture-run 99)

;;; capture-lib.el ends here