(Racket) draw-text における文字回転

draw-textによる縦書きは、文字列を分割して一文字ずつ置いていくのが簡単です。ただしカタカナの長音記号は横棒のままになっていますので、文字を回転して描画します。

• 回転したい文字の中心に座標原点を移動 (set-origin)
• さらに座標系の回転(rotate)
• そして文字を描画(draw-text)
• その後座標系を元に戻す

予め get-transformation で座標系の状態を取得しておき、回転描画が終わった後に元の状態に戻します (set-transformation)。
そうすることで以降の処理は通常通りの座標系で描画を再開することが可能となります。

なお、割と綺麗に見えるフォントを使っていますが、フォントによっては縦棒の位置がぴったり収まらないこともあるようです。

draw-text における文字回転の例

(Racket) 無名関数をcutで評価

lamda式等で無名関数を作り即時評価するコードは次のようになります。

((lambda (x y) (* x y)) 5 7) ;=> 35

このように無名関数のコードが短ければいいのですが長くなると適用される引数をずっと後ろの方に書く事になり可読性が下がります。

((lambda (x y) 
   ...
   ...
   ... ) 5 7)

そこで srfi26 の cut を使い次のように書くと良いんじゃないかと思いました。

(require srfi/26)

((cut <> 5 7)
 (lambda (x y)
   ...
   ...
   ...))

cut のプレースホルダ <> に無名関数を渡してやるわけです。

racketではミックスイン*1は「クラスへ適用するとミックスインされた新たなクラスを返す関数」として表現されます。そしてそのような関数を作るショートカットに mixin というマクロを用意しています。つまり mixin は関数を作るマクロです。
例えば、racket/gui で幅や高さを固定したUIパーツを作るためのミックスインは次のように書くことができます。

(define (fixed-size-mixin % #:width (width -1) #:height (height -1))
  ((cut <> %)
   (mixin (area<%>) ()
          (super-new)
          (when (>= width 0)
            (send* this
              (stretchable-width #f)
              (min-width width)))
          (when (>= height 0)
            (send* this
              (stretchable-height #f)
              (min-height height))))))

引数 % はミックスインを適用するターゲットクラス。 #:XXXX はキーワード引数です。
mixinマクロが作るミックスイン関数をターゲットクラス % へ適用しています。
cutを使わないと、% をmixinフォームの後ろに書くにことになりますが、それはちょっと読みにくいですよね。

記事の主題からは外れますが、上のミックスインの使い方も一応書いておきます。ミックスインでクラスを定義する例です。

;; 垂直パネルを幅だけ100に固定
(define my-panel%
  (fixed-size-mixin vertical-panel% #:width 100))

;; サイズ 100x200 のキャンバス派生クラスを定義
(define my-canvas%
  (fixed-size-mixin
   #:width 100 #:height 200
   (class canvas% (super-new)
     (define/override (on-paint)
       ...))))

area<%>インターフェースを実装しているクラスであれば、簡単にサイズ固定できます。*2

*1:「ミキシン」と呼ぶ方が正しいらしい。

*2:racket/guiではpanel%やcanvas%等のクラスはデフォルトで親コンテナにオートフィットする設定になっています。

(Racket) values->list マクロとか

無いっぽいので...

(define-syntax values->list
  (syntax-rules ()
    ((_ vs) (call-with-values (thunk vs) list))))

(define-syntax values->vector
  (syntax-rules ()
    ((_ vs) (call-with-values (thunk vs) vector))))

(define-syntax values->hash
  (syntax-rules ()
    ((_ vs) (call-with-values (thunk vs) hash))))

(define-syntax values->struct
  (syntax-rules ()
    ((_ struct-type vs)
     (apply struct-type
            (call-with-values (thunk vs) list)))))

つかう

(values->list (values 10 20)) ;=> (10 20)

(values->vector (values 10 20)) ;=> #(10 20)

(values->hash (values 'a 10 'b 20)) ;=> #hash((b . 20) (a . 10))

(struct person (name age email) #:transparent)
(values->struct person (values "Yamada" 42 "hoge@foo.bar"))
 ;;=> #(person "Yamada" 42 "hoge@foo.bar")