src/DrawResources/StandardCommands.tcl

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