sample1.rb

ruby的源代码

    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