# File draw_p.tcl (draw_physical)
#
# Prozeduren, die das tatsaechliche Zeichnen uebernehmen

# diese Prozedur zeichnet eine Kante physikalisch auf das Canvas
proc physical_draw_edge { name id start end label status extension children args } {
    
    global chart token edge
  
    my_trace "Entering proc physical_draw_edges $name $id $start $end $label $status $extension $children $args"
    

    # Kante ist eine Regel
    if { $start == -1 } {
	draw_rule $name $id
	return
    }

    my_trace "Drawing edge $id"

    # 0-Span Kante ?
    if { $start == $end } {

	# Erhoehe Platz unter Token
        incr token($name,$start,depth)
        
	# berechne Fonthoehe
	set fontheight [lindex [broadness_of_string $edge($name,$id,label) $name] 1]
	
	# berechne Position des Textes unter Token
	set xpos_of_text $token($name,$start,x0)
	set ypos_of_text [expr $token($name,$start,y0) + $chart(defaulttokendiameter) + $fontheight * $token($name,$start,depth)]
	
	# schreibe Text unter entsprechendes Token
        .chart$name.canvas.draw create text $xpos_of_text $ypos_of_text -text $label -font $chart(defaultfont) -tags "edge$id text edge item$id"

#        .chart$name.canvas.draw bind edge$id <Button-1> ".chart$name.canvas.draw itemconfigure item$id -fill green;make_edgepopup $name $id;tk_popup .chart$name.edgepopup %X %Y"
	# speichere Position des Textes wegen Blinken
	set edge($name,$id,xtext) $xpos_of_text
	set edge($name,$id,ytext) $ypos_of_text

	# hier noch Handling, falls Text out of canvas...

        return
    }
    # Ende der Behandlung einer 0-Span Kante
    
    set maxheight 0

    my_trace "maxheight = $maxheight"

    # suche die maximale Hoehe der ueberspannten Token
    for { set i $start } { $i < $end } { incr i } {
        if { $token($name,$i,height) > $maxheight } {
            set maxheight $token($name,$i,height)
        }
    }

    if { [info exists edge($name,$id,tokenheights)] == 1 } {
        unset edge($name,$id,tokenheights)
    }
    for { set i $start } { $i < $end } { incr i } {
        lappend edge($name,$id,tokenheights) $token($name,$i,height)
        set token($name,$i,height) [expr $maxheight + 1]
    }

    set edge($name,$id,height) $maxheight

    if { $status == 1 } {
        if { $chart(colormodel) == 1 } {
	    set fill $chart(color,active_color)
	} else {
	    set fill $chart(bw,active_color)
	}
	set a_p_tag "active"
    } else {
        if { $chart(colormodel) == 1 } {
	    set fill $chart(color,passive_color)
	} else {
	    set fill $chart(bw,passive_color)
	}
	set a_p_tag "passive"
    }
    
    # Berechne die Breite des Labels im aktuellen Font
    set broad [lindex [broadness_of_string $edge($name,$id,label) $name] 0]
    my_trace "Broad=$broad"
    
    # Berechne die Hoehe des aktuellen Fonts
    set fontheight [lindex [broadness_of_string $edge($name,$id,label) $name] 1]
    my_trace "Fontheight=$fontheight"
    
    # Berechne den Abstand zwischen den Tokens
    set abstand [expr $token($name,$end,x0) + $token($name,$start,x0)]
    
    my_trace "Zwischen Token $end und Token $start"
    my_trace "Abstand = $token($name,$end,x0) + $token($name,$start,x0) = $abstand"

    # Xpos des Textes ist der Abstand / 2
    set xpos_of_text [expr round([expr $abstand / 2])]
    
    # Ypos des Textes ist ein wenig ueber den Token - die aktuelle Hoehe
    set ypos_of_text [expr $chart(defaultscrollheight) - $chart($name,downspace) - 2 * $chart(defaulttokendiameter) - $maxheight * $fontheight]
    
    # speichere die Pos des Textes zum Blinken
    set edge($name,$id,xtext) $xpos_of_text
    set edge($name,$id,ytext) $ypos_of_text
    
    set start_tag "s$start"
    set end_tag "e$end"

    .chart$name.canvas.draw create text $xpos_of_text $ypos_of_text -text $edge($name,$id,label) -justify center -tags "text$id text edge item$id" -font $chart(defaultfont)
    
    .chart$name.canvas.draw bind text$id <ButtonPress-1> ".chart$name.canvas.draw raise item$id;.chart$name.canvas.draw itemconfigure item$id -fill $chart($name,color,blink_color);make_edgepopup $name $id edge;tk_popup .chart$name.edgepopup %X %Y"

    .chart$name.canvas.draw bind item$id <ButtonPress-2> ".chart$name.canvas.draw raise item$id;.chart$name.canvas.draw itemconfigure item$id -fill $chart($name,color,blink_color)"
    .chart$name.canvas.draw bind item$id <ButtonRelease-2> "rebuild_item $name $id"
    


#    .chart$name.canvas.draw bind edge$id <ButtonPress-1> ".chart$name.canvas.draw itemconfigure item$id -fill green"
#    .chart$name.canvas.draw bind edge$id <Enter> ".chart$name.canvas.draw itemconfigure edge$id -fill green;.chart$name.canvas.draw itemconfigure whole$id -fill green;.chart$name.canvas.draw raise whole$id"
#    .chart$name.canvas.draw bind edge$id <Leave> ".chart$name.canvas.draw itemconfigure edge$id -fill black;.chart$name.canvas.draw itemconfigure whole$id -fill black"

    set begin_of_string [expr $xpos_of_text - round([expr $broad / 2]) - 2]
    set end_of_string [expr round([expr $broad / 2]) + $xpos_of_text + 2]


# Stretch - Mode ?
    if { [string compare $chart($name,view) "stretched"] == 0 } {
        set chart($name,stretch) $chart(defaultstretchfactor)
    } else {
        set chart($name,stretch) 0
    }

# 990528: do not care for marked edges

# 980930: care for the mark flag
# 981001: changed the meaning of mark flag
#    if { $edge($name,$id,mark) != 0 } {
#        if { $chart(colormodel) == 1 } {
#	    set fill $chart(color,mark_color)
#	} else {
#	    set fill $chart(bw,mark_color)
#	}
#        set fill $edge($name,$id,mark)
#    }

# # Linie links

# # Linie senkrecht (unten nach oben)

    .chart$name.canvas.draw create line $token($name,$start,x0) $token($name,$start,y0) [expr $token($name,$start,x0)+$chart($name,stretch)] [expr $ypos_of_text + 10] -fill $fill -width $chart(defaultlinewidth) -tags "edge$id line edge item$id"

# # Linie schraeg (links unten nach rechts oben)

    .chart$name.canvas.draw create line [expr $token($name,$start,x0) + $chart($name,stretch)] [expr $ypos_of_text + 10] [expr 15 + $token($name,$start,x0)] $ypos_of_text -fill $fill -width $chart(defaultlinewidth) -tags "edge$id line edge item$id"

# # Linie waagerecht (links nach rechts)
     .chart$name.canvas.draw create line [expr 15 + $token($name,$start,x0)] $ypos_of_text $begin_of_string $ypos_of_text -fill $fill -width $chart(defaultlinewidth) -tags "edge$id line edge item$id"


# # Linie rechts

# # Linie senkrecht (von unten nach oben)

    .chart$name.canvas.draw create line $token($name,$end,x0) $token($name,$end,y0) [expr $token($name,$end,x0) - $chart($name,stretch)] [expr $ypos_of_text + 10] -fill $fill -width $chart(defaultlinewidth) -tags "edge$id line edge item$id"

# # Linie schraeg (von rechts unten nach links oben)

    .chart$name.canvas.draw create line [expr $token($name,$end,x0) - $chart($name,stretch)] [expr $ypos_of_text + 10] [expr $token($name,$end,x0) - 15] $ypos_of_text -fill $fill -width $chart(defaultlinewidth) -tags "edge$id line edge item$id"

# # Linie waagerecht (von rechts nach links)

     .chart$name.canvas.draw create line [expr $token($name,$end,x0) - 15] $ypos_of_text $end_of_string $ypos_of_text -fill $fill -width $chart(defaultlinewidth) -tags "edge$id line edge item$id"

    # draw arraw according to extension

    # right extension
    if { $extension == 1 && $status == 1 } {
	.chart$name.canvas.draw create line $end_of_string [expr $ypos_of_text - 2]  $end_of_string [expr $ypos_of_text + 2] -fill $fill -width $chart(defaultlinewidth) -tags "edge$id line edge item$id"
	.chart$name.canvas.draw create line $end_of_string [expr $ypos_of_text - 2] [expr $end_of_string + 4] $ypos_of_text -fill $fill -width $chart(defaultlinewidth) -tags "edge$id line edge item$id"
	.chart$name.canvas.draw create line $end_of_string [expr $ypos_of_text + 2] [expr $end_of_string + 4] $ypos_of_text -fill $fill -width $chart(defaultlinewidth) -tags "edge$id line edge item$id"
    }

    # left extension
    if { $extension == 0 && $status == 1 } {
	.chart$name.canvas.draw create line $begin_of_string [expr $ypos_of_text - 2]  $begin_of_string [expr $ypos_of_text + 2] -fill $fill -width $chart(defaultlinewidth) -tags "edge$id line edge item$id"
	.chart$name.canvas.draw create line $begin_of_string [expr $ypos_of_text - 2] [expr $begin_of_string - 4] $ypos_of_text -fill $fill -width $chart(defaultlinewidth) -tags "edge$id line edge item$id"
	.chart$name.canvas.draw create line $begin_of_string [expr $ypos_of_text + 2] [expr $begin_of_string - 4] $ypos_of_text -fill $fill -width $chart(defaultlinewidth) -tags "edge$id line edge item$id"
    }

# edge out of area ?

    if { $ypos_of_text < 0 } {
	
	incr chart(defaultscrollheight) $chart(defaultheightincrement)
	my_trace "Edge out of bounds, extending y_res by $chart(defaultheightincrement)"
	.chart$name.canvas.draw configure -scrollregion "0 0 $chart(defaultscrollwidth) $chart(defaultscrollheight)"
	redraw_chart $name allrules
    }

    update

    my_trace "Leaving physical_draw_edge"

}

