
#-------------------------------------------------------------------------------
# Module:     menuCompose.tk
# Activation: Loaded during GOBLET startup
# Scope:      Compose menu item, bindings, some small dialogs
#-------------------------------------------------------------------------------



proc MakeComposeMenu {} {
    global ThisGraph

    destroy .mbar.compose.menu

    menu .mbar.compose.menu -tearoff false

    if {[$ThisGraph is mip]} {
        .mbar.compose.menu add command -label "Standard Form" -underline 0 \
            -command {SaveAndCompose standard}
        .mbar.compose.menu add command -label "Canonical Form" -underline 0 \
            -command {SaveAndCompose canonical}
        .mbar.compose.menu add command -label "Dual Form" -underline 0 \
            -command {SaveAndCompose dual}
        return
    }

    .mbar.compose.menu add command -label "Underlying Graph" -underline 0 \
        -command "SaveAndCompose underlying"

    menu .mbar.compose.menu.orientation -tearoff false
    .mbar.compose.menu add cascade -label "Orientation" -underline 0 \
        -menu .mbar.compose.menu.orientation
    .mbar.compose.menu.orientation add command -label "Complete Orientation" \
        -underline 0 -command {SaveAndCompose orientation}
    .mbar.compose.menu.orientation add command -label "...Induced By Colours" \
        -underline 3 -command SaveAndInducedOrientation

    .mbar.compose.menu add command -label "Shrink Colours" -underline 7 \
        -command {SaveAndCompose contraction}

    menu .mbar.compose.menu.subgraph -tearoff false
    .mbar.compose.menu add cascade -label "Subgraph" -underline 0 \
        -menu .mbar.compose.menu.subgraph
    .mbar.compose.menu.subgraph add command -label "By Node Colour..." \
        -underline 3 \
        -command SaveAndInducedSubgraph
    .mbar.compose.menu.subgraph add command -label "By Edge Colour..." \
        -underline 8 \
        -command SaveAndInducedColour
    .mbar.compose.menu.subgraph add command -label "Induced Bigraph..." \
        -underline 8 -command SaveAndInducedBigraph

    if {[$ThisGraph is undirected] || [$ThisGraph is directed]} {
        .mbar.compose.menu.subgraph add command -label "Explicit Subgraph" \
            -underline 0 -command {SaveAndCompose subgraph}
    }

    if {[$ThisGraph is directed]} {
        .mbar.compose.menu.subgraph add command -label "Transitive Closure" \
            -underline 0 -command {SaveAndCompose transitive}
        .mbar.compose.menu.subgraph add command -label "Intransitive Reduction" \
            -underline 13 -command {SaveAndCompose intransitive}
    }


    .mbar.compose.menu add command -label "Complement" -underline 0 \
        -command {SaveAndCompose complement}
    .mbar.compose.menu add command -label "Line Graph" -underline 0 \
        -command {SaveAndCompose "linegraph -directed"}
    .mbar.compose.menu add command -label "Node Splitting" -underline 0 \
        -command {SaveAndCompose nodesplitting}
    .mbar.compose.menu add command -label "Mycielskian" -underline 1 \
        -command {SaveAndCompose mycielskian}
    .mbar.compose.menu add command -label "Subdivision" -underline 5 \
        -command {SaveAndCompose subdivision}

    if {[$ThisGraph is sparse]} {
        menu .mbar.compose.menu.planar -tearoff false
        .mbar.compose.menu add cascade -label "Planar" -underline 0 \
            -menu .mbar.compose.menu.planar
        .mbar.compose.menu.planar add command -label "Undirected Dual Graph" \
            -underline 0 -command {SaveAndCompose dualgraph}
        .mbar.compose.menu.planar add command -label "Directed Dual Graph" \
            -underline 0 -command {SaveAndCompose "dualgraph -directed"}
        .mbar.compose.menu.planar add command -label "Planar Line Graph" \
            -underline 0 -command {SaveAndCompose "linegraph -planar"}
        .mbar.compose.menu.planar add command -label "Truncate Vertices" \
            -underline 0 -command {SaveAndCompose truncate}
        .mbar.compose.menu.planar add command -label "Tear Regions Apart" \
            -underline 0 -command {SaveAndCompose separate}
        .mbar.compose.menu.planar add command -label "Tear & Turn Left" \
            -underline 0 -command {SaveAndCompose "separate -turnLeft"}
        .mbar.compose.menu.planar add command -label "Tear & Turn Right" \
            -underline 0 -command {SaveAndCompose "separate -turnRight"}
        .mbar.compose.menu.planar add command -label "Spread To Outerplanar" \
            -underline 0 -command {SaveAndCompose spread}
    }

    .mbar.compose.menu add command -label "Distance Graph" \
         -underline 0 -command {
            $ThisGraph layout configure -arcVisibilityMode 1
            SaveAndCompose distances
        }

    if {[$ThisGraph is undirected]} {
        .mbar.compose.menu add separator
        .mbar.compose.menu add command -label "Metric Graph" -underline 0 \
            -command {
                $ThisGraph layout configure -arcVisibilityMode 1
                SaveAndCompose metricGraph
            }
        .mbar.compose.menu add command -label "Tiling..." -underline 0 \
            -command SaveAndTiling
    }

    if {[$ThisGraph is directed]} {
        .mbar.compose.menu add separator
        .mbar.compose.menu add command -label "Split Graph..." -underline 0 \
            -command SaveAndSplitGraph
    }

    menu .mbar.compose.menu.mip -tearoff false
    .mbar.compose.menu add cascade -label "Integer / Linear" -underline 1 \
        -menu .mbar.compose.menu.mip
    .mbar.compose.menu.mip add command -label "Stable Set Problem" \
        -underline 0 -command {SaveAndCompose ilpstable}

    if {[$ThisGraph is directed]} {
        .mbar.compose.menu.mip add command -label "b-Flow Problem" \
            -underline 0 -command {SaveAndCompose lpflow}
    }
}

