hju.ros

#!/bin/sh
#|-*- mode:lisp -*-|#
#| hue cmdline controller
exec ros -Q -- $0 "$@"
|#
(progn ;;init forms
  (ros:ensure-asdf)
  #+quicklisp (ql:quickload '(cl-hue
                              apply-argv
                              parse-number) :silent t))

(defpackage :ros.script.hju.3690567483
  (:use :cl))
(defpackage :ros.script.hju.3690567483.config
  (:use :cl)
  (:nicknames :hju-config)
  (:export #:*bridge-url*
           #:*user-id*))

(in-package :ros.script.hju.3690567483)


;;; State.

(defvar *bridge* nil "Hue bridge.")
(defvar *all-lights* nil "All lights registered to the Hue bridge.")
(defvar *verbose* nil "Do a verbose output.")
(defvar *errno* 0 "Error return code to OS.")
(defvar *transition-time* 4 "Transition time (in 1/10ths of a second).")


;;; Exit value constants (aka. SYSEXITs)
(defparameter +exit-ok+ 0)
(defparameter +exit-whatever+ 1)
(defparameter +exit-usage-error+ 64)
(defparameter +exit-data-format-error+ 65)
(defparameter +exit-configuration-error+ 78)


;;; Other constants
(defparameter +config-file-name+ ".hju")
(defparameter +config-file-search-locations+ (list (merge-pathnames +config-file-name+ (user-homedir-pathname))
                                                   (merge-pathnames +config-file-name+ (merge-pathnames ".config/hju/" (user-homedir-pathname)))))

(defparameter hju-config:*bridge-url* nil "Bridge URL settable by config file.")
(defparameter hju-config:*user-id* nil "User ID settable by config file.")


;;; Color gamuts
(defparameter +color-gamuts+ '((:gamut-A . ((0.704 0.296)   ;R
                                            (0.2151 0.7106) ;G
                                            (0.138 0.080)   ;B
                                            ))
                               (:gamut-B . ((0.675 0.322)   ;R
                                            (0.409 0.518)   ;G
                                            (0.167 0.040)   ;B
                                            ))
                               (:gamut-C . ((0.692 0.308)   ;R
                                            (0.170 0.700)   ;G
                                            (0.153 0.048)   ;B
                                            ))
                               (:default . ((1.000 0.000)   ;R
                                            (0.000 1.000)   ;G
                                            (0.000 0.000)   ;B
                                            ))))

(defparameter +bulbs->gamuts+ '(("LST001" . :gamut-A)
                                ("LLC010" . :gamut-A)
                                ("LLC011" . :gamut-A)
                                ("LLC012" . :gamut-A)
                                ("LLC006" . :gamut-A)
                                ("LLC007" . :gamut-A)
                                ("LLC013" . :gamut-A)
                                
                                ("LCT001" . :gamut-B)
                                ("LCT002" . :gamut-B)
                                ("LCT003" . :gamut-B)
                                ("LCT007" . :gamut-B)
                                ("LLM001" . :gamut-B)

                                ("LCT010" . :gamut-C)
                                ("LCT014" . :gamut-C)
                                ("LCT011" . :gamut-C)
                                ("LLC020" . :gamut-C)
                                ("LST002" . :gamut-C)))


;;; Error handling.
(defun errout (exit-code error-message)
  "Sets the error string to be displayed at the end of application to `ERROR-MESSAGE', and sets the exit value of the program to `EXIT-CODE'."
  (setf *errno* exit-code)
  (error error-message))

