Indic OpenType GSUB graph drawing using GraphViz

indic-graphviz.el

;; OpenTypeの Named-Key 形式FontのGSUB Lookupのグラフを作成する。

;; input file
;;   `spot -t GSUB=7' で、features ファイルを作成する。
(defvar indic-feature-file   "~/Dropbox/lessons/graphviz/indic/vrinda.features")
;; output file
(defvar indic-dot-file-fmt   "~/Dropbox/lessons/graphviz/indic/vrinda.%s.dot")
;; image file directory (use fontforge Export("%n.png") function)
(defvar indic-image-file-fmt "~/.tmp/vrinda/%s.png")

(defvar indic-glyph-names nil)
(defvar indic-feat-input-table  nil) ;; (make-hash-table :test 'equal))
(defvar indic-feat-output-table nil) ;; (make-hash-table :test 'equal))

(defun addhash (key value table &optional append)
  "Add VALUE with list associated with KEY in table TABLE."
  (let ((x (gethash key table)))
    (add-to-list 'x value append)
    (puthash key x table)))

(defun indic-setup ()
  (interactive)
  (setq indic-glyph-names nil
        indic-feat-input-table  (make-hash-table :test 'equal)
        indic-feat-output-table (make-hash-table :test 'equal))
  (with-temp-buffer
    (insert-file-contents indic-feature-file)
    (let (feat (index "0")))
    (while (re-search-forward "\\(?:^ sub \\(.+?\\) by \\(.+?\\);\\)\\|\\(?:in feature '\\(....\\)'\\)\\|\\(?:Start Lookup \\[\\([0-9]+\\)\\]\\)" nil t)
      (let ((entry-in (match-string 1))
            (entry-out (match-string 2))
            (feat-name (match-string 3))
            (lookup-index (match-string 4)))
        (if feat-name (setq feat feat-name)
          (if lookup-index (setq index lookup-index)
            (let* ((inputs (save-match-data 
                             (split-string (replace-regexp-in-string "@[0-9]+" "" entry-in) " " t)))
                   (outputs (save-match-data 
                             (split-string (replace-regexp-in-string "@[0-9]+" "" entry-out) " " t)))
                   (entry (list (cons feat index) inputs outputs)))
              (dolist (input inputs)
                (add-to-list 'indic-glyph-names input)
                (addhash input entry indic-feat-input-table))
              (dolist (output outputs)
                (add-to-list 'indic-glyph-names output)
                (addhash output entry indic-feat-output-table)))))))))

(defvar indic-result nil)

;; graph計算
(defun indic-compute-graph (glyph-name)
  (let* (result 
         (input-list (list glyph-name))
         (output-list (list glyph-name)))
    ;; downward
    (while input-list
      ;;(message "debug: input-list %s" input-list)
      (let ((entries (gethash (car input-list) indic-feat-input-table)))
        (dolist (entry entries)
          (add-to-list 'result entry)
          (dolist (output (elt entry 2))
            (add-to-list 'input-list output t))))
      (setq input-list (cdr input-list)))
    ;; upward
    (while output-list
      ;;(message "debug: output-list %s" output-list)
      (let ((entries (gethash (car output-list) indic-feat-output-table)))
        (dolist (entry entries)
          (add-to-list 'result entry)
          (dolist (input (elt entry 1))
            (add-to-list 'output-list input t))))
      (setq output-list (cdr output-list)))
    (setq indic-result result)))

;; グラフ出力    
(defun indic-graph-output (glyph-name)
  (with-temp-file (format indic-dot-file-fmt glyph-name)
    (let (nodes)
      (dolist (result indic-result)
        (let ((feat (elt result 0))
              (inputs (elt result 1))
              (outputs (elt result 2)))
          (dolist (input inputs)
            (add-to-list 'nodes input)
            (dolist (output outputs)
              (add-to-list 'nodes output)
              (insert (format "  %s -> %s [ label=\"%s(%s)\" ];\n"
                              input output (car feat) (cdr feat)))))))
      (insert "\n}\n")
      (goto-char (point-min))
      (insert "digraph G {\n")
      (insert "  graph [dpi=96.0 ranksep=5.0];\n")
      (insert "  node [shape=none constraint=true];\n")
      (dolist (node nodes)
        (insert 
         (format
          "  %s [ label=<<table border='0'><tr><td><img src='%s'/></td></tr><tr><td>%s</td></tr></table>> ] ;\n"
          node (expand-file-name (format indic-image-file-fmt node))
          node))))))

;; UI
(defun indic-compute (glyph-name)
  (interactive
   (list
    (completing-read "Input glyph name: " indic-glyph-names)))
  (indic-compute-graph glyph-name)
  (indic-graph-output glyph-name))