M.Hiroi's Home Page

Tcl/Tk GUI Programming

Tcl/Tk お気楽 GUI プログラミング実用編

[ Home | Tcl/Tk | Tcl/Tk入門 ]

●TclOO の基礎知識

% oo::class create Foo
::Foo
% set a [Foo new]
::oo::Obj12
% echo $a
::oo::Obj12
% Foo create b
::b

リスト : 簡単な使用例１

oo::class create Foo {
    variable a b

    constructor {x y} {
        set a $x
        set b $y
    }

    # アクセスメソッド
    method get_a {} {
        return $a
    }
    method set_a {x} {
        set a $x
    }
    method get_b {} {
        return $b
    }
    method set_b {x} {
        set b $x
    }
}

Foo create obj1 10 20
Foo create obj2 30 40
puts [obj1 get_a]
puts [obj1 get_b]
puts [obj2 get_a]
puts [obj2 get_b]
obj1 set_a 100
obj2 set_b 400
puts [obj1 get_a]
puts [obj1 get_b]
puts [obj2 get_a]
puts [obj2 get_b]

C>tclsh oo01.tcl
10
20
30
40
100
20
30
400

% oo::class create Foo {
    variable x
    constructor {a} {
        set x $a
    }
    destructor {
        puts "destroy Foo $x"
    }
}
::Foo
% Foo create a 1
::a
% Foo create b 2
::b
% Foo create c 3
::c
% a destroy
destroy Foo 1
% Foo destroy
destroy Foo 3
destroy Foo 2

リスト : 簡単な使用例２

oo::class create Point {
    variable x y

    constructor {a b} {
        set x $a
        set y $b
    }
    method get_x {} { return $x }
    method get_y {} { return $y }

    method distance {p} {
        set dx [expr $x - [$p get_x]]
        set dy [expr $y - [$p get_y]]
        return [expr sqrt($dx * $dx + $dy * $dy)]
    }
}

oo::class create Point3d {
    variable x y z

    constructor {a b c} {
        set x $a
        set y $b
        set z $c
    }
    method get_x {} { return $x }
    method get_y {} { return $y }
    method get_z {} { return $z }

    method distance {p} {
        set dx [expr $x - [$p get_x]]
        set dy [expr $y - [$p get_y]]
        set dz [expr $z - [$p get_z]]
        return [expr sqrt($dx * $dx + $dy * $dy + $dz * $dz)]
    }
}

Point create p1 0 0
Point create p2 10 10
puts [p1 distance p2]
Point3d create p3 0 0 0
Point3d create p4 10 10 10
puts [p3 distance p4]

C>tclsh oo02.tcl
14.142135623730951
17.320508075688775

●簡単なプログラム (ワーム)

A. K. デュードニー 著「別冊 日経サイエンス コンピューターレクリエーション３ 遊びの発見」 より、 ワーム（ミミズ）のグラフィックです。本では１匹のミミズしか登場しませんが、 このプログラムではミミズを４匹に増やしました。 ミミズは円を連結しているだけの簡単なグラフィックなので、 すぐに飽きると思います。 ミミズの数を増やすとか色や形を変えるなど、プログラムを改造して遊んでみてください。

●プログラムリスト

#
# worms.tcl : ワーム
#
#             Copyright (C) 2019 Makoto Hiroi
#

# 画面の大きさ
set board_size 300

# キャンバスの生成
canvas .c0 -width $board_size -height $board_size -bg darkgray
pack .c0

# ワームの体を作る
proc make_body {color} {
    global board_size
    set body {}
    set x [expr $board_size / 2]
    for {set i 0} {$i < 25} {incr i} {
        set id [.c0 create oval $x $x [expr $x + 10] [expr $x + 10] -outline $color]
        lappend body $id
    }
    return $body
}

# ワーム
oo::class create Worm {
    variable body x y dir tail
    constructor {color} {
        global board_size
        set body [make_body $color]
        set x [expr $board_size / 2]
        set y [expr $board_size / 2]
        set dir 0
        set tail 0
    }

    method move_worm {} {
        global board_size
        set tail [expr ($tail + 1) % 25]
        if {[expr rand()] > 0.5} {
            set dir [expr $dir + 0.18]
        } else {
            set dir [expr $dir - 0.18]
        }
        set x [expr $x + sin($dir) * 4]
        if {$x < 0} {
            set x [expr $x + $board_size]
        } elseif {$x >= $board_size} {
            set x [expr $x - $board_size]
        }
        set y [expr $y + cos($dir) * 4]
        if {$y < 0.0} {
            set y [expr $y + $board_size]
        } elseif {$y >= $board_size} {
            set y [expr $y - $board_size]
        }
        .c0 coords [lindex $body $tail] $x $y [expr $x + 10] [expr $y + 10]
    }
}

