# Scilab ( http://www.scilab.org/ ) - This file is part of Scilab # Copyright (C) 2004 - INRIA - Fabrice Leray # Copyright (C) 2006 - INRIA - Jean-Baptiste Silvy # # This file must be used under the terms of the CeCILL. # This source file is licensed as described in the file COPYING, which # you should have received as part of this distribution. The terms # are also available at # http://www.cecill.info/licences/Licence_CeCILL_V2.1-en.txt set pwd [pwd] cd [file dirname [info script]] variable DEMODIR [pwd] cd $pwd variable DEMODIR lappend ::auto_path [file dirname "$env(SCIPATH)/modules/tclsci/tcl/BWidget"] namespace inscope :: package require BWidget package require BWidget set sourcedir [file join "$env(SCIPATH)" "modules" "tclsci" "tcl" "utils"] set sourcedir2 [file join "$env(SCIPATH)" "modules" "graphics" "tcl" "ged"] source [file join $sourcedir Notebook.tcl] source [file join $sourcedir Combobox.tcl] source [file join $sourcedir2 ObjectsBrowser.tcl] package require combobox 2.3 catch {namespace import combobox::*} #package require lemonTree catch {namespace import LemonTree::*} global envSCIHOME MAIN_WINDOW_POSITION TICK_WINDOW_POSITION msdos set ged_listofpref "MAIN_WINDOW_POSITION TICK_WINDOW_POSITION" set MAIN_WINDOW_POSITION "+0+0" set TICK_WINDOW_POSITION "+0+0" set envSCIHOME $SCIHOME set preffilename $envSCIHOME/.GedPreferences.tcl catch {source $preffilename} global SELOBJECT global ged_handle_list_size global lalist global curgedindex global curgedobject global curvis global curforeground ncolors curfontstyle curfontsize curfontangle curtextbox1 curtextbox2 global curtextboxmode curtext global RED BLUE GREEN ncolors #To update foreground color grey ("off"), black ("on") for checkbutton boxes proc OnOffForeground { frame flag } { if { $flag == "on" } { $frame configure -foreground black } else { $frame configure -foreground grey } } set NBheight 200 set NBwidth 220 set Wheight [expr $NBheight + 115] set Wwidth [expr $NBwidth + 270] set smallPad 4 set mediumPad 8 #create the font we will use set gedFont {Arial -12} set ww .axes catch {destroy $ww} toplevel $ww wm title $ww "Legend Object" wm iconname $ww "LO" wm geometry $ww [expr $Wwidth]x[expr $Wheight]$MAIN_WINDOW_POSITION wm maxsize $ww $Wwidth $Wheight wm protocol $ww WM_DELETE_WINDOW "DestroyGlobals; destroy $ww " set topf [frame $ww.topf] set titf1 [TitleFrame $topf.titf1 -text "Graphic Editor" -font $gedFont] set parent [$titf1 getframe] set pw1 [PanedWindow $parent.pw -side top] set pane3 $pw1 # Make a frame scrollable set sw [ScrolledWindow $pane3.sw -relief sunken -borderwidth 2] # pack $sw -in .sw -fill both -expand true set sf [ScrollableFrame $sw.f] $sw setwidget $sf set uf [$sf getframe] set w $uf set fra [frame $w.frame -borderwidth 0] pack $fra -anchor w -fill both #------------------------------------------------ set theframe $fra #adding 15.06.2005 set topflabel [frame $theframe.topflabel] set titf1label [TitleFrame $topflabel.titflabel1 -text "Objects Browser" -font $gedFont] set titf1axes [TitleFrame $topflabel.titfaxes1 -text "Object Properties" -font $gedFont] set w [$titf1label getframe] pack $titf1label -padx 4 -side left -fill both -expand yes pack $topflabel -fill x -pady 0 pack $titf1axes -pady 0 -padx 4 -fill both -expand yes frame $w.frame -borderwidth 0 pack $w.frame -anchor w -fill both #end adding set wfortree $w for {set i 1} {$i<=$ged_handle_list_size} {incr i} { set OBJECTSARRAY($i) $SELOBJECT($i) } set curgedobject $SELOBJECT($curgedindex) set tree [Tree $wfortree.tree \ -yscrollcommand {$wfortree.y set} -xscrollcommand {$wfortree.x set} \ -width 20 -height 10 \ -background white -opencmd {LemonTree::open $wfortree.tree} \ -selectbackground blue -selectforeground white ] pack [scrollbar $wfortree.x -orient horiz -command {$wfortree.tree xview}] -side bottom -fill x pack [scrollbar $wfortree.y -command {$wfortree.tree yview}] -side right -fill y pack $tree -fill both -expand 1 -side left $tree bindText <1> {LemonTree::Info $tree} $tree bindImage <1> {LemonTree::Info $tree} LemonTree::add $tree root FIGURE currentfigure "Figure(1)" # I open the tree to browse all the nodes (to know what nodes I have and what their names are) $tree opentree n1 set allnodes [$tree selection get] #I close quickly the tree because openreeatnode expanded the tree... $tree closetree n1 # I directly point onto the current curgedobject (current Axes or Figure or picked entity) LemonTree::finddata $tree $allnodes $curgedobject #adding 15.06.2005 set w [$titf1axes getframe] set uf $w #------------------------------------------------ set largeur 9 Notebook:create $uf.n -pages {"Style & Data"} -pad 0 -height $NBheight -width $NBwidth pack $uf.n -in $uf -fill both -expand 1 ########### Style onglet ########################################## ################################################################### set w [Notebook:frame $uf.n "Style & Data"] frame $w.frame -borderwidth 0 pack $w.frame -anchor w -fill both #visibility frame $w.frame.vis -borderwidth 0 pack $w.frame.vis -in $w.frame -side top -fill x label $w.frame.vislabel -text "Visibility:" -font $gedFont -anchor e -width $largeur checkbutton $w.frame.visib -text "on"\ -variable curvis -onvalue "on" -offvalue "off" \ -command "toggleVis $w.frame.visib" -font $gedFont OnOffForeground $w.frame.visib $curvis pack $w.frame.vislabel -in $w.frame.vis -side left pack $w.frame.visib -in $w.frame.vis -side left -padx $smallPad #x label frame $w.frame.lbx -borderwidth 0 pack $w.frame.lbx -in $w.frame -side top -fill x -pady 0 label $w.frame.xlabel -text "Text:" -font $gedFont -anchor e -width $largeur entry $w.frame.xlabel1 -relief sunken -textvariable curtext -width 20 -font $gedFont pack $w.frame.xlabel -in $w.frame.lbx -side left pack $w.frame.xlabel1 -in $w.frame.lbx -pady 0 -padx $mediumPad bind $w.frame.xlabel1 {setText} bind $w.frame.xlabel1 {setText} bind $w.frame.xlabel1 {setText} ############### #Font color frame $w.frame.fontcol -borderwidth 0 pack $w.frame.fontcol -in $w.frame -side top -fill x -pady 0 label $w.frame.fontcolorlabel -height 0 -text "Color:" -font $gedFont -anchor e -width $largeur scale $w.frame.fontcolor -orient horizontal -from -2 -to $ncolors \ -resolution 1.0 -command "setFontColor $w.frame.fontcolor" -tickinterval 0 -font $gedFont pack $w.frame.fontcolorlabel -in $w.frame.fontcol -side left pack $w.frame.fontcolor -in $w.frame.fontcol -side left -expand 1 -fill x -pady 0 -padx $smallPad $w.frame.fontcolor set $curforeground #Fontsize scale frame $w.frame.fontssz -borderwidth 0 pack $w.frame.fontssz -in $w.frame -side top -fill x -pady 0 label $w.frame.fontsizelabel -height 0 -text "Font size:" -width 0 -font $gedFont -anchor e -width $largeur scale $w.frame.fontsize -orient horizontal -from 0 -to 5 \ -resolution 1.0 -command "setFontSize $w.frame.fontsize" -tickinterval 0 -font $gedFont pack $w.frame.fontsizelabel -in $w.frame.fontssz -side left pack $w.frame.fontsize -in $w.frame.fontssz -expand 1 -fill x -pady 0 -padx $smallPad $w.frame.fontsize set $curfontsize #Fonts Style frame $w.frame.fontsst -borderwidth 0 pack $w.frame.fontsst -in $w.frame -side top -fill x -pady 0 label $w.frame.stylelabel -height 0 -text "Font style:" -width 0 -font $gedFont -anchor e -width $largeur combobox $w.frame.style \ -borderwidth 1 \ -highlightthickness 1 \ -maxheight 0 \ -width 3 \ -textvariable curfontstyle \ -editable false \ -command [list SelectFontStyle] -font $gedFont eval $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"] pack $w.frame.stylelabel -in $w.frame.fontsst -side left pack $w.frame.style -in $w.frame.fontsst -expand 1 -fill x -pady 1 -padx $mediumPad #sep bar frame $w.sep -height 2 -borderwidth 1 -relief sunken pack $w.sep -fill both #exit button frame $w.buttons pack $w.buttons -side bottom -fill x -pady 0 button $w.buttons.dismiss -text Quit -command "DestroyGlobals; destroy $ww" -font $gedFont pack $w.buttons.dismiss -side bottom -expand 1 pack $sw $pw1 -fill both -expand yes pack $titf1 -padx 4 -side left -fill both -expand yes pack $topf -fill both -pady 2 -expand yes #proc associes proc toggleVis { frame } { global curvis ScilabEval "global ged_handle;ged_handle.visible='$curvis'" OnOffForeground $frame $curvis } proc setFontColor {w index} { global RED BLUE GREEN variable REDCOL variable GRECOL variable BLUCOL #ScilabEval "global ged_handle;" if { $index == -2 } { ScilabEval "global ged_handle; if ged_handle.foreground <> $index then ged_handle.foreground=$index; end;" #like $index==-2: display white color set color [format \#%02x%02x%02x 255 255 255] $w config -activebackground $color -troughcolor $color } elseif { $index == -1 } { ScilabEval "global ged_handle; if ged_handle.foreground <> $index then ged_handle.foreground=$index; end;" #like $index==-1: display black color set color [format \#%02x%02x%02x 0 0 0] $w config -activebackground $color -troughcolor $color } elseif { $index == 0 } { ScilabEval "global ged_handle; if ged_handle.foreground <> $index then ged_handle.foreground=$index; end;" #like $index==1: display first color set REDCOL $RED(1) set GRECOL $GREEN(1) set BLUCOL $BLUE(1) set color [format \#%02x%02x%02x [expr int($REDCOL*255)] [expr int($GRECOL*255)] [expr int($BLUCOL*255)]] $w config -activebackground $color -troughcolor $color } else { ScilabEval "global ged_handle; if ged_handle.foreground <> $index then ged_handle.foreground=$index; end;" set REDCOL $RED($index) set GRECOL $GREEN($index) set BLUCOL $BLUE($index) set color [format \#%02x%02x%02x [expr int($REDCOL*255)] [expr int($GRECOL*255)] [expr int($BLUCOL*255)]] $w config -activebackground $color -troughcolor $color } } proc setFontSize {w fs} { ScilabEval "global ged_handle;if ged_handle.font_size <> $fs then ged_handle.font_size=$fs; end;" } proc SelectFontStyle {w args} { global curfontstyle ScilabEval "setFontStyle('$curfontstyle')" } proc setText {} { global curtext ScilabEval "global ged_handle;ged_handle.text='$curtext'" } proc SavePreferences { } { global ged_listofpref global envSCIHOME MAIN_WINDOW_POSITION TICK_WINDOW_POSITION global ww msdos ScilabEval "DestroyGlobals()" "seq" if { $msdos == "F" } { #unix mandrake (at least) needs this offset #test other unix distribution to see (red hat, suse...) set xoffset -5 set yoffset -26 } else { set xoffset 0 set yoffset 0 } set x [eval {winfo x $ww}] set y [eval {winfo y $ww}] set MAIN_WINDOW_POSITION "+[expr $x+$xoffset]+[expr $y+$yoffset]" #save preferences (position...) set preffilename [file join $envSCIHOME .GedPreferences.tcl] catch { set preffile [open $preffilename w] foreach opt $ged_listofpref { global $opt puts $preffile [concat "set $opt " [set $opt]] # puts [concat "set $opt" [set $opt]] } close $preffile } } proc DestroyGlobals { } { ScilabEval "DestroyGlobals()" "seq" SavePreferences }