proc draw_physical_rule { name id } {

    global chart edge token

    my_trace "Entering proc draw_physical_rule $name $id"

    incr chart($name,ruleheight)
    my_trace "Ruleheight = $chart($name,ruleheight)"

    # Berechne die Hoehe des aktuellen Fonts
    set fontheight [lindex [broadness_of_string $edge($name,$id,label) $name] 1]
    
    # speichere Textposition fuer die Blinkenlights
    set edge($name,$id,xtext) [expr $chart($name,leftspace) / 2]
    #set edge($name,$id,ytext) [expr $token($name,0,y0) - $chart($name,ruleheight) * $fontheight]
    set edge($name,$id,ytext) [expr $chart(defaultscrollheight) - $chart($name,downspace) - $chart(defaulttokendiameter) + round($chart(defaulttokendiameter)/2) - $chart($name,ruleheight) * ($fontheight + $chart(rulespace))]
    
    my_trace "Drawing rule on $edge($name,$id,xtext),$edge($name,$id,ytext)"

    # 981001 new: Marking of rules possible
    if { $edge($name,$id,mark) != 0 } {
        set fill $edge($name,$id,mark)
    } else {
        set fill black
    }

    # zeichne Regel links der Chart
    .chart$name.canvas.draw create text $edge($name,$id,xtext) $edge($name,$id,ytext) -text $edge($name,$id,label) -font $chart(defaultfont) -tags "rule rule$id item$id" -fill $fill

    # now show an rule-menu on a rule
    .chart$name.canvas.draw bind rule$id <ButtonPress-1> "make_rulepopup $name $id;tk_popup .chart$name.rulepopup %X %Y"
    
    my_trace "Leaving draw_physical_rule"

}

# loescht die Draw-Flags aller Kanten
proc erase_drawn_flags { name } {

    global edge draw chart

    my_trace "Entering proc erase_drawn_flags $name"
    
    for { set i 0 } { $i <= $chart($name,drawn_edges) } {incr i } {

	set id $draw($name,$i)
	set edge($name,$id,drawn) 0
    }

    my_trace "Leaving erase_drawn_flags"

}

# loescht nur das Display !
proc clear_view { name } {

    global chart

    my_trace "Entering proc clear_view $name"

    .chart$name.canvas.draw delete all

    set chart(result) 1
    set chart($name,ruleheight) 0

    # zeichne wieder alle Tokens
    for { set i 0 } { $i <= $chart($name,max_token) } { incr i } {
	draw_token $name $i
    }

    my_trace "Leaving clear_view"
}