提交 e341c06d 编写于 作者: P Paul Mackerras

gitk: Eliminate diagonal arrows

This changes the optimizer to insert pads to straighten downward
pointing arrows so they point straight down.  When drawing the parent
link to the first child in drawlineseg, this draws it with 3 segments
like other parent links if it is only one row high with an arrow.
These two things mean we can dispense with the workarounds for arrows
on diagonal segments.  This also fixes a couple of other minor bugs.
Signed-off-by: NPaul Mackerras <paulus@samba.org>
上级 513a54dc
......@@ -2600,7 +2600,7 @@ proc idcol {idlist id {i 0}} {
proc makeuparrow {oid y x} {
global rowidlist uparrowlen idrowranges displayorder
for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
for {set i 0} {$i < $uparrowlen && $y > 1} {incr i} {
incr y -1
set idl [lindex $rowidlist $y]
set x [idcol $idl $oid $x]
......@@ -3005,7 +3005,14 @@ proc insert_pad {row col npad} {
global rowidlist
set pad [ntimes $npad {}]
lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
set idlist [lindex $rowidlist $row]
set bef [lrange $idlist 0 [expr {$col - 1}]]
set aft [lrange $idlist $col end]
set i [lsearch -exact $aft {}]
if {$i > 0} {
set aft [lreplace $aft $i $i]
}
lset rowidlist $row [concat $bef $pad $aft]
}
proc optimize_rows {row col endrow} {
......@@ -3053,6 +3060,10 @@ proc optimize_rows {row col endrow} {
set isarrow 1
}
}
if {!$isarrow && $id ne [lindex $displayorder $row] &&
[lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
set isarrow 1
}
# Looking at lines from this row to the previous row,
# make them go straight up if they end in an arrow on
# the previous row; otherwise make them go straight up
......@@ -3077,8 +3088,8 @@ proc optimize_rows {row col endrow} {
# Line currently goes right too much;
# insert pads in this line
set npad [expr {$z - 1 + $isarrow}]
set pad [ntimes $npad {}]
set idlist [eval linsert \$idlist $col $pad]
insert_pad $row $col $npad
set idlist [lindex $rowidlist $row]
incr col $npad
set z [expr {$x0 - $col}]
set haspad 1
......@@ -3169,31 +3180,9 @@ proc rowranges {id} {
return $linenos
}
# work around tk8.4 refusal to draw arrows on diagonal segments
proc adjarrowhigh {coords} {
global linespc
set x0 [lindex $coords 0]
set x1 [lindex $coords 2]
if {$x0 != $x1} {
set y0 [lindex $coords 1]
set y1 [lindex $coords 3]
if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
# we have a nearby vertical segment, just trim off the diag bit
set coords [lrange $coords 2 end]
} else {
set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
set xi [expr {$x0 - $slope * $linespc / 2}]
set yi [expr {$y0 - $linespc / 2}]
set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
}
}
return $coords
}
proc drawlineseg {id row endrow arrowlow} {
global rowidlist displayorder iddrawn linesegs
global canv colormap linespc curview maxlinelen
global canv colormap linespc curview maxlinelen parentlist
set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
set le [expr {$row + 1}]
......@@ -3268,9 +3257,11 @@ proc drawlineseg {id row endrow arrowlow} {
set itl [lindex $lines [expr {$i-1}] 2]
set al [$canv itemcget $itl -arrow]
set arrowlow [expr {$al eq "last" || $al eq "both"}]
} elseif {$arrowlow &&
[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0} {
set arrowlow 0
} elseif {$arrowlow} {
if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
[lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
set arrowlow 0
}
}
set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
for {set y $le} {[incr y -1] > $row} {} {
......@@ -3289,8 +3280,19 @@ proc drawlineseg {id row endrow arrowlow} {
set xc [lsearch -exact [lindex $rowidlist $row] $ch]
if {$xc < 0} {
puts "oops: drawlineseg: child $ch not on row $row"
} else {
if {$xc < $x - 1} {
} elseif {$xc != $x} {
if {($arrowhigh && $le == $row + 1) || $dir == 0} {
set d [expr {int(0.5 * $linespc)}]
set x1 [xc $row $x]
if {$xc < $x} {
set x2 [expr {$x1 - $d}]
} else {
set x2 [expr {$x1 + $d}]
}
set y2 [yc $row]
set y1 [expr {$y2 + $d}]
lappend coords $x1 $y1 $x2 $y2
} elseif {$xc < $x - 1} {
lappend coords [xc $row [expr {$x-1}]] [yc $row]
} elseif {$xc > $x + 1} {
lappend coords [xc $row [expr {$x+1}]] [yc $row]
......@@ -3301,23 +3303,9 @@ proc drawlineseg {id row endrow arrowlow} {
} else {
set xn [xc $row $xp]
set yn [yc $row]
# work around tk8.4 refusal to draw arrows on diagonal segments
if {$arrowlow && $xn != [lindex $coords end-1]} {
if {[llength $coords] < 4 ||
[lindex $coords end-3] != [lindex $coords end-1] ||
[lindex $coords end] - $yn > 2 * $linespc} {
set xn [xc $row [expr {$xp - 0.5 * $dir}]]
set yo [yc [expr {$row + 0.5}]]
lappend coords $xn $yo $xn $yn
}
} else {
lappend coords $xn $yn
}
lappend coords $xn $yn
}
if {!$joinhigh} {
if {$arrowhigh} {
set coords [adjarrowhigh $coords]
}
assigncolor $id
set t [$canv create line $coords -width [linewidth $id] \
-fill $colormap($id) -tags lines.$id -arrow $arrow]
......@@ -3341,9 +3329,6 @@ proc drawlineseg {id row endrow arrowlow} {
set coords [concat $coords $clow]
if {!$joinhigh} {
lset lines [expr {$i-1}] 1 $le
if {$arrowhigh} {
set coords [adjarrowhigh $coords]
}
} else {
# coalesce two pieces
$canv delete $ith
......@@ -3373,7 +3358,7 @@ proc drawparentlinks {id row} {
set x [xc $row $col]
set y [yc $row]
set y2 [yc $row2]
set d [expr {int(0.4 * $linespc)}]
set d [expr {int(0.5 * $linespc)}]
set ymid [expr {$y + $d}]
set ids [lindex $rowidlist $row2]
# rmx = right-most X coord used
......
Markdown is supported
0% .
You are about to add 0 people to the discussion. Proceed with caution.
先完成此消息的编辑!
想要评论请 注册