"requires: vector."

prototypes addSlot: #PointND valued: Vector derive.

"N-dimensional points are vectors which don't accept further tupling."

p@(PointND traits) , _
[
  p
].

p@(PointND traits) origin
"Return the absolute idea of a 0-filled point for my size."
[| newP |
  newP: p clone.
  newP contents doWithIndex: [| :index |
    newP contents at: index put: 0].
  newP
].

t@(Tuple traits) as: p@(PointND traits)
[| newP |
  newP: (p newSize: p size).
  0 below: p size do: [| :each | newP at: each put: (t at: each)].
  newP
].

p@(PointND traits) x
[p at: 0].

p@(PointND traits) y
[p at: 1].

p@(PointND traits) z
[p at: 2].

p@(PointND traits) deriveForSize: n
[| newT origin |
  newT: PointND derive.
  q@(newT traits) size [n].
  q@(newT traits) newSize: m
    [m = n ifTrue: [resend] ifFalse: [PointND newSize: m]].
  origin: newT origin.
  q@(newT traits) origin
    [origin].
  newT
].

prototypes addSlot: #Point2D valued: (PointND deriveForSize: 2).

p@(Point2D traits) x: x y: y
[| newP |
  newP: Point2D clone.
  newP at: 0 put: x.
  newP at: 1 put: y.
  newP
].

p@(Point2D traits) cross: q@(Point2D traits)
[
  p x * q y - (p y * q x)
].

p@(Point2D traits) distanceTo: q@(Point2D traits)
"The naive Euclidean method."
[
  ((p x - q x) squared + (p y - q y) squared) sqrt
].

p@(Point2D traits) isBetween: a and: b
"This should be called once the point is determined to be within the bounding
box for the other two points. This measures by perpendicular distance from
the line instead of slope and intercept, avoiding divide-by-zero errors and
being robust in case of round-off."
[| dx dy |
  dx: b x - a x.
  dy: b y - a y.
  (dx isZero and: [dy isZero])
    or: [((p y * dx - p x * dy) - (a y * b x - a x * b y)) squared
	   <= (epsilon squared * (dx squared + dy squared))]
].

prototypes addSlot: #Point3D valued: (PointND deriveForSize: 3).

p@(Point2D traits) x: x y: y z: z
[| newP |
  newP: Point2D clone.
  newP at: 0 put: x.
  newP at: 1 put: y.
  newP at: 2 put: z.
  newP
].

lobby addImmutableDelegate: #Graphics valued: Namespace clone.

Graphics addSlot: #Region valued: Cloneable derive.

r@(Region traits) isEmpty
[False].

r@(Region traits) xor: s@(Region traits)
[
  (r - s) \/ (s - r)
].

Graphics addSlot: #BoundRegion valued: Region derive.
BoundRegion addSlot: #boundingRect.

Graphics addImmutableSlot: #Everywhere valued: Region clone.

e@Everywhere contains: r@(Region traits)
[True].

r@(Region traits) contains: e@Everywhere
[e = r].

_@Everywhere = _@Everywhere
[True].

_@Everywhere = _@(Region traits)
[False].

_@Everywhere /\ r@(Region traits)
[r].

e@Everywhere \/ _@(Region traits)
[e].

Graphics addImmutableSlot: #Nowhere valued: Region clone.

r@(Region traits) intersects: s@(Region traits)
[
  (r /\ s = Nowhere) not
].

n@Nowhere isEmpty
[True].

n@Nowhere contains: r@(Region traits)
[n = r].

r@(Region traits) contains: n@Nowhere
[True].

_@Nowhere = _@Nowhere
[True].

_@Nowhere = _@(Region traits)
[False].

_@Nowhere \/ r@(Region traits)
[r].

n@Nowhere /\ _@(Region traits)
[n].

r@(Region traits) = s@(Region traits)
[
  (r xor: s) = Nowhere.
].

Graphics addSlot: #RegionSet valued: BoundRegion derive.
RegionSet addSlot: #regions.

rs@(RegionSet traits) newSize: n
[| newRS |
  newRS: rs clone.
  newRS regions: (Set newSize: n).
  newRS
].

rs@(RegionSet traits) do: block
"Recursively apply the block to all regions and sub-regions of those."
[
  rs regions do: [| :each | each do: block]
].

r@(Region traits) do: block
"Termination handler for RegionSet do:."
[block value: r].

Graphics addSlot: #RegionUnion valued: RegionSet derive.

r@(Region traits) \/ s@(Region traits)
[| newRU |
  newRU: (RegionUnion newSize: 2).
  newRU regions add: r.
  newRU regions add: s.
  newRU
].

