0023348: Expression 'ii >= 0' is always true. Unsigned type value is always >= 0.
[occt.git] / src / DrawResources / StandardCommands.tcl
CommitLineData
b311480e 1# Copyright (c) 1999-2012 OPEN CASCADE SAS
2#
3# The content of this file is subject to the Open CASCADE Technology Public
4# License Version 6.5 (the "License"). You may not use the content of this file
5# except in compliance with the License. Please obtain a copy of the License
6# at http://www.opencascade.org and read it completely before using this file.
7#
8# The Initial Developer of the Original Code is Open CASCADE S.A.S., having its
9# main offices at: 1, place des Freres Montgolfier, 78280 Guyancourt, France.
10#
11# The Original Code and all software distributed under the License is
12# distributed on an "AS IS" basis, without warranty of any kind, and the
13# Initial Developer hereby disclaims all such warranties, including without
14# limitation, any warranties of merchantability, fitness for a particular
15# purpose or non-infringement. Please see the License for the specific terms
16# and conditions governing the rights and limitations under the License.
17
7fd59977 18#
19# Draw standard initialisation
20#
21
22#################################################
23# prompts
24#################################################
25
26set Draw_CmdIndex 0
27set tcl_prompt1 {
28 incr Draw_CmdIndex
29 puts -nonewline "Draw\[$Draw_CmdIndex\]> "
30}
31
32set tcl_prompt2 {puts -nonewline "> "}
33
34
35#################################################
36# the help command in TCL
37#################################################
38
39
40proc help {{command ""} {helpstring ""} {group "Procedures"}} {
41
42 global Draw_Helps Draw_Groups
43
44 if {$command == ""} {
45
46 # help general
47 foreach h [lsort [array names Draw_Groups]] {
48 puts ""
49 puts ""
50 puts $h
51 set i 0
52 foreach f [lsort $Draw_Groups($h)] {
53 if {$i == 0} {
54 puts ""
55 puts -nonewline " "
56 }
57 puts -nonewline $f
58 for {set j [string length $f]} {$j < 15} {incr j} {
59 puts -nonewline " "
60 }
61 incr i
62 if {$i == 4} {set i 0}
63 }
64 puts ""
65 }
66 } elseif {$helpstring == ""} {
67
68 # help fonction
69 append command "*"
70 foreach f [lsort [array names Draw_Helps]] {
71 if {[string match $command $f]} {
72 puts -nonewline $f
73 for {set j [string length $f]} {$j < 15} {incr j} {
74 puts -nonewline " "
75 }
76 puts " : $Draw_Helps($f)"
77 }
78 }
79 } else {
80
81 # set help
82 lappend Draw_Groups($group) $command
83 set Draw_Helps($command) $helpstring
84 }
85
86 flush stdout
87}
88
89help help {help pattern, or help command string group, to set help} {DRAW General Commands}
90#################################################
91# the getsourcefile command in TCL
92#################################################
93
94
95proc getsourcefile {{command ""}} {
96
97 global Draw_Helps Draw_Groups Draw_Files
98
d33dea30 99 set out {}
7fd59977 100 if {$command == ""} {
101
102 # help general
103 foreach h [lsort [array names Draw_Groups]] {
d33dea30 104 lappend out "" "" "$h"
7fd59977 105 set i 0
106 foreach f [lsort $Draw_Groups($h)] {
107 if {$i == 0} {
d33dea30 108 lappend out ""
7fd59977 109 }
110 incr i
111#
112# check that the command has its source file set
113#
114 foreach command_that_has_file [array names Draw_Files] {
115 if {($command_that_has_file == $f)} {
d33dea30 116 lappend out [format {%-20s %s} $f $Draw_Files($f)]
7fd59977 117 }
118 }
119 }
120 }
121 } else {
122
123 # getsourcefile fonction
124 append command "*"
125 foreach f [lsort [array names Draw_Files]] {
126 if {[string match $command $f]} {
d33dea30 127 lappend out [format {%-20s %s} $f $Draw_Files($f)]
7fd59977 128 }
129 }
130
131 }
d33dea30 132 return [join $out "\n"]
7fd59977 133}
134
135help getsourcefile {getsourcefile, or getsourcefile command } {DRAW General Commands}
136
137#################################################
138# whatis
139#################################################
140
141#proc gwhatis {aVarName} {
142# global $aVarName
143# puts -nonewline $aVarName; puts -nonewline " is a "; puts [dtyp ${aVarName}]
144#}
145
146proc whatis args {
147 set __out_string ""
148 foreach i $args {
149 if {$i == "."} {set i [dname $i]}
150 #gwhatis $i
151 global $i
152 set __tmp_string "$i is a [dtyp $i]\n"
153 set __out_string "${__out_string}${__tmp_string}"
154 }
155 return ${__out_string}
156}
157
158help whatis "whatis object1 object2 ..."
159
160#################################################
161# library, lsource
162#################################################
163
164proc library lib {
165 global auto_path
166 set auto_path [linsert $auto_path 0 $lib]
167 if [file readable $lib/LibraryInit] {
168 puts "Loading $lib/LibraryInit"
169 uplevel "source $lib/LibraryInit"
170 }
171}
172
173proc lsource file {
174 if [file readable $file] {source $file} else {
175 global auto_path
176 foreach dir $auto_path {
177 if [file readable $dir/$file] {
178 uplevel #0 "source $dir/$file"
179 break
180 }
181 }
182 }
183}
184
185#################################################
186# directory
187#################################################
188
189proc isgdraw {var} {
190 global $var
191 return [isdraw $var]
192}
193
194proc directory {{joker *}} {
195 set res ""
196 foreach var [info globals $joker] {
197 if [isgdraw $var] {lappend res $var}
198 }
199 return $res
200}
201
202help directory {directory [pattern], list draw variables} {DRAW Variables management}
203
204proc lsd {} { exec ls [datadir] }
205
206proc dall {} {
207 set schmurtz ""
208 foreach var [info globals] {
209 global $var
210 if [isdraw $var] {
211 if ![isprot $var] {
212 lappend schmurtz $var; unset $var
213 }
214 }
215 }
216 return $schmurtz
217}
218
219#################################################
220# repeat, do
221#################################################
222
223proc repeat {val script} {
224 for {set i 1} {$i <= $val} {incr i} {uplevel $script}
225}
226
227proc do {var start end args} {
228 global errorInfo errorCode
229 if {[llength args] == 1} {
230 set incr 1
231 set body args
232 } else {
233 set incr [lindex 1 args]
234 set body [lindex 2 args]
235 }
236 upvar $var v
237 if {[dval $incr] < 0} {set rel >=} else {set rel <=}
238 for {dset v $start} {[dval v] $rel [dval end]} {dset v [dval v+($incr)]} {
239 set code [catch {uplevel $body} string]
240 if {$code == 1} {
241 return -code error -errorInfo $errorInfo -errorcode $errorCode $string
242 } elseif {$code == 2} {
243 return -code return $string
244 }elseif {$code == 3} {
245 return
246 } elseif {$code > 4} {
247 return -code $code $string
248 }
249 }
250}
251
252#################################################
253# datadir, save, restore
254#################################################
255
256set Draw_DataDir "."
257
258proc datadir {{dir ""}} {
259 global Draw_DataDir
260 if {$dir != ""} {
261 if {![file isdirectory $dir]} {
262 error "datadir : $dir is not a directory"
263 } else {
264 set Draw_DataDir $dir
265 }
266 }
267 return $Draw_DataDir
268}
269
270help datadir {datadir [directory]} "DRAW Variables management"
271
272proc save {name {file ""}} {
273 if {$file == ""} {set file $name}
274 upvar $name n
275 if {![isdraw n]} {error "save : $name is not a Draw variable"}
276 global Draw_DataDir
277 bsave n [file join $Draw_DataDir $file]
278 return [file join $Draw_DataDir $file]
279}
280
281help save {save variable [filename]} "DRAW Variables management"
282
283proc restore {file {name ""}} {
284 if {$name == ""} {set name $file}
285 global Draw_DataDir
286 uplevel #0 "brestore [file join $Draw_DataDir $file ] $name"
287 return $name
288}
289
290help restore {restore filename [variablename]} "DRAW Variables management"
291
292#################################################
293# misc...
294#################################################
295
296proc ppcurve {a} {
297 2dclear;
298 uplevel pcurve $a;
299 2dfit;
300}
301
302#################################################
303# display and donly with jokers
304#################################################
305
306
307proc disp { args } {
308 set res ""
309 foreach joker $args {
310 if { $joker == "." } {
311 dtyp .
312 set joker [lastrep id x y b]
313 }
314 foreach var [info globals $joker] {
315 if { $var == "." } {
316 dtyp .
317 set var [lastrep id x y b]
318 }
319 if [isgdraw $var] {lappend res $var}
320 }
321 }
322 uplevel #0 eval display $res
323 return $res
324}
325
326
327proc donl { args } {
328 set res ""
329 foreach joker $args {
330 if { $joker == "." } {
331 dtyp .
332 set joker [lastrep id x y b]
333 }
334 foreach var [info globals $joker] {
335 if { $var == "." } {
336 dtyp .
337 set var [lastrep id x y b]
338 }
339 if [isgdraw $var] {lappend res $var}
340 }
341 }
342 uplevel #0 eval donly $res
343 return $res
344}
345
346proc don { args } {
347 set res ""
348 foreach joker $args {
349 if { $joker == "." } {
350 dtyp .
351 set joker [lastrep id x y b]
352 }
353 foreach var [info globals $joker] {
354 if { $var == "." } {
355 dtyp .
356 set var [lastrep id x y b]
357 }
358 if [isgdraw $var] {lappend res $var}
359 }
360 }
361 uplevel #0 eval donly $res
362 return $res
363}