(import wayland)
(import spork/netrepl)
(import xkbcommon)

(def river-protocols ((os/environ) "RIVER_PROTOCOLS"))

(def interfaces (wayland/scan
                  :system-protocols ["stable/viewporter/viewporter.xml"]
                  :custom-protocols (map |(string river-protocols $)
                                         ["river-window-management-v1.xml"
                                          "river-layer-shell-v1.xml"
                                          "river-xkb-bindings-v1.xml"
                                          "river-input-management-v1.xml"
                                          "river-libinput-config-v1.xml"
                                          "river-xkb-config-v1.xml"])))

(def required-interfaces
  {"river_window_manager_v1" 3
   "river_layer_shell_v1" 1
   "river_xkb_bindings_v1" 1
   "river_xkb_config_v1" 1
   "river_input_manager_v1" 1})

(def registry @{})
(def wl-outputs @{})

(def wm @{:outputs @[] :seats @[] :windows @[] :render-order @[] :inputs @[] :pulldowns @{} :callbacks @{}})
(defn callback [id & args]
  (each cb (get-in wm [:callbacks id] {}) (cb ;args)))

(defmacro register-callback [id args & body]
  (def keysym (gensym))
  ~(do
    (def ,keysym [:callbacks ,id @{}])
    (defn clear [] (put-in wm ,keysym nil))
    (put-in wm ,keysym (fn ,args ,;body))
    clear))

(defmacro register-callback-once [id args & body]
  '(register-callback ,id ,args ,;body '(clear)))

(def tags-main [:a :r :s :t :n :e :i :o])
(def tags-offload [:comma :period])
(def tags-other [:g :m :q :w :f :p :b :j :l :u :y :z :x :c :d :v :k :h])

(def config
  @{:xcursor-theme ["Vanilla-DMZ" 24]
    :border-width 1
    :border-normal 0x646464
    :border-focused 0xffffff
    :appid-rules @{}})

(defn binding/create [seat keysym mods action]
  (def binding @{:obj (:get-xkb-binding (registry "river_xkb_bindings_v1") (seat :obj) (xkbcommon/keysym keysym) mods)})
  (defn handle-event [event]
    (match event
      [:pressed] (put seat :pending-action [binding action])))
  (:set-handler (binding :obj) handle-event)
  (:enable (binding :obj))
  (array/push (seat :xkb-bindings) binding))

(defn input/configure [input]
  # Map trackpads to laptop displays
  (unless (nil? (string/find "Touchpad" (input :name)))
    (when-let [internal (find |(string/has-prefix? "eDP" (get $ :name "")) wl-outputs)]
      (put input :mapped internal)
      (:map-to-output (input :obj) (internal :obj)))))

(defn input/create [input]
  (def input @{:obj input})
  (defn handle-event [event]
    (match event
      [:type type] (put input :type type)
      [:name name] (put input :name name))
    (when (and (input :type) (input :name))
      (input/configure input)))
  (:set-handler (input :obj) handle-event)
  (:set-user-data (input :obj) input)
  (array/push (wm :inputs) input))

(defn wl-output/create [name obj]
  (def output @{:obj obj})
  (put wl-outputs name output)
  (defn handle-event [event]
    (match event
      [:name name] (do
                     (put output :name name)
                     (each input (wm :inputs) (input/configure input)))))
  (:set-handler obj handle-event)
  (:set-user-data obj output))

(defn output/create [obj]
  (def output @{:obj obj
                :layer-shell (:get-output (registry "river_layer_shell_v1") obj)
                :new true
                :tags-other []})
  (defn handle-event [event]
    (match event
      [:removed] (put output :removed true)
      [:position x y] (put output :position [x y])
      [:dimensions w h] (put output :dimensions [w h])
      [:wl-output name] (put output :wl-output (wl-outputs name))))
  (defn handle-layer-shell-event [event]
    (match event
      [:non-exclusive-area x y w h] (put output :non-exclusive-area [x y w h])))
  (:set-user-data obj output)
  (:set-handler obj handle-event)
  (:set-handler (output :layer-shell) handle-layer-shell-event)
  output)