ru@(RegionUnion traits) \/ r@(Region traits)
[| newRU |
  newRU: ru clone.
  newRU regions: (ru regions clone).
  newRU regions add: r.
  newRU
].

ru1@(RegionUnion traits) \/ ru2(RegionUnion traits)
[| newRU |
  newRU: ru1 clone.
  newRU regions: (ru1 regions clone).
  newRU regions addAll: ru2 regions.
  newRU
].

ru@(RegionUnion traits) contains: r@(Region traits)
[
  ru regions do: [| :each |
    (each contains: r) ifTrue: [^ True]].
  False
].

ru@(RegionUnion traits) dimensions
[
  ru regions inject: 0 into: [| :dims :each | dims max: each dimensions]
].

Graphics addSlot: #RegionIntersection valued: RegionSet derive.

r@(Region traits) /\ s@(Region traits)
[| newRI |
  newRI: (RegionIntersection newSize: 2).
  newRI regions add: r.
  newRI regions add: s.
  newRI
].

ri@(RegionUnion traits) /\ r@(Region traits)
[| newRI |
  newRI: ri clone.
  newRI regions: (ri regions clone).
  newRI regions add: r.
  newRI
].

ri1@(RegionIntersection traits) /\ ri2(RegionIntersection traits)
[| newRI |
  newRI: ri1 clone.
  newRI regions: (ri1 regions clone).
  newRI regions addAll: ri2 regions.
  newRI
].

ri@(RegionIntersection traits) contains: r@(Region traits)
[
  ri regions do: [| :each |
    (each contains: r) ifFalse: [^ False]].
  True
].

ru@(RegionUnion traits) dimensions
[
  ru regions inject: 0 into: [| :dims :each | dims max: each dimensions]
].

Graphics addSlot: #RegionComplement valued: Region derive.
RegionComplement addSlot: #region valued: Everywhere.

rc@(RegionComplement traits) newFor: r@(Region derive)
[| newRC |
  newRC: rc clone.
  newRC region: r.
  newRC
].

r@(Region traits) complement
[
  RegionComplement newFor: r
].

r@(RegionComplement traits) complement
"Double negation."
[
  r region
].

rc@(RegionComplement traits) contains: r@(Region derive)
[
  (rc region contains: r) not
].

rc1@(RegionComplement traits) /\ rc2@(RegionComplement traits)
"De Morgan's laws."
[
  (rc1 region \/ rc2 region) complement
].

rc1@(RegionComplement traits) \/ rc2@(RegionComplement traits)
"De Morgan's laws."
[
  (rc1 region /\ rc2 region) complement
].

r@(Region traits) - q@(Region traits)
[
  r /\ q complement
].

Graphics addSlot: #Rectangle valued: BoundRegion derive.
Rectangle addSlot: #origin.
Rectangle addSlot: #corner.

_@(Rectangle traits) dimensions
[2].

r@(Rectangle traits) boundingRect
[r].

r@(Rectangle traits) boundingRect: s@(Rectangle traits)
[s].

Graphics addSlot: #Point valued: BoundRegion derive.
Point addDelegate: #type valued: Point2D traits.

_@(Point traits) dimensions
[0].

p@(Point traits) contains: r@(Region traits)
[p = r].

"Point is the graphics-specific traits for 2D points."

r@(Rectangle traits) origin: p@(Point traits) corner: q@(Point traits)
[| newR |
  newR: Rectangle clone.
  newR origin: p.
  newR corner: q.
  newR
].

r@(Rectangle traits) origin: p@(Point traits) extent: q@(Point traits)
[| newR |
  newR: Rectangle clone.
  newR origin: p.
  newR corner: q + p.
  newR
].

r@(Rectangle traits) newEncompassing: c
"Return a new Rectangle containing all the points of c."
[| newO newC |
  c do: [| :point |
    newO ifNil: [newO: (newC: point)]
         ifNotNil: [newO: (newO min: point).
           newC: (newC max: point)]].
  Rectangle origin: newO corner: newC
].

r@(Rectangle traits) left: v
[
  Rectangle origin: (Point x: v y: r origin y) corner: r corner
].

r@(Rectangle traits) right: v
[
  Rectangle origin: r origin corner: (Point x: v y: r corner y)
].

r@(Rectangle traits) top: v
[
  Rectangle origin: (Point x: r origin x y: v) corner: r corner
].

r@(Rectangle traits) bottom: v
[
  Rectangle origin: r origin corner: (Point x: r corner x y: v)
].

