Add pict-rotation.

1 files changed, 18 insertions, 0 deletions

diff --git a/pict.scm b/pict.scm
index 2fa0352..98e0237 100644
--- a/pict.scm
+++ b/pict.scm
@@ -31,6 +31,7 @@
             pict-sxml
             pict-width
             pict-height
+            pict-rotation
 
             ;; modifiers
             fill
@@ -203,6 +204,13 @@ does not exist it is added with PROC applied to #F."
                items))
         ((_ . items) items))))))
 
+(define (rotation->values str)
+  "Returns a list of three rotation values by converting the rotation
+string STR."
+  (if str
+      (map string->number (string-split str #\space))
+      (list 0 0 0)))
+
 (define (style-string->list styles)
   "Split the styles string into a list of lists from keys to values."
   (map (cut string-split <> #\:)
@@ -609,6 +617,16 @@ of the SVG of PICT or #F."
   "Return the width of PICT."
   (pict-attr 'width pict))
 
+(define (pict-rotation pict)
+  "Return the rotation of PICT."
+  (let ((m (assoc-ref (transform-string->list
+                       (or (pict-attr 'transform pict #:path '(g)) ""))
+                      "rotate")))
+    (or (and (pair? m)
+             (and=> (first m)
+                    (lambda (m) (first (rotation->values m)))))
+        0)))
+
 (define (append-align xalign yalign picts)
   "Append PICTS and align them vertically to the top, center, bottom,
 or spread by an offset according to the symbol YALIGN and horizontally