Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: code/branches/SuperOrxoBros_HS18/SuperOrxoBros_HS18/data/tcl/init.tcl @ 12175

Last change on this file since 12175 was 12175, checked in by siramesh, 5 years ago

Super Orxo Bros (Sidharth Ramesh, Nisa Balta, Jeff Ren)

File size: 8.4 KB
Line 
1# Check if Tcl was properly initialized
2info library
3
4# Create orxonox namespace
5namespace eval orxonox {}
6
7# query --
8# Sends a query to the CommandExecutor of Orxonox and waits for the response.
9# This dummy procedure will be changed to it's real implementation by Orxonox itself.
10#
11# Arguments:
12# args - The command to send to Orxonox
13
14proc query args {
15    return -code error "Can't query Orxonox now"
16}
17
18
19# crossquery --
20# Sends a query to another Tcl-interpreter in Orxonox and waits for the response.
21# This dummy procedure will be changed to it's real implementation by Orxonox itself.
22#
23# Arguments:
24# id   - The ID of the other interpreter
25# args - The command to send to Orxonox
26
27proc crossquery {id args} {
28    return -code error "Can't query interpreter with ID $id now"
29}
30
31
32# execute --
33# Sends a command to the queue of Orxonox where it will be executed by the CommandExecutor after some time
34# This dummy procedure will be changed to it's real implementation by Orxonox itself.
35#
36# Arguments:
37# args - The command
38
39proc execute args {
40    return -code error "Can't execute a command now"
41}
42
43
44# crossexecute --
45# Sends a command to the queue of another Tcl-interpreter where it will be executed by after some time
46# This dummy procedure will be changed to it's real implementation by Orxonox itself.
47#
48# Arguments:
49# id   - The ID of the other interpreter
50# args - The command
51
52proc crossexecute {id args} {
53    return -code error "Can't execute a command now"
54}
55
56
57# running --
58# Returns true if the interpreter is still suposed to be running
59# This dummy procedure will be changed to it's real implementation by Orxonox itself.
60
61proc running {} {
62    return 1
63}
64
65
66# orxonox::while --
67# Works like while but breaks the loop if orxonox::running returns false
68
69proc ::orxonox::while {condition body} {
70    set condition_cmd [list expr $condition]
71    ::tcl::while {1} {
72        if {![uplevel 1 $condition_cmd] || ![::running]} {
73            break
74        }
75        uplevel 1 $body
76    }
77}
78
79
80# orxonox::for --
81# Works like for but breaks the loop if orxonox::running returns false
82
83proc ::orxonox::for {start condition step body} {
84    set condition_cmd [list expr $condition]
85    uplevel 1 $start
86    ::tcl::while {1} {
87        if {![uplevel 1 $condition_cmd] || ![::running]} {
88            break
89        }
90        uplevel 1 $body
91        uplevel 1 $step
92    }
93}
94
95
96# add the path to this file to the auto path
97
98set filepath [info script]
99#set ::orxonox::mediapath [string range $filepath 0 [string last "/" $filepath]]
100set ::orxonox::mediapath [file dirname $filepath]
101
102if {![info exists auto_path]} {
103   set auto_path [list]
104}
105
106if {[lsearch $auto_path $::orxonox::mediapath] == -1} {
107    lappend auto_path $::orxonox::mediapath
108}
109unset filepath
110
111
112# save the start directory and the library directory
113
114proc psd {} "return [pwd]"
115proc pld {} "return $::orxonox::mediapath"
116
117set pwd [pwd]
118set psd [psd]
119set pld [pld]
120
121
122# modify cd to automatically set $pwd
123
124if {[llength [info command ::tcl::cd]] == 0} {
125    rename cd ::tcl::cd
126}
127proc cd {{path "~"}} {
128    global pwd
129    ::tcl::cd $path
130    set pwd [pwd]
131}
132
133
134# change the working directory to the media path
135
136cd $::orxonox::mediapath
137
138
139# Redefines puts to write directly into the Orxonox console if the channel is stdout or stderr.
140
141if {[llength [info command ::tcl::puts]] == 0} {
142    rename puts ::tcl::puts
143}
144proc puts args {
145    set argc [llength $args]
146    if {$argc < 1 || $argc > 3} {
147        error "wrong # args: should be \"puts ?-nonewline? ?channelId? string\""
148    }
149
150    set newline 1
151    set input $args
152
153    if {$argc > 1 && [lindex $input 0] == "-nonewline"} {
154        set newline 0
155        set input [lrange $input 1 end]
156    } elseif {$argc == 3} {
157        if {[lindex $input 2] == "nonewline"} {
158            set newline 0
159            set input [lrange $input 0 1]
160        } else {
161            error "bad argument \"[lindex $input 2]\": should be \"nonewline\""
162        }
163    }
164
165    if {[llength $input] == 1} {
166        set input [list stdout [join $input]]
167    }
168
169    foreach {channel s} $input break
170
171    if {$channel == "stdout"} {
172        execute log $s
173    } elseif {$channel == "stderr"} {
174        execute error $s
175    } else {
176        eval [concat ::tcl::puts $args]
177    }
178}
179
180
181# Redefines unknown to send unknown commands back to orxonox
182
183if {[llength [info commands unknown]] != 0} {
184    # check if a command named "undefined_proc" exists, if yes rename it temporarily
185    set undefined_was_defined 0
186    if {[llength [info commands undefined_proc]] != 0} {
187        set undefined_was_defined 0
188        rename undefined_proc _undefined
189    }
190
191    # get the returned errormessage if an undefined_proc command is called
192    if {[llength [info commands ::tcl::unknown]] == 0} {
193        set errorcode [catch {unknown undefined_proc} result]
194    } else {
195        set errorcode [catch {::tcl::unknown undefined_proc} result]
196    }
197
198    if {$errorcode} {
199        set result_list [split $result]
200        set ::orxonox::errormessage_unknown [list]
201
202        # parse the error message (the original message was something like "invalid command name "undefined_proc"" but we just want "invalid command name")
203        foreach token $result_list {
204            if {![string match "*undefined_proc*" $token]} {
205                lappend ::orxonox::errormessage_unknown $token
206            }
207        }
208
209        unset result_list
210        unset token
211
212        set ::orxonox::errormessage_unknown_length [llength $::orxonox::errormessage_unknown]
213
214        # rename the original unknown procedure
215        if {[llength [info commands ::tcl::unknown]] == 0} {
216            rename unknown ::tcl::unknown
217        }
218
219        # define the modified version of unknown
220        # we implement two versions, because tcl8.4 complains if this fork is moved inside [unknown]
221        if {[info tclversion] >= 8.5} {
222            # version >= 8.5
223            proc unknown args {
224                global ::orxonox::errormessage_unknown ::orxonox::errormessage_unknown_length
225
226                set cmd [concat ::tcl::unknown $args]
227                set errorcode [catch {eval $cmd} result options]
228                set resultlist [split $result]
229                set success 1
230
231                if {$errorcode && [llength $resultlist] >= $::orxonox::errormessage_unknown_length} {
232                    for {set i 0} {$i < $::orxonox::errormessage_unknown_length} {incr i} {
233                        if {[lindex $::orxonox::errormessage_unknown $i] != [lindex $resultlist $i]} {
234                            set success 0
235                            break
236                        }
237                    }
238                } else {
239                    set success 0
240                }
241
242                if {!$success} {
243                    return -code $errorcode -options $options $result
244                } else {
245                    return [query $args]
246                }
247            }
248        } else {
249            # version < 8.5
250            proc unknown args {
251                global ::orxonox::errormessage_unknown ::orxonox::errormessage_unknown_length
252
253                set cmd [concat ::tcl::unknown $args]
254                set errorcode [catch {eval $cmd} result]
255                set resultlist [split $result]
256                set success 1
257
258                if {$errorcode && [llength $resultlist] >= $::orxonox::errormessage_unknown_length} {
259                    for {set i 0} {$i < $::orxonox::errormessage_unknown_length} {incr i} {
260                        if {[lindex $::orxonox::errormessage_unknown $i] != [lindex $resultlist $i]} {
261                            set success 0
262                            break
263                        }
264                    }
265                } else {
266                    set success 0
267                }
268
269                if {!$success} {
270                    return -code $errorcode $result
271                } else {
272                    return [query $args]
273                }
274            }
275        }
276
277        set success 1
278    } else {
279        set success 0
280    }
281
282    unset errorcode
283    unset result
284
285    # if the "undefined_proc" command was renamed previously, undo this
286    if {$undefined_was_defined} {
287        rename _undefined undefined_proc
288    }
289
290    unset undefined_was_defined
291
292    if {!$success} {
293        unset success
294        # something went wrong, use the default method
295        proc unknown args {
296            return [query $args]
297        }
298    }
299    unset success
300} else {
301    # no original unknown procedure defined, use the default method
302    proc unknown args {
303        return [query $args]
304    }
305}
Note: See TracBrowser for help on using the repository browser.