branch: externals/svg-lib
commit ebde0910682e1142fcae06049aefeb2f1e28cb30
Author: Nicolas P. Rougier <nicolas.roug...@inria.fr>
Commit: Nicolas P. Rougier <nicolas.roug...@inria.fr>
Added progress pies
---
README.org | 9 +++----
screenshot.png | Bin 502387 -> 544432 bytes
svg-lib-demo.el | 25 +++++++++---------
svg-lib-demo.org | 10 +++-----
svg-lib.el | 76 ++++++++++++++++++++++++++++++++++++++++++++++++++++++-
5 files changed, 96 insertions(+), 24 deletions(-)
diff --git a/README.org b/README.org
index ac6cb9a..40deeb5 100644
--- a/README.org
+++ b/README.org
@@ -2,13 +2,12 @@
*** SVG Library
A small Emacs library to create and display various SVG objects,
-namely tags, progress bars and icons. Each object is guaranteed to fit
-nicely in a text buffer ensuring width is an integer multiple of
-charater width.
+namely tags, progress bars, progress pies and icons. Each object is
+guaranteed to fit nicely in a text buffer ensuring width is an integer
+multiple of charater width.
*** Usage example
-[[file:screenshot-2.png]]
-
[[file:screenshot.png]]
+[[file:screenshot-2.png]]
diff --git a/screenshot.png b/screenshot.png
index aefb175..748aa9c 100644
Binary files a/screenshot.png and b/screenshot.png differ
diff --git a/svg-lib-demo.el b/svg-lib-demo.el
index 2ed974c..d778a35 100644
--- a/svg-lib-demo.el
+++ b/svg-lib-demo.el
@@ -1,40 +1,41 @@
+(require 'svg-lib)
+
(dotimes (i 5)
(insert-image (svg-lib-tag "TODO" nil
:font-family "Roboto Mono" :font-weight (* (+ i 2)
100))))
-
-
+
(dotimes (i 10)
(insert-image (svg-lib-tag "TODO" nil :padding 1 :stroke (/ i 4.0))))
-
(dotimes (i 10)
(insert-image (svg-lib-tag "TODO" nil :stroke 2 :radius i)))
-
(dotimes (i 10)
- (insert-image (svg-lib-progress (/ (+ i 1) 10.0) nil
+ (insert-image (svg-lib-progress-bar (/ (+ i 1) 10.0) nil
:width 5 :margin 1 :stroke 2 :padding 2)))
-
-(insert-image (svg-lib-progress 0.75 nil :radius 8 :stroke 2 :padding 0))
-
+(insert-image (svg-lib-progress-bar 0.75 nil :radius 8 :stroke 2 :padding 0))
+
+(dotimes (i 10)
+ (insert-image (svg-lib-progress-pie (/ (+ i 1) 10.0) nil
+ :margin 1 :stroke 2 :padding 1)))
+
(dotimes (i 10)
(insert-image (svg-lib-icon "star" nil :scale (/ (+ i 1) 10.0))))
-
-
+
(insert-image (svg-lib-button "check-bold" "DONE" nil
:font-family "Roboto Mono"
:font-weight 500
:stroke 0 :background "#673AB7" :foreground "white"))
-
+
(insert-image (svg-lib-icon "gnuemacs" nil :collection "simple"
:stroke 0 :scale 1 :padding 0))
- GNU Emacs
+ GNU Emacs
diff --git a/svg-lib-demo.org b/svg-lib-demo.org
index a63b87d..b67911f 100644
--- a/svg-lib-demo.org
+++ b/svg-lib-demo.org
@@ -31,7 +31,7 @@
(defun svg-font-lock-progress_percent (value)
(svg-image (svg-lib-concat
- (svg-lib-progress (/ (string-to-number value) 100.0)
+ (svg-lib-progress-bar (/ (string-to-number value) 100.0)
nil :margin 0 :stroke 2 :radius 3 :padding 2
:width 12)
(svg-lib-tag (concat value "%")
nil :stroke 0 :margin 0)) :ascent 'center))
@@ -41,7 +41,7 @@
(count (float (car seq)))
(total (float (cadr seq))))
(svg-image (svg-lib-concat
- (svg-lib-progress (/ count total) nil
+ (svg-lib-progress-bar (/ count total) nil
:margin 0 :stroke 2 :radius 3 :padding 2
:width 12)
(svg-lib-tag value nil
:stroke 0 :margin 0)) :ascent 'center)))
@@ -57,8 +57,6 @@
#+end_src
-#+RESULTS:
-
* Progress count: [2/3]
:PROPERTIES:
:END:
@@ -67,10 +65,10 @@
- [X] Sub-task 2
- [ ] Sub-task 3
-* Progress percent: [100%]
+* Progress percent: [66%]
:PROPERTIES:
:END:
- [X] Sub-task 1
- [X] Sub-task 2
-- [X] Sub-task 3
+- [ ] Sub-task 3
diff --git a/svg-lib.el b/svg-lib.el
index 40fc697..d7a8790 100644
--- a/svg-lib.el
+++ b/svg-lib.el
@@ -71,6 +71,10 @@
(require 'xml)
(require 'cl-lib)
+;; Check if Emacs has been compled with svg support
+(if (not (image-type-available-p 'svg))
+ (error (concat "svg-lib.el requires Emacs to be compiled with svg
support.\n")))
+
(defgroup svg-lib nil
"SVG tags, bars & icons."
@@ -249,7 +253,77 @@ and style elements ARGS."
;; Create a progress bar
;; ---------------------------------------------------------------------
-(defun svg-lib-progress (value &optional style &rest args)
+(defun svg-lib-progress-pie (value &optional style &rest args)
+ "Create a progress pie image with value VALUE using given STYLE
+and style elements ARGS."
+
+ (let* ((default svg-lib-style-default)
+ (style (if style (apply #'svg-lib-style nil style) default))
+ (style (if args (apply #'svg-lib-style style args) style))
+
+ (foreground (plist-get style :foreground))
+ (background (plist-get style :background))
+ (stroke (plist-get style :stroke))
+ (width (plist-get style :width))
+ (height (plist-get style :height))
+ (scale (plist-get style :scale))
+ (margin (plist-get style :margin))
+ (padding (plist-get style :padding))
+ (font-size (plist-get style :font-size))
+ (font-family (plist-get style :font-family))
+ (font-weight (plist-get style :font-weight))
+
+ (txt-char-width (window-font-width))
+ (txt-char-height (window-font-height))
+
+ (font-info (font-info (format "%s:%d" font-family font-size)))
+ (ascent (aref font-info 8))
+ (tag-char-width (aref font-info 11))
+ (tag-char-height (aref font-info 3))
+
+ (tag-width (* 2 txt-char-width))
+ (tag-height (* txt-char-height height))
+
+ (svg-width (+ tag-width (* margin txt-char-width)))
+ (svg-height tag-height)
+
+ (tag-x (/ (- svg-width tag-width) 2))
+
+ (cx (/ svg-width 2))
+ (cy (/ svg-height 2))
+ (radius (/ tag-height 2))
+
+ (iradius (- radius stroke (/ padding 2)))
+
+ (angle0 (- (/ pi 2)))
+ (x0 (+ cx (* iradius (cos angle0))))
+ (y0 (+ cy (* iradius (sin angle0))))
+
+ (angle1 (+ angle0 (* value 2 pi)))
+ (x1 (+ cx (* iradius (cos angle1))))
+ (y1 (+ cy (* iradius (sin angle1))))
+
+ (large-arc (if (>= (- angle1 angle0) pi) t nil))
+ (svg (svg-create svg-width svg-height)))
+
+ (if (>= stroke 0.25)
+ (svg-circle svg cx cy radius :fill foreground))
+
+ (svg-circle svg cx cy (- radius (/ stroke 2.0)) :fill background)
+
+ (if (>= (- angle1 angle0) (* pi 2))
+ (svg-circle svg cx cy iradius :fill foreground)
+ (svg-path svg `((moveto ((,cx . ,cy)))
+ (lineto ((,x0 . ,y0)))
+ (elliptical-arc ((,iradius ,iradius ,x1 ,y1
+ :sweep t :large-arc ,large-arc))))
+ :fill foreground))
+ (svg-image svg :scale 1 :ascent 'center)))
+
+
+;; Create a progress bar
+;; ---------------------------------------------------------------------
+(defun svg-lib-progress-bar (value &optional style &rest args)
"Create a progress bar image with value VALUE using given STYLE
and style elements ARGS."
