stumpwm/posture.lisp @ a65fd2691c94 default tip

(in-package :stumpwm-user)

(defparameter *posture-thread* nil)
(defparameter *posture-should-stop* nil)
(defparameter *posture-paused* nil)
(defparameter *posture-snooze* nil)
(defparameter *posture-current* 30)
(defparameter *posture-min* 5)
(defparameter *posture-max* (hours->seconds 2))

(defun posture-paused-p ()
  ;; this is the dumbest shit ever, but I can't figure out how to call into
  ;; stumpish from the setguid slock process
  (or *posture-paused* (probe-file "/tmp/.posture-pause")))

(defun posture-snoozed-p ()
  (and *posture-snooze*
       (< (get-universal-time) *posture-snooze*)))

(defcommand posture-pause () ()
  (message "Pausing posture.")
  (setf *posture-paused* t))

(defcommand posture-unpause () ()
  (message "Unpausing posture.")
  (setf *posture-paused* nil))

(defcommand posture-toggle-pause () ()
  (if (setf *posture-paused* (not *posture-paused*))
    (message "Posture is now paused.")
    (message "Posture is now unpaused.")))

(defcommand posture-snooze (hours)
    ((:real "Snooze for how many hours? "))
  (setf *posture-snooze* (+ (hours->seconds hours) (get-universal-time))))

(defun posture-update (delta)
  (setf *posture-current*
        (clamp *posture-min* *posture-max* (* *posture-current* delta))))

(defun posture-query ()
  (speak "Is your posture okay?"))

(defcommand posture-answer-yes () ()
  (message "Good work.")
  (run-shell-command "echo $(epochseconds) 1.0 >> ~/.posture.log")
  (posture-update 11/10))

(defcommand posture-answer-meh () ()
  (message "Better than nothing.")
  (run-shell-command "echo $(epochseconds) 0.5 >> ~/.posture.log"))

(defcommand posture-answer-no () ()
  (message "Try harder.")
  (run-shell-command "echo $(epochseconds) 0.0 >> ~/.posture.log")
  (posture-update 8/10))

(defun posture% ()
  (if *posture-should-stop*
    nil
    (progn (unless (or (posture-paused-p) (posture-snoozed-p))
             (posture-query)
             (sleep 10))
           *posture-current*)))

(defun posture-running-p ()
  (and *posture-thread* (sb-thread:thread-alive-p *posture-thread*)))

(defcommand posture-stop () ()
  (setf *posture-should-stop* t))

(defcommand posture-start () ()
  (setf *posture-should-stop* nil)
  (if (posture-running-p)
    (message "Posture loop was already running.")
    (setf *posture-thread*
          (sb-thread:make-thread
            (lambda ()
              (loop :for seconds = (posture%)
                    :while seconds
                    :do (sleep seconds))
              (message "Posture loop exiting."))
            :name "Posture thread"))))