# ミミズの生成
Worm create worm1 red
Worm create worm2 blue
Worm create worm3 yellow
Worm create worm4 green

# 表示
proc show_worm {} {
    worm1 move_worm
    worm2 move_worm
    worm3 move_worm
    worm4 move_worm
    after 40 show_worm
}

# 実行
show_worm

●継承

リスト : 単一継承

oo::class create Foo {
    variable a b

    constructor {x y} {
        set a $x
        set b $y
    }

    # アクセスメソッド
    method get_a {} {
        return $a
    }
    method set_a {x} {
        set a $x
    }
    method get_b {} {
        return $b
    }
    method set_b {x} {
        set b $x
    }
}

oo::class create Bar {
    superclass Foo
    variable c

    constructor {x y z} {
        next $x $y
        set c $z
    }

    # アクセスメソッド
    method get_c {} {
        return $c
    }
    method set_c {x} {
        set c $x
    }
}

Foo create a 10 20
puts [a get_a]
puts [a get_b]
Bar create b 1 2 3
puts [b get_a]
puts [b get_b]
puts [b get_c]

10
20
1
2
3

% oo::class create Bar1 {
    superclass Foo
    variable a b
    method get_c {} {
        return [expr $a + $b]
    }
}
::Bar1
% Bar1 create c 100 200
::c
% c get_c
300

●多重継承

リスト : Mix-in の簡単な例題

oo::class create Foo {
    variable x
    constructor {a} {
        set x $a
    }
    method foo {} {
        puts "Foo::foo $x"
    }
}

oo::class create Bar {
    method bar_1 {} {
        puts "bar_1 !"
    }
    method bar_2 {} {
        puts "bar_2 !!"
    }
}

oo::class create Baz {
    superclass Foo
    mixin Bar
    method foo {} {
        next
        puts "Baz::foo"
    }
}

Baz create b 100
b foo
b bar_1
b bar_2

Foo::foo 100
Baz::foo
bar_1 !
bar_2 !!
----- 参考文献 -----
Patrick Henry Winston, Berthold Klaus Paul Horn, 『LISP 原書第 3 版 (1) (2)』, 培風館, 1992

●データ型の継承

% oo::class create Foo
::Foo
% oo::class create Bar {
superclass Foo
}
::Bar
% oo::class create Baz {
superclass Bar
}
::Baz
% Foo create a
::a
% Bar create b
::b
% Baz create c
::c
% info object isa typeof a Foo
1
% info object isa typeof a Bar
0
% info object isa typeof b Foo
1
% info object isa typeof b Bar
1
% info object isa typeof b Baz
0
% info object isa typeof c Foo
1
% info object isa typeof c Bar
1
% info object isa typeof c Baz
1


  図 : クラスとサブクラスの関係

●特異メソッド

% oo::class create Foo
::Foo
% Foo create a
::a
% Foo create b
::b
% oo::objdefine a {
    method bar {} {
        puts "bar!!"
    }
}
% a bar
bar!!
% b bar
unknown method "bar": must be destroy

% oo::class create Foo
::Foo
% oo::objdefine Foo {
    variable x
    method get_x {} {
        return $x
    }
    method set_x {a} {
        set x $a
    }
}
% Foo set_x 10
10
% Foo get_x
10
% Foo create a
::a
% a get_x
unknown method "get_x": must be destroy

% oo::define Foo {
    method get_x {} {
        return [[self class] get_x]
    }
    method set_x {a} {
        [self class] set_x $a
    }
}
% Foo set_x 1
1
% Foo get_x
1
% Foo create a
::a
% a get_x
1
% a set_x 10
10
% Foo create b
::b
% b get_x
10
% b set_x 100
100
% a get_x
100
% Foo get_x
100

●export と unexport

% oo::class create Foo {
    method foo {} {
        puts "foo!!"
    }
    method bar {} {
        my foo
        puts "bar!!"
    }
}
::Foo
% Foo create a
::a
% a foo
foo!!
% a bar
foo!!
bar!!

% oo::define Foo {
    unexport foo
}
% a foo
unknown method "foo": must be bar or destroy
% a bar
foo!!
bar!!

% oo::define Foo {
    export foo
}
% a foo
foo!!
Copyright (C) 2019 Makoto Hiroi
All rights reserved.
[ Home | Tcl/Tk | Tcl/Tk入門 ]