
#-------------------------------------------------------------------------------
# Module:     editor.tk
# Activation: Loaded during GOBLET startup
# Scope:      Generation of the editor canvas
#             All editor functions
#             Conversions between library and editor object
#
# Updated:
#-------------------------------------------------------------------------------



# Conversions of Canvas Coordinates and Goblin Coordinates

proc CanvasCX {cx} {
    global goblinXShift goblinXZoom Zoom

    return [expr {$cx*$goblinXZoom*$Zoom+$goblinXShift*$Zoom}];
}


proc CanvasCY {cy} {
    global goblinYShift goblinYZoom Zoom

    return [expr {$cy*$goblinYZoom*$Zoom+$goblinYShift*$Zoom}];
}


proc GoblinCX {cx} {
    global goblinXShift goblinXZoom Zoom Grid
    if ($Grid==0) {
        return [expr {($cx-$goblinXShift*$Zoom)/($goblinXZoom+0.00001)/$Zoom}]
    } else {
        return [expr {round(($cx-$goblinXShift*$Zoom)/($goblinXZoom+0.00001)/$Zoom/$Grid)*$Grid}]
    }
}


proc GoblinCY {cy} {
    global goblinYShift goblinYZoom Zoom Grid
    if ($Grid==0) {
        return [expr {($cy-$goblinYShift*$Zoom)/($goblinYZoom+0.00001)/$Zoom}]
    } else {
        return [expr {round(($cy-$goblinYShift*$Zoom)/($goblinYZoom+0.00001)/$Zoom/$Grid)*$Grid}]
    }
}


proc GridCX {cx} {
    return [CanvasCX [GoblinCX $cx]];
}


proc GridCY {cy} {
    return [CanvasCY [GoblinCY $cy]];
}


proc CurrentCX {cx} {
    global xscroll
    return [GridCX [expr {$cx+[MaxCX]*[lindex [$xscroll get] 0]}]]
}


proc CurrentCY {cy} {
    global yscroll
    return [GridCY [expr {$cy+[MaxCY]*[lindex [$yscroll get] 0]}]]
}


proc MaxCX {} {
    global ThisGraph goblinXShift Zoom

    return [expr {[CanvasCX [$ThisGraph max cx]]+$goblinXShift*$Zoom}];
}


proc MaxCY {} {
    global ThisGraph goblinYShift Zoom

    return [expr {[CanvasCY [$ThisGraph max cy]]+$goblinYShift*$Zoom}];
}



# Placement of Canvas Nodes

proc DrawNode {v nodeType cx cy} {
    global c IncIn IncOut NodeIndex RevNodeIndex goblinNodeSize Zoom

    if {[string equal $nodeType "real"]} {
        set ratio [expr {$goblinNodeSize*$Zoom}]
    } else {set ratio 4}
    
    set node [$c create oval \
        [expr {$cx-$ratio}] [expr {$cy-$ratio}] \
        [expr {$cx+$ratio}] [expr {$cy+$ratio}] \
        -outline black -fill grey -tags node]
    set IncIn($v) {}
    set IncOut($v) {}
    set NodeIndex($node) $v
    set RevNodeIndex($v) $node
}


proc RedrawNode {v nodeType} {
    global c ThisGraph RevNodeIndex goblinNodeSize Zoom

    if {[string equal $nodeType "real"]} {
        set ratio [expr {$goblinNodeSize*$Zoom}]
    } else {set ratio 4}
    
    set Node $RevNodeIndex($v)
    $c coords $Node \
        [expr {[CanvasCX [$ThisGraph node $v cx]]-$ratio}] \
        [expr {[CanvasCY [$ThisGraph node $v cy]]-$ratio}] \
        [expr {[CanvasCX [$ThisGraph node $v cx]]+$ratio}] \
        [expr {[CanvasCY [$ThisGraph node $v cy]]+$ratio}]
}


