973c2be1 |
1 | # Copyright (c) 1999-2014 OPEN CASCADE SAS |
b311480e |
2 | # |
973c2be1 |
3 | # This file is part of Open CASCADE Technology software library. |
b311480e |
4 | # |
d5f74e42 |
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 |
973c2be1 |
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. |
b311480e |
10 | # |
973c2be1 |
11 | # Alternatively, this file may be used under the terms of Open CASCADE |
12 | # commercial license or contractual agreement. |
b311480e |
13 | |
7fd59977 |
14 | # |
15 | # TK features for Draw |
16 | # |
17 | |
18 | # reload bindings |
19 | if { [info exists tk_library] } { |
20 | set version [split [info tclversion] "."] |
21 | set major [lindex ${version} 0] |
22 | set minor [lindex ${version} 1] |
23 | if { (${major} > 8) || (${major} >= 8 && ${minor} >= 4) } { |
24 | #source $tk_library/tk.tcl |
25 | } else { |
26 | source $tk_library/tk.tcl |
27 | } |
28 | } |
29 | |
ab91ab6f |
30 | #fills menu "Load" with submenus |
31 | proc fillloadmenu {} { |
4b3541c6 |
32 | set drawplugpath "" |
33 | if {[array names ::env CSF_OCCTResourcePath] != "" && "$::env(CSF_OCCTResourcePath)" != "" && [file exists $::env(CSF_OCCTResourcePath)/DrawResources/DrawPlugin]} { |
34 | set drawplugpath "$::env(CSF_OCCTResourcePath)/DrawResources/DrawPlugin" |
35 | } elseif {[array names ::env CASROOT] != "" && "$::env(CASROOT)" != "" && [file exists $::env(CASROOT)/src/DrawResources/DrawPlugin]} { |
36 | set drawplugpath "$::env(CASROOT)/src/DrawResources/DrawPlugin" |
096ef695 |
37 | } |
38 | |
39 | set chan [open [file nativename $drawplugpath]] |
ab91ab6f |
40 | while {[gets $chan line] >= 0} { |
41 | if {[lindex [split $line ""] 0] != "!"} { |
42 | if {[lindex [split $line ""] 0] == ""} {continue} |
43 | set plugname [lindex [split $line " "] 0] |
44 | addmenu Load "pload $plugname" "pload $plugname" |
45 | } |
46 | } |
47 | close $chan |
48 | } |
49 | |
7fd59977 |
50 | wm geometry . +10+10 |
ab91ab6f |
51 | bind . <F1> {vcommands} |
7fd59977 |
52 | |
53 | frame .mbar -relief raised -bd 2 |
54 | pack .mbar -side top -fill x |
55 | focus .mbar |
56 | |
57 | set theMenus("") "" |
58 | set Draw_MenuIndex 0 |
59 | |
60 | proc addmenuitem {menu options} { |
61 | |
62 | global theMenus Draw_MenuIndex |
63 | if {![info exists theMenus($menu)]} { |
64 | incr Draw_MenuIndex |
65 | set m .mbar.m$Draw_MenuIndex.menu |
66 | menubutton .mbar.m$Draw_MenuIndex -text $menu -menu $m |
67 | pack .mbar.m$Draw_MenuIndex -side left |
68 | menu $m |
69 | set theMenus($menu) $m |
70 | } else {set m $theMenus($menu)} |
71 | |
72 | eval $m add $options |
73 | } |
74 | |
75 | proc addmenu {menu submenu {command ""}} { |
76 | if {$command == ""} {set command $submenu} |
ab91ab6f |
77 | addmenuitem $menu "command -label {$submenu} -command {$command}" |
7fd59977 |
78 | } |
79 | |
80 | ################################# |
81 | # Menus definition |
82 | ################################# |
83 | |
84 | # the file menu |
85 | |
ab91ab6f |
86 | addmenu File "Choose Data Directory" vdatadir |
87 | addmenu File "Load Shape (restore)" vrestore |
88 | addmenu File "Load Script (source)" vsource |
89 | addmenu File Exit exit |
90 | |
91 | # the Load menu |
92 | fillloadmenu |
7fd59977 |
93 | |
94 | # the view menu |
95 | |
96 | addmenu Views axo {smallview AXON} |
97 | addmenu Views top {smallview +X+Y} |
98 | addmenu Views front {smallview +X+Z} |
99 | addmenu Views left {smallview +Y+Z} |
100 | addmenu Views 2d {smallview -2D-} |
101 | addmenuitem Views "separator" |
102 | addmenu Views mu4 |
103 | addmenu Views av2d |
104 | addmenu Views axo |
105 | addmenu Views pers |
106 | |
107 | # the display menu |
108 | |
109 | addmenu Display fit "fit; repaint" |
110 | addmenu Display 2dfit "2dfit; repaint" |
111 | addmenu Display clear |
112 | addmenu Display 2dclear |
113 | |
ab91ab6f |
114 | # the samples menu |
115 | addmenu Samples "View samples" vsample |
116 | |
117 | # the help menu |
118 | |
119 | addmenu Help "System Info" sysinfo |
120 | addmenu Help Commands vcommands |
121 | addmenu Help About about |
122 | addmenu Help "User Guide" openuserguide |
123 | |
124 | #redraw help submenu in the end of menu |
125 | proc redrawhelp {} { |
126 | global theMenus |
127 | set m $theMenus(Help) |
128 | destroy [string trimright $m ".menu"] |
129 | if [info exists theMenus(Help)] {unset theMenus(Help)} |
130 | addmenu Help "System Info" sysinfo |
131 | addmenu Help Commands vcommands |
132 | addmenu Help About about |
133 | addmenu Help "User Guide" openuserguide |
134 | } |
7fd59977 |
135 | |
136 | ################################# |
137 | # Modal dialog box |
ab91ab6f |
138 | # add OK, help, cancel buttons |
7fd59977 |
139 | ################################# |
140 | |
141 | proc modaldialog {box okproc {helpproc ""} {cancelproc ""}} { |
142 | wm geometry $box +10+60 |
7fd59977 |
143 | button $box.ok -text ok -command "$okproc ; destroy $box" |
144 | pack $box.ok -side left |
145 | button $box.ko -text Cancel -command "$cancelproc ; destroy $box" |
146 | pack $box.ko -side right |
147 | if {$helpproc != ""} { |
148 | button $box.help -text Help -command $helpproc |
149 | pack $box.help -side right |
150 | } |
151 | grab set $box |
152 | } |
153 | |
ab91ab6f |
154 | |
155 | ################################# |
156 | # File menu procedures |
157 | ################################# |
158 | |
7fd59977 |
159 | ############################## |
160 | # |
161 | # dialbox command arg1 val1 arg2 val2 ... |
162 | # |
163 | ############################## |
164 | |
165 | proc dialbox args { |
7fd59977 |
166 | set com [lindex $args 0] |
167 | |
168 | toplevel .d |
169 | wm title .d $com |
170 | |
171 | # com will be the command |
172 | set com "eval $com" |
173 | |
174 | # create entries for the arguments |
175 | set n [llength $args] |
176 | |
177 | for {set i 1} {$i < $n} {incr i 2} { |
178 | |
179 | frame .d.a$i |
180 | label .d.a$i.l -text [lindex $args $i] |
181 | entry .d.a$i.e -relief sunken |
182 | .d.a$i.e insert end [lindex $args [expr $i+1]] |
183 | pack .d.a$i.l -side left |
184 | pack .d.a$i.e -side right |
185 | pack .d.a$i -side top -fill x |
186 | |
187 | append com { [} ".d.a$i.e get" {]} |
188 | } |
189 | append com ";repaint" |
190 | |
191 | modaldialog .d $com "help [lindex $args 0]" |
ab91ab6f |
192 | } |
193 | proc sdatadir {d} { |
194 | global Draw_DataDir |
195 | set Draw_DataDir $d |
7fd59977 |
196 | } |
197 | |
ab91ab6f |
198 | proc vdatadir {} { |
199 | global Draw_DataDir |
200 | sdatadir [tk_chooseDirectory -title "Data Directory" -initialdir $Draw_DataDir] |
201 | } |
7fd59977 |
202 | |
ab91ab6f |
203 | proc rresto {f} { |
204 | if {[file exists $f]} { |
205 | if {! [file isdirectory $f]} { |
206 | puts "restore $f [file tail $f]" |
207 | uplevel \#0 "restore $f [file tail $f]" |
208 | repaint |
7fd59977 |
209 | } |
ab91ab6f |
210 | } |
7fd59977 |
211 | } |
212 | |
ab91ab6f |
213 | proc vrestore {} { |
214 | global Draw_DataDir |
215 | rresto [tk_getOpenFile -title "Load Shape (restore)" -filetypes {{{BREP} {.brep}}} -initialdir $Draw_DataDir] |
216 | } |
217 | |
218 | |
219 | proc ssour {f} { |
220 | global Draw_Source |
221 | if {[file exists $f]} { |
222 | set Draw_Source $f |
7fd59977 |
223 | if {! [file isdirectory $f]} { |
ab91ab6f |
224 | puts "source $f [file tail $f]" |
225 | uplevel \#0 "source $f" |
7fd59977 |
226 | } |
ab91ab6f |
227 | } |
7fd59977 |
228 | } |
229 | |
ab91ab6f |
230 | set Draw_Source [pwd] |
231 | proc vsource {} { |
232 | global Draw_Source |
233 | ssour [tk_getOpenFile -title "Load Script (source)" -filetypes {{{All Files} *}} -initialdir Draw_Source] |
234 | } |
7fd59977 |
235 | |
ab91ab6f |
236 | #Creates a "Samples" window |
237 | proc vsamples {} { |
238 | #create list {{category} {title} {filename}} |
239 | set alistofthree "" |
096ef695 |
240 | |
4b3541c6 |
241 | set samplespath "" |
242 | if { [array names ::env CSF_OCCTSamplesPath] != "" && "$::env(CSF_OCCTSamplesPath)" != "" && [file exists $::env(CSF_OCCTSamplesPath)/tcl/]} { |
243 | set samplespath "$::env(CSF_OCCTSamplesPath)/tcl/" |
244 | } elseif { [array names ::env CASROOT] != "" && "$::env(CASROOT)" != "" && [file exists $::env(CASROOT)/samples/tcl/]} { |
245 | set samplespath "$::env(CASROOT)/samples/tcl/" |
096ef695 |
246 | } |
247 | |
248 | foreach fname [glob -path "${samplespath}" *.tcl] { |
249 | |
ab91ab6f |
250 | set chan [open $fname] |
251 | set istitlefound 0 |
252 | while {[gets $chan line] >= 0} { |
253 | if {[lindex [split $line " "] 0] == "#Category:"} { |
031224c9 |
254 | set acategory [string trim [string trimleft $line "#Category: "]] |
ab91ab6f |
255 | } |
256 | if {[lindex [split $line " "] 0] == "#Title:"} { |
031224c9 |
257 | set atitle [string trim [string trimleft $line "#Title: "]] |
ab91ab6f |
258 | lappend alistofthree $acategory $atitle $fname |
259 | incr istitlefound |
260 | break |
261 | } |
7fd59977 |
262 | } |
ab91ab6f |
263 | close $chan |
264 | if {$istitlefound == 0} { |
265 | lappend alistofthree Other "[lindex [split $fname \\] end]" $fname |
7fd59977 |
266 | } |
ab91ab6f |
267 | } |
268 | #create window |
269 | toplevel .samples |
270 | wm title .samples "Samples" |
271 | wm geometry .samples +0+0 |
272 | wm minsize .samples 800 600 |
273 | frame .samples.right |
274 | frame .samples.left |
275 | frame .samples.right.textframe |
276 | frame .samples.right.botframe |
277 | ttk::treeview .samples.left.tree -selectmode browse -yscrollcommand {.samples.left.treescroll set} |
278 | pack .samples.left.tree -fill both -expand 1 -side left |
279 | .samples.left.tree column #0 -minwidth 200 |
280 | .samples.left.tree heading #0 -text "Samples" |
281 | pack .samples.right -side right -fill both -expand 1 -padx 10 -pady 10 |
282 | pack .samples.left -side left -padx 10 -pady 10 -fill both |
283 | pack .samples.right.textframe -side top -fill both -expand 1 |
284 | pack .samples.right.botframe -side bottom -fill both -expand 1 |
285 | text .samples.right.textframe.text -yscrollcommand {.samples.right.textframe.scroll set} -xscrollcommand {.samples.right.botframe.scrollx set} -wrap none -width 40 -height 32 |
286 | pack .samples.right.textframe.text -fill both -side left -expand 1 |
287 | .samples.right.textframe.text delete 0.0 end |
288 | .samples.right.textframe.text configure -state disabled |
289 | set i 1 |
290 | foreach {acat title fnam} $alistofthree { |
291 | if [.samples.left.tree exists $acat] { |
292 | .samples.left.tree insert $acat end -id $title -text $title -tags "selected$i" |
293 | .samples.left.tree tag bind selected$i <1> "fillsampletext {$fnam}" |
294 | incr i |
295 | continue |
296 | } else { |
297 | .samples.left.tree insert {} end -id $acat -text $acat |
298 | .samples.left.tree insert $acat end -id $title -text $title -tags "selected$i" |
299 | .samples.left.tree tag bind selected$i <1> "fillsampletext {$fnam}" |
300 | incr i |
7fd59977 |
301 | } |
ab91ab6f |
302 | } |
303 | scrollbar .samples.right.textframe.scroll -command {.samples.right.textframe.text yview} |
304 | scrollbar .samples.left.treescroll -command {.samples.left.tree yview} |
305 | scrollbar .samples.right.botframe.scrollx -command {.samples.right.textframe.text xview} -orient horizontal |
306 | pack .samples.right.textframe.scroll -side right -fill y |
307 | pack .samples.right.botframe.scrollx -side top -fill x |
308 | pack .samples.left.treescroll -side right -fill y |
309 | button .samples.right.botframe.button -text "Run sample" -state disabled |
310 | pack .samples.right.botframe.button -fill none -pady 10 |
7fd59977 |
311 | } |
312 | |
ab91ab6f |
313 | #Fills the textbox in "Samples" window |
314 | proc fillsampletext {fname} { |
315 | .samples.right.botframe.button configure -state normal -command "lower .samples;catch {vclose ALL};catch {vremove -all}; catch {vclear}; source {$fname}" |
316 | .samples.right.textframe.text configure -state normal |
317 | .samples.right.textframe.text delete 0.0 end |
318 | set chan [open "$fname"] |
319 | while {[gets $chan line] >= 0} { |
320 | .samples.right.textframe.text insert end "$line\n" |
321 | } |
322 | close $chan |
323 | .samples.right.textframe.text configure -state disabled |
324 | } |
7fd59977 |
325 | |
ab91ab6f |
326 | #Creates a "Commands help" window |
327 | proc vcommands {} { |
328 | global Draw_Groups Find_Button_Click_Count Entry_Cache |
329 | set Find_Button_Click_Count 0 |
330 | set Entry_Cache "" |
331 | toplevel .commands |
332 | focus .commands |
333 | wm minsize .commands 800 600 |
334 | wm title .commands "Commands help" |
335 | wm geometry .commands +0+0 |
336 | frame .commands.t |
337 | frame .commands.left |
338 | ttk::treeview .commands.left.tree -selectmode browse -yscrollcommand {.commands.left.treescroll set} |
339 | .commands.left.tree column #0 -width 300 |
340 | .commands.left.tree heading #0 -text "Help treeview" |
341 | pack .commands.left.tree -expand 1 -fill both -side left |
342 | pack .commands.t -side right -fill both -expand 1 -padx 10 -pady 10 |
343 | pack .commands.left -side left -fill both -padx 10 -pady 10 |
344 | pack [frame .commands.t.top] -side top -fill x -padx 10 -pady 10 |
345 | text .commands.t.text -yscrollcommand {.commands.t.scroll set} -width 40 |
346 | .commands.t.text delete 0.0 end |
347 | pack .commands.t.text -fill both -side left -expand 1 |
348 | .commands.t.text configure -state disabled |
349 | pack [entry .commands.t.top.e -width 20] -side left |
350 | pack [button .commands.t.top.findcom -text "Find command" -command vhelpsearch] -side left -padx 10 |
351 | pack [button .commands.t.top.textfind -text "Find in text" -command "vhelptextsearch; incr Find_Button_Click_Count"] -side left |
352 | set i 1 |
353 | set j 100 |
354 | set newgroupinx 0 |
355 | foreach h [lsort [array names Draw_Groups]] { |
356 | .commands.left.tree insert {} end -id $i -text $h -tags "info$i" |
357 | .commands.left.tree tag bind info$i <1> "vcomhelp {$h}" |
358 | set newgroupinx $j |
359 | foreach f [lsort $Draw_Groups($h)] { |
360 | .commands.left.tree insert $i end -id $j -text $f -tags "selected$j" |
361 | .commands.left.tree tag bind selected$j <1> "vcomhelp {$h} $j $newgroupinx" |
362 | incr j |
363 | } |
364 | incr i |
365 | } |
366 | scrollbar .commands.t.scroll -command {.commands.t.text yview} |
367 | scrollbar .commands.left.treescroll -command {.commands.left.tree yview} |
368 | pack .commands.t.scroll -side right -fill y |
369 | pack .commands.left.treescroll -side right -fill y -expand 1 |
370 | #hotkeys |
371 | bind .commands.t.top.e <Return> {vhelpsearch} |
372 | bind .commands <Control-f> {focus .commands.t.top.e} |
373 | bind .commands <Control-F> {focus .commands.t.top.e} |
374 | bind .commands <Escape> {destroy .commands} |
375 | } |
376 | |
377 | ############################################################ |
378 | # Fills the textbox in "Commands help" window |
379 | # $h -group of commands to display |
380 | # $selindex - index of selected item in the treeview |
381 | # $startindex - index of item int the treeview to start from |
382 | ############################################################ |
383 | proc vcomhelp {h {selindex -1} {startindex 0}} { |
384 | global Draw_Helps Draw_Groups |
385 | set highlighted false |
386 | .commands.t.text configure -state normal |
387 | .commands.t.text delete 1.0 end |
388 | foreach f [lsort $Draw_Groups($h)] { |
389 | if {$startindex == $selindex} { |
390 | .commands.t.text insert end "$f : $Draw_Helps($f)\n\n" "highlightline" |
391 | incr startindex |
392 | set highlighted true |
393 | continue |
394 | } |
395 | .commands.t.text insert end "$f : $Draw_Helps($f)\n\n" |
396 | incr startindex |
397 | } |
398 | .commands.t.text tag configure highlightline -background yellow -relief raised |
399 | .commands.t.text configure -state disabled |
400 | if {$highlighted == true} {.commands.t.text see highlightline.last} |
401 | } |
7fd59977 |
402 | |
ab91ab6f |
403 | #Creates a "About" window |
404 | proc about {} { |
405 | toplevel .about |
406 | focus .about |
407 | wm resizable .about 0 0 |
408 | wm title .about "About" |
409 | set screenheight [expr {int([winfo screenheight .]*0.5-200)}] |
410 | set screenwidth [expr {int([winfo screenwidth .]*0.5-200)}] |
411 | wm geometry .about 400x200+$screenwidth+$screenheight |
096ef695 |
412 | |
4b3541c6 |
413 | set logopath "" |
414 | if {[array names ::env CSF_OCCTResourcePath] != "" && "$::env(CSF_OCCTResourcePath)" != "" && [file exists $::env(CSF_OCCTResourcePath)/DrawResources/OCC_logo.png]} { |
415 | set logopath "$::env(CSF_OCCTResourcePath)/DrawResources/OCC_logo.png" |
416 | } elseif {[array names ::env CASROOT] != "" && "$::env(CASROOT)" != "" && [file exists $::env(CASROOT)/src/DrawResources/OCC_logo.png]} { |
417 | set logopath "$::env(CASROOT)/src/DrawResources/OCC_logo.png" |
096ef695 |
418 | } |
419 | |
420 | image create photo occlogo -file $logopath -format png |
ab91ab6f |
421 | frame .about.logo -bg red |
422 | frame .about.links -bg blue |
423 | frame .about.copyright |
424 | pack .about.logo -side top -fill both |
425 | pack .about.links -fill both |
426 | pack .about.copyright -side top -fill both |
427 | label .about.logo.img -image occlogo |
428 | pack .about.logo.img -fill both |
429 | text .about.links.text -bg lightgray -fg blue -height 1 -width 10 |
430 | .about.links.text insert end "http://www.opencascade.com/" "link1" |
431 | .about.links.text tag bind link1 <1> "_launchBrowser http://www.opencascade.com/" |
432 | .about.links.text tag bind link1 <Enter> ".about.links.text configure -cursor hand2" |
433 | .about.links.text tag bind link1 <Leave> ".about.links.text configure -cursor arrow" |
434 | .about.links.text tag configure link1 -underline true -justify center |
435 | pack .about.links.text -fill both |
436 | label .about.copyright.text -text "Copyright (c) 1999-2014 OPEN CASCADE SAS" |
437 | button .about.button -text "OK" -command "destroy .about" |
438 | pack .about.button -padx 10 -pady 10 |
439 | pack .about.copyright.text |
440 | .about.links.text configure -state disabled |
441 | grab .about |
442 | bind .about <Return> {destroy .about} |
443 | } |
7fd59977 |
444 | |
ab91ab6f |
445 | #Executes files and hyperlinks |
446 | proc launchBrowser url { |
447 | global tcl_platform |
7fd59977 |
448 | |
ab91ab6f |
449 | if {$tcl_platform(platform) eq "windows"} { |
450 | set command [list {*}[auto_execok start] {}] |
451 | } elseif {$tcl_platform(os) eq "Darwin"} { |
452 | set command [list open] |
453 | } else { |
454 | set command [list xdg-open] |
455 | } |
456 | exec {*}$command $url & |
7fd59977 |
457 | } |
458 | |
ab91ab6f |
459 | #Safe execution of files and hyperlinks |
460 | proc _launchBrowser {url} { |
461 | if [catch {launchBrowser $url} err] { |
462 | tk_messageBox -icon error -message "error '$err' with '$command'" |
463 | } |
464 | } |
465 | ################################################################ |
466 | # This procedure tries to open an userguide on Draw Harness in pdf format |
467 | # If there is no a such one, then tries to open it in html format |
468 | # Else opens a site with this guide |
469 | ################################################################ |
470 | proc openuserguide {} { |
4b3541c6 |
471 | if { [array names ::env CSF_OCCTDocPath] != "" && "$::env(CSF_OCCTDocPath)" != "" && [file exists $::env(CSF_OCCTDocPath)/pdf/user_guides/occt_test_harness.pdf]} { |
472 | _launchBrowser $::env(CSF_OCCTDocPath)/pdf/user_guides/occt_test_harness.pdf |
473 | } elseif { [array names ::env CSF_OCCTDocPath] != "" && "$::env(CSF_OCCTDocPath)" != "" && [file exists $::env(CSF_OCCTDocPath)/overview/html/occt_user_guides__test_harness.html]} { |
474 | _launchBrowser $::env(CSF_OCCTDocPath)/overview/html/occt_user_guides__test_harness.html |
475 | } elseif { [array names ::env CASROOT] != "" && "$::env(CASROOT)" != "" && [file exists $::env(CASROOT)/doc/pdf/user_guides/occt_test_harness.pdf]} { |
096ef695 |
476 | _launchBrowser $::env(CASROOT)/doc/pdf/user_guides/occt_test_harness.pdf |
4b3541c6 |
477 | } elseif { [array names ::env CASROOT] != "" && "$::env(CASROOT)" != "" && [file exists $::env(CASROOT)/doc/overview/html/occt_user_guides__test_harness.html]} { |
096ef695 |
478 | _launchBrowser $::env(CASROOT)/doc/overview/html/occt_user_guides__test_harness.html |
ab91ab6f |
479 | } else { |
096ef695 |
480 | launchBrowser {http://dev.opencascade.org/doc/overview/html/occt_user_guides__test_harness.html} |
481 | } |
7fd59977 |
482 | } |
483 | |
ab91ab6f |
484 | #Search through commands and display the result |
485 | proc vhelpsearch {} { |
486 | global Draw_Groups Entry_Cache |
487 | set searchstring [.commands.t.top.e get] |
488 | set i 1 |
489 | set j 100 |
490 | set newgroupinx 0 |
491 | set isfound 0 |
492 | foreach h [lsort [array names Draw_Groups]] { |
493 | set newgroupinx $j |
494 | foreach f [lsort $Draw_Groups($h)] { |
495 | if {$f == $searchstring} { |
496 | incr isfound |
497 | .commands.left.tree see $j |
498 | .commands.left.tree selection set $j |
499 | vcomhelp $h $j $newgroupinx |
500 | break |
501 | } |
502 | incr j |
7fd59977 |
503 | } |
ab91ab6f |
504 | incr i |
505 | } |
506 | if {$isfound == 0} { |
507 | errorhelp "No help found for '$searchstring'!" |
508 | } else {set Entry_Cache ""} |
7fd59977 |
509 | } |
510 | |
ab91ab6f |
511 | #Displays an error window with $errstring inside |
512 | proc errorhelp {errstring} { |
513 | toplevel .errorhelp |
514 | focus .errorhelp |
515 | wm resizable .errorhelp 0 0 |
516 | wm title .errorhelp "Error" |
517 | set screenheight [expr {int([winfo screenheight .]*0.5-200)}] |
518 | set screenwidth [expr {int([winfo screenwidth .]*0.5-200)}] |
519 | wm geometry .errorhelp +$screenwidth+$screenheight |
520 | text .errorhelp.t -width 40 -height 5 |
521 | .errorhelp.t insert end $errstring |
522 | button .errorhelp.button -text "OK" -command "destroy .errorhelp" |
523 | pack .errorhelp.t |
524 | .errorhelp.t configure -state disabled |
525 | pack .errorhelp.button -padx 10 -pady 10 |
526 | bind .errorhelp <Return> {destroy .errorhelp} |
527 | grab .errorhelp |
7fd59977 |
528 | } |
529 | |
ab91ab6f |
530 | #Search through text of help and display the result |
531 | proc vhelptextsearch {} { |
532 | global Draw_Helps Draw_Groups Find_Button_Click_Count Entry_Cache End_of_Search |
533 | set searchstring [.commands.t.top.e get] |
534 | if {$Entry_Cache != $searchstring} { |
535 | set Find_Button_Click_Count 0 |
536 | set End_of_Search 0 |
537 | set Entry_Cache $searchstring |
538 | } |
539 | if {$End_of_Search} { |
540 | errorhelp "No more '$searchstring' found!" |
541 | return |
542 | } |
543 | .commands.t.text configure -state normal |
544 | .commands.t.text delete 0.0 end |
545 | set i 0 |
546 | set isfound 0 |
547 | foreach h [lsort [array names Draw_Groups]] { |
548 | foreach f [lsort $Draw_Groups($h)] { |
549 | if [string match *$searchstring* $Draw_Helps($f)] { |
550 | incr i |
551 | if {$i > $Find_Button_Click_Count+1} {incr isfound; break} |
552 | .commands.t.text insert end "$f : " |
553 | foreach line [list $Draw_Helps($f)] { |
554 | foreach word [split $line " "] { |
555 | if [string match *$searchstring* $word] { |
556 | .commands.t.text insert end "$word" "highlightword" |
557 | .commands.t.text insert end " " |
558 | continue |
559 | } |
560 | .commands.t.text insert end "$word " |
561 | } |
562 | } |
563 | .commands.t.text insert end \n\n |
564 | } |
7fd59977 |
565 | } |
ab91ab6f |
566 | } |
567 | if {!$isfound} { |
568 | incr End_of_Search |
569 | } |
570 | .commands.t.text tag configure highlightword -background yellow -relief raised |
571 | .commands.t.text see end |
7fd59977 |
572 | } |
573 | |
ab91ab6f |
574 | #Create a "System information" window |
575 | proc sysinfo {} { |
576 | toplevel .info |
577 | wm title .info "System information" |
578 | wm resizable .info 0 0 |
579 | pack [frame .info.top] -side top -fill both -padx 5 -pady 10 |
580 | pack [frame .info.bot] -side bottom -fill both -padx 5 -pady 10 |
581 | pack [frame .info.top.left] -side left -fill both -padx 5 -pady 10 |
582 | pack [frame .info.top.mid] -side left -fill both -padx 5 -pady 10 |
583 | pack [frame .info.top.right] -side left -fill both -padx 5 -pady 10 |
584 | pack [label .info.top.left.label -text "OCCT build configuration "] |
585 | pack [label .info.top.mid.label -text "Memory info"] |
586 | pack [label .info.top.right.label -text "OpenGL info"] |
587 | pack [text .info.top.left.text -width 50 -height 20] |
588 | pack [text .info.top.mid.text -width 50 -height 20] |
589 | pack [text .info.top.right.text -width 50 -height 20] |
590 | pack [button .info.bot.button -text "Update" -command rescaninfo] |
591 | pack [button .info.bot.close -text "Close" -command "destroy .info"] -pady 10 |
592 | rescaninfo |
593 | } |
594 | |
595 | #Updates information in "System information" window |
596 | proc rescaninfo {} { |
597 | .info.top.left.text configure -state normal |
598 | .info.top.mid.text configure -state normal |
599 | .info.top.right.text configure -state normal |
600 | .info.top.left.text delete 0.0 end |
601 | .info.top.mid.text delete 0.0 end |
602 | .info.top.right.text delete 0.0 end |
603 | .info.top.left.text insert end [dversion] |
604 | .info.top.mid.text insert end [meminfo] |
605 | set glinfo "" |
606 | if [catch {vglinfo} err] { |
607 | if {$err == ""} { |
608 | .info.top.right.text insert end "No active view. Please call vinit." |
609 | } else { |
610 | .info.top.right.text insert end "VISUALIZATION is not loaded. Please call pload VISUALIZATION" |
611 | } |
612 | } else { |
613 | .info.top.right.text insert end [vglinfo] |
614 | } |
615 | .info.top.left.text configure -state disabled |
616 | .info.top.mid.text configure -state disabled |
617 | .info.top.right.text configure -state disabled |
7fd59977 |
618 | } |