1 ;;; svg-clock.el --- Analog clock using Scalable Vector Graphics -*- lexical-binding: t -*-
3 ;; Copyright (C) 2011, 2014 Free Software Foundation, Inc.
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
10 ;; Package-Requires: ((svg "0.1") (emacs "25.0"))
12 ;; This file is part of GNU Emacs.
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.
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.
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/>.
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).
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.
47 ;; New function `svg-clock-insert'. Removed customization
51 ;; Fixes (image-mode issue etc.).
54 ;; Fixes (disable buffer undo).
57 ;; Automatic fitting of clock to window size.
63 (defconst svg-clock-version "0.5" "Version number of `svg-clock'.")
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
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
102 `(fill . ,foreground)))
103 (svg-clock-symbol 'background
104 (svg-clock-circle .5 .5 .49
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))
115 'rotate angle .5 .5)))
116 (number-sequence 0 354 6))))))
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."
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))
128 (clock (svg-clock-group
130 (svg-clock-use 'clock-face)
131 (svg-clock-use 'second-hand
134 (* seconds 6) .5 .5))
135 (svg-clock-use 'minute-hand
138 (+ (* minutes 6) (/ seconds 10.0)) .5 .5))
139 (svg-clock-use 'hour-hand
142 (+ (* hours 30) (/ minutes 2.0)) .5 .5)))))
143 (dolist (def defs) (svg-def svg def))
145 (dom-append-child svg
146 (svg-clock-use 'clock
147 (svg-clock-transform 'scale size size)))
150 (defun svg-clock--window-size ()
151 "Return maximal size for displaying the svg clock."
153 (let ((clock-win (get-buffer-window "*clock*")))
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))))
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
166 (let* ((time (decode-time (if offset
167 (time-add (current-time)
168 (seconds-to-time offset))
170 (size (or size (svg-clock--window-size)))
171 (svg (svg-clock--create-svg time size foreground background )))
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."
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)))
184 (if (and (buffer-live-p buf)
185 (not (eq (overlay-start 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))
197 (overlay-put ovl 'display img))))
198 ;; clock or its buffer is gone
201 (message "Cancelling clock timer")
202 (cancel-timer (svg-clock-handle-timer clock-handle))
203 (delete-overlay ovl))))))
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
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))
220 (setq ovl (make-overlay (marker-position marker)
221 (1+ (marker-position marker))
223 (setf (svg-clock-handle-overlay ch) ovl)
224 (setq timer (run-at-time 0 1
226 (svg-clock--update ch size fg bg offset))))
227 (setf (svg-clock-handle-timer ch) timer)))
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)
237 "Start/stop the svg clock."
239 (switch-to-buffer (get-buffer-create "*clock*"))
240 (let ((inhibit-read-only t))
241 (buffer-disable-undo)
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))
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."
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)
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))
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)))
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."
282 (format "%s(%s)" action (mapconcat 'number-to-string args ", "))))
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))))
292 ;;; svg-clock.el ends here