0023348: Expression 'ii >= 0' is always true. Unsigned type value is always >= 0.
[occt.git] / src / DrawResources / StandardCommands.tcl
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
18 #
19 # Draw standard initialisation
20 #
21
22 #################################################
23 # prompts
24 #################################################
25
26 set Draw_CmdIndex 0
27 set tcl_prompt1 {
28     incr Draw_CmdIndex
29     puts -nonewline "Draw\[$Draw_CmdIndex\]> "
30 }
31
32 set tcl_prompt2 {puts -nonewline "> "}
33
34
35 #################################################
36 # the help command in TCL
37 #################################################
38
39
40 proc 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
89 help help {help pattern, or help command string group, to set help} {DRAW General Commands}
90 #################################################
91 # the getsourcefile command in TCL
92 #################################################
93
94
95 proc getsourcefile {{command ""}} {
96
97     global Draw_Helps Draw_Groups Draw_Files
98
99     set out {}
100     if {$command == ""} {
101
102         # help general
103         foreach h [lsort [array names Draw_Groups]] {
104             lappend out "" "" "$h"
105             set i 0
106             foreach f [lsort $Draw_Groups($h)] {
107                 if {$i == 0} {
108                     lappend out ""
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)} {
116                         lappend out [format {%-20s %s} $f $Draw_Files($f)]
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]} {
127                 lappend out [format {%-20s %s} $f $Draw_Files($f)]
128             }
129         }
130         
131     } 
132     return [join $out "\n"]
133 }
134
135 help 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
146 proc 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
158 help whatis "whatis object1 object2 ..." 
159
160 #################################################
161 # library, lsource
162 #################################################
163
164 proc 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
173 proc 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
189 proc isgdraw {var} {
190     global $var
191     return [isdraw $var]
192 }
193
194 proc directory {{joker *}} {
195     set res ""
196     foreach var [info globals $joker] { 
197         if [isgdraw $var] {lappend res $var}
198     }
199     return $res
200 }
201
202 help directory {directory [pattern], list draw variables} {DRAW Variables management}
203
204 proc lsd {} { exec ls [datadir] }
205
206 proc 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
223 proc repeat {val script} {
224     for {set i 1} {$i <= $val} {incr i} {uplevel $script}
225 }
226
227 proc 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
256 set Draw_DataDir "."
257
258 proc 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
270 help datadir {datadir [directory]} "DRAW Variables management"
271
272 proc 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
281 help save {save variable [filename]} "DRAW Variables management"
282
283 proc 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
290 help restore {restore filename [variablename]} "DRAW Variables management"
291
292 #################################################
293 # misc...
294 #################################################
295
296 proc ppcurve {a} {
297         2dclear;
298         uplevel pcurve $a;
299         2dfit;
300 }
301
302 #################################################
303 # display and donly with jokers
304 #################################################
305
306
307 proc 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
327 proc 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
346 proc 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 }