r@(Rectangle traits) height
[
  r corner y - r origin y
].

r@(Rectangle traits) width
[
  r corner x - r origin x
].

r@(Rectangle traits) extent
[
  Point x: r width y: r height
].

r@(Rectangle traits) area
[
  (r height max: 0) * (r width max: 0)
].

r@(Rectangle traits) bottom
[
  r corner y
].

r@(Rectangle traits) top
[
  r origin y
].

r@(Rectangle traits) left
[
  r origin x
].

r@(Rectangle traits) right
[
  r corner x
].

r@(Rectangle traits) = q@(Rectangle traits)
[
  r origin = q origin and: [r corner = q corner]
].

r@(Rectangle traits) hash
[
  origin hash bitXor: corner hash
].

r@(Rectangle traits) topLeft
[
  Point x: r left y: r top
].

r@(Rectangle traits) topCenter
[
  Point x: r right + r left // 2 y: r top
].

r@(Rectangle traits) topRight
[
  Point x: r right y: r top
].

r@(Rectangle traits) bottomLeft
[
  Point x: r left y: r bottom
].

r@(Rectangle traits) bottomCenter
[
  Point x: r right + r left // 2 y: r bottom
].

r@(Rectangle traits) bottomRight
[
  Point x: r right y: r bottom
].

r@(Rectangle traits) leftCenter
[
  Point x: r left y: r bottom + r top // 2
].

r@(Rectangle traits) rightCenter
[
  Point x: r right y: r bottom + r top // 2
].

r@(Rectangle traits) center
[
  Point x: r top + r bottom // 2 y: r left + r right // 2
].

r@(Rectangle traits) corners
[
  {r topLeft. r bottomLeft. r bottomRight. r topRight}
    as: ExtensibleSequence
].

r@(Rectangle traits) innerCorners
[
  (Rectangle
    origin: r topLeft
    corner: r bottomRight - 1) corners
].

r@(Rectangle traits) boundingBox
[r].

r@(Rectangle traits) areasOutside: q@(Rectangle traits)
"Return a collection of rectangles not intersecting q."
[| areas oy cy |
  ((r origin <= q corner) and: [q origin <= r corner])
    ifFalse: [^ {r} as: ExtensibleSequence].
  areas: (ExtensibleSequence newSize: 3).
  q origin y > r origin y
    ifTrue: [areas addLast:
      (Rectangle origin: r origin
                 corner: (Point x: r origin x y: (oy: q origin y)))]
    ifFalse: [oy: r origin y].
  q corner y < r corner y
    ifTrue: [areas addLast:
      (Rectangle origin: (Point x: r origin x y: (cy: q corner y))
                 corner: q corner)]
    ifFalse: [cy: r corner y].
  q origin x > r origin x
    ifTrue: [areas addLast:
      (Rectangle origin: (Point x: r origin x y: yo)
                 corner: (Point x: q origin x y: yc))].
  q corner x < r corner x
    ifTrue: [areas addLast:
      (Rectangle origin: (Point x: q corner x y: yo)
                 corner: (Point x: r corner x y: yc))].
  areas
].

r@(Rectangle traits) - q@(Rectangle traits)
[
  RegionUnion clone regions: (r areasOutside: q)
].

r@(Rectangle traits) /\ q@(Rectangle traits)
[| p1 p2 left right top bottom |
  p: q origin.
  left: (p x max: r origin x).
  top: (p y max: r origin y).
  p: q corner.
  right: (p x min: r corner x).
  bottom: (p y min: r corner y).
  (left > right or: [top > bottom]) ifTrue: [^ Nowhere]
  Rectangle origin: (Point x: left y: top)
            corner: (Point x: right y: bottom)
].

r@(Rectangle traits) encompass: p@(Point traits)
[
  Rectangle origin: (r origin min: p) corner: (r corner max: p)
].

r@(Rectangle traits) merge: q@(Rectangle traits)
"Returns the smallest bounding rectangle which encompasses the two arguments."
[
  Rectangle origin: (r origin min: q origin)
            corner: (r corner max: q corner)
].

r@(Rectangle traits) mergeWithAll: col
"An optimized (non-allocating) method for merging many rectangles at once.
Use this over merge: whenever possible."
[| minX maxX minY maxY |
  minX: r origin x. minY: r origin y.
  maxX: r corner x. maxY: r corner y.
  col do: [| :each |
	     minX: (each origin x min: minX).
	     minY: (each origin y min: minY).
	     maxX: (each corner x max: maxX).
	     maxY: (each corner y max: maxY)].
  Rectangle origin: (Point x: minX y: minY)
	    corner: (Point x: maxX y: maxY)
].

