Gauche-rfbを使用したグラフの表示パッケージ 〜 『計算物理学入門』読み(その3)

Gauche-rfbを使用してグラフを表示するためのパッケージを作ってみた。

パッケージは以下の通り

;; -*- coding: utf-8; mode: scheme -*-

;; 

;; graph.scm - Drawing graph module with Gauche-rfb

;;

;; Copyright (c) 2008 Ettem

;; All rights reserved.

;; 
(define-module graph

  (use rfb)

  (use srfi-1)

  (export graph-init

	  graph-set-x-min! graph-set-x-max! graph-set-y-min! graph-set-y-max!

	  graph-set-point graph-line graph-box graph-grid graph-circle))
(select-module graph)
;; グラフのインスタンス

(define *graph* #f)
;; グラフの表示範囲

(define-class  ()

  ((x-min :init-keyword :x-min

	  :getter get-x-min

	  :setter set-x-min!)

   (x-max :init-keyword :x-max

	  :getter get-x-max

	  :setter set-x-max!)

   (y-min :init-keyword :y-min

	  :getter get-y-min

	  :setter set-y-min!)

   (y-max :init-keyword :y-max

	  :getter get-y-max

	  :setter set-y-max!)

   (window-x :init-keyword :window-x

	     :getter get-window-x

	     :setter set-window-x!)

   (window-y :init-keyword :window-y

	     :getter get-window-y

	     :setter set-window-y!)

   (inset-ratio :init-keyword :inset-ratio

		:init-value 0.05

		:getter get-inset-ratio

		:setter set-inset-ratio)))
(define-method get-x-len ((graph ))

  (- (get-x-max graph) (get-x-min graph)))
(define-method get-y-len ((graph ))

  (- (get-y-max graph) (get-y-min graph)))
(define-method get-x-pixel ((graph ))

  (round->exact

   (* (get-window-x graph)

      (- 1 (* 2 (get-inset-ratio graph))))))
(define-method get-y-pixel ((graph ))

  (round->exact

   (* (get-window-y graph)

      (- 1 (* 2 (get-inset-ratio graph))))))
(define-method get-inset-left ((graph ))

  (round->exact (* (get-window-x graph) (get-inset-ratio graph))))
(define-method get-inset-top ((graph ))

  (round->exact (* (get-window-y graph) (get-inset-ratio graph))))
;; グラフの値から、画面上のピクセルへの変換

(define (x->x-pixel x)

  (+ (get-inset-left *graph*)

     (round->exact

      (* (/ (abs (- x (get-x-min *graph*)))

            (get-x-len *graph*))

         (get-x-pixel *graph*)))))
(define (y->y-pixel y)

  (- (get-window-y *graph*)

     (get-inset-top *graph*)

     (round->exact

      (* (/ (abs (- y (get-y-min *graph*)))

            (get-y-len *graph*))

         (get-y-pixel *graph*)))))
;;; API

;; グラフの表示

(define (graph-init win-x win-y . restarg)

  (let-keywords restarg ((title #f) (display 0) (port #f)

                         (x-min 0) (x-max win-x)

                         (y-min 0) (y-max win-y))

                (set! *graph* (make 

                                :x-min x-min :x-max x-max

                                :y-min y-min :y-max y-max

                                :window-x win-x :window-y win-y))

                (let ((rfb-arg '()))

                  (if title

                      (set! rfb-arg (append `(:title ,title) rfb-arg)))

                  (if port

                      (set! rfb-arg (append `(:port ,port) rfb-arg)))

                  (apply rfb-init win-x win-y :display display rfb-arg))))
(define (graph-set-x-min! x)

  (set-x-min! *graph* x))
(define (graph-set-x-max! x)

  (set-x-max! *graph* x))
(define (graph-set-y-min! y)

  (set-y-min! *graph* y))
(define (graph-set-y-max! y)

  (set-y-max! *graph* y))
;; 点の描画

(define (graph-set-point x y c)

  (rfb-set-pixel  (x->x-pixel x)

                  (y->y-pixel y)

                  c))
;; 線の描画

(define (graph-line x1 y1 x2 y2 c)

  (rfb-line (x->x-pixel x1)

            (y->y-pixel y1)

            (x->x-pixel x2)

            (y->y-pixel y2)

            c))
;; 矩形描画

(define (graph-box x1 y1 x2 y2 c . restarg)

  (let-keywords restarg ((filled? #f))

                (rfb-box (x->x-pixel x1)

                         (y->y-pixel y1)

                         (x->x-pixel x2)

                         (y->y-pixel y2)

                         c

                         :filled? filled?)))
;; グリッド線の描画

(define (graph-grid n-x n-y c)

  (for-each (lambda (x)

              (rfb-line (x->x-pixel x)

                        (y->y-pixel (get-y-min *graph*))

                        (x->x-pixel x)

                        (y->y-pixel (get-y-max *graph*))

                        c))

            (iota (+ n-x 1) (get-x-min *graph*) (/ (get-x-len *graph*) n-x)))

    (for-each (lambda (y)

              (rfb-line (x->x-pixel (get-x-min *graph*))

                        (y->y-pixel y)

                        (x->x-pixel (get-x-max *graph*))

                        (y->y-pixel y)

                        c))

            (iota (+ n-y 1) (get-y-min *graph*) (/ (get-y-len *graph*) n-y))))
;; 円の描画

;; 目盛にあった、円は描けない場合がある...

;; Windowのアスペクト比と、目盛のアスペクト比は一致させる必要がある。

(define (graph-circle x y r c)

  (rfb-circle (x->x-pixel x)

              (y->y-pixel y)

              (x->x-pixel r)

              c))
(provide "graph")