TclOO - Tcl の標準オブジェクトシステム（２）

Tcl/Tk8.6a1 から、TclOO が標準のオブジェクトシステムとしてコアパッケージに取り込まれましたが、その TclOO を利用したサンプルプログラムを紹介します。オブジェクト指向プログラミングの利点を効果的に活用しているかというと疑問ですが、とにかくいろいろなサンプルを不定期で紹介していきたいと考えています。

サンプル・プログラム

今回は、canvas ウィジェットにマウスで曲線を描画するサンプルです。Tk 入門の canvas の説明で紹介しているサンプルを TclOO を利用したプログラムに書き換えました。

#!/bin/sh
# the next line restarts using wish \
exec wish8.6 "$0" "$@"
package require TclOO; # ビルトインパッケージなので省略可
namespace import oo::*

# ----------------------------------------------------------------------------
# クラス Draw
# ----------------------------------------------------------------------------
class create Draw {
    # ------------------------------------------------------------------------
    # コンストラクタ
    # ------------------------------------------------------------------------
    constructor {} {
        my variable conf
        set conf(color) black
        set conf(width) 1
    }

    # ------------------------------------------------------------------------
    # 設定
    # ------------------------------------------------------------------------
    method init {color {width 1}} {
        my variable conf
        set conf(color) $color
        set conf(width) $width
        return
    }

    # ------------------------------------------------------------------------
    # 描画起点の座標を取得
    # ------------------------------------------------------------------------
    method first {x y} {
        my variable conf
        set conf(x0) $x
        set conf(y0) $y
        return
    }

    # ------------------------------------------------------------------------
    # 線を描画
    # ------------------------------------------------------------------------
    method line {w x y} {
        my variable conf
        $w create line $conf(x0) $conf(y0) $x $y \
                -fill  $conf(color) \
                -width $conf(width) \
                -tags  mLine
        my first $x $y
        return
    }
}

# ----------------------------------------------------------------------------
# メイン
# ----------------------------------------------------------------------------
wm title . "canvas"

set color_bg   "#f0fff8"
set color_grid "#c0e0d0"
set color_draw "#804040"

# キャンバスの生成
set cw 200
set ch 200
canvas .can \
        -width              $cw \
        -height             $ch \
        -borderwidth        0 \
        -highlightthickness 0 \
        -background         $color_bg
pack .can

# 方眼
for {set y 0} {$y < $ch} {incr y 10} {
    .can create line 0 $y $cw $y -fill $color_grid
}
for {set x 0} {$x < $cw} {incr x 10} {
    .can create line $x 0 $x $ch -fill $color_grid
}

# クラス Draw のインスタンス pen を生成
set pen [Draw new]

# メソッド init で描画色を設定
$pen init $color_draw

# マウス左ボタンを .can 上で押した時、メソッド first で座標を取得
bind .can <Button-1> {$pen first %x %y}

# マウス左ボタンを押しながら .can 上を移動した時、メソッド line を実行
bind .can <B1-Motion> {$pen line %W %x %y}

# ---
# tkwidget_canvas_2.tcl

関連情報
[1] Tcl 入門編 - TclOO