(defn seat/create [obj]
  (def seat @{:obj obj
              :layer-shell (:get-seat (registry "river_layer_shell_v1") obj)
              :layer-focus :none
              :xkb-bindings @[]
              :pointer-bindings @[]
              :new true})
  (defn handle-event [event]
    (match event
      [:removed] (put seat :removed true)
      [:pointer-enter window] (put seat :pointer-target (:get-user-data window))
      [:pointer-leave] (put seat :pointer-target nil)
      [:window-interaction window] (put seat :window-interaction (:get-user-data window))
      [:shell-surface-interaction shell-surface] (do)))
  (defn handle-layer-shell-event [event]
    (match event
      [:focus-exclusive] (put seat :layer-focus :exclusive)
      [:focus-non-exclusive] (put seat :layer-focus :non-exclusive)
      [:focus-none] (put seat :layer-focus :none)))
  (:set-handler obj handle-event)
  (:set-handler (seat :layer-shell) handle-layer-shell-event)
  (:set-user-data obj seat)
  (:set-xcursor-theme obj ;(config :xcursor-theme))
  seat)

(defn window/create [obj]
  (def window
    @{:obj obj
      :node (:get-node obj)
      :new true})
  (defn handle-event [event]
    (match event
      [:closed] (put window :closed true)
      [:dimensions-hint min-w min-h max-w max-h] (put window :dimensions-bounds [min-w max-w min-h max-h])
      [:dimensions w h] (do (put window :w w) (put window :h h))
      [:app-id app-id] (put window :app-id app-id)
      [:parent parent] (put window :parent (if parent (:get-user-data parent)))
      [:decoration-hint hint] (put window :decoration-hint hint)
      [:pointer-move-requested seat] (put window :pointer-move-requested {:seat (:get-user-data seat)})
      [:pointer-resize-requested seat edges] (put window :pointer-resize-requested {:seat (:get-user-data seat) :edges edges})
      [:fullscreen-requested output] (put window :fullscreen-requested [:enter (if output (:get-user-data output))])
      [:exit-fullscreen-requested] (put window :fullscreen-requested [:exit])))
  (:set-handler obj handle-event)
  (:set-user-data obj window)
  window)

(defn clear [keys]
  (fn [obj]
    (each k keys
      (put obj k nil))))

(defn output/manage [output]
  (def new-tags [(output :tag-main)
                 ;(output :tags-other)
                 ;(if (output :tag-offload)
                    [[(output :tag-main) (output :tag-offload)]]
                    [])])
  (unless (= new-tags (output :tags))
    (put output :tags new-tags)
    (callback [:output-new-tags (get-in output [:wl-output :name])] new-tags)))

(defn window/enter-fullscreen [window &opt inform]
  (put window :fullscreen true)
  (when inform
    (:inform-fullscreen (window :obj)))
  (:fullscreen (window :obj) ((window :output) :obj)))

(defn window/exit-fullscreen [window &opt inform]
  (put window :fullscreen false)
  (when inform
    (:inform-not-fullscreen (window :obj)))
  (:exit-fullscreen (window :obj)))

(defn window/set-float [window float]
  (if float
    (:set-tiled (window :obj) {})
    (:set-tiled (window :obj) {:left true :bottom true :top true :right true}))
  (put window :float float))

(defn window/move-output [window output]
  (when output
    (put window :tag (output :tag-main))
    (put window :output output)))

(defn seat/focus-output [seat output]
  (unless (= output (seat :focused-output))
    (put seat :focused-output output)
    (when output (:set-default (output :layer-shell)))))

(defn seat/focus [seat window]
  (defn focus-window [window]
    (:focus-window (seat :obj) (window :obj))
    (put seat :focused window)
    (set (wm :render-order) (filter |(not (= $ window)) (wm :render-order)))
    (array/push (wm :render-order) window)
    (:place-top (window :node)))
  (defn clear-focus []
    (when (seat :focused)
      (:clear-focus (seat :obj))
      (put seat :focused nil)))
  (defn focus-non-layer []
    (when (and window (window :output))
      (seat/focus-output seat (window :output)))
    (when-let [output (seat :focused-output)]
      (defn visible? [w] (and w (= output (w :output))))
      (def visible (filter |(= output ($ :output)) (wm :render-order)))
      (cond
        (def fullscreen (last (filter |($ :fullscreen) visible))) (focus-window fullscreen)
        (visible? window) (focus-window window)
        (visible? (seat :focused)) (do)
        (def top-visible (last visible)) (focus-window top-visible)
        (clear-focus))))
  (case (seat :layer-focus)
    :exclusive (put seat :focused nil)
    :non-exclusive (if window
                     (do
                       (put seat :layer-focus :none)
                       (focus-non-layer))
                     (put seat :focused nil))
    :none (focus-non-layer)))

(defn window/should-float [window]
  (let [[min-w max-w min-h max-h] (or (window :dimensions-bounds) [0 1 0 1])]
    (and (= min-w max-w) (= min-h max-h) (< 0 min-w) (< 0 min-h))))

(defn window/manage [window]
  (when (window :new)
    (:use-ssd (window :obj))
    (if-let [parent (window :parent)]
      (do
        (window/set-float window true)
        (put window :tag (parent :tag))
        (:propose-dimensions (window :obj) 0 0))
      (do
        (def seat (first (wm :seats)))
        (window/set-float window (window/should-float window))
        (window/move-output window (seat :focused-output))
        (each seat (wm :seats) (seat/focus seat window))))
    (when-let [rule ((config :appid-rules) (window :app-id))]
      (rule window))
    (callback :new-window window))

  (match (window :fullscreen-requested)
    [:enter] (window/enter-fullscreen window)
    [:enter output] (do
                      (window/move-output window output)
                      (window/enter-fullscreen window))
    [:exit] (window/exit-fullscreen window))

  (put window :output (find |(has-value? ($ :tags) (window :tag)) (wm :outputs)))

  (if (window :output)
    (do
      (:show (window :obj))
      (when (window :fullscreen)
        (:fullscreen (window :obj) ((window :output) :obj))))
    (:hide (window :obj))))


(defn seat/manage [seat]
  (when (seat :new)
    (each binding (config :xkb-bindings)
      (binding/create seat ;binding)))

  (when-let [window (seat :focused)]
    (when (window :closed)
      (put seat :focused nil)))

  (if (or (not (seat :focused-output)) ((seat :focused-output) :removed))
    (seat/focus-output seat (first (wm :outputs))))

  (when (not= (seat :layer-focus) :non-exclusive)
    (seat/focus seat (seat :focused)))

  (seat/focus seat nil)

  (if-let [window (seat :window-interaction)]
    (seat/focus seat window))

  (when-let [[binding action] (seat :pending-action)]
    (action seat binding))

  (seat/focus seat nil))

(defn window/set-position [window x y]
  (let [border-width (config :border-width)
        x (+ x border-width)
        y (+ y border-width)]
    (put window :x x)
    (put window :y y)
    (:set-position (window :node) x y)))

(defn window/propose-dimensions [window w h]
  (:propose-dimensions (window :obj)
                       (max 1 (- w (* 2 (config :border-width))))
                       (max 1 (- h (* 2 (config :border-width))))))

(defn layout/rows [n x y w h]
  (if (> n 0)
    (do
      (def height (math/trunc (/ h n)))
      (defn rows [n]
        (if (= n 0) [] (let [Y (- (+ y h) (* n height))]
                         (tuple/join [[x Y w height]]
                                     (rows (- n 1))))))
      (rows n))
    []))

(defn layout/split [count n x y w h]
  (if (= n 1)
    [[x y w h]]
    (let [left (/ w 2)
          right (- w left)]
      (tuple/join (layout/rows (min n count) x y (+ x left) h)
                  (layout/rows (- n count) (+ x left) y right h)))))

(defn layout/main [n w h] (layout/split 1 n 0 0 w h))

(defn output/windows [output] (filter |(= output ($ :output)) (wm :windows)))

