diff options
Diffstat (limited to 'ext/tcltklib')
-rw-r--r-- | ext/tcltklib/MANIFEST | 15 | ||||
-rw-r--r-- | ext/tcltklib/MANUAL.euc | 124 | ||||
-rw-r--r-- | ext/tcltklib/README.euc | 133 | ||||
-rw-r--r-- | ext/tcltklib/demo/lines0.tcl | 42 | ||||
-rw-r--r-- | ext/tcltklib/demo/lines1.rb | 54 | ||||
-rw-r--r-- | ext/tcltklib/demo/lines2.rb | 50 | ||||
-rw-r--r-- | ext/tcltklib/depend | 1 | ||||
-rw-r--r-- | ext/tcltklib/extconf.rb | 79 | ||||
-rw-r--r-- | ext/tcltklib/lib/tcltk.rb | 388 | ||||
-rw-r--r-- | ext/tcltklib/sample/batsu.gif | bin | 0 -> 538 bytes | |||
-rw-r--r-- | ext/tcltklib/sample/maru.gif | bin | 0 -> 481 bytes | |||
-rw-r--r-- | ext/tcltklib/sample/sample0.rb | 39 | ||||
-rw-r--r-- | ext/tcltklib/sample/sample1.rb | 634 | ||||
-rw-r--r-- | ext/tcltklib/sample/sample2.rb | 449 | ||||
-rw-r--r-- | ext/tcltklib/tcltklib.c | 216 |
15 files changed, 2224 insertions, 0 deletions
diff --git a/ext/tcltklib/MANIFEST b/ext/tcltklib/MANIFEST new file mode 100644 index 0000000000..b5e88278e0 --- /dev/null +++ b/ext/tcltklib/MANIFEST @@ -0,0 +1,15 @@ +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 new file mode 100644 index 0000000000..789e85a9de --- /dev/null +++ b/ext/tcltklib/MANUAL.euc @@ -0,0 +1,124 @@ +(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 new file mode 100644 index 0000000000..290ffb0b60 --- /dev/null +++ b/ext/tcltklib/README.euc @@ -0,0 +1,133 @@ +(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 ([email protected]) ��ˤ�� + (`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 ���ץ�Dz�ǽ�ʤ��Ȥ� + + �ۤȤ�� + + 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 new file mode 100644 index 0000000000..8ed3c5e1c1 --- /dev/null +++ b/ext/tcltklib/demo/lines0.tcl @@ -0,0 +1,42 @@ +#! /usr/local/bin/wish + +proc drawlines {} { + puts [clock format [clock seconds]] + + for {set j 0} {$j < 100} {incr j} { + puts -nonewline "*" + flush stdout + if {$j & 1} { + set c "blue" + } { + set c "red" + } + for {set i 0} {$i < 100} {incr i} { +# .a create line $i 0 0 [expr 500 - $i] -fill $c + } + } + + puts [clock format [clock seconds]] + + for {set j 0} {$j < 100} {incr j} { + puts -nonewline "*" + flush stdout + if {$j & 1} { + set c "blue" + } { + set c "red" + } + for {set i 0} {$i < 100} {incr i} { + .a create line $i 0 0 [expr 500 - $i] -fill $c + } + } + + puts [clock format [clock seconds]] +# destroy . +} + +canvas .a -height 500 -width 500 +button .b -text draw -command drawlines +pack .a .b -side left + +# eof diff --git a/ext/tcltklib/demo/lines1.rb b/ext/tcltklib/demo/lines1.rb new file mode 100644 index 0000000000..e459589f50 --- /dev/null +++ b/ext/tcltklib/demo/lines1.rb @@ -0,0 +1,54 @@ +#! /usr/local/bin/ruby + +require "tk" + +def drawlines() + print Time.now, "\n" + + for j in 0 .. 99 + print "*" + $stdout.flush + if (j & 1) != 0 + col = "blue" + else + col = "red" + end + for i in 0 .. 99 +# TkcLine.new($a, i, 0, 0, 500 - i, "-fill", col) + end + end + + print Time.now, "\n" + + for j in 0 .. 99 + print "*" + $stdout.flush + if (j & 1) != 0 + col = "blue" + else + col = "red" + end + for i in 0 .. 99 + TkcLine.new($a, i, 0, 0, 500 - i, "-fill", col) + end + end + + print Time.now, "\n" +# Tk.root.destroy +end + +$a = TkCanvas.new{ + height(500) + width(500) +} + +$b = TkButton.new{ + text("draw") + command(proc{drawlines()}) +} + +TkPack.configure($a, $b, {"side"=>"left"}) + +Tk.mainloop + +# eof diff --git a/ext/tcltklib/demo/lines2.rb b/ext/tcltklib/demo/lines2.rb new file mode 100644 index 0000000000..9f21ae6377 --- /dev/null +++ b/ext/tcltklib/demo/lines2.rb @@ -0,0 +1,50 @@ +#! /usr/local/bin/ruby + +require "tcltk" + +def drawlines() + print Time.now, "\n" + + for j in 0 .. 99 + print "*" + $stdout.flush + if (j & 1) != 0 + col = "blue" + else + col = "red" + end + for i in 0 .. 99 +# $a.e("create line", i, 0, 0, 500 - i, "-fill", col) + end + end + + print Time.now, "\n" + + for j in 0 .. 99 + print "*" + $stdout.flush + if (j & 1) != 0 + col = "blue" + else + col = "red" + end + for i in 0 .. 99 + $a.e("create line", i, 0, 0, 500 - i, "-fill", col) + end + end + + print Time.now, "\n" +# $ip.commands()["destroy"].e($root) +end + +$ip = TclTkInterpreter.new() +$root = $ip.rootwidget() +$a = TclTkWidget.new($ip, $root, "canvas", "-height 500 -width 500") +$c = TclTkCallback.new($ip, proc{drawlines()}) +$b = TclTkWidget.new($ip, $root, "button", "-text draw -command", $c) + +$ip.commands()["pack"].e($a, $b, "-side left") + +TclTk.mainloop + +# eof diff --git a/ext/tcltklib/depend b/ext/tcltklib/depend new file mode 100644 index 0000000000..71d9f20537 --- /dev/null +++ b/ext/tcltklib/depend @@ -0,0 +1 @@ +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 new file mode 100644 index 0000000000..26e7fe7b09 --- /dev/null +++ b/ext/tcltklib/extconf.rb @@ -0,0 +1,79 @@ +# extconf.rb for tcltklib + +have_library("socket", "socket") +have_library("nsl", "gethostbyname") + +def search_file(var, include, *path) + pwd = Dir.getwd + begin + for i in path.reverse! + dir = Dir[i] + for path in dir + Dir.chdir path + files = Dir[include] + if files.size > 0 + var << path + return files.pop + end + end + end + ensure + Dir.chdir pwd + end +end + +$includes = [] +search_file($includes, + "tcl.h", + "/usr/include/tcl*", + "/usr/include", + "/usr/local/include/tcl*", + "/usr/local/include") +search_file($includes, + "tk.h", + "/usr/include/tk*", + "/usr/include", + "/usr/local/include/tk*", + "/usr/local/include") +search_file($includes, + "X11/Xlib.h", + "/usr/include", + "/usr/X11*/include", + "/usr/include", + "/usr/X11*/include") + +$CFLAGS = "-Wall " + $includes.collect{|path| "-I" + path}.join(" ") + +$libraries = [] +tcllibfile = search_file($libraries, + "libtcl{,7*,8*}.{a,so}", + "/usr/lib", + "/usr/local/lib") +if tcllibfile + tcllibfile.sub!(/^lib/, '') + tcllibfile.sub!(/\.(a|so)$/, '') +end +tklibfile = search_file($libraries, + "libtk{,4*,8*}.{a,so}", + "/usr/lib", + "/usr/local/lib") +if tklibfile + tklibfile.sub!(/^lib/, '') + tklibfile.sub!(/\.(a|so)$/, '') +end +search_file($libraries, + "libX11.{a,so}", + "/usr/lib", + "/usr/X11*/lib") + +$LDFLAGS = $libraries.collect{|path| "-L" + path}.join(" ") + +have_library("dl", "dlopen") +if have_header("tcl.h") && + have_header("tk.h") && + have_library("X11", "XOpenDisplay") && + have_library("m", "log") && + have_library(tcllibfile, "Tcl_FindExecutable") && + have_library(tklibfile, "Tk_Init") + create_makefile("tcltklib") +end diff --git a/ext/tcltklib/lib/tcltk.rb b/ext/tcltklib/lib/tcltk.rb new file mode 100644 index 0000000000..81d01f930d --- /dev/null +++ b/ext/tcltklib/lib/tcltk.rb @@ -0,0 +1,388 @@ +# 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 [email protected]?(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 Binary files differnew file mode 100644 index 0000000000..880cc73e09 --- /dev/null +++ b/ext/tcltklib/sample/batsu.gif diff --git a/ext/tcltklib/sample/maru.gif b/ext/tcltklib/sample/maru.gif Binary files differnew file mode 100644 index 0000000000..2c0202892e --- /dev/null +++ b/ext/tcltklib/sample/maru.gif diff --git a/ext/tcltklib/sample/sample0.rb b/ext/tcltklib/sample/sample0.rb new file mode 100644 index 0000000000..cd4c8069b4 --- /dev/null +++ b/ext/tcltklib/sample/sample0.rb @@ -0,0 +1,39 @@ +#! /usr/local/bin/ruby -vd + +# tcltklib �饤�֥��Υƥ��� + +require "tcltklib" + +def test + # ���ץ���������� + ip1 = TclTkIp.new() + + # ɾ�����Ƥߤ� + print ip1._return_value().inspect, "\n" + print ip1._eval("puts {abc}").inspect, "\n" + + # �ܥ�����äƤߤ� + print ip1._return_value().inspect, "\n" + print ip1._eval("button .lab -text exit -command \"destroy .\"").inspect, + "\n" + print ip1._return_value().inspect, "\n" + print ip1._eval("pack .lab").inspect, "\n" + print ip1._return_value().inspect, "\n" + + # ���ץ���� ruby ���ޥ�ɤ�ɾ�����Ƥߤ� +# print ip1._eval(%q/ruby {print "print by ruby\n"}/).inspect, "\n" + print ip1._eval(%q+puts [ruby {print "print by ruby\n"; "puts by tcl/tk"}]+).inspect, "\n" + print ip1._return_value().inspect, "\n" + + # �⤦��ĥ��ץ���������Ƥߤ� + ip2 = TclTkIp.new() + ip2._eval("button .lab -text test -command \"puts test ; destroy .\"") + ip2._eval("pack .lab") + + TclTkLib.mainloop +end + +test +GC.start + +print "exit\n" diff --git a/ext/tcltklib/sample/sample1.rb b/ext/tcltklib/sample/sample1.rb new file mode 100644 index 0000000000..28ba7b547a --- /dev/null +++ b/ext/tcltklib/sample/sample1.rb @@ -0,0 +1,634 @@ +#! /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 new file mode 100644 index 0000000000..969d8de09a --- /dev/null +++ b/ext/tcltklib/sample/sample2.rb @@ -0,0 +1,449 @@ +#!/usr/local/bin/ruby +#----------------------> pretty simple othello game <----------------------- +# othello.rb +# +# version 0.3 +# maeda shugo ([email protected]) +#--------------------------------------------------------------------------- + +# Sep. 17, 1997 modified by Y. Shigehiro for tcltk library +# maeda shugo ([email protected]) ��ˤ�� +# (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 new file mode 100644 index 0000000000..e7fe77d2b7 --- /dev/null +++ b/ext/tcltklib/tcltklib.c @@ -0,0 +1,216 @@ +/* + * tcltklib.c + * Aug. 27, 1997 Y. Shigehiro + * Oct. 24, 1997 Y. Matsumoto + */ + +#include "ruby.h" +#include "sig.h" +#include <stdio.h> +#include <string.h> +#include <tcl.h> +#include <tk.h> + +/* for debug */ + +#define DUMP1(ARG1) if (debug) { fprintf(stderr, "tcltklib: %s\n", ARG1);} +#define DUMP2(ARG1, ARG2) if (debug) { fprintf(stderr, "tcltklib: ");\ +fprintf(stderr, ARG1, ARG2); fprintf(stderr, "\n"); } +/* +#define DUMP1(ARG1) +#define DUMP2(ARG1, ARG2) +*/ + +/* 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 ----*/ + +static VALUE thread_safe = Qnil; + +/* execute Tk_MainLoop */ +static VALUE +lib_mainloop(VALUE self) +{ + int old_trapflg; + int flags = RTEST(thread_safe)?TCL_DONT_WAIT:0; + + DUMP1("start Tk_Mainloop"); + while (Tk_GetNumMainWindows() > 0) { + old_trapflg = trap_immediate; + trap_immediate = 1; + Tcl_DoOneEvent(flags); + trap_immediate = old_trapflg; + CHECK_INTS; + flags = (thread_safe == 0 || thread_safe == Qnil)?0:TCL_DONT_WAIT; + } + DUMP1("stop Tk_Mainloop"); + + 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 +ip_ruby(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) +{ + VALUE res; + int old_trapflg; + VALUE failed = 0; + + /* ruby command has 1 arg. */ + if (argc != 2) { + ArgError("wrong # of arguments (%d for 1)", argc); + } + + /* evaluate the argument string by ruby */ + DUMP2("rb_eval_string(%s)", argv[1]); + old_trapflg = trap_immediate; + trap_immediate = 0; + res = rb_rescue(rb_eval_string, argv[1], ip_eval_rescue, &failed); + trap_immediate = old_trapflg; + + if (failed) { + Tcl_AppendResult(interp, RSTRING(failed)->ptr, (char*)NULL); + return TCL_ERROR; + } + + /* result must be string or nil */ + if (NIL_P(res)) { + DUMP1("(rb_eval_string result) nil"); + return TCL_OK; + } + Check_Type(res, T_STRING); + + /* copy result to the tcl interpreter */ + DUMP2("(rb_eval_string result) %s", RSTRING(res)->ptr); + DUMP1("Tcl_AppendResult"); + Tcl_AppendResult(interp, RSTRING(res)->ptr, (char *)NULL); + + return TCL_OK; +} + +/* destroy interpreter */ +static void +ip_free(struct tcltkip *ptr) +{ + DUMP1("Tcl_DeleteInterp"); + Tcl_DeleteInterp(ptr->ip); +} + +/* 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) { + Fail("Tcl_Init"); + } + DUMP1("Tk_Init"); + if (Tk_Init(ptr->ip) == TCL_ERROR) { + Fail("Tk_Init"); + } + DUMP1("Tcl_StaticPackage(\"Tk\")"); + Tcl_StaticPackage(ptr->ip, "Tk", Tk_Init, + (Tcl_PackageInitProc *) NULL); + + /* add ruby command to the interpreter */ + DUMP1("Tcl_CreateCommand(\"ruby\")"); + Tcl_CreateCommand(ptr->ip, "ruby", ip_ruby, (ClientData *)NULL, + (Tcl_CmdDeleteProc *)NULL); + + return obj; +} + +/* eval string in tcl by Tcl_Eval() */ +static VALUE +ip_eval(VALUE self, VALUE str) +{ + 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() */ + Check_Type(str, T_STRING); + buf = ALLOCA_N(char,RSTRING(str)->len+1); + strcpy(buf, RSTRING(str)->ptr); + DUMP2("Tcl_Eval(%s)", buf); + ptr->return_value = Tcl_Eval(ptr->ip, buf); + if (ptr->return_value == TCL_ERROR) { + Fail(ptr->ip->result); + } + DUMP2("(TCL_Eval result) %d", ptr->return_value); + + /* pass back the result (as string) */ + return(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)); +} + +/*---- initialization ----*/ +void Init_tcltklib() +{ + extern VALUE rb_argv0; /* the argv[0] */ + + VALUE lib = rb_define_module("TclTkLib"); + VALUE ip = rb_define_class("TclTkIp", cObject); + + 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, "_return_value", ip_retval, 0); + rb_define_method(ip, "mainloop", lib_mainloop, 0); + + /*---- initialize tcl/tk libraries ----*/ + /* from Tk_Main() */ + DUMP1("Tcl_FindExecutable"); + Tcl_FindExecutable(RSTRING(rb_argv0)->ptr); + + rb_define_variable("$tk_thread_safe", &thread_safe); +} + +/* eof */ |