DEFINITIONS
This source file includes following functions.
1 #! /usr/local/bin/ruby -d
2 #! /usr/local/bin/ruby
3 # -d オプションを付けると, デバッグ情報を表示する.
4
5 # tcltk ライブラリのサンプル
6
7 # まず, ライブラリを require する.
8 require "tcltk"
9
10 # 以下は, Test1 のインスタンスの initialize() で,
11 # tcl/tk に関する処理を行う例である.
12 # 必ずしもそのようにする必要は無く,
13 # (もし, そうしたければ) class の外で tcl/tk に関する処理を行っても良い.
14
15 class Test1
16 # 初期化(インタプリタを生成してウィジェットを生成する).
17 def initialize()
18
19 #### 使う前のおまじない
20
21 # インタプリタの生成.
22 ip = TclTkInterpreter.new()
23 # コマンドに対応するオブジェクトを c に設定しておく.
24 c = ip.commands()
25 # 使用するコマンドに対応するオブジェクトは変数に入れておく.
26 append, bind, button, destroy, incr, info, label, place, set, wm =
27 c.indexes(
28 "append", "bind", "button", "destroy", "incr", "info", "label", "place",
29 "set", "wm")
30
31 #### tcl/tk のコマンドに対応するオブジェクト(TclTkCommand)の操作
32
33 # 実行する時は, e() メソッドを使う.
34 # (以下は, tcl/tk における info command r* を実行.)
35 print info.e("command", "r*"), "\n"
36 # 引数は, まとめた文字列にしても同じ.
37 print info.e("command r*"), "\n"
38 # 変数を用いなくとも実行できるが, 見ためが悪い.
39 print c["info"].e("command", "r*"), "\n"
40 # インタプリタのメソッドとしても実行できるが, 効率が悪い.
41 print ip.info("command", "r*"), "\n"
42
43 ####
44
45 # 以下, 生成したオブジェクトは変数に代入しておかないと
46 # GC の対象になってしまう.
47
48 #### tcl/tk の変数に対応するオブジェクト(TclTkVariable)の操作
49
50 # 生成と同時に値を設定する.
51 v1 = TclTkVariable.new(ip, "20")
52 # 読み出しは get メソッドを使う.
53 print v1.get(), "\n"
54 # 設定は set メソッドを使う.
55 v1.set(40)
56 print v1.get(), "\n"
57 # set コマンドを使って読み出し, 設定は可能だが見ためが悪い.
58 # e() メソッド等の引数に直接 TclTkObject や数値を書いても良い.
59 set.e(v1, 30)
60 print set.e(v1), "\n"
61 # tcl/tk のコマンドで変数を操作できる.
62 incr.e(v1)
63 print v1.get(), "\n"
64 append.e(v1, 10)
65 print v1.get(), "\n"
66
67 #### tcl/tk のウィジェットに対応するオブジェクト(TclTkWidget)の操作
68
69 # ルートウィジェットを取り出す.
70 root = ip.rootwidget()
71 # ウィジェットの操作.
72 root.e("configure -height 300 -width 300")
73 # タイトルを付けるときは wm を使う.
74 wm.e("title", root, $0)
75 # 親ウィジェットとコマンドを指定して, ウィジェットを作る.
76 l1 = TclTkWidget.new(ip, root, label, "-text {type `x' to print}")
77 # place すると表示される.
78 place.e(l1, "-x 0 -rely 0.0 -relwidth 1 -relheight 0.1")
79 # コマンド名は文字列で指定しても良いが, 見ためが悪い.
80 # (コマンド名は独立した引数でなければならない.)
81 l2 = TclTkWidget.new(ip, root, "label")
82 # ウィジェットの操作.
83 l2.e("configure -text {type `q' to exit}")
84 place.e(l2, "-x 0 -rely 0.1 -relwidth 1 -relheight 0.1")
85
86 #### tcl/tk のコールバックに対応するオブジェクト(TclTkCallback)の操作
87
88 # コールバックを生成する.
89 c1 = TclTkCallback.new(ip, proc{sample(ip, root)})
90 # コールバックを持つウィジェットを生成する.
91 b1 = TclTkWidget.new(ip, root, button, "-text sample -command", c1)
92 place.e(b1, "-x 0 -rely 0.2 -relwidth 1 -relheight 0.1")
93 # イベントループを抜けるには destroy.e(root) する.
94 c2 = TclTkCallback.new(ip, proc{destroy.e(root)})
95 b2 = TclTkWidget.new(ip, root, button, "-text exit -command", c2)
96 place.e(b2, "-x 0 -rely 0.3 -relwidth 1 -relheight 0.1")
97
98 #### イベントのバインド
99 # script の追加 (bind tag sequence +script) は今のところできない.
100 # (イテレータ変数の設定がうまくいかない.)
101
102 # 基本的にはウィジェットに対するコールバックと同じ.
103 c3 = TclTkCallback.new(ip, proc{print("q pressed\n"); destroy.e(root)})
104 bind.e(root, "q", c3)
105 # bind コマンドで % 置換によりパラメータを受け取りたいときは,
106 # proc{} の後ろに文字列で指定すると,
107 # 置換結果をイテレータ変数を通して受け取ることができる.
108 # ただし proc{} の後ろの文字列は,
109 # bind コマンドに与えるコールバック以外で指定してはいけない.
110 c4 = TclTkCallback.new(ip, proc{|i| print("#{i} pressed\n")}, "%A")
111 bind.e(root, "x", c4)
112 # TclTkCallback を GC の対象にしたければ,
113 # dcb() (または deletecallbackkeys()) する必要がある.
114 cb = [c1, c2, c3, c4]
115 c5 = TclTkCallback.new(ip, proc{|w| TclTk.dcb(cb, root, w)}, "%W")
116 bind.e(root, "<Destroy>", c5)
117 cb.push(c5)
118
119 #### tcl/tk のイメージに対応するオブジェクト(TclTkImage)の操作
120
121 # データを指定して生成する.
122 i1 = TclTkImage.new(ip, "photo", "-file maru.gif")
123 # ラベルに張り付けてみる.
124 l3 = TclTkWidget.new(ip, root, label, "-relief raised -image", i1)
125 place.e(l3, "-x 0 -rely 0.4 -relwidth 0.2 -relheight 0.2")
126 # 空のイメージを生成して後で操作する.
127 i2 = TclTkImage.new(ip, "photo")
128 # イメージを操作する.
129 i2.e("copy", i1)
130 i2.e("configure -gamma 0.5")
131 l4 = TclTkWidget.new(ip, root, label, "-relief raised -image", i2)
132 place.e(l4, "-relx 0.2 -rely 0.4 -relwidth 0.2 -relheight 0.2")
133
134 ####
135 end
136
137 # サンプルのためのウィジェットを生成する.
138 def sample(ip, parent)
139 bind, button, destroy, grid, toplevel, wm = ip.commands().indexes(
140 "bind", "button", "destroy", "grid", "toplevel", "wm")
141
142 ## toplevel
143
144 # 新しいウインドウを開くには, toplevel を使う.
145 t1 = TclTkWidget.new(ip, parent, toplevel)
146 # タイトルを付けておく
147 wm.e("title", t1, "sample")
148
149 # ウィジェットが破壊されたとき, コールバックが GC の対象になるようにする.
150 cb = []
151 cb.push(c = TclTkCallback.new(ip, proc{|w| TclTk.dcb(cb, t1, w)}, "%W"))
152 bind.e(t1, "<Destroy>", c)
153
154 # ボタンの生成.
155 wid = []
156 # toplevel ウィジェットを破壊するには destroy する.
157 cb.push(c = TclTkCallback.new(ip, proc{destroy.e(t1)}))
158 wid.push(TclTkWidget.new(ip, t1, button, "-text close -command", c))
159 cb.push(c = TclTkCallback.new(ip, proc{test_label(ip, t1)}))
160 wid.push(TclTkWidget.new(ip, t1, button, "-text label -command", c))
161 cb.push(c = TclTkCallback.new(ip, proc{test_button(ip, t1)}))
162 wid.push(TclTkWidget.new(ip, t1, button, "-text button -command", c))
163 cb.push(c = TclTkCallback.new(ip, proc{test_checkbutton(ip, t1)}))
164 wid.push(TclTkWidget.new(ip, t1, button, "-text checkbutton -command", c))
165 cb.push(c = TclTkCallback.new(ip, proc{test_radiobutton(ip, t1)}))
166 wid.push(TclTkWidget.new(ip, t1, button, "-text radiobutton -command", c))
167 cb.push(c = TclTkCallback.new(ip, proc{test_scale(ip, t1)}))
168 wid.push(TclTkWidget.new(ip, t1, button, "-text scale -command", c))
169 cb.push(c = TclTkCallback.new(ip, proc{test_entry(ip, t1)}))
170 wid.push(TclTkWidget.new(ip, t1, button, "-text entry -command", c))
171 cb.push(c = TclTkCallback.new(ip, proc{test_text(ip, t1)}))
172 wid.push(TclTkWidget.new(ip, t1, button, "-text text -command", c))
173 cb.push(c = TclTkCallback.new(ip, proc{test_raise(ip, t1)}))
174 wid.push(TclTkWidget.new(ip, t1, button, "-text raise/lower -command", c))
175 cb.push(c = TclTkCallback.new(ip, proc{test_modal(ip, t1)}))
176 wid.push(TclTkWidget.new(ip, t1, button, "-text message/modal -command",
177 c))
178 cb.push(c = TclTkCallback.new(ip, proc{test_menu(ip, t1)}))
179 wid.push(TclTkWidget.new(ip, t1, button, "-text menu -command", c))
180 cb.push(c = TclTkCallback.new(ip, proc{test_listbox(ip, t1)}))
181 wid.push(TclTkWidget.new(ip, t1, button, "-text listbox/scrollbar",
182 "-command", c))
183 cb.push(c = TclTkCallback.new(ip, proc{test_canvas(ip, t1)}))
184 wid.push(TclTkWidget.new(ip, t1, button, "-text canvas -command", c))
185
186 # grid で表示する.
187 ro = co = 0
188 wid.each{|w|
189 grid.e(w, "-row", ro, "-column", co, "-sticky news")
190 ro += 1
191 if ro == 7
192 ro = 0
193 co += 1
194 end
195 }
196 end
197
198 # inittoplevel(ip, parent, title)
199 # 以下の処理をまとめて行う.
200 # 1. toplevel ウィジェットを作成する.
201 # 2. コールバックを登録する配列を用意し, toplevel ウィジェットの
202 # <Destroy> イベントにコールバックを削除する手続きを登録する.
203 # 3. クローズボタンを作る.
204 # 作成した toplevel ウィジェット, クローズボタン, コールバック登録用変数
205 # を返す.
206 # ip: インタプリタ
207 # parent: 親ウィジェット
208 # title: toplevel ウィジェットのウインドウのタイトル
209 def inittoplevel(ip, parent, title)
210 bind, button, destroy, toplevel, wm = ip.commands().indexes(
211 "bind", "button", "destroy", "toplevel", "wm")
212
213 # 新しいウインドウを開くには, toplevel を使う.
214 t1 = TclTkWidget.new(ip, parent, toplevel)
215 # タイトルを付けておく
216 wm.e("title", t1, title)
217
218 # ウィジェットが破壊されたとき, コールバックが GC の対象になるようにする.
219 cb = []
220 cb.push(c = TclTkCallback.new(ip, proc{|w| TclTk.dcb(cb, t1, w)}, "%W"))
221 bind.e(t1, "<Destroy>", c)
222 # close ボタンを作っておく.
223 # toplevel ウィジェットを破壊するには destroy する.
224 cb.push(c = TclTkCallback.new(ip, proc{destroy.e(t1)}))
225 b1 = TclTkWidget.new(ip, t1, button, "-text close -command", c)
226
227 return t1, b1, cb
228 end
229
230 # label のサンプル.
231 def test_label(ip, parent)
232 button, global, label, pack = ip.commands().indexes(
233 "button", "global", "label", "pack")
234 t1, b1, cb = inittoplevel(ip, parent, "label")
235
236 ## label
237
238 # いろいろな形のラベル.
239 l1 = TclTkWidget.new(ip, t1, label, "-text {default(flat)}")
240 l2 = TclTkWidget.new(ip, t1, label, "-text raised -relief raised")
241 l3 = TclTkWidget.new(ip, t1, label, "-text sunken -relief sunken")
242 l4 = TclTkWidget.new(ip, t1, label, "-text groove -relief groove")
243 l5 = TclTkWidget.new(ip, t1, label, "-text ridge -relief ridge")
244 l6 = TclTkWidget.new(ip, t1, label, "-bitmap error")
245 l7 = TclTkWidget.new(ip, t1, label, "-bitmap questhead")
246
247 # pack しても表示される.
248 pack.e(b1, l1, l2, l3, l4, l5, l6, l7, "-pady 3")
249
250 ## -textvariable
251
252 # tcltk ライブラリの実装では, コールバックは tcl/tk の``手続き''を通して
253 # 呼ばれる. したがって, コールバックの中で(大域)変数にアクセスするときは,
254 # global する必要がある.
255 # global する前に変数に値を設定してしまうとエラーになるので,
256 # tcl/tk における表現形だけ生成して, 実際に値を設定しないように,
257 # 2 番目の引数には nil を与える.
258 v1 = TclTkVariable.new(ip, nil)
259 global.e(v1)
260 v1.set(100)
261 # -textvariable で変数を設定する.
262 l6 = TclTkWidget.new(ip, t1, label, "-textvariable", v1)
263 # コールバックの中から変数を操作する.
264 cb.push(c = TclTkCallback.new(ip, proc{
265 global.e(v1); v1.set(v1.get().to_i + 10)}))
266 b2 = TclTkWidget.new(ip, t1, button, "-text +10 -command", c)
267 cb.push(c = TclTkCallback.new(ip, proc{
268 global.e(v1); v1.set(v1.get().to_i - 10)}))
269 b3 = TclTkWidget.new(ip, t1, button, "-text -10 -command", c)
270 pack.e(l6, b2, b3)
271 end
272
273 # button のサンプル.
274 def test_button(ip, parent)
275 button, pack = ip.commands().indexes("button", "pack")
276 t1, b1, cb = inittoplevel(ip, parent, "button")
277
278 ## button
279
280 # コールバック内で参照する変数は先に宣言しておかなければならない.
281 b3 = b4 = nil
282 cb.push(c = TclTkCallback.new(ip, proc{b3.e("flash"); b4.e("flash")}))
283 b2 = TclTkWidget.new(ip, t1, button, "-text flash -command", c)
284 cb.push(c = TclTkCallback.new(ip, proc{b2.e("configure -state normal")}))
285 b3 = TclTkWidget.new(ip, t1, button, "-text normal -command", c)
286 cb.push(c = TclTkCallback.new(ip, proc{b2.e("configure -state disabled")}))
287 b4 = TclTkWidget.new(ip, t1, button, "-text disable -command", c)
288 pack.e(b1, b2, b3, b4)
289 end
290
291 # checkbutton のサンプル.
292 def test_checkbutton(ip, parent)
293 checkbutton, global, pack = ip.commands().indexes(
294 "checkbutton", "global", "pack")
295 t1, b1, cb = inittoplevel(ip, parent, "checkbutton")
296
297 ## checkbutton
298
299 v1 = TclTkVariable.new(ip, nil)
300 global.e(v1)
301 # -variable で変数を設定する.
302 ch1 = TclTkWidget.new(ip, t1, checkbutton, "-onvalue on -offvalue off",
303 "-textvariable", v1, "-variable", v1)
304 pack.e(b1, ch1)
305 end
306
307 # radiobutton のサンプル.
308 def test_radiobutton(ip, parent)
309 global, label, pack, radiobutton = ip.commands().indexes(
310 "global", "label", "pack", "radiobutton")
311 t1, b1, cb = inittoplevel(ip, parent, "radiobutton")
312
313 ## radiobutton
314
315 v1 = TclTkVariable.new(ip, nil)
316 global.e(v1)
317 # ヌルストリングは "{}" で指定する.
318 v1.set("{}")
319 l1 = TclTkWidget.new(ip, t1, label, "-textvariable", v1)
320 # -variable で同じ変数を指定すると同じグループになる.
321 ra1 = TclTkWidget.new(ip, t1, radiobutton,
322 "-text radio1 -value r1 -variable", v1)
323 ra2 = TclTkWidget.new(ip, t1, radiobutton,
324 "-text radio2 -value r2 -variable", v1)
325 cb.push(c = TclTkCallback.new(ip, proc{global.e(v1); v1.set("{}")}))
326 ra3 = TclTkWidget.new(ip, t1, radiobutton,
327 "-text clear -value r3 -variable", v1, "-command", c)
328 pack.e(b1, l1, ra1, ra2, ra3)
329 end
330
331 # scale のサンプル.
332 def test_scale(ip, parent)
333 global, pack, scale = ip.commands().indexes(
334 "global", "pack", "scale")
335 t1, b1, cb = inittoplevel(ip, parent, "scale")
336
337 ## scale
338
339 v1 = TclTkVariable.new(ip, nil)
340 global.e(v1)
341 v1.set(219)
342 # コールバック内で参照する変数は先に宣言しておかなければならない.
343 sca1 = nil
344 cb.push(c = TclTkCallback.new(ip, proc{global.e(v1); v = v1.get();
345 sca1.e("configure -background", format("#%02x%02x%02x", v, v, v))}))
346 sca1 = TclTkWidget.new(ip, t1, scale,
347 "-label scale -orient h -from 0 -to 255 -variable", v1, "-command", c)
348 pack.e(b1, sca1)
349 end
350
351 # entry のサンプル.
352 def test_entry(ip, parent)
353 button, entry, global, pack = ip.commands().indexes(
354 "button", "entry", "global", "pack")
355 t1, b1, cb = inittoplevel(ip, parent, "entry")
356
357 ## entry
358
359 v1 = TclTkVariable.new(ip, nil)
360 global.e(v1)
361 # ヌルストリングは "{}" で指定する.
362 v1.set("{}")
363 en1 = TclTkWidget.new(ip, t1, entry, "-textvariable", v1)
364 cb.push(c = TclTkCallback.new(ip, proc{
365 global.e(v1); print(v1.get(), "\n"); v1.set("{}")}))
366 b2 = TclTkWidget.new(ip, t1, button, "-text print -command", c)
367 pack.e(b1, en1, b2)
368 end
369
370 # text のサンプル.
371 def test_text(ip, parent)
372 button, pack, text = ip.commands().indexes(
373 "button", "pack", "text")
374 t1, b1, cb = inittoplevel(ip, parent, "text")
375
376 ## text
377
378 te1 = TclTkWidget.new(ip, t1, text)
379 cb.push(c = TclTkCallback.new(ip, proc{
380 # 1 行目の 0 文字目から最後までを表示し, 削除する.
381 print(te1.e("get 1.0 end")); te1.e("delete 1.0 end")}))
382 b2 = TclTkWidget.new(ip, t1, button, "-text print -command", c)
383 pack.e(b1, te1, b2)
384 end
385
386 # raise/lower のサンプル.
387 def test_raise(ip, parent)
388 button, frame, lower, pack, raise = ip.commands().indexes(
389 "button", "frame", "lower", "pack", "raise")
390 t1, b1, cb = inittoplevel(ip, parent, "raise/lower")
391
392 ## raise/lower
393
394 # button を隠すテストのために, frame を使う.
395 f1 = TclTkWidget.new(ip, t1, frame)
396 # コールバック内で参照する変数は先に宣言しておかなければならない.
397 b2 = nil
398 cb.push(c = TclTkCallback.new(ip, proc{raise.e(f1, b2)}))
399 b2 = TclTkWidget.new(ip, t1, button, "-text raise -command", c)
400 cb.push(c = TclTkCallback.new(ip, proc{lower.e(f1, b2)}))
401 b3 = TclTkWidget.new(ip, t1, button, "-text lower -command", c)
402 lower.e(f1, b3)
403
404 pack.e(b2, b3, "-in", f1)
405 pack.e(b1, f1)
406 end
407
408 # modal なウィジェットのサンプル.
409 def test_modal(ip, parent)
410 button, frame, message, pack, tk_chooseColor, tk_getOpenFile,
411 tk_messageBox = ip.commands().indexes(
412 "button", "frame", "message", "pack", "tk_chooseColor",
413 "tk_getOpenFile", "tk_messageBox")
414 # 最初に load されていないライブラリは ip.commands() に存在しないので,
415 # TclTkLibCommand を生成する必要がある.
416 tk_dialog = TclTkLibCommand.new(ip, "tk_dialog")
417 t1, b1, cb = inittoplevel(ip, parent, "message/modal")
418
419 ## message
420
421 mes = "これは message ウィジェットのテストです."
422 mes += "以下は modal なウィジェットのテストです."
423 me1 = TclTkWidget.new(ip, t1, message, "-text {#{mes}}")
424
425 ## modal
426
427 # tk_messageBox
428 cb.push(c = TclTkCallback.new(ip, proc{
429 print tk_messageBox.e("-type yesnocancel -message messageBox",
430 "-icon error -default cancel -title messageBox"), "\n"}))
431 b2 = TclTkWidget.new(ip, t1, button, "-text messageBox -command", c)
432 # tk_dialog
433 cb.push(c = TclTkCallback.new(ip, proc{
434 # ウィジェット名を生成するためにダミーの frame を生成.
435 print tk_dialog.e(TclTkWidget.new(ip, t1, frame),
436 "dialog dialog error 2 yes no cancel"), "\n"}))
437 b3 = TclTkWidget.new(ip, t1, button, "-text dialog -command", c)
438 # tk_chooseColor
439 cb.push(c = TclTkCallback.new(ip, proc{
440 print tk_chooseColor.e("-title chooseColor"), "\n"}))
441 b4 = TclTkWidget.new(ip, t1, button, "-text chooseColor -command", c)
442 # tk_getOpenFile
443 cb.push(c = TclTkCallback.new(ip, proc{
444 print tk_getOpenFile.e("-defaultextension .rb",
445 "-filetypes {{{Ruby Script} {.rb}} {{All Files} {*}}}",
446 "-title getOpenFile"), "\n"}))
447 b5 = TclTkWidget.new(ip, t1, button, "-text getOpenFile -command", c)
448
449 pack.e(b1, me1, b2, b3, b4, b5)
450 end
451
452 # menu のサンプル.
453 def test_menu(ip, parent)
454 global, menu, menubutton, pack = ip.commands().indexes(
455 "global", "menu", "menubutton", "pack")
456 tk_optionMenu = TclTkLibCommand.new(ip, "tk_optionMenu")
457 t1, b1, cb = inittoplevel(ip, parent, "menu")
458
459 ## menu
460
461 # menubutton を生成する.
462 mb1 = TclTkWidget.new(ip, t1, menubutton, "-text menu")
463 # menu を生成する.
464 me1 = TclTkWidget.new(ip, mb1, menu)
465 # mb1 から me1 が起動されるようにする.
466 mb1.e("configure -menu", me1)
467
468 # cascade で起動される menu を生成する.
469 me11 = TclTkWidget.new(ip, me1, menu)
470 # radiobutton のサンプル.
471 v1 = TclTkVariable.new(ip, nil); global.e(v1); v1.set("r1")
472 me11.e("add radiobutton -label radio1 -value r1 -variable", v1)
473 me11.e("add radiobutton -label radio2 -value r2 -variable", v1)
474 me11.e("add radiobutton -label radio3 -value r3 -variable", v1)
475 # cascade により mb11 が起動されるようにする.
476 me1.e("add cascade -label cascade -menu", me11)
477
478 # checkbutton のサンプル.
479 v2 = TclTkVariable.new(ip, nil); global.e(v2); v2.set("none")
480 me1.e("add checkbutton -label check -variable", v2)
481 # separator のサンプル.
482 me1.e("add separator")
483 # command のサンプル.
484 v3 = nil
485 cb.push(c = TclTkCallback.new(ip, proc{
486 global.e(v1, v2, v3); print "v1: ", v1.get(), ", v2: ", v2.get(),
487 ", v3: ", v3.get(), "\n"}))
488 me1.e("add command -label print -command", c)
489
490 ## tk_optionMenu
491
492 v3 = TclTkVariable.new(ip, nil); global.e(v3); v3.set("opt2")
493 om1 = TclTkWidget.new(ip, t1, tk_optionMenu, v3, "opt1 opt2 opt3 opt4")
494
495 pack.e(b1, mb1, om1, "-side left")
496 end
497
498 # listbox のサンプル.
499 def test_listbox(ip, parent)
500 clipboard, frame, grid, listbox, lower, menu, menubutton, pack, scrollbar,
501 selection = ip.commands().indexes(
502 "clipboard", "frame", "grid", "listbox", "lower", "menu", "menubutton",
503 "pack", "scrollbar", "selection")
504 t1, b1, cb = inittoplevel(ip, parent, "listbox")
505
506 ## listbox/scrollbar
507
508 f1 = TclTkWidget.new(ip, t1, frame)
509 # コールバック内で参照する変数は先に宣言しておかなければならない.
510 li1 = sc1 = sc2 = nil
511 # 実行時に, 後ろにパラメータがつくコールバックは,
512 # イテレータ変数でそのパラメータを受け取ることができる.
513 # (複数のパラメータはひとつの文字列にまとめられる.)
514 cb.push(c1 = TclTkCallback.new(ip, proc{|i| li1.e("xview", i)}))
515 cb.push(c2 = TclTkCallback.new(ip, proc{|i| li1.e("yview", i)}))
516 cb.push(c3 = TclTkCallback.new(ip, proc{|i| sc1.e("set", i)}))
517 cb.push(c4 = TclTkCallback.new(ip, proc{|i| sc2.e("set", i)}))
518 # listbox
519 li1 = TclTkWidget.new(ip, f1, listbox,
520 "-xscrollcommand", c3, "-yscrollcommand", c4,
521 "-selectmode extended -exportselection true")
522 for i in 1..20
523 li1.e("insert end {line #{i} line #{i} line #{i} line #{i} line #{i}}")
524 end
525 # scrollbar
526 sc1 = TclTkWidget.new(ip, f1, scrollbar, "-orient horizontal -command", c1)
527 sc2 = TclTkWidget.new(ip, f1, scrollbar, "-orient vertical -command", c2)
528
529 ## selection/clipboard
530
531 mb1 = TclTkWidget.new(ip, t1, menubutton, "-text edit")
532 me1 = TclTkWidget.new(ip, mb1, menu)
533 mb1.e("configure -menu", me1)
534 cb.push(c = TclTkCallback.new(ip, proc{
535 # clipboard をクリア.
536 clipboard.e("clear")
537 # selection から文字列を読み込み clipboard に追加する.
538 clipboard.e("append {#{selection.e('get')}}")}))
539 me1.e("add command -label {selection -> clipboard} -command",c)
540 cb.push(c = TclTkCallback.new(ip, proc{
541 # li1 をクリア.
542 li1.e("delete 0 end")
543 # clipboard から文字列を取り出し, 1 行ずつ
544 selection.e("get -selection CLIPBOARD").split(/\n/).each{|line|
545 # li1 に挿入する.
546 li1.e("insert end {#{line}}")}}))
547 me1.e("add command -label {clipboard -> listbox} -command",c)
548
549 grid.e(li1, "-row 0 -column 0 -sticky news")
550 grid.e(sc1, "-row 1 -column 0 -sticky ew")
551 grid.e(sc2, "-row 0 -column 1 -sticky ns")
552 grid.e("rowconfigure", f1, "0 -weight 100")
553 grid.e("columnconfigure", f1, "0 -weight 100")
554 f2 = TclTkWidget.new(ip, t1, frame)
555 lower.e(f2, b1)
556 pack.e(b1, mb1, "-in", f2, "-side left")
557 pack.e(f2, f1)
558 end
559
560 # canvas のサンプル.
561 def test_canvas(ip, parent)
562 canvas, lower, pack = ip.commands().indexes("canvas", "lower", "pack")
563 t1, b1, cb = inittoplevel(ip, parent, "canvas")
564
565 ## canvas
566
567 ca1 = TclTkWidget.new(ip, t1, canvas, "-width 400 -height 300")
568 lower.e(ca1, b1)
569 # rectangle を作る.
570 idr = ca1.e("create rectangle 10 10 20 20")
571 # oval を作る.
572 ca1.e("create oval 60 10 100 50")
573 # polygon を作る.
574 ca1.e("create polygon 110 10 110 30 140 10")
575 # line を作る.
576 ca1.e("create line 150 10 150 30 190 10")
577 # arc を作る.
578 ca1.e("create arc 200 10 250 50 -start 0 -extent 90 -style pieslice")
579 # i1 は本当は, どこかで破壊しなければならないが, 面倒なので放ってある.
580 i1 = TclTkImage.new(ip, "photo", "-file maru.gif")
581 # image を作る.
582 ca1.e("create image 100 100 -image", i1)
583 # bitmap を作る.
584 ca1.e("create bitmap 260 50 -bitmap questhead")
585 # text を作る.
586 ca1.e("create text 320 50 -text {drag rectangle}")
587 # window を作る(クローズボタン).
588 ca1.e("create window 200 200 -window", b1)
589
590 # bind により rectangle を drag できるようにする.
591 cb.push(c = TclTkCallback.new(ip, proc{|i|
592 # i に x と y を受け取るので, 取り出す.
593 x, y = i.split(/ /); x = x.to_f; y = y.to_f
594 # 座標を変更する.
595 ca1.e("coords current #{x - 5} #{y - 5} #{x + 5} #{y + 5}")},
596 # x, y 座標を空白で区切ったものをイテレータ変数へ渡すように指定.
597 "%x %y"))
598 # rectangle に bind する.
599 ca1.e("bind", idr, "<B1-Motion>", c)
600
601 pack.e(ca1)
602 end
603 end
604
605 # test driver
606
607 if ARGV.size == 0
608 print "#{$0} n で, n 個のインタプリタを起動します.\n"
609 n = 1
610 else
611 n = ARGV[0].to_i
612 end
613
614 print "start\n"
615 ip = []
616
617 # インタプリタ, ウィジェット等の生成.
618 for i in 1 .. n
619 ip.push(Test1.new())
620 end
621
622 # 用意ができたらイベントループに入る.
623 TclTk.mainloop()
624 print "exit from mainloop\n"
625
626 # インタプリタが GC されるかのテスト.
627 ip = []
628 print "GC.start\n" if $DEBUG
629 GC.start() if $DEBUG
630 print "end\n"
631
632 exit
633
634 # end