1# Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
2# Copyright (C) 2004 - INRIA - Fabrice Leray
3#
4# Copyright (C) 2012 - 2016 - Scilab Enterprises
5#
6# This file is hereby licensed under the terms of the GNU GPL v2.0,
7# pursuant to article 5.3.4 of the CeCILL v.2.1.
8# This file was originally licensed under the terms of the CeCILL v2.1,
9# and continues to be available under such terms.
10# For more information, see the COPYING file which you should have received
11# along with this program.
12
13set pwd [pwd]
14cd [file dirname [info script]]
15variable DEMODIR [pwd]
16cd $pwd
17
18
19
20variable DEMODIR
21
22lappend ::auto_path [file dirname  "$env(SCIPATH)/modules/tclsci/tcl/BWidget"]
23namespace inscope :: package require BWidget
24package require BWidget
25
26
27set sourcedir [file join "$env(SCIPATH)" "modules" "tclsci" "tcl" "utils"]
28set sourcedir2 [file join "$env(SCIPATH)" "modules" "graphics" "tcl" "ged"]
29
30source [file join $sourcedir Notebook.tcl]
31source [file join $sourcedir Combobox.tcl]
32source [file join $sourcedir2 ObjectsBrowser.tcl]
33
34package require combobox 2.3
35catch {namespace import combobox::*}
36
37#package require lemonTree
38catch {namespace import LemonTree::*}
39
40global envSCIHOME MAIN_WINDOW_POSITION TICK_WINDOW_POSITION msdos
41set ged_listofpref "MAIN_WINDOW_POSITION TICK_WINDOW_POSITION"
42set MAIN_WINDOW_POSITION "+0+0"
43set TICK_WINDOW_POSITION "+0+0"
44
45set envSCIHOME $SCIHOME
46set preffilename $envSCIHOME/.GedPreferences.tcl
47catch {source $preffilename}
48
49
50global SELOBJECT
51global ged_handle_list_size
52global lalist
53global curgedindex
54global curgedobject
55
56global curvis
57global curfontforeground ncolors curfontstyle curfontsize curfontangle
58global curtextboxmode curtext
59global RED BLUE GREEN
60global curclipstate Xclipbox Yclipbox Wclipbox Hclipbox letext
61global old_Xclipbox old_Yclipbox old_Wclipbox old_Hclipbox
62global curboxmode curlinemode curlfillmode curforeground curbackground
63global curtext
64global textBoxWidth textBoxHeight
65global curAlignment
66
67#To update foreground color grey ("off"), black ("on") for checkbutton boxes
68proc OnOffForeground { frame flag } {
69
70    if { $flag == "on" } {
71	$frame configure -foreground black
72    } else {
73	$frame configure -foreground grey
74    }
75}
76
77set NBheight 310
78set NBwidth  250
79
80set Wheight [expr $NBheight + 185]
81set Wwidth  [expr $NBwidth  + 270]
82
83set smallPad  4
84set mediumPad 8
85
86#create the font we will use
87set gedFont {Arial -12}
88
89set ww .axes
90catch {destroy $ww}
91
92toplevel $ww
93wm title $ww "Text Object"
94wm iconname $ww "TO"
95wm geometry $ww [expr $Wwidth]x[expr $Wheight]$MAIN_WINDOW_POSITION
96wm maxsize  $ww $Wwidth $Wheight
97wm protocol $ww WM_DELETE_WINDOW "DestroyGlobals; destroy $ww "
98
99set topf  [frame $ww.topf]
100set titf1 [TitleFrame $topf.titf1 -text "Graphic Editor" -font $gedFont]
101
102set parent  [$titf1 getframe]
103set pw1  [PanedWindow $parent.pw -side top]
104set pane3  $pw1
105
106
107
108# Make a frame scrollable
109
110set sw [ScrolledWindow $pane3.sw -relief sunken -borderwidth 2]
111# pack $sw -in .sw -fill both -expand true
112set sf [ScrollableFrame $sw.f]
113$sw setwidget $sf
114set uf [$sf getframe]
115
116
117
118set w $uf
119set fra [frame $w.frame -borderwidth 0]
120pack $fra  -anchor w -fill both
121
122#------------------------------------------------
123
124set theframe $fra
125
126#adding 15.06.2005
127set topflabel  [frame $theframe.topflabel]
128set titf1label [TitleFrame $topflabel.titflabel1 -text "Objects Browser" -font $gedFont]
129set titf1axes  [TitleFrame $topflabel.titfaxes1 -text "Object Properties" -font $gedFont]
130
131set w [$titf1label getframe]
132
133pack $titf1label -padx 4 -side left -fill both -expand yes
134pack $topflabel -fill x -pady 0
135pack $titf1axes  -pady 0 -padx 4 -fill both -expand yes
136
137frame $w.frame -borderwidth 0
138pack $w.frame -anchor w -fill both
139#end adding
140
141
142set wfortree $w
143
144for {set i 1} {$i<=$ged_handle_list_size} {incr i} {
145    set OBJECTSARRAY($i) $SELOBJECT($i)
146}
147
148set curgedobject $SELOBJECT($curgedindex)
149
150set tree  [Tree $wfortree.tree \
151	       -yscrollcommand {$wfortree.y set} -xscrollcommand {$wfortree.x set} \
152	       -width 20 -height 26 \
153	       -background white -opencmd {LemonTree::open $wfortree.tree} \
154	       -selectbackground blue -selectforeground white ]
155
156pack [scrollbar $wfortree.x -orient horiz -command {$wfortree.tree xview}] -side bottom -fill x
157pack [scrollbar $wfortree.y -command {$wfortree.tree yview}] -side right -fill y
158pack $tree -fill both -expand 1 -side left
159
160$tree bindText  <1> {LemonTree::Info $tree}
161$tree bindImage <1> {LemonTree::Info $tree}
162
163LemonTree::add $tree root FIGURE    currentfigure  "Figure(1)"
164
165# I open the tree to browse all the nodes (to know what nodes I have and what their names are)
166$tree opentree n1
167
168set allnodes [$tree selection get]
169
170#I close quickly the tree because openreeatnode expanded the tree...
171$tree closetree n1
172
173
174# I directly point onto the current curgedobject (current Axes or Figure or picked entity)
175LemonTree::finddata $tree $allnodes $curgedobject
176
177
178#adding 15.06.2005
179set w [$titf1axes getframe]
180
181set uf $w
182#------------------------------------------------
183
184set largeur 12
185
186Notebook:create $uf.n -pages {Style "Data & Mode" "Clipping"} -pad 0 -height $NBheight -width $NBwidth
187pack $uf.n -in $uf -fill both -expand 1
188
189########### Style onglet ##########################################
190###################################################################
191set w [Notebook:frame $uf.n Style]
192
193frame $w.frame -borderwidth 0
194pack $w.frame -anchor w -fill both
195
196#visibility
197frame $w.frame.vis -borderwidth 0
198pack $w.frame.vis  -in $w.frame  -side top -fill x
199label $w.frame.vislabel  -text "Visibility:" -font $gedFont -anchor e -width $largeur
200checkbutton $w.frame.visib  -text "on"\
201    -variable curvis  -onvalue "on" -offvalue "off" \
202    -command "toggleVis $w.frame.visib" -font $gedFont
203OnOffForeground $w.frame.visib $curvis
204
205pack $w.frame.vislabel -in $w.frame.vis  -side left
206pack $w.frame.visib  -in $w.frame.vis    -side left -padx $smallPad
207
208#Box mode
209frame $w.frame.boxmode  -borderwidth 0
210pack $w.frame.boxmode  -in $w.frame -side top   -fill x -pady 0
211
212label $w.frame.boxmodelabel -height 0 -text "Box :" -width 0  -font $gedFont -anchor e -width $largeur
213checkbutton $w.frame.boxmodevalue  -text "on"\
214    -variable curboxmode  -onvalue "on" -offvalue "off" \
215    -command "toggleBoxmode $w.frame.boxmodevalue" -font $gedFont
216OnOffForeground $w.frame.boxmodevalue $curboxmode
217
218pack $w.frame.boxmodelabel -in $w.frame.boxmode  -side left
219pack $w.frame.boxmodevalue  -in $w.frame.boxmode    -side left -padx $smallPad
220
221#line mode
222frame $w.frame.linemode  -borderwidth 0
223pack $w.frame.linemode  -in $w.frame -side top   -fill x -pady 0
224label $w.frame.linemodelabel -height 0 -text "Line mode :" -width 0  -font $gedFont -anchor e -width $largeur
225checkbutton $w.frame.linemodevalue  -text "on"\
226    -variable curlinemode  -onvalue "on" -offvalue "off" \
227    -command "toggleLineMode $w.frame.linemodevalue" -font $gedFont
228OnOffForeground $w.frame.linemodevalue $curlinemode
229
230pack $w.frame.linemodelabel -in $w.frame.linemode  -side left
231pack $w.frame.linemodevalue  -in $w.frame.linemode    -side left -padx $smallPad
232
233#fill mode
234frame $w.frame.fillmode  -borderwidth 0
235pack $w.frame.fillmode  -in $w.frame -side top   -fill x -pady 0
236label $w.frame.fillmodelabel -height 0 -text "Fill mode :" -width 0  -font $gedFont -anchor e -width $largeur
237checkbutton $w.frame.fillmodevalue  -text "on"\
238    -variable curfillmode  -onvalue "on" -offvalue "off" \
239    -command "toggleFillMode $w.frame.fillmodevalue" -font $gedFont
240OnOffForeground $w.frame.fillmodevalue $curfillmode
241
242pack $w.frame.fillmodelabel -in $w.frame.fillmode  -side left
243pack $w.frame.fillmodevalue  -in $w.frame.fillmode    -side left -padx $smallPad
244
245###############
246#Font color
247frame $w.frame.fontcol  -borderwidth 0
248pack $w.frame.fontcol  -in $w.frame -side top   -fill x -pady 0
249
250label $w.frame.fontcolorlabel -height 0 -text "Font color:" -width 0  -font $gedFont -anchor e -width $largeur
251scale $w.frame.fontcolor -orient horizontal -from -2 -to $ncolors \
252	 -resolution 1.0 -command "setFontColor $w.frame.fontcolor" -tickinterval 0  -font $gedFont
253
254pack $w.frame.fontcolorlabel  -in  $w.frame.fontcol -side left
255pack $w.frame.fontcolor -in  $w.frame.fontcol -side left -expand 1 -fill x -pady 0 -padx $smallPad
256$w.frame.fontcolor set $curfontforeground
257
258#Fontsize scale
259frame $w.frame.fontssz  -borderwidth 0
260pack $w.frame.fontssz  -in $w.frame    -side top -fill x -pady 0
261
262label $w.frame.fontsizelabel -height 0 -text "Font size:" -width 0  -font $gedFont -anchor e -width $largeur
263scale $w.frame.fontsize -orient horizontal  -from 0 -to [expr max(5,$curfontsize*1.5)] \
264	 -resolution 1.0 -command "setFontSize $w.frame.fontsize" -tickinterval 0 -font $gedFont
265pack $w.frame.fontsizelabel  -in $w.frame.fontssz -side left
266pack $w.frame.fontsize -in $w.frame.fontssz   -expand 1 -fill x -pady 0 -padx $smallPad
267$w.frame.fontsize set $curfontsize
268
269
270#Fonts Style
271frame $w.frame.fontsst  -borderwidth 0
272pack $w.frame.fontsst  -in $w.frame -side top -fill x -pady 0
273
274label $w.frame.stylelabel  -height 0 -text "Font style:" -width 0  -font $gedFont -anchor e -width $largeur
275combobox $w.frame.style \
276    -borderwidth 1 \
277    -highlightthickness 1 \
278    -maxheight 0 \
279    -width 3 \
280    -textvariable curfontstyle \
281    -editable false \
282    -command [list SelectFontStyle] -font $gedFont
283eval $w.frame.style list insert end [list "Monospaced" "Symbol" "Serif" "Serif Italic" "Serif Bold" "Serif Bold Italic"  "SansSerif"  "SansSerif Italic" "SansSerif Bold" "SansSerif Bold Italic"]
284
285pack $w.frame.stylelabel -in $w.frame.fontsst   -side left
286pack $w.frame.style -in $w.frame.fontsst   -expand 1 -fill x -pady 0 -padx $mediumPad
287
288#Font Angle
289frame $w.frame.fontsang  -borderwidth 0
290pack $w.frame.fontsang  -in $w.frame    -side top -fill x -pady 0
291
292label $w.frame.fontanglelabel -height 0 -text "Font angle:" -width 0  -font $gedFont -anchor e -width $largeur
293scale $w.frame.fontangle -orient horizontal  -from 0 -to 360 \
294	 -resolution 1.0 -command "setFontAngle $w.frame.fontangle " -tickinterval 0 -font $gedFont
295$w.frame.fontangle set $curfontangle
296entry $w.frame.fontangle2 -relief sunken  -textvariable curfontangle2 -font $gedFont -width 15
297
298bind  $w.frame.fontangle2 <Return> "setEntryFontAngle $w.frame.fontangle2 $w.frame.fontangle"
299bind  $w.frame.fontangle2 <KP_Enter> 	"setEntryFontAngle $w.frame.fontangle2 $w.frame.fontangle"
300bind  $w.frame.fontangle2 <FocusOut> 	"setEntryFontAngle $w.frame.fontangle2 $w.frame.fontangle"
301
302#Foreground scale
303frame $w.frame.clrf  -borderwidth 0
304pack $w.frame.clrf  -in $w.frame -side top  -fill x
305
306label $w.frame.colorlabel -height 0 -text "Foreground:" -width 0  -font $gedFont -anchor e -width $largeur
307#         -foreground $color
308scale $w.frame.color -orient horizontal -from -2 -to $ncolors \
309	 -resolution 1.0 -command "setForeground $w.frame.color" -tickinterval 0  -font $gedFont
310
311pack $w.frame.colorlabel -in $w.frame.clrf -side left
312pack $w.frame.color -in  $w.frame.clrf -side left  -expand 1 -fill x -pady 0 -padx $smallPad
313$w.frame.color set $curforeground
314
315#Background scale (line)
316frame $w.frame.backg  -borderwidth 0
317pack $w.frame.backg  -in $w.frame -side top  -fill x
318
319label $w.frame.backlabel -height 0 -text "Background:" -font $gedFont -anchor e -width $largeur
320#         -foreground $back
321scale $w.frame.back -orient horizontal -from -2 -to $ncolors \
322	 -resolution 1.0 -command "setBackground $w.frame.back" -tickinterval 0  -font $gedFont
323
324pack $w.frame.backlabel -in $w.frame.backg -side left
325pack $w.frame.back  -in  $w.frame.backg -side left -expand 1 -fill x -pady 0 -padx $smallPad
326$w.frame.back set $curbackground
327
328
329pack $w.frame.fontanglelabel  -in $w.frame.fontsang -side left
330pack $w.frame.fontangle -in $w.frame.fontsang    -side left -padx $smallPad
331pack $w.frame.fontangle2 -in $w.frame.fontsang   -expand 1 -fill x -pady 0 -padx $mediumPad
332
333#############
334
335#sep bar
336frame $w.sep -height 2 -borderwidth 1 -relief sunken
337pack $w.sep -fill both
338
339#exit button
340frame $w.buttons
341pack $w.buttons -side bottom -fill x -pady 0
342button $w.buttons.dismiss -text Quit -command "DestroyGlobals; destroy $ww"  -font $gedFont
343pack $w.buttons.dismiss  -side bottom -expand 1
344
345
346########### Data & Mode onglet ####################################
347###################################################################
348set w [Notebook:frame $uf.n "Data & Mode"]
349
350frame $w.frame -borderwidth 0
351pack $w.frame -anchor w -fill both
352
353
354### Text data ###
355set mycurtext $curtext
356
357frame $w.frame.textframe  -borderwidth 0
358pack $w.frame.textframe  -in $w.frame  -side top  -fill x
359
360label $w.frame.textlabel  -height 0 -text "Text:" -width 0  -font $gedFont  -anchor e -width $largeur
361combobox $w.frame.text \
362    -borderwidth 1 \
363    -highlightthickness 1 \
364    -maxheight 0 \
365    -width 3 \
366    -textvariable curtext \
367    -editable true \
368    -command [list SelectData ] -font $gedFont
369eval $w.frame.text list insert end [list $mycurtext "----" "Edit data..."]
370pack $w.frame.textlabel -in $w.frame.textframe  -side left
371pack $w.frame.text   -in $w.frame.textframe  -expand 1 -fill x -pady $smallPad -padx $mediumPad
372
373
374
375
376### Text box mode ###
377frame $w.frame.fontsst  -borderwidth 0
378pack $w.frame.fontsst  -in $w.frame -side top -fill x -pady 0
379
380label $w.frame.stylelabel  -height 0 -text "Text box mode:" -width 0  -font $gedFont -anchor e -width $largeur
381combobox $w.frame.style \
382    -borderwidth 1 \
383    -highlightthickness 1 \
384    -maxheight 0 \
385    -width 13 \
386    -textvariable curtextboxmode \
387    -editable false \
388    -command [list SelectTextBoxMode] -font $gedFont
389eval $w.frame.style list insert end [list "off" "centered" "filled"]
390
391pack $w.frame.stylelabel -in $w.frame.fontsst   -side left
392pack $w.frame.style -in $w.frame.fontsst  -side left -pady $smallPad -padx $mediumPad
393
394#### Text box ###
395frame $w.frame.textBoxFrame  -borderwidth 0
396pack $w.frame.textBoxFrame  -in $w.frame -side top -fill x -pady 0
397
398#display label
399label $w.frame.labelTextBox -text "Text Box: Width and Height:" -font $gedFont
400pack $w.frame.labelTextBox -in $w.frame.textBoxFrame -side left
401
402#create the 2 entity boxes
403frame $w.frame.textBoxWidth -borderwidth 0
404pack $w.frame.textBoxWidth -in $w.frame -side top -fill x
405
406label $w.frame.labelTbWidth -text  "Width:" -font $gedFont  -anchor e -width $largeur
407entry $w.frame.tbWidthEntry -relief sunken -textvariable textBoxWidth -width 10 -font $gedFont
408
409pack $w.frame.labelTbWidth -in $w.frame.textBoxWidth -side left
410pack $w.frame.tbWidthEntry -in $w.frame.textBoxWidth -side left -fill x -pady $smallPad -padx $mediumPad
411
412bind $w.frame.tbWidthEntry <Return>   { setTextBox }
413bind $w.frame.tbWidthEntry <KP_Enter> { setTextBox }
414
415frame $w.frame.textBoxHeight -borderwidth 0
416pack $w.frame.textBoxHeight -in $w.frame -side top -fill x
417
418label $w.frame.labelTbHeight -text  "Height:" -font $gedFont -anchor e -width $largeur
419entry $w.frame.tbHeightEntry -relief sunken -textvariable textBoxHeight -width 10 -font $gedFont
420
421pack $w.frame.labelTbHeight -in $w.frame.textBoxHeight -side left
422pack $w.frame.tbHeightEntry -in $w.frame.textBoxHeight -side left -padx $mediumPad
423
424bind $w.frame.tbHeightEntry <Return>   {setTextBox}
425bind $w.frame.tbHeightEntry <KP_Enter> {setTextBox}
426
427
428### alignment ###
429frame $w.frame.alignment  -borderwidth 0
430pack $w.frame.alignment  -in $w.frame -side top -fill x -pady 0
431
432label $w.frame.alignLabel  -height 0 -text "Alignment:" -width 0  -font $gedFont -anchor e -width $largeur
433combobox $w.frame.alignMenu \
434    -borderwidth 1 \
435    -highlightthickness 1 \
436    -maxheight 0 \
437    -width 13 \
438    -textvariable curAlignment \
439    -editable false \
440    -command [list setTextAlignment] -font $gedFont
441eval $w.frame.alignMenu list insert end [list "left" "center" "right"]
442
443pack $w.frame.alignLabel -in $w.frame.alignment   -side left
444pack $w.frame.alignMenu -in $w.frame.alignment  -side left -pady $smallPad -padx $mediumPad
445
446
447
448#sep bar
449frame $w.sep -height 2 -borderwidth 1 -relief sunken
450pack $w.sep -fill both
451
452#exit button
453frame $w.buttons
454pack $w.buttons -side bottom -fill x -pady 0
455button $w.buttons.dismiss -text Quit -command "destroy $ww"  -font $gedFont
456pack $w.buttons.dismiss  -side bottom -expand 1
457
458
459########### Clipping onglet #######################################
460###################################################################
461
462set w9 [Notebook:frame $uf.n Clipping]
463
464frame $w9.frame -borderwidth 0
465pack $w9.frame -anchor w -fill both
466
467set letext ""
468
469#Clip state
470#frame $w9.frame.clpwarning  -borderwidth 0
471
472frame $w9.frame.clpstat  -borderwidth 0
473pack $w9.frame.clpstat  -in $w9.frame -side top -fill x -pady 0
474
475label $w9.frame.cliplabel  -height 0 -text "Clip state:" -width 0  -font $gedFont -anchor e -width $largeur
476combobox $w9.frame.clip \
477    -borderwidth 1 \
478    -highlightthickness 1 \
479    -maxheight 0 \
480    -width 8 \
481    -textvariable curclipstate\
482    -editable false \
483    -command [list SelectClipState ] -font $gedFont
484eval $w9.frame.clip list insert end [list "on" "off" "clipgrf"]
485
486pack $w9.frame.cliplabel -in $w9.frame.clpstat   -side left
487pack $w9.frame.clip -in $w9.frame.clpstat  -side left -pady 0 -padx $mediumPad
488
489#clip box
490frame $w9.frame.lb1 -borderwidth 0
491pack $w9.frame.lb1  -in $w9.frame -side top   -fill x
492label $w9.frame.labelul -text "Clip box : upper-left point coordinates" -font $gedFont
493pack $w9.frame.labelul -in  $w9.frame.lb1 -side left
494
495frame $w9.frame.lb2 -borderwidth 0
496pack $w9.frame.lb2  -in $w9.frame -side top   -fill x
497
498frame $w9.frame.lb21 -borderwidth 0
499pack $w9.frame.lb21  -in $w9.frame -side top   -fill x
500
501frame $w9.frame.lb22 -borderwidth 0
502pack $w9.frame.lb22  -in $w9.frame -side top   -fill x
503
504label $w9.frame.labelx -text "X:" -font $gedFont  -anchor e -width $largeur
505entry $w9.frame.datax -relief sunken  -textvariable Xclipbox -width 10  -font $gedFont
506label $w9.frame.labely -text "Y:" -font $gedFont -anchor e -width $largeur
507entry $w9.frame.datay -relief sunken  -textvariable Yclipbox -width 10  -font $gedFont
508
509pack $w9.frame.labelx  -in  $w9.frame.lb2 -side left
510pack $w9.frame.datax   -in  $w9.frame.lb2 -side left -pady 0 -padx $mediumPad
511pack $w9.frame.labely  -in  $w9.frame.lb21 -side left
512pack $w9.frame.datay   -in  $w9.frame.lb21 -side left -pady 0 -padx $mediumPad
513bind  $w9.frame.datax <Return> "SelectClipBox $w9.frame"
514bind  $w9.frame.datay <Return> "SelectClipBox $w9.frame"
515bind  $w9.frame.datax <KP_Enter> "SelectClipBox $w9.frame"
516bind  $w9.frame.datay <KP_Enter> "SelectClipBox $w9.frame"
517
518#----------------------------#
519frame $w9.frame.lb3 -borderwidth 0
520pack $w9.frame.lb3  -in $w9.frame -side top   -fill x
521label $w9.frame.labelwh -text "Clip box : width and height" -font $gedFont
522pack $w9.frame.labelwh -in  $w9.frame.lb3 -side left
523
524frame $w9.frame.lb4 -borderwidth 0
525pack $w9.frame.lb4  -in $w9.frame -side top   -fill x
526
527frame $w9.frame.lb41 -borderwidth 0
528pack $w9.frame.lb41  -in $w9.frame -side top   -fill x
529
530label $w9.frame.labelw -text "W:" -font $gedFont -anchor e -width $largeur
531entry $w9.frame.dataw -relief sunken  -textvariable Wclipbox -width 10  -font $gedFont
532label $w9.frame.labelh -text "H:" -font $gedFont -anchor e -width $largeur
533entry $w9.frame.datah -relief sunken  -textvariable Hclipbox -width 10  -font $gedFont
534
535pack $w9.frame.labelw  -in  $w9.frame.lb4 -side left
536pack $w9.frame.dataw   -in  $w9.frame.lb4 -side left -pady 0 -padx $mediumPad
537pack $w9.frame.labelh  -in  $w9.frame.lb41 -side left
538pack $w9.frame.datah   -in  $w9.frame.lb41 -side left -pady 0 -padx $mediumPad
539bind  $w9.frame.dataw <Return> "SelectClipBox $w9.frame"
540bind  $w9.frame.datah <Return> "SelectClipBox $w9.frame"
541bind  $w9.frame.dataw <KP_Enter> "SelectClipBox $w9.frame"
542bind  $w9.frame.datah <KP_Enter> "SelectClipBox $w9.frame"
543
544
545frame $w9.frame.warning
546label $w9.frame.mesgwarning  -justify left -textvariable letext -font $gedFont
547$w9.frame.mesgwarning config -foreground red
548pack $w9.frame.mesgwarning -in $w9.frame.warning
549pack $w9.frame.warning -in $w9.frame
550
551#sep bar
552frame $w9.sep -height 2 -borderwidth 1 -relief sunken
553pack $w9.sep -fill both
554
555
556#exit button
557frame $w9.buttons
558button $w9.b -text Quit -command "DestroyGlobals; destroy $ww" -font $gedFont
559pack $w9.b -side bottom
560
561
562pack $sw $pw1 -fill both -expand yes
563pack $titf1 -padx 4 -side left -fill both -expand yes
564pack $topf -fill both -pady 2 -expand yes
565
566
567#proc associes
568proc toggleVis { frame } {
569    global curvis
570    ScilabEval "global ged_handle;ged_handle.visible='$curvis'"
571
572    OnOffForeground $frame $curvis
573}
574
575
576proc setFontColor {w  index} {
577    global RED BLUE GREEN
578    variable REDCOL
579    variable GRECOL
580    variable BLUCOL
581
582    #ScilabEval "global ged_handle;"
583    if { $index == -2 } {
584	ScilabEval "global ged_handle; if ged_handle.font_foreground <> $index then ged_handle.font_foreground=$index; end;"
585	#like $index==-2: display white color
586	set color [format \#%02x%02x%02x 255 255 255]
587	$w config  -activebackground $color -troughcolor $color
588    } elseif { $index == -1 } {
589	ScilabEval "global ged_handle; if ged_handle.font_foreground <> $index then ged_handle.font_foreground=$index; end;"
590	#like $index==-1: display black color
591	set color [format \#%02x%02x%02x 0 0 0]
592	$w config  -activebackground $color -troughcolor $color
593    } elseif { $index == 0 } {
594	ScilabEval "global ged_handle; if ged_handle.font_foreground <> $index then ged_handle.font_foreground=$index; end;"
595	#like $index==1: display first color
596	set REDCOL $RED(1)
597	set GRECOL $GREEN(1)
598	set BLUCOL $BLUE(1)
599
600	set color [format \#%02x%02x%02x [expr int($REDCOL*255)]  [expr int($GRECOL*255)]  [expr int($BLUCOL*255)]]
601
602	$w config  -activebackground $color -troughcolor $color
603    } else {
604	ScilabEval "global ged_handle; if ged_handle.font_foreground <> $index then ged_handle.font_foreground=$index; end;"
605
606	set REDCOL $RED($index)
607	set GRECOL $GREEN($index)
608	set BLUCOL $BLUE($index)
609
610	set color [format \#%02x%02x%02x [expr int($REDCOL*255)]  [expr int($GRECOL*255)]  [expr int($BLUCOL*255)]]
611
612	$w config  -activebackground $color -troughcolor $color
613
614    }
615}
616
617proc setFontSize {w fs} {
618    ScilabEval "global ged_handle; if ged_handle.font_size <> $fs then ged_handle.font_size=$fs; end;"
619}
620
621
622proc SelectFontStyle {w args} {
623global curfontstyle
624ScilabEval "setFontStyle('$curfontstyle')"
625}
626
627proc setFontAngle {w fa} {
628    global curfontangle2
629    ScilabEval "global ged_handle;if ged_handle.font_angle <> $fa then ged_handle.font_angle=$fa; end;"
630    set curfontangle2 $fa
631}
632
633proc setEntryFontAngle {w w2 args} {
634    global curfontangle
635    global curfontangle2
636    if { $curfontangle2 == "" || $curfontangle2 < 0} {
637	tk_messageBox -icon error -type ok -title "Incorrect angle" -message "Set a correct angle value in degree from 0 to 360"
638	return
639    }
640    ScilabEval "global ged_handle;if ged_handle.font_angle <> $curfontangle2 then ged_handle.font_angle=$curfontangle2; end;"
641    set curfontangle $curfontangle2
642    $w2 set $curfontangle
643}
644
645proc setText {} {
646global curtext
647ScilabEval "global ged_handle;ged_handle.text='$curtext'"
648}
649
650
651proc SelectTextBoxMode {w args} {
652global curtextboxmode
653ScilabEval "global ged_handle;ged_handle.text_box_mode='$curtextboxmode'"
654}
655
656proc toggleBoxmode { frame } { #fill mode for text object
657    global curboxmode
658    ScilabEval "global ged_handle;ged_handle.box='$curboxmode'"
659
660    OnOffForeground $frame $curboxmode
661}
662
663proc toggleLineMode { frame } { #line mode for text object
664    global curlinemode
665    ScilabEval "global ged_handle;ged_handle.line_mode='$curlinemode'"
666
667    OnOffForeground $frame $curlinemode
668}
669
670proc toggleFillMode { frame } { #line mode for text object
671    global curfillmode
672    ScilabEval "global ged_handle;ged_handle.fill_mode='$curfillmode'"
673
674    OnOffForeground $frame $curfillmode
675}
676
677
678#Clipping proc for all entities (clip box and clip state fields)
679proc SelectClipBox { w } {
680    global Xclipbox Yclipbox Wclipbox Hclipbox curclipstate letext
681    if { ($Xclipbox == "") || ($Yclipbox == "") ||
682	 ($Wclipbox == "") || ($Hclipbox == "") } {
683	if { [info exists  text] } {
684	    unset text
685	}
686	set letext "Note that all clip box fields must be filled."
687
688    } else {
689	if { [info exists  text] } {
690	    unset text
691	}
692	set letext ""
693
694	ScilabEval "global ged_handle;ged_handle.clip_box=\[$Xclipbox $Yclipbox $Wclipbox $Hclipbox\]"
695	set curclipstate "on"
696    }
697}
698
699proc SelectClipState {w args} {
700global curclipstate Xclipbox Yclipbox Wclipbox Hclipbox
701global old_Xclipbox old_Yclipbox old_Wclipbox old_Hclipbox
702ScilabEval "global ged_handle;ged_handle.clip_state='$curclipstate';"
703    if { $curclipstate == "off" } {
704	set old_Xclipbox $Xclipbox
705	set old_Yclipbox $Yclipbox
706	set old_Wclipbox $Wclipbox
707	set old_Hclipbox $Hclipbox
708	set Xclipbox ""
709	set Yclipbox ""
710	set Wclipbox ""
711	set Hclipbox ""
712    } else {
713	set Xclipbox $old_Xclipbox
714	set Yclipbox $old_Yclipbox
715	set Wclipbox $old_Wclipbox
716	set Hclipbox $old_Hclipbox
717    }
718}
719
720proc SavePreferences { } {
721    global ged_listofpref
722    global envSCIHOME MAIN_WINDOW_POSITION TICK_WINDOW_POSITION
723    global ww msdos
724
725    ScilabEval "DestroyGlobals()" "seq"
726
727    if { $msdos == "F" } {
728#unix mandrake (at least) needs this offset
729#test other unix distribution to see (red hat, suse...)
730	set xoffset -5
731	set yoffset -26
732    } else {
733	set xoffset 0
734	set yoffset 0
735    }
736
737    set x [eval {winfo x $ww}]
738    set y [eval {winfo y $ww}]
739    set MAIN_WINDOW_POSITION "+[expr $x+$xoffset]+[expr $y+$yoffset]"
740
741    #save preferences (position...)
742    set preffilename [file join $envSCIHOME .GedPreferences.tcl]
743    catch {
744 	set preffile [open $preffilename w]
745	foreach opt $ged_listofpref {
746	    global $opt
747	    puts $preffile [concat "set $opt " [set $opt]]
748	    # 	    puts [concat "set $opt" [set $opt]]
749	}
750	close $preffile
751    }
752}
753
754proc setForeground {w index} {
755    global RED BLUE GREEN
756    variable REDCOL
757    variable GRECOL
758    variable BLUCOL
759
760    #ScilabEval "global ged_handle;"
761    if { $index == -2 } {
762	ScilabEval "global ged_handle; if ged_handle.foreground <> $index then ged_handle.foreground=$index; end;"
763	#like $index==-2: display white color
764	set color [format \#%02x%02x%02x 255 255 255]
765	$w config  -activebackground $color -troughcolor $color
766    } elseif { $index == -1 } {
767	ScilabEval "global ged_handle; if ged_handle.foreground <> $index then ged_handle.foreground=$index; end;"
768	#like $index==-1: display black color
769	set color [format \#%02x%02x%02x 0 0 0]
770	$w config  -activebackground $color -troughcolor $color
771    } elseif { $index == 0 } {
772	ScilabEval "global ged_handle; if ged_handle.foreground <> $index then ged_handle.foreground=$index; end;"
773	#like $index==1: display first color
774	set REDCOL $RED(1)
775	set GRECOL $GREEN(1)
776	set BLUCOL $BLUE(1)
777	set color [format \#%02x%02x%02x [expr int($REDCOL*255)]  [expr int($GRECOL*255)]  [expr int($BLUCOL*255)]]
778
779	$w config  -activebackground $color -troughcolor $color
780    } else {
781	ScilabEval "global ged_handle; if ged_handle.foreground <> $index then ged_handle.foreground=$index; end;"
782
783	set REDCOL $RED($index)
784	set GRECOL $GREEN($index)
785	set BLUCOL $BLUE($index)
786	set color [format \#%02x%02x%02x [expr int($REDCOL*255)]  [expr int($GRECOL*255)]  [expr int($BLUCOL*255)]]
787
788	$w config  -activebackground $color -troughcolor $color
789    }
790}
791
792proc setBackground {w index} {
793    global RED BLUE GREEN
794    variable REDCOL
795    variable GRECOL
796    variable BLUCOL
797
798    #ScilabEval "global ged_handle;"
799    if { $index == -2 } {
800	ScilabEval "global ged_handle; if ged_handle.background <> $index then ged_handle.background=$index; end;"
801	#like $index==-2: display white color
802	set color [format \#%02x%02x%02x 255 255 255]
803	$w config  -activebackground $color -troughcolor $color
804    } elseif { $index == -1 } {
805	ScilabEval "global ged_handle; if ged_handle.background <> $index then ged_handle.background=$index; end;"
806	#like $index==-1: display black color
807	set color [format \#%02x%02x%02x 0 0 0]
808	$w config  -activebackground $color -troughcolor $color
809    } elseif { $index == 0 } {
810	ScilabEval "global ged_handle; if ged_handle.background <> $index then ged_handle.background=$index; end;"
811	#like $index==1: display first color
812	set REDCOL $RED(1)
813	set GRECOL $GREEN(1)
814	set BLUCOL $BLUE(1)
815
816	set color [format \#%02x%02x%02x [expr int($REDCOL*255)]  [expr int($GRECOL*255)]  [expr int($BLUCOL*255)]]
817
818	$w config  -activebackground $color -troughcolor $color
819    } else {
820	ScilabEval "global ged_handle; if ged_handle.background <> $index then ged_handle.background=$index; end;"
821
822	set REDCOL $RED($index)
823	set GRECOL $GREEN($index)
824	set BLUCOL $BLUE($index)
825
826	set color [format \#%02x%02x%02x [expr int($REDCOL*255)]  [expr int($GRECOL*255)]  [expr int($BLUCOL*255)]]
827
828	$w config  -activebackground $color -troughcolor $color
829
830    }
831}
832
833
834proc DestroyGlobals { } {
835    ScilabEval "DestroyGlobals()" "seq"
836
837    SavePreferences
838}
839
840
841proc sciCommandData {} {
842    global scicomint_text
843
844    set longueur [expr [string length $scicomint_text]]
845
846    if { $longueur == 0 } {
847	tk_messageBox -icon error -type ok -title "Incorrect input" -message "You must specify a variable defined in Scilab Console representing a string matrix\n(or use a macro call).\n to initialize the \"text\" field."
848    } else {
849	# check if it is needed to reload the page
850        # jb Silvy 06/2006: I removed the call to tkged
851        ScilabEval "global ged_handle ; if ( ged_handle.text <> $scicomint_text ) then, ged_handle.text = $scicomint_text ; end;" "seq"
852    }
853}
854
855proc GUIEditData  {} {
856    ScilabEval "global ged_handle;editvar(\"ged_handle.text\")" "seq"
857}
858
859proc SelectData  {w args} {
860    global curtext scicomint_text
861    set finddbarray -1
862    set dbarray "string array"
863    set finddbarray [expr [string first $dbarray $curtext]]
864
865    if { ($curtext == "----") || ($finddbarray != -1) } {
866#	puts "nothing to do"
867    } else {
868	if { $curtext ==  "Edit data..." } {
869	    GUIEditData
870	} else {
871	    #enter a variable
872	    set scicomint_text $curtext
873	    sciCommandData
874	}
875    }
876}
877
878proc setTextBox {} {
879    global textBoxWidth
880    global textBoxHeight
881
882    if { ($textBoxWidth == "") || ($textBoxHeight == "") } {
883	tk_messageBox -icon error -type ok -title "Text Box error" -message "You must fill in the 2 fields."
884	return
885    }
886    ScilabEval "global ged_handle;ged_handle.text_box=\[$textBoxWidth $textBoxHeight \]"
887}
888
889proc setTextAlignment {w args} {
890    global curAlignment
891    if { ($curAlignment == "" ) } {
892        tk_messageBox -icon error -type ok -title "Alignment error" -message "You must fill in the field."
893	return
894    }
895    ScilabEval "global ged_handle;ged_handle.alignment = \"$curAlignment\" "
896}
897