proc SaveAndCompose {option} {
    global Unchanged GoblinTclPath PromptCommand

    set PromptCommand "Compose $option"
    source [file join $GoblinTclPath fileChanges.tk]
}

proc Compose {option {option2 {default}}} {
    global ThisGraph OrigFileName FileName TraceDir

    set newObject [ChooseObjectName]

    if {   ($option2=="default" && [catch [$ThisGraph $option $newObject] result]) \
        || ($option2!="default" && [catch [$ThisGraph $option $option2 $newObject] result]) \
    } {
        AcknowledgementMessage $result
        ViewMessenger
        return
    }

    $ThisGraph delete
    set ThisGraph $newObject

    DeleteTempFiles
    set OrigFileName [file join [pwd] unnamed]
    set FileName [file join $TraceDir unnamed]
    InitFile
    UpdateMessenger
}

proc SaveAndInducedOrientation {} {
    global Unchanged GoblinTclPath PromptCommand
    set PromptCommand "Compose induced orientation"
    source [file join $GoblinTclPath fileChanges.tk]
}

proc CallWithIntParameter {_execCommand parameterDescription} {
    global ThisGraph InputData execCommand WDInputParameter

    if {![info exists InputData(inputParameter)]} {set InputData(inputParameter) "*"}

    set execCommand $_execCommand
    set WDInputParameter .inputParameter

    destroy $WDInputParameter
    toplevel $WDInputParameter
    wm withdraw $WDInputParameter
    wm title $WDInputParameter "GOBLIN Prompt"

    frame $WDInputParameter.frame
    pack $WDInputParameter.frame -padx 2m -pady 3m -side top -anchor w


    label $WDInputParameter.frame.text -text "$parameterDescription:  "
    entry $WDInputParameter.frame.entry -textvariable InputData(inputParameter) \
        -bg white -width 8
    pack $WDInputParameter.frame.text $WDInputParameter.frame.entry \
        -side left -fill x -expand 1
    bind $WDInputParameter.frame.entry <Return> {
        if {   $InputData(inputParameter)=="*" \
            || [QualifiedInt $InputData(inputParameter) 0 "*"] \
        } {
            destroy .inputParameter
            eval $execCommand
        }
    }

    focus $WDInputParameter.frame.entry

    bind $WDInputParameter <FocusOut> {
        if {[winfo exists .inputParameter]} {
            raise .inputParameter .
        }
    }

    bind . <FocusIn> {
        if {[winfo exists .inputParameter]} {
            raise .inputParameter .
        }
    }

    after 500 {AdjustWithRootWindow $WDInputParameter}
    after 500 {wm resizable $WDInputParameter 0 0}
}

