sample1.rb

ruby的源代码

#! /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("{}")