define smooth [require './monotonic-interpolate'].createInterpolant
define intersection [require './intersection'].intersection
define Bezier [require 'bezier-js']
define tp [require './transform'].transformPoint
define utp [require './transform'].untransform

define [fallback] : for [local j 0] [j < arguments.length] [inc j] : if [arguments`j !== nothing] : return arguments`j

define [xs-array low high] : begin {
	local a ()
	for [local j [low - 1]] [j <= high] [inc j] : a.push j
	return a
}
define [ys-array a] (a.0 :: [a.concat (a`[a.length - 1])])

define SAMPLES 3
define TINY 0.001
define LITTLE 0.01
define KAPPA 0.51
define COKAPPA : 1 - KAPPA
define BKAPPA : KAPPA + 0.1
define COBKAPPA : COKAPPA - 0.1
define CKAPPA BKAPPA

define [Stroke] : begin {
	this.points = ()
	this.samples = SAMPLES
	this.gizmo = (
		.xx 1
		.yx 0
		.xy 0
		.yy 1
		.x 0
		.y 0
	)
	return this
}
define Stroke.is : object {
	unapply : function [obj] : if [obj <@ Stroke] (obj) null
}
define [Stroke.prototype.set-transform t] : begin {
	this.gizmo = t
	return this
}
define [Stroke.bindParameters para] : begin {
	KAPPA = para.kappa
	COKAPPA = 1 - KAPPA
	COBKAPPA = COKAPPA - 0.1
	BKAPPA = KAPPA + 0.1
	CKAPPA = para.ckappa || BKAPPA
}
define [Stroke.prototype.set-width d1 d2] : begin {
	local point this.points`[this.points.length - 1]
	point.d1 = d1
	point.d2 = d2
	return this
}
define [Stroke.prototype.heads-to x y] : begin {
	if [x.x !== nothing || x.y !== nothing] : begin {
		set y x.y
		set x x.x
	}
	local point this.points`[this.points.length - 1]
	point.pdx = x
	point.pdy = y
	return this
}
define [Stroke.prototype.start-from x y] : begin {
	this.points = ([tp this.gizmo (.x x .y y .onCurve true)])
	return this
}
define [Stroke.prototype.line-to x y] : begin {
	this.points.push [tp this.gizmo (.x x .y y .onCurve true)]
	return this
}
define [Stroke.prototype.curve-to xc yc x y] : begin {
	this.points.push [tp this.gizmo (.x xc .y yc .onCurve false)] [tp this.gizmo (.x x .y y .onCurve true)]
	return this
}
define [Stroke.prototype.cubic-to x1 y1 x2 y2 x y] : begin {
	this.points.push [tp this.gizmo (.x x1 .y y1 .onCurve false .cubic true)] [tp this.gizmo (.x x2 .y y2 .onCurve false .cubic true)] [tp this.gizmo (.x x .y y .onCurve true)]
	return this
}
define [Stroke.prototype.arc-vh-to x y _kappah _kappav] : begin {
	local kappah : fallback _kappah BKAPPA
	local kappav : fallback _kappav _kappah CKAPPA
	local last :utp this.gizmo this.points`[this.points.length - 1]
	this.cubic-to last.x [last.y + kappav * [y - last.y]] [x + kappah * [last.x - x]] y x y
	return this
}
define [Stroke.prototype.arc-hv-to x y _kappah _kappav] : begin {
	local kappah : fallback _kappah BKAPPA
	local kappav : fallback _kappav _kappah CKAPPA
	local last :utp this.gizmo this.points`[this.points.length - 1]
	this.cubic-to [last.x + kappah * [x - last.x]] last.y x [y + kappav * [last.y - y]] x y
	return this
}
define [Stroke.prototype.set-samples samples] : begin {
	this.samples = samples
	return this
}

define [dforward p0 p1 p2 p3] (
	.x [p0.x + [[-11] / 6 * p0.x + 3 * p1.x - 3 / 2 * p2.x + p3.x / 3] / TINY * LITTLE]
	.y [p0.y + [[-11] / 6 * p0.y + 3 * p1.y - 3 / 2 * p2.y + p3.y / 3] / TINY * LITTLE]
)
define [dbackward p0 p1 p2 p3] (
	.x [p0.x + [11 / 6 * p0.x - 3 * p1.x + 3 / 2 * p2.x - p3.x / 3] / TINY * LITTLE]
	.y [p0.y + [11 / 6 * p0.y - 3 * p1.y + 3 / 2 * p2.y - p3.y / 3] / TINY * LITTLE]
)
define [nonlinear a b c] : [Math.abs [[c.y - a.y] * [b.x - a.x] - [c.x - a.x] * [b.y - a.y]]] > TINY
define [midclose a b c] : begin {
	local xm : [a.x + c.x] / 2
	local ym : [a.y + c.y] / 2
	return : [Math.abs [b.x - xm]] < 0.5 && [Math.abs [b.y - ym]] < 0.5
}
define [near a b c] : begin {
	local mx : [a.x + c.x] / 2
	local my : [a.y + c.y] / 2
	local dist : Math.max [Math.abs [a.y - c.y]] [Math.abs [a.x - c.x]]
	return : [Math.abs [b.y - my]] < dist && [Math.abs [b.x - mx]] < dist
}
define [computeOffsetPoint curve t j foffset fpdx fpdy] : begin {
	local onpoint : curve.compute [t - j]
	local normal : curve.normal [t - j]
	return (.x onpoint.x + [foffset t] * [normal.x + [fpdx t]] .y onpoint.y + [foffset t] * [normal.y + [fpdy t]])
}

define [Stroke.prototype.to-outline d1 d2 _samples straight] : begin {
	local d1s ([set d1 [if [this.points.0.d1 >= 0] this.points.0.d1 d1]])
	local d2s ([set d2 [if [this.points.0.d2 >= 0] this.points.0.d2 d2]])
	local pdxs (0)
	local pdys (0)
	
	local samples : fallback _samples this.samples SAMPLES
	local shapes ()
	local subSegments ()
	
	local p0 this.points.0
	for [local j 1] [j < this.points.length] [inc j] : begin {
		local p1 this.points`j
		piecewise {
			p1.onCurve : begin {
				subSegments.push : local seg : new Bezier p0.x p0.y [[p0.x + p1.x] / 2] [[p0.y + p1.y] / 2] p1.x p1.y
				d1s.push : set d1 [if [p1.d1 >= 0] p1.d1 d1]
				d2s.push : set d2 [if [p1.d2 >= 0] p1.d2 d2]
				local normalpt : seg.normal 1
				pdxs.push : if [p1.pdx !== nothing] [p1.pdx - normalpt.x] 0
				pdys.push : if [p1.pdy !== nothing] [p1.pdy - normalpt.y] 0
				p0 = p1
			}
			p1.cubic : begin {
				local p2 this.points`[j + 1]
				local p3 this.points`[j + 2]
				subSegments.push : local seg : new Bezier p0.x p0.y p1.x p1.y p2.x p2.y p3.x p3.y
				d1s.push : set d1 [if [p3.d1 >= 0] p3.d1 d1]
				d2s.push : set d2 [if [p3.d2 >= 0] p3.d2 d2]
				local normalpt : seg.normal 1
				pdxs.push : if [p3.pdx !== nothing] [p3.pdx - normalpt.x] 0
				pdys.push : if [p3.pdy !== nothing] [p3.pdy - normalpt.y] 0
				p0 = p3
				j = j + 2
			}
			true : begin {
				local p2 this.points`[j + 1]
				subSegments.push : local seg : new Bezier p0.x p0.y p1.x p1.y p2.x p2.y
				d1s.push : set d1 [if [p2.d1 >= 0] p2.d1 d1]
				d2s.push : set d2 [if [p2.d2 >= 0] p2.d2 d2]
				local normalpt : seg.normal 1
				pdxs.push : if [p2.pdx !== nothing] [p2.pdx - normalpt.x] 0
				pdys.push : if [p2.pdy !== nothing] [p2.pdy - normalpt.y] 0
				p0 = p2
				j = j + 1
			}
		}
	}
	if [this.points.0.pdx !== nothing] : set pdxs.0 [this.points.0.pdx - [subSegments.0.normal 0].x]
	if [this.points.0.pdy !== nothing] : set pdys.0 [this.points.0.pdy - [subSegments.0.normal 0].y]
	
	local f1 : smooth [xs-array 0 d1s.length] [ys-array d1s]
	local f2 : smooth [xs-array 0 d2s.length] [ys-array [d2s.map [[x] -> [-x]]]]
	local fpdx : smooth [xs-array 0 d1s.length] [ys-array pdxs]
	local fpdy : smooth [xs-array 0 d2s.length] [ys-array pdys]
	
	local left ()
	local right ()
	for [local j 0] [j < subSegments.length] [inc j] : begin {
		local curve subSegments`j
		left.push [begin [local last [computeOffsetPoint curve j j f1 fpdx fpdy]] (.x last.x .y last.y .onCurve true)]
		right.push [begin [local last [computeOffsetPoint curve j j f2 fpdx fpdy]] (.x last.x .y last.y .onCurve true)]

		foreach sample [range 0 samples] : begin {
			local t : j + sample / samples
			local tn : j + [sample + 1] / samples
			
			local lthis : computeOffsetPoint curve t j f1 fpdx fpdy
			local rthis : computeOffsetPoint curve t j f2 fpdx fpdy
			local lnext : computeOffsetPoint curve tn j f1 fpdx fpdy
			local rnext : computeOffsetPoint curve tn j f2 fpdx fpdy
			local lnthis1 : computeOffsetPoint curve [t + TINY] j f1 fpdx fpdy
			local rnthis1 : computeOffsetPoint curve [t + TINY] j f2 fpdx fpdy
			local lnnext1 : computeOffsetPoint curve [tn - TINY] j f1 fpdx fpdy
			local rnnext1 : computeOffsetPoint curve [tn - TINY] j f2 fpdx fpdy
			local lnthis2 : computeOffsetPoint curve [t + 2 * TINY] j f1 fpdx fpdy
			local rnthis2 : computeOffsetPoint curve [t + 2 * TINY] j f2 fpdx fpdy
			local lnnext2 : computeOffsetPoint curve [tn - 2 * TINY] j f1 fpdx fpdy
			local rnnext2 : computeOffsetPoint curve [tn - 2 * TINY] j f2 fpdx fpdy
			local lnthis3 : computeOffsetPoint curve [t + 3 * TINY] j f1 fpdx fpdy
			local rnthis3 : computeOffsetPoint curve [t + 3 * TINY] j f2 fpdx fpdy
			local lnnext3 : computeOffsetPoint curve [tn - 3 * TINY] j f1 fpdx fpdy
			local rnnext3 : computeOffsetPoint curve [tn - 3 * TINY] j f2 fpdx fpdy

			local dlthis [dforward lthis lnthis1 lnthis2 lnthis3]
			local drthis [dforward rthis rnthis1 rnthis2 rnthis3]
			local dlnext [dbackward lnext lnnext1 lnnext2 lnnext3]
			local drnext [dbackward rnext rnnext2 rnnext2 rnnext3]
			
			local il : intersection lthis.x lthis.y dlthis.x dlthis.y lnext.x lnext.y dlnext.x dlnext.y
			if [[not straight] && [nonlinear lthis lnext dlthis] && [nonlinear lthis lnext dlnext] && [il.x != null] && [il.y != null] && [nonlinear lthis il lnext] && [near lthis il lnext]] [then {
				left.push (.x il.x .y il.y .onCurve false) (.x lnext.x .y lnext.y .onCurve true)
			}] [else {
				left.push (.x lnext.x .y lnext.y .onCurve true)
			}]
			
			local ir : intersection rthis.x rthis.y drthis.x drthis.y rnext.x rnext.y drnext.x drnext.y
			if [[not straight] && [nonlinear rthis rnext drthis] && [nonlinear rthis rnext drnext] && [ir.x != null] && [ir.y != null] && [nonlinear rthis ir rnext] && [near rthis ir rnext]] [then {
				right.push (.x ir.x .y ir.y .onCurve false) (.x rnext.x .y rnext.y .onCurve true)
			}] [else {
				right.push (.x rnext.x .y rnext.y .onCurve true)
			}]
		}
		shapes.push : left.concat [right.reverse]
		set left ()
		set right ()
	}

	return : shapes.map : function [shape] : begin {
		# Remove duplicate points
		for [local j] [j < shape.length - 1] [inc j] : begin {
			local p0 shape.(j)
			local p1 shape.[j + 1]
			if [p0.onCurve && p1.onCurve && p0.x === p1.x && p0.y === p1.y] : set p1.removable true
		}
		# Remove colinear oncurve points
		set shape : shape.filter : function [point] [point && [not point.removable]]
		for [local j 0] [j < shape.length - 1] [inc j] : begin {
			local p0 shape`j
			local still true
			for [local k [j + 1]] [still && k < shape.length - 1] [inc k] : begin {
				local p1 shape`k
				local p2 shape`[k + 1]
				if [p0.onCurve && p1.onCurve && p2.onCurve && [not [nonlinear p0 p1 p2]]] [then {
					set p1.removable true
				}] [else {
					set still false
				}]
			}
			set j [k - 1]
		}
		set shape : shape.filter : function [point] [point && [not point.removable]]
		# Remove removable midpoints
		for [local j 1] [j < shape.length - 2] [inc j] : begin {
			local p0 shape`j
			local p1 shape`[j + 1]
			local p2 shape`[j + 2]
			if [[not p0.onCurve] && p1.onCurve && [not p2.onCurve] && [midclose p0 p1 p2]] : begin {
				set p1.removable true
				set j [j + 1]
			}
		}
		set shape : shape.filter : function [point] [point && [not point.removable]]
		return shape
	}
}

exports.Stroke = Stroke