871016ba619de4b1a216150f901a40c35761b85d
[scilab.git] / scilab / modules / graphics / tcl / ged / Figure.tcl
1 # Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
2 # Copyright (C) 2004 - INRIA - Fabrice Leray
3 # Copyright (C) 2006 - INRIA - Jean-Baptiste Silvy
4 #
5 # This file must be used under the terms of the CeCILL.
6 # This source file is licensed as described in the file COPYING, which
7 # you should have received as part of this distribution.  The terms
8 # are also available at    
9 # http://www.cecill.info/licences/Licence_CeCILL_V2.1-en.txt
10
11
12 set pwd [pwd]
13 cd [file dirname [info script]]
14 variable DEMODIR [pwd]
15 cd $pwd
16
17 variable DEMODIR2i
18
19 lappend ::auto_path [file dirname  "$env(SCIPATH)/modules/tclsci/tcl/BWidget"]
20 namespace inscope :: package require BWidget
21 package require BWidget
22
23 set sourcedir [file join "$env(SCIPATH)" "modules" "tclsci" "tcl" "utils"]
24 set sourcedir2 [file join "$env(SCIPATH)" "modules" "graphics" "tcl" "ged"]
25
26
27 source [file join $sourcedir Notebook.tcl]
28 source [file join $sourcedir Combobox.tcl]
29 source [file join $sourcedir Balloon.tcl]
30 source [file join $sourcedir2 ObjectsBrowser.tcl]
31
32
33
34
35 package require combobox 2.3
36 catch {namespace import combobox::*}
37
38 #package require lemonTree
39 catch {namespace import LemonTree::*}
40
41
42
43 global envSCIHOME MAIN_WINDOW_POSITION TICK_WINDOW_POSITION msdos
44 set ged_listofpref "MAIN_WINDOW_POSITION TICK_WINDOW_POSITION"
45 set MAIN_WINDOW_POSITION "+0+0"
46 set TICK_WINDOW_POSITION "+0+0"
47
48 set envSCIHOME $SCIHOME
49 set preffilename $envSCIHOME/.GedPreferences.tcl
50 catch {source $preffilename}
51
52 global SELOBJECT
53 global ged_handle_list_size
54 global lalist
55 global curgedindex
56 global curgedobject
57
58
59 global RED BLUE GREEN
60 global figure_name figure_id background figure_xposition figure_yposition
61 global figure_xsiz figure_ysiz figure_xaxesiz figure_yaxesiz
62 global curvis
63 global ncolors
64 global curpix curpdm currotation_style
65
66 global scicomint_colormap
67 global smallPad mediumPad
68
69
70 #To update foreground color grey ("off"), black ("on") for checkbutton boxes
71 proc OnOffForeground { frame flag } {
72     
73     if { $flag == "on" } {
74         $frame configure -foreground black
75     } else {
76         $frame configure -foreground grey
77     }
78 }
79
80 set NBheight 395
81 set NBwidth  330
82
83 set Wheight [expr $NBheight + 120]
84 set Wwidth  [expr $NBwidth  + 265]
85
86 set smallPad  4
87 set mediumPad 8
88
89 #create the font we will use
90 set gedFont {Arial -12}
91
92 set ww .axes
93 catch {destroy $ww}
94 toplevel $ww
95 wm title $ww "Figure Editor"
96 wm iconname $ww "FE"
97 wm geometry $ww [expr $Wwidth]x[expr $Wheight]$MAIN_WINDOW_POSITION
98 wm maxsize  $ww $Wwidth $Wheight
99 wm protocol $ww WM_DELETE_WINDOW "DestroyGlobals; destroy $ww "
100
101
102 set topf  [frame $ww.topf]
103 set titf1 [TitleFrame $topf.titf1 -text "Graphic Editor" -font $gedFont]
104
105 set parent  [$titf1 getframe]
106 set pw1  [PanedWindow $parent.pw -side top]
107 set pane3  $pw1  
108
109
110 # Make a frame scrollable
111
112 set sw [ScrolledWindow $pane3.sw -relief sunken -borderwidth 2]
113 # pack $sw -in .sw -fill both -expand true 
114 set sf [ScrollableFrame $sw.f]
115 $sw setwidget $sf
116 set uf [$sf getframe]
117
118
119
120 set w $uf
121 set fra [frame $w.frame -borderwidth 0]
122 pack $fra  -anchor w -fill both
123
124
125 #------------------------------------------------
126
127 set theframe $fra
128
129 #adding 15.06.2005
130 set topflabel  [frame $theframe.topflabel]
131 set titf1label [TitleFrame $topflabel.titflabel1 -text "Objects Browser" -font $gedFont]
132 set titf1axes  [TitleFrame $topflabel.titfaxes1 -text "Object Properties" -font $gedFont]
133
134 set w [$titf1label getframe]
135
136 pack $titf1label -padx 4 -side left -fill both -expand yes
137 pack $topflabel -fill x -pady 0
138 pack $titf1axes  -pady 0 -padx 4 -fill both -expand yes
139
140 frame $w.frame -borderwidth 0
141 pack $w.frame -anchor w -fill both
142 #end adding
143
144 # The variable wfortree create an error in the combobox
145 # : "Error: can't read "wfortree": no such variable"
146 # The reason of the bug has nor been found but it is certainly in
147 # Combobox.tcl (with no combobox in the note book, no error)
148 # This bug only occurs under windows. However the result is OK. 
149 set wfortree $w
150
151 for {set i 1} {$i<=$ged_handle_list_size} {incr i} { 
152     set OBJECTSARRAY($i) $SELOBJECT($i)
153 }
154
155 set curgedobject $SELOBJECT($curgedindex)
156
157 set tree  [Tree $wfortree.tree \
158                -yscrollcommand {$wfortree.y set} -xscrollcommand {$wfortree.x set} \
159                -width 20 -height 10 \
160                -background white -opencmd {LemonTree::open $wfortree.tree} \
161                -selectbackground blue -selectforeground white ]
162
163 pack [scrollbar $wfortree.x -orient horiz -command {$wfortree.tree xview}] -side bottom -fill x
164 pack [scrollbar $wfortree.y -command {$wfortree.tree yview}] -side right -fill y
165 pack $tree -fill both -expand 1 -side left
166
167 $tree bindText  <1> {LemonTree::Info $tree}
168 $tree bindImage <1> {LemonTree::Info $tree}
169
170 LemonTree::add $tree root FIGURE    currentfigure  "Figure(1)"
171
172 # I open the tree to browse all the nodes (to know what nodes I have and what their names are)
173 $tree opentree n1
174
175 set allnodes [$tree selection get]
176
177 #I close quickly the tree because openreeatnode expanded the tree...
178 $tree closetree n1
179
180
181 # I directly point onto the current curgedobject (current Axes or Figure or picked entity)
182 LemonTree::finddata $tree $allnodes $curgedobject
183
184
185 #adding 15.06.2005
186 set w [$titf1axes getframe]
187
188 set uf $w
189 #------------------------------------------------
190
191 set largeur 14
192
193 Notebook:create  $uf.n -pages {Style Mode Colormap} -pad 0   -height $NBheight -width $NBwidth
194 pack  $uf.n -fill both -expand 1
195
196 ########### Style onglet ##########################################
197 ###################################################################
198 set w [Notebook:frame  $uf.n Style]
199
200 frame $w.frame -borderwidth 0
201 pack $w.frame -anchor w -fill both
202
203 #visibility
204 frame $w.frame.vis -borderwidth 0
205 pack $w.frame.vis  -in $w.frame  -side top -fill x
206 label $w.frame.vislabel  -text "Visibility:" -font $gedFont -anchor e -width $largeur
207 checkbutton $w.frame.visib  -text "on"\
208     -variable curvis  -onvalue "on" -offvalue "off" \
209     -command "toggleVis $w.frame.visib" -font $gedFont
210 OnOffForeground $w.frame.visib $curvis
211
212 pack $w.frame.vislabel -in $w.frame.vis  -side left
213 pack $w.frame.visib  -in $w.frame.vis    -side left -fill x -pady 0 -padx $smallPad
214
215
216 #figure label
217 frame $w.frame.lbfig -borderwidth 0
218 pack $w.frame.lbfig  -in $w.frame -side top   -fill x
219
220 label $w.frame.figlabel -text " Figure name:" -font $gedFont -anchor e -width $largeur
221 entry $w.frame.figlabel1 -relief sunken  -textvariable figure_name -font $gedFont -width 15
222 pack $w.frame.figlabel -in  $w.frame.lbfig -side left
223 pack $w.frame.figlabel1  -in  $w.frame.lbfig  -expand 1 -fill x -pady 0 -padx $mediumPad
224 bind  $w.frame.figlabel1 <Return> {setFiglabel} 
225 bind  $w.frame.figlabel1 <KP_Enter> {setFiglabel} 
226 bind  $w.frame.figlabel1 <FocusOut> {setFiglabel} 
227
228 #figure id
229 #label tout court non modifiable
230 frame $w.frame.lbfigid -borderwidth 0
231 pack $w.frame.lbfigid  -in $w.frame -side top   -fill x
232
233 label $w.frame.figidlabel -text "Figure id:" -font $gedFont -anchor e -width $largeur
234 label $w.frame.figidlabel1 -textvariable figure_id -font $gedFont -anchor e
235 pack $w.frame.figidlabel  -in  $w.frame.lbfigid -side left
236 pack $w.frame.figidlabel1 -in  $w.frame.lbfigid -side left -pady 0 -padx $smallPad
237
238 #figure position x
239 frame $w.frame.xfigpos -borderwidth 0
240 pack $w.frame.xfigpos  -in $w.frame -side top   -fill x
241
242 label $w.frame.xfigposlabel -text " X position:" -font $gedFont -anchor e -width $largeur
243 entry $w.frame.xfigposlabel1 -relief sunken  -textvariable figure_xposition -font $gedFont -width 10
244 pack $w.frame.xfigposlabel -in  $w.frame.xfigpos -side left
245 pack $w.frame.xfigposlabel1  -in  $w.frame.xfigpos   -pady 0 -padx $mediumPad -side left 
246 bind  $w.frame.xfigposlabel1 <Return> {setFigPos} 
247 bind  $w.frame.xfigposlabel1 <KP_Enter> {setFigPos} 
248 bind  $w.frame.xfigposlabel1 <FocusOut> {setFigPos} 
249
250 #figure position y
251 frame $w.frame.yfigpos -borderwidth 0
252 pack $w.frame.yfigpos  -in $w.frame -side top   -fill x
253
254 label $w.frame.yfigposlabel -text "Y position:" -font $gedFont -anchor e -width $largeur
255 entry $w.frame.yfigposlabel1 -relief sunken  -textvariable figure_yposition -font $gedFont -width 10
256 pack $w.frame.yfigposlabel -in  $w.frame.yfigpos -side left
257 pack $w.frame.yfigposlabel1  -in  $w.frame.yfigpos  -pady 0 -padx $mediumPad -side left 
258 bind  $w.frame.yfigposlabel1 <Return> {setFigPos} 
259 bind  $w.frame.yfigposlabel1 <KP_Enter> {setFigPos} 
260 bind  $w.frame.yfigposlabel1 <FocusOut> {setFigPos} 
261
262 #figure size x
263 frame $w.frame.xfigsiz -borderwidth 0
264 pack $w.frame.xfigsiz  -in $w.frame -side top   -fill x
265
266 label $w.frame.xfigsizlabel -text "X size:" -font $gedFont -anchor e -width $largeur
267 entry $w.frame.xfigsizlabel1 -relief sunken  -textvariable figure_xsiz -font $gedFont -width 10
268 pack $w.frame.xfigsizlabel -in  $w.frame.xfigsiz -side left
269 pack $w.frame.xfigsizlabel1  -in  $w.frame.xfigsiz  -pady 0 -padx $mediumPad -side left 
270 bind  $w.frame.xfigsizlabel1 <Return> {setFigSiz} 
271 bind  $w.frame.xfigsizlabel1 <KP_Enter> {setFigSiz} 
272 bind  $w.frame.xfigsizlabel1 <FocusOut> {setFigSiz} 
273
274 #figure size y
275 frame $w.frame.yfigsiz -borderwidth 0
276 pack $w.frame.yfigsiz  -in $w.frame -side top   -fill x
277
278 label $w.frame.yfigsizlabel -text "Y size:" -font $gedFont -anchor e -width $largeur
279 entry $w.frame.yfigsizlabel1 -relief sunken  -textvariable figure_ysiz -font $gedFont -width 10
280 pack $w.frame.yfigsizlabel -in  $w.frame.yfigsiz -side left
281 pack $w.frame.yfigsizlabel1  -in  $w.frame.yfigsiz  -pady 0 -padx $mediumPad -side left 
282 bind  $w.frame.yfigsizlabel1 <Return> {setFigSiz} 
283 bind  $w.frame.yfigsizlabel1 <KP_Enter> {setFigSiz} 
284 bind  $w.frame.yfigsizlabel1 <FocusOut> {setFigSiz} 
285
286 #axes size x
287 frame $w.frame.xaxesiz -borderwidth 0
288 pack $w.frame.xaxesiz  -in $w.frame -side top   -fill x
289
290 label $w.frame.xaxesizlabel -text "X axis size:" -font $gedFont -anchor e -width $largeur
291 entry $w.frame.xaxesizlabel1 -relief sunken  -textvariable figure_xaxesiz -font $gedFont -width 10
292 pack $w.frame.xaxesizlabel -in  $w.frame.xaxesiz -side left
293 pack $w.frame.xaxesizlabel1  -in  $w.frame.xaxesiz  -pady 0 -padx $mediumPad -side left 
294 bind  $w.frame.xaxesizlabel1 <Return> {setAxeSiz} 
295 bind  $w.frame.xaxesizlabel1 <KP_Enter> {setAxeSiz} 
296 bind  $w.frame.xaxesizlabel1 <FocusOut> {setAxeSiz} 
297
298 #axes size y
299 frame $w.frame.yaxesiz -borderwidth 0
300 pack $w.frame.yaxesiz  -in $w.frame -side top   -fill x
301
302 label $w.frame.yaxesizlabel -text "Y axis size:" -font $gedFont -anchor e -width $largeur
303 entry $w.frame.yaxesizlabel1 -relief sunken  -textvariable figure_yaxesiz -font $gedFont -width 10
304 pack $w.frame.yaxesizlabel -in  $w.frame.yaxesiz -side left
305 pack $w.frame.yaxesizlabel1  -in  $w.frame.yaxesiz  -pady 0 -padx $mediumPad -side left 
306 bind  $w.frame.yaxesizlabel1 <Return> {setAxeSiz} 
307 bind  $w.frame.yaxesizlabel1 <KP_Enter> {setAxeSiz} 
308 bind  $w.frame.yaxesizlabel1 <FocusOut> {setAxeSiz} 
309
310 #Color scale background
311 frame $w.frame.clrb  -borderwidth 0
312 pack $w.frame.clrb  -in $w.frame -side top  -fill x
313 label $w.frame.bcolorlabel -height 0 -text "Back. color:" -width 0  -font $gedFont -anchor e -width $largeur
314
315 scale $w.frame.bcolor -orient horizontal -from -2 -to $ncolors \
316          -resolution 1.0 -command "setBackColor $w.frame.bcolor" -tickinterval 0 -font $gedFont
317
318 pack $w.frame.bcolorlabel -in $w.frame.clrb -side left
319 pack $w.frame.bcolor -in  $w.frame.clrb -side left  -expand 1 -fill x -pady 0 -padx $smallPad
320 $w.frame.bcolor set $bcolor
321
322 #sep bar
323 frame $w.sep -height 2 -borderwidth 1 -relief sunken
324 pack $w.sep -fill both
325
326 #exit button
327 frame $w.buttons
328 pack $w.buttons -side bottom -fill x -pady 0
329 button $w.buttons.dismiss -text Quit -command "DestroyGlobals; destroy $ww"  -font $gedFont
330 pack $w.buttons.dismiss  -side top
331
332
333 ########### Mode onglet ###########################################
334 ###################################################################
335 set w [Notebook:frame  $uf.n Mode]
336
337 frame $w.frame -borderwidth 0
338 pack $w.frame -anchor w -fill both
339
340 #update largeur
341 set largeur 18
342
343 #auto resize
344 frame $w.frame.autorsz -borderwidth 0
345 pack $w.frame.autorsz  -in $w.frame  -side top -fill x
346 label $w.frame.autorszlabel  -text "Auto resize:" -font $gedFont -anchor e -width $largeur
347 checkbutton $w.frame.autorszib  -text "on"\
348     -variable curautoresize -onvalue "on" -offvalue "off" \
349     -command "toggleResize $w.frame.autorszib" -font $gedFont
350 OnOffForeground $w.frame.autorszib $curautoresize
351
352 pack $w.frame.autorszlabel -in $w.frame.autorsz  -side left
353 pack $w.frame.autorszib  -in $w.frame.autorsz    -side left -fill x -pady 0 -padx $smallPad
354
355
356 #pixmap
357 frame $w.frame.pix -borderwidth 0
358 pack $w.frame.pix  -in $w.frame  -side top -fill x
359 label $w.frame.pixlabel  -text "Pixmap:" -font $gedFont -anchor e -width $largeur
360 checkbutton $w.frame.pixib  -text "on"\
361     -variable curpix  -onvalue "on" -offvalue "off" \
362     -command "togglePix $w.frame.pixib" -font $gedFont
363 OnOffForeground $w.frame.pixib $curpix
364
365 pack $w.frame.pixlabel -in $w.frame.pix  -side left
366 pack $w.frame.pixib  -in $w.frame.pix    -side left -fill x -pady 0 -padx $smallPad
367
368
369 #pixel drawing mode
370 frame $w.frame.pixel  -borderwidth 0
371 pack $w.frame.pixel  -in $w.frame -side top -fill x
372
373 label $w.frame.pixdmodelbl  -height 0 -text "Pixel drawing mode:" -width 0  -font $gedFont -anchor e -width $largeur
374 combobox $w.frame.pixdmode \
375     -borderwidth 1 \
376     -highlightthickness 1 \
377     -maxheight 0 \
378     -width 3 \
379     -textvariable curpdm \
380     -editable false \
381     -command [list SelectPixelDrawingMode] -font $gedFont
382 eval $w.frame.pixdmode list insert end [list "clear" "and" "andReverse"  "copy" "andInverted"  "noop"  "xor"  "or"  "nor"  "equiv"  "invert"  "orReverse"  "copyInverted"  "orInverted"  "nand"  "set" ]
383
384 pack $w.frame.pixdmodelbl -in $w.frame.pixel   -side left
385 pack $w.frame.pixdmode -in $w.frame.pixel  -expand 1 -fill x -pady 0 -padx $mediumPad
386
387
388 #rotation style
389 frame $w.frame.rotstyle  -borderwidth 0
390 pack $w.frame.rotstyle  -in $w.frame -side top -fill x
391
392 label $w.frame.rotstylelbl  -height 0 -text "Rotation style:" -width 0  -font $gedFont -anchor e -width $largeur
393 combobox $w.frame.rotstyl \
394     -borderwidth 1 \
395     -highlightthickness 1 \
396     -maxheight 0 \
397     -width 3 \
398     -textvariable currotation_style \
399     -editable false \
400     -command [list SelectRotationStyle] -font $gedFont
401 eval $w.frame.rotstyl list insert end [list "unary" "multiple"]
402
403 pack $w.frame.rotstylelbl -in $w.frame.rotstyle   -side left
404 pack $w.frame.rotstyl -in $w.frame.rotstyle  -expand 1 -fill x -pady 0 -padx $mediumPad
405
406 #sep bar
407 frame $w.sep -height 2 -borderwidth 1 -relief sunken
408 pack $w.sep -fill both
409
410 #exit button
411 frame $w.buttons
412 pack $w.buttons -side bottom -fill x
413 button $w.buttons.dismiss -text Quit -command "DestroyGlobals; destroy $ww"  -font $gedFont
414 pack $w.buttons.dismiss  -side bottom
415
416
417 ########### Colormap onglet #######################################
418 ###################################################################
419 set w [Notebook:frame  $uf.n Colormap]
420
421 frame $w.frame -borderwidth 0
422 pack $w.frame -anchor w -fill both
423
424
425 frame $w.frame.fdata -borderwidth 0
426 pack $w.frame.fdata  -in $w.frame -side top   -fill x
427
428 scrollbar $w.frame.ysbar -orient vertical -command   {$w.frame.c yview}
429 #canvas $w.frame.c -width 8i -height 3i  -yscrollcommand {$w.frame.ysbar set}
430 canvas $w.frame.c -width 310 -height 265 -yscrollcommand {$w.frame.ysbar set}
431
432 $w.frame.c create text 70 10 -anchor c -text "RED" -font $gedFont
433 $w.frame.c create text 150 10 -anchor c -text "GREEN" -font $gedFont
434 $w.frame.c create text 230 10 -anchor c -text "BLUE" -font $gedFont
435
436 for {set i 1} {$i<=$ncolors} {incr i} {
437     set bb [expr 10+(25*$i)]
438     $w.frame.c create text 10 $bb -anchor c -text $i -font $gedFont
439 #RED
440     set aa 70
441     entry  $w.frame.c.reddata$i  -relief sunken  -textvariable RED($i) -width 10 -font $gedFont
442     bind  $w.frame.c.reddata$i <Return> "setRedColor $w $i "
443     bind  $w.frame.c.reddata$i <KP_Enter> "setRedColor $w $i "
444     bind  $w.frame.c.reddata$i <FocusOut> "setRedColor $w $i "
445 #location help balloon
446     set_balloon $w.frame.c.reddata$i "Row: $i Column: 1"
447     $w.frame.c create window $aa $bb -anchor c -window $w.frame.c.reddata$i
448
449 #GREEN
450     set aa 150
451     entry  $w.frame.c.gredata$i  -relief sunken  -textvariable GREEN($i) -width 10 -font $gedFont
452     bind  $w.frame.c.gredata$i <Return> "setGreenColor $w $i "
453     bind  $w.frame.c.gredata$i <KP_Enter> "setGreenColor $w $i "
454     bind  $w.frame.c.gredata$i <FocusOut> "setGreenColor $w $i "
455 #location help balloon  
456 #location help balloon  
457     set_balloon $w.frame.c.gredata$i "Row: $i Column: 2"
458     $w.frame.c create window $aa $bb -anchor c -window $w.frame.c.gredata$i
459
460 #BLUE
461     set aa 230
462     entry  $w.frame.c.bludata$i  -relief sunken  -textvariable BLUE($i) -width 10 -font $gedFont
463     bind  $w.frame.c.bludata$i <Return> "setBlueColor  $w $i "
464     bind  $w.frame.c.bludata$i <KP_Enter> "setBlueColor  $w $i "
465     bind  $w.frame.c.bludata$i <FocusOut> "setBlueColor  $w $i "
466 #location help balloon  
467     set_balloon $w.frame.c.bludata$i "Row: $i Column: 3"
468     $w.frame.c create window $aa $bb -anchor c -window $w.frame.c.bludata$i
469     
470 #sample
471     set REDC $RED($i) 
472     set GREC $GREEN($i) 
473     set BLUC $BLUE($i) 
474     
475     set color [format \#%02x%02x%02x [expr int($REDC*255)]  [expr int($GREC*255)]  [expr int($BLUC*255)]]
476     set aa 280
477     $w.frame.c create rectangle $aa [expr $bb-10] [expr $aa+20] [expr $bb+10] -fill $color
478
479 }
480
481 $w.frame.c configure -scrollregion [$w.frame.c bbox all] -yscrollincrement 0.1i
482
483 pack  $w.frame.ysbar -side right -fill y
484 pack  $w.frame.c
485
486
487 frame $w.scicom1
488 pack $w.scicom1 -side top -fill x -pady 0
489
490 label $w.scicom1.label1 -text "Scilab Command Interface for colormap:" -font $gedFont
491 pack  $w.scicom1.label1 -in $w.scicom1 -side left
492
493 frame $w.scicom
494 pack $w.scicom -side top -fill x -pady 0
495
496
497 label $w.scicom.label1 -text "Colormap (Nx3 double array) = " -font $gedFont
498 pack  $w.scicom.label1 -in $w.scicom -side left
499
500 #text $w.scicom.text1 -height 3m -width 50 -relief sunken -yscrollcommand "$w.scicom.scroll set"
501 entry $w.scicom.text1 -relief sunken -textvariable scicomint_colormap -width 10 -font $gedFont
502 set_balloon $w.scicom.text1 "Enter a graycolormap(COLOR_NUMBER), hotcolormap(COLOR_NUMBER)\n or jetcolormap(COLOR_NUMBER) call to initialize the \"colormap\" field."
503 bind  $w.scicom.text1 <Return> "sciCommandColormap"
504 bind  $w.scicom.text1 <KP_Enter> "sciCommandColormap"
505
506 pack $w.scicom.text1  -side left -fill both -expand yes
507
508 #sep bar
509 frame $w.sep -height 2 -borderwidth 1 -relief sunken
510 pack $w.sep -fill both
511
512 #exit button
513 frame $w.buttons
514 #pack $w.buttons -side bottom -fill x -pady $mediumPad
515 button $w.dismiss -text Quit -command "DestroyGlobals; destroy $ww"  -font $gedFont
516 pack $w.dismiss  -side bottom
517
518
519 pack $sw $pw1 -fill both -expand yes
520 pack $titf1 -padx 4 -side left -fill both -expand yes
521 pack $topf -fill both -pady 2 -expand yes
522
523
524
525 proc setFiglabel {} {
526 global figure_name
527 ScilabEval "global ged_handle;ged_handle.figure_name='$figure_name'"
528 }
529
530
531 proc toggleVis { frame } {
532     global curvis
533     ScilabEval "global ged_handle;ged_handle.visible='$curvis'"
534
535     OnOffForeground $frame $curvis
536 }
537
538
539 proc setFigPos {} {
540 global figure_yposition
541 global figure_xposition
542 ScilabEval "global ged_handle;ged_handle.figure_position=\[$figure_xposition , $figure_yposition\]"
543 }
544
545 proc setFigSiz {} {
546 global figure_xsiz
547 global figure_ysiz
548 ScilabEval "global ged_handle;ged_handle.figure_size=\[$figure_xsiz , $figure_ysiz\]"
549 }
550
551
552 proc setAxeSiz {} {
553 global figure_xaxesiz
554 global figure_yaxesiz
555 ScilabEval "global ged_handle;ged_handle.axes_size=\[$figure_xaxesiz , $figure_yaxesiz\]"
556 }
557
558 proc setBackColor {w index} {  
559     global RED BLUE GREEN
560     variable REDCOL 
561     variable GRECOL 
562     variable BLUCOL
563     
564     #ScilabEval "global ged_handle;"
565     if { $index == -2 } {
566         ScilabEval "global ged_handle; if ged_handle.background <> $index then ged_handle.background=$index; end;"
567         #like $index==-2: display white color
568         set color [format \#%02x%02x%02x 255 255 255]
569         $w config  -activebackground $color -troughcolor $color
570     } elseif { $index == -1 } {
571         ScilabEval "global ged_handle; if ged_handle.background <> $index then ged_handle.background=$index; end;"
572         #like $index==-1: display black color
573         set color [format \#%02x%02x%02x 0 0 0]
574         $w config  -activebackground $color -troughcolor $color
575     } elseif { $index == 0 } {
576         ScilabEval "global ged_handle; if ged_handle.background <> $index then ged_handle.background=$index; end;"
577         #like $index==1: display first color
578         set REDCOL $RED(1) 
579         set GRECOL $GREEN(1) 
580         set BLUCOL $BLUE(1) 
581         
582         set color [format \#%02x%02x%02x [expr int($REDCOL*255)]  [expr int($GRECOL*255)]  [expr int($BLUCOL*255)]]
583         $w config  -activebackground $color -troughcolor $color
584     } else { 
585         ScilabEval "global ged_handle; if ged_handle.background <> $index then ged_handle.background=$index; end;"
586         
587         set REDCOL $RED($index) 
588         set GRECOL $GREEN($index) 
589         set BLUCOL $BLUE($index) 
590
591         set color [format \#%02x%02x%02x [expr int($REDCOL*255)]  [expr int($GRECOL*255)]  [expr int($BLUCOL*255)]]
592
593         $w config  -activebackground $color -troughcolor $color
594         
595     }
596 }
597
598
599
600 proc togglePix { frame } {
601     global curpix
602     ScilabEval "global ged_handle;ged_handle.pixmap='$curpix'"
603
604     OnOffForeground $frame $curpix
605 }
606
607 proc toggleResize { frame } {
608     global curautoresize
609     ScilabEval "global ged_handle;ged_handle.auto_resize='$curautoresize'"
610
611     OnOffForeground $frame $curautoresize
612 }
613
614
615 proc SelectPixelDrawingMode {w args} {
616 global curpdm
617 ScilabEval "global ged_handle; ged_handle.pixel_drawing_mode ='$curpdm'"
618 }
619
620
621 proc SelectRotationStyle {w args} {
622 global currotation_style
623 ScilabEval "global ged_handle; ged_handle.rotation_style ='$currotation_style'"
624 }
625
626
627 proc setRedColor { w i } {
628     global RED GREEN BLUE
629     variable REDC GREC BLUC color aa bb
630     ScilabEval "execstr(\"global ged_handle; ged_handle.color_map($i,1)=$RED($i);\",\'errcatch\',\'n\');"
631     set REDC $RED($i) 
632     set GREC $GREEN($i) 
633     set BLUC $BLUE($i) 
634     set bb [expr 10+(25*$i)]
635     set color [format \#%02x%02x%02x [expr int($REDC*255)]  [expr int($GREC*255)]  [expr int($BLUC*255)]]
636     set aa [expr 10+(4*150) - 60]
637     $w.frame.c create rectangle $aa [expr $bb-10] [expr $aa+20] [expr $bb+10] -fill $color
638
639 }
640
641
642 proc setGreenColor { w i } {
643     global RED GREEN BLUE
644     variable REDC GREC BLUC color aa bb
645     ScilabEval "execstr(\"global ged_handle; ged_handle.color_map($i,2)=$GREEN($i);\",\'errcatch\',\'n\');"
646     set REDC $RED($i) 
647     set GREC $GREEN($i) 
648     set BLUC $BLUE($i) 
649     set bb [expr 10+(25*$i)]
650     set color [format \#%02x%02x%02x [expr int($REDC*255)]  [expr int($GREC*255)]  [expr int($BLUC*255)]]
651     set aa [expr 10+(4*150) - 60]
652     $w.frame.c create rectangle $aa [expr $bb-10] [expr $aa+20] [expr $bb+10] -fill $color
653 }
654
655
656 proc setBlueColor { w i } {
657     global RED GREEN BLUE
658     variable REDC GREC BLUC color aa bb
659     ScilabEval "execstr(\"global ged_handle; ged_handle.color_map($i,3)=$BLUE($i);\",\'errcatch\',\'n\');"
660     set REDC $RED($i) 
661     set GREC $GREEN($i) 
662     set BLUC $BLUE($i) 
663     set bb [expr 10+(25*$i)]
664     set color [format \#%02x%02x%02x [expr int($REDC*255)]  [expr int($GREC*255)]  [expr int($BLUC*255)]]
665     set aa [expr 10+(4*150) - 60]
666     $w.frame.c create rectangle $aa [expr $bb-10] [expr $aa+20] [expr $bb+10] -fill $color
667 }
668
669
670 proc sciCommandColormap {} {
671     global scicomint_colormap
672
673     set longueur [expr [string length $scicomint_colormap]]
674     
675     if { $longueur == 0 } {
676         tk_messageBox -icon error -type ok -title "Incorrect input" -message "You must specify an entry (such as graycolormap(COLOR_NUMBER), hotcolormap(COLOR_NUMBER) or jetcolormap(COLOR_NUMBER) or...) to initialize the \"colormap\" field."
677     } else {
678         
679         ScilabEval "global ged_handle;ged_handle.color_map=$scicomint_colormap;" "seq"
680         #Refresh now !
681         ScilabEval "tkged();" "seq"
682     }
683 }
684
685
686 proc SavePreferences { } {
687     global ged_listofpref
688     global envSCIHOME MAIN_WINDOW_POSITION TICK_WINDOW_POSITION
689     global ww msdos
690     
691     ScilabEval "DestroyGlobals()" "seq"
692         
693     if { $msdos == "F" } {
694 #unix mandrake (at least) needs this offset
695 #test other unix distribution to see (red hat, suse...)
696         set xoffset -5
697         set yoffset -26
698     } else {
699         set xoffset 0
700         set yoffset 0
701     }
702     
703     set x [eval {winfo x $ww}]
704     set y [eval {winfo y $ww}]
705     set MAIN_WINDOW_POSITION "+[expr $x+$xoffset]+[expr $y+$yoffset]"
706     
707     #save preferences (position...)
708     set preffilename [file join $envSCIHOME .GedPreferences.tcl]
709     catch {
710         set preffile [open $preffilename w]
711         foreach opt $ged_listofpref {
712             global $opt
713             puts $preffile [concat "set $opt " [set $opt]]
714             #       puts [concat "set $opt" [set $opt]]
715         }
716         close $preffile
717     }
718 }
719
720 proc DestroyGlobals { } {
721     ScilabEval "DestroyGlobals()" "seq"
722
723     SavePreferences
724 }