2012年が明けたので書き初めしました。lispで。

明けましておめでとうございます。書き初めしました。lisp（というかscheme（というかgauche））で。辰年なので図形言語でドラゴン曲線を描くべきかとも思いましたが書き初めにしました。元ネタはこちら。

参考

参考にしたのはこちら

• Common Lispで書き初め « 週記くらい@日本
• Gauche-gd リファレンスマニュアル

Gauche-gdは仕事でも使っていたので、一部流用しつつ。

使い方

コマンドにしたので、下記のように使えます。
フォントはここと同じものにしました。

• 青柳隷書しも

gauche 0.9.2以降で動きます。最後の「あけおめ」のように別のfontでもOK。

$ kakizome "吾唯足知" "ばるばろう" /home/valvallow/.fonts/opentype/aoyagireisyosimo/aoyagireisyosimo.otf | hd -C | less

すると以下のような出力が得られるので、> hoge.pngとかして下さい。

00000000  89 50 4e 47 0d 0a 1a 0a  00 00 00 0d 49 48 44 52  |.PNG........IHDR|
00000010  00 00 00 7a 00 00 01 60  08 02 00 00 00 fb 01 fa  |...z...`........|
00000020  fa 00 00 20 00 49 44 41  54 78 9c ed 9d 7f 4c 1b  |... .IDATx....L.|
00000030  e7 fd c7 ef eb b8 8e 71  5c 8f b8 ae eb 52 87 7a  |.......q\....R.z|
00000040  0c b9 1e 75 19 a2 8c 51  ea 52 46 a9 85 18 65 cc  |...u...Q.RF...e.|
00000050  65 14 a1 34 62 94 b2 88  a1 2c c9 a2 8c a1 28 42  |e..4b....,....(B|
00000060  34 5f 84 22 14 21 c4 88  47 29 63 0c 65 0c 51 44  |4_.".!..G)c.e.QD|
00000070  29 a5 94 22 0f 21 ca 18  63 d4 73 29 61 8e 87 98  |)..".!..c.s)a...|
00000080  71 88 e3 38 84 3a ae 63  8c 89 bf 7f dc b7 de f5  |q..8.:.c........|
...
..
.

こんな感じで

$ kakizome "吾唯足知" "ばるばろう" /home/valvallow/.fonts/opentype/aoyagireisyosimo/aoyagireisyosimo.otf > temp/hoge.png ; eog temp/hoge.png

ソースは以下の通り。

• kakizome — Gist

	#!/usr/local/bin/gosh
	(use graphics.gd)
	(use gauche.parseopt)
	(define (usage)
	(print "Usage: kakizome <message> <name> <font>")
	(exit 1))
	(define (string->string-list str)
	(map string (string->list str)))
	(define (string-rectangle x y str font point)
	(gd-image-string-ft #f 0 font point 0 x y str))
	(define (string-size str font point)
	(receive (a b c d)
	(string-rectangle 0 0 str font point)
	(let ((width (- (car b)(car a)))
	(height (- (cdr a)(cdr d))))
	(values width height))))
	(define (string-max-width&height str font point)
	(let1 strls (string->string-list str)
	(let* ((size-ls (map (^s (receive (w h)
	(string-size s font point)
	(cons w h))) strls))
	(max-width (apply max (map car size-ls)))
	(max-height (apply max (map cdr size-ls))))
	(values max-width max-height))))
	(define (string->image-vertical str font point bgcolor fgcolor)
	(let* ((side-margin (quotient point 5))
	(bottom-margin (* side-margin 2))
	(top-margin (+ side-margin point))
	(signature-space 10))
	(receive (sw sh)
	(string-max-width&height str font point)
	(let* ((cw (+ sw side-margin signature-space))
	(ch (+ (* sh (string-length str)) bottom-margin))
	(image (gd-image-create-true-color cw ch))
	(x (+ (quotient side-margin 2) signature-space))
	(y top-margin))
	(gd-image-fill image 0 0 bgcolor)
	(let rec ((ls (string->string-list str))(y y))
	(unless (null? ls)
	(string! image x y (car ls) :font font :fg fgcolor :pt point)
	(rec (cdr ls)(+ y sh))))
	(values image cw ch)))))
	(define (write-signature! image signature font point fgcolor)
	(receive (sw sh)
	(string-max-width&height signature font point)
	(let* ((strls (reverse (string->string-list signature)))
	(ch (gd-image-sy image)))
	(let rec ((ls strls)(y (- ch (* sh 3))))
	(unless (null? ls)
	(string! image 5 y (car ls) :font font :fg fgcolor :pt point)
	(rec (cdr ls)(- y sh))))
	image)))
	(define (main args)
	(let-args (cdr args)
	((message "m|message=s")
	(font "f|font=s")
	(name "n|name=s")
	(help "h|help" => usage)
	(else (opt . _)
	(print "Unknown option : " opt)
	(usage))
	. rest)
	(let ((message (if (null? rest)
	(read)
	(car rest)))
	(name (if (or (null? rest)
	(null? (cdr rest)))
	(read)
	(cadr rest)))
	(font (if (or (null? rest)
	(null? (cdr rest))
	(null? (cddr rest)))
	(read)
	(caddr rest)))
	(bgcolor (gd-true-color 255 255 255))
	(fgcolor (gd-true-color 0 0 0))
	(point 72))
	(let1 image (string->image-vertical message font point bgcolor fgcolor)
	(write-signature! image name font 12 fgcolor)
	(write-as image 'png (current-output-port))))))

view raw kakizome.scm hosted with ❤ by GitHub

関連

• vallog: クリスマスツリーを飾りました。Lispで。