Fresh start

11 files changed, 1400 insertions, 0 deletions

diff --git a/jni/ruby/ext/tk/sample/tcltklib/batsu.gif b/jni/ruby/ext/tk/sample/tcltklib/batsu.gif
new file mode 100644
index 0000000..880cc73
--- /dev/null
+++ b/jni/ruby/ext/tk/sample/tcltklib/batsu.gif
diff --git a/jni/ruby/ext/tk/sample/tcltklib/lines0.tcl b/jni/ruby/ext/tk/sample/tcltklib/lines0.tcl
new file mode 100644
index 0000000..8ed3c5e
--- /dev/null
+++ b/jni/ruby/ext/tk/sample/tcltklib/lines0.tcl
@@ -0,0 +1,42 @@
+#! /usr/local/bin/wish
+
+proc drawlines {} {
+    puts [clock format [clock seconds]]
+
+    for {set j 0} {$j < 100} {incr j} {
+	puts -nonewline "*"
+	flush stdout
+	if {$j & 1} {
+	    set c "blue"
+	} {
+	    set c "red"
+	}
+	for {set i 0} {$i < 100} {incr i} {
+#	    .a create line $i 0 0 [expr 500 - $i] -fill $c
+	}
+    }
+
+    puts [clock format [clock seconds]]
+
+    for {set j 0} {$j < 100} {incr j} {
+	puts -nonewline "*"
+	flush stdout
+	if {$j & 1} {
+	    set c "blue"
+	} {
+	    set c "red"
+	}
+	for {set i 0} {$i < 100} {incr i} {
+	    .a create line $i 0 0 [expr 500 - $i] -fill $c
+	}
+    }
+
+    puts [clock format [clock seconds]]
+#    destroy .
+}
+
+canvas .a -height 500 -width 500
+button .b -text draw -command drawlines
+pack .a .b -side left
+
+# eof
diff --git a/jni/ruby/ext/tk/sample/tcltklib/lines1.rb b/jni/ruby/ext/tk/sample/tcltklib/lines1.rb
new file mode 100644
index 0000000..9f21ae6
--- /dev/null
+++ b/jni/ruby/ext/tk/sample/tcltklib/lines1.rb
@@ -0,0 +1,50 @@
+#! /usr/local/bin/ruby
+
+require "tcltk"
+
+def drawlines()
+  print Time.now, "\n"
+
+  for j in 0 .. 99
+    print "*"
+    $stdout.flush
+    if (j & 1) != 0
+      col = "blue"
+    else
+      col = "red"
+    end
+    for i in 0 .. 99
+#      $a.e("create line", i, 0, 0, 500 - i, "-fill", col)
+    end
+  end
+
+  print Time.now, "\n"
+
+  for j in 0 .. 99
+    print "*"
+    $stdout.flush
+    if (j & 1) != 0
+      col = "blue"
+    else
+      col = "red"
+    end
+    for i in 0 .. 99
+      $a.e("create line", i, 0, 0, 500 - i, "-fill", col)
+    end
+  end
+
+  print Time.now, "\n"
+#  $ip.commands()["destroy"].e($root)
+end
+
+$ip = TclTkInterpreter.new()
+$root = $ip.rootwidget()
+$a = TclTkWidget.new($ip, $root, "canvas", "-height 500 -width 500")
+$c = TclTkCallback.new($ip, proc{drawlines()})
+$b = TclTkWidget.new($ip, $root, "button", "-text draw -command", $c)
+
+$ip.commands()["pack"].e($a, $b, "-side left")
+
+TclTk.mainloop
+
+# eof
diff --git a/jni/ruby/ext/tk/sample/tcltklib/lines2.rb b/jni/ruby/ext/tk/sample/tcltklib/lines2.rb
new file mode 100644
index 0000000..e459589
--- /dev/null
+++ b/jni/ruby/ext/tk/sample/tcltklib/lines2.rb
@@ -0,0 +1,54 @@
+#! /usr/local/bin/ruby
+
+require "tk"
+
+def drawlines()
+  print Time.now, "\n"
+
+  for j in 0 .. 99
+    print "*"
+    $stdout.flush
+    if (j & 1) != 0
+      col = "blue"
+    else
+      col = "red"
+    end
+    for i in 0 .. 99
+#      TkcLine.new($a, i, 0, 0, 500 - i, "-fill", col)
+    end
+  end
+
+  print Time.now, "\n"
+
+  for j in 0 .. 99
+    print "*"
+    $stdout.flush
+    if (j & 1) != 0
+      col = "blue"
+    else
+      col = "red"
+    end
+    for i in 0 .. 99
+      TkcLine.new($a, i, 0, 0, 500 - i, "-fill", col)
+    end
+  end
+
+  print Time.now, "\n"
+#  Tk.root.destroy
+end
+
+$a = TkCanvas.new{
+  height(500)
+  width(500)
+}
+
+$b = TkButton.new{
+  text("draw")
+  command(proc{drawlines()})
+}
+
+TkPack.configure($a, $b, {"side"=>"left"})
+
+Tk.mainloop
+
+# eof
diff --git a/jni/ruby/ext/tk/sample/tcltklib/lines3.rb b/jni/ruby/ext/tk/sample/tcltklib/lines3.rb
new file mode 100644
index 0000000..caa50f9
--- /dev/null
+++ b/jni/ruby/ext/tk/sample/tcltklib/lines3.rb
@@ -0,0 +1,54 @@
+#! /usr/local/bin/ruby
+
+require "tk"
+
+def drawlines()
+  print Time.now, "\n"
+
+  for j in 0 .. 99
+    print "*"
+    $stdout.flush
+    if (j & 1) != 0
+      col = "blue"
+    else
+      col = "red"
+    end
+    for i in 0 .. 99
+#      $a.create(TkcLine, i, 0, 0, 500 - i, "fill"=>col)
+    end
+  end
+
+  print Time.now, "\n"
+
+  for j in 0 .. 99
+    print "*"
+    $stdout.flush
+    if (j & 1) != 0
+      col = "blue"
+    else
+      col = "red"
+    end
+    for i in 0 .. 99
+      $a.create(TkcLine, i, 0, 0, 500 - i, "fill"=>col)
+    end
+  end
+
+  print Time.now, "\n"
+#  Tk.root.destroy
+end
+
+$a = TkCanvas.new{
+  height(500)
+  width(500)
+}
+
+$b = TkButton.new{
+  text("draw")
+  command(proc{drawlines()})
+}
+
+TkPack.configure($a, $b, {"side"=>"left"})
+
+Tk.mainloop
+
+# eof
diff --git a/jni/ruby/ext/tk/sample/tcltklib/lines4.rb b/jni/ruby/ext/tk/sample/tcltklib/lines4.rb
new file mode 100644
index 0000000..7a1175b
--- /dev/null
+++ b/jni/ruby/ext/tk/sample/tcltklib/lines4.rb
@@ -0,0 +1,54 @@
+#! /usr/local/bin/ruby
+
+require "tk"
+
+def drawlines()
+  print Time.now, "\n"
+
+  for j in 0 .. 99
+    print "*"
+    $stdout.flush
+    if (j & 1) != 0
+      col = "blue"
+    else
+      col = "red"
+    end
+    for i in 0 .. 99
+#      TkCore::INTERP.__invoke($a.path, "create", "line", i.to_s, '0', '0', (500 - i).to_s, "-fill", col)
+    end
+  end
+
+  print Time.now, "\n"
+
+  for j in 0 .. 99
+    print "*"
+    $stdout.flush
+    if (j & 1) != 0
+      col = "blue"
+    else
+      col = "red"
+    end
+    for i in 0 .. 99
+      TkCore::INTERP.__invoke($a.path, "create", "line", i.to_s, '0', '0', (500 - i).to_s, "-fill", col)
+    end
+  end
+
+  print Time.now, "\n"
+#  Tk.root.destroy
+end
+
+$a = TkCanvas.new{
+  height(500)
+  width(500)
+}
+
+$b = TkButton.new{
+  text("draw")
+  command(proc{drawlines()})
+}
+
+TkPack.configure($a, $b, {"side"=>"left"})
+
+Tk.mainloop
+
+# eof
diff --git a/jni/ruby/ext/tk/sample/tcltklib/maru.gif b/jni/ruby/ext/tk/sample/tcltklib/maru.gif
new file mode 100644
index 0000000..2c02028
--- /dev/null
+++ b/jni/ruby/ext/tk/sample/tcltklib/maru.gif
diff --git a/jni/ruby/ext/tk/sample/tcltklib/safeTk.rb b/jni/ruby/ext/tk/sample/tcltklib/safeTk.rb
new file mode 100644
index 0000000..5d2c60e
--- /dev/null
+++ b/jni/ruby/ext/tk/sample/tcltklib/safeTk.rb
@@ -0,0 +1,22 @@
+#!/usr/bin/env ruby
+require 'tcltklib'
+
+master = TclTkIp.new
+slave_name = 'slave0'
+slave = master.create_slave(slave_name, true)
+master._eval("::safe::interpInit #{slave_name}")
+master._eval("::safe::loadTk #{slave_name}")
+
+master._invoke('label', '.l1', '-text', 'master')
+master._invoke('pack', '.l1', '-padx', '30', '-pady', '50')
+master._eval('label .l2 -text {root widget of master-ip}')
+master._eval('pack .l2 -padx 30 -pady 50')
+
+slave._invoke('label', '.l1', '-text', 'slave')
+slave._invoke('pack', '.l1', '-padx', '30', '-pady', '50')
+slave._eval('label .l2 -text {root widget of slave-ip}')
+slave._eval('pack .l2 -padx 30 -pady 20')
+slave._eval('label .l3 -text {( container frame widget of master-ip )}')
+slave._eval('pack .l3 -padx 30 -pady 20')
+
+TclTkLib.mainloop
diff --git a/jni/ruby/ext/tk/sample/tcltklib/sample0.rb b/jni/ruby/ext/tk/sample/tcltklib/sample0.rb
new file mode 100644
index 0000000..0ac303a
--- /dev/null
+++ b/jni/ruby/ext/tk/sample/tcltklib/sample0.rb
@@ -0,0 +1,39 @@
+#! /usr/local/bin/ruby -vd
+
+# tcltklib ライブラリのテスト
+
+require "tcltklib"
+
+def test
+  # インタプリタを生成する
+  ip1 = TclTkIp.new()
+
+  # 評価してみる
+  print ip1._return_value().inspect, "\n"
+  print ip1._eval("puts {abc}").inspect, "\n"
+
+  # ボタンを作ってみる
+  print ip1._return_value().inspect, "\n"
+  print ip1._eval("button .lab -text exit -command \"destroy .\"").inspect,
+    "\n"
+  print ip1._return_value().inspect, "\n"
+  print ip1._eval("pack .lab").inspect, "\n"
+  print ip1._return_value().inspect, "\n"
+
+  # インタプリタから ruby コマンドを評価してみる
+#  print ip1._eval(%q/ruby {print "print by ruby\n"}/).inspect, "\n"
+  print ip1._eval(%q+puts [ruby {print "print by ruby\n"; "puts by tcl/tk"}]+).inspect, "\n"
+  print ip1._return_value().inspect, "\n"
+
+  # もう一つインタプリタを生成してみる
+  ip2 = TclTkIp.new()
+  ip2._eval("button .lab -text test -command \"puts test ; destroy .\"")
+  ip2._eval("pack .lab")
+
+  TclTkLib.mainloop
+end
+
+test
+GC.start
+
+print "exit\n"
diff --git a/jni/ruby/ext/tk/sample/tcltklib/sample1.rb b/jni/ruby/ext/tk/sample/tcltklib/sample1.rb
new file mode 100644
index 0000000..3235edf
--- /dev/null
+++ b/jni/ruby/ext/tk/sample/tcltklib/sample1.rb
@@ -0,0 +1,634 @@
+#! /usr/local/bin/ruby -d
+# -*- encoding: utf-8 -*-
+# -d オプションを付けると, デバッグ情報を表示する.
+
+# tcltk ライブラリのサンプル
+
+# まず, ライブラリを require する.
+require "tcltk"
+
+# 以下は, Test1 のインスタンスの initialize() で,
+# tcl/tk に関する処理を行う例である.
+# 必ずしもそのようにする必要は無く,
+# (もし, そうしたければ) class の外で tcl/tk に関する処理を行っても良い.
+
+class Test1
+  # 初期化(インタプリタを生成してウィジェットを生成する).
+  def initialize()
+
+    #### 使う前のおまじない
+
+    # インタプリタの生成.
+    ip = TclTkInterpreter.new()
+    # コマンドに対応するオブジェクトを c に設定しておく.
+    c = ip.commands()
+    # 使用するコマンドに対応するオブジェクトは変数に入れておく.
+    append, bind, button, destroy, incr, info, label, place, set, wm =
+      c.values_at(
+      "append", "bind", "button", "destroy", "incr", "info", "label", "place",
+      "set", "wm")
+
+    #### tcl/tk のコマンドに対応するオブジェクト(TclTkCommand)の操作
+
+    # 実行する時は, e() メソッドを使う.
+    # (以下は, tcl/tk における info command r* を実行.)
+    print info.e("command", "r*"), "\n"
+    # 引数は, まとめた文字列にしても同じ.
+    print info.e("command r*"), "\n"
+    # 変数を用いなくとも実行できるが, 見ためが悪い.
+    print c["info"].e("command", "r*"), "\n"
+    # インタプリタのメソッドとしても実行できるが, 効率が悪い.
+    print ip.info("command", "r*"), "\n"
+
+    ####
+
+    # 以下, 生成したオブジェクトは変数に代入しておかないと
+    # GC の対象になってしまう.
+
+    #### tcl/tk の変数に対応するオブジェクト(TclTkVariable)の操作
+
+    # 生成と同時に値を設定する.
+    v1 = TclTkVariable.new(ip, "20")
+    # 読み出しは get メソッドを使う.
+    print v1.get(), "\n"
+    # 設定は set メソッドを使う.
+    v1.set(40)
+    print v1.get(), "\n"
+    # set コマンドを使って読み出し, 設定は可能だが見ためが悪い.
+    # e() メソッド等の引数に直接 TclTkObject や数値を書いても良い.
+    set.e(v1, 30)
+    print set.e(v1), "\n"
+    # tcl/tk のコマンドで変数を操作できる.
+    incr.e(v1)
+    print v1.get(), "\n"
+    append.e(v1, 10)
+    print v1.get(), "\n"
+
+    #### tcl/tk のウィジェットに対応するオブジェクト(TclTkWidget)の操作
+
+    # ルートウィジェットを取り出す.
+    root = ip.rootwidget()
+    # ウィジェットの操作.
+    root.e("configure -height 300 -width 300")
+    # タイトルを付けるときは wm を使う.
+    wm.e("title", root, $0)
+    # 親ウィジェットとコマンドを指定して, ウィジェットを作る.
+    l1 = TclTkWidget.new(ip, root, label, "-text {type `x' to print}")
+    # place すると表示される.
+    place.e(l1, "-x 0 -rely 0.0 -relwidth 1 -relheight 0.1")
+    # コマンド名は文字列で指定しても良いが, 見ためが悪い.
+    # (コマンド名は独立した引数でなければならない.)
+    l2 = TclTkWidget.new(ip, root, "label")
+    # ウィジェットの操作.
+    l2.e("configure -text {type `q' to exit}")
+    place.e(l2, "-x 0 -rely 0.1 -relwidth 1 -relheight 0.1")
+
+    #### tcl/tk のコールバックに対応するオブジェクト(TclTkCallback)の操作
+
+    # コールバックを生成する.
+    c1 = TclTkCallback.new(ip, proc{sample(ip, root)})
+    # コールバックを持つウィジェットを生成する.
+    b1 = TclTkWidget.new(ip, root, button, "-text sample -command", c1)
+    place.e(b1, "-x 0 -rely 0.2 -relwidth 1 -relheight 0.1")
+    # イベントループを抜けるには destroy.e(root) する.
+    c2 = TclTkCallback.new(ip, proc{destroy.e(root)})
+    b2 = TclTkWidget.new(ip, root, button, "-text exit -command", c2)
+    place.e(b2, "-x 0 -rely 0.3 -relwidth 1 -relheight 0.1")
+
+    #### イベントのバインド
+    # script の追加 (bind tag sequence +script) は今のところできない.
+    # (イテレータ変数の設定がうまくいかない.)
+
+    # 基本的にはウィジェットに対するコールバックと同じ.
+    c3 = TclTkCallback.new(ip, proc{print("q pressed\n"); destroy.e(root)})
+    bind.e(root, "q", c3)
+    # bind コマンドで % 置換によりパラメータを受け取りたいときは,
+    # proc{} の後ろに文字列で指定すると,
+    # 置換結果をイテレータ変数を通して受け取ることができる.
+    # ただし proc{} の後ろの文字列は,
+    # bind コマンドに与えるコールバック以外で指定してはいけない.
+    c4 = TclTkCallback.new(ip, proc{|i| print("#{i} pressed\n")}, "%A")
+    bind.e(root, "x", c4)
+    # TclTkCallback を GC の対象にしたければ,
+    # dcb() (または deletecallbackkeys()) する必要がある.
+    cb = [c1, c2, c3, c4]
+    c5 = TclTkCallback.new(ip, proc{|w| TclTk.dcb(cb, root, w)}, "%W")
+    bind.e(root, "<Destroy>", c5)
+    cb.push(c5)
+
+    #### tcl/tk のイメージに対応するオブジェクト(TclTkImage)の操作
+
+    # データを指定して生成する.
+    i1 = TclTkImage.new(ip, "photo", "-file maru.gif")
+    # ラベルに張り付けてみる.
+    l3 = TclTkWidget.new(ip, root, label, "-relief raised -image", i1)
+    place.e(l3, "-x 0 -rely 0.4 -relwidth 0.2 -relheight 0.2")
+    # 空のイメージを生成して後で操作する.
+    i2 = TclTkImage.new(ip, "photo")
+    # イメージを操作する.
+    i2.e("copy", i1)
+    i2.e("configure -gamma 0.5")
+    l4 = TclTkWidget.new(ip, root, label, "-relief raised -image", i2)
+    place.e(l4, "-relx 0.2 -rely 0.4 -relwidth 0.2 -relheight 0.2")
+
+    ####
+  end
+
+  # サンプルのためのウィジェットを生成する.
+  def sample(ip, parent)
+    bind, button, destroy, grid, toplevel, wm = ip.commands().values_at(
+      "bind", "button", "destroy", "grid", "toplevel", "wm")
+
+    ## toplevel
+
+    # 新しいウインドウを開くには, toplevel を使う.
+    t1 = TclTkWidget.new(ip, parent, toplevel)
+    # タイトルを付けておく
+    wm.e("title", t1, "sample")
+
+    # ウィジェットが破壊されたとき, コールバックが GC の対象になるようにする.
+    cb = []
+    cb.push(c = TclTkCallback.new(ip, proc{|w| TclTk.dcb(cb, t1, w)}, "%W"))
+    bind.e(t1, "<Destroy>", c)
+
+    # ボタンの生成.
+    wid = []
+    # toplevel ウィジェットを破壊するには destroy する.
+    cb.push(c = TclTkCallback.new(ip, proc{destroy.e(t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text close -command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_label(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text label -command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_button(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text button -command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_checkbutton(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text checkbutton -command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_radiobutton(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text radiobutton -command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_scale(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text scale -command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_entry(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text entry -command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_text(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text text -command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_raise(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text raise/lower -command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_modal(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text message/modal -command",
+      c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_menu(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text menu -command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_listbox(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text listbox/scrollbar",
+      "-command", c))
+    cb.push(c = TclTkCallback.new(ip, proc{test_canvas(ip, t1)}))
+    wid.push(TclTkWidget.new(ip, t1, button, "-text canvas -command", c))
+
+    # grid で表示する.
+    ro = co = 0
+    wid.each{|w|
+      grid.e(w, "-row", ro, "-column", co, "-sticky news")
+      ro += 1
+      if ro == 7
+        ro = 0
+        co += 1
+      end
+    }
+  end
+
+  # inittoplevel(ip, parent, title)
+  #   以下の処理をまとめて行う.
+  #       1. toplevel ウィジェットを作成する.
+  #       2. コールバックを登録する配列を用意し, toplevel ウィジェットの
+  #         <Destroy> イベントにコールバックを削除する手続きを登録する.
+  #       3. クローズボタンを作る.
+  #     作成した toplevel ウィジェット, クローズボタン, コールバック登録用変数
+  #     を返す.
+  #   ip: インタプリタ
+  #   parent: 親ウィジェット
+  #   title: toplevel ウィジェットのウインドウのタイトル
+  def inittoplevel(ip, parent, title)
+    bind, button, destroy, toplevel, wm = ip.commands().values_at(
+      "bind", "button", "destroy", "toplevel", "wm")
+
+    # 新しいウインドウを開くには, toplevel を使う.
+    t1 = TclTkWidget.new(ip, parent, toplevel)
+    # タイトルを付けておく
+    wm.e("title", t1, title)
+
+    # ウィジェットが破壊されたとき, コールバックが GC の対象になるようにする.
+    cb = []
+    cb.push(c = TclTkCallback.new(ip, proc{|w| TclTk.dcb(cb, t1, w)}, "%W"))
+    bind.e(t1, "<Destroy>", c)
+    # close ボタンを作っておく.
+    # toplevel ウィジェットを破壊するには destroy する.
+    cb.push(c = TclTkCallback.new(ip, proc{destroy.e(t1)}))
+    b1 = TclTkWidget.new(ip, t1, button, "-text close -command", c)
+
+    return t1, b1, cb
+  end
+
+  # label のサンプル.
+  def test_label(ip, parent)
+    button, global, label, pack = ip.commands().values_at(
+      "button", "global", "label", "pack")
+    t1, b1, cb = inittoplevel(ip, parent, "label")
+
+    ## label
+
+    # いろいろな形のラベル.
+    l1 = TclTkWidget.new(ip, t1, label, "-text {default(flat)}")
+    l2 = TclTkWidget.new(ip, t1, label, "-text raised -relief raised")
+    l3 = TclTkWidget.new(ip, t1, label, "-text sunken -relief sunken")
+    l4 = TclTkWidget.new(ip, t1, label, "-text groove -relief groove")
+    l5 = TclTkWidget.new(ip, t1, label, "-text ridge -relief ridge")
+    l6 = TclTkWidget.new(ip, t1, label, "-bitmap error")
+    l7 = TclTkWidget.new(ip, t1, label, "-bitmap questhead")
+
+    # pack しても表示される.
+    pack.e(b1, l1, l2, l3, l4, l5, l6, l7, "-pady 3")
+
+    ## -textvariable
+
+    # tcltk ライブラリの実装では, コールバックは tcl/tk の``手続き''を通して
+    # 呼ばれる. したがって, コールバックの中で(大域)変数にアクセスするときは,
+    # global する必要がある.
+    # global する前に変数に値を設定してしまうとエラーになるので,
+    # tcl/tk における表現形だけ生成して, 実際に値を設定しないように,
+    # 2 番目の引数には nil を与える.
+    v1 = TclTkVariable.new(ip, nil)
+    global.e(v1)
+    v1.set(100)
+    # -textvariable で変数を設定する.
+    l6 = TclTkWidget.new(ip, t1, label, "-textvariable", v1)
+    # コールバックの中から変数を操作する.
+    cb.push(c = TclTkCallback.new(ip, proc{
+      global.e(v1); v1.set(v1.get().to_i + 10)}))
+    b2 = TclTkWidget.new(ip, t1, button, "-text +10 -command", c)
+    cb.push(c = TclTkCallback.new(ip, proc{
+      global.e(v1); v1.set(v1.get().to_i - 10)}))
+    b3 = TclTkWidget.new(ip, t1, button, "-text -10 -command", c)
+    pack.e(l6, b2, b3)
+  end
+
+  # button のサンプル.
+  def test_button(ip, parent)
+    button, pack = ip.commands().values_at("button", "pack")
+    t1, b1, cb = inittoplevel(ip, parent, "button")
+
+    ## button
+
+    # コールバック内で参照する変数は先に宣言しておかなければならない.
+    b3 = b4 = nil
+    cb.push(c = TclTkCallback.new(ip, proc{b3.e("flash"); b4.e("flash")}))
+    b2 = TclTkWidget.new(ip, t1, button, "-text flash -command", c)
+    cb.push(c = TclTkCallback.new(ip, proc{b2.e("configure -state normal")}))
+    b3 = TclTkWidget.new(ip, t1, button, "-text normal -command", c)
+    cb.push(c = TclTkCallback.new(ip, proc{b2.e("configure -state disabled")}))
+    b4 = TclTkWidget.new(ip, t1, button, "-text disable -command", c)
+    pack.e(b1, b2, b3, b4)
+  end
+
+  # checkbutton のサンプル.
+  def test_checkbutton(ip, parent)
+    checkbutton, global, pack = ip.commands().values_at(
+      "checkbutton", "global", "pack")
+    t1, b1, cb = inittoplevel(ip, parent, "checkbutton")
+
+    ## checkbutton
+
+    v1 = TclTkVariable.new(ip, nil)
+    global.e(v1)
+    # -variable で変数を設定する.
+    ch1 = TclTkWidget.new(ip, t1, checkbutton, "-onvalue on -offvalue off",
+      "-textvariable", v1, "-variable", v1)
+    pack.e(b1, ch1)
+  end
+
+  # radiobutton のサンプル.
+  def test_radiobutton(ip, parent)
+    global, label, pack, radiobutton = ip.commands().values_at(
+      "global", "label", "pack", "radiobutton")
+    t1, b1, cb = inittoplevel(ip, parent, "radiobutton")
+
+    ## radiobutton
+
+    v1 = TclTkVariable.new(ip, nil)
+    global.e(v1)
+    # ヌルストリングは "{}" で指定する.
+    v1.set("{}")
+    l1 = TclTkWidget.new(ip, t1, label, "-textvariable", v1)
+    # -variable で同じ変数を指定すると同じグループになる.
+    ra1 = TclTkWidget.new(ip, t1, radiobutton,
+      "-text radio1 -value r1 -variable", v1)
+    ra2 = TclTkWidget.new(ip, t1, radiobutton,
+      "-text radio2 -value r2 -variable", v1)
+    cb.push(c = TclTkCallback.new(ip, proc{global.e(v1); v1.set("{}")}))
+    ra3 = TclTkWidget.new(ip, t1, radiobutton,
+      "-text clear -value r3 -variable", v1, "-command", c)
+    pack.e(b1, l1, ra1, ra2, ra3)
+  end
+
+  # scale のサンプル.
+  def test_scale(ip, parent)
+    global, pack, scale = ip.commands().values_at(
+      "global", "pack", "scale")
+    t1, b1, cb = inittoplevel(ip, parent, "scale")
+
+    ## scale
+
+    v1 = TclTkVariable.new(ip, nil)
+    global.e(v1)
+    v1.set(219)
+    # コールバック内で参照する変数は先に宣言しておかなければならない.
+    sca1 = nil
+    cb.push(c = TclTkCallback.new(ip, proc{global.e(v1); v = v1.get();
+      sca1.e("configure -background", format("#%02x%02x%02x", v, v, v))}))
+    sca1 = TclTkWidget.new(ip, t1, scale,
+      "-label scale -orient h -from 0 -to 255 -variable", v1, "-command", c)
+    pack.e(b1, sca1)
+  end
+
+  # entry のサンプル.
+  def test_entry(ip, parent)
+    button, entry, global, pack = ip.commands().values_at(
+      "button", "entry", "global", "pack")
+    t1, b1, cb = inittoplevel(ip, parent, "entry")
+
+    ## entry
+
+    v1 = TclTkVariable.new(ip, nil)
+    global.e(v1)
+    # ヌルストリングは "{}" で指定する.
+    v1.set("{}")
+    en1 = TclTkWidget.new(ip, t1, entry, "-textvariable", v1)
+    cb.push(c = TclTkCallback.new(ip, proc{
+      global.e(v1); print(v1.get(), "\n"); v1.set("{}")}))
+    b2 = TclTkWidget.new(ip, t1, button, "-text print -command", c)
+    pack.e(b1, en1, b2)
+  end
+
+  # text のサンプル.
+  def test_text(ip, parent)
+    button, pack, text = ip.commands().values_at(
+      "button", "pack", "text")
+    t1, b1, cb = inittoplevel(ip, parent, "text")
+
+    ## text
+
+    te1 = TclTkWidget.new(ip, t1, text)
+    cb.push(c = TclTkCallback.new(ip, proc{
+      # 1 行目の 0 文字目から最後までを表示し, 削除する.
+      print(te1.e("get 1.0 end")); te1.e("delete 1.0 end")}))
+    b2 = TclTkWidget.new(ip, t1, button, "-text print -command", c)
+    pack.e(b1, te1, b2)
+  end
+
+  # raise/lower のサンプル.
+  def test_raise(ip, parent)
+    button, frame, lower, pack, raise = ip.commands().values_at(
+      "button", "frame", "lower", "pack", "raise")
+    t1, b1, cb = inittoplevel(ip, parent, "raise/lower")
+
+    ## raise/lower
+
+    # button を隠すテストのために, frame を使う.
+    f1 = TclTkWidget.new(ip, t1, frame)
+    # コールバック内で参照する変数は先に宣言しておかなければならない.
+    b2 = nil
+    cb.push(c = TclTkCallback.new(ip, proc{raise.e(f1, b2)}))
+    b2 = TclTkWidget.new(ip, t1, button, "-text raise -command", c)
+    cb.push(c = TclTkCallback.new(ip, proc{lower.e(f1, b2)}))
+    b3 = TclTkWidget.new(ip, t1, button, "-text lower -command", c)
+    lower.e(f1, b3)
+
+    pack.e(b2, b3, "-in", f1)
+    pack.e(b1, f1)
+  end
+
+  # modal なウィジェットのサンプル.
+  def test_modal(ip, parent)
+    button, frame, message, pack, tk_chooseColor, tk_getOpenFile,
+      tk_messageBox = ip.commands().values_at(
+      "button", "frame", "message", "pack", "tk_chooseColor",
+      "tk_getOpenFile", "tk_messageBox")
+    # 最初に load されていないライブラリは ip.commands() に存在しないので,
+    # TclTkLibCommand を生成する必要がある.
+    tk_dialog = TclTkLibCommand.new(ip, "tk_dialog")
+    t1, b1, cb = inittoplevel(ip, parent, "message/modal")
+
+    ## message
+
+    mes = "これは message ウィジェットのテストです."
+    mes += "以下は modal なウィジェットのテストです."
+    me1 = TclTkWidget.new(ip, t1, message, "-text {#{mes}}")
+
+    ## modal
+
+    # tk_messageBox
+    cb.push(c = TclTkCallback.new(ip, proc{
+      print tk_messageBox.e("-type yesnocancel -message messageBox",
+      "-icon error -default cancel -title messageBox"), "\n"}))
+    b2 = TclTkWidget.new(ip, t1, button, "-text messageBox -command", c)
+    # tk_dialog
+    cb.push(c = TclTkCallback.new(ip, proc{
+      # ウィジェット名を生成するためにダミーの frame を生成.
+      print tk_dialog.e(TclTkWidget.new(ip, t1, frame),
+      "dialog dialog error 2 yes no cancel"), "\n"}))
+    b3 = TclTkWidget.new(ip, t1, button, "-text dialog -command", c)
+    # tk_chooseColor
+    cb.push(c = TclTkCallback.new(ip, proc{
+      print tk_chooseColor.e("-title chooseColor"), "\n"}))
+    b4 = TclTkWidget.new(ip, t1, button, "-text chooseColor -command", c)
+    # tk_getOpenFile
+    cb.push(c = TclTkCallback.new(ip, proc{
+      print tk_getOpenFile.e("-defaultextension .rb",
+      "-filetypes {{{Ruby Script} {.rb}} {{All Files} {*}}}",
+      "-title getOpenFile"), "\n"}))
+    b5 = TclTkWidget.new(ip, t1, button, "-text getOpenFile -command", c)
+
+    pack.e(b1, me1, b2, b3, b4, b5)
+  end
+
+  # menu のサンプル.
+  def test_menu(ip, parent)
+    global, menu, menubutton, pack = ip.commands().values_at(
+      "global", "menu", "menubutton", "pack")
+    tk_optionMenu = TclTkLibCommand.new(ip, "tk_optionMenu")
+    t1, b1, cb = inittoplevel(ip, parent, "menu")
+
+    ## menu
+
+    # menubutton を生成する.
+    mb1 = TclTkWidget.new(ip, t1, menubutton, "-text menu")
+    # menu を生成する.
+    me1 = TclTkWidget.new(ip, mb1, menu)
+    # mb1 から me1 が起動されるようにする.
+    mb1.e("configure -menu", me1)
+
+    # cascade で起動される menu を生成する.
+    me11 = TclTkWidget.new(ip, me1, menu)
+    # radiobutton のサンプル.
+    v1 = TclTkVariable.new(ip, nil); global.e(v1); v1.set("r1")
+    me11.e("add radiobutton -label radio1 -value r1 -variable", v1)
+    me11.e("add radiobutton -label radio2 -value r2 -variable", v1)
+    me11.e("add radiobutton -label radio3 -value r3 -variable", v1)
+    # cascade により mb11 が起動されるようにする.
+    me1.e("add cascade -label cascade -menu", me11)
+
+    # checkbutton のサンプル.
+    v2 = TclTkVariable.new(ip, nil); global.e(v2); v2.set("none")
+    me1.e("add checkbutton -label check -variable", v2)
+    # separator のサンプル.
+    me1.e("add separator")
+    # command のサンプル.
+    v3 = nil
+    cb.push(c = TclTkCallback.new(ip, proc{
+      global.e(v1, v2, v3); print "v1: ", v1.get(), ", v2: ", v2.get(),
+      ", v3: ", v3.get(), "\n"}))
+    me1.e("add command -label print -command", c)
+
+    ## tk_optionMenu
+
+    v3 = TclTkVariable.new(ip, nil); global.e(v3); v3.set("opt2")
+    om1 = TclTkWidget.new(ip, t1, tk_optionMenu, v3, "opt1 opt2 opt3 opt4")
+
+    pack.e(b1, mb1, om1, "-side left")
+  end
+
+  # listbox のサンプル.
+  def test_listbox(ip, parent)
+    clipboard, frame, grid, listbox, lower, menu, menubutton, pack, scrollbar,
+      selection = ip.commands().values_at(
+      "clipboard", "frame", "grid", "listbox", "lower", "menu", "menubutton",
+      "pack", "scrollbar", "selection")
+    t1, b1, cb = inittoplevel(ip, parent, "listbox")
+
+    ## listbox/scrollbar
+
+    f1 = TclTkWidget.new(ip, t1, frame)
+    # コールバック内で参照する変数は先に宣言しておかなければならない.
+    li1 = sc1 = sc2 = nil
+    # 実行時に, 後ろにパラメータがつくコールバックは,
+    # イテレータ変数でそのパラメータを受け取ることができる.
+    # (複数のパラメータはひとつの文字列にまとめられる.)
+    cb.push(c1 = TclTkCallback.new(ip, proc{|i| li1.e("xview", i)}))
+    cb.push(c2 = TclTkCallback.new(ip, proc{|i| li1.e("yview", i)}))
+    cb.push(c3 = TclTkCallback.new(ip, proc{|i| sc1.e("set", i)}))
+    cb.push(c4 = TclTkCallback.new(ip, proc{|i| sc2.e("set", i)}))
+    # listbox
+    li1 = TclTkWidget.new(ip, f1, listbox,
+      "-xscrollcommand", c3, "-yscrollcommand", c4,
+      "-selectmode extended -exportselection true")
+    for i in 1..20
+      li1.e("insert end {line #{i} line #{i} line #{i} line #{i} line #{i}}")
+    end
+    # scrollbar
+    sc1 = TclTkWidget.new(ip, f1, scrollbar, "-orient horizontal -command", c1)
+    sc2 = TclTkWidget.new(ip, f1, scrollbar, "-orient vertical -command", c2)
+
+    ## selection/clipboard
+
+    mb1 = TclTkWidget.new(ip, t1, menubutton, "-text edit")
+    me1 = TclTkWidget.new(ip, mb1, menu)
+    mb1.e("configure -menu", me1)
+    cb.push(c = TclTkCallback.new(ip, proc{
+      # clipboard をクリア.
+      clipboard.e("clear")
+      # selection から文字列を読み込み clipboard に追加する.
+      clipboard.e("append {#{selection.e('get')}}")}))
+    me1.e("add command -label {selection -> clipboard} -command",c)
+    cb.push(c = TclTkCallback.new(ip, proc{
+      # li1 をクリア.
+      li1.e("delete 0 end")
+      # clipboard から文字列を取り出し, 1 行ずつ
+      selection.e("get -selection CLIPBOARD").split(/\n/).each{|line|
+        # li1 に挿入する.
+        li1.e("insert end {#{line}}")}}))
+    me1.e("add command -label {clipboard -> listbox} -command",c)
+
+    grid.e(li1, "-row 0 -column 0 -sticky news")
+    grid.e(sc1, "-row 1 -column 0 -sticky ew")
+    grid.e(sc2, "-row 0 -column 1 -sticky ns")
+    grid.e("rowconfigure", f1, "0 -weight 100")
+    grid.e("columnconfigure", f1, "0 -weight 100")
+    f2 = TclTkWidget.new(ip, t1, frame)
+    lower.e(f2, b1)
+    pack.e(b1, mb1, "-in", f2, "-side left")
+    pack.e(f2, f1)
+  end
+
+  # canvas のサンプル.
+  def test_canvas(ip, parent)
+    canvas, lower, pack = ip.commands().values_at("canvas", "lower", "pack")
+    t1, b1, cb = inittoplevel(ip, parent, "canvas")
+
+    ## canvas
+
+    ca1 = TclTkWidget.new(ip, t1, canvas, "-width 400 -height 300")
+    lower.e(ca1, b1)
+    # rectangle を作る.
+    idr = ca1.e("create rectangle 10 10 20 20")
+    # oval を作る.
+    ca1.e("create oval 60 10 100 50")
+    # polygon を作る.
+    ca1.e("create polygon 110 10 110 30 140 10")
+    # line を作る.
+    ca1.e("create line 150 10 150 30 190 10")
+    # arc を作る.
+    ca1.e("create arc 200 10 250 50 -start 0 -extent 90 -style pieslice")
+    # i1 は本当は, どこかで破壊しなければならないが, 面倒なので放ってある.
+    i1 = TclTkImage.new(ip, "photo", "-file maru.gif")
+    # image を作る.
+    ca1.e("create image 100 100 -image", i1)
+    # bitmap を作る.
+    ca1.e("create bitmap 260 50 -bitmap questhead")
+    # text を作る.
+    ca1.e("create text 320 50 -text {drag rectangle}")
+    # window を作る(クローズボタン).
+    ca1.e("create window 200 200 -window", b1)
+
+    # bind により rectangle を drag できるようにする.
+    cb.push(c = TclTkCallback.new(ip, proc{|i|
+      # i に x と y を受け取るので, 取り出す.
+      x, y = i.split(/ /); x = x.to_f; y = y.to_f
+      # 座標を変更する.
+      ca1.e("coords current #{x - 5} #{y - 5} #{x + 5} #{y + 5}")},
+      # x, y 座標を空白で区切ったものをイテレータ変数へ渡すように指定.
+      "%x %y"))
+    # rectangle に bind する.
+    ca1.e("bind", idr, "<B1-Motion>", c)
+
+    pack.e(ca1)
+  end
+end
+
+# test driver
+
+if ARGV.size == 0
+  print "#{$0} n で, n 個のインタプリタを起動します.\n"
+  n = 1
+else
+  n = ARGV[0].to_i
+end
+
+print "start\n"
+ip = []
+
+# インタプリタ, ウィジェット等の生成.
+for i in 1 .. n
+  ip.push(Test1.new())
+end
+
+# 用意ができたらイベントループに入る.
+TclTk.mainloop()
+print "exit from mainloop\n"
+
+# インタプリタが GC されるかのテスト.
+ip = []
+print "GC.start\n" if $DEBUG
+GC.start() if $DEBUG
+print "end\n"
+
+exit
+
+# end
diff --git a/jni/ruby/ext/tk/sample/tcltklib/sample2.rb b/jni/ruby/ext/tk/sample/tcltklib/sample2.rb
new file mode 100644
index 0000000..1acc180
--- /dev/null
+++ b/jni/ruby/ext/tk/sample/tcltklib/sample2.rb
@@ -0,0 +1,451 @@
+#!/usr/local/bin/ruby
+#----------------------> pretty simple othello game <-----------------------
+# othello.rb
+#
+# version 0.3
+# maeda shugo (shuto@po.aianet.ne.jp)
+#---------------------------------------------------------------------------
+
+#       Sep. 17, 1997   modified by Y. Shigehiro for tcltk library
+#          maeda shugo (shugo@po.aianet.ne.jp) 氏による
+#          (ruby/tk で書かれていた) ruby のサンプルプログラム
+#               http://www.aianet.or.jp/~shugo/ruby/othello.rb.gz
+#          を tcltk ライブラリを使うように, 機械的に変更してみました.
+#
+#          なるべくオリジナルと同じになるようにしてあります.
+
+require "observer"
+require "tcltk"
+$ip = TclTkInterpreter.new()
+$root = $ip.rootwidget()
+$button, $canvas, $checkbutton, $frame, $label, $pack, $update, $wm =
+   $ip.commands().values_at(
+   "button", "canvas", "checkbutton", "frame", "label", "pack", "update", "wm")
+
+class Othello
+
+   EMPTY = 0
+   BLACK = 1
+   WHITE = - BLACK
+
+   attr :in_com_turn
+   attr :game_over
+
+   class Board
+
+      include Observable
+
+      DIRECTIONS = [
+         [-1, -1], [-1, 0], [-1, 1],
+         [ 0, -1],          [ 0, 1],
+         [ 1, -1], [ 1, 0], [ 1, 1]
+      ]
+
+      attr_accessor :com_disk
+
+      def initialize(othello)
+         @othello = othello
+         reset
+      end
+
+      def notify_observers(*arg)
+         if @observer_peers != nil
+            super(*arg)
+         end
+      end
+
+      def reset
+         @data = [
+            [EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY],
+            [EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY],
+            [EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY],
+            [EMPTY, EMPTY, EMPTY, WHITE, BLACK, EMPTY, EMPTY, EMPTY],
+            [EMPTY, EMPTY, EMPTY, BLACK, WHITE, EMPTY, EMPTY, EMPTY],
+            [EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY],
+            [EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY],
+            [EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY, EMPTY]
+         ]
+         changed
+         notify_observers
+      end
+
+      def man_disk
+         return - @com_disk
+      end
+
+      def other_disk(disk)
+         return - disk
+      end
+
+      def get_disk(row, col)
+         return @data[row][col]
+      end
+
+      def reverse_to(row, col, my_disk, dir_y, dir_x)
+         y = row
+         x = col
+         begin
+            y += dir_y
+            x += dir_x
+            if y < 0 || x < 0 || y > 7 || x > 7 ||
+                  @data[y][x] == EMPTY
+               return
+            end
+         end until @data[y][x] == my_disk
+         begin
+            @data[y][x] = my_disk
+            changed
+            notify_observers(y, x)
+            y -= dir_y
+            x -= dir_x
+         end until y == row && x == col
+      end
+
+      def put_disk(row, col, disk)
+         @data[row][col] = disk
+         changed
+         notify_observers(row, col)
+         DIRECTIONS.each do |dir|
+            reverse_to(row, col, disk, *dir)
+         end
+      end
+
+      def count_disk(disk)
+         num = 0
+         @data.each do |rows|
+            rows.each do |d|
+               if d == disk
+                  num += 1
+               end
+            end
+         end
+         return num
+      end
+
+      def count_point_to(row, col, my_disk, dir_y, dir_x)
+         return 0 if @data[row][col] != EMPTY
+         count = 0
+         loop do
+            row += dir_y
+            col += dir_x
+            break if row < 0 || col < 0 || row > 7 || col > 7
+            case @data[row][col]
+            when my_disk
+               return count
+            when other_disk(my_disk)
+               count += 1
+            when EMPTY
+               break
+            end
+         end
+         return 0
+      end
+
+      def count_point(row, col, my_disk)
+         count = 0
+         DIRECTIONS.each do |dir|
+            count += count_point_to(row, col, my_disk, *dir)
+         end
+         return count
+      end
+
+      def corner?(row, col)
+         return (row == 0 && col == 0) ||
+            (row == 0 && col == 7) ||
+            (row == 7 && col == 0) ||
+            (row == 7 && col == 7)
+      end
+
+      def search(my_disk)
+         max = 0
+         max_row = nil
+         max_col = nil
+         for row in 0 .. 7
+            for col in 0 .. 7
+               buf = count_point(row, col, my_disk)
+               if (corner?(row, col) && buf > 0) || max < buf
+                  max = buf
+                  max_row = row
+                  max_col = col
+               end
+            end
+         end
+         return max_row, max_col
+      end
+   end #--------------------------> class Board ends here
+
+   class BoardView < TclTkWidget
+
+      BACK_GROUND_COLOR = "DarkGreen"
+      HILIT_BG_COLOR = "green"
+      BORDER_COLOR = "black"
+      BLACK_COLOR = "black"
+      WHITE_COLOR = "white"
+      STOP_COLOR = "red"
+
+      attr :left
+      attr :top
+      attr :right
+      attr :bottom
+
+      class Square
+
+         attr :oval, TRUE
+         attr :row
+         attr :col
+
+         def initialize(view, row, col)
+            @view = view
+            @id = @view.e("create rectangle",
+                          *(view.tk_rect(view.left + col,
+                                         view.top + row,
+                                         view.left + col + 1,
+                                         view.top + row + 1) \
+                            << "-fill #{BACK_GROUND_COLOR}") )
+            @row = row
+            @col = col
+            @view.e("itemconfigure", @id,
+              "-width 0.5m -outline #{BORDER_COLOR}")
+            @view.e("bind", @id, "<Any-Enter>", TclTkCallback.new($ip, proc{
+               if @oval == nil
+                  view.e("itemconfigure", @id, "-fill #{HILIT_BG_COLOR}")
+               end
+            }))
+            @view.e("bind", @id, "<Any-Leave>", TclTkCallback.new($ip, proc{
+               view.e("itemconfigure", @id, "-fill #{BACK_GROUND_COLOR}")
+            }))
+            @view.e("bind", @id, "<ButtonRelease-1>", TclTkCallback.new($ip,
+               proc{
+               view.click_square(self)
+            }))
+         end
+
+         def blink(color)
+            @view.e("itemconfigure", @id, "-fill #{color}")
+            $update.e()
+            sleep(0.1)
+            @view.e("itemconfigure", @id, "-fill #{BACK_GROUND_COLOR}")
+         end
+      end #-----------------------> class Square ends here
+
+      def initialize(othello, board)
+         super($ip, $root, $canvas)
+         @othello = othello
+         @board = board
+         @board.add_observer(self)
+
+         @squares = Array.new(8)
+         for i in 0 .. 7
+            @squares[i] = Array.new(8)
+         end
+         @left = 1
+         @top = 0.5
+         @right = @left + 8
+         @bottom = @top + 8
+
+         i = self.e("create rectangle", *tk_rect(@left, @top, @right, @bottom))
+         self.e("itemconfigure", i,
+            "-width 1m -outline #{BORDER_COLOR} -fill #{BACK_GROUND_COLOR}")
+
+         for row in 0 .. 7
+            for col in 0 .. 7
+               @squares[row][col] = Square.new(self, row, col)
+            end
+         end
+
+         update
+      end
+
+      def tk_rect(left, top, right, bottom)
+         return left.to_s + "c", top.to_s + "c",
+            right.to_s + "c", bottom.to_s + "c"
+      end
+
+      def clear
+         each_square do |square|
+            if square.oval != nil
+               self.e("delete", square.oval)
+               square.oval = nil
+            end
+         end
+      end
+
+      def draw_disk(row, col, disk)
+         if disk == EMPTY
+            if @squares[row][col].oval != nil
+               self.e("delete", @squares[row][col].oval)
+               @squares[row][col].oval = nil
+            end
+            return
+         end
+
+         $update.e()
+         sleep(0.05)
+         oval = @squares[row][col].oval
+         if oval == nil
+            oval = self.e("create oval", *tk_rect(@left + col + 0.2,
+                                           @top + row + 0.2,
+                                           @left + col + 0.8,
+                                           @top + row + 0.8))
+            @squares[row][col].oval = oval
+         end
+         case disk
+         when BLACK
+            color = BLACK_COLOR
+         when WHITE
+            color = WHITE_COLOR
+         else
+            fail format("Unknown disk type: %d", disk)
+         end
+         self.e("itemconfigure", oval, "-outline #{color} -fill #{color}")
+      end
+
+      def update(row = nil, col = nil)
+         if row && col
+            draw_disk(row, col, @board.get_disk(row, col))
+         else
+            each_square do |square|
+               draw_disk(square.row, square.col,
+                         @board.get_disk(square.row, square.col))
+            end
+         end
+         @othello.show_point
+      end
+
+      def each_square
+         @squares.each do |rows|
+            rows.each do |square|
+               yield(square)
+            end
+         end
+      end
+
+      def click_square(square)
+         if @othello.in_com_turn || @othello.game_over ||
+               @board.count_point(square.row,
+                                  square.col,
+                                  @board.man_disk) == 0
+            square.blink(STOP_COLOR)
+            return
+         end
+         @board.put_disk(square.row, square.col, @board.man_disk)
+         @othello.com_turn
+      end
+
+      private :draw_disk
+      public :update
+   end #----------------------> class BoardView ends here
+
+   def initialize
+      @msg_label = TclTkWidget.new($ip, $root, $label)
+      $pack.e(@msg_label)
+
+      @board = Board.new(self)
+      @board_view = BoardView.new(self, @board)
+      #### added by Y. Shigehiro
+      ## board_view の大きさを設定する.
+      x1, y1, x2, y2 = @board_view.e("bbox all").split(/ /).collect{|i| i.to_f}
+      @board_view.e("configure -width", x2 - x1)
+      @board_view.e("configure -height", y2 - y1)
+      ## scrollregion を設定する.
+      @board_view.e("configure -scrollregion {", @board_view.e("bbox all"),
+         "}")
+      #### ここまで
+      $pack.e(@board_view, "-fill both -expand true")
+
+      panel = TclTkWidget.new($ip, $root, $frame)
+
+      @play_black = TclTkWidget.new($ip, panel, $checkbutton,
+        "-text {com is black} -command", TclTkCallback.new($ip, proc{
+         switch_side
+      }))
+      $pack.e(@play_black, "-side left")
+
+      quit = TclTkWidget.new($ip, panel, $button, "-text Quit -command",
+         TclTkCallback.new($ip, proc{
+         exit
+      }))
+      $pack.e(quit, "-side right -fill x")
+
+      reset = TclTkWidget.new($ip, panel, $button, "-text Reset -command",
+         TclTkCallback.new($ip, proc{
+         reset_game
+      }))
+      $pack.e(reset, "-side right -fill x")
+
+      $pack.e(panel, "-side bottom -fill x")
+
+#      root = Tk.root
+      $wm.e("title", $root, "Othello")
+      $wm.e("iconname", $root, "Othello")
+
+      @board.com_disk = WHITE
+      @game_over = FALSE
+
+      TclTk.mainloop
+   end
+
+   def switch_side
+      if @in_com_turn
+         @play_black.e("toggle")
+      else
+         @board.com_disk = @board.man_disk
+         com_turn unless @game_over
+      end
+   end
+
+   def reset_game
+      if @board.com_disk == BLACK
+         @board.com_disk = WHITE
+         @play_black.e("toggle")
+      end
+      @board_view.clear
+      @board.reset
+      $wm.e("title", $root, "Othello")
+      @game_over = FALSE
+   end
+
+   def com_turn
+      @in_com_turn = TRUE
+      $update.e()
+      sleep(0.5)
+      begin
+         com_disk = @board.count_disk(@board.com_disk)
+         man_disk = @board.count_disk(@board.man_disk)
+         if @board.count_disk(EMPTY) == 0
+            if man_disk == com_disk
+               $wm.e("title", $root, "{Othello - Draw!}")
+            elsif man_disk > com_disk
+               $wm.e("title", $root, "{Othello - You Win!}")
+            else
+               $wm.e("title", $root, "{Othello - You Loose!}")
+            end
+            @game_over = TRUE
+            break
+         elsif com_disk == 0
+            $wm.e("title", $root, "{Othello - You Win!}")
+            @game_over = TRUE
+            break
+         elsif man_disk == 0
+            $wm.e("title", $root, "{Othello - You Loose!}")
+            @game_over = TRUE
+            break
+         end
+         row, col = @board.search(@board.com_disk)
+         break if row == nil || col == nil
+         @board.put_disk(row, col, @board.com_disk)
+      end while @board.search(@board.man_disk) == [nil, nil]
+      @in_com_turn = FALSE
+   end
+
+   def show_point
+      black = @board.count_disk(BLACK)
+      white = @board.count_disk(WHITE)
+      @msg_label.e("configure -text",
+         %Q/{#{format("BLACK: %.2d    WHITE: %.2d", black, white)}}/)
+   end
+end #----------------------> class Othello ends here
+
+Othello.new
+
+#----------------------------------------------> othello.rb ends here