# File communicate.tcl
#
# Prozeduren, die mit dem LISP-Interface kommunizieren

proc def_action { name label action_id e_or_m_or_r} {

    global chart action edge

    my_trace "Entering def_action $name $label $action_id $e_or_m_or_r"

    show_in_window "def_action $name $label $action_id $e_or_m_or_r\n" $name

    # Ueberpruefe, ob es diese Action schon gibt

    set exist 0

    for { set i 0 } { $i <= $chart($name,max_action) } { incr i } {
        if { $action_id == $action($name,$i,id) } {
            set exist 1
            break
        }
    }

    if { $exist == 0 } {
        incr chart($name,max_action)

        set action($name,$chart($name,max_action),id) $action_id
        set action($name,$chart($name,max_action),label) $label
        set action($name,$chart($name,max_action),menu) $e_or_m_or_r
        set action($name,$chart($name,max_action),status) 1
    } else {
        set action($name,$i,label) $label
    }

    return

}

proc send_edge_action { name action_id edge_id } {

    global chart edge action

    my_trace "Entering send_action $name $action_id $edge_id"
    
    show_in_window "do_edge_action $name $action_id $edge_id\n" $name

    # 981012 NEW: andere Ausgabe fuer Prolog
    if { $chart(prolog) == 1 } {
        puts stdout "do_edge_action($name,$action_id,$edge_id).\n"
        flush stdout
    } else {
        puts stdout "do_edge_action"
        flush stdout
        puts stdout "$name"
        flush stdout
        puts stdout "$action_id"
        flush stdout
        puts stdout "$edge_id"
        flush stdout
    }



}

proc send_main_action { name action_id } {

    global chart edge action

    my_trace "Entering send_main_action"
    
    show_in_window "do_main_action $name $action_id \n" $name

    # 981012 NEW: andere Ausgabe fuer Prolog
    if { $chart(prolog) == 1 } {
        puts stdout "do_main_action($name,$action_id)."
        flush stdout
    } else {
        puts stdout "do_main_action"
        flush stdout
        puts stdout "$name"
        flush stdout
        puts stdout "$action_id"
        flush stdout
    }

}


proc quit_parser { name } {

    global chart

    my_trace "Entering quit_parser"

    # 981012 NEW: andere Ausgabe fuer Prolog
    if { $chart(prolog) == 1 } {
        puts stdout "quit_parser($name)."
        flush stdout
    } else {
        puts stdout "quit_parser"
        flush stdout
        puts stdout "$name"
        flush stdout
    }
}

# this proc sets the view of the canvas to the bottom

proc show_bottom { name } {

    global chart

    my_trace "Entering proc show_bottom $name"

    .chart$name.canvas.draw yview moveto 1

    my_trace "Leaving show_bottom $name"

}

# this proc toggles the view to compact

proc view_compact { name } {

    global chart

    my_trace "Entering proc view_compact $name"

    set chart($name,drawingstyle) compact
    redraw_chart $name all

    my_trace "Leaving view_compact"
}

# this proc toggles the view to timebased

proc view_timebased { name } {

    global chart

    my_trace "Entering proc view_timebased $name"

    set chart($name,drawingstyle) timebased
    redraw_chart $name all

    my_trace "Leaving view_timebased"
}

# this proc colors a given edge with color or default

proc mark_edge { chart_id edge_id color} {

    global chart edge

    my_trace "Entering proc mark_edge $chart_id $edge_id $color"

    if { $color != 0 } {

        set colors { blue white green red yellow black gray }
        
        if { [lsearch -exact $colors $color] != -1 } {
            
            set edge($chart_id,$edge_id,mark) $color
        
            if { $chart(colormodel) == 1 } {
                set fill $color
            } else {
                set fill $color
            }
            
            .chart$chart_id.canvas.draw itemconfigure "edge$edge_id" -fill $fill
            set edge($chart_id,$edge_id,mark) 1
            set edge($chart_id,$edge_id,mark_color) $fill            
        } else {
            my_trace "Error: Color $color not defined :-("
        } 
    } else {
        .chart$chart_id.canvas.draw itemconfigure "edge$edge_id" -fill $chart($chart_id,color,mark_color)
        set edge($chart_id,$edge_id,mark) 1
        set edge($chart_id,$edge_id,mark_color) $chart($chart_id,color,mark_color)
    }
    
    my_trace "Leaving mark_edge"

}

