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