proc DropNode {v cx cy} {
    global ThisGraph c
    
    set x0 [GoblinCX $cx]
    set y0 [GoblinCY $cy]
    
    if {($x0<0)} {
        for {set u 0} {$u<[expr {[$ThisGraph #nodes]+[$ThisGraph #artificial]}]} {incr u} {
            $ThisGraph node $u set cx [expr {[$ThisGraph node $u cx]-$x0}]
        }
        $ThisGraph node $v set cx 0
    } else {$ThisGraph node $v set cx $x0}

    if {($y0<0)} {
        for {set u 0} {$u<[expr {[$ThisGraph #nodes]+[$ThisGraph #artificial]}]} {incr u} {
            $ThisGraph node $u set cy [expr {[$ThisGraph node $u cy]-$y0}]
        }
        $ThisGraph node $v set cy 0
    } else {$ThisGraph node $v set cy $y0}
    
    RedrawGraph
}


# Placement of Canvas Arcs

proc DrawArc {a} {
    global ThisGraph c IncIn IncOut Mode \
        ArcIndex RevArcIndex HandleIndex RevHandleIndex thisCoords
    
    set u [$ThisGraph arc [expr {2*$a}] tail]
    set v [$ThisGraph arc [expr {2*$a}] head]
    set w [$ThisGraph arc [expr {2*$a}] align]
    
    if {$u==$v && [string equal $w "*"]} {return}

    # Draw Handle
    
    if {[string equal $w "*"]} {
        set cx [expr {([$ThisGraph node $u cx]+[$ThisGraph node $v cx])/2}]
        set cy [expr {([$ThisGraph node $u cy]+[$ThisGraph node $v cy])/2}]
    } else {
        set cx [$ThisGraph node $w cx]
        set cy [$ThisGraph node $w cy]
    }
    
    set handle [$c create rectangle \
        [expr {[CanvasCX $cx]-4}] [expr {[CanvasCY $cy]-4}] \
        [expr {[CanvasCX $cx]+4}] [expr {[CanvasCY $cy]+4}] \
        -outline black -fill black -tags handle]

    
    # Compute Canvas Coordinates
    
    if {$w!="*"} {set w [$ThisGraph node $w interpolate]}
        
    set thisCoords [list \
        [CanvasCX [$ThisGraph node $u cx]] \
        [CanvasCY [$ThisGraph node $u cy]]]
            
    while {$w!="*"} {
        DrawNode $w artifical \
            [CanvasCX [$ThisGraph node $w cx]] \
            [CanvasCY [$ThisGraph node $w cy]]
        lappend thisCoords \
            [CanvasCX [$ThisGraph node $w cx]] \
            [CanvasCY [$ThisGraph node $w cy]]
        set w [$ThisGraph node $w interpolate]
    }
    
    lappend thisCoords \
        [CanvasCX [$ThisGraph node $v cx]] \
        [CanvasCY [$ThisGraph node $v cy]]

    AlignThisCoords 0 2
    AlignThisCoords [expr {[llength $thisCoords]-2}] [expr {[llength $thisCoords]-4}]
    

    # Draw Arc
    
    global goblinArcStyle
    set lineCommand "$c create line $thisCoords"
    set widthOption "-width 2"
    set smoothOption ""
    if {$goblinArcStyle == 1} {set smoothOption "-smooth on"}
    set dirOption ""
    if {[$ThisGraph arc [expr {2*$a}] orientation]} {set dirOption "-arrow last"}

    # Handle predecessor arcs
    
    set fillOption ""
    if {[string equal $Mode "set predecessors"]} {
        if {[$ThisGraph node $v predecessor]==[expr 2*$a]} {
            set widthOption "-width 5"
	    set fillOption "-fill purple"
	    set dirOption "-arrow last"
        }
        if {[$ThisGraph node $u predecessor]==[expr 2*$a+1]} {
            set widthOption "-width 5"
            set fillOption "-fill purple"
            set dirOption "-arrow first"
        }
    }
    
    set Arc [eval $lineCommand $widthOption $smoothOption $fillOption $dirOption]

    # Set Indices
    
    $c lower $Arc
    lappend IncIn($v) $Arc
    lappend IncOut($u) $Arc
    set ArcIndex($Arc) $a
    set RevArcIndex($a) $Arc
    
    set RevHandleIndex($handle) $a
    set HandleIndex($a) $handle
}

proc RedrawArc {a} {
    global ThisGraph c RevArcIndex HandleIndex thisCoords
    
    set u [$ThisGraph arc [expr {2*$a}] tail]
    set v [$ThisGraph arc [expr {2*$a}] head]
    set w [$ThisGraph arc [expr {2*$a}] align]
    
    if {$u==$v && [string equal $w "*"]} {return}
    

    # Draw Handle
    
    if {[string equal $w "*"]} {
        set cx [expr {([$ThisGraph node $u cx]+[$ThisGraph node $v cx])/2}]
        set cy [expr {([$ThisGraph node $u cy]+[$ThisGraph node $v cy])/2}]
    } else {
        set cx [$ThisGraph node $w cx]
        set cy [$ThisGraph node $w cy]
    }
    
    $c coords $HandleIndex($a) \
        [expr {[CanvasCX $cx]-4}] [expr {[CanvasCY $cy]-4}] \
        [expr {[CanvasCX $cx]+4}] [expr {[CanvasCY $cy]+4}]

    
    # Compute Canvas Coordinates
    
    if {$w!="*"} {set w [$ThisGraph node $w interpolate]}
        
    set thisCoords [list \
        [CanvasCX [$ThisGraph node $u cx]] \
        [CanvasCY [$ThisGraph node $u cy]]]
            
    while {$w!="*"} {
        RedrawNode $w artifical
        lappend thisCoords \
            [CanvasCX [$ThisGraph node $w cx]] \
            [CanvasCY [$ThisGraph node $w cy]]
        set w [$ThisGraph node $w interpolate]
    }
    
    lappend thisCoords \
        [CanvasCX [$ThisGraph node $v cx]] \
        [CanvasCY [$ThisGraph node $v cy]]

    AlignThisCoords 0 2
    AlignThisCoords [expr {[llength $thisCoords]-2}] [expr {[llength $thisCoords]-4}]
    

    # Draw Arc
    
    eval $c coords $RevArcIndex($a) $thisCoords
    if {[$ThisGraph arc [expr {2*$a}] orientation]} {
        $c itemconfigure $RevArcIndex($a) -arrow last
    } else {
        $c itemconfigure $RevArcIndex($a) -arrow none
    }
}

proc AlignThisCoords {indexHead indexPred} {
    global thisCoords goblinNodeSize Zoom
    
    set xPred [lindex $thisCoords $indexPred]
    set yPred [lindex $thisCoords [expr {$indexPred+1}]]
    set xHead [lindex $thisCoords $indexHead]
    set yHead [lindex $thisCoords [expr {$indexHead+1}]]
    set dx [expr {$xHead-$xPred}]
    set dy [expr {$yHead-$yPred}]
    set norm [expr {sqrt($dx*$dx+$dy*$dy)}]
    
    if {$norm==0} {return}
    
    set newX [expr {$xHead-$dx/$norm*$goblinNodeSize*$Zoom}]
    set newY [expr {$yHead-$dy/$norm*$goblinNodeSize*$Zoom}]
        
    set thisCoords [lreplace $thisCoords $indexHead [expr {$indexHead+1}] \
        $newX $newY
    ]
}


# Initialize Canvas with Graph in GOBLIN Library

proc DrawGraph {} {
    global ThisGraph c
    
    $c configure -scrollregion [list 0 0 [MaxCX] [MaxCY]]

    for {set v 0} {$v<[$ThisGraph #nodes]} {incr v} {
        DrawNode $v real \
            [CanvasCX [$ThisGraph node $v cx]] \
            [CanvasCY [$ThisGraph node $v cy]]
    }
    
    if {[$ThisGraph is sparse]} {
        for {set a 0} {$a<[$ThisGraph #arcs]} {incr a} {DrawArc $a}
    } else {
        for {set v 0} {$v<[$ThisGraph #nodes]} {incr v} {
            set thisPred [$ThisGraph node $v predecessor]
		    if {$thisPred!="*"} {DrawArc [expr $thisPred/2]}
        }
    }
}

proc RedrawGraph {} {
    global ThisGraph c
    
    $c configure -scrollregion [list 0 0 [MaxCX] [MaxCY]]

    for {set v 0} {$v<[$ThisGraph #nodes]} {incr v} {RedrawNode $v real}
    
    if {[$ThisGraph is sparse]} {
        for {set a 0} {$a<[$ThisGraph #arcs]} {incr a} {RedrawArc $a}
    } else {
        for {set v 0} {$v<[$ThisGraph #nodes]} {incr v} {
            set thisPred [$ThisGraph node $v predecessor]
		    if {$thisPred!="*"} {RedrawArc [expr $thisPred/2]}
        }
    }
}



# Editor Event Bindings

proc MakeBalloon3 {label cx cy} {
    global ThisGraph c
    destroy .balloon
    toplevel .balloon
    append wdSize 100x20+ \
        [expr [winfo rootx $c]+$cx+15] + \
        [expr [winfo rooty $c]+$cy+20]
    wm geometry .balloon $wdSize
    label .balloon.text -text $label -bg yellow -relief solid -anchor w
    pack .balloon.text -fill both

    set wdSize ""
    append wdSize [winfo reqwidth .balloon.text] x \
        [winfo reqheight .balloon.text] + \
        [expr [winfo rootx $c]+$cx+15]  + \
        [expr [winfo rooty $c]+$cy+20]
    wm geometry .balloon $wdSize
    wm overrideredirect .balloon 1
}

proc InitEditor {} {
    global ThisGraph currentNode currentArc StatusInfo GoblinTclPath Unchanged

    InitCanvasRegion
    MakeEditorBar

    set currentNode ""
    set currentArc ""
    set StatusInfo ""
    
    global c NodeIndex RevHandleIndex

    $c bind node <Any-Enter> {
        set thisObj [$c find withtag current]
        $c itemconfigure current -fill black
        set currentNode $NodeIndex($thisObj)
        MakeBalloon3 "node index $currentNode" %x %y
    }

    $c bind handle <Any-Enter> {
        set thisObj [$c find withtag current]
        $c itemconfigure current -fill grey
        set currentArc $RevHandleIndex($thisObj)
        MakeBalloon3 "arc index $currentArc" %x %y
    }

    $c bind node <Any-Leave> {
        set thisObj [$c find withtag current]
        $c itemconfigure current -fill grey
        set currentNode ""
        DestroyBalloon
    }
    
    $c bind handle <Any-Leave> {
        set thisObj [$c find withtag current]
        $c itemconfigure current -fill black
        set currentArc ""
        DestroyBalloon
    }
    
    global Mode ThisNode ThisArc StartNode EndNode ThisCoords HandleIndex

    set ThisNode ""
    set ThisArc ""
    set StartNode ""
    set EndNode ""

    bind $c <Button-1> {
        if {[string equal $Mode "move nodes"]} {
            set ThisNode $currentNode
            if {$currentArc!="" && [$ThisGraph arc [expr {2*$currentArc}] align]!="*"} {
                set ThisArc $currentArc}
        }
    
        if {[string equal $Mode "change labels"]} {
            if {$currentNode!="" && $currentNode<[$ThisGraph #nodes]} {
                source [file join $GoblinTclPath nodeattrib.tk]}
            if {$currentArc!=""} {
                source [file join $GoblinTclPath arcattrib.tk]}
        }
    
        if {[string equal $Mode "redirect arcs"]} {
            if {$currentArc!=""} {
                $ThisGraph arc [expr {2*$currentArc}] flip
                RedrawArc $currentArc
                PropagateModifications
            }
        }

        if {[string equal $Mode "insert nodes"]} {
            if {$currentNode == ""} {
                set v [$ThisGraph node insert]
                PropagateModifications

                DrawNode $v real [CurrentCX %x] [CurrentCY %y]
                DropNode $v [CurrentCX %x] [CurrentCY %y]
            }
        }
    
        if {[string equal $Mode "set predecessors"]} {
            if {$EndNode == ""} {
                if {$currentNode != "" && $currentNode<[$ThisGraph #nodes]} {
                    set EndNode $currentNode

                    MakeHelp "(L) set predecessor node/arc  (C) dismiss"
                }
            } else {
                set thisPred ""
                if {$currentNode!="" && $currentNode<[$ThisGraph #nodes]} {
                    set StartNode $currentNode
                    set thisPred [$ThisGraph adjacency $StartNode $EndNode]
                }

                if {$currentArc!=""} {
                    set thisPred [expr 2*$currentArc]
		    if {[$ThisGraph arc $thisPred head]!=$EndNode} {
                        incr thisPred
                    }
                    set StartNode [$ThisGraph arc $thisPred tail]
                }

                if {$thisPred!="" && [$ThisGraph arc $thisPred head]==$EndNode} {
                    $ThisGraph node $EndNode set predecessor $thisPred
                    PropagateModifications
                    set EndNode ""
                    MakeHelp "(L) select node"
                    InitEditor
                }
            }
        }
    
        if {[string equal $Mode "insert arcs"]} {
            if {$StartNode == ""} {
                if {$currentNode != "" && $currentNode<[$ThisGraph #nodes]} {
                    set StartNode $currentNode

                    set ThisCoords [list \
                        [CanvasCX [$ThisGraph node $StartNode cx]] \
                        [CanvasCY [$ThisGraph node $StartNode cy]] \
                        [CurrentCX %x] [CurrentCY %y]]
                    set ThisArc [$c create line $ThisCoords]
                    $c lower $ThisArc
                    MakeHelp "(L) select end node/place bend  (C) cancel"
                }
            } else {
                set EndNode [$c find withtag current]

                if {$EndNode != "" && \
                        [info exists NodeIndex($EndNode)]==1 && \
                        $NodeIndex($EndNode)<[$ThisGraph #nodes] \
                    } {
                    set u $StartNode
                    set v $NodeIndex($EndNode)
                    $c delete $ThisArc
            
                    set a [$ThisGraph arc insert $u $v]
                    set thisLength [llength $ThisCoords]
                    if {$thisLength>4} {
                        set goblinCoords ""
                        for {set i 0} {$i < $thisLength} {incr i} {
                            lappend goblinCoords [GoblinCX [lindex $ThisCoords $i]]
                        }

                        $ThisGraph arc [expr {2*$a}] set align \
                            [lindex $goblinCoords 0] [lindex $goblinCoords 1]
                        eval $ThisGraph arc [expr {2*$a}] interpolate \
                            [lrange $goblinCoords 2 [expr {$thisLength-3}]]

                        set ThisNode [$ThisGraph arc [expr {2*$a}] align]
                        MakeHelp "(L) align label"
                    } else {
                        set ThisNode ""
                        MakeHelp "(L) align label  (R) automatic alignment"
                    }

                    DrawArc $a
                    if {[info exists HandleIndex($a)]} {
                        set ThisArc $a
                        set Mode "align label"

                        PropagateModifications
                        set StartNode ""
                        set EndNode ""
                    } else {
                        MakeHelp "Missing interpolation points"
                        set StartNode ""
                        set EndNode ""
                    }
                } else {
                    set ThisCoords \
                        [lappend ThisCoords \
                            [CurrentCX %x] \
                            [CurrentCY %y] \
                        ]
                }
            }
        }
    
        if {[string equal $Mode "align label"] && $currentNode == ""} {
            if {$ThisNode == ""} {
                $ThisGraph arc [expr {2*$ThisArc}] set align \
                    [GoblinCX %x] [GoblinCX %y]
            } else {
                $ThisGraph node $ThisNode set cx [GoblinCX %x]
                $ThisGraph node $ThisNode set cy [GoblinCY %y]
            }
            set Mode "insert arcs"
            MakeHelp "(L) select start node"
            set ThisNode ""
            set ThisArc ""
        }
        
        if {[string equal $Mode "delete objects"]} {
            if {$currentNode != "" && ![$ThisGraph is bipartite]} {
                $ThisGraph node $currentNode delete
                PropagateModifications
                InitEditor
            }
            if {$currentArc != ""} {
                $ThisGraph arc [expr {2*$currentArc}] delete
                PropagateModifications
                InitEditor
            }
        }
    }

    bind $c <B1-Motion> {
        if {[string equal $Mode "move nodes"] || [string equal $Mode "insert nodes"]} {
            if {$ThisNode != ""} {
                DropNode $ThisNode [CurrentCX %x] [CurrentCY %y]
            }
            if {$ThisArc != ""} {
                DropNode [$ThisGraph arc [expr {2*$ThisArc}] align] \
                    [CurrentCX %x] [CurrentCY %y]
            }
        }
    }

    bind $c <Motion> {
        if {[string equal $Mode "insert arcs"]} {
            if {$StartNode != ""} {
                set thisLength [llength $ThisCoords]
                set thiscx [CurrentCX %x]
                set thiscy [CurrentCY %y]
                
                if {$goblinArcStyle==2} {
                    set prevcx [lindex $ThisCoords [expr {$thisLength-4}]]
                    set prevcy [lindex $ThisCoords [expr {$thisLength-3}]]

                    if {$thiscx > $prevcx} {
                        set diffcx [expr {$thiscx-$prevcx}]
                    } else {
                        set diffcx [expr {$prevcx-$thiscx}]
                    }
                    if {$thiscy > $prevcy} {
                        set diffcy [expr {$thiscy-$prevcy}]
                    } else {
                        set diffcy [expr {$prevcy-$thiscy}]
                    }
                    if {$diffcx*0.95>$diffcy} {set thiscy $prevcy}
                    if {$diffcx<$diffcy*0.95} {set thiscx $prevcx}
                }
                
                set ThisCoords \
                    [lreplace $ThisCoords \
                        [expr {$thisLength-2}] \
                        [expr {$thisLength-1}] \
                        $thiscx $thiscy \
                    ]
                eval $c coords $ThisArc $ThisCoords
            }
        }
        
        if {[string equal $Mode "align label"]} {
            $c coords $HandleIndex($ThisArc) \
                [expr {[CurrentCX %x]-4}] [expr {[CurrentCY %y]-4}] \
                [expr {[CurrentCX %x]+4}] [expr {[CurrentCY %y]+4}]
        }
        
    }

    bind $c <ButtonRelease-1> {
        if {[string equal $Mode "move nodes"] || [string equal $Mode "insert nodes"]} {
            if {$ThisNode != ""} {
                set ThisNode ""
                PropagateModifications
            }
            if {$ThisArc != ""} {
                set v [$ThisGraph arc [expr {2*$ThisArc}] align]
                $ThisGraph node $v set cx [GoblinCX %x]
                $ThisGraph node $v set cy [GoblinCY %y]
                set ThisArc ""
                PropagateModifications
            }
        }
    }

    bind $c <Button-3> {
        if {[string equal $Mode "insert arcs"]} {
            if {$ThisArc != ""} {
                $c delete $ThisArc
                set StartNode ""
                set ThisArc ""
                MakeHelp "(L) select start node"
            }
        }
        
        if {[string equal $Mode "redirect arcs"]} {
            if {$currentArc!="" && ![$ThisGraph is undirected] \
                 && ![$ThisGraph is directed]} {
                $ThisGraph arc [expr {2*$currentArc}] set orientation \
                    [expr {1-[$ThisGraph arc [expr {2*$currentArc}] orientation]}]
                RedrawArc $currentArc
                PropagateModifications
            }
        }

        if {[string equal $Mode "align label"] && $ThisNode==""} {
            $c delete $HandleIndex($ThisArc)
            $c delete $RevArcIndex($ThisArc)
            DrawArc $ThisArc
            set ThisNode ""
            set ThisArc ""
            set Mode "insert arcs"
            MakeHelp "(L) select start node"
        }
    
        if {[string equal $Mode "set predecessors"]} {
            if {$EndNode != ""} {
                $ThisGraph node $EndNode set predecessor "*"
                PropagateModifications
                set EndNode ""
                MakeHelp "(L) select node"
                InitEditor
            }
        }
    }

    DrawGraph
    BackupScrollPos
}
