12dd252e15408f6a0f64570909ab4b287cca0cca
[occt.git] / src / DrawResources / DrawTK.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 # 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
30 wm geometry . +10+10
31
32 frame .mbar -relief raised -bd 2
33 pack .mbar -side top -fill x
34 focus .mbar
35
36 set theMenus("") ""
37 set Draw_MenuIndex 0
38
39 proc addmenuitem {menu options} {
40
41     global theMenus Draw_MenuIndex
42     if {![info exists theMenus($menu)]} {
43         incr Draw_MenuIndex
44         set m .mbar.m$Draw_MenuIndex.menu
45         menubutton .mbar.m$Draw_MenuIndex -text $menu -menu $m
46         pack .mbar.m$Draw_MenuIndex -side left
47         menu $m
48         set theMenus($menu) $m
49     } else {set m $theMenus($menu)}
50
51     eval $m add $options
52 }
53
54 proc addmenu {menu submenu {command ""}} {
55     if {$command == ""} {set command $submenu}
56     addmenuitem $menu "command -label $submenu -command {$command}"
57 }
58
59 #################################
60 # Menus definition
61 #################################
62
63 # the file menu
64
65 addmenu File datadir vdatadir
66 addmenu File restore vrestore
67 addmenu File source  vsource
68 addmenu File exit    
69
70 # the view menu
71
72 addmenu Views axo   {smallview AXON}
73 addmenu Views top   {smallview +X+Y}
74 addmenu Views front {smallview +X+Z}
75 addmenu Views left  {smallview +Y+Z}
76 addmenu Views 2d    {smallview -2D-}
77 addmenuitem Views   "separator"
78 addmenu Views mu4
79 addmenu Views av2d
80 addmenu Views axo
81 addmenu Views pers
82
83 # the display menu
84
85 addmenu Display fit   "fit; repaint"
86 addmenu Display 2dfit "2dfit; repaint"
87 addmenu Display clear
88 addmenu Display 2dclear
89
90
91 #################################
92 # Modal dialog box
93 # add OK, help,  cancel buttons  
94 #################################
95
96 proc modaldialog {box okproc {helpproc ""} {cancelproc ""}} {
97     wm geometry $box +10+60
98
99     button $box.ok -text ok -command "$okproc ; destroy $box"
100     pack $box.ok -side left
101     button $box.ko -text Cancel -command "$cancelproc ; destroy $box"
102     pack $box.ko -side right
103     if {$helpproc != ""} {
104         button $box.help -text Help -command $helpproc
105         pack $box.help -side right
106     }
107     grab set $box
108 }
109
110 ##############################
111 #
112 # dialbox command arg1 val1 arg2 val2 ...
113 #
114 ##############################
115
116 proc dialbox args {
117     
118     set com [lindex $args 0]
119
120     toplevel .d
121     wm title .d $com
122
123     # com will be the command
124     set com "eval $com"
125
126     # create entries for the arguments
127     set n [llength $args]
128
129     for {set i 1} {$i < $n} {incr i 2} {
130
131         frame .d.a$i
132         label .d.a$i.l -text [lindex $args $i]
133         entry .d.a$i.e -relief sunken
134         .d.a$i.e insert end [lindex $args [expr $i+1]]
135         pack .d.a$i.l -side left
136         pack .d.a$i.e -side right
137         pack .d.a$i -side top -fill x
138
139         append com { [} ".d.a$i.e get" {]}
140     }
141     append com ";repaint"
142
143     modaldialog .d $com "help [lindex $args 0]"
144 }
145
146
147 ####################################
148 # Modal get file
149 #  select a file and launch a command
150 #  - file is the original value
151 #  - okproc is the OK procedure, 
152 #    it will be called with the filename
153 #  - title is the box title
154 #  - filter is called on each subfile
155 #  - Buttons are added in the dialbox, if none it is created
156 ####################################
157
158 proc retyes {file} {return 1}
159
160 proc getfile {file okproc title {filter "retyes"} {box ""}} {
161
162     if {$box == ""} {
163         set box ".s"
164         toplevel .s
165     }
166     wm title $box $title
167
168     # The text entry at the top
169     frame  $box.d
170     entry  $box.d.e -relief sunken -width 40
171     $box.d.e insert end $file
172     button $box.d.s -text scan -command "filescan $filter $box"
173     pack   $box.d.e -side left
174     pack   $box.d.s -side right
175     pack   $box.d   -side top
176
177     # The list box with the files
178     frame $box.f
179     listbox $box.f.l -relief sunken -yscrollcommand "$box.f.s set"
180     scrollbar $box.f.s -relief sunken -command "$box.f.l yview"
181     pack $box.f.l $box.f.s -side left -fill y
182     pack $box.f -side top
183
184     filescan $filter $box
185
186     bind $box.f.l <Double-Button-1> "fileclick $box $filter $okproc"
187     
188     modaldialog $box [concat $okproc " \[" $box.d.e "get\]"]
189 }
190
191 # when double click
192 proc fileclick {box filter okproc} {
193     filescan $filter $box [selection get]
194     set f [$box.d.e get]
195     if {! [file isdirectory $f]} {
196         destroy $box
197         $okproc $f
198     }
199 }
200
201 proc filescan {filter box {subfile ""}} {
202
203     set s [$box.d.e get]
204     if {$s == "."} {set s [pwd]/}
205
206     $box.d.e delete 0 end
207     if {$subfile != ""} {
208         if {$subfile == ".."} {
209             set s [file dirname [file dirname $s]]/
210         } else {
211             set s [file dirname $s]/$subfile
212         }
213     }
214     $box.d.e insert end $s
215
216     # list directories
217     $box.f.l delete 0 end
218     $box.f.l insert end ".."
219     if [file isdirectory $s] {
220         set d $s
221         if {![string match */ $s]} {append s "/"}
222     } else {
223         set d [file dirname $s]
224     }
225     foreach f [glob -nocomplain $d/*] {
226         if [$filter $f] {
227             set x [file tail $f]
228             if [file isdirectory $f] {append x "/"}
229             $box.f.l insert end $x
230         }
231     }
232 }
233
234
235 #################################
236 # File menu procedures
237 #################################
238
239 #
240 # dialog box for datadir
241 #
242
243 proc isdir {f} {return [file isdirectory $f]}
244
245 proc sdatadir {d} {
246     global Draw_DataDir
247     set Draw_DataDir $d
248 }
249
250 proc vdatadir {} {
251     global Draw_DataDir
252     toplevel .s
253     frame .s.t
254     button .s.t.d -text data -command {
255         .s.d.e delete 0 end
256         .s.d.e insert end $env(WBCONTAINER)/data/
257         filescan isdir .s
258     }
259     pack .s.t.d -side left
260     pack .s.t -side top
261     getfile $Draw_DataDir sdatadir "Data Directory" isdir .s
262 }
263
264 proc notild {f} {return [expr ! [string match *~ $f]]}
265
266 proc rresto {f} {
267     if {! [file isdirectory $f]} {
268         uplevel \#0 "brestore $f [file tail $f]"
269         repaint
270     }
271 }
272
273 proc vrestore {} {
274     global Draw_DataDir 
275     getfile $Draw_DataDir rresto "Restore" notild
276 }
277
278
279 proc ssour {f} {
280     global Draw_Source
281     set Draw_Source $f
282     if {! [file isdirectory $f]} {
283         uplevel \#0 "source $f"
284     }
285 }
286
287 set Draw_Source [pwd]
288 proc vsource {} {
289     global Draw_Source 
290     getfile $Draw_Source  ssour "Source" notild
291 }