# this proc unmarks a marked edge

proc unmark_edge { chart_id edge_id } {

    global chart edge

    my_trace "Entering proc unmark_edge $chart_id $edge_id"

    set edge($chart_id,$edge_id,mark) 0

    # was it an active or passive edge?

    if { $edge($chart_id,$edge_id,status) == 1 } {
                if { $chart(colormodel) == 1 } {
	    set fill $chart(color,active_color)
	} else {
	    set fill $chart(bw,active_color)
	}
    } else {
        if { $chart(colormodel) == 1 } {
	    set fill $chart(color,passive_color)
	} else {
	    set fill $chart(bw,passive_color)
	}
    }

    .chart$chart_id.canvas.draw itemconfigure "edge$edge_id" -fill $fill -width 1.0

    my_trace "Leaving unmark_edge"

}

# this proc marks a rule

proc mark_rule { chart_id rule_id color } {

    global chart edge

    my_trace "Entering proc mark_rule $chart_id $rule_id $color"

    if { $edge($chart_id,$rule_id,start) != -1 } {

        my_trace "There is no rule with ID $rule_id"
        return
    }

    set colors { blue white green red yellow black gray }

    if { [lsearch -exact $colors $color] == -1 } {
        my_trace "Color $color does not exist :-("
        return
    }

    set edge($chart_id,$rule_id,mark) $color
        
    if { $chart(colormodel) == 1 } {
        set fill $color
    } else {
        set fill $color
    }
        
    .chart$chart_id.canvas.draw itemconfigure "rule$rule_id" -fill $fill

    my_trace "Leaving mark_rule"
}

# this proc unmarks a marked rule

proc unmark_rule { chart_id rule_id } {

    global chart edge

    my_trace "Entering proc unmark_rule $chart_id $rule_id"

    if { $edge($chart_id,$rule_id,start) != -1 } {
        
        my_trace "There is no rule with ID $rule_id"
        return
    }
    
    set edge($chart_id,$rule_id,mark) 0

    .chart$chart_id.canvas.draw itemconfigure "rule$rule_id" -fill black
    
    my_trace "Leaving unmark_rule"
}
    
# this proc disables a menu entry

proc disable_menu_entry { chart_id action_id } {

    global chart edge action

    my_trace "Entering proc disable_menu_entry $chart_id $action_id"

    # Ueberpruefe, ob es diese Action ueberhaupt gibt

    set exist 0
    for { set i 0 } { $i <= $chart($chart_id,max_action) } { incr i } {
        if { $action_id == $action($chart_id,$i,id) } {
            set exist 1
            break
        }
    }

    if { $exist == 1 } {

        set action($chart_id,$i,status) 0

    } else {

        my_trace "Action $action_id does not exist!"

    }

    my_trace "Leaving disable_menu_entry"
}

# this proc enables a disabled menu entry

proc enable_menu_entry { chart_id action_id } {

    global chart edge action

    my_trace "Entering proc enable_menu_entry $chart_id $action_id"

    # Ueberpruefe, ob es diese Action ueberhaupt gibt

    set exist 0
    for { set i 0 } { $i <= $chart($chart_id,max_action) } { incr i } {
        if { $action_id == $action($chart_id,$i,id) } {
            set exist 1
            break
        }
    }

    if { $exist == 1 } {

        set action($chart_id,$i,status) 1

    } else {

        my_trace "Action $action_id does not exist!"

    }

    my_trace "Leaving enable_menu_entry"
}


# NEW 990520
# this proc dyes an edge and its children

