Gauche-OLE を使って IE に内トロコイド曲線を書く

Gauche-OLE 0.8 で問題が解消されたので、ちょっと真面目に図形を描画する例を作ろうと考えました。 例なので図は何でもよいのですが、 Gauche-gl での図形描画例として内トロコイド曲線を描くものを見付けたので、これを元にすることにします。

http://practical-scheme.net/wiliki/wiliki.cgi?Gauche%3AGauche-gl%E3%82%B5%E3%83%B3%E3%83%97%E3%83%AB

以下が IE 描画用に移植したものです。

#!/usr/bin/env gosh
;; -*- coding: utf-8 -*-
(use win.ole)
(use math.const)

(define *rc* 200)

(define (trochoid-path rc rm rd)
  (let* ((t1 (-  rc rm))
         (t2 (/. t1 rm))
         (n  (/. rm (gcd t1 rm))))
    (do ((i  0 (+ i (/. 2pi 360)))
         (lst '() (cons (cons (+ (* t1 (cos i)) (* rd (cos (* t2 i))))
                              (+ (* t1 (sin i)) (* (- rd) (sin (* t2 i)))))
                        lst)))
        ((>= i (* 2pi n)) lst))))

(define (make-canvas)
  (define IE (make-ole "InternetExplorer.Application"))
  (set! (~ IE 'Visible) #t)
  (while (~ IE 'busy) (sys-nanosleep 500000000))
  (IE 'Navigate "about:blank")
  (rlet1 canvas (? IE 'Document ! 'createElement "canvas")
    (while (~ IE 'busy) (sys-nanosleep 500000000))
    (set! (~ canvas 'height) 480)
    (set! (~ canvas 'width) 480)
    (? IE 'Document ? 'body ! 'appendChild canvas)))

(define (draw-path canvas path)
  (define ctx (canvas 'getContext "2d"))
  (ctx 'translate 200 200)
  (ctx 'beginPath)
  (ctx 'moveTo (caar path) (cdar path))
  (for-each (^(x) (ctx 'lineTo (car x) (cdr x))) (cdr path))
  (ctx 'closePath)
  (ctx 'stroke))

(define (main args)
  (let* ((rm 44) (rd 30))
    (draw-path (make-canvas) (trochoid-path *rc* rm rd)))
  (ole-release!)
  0)

パスを構成する線が多すぎるとエラーになるようなのでパラメータは乱数ではなく固定にしています。 また、キー入力を受付けて再描画するのも省きました。 単に描画してそのまま終了するだけです。

現在の Gauche-OLE ではイベントを扱う機能が不充分で、キー入力イベントを捉えることが出来ません。 次の課題として取り組むつもりです。 (Ruby の WIN32OLE_EVENT に相当するような機能。) 非同期な処理となると Gauche 側の仕組みと上手く噛み合うか不安な部分はありますが XMLHttpRequest の非同期処理ではコールバックが上手くいっているのでなんとかなるのではないかと楽観的に考えています。

Document ID: 6d4e65975eb0b154e76b9615dd8a8530