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# Copyright (C) 2012 - 2016 - Scilab Enterprises 6# 7# This file is hereby licensed under the terms of the GNU GPL v2.0, 8# pursuant to article 5.3.4 of the CeCILL v.2.1. 9# This file was originally licensed under the terms of the CeCILL v2.1, 10# and continues to be available under such terms. 11# For more information, see the COPYING file which you should have received 12# along with this program. 13 14set pwd [pwd] 15cd [file dirname [info script]] 16variable DEMODIR [pwd] 17cd $pwd 18 19 20 21variable DEMODIR 22 23lappend ::auto_path [file dirname "$env(SCIPATH)/modules/tclsci/tcl/BWidget"] 24namespace inscope :: package require BWidget 25package require BWidget 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 curvis red green blue color curfillmode curlinestyle curmarkstyle curmarkmode 51global curmarkmode curlinemode curmarksize curmarksizeunit curmarkforeground curmarkbackground 52global curback 53 54global SELOBJECT 55global ged_handle_list_size 56global lalist 57global curgedindex 58global curgedobject 59global curclipstate Xclipbox Yclipbox Wclipbox Hclipbox letext 60global old_Xclipbox old_Yclipbox old_Wclipbox old_Hclipbox 61global ncolors RED GREEN BLUE 62 63global Hval Wval Xval Yval Zval 64 65#To update foreground color grey ("off"), black ("on") for checkbutton boxes 66proc OnOffForeground { frame flag } { 67 68 if { $flag == "on" } { 69 $frame configure -foreground black 70 } else { 71 $frame configure -foreground grey 72 } 73} 74 75set NBheight 400 76set NBwidth 310 77 78set Wheight [expr $NBheight + 115] 79set Wwidth [expr $NBwidth + 270] 80 81set smallPad 4 82set mediumPad 8 83 84#create the font we will use 85set gedFont {Arial -12} 86 87set ww .axes 88catch {destroy $ww} 89toplevel $ww 90wm title $ww "Rectangle Editor" 91wm iconname $ww "RE" 92wm geometry $ww [expr $Wwidth]x[expr $Wheight]$MAIN_WINDOW_POSITION 93wm maxsize $ww $Wwidth $Wheight 94wm protocol $ww WM_DELETE_WINDOW "DestroyGlobals; destroy $ww " 95 96set topf [frame $ww.topf] 97set titf1 [TitleFrame $topf.titf1 -text "Graphic Editor" -font $gedFont] 98 99set parent [$titf1 getframe] 100set pw1 [PanedWindow $parent.pw -side top] 101set pane3 $pw1 102 103 104 105# Make a frame scrollable 106 107set sw [ScrolledWindow $pane3.sw -relief sunken -borderwidth 2] 108# pack $sw -in .sw -fill both -expand true 109set sf [ScrollableFrame $sw.f] 110$sw setwidget $sf 111set uf [$sf getframe] 112 113 114set w $uf 115set fra [frame $w.frame -borderwidth 0] 116pack $fra -anchor w -fill both 117 118#------------------------------------------------ 119 120set theframe $fra 121 122#adding 15.06.2005 123set topflabel [frame $theframe.topflabel] 124set titf1label [TitleFrame $topflabel.titflabel1 -text "Objects Browser" -font $gedFont] 125set titf1axes [TitleFrame $topflabel.titfaxes1 -text "Object Properties" -font $gedFont] 126 127set w [$titf1label getframe] 128 129pack $titf1label -padx 4 -side left -fill both -expand yes 130pack $topflabel -fill x -pady 0 131pack $titf1axes -pady 0 -padx 4 -fill both -expand yes 132 133frame $w.frame -borderwidth 0 134pack $w.frame -anchor w -fill both 135#end adding 136 137 138set wfortree $w 139 140for {set i 1} {$i<=$ged_handle_list_size} {incr i} { 141 set OBJECTSARRAY($i) $SELOBJECT($i) 142} 143 144set curgedobject $SELOBJECT($curgedindex) 145 146set tree [Tree $wfortree.tree \ 147 -yscrollcommand {$wfortree.y set} -xscrollcommand {$wfortree.x set} \ 148 -width 20 -height 10 \ 149 -background white -opencmd {LemonTree::open $wfortree.tree} \ 150 -selectbackground blue -selectforeground white ] 151 152pack [scrollbar $wfortree.x -orient horiz -command {$wfortree.tree xview}] -side bottom -fill x 153pack [scrollbar $wfortree.y -command {$wfortree.tree yview}] -side right -fill y 154pack $tree -fill both -expand 1 -side left 155 156$tree bindText <1> {LemonTree::Info $tree} 157$tree bindImage <1> {LemonTree::Info $tree} 158 159LemonTree::add $tree root FIGURE currentfigure "Figure(1)" 160 161# I open the tree to browse all the nodes (to know what nodes I have and what their names are) 162$tree opentree n1 163 164set allnodes [$tree selection get] 165 166#I close quickly the tree because openreeatnode expanded the tree... 167$tree closetree n1 168 169 170# I directly point onto the current curgedobject (current Axes or Figure or picked entity) 171LemonTree::finddata $tree $allnodes $curgedobject 172 173 174#adding 15.06.2005 175set w [$titf1axes getframe] 176 177set uf $w 178#------------------------------------------------ 179 180set largeur 14 181 182Notebook:create $uf.n -pages {Style Data Clipping} -pad 0 -height $NBheight -width $NBwidth 183pack $uf.n -fill both -expand 1 184 185########### Style onglet ########################################## 186################################################################### 187set w [Notebook:frame $uf.n Style] 188 189frame $w.frame -borderwidth 10 190pack $w.frame -anchor w -fill both 191 192#Visibility 193frame $w.frame.vis -borderwidth 0 194pack $w.frame.vis -in $w.frame -side top -fill x 195 196label $w.frame.visiblelabel -height 0 -text "Visibility:" -width 0 -font $gedFont -anchor e -width $largeur 197checkbutton $w.frame.visible -text "on" -indicatoron 1 \ 198 -variable curvis -onvalue "on" -offvalue "off" \ 199 -command "toggleVisibility $w.frame.visible" -font $gedFont 200OnOffForeground $w.frame.visible $curvis 201 202pack $w.frame.visiblelabel -in $w.frame.vis -side left 203pack $w.frame.visible -in $w.frame.vis -side left -fill x -pady 0 -padx $smallPad 204 205 206#Line mode 207frame $w.frame.linelinemode -borderwidth 0 208pack $w.frame.linelinemode -in $w.frame -side top -fill x 209 210label $w.frame.linemodelabel -height 0 -text "Line mode:" -width 0 -font $gedFont -anchor e -width $largeur 211checkbutton $w.frame.linemode -text "on" -indicatoron 1 \ 212 -variable curlinemode -onvalue "on" -offvalue "off" \ 213 -command "toggleLinemode $w.frame.linemode" -font $gedFont 214OnOffForeground $w.frame.linemode $curlinemode 215 216pack $w.frame.linemodelabel -in $w.frame.linelinemode -side left 217pack $w.frame.linemode -in $w.frame.linelinemode -side left -fill x -pady 0 -padx $smallPad 218 219#Fill mode 220frame $w.frame.fillfillmode -borderwidth 0 221pack $w.frame.fillfillmode -in $w.frame -side top -fill x 222 223label $w.frame.fillmodelabel -height 0 -text "Fill mode:" -font $gedFont -anchor e -width $largeur 224checkbutton $w.frame.fillmode -text "on" -indicatoron 1 \ 225 -variable curfillmode -onvalue "on" -offvalue "off" \ 226 -command "toggleFillmode $w.frame.fillmode" -font $gedFont 227OnOffForeground $w.frame.fillmode $curfillmode 228 229pack $w.frame.fillmodelabel -in $w.frame.fillfillmode -side left 230pack $w.frame.fillmode -in $w.frame.fillfillmode -side left -fill x -pady 0 -padx $smallPad 231 232#Line Style 233frame $w.frame.rectst -borderwidth 0 234pack $w.frame.rectst -in $w.frame -side top -fill x 235 236label $w.frame.stylelabel -height 0 -text "Line:" -width 0 -font $gedFont -anchor e -width $largeur 237combobox $w.frame.style \ 238 -borderwidth 1 \ 239 -highlightthickness 1 \ 240 -maxheight 0 \ 241 -width 14 \ 242 -textvariable curlinestyle \ 243 -editable false \ 244 -command [list SelectLineStyle ] -font $gedFont 245eval $w.frame.style list insert end [list "solid" "dash" "dash dot" "longdash dot" "bigdash dot" "bigdash longdash" "dot" "double dot"] 246 247#Add thickness here 248combobox $w.frame.thickness \ 249 -borderwidth 1 \ 250 -highlightthickness 1 \ 251 -maxheight 0 \ 252 -width 10 \ 253 -textvariable curthick \ 254 -editable true \ 255 -command [list SelectThickness ] -font $gedFont 256eval $w.frame.thickness list insert end [list "0.0" "1.0" "2.0" "3.0" "4.0" "5.0" "6.0" "8.0" "10.0"] 257 258 259pack $w.frame.stylelabel -in $w.frame.rectst -side left 260pack $w.frame.style -in $w.frame.rectst -side left -padx $smallPad 261pack $w.frame.thickness -in $w.frame.rectst -side left -expand 1 -fill x -pady 0 -padx $smallPad 262 263#Color scale 264frame $w.frame.clrf -borderwidth 0 265pack $w.frame.clrf -in $w.frame -side top -fill x 266 267label $w.frame.colorlabel -height 0 -text "Foreground:" -width 0 -font $gedFont -anchor e -width $largeur 268# -foreground $color 269scale $w.frame.color -orient horizontal -from -2 -to $ncolors \ 270 -resolution 1.0 -command "setColor $w.frame.color" -tickinterval 0 -font $gedFont 271 272pack $w.frame.colorlabel -in $w.frame.clrf -side left 273pack $w.frame.color -in $w.frame.clrf -side left -expand 1 -fill x -pady 0 -padx $smallPad 274$w.frame.color set $curcolor 275 276#Background scale (line) 277frame $w.frame.backg -borderwidth 0 278pack $w.frame.backg -in $w.frame -side top -fill x 279 280label $w.frame.backlabel -height 0 -text "Background:" -font $gedFont -anchor e -width $largeur 281# -foreground $back 282scale $w.frame.back -orient horizontal -from -2 -to $ncolors \ 283 -resolution 1.0 -command "setBack $w.frame.back" -tickinterval 0 -font $gedFont 284 285pack $w.frame.backlabel -in $w.frame.backg -side left 286pack $w.frame.back -in $w.frame.backg -side left -expand 1 -fill x -pady 0 -padx $smallPad 287$w.frame.back set $curback 288 289#Mark mode 290frame $w.frame.rectmarkmode -borderwidth 0 291pack $w.frame.rectmarkmode -in $w.frame -side top -fill x 292 293label $w.frame.markmodelabel -height 0 -text " Mark mode:" -width 0 -font $gedFont -anchor e -width $largeur 294checkbutton $w.frame.markmode -text "on" -indicatoron 1 \ 295 -variable curmarkmode -onvalue "on" -offvalue "off" \ 296 -command "toggleMarkmode $w.frame.markmode" -font $gedFont 297OnOffForeground $w.frame.markmode $curmarkmode 298 299pack $w.frame.markmodelabel -in $w.frame.rectmarkmode -side left 300pack $w.frame.markmode -in $w.frame.rectmarkmode -side left -fill x -pady 0 -padx $smallPad 301 302 303#Mark style 304frame $w.frame.rectmarkst -borderwidth 0 305pack $w.frame.rectmarkst -in $w.frame -side top -fill x 306 307label $w.frame.markstylelabel -height 0 -text "Mark style:" -width 0 -font $gedFont -anchor e -width $largeur 308combobox $w.frame.markstyle \ 309 -borderwidth 1 \ 310 -highlightthickness 1 \ 311 -maxheight 0 \ 312 -width 3 \ 313 -textvariable curmarkstyle \ 314 -editable false \ 315 -command [list SelectMarkStyle ] -font $gedFont 316eval $w.frame.markstyle list insert end [list "dot" "plus" "cross" "star" "filled diamond" "diamond" "triangle up" "triangle down" "diamond plus" "circle" "asterisk" "square" "triangle right" "triangle left" "pentagram"] 317 318 319pack $w.frame.markstylelabel -in $w.frame.rectmarkst -side left 320pack $w.frame.markstyle -in $w.frame.rectmarkst -expand 1 -fill x -pady 0 -padx $mediumPad 321 322 323#Mark size 324frame $w.frame.mksize -borderwidth 0 325pack $w.frame.mksize -side top -fill x 326 327combobox $w.frame.marksize \ 328 -borderwidth 1 \ 329 -highlightthickness 1 \ 330 -maxheight 0 \ 331 -width 3 \ 332 -textvariable curmarksize \ 333 -editable true \ 334 -command [list SelectMarkSize ] -font $gedFont 335eval $w.frame.marksize list insert end [list "0.5" "1.0" "2.0" "3.0" "4.0" "6.0" "8.0" "10.0" "15.0" "20.0" "25.0" "30.0"] 336 337 338#Add Mark size unit 339label $w.frame.marksizeunitlabel -height 0 -text "Mark size:" -font $gedFont -anchor e -width $largeur 340combobox $w.frame.marksizeunit \ 341 -borderwidth 1 \ 342 -highlightthickness 1 \ 343 -maxheight 0 \ 344 -width 10 \ 345 -textvariable curmarksizeunit \ 346 -editable false \ 347 -command [list SelectMarkSizeUnit ] -font $gedFont 348eval $w.frame.marksizeunit list insert end [list "point" "tabulated"] 349 350pack $w.frame.marksizeunitlabel -in $w.frame.mksize -side left 351pack $w.frame.marksizeunit -in $w.frame.mksize -side left -padx $mediumPad -fill x 352pack $w.frame.marksize -in $w.frame.mksize -side left -pady 0 -padx $mediumPad -fill x -expand 1 353 354 355#Mark foreground 356frame $w.frame.markf -borderwidth 0 357pack $w.frame.markf -in $w.frame -side top -fill x 358 359label $w.frame.markflabel -height 0 -text "Mark foreground:" -width 0 -font $gedFont -anchor e -width $largeur 360scale $w.frame.markforeground -orient horizontal -from -2 -to $ncolors \ 361 -resolution 1.0 -command "setMarkForeground $w.frame.markforeground" -tickinterval 0 -font $gedFont 362 363pack $w.frame.markflabel -in $w.frame.markf -side left 364pack $w.frame.markforeground -in $w.frame.markf -side left -expand 1 -fill x -pady 0 -padx $smallPad 365$w.frame.markforeground set $curmarkforeground 366 367 368#Mark background 369frame $w.frame.markb -borderwidth 0 370pack $w.frame.markb -in $w.frame -side top -fill x 371 372label $w.frame.markblabel -height 0 -text "Mark background:" -width 0 -font $gedFont -anchor e -width $largeur 373scale $w.frame.markbackground -orient horizontal -from -2 -to $ncolors \ 374 -resolution 1.0 -command "setMarkBackground $w.frame.markbackground" -tickinterval 0 -font $gedFont 375 376pack $w.frame.markblabel -in $w.frame.markb -side left 377pack $w.frame.markbackground -in $w.frame.markb -side left -expand 1 -fill x -pady 0 -padx $smallPad 378$w.frame.markbackground set $curmarkbackground 379 380#sep bar 381frame $w.sep -height 2 -borderwidth 1 -relief sunken 382pack $w.sep -fill both 383 384#exit button 385frame $w.buttons 386button $w.b -text Quit -command "DestroyGlobals; destroy $ww" -font $gedFont 387pack $w.b -side bottom 388 389########### Data onglet ########################################### 390################################################################### 391set w [Notebook:frame $uf.n Data] 392 393frame $w.frame -borderwidth 0 394pack $w.frame -anchor w -fill both 395 396#x 397frame $w.frame.lb1 -borderwidth 0 398pack $w.frame.lb1 -in $w.frame -side top -fill x 399label $w.frame.labelul -text "Upper-left point coordinates" -font $gedFont -anchor w 400pack $w.frame.labelul -in $w.frame.lb1 -side left 401 402frame $w.frame.lb2 -borderwidth 0 403pack $w.frame.lb2 -in $w.frame -side top -fill x 404 405frame $w.frame.lb21 -borderwidth 0 406pack $w.frame.lb21 -in $w.frame -side top -fill x 407 408frame $w.frame.lb22 -borderwidth 0 409pack $w.frame.lb22 -in $w.frame -side top -fill x 410 411label $w.frame.labelx -text "X:" -font $gedFont -anchor e -width $largeur 412entry $w.frame.datax -relief sunken -textvariable Xval -width 10 -font $gedFont 413label $w.frame.labely -text "Y:" -font $gedFont -anchor e -width $largeur 414entry $w.frame.datay -relief sunken -textvariable Yval -width 10 -font $gedFont 415label $w.frame.labelz -text "Z:" -font $gedFont -anchor e -width $largeur 416entry $w.frame.dataz -relief sunken -textvariable Zval -width 10 -font $gedFont 417 418pack $w.frame.labelx $w.frame.datax -in $w.frame.lb2 -side left -fill x -pady 0 -padx $mediumPad 419pack $w.frame.labely $w.frame.datay -in $w.frame.lb21 -side left -fill x -pady 0 -padx $mediumPad 420pack $w.frame.labelz $w.frame.dataz -in $w.frame.lb22 -side left -fill x -pady 0 -padx $mediumPad 421bind $w.frame.datax <Return> {SelectXval} 422bind $w.frame.datay <Return> {SelectYval} 423bind $w.frame.dataz <Return> {SelectZval} 424bind $w.frame.datax <KP_Enter> {SelectXval} 425bind $w.frame.datay <KP_Enter> {SelectYval} 426bind $w.frame.dataz <KP_Enter> {SelectZval} 427bind $w.frame.datax <FocusOut> {SelectXval} 428bind $w.frame.datay <FocusOut> {SelectYval} 429bind $w.frame.dataz <FocusOut> {SelectZval} 430 431#----------------------------# 432frame $w.frame.lb3 -borderwidth 0 433pack $w.frame.lb3 -in $w.frame -side top -fill x 434label $w.frame.labelwh -text "Width and height" -font $gedFont -anchor w 435pack $w.frame.labelwh -in $w.frame.lb3 -side left 436 437frame $w.frame.lb4 -borderwidth 0 438pack $w.frame.lb4 -in $w.frame -side top -fill x 439 440frame $w.frame.lb41 -borderwidth 0 441pack $w.frame.lb41 -in $w.frame -side top -fill x 442 443label $w.frame.labelw -text "W:" -font $gedFont -anchor e -width $largeur 444entry $w.frame.dataw -relief sunken -textvariable Wval -width 10 -font $gedFont 445label $w.frame.labelh -text "H:" -font $gedFont -anchor e -width $largeur 446entry $w.frame.datah -relief sunken -textvariable Hval -width 10 -font $gedFont 447 448pack $w.frame.labelw $w.frame.dataw -in $w.frame.lb4 -side left -fill x -pady 0 -padx $mediumPad 449pack $w.frame.labelh $w.frame.datah -in $w.frame.lb41 -side left -fill x -pady 0 -padx $mediumPad 450bind $w.frame.dataw <Return> {SelectWval} 451bind $w.frame.datah <Return> {SelectHval} 452bind $w.frame.dataw <KP_Enter> {SelectWval} 453bind $w.frame.datah <KP_Enter> {SelectHval} 454bind $w.frame.dataw <FocusOut> {SelectWval} 455bind $w.frame.datah <FocusOut> {SelectHval} 456 457#sep bar 458frame $w.sep -height 2 -borderwidth 1 -relief sunken 459pack $w.sep -fill both 460 461#exit button 462frame $w.buttons 463button $w.b -text Quit -command "destroy $ww" -font $gedFont 464pack $w.b -side bottom 465 466 467########### Clipping onglet ####################################### 468################################################################### 469 470set w9 [Notebook:frame $uf.n Clipping] 471 472frame $w9.frame -borderwidth 0 473pack $w9.frame -anchor w -fill both 474 475set letext "" 476 477#Clip state 478#frame $w9.frame.clpwarning -borderwidth 0 479 480frame $w9.frame.clpstat -borderwidth 0 481pack $w9.frame.clpstat -in $w9.frame -side top -fill x -pady 0 482 483label $w9.frame.cliplabel -height 0 -text "Clip state:" -width 0 -font $gedFont -anchor e -width $largeur 484combobox $w9.frame.clip \ 485 -borderwidth 1 \ 486 -highlightthickness 1 \ 487 -maxheight 0 \ 488 -width 8 \ 489 -textvariable curclipstate\ 490 -editable false \ 491 -command [list SelectClipState ] -font $gedFont 492eval $w9.frame.clip list insert end [list "on" "off" "clipgrf"] 493 494pack $w9.frame.cliplabel -in $w9.frame.clpstat -side left 495pack $w9.frame.clip -in $w9.frame.clpstat -side left -pady 0 -padx $mediumPad 496 497#clip box 498frame $w9.frame.lb1 -borderwidth 0 499pack $w9.frame.lb1 -in $w9.frame -side top -fill x 500label $w9.frame.labelul -text "Clip box : upper-left point coordinates" -font $gedFont 501pack $w9.frame.labelul -in $w9.frame.lb1 -side left 502 503frame $w9.frame.lb2 -borderwidth 0 504pack $w9.frame.lb2 -in $w9.frame -side top -fill x 505 506frame $w9.frame.lb21 -borderwidth 0 507pack $w9.frame.lb21 -in $w9.frame -side top -fill x 508 509frame $w9.frame.lb22 -borderwidth 0 510pack $w9.frame.lb22 -in $w9.frame -side top -fill x 511 512label $w9.frame.labelx -text "X:" -font $gedFont -anchor e -width $largeur 513entry $w9.frame.datax -relief sunken -textvariable Xclipbox -width 10 -font $gedFont 514label $w9.frame.labely -text "Y:" -font $gedFont -anchor e -width $largeur 515entry $w9.frame.datay -relief sunken -textvariable Yclipbox -width 10 -font $gedFont 516 517pack $w9.frame.labelx -in $w9.frame.lb2 -side left 518pack $w9.frame.datax -in $w9.frame.lb2 -side left -pady 0 -padx $mediumPad 519pack $w9.frame.labely -in $w9.frame.lb21 -side left 520pack $w9.frame.datay -in $w9.frame.lb21 -side left -pady 0 -padx $mediumPad 521bind $w9.frame.datax <Return> "SelectClipBox $w9.frame" 522bind $w9.frame.datay <Return> "SelectClipBox $w9.frame" 523bind $w9.frame.datax <KP_Enter> "SelectClipBox $w9.frame" 524bind $w9.frame.datay <KP_Enter> "SelectClipBox $w9.frame" 525 526#----------------------------# 527frame $w9.frame.lb3 -borderwidth 0 528pack $w9.frame.lb3 -in $w9.frame -side top -fill x 529label $w9.frame.labelwh -text "Clip box : width and height" -font $gedFont 530pack $w9.frame.labelwh -in $w9.frame.lb3 -side left 531 532frame $w9.frame.lb4 -borderwidth 0 533pack $w9.frame.lb4 -in $w9.frame -side top -fill x 534 535frame $w9.frame.lb41 -borderwidth 0 536pack $w9.frame.lb41 -in $w9.frame -side top -fill x 537 538label $w9.frame.labelw -text "W:" -font $gedFont -anchor e -width $largeur 539entry $w9.frame.dataw -relief sunken -textvariable Wclipbox -width 10 -font $gedFont 540label $w9.frame.labelh -text "H:" -font $gedFont -anchor e -width $largeur 541entry $w9.frame.datah -relief sunken -textvariable Hclipbox -width 10 -font $gedFont 542 543pack $w9.frame.labelw -in $w9.frame.lb4 -side left 544pack $w9.frame.dataw -in $w9.frame.lb4 -side left -pady 0 -padx $mediumPad 545pack $w9.frame.labelh -in $w9.frame.lb41 -side left 546pack $w9.frame.datah -in $w9.frame.lb41 -side left -pady 0 -padx $mediumPad 547bind $w9.frame.dataw <Return> "SelectClipBox $w9.frame" 548bind $w9.frame.datah <Return> "SelectClipBox $w9.frame" 549bind $w9.frame.dataw <KP_Enter> "SelectClipBox $w9.frame" 550bind $w9.frame.datah <KP_Enter> "SelectClipBox $w9.frame" 551 552 553frame $w9.frame.warning 554label $w9.frame.mesgwarning -justify left -textvariable letext -font $gedFont 555$w9.frame.mesgwarning config -foreground red 556pack $w9.frame.mesgwarning -in $w9.frame.warning 557pack $w9.frame.warning -in $w9.frame 558 559#sep bar 560frame $w9.sep -height 2 -borderwidth 1 -relief sunken 561pack $w9.sep -fill both 562 563 564#exit button 565frame $w9.buttons 566button $w9.b -text Quit -command "DestroyGlobals; destroy $ww" -font $gedFont 567pack $w9.b -side bottom 568 569 570 571pack $sw $pw1 -fill both -expand yes 572pack $titf1 -padx 4 -side left -fill both -expand yes 573pack $topf -fill both -pady 2 -expand yes 574 575 576 577#proc associes 578proc setColor {w index} { 579 global RED BLUE GREEN 580 variable REDCOL 581 variable GRECOL 582 variable BLUCOL 583 584 #ScilabEval "global ged_handle;" 585 if { $index == -2 } { 586 ScilabEval "global ged_handle; if ged_handle.foreground <> $index then ged_handle.foreground=$index; end;" 587 #like $index==-2: display white color 588 set color [format \#%02x%02x%02x 255 255 255] 589 $w config -activebackground $color -troughcolor $color 590 } elseif { $index == -1 } { 591 ScilabEval "global ged_handle; if ged_handle.foreground <> $index then ged_handle.foreground=$index; end;" 592 #like $index==-1: display black color 593 set color [format \#%02x%02x%02x 0 0 0] 594 $w config -activebackground $color -troughcolor $color 595 } elseif { $index == 0 } { 596 ScilabEval "global ged_handle; if ged_handle.foreground <> $index then ged_handle.foreground=$index; end;" 597 #like $index==1: display first color 598 set REDCOL $RED(1) 599 set GRECOL $GREEN(1) 600 set BLUCOL $BLUE(1) 601 set color [format \#%02x%02x%02x [expr int($REDCOL*255)] [expr int($GRECOL*255)] [expr int($BLUCOL*255)]] 602 603 $w config -activebackground $color -troughcolor $color 604 } else { 605 ScilabEval "global ged_handle; if ged_handle.foreground <> $index then ged_handle.foreground=$index; end;" 606 607 set REDCOL $RED($index) 608 set GRECOL $GREEN($index) 609 set BLUCOL $BLUE($index) 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 616proc setBack {w index} { 617 global RED BLUE GREEN 618 variable REDCOL 619 variable GRECOL 620 variable BLUCOL 621 622 #ScilabEval "global ged_handle;" 623 if { $index == -2 } { 624 ScilabEval "global ged_handle; if ged_handle.background <> $index then ged_handle.background=$index; end;" 625 #like $index==-2: display white color 626 set color [format \#%02x%02x%02x 255 255 255] 627 $w config -activebackground $color -troughcolor $color 628 } elseif { $index == -1 } { 629 ScilabEval "global ged_handle; if ged_handle.background <> $index then ged_handle.background=$index; end;" 630 #like $index==-1: display black color 631 set color [format \#%02x%02x%02x 0 0 0] 632 $w config -activebackground $color -troughcolor $color 633 } elseif { $index == 0 } { 634 ScilabEval "global ged_handle; if ged_handle.background <> $index then ged_handle.background=$index; end;" 635 #like $index==1: display first color 636 set REDCOL $RED(1) 637 set GRECOL $GREEN(1) 638 set BLUCOL $BLUE(1) 639 640 set color [format \#%02x%02x%02x [expr int($REDCOL*255)] [expr int($GRECOL*255)] [expr int($BLUCOL*255)]] 641 642 $w config -activebackground $color -troughcolor $color 643 } else { 644 ScilabEval "global ged_handle; if ged_handle.background <> $index then ged_handle.background=$index; end;" 645 646 set REDCOL $RED($index) 647 set GRECOL $GREEN($index) 648 set BLUCOL $BLUE($index) 649 650 set color [format \#%02x%02x%02x [expr int($REDCOL*255)] [expr int($GRECOL*255)] [expr int($BLUCOL*255)]] 651 652 $w config -activebackground $color -troughcolor $color 653 654 } 655} 656 657 658proc setThickness {w thick} { 659ScilabEval "global ged_handle;ged_handle.thickness=$thick;" 660} 661 662proc toggleVisibility { frame } { 663 global curvis 664 ScilabEval "global ged_handle;ged_handle.visible='$curvis'" 665 666 OnOffForeground $frame $curvis 667} 668proc toggleFillmode { frame } { 669 global curfillmode 670 ScilabEval "global ged_handle;ged_handle.fill_mode='$curfillmode'" 671 672 OnOffForeground $frame $curfillmode 673} 674 675proc SelectLineStyle {w args} { 676global curlinestyle 677ScilabEval "setLineStyle('$curlinestyle')" 678} 679 680proc SelectMarkStyle {w args} { 681global curmarkstyle 682global curmarkmode 683ScilabEval "setMarkStyle('$curmarkstyle')" 684set curmarkmode "on" 685#ScilabEval "global ged_handle;ged_handle.mark_mode='$curmarkmode'" 686 687} 688 689proc toggleMarkmode { frame } { 690 global curmarkmode 691 ScilabEval "global ged_handle;ged_handle.mark_mode='$curmarkmode'" 692 693 OnOffForeground $frame $curmarkmode 694} 695 696 697proc SelectXval {} { 698global Xval 699ScilabEval "setXval($Xval)" 700} 701 702 703proc SelectYval {} { 704global Yval 705ScilabEval "setYval($Yval)" 706} 707 708 709proc SelectZval {} { 710global Zval 711ScilabEval "setZval($Zval)" 712} 713 714 715 716proc SelectWval {} { 717global Wval 718ScilabEval "setWval($Wval)" 719} 720 721 722 723proc SelectHval {} { 724global Hval 725ScilabEval "setHval($Hval)" 726} 727 728 729#Clipping proc for all entities (clip box and clip state fields) 730proc SelectClipBox { w } { 731 global Xclipbox Yclipbox Wclipbox Hclipbox curclipstate letext 732 if { ($Xclipbox == "") || ($Yclipbox == "") || 733 ($Wclipbox == "") || ($Hclipbox == "") } { 734 if { [info exists text] } { 735 unset text 736 } 737 set letext "Note that all clip box fields must be filled." 738 739 } else { 740 if { [info exists text] } { 741 unset text 742 } 743 set letext "" 744 745 ScilabEval "global ged_handle;ged_handle.clip_box=\[$Xclipbox $Yclipbox $Wclipbox $Hclipbox\]" 746 set curclipstate "on" 747 } 748} 749 750proc SelectClipState {w args} { 751global curclipstate Xclipbox Yclipbox Wclipbox Hclipbox 752global old_Xclipbox old_Yclipbox old_Wclipbox old_Hclipbox 753ScilabEval "global ged_handle;ged_handle.clip_state='$curclipstate';" 754 if { $curclipstate == "off" } { 755 set old_Xclipbox $Xclipbox 756 set old_Yclipbox $Yclipbox 757 set old_Wclipbox $Wclipbox 758 set old_Hclipbox $Hclipbox 759 set Xclipbox "" 760 set Yclipbox "" 761 set Wclipbox "" 762 set Hclipbox "" 763 } else { 764 set Xclipbox $old_Xclipbox 765 set Yclipbox $old_Yclipbox 766 set Wclipbox $old_Wclipbox 767 set Hclipbox $old_Hclipbox 768 } 769} 770 771 772proc SavePreferences { } { 773 global ged_listofpref 774 global envSCIHOME MAIN_WINDOW_POSITION TICK_WINDOW_POSITION 775 global ww msdos 776 777 ScilabEval "DestroyGlobals()" "seq" 778 779 if { $msdos == "F" } { 780#unix mandrake (at least) needs this offset 781#test other unix distribution to see (red hat, suse...) 782 set xoffset -5 783 set yoffset -26 784 } else { 785 set xoffset 0 786 set yoffset 0 787 } 788 789 set x [eval {winfo x $ww}] 790 set y [eval {winfo y $ww}] 791 set MAIN_WINDOW_POSITION "+[expr $x+$xoffset]+[expr $y+$yoffset]" 792 793 #save preferences (position...) 794 set preffilename [file join $envSCIHOME .GedPreferences.tcl] 795 catch { 796 set preffile [open $preffilename w] 797 foreach opt $ged_listofpref { 798 global $opt 799 puts $preffile [concat "set $opt " [set $opt]] 800 # puts [concat "set $opt" [set $opt]] 801 } 802 close $preffile 803 } 804} 805 806proc DestroyGlobals { } { 807 ScilabEval "DestroyGlobals()" "seq" 808 809 SavePreferences 810} 811 812 813proc setMarkForeground {w index} { 814 global RED BLUE GREEN 815 variable REDCOL 816 variable GRECOL 817 variable BLUCOL 818 819 #ScilabEval "global ged_handle;" 820 if { $index == -2 } { 821 ScilabEval "global ged_handle; if ged_handle.mark_foreground <> $index then ged_handle.mark_foreground=$index; end;" 822 #like $index==-2: display white color 823 set color [format \#%02x%02x%02x 255 255 255] 824 $w config -activebackground $color -troughcolor $color 825 } elseif { $index == -1 } { 826 ScilabEval "global ged_handle; if ged_handle.mark_foreground <> $index then ged_handle.mark_foreground=$index; end;" 827 #like $index==-1: display black color 828 set color [format \#%02x%02x%02x 0 0 0] 829 $w config -activebackground $color -troughcolor $color 830 } elseif { $index == 0 } { 831 ScilabEval "global ged_handle; if ged_handle.mark_foreground <> $index then ged_handle.mark_foreground=$index; end;" 832 #like $index==1: display first color 833 set REDCOL $RED(1) 834 set GRECOL $GREEN(1) 835 set BLUCOL $BLUE(1) 836 837 set color [format \#%02x%02x%02x [expr int($REDCOL*255)] [expr int($GRECOL*255)] [expr int($BLUCOL*255)]] 838 839 $w config -activebackground $color -troughcolor $color 840 } else { 841 ScilabEval "global ged_handle; if ged_handle.mark_foreground <> $index then ged_handle.mark_foreground=$index; end;" 842 843 set REDCOL $RED($index) 844 set GRECOL $GREEN($index) 845 set BLUCOL $BLUE($index) 846 847 set color [format \#%02x%02x%02x [expr int($REDCOL*255)] [expr int($GRECOL*255)] [expr int($BLUCOL*255)]] 848 849 $w config -activebackground $color -troughcolor $color 850 851 } 852} 853 854 855 856proc setMarkBackground {w index} { 857 global RED BLUE GREEN 858 variable REDCOL 859 variable GRECOL 860 variable BLUCOL 861 862 #ScilabEval "global ged_handle;" 863 if { $index == -2 } { 864 ScilabEval "global ged_handle; ged_handle.mark_background=$index;" 865 #like $index==-2: display white color 866 set color [format \#%02x%02x%02x 255 255 255] 867 $w config -activebackground $color -troughcolor $color 868 } elseif { $index == -1 } { 869 ScilabEval "global ged_handle; ged_handle.mark_background=$index;" 870 #like $index==-1: display black color 871 set color [format \#%02x%02x%02x 0 0 0] 872 $w config -activebackground $color -troughcolor $color 873 } elseif { $index == 0 } { 874 ScilabEval "global ged_handle; ged_handle.mark_background=$index;" 875 #like $index==1: display first color 876 set REDCOL $RED(1) 877 set GRECOL $GREEN(1) 878 set BLUCOL $BLUE(1) 879 880 set color [format \#%02x%02x%02x [expr int($REDCOL*255)] [expr int($GRECOL*255)] [expr int($BLUCOL*255)]] 881 882 $w config -activebackground $color -troughcolor $color 883 } else { 884 ScilabEval "global ged_handle; ged_handle.mark_background=$index;" 885 886 set REDCOL $RED($index) 887 set GRECOL $GREEN($index) 888 set BLUCOL $BLUE($index) 889 890 set color [format \#%02x%02x%02x [expr int($REDCOL*255)] [expr int($GRECOL*255)] [expr int($BLUCOL*255)]] 891 892 $w config -activebackground $color -troughcolor $color 893 894 } 895} 896 897 898proc toggleMarkmode { frame } { 899 global curmarkmode 900 ScilabEval "global ged_handle;ged_handle.mark_mode='$curmarkmode'" 901 902 OnOffForeground $frame $curmarkmode 903} 904 905#Added on the 21.01.05 906proc toggleLinemode { frame } { 907 global curlinemode 908 ScilabEval "global ged_handle;ged_handle.line_mode='$curlinemode'" 909 910 OnOffForeground $frame $curlinemode 911} 912 913 914proc SelectMarkSizeUnit {w args} { 915 global curmarksizeunit 916 ScilabEval "global ged_handle;ged_handle.mark_size_unit='$curmarksizeunit'" 917} 918 919 920 921proc SelectMarkSize {w args} { 922 global curmarksize 923 ScilabEval "global ged_handle;ged_handle.mark_size=$curmarksize" 924} 925 926 927proc SelectThickness {w args} { 928 global curthick 929 ScilabEval "global ged_handle;ged_handle.thickness=$curthick;" 930} 931