code.delx.au - gnu-emacs-elpa/blob - packages/svg-clock/svg-clock.el

   1 ;;; svg-clock.el --- Analog clock using Scalable Vector Graphics -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2011, 2014  Free Software Foundation, Inc.
   4
   5 ;; Maintainer:  Ulf Jasper <ulf.jasper@web.de>
   6 ;; Author:      Ulf Jasper <ulf.jasper@web.de>
   7 ;; Created:     22. Sep. 2011
   8 ;; Keywords:    demo, svg, clock
   9 ;; Version:     0.5
  10 ;; Package-Requires: ((svg "0.1") (emacs "25.0"))
  11
  12 ;; This file is part of GNU Emacs.
  13
  14 ;; GNU Emacs is free software: you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation, either version 3 of the License, or
  17 ;; (at your option) any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  26
  27 ;;; Commentary:
  28
  29 ;; svg-clock provides a scalable analog clock.  Rendering is done by
  30 ;; means of svg (Scalable Vector Graphics).  In order to use svg-clock
  31 ;; you need to build Emacs with svg support.  (To check whether your
  32 ;; Emacs supports svg, do "M-: (image-type-available-p 'svg) RET"
  33 ;; which must return t).
  34
  35 ;; Call `svg-clock' to start a clock.  This will open a new buffer
  36 ;; "*clock*" displaying a clock which fills the buffer's window.  Use
  37 ;; `svg-clock-insert' to insert a clock programmatically in any
  38 ;; buffer, possibly specifying the clock's size, colours and offset to
  39 ;; the current-time.  Arbitrary many clocks can be displayed
  40 ;; independently.  Clock instances ared updated automatically.  Their
  41 ;; resources (timers etc.) are cleaned up automatically when the
  42 ;; clocks are removed.
  43
  44 ;;; News:
  45
  46 ;;  Version FIXME
  47 ;;    New function `svg-clock-insert'.  Removed customization
  48 ;;    options.
  49
  50 ;;  Version 0.5
  51 ;;    Fixes (image-mode issue etc.).
  52
  53 ;;  Version 0.3
  54 ;;    Fixes (disable buffer undo).
  55
  56 ;;  Version 0.2
  57 ;;    Automatic fitting of clock to window size.
  58
  59 ;;  Version 0.1
  60 ;;    Initial version.
  61
  62 ;;; Code:
  63 (defconst svg-clock-version "0.5" "Version number of `svg-clock'.")
  64
  65 (require 'dom)
  66 (require 'svg)
  67 (require 'cl-macs)
  68
  69 (cl-defstruct svg-clock-handle
  70   marker  ;; points to the clock's buffer and position
  71   overlay ;; holds the clock's image
  72   timer)  ;; takes care of updating the clock
  73
  74 (defun svg-clock--create-def-elements (foreground background)
  75   "Return a list of SVG elements using the colors FOREGROUND and BACKGROUND.
  76 The elements are supposed to be added to an SVG object as 'defs'.
  77 The SVG may then 'use': 'clock-face, 'second-hand, 'minute-hand
  78 and 'hour-hand.  The clock-face has a size of 1x1."
  79   (list (svg-clock-symbol 'tickshort
  80                           (svg-clock-line .5 .02 .5 .04
  81                                           `(stroke . ,foreground)
  82                                           '(stroke-width . .01)))
  83         (svg-clock-symbol 'ticklong
  84                           (svg-clock-line .5 .02 .5 .09
  85                                           `(stroke . ,foreground)
  86                                           '(stroke-width . .02)))
  87         (svg-clock-symbol 'hour-hand
  88                           (svg-clock-line .5 .22 .5 .54
  89                                           `(stroke . ,foreground)
  90                                           '(stroke-width . .04)))
  91         (svg-clock-symbol 'minute-hand
  92                           (svg-clock-line .5 .12 .5 .55
  93                                           `(stroke . ,foreground)
  94                                           '(stroke-width . .03)))
  95         (svg-clock-symbol 'second-hand
  96                           (svg-clock-line .5 .1 .5 .56
  97                                           `(stroke . ,foreground)
  98                                           '(stroke-width . 0.005)))
  99         (svg-clock-symbol 'hand-cap
 100                           (svg-clock-circle .5 .5 .03
 101                                             `(stroke . "none")
 102                                             `(fill . ,foreground)))
 103         (svg-clock-symbol 'background
 104                           (svg-clock-circle .5 .5 .49
 105                                             `(stroke . "none")
 106                                             `(fill . ,background)))
 107         (apply 'svg-clock-group 'clock-face
 108                (nconc (list (svg-clock-use 'background)
 109                             (svg-clock-use 'hand-cap))
 110                       (mapcar (lambda (angle)
 111                                 (svg-clock-use (if (= 0 (% angle 30))
 112                                                    'ticklong
 113                                                  'tickshort)
 114                                                (svg-clock-transform
 115                                                 'rotate angle .5 .5)))
 116                               (number-sequence 0 354 6))))))
 117
 118 (defun svg-clock--create-svg (time size foreground background)
 119   "Return an SVG element displaying an analog clock.
 120 The clock shows the given TIME, it has a diameter of SIZE, and
 121 its colors are FOREGROUND and BACKGROUND."
 122   (interactive)
 123   (let* ((defs (svg-clock--create-def-elements foreground background))
 124          (svg (svg-create size size))
 125          (seconds (nth 0 time))
 126          (minutes (nth 1 time))
 127          (hours (nth 2 time))
 128          (clock (svg-clock-group
 129                  'clock
 130                  (svg-clock-use 'clock-face)
 131                  (svg-clock-use 'second-hand
 132                                 (svg-clock-transform
 133                                  'rotate
 134                                  (* seconds 6) .5 .5))
 135                  (svg-clock-use 'minute-hand
 136                                 (svg-clock-transform
 137                                  'rotate
 138                                  (+ (* minutes 6) (/ seconds 10.0)) .5 .5))
 139                  (svg-clock-use 'hour-hand
 140                                 (svg-clock-transform
 141                                  'rotate
 142                                  (+ (* hours 30) (/ minutes 2.0))  .5 .5)))))
 143     (dolist (def defs) (svg-def svg def))
 144     (svg-def svg clock)
 145     (dom-append-child svg
 146                       (svg-clock-use 'clock
 147                                      (svg-clock-transform 'scale size size)))
 148     svg))
 149
 150 (defun svg-clock--window-size ()
 151   "Return maximal size for displaying the svg clock."
 152   (save-excursion
 153     (let  ((clock-win (get-buffer-window "*clock*")))
 154       (if clock-win
 155           (let* ((coords (window-inside-pixel-edges clock-win))
 156                  (width (- (nth 2 coords) (nth 0 coords)))
 157                (height (- (nth 3 coords) (nth 1 coords))))
 158             (min width height))
 159         ;; fallback
 160         100))))
 161
 162 (defun svg-clock--do-create (size foreground background &optional offset)
 163   "Create an SVG element.
 164 See `svg-clock-insert' for meaning of arguments SIZE, FOREGROUND, BACKGROUND
 165 and OFFSET."
 166   (let* ((time (decode-time (if offset
 167                                 (time-add (current-time)
 168                                           (seconds-to-time offset))
 169                               (current-time))))
 170          (size (or size (svg-clock--window-size)))
 171          (svg (svg-clock--create-svg time size foreground background )))
 172     svg))
 173
 174 (defun svg-clock--update (clock-handle &optional size foreground background offset)
 175   "Update the clock referenced as CLOCK-HANDLE.
 176 See `svg-clock-insert' for meaning of optional arguments SIZE, FOREGROUND,
 177 BACKGROUND and OFFSET."
 178   (when clock-handle
 179     (let* ((marker (svg-clock-handle-marker clock-handle))
 180            (buf (marker-buffer marker))
 181            (win (get-buffer-window buf))
 182            (ovl (svg-clock-handle-overlay clock-handle)))
 183       (condition-case nil
 184           (if (and (buffer-live-p buf)
 185                    (not (eq (overlay-start ovl)
 186                             (overlay-end ovl))))
 187               (when (pos-visible-in-window-p marker win t)
 188                 (with-current-buffer buf
 189                   (let* ((svg (svg-clock--do-create size
 190                                                     foreground background offset))
 191                          (img (create-image
 192                                (with-temp-buffer
 193                                  (svg-print svg)
 194                                  (buffer-string))
 195                                'svg t
 196                                :ascent 'center)))
 197                     (overlay-put ovl 'display img))))
 198             ;; clock or its buffer is gone
 199             (signal 'error nil))
 200         (error
 201          (message "Cancelling clock timer")
 202          (cancel-timer (svg-clock-handle-timer clock-handle))
 203          (delete-overlay ovl))))))
 204
 205 ;;;###autoload
 206 (defun svg-clock-insert (&optional size foreground background offset)
 207   "Insert a self-updating image displaying an analog clock at point.
 208 Optional argument SIZE the size of the clock in pixels.
 209 Optional argument FOREGROUND the foreground color.
 210 Optional argument BACKGROUND the background color.
 211 Optional argument OFFSET the offset in seconds between current and displayed
 212 time."
 213   (let* ((fg (or foreground (face-foreground 'default)))
 214          (bg (or background (face-background 'default)))
 215          (marker (point-marker))
 216          (ch (make-svg-clock-handle :marker marker))
 217          timer
 218          ovl)
 219     (insert "*")
 220     (setq ovl (make-overlay (marker-position marker)
 221                             (1+ (marker-position marker))
 222                             nil t))
 223     (setf (svg-clock-handle-overlay ch) ovl)
 224     (setq timer (run-at-time 0 1
 225                              (lambda ()
 226                                (svg-clock--update ch size fg bg offset))))
 227     (setf (svg-clock-handle-timer ch) timer)))
 228
 229 (defvar svg-clock-mode-map
 230   (let ((map (make-sparse-keymap)))
 231     (define-key map [?+] 'svg-clock-grow)
 232     (define-key map [?-] 'svg-clock-shrink)
 233     map))
 234
 235 ;;;###autoload
 236 (defun svg-clock ()
 237   "Start/stop the svg clock."
 238   (interactive)
 239   (switch-to-buffer (get-buffer-create "*clock*"))
 240   (let ((inhibit-read-only t))
 241     (buffer-disable-undo)
 242     (erase-buffer)
 243     (svg-clock-insert)
 244     (view-mode)))
 245
 246 ;; Move to svg.el?
 247 (defun svg-clock-symbol (id value)
 248   "Create an SVG symbol element with given ID and VALUE."
 249   (dom-node 'symbol `((id . ,id)) value))
 250
 251 (defun svg-clock-circle (x y radius &rest attributes)
 252   "Create an SVG circle element at position X Y with given RADIUS.
 253 Optional argument ATTRIBUTES contain conses with SVG attributes."
 254    (dom-node 'circle
 255              `((cx . ,x)
 256                (cy . ,y)
 257                (r . ,radius)
 258                ,@attributes)))
 259
 260 (defun svg-clock-line (x1 y1 x2 y2 &rest attributes)
 261   "Create an SVG line element starting at (X1, Y1), ending at (X2, Y2).
 262 Optional argument ATTRIBUTES contain conses with SVG attributes."
 263   (dom-node 'line `((x1 . ,x1)
 264                     (y1 . ,y1)
 265                     (x2 . ,x2)
 266                     (y2 . ,y2)
 267                     ,@attributes)))
 268
 269 (defun svg-clock-group (id &rest children)
 270   "Create an SVG group element with given ID and CHILDREN."
 271   (apply 'dom-node 'g `((id . ,id)) children))
 272
 273 (defun svg-clock-use (id &rest attributes)
 274   "Create an SVG use element with given ID.
 275 Optional argument ATTRIBUTES contain conses with SVG attributes."
 276   (dom-node 'use `((xlink:href . ,(format "#%s" id)) ,@attributes)))
 277
 278 (defun svg-clock-transform (action &rest args)
 279   "Create an SVG transform attribute element for given ACTION.
 280 Argument ARGS contain the action's arguments."
 281   (cons 'transform
 282         (format "%s(%s)" action (mapconcat 'number-to-string args ", "))))
 283
 284 (defun svg-clock-color-to-hex (color)
 285   "Return hex representation of COLOR."
 286   (let ((values (color-values color)))
 287     (format "#%02x%02x%02x" (nth 0 values) (nth 1 values) (nth 2 values))))
 288
 289
 290 (provide 'svg-clock)
 291
 292 ;;; svg-clock.el ends here