$$include '../meta/macros.ptl'

import '../support/transform' as : Transform && [object [transformPoint tp] [untransform utp] inverse]
import '../support/fairify' as fairify

import [mix linreg clamp fallback] from '../support/utils'
import [designParameters] from '../meta/aesthetics'

export : define [apply] : begin
	glyph-module-entry
	###### COMMON GLYPH CONSTRUCTIONS
	define [select-variant name unicode default featureSelector] : begin
		if (pickHash && [not pickHash.(name)]) : return nothing
		local variant : variantSelector.(name) || default
		local chosenGlyph glyphs.((name + '.' + variant))
		create-glyph name : glyph-construction
			include chosenGlyph AS_BASE ALSO_METRICS
			if unicode : assign-unicode unicode
			if featureSelector : set currentGlyph.featureSelector featureSelector
			set this.cmpPriority chosenGlyph.cmpPriority

	define [italic-variant name unicode] : create-glyph name : glyph-construction
		if para.isItalic
			then : include glyphs.(name + '.italic') AS_BASE
			else : include glyphs.(name + '.upright') AS_BASE
		if unicode : assign-unicode unicode

	define [alias newid unicode oldid] : begin
		create-glyph newid : glyph-construction
			if unicode : assign-unicode unicode
			include glyphs.(oldid) AS_BASE
			set-width glyphs.(oldid).advanceWidth
			set this.featureSelector glyphs.(oldid).featureSelector
			set this.cmpPriority glyphs.(oldid).cmpPriority

	define [composite newid] : let [parts : {}.slice.call arguments 1] : begin
		create-glyph [fallback newid ('glyph' + [newtemp])] : glyph-construction
			local first true
			foreach [part : items-of parts] : begin
				include part first
				if first : set-width part.advanceWidth
				set first false

	define [into-unicode code] : glyph-construction
		if code : assign-unicode code

	# Transformation variants
	define [turned newid unicode id x y mark] : create-glyph [fallback newid : 'turn' + id] : glyph-construction
		if unicode : assign-unicode unicode
		include glyphs.(id) [if mark false AS_BASE]
		set-width glyphs.(id).advanceWidth
		if mark : include mark
		include : FlipAround x y
	# Dual derivatives
	define [dual newid unicode id spacing] : create-glyph [fallback newid : 'double' + id] : glyph-construction
		if unicode : assign-unicode unicode
		include glyphs.(id) AS_BASE
		apply-transform : Translate (-spacing) 0
		include glyphs.(id)
		apply-transform : Translate (spacing / 2) 0

	define [vdual newid unicode id spacing] : create-glyph [fallback newid : 'double' + id] : glyph-construction
		if unicode : assign-unicode unicode
		depends-on glyphs.(id)
		include : create-glyph : glyph-construction
			include glyphs.(id)
			apply-transform : Upright
		apply-transform : Translate 0 (-spacing)
		include : create-glyph : glyph-construction
			include glyphs.(id)
			apply-transform : Upright
		apply-transform : Translate 0 (spacing / 2)
		apply-transform : Italify
	# Full-width derivatives
	define [fwl newid unicode id] : create-glyph [fallback newid : 'fwl' + id] : glyph-construction
		if unicode : assign-unicode unicode
		include glyphs.(id)
		set-width FULLWIDTH

	define [fwr newid unicode id] : create-glyph [fallback newid : 'fwr' + id] : glyph-construction
		if unicode : assign-unicode unicode
		include glyphs.(id)
		set-width FULLWIDTH
		apply-transform : Translate (FULLWIDTH - WIDTH) 0

	define [dwl newid unicode id] : create-glyph [fallback newid : 'dwl' + id] : glyph-construction
		if unicode : assign-unicode unicode
		include glyphs.(id)
		set-width UPM

	define [dwr newid unicode id] : create-glyph [fallback newid : 'dwr' + id] : glyph-construction
		if unicode : assign-unicode unicode
		include glyphs.(id)
		set-width UPM
		apply-transform : Translate (UPM - WIDTH) 0

	define [dwc newid unicode id] : create-glyph [fallback newid : 'dwc' + id] : glyph-construction
		if unicode : assign-unicode unicode
		include glyphs.(id)
		set-width UPM
		apply-transform : Translate ((UPM - WIDTH) / 2) 0



	###### COMMON SHAPES
	define [Ring u d l r transformShiftOnly] : create-glyph : glyph-construction
		local my ((u + d) / 2)
		local mx ((l + r) / 2)
		currentGlyph.gizmo = [if transformShiftOnly [Translate 0 0] globalTransform]
		include : spiro-outline
			begin [lambda : set this.gizmo currentGlyph.gizmo]
			g4 mx d
			archv
			g4 l my
			arcvh
			g4 mx u
			archv
			g4 r my
			arcvh
			close [lambda : begin [set this.angles 4] [set this.fairGizmo currentGlyph.gizmo]]
		if transformShiftOnly : begin
			local {.x mx1 .y my1} [tp globalTransform {.x mx .y my}]
			apply-transform : Translate (mx1 - mx) (my1 - my)
	define [RingAt x y r] : Ring (y + r) (y - r) (x - r) (x + r)
	define [DotAt x y r] : Ring (y + r) (y - r) (x - r) (x + r) true

	define [CircleRing u d l r transformShiftOnly] : create-glyph : glyph-construction
		local my ((u + d) / 2)
		local mx ((l + r) / 2)
		currentGlyph.gizmo = [if transformShiftOnly [Translate 0 0] globalTransform]
		include : spiro-outline
			begin [lambda : set this.gizmo currentGlyph.gizmo]
			g4 mx d
			g4 l my
			g4 mx u
			g4 r my
			close [lambda : begin [set this.angles 4] [set this.fairGizmo currentGlyph.gizmo]]
		if transformShiftOnly : begin
			local {.x mx1 .y my1} [tp globalTransform {.x mx .y my}]
			apply-transform : Translate (mx1 - mx) (my1 - my)
	define [CircleRingAt x y r] : CircleRing (y + r) (y - r) (x - r) (x + r)
	define [CircleDotAt x y r] : CircleRing (y + r) (y - r) (x - r) (x + r) true

	define [OShape u d l r _width _sma _smb ai] : glyph-construction
		local middle : (l + r) / 2
		local width : fallback _width STROKE
		local sma : fallback _sma SMALLSMOOTHA
		local smb : fallback _smb SMALLSMOOTHB
		local mc : CORRECTION_OMIDX * width
		if (u - d > sma + smb) : then : begin
			include : dispiro
				widths width 0
				g4 (middle - mc) (u - O)
				archv
				[if ai flat.ai flat] (l + OX) (u - sma)
				[if ai curl.ai curl] (l + OX) (d + smb)
				arcvh
				g4 (middle + mc) (d + O)
				archv
				[if ai flat.ai flat] (r - OX) (d + sma)
				[if ai curl.ai curl] (r - OX) (u - smb)
				arcvh
				close
		: else : begin
			local ymiddlea : mix d u (smb / (sma + smb))
			local ymiddleb : mix d u (sma / (sma + smb))
			include : dispiro
				widths width 0
				g4 (middle - mc) (u - O)
				archv
				g4 (l + OX) ymiddlea
				arcvh
				g4 (middle + mc) (d + O)
				archv
				g4 (r - OX) ymiddleb
				arcvh
				close
	define [OBarLeftShape _top _left] : glyph-construction
		local top : fallback _top XH
		local left : fallback _left SB
		local fine SHOULDERFINE
		local st : shoulderMidSlope fine nothing 1
		local sb : shoulderMidSlope fine nothing (-1)
		local mt : [mix left RIGHTSB 0.5] + (st - CORRECTION_OMIDX) * STROKE
		local mb : [mix left RIGHTSB 0.5] + (sb + CORRECTION_OMIDX) * STROKE
		include : dispiro
			widths.lhs
			g4   (mt) (top - O) [heading {.y (-1) .x (-st)}]
			archv
			flat (left + (STROKE - fine) * HVCONTRAST) (top - SMALLSMOOTHA) [widths fine 0]
			curl (left + (STROKE - fine) * HVCONTRAST) (0 + SMALLSMOOTHB) [widths fine 0]
			arcvh
			g4   (mb) O [widths.heading STROKE 0 {.y (1) .x (-sb)}]
			archv
			[if ((SMALLSMOOTHA + SMALLSMOOTHB) / top > 0.75) flat.ai flat] (RIGHTSB - OX) (0 + SMALLSMOOTHA)
			[if ((SMALLSMOOTHA + SMALLSMOOTHB) / top > 0.75) curl.ai curl] (RIGHTSB - OX) (top - SMALLSMOOTHB)
			arcvh
			close

	define [OBarRightShape top right] : glyph-construction
		include : create-glyph [OBarLeftShape top (WIDTH - [fallback right RIGHTSB])]
		include : FlipAround MIDDLE ([fallback top XH] / 2)

	define SERIF_SHIFT_X 0.6
	define [LeftwardTopSerif x y length _sw] : glyph-construction
		local sw : fallback _sw STROKE
		include : dispiro
			flat (x + HALFSTROKE * HVCONTRAST) y [widths.heading sw 0 LEFTWARD]
			curl (x - length - TANSLANT * (sw * SERIF_SHIFT_X)) y

	define [LeftwardBottomSerif x y length _sw] : glyph-construction
		local sw : fallback _sw STROKE
		include : dispiro
			flat (x + HALFSTROKE * HVCONTRAST) y [widths.heading 0 sw LEFTWARD]
			curl (x - length + TANSLANT * (sw * SERIF_SHIFT_X)) y

	define [RightwardTopSerif x y length _sw] : glyph-construction
		local sw : fallback _sw STROKE
		include : dispiro
			flat (x - HALFSTROKE * HVCONTRAST) y [widths.heading 0 sw RIGHTWARD]
			curl (x + length - TANSLANT * (sw * SERIF_SHIFT_X)) y

	define [RightwardBottomSerif x y length _sw] : glyph-construction
		local sw : fallback _sw STROKE
		include : dispiro
			flat (x - HALFSTROKE * HVCONTRAST) y [widths.heading sw 0 RIGHTWARD]
			curl (x + length + TANSLANT * (sw * SERIF_SHIFT_X)) y

	define [CenterTopSerif x y length _sw] : glyph-construction
		local sw : fallback _sw STROKE
		include : dispiro
			flat (x + length - TANSLANT * (sw * SERIF_SHIFT_X)) y [widths sw 0]
			curl (x - length - TANSLANT * (sw * SERIF_SHIFT_X)) y

	define [CenterBottomSerif x y length _sw] : glyph-construction
		local sw : fallback _sw STROKE
		include : dispiro
			flat (x + length + TANSLANT * (sw * SERIF_SHIFT_X)) y [widths 0 sw]
			curl (x - length + TANSLANT * (sw * SERIF_SHIFT_X)) y

	define [DownwardRightSerif x y length sw] : glyph-construction
		include : dispiro
			widths.rhs sw
			flat x y [heading DOWNWARD]
			curl x (y - length) [heading DOWNWARD]
	define [UpwardRightSerif x y length sw] : glyph-construction
		include : dispiro
			widths.lhs sw
			flat x y [heading UPWARD]
			curl x (y + length) [heading UPWARD]
	define [DownwardLeftSerif x y length sw] : glyph-construction
		include : dispiro
			widths.lhs sw
			flat x y [heading DOWNWARD]
			curl x (y - length) [heading DOWNWARD]
	define [UpwardLeftSerif x y length sw] : glyph-construction
		include : dispiro
			widths.rhs sw
			flat x y [heading UPWARD]
			curl x (y + length) [heading UPWARD]

	define sideSerifK 0.5
	define [AIVSerifs top _left _right] : glyph-construction
		local left : fallback _left SB
		local right : fallback _right RIGHTSB
		if SLAB : begin
			include : CenterTopSerif (left + STROKE * sideSerifK * HVCONTRAST) top JUT
			tag-contour 'serifLT'
			include : CenterTopSerif (right - STROKE * sideSerifK * HVCONTRAST) top JUT
			tag-contour 'serifRT'
	define [AIHSerifs top _left _right] : glyph-construction
		local left : fallback _left SB
		local right : fallback _right RIGHTSB
		if SLAB : begin
			include : AIVSerifs top _left _right
			include : CenterBottomSerif (left + STROKE * sideSerifK * HVCONTRAST) 0 JUT
			include : CenterBottomSerif (right - STROKE * sideSerifK * HVCONTRAST) 0 JUT
	define [AINSerifs top _left _right sw xn] : glyph-construction
		local left : fallback _left SB
		local right : fallback _right RIGHTSB
		local jut : JUT * [fallback xn 1]
		if SLAB : begin
			include : LeftwardTopSerif (left + sw * (sideSerifK - 0.5) * HVCONTRAST) top (jut - sw / 2 * HVCONTRAST)
			include : CenterTopSerif (right - sw * sideSerifK * HVCONTRAST) top jut
			include : CenterBottomSerif (left + sw * sideSerifK * HVCONTRAST) 0 jut
			tag-contour 'serifLB'
			#include : CenterdBottomSerif (right - STROKE * (sideSerifK - 0.5) * HVCONTRAST) 0 (JUT / 2)
	define [AICyrISerifs top _left _right] : glyph-construction
		local left : fallback _left SB
		local right : fallback _right RIGHTSB
		if SLAB : begin
			include : LeftwardBottomSerif left 0 SIDEJUT
			include : RightwardTopSerif right top SIDEJUT
			include : CenterTopSerif (left + STROKE * sideSerifK * HVCONTRAST) top JUT
			include : CenterBottomSerif (right - STROKE * sideSerifK * HVCONTRAST) 0 JUT
			tag-contour 'serifRB'
	define [AIMSerifs top _left _right] : glyph-construction
		local left : fallback _left SB
		local right : fallback _right RIGHTSB
		if SLAB : begin
			include : LeftwardTopSerif (left + STROKE * (sideSerifK - 0.5) * HVCONTRAST) top SIDEJUT
			include : RightwardTopSerif (right - STROKE * (sideSerifK - 0.5) * HVCONTRAST) top SIDEJUT
			include : CenterBottomSerif (left + STROKE * sideSerifK * HVCONTRAST) 0 JUT
			include : CenterBottomSerif (right - STROKE * sideSerifK * HVCONTRAST) 0 JUT


	define [halfXStrand _leftx lefty rightx righty turn straight tension _fine] : glyph-construction
		local leftx : _leftx + (HALFSTROKE * HVCONTRAST * [if (rightx > _leftx) 1 (-1)])
		local fine  : (_fine || STROKE) * 0.5
		
		local turnyleft : mix lefty righty turn
		local cyleft : mix turnyleft righty tension
		
		local straightxleft : mix leftx rightx straight
		local straightyleft : mix cyleft righty straight
		
		include : dispiro
			widths.center
			flat leftx lefty [heading [if (lefty < righty) UPWARD DOWNWARD]]
			curl leftx turnyleft [heading [if (lefty < righty) UPWARD DOWNWARD]]
			quadcontrols 0 ((cyleft - turnyleft) / (straightyleft - turnyleft)) 24
			flat straightxleft straightyleft
			curl rightx righty
			end [function : set this.cleanmore true]


	define [xStrand _leftx lefty _rightx righty turn straight tension] : glyph-construction
		local middlex : mix _leftx _rightx 0.5
		local middley : mix lefty righty 0.5
		
		include : halfXStrand _leftx lefty middlex middley turn straight tension
		include : halfXStrand _rightx righty middlex middley turn straight tension

	define [nShoulderKnots] : params [left right [fine SHOULDERFINE] [top XH] [bottom 0] [sma SMALLSMOOTHA] [smb SMALLSMOOTHB] [stroke STROKE]] : begin
		local slope : shoulderMidSlope fine stroke
		local middle : [mix (left - stroke * HVCONTRAST) right 0.5] + (slope - CORRECTION_OMIDX) * stroke
		return : list
			flat left (top - sma - 2) [widths fine 0]
			curl left (top - sma)
			arcvh
			g4   middle (top - O) [widths.heading 0 stroke {.y (1) .x (slope)}]
			archv
			flat right (top - smb)
			curl right bottom [heading DOWNWARD]

	define [nShoulder] : begin
		local a arguments
		glyph-construction
			include : dispiro : nShoulderKnots.apply null a


	define [mShoulderSpiro] : params [left right top bottom width fine] : glyph-construction
		local fix : TANSLANT * STROKE * HVCONTRAST * width / STROKE
		local sm : SMALLSMOOTH * 0.75
		include : spiro-outline
			corner (right - width * HVCONTRAST) bottom
			curl   (right - width * HVCONTRAST) (top - sm + fix)
			arcvh 8 'no-tiny'
			g2     [mix left (right - width * HVCONTRAST) 0.5] (top - O - width)
			archv 8 'no-tiny'
			flat   left (top - sm - fix)
			corner left (top - sm - fix - 1)
			corner (left - fine) (top - sm - 1)
			curl   (left - fine) (top - sm)
			arcvh 8 'no-tiny'
			g2     [mix (left - fine * HVCONTRAST) right 0.5] (top - O)
			archv 8 'no-tiny'
			flat   right (top - sm)
			corner right bottom
			close

	define [HBar xleft xright y _fine] : glyph-construction
		include : dispiro
			widths.center [fallback _fine STROKE]
			flat xleft y [heading RIGHTWARD]
			curl xright y [heading RIGHTWARD]

	define [HBarTop xl xr y _fine] : HBar xl xr (y - [fallback _fine STROKE] * 0.5) _fine
	define [HBarBottom xl xr y _fine] : HBar xl xr (y + [fallback _fine STROKE] * 0.5) _fine
	define [HOverlayBar xleft xright y s] : dispiro
		widths.center [fallback s OVERLAYSTROKE]
		flat xleft y
		curl xright y
	define [VBar x ydown yup _fine] : glyph-construction
		local fine : fallback _fine STROKE
		include : dispiro
			widths.center fine
			flat x ydown [heading [if (ydown < yup) UPWARD DOWNWARD]]
			curl x yup [heading [if (ydown < yup) UPWARD DOWNWARD]]

	define [VBarLeft x yd yu _fine] : VBar (x + [fallback _fine STROKE] * 0.5 * HVCONTRAST) yd yu _fine
	define [VBarRight x yd yu _fine] : VBar (x - [fallback _fine STROKE] * 0.5 * HVCONTRAST) yd yu _fine

	define [VerticalHook x y extend depth fine strg] : glyph-construction
		include : dispiro
			widths.center [fallback fine STROKE]
			flat x (y + [fallback strg 0]) [heading [if (depth > 0) DOWNWARD UPWARD]]
			curl x (y - [if (depth > 0) 0.01 (-0.01)]) [heading [if (depth > 0) DOWNWARD UPWARD]]
			arcvh
			flat (x + extend - [if (extend > 0) 0.01 (-0.01)]) (y - depth)
			curl (x + extend) (y - depth)

	define [LegShape] : params [[ztop nothing (xt <> top)] [zbot nothing (xs <> bottom)] xb [fine STROKE]] : glyph-construction
		include : dispiro
			widths.lhs fine
			flat xt top [heading DOWNWARD]
			curl xb (bottom + LONGJUT)
			alsothruthem {{0.5 0.94}}
			g4.left.end xs (bottom + fine) [heading LEFTWARD]

	define [LeftHook x y xextend] : glyph-construction
		local fine : adviceBlackness 4.25
		include : dispiro
			widths.lhs fine
			flat [fallback xextend : x + 1] y
			curl x y
			archv 8
			g4.down.end (x - LeftHook.extension) (y - HOOKX) [heading DOWNWARD]
	set LeftHook.extension [Math.max (WIDTH * 0.15) ([adviceBlackness 4.25] * 1.5)]

	define [HooktopLeftBar stroke bottom] : glyph-construction
		include : dispiro
			widths.lhs [fallback stroke STROKE]
			g4 RIGHTSB (CAP - HOOK)
			hookstart CAPO
			flat SB (CAP - SMALLSMOOTHA)
			curl SB [fallback bottom 0] [heading DOWNWARD]

	define [CurlyTail] : params [fine rinner xleft bottom right x2 y2 [adj 0.4] [adj2 0.4] [adj3 0]] : begin
		local ltr : right > xleft
		set right : right - fine * [if ltr 1 (-1)]
		local mid : mix [mix xleft right 0.5] (right - rinner * [if ltr 1 (-1)]) adj
		local midu : mix [mix xleft right 0.5] (right - rinner * [if ltr 1 (-1)]) adj2
		return : list
			g4.[if ltr 'right' 'left'].mid (mid + CORRECTION_OMIDX * fine * adj3 * [if ltr 1 (-1)]) (bottom + fine + O) [widths [if ltr 0 fine] [if ltr fine 0]]
			archv 2
			g4   right (bottom + fine + rinner - 0.1)
			g4   right (bottom + fine + rinner + 0.1)
			arcvh 2
			g4   mid (bottom + fine + rinner * 2 - O)
			alsothruthem {{0.25 0.06} {0.52 0.25}} important
			g4   x2 y2

	define [HCurlyTail fine wide rinner left m1 _right x1 x2 y2] : glyph-construction
		local right : _right - fine
		local mid : right - rinner + O
		include : dispiro
			widths.rhs wide
			flat left wide [heading RIGHTWARD]
			curl m1 wide [heading RIGHTWARD]
			archv 8
			g4   right (wide + rinner - O / 2) [widths.heading 0 fine {.x (-HVCONTRAST) .y ((wide - fine) / (wide + rinner * 2 - O))}]
			arcvh 8 
			g4.left.mid   mid (wide + rinner * 2 - O) [heading LEFTWARD]
			quadcontrols ((x1 - mid) / (x2 - mid)) 0 8
			g4   x2 y2

	define [FlatSlashShape middlex middle fine kx ky] : glyph-construction
		include : dispiro
			flat (middlex - LONGJUT * [fallback kx 0.8]) (middle - LONGJUT * [fallback ky 0.4]) [widths fine fine]
			curl (middlex + LONGJUT * [fallback kx 0.8]) (middle + LONGJUT * [fallback ky 0.4])

	# Spiro shapes
	define [determineMixR w v u sw] : begin
		local r : piecewise
			(w <= v)   0.5
			true     : 1 / ([Math.pow (1 - [Math.pow (1 - v / w) SUPERNESS]) (1 / SUPERNESS)] + 1)
		local idepth : w - sw
		local iwidth : u * r - sw
		if (iwidth > 0 && idepth > 0 && iwidth / idepth >= 2) : begin
			local adjust : clamp 0.975 1 (1 - (iwidth / idepth - 2) * 0.0125)
			#console.log iwidth idepth (iwidth / idepth) adjust
			r = r * adjust
		if (r < 0.5) : set r 0.5
		return r

	define nHookSegments 12
	define [HookShape toStraight toFinish isStart y tight s kkaf dontadjust] : begin
		local atBottom : toStraight.y > y
		local sw : fallback s STROKE
		local ltr : if isStart (toFinish.x < toStraight.x) (toFinish.x > toStraight.x)
		local dtu : if isStart (y > toFinish.y) (y < toFinish.y)
		
		if [not dontadjust] : begin
			toFinish.x = toFinish.x + OXHOOK * [if ltr (-1) 1] * [if isStart (-1) 1]
			if (atBottom && ltr && !isStart) : begin
				toFinish.x = toFinish.x + TAILADJX * TANSLANT
				toFinish.y = toFinish.y - TAILADJY * TANSLANT

		local w : Math.abs (toStraight.y - y)
		local v : Math.abs (toFinish.y - y)
		local u : Math.abs (toFinish.x - toStraight.x)
		local mixr : determineMixR w v u sw
		local mx ([mix toStraight.x toFinish.x mixr] + ([if (tight && tight.shift) tight.shift (1 - (tight || 0))] * [if atBottom 1 (-1)] * CORRECTION_OMIDX) * sw)
		local keyKnot : g4.[if ltr "right" "left"].mid mx y [fallback kkaf : if tight [let [s : if ltr RIGHTWARD LEFTWARD] [heading {.x (s.x * [fallback tight.skew 1]) .y s.y}]] nothing]
		
		local faf toFinish.af
		set toFinish.af : lambda [] : begin
			local rad : Math.min w (mixr * u)
			local skew0 : [clamp 0 w (w - v)] / rad + ([clamp 1 1.5 (mixr * u / w)] - 1) * 0.5
			local depth : v + skew0 * sw - sw
			local shallowLimit (sw * 0.5)
			local skew : clamp 0 (1 / 2) : skew0 + [clamp 0 shallowLimit (shallowLimit - depth)] / rad
			if faf : faf.apply this arguments
			this.heads-to {
				.x (CONTRAST / [Math.sqrt : 1 + skew * skew] * [if dtu (-1) 1])
				.y (skew / [Math.sqrt : 1 + skew * skew] * [if ltr 1 (-1)])
			}
		
		local segBefore {}
		local segAfter {}
		foreach [j : range 1 nHookSegments] : begin
			local fraction : j / nHookSegments
			local fractionAfter : fraction * (1 - mixr) / mixr
			local myfinal : superxy ((1 - mixr) / mixr)
			segBefore.push : g4 [mix mx toStraight.x fraction] [mix y toStraight.y (1 - [superxy fraction])] unimportant
			segAfter.push : g4 [mix mx toFinish.x fraction] [mix y toFinish.y ((1 - [superxy fractionAfter]) / (1 - myfinal))] unimportant
			if (!tight && w < u * mixr) : set segAfter {}
		if isStart
		: then : return : list
			segAfter.reverse
			* keyKnot
			* segBefore
		: else : return : list
			segBefore.reverse
			* keyKnot
			* segAfter

	define [hookstart] : params [y tight sw kkaf dontadjust] : return {
		.type 'interpolate'
		.af [lambda [before after] [HookShape after before true y tight sw kkaf dontadjust]]
	}
	define [hookend] : params [y tight sw kkaf dontadjust] : return {
		.type 'interpolate'
		.af [lambda [before after] [HookShape before after false y tight sw kkaf dontadjust]]
	}

	define [WaveShape] : params [l r cy extendy tension sw] : glyph-construction
		local cx : mix l r 0.5
		local wavex : (r - l) * tension
		local endwavey : extendy * 0.97
		include : dispiro
			widths.center sw
			g4 l (cy - endwavey)
			bezcontrols.absolute (l + wavex) (cy + extendy) (cx - wavex * 0.8) (cy + extendy) 8 important
			g4 cx cy
			bezcontrols.absolute (cx + wavex * 0.8) (cy - extendy) (r - wavex) (cy - extendy) 8 important
			g4 r (cy + endwavey)

	define [CyrDescender x shift connex] : glyph-construction
		local descenderOverflow : if SLAB SIDEJUT ((RIGHTSB - SB) * [fallback shift 0.1])
		include : VBarRight (x + descenderOverflow + 0.25 * STROKE) (HALFSTROKE - LONGJUT) STROKE
		if (!SLAB && descenderOverflow > STROKE * 0.75 || connex) : include : HBarTop (x - HALFSTROKE * HVCONTRAST) (x + descenderOverflow) STROKE

	# Derived subfonts
	define [refair g] : begin
		foreach [j : range 0 g.contours.length] : begin
			set g.contours.(j) : fairify g.contours.(j) globalTransform
		return nothing
	define [Fork gs ps] : begin
		# BFS construct ShouldBuildList
		local sbh {.}
		local found true
		local PENDING 1
		local CHECKED 2
		foreach [glyphid : items-of gs] : set sbh.(glyphid) PENDING
		while found : begin
			set found false
			foreach [glyphid : items-of : Object.keys sbh] : if (sbh.(glyphid) === PENDING) : begin
				set sbh.(glyphid) CHECKED
				if dependencyProfile.(glyphid) : foreach [k : items-of dependencyProfile.(glyphid)] : if [not sbh.(k)] : begin
					set sbh.(k) PENDING
					set found true
		
		local shouldBuildList : Object.keys sbh :.filter ([x] => [not [not x]])
		#console.log shouldBuildList
		local shouldBuildUnicodes : shouldBuildList.map ([x] => [if (glyphs.(x) && glyphs.(x).unicode) glyphs.(x).unicode.0 nothing])
			:.filter ([x] => [not [not x]])
		
		local p {.}
		foreach [{k v} : pairs-of all ps] : set p.(k) v
		try : begin
			local forkFont : buildFont.call [TempFont] p shouldBuildList shouldBuildUnicodes
		: ex
		: begin
			if ex.glyfMap : return ex.glyfMap
			: else : throw ex
		return forkFont.glyfMap

	define [Miniature] : params [glyphs crowd scale [slantAngle para.slantAngle] unfair [sbscale 0.5]] : begin
		local forkedPara : Object.create para
		forkedPara.stroke = [adviceBlackness crowd] / scale
		forkedPara.ess = para.ess * forkedPara.stroke / para.stroke
		forkedPara.dotsize = para.dotsize * forkedPara.stroke / para.stroke
		forkedPara.periodsize = para.periodsize * forkedPara.stroke / para.stroke
		forkedPara.sb = SB * sbscale
		forkedPara.slantAngle = slantAngle
		forkedPara.unfair = unfair
		return : Fork glyphs forkedPara

	define [Thinner glyphs p] : begin
		local forkedPara : Object.create para
		forkedPara.width = WIDTH * p
		forkedPara.accentx = ACCENTX * p
		forkedPara.jut = JUT * p
		forkedPara.longjut = LONGJUT * p
		#forkedPara.hookx = HOOKX * p
		return : Fork glyphs forkedPara

	define [Widen glyphs p psb] : begin
		local forkedPara : Object.create para
		forkedPara.width = WIDTH * p
		forkedPara.sb = SB * [fallback psb p]
		forkedPara.accentx = ACCENTX * p
		forkedPara.jut = JUT * p
		forkedPara.longjut = LONGJUT * p
		forkedPara.hookx = HOOKX * p
		forkedPara.smoothadjust = para.smoothadjust * p
		return : Fork glyphs forkedPara

	# Composite transformations
	define [FlipAround x y sx sy] : glyph-construction
		apply-transform : Upright
		apply-transform : Translate (-x) (-y)
		apply-transform : Scale [fallback sx (-1)] [fallback sy sx (-1)]
		apply-transform : Translate x y
		apply-transform : Italify
	
	return [object select-variant italic-variant alias composite into-unicode turned dual vdual fwl fwr dwl dwr dwc Ring RingAt DotAt CircleRing CircleRingAt CircleDotAt OShape OBarLeftShape OBarRightShape LeftwardTopSerif LeftwardBottomSerif RightwardTopSerif RightwardBottomSerif CenterTopSerif CenterBottomSerif DownwardRightSerif UpwardRightSerif DownwardLeftSerif UpwardLeftSerif AIVSerifs AIHSerifs AINSerifs AICyrISerifs AIMSerifs halfXStrand xStrand nShoulderKnots nShoulder mShoulderSpiro HBar HBarTop HBarBottom HOverlayBar VBar VBarLeft VBarRight VerticalHook LegShape LeftHook HooktopLeftBar CurlyTail HCurlyTail FlatSlashShape determineMixR HookShape hookstart hookend WaveShape CyrDescender refair Fork Miniature Thinner Widen FlipAround]