summaryrefslogtreecommitdiff
path: root/ext/tcltklib
diff options
context:
space:
mode:
Diffstat (limited to 'ext/tcltklib')
-rw-r--r--ext/tcltklib/MANIFEST15
-rw-r--r--ext/tcltklib/MANUAL.euc124
-rw-r--r--ext/tcltklib/README.euc133
-rw-r--r--ext/tcltklib/demo/lines0.tcl42
-rw-r--r--ext/tcltklib/demo/lines1.rb54
-rw-r--r--ext/tcltklib/demo/lines2.rb50
-rw-r--r--ext/tcltklib/depend1
-rw-r--r--ext/tcltklib/extconf.rb85
-rw-r--r--ext/tcltklib/lib/tcltk.rb388
-rw-r--r--ext/tcltklib/sample/batsu.gifbin538 -> 0 bytes
-rw-r--r--ext/tcltklib/sample/maru.gifbin481 -> 0 bytes
-rw-r--r--ext/tcltklib/sample/sample0.rb39
-rw-r--r--ext/tcltklib/sample/sample1.rb634
-rw-r--r--ext/tcltklib/sample/sample2.rb449
-rw-r--r--ext/tcltklib/tcltklib.c441
15 files changed, 0 insertions, 2455 deletions
diff --git a/ext/tcltklib/MANIFEST b/ext/tcltklib/MANIFEST
deleted file mode 100644
index b5e88278e0..0000000000
--- a/ext/tcltklib/MANIFEST
+++ /dev/null
@@ -1,15 +0,0 @@
-MANIFEST
-README.euc
-MANUAL.euc
-tcltklib.c
-depend
-extconf.rb
-lib/tcltk.rb
-demo/lines1.rb
-demo/lines0.tcl
-demo/lines2.rb
-sample/sample1.rb
-sample/sample2.rb
-sample/maru.gif
-sample/batsu.gif
-sample/sample0.rb
diff --git a/ext/tcltklib/MANUAL.euc b/ext/tcltklib/MANUAL.euc
deleted file mode 100644
index 789e85a9de..0000000000
--- a/ext/tcltklib/MANUAL.euc
+++ /dev/null
@@ -1,124 +0,0 @@
-(tof)
- MANUAL.euc
- Sep. 19, 1997 Y. Shigehiro
-
-以下, 「tcl/tk」という表記は, tclsh や wish を実現している, 一般でいう
-ところの tcl/tk を指します. 「tcltk ライブラリ」, 「tcltklib ライブラ
-リ」という表記は, 本パッケージに含まれる ruby 用のライブラリを指します.
-
-<< tcltk ライブラリ >>
-
-tcl/tk の C ライブラリを利用するための高(中?)水準インターフェースを提
-供します.
-
-このライブラリは ruby から tcl/tk ライブラリを利用するためのもので, 内
-部で tcltklib ライブラリを利用しています.
-
-[説明]
-
-tcl/tk インタプリタでは, ウィジェットに何か指示を送るには, ウィジェッ
-ト名に続いてパラメータを書きます. したがって, ウィジェットがオブジェク
-トであり, それに対してメソッドを送っている, とみなすことができます. さ
-て, tcl/tk インタプリタでは, 組み込みコマンドも, 前述のウィジェットと
-同じような書式の命令で実行されます. すなわち, コマンドもオブジェクトで
-あると考えることができます.
-
-このような考えに基づき, tcltk ライブラリでは, tcl/tk のコマンドやウィ
-ジェットに対応するオブジェクトを生成します. オブジェクトに対するメソッ
-ド呼び出しは, e() メソッドにより実行されます. 例えば, tcl/tk の info
-コマンドに対応する ruby のオブジェクトが info という名前であるとすると,
-tcl/tk の
- info commands
-という命令は tcltk ライブラリでは
- info.e("commands")
-と記述されます. また, 「.」というウィジェット (wish 実行時に自動的に生
-成されるルートウィジェット) に対応する ruby のオブジェクトが root とい
-う名前であるとすると,
- . configure -height 300 -width 300
-という tcl/tk の命令は
- root.e("configure -height 300 -width 300")
-と記述されます. このような記述は, 見ためには美しくありませんが, そして,
-スクリプトを読む人には見づらいかも知れませんが, 実際にスクリプトを書い
-てみると予想外に手軽です.
-
-[使用法]
-
-1. ライブラリを読み込む.
- require "tcltk"
-
-2. tcl/tk インタプリタを生成する.
- ip = TclTkInterpreter.new()
-
-3. tcl/tk のコマンドに対応するオブジェクトを変数に代入しておく.
- # コマンドに対応するオブジェクトが入った Hash を取り出す.
- c = ip.commands()
- # 使いたいコマンドに対応するオブジェクトを個別の変数に代入する.
- bind, button, info, wm = c.indexes("bind", "button", "info", "wm")
-
-4. 必要な処理を行う.
- 詳しくは, サンプルを参照のこと.
-
-5. 準備ができたら, イベントループに入る.
- TclTk.mainloop()
-
-(( 以下, モジュール, クラス等の説明を書く予定.))
-
-
-
-<< tcltklib ライブラリ >>
-
-tcl/tk の C ライブラリを利用するための低水準インターフェースを提供しま
-す.
-
-コンパイル/実行には, tcl/tk の C ライブラリが必要です.
-
-[説明]
-
-このライブラリを用いると, ruby から tcl/tk の C ライブラリを利用できま
-す. 具体的には, ruby インタプリタから tcl/tk インタプリタを呼び出すこ
-とができます. さらに, その(ruby インタプリタから呼び出した) tcl/tk イ
-ンタプリタから, 逆に ruby インタプリタを呼び出すこともできます.
-
-[使用法]
-
-require "tcltklib" すると, 以下のモジュール, クラスが利用可能です.
-
-モジュール TclTkLib
- tcl/tk ライブラリを呼び出すメソッドを集めたモジュールです. ただし,
- tcl/tk インタプリタ関係のメソッドはクラス TclTkIp にあります.
-
- モジュールメソッド mainloop()
- Tk_MainLoop を実行します. 全ての tk のウインドウが無くなると終了
- します(例えば, tcl/tk で書くところの "destroy ." をした場合等).
- 引数: 無し
- 戻り値: nil
-
-クラス TclTkIp
- インスタンスが tcl/tk のインタプリタに対応します. tcl/tk のライブ
- ラリの仕様通り, インスタンスを複数個生成しても正しく動作します(そ
- んなことをする必要はあまり無いはずですが). インタプリタは wish の
- tcl/tk コマンドを実行できます. さらに, 以下のコマンドを実行できま
- す.
- コマンド ruby
- 引数を ruby で実行します(ruby_eval_string を実行します). 引数
- は 1 つでなければなりません. 戻り値は ruby の実行結果です.
- ruby の実行結果は nil か String でなければなりません.
-
- クラスメソッド new()
- TclTkIp クラスのインスタンスを生成します
- 引数: 無し
- 戻り値 (TclTkIp): 生成されたインスタンス
-
- メソッド _eval(script)
- インタプリタで script を評価します(Tcl_Eval を実行します). 前述
- のように, ruby コマンドにより script 内から ruby スクリプトを実
- 行できます.
- 引数: script (String) - インタプリタで評価するスクリプト文字列
- 戻り値 (String): 評価結果 ((Tcl_Interp *)->result)
-
- メソッド _return_value()
- 直前の Tcl_Eval の戻り値を返します. 0(TCL_OK) で正常終了です.
- 引数: 無し
- 戻り値 (Fixnum): 直前の Tcl_Eval() が返した値.
-
-(eof)
diff --git a/ext/tcltklib/README.euc b/ext/tcltklib/README.euc
deleted file mode 100644
index 290ffb0b60..0000000000
--- a/ext/tcltklib/README.euc
+++ /dev/null
@@ -1,133 +0,0 @@
-(tof)
- tcltk ライブラリ
- tcltklib ライブラリ
- Sep. 19, 1997 Y. Shigehiro
-
-以下, 「tcl/tk」という表記は, tclsh や wish を実現している, 一般でいう
-ところの tcl/tk を指します. 「tcltk ライブラリ」, 「tcltklib ライブラ
-リ」という表記は, 本パッケージに含まれる ruby 用のライブラリを指します.
-
-[ファイルについて]
-
-README.euc : このファイル(注意, 特徴, インストールの方法).
-MANUAL.euc : マニュアル.
-
-lib/, ext/ : ライブラリの実体.
-
-sample/ : マニュアル代わりのサンプルプログラム.
-sample/sample0.rb : tcltklib ライブラリのテスト.
-sample/sample1.rb : tcltk ライブラリのテスト.
- tcl/tk (wish) でできそうなことを一通り書いてみました.
-sample/sample2.rb : tcltk ライブラリのサンプル.
- maeda shugo (shugo@po.aianet.ne.jp) 氏による
- (`rb.tk' で書かれていた) ruby のサンプルプログラム
- http://www.aianet.or.jp/~shugo/ruby/othello.rb.gz
- を tcltk ライブラリを使うように, 機械的に変更してみました.
-
-demo/ : 100 本の線を 100 回描くデモプログラム.
- 最初に空ループの時間を測定し, 続いて実際に線を引く時間を測定します.
- tcl/tk は(再)描画のときに backing store を使わずに律義に 10000 本(?)
- 線を引くので, (再)描画を始めると, マシンがかなり重くなります.
-demo/lines0.tcl : wish 用のスクリプト.
-demo/lines1.rb : `tk.rb' 用のスクリプト.
-demo/lines2.rb : tcltk ライブラリ用のスクリプト.
-
-[注意]
-
-コンパイル/実行には, tcl/tk の C ライブラリが必要です.
-
-このライブラリは,
-
- ruby-1.0-970701, ruby-1.0-970911, ruby-1.0-970919
- FreeBSD 2.2.2-RELEASE
- およびそのパッケージ jp-tcl-7.6.tgz, jp-tk-4.2.tgz
-
-で作成/動作確認しました. 他の環境では動作するかどうかわかりません.
-
-TclTkLib.mainloop を実行中に Control-C が効かないのは不便なので, ruby
-のソースを参考に, #include "sig.h" して trap_immediate を操作していま
-すが, ruby の README.EXT にも書いてないのに, こんなことをして良いのか
-どうかわかりません.
-
--d オプションでデバッグ情報を表示させるために, ruby のソースを参考に,
-debug という大域変数を参照していますが, ruby の README.EXT にも書いて
-ないのに, こんなことをして良いのかどうかわかりません.
-
-extconf.rb は書きましたが, (いろいろな意味で)これで良いのか良く分かり
-ません.
-
-[特徴]
-
-ruby から tcl/tk ライブラリを利用できます.
-
-tcl/tk インタプリタのスクリプトは, 機械的に tcltk ライブラリ用の ruby
-スクリプトに変換できます.
-
-(`tk.rb' との違い)
-
-1. tcl/tk インタプリタのスクリプトが, どのように, tcltk ライブラリ用の
- ruby スクリプトに変換されるかが理解できれば, マニュアル類が無いに等
- しい `tk.rb' とは異なり
-
- tcl/tk のマニュアルやオンラインドキュメントを用いて
-
- 効率良くプログラミングを行うことができます.
- 記述方法がわからない, コマンドに与えるパラメータがわからない...
- - Canvas.new { ... } と, なぜイテレータブロックを書けるの??
- - Canvas の bbox は数値のリストを返すのに, xview は文字列を返すの??
- と, いちいち, ライブラリのソースを追いかける必要はありません.
-
-2. 個々の機能(オプション)を個別処理によりサポートしており, そのためサ
- ポートしていない機能は使うことができない(本当は使えないこともないの
- ですが) `tk.rb' とは異なり, tcl/tk インタプリタで可能なことは
-
- ほとんど
-
- ruby からも実行できます. 現在, ruby から実行できないことが確認され
- ているのは,
-
- bind コマンドでスクリプトを追加する構文
- 「bind tag sequence +script」
- ^
-
- のみです.
- - `. configure -width' をしようとして, `Tk.root.height()' と書い
- たのに, `undefined method `height'' と怒られてしまった. tk.rb を
- 読んでみて, ガーン. できないのか...
- ということはありません.
-
-3. wish プロセスを起動しプロセス間通信で wish を利用する `tk.rb' とは
- 異なり, tcl/tk の C ライブラリをリンクし
-
- より高速に (といっても, 思った程は速くないですが)
-
- 処理を行います.
-
-4. `tk.rb' ほど, 高水準なインターフェースを備えていないため, tcl/tk イ
- ンタプリタの生成等
-
- 何から何まで自分で記述
-
- しなければなりません(その代わり, tcl/tk ライブラリの仕様通り,
- tcl/tk インタプリタを複数生成することもできますが).
- インターフェースは(おそらく) ruby の思想に沿ったものではありません.
- また, スクリプトの記述は
-
- ダサダサ
-
- です. スクリプトは, 一見, 読みづらいものとなります. が, 書く人にとっ
- ては, それほど煩わしいものではないと思います.
-
-[インストールの方法]
-
-0. ruby のソースファイル(ruby-1.0-なんたら.tgz)を展開しておきます.
-
-1. ruby-1.0-なんたら/ext に ext/tcltklib をコピーします.
- cp -r ext/tcltklib ???/ruby-1.0-なんたら/ext/
-
-2. ruby のインストール法に従い make 等をします.
-
-3. ruby のライブラリ置場に lib/* をコピーします.
- cp lib/* /usr/local/lib/ruby/
-
-(eof)
diff --git a/ext/tcltklib/demo/lines0.tcl b/ext/tcltklib/demo/lines0.tcl
deleted file mode 100644
index 8ed3c5e1c1..0000000000
--- a/ext/tcltklib/demo/lines0.tcl
+++ /dev/null
@@ -1,42 +0,0 @@
-#! /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/ext/tcltklib/demo/lines1.rb b/ext/tcltklib/demo/lines1.rb
deleted file mode 100644
index e459589f50..0000000000
--- a/ext/tcltklib/demo/lines1.rb
+++ /dev/null
@@ -1,54 +0,0 @@
-#! /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/ext/tcltklib/demo/lines2.rb b/ext/tcltklib/demo/lines2.rb
deleted file mode 100644
index 9f21ae6377..0000000000
--- a/ext/tcltklib/demo/lines2.rb
+++ /dev/null
@@ -1,50 +0,0 @@
-#! /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/ext/tcltklib/depend b/ext/tcltklib/depend
deleted file mode 100644
index 71d9f20537..0000000000
--- a/ext/tcltklib/depend
+++ /dev/null
@@ -1 +0,0 @@
-tcltklib.o: tcltklib.c $(hdrdir)/ruby.h $(hdrdir)/config.h $(hdrdir)/defines.h
diff --git a/ext/tcltklib/extconf.rb b/ext/tcltklib/extconf.rb
deleted file mode 100644
index 14c8e45ae5..0000000000
--- a/ext/tcltklib/extconf.rb
+++ /dev/null
@@ -1,85 +0,0 @@
-# extconf.rb for tcltklib
-
-require 'mkmf'
-
-have_library("nsl", "t_open")
-have_library("socket", "socket")
-have_library("dl", "dlopen")
-have_library("m", "log")
-
-$includes = []
-def search_header(include, *path)
- pwd = Dir.getwd
- begin
- for i in path.sort!.reverse!
- dir = Dir[i]
- for path in dir
- next unless File.directory? path
- Dir.chdir path
- files = Dir[include]
- if files.size > 0
- unless $includes.include? path
- $includes << path
- end
- return
- end
- end
- end
- ensure
- Dir.chdir pwd
- end
-end
-
-search_header("tcl.h",
- "/usr/include/tcl{,8*,7*}",
- "/usr/include",
- "/usr/local/include/tcl{,8*,7*}",
- "/usr/local/include")
-search_header("tk.h",
- "/usr/include/tk{,8*,4*}",
- "/usr/include",
- "/usr/local/include/tk{,8*,4*}",
- "/usr/local/include")
-search_header("X11/Xlib.h",
- "/usr/include/X11*",
- "/usr/include",
- "/usr/openwin/include",
- "/usr/X11*/include")
-
-$CFLAGS = $includes.collect{|path| "-I" + path}.join(" ")
-
-$libraries = []
-def search_lib(file, func, *path)
- for i in path.reverse!
- dir = Dir[i]
- for path in dir
- $LDFLAGS = $libraries.collect{|p| "-L" + p}.join(" ") + " -L" + path
- files = Dir[path+"/"+file]
- if files.size > 0
- for lib in files
- lib = File::basename(lib)
- lib.sub!(/^lib/, '')
- lib.sub!(/\.(a|so)$/, '')
- if have_library(lib, func)
- unless $libraries.include? path
- $libraries << path
- end
- return TRUE
- end
- end
- end
- end
- end
- return FALSE;
-end
-
-if have_header("tcl.h") && have_header("tk.h") &&
- search_lib("libX11.{a,so}", "XOpenDisplay",
- "/usr/lib", "/usr/openwin/lib", "/usr/X11*/lib") &&
- search_lib("libtcl{,8*,7*}.{a,so}", "Tcl_FindExecutable",
- "/usr/lib", "/usr/local/lib") &&
- search_lib("libtk{,8*,4*}.{a,so}", "Tk_Init",
- "/usr/lib", "/usr/local/lib")
- $LDFLAGS = $libraries.collect{|path| "-L" + path}.join(" ")
- create_makefile("tcltklib")
-end
diff --git a/ext/tcltklib/lib/tcltk.rb b/ext/tcltklib/lib/tcltk.rb
deleted file mode 100644
index 81d01f930d..0000000000
--- a/ext/tcltklib/lib/tcltk.rb
+++ /dev/null
@@ -1,388 +0,0 @@
-# tof
-
-#### tcltk ライブラリ
-#### Sep. 5, 1997 Y. Shigehiro
-
-require "tcltklib"
-
-################
-
-# module TclTk: tcl/tk のライブラリ全体で必要になるものを集めたもの
-# (主に, 名前空間の点から module にする使う.)
-module TclTk
-
- # 単にここに書けば最初に 1 度実行されるのか??
-
- # 生成した一意な名前を保持しておく連想配列を初期化する.
- @namecnt = {}
-
- # コールバックを保持しておく連想配列を初期化する.
- @callback = {}
-end
-
-# TclTk.mainloop(): TclTkLib.mainloop() を呼ぶ.
-def TclTk.mainloop()
- print("mainloop: start\n") if $DEBUG
- TclTkLib.mainloop()
- print("mainloop: end\n") if $DEBUG
-end
-
-# TclTk.deletecallbackkey(ca): コールバックを TclTk module から取り除く.
-# tcl/tk インタプリタにおいてコールバックが取り消されるわけではない.
-# これをしないと, 最後に TclTkInterpreter が GC できない.
-# (GC したくなければ, 別に, これをしなくても良い.)
-# ca: コールバック(TclTkCallback)
-def TclTk.deletecallbackkey(ca)
- print("deletecallbackkey: ", ca.to_s(), "\n") if $DEBUG
- @callback.delete(ca.to_s)
-end
-
-# TclTk.dcb(ca, wid, W): 配列に入っている複数のコールバックに対して
-# TclTk.deletecallbackkey() を呼ぶ.
-# トップレベルの <Destroy> イベントのコールバックとして呼ぶためのもの.
-# ca: コールバック(TclTkCallback) の Array
-# wid: トップレベルのウィジェット(TclTkWidget)
-# w: コールバックに %W で与えられる, ウインドウに関するパラメータ(String)
-def TclTk.dcb(ca, wid, w)
- if wid.to_s() == w
- ca.each{|i|
- TclTk.deletecallbackkey(i)
- }
- end
-end
-
-# TclTk._addcallback(ca): コールバックを登録する.
-# ca: コールバック(TclTkCallback)
-def TclTk._addcallback(ca)
- print("_addcallback: ", ca.to_s(), "\n") if $DEBUG
- @callback[ca.to_s()] = ca
-end
-
-# TclTk._callcallback(key, arg): 登録したコールバックを呼び出す.
-# key: コールバックを選択するキー (TclTkCallback が to_s() で返す値)
-# arg: tcl/tk インタプリタからのパラメータ
-def TclTk._callcallback(key, arg)
- print("_callcallback: ", @callback[key].inspect, "\n") if $DEBUG
- @callback[key]._call(arg)
- # コールバックからの返り値はどうせ捨てられる.
- # String を返さないと, rb_eval_string() がエラーになる.
- return ""
-end
-
-# TclTk._newname(prefix): 一意な名前(String)を生成して返す.
-# prefix: 名前の接頭語
-def TclTk._newname(prefix)
- # 生成した名前のカウンタは @namecnt に入っているので, 調べる.
- if !@namecnt.key?(prefix)
- # 初めて使う接頭語なので初期化する.
- @namecnt[prefix] = 1
- else
- # 使ったことのある接頭語なので, 次の名前にする.
- @namecnt[prefix] += 1
- end
- return "#{prefix}#{@namecnt[prefix]}"
-end
-
-################
-
-# class TclTkInterpreter: tcl/tk のインタプリタ
-class TclTkInterpreter
-
- # initialize(): 初期化.
- def initialize()
- # インタプリタを生成する.
- @ip = TclTkIp.new()
-
- # インタプリタに ruby_fmt コマンドを追加する.
- # ruby_fmt コマンドとは, 後ろの引数を format コマンドで処理して
- # ruby コマンドに渡すものである.
- # (なお, ruby コマンドは, 引数を 1 つしかとれない.)
- if $DEBUG
- @ip._eval("proc ruby_fmt {fmt args} { puts \"ruby_fmt: $fmt $args\" ; ruby [format $fmt $args] }")
- else
- @ip._eval("proc ruby_fmt {fmt args} { ruby [format $fmt $args] }")
- end
-
- # @ip._get_eval_string(*args): tcl/tk インタプリタで評価する
- # 文字列(String)を生成して返す.
- # *args: tcl/tk で評価するスクリプト(に対応するオブジェクト列)
- def @ip._get_eval_string(*args)
- argstr = ""
- args.each{|arg|
- argstr += " " if argstr != ""
- # もし to_eval() メソッドが
- if (arg.respond_to?(:to_eval))
- # 定義されていればそれを呼ぶ.
- argstr += arg.to_eval()
- else
- # 定義されていなければ to_s() を呼ぶ.
- argstr += arg.to_s()
- end
- }
- return argstr
- end
-
- # @ip._eval_args(*args): tcl/tk インタプリタで評価し,
- # その結果(String)を返す.
- # *args: tcl/tk で評価するスクリプト(に対応するオブジェクト列)
- def @ip._eval_args(*args)
- # インタプリタで評価する文字列を求める.
- argstr = _get_eval_string(*args)
-
- # インタプリタで評価する.
- print("_eval: \"", argstr, "\"") if $DEBUG
- res = _eval(argstr)
- if $DEBUG
- print(" -> \"", res, "\"\n")
- elsif _return_value() != 0
- print(res, "\n")
- end
- fail(%Q/can't eval "#{argstr}"/) if _return_value() != 0
- return res
- end
-
- # tcl/tk のコマンドに対応するオブジェクトを生成し, 連想配列に入れておく.
- @commands = {}
- # tcl/tk インタプリタに登録されているすべてのコマンドに対して,
- @ip._eval("info command").split(/ /).each{|comname|
- if comname =~ /^[.]/
- # コマンドがウィジェット(のパス名)の場合は
- # TclTkWidget のインスタンスを作って連想配列に入れる.
- @commands[comname] = TclTkWidget.new(@ip, comname)
- else
- # そうでない場合は
- # TclTkCommand のインスタンスを作って連想配列に入れる.
- @commands[comname] = TclTkCommand.new(@ip, comname)
- end
- }
- end
-
- # commands(): tcl/tk のコマンドに対応するオブジェクトを Hash に
- # 入れたものを返す.
- def commands()
- return @commands
- end
-
- # rootwidget(): ルートウィジェット(TclTkWidget)を返す.
- def rootwidget()
- return @commands["."]
- end
-
- # _tcltkip(): @ip(TclTkIp) を返す.
- def _tcltkip()
- return @ip
- end
-
- # method_missing(id, *args): 未定義のメソッドは tcl/tk のコマンドとみなして
- # 実行し, その結果(String)を返す.
- # id: メソッドのシンボル
- # *args: コマンドの引数
- def method_missing(id, *args)
- # もし, メソッドの tcl/tk コマンドが
- if @commands.key?(id.id2name)
- # あれば, 実行して結果を返す.
- return @commands[id.id2name].e(*args)
- else
- # 無ければもともとの処理.
- super
- end
- end
-end
-
-# class TclTkObject: tcl/tk のオブジェクト
-# (基底クラスとして使う.
-# tcltk ライブラリを使う人が TclTkObject.new() することはないはず.)
-class TclTkObject
-
- # initialize(ip, exp): 初期化.
- # ip: インタプリタ(TclTkIp)
- # exp: tcl/tk での表現形
- def initialize(ip, exp)
- fail("type is not TclTkIp") if !ip.kind_of?(TclTkIp)
- @ip = ip
- @exp = exp
- end
-
- # to_s(): tcl/tk での表現形(String)を返す.
- def to_s()
- return @exp
- end
-end
-
-# class TclTkCommand: tcl/tk のコマンド
-# (tcltk ライブラリを使う人が TclTkCommand.new() することはないはず.
-# TclTkInterpreter:initialize() から new() される.)
-class TclTkCommand < TclTkObject
-
- # e(*args): コマンドを実行し, その結果(String)を返す.
- # (e は exec または eval の e.)
- # *args: コマンドの引数
- def e(*args)
- return @ip._eval_args(to_s(), *args)
- end
-end
-
-# class TclTkLibCommand: tcl/tk のコマンド
-# (ライブラリにより実現されるコマンドで, tcl/tk インタプリタに最初から
-# 存在しないものは, インタプリタの commands() では生成できない.
-# そのようなものに対し, コマンドの名前から TclTkCommand オブジェクトを
-# 生成する.
-class TclTkLibCommand < TclTkCommand
-
- # initialize(ip, name): 初期化
- # ip: インタプリタ(TclTkInterpreter)
- # name: コマンド名 (String)
- def initialize(ip, name)
- super(ip._tcltkip, name)
- end
-end
-
-# class TclTkVariable: tcl/tk の変数
-class TclTkVariable < TclTkObject
-
- # initialize(interp, dat): 初期化.
- # interp: インタプリタ(TclTkInterpreter)
- # dat: 設定する値(String)
- # nil なら, 設定しない.
- def initialize(interp, dat)
- # tcl/tk での表現形(変数名)を自動生成する.
- exp = TclTk._newname("v_")
- # TclTkObject を初期化する.
- super(interp._tcltkip(), exp)
- # set コマンドを使うのでとっておく.
- @set = interp.commands()["set"]
- # 値を設定する.
- set(dat) if dat
- end
-
- # tcl/tk の set を使えば, 値の設定/参照はできるが,
- # それだけではなんなので, 一応, メソッドをかぶせたものも用意しておく.
-
- # set(data): tcl/tk の変数に set を用いて値を設定する.
- # data: 設定する値
- def set(data)
- @set.e(to_s(), data.to_s())
- end
-
- # get(): tcl/tk の変数の値(String)を set を用いて読みだし返す.
- def get()
- return @set.e(to_s())
- end
-end
-
-# class TclTkWidget: tcl/tk のウィジェット
-class TclTkWidget < TclTkCommand
-
- # initialize(*args): 初期化.
- # *args: パラメータ
- def initialize(*args)
- if args[0].kind_of?(TclTkIp)
- # 最初の引数が TclTkIp の場合:
-
- # 既に tcl/tk に定義されているウィジェットに TclTkWidget の構造を
- # かぶせる. (TclTkInterpreter:initialize() から使われる.)
-
- # パラメータ数が 2 でなければエラー.
- fail("illegal # of parameter") if args.size != 2
-
- # ip: インタプリタ(TclTkIp)
- # exp: tcl/tk での表現形
- ip, exp = args
-
- # TclTkObject を初期化する.
- super(ip, exp)
- elsif args[0].kind_of?(TclTkInterpreter)
- # 最初の引数が TclTkInterpreter の場合:
-
- # 親ウィジェットから新たなウィジェトを生成する.
-
- # interp: インタプリタ(TclTkInterpreter)
- # parent: 親ウィジェット
- # command: ウィジェットを生成するコマンド(label 等)
- # *args: command に渡す引数
- interp, parent, command, *args = args
-
- # ウィジェットの名前を作る.
- exp = parent.to_s()
- exp += "." if exp !~ /[.]$/
- exp += TclTk._newname("w_")
- # TclTkObject を初期化する.
- super(interp._tcltkip(), exp)
- # ウィジェットを生成する.
- res = @ip._eval_args(command, exp, *args)
-# fail("can't create Widget") if res != exp
- # tk_optionMenu では, ボタン名を exp で指定すると
- # res にメニュー名を返すので res != exp となる.
- else
- fail("first parameter is not TclTkInterpreter")
- end
- end
-end
-
-# class TclTkCallback: tcl/tk のコールバック
-class TclTkCallback < TclTkObject
-
- # initialize(interp, pr, arg): 初期化.
- # interp: インタプリタ(TclTkInterpreter)
- # pr: コールバック手続き(Proc)
- # arg: pr のイテレータ変数に渡す文字列
- # tcl/tk の bind コマンドではパラメータを受け取るために % 置換を
- # 用いるが, pr の内部で % を書いてもうまくいかない.
- # arg に文字列を書いておくと, その置換結果を, pr で
- # イテレータ変数を通して受け取ることができる.
- # scrollbar コマンドの -command オプションのように
- # 何も指定しなくてもパラメータが付くコマンドに対しては,
- # arg を指定してはならない.
- def initialize(interp, pr, arg = nil)
- # tcl/tk での表現形(変数名)を自動生成する.
- exp = TclTk._newname("c_")
- # TclTkObject を初期化する.
- super(interp._tcltkip(), exp)
- # パラメータをとっておく.
- @pr = pr
- @arg = arg
- # モジュールに登録しておく.
- TclTk._addcallback(self)
- end
-
- # to_eval(): @ip._eval_args で評価するときの表現形(String)を返す.
- def to_eval()
- if @arg
- # %s は ruby_fmt より前に bind により置換されてしまうので
- # %%s としてある. したがって, これは bind 専用.
- s = %Q/{ruby_fmt {TclTk._callcallback("#{to_s()}", "%%s")} #{@arg}}/
- else
- s = %Q/{ruby_fmt {TclTk._callcallback("#{to_s()}", "%s")}}/
- end
-
- return s
- end
-
- # _call(arg): コールバックを呼び出す.
- # arg: コールバックに渡されるパラメータ
- def _call(arg)
- @pr.call(arg)
- end
-end
-
-# class TclTkImage: tcl/tk のイメージ
-class TclTkImage < TclTkCommand
-
- # initialize(interp, t, *args): 初期化.
- # イメージの生成は TclTkImage.new() で行うが,
- # 破壊は image delete で行う. (いまいちだけど仕方が無い.)
- # interp: インタプリタ(TclTkInterpreter)
- # t: イメージのタイプ (photo, bitmap, etc.)
- # *args: コマンドの引数
- def initialize(interp, t, *args)
- # tcl/tk での表現形(変数名)を自動生成する.
- exp = TclTk._newname("i_")
- # TclTkObject を初期化する.
- super(interp._tcltkip(), exp)
- # イメージを生成する.
- res = @ip._eval_args("image create", t, exp, *args)
- fail("can't create Image") if res != exp
- end
-end
-
-# eof
diff --git a/ext/tcltklib/sample/batsu.gif b/ext/tcltklib/sample/batsu.gif
deleted file mode 100644
index 880cc73e09..0000000000
--- a/ext/tcltklib/sample/batsu.gif
+++ /dev/null
Binary files differ
diff --git a/ext/tcltklib/sample/maru.gif b/ext/tcltklib/sample/maru.gif
deleted file mode 100644
index 2c0202892e..0000000000
--- a/ext/tcltklib/sample/maru.gif
+++ /dev/null
Binary files differ
diff --git a/ext/tcltklib/sample/sample0.rb b/ext/tcltklib/sample/sample0.rb
deleted file mode 100644
index cd4c8069b4..0000000000
--- a/ext/tcltklib/sample/sample0.rb
+++ /dev/null
@@ -1,39 +0,0 @@
-#! /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/ext/tcltklib/sample/sample1.rb b/ext/tcltklib/sample/sample1.rb
deleted file mode 100644
index 28ba7b547a..0000000000
--- a/ext/tcltklib/sample/sample1.rb
+++ /dev/null
@@ -1,634 +0,0 @@
-#! /usr/local/bin/ruby -d
-#! /usr/local/bin/ruby
-# -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.indexes(
- "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().indexes(
- "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().indexes(
- "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().indexes(
- "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().indexes("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().indexes(
- "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().indexes(
- "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().indexes(
- "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().indexes(
- "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().indexes(
- "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().indexes(
- "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().indexes(
- "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().indexes(
- "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().indexes(
- "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().indexes("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/ext/tcltklib/sample/sample2.rb b/ext/tcltklib/sample/sample2.rb
deleted file mode 100644
index 969d8de09a..0000000000
--- a/ext/tcltklib/sample/sample2.rb
+++ /dev/null
@@ -1,449 +0,0 @@
-#!/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().indexes(
- "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 :com_disk, TRUE
-
- 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))
- @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
diff --git a/ext/tcltklib/tcltklib.c b/ext/tcltklib/tcltklib.c
deleted file mode 100644
index 625fe61ccc..0000000000
--- a/ext/tcltklib/tcltklib.c
+++ /dev/null
@@ -1,441 +0,0 @@
-/*
- * tcltklib.c
- * Aug. 27, 1997 Y. Shigehiro
- * Oct. 24, 1997 Y. Matsumoto
- */
-
-#include "ruby.h"
-#include "rubysig.h"
-#include <stdio.h>
-#include <string.h>
-#include <tcl.h>
-#include <tk.h>
-
-#ifdef __MACOS__
-# include <tkMac.h>
-# include <Quickdraw.h>
-#endif
-
-/* for rb_debug */
-
-#define DUMP1(ARG1) if (rb_debug) { fprintf(stderr, "tcltklib: %s\n", ARG1);}
-#define DUMP2(ARG1, ARG2) if (rb_debug) { fprintf(stderr, "tcltklib: ");\
-fprintf(stderr, ARG1, ARG2); fprintf(stderr, "\n"); }
-/*
-#define DUMP1(ARG1)
-#define DUMP2(ARG1, ARG2)
-*/
-
-/* for callback break & continue */
-VALUE eTkCallbackBreak;
-VALUE eTkCallbackContinue;
-
-/* from tkAppInit.c */
-
-/*
- * The following variable is a special hack that is needed in order for
- * Sun shared libraries to be used for Tcl.
- */
-
-extern int matherr();
-int *tclDummyMathPtr = (int *) matherr;
-
-/*---- module TclTkLib ----*/
-
-/* Tk_ThreadTimer */
-typedef struct {
- Tcl_TimerToken token;
- int flag;
-} Tk_TimerData;
-
-/* timer callback */
-void _timer_for_tcl (ClientData clientData)
-{
- Tk_TimerData *timer = (Tk_TimerData*)clientData;
-
- timer->flag = 0;
- CHECK_INTS;
-#ifdef USE_THREAD
- if (!rb_thread_critical) rb_thread_schedule();
-#endif
-
- timer->token = Tk_CreateTimerHandler(200, _timer_for_tcl,
- (ClientData)timer);
- timer->flag = 1;
-}
-
-/* execute Tk_MainLoop */
-static VALUE
-lib_mainloop(VALUE self)
-{
- Tk_TimerData *timer;
-
- timer = (Tk_TimerData *) ckalloc(sizeof(Tk_TimerData));
- timer->flag = 0;
- timer->token = Tk_CreateTimerHandler(200, _timer_for_tcl,
- (ClientData)timer);
- timer->flag = 1;
-
- DUMP1("start Tk_Mainloop");
- while (Tk_GetNumMainWindows() > 0) {
- Tcl_DoOneEvent(0);
- }
- DUMP1("stop Tk_Mainloop");
-
-#ifdef USE_THREAD
- if (timer->flag) {
- Tk_DeleteTimerHandler(timer->token);
- }
-#endif
-
- return Qnil;
-}
-
-/*---- class TclTkIp ----*/
-struct tcltkip {
- Tcl_Interp *ip; /* the interpreter */
- int return_value; /* return value */
-};
-
-/* Tcl command `ruby' */
-static VALUE
-ip_eval_rescue(VALUE *failed, VALUE einfo)
-{
- *failed = einfo;
- return Qnil;
-}
-
-static int
-#if TCL_MAJOR_VERSION >= 8
-ip_ruby(ClientData clientData, Tcl_Interp *interp,
- int argc, Tcl_Obj *CONST argv[])
-#else
-ip_ruby(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
-#endif
-{
- VALUE res;
- int old_trapflg;
- VALUE failed = 0;
- char *arg;
- int dummy;
-
- /* ruby command has 1 arg. */
- if (argc != 2) {
- rb_raise(rb_eArgError, "wrong # of arguments (%d for 1)", argc);
- }
-
- /* get C string from Tcl object */
-#if TCL_MAJOR_VERSION >= 8
- arg = Tcl_GetStringFromObj(argv[1], &dummy);
-#else
- arg = argv[1];
-#endif
-
- /* evaluate the argument string by ruby */
- DUMP2("rb_eval_string(%s)", arg);
- old_trapflg = rb_trap_immediate;
- rb_trap_immediate = 0;
- res = rb_rescue(rb_eval_string, (VALUE)arg, ip_eval_rescue, (VALUE)&failed);
- rb_trap_immediate = old_trapflg;
-
- Tcl_ResetResult(interp);
- if (failed) {
- VALUE eclass = CLASS_OF(failed);
- Tcl_AppendResult(interp, STR2CSTR(failed), (char*)NULL);
- if (eclass == eTkCallbackBreak) {
- return TCL_BREAK;
- } else if (eclass == eTkCallbackContinue) {
- return TCL_CONTINUE;
- } else {
- return TCL_ERROR;
- }
- }
-
- /* result must be string or nil */
- if (NIL_P(res)) {
- DUMP1("(rb_eval_string result) nil");
- return TCL_OK;
- }
-
- /* copy result to the tcl interpreter */
- DUMP2("(rb_eval_string result) %s", STR2CSTR(res));
- DUMP1("Tcl_AppendResult");
- Tcl_AppendResult(interp, STR2CSTR(res), (char *)NULL);
-
- return TCL_OK;
-}
-
-/* destroy interpreter */
-static void
-ip_free(struct tcltkip *ptr)
-{
- DUMP1("Tcl_DeleteInterp");
- Tcl_DeleteInterp(ptr->ip);
- free(ptr);
-}
-
-/* create and initialize interpreter */
-static VALUE
-ip_new(VALUE self)
-{
- struct tcltkip *ptr; /* tcltkip data struct */
- VALUE obj; /* newly created object */
-
- /* create object */
- obj = Data_Make_Struct(self, struct tcltkip, 0, ip_free, ptr);
- ptr->return_value = 0;
-
- /* from Tk_Main() */
- DUMP1("Tcl_CreateInterp");
- ptr->ip = Tcl_CreateInterp();
-
- /* from Tcl_AppInit() */
- DUMP1("Tcl_Init");
- if (Tcl_Init(ptr->ip) == TCL_ERROR) {
- rb_raise(rb_eRuntimeError, "Tcl_Init");
- }
- DUMP1("Tk_Init");
- if (Tk_Init(ptr->ip) == TCL_ERROR) {
- rb_raise(rb_eRuntimeError, "Tk_Init");
- }
- DUMP1("Tcl_StaticPackage(\"Tk\")");
- Tcl_StaticPackage(ptr->ip, "Tk", Tk_Init,
- (Tcl_PackageInitProc *) NULL);
-
- /* add ruby command to the interpreter */
-#if TCL_MAJOR_VERSION >= 8
- DUMP1("Tcl_CreateObjCommand(\"ruby\")");
- Tcl_CreateObjCommand(ptr->ip, "ruby", ip_ruby, (ClientData *)NULL,
- (Tcl_CmdDeleteProc *)NULL);
-#else
- DUMP1("Tcl_CreateCommand(\"ruby\")");
- Tcl_CreateCommand(ptr->ip, "ruby", ip_ruby, (ClientData *)NULL,
- (Tcl_CmdDeleteProc *)NULL);
-#endif
-
- return obj;
-}
-
-/* eval string in tcl by Tcl_Eval() */
-static VALUE
-ip_eval(VALUE self, VALUE str)
-{
- char *s;
- char *buf; /* Tcl_Eval requires re-writable string region */
- struct tcltkip *ptr; /* tcltkip data struct */
-
- /* get the data struct */
- Data_Get_Struct(self, struct tcltkip, ptr);
-
- /* call Tcl_Eval() */
- s = STR2CSTR(str);
- buf = ALLOCA_N(char, strlen(s)+1);
- strcpy(buf, s);
- DUMP2("Tcl_Eval(%s)", buf);
- ptr->return_value = Tcl_Eval(ptr->ip, buf);
- if (ptr->return_value == TCL_ERROR) {
- rb_raise(rb_eRuntimeError, ptr->ip->result);
- }
- DUMP2("(TCL_Eval result) %d", ptr->return_value);
-
- /* pass back the result (as string) */
- return(rb_str_new2(ptr->ip->result));
-}
-
-
-static VALUE
-ip_toUTF8(VALUE self, VALUE str, VALUE encodename)
-{
-#ifndef TCL_UTF_MAX
- return str;
-#else
- Tcl_Interp *interp;
- Tcl_Encoding encoding;
- Tcl_DString dstr;
- struct tcltkip *ptr;
- char *buff1,*buff2;
-
- Data_Get_Struct(self,struct tcltkip, ptr);
- interp = ptr->ip;
-
- encoding = Tcl_GetEncoding(interp,STR2CSTR(encodename));
- buff1 = ALLOCA_N(char,strlen(STR2CSTR(str))+1);
- strcpy(buff1,STR2CSTR(str));
-
- Tcl_DStringInit(&dstr);
- Tcl_DStringFree(&dstr);
- Tcl_ExternalToUtfDString(encoding,buff1,strlen(buff1),&dstr);
- buff2 = ALLOCA_N(char,Tcl_DStringLength(&dstr)+1);
- strcpy(buff2,Tcl_DStringValue(&dstr));
-
- Tcl_FreeEncoding(encoding);
- Tcl_DStringFree(&dstr);
-
- return rb_str_new2(buff2);
-#endif
-}
-
-static VALUE
-ip_fromUTF8(VALUE self, VALUE str, VALUE encodename)
-{
-#ifndef TCL_UTF_MAX
- return str;
-#else
- Tcl_Interp *interp;
- Tcl_Encoding encoding;
- Tcl_DString dstr;
- struct tcltkip *ptr;
- char *buff1,*buff2;
-
- Data_Get_Struct(self,struct tcltkip, ptr);
- interp = ptr->ip;
-
- encoding = Tcl_GetEncoding(interp,STR2CSTR(encodename));
- buff1 = ALLOCA_N(char,strlen(STR2CSTR(str))+1);
- strcpy(buff1,STR2CSTR(str));
-
- Tcl_DStringInit(&dstr);
- Tcl_DStringFree(&dstr);
- Tcl_UtfToExternalDString(encoding,buff1,strlen(buff1),&dstr);
- buff2 = ALLOCA_N(char,Tcl_DStringLength(&dstr)+1);
- strcpy(buff2,Tcl_DStringValue(&dstr));
-
- Tcl_FreeEncoding(encoding);
- Tcl_DStringFree(&dstr);
-
- return rb_str_new2(buff2);
-#endif
-}
-
-
-static VALUE
-ip_invoke(int argc, VALUE *argv, VALUE obj)
-{
- struct tcltkip *ptr; /* tcltkip data struct */
- int i;
- int object = 0;
- Tcl_CmdInfo info;
- char *cmd;
- char **av = (char **)NULL;
-#if TCL_MAJOR_VERSION >= 8
- Tcl_Obj **ov = (Tcl_Obj **)NULL;
- Tcl_Obj *resultPtr;
-#endif
-
- /* get the data struct */
- Data_Get_Struct(obj, struct tcltkip, ptr);
-
- /* get the command name string */
- cmd = STR2CSTR(argv[0]);
-
- /* map from the command name to a C procedure */
- if (!Tcl_GetCommandInfo(ptr->ip, cmd, &info)) {
- rb_raise(rb_eNameError, "invalid command name `%s'", cmd);
- }
-#if TCL_MAJOR_VERSION >= 8
- object = info.isNativeObjectProc;
-#endif
-
- /* memory allocation for arguments of this command */
- if (object) {
-#if TCL_MAJOR_VERSION >= 8
- /* object interface */
- ov = (Tcl_Obj **)ALLOCA_N(Tcl_Obj *, argc+1);
- for (i = 0; i < argc; ++i) {
- char *s = STR2CSTR(argv[i]);
- ov[i] = Tcl_NewStringObj(s, strlen(s));
- }
- ov[argc] = (Tcl_Obj *)NULL;
-#endif
- } else {
- /* string interface */
- av = (char **)ALLOCA_N(char *, argc+1);
- for (i = 0; i < argc; ++i) {
- char *s = STR2CSTR(argv[i]);
-
- av[i] = ALLOCA_N(char, strlen(s)+1);
- strcpy(av[i], s);
- }
- av[argc] = (char *)NULL;
- }
-
- Tcl_ResetResult(ptr->ip);
-
- /* Invoke the C procedure */
- if (object) {
-#if TCL_MAJOR_VERSION >= 8
- int dummy;
- ptr->return_value = (*info.objProc)(info.objClientData,
- ptr->ip, argc, ov);
-
- /* get the string value from the result object */
- resultPtr = Tcl_GetObjResult(ptr->ip);
- Tcl_SetResult(ptr->ip, Tcl_GetStringFromObj(resultPtr, &dummy),
- TCL_VOLATILE);
-#endif
- } else {
- ptr->return_value = (*info.proc)(info.clientData,
- ptr->ip, argc, av);
- }
-
- if (ptr->return_value == TCL_ERROR) {
- rb_raise(rb_eRuntimeError, ptr->ip->result);
- }
-
- /* pass back the result (as string) */
- return(rb_str_new2(ptr->ip->result));
-}
-
-/* get return code from Tcl_Eval() */
-static VALUE
-ip_retval(VALUE self)
-{
- struct tcltkip *ptr; /* tcltkip data struct */
-
- /* get the data strcut */
- Data_Get_Struct(self, struct tcltkip, ptr);
-
- return (INT2FIX(ptr->return_value));
-}
-
-#ifdef __MACOS__
-static void
-_macinit()
-{
- tcl_macQdPtr = &qd; /* setup QuickDraw globals */
- Tcl_MacSetEventProc(TkMacConvertEvent); /* setup event handler */
-}
-#endif
-
-/*---- initialization ----*/
-void Init_tcltklib()
-{
- extern VALUE rb_argv0; /* the argv[0] */
-
- VALUE lib = rb_define_module("TclTkLib");
- VALUE ip = rb_define_class("TclTkIp", rb_cObject);
-
- eTkCallbackBreak = rb_define_class("TkCallbackBreak", rb_eStandardError);
- eTkCallbackContinue = rb_define_class("TkCallbackContinue",rb_eStandardError);
-
- rb_define_module_function(lib, "mainloop", lib_mainloop, 0);
-
- rb_define_singleton_method(ip, "new", ip_new, 0);
- rb_define_method(ip, "_eval", ip_eval, 1);
- rb_define_method(ip, "_toUTF8",ip_toUTF8,2);
- rb_define_method(ip, "_fromUTF8",ip_fromUTF8,2);
- rb_define_method(ip, "_invoke", ip_invoke, -1);
- rb_define_method(ip, "_return_value", ip_retval, 0);
- rb_define_method(ip, "mainloop", lib_mainloop, 0);
-
-#ifdef __MACOS__
- _macinit();
-#endif
-
- /*---- initialize tcl/tk libraries ----*/
- /* from Tk_Main() */
- DUMP1("Tcl_FindExecutable");
- Tcl_FindExecutable(RSTRING(rb_argv0)->ptr);
-}
-
-/* eof */
generated by cgit v1.2.3 (git 2.25.1) at 2026-06-05 21:23:08 +0000