summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ChangeLog24
-rw-r--r--doc/user/pie.skb69
-rw-r--r--doc/user/src/pie1.skb13
-rw-r--r--doc/user/src/pie2.skb14
-rw-r--r--doc/user/user.skb6
-rw-r--r--src/guile/skribilo/package/pie.scm313
-rw-r--r--src/guile/skribilo/package/pie/lout.scm131
7 files changed, 569 insertions, 1 deletions
diff --git a/ChangeLog b/ChangeLog
index 132247b..3a1acfe 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,30 @@
# arch-tag: automatic-ChangeLog--lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2
#
+2006-07-23 20:47:15 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-63
+
+ Summary:
+ Added a pie-chart package that can use either Ploticus or Lout.
+ Revision:
+ skribilo--devel--1.2--patch-63
+
+ * doc/user/user.skb: Use the `pie' package and include `pie.skb'.
+
+ new files:
+ doc/user/pie.skb doc/user/src/.arch-ids/pie1.skb.id
+ doc/user/src/.arch-ids/pie2.skb.id doc/user/src/pie1.skb
+ doc/user/src/pie2.skb src/guile/skribilo/package/pie.scm
+ src/guile/skribilo/package/pie/.arch-ids/=id
+ src/guile/skribilo/package/pie/lout.scm
+
+ modified files:
+ ChangeLog doc/user/user.skb
+
+ new directories:
+ src/guile/skribilo/package/pie
+ src/guile/skribilo/package/pie/.arch-ids
+
+
2006-07-23 20:36:51 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-62
Summary:
diff --git a/doc/user/pie.skb b/doc/user/pie.skb
new file mode 100644
index 0000000..2258e62
--- /dev/null
+++ b/doc/user/pie.skb
@@ -0,0 +1,69 @@
+;;; Copyright 2006 Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;; USA.
+
+;;; FIXME: This is a stub and must be completed!
+
+(chapter :title [Pie Charts] :ident "pie-charts"
+
+ (p [Skribilo contains a pie-chart formatting package, located in the
+,(tt [(skribilo package pie)]) module. It allows users to produces
+represent numeric data as pie charts as in the following example:]
+
+ (disp (pie :title [Use of Document Formatting Systems]
+ :fingers? #t :labels 'outside
+ :initial-angle 90
+ :ident "pie-skribilo-rulez"
+ (slice :weight 10 :color "red" :detach? #t
+ (bold [Skribilo]))
+ (slice :weight 6 :color "green" "Skribe")
+ (slice :weight 6 :color "blue" "Lout")
+ (slice :weight 4 :color "lightgrey" "LaTeX")
+ (slice :weight 2 :color "yellow" "Docbook")
+ (slice :weight 1 :color "black" "others"))))
+
+ (p [A default implementation, which uses ,(ref :text [Ploticus] :url
+"http://ploticus.sf.net") as an external program, is available for all
+engines. There is also a specific implementation for the Lout engine
+which relies on Lout's own pie-chart package. In the latter case, you
+don't need to have Ploticus installed, but you need it in the former.])
+ (p [Currently it only supports slice-coloring, but support for
+textures (particularly useful for black & white printouts) could be
+added in the future.])
+
+ (section :title [Syntax]
+
+ (p [Let us start with a simple example:]
+
+ (example-produce
+ (example :legend "Example of a pie chart"
+ (prgm :file "src/pie1.skb"))
+ (disp (include "src/pie1.skb"))))
+
+ (p [This illustrates the three markups provided by the ,(tt [pie])
+package, namely ,(tt [pie]), ,(tt [slice]), and ,(tt [sliceweight]).
+This last markup returns the weight of the slice it is used in, be it as
+a percentage or an absolute value. Note that the ,(tt [:total]) option
+of ,(tt [pie]) can be used to create pie charts no entirely filled.])
+ (p [Various options allow the pie layout to be controlled:]
+
+ (example-produce
+ (example :legend "Specifying the layout of a pie chart"
+ (prgm :file "src/pie2.skb"))
+ (disp (include "src/pie2.skb"))))))
+
+;;; arch-tag: 60382016-3a63-4466-83e0-46a259cb39ab
diff --git a/doc/user/src/pie1.skb b/doc/user/src/pie1.skb
new file mode 100644
index 0000000..0d0fd0b
--- /dev/null
+++ b/doc/user/src/pie1.skb
@@ -0,0 +1,13 @@
+;; A sad pie chart.
+;;
+
+(pie :title [Casualties in the Israel-Lebanon 2006 Conflict (source:
+English Wikipedia page, 2006-07-23)]
+ :total 450 ;; to show the uncertainty on figures
+ :ident "pie-lebanon-2006"
+ :labels 'outside :fingers? #t
+
+ (slice :weight 8 :color "black" [Hezbollah militants])
+ (slice :weight 42 :color "blue" [soldiers])
+ (slice :weight 317 :color "red" :detach? #t
+ [civilians (,(sliceweight :percentage? #t)%)]))
diff --git a/doc/user/src/pie2.skb b/doc/user/src/pie2.skb
new file mode 100644
index 0000000..84b5394
--- /dev/null
+++ b/doc/user/src/pie2.skb
@@ -0,0 +1,14 @@
+;; Another sad pie chart.
+;;
+
+(pie :title [Casualties of the Conflict in Iraq since 2003 (source:
+English Wikipedia page, 2006-07-23)]
+ :ident "pie-iraq-2006"
+ :fingers? #f
+ :labels 'inside
+ :initial-angle 45
+ :radius 2
+
+ (slice :weight 100000 :color "red" :detach? #t
+ [civilians (,(sliceweight :percentage? #t)%)])
+ (slice :weight (+ 2555 229) :color #xeeeeee [soldiers]))
diff --git a/doc/user/user.skb b/doc/user/user.skb
index a8054e3..82e614e 100644
--- a/doc/user/user.skb
+++ b/doc/user/user.skb
@@ -20,7 +20,8 @@
;*---------------------------------------------------------------------*/
;* Packages */
;*---------------------------------------------------------------------*/
-(use-modules (skribilo package eq))
+(use-modules (skribilo package eq)
+ (skribilo package pie))
;*---------------------------------------------------------------------*/
;* HTML custom */
@@ -136,6 +137,9 @@ as HTML, Info pages, man pages, Postscript, etc.]))))
;;; Equations
(include "eq.skb")
+;;; Pie charts
+(include "pie.skb")
+
;;; Standard Library
(include "lib.skb")
diff --git a/src/guile/skribilo/package/pie.scm b/src/guile/skribilo/package/pie.scm
new file mode 100644
index 0000000..2644cb7
--- /dev/null
+++ b/src/guile/skribilo/package/pie.scm
@@ -0,0 +1,313 @@
+;;; pie.scm -- An pie-chart formatting package.
+;;;
+;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;; USA.
+
+(define-module (skribilo package pie)
+ :autoload (skribilo ast) (markup? markup-ident)
+ :autoload (skribilo output) (output)
+ :use-module (skribilo writer)
+ :use-module (skribilo engine)
+ :use-module (skribilo lib) ;; `skribe-error' et al.
+ :use-module (skribilo utils syntax)
+ :use-module (skribilo utils keywords) ;; `the-options', etc.
+ :use-module (skribilo utils strings) ;; `make-string-replace'
+ :use-module (skribilo module)
+ :autoload (skribilo color) (skribe-color->rgb)
+ :autoload (skribilo skribe api) (bold)
+ :autoload (skribilo engine lout) (lout-illustration)
+ :autoload (ice-9 popen) (open-output-pipe)
+ :use-module (ice-9 optargs)
+ :export (pie-sliceweight-value pie-remove-markup))
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+
+;;;
+;;; Markup.
+;;;
+
+(define-markup (pie :rest opts
+ :key (ident #f) (title "Pie Chart")
+ (initial-angle 0) (total #f) (radius 3)
+ (fingers? #t) (labels 'outside)
+ (class "pie"))
+ (new container
+ (markup 'pie)
+ (ident (or ident (symbol->string (gensym "pie"))))
+ (options (the-options opts))
+ (body (the-body opts))))
+
+(define-markup (slice :rest opts
+ :key (ident #f) (weight 1) (color "white") (detach? #f))
+ (new container
+ (markup 'slice)
+ (ident (or ident (symbol->string (gensym "slice"))))
+ (weight weight)
+ (color color)
+ (detach? detach?)
+ (options (the-options opts))
+ (body (the-body opts))))
+
+(define-markup (sliceweight :rest opts
+ :key (ident #f) (percentage? #f))
+ (new markup
+ (markup 'sliceweight)
+ (ident (or ident (symbol->string (gensym "sliceweight"))))
+ (percentage? percentage?)
+ (options (the-options opts))
+ (body '())))
+
+
+
+;;;
+;;; Helper functions.
+;;;
+
+(define (make-rounder pow10)
+ ;; Return a procedure that round to 10 to the -POW10.
+ (let ((times (expt 10.0 pow10)))
+ (lambda (x)
+ (/ (round (* x times)) times))))
+
+(define (pie-sliceweight-value sw-node pct?)
+ "Return the value that should be displayed by `sw-node', a
+ `sliceweight' markup node. If `pct?' is true, then this value
+ should be a percentage."
+ (let* ((the-slice (ast-parent sw-node))
+ (weight (and the-slice (markup-option the-slice :weight))))
+ (if (not the-slice)
+ (skribe-error 'lout
+ "`sliceweight' node not within a `slice' body"
+ sw-node)
+ (if pct?
+ (let* ((the-pie (ast-parent the-slice))
+ (total (and the-pie
+ (markup-option the-pie
+ '&total-weight))))
+ (if (not the-pie)
+ (skribe-error 'lout
+ "`slice' not within a `pie' body"
+ the-slice)
+ (* 100.0 (/ weight total)))) ;; flonum (FIXME: precision)
+
+ weight))))
+
+(define (pie-remove-markup node)
+ "Remove markup from `node', ie. turn something like `(it \"hello\")' into
+the string \"hello\". Implement `sliceweight' markups too."
+ (define percentage-round (make-rounder 2))
+
+ (if (markup? node)
+ (if (and node (is-markup? node 'sliceweight))
+ (let* ((pct? (markup-option node :percentage?))
+ (value (pie-sliceweight-value node pct?)))
+ (number->string (percentage-round value)))
+ (pie-remove-markup (markup-body node)))
+ (if (list? node)
+ (apply string-append (map pie-remove-markup node))
+ node)))
+
+(define strip-newlines (make-string-replace '((#\newline " "))))
+
+(define (select-output-format engine)
+ ;; Choose an ouptut format suitable for ENGINE.
+ (define %supported-formats '("png" "ps" "eps" "svg" "svgz"))
+ (define %default-format "png")
+
+ (let ((fmt (engine-custom engine 'image-format)))
+ (cond ((string? fmt) fmt)
+ ((and (list? fmt) (not (null? fmt)))
+ (let ((f (car fmt)))
+ (if (member f %supported-formats)
+ f
+ %default-format)))
+ (else %default-format))))
+
+
+;;;
+;;; Default implementation (`base' engine).
+;;;
+
+;; Ploticus-based implementation of pie charts, suitable for most engines.
+;; See http://ploticus.sf.net for info about Ploticus.
+
+(define %ploticus-program "ploticus")
+(define %ploticus-debug? #f)
+
+(define (color-spec->ploticus color-spec)
+ (define round (make-rounder 2))
+
+ (call-with-values (lambda () (skribe-color->rgb color-spec))
+ (lambda (r g b)
+ (format #f "rgb(~a,~a,~a)"
+ (round (/ r 255.0))
+ (round (/ g 255.0))
+ (round (/ b 255.0))))))
+
+(define (ploticus-script pie)
+ (let* ((weights (map (lambda (slice)
+ (markup-option slice :weight))
+ (markup-body pie)))
+ (colors (map (lambda (slice)
+ (let ((c (markup-option slice :color)))
+ (string-append (color-spec->ploticus c)
+ " ")))
+ (markup-body pie)))
+ (total-weight (or (if (number? (markup-option pie
+ :total))
+ (markup-option pie :total)
+ #f)
+ (apply + weights)))
+
+ ;; Attach useful information to the pie and its slices
+ (-/- (markup-option-add! pie '&total-weight total-weight))
+
+ ;; One slice label per line -- so we need to remove
+ ;; newlines from labels.
+ (labels (map (lambda (b)
+ (strip-newlines (pie-remove-markup b)))
+ (markup-body pie)))
+
+; (flat-title (map pie-remove-markup
+; (markup-option pie :title)))
+ (detached (map (lambda (slice)
+ (let ((d (markup-option slice
+ :detach?)))
+ (cond ((number? d) d)
+ (d 0.5) ;; default
+ (#t 0))))
+ (markup-body pie)))
+
+ (initial-angle (or (markup-option pie :initial-angle)
+ 0))
+ (radius (or ;;FIXME
+ (markup-option pie :radius) 3))
+ (max-radius (+ radius (apply max detached)))
+
+ ;; center coordinates must take into account (i) the
+ ;; maxium radius when detached slices are considered and
+ ;; (ii) the fact that labels may get displayed to the
+ ;; left of the pie.
+ ;; FIXME: labels to the left (ii) end up being truncated
+ ;; when the radius is e.g. < 2.
+ (center `(,(+ max-radius
+ (* max-radius max-radius)) .
+ ,(* max-radius max-radius))))
+
+ (apply string-append
+ (append (list "#proc getdata\n" "data: ")
+ (map (lambda (weight)
+ (string-append (number->string weight)
+ "\n"))
+ weights)
+ `("\n"
+; "#proc page\n"
+; "title " ,@flat-title
+; "\n"
+ "#proc pie\n"
+ "total: "
+ ,(number->string total-weight)
+ "\n"
+ "datafield: " "1" "\n")
+ `("firstslice: " ,(number->string initial-angle) "\n")
+ `("radius: " ,(number->string radius) "\n")
+ `("center: " ,(number->string (car center))
+ " " ,(number->string (cdr center)) "\n")
+ `("labelmode: "
+ ,(case (markup-option
+ pie :labels)
+ ((outside) "line+label")
+ ((inside) "labelonly")
+ ((legend) "legend")
+ (else "legend"))
+ "\n"
+ "labels: " ,@(map (lambda (label)
+ (string-append label "\n"))
+ labels)
+ "\n")
+ `("explode: "
+ ,@(map (lambda (number)
+ (string-append (number->string number)
+ " "))
+ detached)
+ "\n")
+ `("colors: " ,@colors "\n")))))
+
+(markup-writer 'pie (find-engine 'base)
+ :action (lambda (node engine)
+ (let* ((fmt (select-output-format engine))
+ (pie-file (string-append (markup-ident node) "."
+ fmt))
+ (port (open-output-pipe
+ (string-append %ploticus-program
+ " -o " pie-file
+ " -cm -" fmt " -stdin")))
+ (script (ploticus-script node)))
+
+
+ (if %ploticus-debug?
+ (format (current-error-port) "** Ploticus script: ~a"
+ script))
+
+ (display script port)
+
+ (let ((exit-val (status:exit-val (close-pipe port))))
+ (if (not (eqv? 0 exit-val))
+ (skribe-error 'pie/ploticus
+ "ploticus exited with error code"
+ exit-val)))
+
+ (if (not (file-exists? pie-file))
+ (skribe-error 'ploticus
+ "Ploticus did not create the image file"
+ script))
+
+ (if (markup-option node :title)
+ (output (list (bold (markup-option node :title))
+ (linebreak))
+ engine))
+
+ (output (image :file pie-file
+ :class (markup-option node :class)
+ (or (markup-option node :title)
+ "A Pie Chart"))
+ engine))))
+
+(markup-writer 'slice (find-engine 'base)
+ :action (lambda (node engine)
+ ;; Nothing to do here
+ (error "slice: this writer should never be invoked")))
+
+(markup-writer 'sliceweight (find-engine 'base)
+ :action (lambda (node engine)
+ ;; Nothing to do here.
+ (error "sliceweight: this writer should never be invoked")))
+
+
+;;;
+;;; Initialization.
+;;;
+
+(when-engine-is-loaded 'lout
+ (lambda ()
+ (resolve-module '(skribilo package pie lout))))
+
+
+;;; arch-tag: 8095d8f6-b810-4619-9fdb-23fb94a77ee3
diff --git a/src/guile/skribilo/package/pie/lout.scm b/src/guile/skribilo/package/pie/lout.scm
new file mode 100644
index 0000000..e6c4eb3
--- /dev/null
+++ b/src/guile/skribilo/package/pie/lout.scm
@@ -0,0 +1,131 @@
+;;; lout.scm -- Lout implementation of the `pie' package.
+;;;
+;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;; USA.
+
+(define-module (skribilo package pie lout)
+ :use-module (skribilo package pie)
+ :use-module (skribilo ast)
+ :autoload (skribilo output) (output)
+ :use-module (skribilo writer)
+ :use-module (skribilo engine)
+ :use-module (skribilo lib)
+ :use-module (skribilo utils syntax)
+ :use-module (skribilo utils keywords) ;; `the-options', etc.
+ :use-module (ice-9 optargs))
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+
+
+;;;
+;;; Helper functions.
+;;;
+
+(let ((lout (find-engine 'lout)))
+ (if lout
+ (engine-custom-set! lout 'includes
+ (string-append (engine-custom lout 'includes)
+ "\n@SysInclude { pie } # Pie Charts\n"))))
+
+
+
+;;;
+;;; Writers.
+;;;
+
+(markup-writer 'pie (find-engine 'lout)
+ :before (lambda (node engine)
+ (let* ((weights (map (lambda (slice)
+ (markup-option slice :weight))
+ (markup-body node)))
+ (total-weight (or (if (number? (markup-option node
+ :total))
+ (markup-option node :total)
+ #f)
+ (apply + weights))))
+
+ (if (= 0 total-weight)
+ (skribe-error 'lout
+ "Slices weight sum should not be zero"
+ total-weight))
+
+ ;; Attach useful information to the pie and its slices
+ (markup-option-add! node '&total-weight total-weight)
+
+ (display "\n@Pie\n")
+ (display " abovecaption { ")
+ (if (markup-option node :title)
+ (output (markup-option node :title) engine))
+ (display " }\n")
+ (format #t " totalweight { ~a }\n" total-weight)
+ (format #t " initialangle { ~a }\n"
+ (or (markup-option node :initial-angle) 0))
+ (format #t " finger { ~a }\n"
+ (case (markup-option node :labels)
+ ((outside) (if (markup-option node :fingers?)
+ "yes" "no"))
+ (else "no")))
+
+ ;; We assume `:radius' to be centimeters
+ (if (markup-option node :radius)
+ (printf " radius { ~ac }\n"
+ (markup-option node :radius)))
+
+ (format #t " labelradius { ~a }\n"
+ (case (markup-option node :labels)
+ ((outside #f) "external") ; FIXME: options are
+ ; not availble within
+ ; :before? (hence the #f)
+
+ ((inside) "internal")
+ (else
+ (skribe-error 'lout
+ "`:labels' should be one of 'inside or 'outside."
+ (markup-option node :labels)))))
+ (display "{\n")))
+ :after "\n} # @Pie\n")
+
+(markup-writer 'slice (find-engine 'lout)
+ :options '(:weight :detach? :color)
+ :action (lambda (node engine)
+ (display " @Slice\n")
+ (format #t " detach { ~a }\n"
+ (if (markup-option node :detach?)
+ "yes"
+ "no"))
+ (format #t " paint { ~a }\n"
+ (lout-color-specification (markup-option node
+ :color)))
+ (format #t " weight { ~a }\n"
+ (markup-option node :weight))
+
+ (display " label { ")
+ (output (markup-body node) engine)
+ (display " }\n")))
+
+(markup-writer 'sliceweight (find-engine 'base)
+ ;; This writer should work for every engine, provided the `pie' markup has
+ ;; a proper `&total-weight' option.
+ :action (lambda (node engine)
+ (let ((pct? (markup-option node :percentage?)))
+ (output (number->string
+ (pie-sliceweight-value node pct?))
+ engine))))
+
+;;; arch-tag: b5221e30-f80e-4b72-a281-83ce19ddb755