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)

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 "ＭＳ ゴシック" '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 --'

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)

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で怒られるのを回避するにはどうすればよいのだろう。