proc CallWithTwoIntParameters {_execCommand parameterDescr1 parameterDescr2} {
    global ThisGraph InputData execCommand WDInputParameter

    if {![info exists InputData(inputParameter1)]} {set InputData(inputParameter1) "*"}
    if {![info exists InputData(inputParameter2)]} {set InputData(inputParameter2) "*"}

    set execCommand $_execCommand
    set WDInputParameter .inputParameter

    destroy $WDInputParameter
    toplevel $WDInputParameter
    wm withdraw $WDInputParameter
    wm title $WDInputParameter "GOBLIN Prompt"

    frame $WDInputParameter.frame
    pack $WDInputParameter.frame -padx 2m -pady 3m -side top -anchor w


    label $WDInputParameter.frame.text1 -text "$parameterDescr1:  "
    grid $WDInputParameter.frame.text1 \
        -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky w -padx 1m

    entry $WDInputParameter.frame.entry1 -textvariable InputData(inputParameter1) \
        -bg white -width 8
    grid $WDInputParameter.frame.entry1 \
        -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky w -padx 1m

    label $WDInputParameter.frame.text2 -text "$parameterDescr2:  "
    grid $WDInputParameter.frame.text2 \
        -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky w -padx 1m

    entry $WDInputParameter.frame.entry2 -textvariable InputData(inputParameter2) \
        -bg white -width 8
    grid $WDInputParameter.frame.entry2 \
        -row 1 -column 1 -rowspan 1 -columnspan 1 -sticky w -padx 1m


    bind $WDInputParameter.frame.entry1 <Return> {
        if {   $InputData(inputParameter1)=="*" \
            || [QualifiedInt $InputData(inputParameter1) 0 "*"] \
        } {
            focus $WDInputParameter.frame.entry2
        }
    }

    bind $WDInputParameter.frame.entry2 <Return> {
        if {   $InputData(inputParameter2)=="*" \
            || [QualifiedInt $InputData(inputParameter2) 0 "*"] \
        } {
            destroy .inputParameter
            eval $execCommand
        }
    }

    focus $WDInputParameter.frame.entry1

    bind $WDInputParameter <FocusOut> {
        if {[winfo exists .inputParameter]} {
            raise .inputParameter .
        }
    }

    bind . <FocusIn> {
        if {[winfo exists .inputParameter]} {
            raise .inputParameter .
        }
    }

    after 500 {AdjustWithRootWindow $WDInputParameter}
    after 500 {wm resizable $WDInputParameter 0 0}
}

proc SaveAndInducedSubgraph {} {
    global Unchanged GoblinTclPath PromptCommand
    set PromptCommand "InducedSubgraph"
    source [file join $GoblinTclPath fileChanges.tk]
}

