;;;; -*- Mode: Lisp -*-

;;;; This is the .stumpwmrc file of Jean-Philippe Paradis (Hexstream).
;;;; I have not yet documented and cleaned this so it's a bit raw.

;;;; StumpWM is an emacs-like X window manager written in Common Lisp.
;;;; StumpWM homepage: http://www.nongnu.org/stumpwm/
;;;; (I'm not affiliated with StumpWM, just an enthusiastic user.)

(defpackage #:stumpwm-hexstream
  (:use #:cl)
  (:import-from #:stumpwm #:bind #:define-key #:kbd #:defcommand))

(in-package #:stumpwm-hexstream)

(defun hexstream-setup-groups ()
  (stumpwm:grename "Misc")
  (let ((misc (stumpwm:current-group))
        (dev (stumpwm:gnewbg "Dev"))
        (games (stumpwm:gnewbg "Games"))
        (desktop (stumpwm:gnewbg ".Desktop")))
    (stumpwm:define-frame-preference desktop (0 nil nil :title "x-nautilus-desktop"))
    (defparameter *misc-group* misc)
    (defparameter *dev-group* dev)
    (defparameter *games-group* games)
    (defparameter *desktop-group* desktop)))

(defun hexstream-cold-init ()
  (hexstream-setup-groups))

(defun get-sound-volume ()
  (let ((string (stumpwm:run-shell-command "amixer sget Master" t)))
    (parse-integer string :start (1+ (position #\[ string)) :junk-allowed t)))

(defun format-volume (adjust-mode amount)
  (format nil "~A%~A" amount (ecase adjust-mode
                               (:+ "+")
                               (:- "-")
                               (:= ""))))

(defun volcontrol-custom (channel adjust-mode amount &key (messagep t))
  (let ((previous (get-sound-volume)))
    (stumpwm:run-shell-command (format nil "amixer set ~A ~A"
                                       channel (format-volume adjust-mode amount))
     t)
    (when messagep
      (let ((stumpwm:*timeout-wait* 1))
        (stumpwm:message (format nil "~A% --> ~A%" previous (get-sound-volume)))))))

(defcommand adjust-volume (delta) ((:number "Adjust volume by delta: "))
  (multiple-value-bind (adjust-mode delta)
      (if (>= delta 0)
          (values :+ delta)
          (values :- (- delta)))
    (volcontrol-custom "Master" adjust-mode delta :messagep nil))
  (stumpwm:message (format nil "~A%" (get-sound-volume))))

(defun get-mouse-location ()
  (let ((output (stumpwm:run-shell-command "xdotool getmouselocation" t)))
    (flet ((parse (prefix)
             (parse-integer output
                            :start (+ (search prefix output) (length prefix))
                            :junk-allowed t)))
      (values (parse "x:") (parse "y:")))))

(defcommand show-mouse-location () ()
  (stumpwm:message (multiple-value-call #'format nil "~A ~A" (get-mouse-location))))


(defun centroid (coords &key (key #'identity))
  (let ((length (length coords)))
    (case length
      (0 (error "Cannot determine centroid."))
      (1 (funcall key (first coords)))
      (t (/ (reduce #'+ coords :key key) length)))))

(defparameter *warp-combo* nil)

(defparameter *combo-threshold* 50)

(declaim (inline complex-parts))
(defun complex-parts (complex)
  (values (realpart complex) (imagpart complex)))

(defun floor-complex (complex)
  (complex (floor (realpart complex))
           (floor (imagpart complex))))

;; What is the actual name of this math operation?
(defun scale-complexes (unscaled scaling-factor)
  (complex (* (realpart unscaled) (realpart scaling-factor))
           (* (imagpart unscaled) (imagpart scaling-factor))))

(defun make-quadrant-to-point-converter (far)
  (let ((quadrant-to-inner-offset
         (if far
             (lambda (quadrant)
               (svref (load-time-value
                       (let ((vector (make-array 9 :element-type 'complex))
                             (i 0)
                             (steps '(0 1/2 1)))
                         (dolist (y steps)
                           (dolist (x steps)
                             (setf (svref vector i) (complex x y))
                             (incf i)))
                         vector))
                      (1- quadrant)))
             (constantly #C(1/2 1/2)))))
    (lambda (quadrant)
      (multiple-value-bind (row column) (floor (1- quadrant) 3)
        (+ (complex column row)
           (funcall quadrant-to-inner-offset quadrant))))))

(defcommand warp-mouse-to-quadrant (quadrant &optional far) ((:number "Warp to quadrant: ") (:y-or-n "Far? "))
  (check-type quadrant (integer 1 9))
  (let ((new-combo (let ((now (get-internal-real-time)))
                     (cons (list now quadrant far)
                           (remove-if (lambda (when)
                                        (> (- now when) *combo-threshold*))
                                      *warp-combo* :key #'first)))))
    (setf *warp-combo* new-combo)
    (let ((unscaled-point (centroid new-combo :key (let ((converter (make-quadrant-to-point-converter
                                                                     (some #'third new-combo))))
                                                     (lambda (request)
                                                       (funcall converter (second request))))))
          (quadrant-size (/ (let ((screen (stumpwm:current-screen)))
                              (complex (stumpwm:screen-width screen)
                                       (stumpwm:screen-height screen)))
                            3)))
      (multiple-value-call #'stumpwm:ratwarp
        (complex-parts (floor-complex (scale-complexes unscaled-point quadrant-size)))))))

(defvar *truly-fullscreen* nil)

(defcommand toggle-truly-fullscreen () ()
  (setf *truly-fullscreen* (not *truly-fullscreen*))
  (let ((ignored-pixels (if *truly-fullscreen* 0 33))
        (screen (stumpwm:current-screen)))
    (stumpwm::resize-head 0 0 ignored-pixels
                          (stumpwm:screen-width screen)
                          (- (stumpwm:screen-height screen) ignored-pixels))))

(defcommand mate-terminal () ()
  (stumpwm:run-or-raise "mate-terminal" '(:class "Mate-terminal")))

(defcommand google-chrome () ()
  (stumpwm:run-or-raise "google-chrome" '(:class "Chrome")))

(defcommand lastmsg-no-timeout () ()
  (let ((stumpwm:*timeout-wait* 3600))
    (stumpwm:lastmsg)))

(defcommand activate-screensaver () ()
  (stumpwm:run-shell-command "gnome-screensaver-command -a"))

(defcommand amixer-master (percent) ((:string "Set volume: "))
  (if percent
      (volcontrol-custom "Master" := (or (cdr (assoc percent '(("1" . "33")
                                                               ("2" . "50")
                                                               ("3" . "75")
                                                               ("4" . "100"))
                                                     :test #'string=))
                                         percent))
      (throw 'error "Abort.")))


;;; Multiclick

(defvar *recorded-clicks* nil)
(defvar *recorded-clicks-armed* nil)

(defcommand multiclick-reset () ()
  (setf *recorded-clicks* nil
        *recorded-clicks-armed* nil))

(defcommand multiclick-append () ()
  (when *recorded-clicks-armed*
    (multiclick-reset))
  (push (multiple-value-call #'cons (get-mouse-location))
        *recorded-clicks*))

(defcommand multiclick-apply () ()
  (unless *recorded-clicks-armed*
    (setf *recorded-clicks* (nreverse *recorded-clicks*)
          *recorded-clicks-armed* t))
  (dolist (click *recorded-clicks*)
    (stumpwm:ratwarp (car click) (cdr click))
    (stumpwm:ratclick)))


(defun hexstream-init ()
  (when stumpwm:*initializing*
    (hexstream-cold-init)
    (toggle-truly-fullscreen))
  (stumpwm:set-font "-*-fixed-*-*-*-*-20-*-*-*-*-*-*-*")
  (bind "C-t" "other-in-frame")
  (bind "-" "remove-split")
  (bind "=" "balance-frames")
  (bind "M-t" "pull-hidden-other")
  (setf stumpwm:*mouse-focus-policy* :click)
  (setf stumpwm:*timeout-frame-indicator-wait* 0.2
        stumpwm:*timeout-wait* 5)
  (setf stumpwm:*window-border-style* :thick)
  (bind "DEL" "multiclick-reset")
  (bind "SPC" "multiclick-append")
  (bind "RET" "multiclick-apply")
  (flet ((dk (key command)
           (define-key stumpwm:*top-map* (kbd key) command)))
    (dk "s-b" "banish")
    (dk "F6" "abort")
    (dk "s-1" "gselect 1")
    (dk "s-2" "gselect 2")
    (dk "s-3" "gselect 3")
    (dk "s-4" "vgroups")
    (dk "M-s-1" "select-window-by-number 1")
    (dk "M-s-2" "select-window-by-number 2")
    (dk "M-s-3" "select-window-by-number 3")
    (dk "M-s-4" "select-window-by-number 4")
    (dk "s-a" "delete")
    (dk "s-f" "fullscreen")
    (dk "s-e" "exec caja --no-desktop --browser /home/hexstream/")
    (dk "s-y" "exec google-chrome https://www.meteomedia.com/ca/meteo/quebec/terrebonne")
    (dk "XF86AudioRaiseVolume" "adjust-volume 1")
    (dk "XF86AudioLowerVolume" "adjust-volume -1")
    (dk "XF86AudioMute" "amixer-master 0")
    (dk "C-s-1" "amixer-master 1")
    (dk "C-s-2" "amixer-master 2")
    (dk "C-s-3" "amixer-master 3")
    (dk "C-s-4" "amixer-master 4")
    (dk "s-Up" "ratrelwarp 0 -1")
    (dk "s-Down" "ratrelwarp 0 1")
    (dk "s-Left" "ratrelwarp -1 0")
    (dk "s-Right" "ratrelwarp 1 0")
    (dk "s-KP_Delete" "show-mouse-location")
    (dk "M-s-a" "warp-mouse-to-quadrant 1 n")
    (dk "M-s-b" "warp-mouse-to-quadrant 2 n")
    (dk "M-s-c" "warp-mouse-to-quadrant 3 n")
    (dk "M-s-d" "warp-mouse-to-quadrant 4 n")
    (dk "M-s-e" "warp-mouse-to-quadrant 5 n")
    (dk "M-s-f" "warp-mouse-to-quadrant 6 n")
    (dk "M-s-g" "warp-mouse-to-quadrant 7 n")
    (dk "M-s-h" "warp-mouse-to-quadrant 8 n")
    (dk "M-s-i" "warp-mouse-to-quadrant 9 n")
    (dk "M-s-A" "warp-mouse-to-quadrant 1 y")
    (dk "M-s-B" "warp-mouse-to-quadrant 2 y")
    (dk "M-s-C" "warp-mouse-to-quadrant 3 y")
    (dk "M-s-D" "warp-mouse-to-quadrant 4 y")
    (dk "M-s-E" "warp-mouse-to-quadrant 5 y")
    (dk "M-s-F" "warp-mouse-to-quadrant 6 y")
    (dk "M-s-G" "warp-mouse-to-quadrant 7 y")
    (dk "M-s-H" "warp-mouse-to-quadrant 8 y")
    (dk "M-s-I" "warp-mouse-to-quadrant 9 y")
    (dk "XF86Launch6" "toggle-truly-fullscreen"))
  (defparameter *ror-map*
    (let ((map (stumpwm:make-sparse-keymap)))
      (flet ((dk (key command)
               (define-key map (kbd key) command)))
        (dk "e" "emacs")
        (dk "c" "mate-terminal")
        (dk "b" "google-chrome"))
      map))
  (bind "e" '*ror-map*)
  (bind "M" "lastmsg-no-timeout")
  (defparameter *ext-map*
    (let ((map (stumpwm:make-sparse-keymap)))
      (flet ((dk (key command)
               (define-key map (kbd key) command)))
        (dk "p" "list-window-properties")
        (dk "l" "loadrc")
        (dk "b" "activate-screensaver")
        (dk "v" "amixer-master")
        (dk "f" "fullscreen"))
      map))
  (bind "x" '*ext-map*)
  (setf stumpwm::*window-number-map* "123456789"))

(hexstream-init)