McCLIMでグラフを書く

McCLIMでグラフを描画する。ノードが循環すると繰り返し処理をしようとして落ちるようだ。

(require :asdf)
(asdf:oos 'asdf:load-op :mcclim)

(in-package :clim-user)

(define-application-frame graph-frame ()
  ()
  (:menu-bar t)
  (:panes
   (app :application
	:min-width 200
	:min-height 200
	:scroll-bars nil
	:display-time :command-loop
	:display-function 'draw))
  (:layouts
   (default (horizontally () app))))

(define-graph-frame-command (com-quit :menu t) ()
  (frame-exit *application-frame*))

(defstruct node (name "") (children nil))
(defparameter gl (let* ((2a (make-node :name "2A"))
			(2b (make-node :name "2B"))
			(2c (make-node :name "2C"))
			(1a (make-node :name "1A" :children (list 2a 2b)))
			(1b (make-node :name "1B" :children (list 2b 2c))))
		   (make-node :name "0" :children (list 1a 1b))))
(define-presentation-type node ())
(defun test-graph (root-node &rest keys)
  (apply #'clim:format-graph-from-root gl
	 #'(lambda (node stream)
	       (clim:surrounding-output-with-border (stream :shape :underline)
		 (write-string (node-name node) stream)))
	 #'node-children
	 keys))
(defgeneric draw (frame stream))
(defmethod draw ((frame application-frame) stream)
  (declare (ignore frame))
  (test-graph gl :stream stream))

(defun run ()
  (clim:run-frame-top-level (clim:make-application-frame 'graph-frame)))

McCLIMはPostScriptを出力する事もできるらしい。

(defun output-postscript (filename)
  (with-open-file (out filename :direction :output)
    (with-output-to-postscript-stream
	(stream out
		:header-comments '(:title "PostScript Test"))
      (test-graph gl :stream stream))))