
#-------------------------------------------------------------------------------
# Module:     menuEdit.tk
# Activation: Loaded during GOBLET startup
# Scope:      Edit menu item, bindings, some small dialogs
#             Handling of transitions between different run modes
#             Handling of modified objects
#             Checking node and arc indices
#-------------------------------------------------------------------------------



proc MakeEditMenu {} {
    global ThisGraph
    
    destroy .mbar.edit.menu

    menu .mbar.edit.menu

    if {[$ThisGraph is mip]} {
        .mbar.edit.menu add command -label "Reset Basis" \
            -accelerator Ctrl+X -command ResetLPBasis
        .mbar.edit.menu add command -label "Pivoting..."\
            -accelerator Shift+Ctrl+P -command LPPivoting
        .mbar.edit.menu add command -label "Edit Rows..."\
            -accelerator Shift+Ctrl+R -command EditLPRow
        .mbar.edit.menu add command -label "Edit Columns..."\
            -accelerator Shift+Ctrl+C -command EditLPColumn

        bind . <Control-x> ResetLPBasis
        bind . <Control-P> LPPivoting
        bind . <Control-R> EditLPRow
        bind . <Control-C> EditLPColumn
    } else {
        if {[$ThisGraph is sparse]} {
            .mbar.edit.menu add command -label "Insert Arcs" \
                -accelerator Ctrl+A -command InsertArcs
            if {![$ThisGraph is bipartite]} {
                .mbar.edit.menu add command -label "Insert Nodes" \
                    -accelerator Ctrl+V -command AddNodes
                bind . <Control-v> {AddNodes}
            }
            .mbar.edit.menu add command -label "Redirect Arcs" \
                -accelerator Ctrl+R -command RedirectArcs
            .mbar.edit.menu add command -label "Delete Objects" \
                -accelerator Ctrl+X -command DeleteObjects
            .mbar.edit.menu add separator

            bind . <Control-a> {InsertArcs}
            bind . <Control-r> {RedirectArcs}
            bind . <Control-x> {DeleteObjects}
        }
        .mbar.edit.menu add command -label "Move Nodes" \
            -accelerator Ctrl+M -command MoveNodes
        .mbar.edit.menu add command -label "Node Positions..." \
             -underline 0 -command SetGrid
        .mbar.edit.menu add command -label "Edit Labels" \
            -accelerator Ctrl+E -command EditLabels
        .mbar.edit.menu add command -label "Set Colours" \
            -command SetColours
        .mbar.edit.menu add command -label "Set Predecessors" \
            -command SetPredecessors
        .mbar.edit.menu add command -label "Constant Labels..." \
            -accelerator Shift+Ctrl+C \
            -command {source [file join $GoblinTclPath editConstants.tk]}
        .mbar.edit.menu add command -label "Metrics..." -underline 0 \
            -command {source [file join $GoblinTclPath editMetrics.tk]}
        .mbar.edit.menu add separator
        .mbar.edit.menu add command -label "Delete Solutions..." \
            -accelerator Shift+Ctrl+X \
            -command {source [file join $GoblinTclPath editDelete.tk]}
        .mbar.edit.menu add command -label "Extract Solutions..." \
            -accelerator Shift+Ctrl+E \
            -command {source [file join $GoblinTclPath editExtract.tk]}

        bind . <Control-a> {}
        bind . <Control-v> {}
        bind . <Control-x> {}
        bind . <Control-X> {source [file join $GoblinTclPath editDelete.tk]}
        bind . <Control-E> {source [file join $GoblinTclPath editExtract.tk]}
        bind . <Control-m> {MoveNodes}
        bind . <Control-e> {EditLabels}
        bind . <Control-C> {source [file join $GoblinTclPath editConstants.tk]}
    }
    
    .mbar.edit.menu add separator
    .mbar.edit.menu add command -label "Undo Changes" \
        -accelerator Ctrl+Z -command UndoChanges
    .mbar.edit.menu add command -label "Redo Changes" \
        -accelerator Ctrl+Y -command RedoChanges

    bind . <Control-y> {RedoChanges}
    bind . <Control-z> {UndoChanges}
}

proc ResetMode {nextMode} {
    global c CanvasRegion Mode StartNode ThisArc ThisNode \
        WDAttribs NavigationBar

    DestroyBalloon

    if {[string equal $Mode "insert arcs"]} {
        if {$ThisArc != ""} {
            $c delete $ThisArc
            set ThisArc ""
        }
        set StartNode ""
    }

    if {[string equal $Mode "align label"]} {
        set ThisNode ""
        set ThisArc ""
    }

    if {[string equal $Mode "move nodes"]} {
        set ThisNode ""
    }

    if {[string equal $Mode "change labels"]} {
        UploadLabels
        global ActiveDialog
        if {$ActiveDialog=="Node Attributes" || \
            $ActiveDialog=="Arc Attributes"} {DestroyActiveDialog}
        set ThisNode ""
        set ThisArc ""
    }

    set Mode $nextMode
}