(defn output/layout [output]
  (def [X Y W H] (or (output :non-exclusive-area) [;(output :position) ;(output :dimensions)]))
  (def windows (filter |(not ($ :float)) (output/windows output)))
  (map (fn [window [x y w h]]
         (window/set-position window (+ X x) (+ Y y))
         (window/propose-dimensions window w h))
       windows
       (layout/main (length windows) W H))

  (each window (filter |($ :float) (output/windows output))
    (callback :layout-floating window)
    (let [[min-w max-w min-h max-h] (or (window :dimensions-bounds) [(/ W 2) (/ W 2) (/ H 2) (/ H 2)])
          h (if (< 10 min-h) min-h (/ H 2))
          w (if (< 10 min-w) min-w (/ W 2))
          t (+ Y (/ H 2) (- (math/trunc (/ h 2))))
          l (+ X (/ W 2) (- (math/trunc (/ w 2))))]
      (window/set-position window l t)
      (window/propose-dimensions window w h)
      (:place-top (window :node)))))

(defn output/set-main-tag [output tag]
  (map |(when (= ($ :tag-main) tag) (put $ :tag-main nil)) (wm :outputs))
  (put output :tag-main tag)
  (put output :tag-offload nil)
  (put output :tags-other []))

(defn output/toggle-other-tag [output tag]
  (if (has-value? (output :tags-other) tag)
    (do
      (put output :tags-other (filter |(not (= $ tag)) (output :tags-other)))
      false)
    (do
      (map (fn [output] (update output :tags-other (fn [tags] (filter |(not (= $ tag)) tags)))) (wm :outputs))
      (update output :tags-other |[;$ tag])
      (when-let [window (find |(= ($ :tag) tag) (wm :windows))]
        (put window :output output)
        (seat/focus (first (wm :seats)) window))
      true)))

(defn output/toggle-offload-tag [output tag]
  (put output :tag-offload (if (= (output :tag-offload) tag) nil tag)))

(defn output/ensure-main-tag [output]
  (when (not (output :tag-main))
    (def available (->> tags-main
                        (reverse)
                        (filter (fn [tag] (not (some |(= tag ($ :tag-main)) (wm :outputs)))))))
    (def tag (or
               (find (fn [tag] (not (some |(= ($ :tag) tag) (wm :windows)))) available)
               (first available)))
    (put output :tag-main tag)))


(defn wm/manage []
  (set (wm :render-order) (filter |(not ($ :closed)) (wm :render-order)))
  (defn close [o] (not (when (or (o :removed) (o :closed)) (:destroy (o :obj)) true)))
  (set (wm :outputs) (filter close (wm :outputs)))
  (set (wm :windows) (filter close (wm :windows)))
  (set (wm :seats) (filter close (wm :seats)))

  (map seat/manage (wm :seats))
  (map output/ensure-main-tag (wm :outputs))
  (map output/manage (wm :outputs))
  (map window/manage (wm :windows))
  (map |(seat/focus $ nil) (wm :seats)) # Reconcile focus again after potential tag changes

  (map output/layout (wm :outputs))

  (map (clear [:new]) (wm :outputs))
  (map (clear [:new :pointer-move-requested :pointer-resize-requested :fullscreen-requested]) (wm :windows))
  (map (clear [:new :window-interaction :pending-action]) (wm :seats))

  (:manage-finish (registry "river_window_manager_v1")))


(defn rgb-to-u32-rgba [rgb]
  [(* (band 0xff (brushift rgb 16)) (/ 0xffff_ffff 0xff))
   (* (band 0xff (brushift rgb 8)) (/ 0xffff_ffff 0xff))
   (* (band 0xff rgb) (/ 0xffff_ffff 0xff))
   0xffff_ffff])

(defn set-borders [window status]
  (def rgb (case status
             :normal (config :border-normal)
             :focused (config :border-focused)))
  (:set-borders (window :obj)
                {:left true :bottom :true :top :true :right true}
                (config :border-width)
                ;(rgb-to-u32-rgba rgb)))

(defn window/render [window]
  (when (and (not (window :x)) (window :w))
    (def output ((window :parent) :output))
    (window/set-position
      window
      (+ (output :x) (div (- (output :w) (window :w)) 2))
      (+ (output :y) (div (- (output :h) (window :h)) 2))))
  (if (find |(= ($ :focused) window) (wm :seats))
    (set-borders window :focused)
    (set-borders window :normal)))

(defn wm/render []
  (map window/render (wm :windows))
  (:render-finish (registry "river_window_manager_v1")))


