mirror of
https://github.com/ruby/ruby.git
synced 2022-11-09 12:17:21 -05:00
* ext/tcltklib: merge into ext/tk and remove.
git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/branches/ruby_1_8@9496 b2dd03c8-39d4-4d8f-98ff-823fe69b080e
This commit is contained in:
nagai
parent
6f2cce43a1
commit
a2af997b7e
26 changed files with 314 additions and 13392 deletions
|
|
@ -1,3 +1,7 @@
|
|||
Wed Nov 2 20:14:53 2005 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp>
|
||||
|
||||
* ext/tcltklib: merge into ext/tk and remove.
|
||||
|
||||
Wed Nov 2 19:03:06 2005 Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp>
|
||||
|
||||
* ext/tcltklib/tcltklib.c (ip_rbUpdateObjCmd,
|
||||
|
|
|
|||
|
|
@ -1,445 +0,0 @@
|
|||
(tof)
|
||||
2005/07/05 Hidetoshi NAGAI
|
||||
|
||||
This document discribes about the 'tcltklib' library. Although there
|
||||
is the 'tcltk' library (tcltk.rb) under this directory, no description
|
||||
in this document (because it is not maintained recently).
|
||||
|
||||
==============================================================
|
||||
module TclTklib
|
||||
: Defines methods to do operations which are independed on
|
||||
: Tcl/Tk interpreters
|
||||
|
||||
module TclTkLib::EventFlag
|
||||
: Defines flags to define taget events on 'do_one_event' methos.
|
||||
: When to give, please use bit-operator (e.g. WINDOW | DONT_WAIT).
|
||||
|
||||
[constants]
|
||||
NONE
|
||||
: Is 0. It means "there is no target". But on the real
|
||||
: operation, it is same to ALL.
|
||||
|
||||
WINDOW
|
||||
: 'window' event is processed.
|
||||
|
||||
FILE
|
||||
: 'file' event is processed.
|
||||
|
||||
TIMER
|
||||
: 'timer' event is processed.
|
||||
|
||||
IDLE
|
||||
: 'idle' operation (e.g. 're-draw'; the operations when the
|
||||
: other kinds of events doesn't occur) is processed.
|
||||
|
||||
ALL
|
||||
: All kinds of events are processed.
|
||||
: Same to 'WINDOW | FILE | TIMER | IDLE'.
|
||||
|
||||
DONT_WAIT
|
||||
: Without this flag, 'do_one_event' waits the occurence of
|
||||
: a target event. With this flag, doesn't wait and returns
|
||||
: false if there is no target event for processing.
|
||||
|
||||
module TclTkLib::VarAccessFlag
|
||||
: Defines flags to give '_get_variable' and so on. When to give,
|
||||
: please use bit-operator (e.g. GLOBAL_ONLY | LEAVE_ERR_MSG ).
|
||||
|
||||
[constants]
|
||||
NONE
|
||||
: Is 0. It means "set no flag".
|
||||
|
||||
GLOBAL_ONLY
|
||||
: (site Tcl/Tk's man page)
|
||||
: Under normal circumstances the procedures look up
|
||||
: variables as follows: If a procedure call is active
|
||||
: in interp, a variable is looked up at the current
|
||||
: level of procedure call. Otherwise, a variable is
|
||||
: looked up first in the current namespace, then in
|
||||
: the global namespace. However, if this bit is set
|
||||
: in flags then the variable is looked up only in the
|
||||
: global namespace even if there is a procedure call
|
||||
: active. If both GLOBAL_ONLY and NAMESPACE_ONLY are
|
||||
: given, GLOBAL_ONLY is ignored.
|
||||
:
|
||||
: *** ATTENTION ***
|
||||
: Tcl7.6 doesn't have namespaces. So NAMESPACE_ONLY
|
||||
: is defined as 0, and then GLOBAL_ONLY is available
|
||||
: even if flag is (GLOBAL_ONLY | NAMESPACE_ONLY).
|
||||
|
||||
NAMESPACE_ONLY
|
||||
: (site Tcl/Tk's man page)
|
||||
: Under normal circumstances the procedures look up
|
||||
: variables as follows: If a procedure call is active
|
||||
: in interp, a variable is looked up at the current
|
||||
: level of procedure call. Otherwise, a variable is
|
||||
: looked up first in the current namespace, then in
|
||||
: the global namespace. However, if this bit is set
|
||||
: in flags then the variable is looked up only in the
|
||||
: current namespace even if there is a procedure call
|
||||
: active.
|
||||
:
|
||||
: *** ATTENTION ***
|
||||
: Tcl7.6 doesn't have namespaces. So NAMESPACE_ONLY
|
||||
: is defined as 0.
|
||||
|
||||
LEAVE_ERR_MSG
|
||||
: (site Tcl/Tk's man page)
|
||||
: If an error is returned and this bit is set in flags,
|
||||
: then an error message will be left in the interpreter's
|
||||
: result, where it can be retrieved with Tcl_GetObjResult
|
||||
: or Tcl_GetStringResult. If this flag bit isn't set then
|
||||
: no error message is left and the interpreter's result
|
||||
: will not be modified.
|
||||
|
||||
APPEND_VALUE
|
||||
: (site Tcl/Tk's man page)
|
||||
: If this bit is set then newValue is appended to the
|
||||
: current value, instead of replacing it. If the variable
|
||||
: is currently undefined, then this bit is ignored.
|
||||
|
||||
LIST_ELEMENT
|
||||
: (site Tcl/Tk's man page)
|
||||
: If this bit is set, then newValue is converted to a
|
||||
: valid Tcl list element before setting (or appending
|
||||
: to) the variable. A separator space is appended before
|
||||
: the new list element unless the list element is going
|
||||
: to be the first element in a list or sublist (i.e. the
|
||||
: variable's current value is empty, or contains the
|
||||
: single character ``{'', or ends in `` }'').
|
||||
|
||||
PARSE_VARNAME
|
||||
: (site Tcl/Tk's man page)
|
||||
: If this bit is set when calling _set_variable and so
|
||||
: on, var_name argument may contain both an array and an
|
||||
: element name: if the name contains an open parenthesis
|
||||
: and ends with a close parenthesis, then the value
|
||||
: between the parentheses is treated as an element name
|
||||
: (which can have any string value) and the characters
|
||||
: before the first open parenthesis are treated as the
|
||||
: name of an array variable. If the flag PARSE_VARNAME
|
||||
: is given, index_name argument should be 'nil' since the
|
||||
: array and element names are taken from var_name.
|
||||
:
|
||||
: *** ATTENTION ***
|
||||
: Tcl7.6 doesn't have this flag. So PARSE_VARNAME is
|
||||
: defined as 0.
|
||||
|
||||
[module methods]
|
||||
mainloop(check_root = true)
|
||||
: Starts the eventloop. If 'check_root' is true, this method
|
||||
: doesn't return when a root widget exists.
|
||||
: If 'check_root' is false, doen't return by the other
|
||||
: reasons than exceptions.
|
||||
|
||||
mainloop_thread?
|
||||
: Returns whether the current thread executes the eventloop.
|
||||
: If true, the eventloop is working on the current thread.
|
||||
: If no eventloop is working, this method returns nil.
|
||||
: And if the other thread executes the eventloop, returns false.
|
||||
:
|
||||
: *** ATTENTION ***
|
||||
: When this methods returns false, it is dangerous to call a Tk
|
||||
: interpreter directly.
|
||||
|
||||
mainloop_watchdog(check_root = true)
|
||||
: On the normal eventloop, some kinds of callback operations
|
||||
: cause deadlock. To avoid some of such deadlocks, this
|
||||
: method starts an eventloop and a watchdog-thread.
|
||||
|
||||
do_one_event(flag = TclTkLib::EventFlag::ALL |
|
||||
TclTkLib::EventFlag::DONT_WAIT)
|
||||
: Do one event for processing. When processed an event,
|
||||
: returns true.
|
||||
: If NOT set DONT_WAIT flag, this method waits occurrence of
|
||||
: a target event.
|
||||
: If set DONT_WAIT flag and no event for processing, returns
|
||||
: false immediately.
|
||||
: If $SAFE >= 4, or $SAFE >= 1 and the flag is tainted,
|
||||
: force to set DONT_WAIT flag.
|
||||
|
||||
set_eventloop_tick(timer_tick)
|
||||
: Define the interval of thread-switching with an integer
|
||||
: value of mili-seconds.
|
||||
: Default timer_tick is 0. It means that thread-switching
|
||||
: is based on the count of processed events.
|
||||
: ( see 'set_eventloop_weight' method )
|
||||
: However, if the eventloop thread is the only thread,
|
||||
: timer_tick cannt be set to 0. If 0, then is set to 100 ms
|
||||
: automatically (see NO_THREAD_INTERRUPT_TIME on tcltklib.c).
|
||||
: On $SAFE >= 4, cannot call this method.
|
||||
|
||||
get_eventloop_tick
|
||||
: Get current value of 'timer_tick'
|
||||
|
||||
set_no_event_wait(no_event_wait)
|
||||
: Define sleeping time of the eventloop when two or more
|
||||
: thread are running and there is no event for processing.
|
||||
: Default value is 20 (ms).
|
||||
: If the eventloop thread is the only thread, this value is
|
||||
: invalid.
|
||||
: On $SAFE >= 4, cannot call this method.
|
||||
|
||||
get_no_event_wait
|
||||
: Get current value of 'no_event_wait'.
|
||||
|
||||
set_eventloop_weight(loop_max, no_event_tick)
|
||||
: Define the weight parameters for the eventloop thread.
|
||||
: That is invalid when the eventloop is the only thread.
|
||||
: 'loop_max' is the max events for thread-switching.
|
||||
: 'no_event_tick' is the increment value of the event count
|
||||
: when no event for processing (And then, the eventloop thead
|
||||
: sleeps 'no_event_wait' mili-seconds).
|
||||
: 'loop_max == 800' and 'no_event_tick == 10' are defalut.
|
||||
: On $SAFE >= 4, cannot call this method.
|
||||
|
||||
get_eventloop_weight
|
||||
: Get current values of 'loop_max' and 'no_event_tick'.
|
||||
|
||||
mainloop_abort_on_exception=(bool)
|
||||
: Define whether the eventloop stops on exception or not.
|
||||
: If true (default value), stops on exception.
|
||||
: If false, show a warinig message but ignore the exception.
|
||||
: If nil, no warning message and ignore the excepsion.
|
||||
: This parameter is sometimes useful when multiple Tk
|
||||
: interpreters are working. Because the only one eventloop
|
||||
: admins all Tk interpreters, sometimes exception on a
|
||||
: interpreter kills the eventloop thread. Even if such
|
||||
: situation, when abort_on_exception == false or nil,
|
||||
: the eventloop ignores the exception and continue to working.
|
||||
: On $SAFE >= 4, cannot call this method.
|
||||
|
||||
mainloop_abort_on_exception
|
||||
: Get current status of that.
|
||||
|
||||
num_of_mainwindows
|
||||
: Returns the number of main-windows (root-widget).
|
||||
: Because there is only one main-window for one Tk interpreter,
|
||||
: the value is same to the number of interpreters which has
|
||||
: available Tk functions.
|
||||
|
||||
_merge_tklist(str, str, ... )
|
||||
: Get a Tcl's list string from arguments with a Tcl/Tk's
|
||||
: library function. Each arguemnt is converted to a valid
|
||||
: Tcl list element.
|
||||
|
||||
_conv_listelement(str)
|
||||
: Convert the argument to a valid Tcl list element with
|
||||
: Tcl/Tk's library function.
|
||||
|
||||
_toUTF8(str, encoding=nil)
|
||||
_fromUTF8(str, encoding=nil)
|
||||
: Call the function (which is internal function of Tcl/Tk) to
|
||||
: convert to/from a UTF8 string.
|
||||
|
||||
_subst_UTF_backslash(str)
|
||||
_subst_Tcl_backslash(str)
|
||||
: Substitute backslash sequence with Tcl's rule (include \uhhhh;
|
||||
: give a sixteen-bit hexadecimal value for Unicode character).
|
||||
: _subst_Tcl_backslash method parses all backslash sequence.
|
||||
: _subst_UTF_backslash method parses \uhhhh only.
|
||||
|
||||
encoding_system
|
||||
encoding_system=(encoding)
|
||||
: Get and set Tcl's system encoding.
|
||||
|
||||
encoding
|
||||
encoding=(encoding)
|
||||
: alias of encoding_system / encoding_system=
|
||||
: ( probably, Ruby/Tk's tk.rb will override them )
|
||||
|
||||
|
||||
class TclTkIp
|
||||
[class methods]
|
||||
new(ip_name=nil, options='')
|
||||
: Generate an instance of TclTkIp class.
|
||||
: If 'ip_name' argument is given as a string, it is the name
|
||||
: of the Tk interpreter which is shown by 'winfo interps'
|
||||
: command.
|
||||
: 'options' argument accepts a string which is the command
|
||||
: line options of wish; such as '-geometry' or '-use'.
|
||||
: The information is used to generate the root widget of the
|
||||
: interpreter.
|
||||
: ( e.g. TclTkIp.new('FOO', '-geometry 500x200 -use 0x2200009') )
|
||||
: If is given nil or falsr for the 'option' argument, generates
|
||||
: the Tcl interpreter without Tk library. Then the interpreter
|
||||
: doesn't need GUI environment. Therefore, even if a window
|
||||
: system doesn't exist or cannot be used, Ruby can control the
|
||||
: Tcl interpreter and the extention libraries loaded on the
|
||||
: interpreter.
|
||||
|
||||
[instance methods]
|
||||
create_slave(name, safe=false)
|
||||
: Create a slave interpreter.
|
||||
: The parent of the interpreter is the receiver of this method.
|
||||
: The name of the slave interpreter is given by 'name' argument.
|
||||
: The 'safe' argument decides whether the slave interpreter is
|
||||
: created as a safe interpreter or not. If true, create a safe
|
||||
: interpreter. Default is false. However, if the parent
|
||||
: interpreter is a safe interpreter, the created interpreter is
|
||||
: a safe interpreter (ignore 'safe' argument value).
|
||||
: If $SAFE >= 4, can create a safe interpreter only.
|
||||
|
||||
make_safe
|
||||
: Make the interpreter to the safe interpreter, and returns
|
||||
: self. If fail, raise RuntimeError.
|
||||
|
||||
safe?
|
||||
: Check whether the interpreter is the safe interpreter.
|
||||
: If is the safe interpreter, returns true.
|
||||
|
||||
allow_ruby_exit?
|
||||
: Return the mode whether 'exit' function of ruby or 'exit'
|
||||
: command of Tcl/Tk can quit the ruby process or not on the
|
||||
: interpreter. If false, such a command quit the interpreter
|
||||
: only.
|
||||
: The default value for a master interpreter is true, and
|
||||
: for a slave interpreter is false.
|
||||
|
||||
allow_ruby_exit=(mode)
|
||||
: Change the mode of 'allow_ruby_exit?'.
|
||||
: If $SAFE >= 4 or the interpreter is a "safe" interpreter,
|
||||
: this is not permitted (raise an exception).
|
||||
|
||||
delete
|
||||
: Delete the interpreter.
|
||||
: The deleted interpreter doesn't accept command and then
|
||||
: raise an exception.
|
||||
|
||||
deleted?
|
||||
: Check whether the interpreter is already deleted.
|
||||
: If deleted, returns true.
|
||||
|
||||
has_mainwindow?
|
||||
: Check whether the interpreter has a MainWindow (root widget).
|
||||
: If has, returns true. If doesn't, returns false.
|
||||
: If IP is already deleted, returns nil.
|
||||
|
||||
restart
|
||||
: Restart Tk part of the interpreter.
|
||||
: Use this when you need Tk functions after destroying the
|
||||
: root widget.
|
||||
: On $SAFE >= 4, cannot call this method.
|
||||
|
||||
_eval(str)
|
||||
_invoke(*args)
|
||||
: Estimates the arguments as a command on the Tk interpreter.
|
||||
: The argument of _eval is a script of Tcl/Tk.
|
||||
: Each argument of _invoke is a token of one command line of
|
||||
: Tcl/Tk.
|
||||
: Because the operation of _invoke doesn't through the
|
||||
: command line parser of Tk interpreter, the cost of
|
||||
: estimation is smaller than _eval. However, auto_load
|
||||
: mechanism of the Tk interpreter doesn't work on _invoke.
|
||||
: So _invoke can call only the command which already
|
||||
: registered on the interpreter by 'load' command and so on.
|
||||
: On _eval command, auto_load mechanism words. So if succeed
|
||||
: to _eval and regist the command once, after that, the
|
||||
: command can be called by _invoke.
|
||||
|
||||
_toUTF8(str, encoding=nil)
|
||||
_fromUTF8(str, encoding=nil)
|
||||
: Call the function (which is internal function of Tcl/Tk) to
|
||||
: convert to/from a UTF8 string.
|
||||
|
||||
_thread_vwait(var_name)
|
||||
_thread_tkwait(mode, target)
|
||||
: 'vwait' or 'tkwait' with thread support.
|
||||
: The difference from normal 'vwait' or 'tkwait' command is
|
||||
: doing independent wait from the vwait stack when they are
|
||||
: called on the other thread than the eventloop thread.
|
||||
: In the case of Tcl/Tk's vwait / tkwait, if 2nd vwait /
|
||||
: tkwait is called on waiting for 1st vwait / tkwait,
|
||||
: returns the order of [2nd]->[1st] regardless of the order
|
||||
: of when the wait condition was fulfilled.
|
||||
: If _thread_vwait / _thread_tkwait is called on the
|
||||
: eventloop thread, there is no difference from vwait /
|
||||
: tkwait. But if called on the other thread than the
|
||||
: eventloop, stops the thread. And when the wait condition
|
||||
: is fulfilled, the thread restarts. The meaning of
|
||||
: "independent from the vwait stack" is that the timing of
|
||||
: restarting is independent from the waiting status of the
|
||||
: other threads. That is, even if the eventloop thread is
|
||||
: waiting by vwait and is not fulfilled the condition,
|
||||
: _thread_vwait completes the waiting when its waiting
|
||||
: condition is fulfilled and the thread which stopped by
|
||||
: _thread_vwait can continue the operation.
|
||||
|
||||
_return_value
|
||||
: Get the last result value on the interpreter.
|
||||
|
||||
_get_variable(var_name, flag)
|
||||
_get_variable2(var_name, index_name, flag)
|
||||
: Get the current value of a variable. If specified a
|
||||
: index_name (see also the PARSE_VARNAME flag), get the
|
||||
: value of the index_name element.
|
||||
|
||||
_set_variable(var_name, value, flag)
|
||||
_set_variable2(var_name, index_name, value, flag)
|
||||
: Create or modify a variable. If specified a index_name
|
||||
: (see also the PARSE_VARNAME flag), create or modify the
|
||||
: index_name element.
|
||||
|
||||
_unset_variable(var_name)
|
||||
_unset_variable2(var_name, index_name)
|
||||
: Remove a variable. If specified a index_name (see also
|
||||
: the PARSE_VARNAME flag), remove the index_name element.
|
||||
|
||||
_get_global_var(var_name)
|
||||
_get_global_var2(var_name, index_name)
|
||||
_set_global_var(var_name, value)
|
||||
_set_global_var2(var_name, index_name, value)
|
||||
_unset_global_var(var_name)
|
||||
_unset_global_var2(var_name, index_name)
|
||||
: Call the associated method with the flag argument
|
||||
: (GLOBAL_ONLY | LEAVE_ERR_MSG).
|
||||
|
||||
_split_tklist(str)
|
||||
: Split the argument with Tcl/Tk's library function and
|
||||
: get an array as a list of Tcl list elements.
|
||||
|
||||
_merge_tklist(str, str, ... )
|
||||
: Get a Tcl's list string from arguments with a Tcl/Tk's
|
||||
: library function. Each arguemnt is converted to a valid
|
||||
: Tcl list element.
|
||||
|
||||
_conv_listelement(str)
|
||||
: Convert the argument to a valid Tcl list element with
|
||||
: Tcl/Tk's library function.
|
||||
|
||||
mainloop
|
||||
mainloop_watchdog
|
||||
: If on the slave interpreter, never start an eventloop and
|
||||
: returns nil.
|
||||
: With the exception that, same to the TclTkLib module method
|
||||
: with the same name.
|
||||
|
||||
do_one_event
|
||||
: With the exception that the argument is forced to set
|
||||
: DONT_WAIT flag on the slave interpreter, same to
|
||||
: TclTkLib#do_one_event.
|
||||
|
||||
set_eventloop_tick
|
||||
get_eventloop_tick
|
||||
set_no_event_wait
|
||||
get_no_event_wait
|
||||
set_eventloop_weight
|
||||
get_eventloop_weight
|
||||
mainloop_abort_on_exception
|
||||
mainloop_abort_on_exception=
|
||||
: With the exception that it is ignored to set value on the
|
||||
: slave interpreter, same to the TclTkLib module method with
|
||||
: the same name.
|
||||
|
||||
class TkCallbackBreak < StandardError
|
||||
class TkCallbackContinue < StandardError
|
||||
: They are exception classes to break or continue the Tk callback
|
||||
: operation.
|
||||
: If raise TkCallbackBreak on the callback procedure, Ruby returns
|
||||
: 'break' code to Tk interpreter (Then the Tk interpreter will
|
||||
: break the operation for the current event).
|
||||
: If raise TkCallbackContinue, returns 'continue' code (Then the Tk
|
||||
: interpreter will break the operateion for the current bindtag and
|
||||
: starts the operation for the next buindtag for the current event).
|
||||
|
||||
(eof)
|
||||
|
|
@ -1,557 +0,0 @@
|
|||
(tof)
|
||||
2005/07/05 Hidetoshi NAGAI
|
||||
|
||||
本ドキュメントには古い tcltk ライブラリ，tcltklib ライブラリの説明
|
||||
が含まれていますが，その記述内容は古いものとなっています．
|
||||
|
||||
tcltk ライブラリ（tcltk.rb）は現在ではメンテナンスが事実上行われて
|
||||
いないため，古いドキュメントの説明がそのまま有効です．それに対し，
|
||||
tcltklib ライブラリについては，現在の Ruby/Tk（tk.rb 以下のライブラ
|
||||
リ群）を稼働させるための中心としてメンテナンスされているため，少々
|
||||
違いが生じています．
|
||||
|
||||
そこで，まず古い説明文書を示した後，現在の tcltklib ライブラリにつ
|
||||
いての説明を加えます．
|
||||
|
||||
以下がライブラリの古い説明文書です．
|
||||
==============================================================
|
||||
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() が返した値.
|
||||
|
||||
==============================================================
|
||||
|
||||
以下が本ドキュメント作成時点での tcltklib ライブラリの説明です．
|
||||
==============================================================
|
||||
モジュール TclTkLib
|
||||
: 個々の Tcl/Tk インタープリタに依存しない処理 ( == イベントルー
|
||||
: プに関する処理 ) を呼び出すメソッドを定義したモジュール．
|
||||
|
||||
モジュール TclTkLib::EventFlag
|
||||
: do_one_event を呼び出す際の処理対象イベントを指定するための
|
||||
: フラグ ( WINDOW|DONT_WAIT というようにビット演算子で連結して
|
||||
: 指定 ) を定数として定義したモジュール．以下の定数が含まれる．
|
||||
|
||||
定数 NONE
|
||||
: 値は 0 で，値としてはいかなる種類のイベントも指定していない
|
||||
: ことになるが，実際の処理上は ALL と同じとして扱われる．
|
||||
|
||||
定数 WINDOW
|
||||
: window イベントを処理対象とする
|
||||
|
||||
定数 FILE
|
||||
: file イベントを処理対象とする
|
||||
|
||||
定数 TIMER
|
||||
: timer イベントを処理対象とする
|
||||
|
||||
定数 IDLE
|
||||
: アイドルループ処理 ( 再描画など，他の種類のイベントが発生
|
||||
: していないときに行われる処理 ) を処理対象とする
|
||||
|
||||
定数 ALL
|
||||
: すべての種類のイベントを処理対象とする
|
||||
: WINDOW|FILE|TIMER|IDLE と同じ
|
||||
|
||||
定数 DONT_WAIT
|
||||
: 処理対象イベントが存在しない場合に，イベント発生を待たず
|
||||
: に do_one_event を終了 ( false を返す ) する
|
||||
|
||||
モジュール TclTkLib::VarAccessFlag
|
||||
: _get_variable などでのフラグを指定するためのもの．フラグに
|
||||
: は以下の定数を OR で連結して与える．
|
||||
|
||||
定数 NONE
|
||||
: 値は 0 で，何もフラグを指定していないのに等しい．
|
||||
|
||||
定数 GLOBAL_ONLY
|
||||
: 通常，変数の検索はまず手続き呼び出しを行ったレベルで検
|
||||
: 索し，次に現在の名前空間で検索，最後にグローバル空間で
|
||||
: 検索を行う．しかし，このフラグが指定された場合には，グ
|
||||
: ローバル空間でのみ検索する．
|
||||
: もし GLOBAL_ONLY と NAMESPACE_ONLY とが両方指定された場
|
||||
: 合には，GLOBAL_ONLY の指定は無視される．
|
||||
|
||||
定数 NAMESPACE_ONLY
|
||||
: このフラグが指定された場合には，現在の名前空間でのみ変
|
||||
: 数の検索を行う．GLOBAL_ONLY の説明も参照すること．
|
||||
|
||||
定数 LEAVE_ERR_MSG
|
||||
: 変数アクセスにおいてエラーが発生した場合，このフラグが
|
||||
: 指定されていれば，実行結果として Tcl インタープリタにエ
|
||||
: ラーメッセージが残される．このフラグが指定されていなけ
|
||||
: れば，エラーメッセージは一切残されない．
|
||||
|
||||
定数 APPEND_VALUE
|
||||
: このフラグが指定されていた場合，変数の値を置き換えので
|
||||
: はなく，現在の値に代入値が追加 (append; 文字列連結) さ
|
||||
: れる．変数が未定義あった場合，このフラグは無視される．
|
||||
|
||||
定数 LIST_ELEMENT
|
||||
: このフラグが指定されていた場合，代入値はまず Tcl のリス
|
||||
: ト要素として適切となるように変換される．代入値がリスト
|
||||
: (またはサブリスト) の最初の要素となるのでない限り，代入
|
||||
: 値の直前には空白文字が追加される．
|
||||
|
||||
定数 PARSE_VARNAME
|
||||
: _set_variable などの呼び出しにおいてこのフラグが指定さ
|
||||
: れていた場合，var_name 引数が連想配列名と要素名とを両方
|
||||
: 含む可能性がある (開き括弧を含み，閉じ括弧で終わる) こ
|
||||
: とを示す．その場合，括弧の間が要素名指定，最初の開き括
|
||||
: 弧までが連想配列名として扱われる．_set_variable2 などで
|
||||
: このフラグを指定する場合，連想配列名と要素名は var_name
|
||||
: から抽出されるはずであるから，index_name 引数は nil と
|
||||
: せねばならない．
|
||||
|
||||
モジュールメソッド
|
||||
mainloop(check_root = true)
|
||||
: イベントループを起動する．check_root が true であれば，
|
||||
: root widget が存在する限り，このメソッドは終了しない．
|
||||
: check_root が false の場合は，root widget が消滅しても
|
||||
: このメソッドは終了しない ( root widget が消滅しても，
|
||||
: WINDOW 以外のイベントは発生しうるため )．終了には，外部
|
||||
: からの働き掛け ( スレッドを活用するなど ) が必要．
|
||||
|
||||
mainloop_thread?
|
||||
: カレントスレッドがイベントループを実行しているスレッド
|
||||
: かどうかを返す．
|
||||
: イベントループを実行しているスレッドであれば true を，
|
||||
: どのスレッドでもイベントループが実行されていない場合は
|
||||
: nil を，他のスレッドでイベントループが実行されている場
|
||||
: 合は false を返す．
|
||||
: false の際に Tk インタープリタを直接呼ぶのは危険である．
|
||||
|
||||
mainloop_watchdog(check_root = true)
|
||||
: 通常のイベントループでは，イベント処理の内容によっては
|
||||
: デッドロックを引き起こす可能性がある (例えばイベントに
|
||||
: 対するコールバック処理中で widget 操作をし，その終了を
|
||||
: 待つなど)．このメソッドは，そうしたデッドロックを回避す
|
||||
: るための監視スレッド付きでイベントループを起動する
|
||||
: ( 監視スレッドを生成した後にイベントループを実行する )．
|
||||
: 引数の意味は mainloop と同じである．
|
||||
|
||||
do_one_event(flag = TclTkLib::EventFlag::ALL |
|
||||
TclTkLib::EventFlag::DONT_WAIT)
|
||||
: 処理待ちのイベント 1 個を実行する．
|
||||
: イベントを処理した場合は true を返す．
|
||||
: フラグで DONT_WAIT を指定していない場合，フラグで処理対
|
||||
: 象となっている種類のイベントが発生するまで待ち続ける．
|
||||
: DONT_WAIT を指定していた場合，処理対象イベントがなくても
|
||||
: すぐに終了し false を返す．
|
||||
: $SAFE >= 4 か，$SAFE >= 1 かつ flag が汚染されているならば
|
||||
: flag には DONT_WAIT が強制的に付けられる．
|
||||
|
||||
set_eventloop_tick(timer_tick)
|
||||
: イベントループと同時に別スレッドが稼働している場合に，時
|
||||
: 間に基づいた強制的なスレッドスイッチングをどの程度の頻度
|
||||
: ( 時間間隔 ) で発生させるかをミリ秒単位の整数値で指定する．
|
||||
: 0 を指定すると，この強制的なスイッチングは行われない．
|
||||
: 標準では 0 に設定されており，イベント処理数に基づくスイッ
|
||||
: チングだけが行われる ( see set_eventloop_weight )．
|
||||
: ただし，稼働しているスレッドがイベントループだけの場合，
|
||||
: timer_tick を 0 に設定することはできない．もし設定されて
|
||||
: いたら，100 ms ( see NO_THREAD_INTERRUPT_TIME ) に自動設
|
||||
: 定される．
|
||||
: 詳細な説明は略すが，これは CPU パワーを節約しつつ安全で
|
||||
: 安定した動作を実現するために実装した仕様である．
|
||||
: $SAFE >= 4 では実行が禁止される．
|
||||
|
||||
get_eventloop_tick
|
||||
: timer_tick の現在値を返す．
|
||||
|
||||
set_no_event_wait(no_event_wait)
|
||||
: 複数のスレッドが稼働している場合で，処理待ちイベントが全
|
||||
: く存在しなかった際に sleep 状態に入る時間長を指定する．
|
||||
: 稼働スレッドがイベントループだけの場合には意味をなさない．
|
||||
: デフォルトの値は 20 (ms)
|
||||
: $SAFE >= 4 では実行が禁止される．
|
||||
|
||||
get_no_event_wait
|
||||
: no_event_wait の現在値を返す．
|
||||
|
||||
set_eventloop_weight(loop_max, no_event_tick)
|
||||
: 複数のスレッドが稼働している際に Ruby/Tk のイベントルー
|
||||
: プに割り当てる比重を定めるためのパラメータを設定する．
|
||||
: 稼働スレッドがイベントループだけの場合には意味をなさない．
|
||||
: 一度のスレッド切り替えの間に処理するイベントの最大数と，
|
||||
: 処理待ちのイベントが存在しない際の加算数とを設定する．
|
||||
: 処理待ちイベントが存在しない場合は no_event_wait ( see
|
||||
: set_no_event_wait ) だけの間 sleep 状態に入る．
|
||||
: デフォルトではそれぞれ 800 回と 10 回，つまり，800 個のイ
|
||||
: ベント (アイドルイベントを含む) を処理するとか，イベント
|
||||
: が全く発生しないままに 80 回の処理待ちイベント検査が完了
|
||||
: するとかでカウントが 800 以上になるとスレッドスイッチング
|
||||
: が発生することになる．
|
||||
: $SAFE >= 4 では実行が禁止される．
|
||||
|
||||
get_eventloop_weight
|
||||
: 現在の loop_max と no_event_tick との値を返す．
|
||||
: ( see set_eventloop_wait )
|
||||
|
||||
mainloop_abort_on_exception=(bool)
|
||||
: Tk インタープリタ上で例外を発生した際に，イベントループを
|
||||
: エラー停止させるかどうかを指定する．true を指定した場合は
|
||||
: エラー停止するが，false の場合は例外を無視してイベントルー
|
||||
: プを継続する．さらに nil の場合は警告モードでない限りはエ
|
||||
: ラーメッセージの出力すら省略して，例外を無視する．
|
||||
: デフォルトでは true に設定されている．
|
||||
: １個のインタープリタだけを使っている場合にはエラー時にその
|
||||
: まま停止しても通常は問題ないが，複数のインタープリタが同時
|
||||
: に動作している場合には，それらを管理するイベントループは１
|
||||
: 個だけであるため，いずれかのインタープリタのエラーが原因で，
|
||||
: 他のインタープリタの処理継続が不可能になることがある．その
|
||||
: ような場合でもエラーを無視してイベントループが稼働を続ける
|
||||
: ことで，他のインタープリタが正常に動作し続けることができる．
|
||||
: $SAFE >= 4 では実行が禁止される．
|
||||
|
||||
mainloop_abort_on_exception
|
||||
: Tk インタープリタ上で例外を発生した際に，イベントループをエ
|
||||
: ラー停止させるかどうかの設定状態を true/false で得る．
|
||||
|
||||
num_of_mainwindows
|
||||
: 現在のメインウィンドウ (ルートウィジェット) の数を返す．
|
||||
: メインウィンドウは一つのインタープリタに付き最大一つである
|
||||
: ので，この値は現在 Tk の機能が有効であるインタープリタの総
|
||||
: 数に等しい．
|
||||
|
||||
_merge_tklist(str, str, ... )
|
||||
: Tcl/Tk のライブラリ関数を使って，引数の文字列がそれぞれ
|
||||
: 正しく一つのリスト要素となるように連結した文字列を返す．
|
||||
|
||||
_conv_listelement(str)
|
||||
: Tcl/Tk のライブラリ関数を使って，引数の文字列が Tcl の
|
||||
: 一つのリスト要素として適切な表現になるように変換した文
|
||||
: 字列を返す．
|
||||
|
||||
_toUTF8(str, encoding=nil)
|
||||
_fromUTF8(str, encoding=nil)
|
||||
: Tcl/Tk が内蔵している UTF8 変換処理を呼び出す．
|
||||
|
||||
_subst_UTF_backslash(str)
|
||||
_subst_Tcl_backslash(str)
|
||||
: Tcl のルールでバックスラッシュ記法 ( \uhhhh による
|
||||
: Unicode 文字表現を含む ) を解析する．
|
||||
: _subst_Tcl_backslash はすべてのバックスラッシュ記法を
|
||||
: 置き換えるのに対し，_subst_UTF_backslash は \uhhhh
|
||||
: による Unicode 文字表現だけを置き換える．
|
||||
|
||||
encoding_system
|
||||
encoding_system=(encoding)
|
||||
: Tcl の system encoding の獲得および設定
|
||||
|
||||
encoding
|
||||
encoding=(encoding)
|
||||
: encoding_system / encoding_system= の alias
|
||||
: ( Ruby/Tk の tk.rb では置き換えられる予定のもの．)
|
||||
|
||||
|
||||
クラス TclTkIp
|
||||
クラスメソッド
|
||||
new(ip_name=nil, options='')
|
||||
: TclTkIp クラスのインスタンスを生成する．
|
||||
: ip_name に文字列を与えた場合は，それが winfo interps などで
|
||||
: 表示される名前になる．
|
||||
: options には，-geometry や -use など，wish のコマンドライン
|
||||
: 引数として与えるオプションと同様の情報を文字列として与える．
|
||||
: 与えられた情報は，root widget 生成の際に用いられる．
|
||||
: ( e.g. TclTkIp.new('FOO', '-geometry 500x200 -use 0x2200009') )
|
||||
: もし options に敢えて nil または false を与えた場合，Tk ライ
|
||||
: ブラリが導入されていない (つまりは Tcl のみの) インタープリ
|
||||
: タを生成する．この場合は GUI 環境は必要ないため，ウインドウ
|
||||
: システムが存在しない，または使用できない環境でも Tcl インター
|
||||
: プリタを生成し，Tcl やその拡張ライブラリを活用することができる．
|
||||
|
||||
インスタンスメソッド
|
||||
create_slave(name, safe=false)
|
||||
: レシーバを親とする name という名前のスレーブインタープリタを
|
||||
: 生成する．
|
||||
: safe には生成するインタープリタを safe インタープリタとする
|
||||
: かを指定する．デフォルトは false ということになっているが，
|
||||
: たとえ明確に false を指定していたとしても，親となるインター
|
||||
: プリタが safe インタープリタであれば，その設定を引き継いで
|
||||
: safe インタープリタとして生成される．
|
||||
: $SAFE >= 4 では，safe インタープリタ以外の生成が禁止される．
|
||||
|
||||
make_safe
|
||||
: Tcl/Tk インタープリタを safe インタープリタに変更する．
|
||||
: 戻り値はレシーバであるインタープリタ自身である．
|
||||
: 失敗した場合は RuntimeError の例外を発生する．
|
||||
|
||||
safe?
|
||||
: Tcl/Tk インタープリタが safe インタープリタであるかを調べる．
|
||||
: safe インタープリタであれば true を返す．
|
||||
|
||||
allow_ruby_exit?
|
||||
: 対象となるインタープリタ上の評価で，ruby の exit 関数または
|
||||
: Tcl/Tk 上の exit コマンドによって ruby 自体を終了させること
|
||||
: を許すかどうかを返す．
|
||||
: 許さない場合は対象のインタープリタだけが終了する．
|
||||
: マスターインタープリタのデフォルト値は true，スレーブインター
|
||||
: プリタのデフォルト値は false である．
|
||||
|
||||
allow_ruby_exit=(mode)
|
||||
: 対象となるインタープリタの allow_ruby_exit? の状態を変更する．
|
||||
: $SAFE >= 4 またはインタープリタが safe インタープリタの場合は
|
||||
: 変更が許されない (例外を発生)．
|
||||
|
||||
delete
|
||||
: Tcl/Tk インタープリタを delete する．
|
||||
: delete されたインタープリタは，以後一切の操作ができなくなり，
|
||||
: コマンドを送っても例外を発生するようになる．
|
||||
|
||||
deleted?
|
||||
: Tcl/Tk インタープリタがすでに delete されているかを調べる．
|
||||
: delete 済みでコマンドを受け付けない状態になっているならば
|
||||
: true を返す．
|
||||
|
||||
has_mainwindow?
|
||||
: Tcl/Tk インタープリタにメインウィンドウ (root widget) が
|
||||
: 存在すれば true を，存在しなければ false を返す．
|
||||
: インタープリタが既に delete 済みであれば nil を返す．
|
||||
|
||||
restart
|
||||
: Tcl/Tk インタープリタの Tk 部分の初期化，再起動を行う．
|
||||
: 一旦 root widget を破壊した後に再度 Tk の機能が必要と
|
||||
: なった場合に用いる．
|
||||
: $SAFE >= 4 では実行が禁止される．
|
||||
|
||||
_eval(str)
|
||||
_invoke(*args)
|
||||
: Tcl/Tk インタープリタ上で評価を行う．
|
||||
: _eval は評価スクリプトが一つの文字列であることに対し，
|
||||
: _invoke は評価スクリプトの token ごとに一つの引数とな
|
||||
: るように与える．
|
||||
: _invoke の方は Tcl/Tk インタープリタの字句解析器を用い
|
||||
: ないため，評価の負荷がより少なくてすむ．ただし，その代
|
||||
: わりに auto_load のような機構は働かず，load 等によって
|
||||
: Tcl/Tk インタープリタ上に既に登録済みのコマンドしか呼
|
||||
: び出すことができない．
|
||||
: _eval では auto_load 機構が働くため，一度 _eval を実行
|
||||
: して登録に成功しさえすれば，以降は _invoke でも利用で
|
||||
: きるようになる．
|
||||
|
||||
_toUTF8(str, encoding=nil)
|
||||
_fromUTF8(str, encoding=nil)
|
||||
: Tcl/Tk が内蔵している UTF8 変換処理を呼び出す．
|
||||
|
||||
_thread_vwait(var_name)
|
||||
_thread_tkwait(mode, target)
|
||||
: スレッド対応の vwait あるいは tkwait 相当のメソッド．
|
||||
: 通常の vwait あるいは tkwait コマンドと異なるのは，イベン
|
||||
: トループとは異なるスレッドから呼び出した場合に vwait 等の
|
||||
: スタックとは独立に条件の成立待ちがなされることである．
|
||||
: 通常の vwait / tkwait では，vwait / tkwait (1) の待ちの途
|
||||
: 中でさらに vwait / tkwait (2) が呼ばれた場合，待ちの対象
|
||||
: となっている条件の成立順序がどうあれ，(2)->(1) の順で待ち
|
||||
: を終了して戻ってくる．
|
||||
: _thread_vwait / _thread_tkwait は，イベントループのスレッ
|
||||
: ドで呼ばれた場合は通常の vwait / tkwait と同様に動作する
|
||||
: が，イベントループ以外のスレッドで呼ばれた場合にはそのス
|
||||
: レッドを停止させて待ちに入り，条件が成立した時にスレッド
|
||||
: の実行を再開する．「vwait 等の待ちスタックとは独立」とい
|
||||
: う意味は，この再開のタイミングが他のスレッドでの待ち状況
|
||||
: とは無関係ということである．つまり，イベントループ等の他
|
||||
: のスレッドで vwait 等で待ちの状態にあったとしてもその完了
|
||||
: を待つことなく，自らの待ち条件が成立次第，処理を継続する
|
||||
: ことになる．
|
||||
|
||||
_return_value
|
||||
: 直前の Tcl/Tk 上での評価の実行結果としての戻り値を返す．
|
||||
|
||||
_get_variable(var_name, flag)
|
||||
_get_variable2(var_name, index_name, flag)
|
||||
: Tcl/Tk 上の var という変数名の変数の値を返す．
|
||||
: もし index_name が指定 (PARSE_VARNAME フラグの説明も参照)
|
||||
: された場合は連想配列 var_name の index_name の要素を返す．
|
||||
: flag には変数を検索する際の条件を指定する．flag に与える
|
||||
: 値はモジュール TclTkLib::VarAccessFlag を参照すること．
|
||||
|
||||
_set_variable(var_name, value, flag)
|
||||
_set_variable2(var_name, index_name, value, flag)
|
||||
: Tcl/Tk 上の var という変数名の変数に値を設定する．
|
||||
: もし index_name が指定 (PARSE_VARNAME フラグの説明も参照)
|
||||
: された場合は連想配列 var_name の index_name の要素を設定
|
||||
: する．
|
||||
: flag には変数を検索する際の条件を指定する．flag に与える
|
||||
: 値はモジュール TclTkLib::VarAccessFlag を参照すること．
|
||||
|
||||
_unset_variable(var_name)
|
||||
_unset_variable2(var_name, index_name)
|
||||
: Tcl/Tk 上の var_name という変数名の変数を消去する．
|
||||
: もし index_name が指定 (PARSE_VARNAME フラグの説明も参照)
|
||||
: された場合は連想配列 var_name から index_name の要素だけ
|
||||
: を消去する．
|
||||
|
||||
_get_global_var(var_name)
|
||||
_get_global_var2(var_name, index_name)
|
||||
_set_global_var(var_name, value)
|
||||
_set_global_var2(var_name, index_name, value)
|
||||
_unset_global_var(var_name)
|
||||
_unset_global_var2(var_name, index_name)
|
||||
: それぞれ，対応する変数アクセスメソッドの flag に対して
|
||||
: (GLOBAL_ONLY | LEAVE_ERR_MSG) を与えたもの．
|
||||
|
||||
_split_tklist(str)
|
||||
: Tcl/Tk のライブラリ関数を使って，文字列 str をリストに
|
||||
: 分割する (文字列の配列として返す)．
|
||||
|
||||
_merge_tklist(str, str, ... )
|
||||
: Tcl/Tk のライブラリ関数を使って，引数の文字列がそれぞれ
|
||||
: 正しく一つのリスト要素となるように連結した文字列を返す．
|
||||
|
||||
_conv_listelement(str)
|
||||
: Tcl/Tk のライブラリ関数を使って，引数の文字列が Tcl の
|
||||
: 一つのリスト要素として適切な表現になるように変換した文
|
||||
: 字列を返す．
|
||||
|
||||
mainloop
|
||||
mainloop_watchdog
|
||||
: スレーブ IP の場合にはイベントループを起動せずに nil を返す．
|
||||
: それ以外の点では引数を含めて TclTkLib の同名メソッドに同じ．
|
||||
|
||||
do_one_event
|
||||
: スレーブ IP の場合には引数のイベントフラグに DONT_WAIT が
|
||||
: 強制的に追加される (イベント待ちでスリープすることは禁止)．
|
||||
: それ以外の点では引数を含めて TclTkLib の同名メソッドに同じ．
|
||||
|
||||
set_eventloop_tick
|
||||
get_eventloop_tick
|
||||
set_no_event_wait
|
||||
get_no_event_wait
|
||||
set_eventloop_weight
|
||||
get_eventloop_weight
|
||||
mainloop_abort_on_exception
|
||||
mainloop_abort_on_exception=
|
||||
: スレーブ IP の場合には値の設定が許されない (無視される)．
|
||||
: それ以外の点では引数を含めて TclTkLib の同名メソッドに同じ．
|
||||
|
||||
クラス TkCallbackBreak < StandardError
|
||||
クラス TkCallbackContinue < StandardError
|
||||
: これらはイベントコールバックにおいて，コールバック処理を適切に中
|
||||
: 断したり，次のバインドタグのバインディング処理に進めたりすること
|
||||
: を可能にするための例外クラスである．
|
||||
: コールバックで break や continue を実現するためには，コールバック
|
||||
: である Ruby 手続きが Tcl/Tk インタープリタ側に適切なリターンコー
|
||||
: ドを返す必要がある．Ruby の手続きが普通に値を返すのでは，それが普
|
||||
: 通の戻り値であるのか否かを区別ができないため，例外発生を利用した
|
||||
: 実装を行っている．
|
||||
|
||||
(eof)
|
||||
|
|
@ -1,72 +0,0 @@
|
|||
To compile 'tcltklib', you must have Tcl/Tk libraries on your environment.
|
||||
Although 'extconf.rb' script searches Tcl/Tk libraries and header files,
|
||||
sometimes fails to find them. And then, 'tcltklib' cannot be compiled. If
|
||||
Tcl/Tk libraries or header files are installed but are not found, you can
|
||||
give the information by arguments of the 'configure' script. Please give
|
||||
some or all of the following options.
|
||||
|
||||
--with-tcllib=<libname> (e.g. libtcl8.4.so ==> --with-tcllib=tcl8.4)
|
||||
--with-tklib=<libname> (e.g. libtk8.4.so ==> --with-tklib=tk8.4)
|
||||
|
||||
--enable-tcltk_stubs (if you force to enable stubs)
|
||||
|
||||
--with-tcl-dir=<path>
|
||||
equal to "--with-tcl-include=<path>/include --with-tcl-lib=<path>/lib"
|
||||
|
||||
--with-tk-dir=<path>
|
||||
equal to "--with-tk-include=<path>/include --with-tk-lib=<path>/lib"
|
||||
|
||||
--with-tcl-include=<dir> the directry containts 'tcl.h'
|
||||
--with-tk-include=<dir> the directry containts 'tk.h'
|
||||
|
||||
--with-tcl-lib=<dir> the directry containts 'libtcl<version>.so'
|
||||
--with-tk-lib=<dir> the directry containts 'libtk<version>.so'
|
||||
|
||||
--enable-mac-tcltk-framework (MacOS X) use Tcl/Tk framework
|
||||
(Obsolete. Please use '--enable-tcltk-framework'.)
|
||||
|
||||
--enable-tcltk-framework use Tcl/Tk framework
|
||||
|
||||
--with-tcltk-framework=<dir> the directory containts Tcl/Tk framework;
|
||||
"<dir>/Tcl.framework" and "<dir>/Tk.framework".
|
||||
When this option is given, it is assumed that
|
||||
--enable-tcltk-framework option is given also.
|
||||
|
||||
--with-tcl-framework-header=<dir>
|
||||
Tcl framework headers directory
|
||||
(e.g. "/Library/Frameworks/Tcl.framework/Headers")
|
||||
|
||||
--with-tk-framework-header=<dir>
|
||||
Tk framework headers directory
|
||||
(e.g. "/Library/Frameworks/Tk.framework/Headers")
|
||||
|
||||
|
||||
If you forgot to give the options when do 'configure' on toplevel
|
||||
directry of Ruby sources, please try something like as the followings.
|
||||
|
||||
$ cd ext/tcltklib
|
||||
$ rm Makefile
|
||||
$ CONFIGURE_ARGS='--with-tcl-include=/usr/local/include/tcl8.4/ --with-tcllib=tcl8.4 --with-tklib=tk8.4' ruby extconf.rb
|
||||
|
||||
|
||||
*** ATTENTION ***
|
||||
When your Tcl/Tk libraries are compiled with "pthread support",
|
||||
Ruby/Tk may cause "Hang-up" or "Segmentation Fault" frequently.
|
||||
If you have such a trouble, please try to use the '--enable-pthread'
|
||||
option of the 'configure' command and re-compile Ruby sources.
|
||||
It may help you to avoid this trouble. The following configure
|
||||
options may be useful.
|
||||
|
||||
--enable-tcl-thread/--disable-tcl-thread
|
||||
--with-tclConfig-file=<path of 'tclConfig.sh'>
|
||||
|
||||
It is not need that 'tclConfig.sh' is a normal Tcl/Tk's tclConfig.sh.
|
||||
But the file is expected to include the line "TCL_THREADS=0" or "...=1".
|
||||
When no "TCL_THREADS=?" line, if Tcl version is 7.x or 8.0 which is
|
||||
given by "TCL_MAJOR_VERSION=?" line and "TCL_MINOR_VERSION=?" line,
|
||||
then --disable-tcl-thread is expected. Else, ignore the 'tclConfig.sh'.
|
||||
If --enable-tcl-thread or --disable-tcl-thread option is given, then
|
||||
--with-tclConfig-file option is ignored.
|
||||
|
||||
==========================================================
|
||||
Hidetoshi NAGAI (nagai@ai.kyutech.ac.jp)
|
||||
|
|
@ -1,49 +0,0 @@
|
|||
ActiveTcl is ActiveState's quality-assured distribution of Tcl.
|
||||
|
||||
# see <http://www.activestate.com/Products/ActiveTcl/>
|
||||
# <http://www.tcl.tk/>
|
||||
|
||||
If you want to use ActiveTcl binary package as the Tcl/Tk libraries,
|
||||
please use the following configure options.
|
||||
|
||||
--with-tcl-dir=<ActiveTcl_root>
|
||||
--with-tk-dir=<ActiveTcl_root>
|
||||
|
||||
And use the followings if you need.
|
||||
|
||||
--with-tcllib=<libname>
|
||||
--with-tklib=<libname>
|
||||
--enable-tcltk-stubs
|
||||
|
||||
For example, when you install ActiveTcl-8.4.x to '/usr/local/ActiveTcl',
|
||||
|
||||
configure --with-tcl-dir=/usr/local/ActiveTcl/ \
|
||||
--with-tk-dir=/usr/local/ActiveTcl/ \
|
||||
--with-tcllib=tclstub8.4 \
|
||||
--with-tklib=tkstub8.4 \
|
||||
--enable-tcltk-stubs
|
||||
|
||||
It depends on your environment that you have to add the directory of
|
||||
ActiveTcl's libraries to your library path when execute Ruby/Tk.
|
||||
One of the way is to add entries to TCLLIBPATH environment variable,
|
||||
and one of the others add to LD_LIBRARY_PATH environment variable
|
||||
|
||||
Probably, using TCLLIBPATH is better. The value is appended at the
|
||||
head of Tcl's 'auto_path' variable. You can see the value of the
|
||||
variable by using 'Tk::AUTO_PATH.value' or 'Tk::AUTO_PATH.list'.
|
||||
|
||||
For example, on Linux, one of the ways is to use LD_LIBRARY_PATH
|
||||
environment variable.
|
||||
-------------------------------------------------------------------------
|
||||
[bash]$ LD_LIBRARY_PATH=/usr/local/ActiveTcl/lib:$LD_LIBRARY_PATH \
|
||||
ruby your-Ruby/Tk-script
|
||||
|
||||
[bash]$ LD_LIBRARY_PATH=/usr/local/ActiveTcl/lib:$LD_LIBRARY_PATH irb
|
||||
-------------------------------------------------------------------------
|
||||
Based on it, the Tcl interpreter changes auto_path variable's value.
|
||||
|
||||
Then, you'll be able to use Tcl/Tk extension libraries included in the
|
||||
ActiveTcl package (e.g. call TkPackage.require('BWidget'), and then,
|
||||
use functions/widgets of BWidget extention).
|
||||
|
||||
Hidetoshi NAGAI (nagai@ai.kyutech.ac.jp)
|
||||
|
|
@ -1,159 +0,0 @@
|
|||
(tof)
|
||||
2003/06/19 Hidetoshi NAGAI
|
||||
|
||||
本ドキュメントには古い tcltk ライブラリ，tcltklib ライブラリの説明
|
||||
が含まれていますが，その記述内容は古いものとなっています．
|
||||
|
||||
まず，現在の Ruby/Tk の中心である tk.rb は wish を呼び出したりはせ
|
||||
ず，tcltklib ライブラリを wrap して動作するものとなっています．その
|
||||
ため，古い説明記述で述べられているようなプロセス間通信によるオーバ
|
||||
ヘッドは存在しません．
|
||||
|
||||
現在の tcltklib ライブラリでも，Tcl/Tk の C ライブラリをリンクして
|
||||
直接に動かすことで，オーバヘッドを押さえつつ Tcl/Tk インタープリタ
|
||||
のほぼ全機能（拡張ライブラリを含む）を使える点は同じです．しかし，
|
||||
その役割はほぼ「tk.rb 以下のライブラリを効果的に働かせるためのもの」
|
||||
と見なされており，その目的でメンテナンスされています．
|
||||
|
||||
tk.rb の高機能化に伴って，中水準のライブラリである tcltk ライブラリ
|
||||
（tcltk.rb）はその存在意義を減じており，現在ではメンテナンスは行わ
|
||||
れていません．
|
||||
|
||||
なお，古い説明ではバインディングにおけるスクリプトの追加はできないこ
|
||||
ととなっていますが，現在の tk.rb ではこれも可能であることを補足して
|
||||
おきます．
|
||||
|
||||
以下がライブラリの古い説明文書です．
|
||||
==============================================================
|
||||
tcltk ライブラリ
|
||||
tcltklib ライブラリ
|
||||
Sep. 19, 1997 Y. Shigehiro
|
||||
|
||||
以下, 「tcl/tk」という表記は, tclsh や wish を実現している, 一般でいう
|
||||
ところの tcl/tk を指します. 「tcltk ライブラリ」, 「tcltklib ライブラ
|
||||
リ」という表記は, 本パッケージに含まれる ruby 用のライブラリを指します.
|
||||
|
||||
[ファイルについて]
|
||||
|
||||
README.euc : このファイル(注意, 特徴, インストールの方法).
|
||||
MANUAL.euc : マニュアル.
|
||||
|
||||
lib/, ext/ : ライブラリの実体.
|
||||
|
||||
sample/ : マニュアル代わりのサンプルプログラム.
|
||||
sample/sample0.rb : tcltklib ライブラリのテスト.
|
||||
sample/sample1.rb : tcltk ライブラリのテスト.
|
||||
tcl/tk (wish) でできそうなことを一通り書いてみました.
|
||||
sample/sample2.rb : tcltk ライブラリのサンプル.
|
||||
maeda shugo (shugo@po.aianet.ne.jp) 氏による
|
||||
(`rb.tk' で書かれていた) ruby のサンプルプログラム
|
||||
http://www.aianet.or.jp/~shugo/ruby/othello.rb.gz
|
||||
を tcltk ライブラリを使うように, 機械的に変更してみました.
|
||||
|
||||
demo/ : 100 本の線を 100 回描くデモプログラム.
|
||||
最初に空ループの時間を測定し, 続いて実際に線を引く時間を測定します.
|
||||
tcl/tk は(再)描画のときに backing store を使わずに律義に 10000 本(?)
|
||||
線を引くので, (再)描画を始めると, マシンがかなり重くなります.
|
||||
demo/lines0.tcl : wish 用のスクリプト.
|
||||
demo/lines1.rb : `tk.rb' 用のスクリプト.
|
||||
demo/lines2.rb : tcltk ライブラリ用のスクリプト.
|
||||
|
||||
[注意]
|
||||
|
||||
コンパイル/実行には, tcl/tk の C ライブラリが必要です.
|
||||
|
||||
このライブラリは,
|
||||
|
||||
ruby-1.0-970701, ruby-1.0-970911, ruby-1.0-970919
|
||||
FreeBSD 2.2.2-RELEASE
|
||||
およびそのパッケージ jp-tcl-7.6.tgz, jp-tk-4.2.tgz
|
||||
|
||||
で作成/動作確認しました. 他の環境では動作するかどうかわかりません.
|
||||
|
||||
TclTkLib.mainloop を実行中に Control-C が効かないのは不便なので, ruby
|
||||
のソースを参考に, #include "sig.h" して trap_immediate を操作していま
|
||||
すが, ruby の README.EXT にも書いてないのに, こんなことをして良いのか
|
||||
どうかわかりません.
|
||||
|
||||
-d オプションでデバッグ情報を表示させるために, ruby のソースを参考に,
|
||||
debug という大域変数を参照していますが, ruby の README.EXT にも書いて
|
||||
ないのに, こんなことをして良いのかどうかわかりません.
|
||||
|
||||
extconf.rb は書きましたが, (いろいろな意味で)これで良いのか良く分かり
|
||||
ません.
|
||||
|
||||
[特徴]
|
||||
|
||||
ruby から tcl/tk ライブラリを利用できます.
|
||||
|
||||
tcl/tk インタプリタのスクリプトは, 機械的に tcltk ライブラリ用の ruby
|
||||
スクリプトに変換できます.
|
||||
|
||||
(`tk.rb' との違い)
|
||||
|
||||
1. tcl/tk インタプリタのスクリプトが, どのように, tcltk ライブラリ用の
|
||||
ruby スクリプトに変換されるかが理解できれば, マニュアル類が無いに等
|
||||
しい `tk.rb' とは異なり
|
||||
|
||||
tcl/tk のマニュアルやオンラインドキュメントを用いて
|
||||
|
||||
効率良くプログラミングを行うことができます.
|
||||
記述方法がわからない, コマンドに与えるパラメータがわからない...
|
||||
- Canvas.new { ... } と, なぜイテレータブロックを書けるの??
|
||||
- Canvas の bbox は数値のリストを返すのに, xview は文字列を返すの??
|
||||
と, いちいち, ライブラリのソースを追いかける必要はありません.
|
||||
|
||||
2. 個々の機能(オプション)を個別処理によりサポートしており, そのためサ
|
||||
ポートしていない機能は使うことができない(本当は使えないこともないの
|
||||
ですが) `tk.rb' とは異なり, tcl/tk インタプリタで可能なことは
|
||||
|
||||
ほとんど
|
||||
|
||||
ruby からも実行できます. 現在, ruby から実行できないことが確認され
|
||||
ているのは,
|
||||
|
||||
bind コマンドでスクリプトを追加する構文
|
||||
「bind tag sequence +script」
|
||||
^
|
||||
|
||||
のみです.
|
||||
- `. configure -width' をしようとして, `Tk.root.height()' と書い
|
||||
たのに, `undefined method `height'' と怒られてしまった. tk.rb を
|
||||
読んでみて, ガーン. できないのか...
|
||||
ということはありません.
|
||||
|
||||
3. wish プロセスを起動しプロセス間通信で wish を利用する `tk.rb' とは
|
||||
異なり, tcl/tk の C ライブラリをリンクし
|
||||
|
||||
より高速に (といっても, 思った程は速くないですが)
|
||||
|
||||
処理を行います.
|
||||
|
||||
4. `tk.rb' ほど, 高水準なインターフェースを備えていないため, tcl/tk イ
|
||||
ンタプリタの生成等
|
||||
|
||||
何から何まで自分で記述
|
||||
|
||||
しなければなりません(その代わり, tcl/tk ライブラリの仕様通り,
|
||||
tcl/tk インタプリタを複数生成することもできますが).
|
||||
インターフェースは(おそらく) ruby の思想に沿ったものではありません.
|
||||
また, スクリプトの記述は
|
||||
|
||||
ダサダサ
|
||||
|
||||
です. スクリプトは, 一見, 読みづらいものとなります. が, 書く人にとっ
|
||||
ては, それほど煩わしいものではないと思います.
|
||||
|
||||
[インストールの方法]
|
||||
|
||||
0. ruby のソースファイル(ruby-1.0-なんたら.tgz)を展開しておきます.
|
||||
|
||||
1. ruby-1.0-なんたら/ext に ext/tcltklib をコピーします.
|
||||
cp -r ext/tcltklib ???/ruby-1.0-なんたら/ext/
|
||||
|
||||
2. ruby のインストール法に従い make 等をします.
|
||||
|
||||
3. ruby のライブラリ置場に lib/* をコピーします.
|
||||
cp lib/* /usr/local/lib/ruby/
|
||||
|
||||
(eof)
|
||||
|
|
@ -1,42 +0,0 @@
|
|||
#! /usr/local/bin/wish
|
||||
|
||||
proc drawlines {} {
|
||||
puts [clock format [clock seconds]]
|
||||
|
||||
for {set j 0} {$j < 100} {incr j} {
|
||||
puts -nonewline "*"
|
||||
flush stdout
|
||||
if {$j & 1} {
|
||||
set c "blue"
|
||||
} {
|
||||
set c "red"
|
||||
}
|
||||
for {set i 0} {$i < 100} {incr i} {
|
||||
# .a create line $i 0 0 [expr 500 - $i] -fill $c
|
||||
}
|
||||
}
|
||||
|
||||
puts [clock format [clock seconds]]
|
||||
|
||||
for {set j 0} {$j < 100} {incr j} {
|
||||
puts -nonewline "*"
|
||||
flush stdout
|
||||
if {$j & 1} {
|
||||
set c "blue"
|
||||
} {
|
||||
set c "red"
|
||||
}
|
||||
for {set i 0} {$i < 100} {incr i} {
|
||||
.a create line $i 0 0 [expr 500 - $i] -fill $c
|
||||
}
|
||||
}
|
||||
|
||||
puts [clock format [clock seconds]]
|
||||
# destroy .
|
||||
}
|
||||
|
||||
canvas .a -height 500 -width 500
|
||||
button .b -text draw -command drawlines
|
||||
pack .a .b -side left
|
||||
|
||||
# eof
|
||||
|
|
@ -1,50 +0,0 @@
|
|||
#! /usr/local/bin/ruby
|
||||
|
||||
require "tcltk"
|
||||
|
||||
def drawlines()
|
||||
print Time.now, "\n"
|
||||
|
||||
for j in 0 .. 99
|
||||
print "*"
|
||||
$stdout.flush
|
||||
if (j & 1) != 0
|
||||
col = "blue"
|
||||
else
|
||||
col = "red"
|
||||
end
|
||||
for i in 0 .. 99
|
||||
# $a.e("create line", i, 0, 0, 500 - i, "-fill", col)
|
||||
end
|
||||
end
|
||||
|
||||
print Time.now, "\n"
|
||||
|
||||
for j in 0 .. 99
|
||||
print "*"
|
||||
$stdout.flush
|
||||
if (j & 1) != 0
|
||||
col = "blue"
|
||||
else
|
||||
col = "red"
|
||||
end
|
||||
for i in 0 .. 99
|
||||
$a.e("create line", i, 0, 0, 500 - i, "-fill", col)
|
||||
end
|
||||
end
|
||||
|
||||
print Time.now, "\n"
|
||||
# $ip.commands()["destroy"].e($root)
|
||||
end
|
||||
|
||||
$ip = TclTkInterpreter.new()
|
||||
$root = $ip.rootwidget()
|
||||
$a = TclTkWidget.new($ip, $root, "canvas", "-height 500 -width 500")
|
||||
$c = TclTkCallback.new($ip, proc{drawlines()})
|
||||
$b = TclTkWidget.new($ip, $root, "button", "-text draw -command", $c)
|
||||
|
||||
$ip.commands()["pack"].e($a, $b, "-side left")
|
||||
|
||||
TclTk.mainloop
|
||||
|
||||
# eof
|
||||
|
|
@ -1,54 +0,0 @@
|
|||
#! /usr/local/bin/ruby
|
||||
|
||||
require "tk"
|
||||
|
||||
def drawlines()
|
||||
print Time.now, "\n"
|
||||
|
||||
for j in 0 .. 99
|
||||
print "*"
|
||||
$stdout.flush
|
||||
if (j & 1) != 0
|
||||
col = "blue"
|
||||
else
|
||||
col = "red"
|
||||
end
|
||||
for i in 0 .. 99
|
||||
# TkcLine.new($a, i, 0, 0, 500 - i, "-fill", col)
|
||||
end
|
||||
end
|
||||
|
||||
print Time.now, "\n"
|
||||
|
||||
for j in 0 .. 99
|
||||
print "*"
|
||||
$stdout.flush
|
||||
if (j & 1) != 0
|
||||
col = "blue"
|
||||
else
|
||||
col = "red"
|
||||
end
|
||||
for i in 0 .. 99
|
||||
TkcLine.new($a, i, 0, 0, 500 - i, "-fill", col)
|
||||
end
|
||||
end
|
||||
|
||||
print Time.now, "\n"
|
||||
# Tk.root.destroy
|
||||
end
|
||||
|
||||
$a = TkCanvas.new{
|
||||
height(500)
|
||||
width(500)
|
||||
}
|
||||
|
||||
$b = TkButton.new{
|
||||
text("draw")
|
||||
command(proc{drawlines()})
|
||||
}
|
||||
|
||||
TkPack.configure($a, $b, {"side"=>"left"})
|
||||
|
||||
Tk.mainloop
|
||||
|
||||
# eof
|
||||
|
|
@ -1,54 +0,0 @@
|
|||
#! /usr/local/bin/ruby
|
||||
|
||||
require "tk"
|
||||
|
||||
def drawlines()
|
||||
print Time.now, "\n"
|
||||
|
||||
for j in 0 .. 99
|
||||
print "*"
|
||||
$stdout.flush
|
||||
if (j & 1) != 0
|
||||
col = "blue"
|
||||
else
|
||||
col = "red"
|
||||
end
|
||||
for i in 0 .. 99
|
||||
# $a.create(TkcLine, 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.create(TkcLine, 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
|
||||
|
|
@ -1,54 +0,0 @@
|
|||
#! /usr/local/bin/ruby
|
||||
|
||||
require "tk"
|
||||
|
||||
def drawlines()
|
||||
print Time.now, "\n"
|
||||
|
||||
for j in 0 .. 99
|
||||
print "*"
|
||||
$stdout.flush
|
||||
if (j & 1) != 0
|
||||
col = "blue"
|
||||
else
|
||||
col = "red"
|
||||
end
|
||||
for i in 0 .. 99
|
||||
# TkCore::INTERP.__invoke($a.path, "create", "line", i.to_s, '0', '0', (500 - i).to_s, "-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
|
||||
TkCore::INTERP.__invoke($a.path, "create", "line", i.to_s, '0', '0', (500 - i).to_s, "-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
|
||||
|
|
@ -1,22 +0,0 @@
|
|||
#!/usr/bin/env ruby
|
||||
require 'tcltklib'
|
||||
|
||||
master = TclTkIp.new
|
||||
slave_name = 'slave0'
|
||||
slave = master.create_slave(slave_name, true)
|
||||
master._eval("::safe::interpInit #{slave_name}")
|
||||
master._eval("::safe::loadTk #{slave_name}")
|
||||
|
||||
master._invoke('label', '.l1', '-text', 'master')
|
||||
master._invoke('pack', '.l1', '-padx', '30', '-pady', '50')
|
||||
master._eval('label .l2 -text {root widget of master-ip}')
|
||||
master._eval('pack .l2 -padx 30 -pady 50')
|
||||
|
||||
slave._invoke('label', '.l1', '-text', 'slave')
|
||||
slave._invoke('pack', '.l1', '-padx', '30', '-pady', '50')
|
||||
slave._eval('label .l2 -text {root widget of slave-ip}')
|
||||
slave._eval('pack .l2 -padx 30 -pady 20')
|
||||
slave._eval('label .l3 -text {( container frame widget of master-ip )}')
|
||||
slave._eval('pack .l3 -padx 30 -pady 20')
|
||||
|
||||
TclTkLib.mainloop
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
tcltklib.o: tcltklib.c $(hdrdir)/ruby.h $(topdir)/config.h $(hdrdir)/defines.h
|
||||
stubs.o: stubs.c stubs.h $(hdrdir)/ruby.h $(topdir)/config.h $(hdrdir)/defines.h
|
||||
|
|
@ -1,300 +0,0 @@
|
|||
# extconf.rb for tcltklib
|
||||
|
||||
require 'mkmf'
|
||||
|
||||
is_win32 = (/mswin32|mingw|cygwin|bccwin32/ =~ RUBY_PLATFORM)
|
||||
#is_macosx = (/darwin/ =~ RUBY_PLATFORM)
|
||||
|
||||
def find_framework(tcl_hdr, tk_hdr)
|
||||
if framework_dir = with_config("tcltk-framework")
|
||||
paths = [framework_dir]
|
||||
else
|
||||
unless tcl_hdr || tk_hdr ||
|
||||
enable_config("tcltk-framework", false) ||
|
||||
enable_config("mac-tcltk-framework", false)
|
||||
return false
|
||||
end
|
||||
paths = ["/Library/Frameworks", "/System/Library/Frameworks"]
|
||||
end
|
||||
|
||||
checking_for('Tcl/Tk Framework') {
|
||||
paths.find{|dir|
|
||||
dir.strip!
|
||||
dir.chomp!('/')
|
||||
(tcl_hdr || FileTest.directory?(dir + "/Tcl.framework/") ) &&
|
||||
(tk_hdr || FileTest.directory?(dir + "/Tk.framework/") )
|
||||
}
|
||||
}
|
||||
end
|
||||
|
||||
tcl_framework_header = with_config("tcl-framework-header")
|
||||
tk_framework_header = with_config("tk-framework-header")
|
||||
|
||||
tcltk_framework = find_framework(tcl_framework_header, tk_framework_header)
|
||||
|
||||
unless is_win32
|
||||
have_library("nsl", "t_open")
|
||||
have_library("socket", "socket")
|
||||
have_library("dl", "dlopen")
|
||||
have_library("m", "log")
|
||||
end
|
||||
|
||||
dir_config("tk")
|
||||
dir_config("tcl")
|
||||
dir_config("X11")
|
||||
|
||||
tklib = with_config("tklib")
|
||||
tcllib = with_config("tcllib")
|
||||
stubs = enable_config("tcltk_stubs") || with_config("tcltk_stubs")
|
||||
|
||||
def find_tcl(tcllib, stubs)
|
||||
paths = ["/usr/local/lib", "/usr/pkg/lib", "/usr/lib"]
|
||||
if stubs
|
||||
func = "Tcl_InitStubs"
|
||||
lib = "tclstub"
|
||||
else
|
||||
func = "Tcl_FindExecutable"
|
||||
lib = "tcl"
|
||||
end
|
||||
if tcllib
|
||||
find_library(tcllib, func, *paths)
|
||||
elsif find_library(lib, func, *paths)
|
||||
true
|
||||
else
|
||||
%w[8.5 8.4 8.3 8.2 8.1 8.0 7.6].find { |ver|
|
||||
find_library("#{lib}#{ver}", func, *paths) or
|
||||
find_library("#{lib}#{ver.delete('.')}", func, *paths) or
|
||||
find_library("tcl#{ver}", func, *paths) or
|
||||
find_library("tcl#{ver.delete('.')}", func, *paths)
|
||||
}
|
||||
end
|
||||
end
|
||||
|
||||
def find_tk(tklib, stubs)
|
||||
paths = ["/usr/local/lib", "/usr/pkg/lib", "/usr/lib"]
|
||||
if stubs
|
||||
func = "Tk_InitStubs"
|
||||
lib = "tkstub"
|
||||
else
|
||||
func = "Tk_Init"
|
||||
lib = "tk"
|
||||
end
|
||||
if tklib
|
||||
find_library(tklib, func, *paths)
|
||||
elsif find_library(lib, func, *paths)
|
||||
true
|
||||
else
|
||||
%w[8.5 8.4 8.3 8.2 8.1 8.0 4.2].find { |ver|
|
||||
find_library("#{lib}#{ver}", func, *paths) or
|
||||
find_library("#{lib}#{ver.delete('.')}", func, *paths) or
|
||||
find_library("tk#{ver}", func, *paths) or
|
||||
find_library("tk#{ver.delete('.')}", func, *paths)
|
||||
}
|
||||
end
|
||||
end
|
||||
|
||||
def pthread_check()
|
||||
tcl_major_ver = nil
|
||||
tcl_minor_ver = nil
|
||||
|
||||
# Is tcl-thread given by user ?
|
||||
case enable_config("tcl-thread")
|
||||
when true
|
||||
tcl_enable_thread = true
|
||||
when false
|
||||
tcl_enable_thread = false
|
||||
else
|
||||
tcl_enable_thread = nil
|
||||
end
|
||||
|
||||
if (tclConfig = with_config("tclConfig-file"))
|
||||
if tcl_enable_thread == true
|
||||
puts("Warning: --with-tclConfig-file option is ignored, because --enable-tcl-thread option is given.")
|
||||
elsif tcl_enable_thread == false
|
||||
puts("Warning: --with-tclConfig-file option is ignored, because --disable-tcl-thread option is given.")
|
||||
else
|
||||
# tcl-thread is unknown and tclConfig.sh is given
|
||||
begin
|
||||
open(tclConfig, "r") do |cfg|
|
||||
while line = cfg.gets()
|
||||
if line =~ /^\s*TCL_THREADS=(0|1)/
|
||||
tcl_enable_thread = ($1 == "1")
|
||||
break
|
||||
end
|
||||
|
||||
if line =~ /^\s*TCL_MAJOR_VERSION=("|')(\d+)\1/
|
||||
tcl_major_ver = $2
|
||||
if tcl_major_ver =~ /^[1-7]$/
|
||||
tcl_enable_thread = false
|
||||
break
|
||||
end
|
||||
if tcl_major_ver == "8" && tcl_minor_ver == "0"
|
||||
tcl_enable_thread = false
|
||||
break
|
||||
end
|
||||
end
|
||||
|
||||
if line =~ /^\s*TCL_MINOR_VERSION=("|')(\d+)\1/
|
||||
tcl_minor_ver = $2
|
||||
if tcl_major_ver == "8" && tcl_minor_ver == "0"
|
||||
tcl_enable_thread = false
|
||||
break
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
if tcl_enable_thread == nil
|
||||
# not find definition
|
||||
if tcl_major_ver
|
||||
puts("Warning: '#{tclConfig}' doesn't include TCL_THREADS definition.")
|
||||
else
|
||||
puts("Warning: '#{tclConfig}' may not be a tclConfig file.")
|
||||
end
|
||||
tclConfig = false
|
||||
end
|
||||
rescue Exception
|
||||
puts("Warning: fail to read '#{tclConfig}'!! --> ignore the file")
|
||||
tclConfig = false
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
if tcl_enable_thread == nil && !tclConfig
|
||||
# tcl-thread is unknown and tclConfig is unavailable
|
||||
begin
|
||||
try_run_available = try_run("int main() { exit(0); }")
|
||||
rescue Exception
|
||||
# cannot try_run. Is CROSS-COMPILE environment?
|
||||
puts(%Q'\
|
||||
*****************************************************************************
|
||||
**
|
||||
** PTHREAD SUPPORT CHECK WARNING:
|
||||
**
|
||||
** We cannot check the consistency of pthread support between Ruby
|
||||
** and the Tcl/Tk library in your environment (are you perhaps
|
||||
** cross-compiling?). If pthread support for these 2 packages is
|
||||
** inconsistent you may find you get errors when running Ruby/Tk
|
||||
** (e.g. hangs or segmentation faults). We strongly recommend
|
||||
** you to check the consistency manually.
|
||||
**
|
||||
*****************************************************************************
|
||||
')
|
||||
return true
|
||||
end
|
||||
end
|
||||
|
||||
if tcl_enable_thread == nil
|
||||
# tcl-thread is unknown
|
||||
if try_run(<<EOF)
|
||||
#include <tcl.h>
|
||||
int main() {
|
||||
Tcl_Interp *ip;
|
||||
ip = Tcl_CreateInterp();
|
||||
exit((Tcl_Eval(ip, "set tcl_platform(threaded)") == TCL_OK)? 0: 1);
|
||||
}
|
||||
EOF
|
||||
tcl_enable_thread = true
|
||||
elsif try_run(<<EOF)
|
||||
#include <tcl.h>
|
||||
static Tcl_ThreadDataKey dataKey;
|
||||
int main() { exit((Tcl_GetThreadData(&dataKey, 1) == dataKey)? 1: 0); }
|
||||
EOF
|
||||
tcl_enable_thread = true
|
||||
else
|
||||
tcl_enable_thread = false
|
||||
end
|
||||
end
|
||||
|
||||
# check pthread mode
|
||||
if (macro_defined?('HAVE_LIBPTHREAD', '#include "ruby.h"'))
|
||||
# ruby -> enable
|
||||
unless tcl_enable_thread
|
||||
# ruby -> enable && tcl -> disable
|
||||
puts(%Q'\
|
||||
*****************************************************************************
|
||||
**
|
||||
** PTHREAD SUPPORT MODE WARNING:
|
||||
**
|
||||
** Ruby is compiled with --enable-pthread, but your Tcl/Tk library
|
||||
** seems to be compiled without pthread support. Although you can
|
||||
** create the tcltklib library, this combination may cause errors
|
||||
** (e.g. hangs or segmentation faults). If you have no reason to
|
||||
** keep the current pthread support status, we recommend you reconfigure
|
||||
** and recompile the libraries so that both or neither support pthreads.
|
||||
**
|
||||
** If you want change the status of pthread support, please recompile
|
||||
** Ruby without "--enable-pthread" configure option or recompile Tcl/Tk
|
||||
** with "--enable-threads" configure option (if your Tcl/Tk is later
|
||||
** than or equal to Tcl/Tk 8.1).
|
||||
**
|
||||
*****************************************************************************
|
||||
')
|
||||
end
|
||||
|
||||
# ruby -> enable && tcl -> enable/disable
|
||||
if tcl_enable_thread
|
||||
$CPPFLAGS += ' -DWITH_TCL_ENABLE_THREAD=1'
|
||||
else
|
||||
$CPPFLAGS += ' -DWITH_TCL_ENABLE_THREAD=0'
|
||||
end
|
||||
|
||||
return true
|
||||
|
||||
else
|
||||
# ruby -> disable
|
||||
if tcl_enable_thread
|
||||
# ruby -> disable && tcl -> enable
|
||||
puts(%Q'\
|
||||
*****************************************************************************
|
||||
**
|
||||
** PTHREAD SUPPORT MODE ERROR:
|
||||
**
|
||||
** Ruby is not compiled with --enable-pthread, but your Tcl/Tk
|
||||
** library seems to be compiled with pthread support. This
|
||||
** combination may cause frequent hang or segmentation fault
|
||||
** errors when Ruby/Tk is working. We recommend that you NEVER
|
||||
** create the library with such a combination of pthread support.
|
||||
**
|
||||
** Please recompile Ruby with the "--enable-pthread" configure option
|
||||
** or recompile Tcl/Tk with the "--disable-threads" configure option.
|
||||
**
|
||||
*****************************************************************************
|
||||
')
|
||||
$CPPFLAGS += ' -DWITH_TCL_ENABLE_THREAD=1'
|
||||
return false
|
||||
else
|
||||
# ruby -> disable && tcl -> disable
|
||||
$CPPFLAGS += ' -DWITH_TCL_ENABLE_THREAD=0'
|
||||
return true
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
if tcltk_framework ||
|
||||
(have_header("tcl.h") && have_header("tk.h") &&
|
||||
(is_win32 || find_library("X11", "XOpenDisplay",
|
||||
"/usr/X11/lib", "/usr/lib/X11", "/usr/X11R6/lib", "/usr/openwin/lib")) &&
|
||||
find_tcl(tcllib, stubs) &&
|
||||
find_tk(tklib, stubs))
|
||||
$CPPFLAGS += ' -DUSE_TCL_STUBS -DUSE_TK_STUBS' if stubs
|
||||
$CPPFLAGS += ' -D_WIN32' if /cygwin/ =~ RUBY_PLATFORM
|
||||
|
||||
if tcltk_framework
|
||||
if tcl_framework_header
|
||||
$CPPFLAGS += " -I#{tcl_framework_header}"
|
||||
else
|
||||
$CPPFLAGS += " -I#{tcltk_framework}/Tcl.framework/Headers"
|
||||
end
|
||||
|
||||
if tk_framework_header
|
||||
$CPPFLAGS += " -I#{tk_framework_header}"
|
||||
else
|
||||
$CPPFLAGS += " -I#{tcltk_framework}/Tk.framework/Headers"
|
||||
end
|
||||
|
||||
$LDFLAGS += ' -framework Tk -framework Tcl'
|
||||
end
|
||||
|
||||
create_makefile("tcltklib") if stubs or pthread_check
|
||||
end
|
||||
|
|
@ -1,367 +0,0 @@
|
|||
# tof
|
||||
|
||||
#### tcltk library, more direct manipulation of tcl/tk
|
||||
#### Sep. 5, 1997 Y. Shigehiro
|
||||
|
||||
require "tcltklib"
|
||||
|
||||
################
|
||||
|
||||
# module TclTk: collection of tcl/tk utilities (supplies namespace.)
|
||||
module TclTk
|
||||
|
||||
# initialize Hash to hold unique symbols and such
|
||||
@namecnt = {}
|
||||
|
||||
# initialize Hash to hold callbacks
|
||||
@callback = {}
|
||||
end
|
||||
|
||||
# TclTk.mainloop(): call TclTkLib.mainloop()
|
||||
def TclTk.mainloop()
|
||||
print("mainloop: start\n") if $DEBUG
|
||||
TclTkLib.mainloop()
|
||||
print("mainloop: end\n") if $DEBUG
|
||||
end
|
||||
|
||||
# TclTk.deletecallbackkey(ca): remove callback from TclTk module
|
||||
# this does not remove callbacks from tcl/tk interpreter
|
||||
# without calling this method, TclTkInterpreter will not be GCed
|
||||
# ca: callback(TclTkCallback)
|
||||
def TclTk.deletecallbackkey(ca)
|
||||
print("deletecallbackkey: ", ca.to_s(), "\n") if $DEBUG
|
||||
@callback.delete(ca.to_s)
|
||||
end
|
||||
|
||||
# TclTk.dcb(ca, wid, W): call TclTk.deletecallbackkey() for each callbacks
|
||||
# in an array.
|
||||
# this is for callback for top-level <Destroy>
|
||||
# ca: array of callbacks(TclTkCallback)
|
||||
# wid: top-level widget(TclTkWidget)
|
||||
# w: information about window given by %W(String)
|
||||
def TclTk.dcb(ca, wid, w)
|
||||
if wid.to_s() == w
|
||||
ca.each{|i|
|
||||
TclTk.deletecallbackkey(i)
|
||||
}
|
||||
end
|
||||
end
|
||||
|
||||
# TclTk._addcallback(ca): register callback
|
||||
# ca: callback(TclTkCallback)
|
||||
def TclTk._addcallback(ca)
|
||||
print("_addcallback: ", ca.to_s(), "\n") if $DEBUG
|
||||
@callback[ca.to_s()] = ca
|
||||
end
|
||||
|
||||
# TclTk._callcallback(key, arg): invoke registered callback
|
||||
# key: key to select callback (to_s value of the TclTkCallback)
|
||||
# arg: parameter from tcl/tk interpreter
|
||||
def TclTk._callcallback(key, arg)
|
||||
print("_callcallback: ", @callback[key].inspect, "\n") if $DEBUG
|
||||
@callback[key]._call(arg)
|
||||
# throw out callback value
|
||||
# should return String to satisfy rb_eval_string()
|
||||
return ""
|
||||
end
|
||||
|
||||
# TclTk._newname(prefix): generate unique name(String)
|
||||
# prefix: prefix of the unique name
|
||||
def TclTk._newname(prefix)
|
||||
# generated name counter is stored in @namecnt
|
||||
if !@namecnt.key?(prefix)
|
||||
# first appearing prefix, initialize
|
||||
@namecnt[prefix] = 1
|
||||
else
|
||||
# already appeared prefix, generate next name
|
||||
@namecnt[prefix] += 1
|
||||
end
|
||||
return "#{prefix}#{@namecnt[prefix]}"
|
||||
end
|
||||
|
||||
################
|
||||
|
||||
# class TclTkInterpreter: tcl/tk interpreter
|
||||
class TclTkInterpreter
|
||||
|
||||
# initialize():
|
||||
def initialize()
|
||||
# generate interpreter object
|
||||
@ip = TclTkIp.new()
|
||||
|
||||
# add ruby_fmt command to tcl interpreter
|
||||
# ruby_fmt command format arguments by `format' and call `ruby' command
|
||||
# (notice ruby command receives only one argument)
|
||||
if $DEBUG
|
||||
@ip._eval("proc ruby_fmt {fmt args} { puts \"ruby_fmt: $fmt $args\" ; set cmd [list ruby [format $fmt $args]] ; uplevel $cmd }")
|
||||
else
|
||||
@ip._eval("proc ruby_fmt {fmt args} { set cmd [list ruby [format $fmt $args]] ; uplevel $cmd }")
|
||||
end
|
||||
|
||||
# @ip._get_eval_string(*args): generate string to evaluate in tcl interpreter
|
||||
# *args: script which is going to be evaluated under tcl/tk
|
||||
def @ip._get_eval_string(*args)
|
||||
argstr = ""
|
||||
args.each{|arg|
|
||||
argstr += " " if argstr != ""
|
||||
# call to_eval if it is defined
|
||||
if (arg.respond_to?(:to_eval))
|
||||
argstr += arg.to_eval()
|
||||
else
|
||||
# call to_s unless defined
|
||||
argstr += arg.to_s()
|
||||
end
|
||||
}
|
||||
return argstr
|
||||
end
|
||||
|
||||
# @ip._eval_args(*args): evaluate string under tcl/tk interpreter
|
||||
# returns result string.
|
||||
# *args: script which is going to be evaluated under tcl/tk
|
||||
def @ip._eval_args(*args)
|
||||
# calculate the string to eval in the interpreter
|
||||
argstr = _get_eval_string(*args)
|
||||
|
||||
# evaluate under the interpreter
|
||||
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
|
||||
|
||||
# generate tcl/tk command object and register in the hash
|
||||
@commands = {}
|
||||
# for all commands registered in tcl/tk interpreter:
|
||||
@ip._eval("info command").split(/ /).each{|comname|
|
||||
if comname =~ /^[.]/
|
||||
# if command is a widget (path), generate TclTkWidget,
|
||||
# and register it in the hash
|
||||
@commands[comname] = TclTkWidget.new(@ip, comname)
|
||||
else
|
||||
# otherwise, generate TclTkCommand
|
||||
@commands[comname] = TclTkCommand.new(@ip, comname)
|
||||
end
|
||||
}
|
||||
end
|
||||
|
||||
# commands(): returns hash of the tcl/tk commands
|
||||
def commands()
|
||||
return @commands
|
||||
end
|
||||
|
||||
# rootwidget(): returns root widget(TclTkWidget)
|
||||
def rootwidget()
|
||||
return @commands["."]
|
||||
end
|
||||
|
||||
# _tcltkip(): returns @ip(TclTkIp)
|
||||
def _tcltkip()
|
||||
return @ip
|
||||
end
|
||||
|
||||
# method_missing(id, *args): execute undefined method as tcl/tk command
|
||||
# id: method symbol
|
||||
# *args: method arguments
|
||||
def method_missing(id, *args)
|
||||
# if command named by id registered, then execute it
|
||||
if @commands.key?(id.id2name)
|
||||
return @commands[id.id2name].e(*args)
|
||||
else
|
||||
# otherwise, exception
|
||||
super
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
# class TclTkObject: base class of the tcl/tk objects
|
||||
class TclTkObject
|
||||
|
||||
# initialize(ip, exp):
|
||||
# ip: interpreter(TclTkIp)
|
||||
# exp: tcl/tk representation
|
||||
def initialize(ip, exp)
|
||||
fail("type is not TclTkIp") if !ip.kind_of?(TclTkIp)
|
||||
@ip = ip
|
||||
@exp = exp
|
||||
end
|
||||
|
||||
# to_s(): returns tcl/tk representation
|
||||
def to_s()
|
||||
return @exp
|
||||
end
|
||||
end
|
||||
|
||||
# class TclTkCommand: tcl/tk commands
|
||||
# you should not call TclTkCommand.new()
|
||||
# commands are created by TclTkInterpreter:initialize()
|
||||
class TclTkCommand < TclTkObject
|
||||
|
||||
# e(*args): execute command. returns String (e is for exec or eval)
|
||||
# *args: command arguments
|
||||
def e(*args)
|
||||
return @ip._eval_args(to_s(), *args)
|
||||
end
|
||||
end
|
||||
|
||||
# class TclTkLibCommand: tcl/tk commands in the library
|
||||
class TclTkLibCommand < TclTkCommand
|
||||
|
||||
# initialize(ip, name):
|
||||
# ip: interpreter(TclTkInterpreter)
|
||||
# name: command name (String)
|
||||
def initialize(ip, name)
|
||||
super(ip._tcltkip, name)
|
||||
end
|
||||
end
|
||||
|
||||
# class TclTkVariable: tcl/tk variable
|
||||
class TclTkVariable < TclTkObject
|
||||
|
||||
# initialize(interp, dat):
|
||||
# interp: interpreter(TclTkInterpreter)
|
||||
# dat: the value to set(String)
|
||||
# if nil, not initialize variable
|
||||
def initialize(interp, dat)
|
||||
# auto-generate tcl/tk representation (variable name)
|
||||
exp = TclTk._newname("v_")
|
||||
# initialize TclTkObject
|
||||
super(interp._tcltkip(), exp)
|
||||
# safe this for `set' command
|
||||
@set = interp.commands()["set"]
|
||||
# set value
|
||||
set(dat) if dat
|
||||
end
|
||||
|
||||
# although you can set/refer variable by using set in tcl/tk,
|
||||
# we provide the method for accessing variables
|
||||
|
||||
# set(data): set tcl/tk variable using `set'
|
||||
# data: new value
|
||||
def set(data)
|
||||
@set.e(to_s(), data.to_s())
|
||||
end
|
||||
|
||||
# get(): read tcl/tk variable(String) using `set'
|
||||
def get()
|
||||
return @set.e(to_s())
|
||||
end
|
||||
end
|
||||
|
||||
# class TclTkWidget: tcl/tk widget
|
||||
class TclTkWidget < TclTkCommand
|
||||
|
||||
# initialize(*args):
|
||||
# *args: parameters
|
||||
def initialize(*args)
|
||||
if args[0].kind_of?(TclTkIp)
|
||||
# in case the 1st argument is TclTkIp:
|
||||
|
||||
# Wrap tcl/tk widget by TclTkWidget
|
||||
# (used in TclTkInterpreter#initialize())
|
||||
|
||||
# need two arguments
|
||||
fail("illegal # of parameter") if args.size != 2
|
||||
|
||||
# ip: interpreter(TclTkIp)
|
||||
# exp: tcl/tk representation
|
||||
ip, exp = args
|
||||
|
||||
# initialize TclTkObject
|
||||
super(ip, exp)
|
||||
elsif args[0].kind_of?(TclTkInterpreter)
|
||||
# in case 1st parameter is TclTkInterpreter:
|
||||
|
||||
# generate new widget from parent widget
|
||||
|
||||
# interp: interpreter(TclTkInterpreter)
|
||||
# parent: parent widget
|
||||
# command: widget generating tk command(label Åù)
|
||||
# *args: argument to the command
|
||||
interp, parent, command, *args = args
|
||||
|
||||
# generate widget name
|
||||
exp = parent.to_s()
|
||||
exp += "." if exp !~ /[.]$/
|
||||
exp += TclTk._newname("w_")
|
||||
# initialize TclTkObject
|
||||
super(interp._tcltkip(), exp)
|
||||
# generate widget
|
||||
res = @ip._eval_args(command, exp, *args)
|
||||
# fail("can't create Widget") if res != exp
|
||||
# for tk_optionMenu, it is legal res != exp
|
||||
else
|
||||
fail("first parameter is not TclTkInterpreter")
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
# class TclTkCallback: tcl/tk callbacks
|
||||
class TclTkCallback < TclTkObject
|
||||
|
||||
# initialize(interp, pr, arg):
|
||||
# interp: interpreter(TclTkInterpreter)
|
||||
# pr: callback procedure(Proc)
|
||||
# arg: string to pass as block parameters of pr
|
||||
# bind command of tcl/tk uses % replacement for parameters
|
||||
# pr can receive replaced data using block parameter
|
||||
# its format is specified by arg string
|
||||
# You should not specify arg for the command like
|
||||
# scrollbar with -command option, which receives parameters
|
||||
# without specifying any replacement
|
||||
def initialize(interp, pr, arg = nil)
|
||||
# auto-generate tcl/tk representation (variable name)
|
||||
exp = TclTk._newname("c_")
|
||||
# initialize TclTkObject
|
||||
super(interp._tcltkip(), exp)
|
||||
# save parameters
|
||||
@pr = pr
|
||||
@arg = arg
|
||||
# register in the module
|
||||
TclTk._addcallback(self)
|
||||
end
|
||||
|
||||
# to_eval(): retuens string representation for @ip._eval_args
|
||||
def to_eval()
|
||||
if @arg
|
||||
# bind replaces %s before calling ruby_fmt, so %%s is used
|
||||
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): invoke callback
|
||||
# arg: callback parameter
|
||||
def _call(arg)
|
||||
@pr.call(arg)
|
||||
end
|
||||
end
|
||||
|
||||
# class TclTkImage: tcl/tk images
|
||||
class TclTkImage < TclTkCommand
|
||||
|
||||
# initialize(interp, t, *args):
|
||||
# generating image is done by TclTkImage.new()
|
||||
# destrying is done by image delete (inconsistent, sigh)
|
||||
# interp: interpreter(TclTkInterpreter)
|
||||
# t: image type (photo, bitmap, etc.)
|
||||
# *args: command argument
|
||||
def initialize(interp, t, *args)
|
||||
# auto-generate tcl/tk representation
|
||||
exp = TclTk._newname("i_")
|
||||
# initialize TclTkObject
|
||||
super(interp._tcltkip(), exp)
|
||||
# generate image
|
||||
res = @ip._eval_args("image create", t, exp, *args)
|
||||
fail("can't create Image") if res != exp
|
||||
end
|
||||
end
|
||||
|
||||
# eof
|
||||
Binary file not shown.
|
Before Width: | Height: | Size: 538 B |
Binary file not shown.
|
Before Width: | Height: | Size: 481 B |
|
|
@ -1,39 +0,0 @@
|
|||
#! /usr/local/bin/ruby -vd
|
||||
|
||||
# tcltklib ライブラリのテスト
|
||||
|
||||
require "tcltklib"
|
||||
|
||||
def test
|
||||
# インタプリタを生成する
|
||||
ip1 = TclTkIp.new()
|
||||
|
||||
# 評価してみる
|
||||
print ip1._return_value().inspect, "\n"
|
||||
print ip1._eval("puts {abc}").inspect, "\n"
|
||||
|
||||
# ボタンを作ってみる
|
||||
print ip1._return_value().inspect, "\n"
|
||||
print ip1._eval("button .lab -text exit -command \"destroy .\"").inspect,
|
||||
"\n"
|
||||
print ip1._return_value().inspect, "\n"
|
||||
print ip1._eval("pack .lab").inspect, "\n"
|
||||
print ip1._return_value().inspect, "\n"
|
||||
|
||||
# インタプリタから ruby コマンドを評価してみる
|
||||
# print ip1._eval(%q/ruby {print "print by ruby\n"}/).inspect, "\n"
|
||||
print ip1._eval(%q+puts [ruby {print "print by ruby\n"; "puts by tcl/tk"}]+).inspect, "\n"
|
||||
print ip1._return_value().inspect, "\n"
|
||||
|
||||
# もう一つインタプリタを生成してみる
|
||||
ip2 = TclTkIp.new()
|
||||
ip2._eval("button .lab -text test -command \"puts test ; destroy .\"")
|
||||
ip2._eval("pack .lab")
|
||||
|
||||
TclTkLib.mainloop
|
||||
end
|
||||
|
||||
test
|
||||
GC.start
|
||||
|
||||
print "exit\n"
|
||||
|
|
@ -1,634 +0,0 @@
|
|||
#! /usr/local/bin/ruby -d
|
||||
#! /usr/local/bin/ruby
|
||||
# -d オプションを付けると, デバッグ情報を表示する.
|
||||
|
||||
# tcltk ライブラリのサンプル
|
||||
|
||||
# まず, ライブラリを require する.
|
||||
require "tcltk"
|
||||
|
||||
# 以下は, Test1 のインスタンスの initialize() で,
|
||||
# tcl/tk に関する処理を行う例である.
|
||||
# 必ずしもそのようにする必要は無く,
|
||||
# (もし, そうしたければ) class の外で tcl/tk に関する処理を行っても良い.
|
||||
|
||||
class Test1
|
||||
# 初期化(インタプリタを生成してウィジェットを生成する).
|
||||
def initialize()
|
||||
|
||||
#### 使う前のおまじない
|
||||
|
||||
# インタプリタの生成.
|
||||
ip = TclTkInterpreter.new()
|
||||
# コマンドに対応するオブジェクトを c に設定しておく.
|
||||
c = ip.commands()
|
||||
# 使用するコマンドに対応するオブジェクトは変数に入れておく.
|
||||
append, bind, button, destroy, incr, info, label, place, set, wm =
|
||||
c.values_at(
|
||||
"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().values_at(
|
||||
"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().values_at(
|
||||
"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().values_at(
|
||||
"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().values_at("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().values_at(
|
||||
"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().values_at(
|
||||
"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().values_at(
|
||||
"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().values_at(
|
||||
"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().values_at(
|
||||
"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().values_at(
|
||||
"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().values_at(
|
||||
"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().values_at(
|
||||
"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().values_at(
|
||||
"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().values_at("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
|
||||
|
|
@ -1,451 +0,0 @@
|
|||
#!/usr/local/bin/ruby
|
||||
#----------------------> pretty simple othello game <-----------------------
|
||||
# othello.rb
|
||||
#
|
||||
# version 0.3
|
||||
# maeda shugo (shuto@po.aianet.ne.jp)
|
||||
#---------------------------------------------------------------------------
|
||||
|
||||
# Sep. 17, 1997 modified by Y. Shigehiro for tcltk library
|
||||
# maeda shugo (shugo@po.aianet.ne.jp) 氏による
|
||||
# (ruby/tk で書かれていた) ruby のサンプルプログラム
|
||||
# http://www.aianet.or.jp/~shugo/ruby/othello.rb.gz
|
||||
# を tcltk ライブラリを使うように, 機械的に変更してみました.
|
||||
#
|
||||
# なるべくオリジナルと同じになるようにしてあります.
|
||||
|
||||
require "observer"
|
||||
require "tcltk"
|
||||
$ip = TclTkInterpreter.new()
|
||||
$root = $ip.rootwidget()
|
||||
$button, $canvas, $checkbutton, $frame, $label, $pack, $update, $wm =
|
||||
$ip.commands().values_at(
|
||||
"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) \
|
||||
<< "-fill #{BACK_GROUND_COLOR}") )
|
||||
@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
|
||||
|
|
@ -1,507 +0,0 @@
|
|||
#include "stubs.h"
|
||||
#include "ruby.h"
|
||||
#include <tcl.h>
|
||||
#include <tk.h>
|
||||
|
||||
/*------------------------------*/
|
||||
|
||||
#ifdef __MACOS__
|
||||
# include <tkMac.h>
|
||||
# include <Quickdraw.h>
|
||||
|
||||
static int call_macinit = 0;
|
||||
|
||||
static void
|
||||
_macinit()
|
||||
{
|
||||
if (!call_macinit) {
|
||||
tcl_macQdPtr = &qd; /* setup QuickDraw globals */
|
||||
Tcl_MacSetEventProc(TkMacConvertEvent); /* setup event handler */
|
||||
call_macinit = 1;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
/*------------------------------*/
|
||||
|
||||
static int nativethread_checked = 0;
|
||||
|
||||
static void
|
||||
_nativethread_consistency_check(ip)
|
||||
Tcl_Interp *ip;
|
||||
{
|
||||
if (nativethread_checked || ip == (Tcl_Interp *)NULL) {
|
||||
return;
|
||||
}
|
||||
|
||||
if (Tcl_Eval(ip, "set ::tcl_platform(threaded)") == TCL_OK) {
|
||||
#ifdef HAVE_NATIVETHREAD
|
||||
/* consistent */
|
||||
#else
|
||||
rb_warn("Inconsistency. Loaded Tcl/Tk libraries are enabled nativethread-support. But `tcltklib' is not. The inconsistency causes SEGV or other troubles frequently.");
|
||||
#endif
|
||||
} else {
|
||||
#ifdef HAVE_NATIVETHREAD
|
||||
rb_warning("Inconsistency.`tcltklib' is enabled nativethread-support. But loaded Tcl/Tk libraries are not. (Probably, the inconsistency doesn't cause any troubles.)");
|
||||
#else
|
||||
/* consistent */
|
||||
#endif
|
||||
}
|
||||
|
||||
Tcl_ResetResult(ip);
|
||||
|
||||
nativethread_checked = 1;
|
||||
}
|
||||
|
||||
/*------------------------------*/
|
||||
|
||||
#if defined USE_TCL_STUBS && defined USE_TK_STUBS
|
||||
|
||||
#if defined _WIN32 || defined __CYGWIN__
|
||||
# include "util.h"
|
||||
# include <windows.h>
|
||||
typedef HINSTANCE DL_HANDLE;
|
||||
# define DL_OPEN LoadLibrary
|
||||
# define DL_SYM GetProcAddress
|
||||
# define TCL_INDEX 4
|
||||
# define TK_INDEX 3
|
||||
# define TCL_NAME "tcl89%s"
|
||||
# define TK_NAME "tk89%s"
|
||||
# undef DLEXT
|
||||
# define DLEXT ".dll"
|
||||
#elif defined HAVE_DLOPEN
|
||||
# include <dlfcn.h>
|
||||
typedef void *DL_HANDLE;
|
||||
# define DL_OPEN(file) dlopen(file, RTLD_LAZY|RTLD_GLOBAL)
|
||||
# define DL_SYM dlsym
|
||||
# define TCL_INDEX 8
|
||||
# define TK_INDEX 7
|
||||
# define TCL_NAME "libtcl8.9%s"
|
||||
# define TK_NAME "libtk8.9%s"
|
||||
#endif
|
||||
|
||||
static DL_HANDLE tcl_dll = (DL_HANDLE)0;
|
||||
static DL_HANDLE tk_dll = (DL_HANDLE)0;
|
||||
|
||||
int
|
||||
ruby_open_tcl_dll(appname)
|
||||
char *appname;
|
||||
{
|
||||
void (*p_Tcl_FindExecutable)(const char *);
|
||||
int n;
|
||||
char *ruby_tcl_dll = 0;
|
||||
char tcl_name[20];
|
||||
|
||||
if (tcl_dll) return TCLTK_STUBS_OK;
|
||||
|
||||
ruby_tcl_dll = getenv("RUBY_TCL_DLL");
|
||||
#if defined _WIN32
|
||||
if (ruby_tcl_dll) ruby_tcl_dll = ruby_strdup(ruby_tcl_dll);
|
||||
#endif
|
||||
if (ruby_tcl_dll) {
|
||||
tcl_dll = (DL_HANDLE)DL_OPEN(ruby_tcl_dll);
|
||||
} else {
|
||||
snprintf(tcl_name, sizeof tcl_name, TCL_NAME, DLEXT);
|
||||
/* examine from 8.9 to 8.1 */
|
||||
for (n = '9'; n > '0'; n--) {
|
||||
tcl_name[TCL_INDEX] = n;
|
||||
tcl_dll = (DL_HANDLE)DL_OPEN(tcl_name);
|
||||
if (tcl_dll)
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
#if defined _WIN32
|
||||
if (ruby_tcl_dll) ruby_xfree(ruby_tcl_dll);
|
||||
#endif
|
||||
|
||||
if (!tcl_dll)
|
||||
return NO_TCL_DLL;
|
||||
|
||||
p_Tcl_FindExecutable = (void (*)(const char *))DL_SYM(tcl_dll, "Tcl_FindExecutable");
|
||||
if (!p_Tcl_FindExecutable)
|
||||
return NO_FindExecutable;
|
||||
|
||||
if (appname) {
|
||||
p_Tcl_FindExecutable(appname);
|
||||
} else {
|
||||
p_Tcl_FindExecutable("ruby");
|
||||
}
|
||||
|
||||
return TCLTK_STUBS_OK;
|
||||
}
|
||||
|
||||
int
|
||||
ruby_open_tk_dll()
|
||||
{
|
||||
int n;
|
||||
char *ruby_tk_dll = 0;
|
||||
char tk_name[20];
|
||||
|
||||
if (!tcl_dll) {
|
||||
int ret = ruby_open_tcl_dll(RSTRING(rb_argv0)->ptr);
|
||||
if (ret != TCLTK_STUBS_OK) return ret;
|
||||
}
|
||||
|
||||
if (tk_dll) return TCLTK_STUBS_OK;
|
||||
|
||||
ruby_tk_dll = getenv("RUBY_TK_DLL");
|
||||
if (ruby_tk_dll) {
|
||||
tk_dll = (DL_HANDLE)DL_OPEN(ruby_tk_dll);
|
||||
} else {
|
||||
snprintf(tk_name, sizeof tk_name, TK_NAME, DLEXT);
|
||||
/* examine from 8.9 to 8.1 */
|
||||
for (n = '9'; n > '0'; n--) {
|
||||
tk_name[TK_INDEX] = n;
|
||||
tk_dll = (DL_HANDLE)DL_OPEN(tk_name);
|
||||
if (tk_dll)
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
if (!tk_dll)
|
||||
return NO_TK_DLL;
|
||||
|
||||
return TCLTK_STUBS_OK;
|
||||
}
|
||||
|
||||
int
|
||||
ruby_open_tcltk_dll(appname)
|
||||
char *appname;
|
||||
{
|
||||
return( ruby_open_tcl_dll(appname) || ruby_open_tk_dll() );
|
||||
}
|
||||
|
||||
int
|
||||
tcl_stubs_init_p()
|
||||
{
|
||||
return(tclStubsPtr != (TclStubs*)NULL);
|
||||
}
|
||||
|
||||
int
|
||||
tk_stubs_init_p()
|
||||
{
|
||||
return(tkStubsPtr != (TkStubs*)NULL);
|
||||
}
|
||||
|
||||
|
||||
Tcl_Interp *
|
||||
ruby_tcl_create_ip_and_stubs_init(st)
|
||||
int *st;
|
||||
{
|
||||
Tcl_Interp *tcl_ip;
|
||||
|
||||
if (st) *st = 0;
|
||||
|
||||
if (tcl_stubs_init_p()) {
|
||||
tcl_ip = Tcl_CreateInterp();
|
||||
|
||||
if (!tcl_ip) {
|
||||
if (st) *st = FAIL_CreateInterp;
|
||||
return (Tcl_Interp*)NULL;
|
||||
}
|
||||
|
||||
_nativethread_consistency_check(tcl_ip);
|
||||
|
||||
return tcl_ip;
|
||||
|
||||
} else {
|
||||
Tcl_Interp *(*p_Tcl_CreateInterp)();
|
||||
Tcl_Interp *(*p_Tcl_DeleteInterp)();
|
||||
|
||||
if (!tcl_dll) {
|
||||
int ret = ruby_open_tcl_dll(RSTRING(rb_argv0)->ptr);
|
||||
if (ret != TCLTK_STUBS_OK) {
|
||||
if (st) *st = ret;
|
||||
return (Tcl_Interp*)NULL;
|
||||
}
|
||||
}
|
||||
|
||||
p_Tcl_CreateInterp
|
||||
= (Tcl_Interp *(*)())DL_SYM(tcl_dll, "Tcl_CreateInterp");
|
||||
if (!p_Tcl_CreateInterp) {
|
||||
if (st) *st = NO_CreateInterp;
|
||||
return (Tcl_Interp*)NULL;
|
||||
}
|
||||
|
||||
p_Tcl_DeleteInterp
|
||||
= (Tcl_Interp *(*)())DL_SYM(tcl_dll, "Tcl_DeleteInterp");
|
||||
if (!p_Tcl_DeleteInterp) {
|
||||
if (st) *st = NO_DeleteInterp;
|
||||
return (Tcl_Interp*)NULL;
|
||||
}
|
||||
|
||||
tcl_ip = (*p_Tcl_CreateInterp)();
|
||||
if (!tcl_ip) {
|
||||
if (st) *st = FAIL_CreateInterp;
|
||||
return (Tcl_Interp*)NULL;
|
||||
}
|
||||
|
||||
_nativethread_consistency_check(tcl_ip);
|
||||
|
||||
if (!Tcl_InitStubs(tcl_ip, "8.1", 0)) {
|
||||
if (st) *st = FAIL_Tcl_InitStubs;
|
||||
(*p_Tcl_DeleteInterp)(tcl_ip);
|
||||
return (Tcl_Interp*)NULL;
|
||||
}
|
||||
|
||||
return tcl_ip;
|
||||
}
|
||||
}
|
||||
|
||||
int
|
||||
ruby_tcl_stubs_init()
|
||||
{
|
||||
int st;
|
||||
Tcl_Interp *tcl_ip;
|
||||
|
||||
if (!tcl_stubs_init_p()) {
|
||||
tcl_ip = ruby_tcl_create_ip_and_stubs_init(&st);
|
||||
|
||||
if (!tcl_ip) return st;
|
||||
|
||||
Tcl_DeleteInterp(tcl_ip);
|
||||
}
|
||||
|
||||
return TCLTK_STUBS_OK;
|
||||
}
|
||||
|
||||
int
|
||||
ruby_tk_stubs_init(tcl_ip)
|
||||
Tcl_Interp *tcl_ip;
|
||||
{
|
||||
Tcl_ResetResult(tcl_ip);
|
||||
|
||||
if (tk_stubs_init_p()) {
|
||||
if (Tk_Init(tcl_ip) == TCL_ERROR) {
|
||||
return FAIL_Tk_Init;
|
||||
}
|
||||
} else {
|
||||
int (*p_Tk_Init)(Tcl_Interp *);
|
||||
|
||||
if (!tk_dll) {
|
||||
int ret = ruby_open_tk_dll();
|
||||
if (ret != TCLTK_STUBS_OK) return ret;
|
||||
}
|
||||
|
||||
p_Tk_Init = (int (*)(Tcl_Interp *))DL_SYM(tk_dll, "Tk_Init");
|
||||
if (!p_Tk_Init)
|
||||
return NO_Tk_Init;
|
||||
|
||||
if ((*p_Tk_Init)(tcl_ip) == TCL_ERROR)
|
||||
return FAIL_Tk_Init;
|
||||
|
||||
if (!Tk_InitStubs(tcl_ip, "8.1", 0))
|
||||
return FAIL_Tk_InitStubs;
|
||||
|
||||
#ifdef __MACOS__
|
||||
_macinit();
|
||||
#endif
|
||||
}
|
||||
|
||||
return TCLTK_STUBS_OK;
|
||||
}
|
||||
|
||||
int
|
||||
ruby_tk_stubs_safeinit(tcl_ip)
|
||||
Tcl_Interp *tcl_ip;
|
||||
{
|
||||
Tcl_ResetResult(tcl_ip);
|
||||
|
||||
if (tk_stubs_init_p()) {
|
||||
if (Tk_SafeInit(tcl_ip) == TCL_ERROR)
|
||||
return FAIL_Tk_Init;
|
||||
} else {
|
||||
int (*p_Tk_SafeInit)(Tcl_Interp *);
|
||||
|
||||
if (!tk_dll) {
|
||||
int ret = ruby_open_tk_dll();
|
||||
if (ret != TCLTK_STUBS_OK) return ret;
|
||||
}
|
||||
|
||||
p_Tk_SafeInit = (int (*)(Tcl_Interp *))DL_SYM(tk_dll, "Tk_SafeInit");
|
||||
if (!p_Tk_SafeInit)
|
||||
return NO_Tk_Init;
|
||||
|
||||
if ((*p_Tk_SafeInit)(tcl_ip) == TCL_ERROR)
|
||||
return FAIL_Tk_Init;
|
||||
|
||||
if (!Tk_InitStubs(tcl_ip, "8.1", 0))
|
||||
return FAIL_Tk_InitStubs;
|
||||
|
||||
#ifdef __MACOS__
|
||||
_macinit();
|
||||
#endif
|
||||
}
|
||||
|
||||
return TCLTK_STUBS_OK;
|
||||
}
|
||||
|
||||
int
|
||||
ruby_tcltk_stubs()
|
||||
{
|
||||
int st;
|
||||
Tcl_Interp *tcl_ip;
|
||||
|
||||
st = ruby_open_tcltk_dll(RSTRING(rb_argv0)->ptr);
|
||||
switch(st) {
|
||||
case NO_FindExecutable:
|
||||
return -7;
|
||||
case NO_TCL_DLL:
|
||||
case NO_TK_DLL:
|
||||
return -1;
|
||||
}
|
||||
|
||||
tcl_ip = ruby_tcl_create_ip_and_stubs_init(&st);
|
||||
if (!tcl_ip) {
|
||||
switch(st) {
|
||||
case NO_CreateInterp:
|
||||
case NO_DeleteInterp:
|
||||
return -2;
|
||||
case FAIL_CreateInterp:
|
||||
return -3;
|
||||
case FAIL_Tcl_InitStubs:
|
||||
return -5;
|
||||
}
|
||||
}
|
||||
|
||||
st = ruby_tk_stubs_init(tcl_ip);
|
||||
switch(st) {
|
||||
case NO_Tk_Init:
|
||||
Tcl_DeleteInterp(tcl_ip);
|
||||
return -4;
|
||||
case FAIL_Tk_Init:
|
||||
case FAIL_Tk_InitStubs:
|
||||
Tcl_DeleteInterp(tcl_ip);
|
||||
return -6;
|
||||
}
|
||||
|
||||
Tcl_DeleteInterp(tcl_ip);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*###################################################*/
|
||||
#else /* ! USE_TCL_STUBS || ! USE_TK_STUBS) */
|
||||
/*###################################################*/
|
||||
|
||||
static int open_tcl_dll = 0;
|
||||
static int call_tk_stubs_init = 0;
|
||||
|
||||
int
|
||||
ruby_open_tcl_dll(appname)
|
||||
char *appname;
|
||||
{
|
||||
if (appname) {
|
||||
Tcl_FindExecutable(appname);
|
||||
} else {
|
||||
Tcl_FindExecutable("ruby");
|
||||
}
|
||||
open_tcl_dll = 1;
|
||||
|
||||
return TCLTK_STUBS_OK;
|
||||
}
|
||||
|
||||
int ruby_open_tk_dll()
|
||||
{
|
||||
if (!open_tcl_dll) {
|
||||
ruby_open_tcl_dll(RSTRING(rb_argv0)->ptr);
|
||||
}
|
||||
|
||||
return TCLTK_STUBS_OK;
|
||||
}
|
||||
|
||||
int ruby_open_tcltk_dll(appname)
|
||||
char *appname;
|
||||
{
|
||||
return( ruby_open_tcl_dll(appname) || ruby_open_tk_dll() );
|
||||
}
|
||||
|
||||
int
|
||||
tcl_stubs_init_p()
|
||||
{
|
||||
return 1;
|
||||
}
|
||||
|
||||
int
|
||||
tk_stubs_init_p()
|
||||
{
|
||||
return call_tk_stubs_init;
|
||||
}
|
||||
|
||||
Tcl_Interp *
|
||||
ruby_tcl_create_ip_and_stubs_init(st)
|
||||
int *st;
|
||||
{
|
||||
Tcl_Interp *tcl_ip;
|
||||
|
||||
if (!open_tcl_dll) {
|
||||
ruby_open_tcl_dll(RSTRING(rb_argv0)->ptr);
|
||||
}
|
||||
|
||||
if (st) *st = 0;
|
||||
tcl_ip = Tcl_CreateInterp();
|
||||
if (!tcl_ip) {
|
||||
if (st) *st = FAIL_CreateInterp;
|
||||
return (Tcl_Interp*)NULL;
|
||||
}
|
||||
|
||||
_nativethread_consistency_check(tcl_ip);
|
||||
|
||||
return tcl_ip;
|
||||
}
|
||||
|
||||
int
|
||||
ruby_tcl_stubs_init()
|
||||
{
|
||||
return TCLTK_STUBS_OK;
|
||||
}
|
||||
|
||||
int
|
||||
ruby_tk_stubs_init(tcl_ip)
|
||||
Tcl_Interp *tcl_ip;
|
||||
{
|
||||
if (Tk_Init(tcl_ip) == TCL_ERROR)
|
||||
return FAIL_Tk_Init;
|
||||
|
||||
if (!call_tk_stubs_init) {
|
||||
#ifdef __MACOS__
|
||||
_macinit();
|
||||
#endif
|
||||
call_tk_stubs_init = 1;
|
||||
}
|
||||
|
||||
return TCLTK_STUBS_OK;
|
||||
}
|
||||
|
||||
int
|
||||
ruby_tk_stubs_safeinit(tcl_ip)
|
||||
Tcl_Interp *tcl_ip;
|
||||
{
|
||||
#if TCL_MAJOR_VERSION >= 8
|
||||
if (Tk_SafeInit(tcl_ip) == TCL_ERROR)
|
||||
return FAIL_Tk_Init;
|
||||
|
||||
if (!call_tk_stubs_init) {
|
||||
#ifdef __MACOS__
|
||||
_macinit();
|
||||
#endif
|
||||
call_tk_stubs_init = 1;
|
||||
}
|
||||
|
||||
return TCLTK_STUBS_OK;
|
||||
|
||||
#else /* TCL_MAJOR_VERSION < 8 */
|
||||
|
||||
return FAIL_Tk_Init;
|
||||
#endif
|
||||
}
|
||||
|
||||
int
|
||||
ruby_tcltk_stubs()
|
||||
{
|
||||
Tcl_FindExecutable(RSTRING(rb_argv0)->ptr);
|
||||
return 0;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
|
@ -1,33 +0,0 @@
|
|||
#include <tcl.h>
|
||||
|
||||
extern int ruby_open_tcl_dll(char *);
|
||||
extern int ruby_open_tk_dll();
|
||||
extern int ruby_open_tcltk_dll(char *);
|
||||
extern int tcl_stubs_init_p();
|
||||
extern int tk_stubs_init_p();
|
||||
extern Tcl_Interp *ruby_tcl_create_ip_and_stubs_init(int*);
|
||||
extern int ruby_tcl_stubs_init();
|
||||
extern int ruby_tk_stubs_init(Tcl_Interp*);
|
||||
extern int ruby_tk_stubs_safeinit(Tcl_Interp*);
|
||||
extern int ruby_tcltk_stubs();
|
||||
|
||||
/* no error */
|
||||
#define TCLTK_STUBS_OK (0)
|
||||
|
||||
/* return value of ruby_open_tcl_dll() */
|
||||
#define NO_TCL_DLL (1)
|
||||
#define NO_FindExecutable (2)
|
||||
|
||||
/* return value of ruby_open_tk_dll() */
|
||||
#define NO_TK_DLL (-1)
|
||||
|
||||
/* status value of ruby_tcl_create_ip_and_stubs_init(st) */
|
||||
#define NO_CreateInterp (3)
|
||||
#define NO_DeleteInterp (4)
|
||||
#define FAIL_CreateInterp (5)
|
||||
#define FAIL_Tcl_InitStubs (6)
|
||||
|
||||
/* return value of ruby_tk_stubs_init() */
|
||||
#define NO_Tk_Init (7)
|
||||
#define FAIL_Tk_Init (8)
|
||||
#define FAIL_Tk_InitStubs (9)
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -1 +1,2 @@
|
|||
tkutil.o: tkutil.c $(hdrdir)/ruby.h $(topdir)/config.h $(hdrdir)/defines.h
|
||||
tcltklib.o: tcltklib.c $(hdrdir)/ruby.h $(topdir)/config.h $(hdrdir)/defines.h
|
||||
stubs.o: stubs.c $(hdrdir)/ruby.h $(topdir)/config.h $(hdrdir)/defines.h
|
||||
|
|
|
|||
|
|
@ -1,4 +1,309 @@
|
|||
# extconf.rb for tcltklib
|
||||
|
||||
require 'mkmf'
|
||||
$preload = ["tcltklib"]
|
||||
($INSTALLFILES||=[]) << ["lib/tkextlib/SUPPORT_STATUS", "$(RUBYLIBDIR)", "lib"]
|
||||
create_makefile("tkutil")
|
||||
|
||||
is_win32 = (/mswin32|mingw|cygwin|bccwin32/ =~ RUBY_PLATFORM)
|
||||
#is_macosx = (/darwin/ =~ RUBY_PLATFORM)
|
||||
|
||||
def find_framework(tcl_hdr, tk_hdr)
|
||||
if framework_dir = with_config("tcltk-framework")
|
||||
paths = [framework_dir]
|
||||
else
|
||||
unless tcl_hdr || tk_hdr ||
|
||||
enable_config("tcltk-framework", false) ||
|
||||
enable_config("mac-tcltk-framework", false)
|
||||
return false
|
||||
end
|
||||
paths = ["/Library/Frameworks", "/System/Library/Frameworks"]
|
||||
end
|
||||
|
||||
checking_for('Tcl/Tk Framework') {
|
||||
paths.find{|dir|
|
||||
dir.strip!
|
||||
dir.chomp!('/')
|
||||
(tcl_hdr || FileTest.directory?(dir + "/Tcl.framework/") ) &&
|
||||
(tk_hdr || FileTest.directory?(dir + "/Tk.framework/") )
|
||||
}
|
||||
}
|
||||
end
|
||||
|
||||
tcl_framework_header = with_config("tcl-framework-header")
|
||||
tk_framework_header = with_config("tk-framework-header")
|
||||
|
||||
tcltk_framework = find_framework(tcl_framework_header, tk_framework_header)
|
||||
|
||||
unless is_win32
|
||||
have_library("nsl", "t_open")
|
||||
have_library("socket", "socket")
|
||||
have_library("dl", "dlopen")
|
||||
have_library("m", "log")
|
||||
end
|
||||
|
||||
dir_config("tk")
|
||||
dir_config("tcl")
|
||||
dir_config("X11")
|
||||
|
||||
tklib = with_config("tklib")
|
||||
tcllib = with_config("tcllib")
|
||||
stubs = enable_config("tcltk_stubs") || with_config("tcltk_stubs")
|
||||
|
||||
def find_tcl(tcllib, stubs)
|
||||
paths = ["/usr/local/lib", "/usr/pkg/lib", "/usr/lib"]
|
||||
if stubs
|
||||
func = "Tcl_InitStubs"
|
||||
lib = "tclstub"
|
||||
else
|
||||
func = "Tcl_FindExecutable"
|
||||
lib = "tcl"
|
||||
end
|
||||
if tcllib
|
||||
find_library(tcllib, func, *paths)
|
||||
elsif find_library(lib, func, *paths)
|
||||
true
|
||||
else
|
||||
%w[8.5 8.4 8.3 8.2 8.1 8.0 7.6].find { |ver|
|
||||
find_library("#{lib}#{ver}", func, *paths) or
|
||||
find_library("#{lib}#{ver.delete('.')}", func, *paths) or
|
||||
find_library("tcl#{ver}", func, *paths) or
|
||||
find_library("tcl#{ver.delete('.')}", func, *paths)
|
||||
}
|
||||
end
|
||||
end
|
||||
|
||||
def find_tk(tklib, stubs)
|
||||
paths = ["/usr/local/lib", "/usr/pkg/lib", "/usr/lib"]
|
||||
if stubs
|
||||
func = "Tk_InitStubs"
|
||||
lib = "tkstub"
|
||||
else
|
||||
func = "Tk_Init"
|
||||
lib = "tk"
|
||||
end
|
||||
if tklib
|
||||
find_library(tklib, func, *paths)
|
||||
elsif find_library(lib, func, *paths)
|
||||
true
|
||||
else
|
||||
%w[8.5 8.4 8.3 8.2 8.1 8.0 4.2].find { |ver|
|
||||
find_library("#{lib}#{ver}", func, *paths) or
|
||||
find_library("#{lib}#{ver.delete('.')}", func, *paths) or
|
||||
find_library("tk#{ver}", func, *paths) or
|
||||
find_library("tk#{ver.delete('.')}", func, *paths)
|
||||
}
|
||||
end
|
||||
end
|
||||
|
||||
def pthread_check()
|
||||
tcl_major_ver = nil
|
||||
tcl_minor_ver = nil
|
||||
|
||||
# Is tcl-thread given by user ?
|
||||
case enable_config("tcl-thread")
|
||||
when true
|
||||
tcl_enable_thread = true
|
||||
when false
|
||||
tcl_enable_thread = false
|
||||
else
|
||||
tcl_enable_thread = nil
|
||||
end
|
||||
|
||||
if (tclConfig = with_config("tclConfig-file"))
|
||||
if tcl_enable_thread == true
|
||||
puts("Warning: --with-tclConfig-file option is ignored, because --enable-tcl-thread option is given.")
|
||||
elsif tcl_enable_thread == false
|
||||
puts("Warning: --with-tclConfig-file option is ignored, because --disable-tcl-thread option is given.")
|
||||
else
|
||||
# tcl-thread is unknown and tclConfig.sh is given
|
||||
begin
|
||||
open(tclConfig, "r") do |cfg|
|
||||
while line = cfg.gets()
|
||||
if line =~ /^\s*TCL_THREADS=(0|1)/
|
||||
tcl_enable_thread = ($1 == "1")
|
||||
break
|
||||
end
|
||||
|
||||
if line =~ /^\s*TCL_MAJOR_VERSION=("|')(\d+)\1/
|
||||
tcl_major_ver = $2
|
||||
if tcl_major_ver =~ /^[1-7]$/
|
||||
tcl_enable_thread = false
|
||||
break
|
||||
end
|
||||
if tcl_major_ver == "8" && tcl_minor_ver == "0"
|
||||
tcl_enable_thread = false
|
||||
break
|
||||
end
|
||||
end
|
||||
|
||||
if line =~ /^\s*TCL_MINOR_VERSION=("|')(\d+)\1/
|
||||
tcl_minor_ver = $2
|
||||
if tcl_major_ver == "8" && tcl_minor_ver == "0"
|
||||
tcl_enable_thread = false
|
||||
break
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
if tcl_enable_thread == nil
|
||||
# not find definition
|
||||
if tcl_major_ver
|
||||
puts("Warning: '#{tclConfig}' doesn't include TCL_THREADS definition.")
|
||||
else
|
||||
puts("Warning: '#{tclConfig}' may not be a tclConfig file.")
|
||||
end
|
||||
tclConfig = false
|
||||
end
|
||||
rescue Exception
|
||||
puts("Warning: fail to read '#{tclConfig}'!! --> ignore the file")
|
||||
tclConfig = false
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
if tcl_enable_thread == nil && !tclConfig
|
||||
# tcl-thread is unknown and tclConfig is unavailable
|
||||
begin
|
||||
try_run_available = try_run("int main() { exit(0); }")
|
||||
rescue Exception
|
||||
# cannot try_run. Is CROSS-COMPILE environment?
|
||||
puts(%Q'\
|
||||
*****************************************************************************
|
||||
**
|
||||
** PTHREAD SUPPORT CHECK WARNING:
|
||||
**
|
||||
** We cannot check the consistency of pthread support between Ruby
|
||||
** and the Tcl/Tk library in your environment (are you perhaps
|
||||
** cross-compiling?). If pthread support for these 2 packages is
|
||||
** inconsistent you may find you get errors when running Ruby/Tk
|
||||
** (e.g. hangs or segmentation faults). We strongly recommend
|
||||
** you to check the consistency manually.
|
||||
**
|
||||
*****************************************************************************
|
||||
')
|
||||
return true
|
||||
end
|
||||
end
|
||||
|
||||
if tcl_enable_thread == nil
|
||||
# tcl-thread is unknown
|
||||
if try_run(<<EOF)
|
||||
#include <tcl.h>
|
||||
int main() {
|
||||
Tcl_Interp *ip;
|
||||
ip = Tcl_CreateInterp();
|
||||
exit((Tcl_Eval(ip, "set tcl_platform(threaded)") == TCL_OK)? 0: 1);
|
||||
}
|
||||
EOF
|
||||
tcl_enable_thread = true
|
||||
elsif try_run(<<EOF)
|
||||
#include <tcl.h>
|
||||
static Tcl_ThreadDataKey dataKey;
|
||||
int main() { exit((Tcl_GetThreadData(&dataKey, 1) == dataKey)? 1: 0); }
|
||||
EOF
|
||||
tcl_enable_thread = true
|
||||
else
|
||||
tcl_enable_thread = false
|
||||
end
|
||||
end
|
||||
|
||||
# check pthread mode
|
||||
if (macro_defined?('HAVE_LIBPTHREAD', '#include "ruby.h"'))
|
||||
# ruby -> enable
|
||||
unless tcl_enable_thread
|
||||
# ruby -> enable && tcl -> disable
|
||||
puts(%Q'\
|
||||
*****************************************************************************
|
||||
**
|
||||
** PTHREAD SUPPORT MODE WARNING:
|
||||
**
|
||||
** Ruby is compiled with --enable-pthread, but your Tcl/Tk library
|
||||
** seems to be compiled without pthread support. Although you can
|
||||
** create the tcltklib library, this combination may cause errors
|
||||
** (e.g. hangs or segmentation faults). If you have no reason to
|
||||
** keep the current pthread support status, we recommend you reconfigure
|
||||
** and recompile the libraries so that both or neither support pthreads.
|
||||
**
|
||||
** If you want change the status of pthread support, please recompile
|
||||
** Ruby without "--enable-pthread" configure option or recompile Tcl/Tk
|
||||
** with "--enable-threads" configure option (if your Tcl/Tk is later
|
||||
** than or equal to Tcl/Tk 8.1).
|
||||
**
|
||||
*****************************************************************************
|
||||
')
|
||||
end
|
||||
|
||||
# ruby -> enable && tcl -> enable/disable
|
||||
if tcl_enable_thread
|
||||
$CPPFLAGS += ' -DWITH_TCL_ENABLE_THREAD=1'
|
||||
else
|
||||
$CPPFLAGS += ' -DWITH_TCL_ENABLE_THREAD=0'
|
||||
end
|
||||
|
||||
return true
|
||||
|
||||
else
|
||||
# ruby -> disable
|
||||
if tcl_enable_thread
|
||||
# ruby -> disable && tcl -> enable
|
||||
puts(%Q'\
|
||||
*****************************************************************************
|
||||
**
|
||||
** PTHREAD SUPPORT MODE ERROR:
|
||||
**
|
||||
** Ruby is not compiled with --enable-pthread, but your Tcl/Tk
|
||||
** library seems to be compiled with pthread support. This
|
||||
** combination may cause frequent hang or segmentation fault
|
||||
** errors when Ruby/Tk is working. We recommend that you NEVER
|
||||
** create the library with such a combination of pthread support.
|
||||
**
|
||||
** Please recompile Ruby with the "--enable-pthread" configure option
|
||||
** or recompile Tcl/Tk with the "--disable-threads" configure option.
|
||||
**
|
||||
*****************************************************************************
|
||||
')
|
||||
$CPPFLAGS += ' -DWITH_TCL_ENABLE_THREAD=1'
|
||||
return false
|
||||
else
|
||||
# ruby -> disable && tcl -> disable
|
||||
$CPPFLAGS += ' -DWITH_TCL_ENABLE_THREAD=0'
|
||||
return true
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
if tcltk_framework ||
|
||||
(have_header("tcl.h") && have_header("tk.h") &&
|
||||
(is_win32 || find_library("X11", "XOpenDisplay",
|
||||
"/usr/X11/lib", "/usr/lib/X11", "/usr/X11R6/lib", "/usr/openwin/lib")) &&
|
||||
find_tcl(tcllib, stubs) &&
|
||||
find_tk(tklib, stubs))
|
||||
$CPPFLAGS += ' -DUSE_TCL_STUBS -DUSE_TK_STUBS' if stubs
|
||||
$CPPFLAGS += ' -D_WIN32' if /cygwin/ =~ RUBY_PLATFORM
|
||||
|
||||
if tcltk_framework
|
||||
if tcl_framework_header
|
||||
$CPPFLAGS += " -I#{tcl_framework_header}"
|
||||
else
|
||||
$CPPFLAGS += " -I#{tcltk_framework}/Tcl.framework/Headers"
|
||||
end
|
||||
|
||||
if tk_framework_header
|
||||
$CPPFLAGS += " -I#{tk_framework_header}"
|
||||
else
|
||||
$CPPFLAGS += " -I#{tcltk_framework}/Tk.framework/Headers"
|
||||
end
|
||||
|
||||
$LDFLAGS += ' -framework Tk -framework Tcl'
|
||||
end
|
||||
|
||||
if stubs or pthread_check
|
||||
# create Makefile
|
||||
|
||||
# for SUPPORT_STATUS
|
||||
$INSTALLFILES ||= []
|
||||
$INSTALLFILES << ["lib/tkextlib/SUPPORT_STATUS", "$(RUBYLIBDIR)", "lib"]
|
||||
|
||||
# create
|
||||
create_makefile("tcltklib")
|
||||
end
|
||||
end
|
||||
|
|
|
|||
1637
ext/tk/tkutil.c
1637
ext/tk/tkutil.c
File diff suppressed because it is too large
Load diff
Loading…
Add table
Add a link
Reference in a new issue