以前の記事*1でputbytesなる関数を定義しました。これは奥村晴彦さんの本に記載のプログラムをSchemeで書き直したものです。今回はその続きで、grBMP.c (奥村本 p.63)のScheme版を完成させます。
といってもputbytesを作った時点でほぼ完成しており、あとはそれをうまく組み合わせただけです。プログラムは以下のとおりです。
#| grBMP.scm |#
(define XMAX 640)
(define YMAX 400)
(use gauche.array)
(define BLACK (string->number "000000" 16))
(define WHITE (string->number "ffffff" 16))
(define RED (string->number "ff0000" 16))
(define GREEN (string->number "00ff00" 16))
(define BLUE (string->number "0000ff" 16))
(define gr_screen (make-array (shape 0 YMAX 0 XMAX) 0))
(define (putbytes f n x)
(use scheme.bitwise)
(do
([i 0 (+ i 1)])
([= n i] )
(begin
(write-byte (bitwise-and x 255) f)
(set! x (arithmetic-shift x -8))
)
)
)
(define (gr_dot x y color)
(if (and (and (<= 0 x) (< x XMAX))
(and (<= 0 y) (< y YMAX)))
(array-set! gr_screen x y color)
)
)
(define (gr_clear color)
(array-for-each-index gr_screen (^(i j) (gr_dot i j color)))
)
(define f (open-output-file fname))
(display "BM" f)
(putbytes f 4 (+ (* XMAX YMAX 4) 54))
(putbytes f 4 0)
(putbytes f 4 54)
(putbytes f 4 40)
(putbytes f 4 XMAX)
(putbytes f 4 YMAX)
(putbytes f 2 1)
(putbytes f 2 32)
(putbytes f 4 0)
(putbytes f 4 (* XMAX YMAX 4))
(putbytes f 4 3780)
(putbytes f 4 3780)
(putbytes f 4 0)
(putbytes f 4 0)
(array-for-each-index gr_screen (^(i j)
(putbytes f 4 (array-ref gr_screen i j))))
(close-output-port f)
)
上記のプログラムを利用するにはinclude*2が一番楽そうです。また、今回は使用していませんが、loadもまた別の機会に使ってみたいところです。
さて、気を取り直して以下のコードで実際に画像を作ってみます。
main.scmを実行すると同じディレクトリ配下にBMP形式のファイルができました。さっそく開いて確認してみましょう。
はい黒です。まごうことなき黒 (600 x 400)です。gr_screenを0で初期化しているので当然の結果です。これだけ苦労してできたのが真っ黒な画像。。。と思ってしまいますが、自分の今後のベースになるので引き続き頑張りたいところです。
参考文献