(defn wm/handle-event [event]
  (match event
    [:unavailable] (error "another window manager is already running")
    [:finished] (os/exit 0)
    [:manage-start] (wm/manage)
    [:render-start] (wm/render)
    [:output obj] (array/push (wm :outputs) (output/create obj))
    [:seat obj] (array/push (wm :seats) (seat/create obj))
    [:window obj] (array/push (wm :windows) (window/create obj))))

(defn mark-dirty []
  (:manage-dirty (registry "river_window_manager_v1")))

(defn status-display [output]
  (def output (find |(= (get-in $ [:wl-output :name]) output) (wm :outputs)))
  (string
    ":"
    (if (= (output :tag-offload) :comma) "<" "")
    (output :tag-main)
    (if (= (output :tag-offload) :period) ">" "")
    " "
    (string/join (map |(string ":" $) (filter keyword? (output :tags-other))))))

(defn status-watcher [output]
  (def out (dyn *out*))
  (def clear (register-callback [:output-new-tags output] [tags] (with-dyns [*out* out] (print (status-display output)))))
  (print (status-display output))
  (defer (clear) (forever (ev/sleep 0.1))))


(defn action/target-in [obj list dir]
  (let [i (or (index-of obj list) -1)]
    (case dir
      :next (get list (+ i 1) (first list))
      :prev (get list (- i 1) (last list)))))

(defn action/target [seat dir]
  (when-let [window (seat :focused)
             output (window :output)
             windows (output/windows output)]
    (action/target-in window windows dir)))

(defn spawn [command]
  (ev/spawn (os/proc-wait (os/spawn ["/bin/sh" "-c" command] :p)))
  true)

(defn action/spawn [command]
  (fn [seat binding] (spawn command)))

(defn action/focus [dir] (fn [seat binding] (seat/focus seat (action/target seat dir))))
(defn action/focus-output [dir]
  (fn [seat binding]
    (when-let [current-output (seat :focused-output)
               outputs (wm :outputs)
               new-output (action/target-in current-output outputs dir)]
      (seat/focus-output seat new-output)
      (seat/focus seat (first (output/windows new-output)))
      (def [x y] (new-output :position))
      (def [w h] (new-output :dimensions))
      (:pointer-warp (seat :obj) (+ x (/ w 2)) (+ y (/ h 2))))))

(defn action/goto-tag [tag]
  (def f (cond
           (has-value? tags-main tag) output/set-main-tag
           (has-value? tags-other tag) output/toggle-other-tag
           (has-value? tags-offload tag) output/toggle-offload-tag))
  (fn [seat binding]
    (when-let [output (seat :focused-output)]
      (f output tag))))

(defn action/set-tag [tag]
  (fn [seat binding]
    (when-let [window (seat :focused)
               output (seat :focused-output)
               main-tag (output :tag-main)]
      (put window :tag (cond
                         (= (window :tag) [main-tag tag]) main-tag
                         (has-value? tags-offload tag) [main-tag tag]
                         tag)))))

(defn action/toggle-fullscreen [inform]
  (fn [seat binding]
    (def window (seat :focused))
    (if (window :fullscreen)
      (window/exit-fullscreen window inform)
      (window/enter-fullscreen window inform))))

(defn action/close []
  (fn [seat binding]
    (if-let [window (seat :focused)]
      (:close (window :obj)))))

(defn action/zoom []
  (fn [seat binding]
    (when-let [focused (seat :focused)
               output (focused :output)
               visible (output/windows output)
               target (if (= focused (first visible)) (get visible 1) focused)
               i (assert (index-of target (wm :windows)))]
      (array/remove (wm :windows) i)
      (array/insert (wm :windows) 0 target)
      (seat/focus seat (first (wm :windows))))))

(defn action/screenshot []
  (fn [seat binding]
    (spawn (string "GRIM_DEFAULT_DIR=\"$HOME/tmp\" grim -o " (get-in seat [:focused-output :wl-output :name])))))

(defn action/rotate-outputs []
  (def ks [:tag-main :tag-offload :tags-other])
  (fn [seat binding]
    (def outputs (wm :outputs))
    (def tags (map |(tabseq [k :in ks] k ($ k)) outputs))
    (map (fn [out tags]
           (eachp [k tag] tags (put out k tag))) outputs [;(slice tags 1) (first tags)])
    ((action/focus-output :next) seat nil)))

