[occt.git] / src / DrawResources / StandardCommands.tcl

# Copyright (c) 1999-2012 OPEN CASCADE SAS
#
# The content of this file is subject to the Open CASCADE Technology Public
# License Version 6.5 (the "License"). You may not use the content of this file
# except in compliance with the License. Please obtain a copy of the License
# at http://www.opencascade.org and read it completely before using this file.
#
# The Initial Developer of the Original Code is Open CASCADE S.A.S., having its
# main offices at: 1, place des Freres Montgolfier, 78280 Guyancourt, France.
#
# The Original Code and all software distributed under the License is
# distributed on an "AS IS" basis, without warranty of any kind, and the
# Initial Developer hereby disclaims all such warranties, including without
# limitation, any warranties of merchantability, fitness for a particular
# purpose or non-infringement. Please see the License for the specific terms
# and conditions governing the rights and limitations under the License.

#
# Draw standard initialisation
#

#################################################
# prompts
#################################################

set Draw_CmdIndex 0
set tcl_prompt1 {
    incr Draw_CmdIndex
    puts -nonewline "Draw\[$Draw_CmdIndex\]> "
}

set tcl_prompt2 {puts -nonewline "> "}


#################################################
# the help command in TCL
#################################################


proc help {{command ""} {helpstring ""} {group "Procedures"}} {

    global Draw_Helps Draw_Groups

    if {$command == ""} {

	# help general
	foreach h [lsort [array names Draw_Groups]] {
	    puts ""
	    puts ""
	    puts $h
	    set i 0
	    foreach f [lsort $Draw_Groups($h)] {
		if {$i == 0} {
		    puts ""
		    puts -nonewline "  "
		}
		puts -nonewline $f
		for {set j [string length $f]} {$j < 15} {incr j} {
		    puts -nonewline " "
		}
		incr i
		if {$i == 4} {set i 0}
	    }
	    puts ""
	}
    } elseif {$helpstring == ""} {

	# help fonction
	append command "*"
	foreach f [lsort [array names Draw_Helps]] {
	    if {[string match $command $f]} {
		puts -nonewline $f
		for {set j [string length $f]} {$j < 15} {incr j} {
		    puts -nonewline " "
		}
		puts " : $Draw_Helps($f)"
	    }
	}
    } else {

	# set help
	lappend Draw_Groups($group) $command
	set Draw_Helps($command) $helpstring
    }
    
    flush stdout
}

help help {help pattern, or help command string group, to set help} {DRAW General Commands}
#################################################
# the getsourcefile command in TCL
#################################################


proc getsourcefile {{command ""}} {

    global Draw_Helps Draw_Groups Draw_Files

    set out {}
    if {$command == ""} {

	# help general
	foreach h [lsort [array names Draw_Groups]] {
	    lappend out "" "" "$h"
	    set i 0
	    foreach f [lsort $Draw_Groups($h)] {
		if {$i == 0} {
		    lappend out ""
		}
		incr i
#
# check that the command has its source file set
#
		foreach command_that_has_file [array names Draw_Files] {
		    if {($command_that_has_file == $f)} {
			lappend out [format {%-20s %s} $f $Draw_Files($f)]
		    }
		}
	    }
	}
    } else {

	# getsourcefile fonction
	append command "*"
	foreach f [lsort [array names Draw_Files]] {
	    if {[string match $command $f]} {
                lappend out [format {%-20s %s} $f $Draw_Files($f)]
	    }
	}
	
    } 
    return [join $out "\n"]
}

help getsourcefile {getsourcefile, or getsourcefile command } {DRAW General Commands}

#################################################
# whatis
#################################################

#proc gwhatis {aVarName} {
#    global $aVarName
#    puts -nonewline $aVarName; puts -nonewline " is a "; puts [dtyp ${aVarName}]
#}

proc whatis args {
    set __out_string ""
    foreach i $args {
	if {$i == "."} {set i [dname $i]}
	#gwhatis $i
	global $i
	set __tmp_string "$i is a [dtyp $i]\n"
	set __out_string "${__out_string}${__tmp_string}"
    }
    return ${__out_string}
}

help whatis "whatis object1 object2 ..." 

#################################################
# library, lsource
#################################################

proc library lib {
    global auto_path
    set auto_path [linsert $auto_path 0 $lib]
    if [file readable $lib/LibraryInit] {
	puts "Loading $lib/LibraryInit"
	uplevel "source $lib/LibraryInit"
    }
}

proc lsource file {
    if [file readable $file] {source $file} else {
	global auto_path
	foreach dir $auto_path {
	    if [file readable $dir/$file] {
		uplevel #0 "source $dir/$file"
		break
	    }
	}
    }
}

#################################################
# directory
#################################################

proc isgdraw {var} {
    global $var
    return [isdraw $var]
}

proc directory {{joker *}} {
    set res ""
    foreach var [info globals $joker] { 
	if [isgdraw $var] {lappend res $var}
    }
    return $res
}

help directory {directory [pattern], list draw variables} {DRAW Variables management}

proc lsd {} { exec ls [datadir] }

proc dall {} {
    set schmurtz ""
    foreach var [info globals] { 
	global $var
	if [isdraw $var] {
	    if ![isprot $var] {
		lappend schmurtz $var; unset $var
	    }
	}
    }
    return $schmurtz
}

#################################################
# repeat, do
#################################################

proc repeat {val script} {
    for {set i 1} {$i <= $val} {incr i} {uplevel $script}
}

