path: root/src/DrawResources/StandardCommands.tcl

#
# 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

    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 "  "
		}
		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)} {
#
#  compute the length of the string to have the right spacing
#  with tabs
#
			set ll [string length $f] 
			if {($ll >= 1) && ($ll < 8)} {
			    puts "$f\t\t:  $Draw_Files($f) "
			}
			if {($ll >= 8)} {
			    puts "$f\t:  $Draw_Files($f) "
			}
			 
		    }
		}
	    }
	}
    } else {

	# getsourcefile fonction
	append command "*"
	foreach f [lsort [array names Draw_Files]] {
	    if {[string match $command $f]} {
		puts -nonewline $f
		for {set j [string length $f]} {$j < 15} {incr j} {
		    puts -nonewline " "
		}

		puts "     $Draw_Files($f)"
	    }
	}
	
    } 
    flush stdout
}

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 == ""} {set name $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
}