proc dye_children { chart_id edge_id } {

    my_trace "Entering dye_children $chart_id $edge_id"

    global chart edge

    # gibt es bereits gefaerbte Kinder?
    if { $chart($chart_id,dyed_children) != -1 } {
        undye_children $chart_id $chart($chart_id,dyed_children)
    }

    set chart($chart_id,dyed_children) $edge_id
        
    # benutze die Drawn-Flags, um bereits expandierte Kanten zu erkennen
    # Loesche alle drawn flags
    erase_drawn_flags $chart_id

    # setze queue auf startkante
    set queue $edge_id

    # markiere Elternknoten invers und weisse Schrift
    
    # zeichne ein Rechteck in der Dye-Color
    set coord [.chart$chart_id.canvas.draw bbox "text$edge_id"]
    set c0 [lindex $coord 0]
    set c1 [lindex $coord 1]
    set c2 [lindex $coord 2]
    set c3 [lindex $coord 3]

    .chart$chart_id.canvas.draw create rect $c0 $c1 $c2 $c3 -fill $chart($chart_id,color,dye_color) -tag "parent"
    
    # setze die textfarbe auf weiss, falls dye_color != weiss, sonst schwarz
    if { [string compare $chart($chart_id,color,dye_color) "white"] != 0 } {
        .chart$chart_id.canvas.draw itemconfigure "text$edge_id" -fill white
    }

    # bringe das Rechteck UNTER den text
    .chart$chart_id.canvas.draw lower "parent" "text$edge_id"

    # ergaenze parent tag
    .chart$chart_id.canvas.draw addtag "parent" withtag "text$edge_id"

    # solange queue nicht leer

    while { [llength $queue] != 0 } {


        my_trace "Queue is now: $queue"
        # nimm erstes Element von queue
        set this_id [lindex $queue 0]
        set queue [lrange $queue 1 end]

        # wenn ID == -1, dann nicht zeichnen
        if { $this_id != -1 } {

            # wenn Kante schon als gezeichnet markiert, dann Kinder schon auf queue

            if { $edge($chart_id,$this_id,drawn) != 1 } {
                # markiere Kante
                my_trace "Markiere Kante $this_id"
                # setze Flag
                set edge($chart_id,$this_id,dye) 1
                .chart$chart_id.canvas.draw itemconfigure "edge$this_id" -fill $chart($chart_id,color,dye_color) -width 2.0
                .chart$chart_id.canvas.draw raise "edge_id$this_id" all
                set edge($chart_id,$this_id,drawn) 1
                
                # expandiere Kinder auf queue, aber nur wenn Kinder da sind
                if { $edge($chart_id,$this_id,children) != -1 } {
                    set queue [concat $queue $edge($chart_id,$this_id,children)]
                }
            }

        }
    }



    my_trace "Leaving dye_children"
}

# NEW 990520
# this proc undyes an edge and its children

proc undye_children { chart_id edge_id } {

    my_trace "Entering undye_children $chart_id $edge_id"

    global chart edge

    # Loesche alle drawn flags
    erase_drawn_flags $chart_id

    # setze queue auf startkante

    set queue $edge_id

    # loesche das Rechteck, Schrift wieder schwarz
    .chart$chart_id.canvas.draw itemconfigure "text$edge_id" -fill black
    .chart$chart_id.canvas.draw dtag "text$edge_id" "parent"
    .chart$chart_id.canvas.draw delete "parent"

    # solange queue nicht leer

    while { [llength $queue] != 0 } {


        my_trace "Queue is now: $queue"
        # nimm erstes Element von queue
        set this_id [lindex $queue 0]
        set queue [lrange $queue 1 end]

        # wenn ID == -1, dann nicht zeichnen
        if { $this_id != -1 } {

            # wenn Kante schon als gezeichnet markiert, dann Kinder schon auf queue

            if { $edge($chart_id,$this_id,drawn) != 1 } {
                # entferne Flag
                set edge($chart_id,$this_id,dye) 0

                # entferne Markierung
                unmark_edge $chart_id $this_id
                set edge($chart_id,$this_id,drawn) 1
                
                # expandiere Kinder auf queue, aber nur wenn Kinder da sind
                if { $edge($chart_id,$this_id,children) != -1 } {
                    set queue [concat $queue $edge($chart_id,$this_id,children)]
                }
            }

        }
    }
    
    # setze Flag zurueck
    set chart($chart_id,dyed_children) -1

    my_trace "Leaving undye_children"
}



