+# Copyright (c) 1999-2014 OPEN CASCADE SAS
+#
+# This file is part of Open CASCADE Technology software library.
+#
+# This library is free software; you can redistribute it and/or modify it under
+# the terms of the GNU Lesser General Public License version 2.1 as published
+# by the Free Software Foundation, with special exception defined in the file
+# OCCT_LGPL_EXCEPTION.txt. Consult the file LICENSE_LGPL_21.txt included in OCCT
+# distribution for complete text of the license and disclaimer of any warranty.
+#
+# Alternatively, this file may be used under the terms of Open CASCADE
+# commercial license or contractual agreement.
+
#
# TK features for Draw
#
}
}
+#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
proc addmenu {menu submenu {command ""}} {
if {$command == ""} {set command $submenu}
- addmenuitem $menu "command -label $submenu -command {$command}"
+ addmenuitem $menu "command -label {$submenu} -command {$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
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"
grab set $box
}
+
+#################################
+# File menu procedures
+#################################
+
##############################
#
# dialbox command arg1 val1 arg2 val2 ...
##############################
proc dialbox args {
-
set com [lindex $args 0]
toplevel .d
append com ";repaint"
modaldialog .d $com "help [lindex $args 0]"
+ }
+proc sdatadir {d} {
+ global Draw_DataDir
+ set Draw_DataDir $d
}
+proc vdatadir {} {
+ global Draw_DataDir
+ sdatadir [tk_chooseDirectory -title "Data Directory" -initialdir $Draw_DataDir]
+}
-####################################
-# 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
+proc rresto {f} {
+ if {[file exists $f]} {
+ if {! [file isdirectory $f]} {
+ puts "restore $f [file tail $f]"
+ uplevel \#0 "restore $f [file tail $f]"
+ repaint
}
- 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]
+proc vrestore {} {
+ global Draw_DataDir
+ rresto [tk_getOpenFile -title "Load Shape (restore)" -filetypes {{{BREP} {.brep}}} -initialdir $Draw_DataDir]
+}
+
+
+proc ssour {f} {
+ global Draw_Source
+ if {[file exists $f]} {
+ set Draw_Source $f
if {! [file isdirectory $f]} {
- destroy $box
- $okproc $f
+ puts "source $f [file tail $f]"
+ uplevel \#0 "source $f"
}
+ }
}
-proc filescan {filter box {subfile ""}} {
-
- set s [$box.d.e get]
- if {$s == "."} {set s [pwd]/}
+set Draw_Source [pwd]
+proc vsource {} {
+ global Draw_Source
+ ssour [tk_getOpenFile -title "Load Script (source)" -filetypes {{{All Files} *}} -initialdir Draw_Source]
+}
- $box.d.e delete 0 end
- if {$subfile != ""} {
- if {$subfile == ".."} {
- set s [file dirname [file dirname $s]]/
- } else {
- set s [file dirname $s]/$subfile
- }
+#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 trim [string trimleft $line "#Category: "]]
+ }
+ if {[lindex [split $line " "] 0] == "#Title:"} {
+ set atitle [string trim [string trimleft $line "#Title: "]]
+ lappend alistofthree $acategory $atitle $fname
+ incr istitlefound
+ break
+ }
}
- $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]
+ close $chan
+ if {$istitlefound == 0} {
+ lappend alistofthree Other "[lindex [split $fname \\] end]" $fname
}
- 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
- }
+ }
+ #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
+}
-#################################
-# File menu procedures
-#################################
+#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}
+}
-#
-# dialog box for datadir
-#
+#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}
+}
-proc isdir {f} {return [file isdirectory $f]}
+#Executes files and hyperlinks
+proc launchBrowser url {
+ global tcl_platform
-proc sdatadir {d} {
- global Draw_DataDir
- set Draw_DataDir $d
+ 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 &
}
-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
+#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}
}
- pack .s.t.d -side left
- pack .s.t -side top
- getfile $Draw_DataDir sdatadir "Data Directory" isdir .s
}
-proc notild {f} {return [expr ! [string match *~ $f]]}
-
-proc rresto {f} {
- if {! [file isdirectory $f]} {
- uplevel \#0 "brestore $f [file tail $f]"
- repaint
+#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 ""}
}
-proc vrestore {} {
- global Draw_DataDir
- getfile $Draw_DataDir rresto "Restore" notild
+#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
}
-
-proc ssour {f} {
- global Draw_Source
- set Draw_Source $f
- if {! [file isdirectory $f]} {
- uplevel \#0 "source $f"
+#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
}
-set Draw_Source [pwd]
-proc vsource {} {
- global Draw_Source
- getfile $Draw_Source ssour "Source" notild
+#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
}
projects / occt.git / blobdiff