#
# QCad
# (c) Q Solutions 1998
#
#
#
#
#
# Line Normalization
#
#

#
# Version 3, look at first two points only for oblique removal
#
# After changing this and other code to allow moving of either end point
# It is now apparent that the original algorithm of doing a EndOver and
# always moving the end point of a line was far more elegant. I wish I had
# settled on moving the tags with the line swap rather than butchering this 
# code. C'est la vie.
#
# V3, Changed to square endpoint 0 and 1 and then scan line for redundant
#     points.
#
# V4, Added strict option to allow tracks to have 45degree bevels.
#	  Normailisation will probably wipe them off if the track is moved.
#
proc lineNORM {step coords {strict 1} } {

	set coords [join $coords]
	set len [llength $coords]
	if { $len == 4 } {
		set sl  [lineSlope $coords] 
		if { $sl != 0 && $sl != 1 } {
			set coords [lineBreak $step $coords]
			return $coords
		}
		return $coords
	}
	#regsub -all {\.0} $coords {} xcoords
	#Log "NORM I:   $xcoords"

# Square Endpoint 1
### Either geomClip this point or remove from rest of routine
	set hv [lineSlope [lineSegLast $coords]]
	if { $hv != 0 && abs($hv) != 1 } {
		scan [lineSegLast $coords] "%f %f %f %f" Ax Ay Bx By
		set hv [lineSlope [lineGetSeg [expr [lineSegMax $coords] - 1] $coords]]
		#Log "Square 1: $Ax,$Ay - $Bx,$By sl $hv"
		if {  $hv } {
			set Ay $By
		} else {
			set Ax $Bx
		}
	set oc $coords
		set coords [lineRSeg [lineSegMax $coords] $coords $Ax $Ay $Bx $By]
		#Log "Square 1: $Ax,$Ay - $Bx,$By sl $hv  , old $oc :: new c $coords"
	}

# Square Endpoint 0

	set hv [lineSlope [lineGetSeg 0 $coords]]
	if { $hv != 0 && abs($hv) != 1 } {
		scan [lineGetSeg 0 $coords] "%f %f %f %f" Ax Ay Bx By
		set hv [lineSlope [lineGetSeg 1 $coords]]
		#Log "Square 0: $Ax,$Ay - $Bx,$By sl $hv"
		if {  $hv } {
			set By $Ay
		} else {
			set Bx $Ax
		}
		set coords [lineRSeg 0 $coords $Ax $Ay $Bx $By]
	}

# Remove Redundant Points and merge segments

	set Ax [geomClip $step [lindex $coords 0]]
	set Ay [geomClip $step [lindex $coords 1]]
	lappend new $Ax $Ay
	set Bx [geomClip $step [lindex $coords 2]]
	set By [geomClip $step [lindex $coords 3]]
	set hv [lineSlope [lineGetSeg 1 $coords]]
	set stop [llength $coords]
	set xy 4
	while { $xy < $stop } {
		set Cx [geomClip $step [lindex $coords $xy]]
		incr xy
		set Cy [geomClip $step [lindex $coords $xy]]
		incr xy

		set sCB  [lineSlope $Bx $By $Ax $Ay] 
		set sBA  [lineSlope $Cx $Cy $Bx $By]

		if { (($sCB != $sBA)) && ( ($Bx != $Ax) || ($By != $Ay) ) && ( ($Cx != $Bx) || ($Cy != $By) ) } {
			lappend new $Bx $By
		}
		set Ax $Bx
		set Ay $By
		set Bx $Cx
		set By $Cy

		set hv [expr 1 - $hv]
	}
	lappend new $Cx $Cy
	#Log "NORM O:   $new"
	return $new
}

proc lineSlope {args} {

	set list [join $args]
	set x1 [lindex $list 0]
	set y1 [lindex $list 1]
	set x2 [lindex $list 2]
	set y2 [lindex $list 3]

	set dx [expr $x2 - $x1]
	set dy [expr $y2 -$y1]
	if { $y2 < $y1 } {set sign -1 } else { set sign 1}
	if { $dy == 0 } { return 0 }
	if { $dx == 0 } { return 1 }
	if { $dx == $dy } { return [expr 0.5 * $sign] }
#
# oblique line 2 = in x , -2 = in y
#
	if { [expr abs($dx) > abs($dy)] } { return 2}
	return -2
}


#
# Alas poor algorithm, I knew him well.
#
# A cunning solution to a convoluted problem, but unfortunately
# now redundant
# (needs some rework if ever used again to make better use of tcl obj optimisations
#
proc lineEndOver { l } {

	set nl ""
	foreach {x y} $l {
		set nl "$x $y $nl"
	}
	return $nl
}

















