|
|
|
|
@ -27,7 +27,21 @@ if { [info exists tk_library] } {
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#fills menu "Load" with submenus
|
|
|
|
|
proc fillloadmenu {} {
|
|
|
|
|
set chan [open [file nativename $::env(CASROOT)/src/DrawResources/DrawPlugin]]
|
|
|
|
|
while {[gets $chan line] >= 0} {
|
|
|
|
|
if {[lindex [split $line ""] 0] != "!"} {
|
|
|
|
|
if {[lindex [split $line ""] 0] == ""} {continue}
|
|
|
|
|
set plugname [lindex [split $line " "] 0]
|
|
|
|
|
addmenu Load "pload $plugname" "pload $plugname"
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
close $chan
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
wm geometry . +10+10
|
|
|
|
|
bind . <F1> {vcommands}
|
|
|
|
|
|
|
|
|
|
frame .mbar -relief raised -bd 2
|
|
|
|
|
pack .mbar -side top -fill x
|
|
|
|
|
@ -53,7 +67,7 @@ proc addmenuitem {menu options} {
|
|
|
|
|
|
|
|
|
|
proc addmenu {menu submenu {command ""}} {
|
|
|
|
|
if {$command == ""} {set command $submenu}
|
|
|
|
|
addmenuitem $menu "command -label $submenu -command {$command}"
|
|
|
|
|
addmenuitem $menu "command -label {$submenu} -command {$command}"
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#################################
|
|
|
|
|
@ -62,10 +76,13 @@ proc addmenu {menu submenu {command ""}} {
|
|
|
|
|
|
|
|
|
|
# the file menu
|
|
|
|
|
|
|
|
|
|
addmenu File datadir vdatadir
|
|
|
|
|
addmenu File restore vrestore
|
|
|
|
|
addmenu File source vsource
|
|
|
|
|
addmenu File exit
|
|
|
|
|
addmenu File "Choose Data Directory" vdatadir
|
|
|
|
|
addmenu File "Load Shape (restore)" vrestore
|
|
|
|
|
addmenu File "Load Script (source)" vsource
|
|
|
|
|
addmenu File Exit exit
|
|
|
|
|
|
|
|
|
|
# the Load menu
|
|
|
|
|
fillloadmenu
|
|
|
|
|
|
|
|
|
|
# the view menu
|
|
|
|
|
|
|
|
|
|
@ -87,15 +104,35 @@ addmenu Display 2dfit "2dfit; repaint"
|
|
|
|
|
addmenu Display clear
|
|
|
|
|
addmenu Display 2dclear
|
|
|
|
|
|
|
|
|
|
# the samples menu
|
|
|
|
|
addmenu Samples "View samples" vsample
|
|
|
|
|
|
|
|
|
|
# the help menu
|
|
|
|
|
|
|
|
|
|
addmenu Help "System Info" sysinfo
|
|
|
|
|
addmenu Help Commands vcommands
|
|
|
|
|
addmenu Help About about
|
|
|
|
|
addmenu Help "User Guide" openuserguide
|
|
|
|
|
|
|
|
|
|
#redraw help submenu in the end of menu
|
|
|
|
|
proc redrawhelp {} {
|
|
|
|
|
global theMenus
|
|
|
|
|
set m $theMenus(Help)
|
|
|
|
|
destroy [string trimright $m ".menu"]
|
|
|
|
|
if [info exists theMenus(Help)] {unset theMenus(Help)}
|
|
|
|
|
addmenu Help "System Info" sysinfo
|
|
|
|
|
addmenu Help Commands vcommands
|
|
|
|
|
addmenu Help About about
|
|
|
|
|
addmenu Help "User Guide" openuserguide
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#################################
|
|
|
|
|
# Modal dialog box
|
|
|
|
|
# add OK, help, cancel buttons
|
|
|
|
|
# add OK, help, cancel buttons
|
|
|
|
|
#################################
|
|
|
|
|
|
|
|
|
|
proc modaldialog {box okproc {helpproc ""} {cancelproc ""}} {
|
|
|
|
|
wm geometry $box +10+60
|
|
|
|
|
|
|
|
|
|
button $box.ok -text ok -command "$okproc ; destroy $box"
|
|
|
|
|
pack $box.ok -side left
|
|
|
|
|
button $box.ko -text Cancel -command "$cancelproc ; destroy $box"
|
|
|
|
|
@ -107,6 +144,11 @@ proc modaldialog {box okproc {helpproc ""} {cancelproc ""}} {
|
|
|
|
|
grab set $box
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
#################################
|
|
|
|
|
# File menu procedures
|
|
|
|
|
#################################
|
|
|
|
|
|
|
|
|
|
##############################
|
|
|
|
|
#
|
|
|
|
|
# dialbox command arg1 val1 arg2 val2 ...
|
|
|
|
|
@ -114,7 +156,6 @@ proc modaldialog {box okproc {helpproc ""} {cancelproc ""}} {
|
|
|
|
|
##############################
|
|
|
|
|
|
|
|
|
|
proc dialbox args {
|
|
|
|
|
|
|
|
|
|
set com [lindex $args 0]
|
|
|
|
|
|
|
|
|
|
toplevel .d
|
|
|
|
|
@ -141,151 +182,410 @@ proc dialbox args {
|
|
|
|
|
append com ";repaint"
|
|
|
|
|
|
|
|
|
|
modaldialog .d $com "help [lindex $args 0]"
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
####################################
|
|
|
|
|
# Modal get file
|
|
|
|
|
# select a file and launch a command
|
|
|
|
|
# - file is the original value
|
|
|
|
|
# - okproc is the OK procedure,
|
|
|
|
|
# it will be called with the filename
|
|
|
|
|
# - title is the box title
|
|
|
|
|
# - filter is called on each subfile
|
|
|
|
|
# - Buttons are added in the dialbox, if none it is created
|
|
|
|
|
####################################
|
|
|
|
|
|
|
|
|
|
proc retyes {file} {return 1}
|
|
|
|
|
|
|
|
|
|
proc getfile {file okproc title {filter "retyes"} {box ""}} {
|
|
|
|
|
|
|
|
|
|
if {$box == ""} {
|
|
|
|
|
set box ".s"
|
|
|
|
|
toplevel .s
|
|
|
|
|
}
|
|
|
|
|
wm title $box $title
|
|
|
|
|
|
|
|
|
|
# The text entry at the top
|
|
|
|
|
frame $box.d
|
|
|
|
|
entry $box.d.e -relief sunken -width 40
|
|
|
|
|
$box.d.e insert end $file
|
|
|
|
|
button $box.d.s -text scan -command "filescan $filter $box"
|
|
|
|
|
pack $box.d.e -side left
|
|
|
|
|
pack $box.d.s -side right
|
|
|
|
|
pack $box.d -side top
|
|
|
|
|
|
|
|
|
|
# The list box with the files
|
|
|
|
|
frame $box.f
|
|
|
|
|
listbox $box.f.l -relief sunken -yscrollcommand "$box.f.s set"
|
|
|
|
|
scrollbar $box.f.s -relief sunken -command "$box.f.l yview"
|
|
|
|
|
pack $box.f.l $box.f.s -side left -fill y
|
|
|
|
|
pack $box.f -side top
|
|
|
|
|
|
|
|
|
|
filescan $filter $box
|
|
|
|
|
|
|
|
|
|
bind $box.f.l <Double-Button-1> "fileclick $box $filter $okproc"
|
|
|
|
|
|
|
|
|
|
modaldialog $box [concat $okproc " \[" $box.d.e "get\]"]
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
# when double click
|
|
|
|
|
proc fileclick {box filter okproc} {
|
|
|
|
|
filescan $filter $box [selection get]
|
|
|
|
|
set f [$box.d.e get]
|
|
|
|
|
if {! [file isdirectory $f]} {
|
|
|
|
|
destroy $box
|
|
|
|
|
$okproc $f
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
proc filescan {filter box {subfile ""}} {
|
|
|
|
|
|
|
|
|
|
set s [$box.d.e get]
|
|
|
|
|
if {$s == "."} {set s [pwd]/}
|
|
|
|
|
|
|
|
|
|
$box.d.e delete 0 end
|
|
|
|
|
if {$subfile != ""} {
|
|
|
|
|
if {$subfile == ".."} {
|
|
|
|
|
set s [file dirname [file dirname $s]]/
|
|
|
|
|
} else {
|
|
|
|
|
set s [file dirname $s]/$subfile
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
$box.d.e insert end $s
|
|
|
|
|
|
|
|
|
|
# list directories
|
|
|
|
|
$box.f.l delete 0 end
|
|
|
|
|
$box.f.l insert end ".."
|
|
|
|
|
if [file isdirectory $s] {
|
|
|
|
|
set d $s
|
|
|
|
|
if {![string match */ $s]} {append s "/"}
|
|
|
|
|
} else {
|
|
|
|
|
set d [file dirname $s]
|
|
|
|
|
}
|
|
|
|
|
foreach f [glob -nocomplain $d/*] {
|
|
|
|
|
if [$filter $f] {
|
|
|
|
|
set x [file tail $f]
|
|
|
|
|
if [file isdirectory $f] {append x "/"}
|
|
|
|
|
$box.f.l insert end $x
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
#################################
|
|
|
|
|
# File menu procedures
|
|
|
|
|
#################################
|
|
|
|
|
|
|
|
|
|
#
|
|
|
|
|
# dialog box for datadir
|
|
|
|
|
#
|
|
|
|
|
|
|
|
|
|
proc isdir {f} {return [file isdirectory $f]}
|
|
|
|
|
|
|
|
|
|
proc sdatadir {d} {
|
|
|
|
|
global Draw_DataDir
|
|
|
|
|
set Draw_DataDir $d
|
|
|
|
|
global Draw_DataDir
|
|
|
|
|
set Draw_DataDir $d
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
proc vdatadir {} {
|
|
|
|
|
global Draw_DataDir
|
|
|
|
|
toplevel .s
|
|
|
|
|
frame .s.t
|
|
|
|
|
button .s.t.d -text data -command {
|
|
|
|
|
.s.d.e delete 0 end
|
|
|
|
|
.s.d.e insert end $env(WBCONTAINER)/data/
|
|
|
|
|
filescan isdir .s
|
|
|
|
|
}
|
|
|
|
|
pack .s.t.d -side left
|
|
|
|
|
pack .s.t -side top
|
|
|
|
|
getfile $Draw_DataDir sdatadir "Data Directory" isdir .s
|
|
|
|
|
global Draw_DataDir
|
|
|
|
|
sdatadir [tk_chooseDirectory -title "Data Directory" -initialdir $Draw_DataDir]
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
proc notild {f} {return [expr ! [string match *~ $f]]}
|
|
|
|
|
|
|
|
|
|
proc rresto {f} {
|
|
|
|
|
if {[file exists $f]} {
|
|
|
|
|
if {! [file isdirectory $f]} {
|
|
|
|
|
uplevel \#0 "brestore $f [file tail $f]"
|
|
|
|
|
repaint
|
|
|
|
|
puts "restore $f [file tail $f]"
|
|
|
|
|
uplevel \#0 "restore $f [file tail $f]"
|
|
|
|
|
repaint
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
proc vrestore {} {
|
|
|
|
|
global Draw_DataDir
|
|
|
|
|
getfile $Draw_DataDir rresto "Restore" notild
|
|
|
|
|
global Draw_DataDir
|
|
|
|
|
rresto [tk_getOpenFile -title "Load Shape (restore)" -filetypes {{{BREP} {.brep}}} -initialdir $Draw_DataDir]
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
proc ssour {f} {
|
|
|
|
|
global Draw_Source
|
|
|
|
|
global Draw_Source
|
|
|
|
|
if {[file exists $f]} {
|
|
|
|
|
set Draw_Source $f
|
|
|
|
|
if {! [file isdirectory $f]} {
|
|
|
|
|
uplevel \#0 "source $f"
|
|
|
|
|
puts "source $f [file tail $f]"
|
|
|
|
|
uplevel \#0 "source $f"
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
set Draw_Source [pwd]
|
|
|
|
|
proc vsource {} {
|
|
|
|
|
global Draw_Source
|
|
|
|
|
getfile $Draw_Source ssour "Source" notild
|
|
|
|
|
global Draw_Source
|
|
|
|
|
ssour [tk_getOpenFile -title "Load Script (source)" -filetypes {{{All Files} *}} -initialdir Draw_Source]
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#Creates a "Samples" window
|
|
|
|
|
proc vsamples {} {
|
|
|
|
|
#create list {{category} {title} {filename}}
|
|
|
|
|
set alistofthree ""
|
|
|
|
|
foreach fname [file nativename [glob -path $::env(CASROOT)/samples/tcl/ *]] {
|
|
|
|
|
if {[lindex [split $fname "."] end] != "tcl"} {continue}
|
|
|
|
|
set chan [open $fname]
|
|
|
|
|
set istitlefound 0
|
|
|
|
|
while {[gets $chan line] >= 0} {
|
|
|
|
|
if {[lindex [split $line " "] 0] == "#Category:"} {
|
|
|
|
|
set acategory [string trimleft $line "#Category: "]
|
|
|
|
|
}
|
|
|
|
|
if {[lindex [split $line " "] 0] == "#Title:"} {
|
|
|
|
|
set atitle [string trimleft $line "#Title: "]
|
|
|
|
|
lappend alistofthree $acategory $atitle $fname
|
|
|
|
|
incr istitlefound
|
|
|
|
|
break
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
close $chan
|
|
|
|
|
if {$istitlefound == 0} {
|
|
|
|
|
lappend alistofthree Other "[lindex [split $fname \\] end]" $fname
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
#create window
|
|
|
|
|
toplevel .samples
|
|
|
|
|
wm title .samples "Samples"
|
|
|
|
|
wm geometry .samples +0+0
|
|
|
|
|
wm minsize .samples 800 600
|
|
|
|
|
frame .samples.right
|
|
|
|
|
frame .samples.left
|
|
|
|
|
frame .samples.right.textframe
|
|
|
|
|
frame .samples.right.botframe
|
|
|
|
|
ttk::treeview .samples.left.tree -selectmode browse -yscrollcommand {.samples.left.treescroll set}
|
|
|
|
|
pack .samples.left.tree -fill both -expand 1 -side left
|
|
|
|
|
.samples.left.tree column #0 -minwidth 200
|
|
|
|
|
.samples.left.tree heading #0 -text "Samples"
|
|
|
|
|
pack .samples.right -side right -fill both -expand 1 -padx 10 -pady 10
|
|
|
|
|
pack .samples.left -side left -padx 10 -pady 10 -fill both
|
|
|
|
|
pack .samples.right.textframe -side top -fill both -expand 1
|
|
|
|
|
pack .samples.right.botframe -side bottom -fill both -expand 1
|
|
|
|
|
text .samples.right.textframe.text -yscrollcommand {.samples.right.textframe.scroll set} -xscrollcommand {.samples.right.botframe.scrollx set} -wrap none -width 40 -height 32
|
|
|
|
|
pack .samples.right.textframe.text -fill both -side left -expand 1
|
|
|
|
|
.samples.right.textframe.text delete 0.0 end
|
|
|
|
|
.samples.right.textframe.text configure -state disabled
|
|
|
|
|
set i 1
|
|
|
|
|
foreach {acat title fnam} $alistofthree {
|
|
|
|
|
if [.samples.left.tree exists $acat] {
|
|
|
|
|
.samples.left.tree insert $acat end -id $title -text $title -tags "selected$i"
|
|
|
|
|
.samples.left.tree tag bind selected$i <1> "fillsampletext {$fnam}"
|
|
|
|
|
incr i
|
|
|
|
|
continue
|
|
|
|
|
} else {
|
|
|
|
|
.samples.left.tree insert {} end -id $acat -text $acat
|
|
|
|
|
.samples.left.tree insert $acat end -id $title -text $title -tags "selected$i"
|
|
|
|
|
.samples.left.tree tag bind selected$i <1> "fillsampletext {$fnam}"
|
|
|
|
|
incr i
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
scrollbar .samples.right.textframe.scroll -command {.samples.right.textframe.text yview}
|
|
|
|
|
scrollbar .samples.left.treescroll -command {.samples.left.tree yview}
|
|
|
|
|
scrollbar .samples.right.botframe.scrollx -command {.samples.right.textframe.text xview} -orient horizontal
|
|
|
|
|
pack .samples.right.textframe.scroll -side right -fill y
|
|
|
|
|
pack .samples.right.botframe.scrollx -side top -fill x
|
|
|
|
|
pack .samples.left.treescroll -side right -fill y
|
|
|
|
|
button .samples.right.botframe.button -text "Run sample" -state disabled
|
|
|
|
|
pack .samples.right.botframe.button -fill none -pady 10
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#Fills the textbox in "Samples" window
|
|
|
|
|
proc fillsampletext {fname} {
|
|
|
|
|
.samples.right.botframe.button configure -state normal -command "lower .samples;catch {vclose ALL};catch {vremove -all}; catch {vclear}; source {$fname}"
|
|
|
|
|
.samples.right.textframe.text configure -state normal
|
|
|
|
|
.samples.right.textframe.text delete 0.0 end
|
|
|
|
|
set chan [open "$fname"]
|
|
|
|
|
while {[gets $chan line] >= 0} {
|
|
|
|
|
.samples.right.textframe.text insert end "$line\n"
|
|
|
|
|
}
|
|
|
|
|
close $chan
|
|
|
|
|
.samples.right.textframe.text configure -state disabled
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#Creates a "Commands help" window
|
|
|
|
|
proc vcommands {} {
|
|
|
|
|
global Draw_Groups Find_Button_Click_Count Entry_Cache
|
|
|
|
|
set Find_Button_Click_Count 0
|
|
|
|
|
set Entry_Cache ""
|
|
|
|
|
toplevel .commands
|
|
|
|
|
focus .commands
|
|
|
|
|
wm minsize .commands 800 600
|
|
|
|
|
wm title .commands "Commands help"
|
|
|
|
|
wm geometry .commands +0+0
|
|
|
|
|
frame .commands.t
|
|
|
|
|
frame .commands.left
|
|
|
|
|
ttk::treeview .commands.left.tree -selectmode browse -yscrollcommand {.commands.left.treescroll set}
|
|
|
|
|
.commands.left.tree column #0 -width 300
|
|
|
|
|
.commands.left.tree heading #0 -text "Help treeview"
|
|
|
|
|
pack .commands.left.tree -expand 1 -fill both -side left
|
|
|
|
|
pack .commands.t -side right -fill both -expand 1 -padx 10 -pady 10
|
|
|
|
|
pack .commands.left -side left -fill both -padx 10 -pady 10
|
|
|
|
|
pack [frame .commands.t.top] -side top -fill x -padx 10 -pady 10
|
|
|
|
|
text .commands.t.text -yscrollcommand {.commands.t.scroll set} -width 40
|
|
|
|
|
.commands.t.text delete 0.0 end
|
|
|
|
|
pack .commands.t.text -fill both -side left -expand 1
|
|
|
|
|
.commands.t.text configure -state disabled
|
|
|
|
|
pack [entry .commands.t.top.e -width 20] -side left
|
|
|
|
|
pack [button .commands.t.top.findcom -text "Find command" -command vhelpsearch] -side left -padx 10
|
|
|
|
|
pack [button .commands.t.top.textfind -text "Find in text" -command "vhelptextsearch; incr Find_Button_Click_Count"] -side left
|
|
|
|
|
set i 1
|
|
|
|
|
set j 100
|
|
|
|
|
set newgroupinx 0
|
|
|
|
|
foreach h [lsort [array names Draw_Groups]] {
|
|
|
|
|
.commands.left.tree insert {} end -id $i -text $h -tags "info$i"
|
|
|
|
|
.commands.left.tree tag bind info$i <1> "vcomhelp {$h}"
|
|
|
|
|
set newgroupinx $j
|
|
|
|
|
foreach f [lsort $Draw_Groups($h)] {
|
|
|
|
|
.commands.left.tree insert $i end -id $j -text $f -tags "selected$j"
|
|
|
|
|
.commands.left.tree tag bind selected$j <1> "vcomhelp {$h} $j $newgroupinx"
|
|
|
|
|
incr j
|
|
|
|
|
}
|
|
|
|
|
incr i
|
|
|
|
|
}
|
|
|
|
|
scrollbar .commands.t.scroll -command {.commands.t.text yview}
|
|
|
|
|
scrollbar .commands.left.treescroll -command {.commands.left.tree yview}
|
|
|
|
|
pack .commands.t.scroll -side right -fill y
|
|
|
|
|
pack .commands.left.treescroll -side right -fill y -expand 1
|
|
|
|
|
#hotkeys
|
|
|
|
|
bind .commands.t.top.e <Return> {vhelpsearch}
|
|
|
|
|
bind .commands <Control-f> {focus .commands.t.top.e}
|
|
|
|
|
bind .commands <Control-F> {focus .commands.t.top.e}
|
|
|
|
|
bind .commands <Escape> {destroy .commands}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
############################################################
|
|
|
|
|
# Fills the textbox in "Commands help" window
|
|
|
|
|
# $h -group of commands to display
|
|
|
|
|
# $selindex - index of selected item in the treeview
|
|
|
|
|
# $startindex - index of item int the treeview to start from
|
|
|
|
|
############################################################
|
|
|
|
|
proc vcomhelp {h {selindex -1} {startindex 0}} {
|
|
|
|
|
global Draw_Helps Draw_Groups
|
|
|
|
|
set highlighted false
|
|
|
|
|
.commands.t.text configure -state normal
|
|
|
|
|
.commands.t.text delete 1.0 end
|
|
|
|
|
foreach f [lsort $Draw_Groups($h)] {
|
|
|
|
|
if {$startindex == $selindex} {
|
|
|
|
|
.commands.t.text insert end "$f : $Draw_Helps($f)\n\n" "highlightline"
|
|
|
|
|
incr startindex
|
|
|
|
|
set highlighted true
|
|
|
|
|
continue
|
|
|
|
|
}
|
|
|
|
|
.commands.t.text insert end "$f : $Draw_Helps($f)\n\n"
|
|
|
|
|
incr startindex
|
|
|
|
|
}
|
|
|
|
|
.commands.t.text tag configure highlightline -background yellow -relief raised
|
|
|
|
|
.commands.t.text configure -state disabled
|
|
|
|
|
if {$highlighted == true} {.commands.t.text see highlightline.last}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#Creates a "About" window
|
|
|
|
|
proc about {} {
|
|
|
|
|
toplevel .about
|
|
|
|
|
focus .about
|
|
|
|
|
wm resizable .about 0 0
|
|
|
|
|
wm title .about "About"
|
|
|
|
|
set screenheight [expr {int([winfo screenheight .]*0.5-200)}]
|
|
|
|
|
set screenwidth [expr {int([winfo screenwidth .]*0.5-200)}]
|
|
|
|
|
wm geometry .about 400x200+$screenwidth+$screenheight
|
|
|
|
|
image create photo occlogo -file $::env(CASROOT)/src/DrawResources/OCC_logo.png -format png
|
|
|
|
|
frame .about.logo -bg red
|
|
|
|
|
frame .about.links -bg blue
|
|
|
|
|
frame .about.copyright
|
|
|
|
|
pack .about.logo -side top -fill both
|
|
|
|
|
pack .about.links -fill both
|
|
|
|
|
pack .about.copyright -side top -fill both
|
|
|
|
|
label .about.logo.img -image occlogo
|
|
|
|
|
pack .about.logo.img -fill both
|
|
|
|
|
text .about.links.text -bg lightgray -fg blue -height 1 -width 10
|
|
|
|
|
.about.links.text insert end "http://www.opencascade.com/" "link1"
|
|
|
|
|
.about.links.text tag bind link1 <1> "_launchBrowser http://www.opencascade.com/"
|
|
|
|
|
.about.links.text tag bind link1 <Enter> ".about.links.text configure -cursor hand2"
|
|
|
|
|
.about.links.text tag bind link1 <Leave> ".about.links.text configure -cursor arrow"
|
|
|
|
|
.about.links.text tag configure link1 -underline true -justify center
|
|
|
|
|
pack .about.links.text -fill both
|
|
|
|
|
label .about.copyright.text -text "Copyright (c) 1999-2014 OPEN CASCADE SAS"
|
|
|
|
|
button .about.button -text "OK" -command "destroy .about"
|
|
|
|
|
pack .about.button -padx 10 -pady 10
|
|
|
|
|
pack .about.copyright.text
|
|
|
|
|
.about.links.text configure -state disabled
|
|
|
|
|
grab .about
|
|
|
|
|
bind .about <Return> {destroy .about}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#Executes files and hyperlinks
|
|
|
|
|
proc launchBrowser url {
|
|
|
|
|
global tcl_platform
|
|
|
|
|
|
|
|
|
|
if {$tcl_platform(platform) eq "windows"} {
|
|
|
|
|
set command [list {*}[auto_execok start] {}]
|
|
|
|
|
} elseif {$tcl_platform(os) eq "Darwin"} {
|
|
|
|
|
set command [list open]
|
|
|
|
|
} else {
|
|
|
|
|
set command [list xdg-open]
|
|
|
|
|
}
|
|
|
|
|
exec {*}$command $url &
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#Safe execution of files and hyperlinks
|
|
|
|
|
proc _launchBrowser {url} {
|
|
|
|
|
if [catch {launchBrowser $url} err] {
|
|
|
|
|
tk_messageBox -icon error -message "error '$err' with '$command'"
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
################################################################
|
|
|
|
|
# This procedure tries to open an userguide on Draw Harness in pdf format
|
|
|
|
|
# If there is no a such one, then tries to open it in html format
|
|
|
|
|
# Else opens a site with this guide
|
|
|
|
|
################################################################
|
|
|
|
|
proc openuserguide {} {
|
|
|
|
|
if [file exists $::env(CASROOT)/doc/pdf/user_guides/occt_test_harness.pdf] {
|
|
|
|
|
_launchBrowser $::env(CASROOT)/doc/pdf/user_guides/occt_test_harness.pdf
|
|
|
|
|
} elseif [file exists $::env(CASROOT)/doc/overview/html/occt_user_guides__test_harness.html] {
|
|
|
|
|
_launchBrowser $::env(CASROOT)/doc/overview/html/occt_user_guides__test_harness.html
|
|
|
|
|
} else {
|
|
|
|
|
_launchBrowser {http://dev.opencascade.org/doc/overview/html/occt_user_guides__test_harness.html}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#Search through commands and display the result
|
|
|
|
|
proc vhelpsearch {} {
|
|
|
|
|
global Draw_Groups Entry_Cache
|
|
|
|
|
set searchstring [.commands.t.top.e get]
|
|
|
|
|
set i 1
|
|
|
|
|
set j 100
|
|
|
|
|
set newgroupinx 0
|
|
|
|
|
set isfound 0
|
|
|
|
|
foreach h [lsort [array names Draw_Groups]] {
|
|
|
|
|
set newgroupinx $j
|
|
|
|
|
foreach f [lsort $Draw_Groups($h)] {
|
|
|
|
|
if {$f == $searchstring} {
|
|
|
|
|
incr isfound
|
|
|
|
|
.commands.left.tree see $j
|
|
|
|
|
.commands.left.tree selection set $j
|
|
|
|
|
vcomhelp $h $j $newgroupinx
|
|
|
|
|
break
|
|
|
|
|
}
|
|
|
|
|
incr j
|
|
|
|
|
}
|
|
|
|
|
incr i
|
|
|
|
|
}
|
|
|
|
|
if {$isfound == 0} {
|
|
|
|
|
errorhelp "No help found for '$searchstring'!"
|
|
|
|
|
} else {set Entry_Cache ""}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#Displays an error window with $errstring inside
|
|
|
|
|
proc errorhelp {errstring} {
|
|
|
|
|
toplevel .errorhelp
|
|
|
|
|
focus .errorhelp
|
|
|
|
|
wm resizable .errorhelp 0 0
|
|
|
|
|
wm title .errorhelp "Error"
|
|
|
|
|
set screenheight [expr {int([winfo screenheight .]*0.5-200)}]
|
|
|
|
|
set screenwidth [expr {int([winfo screenwidth .]*0.5-200)}]
|
|
|
|
|
wm geometry .errorhelp +$screenwidth+$screenheight
|
|
|
|
|
text .errorhelp.t -width 40 -height 5
|
|
|
|
|
.errorhelp.t insert end $errstring
|
|
|
|
|
button .errorhelp.button -text "OK" -command "destroy .errorhelp"
|
|
|
|
|
pack .errorhelp.t
|
|
|
|
|
.errorhelp.t configure -state disabled
|
|
|
|
|
pack .errorhelp.button -padx 10 -pady 10
|
|
|
|
|
bind .errorhelp <Return> {destroy .errorhelp}
|
|
|
|
|
grab .errorhelp
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#Search through text of help and display the result
|
|
|
|
|
proc vhelptextsearch {} {
|
|
|
|
|
global Draw_Helps Draw_Groups Find_Button_Click_Count Entry_Cache End_of_Search
|
|
|
|
|
set searchstring [.commands.t.top.e get]
|
|
|
|
|
if {$Entry_Cache != $searchstring} {
|
|
|
|
|
set Find_Button_Click_Count 0
|
|
|
|
|
set End_of_Search 0
|
|
|
|
|
set Entry_Cache $searchstring
|
|
|
|
|
}
|
|
|
|
|
if {$End_of_Search} {
|
|
|
|
|
errorhelp "No more '$searchstring' found!"
|
|
|
|
|
return
|
|
|
|
|
}
|
|
|
|
|
.commands.t.text configure -state normal
|
|
|
|
|
.commands.t.text delete 0.0 end
|
|
|
|
|
set i 0
|
|
|
|
|
set isfound 0
|
|
|
|
|
foreach h [lsort [array names Draw_Groups]] {
|
|
|
|
|
foreach f [lsort $Draw_Groups($h)] {
|
|
|
|
|
if [string match *$searchstring* $Draw_Helps($f)] {
|
|
|
|
|
incr i
|
|
|
|
|
if {$i > $Find_Button_Click_Count+1} {incr isfound; break}
|
|
|
|
|
.commands.t.text insert end "$f : "
|
|
|
|
|
foreach line [list $Draw_Helps($f)] {
|
|
|
|
|
foreach word [split $line " "] {
|
|
|
|
|
if [string match *$searchstring* $word] {
|
|
|
|
|
.commands.t.text insert end "$word" "highlightword"
|
|
|
|
|
.commands.t.text insert end " "
|
|
|
|
|
continue
|
|
|
|
|
}
|
|
|
|
|
.commands.t.text insert end "$word "
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
.commands.t.text insert end \n\n
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
if {!$isfound} {
|
|
|
|
|
incr End_of_Search
|
|
|
|
|
}
|
|
|
|
|
.commands.t.text tag configure highlightword -background yellow -relief raised
|
|
|
|
|
.commands.t.text see end
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#Create a "System information" window
|
|
|
|
|
proc sysinfo {} {
|
|
|
|
|
toplevel .info
|
|
|
|
|
wm title .info "System information"
|
|
|
|
|
wm resizable .info 0 0
|
|
|
|
|
pack [frame .info.top] -side top -fill both -padx 5 -pady 10
|
|
|
|
|
pack [frame .info.bot] -side bottom -fill both -padx 5 -pady 10
|
|
|
|
|
pack [frame .info.top.left] -side left -fill both -padx 5 -pady 10
|
|
|
|
|
pack [frame .info.top.mid] -side left -fill both -padx 5 -pady 10
|
|
|
|
|
pack [frame .info.top.right] -side left -fill both -padx 5 -pady 10
|
|
|
|
|
pack [label .info.top.left.label -text "OCCT build configuration "]
|
|
|
|
|
pack [label .info.top.mid.label -text "Memory info"]
|
|
|
|
|
pack [label .info.top.right.label -text "OpenGL info"]
|
|
|
|
|
pack [text .info.top.left.text -width 50 -height 20]
|
|
|
|
|
pack [text .info.top.mid.text -width 50 -height 20]
|
|
|
|
|
pack [text .info.top.right.text -width 50 -height 20]
|
|
|
|
|
pack [button .info.bot.button -text "Update" -command rescaninfo]
|
|
|
|
|
pack [button .info.bot.close -text "Close" -command "destroy .info"] -pady 10
|
|
|
|
|
rescaninfo
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#Updates information in "System information" window
|
|
|
|
|
proc rescaninfo {} {
|
|
|
|
|
.info.top.left.text configure -state normal
|
|
|
|
|
.info.top.mid.text configure -state normal
|
|
|
|
|
.info.top.right.text configure -state normal
|
|
|
|
|
.info.top.left.text delete 0.0 end
|
|
|
|
|
.info.top.mid.text delete 0.0 end
|
|
|
|
|
.info.top.right.text delete 0.0 end
|
|
|
|
|
.info.top.left.text insert end [dversion]
|
|
|
|
|
.info.top.mid.text insert end [meminfo]
|
|
|
|
|
set glinfo ""
|
|
|
|
|
if [catch {vglinfo} err] {
|
|
|
|
|
if {$err == ""} {
|
|
|
|
|
.info.top.right.text insert end "No active view. Please call vinit."
|
|
|
|
|
} else {
|
|
|
|
|
.info.top.right.text insert end "VISUALIZATION is not loaded. Please call pload VISUALIZATION"
|
|
|
|
|
}
|
|
|
|
|
} else {
|
|
|
|
|
.info.top.right.text insert end [vglinfo]
|
|
|
|
|
}
|
|
|
|
|
.info.top.left.text configure -state disabled
|
|
|
|
|
.info.top.mid.text configure -state disabled
|
|
|
|
|
.info.top.right.text configure -state disabled
|
|
|
|
|
}
|
|
|
|
|
|
isz
bugmaster