proc InsertArcs {} {
    if {![goblin solver idle]} {return}

    ResetMode "insert arcs"
    InitEditor
    MakeHelp "(L) select start node"
}

proc ResetLPBasis {} {
    if {![goblin solver idle]} {return}

    global ThisGraph StatusInfo

    $ThisGraph reset
    PropagateModifications

    set StatusInfo "Basis set to lower variable bounds"
}

proc CheckLpVar {} {
    global ThisGraph DialogPar StatusInfo
    
    set k [$ThisGraph #variables]
    for {set i 0} {$i<$k &&
        $DialogPar("LpVarLabel")!=[$ThisGraph variable $i label]} {incr i} {}
    if {$i==$k} {
        set StatusInfo "variable label \"$DialogPar("LpVarLabel")\" not found"
        return -1
    } else {
        return $i
    }
}

proc CheckLpRow {} {
    global ThisGraph DialogPar StatusInfo
    
    set k [$ThisGraph #rows]
    if {$DialogPar("LpRowLabel")==""} {return [expr [CheckLpVar]+$k]}

    for {set i 0} {$i<$k &&
        $DialogPar("LpRowLabel")!=[$ThisGraph row $i label]} {incr i} {}
    if {$i==$k} {
        set StatusInfo "row label \"$DialogPar("LpRowLabel")\" not found"
        return -1
    } else {
        return $i
    }
}

proc LPPivoting {} {
    global GoblinTclPath

    source [file join $GoblinTclPath editPivot.tk]
}

proc EditLPRow {} {
    global GoblinTclPath

    source [file join $GoblinTclPath editRow.tk]
}

proc EditLPColumn {} {
    global GoblinTclPath

    source [file join $GoblinTclPath editVar.tk]
}

proc AddNodes {} {
    if {![goblin solver idle]} {return}

    ResetMode "insert nodes"
    InitEditor
    MakeHelp "(L) place new node"
}

proc QualifiedNode {x} {
    global ThisGraph StatusInfo
    if {$x=="*"} {return 1}
    if {$x=="" || [catch {expr int($x)}] || $x!=[expr int($x)]} {
        set StatusInfo "node index \"$x\" not accepted"
        return 0
    }
    if {[expr $x<[$ThisGraph #nodes] && $x>=0]} {
        return 1
    } else {
        set StatusInfo "node index \"$x\" not accepted"
        return 0
    }
}

proc QualifiedArc {x} {
    global ThisGraph StatusInfo
    if {$x=="*"} {return 1}
    if {$x=="" || [catch {expr int($x)}] || $x!=[expr int($x)]} {
        set StatusInfo "arc index \"$x\" not accepted"
        return 0
    }
    if {[expr $x<2*[$ThisGraph #arcs] && $x>=0]} {
        return 1
    } else {
        set StatusInfo "arc index \"$x\" not accepted"
        return 0
    }
}

proc QualifiedInt {x lower upper} {
    global StatusInfo
    if {$x=="" || [catch {expr int($x)}] || $x!=[expr int($x)]
            || [expr $x>$upper || $x<$lower]} {
        set StatusInfo "value \"$x\" not accepted"
        return 0
    } else {
        return 1
    }
}

proc SetGrid {} {
    global Grid GoCommand UploadCommand WDInput

    set GoCommand {}
    set UploadCommand {
        if {[expr {$Grid<0 && $Grid>=99999}]} {continue}
    }
    
    DisplayInputDialog "Node Positions" "SetGrid" "" "Done" {
        label $WDInput.frame.text -text "Grid for Node Positions:  "
        entry $WDInput.frame.entry -textvariable Grid -bg white -width 5
        pack $WDInput.frame.text $WDInput.frame.entry -side left

        bind $WDInput.frame.entry <Return> $GoCommand
    }
    
    focus $WDInput.frame.entry
}

set ThisArc ""
proc MoveNodes {} {
    ResetMode "move nodes"
    InitEditor
    MakeHelp "(L) drag and drop object"
}

proc EditLabels {} {
    ResetMode "change labels"
    InitEditor
    MakeHelp "(L) select object"
}

proc DownloadNodeLabels {v} {
    global ThisGraph ThisNode ThisDemand ThisDistance ThisColour \
        ThisPotential ThisPredecessor ThisArc
    
    set ThisNode $v
    set ThisDemand [$ThisGraph node $v demand]
    set ThisColour [$ThisGraph node $v colour]
    set ThisDistance [$ThisGraph node $v distance]
    set ThisPotential [$ThisGraph node $v potential]
    set ThisPredecessor [$ThisGraph node $v predecessor]
    set ThisArc ""
}

proc DownloadArcLabels {a} {
    global ThisGraph ThisArc ThisUpper ThisLower ThisLength \
        ThisOrientation ThisSubgraph ThisNode
    
    set ThisArc $a
    set ThisUpper [$ThisGraph arc [expr {2*$a}] ucap]
    set ThisLower [$ThisGraph arc [expr {2*$a}] lcap]
    set ThisLength [$ThisGraph arc [expr {2*$a}] length]
    set ThisOrientation [$ThisGraph arc [expr {2*$a}] orientation]
    set ThisSubgraph [$ThisGraph arc [expr {2*$a}] subgraph]
    set ThisNode ""
}

proc UploadLabels {} {
    global ThisGraph \
        ThisNode ThisDemand ThisDistance ThisColour ThisPotential ThisPredecessor \
        ThisArc ThisUpper ThisLower ThisLength ThisOrientation ThisSubgraph
    
    if {$ThisNode != ""} { \
        $ThisGraph node $ThisNode set demand $ThisDemand
        $ThisGraph node $ThisNode set distance $ThisDistance
        $ThisGraph node $ThisNode set potential $ThisPotential
        $ThisGraph node $ThisNode set colour $ThisColour
        $ThisGraph node $ThisNode set predecessor $ThisPredecessor
        PropagateModifications
    }
    
    if {$ThisArc != "" && $ThisSubgraph<= $ThisUpper && \
        $ThisSubgraph>= $ThisLower} { \
        $ThisGraph arc [expr {2*$ThisArc}] set ucap $ThisUpper
        $ThisGraph arc [expr {2*$ThisArc}] set lcap $ThisLower
        $ThisGraph arc [expr {2*$ThisArc}] set length $ThisLength
        $ThisGraph arc [expr {2*$ThisArc}] set subgraph $ThisSubgraph
        PropagateModifications
    }
}

proc SetColours {} {
    ResetMode "set colours"
    InitEditor
    MakeHelp "(L) decrease  (R) increase colour index"
}

proc SetPredecessors {} {
    ResetMode "set predecessors"
    InitEditor
    MakeHelp "(L) select node"
}

proc RedirectArcs {} {
    if {![goblin solver idle]} {return}

    global ThisGraph

    ResetMode "redirect arcs"
    InitEditor
    if {![$ThisGraph is directed]} {
        MakeHelp "(L) flip direction  (R) enable/disable direction"
    } else {
        MakeHelp "(L) flip direction"
    }
}

proc DeleteObjects {} {
    if {![goblin solver idle]} {return}

    ResetMode "delete objects"
    InitEditor
    MakeHelp "(L) delete object"
}

proc PropagateModifications {} {
    global Unchanged FileName Log FirstBackup ThisBackup LastBackup \
        CanvasRegion Mode ThisGraph BackupLevel

    if {$ThisBackup==$LastBackup} {
        incr ThisBackup
        incr LastBackup
        if {[expr $LastBackup-$FirstBackup-1]==$BackupLevel} {
            file delete -force $FileName.backup$FirstBackup.gob
            incr FirstBackup
        }
    } else {
        incr ThisBackup
        for {set i $ThisBackup} {$i<$LastBackup} {incr i} {
            file delete -force $FileName.backup$i.gob
        }
    }

    set Unchanged 0
    wm title . "GOBLET: [file tail $FileName] (modified)"
    if {[winfo exists $Log]} {LoadLogFile}
    UpdateSystemInfo

    if {[$ThisGraph is mip] || [$ThisGraph #nodes]>0} {
        $ThisGraph write $FileName.backup$ThisBackup.gob
    }

    if {[winfo exists $CanvasRegion] && \
        ($Mode=="display object" || $Mode=="navigate")} {InitDisplay}
}

proc UndoChanges {} {
    global FirstBackup ThisBackup FileName ThisGraph

    if {$ThisBackup>$FirstBackup} {
        incr ThisBackup -1
        $ThisGraph delete
        goblin read $ThisGraph $FileName.backup$ThisBackup.gob
        InitDisplay
    }
}

proc RedoChanges {} {
    global ThisBackup LastBackup FileName ThisGraph

    if {$ThisBackup<$LastBackup} {
        incr ThisBackup
        $ThisGraph delete
        goblin read $ThisGraph $FileName.backup$ThisBackup.gob
        InitDisplay
    }
}