r@(Rectangle traits) contains: p@(Point traits)
[
  r origin <= p and: [p <= r corner]
].

r@(Rectangle traits) contains: q@(Rectangle traits)
[
  q origin >= r origin and: [q corner <= r corner]
].

r@(Rectangle traits) intersects: q@(Rectangle traits)
[
  (r origin max: q origin) < (r corner min: q corner)
].

Graphics addSlot: #Trace valued: Region derive.
"A single-dimensioned Region."

_@(Trace traits) dimensions
[1].

p@(Trace traits) isClosed
"A closed trace starts and ends at the same place."
[
  p start = p end
].

Graphics addSlot: #Path valued: Trace derive.
"Paths are Sequences of Points."
Path addSlot: #points valued: ExtensibleSequence newEmpty.

s@(Sequence traits) as: p@(Path traits)
[| newP |
  newP: p clone.
  newP points: (s select: [| :each | each traits == Point traits]).
  newP
].

p@(Path traits) newFrom: start to: end
[| newP |
  newP: p clone.
  newP points: ({start. end} as: p points).
  newP
].

p@(Path traits) start
[
  p points first
].

p@(Path traits) end
[
  p points last
].

Graphics addSlot: #LineSegment valued: Trace derive.
"A straight path between two Points."
LineSegment addSlot: #start.
LineSegment addSlot: #end.

line1@(LineSegment traits) = line2@(LineSegment traits)
[| s1 s2 e1 e2 |
  s1: line1 start.
  s2: line2 start.
  e1: line1 end.
  e2: line2 end.
  ((s1 = s2) and: [e1 = e2]) or:
    [(s1 = e2) and: [e1 = s2]]
].

line@(LineSegment traits) newFrom: start to: end
[| newL |
  newL: line clone.
  newL start: start.
  newL end: end.
  newL
].

p@(Path traits) segments
"Answer the LineSegments that compose the Path."
[| newOC ps |
  ps: p points size.
  newOC: (ExtensibleSequence newSize: ps - 1).
  1 below: ps do: [| :each |
    newOC add: (LineSegment newFrom: (p at: each - 1) to: (p at: each))].
  newOC
].

line@(LineSegment traits) contains: p@(Point traits)
[| ls le |
  ls: line start.
  le: line end.
  (line boundingRect contains: p)
    and: [(p y - ls x) * (le x - ls x) =
      ((p x - ls x) * (le y - ls y))].
].

line@(LineSegment traits) calcBoundingRect
[| ls le |
  ls: line start.
  le: line end.
  Rectangle origin: (Point x: (ls x min: le x) y: (ls y min: le y))
            corner: (Point x: (ls x max: le x) y: (ls y max: le y))
].

line@(LineSegment traits) clipTo: r@(Rectangle traits)
"Returns a new LineSegment or Nil if the line is gone."
[| x0 x1 y0 y1 interp |
  "TODO: import from Dylan's DUIM extended-geometry/lines.dylan"
].

Graphics addSlot: #Polygon valued: Path derive.

_@(Polygon traits) dimensions
[2].

path@(Path traits) as: poly@(Polygon traits)
"Coerce the path to be closed while converting."
[| tempPath newPoly |
  newP: poly clone.
  newP points: (poly points newSize: path points size + 1).
  newP points addAll: poly points.
  path isClosed
    ifFalse: [newP add: path first].
  newP
].

path@(Path traits) close
"Return a new Polygon if needed, otherwise do nothing."
[
  path isClosed
       ifTrue: [path]
       ifFalse: [path as: Polygon]
].

poly@(Polygon traits) contains: p@(Point traits)
"This algorithm counts the number of edge segments that intersect the ray
from (X,Y) to (+infinity,Y).  If there are an odd number of crossings,
(X,Y) is considered to be inside the Polygon."
[| crossings lastPoint testBlock |
  crossings: 0.
  lastPoint: poly first.
  testBlock: [| :a :b |
		(((p x <= a y) eqv: (p y > b y)) "The segment crosses the ray."
		  and: [a y ~= b y]
		  and: [(p x - a x) -
			  ((p y - a y) * (b x - a x)) / (b y - a y) < 0])
		"The point is to the left."
		   ifTrue: [crossings: crossings + 1]].
  1 below: poly size
    do: [| :index thisPoint |
	 thisPoint: (poly at: index)
	 block value: thisPoint value: lastPoint.
	 lastPoint: thisPoint].
  crossings isOdd
].