(defn rule/pulldown []
  (fn [window]
    (def appid (window :app-id))
    (put window :tag [:pulldown appid])
    (window/set-float window true)
    (when-let [w ((wm :pulldowns) appid)
               open (not (w :closed))]
      (:close (w :obj)))
    (put (wm :pulldowns) appid window)))

(defn action/pulldown [appid command]
  (fn [seat binding]
    (let [output (seat :focused-output)
          tag [:pulldown appid]
          has-tag (has-value? (output :tags-other) tag)
          window (get-in wm [:pulldowns appid])
          closed (when window (window :closed))
          has-window (and window (not closed))
          toggle-tag (delay (output/toggle-other-tag output tag))
          open (delay (spawn command))]
      (cond
        has-window (toggle-tag)
        has-tag (open)
        (do (open) (toggle-tag))))))


(defn locked-screen []
  (def notifs-status (= 0 (os/execute ["dunstctl" "is-paused" "-e"] :p)))
  (os/execute ["dunstctl" "set-paused" "true"] :p)
  (ev/spawn
    (os/execute ["pidwait" "swaylock"] :p)
    (os/execute ["dunstctl" "set-paused" (if notifs-status "true" "false")] :p)))

(defn lock-screen []
  (spawn "swaylock")
  (locked-screen))

(defn action/lock-screen []
  (fn [seat binding]
    (lock-screen)))

(put config :xkb-bindings (let [G {:mod4 true}
                                G-S {:mod4 true :shift true}
                                M {:mod1 true}
                                M-S {:mod1 true :shift true}]
                            [[:Tab M (action/focus :next)]
                             [:Tab M-S (action/focus :prev)]
                             [:Tab G (action/focus-output :next)]
                             [:Tab G-S (action/focus-output :prev)]
                             [:Tab {:mod4 true :ctrl true :mod1 true} (action/spawn "toggle-monitor")]
                             [:Return G (action/spawn "alacritty")]
                             [:f G (action/toggle-fullscreen true)]
                             [:f G-S (action/toggle-fullscreen false)]
                             [:k G (action/close)]
                             [:backslash G (action/zoom)]
                             [:backslash G-S (action/rotate-outputs)]
                             [:space G (action/spawn "rofi -show launch")]
                             [:x {:mod4 true} (action/spawn "rofi -show run")]
                             [:b G (action/spawn "rofi -show bt")]
                             [:p G (action/spawn "rofi-rbw")]
                             [:n G (action/spawn "rofi -show notifications")]
                             [:m G (action/spawn "rofi -show cliphist")]
                             [:s G (action/screenshot)]
                             [:j G (action/spawn "io.github.alainm23.planify.quick-add")]
                             [:o G (action/spawn "wl-present-ui")]
                             [:t G (action/pulldown "floating-terminal" "alacritty --class floating-terminal -e tmux new-session -ADX -s floating")]
                             [:r G (action/pulldown "floating-repl" "alacritty --class floating-repl -e censtablo-repl")]
                             [:h G (action/pulldown "floating-htop" "alacritty --class floating-htop -e htop")]
                             [:XF86AudioLowerVolume {} (action/spawn "pamixer -d 5")]
                             [:XF86AudioRaiseVolume {} (action/spawn "pamixer -i 5")]
                             [:XF86AudioMute {} (action/spawn "pamixer -t")]
                             [:XF86AudioPlay {} (action/spawn "playerctl play-pause")]
                             [:XF86AudioPrev {} (action/spawn "playerctl previous")]
                             [:XF86AudioNext {} (action/spawn "playerctl next")]
                             [:Pause {} (action/lock-screen)]
                             ;(map |[$ {:mod5 true} (action/goto-tag $)] (tuple ;tags-main ;tags-other ;tags-offload))
                             ;(map |[$ {:mod5 true :shift true} (action/set-tag $)] (tuple ;tags-main ;tags-other ;tags-offload))]))


(defn rule/tag [tag] (fn [window] (put window :tag tag)))
(defn rule/float [float] (fn [window] (put window :float float)))