(defun trap-errors-handler (error)
  (format *error-output* "Error: ~A." error)
  (fresh-line *error-output*)
  (throw 'trap-errors (if (zerop *errno*) +exit-whatever+ *errno*)))

(defmacro trap-errors (&rest forms)
  `(catch 'trap-errors
     (handler-bind ((serious-condition #'trap-errors-handler))
       ,@forms)))


;;; Help commands.

(defun print-usage ()
  (format t "~&hju - a simple command line controller for Hue lights
~&Version: 0.5
~&
~&Usage:
~&~8Thju [options...] <command> [args]
~&
~&Use \"hju -h\" or \"hju --help\" for complete list of options.~&"))

(defun print-help ()
  (print-usage)
  (format t "~&Options:
~&~8T-h, --help~35,8@TDisplay this text.
~&~8T-v, --verbose~30,8@TMake output verbose.
~&~8T-b BRIDGE, --bridge=BRIDGE~15,8@TUse different bridge URL than the default.
~&~8T-u USER, --user=USER~25,8@TUse different user ID than the default.
~&~8T-t TRANSITION, --transition=TRANSITION~10,8@TUse specified transition time (in tenths of a second).
~&
~&~4TTRANSITION is given in seconds, can be fractional. Default value: 0.4.
~&~4TTerminate options with -- if -h or -v is used last.
~&
~&Defaults are taken from the config file .hju in your home directory.
~&The format of that file is:
~&~4T(setf *bridge-url* \"bridge URL\" *user-id* \"USER ID\")
~&
~&Commands:
~&~8Tstatus~20,8@TDisplay status of Hue bridge and all lights.
~&~8Tlist~25,8@TJust list available lights and their status.
~&~8Ton LIGHTS~20,8@TTurn on LIGHTS.
~&~8Toff LIGHTS~20,8@TTurn off LIGHTS.
~&~8Ttoggle LIGHTS~15,8@TToggle LIGHTS.
~&~8Treset LIGHTS~15,8@TReset LIGHTS to the values I (the author) like.
~&~8Tblink LIGHTS~15,8@TBlink LIGHTS.
~&~8Tset LIGHTS rgb R G B~10,8@TSet color of LIGHTS to rgb(R, G, B) (each component in [0.0 ... 1.0]).
~&~8Tset LIGHTS rgb #RRGGBB~10,8@TSet color of LIGHTS to #RRGGBB (hex).
~&~8Tset LIGHTS rgb #RGB~10,8@TSet color of LIGHTS to #RRGGBB (hex).
~&~8Tset LIGHTS hue HUE~10,8@TSet hue of LIGHTS to HUE [0...65535].
~&~8Tset LIGHTS sat SAT~10,8@TSet saturation of LIGHTS to SAT [0...254].
~&~8Tset LIGHTS bri BRI~10,8@TSet brightness of LIGHTS to BRI [1...254].
~&~8Tset LIGHTS ct CT~10,8@TSet color temperature of LIGHTS to CT in Mired.
~&~8Tset LIGHTS ctk CTK~10,8@TSet color temperature of LIGHTS to CTK in Kelvins.
~&~8Tset LIGHTS xy X Y~10,8@TSet color of LIGHTS to coordinates (X, Y) in CIE color space.
~&
~&~4TLIGHTS can be given as a comma-separated list of numbers or prefixes of their names.
~&~4TLIGHTS can also be given as \"all\", which will make the command affect all lights.
~&
~&Examples:
~&~8Thju on living,bathroom
~&~8Thju off bat
~&~8Thju set 1,3 rgb #11FF11
"))


;;; Hue lights utils

(defun fetch-all-lights ()
  (setf *all-lights* (cl-hue:get-lights *bridge*)))

(defun kelvins->mireds (ctk)
  "Convert color temperature from Kelvins to mireds."
  (floor (/ 1000000 ctk)))

(defun ttime->msec (transition-time)
  "Converts Hue `transition-time' to milliseconds."
  (* 100 transition-time))


;;; Math utils
(defun make-vec-2d (x y)
  (list x y))

(defun vec-x (v)
  (car v))

(defun vec-y (v)
  (cadr v))

(defun clamp (what a b)
  "Ensures `WHAT' is between `A' and `B' (inclusive)."
  (max a (min b what)))

(defun cross-product (v1 v2)
  "Cross product of two 2D vectors - `v1' and `v2'. Returns a scalar equal to the magnitude
of the cross product in 3D space."
  (- (* (vec-x v1) (vec-y v2))
     (* (vec-y v1) (vec-x v2))))

(defun dot-product (v1 v2)
  "Dot product of two 2D vectors - `v1' and `v2'."
  (+ (* (vec-x v1) (vec-x v2))
     (* (vec-y v1) (vec-y v2))))

(defun distance-2d-squared (v1 v2)
  (let ((dx (- (vec-x v1)
               (vec-x v2)))
        (dy (- (vec-y v1)
               (vec-y v2))))
    (+ (* dx dx)
       (* dy dy))))

(defun closest-point-on-segment (point segment-start segment-end)
  "Returns a point closest to `POINT' that is on a segment starting from `SEGMENT-START' and ending at `SEGMENT-END'.
Order of segment start/end is irrelevant."
  (let* ((start->point (make-vec-2d (- (vec-x point) (vec-x segment-start))
                                    (- (vec-y point) (vec-y segment-start))))
         (start->end (make-vec-2d (- (vec-x segment-end) (vec-x segment-start))
                                  (- (vec-y segment-end) (vec-y segment-start))))
         (start->end-dotsquared (dot-product start->end start->end))
         (start->point-dot-start->end (dot-product start->end start->point))
         (p (clamp (/ start->point-dot-start->end start->end-dotsquared)
                   0.0
                   1.0)))
    (make-vec-2d (+ (vec-x segment-start)
                    (* (vec-x start->end) p))
                 (+ (vec-y segment-start)
                    (* (vec-y start->end) p)))))


;;; Hue x Commands utils
(defun number-in-range-p (number min max)
  (and (numberp number)
       (>= number min)
       (<= number max)))

(defun change-range (number from-start from-end to-start to-end)
  "Change `NUMBER' from range [`FROM-START' ... `FROM-END'] to [`TO-START' ... `TO-END']."
  (+ (* (/ (- number from-start)
           (- from-end from-start))
        (- to-end to-start))
     to-start))

(defun rgbhex->rgb (hex)
  "Convert hexadecimal color notation of #RGB or #RRGGBB to 0-1 ranged rgb(r g b)."
  (let ((string-to-process (cond ((= (length hex) 4)
                                  (coerce (list (elt hex 1) (elt hex 1) (elt hex 2) (elt hex 2) (elt hex 3) (elt hex 3)) 'string))
                                 ((= (length hex) 7)
                                  (subseq hex 1))
                                 (t
                                  (errout +exit-data-format-error+ "malformated RGB hex value")))))
    (values-list (mapcar (lambda (num)
                           (change-range (parse-number:parse-number num :radix 16)
                                         0 255
                                         0.0 1.0))
                         (list (subseq string-to-process 0 2)
                               (subseq string-to-process 2 4)
                               (subseq string-to-process 4 6))))))

(defun denormalize-brightness (brightness)
  "Convert `BRIGHTNESS' from [0.0 ... 1.0] range to [1 ... 254]."
  (round (change-range brightness 0.0 1.0 1 254)))

(defun light-type->color-gamut (light-type)
  "Converts `light-type' property of a light to the appropriate color gamut it uses, per Hue official documentation."
  (if (stringp light-type)
      (or (cdr (assoc light-type +bulbs->gamuts+ :test #'string-equal))
          :default)
      :default))

(defun closest-point-on-triangle (point triangle-r triangle-g triangle-b)
  "Takes a `POINT' and a triangle made of three corners; returns closest point to `POINT' in the triangle."
  (flet ((point-in-triangle ()
           (let* ((rx (vec-x triangle-r))
                  (ry (vec-y triangle-r))
                  (v1 (make-vec-2d (- (vec-x triangle-g) rx)
                                   (- (vec-y triangle-g) ry)))
                  (v2 (make-vec-2d (- (vec-x triangle-b) rx)
                                   (- (vec-y triangle-b) ry)))
                  (q (make-vec-2d (- (vec-x point) rx)
                                  (- (vec-y point) ry)))
                  (divisor (cross-product v1 v2))
                  (s (/ (cross-product q v2) divisor))
                  (u (/ (cross-product v1 q) divisor)))
             (and (>= s 0.0)
                  (>= u 0.0)
                  (<= (+ s u)
                      1.0))))
         (compute-closest-point ()
           (let* ((closest-on-RG (closest-point-on-segment point triangle-r triangle-g))
                  (closest-on-BR (closest-point-on-segment point triangle-b triangle-r))
                  (closest-on-GB (closest-point-on-segment point triangle-g triangle-b))
                  (distance2-to-RG (distance-2d-squared point closest-on-RG))
                  (distance2-to-BR (distance-2d-squared point closest-on-BR))
                  (distance2-to-GB (distance-2d-squared point closest-on-GB))
                  (lowest-distance distance2-to-RG))
             (cond ((< distance2-to-BR lowest-distance)
                    closest-on-BR)
                   ((< distance2-to-GB lowest-distance)
                    closest-on-GB)
                   (t
                    closest-on-RG)))))
    (if (point-in-triangle)
        point
        (compute-closest-point))))

(defun color-gamut->color-triangle (gamut)
  (cdr (assoc gamut +color-gamuts+)))

(defun rgb->xyb (r g b light-type)
  "Takes an RGB color and converts it to XY coordinates in CIE color space and a brightness value, bounded
to the actual color gamut available on light (determined by `LIGHT-TYPE').
Returns results as (VALUES X Y BRIGHTNESS).
Refer to Philips Hue documentation for details."
  (labels ((gamma-correct (component)
             (if (> component 0.04045)
                 (expt (/ (+ component 0.055)
                          (+ 1.0 0.055))
                       2.4)
                 (/ component 12.92)))
           (gamma-correction (r g b)
             (mapcar #'gamma-correct (list r g b)))
           (D65-conversion (r g b)
             ;; taken from Hue documentation
             (let ((x (+ (* r 0.664511)
                         (* g 0.154324)
                         (* b 0.162028)))
                   (y (+ (* r 0.283881)
                         (* g 0.668433)
                         (* b 0.047685)))
                   (z (+ (* r 0.000088)
                         (* g 0.072310)
                         (* b 0.986039))))
               (values x y z))))
    (destructuring-bind (triangle-r triangle-g triangle-b) (color-gamut->color-triangle (light-type->color-gamut light-type))
      (destructuring-bind (corrected-r corrected-g corrected-b) (gamma-correction r g b)
        (multiple-value-bind (x y z) (D65-conversion corrected-r corrected-g corrected-b)
          (let* ((sum (+ x y z))
                 (brightness y)
                 (candidate-point (make-vec-2d (if (zerop sum) 0.0 (/ x sum))
                                               (if (zerop sum) 0.0 (/ y sum))))
                 (final-point (closest-point-on-triangle candidate-point triangle-r triangle-g triangle-b)))
            (values (vec-x final-point) (vec-y final-point) brightness)))))))

(defun starts-with (string with-what &key (test #'char=))
  (let ((result (search with-what string :test test)))
    (and (numberp result)
         (= 0 result))))

(defun get-light-by-param-id (param-id)
  (unless param-id
    (errout +exit-usage-error+ "light ID not specified"))
  (let* ((numeric-id (parse-integer param-id :junk-allowed t))
         (light (if numeric-id
                    (find param-id *all-lights* :test #'string-equal :key #'cl-hue::light-number)
                    (find param-id *all-lights*
                          :test (lambda (key value)
                                  (starts-with value key :test #'char-equal))
                          :key #'cl-hue::light-name))))
    (unless light
      (errout +exit-usage-error+ (format nil "light ~A not found" param-id)))
    light))

(defun get-lights-by-param (param)
  (unless param
    (errout +exit-usage-error+ "light ID not specified"))
  (if (string-equal param "all")
      *all-lights*
      (mapcar #'get-light-by-param-id (split-sequence:split-sequence #\, param))))

(defun light-short-description (light)
  (format nil "~A (~A)" (cl-hue::light-name light) (cl-hue::light-number light)))

(defun describe-light (light)
  (flet ((light-status-shortcode ()
           (cond ((not (cl-hue::light-reachable-p light))
                  "??")
                 ((cl-hue::light-on-p light)
                  "ON")
                 (t
                  "  "))))
    (format t "~&[~A] ~A: ~A"
            (light-status-shortcode)
            (cl-hue::light-number light)
            (cl-hue::light-name light))
    (format t "~40TMode: ~A, HSV: (~A, ~A, ~A), Temp: ~A mireds." ;FIXME if mode = xy, output XY (and brightness)instead; HSV goes only if mode=hs (also consider computed values instead)
            (cl-hue::light-colormode light)
            (cl-hue::light-hue light)
            (cl-hue::light-saturation light)
            (cl-hue::light-brightness light)
            (cl-hue::light-ct light))))

(defun describe-light-verbose (light)
  (format t "~&Light #~A: ~A" (cl-hue::light-number light) (cl-hue::light-name light))
  (format t "~&~4TState: ~A" (if (cl-hue::light-on-p light) "ON" "OFF"))
  (format t "~&~4TType: ~A" (cl-hue::light-type light))
  (format t "~&~4TModel ID: ~A" (cl-hue::light-modelid light))
  (format t "~&~4TUID: ~A" (cl-hue::light-uniqueid light))
  (format t "~&~4TSoftware version: ~A" (cl-hue::light-swversion light))
  (format t "~&~4TReachable: ~A" (if (cl-hue::light-reachable-p light) "YES" "NO"))
  (format t "~&~4TColor mode: ~A" (cl-hue::light-colormode light))
  (format t "~&~8TBrightness: ~A" (cl-hue::light-brightness light))
  (format t "~&~8THue: ~A" (cl-hue::light-hue light))
  (format t "~&~8TSaturation: ~A" (cl-hue::light-saturation light))
  (format t "~&~8TXY: ~A" (cl-hue::light-xy light))
  (format t "~&~8TCT (Mired): ~A" (cl-hue::light-ct light))
  (format t "~%~%"))


;;; Actual commands
(defun bridge-status ()                 ;TODO
  (errout +exit-whatever+ "not yet implemented"))

(defun list-lights ()
  (mapc (if *verbose*
            'describe-light-verbose
            'describe-light)
        *all-lights*))

(defun light-on (light)
  (when *verbose*
    (format t "~&Turning on ~A over ~A milliseconds..." (light-short-description light) (ttime->msec *transition-time*)))
  (cl-hue:set-light-state-by-number *bridge*
                                    (cl-hue::light-number light)
                                    :on t
                                    :transitiontime *transition-time*))

(defun light-off (light)
  ;; FIXME transition time is not used because it somehow breaks light settings...
  (when *verbose*
    (format t "~&Turning off ~A..." (light-short-description light)))
  (cl-hue:set-light-state-by-number *bridge*
                                    (cl-hue::light-number light)
                                    :on nil))

(defun light-toggle (light)
  (if (cl-hue::light-on-p light)
      (light-off light)
      (light-on light)))

(defun light-reset (light)
  (when *verbose*
    (format t "~&Resetting ~A..." (light-short-description light)))
  (cl-hue::set-light-state-by-number *bridge* (cl-hue::light-number light)
                                     :on t
                                     :brightness 254
                                     :ct 233
                                     :transitiontime 2))

(defun light-blink (light)
  (when *verbose*
    (format t "~&Blinking ~A..." (light-short-description light)))
  (cl-hue:set-light-state-by-number *bridge*
                                    (cl-hue::light-number light)
                                    :alert "select"))

(defun light-set-rgb (light r g b)
  (let ((parsed-r (if (numberp r) r (parse-number:parse-number r)))
        (parsed-g (if (numberp g) g (parse-number:parse-number g)))
        (parsed-b (if (numberp b) b (parse-number:parse-number b))))
    (when *verbose*
      (format t "~&Setting ~A to rgb(~S, ~S, ~S) over ~A milliseconds..." (light-short-description light) parsed-r parsed-g parsed-b (ttime->msec *transition-time*)))
    (multiple-value-bind (x y brightness) (rgb->xyb parsed-r parsed-g parsed-b :FIXME)
      (when *verbose*
        (format t "~&Computed XY: (~A, ~A), brightness: ~A." x y (denormalize-brightness brightness)))
      (cl-hue::set-light-state-by-number *bridge* (cl-hue::light-number light)
                                         :brightness (denormalize-brightness brightness)
                                         :xy (list x y)
                                         :transitiontime *transition-time*))))

(defun light-set-rgb-hex (light hex-rgb)
  (multiple-value-bind (r g b) (rgbhex->rgb hex-rgb)
    (light-set-rgb light r g b)))

(defun light-set-hue (light hue)
  (let ((parsed-hue (parse-integer hue :junk-allowed t)))
    (unless (number-in-range-p parsed-hue 0 65535)
      (errout +exit-data-format-error+ "invalid hue value"))
    (when *verbose*
      (format t "~&Setting hue of ~A to ~A over ~A milliseconds..."
              (light-short-description light)
              parsed-hue
              (ttime->msec *transition-time*)))
    (cl-hue:set-light-state-by-number *bridge*
                                      (cl-hue::light-number light)
                                      :hue parsed-hue
                                      :transitiontime *transition-time*)))

(defun light-set-sat (light sat)
  (let ((parsed-sat (parse-integer sat :junk-allowed t)))
    (unless (number-in-range-p parsed-sat 0 254)
      (errout +exit-data-format-error+ "invalid saturation value"))
    (when *verbose*
      (format t "~&Setting saturation of ~A to ~A over ~A milliseconds..."
              (light-short-description light)
              parsed-sat
              (ttime->msec *transition-time*)))
    (cl-hue:set-light-state-by-number *bridge*
                                      (cl-hue::light-number light)
                                      :saturation parsed-sat
                                      :transitiontime *transition-time*)))

(defun light-set-bri (light bri)
  (let ((parsed-bri (parse-integer bri :junk-allowed t)))
    (unless (number-in-range-p parsed-bri 1 254)
      (errout +exit-data-format-error+ "invalid brightness value"))
    (when *verbose*
      (format t "~&Setting brightness of ~A to ~A over ~A milliseconds..."
              (light-short-description light)
              parsed-bri
              (ttime->msec *transition-time*)))
    (cl-hue:set-light-state-by-number *bridge*
                                      (cl-hue::light-number light)
                                      :brightness parsed-bri
                                      :transitiontime *transition-time*)))

(defun light-set-ct (light ct)
  (let ((parsed-ct (parse-integer ct :junk-allowed t)))
    (unless (numberp parsed-ct)
      (errout +exit-data-format-error+ "invalid ct value"))
    (when *verbose*
      (format t "~&Setting color temperature of ~A to ~A mireds over ~A milliseconds..."
              (light-short-description light)
              parsed-ct
              (ttime->msec *transition-time*)))
    (cl-hue:set-light-state-by-number *bridge*
                                      (cl-hue::light-number light)
                                      :ct parsed-ct
                                      :transitiontime *transition-time*)))

(defun light-set-ctk (light ctk)
  (let ((parsed-ctk (parse-integer ctk :junk-allowed t)))
    (unless (numberp parsed-ctk)
      (errout +exit-data-format-error+ "invalid ctk value"))
    (when *verbose*
      (format t "~&Setting color temperature of ~A to ~A Kelvins (~A mireds) over ~A milliseconds..."
              (light-short-description light)
              parsed-ctk
              (kelvins->mireds parsed-ctk)
              (ttime->msec *transition-time*)))
    (cl-hue:set-light-state-by-number *bridge*
                                      (cl-hue::light-number light)
                                      :ct (kelvins->mireds parsed-ctk)
                                      :transitiontime *transition-time*)))

(defun light-set-xy (light x y)
  (let ((parsed-x (parse-number:parse-number x))
        (parsed-y (parse-number:parse-number y)))
    (when *verbose*
      (format t "~&Setting light ~A XY to (~S, ~S) over ~A milliseconds..." (light-short-description light) parsed-x parsed-y (ttime->msec *transition-time*)))
    (cl-hue:set-light-state-by-number *bridge*
                                      (cl-hue::light-number light)
                                      :xy (list parsed-x parsed-y)
                                      :transitiontime *transition-time*)))



;;; Entry point-related and command processing.

(defun load-config-if-exists ()
  (let ((config-file (find-if (lambda (path)
                                (probe-file path))
                              +config-file-search-locations+)))
    (when config-file
      (let ((*package* (find-package :hju-config)))
        (load config-file)))))

(defun init-hue-access (switches)
  ;; TODO also load from file
  (let ((bridge (or (getf switches :b)
                    (getf switches :bridge)
                    hju-config:*bridge-url*))
        (user (or (getf switches :u)
                  (getf switches :user)
                  hju-config:*user-id*)))
    (unless (and bridge user)
      (errout +exit-configuration-error+ "bridge not set"))
    (setf *bridge* (cl-hue:make-bridge bridge user))
    (fetch-all-lights)))

(defun execute-command (command lights &rest args)
  "Execute `COMMAND' once for each light in `LIGHTS', with `ARGS'."
  (loop for light in lights
       do (apply command light args)))

(defun run-set-command (lights set-what args)
  (cond
    ((string-equal set-what "rgb")
     (if (starts-with (first args) "#")
         (execute-command #'light-set-rgb-hex lights (first args))
         (execute-command #'light-set-rgb lights (first args) (second args) (third args))))
    ((string-equal set-what "hue")
     (execute-command #'light-set-hue lights (first args)))
    ((string-equal set-what "sat")
     (execute-command #'light-set-sat lights (first args)))
    ((string-equal set-what "bri")
     (execute-command #'light-set-bri lights (first args)))
    ((string-equal set-what "ct")
     (execute-command #'light-set-ct lights (first args)))
    ((string-equal set-what "ctk")
     (execute-command #'light-set-ctk lights (first args)))
    ((string-equal set-what "xy")
     (execute-command #'light-set-xy lights (first args) (second args)))
    (t
     (errout +exit-usage-error+ "don't know what to set the light to"))))

(defun run-command (command switches)
  (declare (ignore switches))
  (let ((verb (first command))
        (args (rest command)))
    (cond
      ((string-equal verb "status")
       (bridge-status))
      ((string-equal verb "list")
       (list-lights))
      ((string-equal verb "on")
       (execute-command #'light-on (get-lights-by-param (first args))))
      ((string-equal verb "off")
       (execute-command #'light-off (get-lights-by-param (first args))))
      ((string-equal verb "toggle")
       (execute-command #'light-toggle (get-lights-by-param (first args))))
      ((string-equal verb "reset")
       (execute-command #'light-reset (get-lights-by-param (first args))))
      ((string-equal verb "blink")
       (execute-command #'light-blink (get-lights-by-param (first args))))
      ((string-equal verb "set")
       (run-set-command (get-lights-by-param (first args))
                        (second args)
                        (cddr args)))
      (t
       (errout +exit-usage-error+ "no command given")))))

(defun execute (args)
  (trap-errors
   (let ((command (car (remove-if (lambda (p) (not (consp p))) args)))
         (switches (remove-if (lambda (p) (consp p)) args)))
     (let ((show-usage (null args))
           (show-help (or (getf switches :h) (getf switches :help)))
           (run-verbose (or (getf switches :v) (getf switches :verbose)))
           (transition-time (or (getf switches :t) (getf switches :transition))))

       ;; Process switches.
       (when show-usage
         (print-usage)
         (return-from execute 1))

       (when show-help
         (print-help)
         (return-from execute 0))

       (when run-verbose
         (setf *verbose* t))

       (when transition-time
         (let ((parsed-time (parse-integer transition-time :junk-allowed t)))
           (when (and (numberp parsed-time)
                      (>= parsed-time 0))
             (setf *transition-time* parsed-time))))

       ;; Init Hue connection and run actual command.
       (load-config-if-exists)
       (init-hue-access switches)
       (run-command command switches)
       (fresh-line)))
   +exit-ok+))

(defun main (&rest argv)
  (execute (apply-argv:parse-argv argv)))

;;; vim: set ft=lisp lisp: