
#-------------------------------------------------------------------------------
# Module:     menuLayout.tk
# Activation: Loaded during GOBLET startup
# Scope:      Layout menu item, bindings, some small dialogs
#             Graph display and navigator functionality
#-------------------------------------------------------------------------------



proc MakeLayoutMenu {} {
    global ThisGraph
    
    destroy .mbar.layout.menu
    
    menu .mbar.layout.menu -tearoff false

    if {[$ThisGraph is mip]} {
        .mbar.layout.menu add command -label "Display Options..." \
            -accelerator Shift+Ctrl+D -command SetLpDisplayOptions
        bind . <Control-D> {SetLpDisplayOptions}

        return
    }

    .mbar.layout.menu add command -label "Strip Geometry" -underline 6 \
        -command StripGraph
    .mbar.layout.menu add command -label "Scale Geometry..." -underline 0 \
        -command ScaleGraph
    .mbar.layout.menu add command -label "Node Grids..." \
        -underline 1 -command SetGrids
    .mbar.layout.menu add command -label "Fit Into Window" \
        -accelerator Ctrl+W -command FitIntoWindow
    .mbar.layout.menu add command -label "Zoom In" \
        -accelerator Ctrl+ -command ZoomIn
    .mbar.layout.menu add command -label "Zoom Out" \
        -accelerator Ctrl- -command ZoomOut

    if {[$ThisGraph is sparse]} {
        .mbar.layout.menu add separator
        menu .mbar.layout.menu.planar -tearoff false
        .mbar.layout.menu add cascade -label "Planarity" -underline 0 \
            -menu .mbar.layout.menu.planar
        .mbar.layout.menu.planar add command -label "Planarity Test" \
            -underline 0 -command PlanarityTest
        .mbar.layout.menu.planar add command -label "Combinatorial Embedding" \
            -underline 0 -command Planarize
        .mbar.layout.menu.planar add command -label "Outerplanar Embedding" \
            -underline 0 -command RefineExteriorFace
        .mbar.layout.menu.planar add command -label "Straight Line Drawing" \
            -underline 9 -command ConvexDrawing

        .mbar.layout.menu add command -label "Spring Embedding" -underline 7 \
            -command SpringEmbedding

        .mbar.layout.menu add command -label "Align Arcs" -underline 0 \
            -command {CallLayout align}
    }

    menu .mbar.layout.menu.place -tearoff false
    .mbar.layout.menu add cascade -label "Place Nodes" -underline 6 \
        -menu .mbar.layout.menu.place
    .mbar.layout.menu.place add command -label "Predecessor Tree" \
        -underline 0 -command {CallLayout tree}
    .mbar.layout.menu.place add command -label "On A Circle" \
        -underline 5 -command {CallLayout circle}
    .mbar.layout.menu.place add command -label "By Colours" \
        -underline 0 -command {CallLayout colours}
    .mbar.layout.menu.place add command -label "On A Grid" \
        -underline 5 -command {CallLayout grid}

    .mbar.layout.menu add separator
    .mbar.layout.menu add command -label "Arc Display..." \
        -accelerator Shift+Ctrl+A -command SourceArcDisplay
    .mbar.layout.menu add command -label "Node Display..." \
        -accelerator Shift+Ctrl+N -command SourceNodeDisplay
    .mbar.layout.menu add command -label "Layout Options..." \
        -accelerator Shift+Ctrl+W -command SourceLayoutOptions

    bind . <Control-t> {DisplayNewLayout}
    bind . <Control-w> {FitIntoWindow}
    bind . <Control-A> {SourceArcDisplay}
    bind . <Control-N> {SourceNodeDisplay}
    bind . <Control-W> {SourceLayoutOptions}
    bind . <Control-plus> {ZoomIn}
    bind . <Control-minus> {ZoomOut}
}

proc InitDisplay {} {
    global Mode FileName ThisBackup
    set Mode ""
    if {[goblin solver idle]} {ToggleBrowser} else {
        set state [catch {goblin messenger filename} traceFile]
        if {!$state} {
            TraceObject [file rootname $traceFile]
        } else {
            TraceObject $FileName.backup$ThisBackup
        }
    }
}

proc DisplayNewLayout {} {
    global ThisGraph FileCounter goblinTraceCounter Mode goblinCommLevel

    if {[$ThisGraph is mip] || [$ThisGraph max cx]>0 || [$ThisGraph max cy]>0} {
        set savedLevel $goblinCommLevel
        set goblinCommLevel 0
        $ThisGraph trace
        set goblinCommLevel $savedLevel
    }
    set FileCounter $goblinTraceCounter
    set Mode "display object"
    InitNavigator
}

proc InitNavigator {} {
    global goblinTraceCounter Mode

    if {$goblinTraceCounter>0} {
        ResetMode "navigate"
        Navigate
    } else {
        DisplayObject
    }
}

proc DisplayCanvas {fileName} {
    global c

    goblin export goblet $fileName.gob $fileName.tk
    InitCanvasRegion
    set goblinCanvas $c
    source $fileName.tk
    BackupScrollPos
    file delete $fileName.tk
}

proc DisplayTextFile {fileName} {
    global goblinLPDisplay
    InitCanvasRegion 1
    goblin export ascii $fileName.gob $fileName.ascii $goblinLPDisplay
    LoadTextForm $fileName.ascii
    file delete $fileName.ascii
}

proc DisplayNothing {} {
    global StatusInfo
    DestroyCanvasRegion
    set StatusInfo "no visual information available"
}

proc DisplayCanvasOrTextFile {fileName} {
    global ThisGraph

    if {[$ThisGraph is sparse] && [$ThisGraph #arcs]>5000} {
        DisplayNothing
        return 0
    } else {
        if {[$ThisGraph is mip]} {
            DisplayTextFile $fileName
        } else {
            if {[$ThisGraph max cx]<=0 && [$ThisGraph max cy]<=0} {
                if {[$ThisGraph #nodes]==0 || \
                    (![$ThisGraph is sparse] && [$ThisGraph #arcs]>5000)} {
                    DisplayNothing
                    return 0
                } else {
                    DisplayTextFile $fileName
                }
            } else {
                DisplayCanvas $fileName
            }
        }
    }
    
    return 1
}

proc DisplayObject {} {
    global ThisGraph FileName OrigFileName ThisBackup StatusInfo

    if {[goblin solver idle]} {
        if {![DisplayCanvasOrTextFile $FileName.backup$ThisBackup]} {return}

        MakeEditorBar
        ResetMode "display object"
        set StatusInfo "$OrigFileName"
    } else {
        set retState [catch {goblin messenger filename} traceFile]

        if {!$retState} {
            TraceObject [file rootname [goblin messenger filename]]
        } else {
            TraceObject $FileName.backup$ThisBackup
        }
    }
}

proc Navigate {{direction "plus"}} {
    global FileName FileCounter goblinTraceCounter StatusInfo
    
    if {$direction=="plus"} {
        while {![file exists "$FileName.trace$FileCounter.gob"] &&   
            $FileCounter<=$goblinTraceCounter} {incr FileCounter}
        
        if {$FileCounter>$goblinTraceCounter} {
            while {![file exists "$FileName.trace$FileCounter.gob"] &&   
                $FileCounter>0} {incr FileCounter -1}
        }
        
        if {$FileCounter==0} {
            set goblinTraceCounter 0
            ResetMode "display object"
            InitDisplay
            return
        }
    } else {
        while {![file exists "$FileName.trace$FileCounter.gob"] &&   
            $FileCounter>0} {incr FileCounter -1}
        
        if {$FileCounter==0} {
            while {![file exists "$FileName.trace$FileCounter.gob"] &&   
                $FileCounter<=$goblinTraceCounter} {incr FileCounter}
        }
        
        if {$FileCounter>$goblinTraceCounter} {
            set goblinTraceCounter 0
            return
            ResetMode "display object"
            InitDisplay
        }
    }
        
    set StatusInfo "trace file #$FileCounter of $goblinTraceCounter"

    set traceFile $FileName.trace$FileCounter
    
    DisplayCanvasOrTextFile $traceFile
    
    MakeNavigationBar
}

proc TraceObject {traceFile} {
    global c ThisGraph StatusInfo FileName ThisBackup
    
    DisplayCanvasOrTextFile $traceFile
    
    ResetMode "trace"
    MakeTracingBar
    set StatusInfo "$traceFile"
}

proc LoadTextForm {textFile} {
    global c GoblinTclPath StatusInfo
    
    if [catch {open "| cat < \"$textFile\""} textStream] {
        set StatusInfo "Could not open textfile"
        return
    }
    
    $c configure -state normal
    $c delete 1.0 end

    while {[gets $textStream thisLine]>=0} {
        $c insert end $thisLine\n
    }
    close $textStream
    $c see 1.0
    $c configure -state disabled
}

proc SetLpDisplayOptions {} {
    global GoblinTclPath
    source [file join $GoblinTclPath layoutLPOpt.tk]
}

proc StripGraph {} {
    global ThisGraph
    
    $ThisGraph layout strip
    PropagateModifications
}

proc ScaleGraph {} {
    global ThisGraph GoCommand UploadCommand WDInput

    global dx dy
    set dx 1.00
    set dy 1.00
    
    set GoCommand {
        $ThisGraph layout scale $dx $dy
        PropagateModifications
        DestroyFormOrWindow "Scale Geometry" $WDInput
    }
    set UploadCommand {}
    
    DisplayInputDialog "Scale Geometry" "ScaleGraph" "Scale" "Cancel" {
        label $WDInput.frame.xText -text "Horizontal Magnification:" -anchor w
        grid $WDInput.frame.xText -in $WDInput.frame -row 0 -column 0 \
            -rowspan 1 -columnspan 1 -sticky news -padx 1m -pady 1m
        entry $WDInput.frame.x -textvariable dx -bg white -width 5
        grid $WDInput.frame.x -in $WDInput.frame -row 0 -column 1 \
            -rowspan 1 -columnspan 1 -sticky news -padx 1m -pady 1m
    
        label $WDInput.frame.yText -text "Vertical Magnification:" -anchor w
        grid $WDInput.frame.yText -in $WDInput.frame -row 1 -column 0 \
            -rowspan 1 -columnspan 1 -sticky news -padx 1m -pady 1m
        entry $WDInput.frame.y -textvariable dy -bg white -width 5
        grid $WDInput.frame.y -in $WDInput.frame -row 1 -column 1 \
            -rowspan 1 -columnspan 1 -sticky news -padx 1m -pady 1m

        grid rowconfig    $WDInput.frame 0 -weight 1 -minsize 0
        grid columnconfig $WDInput.frame 0 -weight 1 -minsize 0

        bind $WDInput.frame.x <Return> {focus $WDInput.frame.y}
        bind $WDInput.frame.y <Return> $GoCommand
    }
    
    focus $WDInput.frame.x
}

proc PlanarityTest {} {
    global ThisGraph

    CallSolver "Planarity" "$ThisGraph is planar"
}

proc Planarize {} {
    global ThisGraph

    CallSolver "Planarity" "$ThisGraph planarize"
}

proc RefineExteriorFace {} {
    global ThisGraph

    CallSolver "Planarity" "$ThisGraph outerplanar"
}

proc ConvexDrawing {} {
    global ThisGraph

    CallSolver "Planarity" "$ThisGraph convex"
}

proc SpringEmbedding {} {
    global ThisGraph

    CallSolver "Spring Embedding" "$ThisGraph layout spring"
}

proc CallLayout {option} {
    global ThisGraph Mode
    
    eval $ThisGraph layout $option
    
    set Mode "display object"
    PropagateModifications
}

proc FitIntoWindow {} {
    global ThisGraph goblinXZoom goblinYZoom goblinXShift goblinYShift \
        goblinLegenda goblinNodeSize Zoom c Mode

    if {[$ThisGraph is mip]} {return}

    set xSize [winfo width $c]
    set ySize [winfo height $c]
        
    set xMax [$ThisGraph node 0 cx]
    set yMax [$ThisGraph node 0 cy]
    set xMin $xMax
    set yMin $yMax

    for {set v 0} {$v<[$ThisGraph #nodes]+[$ThisGraph #artificial]} {incr v} {
    
        if {[$ThisGraph node $v hidden]} { continue}
        
        if {[$ThisGraph node $v cx]<$xMin} {set xMin [$ThisGraph node $v cx]}
        if {[$ThisGraph node $v cy]<$yMin} {set yMin [$ThisGraph node $v cy]}
        if {[$ThisGraph node $v cx]>$xMax} {set xMax [$ThisGraph node $v cx]}
        if {[$ThisGraph node $v cy]>$yMax} {set yMax [$ThisGraph node $v cy]}
    }

    set margin [expr round(2*$goblinNodeSize*$Zoom)]
    set goblinXZoom [expr ($xSize-2*$margin)/($Zoom*($xMax-$xMin))]
    set goblinYZoom \
        [expr ($ySize-2*$margin)/($Zoom*($yMax-$yMin+$goblinLegenda))]
    set goblinXShift [expr round(($margin-$xMin*$Zoom*$goblinXZoom)/$Zoom)]
    set goblinYShift [expr round(($margin-$yMin*$Zoom*$goblinYZoom)/$Zoom)]
            
    if {$Mode!="trace"} {PropagateModifications}
}

proc ZoomIn {} {
    global goblinXZoom goblinYZoom
    set goblinXZoom [expr {round($goblinXZoom*1.25)}]
    set goblinYZoom [expr {round($goblinYZoom*1.25)}]
    PropagateModifications
}

proc ZoomOut {} {
    global goblinXZoom goblinYZoom
    set goblinXZoom [expr {round($goblinXZoom*0.8)}]
    set goblinYZoom [expr {round($goblinYZoom*0.8)}]
    PropagateModifications
}

proc SourceArcDisplay {} {
    global GoblinTclPath
    source [file join $GoblinTclPath layoutArcs.tk]
}

proc SourceNodeDisplay {} {
    global GoblinTclPath
    source [file join $GoblinTclPath layoutNodes.tk]
}

proc SourceLayoutOptions {} {
    global GoblinTclPath
    source [file join $GoblinTclPath layoutMeasures.tk]
}

proc SetGrids {} {
    global ThisGraph goblinNodeSep Grid2 Grid3 \
        GoCommand UploadCommand WDInput

    set GoCommand {
        if {[expr {$goblinNodeSep<0 && $goblinNodeSep>100000}]} {
            focus $WDInput.frame.nodes
            continue
        }
        if {[expr {$Grid2<0 && $Grid2>50000}]} {
            focus $WDInput.frame.bends
            continue
        }
        if {[expr {$Grid3<0 && $Grid3>10000}]} {
            focus $WDInput.frame.arcs
            continue
        }

        # Move all nodes to grid coordinates

        for {set v 0} {$v<[$ThisGraph #nodes]} {incr v} {
            $ThisGraph node $v set cx \
                [expr round(([$ThisGraph node $v cx]+0.0000000001)/$goblinNodeSep)*$goblinNodeSep]
            $ThisGraph node $v set cy \
                [expr round(([$ThisGraph node $v cy]+0.0000000001)/$goblinNodeSep)*$goblinNodeSep]
        }
    
        for {set a 0} {$a<[$ThisGraph #arcs]} {incr a} {
            set v [$ThisGraph arc [expr {2*$a}] align]

            if {![string equal $v "*"]} {
                $ThisGraph node $v set cx \
                    [expr round(([$ThisGraph node $v cx]+0.0000000001)/$Grid3)*$Grid3]
                $ThisGraph node $v set cy \
                    [expr round(([$ThisGraph node $v cy]+0.0000000001)/$Grid3)*$Grid3]
            }
          
            if {$v!="*"} {set v [$ThisGraph node $v thread]}
      
            while {$v!="*"} {
                $ThisGraph node $v set cx \
                    [expr round(([$ThisGraph node $v cx]+0.0000000001)/$Grid2)*$Grid2]
                $ThisGraph node $v set cy \
                    [expr round(([$ThisGraph node $v cy]+0.0000000001)/$Grid2)*$Grid2]
                set v [$ThisGraph node $v thread]
            }
        }

        PropagateModifications
    }

    set UploadCommand {
        if {[expr {$goblinNodeSep<0 && $goblinNodeSep>100000}]} {
            focus $WDInput.frame.nodes
            continue
        }
        if {[expr {$Grid2<0 && $Grid2>50000}]} {
            focus $WDInput.frame.bends
            continue
        }
        if {[expr {$Grid3<0 && $Grid3>10000}]} {
            focus $WDInput.frame.arcs
            continue
        }

        DestroyFormOrWindow "Node Grids" $WDInput
    }
    
    DisplayInputDialog "Node Grids" "SetGrids" "Force" "Done" {
        label $WDInput.frame.label -text "Grids for Node Positions" -anchor w
        grid $WDInput.frame.label -in $WDInput.frame -row 0 -column 0 \
            -rowspan 1 -columnspan 2 -sticky news -padx 1m -pady 1m

        label $WDInput.frame.nText -text "Graph nodes:" -anchor w
        grid $WDInput.frame.nText -in $WDInput.frame -row 1 -column 0 \
            -rowspan 1 -columnspan 1 -sticky news -padx 1m -pady 1m
        entry $WDInput.frame.nodes -textvariable goblinNodeSep -bg white -width 5
        grid $WDInput.frame.nodes -in $WDInput.frame -row 1 -column 1 \
            -rowspan 1 -columnspan 1 -sticky news -padx 1m -pady 1m
    
        label $WDInput.frame.bText -text "Bend Nodes:" -anchor w
        grid $WDInput.frame.bText -in $WDInput.frame -row 2 -column 0 \
            -rowspan 1 -columnspan 1 -sticky news -padx 1m -pady 1m
        entry $WDInput.frame.bends -textvariable Grid2 -bg white -width 5
        grid $WDInput.frame.bends -in $WDInput.frame -row 2 -column 1 \
            -rowspan 1 -columnspan 1 -sticky news -padx 1m -pady 1m
    
        label $WDInput.frame.aText -text "Arc Labels:" -anchor w
        grid $WDInput.frame.aText -in $WDInput.frame -row 3 -column 0 \
            -rowspan 1 -columnspan 1 -sticky news -padx 1m -pady 1m
        entry $WDInput.frame.arcs -textvariable Grid3 -bg white -width 5
        grid $WDInput.frame.arcs -in $WDInput.frame -row 3 -column 1 \
            -rowspan 1 -columnspan 1 -sticky news -padx 1m -pady 1m

        label $WDInput.frame.label2 -text "0 = Free Placement" -anchor w
        grid $WDInput.frame.label2 -in $WDInput.frame -row 4 -column 0 \
            -rowspan 1 -columnspan 2 -sticky news -padx 1m -pady 1m

        grid rowconfig    $WDInput.frame 0 -weight 1 -minsize 0
        grid columnconfig $WDInput.frame 0 -weight 1 -minsize 0

        bind $WDInput.frame.nodes <Return> {
            set Grid2 [expr $goblinNodeSep*0.5]
            set Grid3 [expr $goblinNodeSep*0.1]
            focus $WDInput.frame.bends
        }
        bind $WDInput.frame.bends <Return> {
            focus $WDInput.frame.arcs
        }
        bind $WDInput.frame.arcs <Return> $UploadCommand
    }
    
    focus $WDInput.frame.nodes
}