(put config :appid-rules @{"thunderbird" (rule/tag :m)
                           "vesktop" (rule/tag :d)
                           "io.github.alainm23.planify" (rule/tag :j)
                           "floating-terminal" (rule/pulldown)
                           "floating-repl" (rule/pulldown)
                           "floating-htop" (rule/pulldown)
                           "steam" (rule/float false)})


(defn startup []
  (spawn "pkill waybar; waybar")
  (spawn "kanshi")

  (spawn "vesktop")
  (spawn "thunderbird")
  (spawn "solaar --window hide")
  (spawn "io.github.alainm23.planify"))

# TODO: layout flexibility
# TODO: fullscreen oddities with games: debug (warframe, novadrift, portal)
# TODO: firefox focus weirdness
# TODO: double fullscreen
# TODO: swaylock hibernate acquire outputs

(defn configure-keymap []
  (def ctx (xkbcommon/context/new))
  (def rmlvo (:create-rmlvo ctx))
  (:append-layout rmlvo "us-local")
  (def keymap (:create-keymap rmlvo :text-v2))
  (def str (:get-string keymap :text-v2))
  (def fd (wayland/memfd/from-string str))

  (def keymap (:create-keymap (registry "river_xkb_config_v1") fd :text-v2))
  (defn apply-km [kb]
    (:set-keymap kb keymap)
    (:set-layout-by-name kb "us-local"))
  (var ready false)
  (def keyboards @[])
  (:set-handler keymap (fn [event]
                         (match event
                           [:success] (do
                                        (set ready true)
                                        (each keyboard keyboards (apply-km keyboard)))
                           [:failure err] (errorf "invalid keymap %s" err))))

  (:set-handler (registry "river_xkb_config_v1") (fn [event]
                                                   (match event
                                                     [:xkb-keyboard keyboard] (if ready (apply-km keyboard) (array/push keyboards keyboard))))))


(def repl-env (curenv))
(defn repl-server-create []
  (def path (string/format "%s/censtablo-%s" (os/getenv "XDG_RUNTIME_DIR") (os/getenv "WAYLAND_DISPLAY")))
  (protect (os/rm path))
  (netrepl/server :unix path repl-env))

# Stolen from https://git.sr.ht/~leon_plickat/river-config/tree/master/item/river/launch-river.sh
(def env {"WAYLAND_DEBUG" nil
          "MOZ_ENABLE_WAYLAND" "1"
          "CLUTTER_BACKEND" "wayland"
          "QT_QPA_PLATFORM" "wayland"
          "ECORE_EVAS_ENGINE" "wayland-egl"
          "ELM_ENGINE" "wayland_egl"
          "_JAVA_AWT_WM_NONREPARENTING" "1"
          "NO_AT_BRIDGE" "1"

          "XDG_SESSION_TYPE" "wayland"
          "XDG_SESSION_DESKTOP" "river"
          "XDG_CURRENT_DESKTOP" "river"

          "NIXOS_OZONE_WL" "1"})

(defn main [&]
  (def display (wayland/connect interfaces))
  (eachp [var val] env (os/setenv var val))

  (put registry :obj (:get-registry display))
  (:set-handler (registry :obj) (fn [event]
                                  (match event
                                    [:global name interface version]
                                    (do
                                      (when-let [required-version (required-interfaces interface)]
                                        (when (< version required-version)
                                          (errorf "wayland compositor supported %s version too old (need %d, got %d)" interface required-version version))
                                        (put registry interface (:bind (registry :obj) name interface required-version)))
                                      (when (= interface "wl_output")
                                        (wl-output/create name (:bind (registry :obj) name interface 4))))
                                    [:global-remove name]
                                    (when-let [obj (wl-outputs name)]
                                      (put wl-outputs name nil)
                                      (:release (obj :obj))))))
  (:roundtrip display)
  (eachk i required-interfaces
    (unless (get registry i)
      (errorf "wayland compositor does not support %s" i)))

  (:set-handler (registry "river_window_manager_v1") wm/handle-event)
  (:set-handler (registry "river_input_manager_v1") (fn [event]
                                                      (match event
                                                        [:input-device input] (input/create input))))
  (configure-keymap)

  (:roundtrip display)

  (startup)

  (def repl-server (repl-server-create))
  (defer (:close repl-server)
    (forever (:dispatch display))))