proc do {var start end args} {
    global errorInfo errorCode
    if {[llength args] == 1} {
	set incr 1
	set body args
    } else {
	set incr [lindex 1 args]
	set body [lindex 2 args]
    }
    upvar $var v
    if {[dval $incr] < 0} {set rel >=} else {set rel <=}
    for {dset v $start} {[dval v] $rel [dval end]} {dset v [dval v+($incr)]} {
	set code [catch {uplevel $body} string]
	if {$code == 1} {
	    return -code error -errorInfo $errorInfo -errorcode $errorCode $string
	} elseif {$code == 2} {
	    return -code return $string
	}elseif {$code == 3} {
	    return
	} elseif {$code > 4} {
	    return -code $code $string
	}
    }
}

#################################################
# datadir, save, restore
#################################################

set Draw_DataDir "."

proc datadir {{dir ""}} {
    global Draw_DataDir
    if {$dir != ""} {
	if {![file isdirectory $dir]} {
	    error "datadir : $dir is not a directory"
	} else {
	    set Draw_DataDir $dir
	}
    }
    return $Draw_DataDir
}

help datadir {datadir [directory]} "DRAW Variables management"

proc save {name {file ""}} {
    if {$file == ""} {set file $name}
    upvar $name n
    if {![isdraw n]} {error "save : $name is not a Draw variable"}
    global Draw_DataDir
    bsave n [file join $Draw_DataDir $file]
    return [file join $Draw_DataDir $file]
}

help save {save variable [filename]} "DRAW Variables management"

proc restore {file {name ""}} {
    if {$name == ""} {
        # if name is not given explicitly, use name of the file w/o extension
        set name [file rootname [file tail $file]]
    }
    global Draw_DataDir
    uplevel #0 "brestore [file join $Draw_DataDir $file ] $name"
    return $name
}

help restore {restore filename [variablename]} "DRAW Variables management"

#################################################
# misc...
#################################################

proc ppcurve {a} {
	2dclear;
	uplevel pcurve $a;
	2dfit;
}

#################################################
# display and donly with jokers
#################################################


proc disp { args } {
    set res ""
    foreach joker $args {
	if { $joker == "." } {
             dtyp .
             set joker [lastrep id x y b]
	}
        foreach var [info globals $joker] { 
	   if { $var == "." } {
               dtyp .
               set var [lastrep id x y b]
	   }
	   if [isgdraw $var] {lappend res $var}
        }
    }
    uplevel #0 eval display $res
    return $res
}


proc donl { args } {
    set res ""
    foreach joker $args {
	if { $joker == "." } {
             dtyp .
             set joker [lastrep id x y b]
	}
        foreach var [info globals $joker] { 
	   if { $var == "." } {
               dtyp .
               set var [lastrep id x y b]
	   }
	   if [isgdraw $var] {lappend res $var}
        }
    }
    uplevel #0 eval donly $res
    return $res
}

proc don { args } {
    set res ""
    foreach joker $args {
	if { $joker == "." } {
             dtyp .
             set joker [lastrep id x y b]
	}
        foreach var [info globals $joker] { 
	   if { $var == "." } {
               dtyp .
               set var [lastrep id x y b]
	   }
	   if [isgdraw $var] {lappend res $var}
        }
    }
    uplevel #0 eval donly $res
    return $res
}
Commit	Line	Data
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
	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
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
	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 ""}} {
1598ec0e	284	if {$name == ""} {
	285	# if name is not given explicitly, use name of the file w/o extension
	286	set name [file rootname [file tail $file]]
	287	}
7fd59977	288	global Draw_DataDir
	289	uplevel #0 "brestore [file join $Draw_DataDir $file ] $name"
	290	return $name
	291	}
	292
	293	help restore {restore filename [variablename]} "DRAW Variables management"
	294
	295	#################################################
	296	# misc...
	297	#################################################
	298
	299	proc ppcurve {a} {
	300	2dclear;
	301	uplevel pcurve $a;
	302	2dfit;
	303	}
	304
	305	#################################################
	306	# display and donly with jokers
	307	#################################################
	308
	309
	310	proc disp { args } {
	311	set res ""
	312	foreach joker $args {
	313	if { $joker == "." } {
	314	dtyp .
	315	set joker [lastrep id x y b]
	316	}
	317	foreach var [info globals $joker] {
	318	if { $var == "." } {
	319	dtyp .
	320	set var [lastrep id x y b]
	321	}
	322	if [isgdraw $var] {lappend res $var}
	323	}
	324	}
	325	uplevel #0 eval display $res
	326	return $res
	327	}
	328
	329
	330	proc donl { args } {
	331	set res ""
	332	foreach joker $args {
	333	if { $joker == "." } {
	334	dtyp .
	335	set joker [lastrep id x y b]
	336	}
	337	foreach var [info globals $joker] {
	338	if { $var == "." } {
	339	dtyp .
	340	set var [lastrep id x y b]
	341	}
	342	if [isgdraw $var] {lappend res $var}
	343	}
	344	}
	345	uplevel #0 eval donly $res
	346	return $res
	347	}
	348
	349	proc don { args } {
	350	set res ""
	351	foreach joker $args {
352	if { $joker == "." } {
353	dtyp .
354	set joker [lastrep id x y b]
355	}
356	foreach var [info globals $joker] {
357	if { $var == "." } {
358	dtyp .
359	set var [lastrep id x y b]
360	}
361	if [isgdraw $var] {lappend res $var}
362	}
363	}
364	uplevel #0 eval donly $res
365	return $res
366	}