#------------------------------------------------------------------------------- # Module: mainIconbars.tk # Activation: Loaded during GOBLET startup # Scope: Main iconbar # Iconbars for navigator, editor and tracing mode # Handling of popup infos #------------------------------------------------------------------------------- proc MakeBalloonRel {label wdName xRel yRel} { global BalloonHelp if {!$BalloonHelp} {return} destroy .balloon toplevel .balloon wm geometry .balloon \ 100x20+[expr [winfo rootx $wdName]+$xRel]+[expr [winfo rooty $wdName]+$yRel] message .balloon.text -text $label -bg yellow -relief solid -justify left \ -aspect 800 pack .balloon.text -fill both append wdSize [winfo reqwidth .balloon.text] x [winfo reqheight .balloon.text] wm geometry .balloon \ $wdSize+[expr [winfo rootx $wdName]+$xRel]+[expr [winfo rooty $wdName]+$yRel] wm overrideredirect .balloon 1 } proc MakeIcon {bar wdName imageName command popup height pos nr} { global IconOffset destroy $wdName if {[expr 74>$height]} {return 0} set i $IconOffset($bar) if {$pos<$i} {return 0} if {[expr 36+38*($pos-$i+1)>$height] && $i>1 && $pos<$nr} {return 0} if {[expr 18+38*($pos-$i+1)>$height] && $i>1 && $pos==$nr} {return 0} if {[expr 18+38*($pos-$i+1)>$height] && $i==1 && $pos<$nr} {return 0} if {[expr 38*($pos-$i+1)>$height] && $i==1 && $pos==$nr} {return 0} if {![winfo exists $wdName]} { button $wdName -image $imageName -relief raised -borderwidth 1 -command $command bind $wdName [list MakeBalloonRel $popup $wdName 32 40] bind $wdName {DestroyBalloon} } grid $wdName \ -row $pos -column 0 -rowspan 1 -columnspan 1 -sticky news eval grid rowconfig [winfo parent $wdName] 0 -weight 1 -minsize 0 eval grid columnconfig [winfo parent $wdName] 0 -weight 1 -minsize 0 return 1 } image create photo arrow_up -file [file join $GoblinTclPath arrowUp.gif] image create photo arrow_down -file [file join $GoblinTclPath arrowDown.gif] proc MakeArrowUp {bar wdName height nr} { global IconOffset CanvasView destroy $wdName if {![info exists IconOffset] || ![info exists IconOffset($bar)]} { set IconOffset($bar) 1 } else { if {![expr 36+38*$nr>$height]} {set IconOffset($bar) 1} } if {$IconOffset($bar)==1 || [expr 74>$height]} { return 0 } if {![winfo exists $wdName]} { button $wdName -image arrow_up -relief raised -borderwidth 1 \ -command [subst {incr IconOffset($bar) -1 ; Make$bar}] } grid $wdName \ -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news eval grid rowconfig [winfo parent $wdName] 0 -weight 1 -minsize 0 eval grid columnconfig [winfo parent $wdName] 0 -weight 1 -minsize 0 grid rowconfig $CanvasView 0 -weight 1 -minsize 0 grid columnconfig $CanvasView 0 -weight 1 -minsize 0 return 1 } proc MakeArrowDown {bar wdName height nr} { global IconOffset CanvasView destroy $wdName if {[expr 74>$height]} {return 0} set i $IconOffset($bar) if {$i>1 && ![expr 18+38*($nr-$i+1)>$height]} {return 0} if {$i==1 && ![expr 38*($nr-$i+1)>$height]} {return 0} if {![winfo exists $wdName]} { button $wdName -image arrow_down -relief raised -borderwidth 1 \ -command [subst {incr IconOffset($bar) 1 ; Make$bar}] } grid $wdName \ -row [expr $nr+1] -column 0 -rowspan 1 -columnspan 1 -sticky news eval grid rowconfig [winfo parent $wdName] 0 -weight 1 -minsize 0 eval grid columnconfig [winfo parent $wdName] 0 -weight 1 -minsize 0 return 1 } proc MakeHelp {label} { global StatusInfo set StatusInfo $label } proc DestroyBalloon {} { destroy .balloon } image create photo tool_open -file [file join $GoblinTclPath fileOpen.gif] image create photo tool_save -file [file join $GoblinTclPath fileSave.gif] image create photo tool_print -file [file join $GoblinTclPath filePrint.gif] image create photo tool_log -file [file join $GoblinTclPath toggleScript.gif] image create photo tool_edit -file [file join $GoblinTclPath toggleEditor.gif] image create photo tool_display -file [file join $GoblinTclPath toggleBrowser.gif] image create photo tool_keep -file [file join $GoblinTclPath camera.gif] image create photo tool_reset -file [file join $GoblinTclPath fileReset.gif] image create photo start_solver -file [file join $GoblinTclPath lightsRed.gif] image create photo running_solver -file [file join $GoblinTclPath lightsGreen.gif] image create photo stopped_solver -file [file join $GoblinTclPath lightsYellow.gif] set Iconbar .iconbar1 frame $Iconbar -relief raised -borderwidth 1 pack $Iconbar -side left -fill y proc MakeToolbar {} { global Iconbar Toolbar ThisGraph set Toolbar $Iconbar.toolbar if {![winfo exists $Toolbar]} { frame $Toolbar pack $Toolbar -side top -fill y } if {![winfo ismapped $Iconbar]} {tkwait visibility $Iconbar} set height [winfo height $Iconbar] bind $Iconbar MakeToolbar MakeArrowUp Toolbar $Toolbar.up $height 9 MakeIcon Toolbar $Toolbar.open tool_open SaveAndOpen \ {open...} $height 1 9 MakeIcon Toolbar $Toolbar.save tool_save SaveFile \ {save object} $height 2 9 MakeIcon Toolbar $Toolbar.print tool_print PrintLayout2 \ {print layout} $height 3 9 MakeIcon Toolbar $Toolbar.log tool_log ViewMessenger \ {view/update messenger} $height 4 9 MakeIcon Toolbar $Toolbar.edit tool_edit { if {[$ThisGraph is mip]} { DisplayObject } else { if {[$ThisGraph #nodes]==0} { AddNodes } else { if {[$ThisGraph max cx]<=0 && [$ThisGraph max cy]<=0} { MoveNodes } else { DisplayObject } } } } {view/edit object} $height 5 9 MakeIcon Toolbar $Toolbar.display tool_display ToggleBrowser \ {image navigator} $height 6 9 MakeIcon Toolbar $Toolbar.keep tool_keep DisplayNewLayout \ {snapshot image} $height 7 9 MakeIcon Toolbar $Toolbar.reset tool_reset RestartEngine \ {reset browser} $height 8 9 MakeIcon Toolbar $Toolbar.solve start_solver StartOrStop \ {stop/restart solver} $height 9 9 MakeArrowDown Toolbar $Toolbar.down $height 9 } image create photo nav_first -file [file join $GoblinTclPath browseFirst.gif] image create photo nav_prev -file [file join $GoblinTclPath browsePrev.gif] image create photo nav_minus -file [file join $GoblinTclPath browseMinus.gif] image create photo nav_next -file [file join $GoblinTclPath browseNext.gif] image create photo nav_plus -file [file join $GoblinTclPath browsePlus.gif] image create photo nav_last -file [file join $GoblinTclPath browseLast.gif] image create photo nav_delete -file [file join $GoblinTclPath browseDelete.gif] proc MakeNavigationBar {} { global FileCounter goblinTraceCounter NavigationBar Mode CanvasToolbar set NavigationBar $CanvasToolbar.nav if {[string equal $Mode "display object"]} { destroy $NavigationBar return } if {![winfo exists $NavigationBar]} { frame $NavigationBar pack $NavigationBar -side top } if {![winfo ismapped $CanvasToolbar]} {tkwait visibility $CanvasToolbar} set height [winfo height $CanvasToolbar] bind $CanvasToolbar MakeNavigationBar MakeArrowUp NavigationBar $NavigationBar.up $height 7 MakeIcon NavigationBar $NavigationBar.first nav_first { if {$FileCounter > 1} { set FileCounter 1 Navigate minus } } {first image} $height 1 7 MakeIcon NavigationBar $NavigationBar.m10 nav_minus { if {$FileCounter > 10} { set FileCounter [expr {$FileCounter-10}] Navigate minus } } {image -10} $height 3 7 MakeIcon NavigationBar $NavigationBar.prev nav_prev { if {$FileCounter > 1} { set FileCounter [expr {$FileCounter-1}] Navigate minus } } {image -1} $height 2 7 MakeIcon NavigationBar $NavigationBar.next nav_next { if {$FileCounter < $goblinTraceCounter} { set FileCounter [expr {$FileCounter+1}] Navigate plus } } {image +1} $height 5 7 MakeIcon NavigationBar $NavigationBar.p10 nav_plus { if {$FileCounter < [expr {$goblinTraceCounter-9}]} { set FileCounter [expr {$FileCounter+10}] Navigate plus } } {image +10} $height 4 7 MakeIcon NavigationBar $NavigationBar.last nav_last { if {$FileCounter < $goblinTraceCounter} { set FileCounter $goblinTraceCounter Navigate plus } } {last image} $height 6 7 MakeIcon NavigationBar $NavigationBar.delete nav_delete { file delete "$FileName.trace$FileCounter.gob" Navigate plus } {delete image} $height 7 7 MakeArrowDown NavigationBar $NavigationBar.down $height 7 } image create photo step_into -file [file join $GoblinTclPath stepInto.gif] image create photo step_out -file [file join $GoblinTclPath stepOut.gif] image create photo step_over -file [file join $GoblinTclPath stepOver2.gif] image create photo step_single -file [file join $GoblinTclPath stepSingle2.gif] image create photo step_auto -file [file join $GoblinTclPath stepClock2.gif] proc MakeTracingBar {} { global FileCounter goblinTraceCounter TracingBar CanvasToolbar set TracingBar $CanvasToolbar.trace if {![winfo exists $TracingBar]} { frame $TracingBar pack $TracingBar -side top } if {![winfo ismapped $CanvasToolbar]} {tkwait visibility $CanvasToolbar} set height [winfo height $CanvasToolbar] bind $CanvasToolbar MakeTracingBar MakeArrowUp TracingBar $TracingBar.up $height 4 MakeIcon TracingBar $TracingBar.into step_into { set goblinBreakLevel 10000 set SingleStep 1 set TraceLock 0 goblin messenger unblock } {step into} $height 1 4 MakeIcon TracingBar $TracingBar.out step_out { set goblinBreakLevel [expr $goblinLogLevel -1] set SingleStep 1 set TraceLock 0 goblin messenger unblock } {step out} $height 2 4 MakeIcon TracingBar $TracingBar.over step_over { set goblinBreakLevel $goblinLogLevel set SingleStep 1 set TraceLock 0 goblin messenger unblock } {step over} $height 3 4 MakeIcon TracingBar $TracingBar.auto step_auto { set goblinBreakLevel 10000 set SingleStep 0 set TraceLock 0 goblin messenger unblock } {continue} $height 4 4 MakeArrowDown TracingBar $TracingBar.down $height 4 } image create photo new_node -file [file join $GoblinTclPath editNewNode.gif] image create photo new_arc -file [file join $GoblinTclPath editNewArc.gif] image create photo edit_label -file [file join $GoblinTclPath editLabel.gif] image create photo move_node -file [file join $GoblinTclPath editMove.gif] image create photo redirect -file [file join $GoblinTclPath editRedirect.gif] image create photo delete -file [file join $GoblinTclPath editDelete.gif] image create photo edit_incidences -file [file join $GoblinTclPath editIncidences.gif] image create photo predecessors -file [file join $GoblinTclPath editPred.gif] image create photo colours -file [file join $GoblinTclPath editColours.gif] proc MakeEditorBar {} { global ThisGraph EditorBar CanvasToolbar if {[$ThisGraph is mip]} { MakeMipEditorBar return } if {![$ThisGraph is sparse]} { MakeDenseEditorBar return } set EditorBar $CanvasToolbar.edit if {![winfo exists $EditorBar]} { destroy $EditorBar frame $EditorBar pack $EditorBar -side top } if {![winfo ismapped $CanvasToolbar]} {tkwait visibility $CanvasToolbar} set height [winfo height $CanvasToolbar] bind $CanvasToolbar MakeEditorBar MakeArrowUp EditorBar $EditorBar.up $height 9 MakeIcon EditorBar $EditorBar.newNode new_node AddNodes \ {insert nodes} $height 1 9 MakeIcon EditorBar $EditorBar.newArc new_arc InsertArcs \ {insert arcs} $height 2 9 MakeIcon EditorBar $EditorBar.editLabel edit_label EditLabels \ {edit labels} $height 3 9 MakeIcon EditorBar $EditorBar.moveNode move_node MoveNodes \ {move nodes} $height 4 9 MakeIcon EditorBar $EditorBar.redirect redirect RedirectArcs \ {redirect arcs} $height 5 9 MakeIcon EditorBar $EditorBar.delete delete DeleteObjects \ {delete objects} $height 6 9 MakeIcon EditorBar $EditorBar.incidences edit_incidences EditIncidences \ {sort incidences} $height 7 9 MakeIcon EditorBar $EditorBar.colours colours SetColours \ {set colours} $height 8 9 MakeIcon EditorBar $EditorBar.pred predecessors SetPredecessors \ {set predecessors} $height 9 9 MakeArrowDown EditorBar $EditorBar.down $height 9 } proc MakeDenseEditorBar {} { global EditorBar CanvasToolbar set EditorBar $CanvasToolbar.edit if {![winfo exists $EditorBar]} { destroy $EditorBar frame $EditorBar pack $EditorBar -side top } if {![winfo ismapped $CanvasToolbar]} {tkwait visibility $CanvasToolbar} set height [winfo height $CanvasToolbar] bind $CanvasToolbar MakeEditorBar MakeArrowUp EditorBar $EditorBar.up $height 4 MakeIcon EditorBar $EditorBar.editLabel edit_label EditLabels \ {edit labels} $height 1 4 MakeIcon EditorBar $EditorBar.moveNode move_node MoveNodes \ {move nodes} $height 2 4 MakeIcon EditorBar $EditorBar.colours colours SetColours \ {set colours} $height 3 4 MakeIcon EditorBar $EditorBar.pred predecessors SetPredecessors \ {set predecessors} $height 4 4 MakeArrowDown EditorBar $EditorBar.down $height 4 } image create photo edit_row -file [file join $GoblinTclPath tableauRow.gif] image create photo edit_col -file [file join $GoblinTclPath tableauCol.gif] image create photo edit_pivot -file [file join $GoblinTclPath tableauPivot.gif] proc MakeMipEditorBar {} { global EditorBar CanvasToolbar set EditorBar $CanvasToolbar.edit if {![winfo exists $EditorBar]} { frame $EditorBar pack $EditorBar -side top } if {![winfo ismapped $CanvasToolbar]} {tkwait visibility $CanvasToolbar} set height [winfo height $CanvasToolbar] bind $CanvasToolbar MakeMipEditorBar MakeArrowUp MipEditorBar $EditorBar.up $height 3 MakeIcon MipEditorBar $EditorBar.editRow edit_row EditLPRow \ {edit rows} $height 1 3 MakeIcon MipEditorBar $EditorBar.newArc edit_col EditLPColumn \ {edit columns} $height 2 3 MakeIcon MipEditorBar $EditorBar.editLabel edit_pivot LPPivoting \ {pivoting} $height 3 3 MakeArrowDown MipEditorBar $EditorBar.down $height 3 }