2012年1月28日土曜日

Racketでファイル名入力ダイアログ

get-file関数でファイル名入力ダイアログを利用できます.戻り値はパスまたは#fです.
オブジェクト指向風にファイル名入力用テキストフィールド+ボタンをまとめたクラスを作成してみます.



#lang racket

(require racket/gui/base)

(define file-input-pane%
(class vertical-pane%
(init-field button-label)
(init-field parent)
(init-field [label #f])
(super-new [parent parent]
[stretchable-height #f]
[stretchable-width #f])
(when label
(new message% [label label]
[stretchable-width #t]
[parent this]))
(define horizontal-pane
(new horizontal-pane% [parent this]
[stretchable-height #f]
[stretchable-width #f]))
(define file-name-field
(new text-field%
[label ""] [parent horizontal-pane]))
(define file-name-button
(new button%
[label button-label]
[parent horizontal-pane]
[callback
(lambda (btn evt)
(let ((fpath (get-file)))
(when fpath
(send file-name-field set-value
(path->string fpath)))))]))
(define/public (get-value)
(send file-name-field get-value))
(define/public (set-value value)
(send file-name-field set-value value))))

;; test
(define frame (new frame% [label "example"]
[width 300]
[height 200]))
(new file-input-pane% [parent frame]
[label "hello"]
[button-label "file"])

(send frame show #t)

2012年1月25日水曜日

Racketで画像作成(racket/draw)

Racketで画像を作成します.
いくつか手段がありそうですが、racket/drawを利用します.


フォントを指定すれば日本語も出力できるようです.



#lang racket

(require racket/draw)

(define target (make-bitmap 150 30))
(define dc (new bitmap-dc% [bitmap target]))

;; 長方形
(send dc draw-rectangle 1 1 149 29)

;; フォントの設定
(define ms-font (make-object font% 10 "MS ゴシック" 'default))
(send dc set-font ms-font)

;; 文字列
(send dc draw-text "こんにちはせかい" 5 10)

;; 保存
(send target save-file "hello.png" 'png)

Racketでコマンドライン引数のパース

Racketにはコマンドライン引数をパースするための機能が備わっているようです.
ためしに簡易catコマンドを作ってみます.



#lang racket

(define line-number? #f)

(define files
(command-line
#:program "cat"
#:once-each
(("-n" "--number") "show line number"
(set! line-number? #t))
;; 残りの引数.command-lineの戻り値になる.
#:args args args))

(define output-lines
(if line-number?
(lambda (port)
(define n 1)
(for ((line (in-lines port)))
(printf "~a\t:~a~%" n line)
(set! n (+ 1 n))))
(lambda (port)
(for ((line (in-lines port)))
(displayln line)))))

(if (null? files)
(output-lines (current-input-port))
(for ((f files))
(call-with-input-file f output-lines)))


Racketに付属しているracoというツールを使って実行ファイルに変換します.



$ raco.exe exe cat.rkt

ソースファイルがcat.rktであるとすると、cat.exeという実行ファイルが作成されます(Windows)


cygwinでechoの出力をパイプすると以下のようになります.helpまで自動的に作ってくれるようです.



$ echo 'hoge
> fuga' | ./cat.exe
hoge
fuga

$ echo 'hoge
fuga' | ./cat.exe -n
1 :hoge
2 :fuga

$ ./cat.exe --help
cat [ <option> ... ] [<args>] ...
where <option> is one of
-n, --number : show line number
--help, -h : Show this help
-- : Do not treat any remaining argument as a switch (at this level)
Multiple single-letter switches can be combined after one `-'; for
example: `-h-' is the same as `-h --'

2012年1月20日金曜日

Racket(Scheme)でGUI


Racketでウィンドウを表示し、線を引いてみます.
"draw"ボタンをクリックするたびにランダムな色と位置で線が表示されます.



#lang racket

(require racket/gui/base
srfi/27)

(define frame
(new frame%
[label "Example"]
[width 300]
[height 300]))
(define cvs (new canvas% [parent frame]))
(define pen-styles
'(transparent solid xor hilite dot long-dash
short-dash dot-dash xor-dot
xor-long-dash xor-short-dash
xor-dot-dash))

(define btn
(new button% [parent frame]
[label "draw"]
[callback
(lambda (b e)
(let ((dc (send cvs get-dc)))
(let-values (((x y) (send cvs get-virtual-size)))
(send dc set-pen
(make-object color%
(random-integer 255)
(random-integer 255)
(random-integer 255))
2
(list-ref pen-styles
(random-integer (length pen-styles))))
(send dc draw-line
(random-integer x) (random-integer y)
(random-integer x) (random-integer y)))))]))

(send frame show #t)

2012年1月19日木曜日

Racket(Scheme)でWebサーバ+formlets


RacketでWebサーバ+formletsを使ってみます。
以下のコードで、ローカルホストの8000ポートでWebサーバが立ち上がります。


#lang racket
(require
web-server/servlet
web-server/servlet-env
web-server/dispatch
web-server/formlets)

(define-values (dispatcher _)
(dispatch-rules
[("input") show-input]
[("output") show-output]
[else show-default]))

(define form
(formlet
(div "input:" ,{=> input-string input})
input))

(define (show-input req)
(response/xexpr
`(html
(head (title "input"))
(body (form ((action "output"))
,@(formlet-display form)
(submit))))))

(define (show-output req)
(let ((input (formlet-process form req)))
(response/xexpr
`(html
(head (title "output"))
(body (p "output : " ,input))))))

(define (show-default req)
(response/xexpr
`(html (head (title "default"))
(body (p "default page")))))

(serve/dispatch dispatcher)



input-intフォームに数字以外の文字列を渡した場合に
contractで怒られるのを回避するにはどうすればよいのだろう。