A simple Google Chart wrapper for Common Lisp

google-chart.lisp

;;;; A simple Google Chart wrapper for Common Lisp

;;;
;;; API reference: http://code.google.com/apis/chart/
;;;
;;; WARNING: Incomplete and buggy -- still has much to be done, e.g.:
;;;
;;;  * more thorough testing (that won't be hard...)
;;;
;;;  * handle spaces/newlines appropriately
;;;
;;;  * a better way to describe axis labels (and remove index value
;;;    presumption)
;;;
;;;  * add shape and range markers
;;;
;;;  * add fill area
;;;
;;;  * a higher-level layer that is a bit "smarter" and more
;;;    convenient (e.g., hide the stupid scale for simple-data)
;;;
;;;  * convenience utilities to make use of the resulting URL
;;;
;;;  * clean up the code, especially colors, names, docs, etc.
;;;
;;; Example of use:
;;;
;;; GOOGLE-CHART> (chart (mapcar #'floor *) :line-chart '(600 200))
;;; "http://chart.apis.google.com/chart?chs=600x200&chd=s:AFOMQCDSIFJICNLLCDHDCBBAGLCEDODCCGADAHQHJGHGGGFL9FBNHCKBbIFKENJJDJ0IC&cht=lc"
;;;

(defpackage #:google-chart
  (:use #:cl)
  (:export
   #:chart
   #:*chart-data-format*))

(in-package #:google-chart)

(defvar *chart-data-format* :simple-data)

(defun chart (data type size &rest args)
  (with-output-to-string (*standard-output*)
    (write-string "http://chart.apis.google.com/chart?")
    (write-parameter data *chart-data-format*)
    (write-parameter-separator)
    (write-parameter type :type)
    (write-parameter-separator)
    (write-parameter size :size)
    (loop for (type value) on args by #'cddr do
          (write-parameter-separator)
          (write-parameter value type))))

(defun write-parameter-separator ()
  (write-char #\&))

(defvar *parameter-dispatch-table*
  (make-hash-table :test 'eq))

(defun write-parameter (value type)
  (funcall (gethash type *parameter-dispatch-table*
                    (lambda (whatever)
                      (declare (ignore whatever))
                      (error "Unknown parameter type: ~S." type)))
           value))

(defmacro define-chart-parameter (type (value) &body body)
  `(progn
     (setf (gethash ',type *parameter-dispatch-table*)
           (lambda (,value)
             ,@body))
     ',type))


;;;; Chart parameters

(define-chart-parameter :size (size)
  (destructuring-bind (width height) size
    (format t "chs=~Dx~D" width height)))

(defvar *simple-encoding-digits*
  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789")

(define-chart-parameter :simple-data (data)
  (write-string "chd=s:")
  (map 'nil
       (lambda (x)
         (write-char
          (case x
            (:missing #\_)
            (:separator #\,)
            (otherwise (char *simple-encoding-digits* x)))))
       data))

(define-chart-parameter :text-data (data)
  (write-string "chd=t")
  (let ((separator #\:))
    (map 'nil
         (lambda (x)
           (case x
             (:missing
              (write-char separator)
              (write-string "-1")
              (setf separator #\,))
             (:separator
              (setf separator #\|))
             (otherwise
              (write-char separator)
              (princ x)
              (setf separator #\,))))
         data)))

(defvar *extended-encoding-digits*
  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-.")

(define-chart-parameter :extended-data (data)
  (write-string "chd=e:")
  (map 'nil
       (lambda (x)
         (case x
           (:missing (write-string "__"))
           (:separator (write-char #\,))
           (otherwise
            (multiple-value-bind (q r) (floor x 64)
              (write-char (char *extended-encoding-digits* q))
              (write-char (char *extended-encoding-digits* r))))))
       data))

(define-chart-parameter :type (type)
  (write-string "cht=")
  (write-string
   (ecase type
     (:line-chart "lc")
     (:line-chart/xy "lxy")
     (:bar-chart/horizontal "bhs")
     (:bar-chart/vertical "bvs")
     (:bar-chart/horizontal-grouped "bhg")
     (:bar-chart/vertical-grouped "bvg")
     (:pie-chart "p")
     (:pie-chart/3 "p3")
     (:venn-diagram "v")
     (:scatter-plot "s"))))

(define-chart-parameter :bar-chart-size (size)
  (write-string "chbh=")
  (etypecase size
    (integer (princ size))
    (list (destructuring-bind (width spacing) size
            (format t "~A,~A" width spacing)))))

(define-chart-parameter :colors (colors)
  (write-string "chco")
  (loop for separator = #\= then #\,
        for color in colors do
        (write-char separator)
        (write-color color)))

(defun fill-parameter (which fill-type &rest args)
  (ecase which
    (:chart-area (write-char #\c))
    (:background (write-string "bg")))
  (write-char #\,)
  (ecase fill-type
    (:solid
     (write-string "s,")
     (destructuring-bind (color) args
       (write-color color)))
    (:linear-gradient
     (write-string "lg,")
     (loop for (angle color) on args by #'cddr do
           (princ angle)
           (write-char #\,)
           (write-color color)))
    (:linear-stripes
     (write-string "ls,")
     (princ (first args))
     (write-char #\,)
     (loop for (color width) on (rest args) by #'cddr do
           (write-color color)
           (write-char #\,)
           (princ width)))))

(defun write-color (color-args)
  (destructuring-bind (r g b &optional a) color-args
    (format t "~2,'0X" r)
    (format t "~2,'0X" g)
    (format t "~2,'0X" b)
    (when a
      (format t "~2,'0X" a))))

(define-chart-parameter :chart-title (title)
  (format t "chtt=~A"
          (substitute #\| #\Linefeed
                      (substitute #\+ #\Space title))))

(define-chart-parameter :title-size (size)
  (destructuring-bind (color font-size) size
    (format t "chts=~A,~A" color font-size)))

(define-chart-parameter :legend (legend)
  (format t "chdl=~{~A~^|~}" legend))

(define-chart-parameter :labels (labels)
  (format t "chl=~{~A~^|~}" labels))

(define-chart-parameter :axis-type (type)
  (format t "chxt=~{~(~A~)~^,~}" type))

(define-chart-parameter :axis-labels (labels)
  (write-string "chxl=")
  (loop for n from 0
        for label in labels
        do (format t "~A:|~{~A|~}" n label)))

(define-chart-parameter :axis-label-positions (positions)
  (format t "chxp=~{~{~A~^,~}~^|~}" positions))

(define-chart-parameter :axis-ranges (ranges)
  (format t "chxr=~{~{~A~^,~}~^|~}" ranges))

(define-chart-parameter :axis-styles (styles)
  (format t "chxs=~{~{~A~^,~}~^|~}" styles))

(define-chart-parameter :line-styles (styles)
  (format t "chls=~{~{~A~^,~}~^|~}" styles))

(define-chart-parameter :grid-lines (lines)
  (format t "chg=~{~A~^,~}" lines))