tkがサポートしているマウスカーソルを調べる。

Gauche-Tkを使って、tkがサポートしているマウスカーソルの形を調べました。

ボタンを押すと、マウスカーソルの形状が変わります。

ソースコード

;; cursor example
(use tk)
;; wishへのPATHが通っていれば、wishとのみ設定すればWindowsでもUbuntuでも同じ記述が使える。
(wish-path "wish") ; wishへのパス
;(with-module tk (set! *tk-debug* #t))

; -cursor オプションに与えることのできるパラメータ
(define *cursors* '(X_cursor
                  arrow
                  based_arrow_down based_arrow_up boat bogosity bottom_left_corner bottom_right_corner bottom_side bottom_tee box_spiral
                  center_ptr circle clock coffee_mug cross cross_reverse crosshair
                  diamond_cross dot dotbox double_arrow draft_large draft_small draped_box
                  exchange
                  fleur
                  gobbler gumby
                  hand1 hand2 heart
                  icon iron_cross
                  left_ptr left_side left_tee leftbutton ll_angle lr_angle
                  man middlebutton mouse
                  none
                  pencil pirate plus
                  question_arrow
                  right_ptr right_side right_tee rightbutton rtl_logo
                  sailboat sb_down_arrow sb_h_double_arrow sb_left_arrow sb_right_arrow sb_up_arrow sb_v_double_arrow shuttle sizing spider spraycan star
                  target tcross top_left_arrow top_left_corner top_right_corner top_side top_tee trek
                  ul_angle umbrella ur_angle
                  watch
                  xterm))

(define *cursor_index* 0)

(define get-cursor-name
  (lambda ()
    (symbol->string (ref *cursors* *cursor_index*))))

(define next
  (lambda ()
    (let ((max (length *cursors*)))
      (unless (eq? (- max 1) *cursor_index*)
        (inc! *cursor_index*)))))

(define prev
  (lambda ()
    (unless (eq? *cursor_index* 0)
      (dec! *cursor_index*))))

(define update-cursor
  (lambda (dirf)
    (dirf)
    (let ((new-cursor (get-cursor-name)))
      (tk-set! "::cursor" new-cursor)
      (tk-call "." "configure" :cursor new-cursor)))) ; マウスカーソルの形を変更

(tk-init '())
(tk-wm 'iconbitmap "." "gauche-logo.ico")
(tk-set! "::cursor" (get-cursor-name))
(tk-label '.l :textvariable "::cursor" :height 4)
(tk-frame '.fb)
(tk-button '.fb.p :text "prev" :command (lambda () (update-cursor prev)))
(tk-button '.fb.n :text "next" :command (lambda () (update-cursor next)))
(tk-pack '.fb.p '.fb.n :side 'left)
(tk-pack '.l '.fb)
(tk-mainloop)