b311480e |
1 | # Copyright (c) 1999-2012 OPEN CASCADE SAS |
2 | # |
3 | # The content of this file is subject to the Open CASCADE Technology Public |
4 | # License Version 6.5 (the "License"). You may not use the content of this file |
5 | # except in compliance with the License. Please obtain a copy of the License |
6 | # at http://www.opencascade.org and read it completely before using this file. |
7 | # |
8 | # The Initial Developer of the Original Code is Open CASCADE S.A.S., having its |
9 | # main offices at: 1, place des Freres Montgolfier, 78280 Guyancourt, France. |
10 | # |
11 | # The Original Code and all software distributed under the License is |
12 | # distributed on an "AS IS" basis, without warranty of any kind, and the |
13 | # Initial Developer hereby disclaims all such warranties, including without |
14 | # limitation, any warranties of merchantability, fitness for a particular |
15 | # purpose or non-infringement. Please see the License for the specific terms |
16 | # and conditions governing the rights and limitations under the License. |
17 | |
7fd59977 |
18 | # |
19 | # TK features for Draw |
20 | # |
21 | |
22 | # reload bindings |
23 | if { [info exists tk_library] } { |
24 | set version [split [info tclversion] "."] |
25 | set major [lindex ${version} 0] |
26 | set minor [lindex ${version} 1] |
27 | if { (${major} > 8) || (${major} >= 8 && ${minor} >= 4) } { |
28 | #source $tk_library/tk.tcl |
29 | } else { |
30 | source $tk_library/tk.tcl |
31 | } |
32 | } |
33 | |
34 | wm geometry . +10+10 |
35 | |
36 | frame .mbar -relief raised -bd 2 |
37 | pack .mbar -side top -fill x |
38 | focus .mbar |
39 | |
40 | set theMenus("") "" |
41 | set Draw_MenuIndex 0 |
42 | |
43 | proc addmenuitem {menu options} { |
44 | |
45 | global theMenus Draw_MenuIndex |
46 | if {![info exists theMenus($menu)]} { |
47 | incr Draw_MenuIndex |
48 | set m .mbar.m$Draw_MenuIndex.menu |
49 | menubutton .mbar.m$Draw_MenuIndex -text $menu -menu $m |
50 | pack .mbar.m$Draw_MenuIndex -side left |
51 | menu $m |
52 | set theMenus($menu) $m |
53 | } else {set m $theMenus($menu)} |
54 | |
55 | eval $m add $options |
56 | } |
57 | |
58 | proc addmenu {menu submenu {command ""}} { |
59 | if {$command == ""} {set command $submenu} |
60 | addmenuitem $menu "command -label $submenu -command {$command}" |
61 | } |
62 | |
63 | ################################# |
64 | # Menus definition |
65 | ################################# |
66 | |
67 | # the file menu |
68 | |
69 | addmenu File datadir vdatadir |
70 | addmenu File restore vrestore |
71 | addmenu File source vsource |
72 | addmenu File exit |
73 | |
74 | # the view menu |
75 | |
76 | addmenu Views axo {smallview AXON} |
77 | addmenu Views top {smallview +X+Y} |
78 | addmenu Views front {smallview +X+Z} |
79 | addmenu Views left {smallview +Y+Z} |
80 | addmenu Views 2d {smallview -2D-} |
81 | addmenuitem Views "separator" |
82 | addmenu Views mu4 |
83 | addmenu Views av2d |
84 | addmenu Views axo |
85 | addmenu Views pers |
86 | |
87 | # the display menu |
88 | |
89 | addmenu Display fit "fit; repaint" |
90 | addmenu Display 2dfit "2dfit; repaint" |
91 | addmenu Display clear |
92 | addmenu Display 2dclear |
93 | |
94 | |
95 | ################################# |
96 | # Modal dialog box |
97 | # add OK, help, cancel buttons |
98 | ################################# |
99 | |
100 | proc modaldialog {box okproc {helpproc ""} {cancelproc ""}} { |
101 | wm geometry $box +10+60 |
102 | |
103 | button $box.ok -text ok -command "$okproc ; destroy $box" |
104 | pack $box.ok -side left |
105 | button $box.ko -text Cancel -command "$cancelproc ; destroy $box" |
106 | pack $box.ko -side right |
107 | if {$helpproc != ""} { |
108 | button $box.help -text Help -command $helpproc |
109 | pack $box.help -side right |
110 | } |
111 | grab set $box |
112 | } |
113 | |
114 | ############################## |
115 | # |
116 | # dialbox command arg1 val1 arg2 val2 ... |
117 | # |
118 | ############################## |
119 | |
120 | proc dialbox args { |
121 | |
122 | set com [lindex $args 0] |
123 | |
124 | toplevel .d |
125 | wm title .d $com |
126 | |
127 | # com will be the command |
128 | set com "eval $com" |
129 | |
130 | # create entries for the arguments |
131 | set n [llength $args] |
132 | |
133 | for {set i 1} {$i < $n} {incr i 2} { |
134 | |
135 | frame .d.a$i |
136 | label .d.a$i.l -text [lindex $args $i] |
137 | entry .d.a$i.e -relief sunken |
138 | .d.a$i.e insert end [lindex $args [expr $i+1]] |
139 | pack .d.a$i.l -side left |
140 | pack .d.a$i.e -side right |
141 | pack .d.a$i -side top -fill x |
142 | |
143 | append com { [} ".d.a$i.e get" {]} |
144 | } |
145 | append com ";repaint" |
146 | |
147 | modaldialog .d $com "help [lindex $args 0]" |
148 | } |
149 | |
150 | |
151 | #################################### |
152 | # Modal get file |
153 | # select a file and launch a command |
154 | # - file is the original value |
155 | # - okproc is the OK procedure, |
156 | # it will be called with the filename |
157 | # - title is the box title |
158 | # - filter is called on each subfile |
159 | # - Buttons are added in the dialbox, if none it is created |
160 | #################################### |
161 | |
162 | proc retyes {file} {return 1} |
163 | |
164 | proc getfile {file okproc title {filter "retyes"} {box ""}} { |
165 | |
166 | if {$box == ""} { |
167 | set box ".s" |
168 | toplevel .s |
169 | } |
170 | wm title $box $title |
171 | |
172 | # The text entry at the top |
173 | frame $box.d |
174 | entry $box.d.e -relief sunken -width 40 |
175 | $box.d.e insert end $file |
176 | button $box.d.s -text scan -command "filescan $filter $box" |
177 | pack $box.d.e -side left |
178 | pack $box.d.s -side right |
179 | pack $box.d -side top |
180 | |
181 | # The list box with the files |
182 | frame $box.f |
183 | listbox $box.f.l -relief sunken -yscrollcommand "$box.f.s set" |
184 | scrollbar $box.f.s -relief sunken -command "$box.f.l yview" |
185 | pack $box.f.l $box.f.s -side left -fill y |
186 | pack $box.f -side top |
187 | |
188 | filescan $filter $box |
189 | |
190 | bind $box.f.l <Double-Button-1> "fileclick $box $filter $okproc" |
191 | |
192 | modaldialog $box [concat $okproc " \[" $box.d.e "get\]"] |
193 | } |
194 | |
195 | # when double click |
196 | proc fileclick {box filter okproc} { |
197 | filescan $filter $box [selection get] |
198 | set f [$box.d.e get] |
199 | if {! [file isdirectory $f]} { |
200 | destroy $box |
201 | $okproc $f |
202 | } |
203 | } |
204 | |
205 | proc filescan {filter box {subfile ""}} { |
206 | |
207 | set s [$box.d.e get] |
208 | if {$s == "."} {set s [pwd]/} |
209 | |
210 | $box.d.e delete 0 end |
211 | if {$subfile != ""} { |
212 | if {$subfile == ".."} { |
213 | set s [file dirname [file dirname $s]]/ |
214 | } else { |
215 | set s [file dirname $s]/$subfile |
216 | } |
217 | } |
218 | $box.d.e insert end $s |
219 | |
220 | # list directories |
221 | $box.f.l delete 0 end |
222 | $box.f.l insert end ".." |
223 | if [file isdirectory $s] { |
224 | set d $s |
225 | if {![string match */ $s]} {append s "/"} |
226 | } else { |
227 | set d [file dirname $s] |
228 | } |
229 | foreach f [glob -nocomplain $d/*] { |
230 | if [$filter $f] { |
231 | set x [file tail $f] |
232 | if [file isdirectory $f] {append x "/"} |
233 | $box.f.l insert end $x |
234 | } |
235 | } |
236 | } |
237 | |
238 | |
239 | ################################# |
240 | # File menu procedures |
241 | ################################# |
242 | |
243 | # |
244 | # dialog box for datadir |
245 | # |
246 | |
247 | proc isdir {f} {return [file isdirectory $f]} |
248 | |
249 | proc sdatadir {d} { |
250 | global Draw_DataDir |
251 | set Draw_DataDir $d |
252 | } |
253 | |
254 | proc vdatadir {} { |
255 | global Draw_DataDir |
256 | toplevel .s |
257 | frame .s.t |
258 | button .s.t.d -text data -command { |
259 | .s.d.e delete 0 end |
260 | .s.d.e insert end $env(WBCONTAINER)/data/ |
261 | filescan isdir .s |
262 | } |
263 | pack .s.t.d -side left |
264 | pack .s.t -side top |
265 | getfile $Draw_DataDir sdatadir "Data Directory" isdir .s |
266 | } |
267 | |
268 | proc notild {f} {return [expr ! [string match *~ $f]]} |
269 | |
270 | proc rresto {f} { |
271 | if {! [file isdirectory $f]} { |
272 | uplevel \#0 "brestore $f [file tail $f]" |
273 | repaint |
274 | } |
275 | } |
276 | |
277 | proc vrestore {} { |
278 | global Draw_DataDir |
279 | getfile $Draw_DataDir rresto "Restore" notild |
280 | } |
281 | |
282 | |
283 | proc ssour {f} { |
284 | global Draw_Source |
285 | set Draw_Source $f |
286 | if {! [file isdirectory $f]} { |
287 | uplevel \#0 "source $f" |
288 | } |
289 | } |
290 | |
291 | set Draw_Source [pwd] |
292 | proc vsource {} { |
293 | global Draw_Source |
294 | getfile $Draw_Source ssour "Source" notild |
295 | } |