proc InducedSubgraph {} {
    global InputData

    set InputData(inputParameter) 0

    CallWithIntParameter {
        global InputData ThisGraph

        set thisC $InputData(inputParameter)

        set found 0
        for {set i 0} {!$found && $i<[$ThisGraph #nodes]} {incr i} {
            if {[$ThisGraph node $i colour]==$thisC} {set found 1}
        }

        if {$found && [QualifiedInt $thisC 0 [$ThisGraph #nodes]]} {
            set newObject [ChooseObjectName]
            $ThisGraph induced subgraph $newObject $thisC
            $ThisGraph delete
            set ThisGraph $newObject
            DeleteTempFiles
            set OrigFileName [file join [pwd] unnamed]
            set FileName [file join $TraceDir unnamed]
            InitFile
            PropagateModifications
        } else {
            PostStatusInfo "inappropriate colour index: $thisC"
        }
    } "Colour Index"
}

proc SaveAndInducedColour {} {
    global Unchanged GoblinTclPath PromptCommand
    set PromptCommand "InducedColour"
    source [file join $GoblinTclPath fileChanges.tk]
}

proc InducedColour {} {
    global InputData

    set InputData(inputParameter) 0

    CallWithIntParameter {
        global InputData ThisGraph

        set thisC $InputData(inputParameter)
        set found 0

        for {set i 0} {!$found && $i<[$ThisGraph #arcs]} {incr i} {
            if {[$ThisGraph arc $i colour]==$thisC} {set found 1}
        }

        if {$found && [QualifiedInt $thisC 0 [$ThisGraph #arcs]]} {
            set newObject [ChooseObjectName]
            $ThisGraph induced colour $newObject $thisC
            $ThisGraph delete
            set ThisGraph $newObject
            DeleteTempFiles
            set OrigFileName [file join [pwd] unnamed]
            set FileName [file join $TraceDir unnamed]
            InitFile
            PropagateModifications
        } else {
            PostStatusInfo "inappropriate colour index: $thisC"
        }
    } "Colour Index"
}

proc SaveAndInducedBigraph {} {
    global Unchanged GoblinTclPath PromptCommand
    set PromptCommand "InducedBigraph"
    source [file join $GoblinTclPath fileChanges.tk]
}

proc InducedBigraph {} {
    global InputData

    set InputData(inputParameter1) 0
    set InputData(inputParameter2) 1

    CallWithTwoIntParameters {
        global InputData ThisGraph

        set thisC1 $InputData(inputParameter1)
        set thisC2 $InputData(inputParameter2)
        set found1 0
        set found2 0

        for {set i 0} {!$found1 && $i<[$ThisGraph #nodes]} {incr i} {
            if {[$ThisGraph node $i colour]==$thisC1} {set found1 1}
        }

        for {set i 0} {!$found2 && $i<[$ThisGraph #nodes]} {incr i} {
            if {[$ThisGraph node $i colour]==$thisC2} {set found2 1}
        }

        if {   $found1 && $found2 \
            && [QualifiedInt $thisC1 0 [$ThisGraph #nodes]] \
            && [QualifiedInt $thisC2 0 [$ThisGraph #nodes]] \
        } {
            set newObject [ChooseObjectName]
            $ThisGraph induced bigraph $newObject $thisC1 $thisC2
            $ThisGraph delete
            set ThisGraph $newObject
            DeleteTempFiles
            set OrigFileName [file join [pwd] unnamed]
            set FileName [file join $TraceDir unnamed]
            InitFile
            PropagateModifications
        } else {
            PostStatusInfo "inappropriate colour indices: $thisC1 $thisC2"
        }
    } "First Colour Index" "Second Colour Index"
}

proc SaveAndTiling {} {
    global Unchanged GoblinTclPath PromptCommand
    set PromptCommand "Tiling"
    source [file join $GoblinTclPath fileChanges.tk]
}

proc Tiling {} {
    global InputData

    set InputData(inputParameter1) 4
    set InputData(inputParameter2) 3

    CallWithTwoIntParameters {
        global InputData ThisGraph

        set thisX $InputData(inputParameter1)
        set thisY $InputData(inputParameter2)

        if {   [QualifiedInt $thisX 1 "*"] \
            && [QualifiedInt $thisY 1 "*"] \
        } {
            set newObject [ChooseObjectName]
            $ThisGraph tiling $newObject $thisX $thisY
            $ThisGraph delete
            set ThisGraph $newObject
            DeleteTempFiles
            set OrigFileName [file join [pwd] unnamed]
            set FileName [file join $TraceDir unnamed]
            InitFile
            PropagateModifications
        } else {
            PostStatusInfo "inappropriate colour indices: $thisC1 $thisC2"
        }
    } "Number of Rows" "Number of Columns"
}

proc SaveAndSplitGraph {} {
    global Unchanged GoblinTclPath PromptCommand
    set PromptCommand "SplitGraph"
    source [file join $GoblinTclPath fileChanges.tk]
}

proc SplitGraph {} {
    CallWithSourceAndTarget {
        if {   ![QualifiedNode [$ThisGraph source]] \
            || ![QualifiedNode [$ThisGraph target]] \
        } {
            return
        }

        set newObject [ChooseObjectName]
        $ThisGraph splitgraph $newObject [$ThisGraph source] [$ThisGraph target]
        $ThisGraph delete
        set ThisGraph $newObject
        DeleteTempFiles

        global OrigFileName FileName TraceDir
        set OrigFileName [file join [pwd] unnamed]
        set FileName [file join $TraceDir unnamed]

        InitFile
        PropagateModifications
    } "Source Node" "Target Node"
}
