###### COMMON SHAPES

define [Ring u d l r transformShiftOnly] : begin {
	local my [[u + d] / 2]
	local mx [[l + r] / 2]
	local s : new Stroke
	if [not transformShiftOnly] : s.set-transform globalTransform
	s.start-from mx d
		:.cubic-to [mx + [l - mx] * CKAPPA] d l [my + [d - my] * CKAPPA] l my
		:.cubic-to l [my + [u - my] * CKAPPA] [mx + [l - mx] * CKAPPA] u mx u
		:.cubic-to [mx + [r - mx] * CKAPPA] u r [my + [u - my] * CKAPPA] r my
		:.cubic-to r [my + [d - my] * CKAPPA] [mx + [r - mx] * CKAPPA] d mx d
	if transformShiftOnly : begin {
		local (.x mx1 .y my1) [tp globalTransform (.x mx .y my)]
		foreach p [items-of s.points] : begin {
			set p.x : p.x + mx1 - mx
			set p.y : p.y + my1 - my
		}
	}
	return s.points
}
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 [ORing u d l r sma smb shift] : begin {
	local mx [[l + r] / 2]
	local s : new Stroke
		:.set-transform globalTransform
		:.start-from [mx + shift] d
		:.arc-hv-to  l [d + smb]
		:.line-to    l [u - sma]
		:.arc-vh-to  [mx - shift] u
		:.arc-hv-to  r [u - smb]
		:.line-to    r [d + sma]
		:.arc-vh-to  [mx + shift] d
	return s.points
}
define [leftwardTopSerif x y length] : begin {
	return : new Stroke
		:.set-transform globalTransform
		:.start-from [x + HALFSTROKE] y
		:.heads-to LEFTWARD
		:.set-width STROKE 0
		:.line-to [x - length - globalTransform.yx * STROKE] y
		:.to-outline
}
define [leftwardBottomSerif x y length] : begin {
	return : new Stroke
		:.set-transform globalTransform
		:.start-from [x + HALFSTROKE] y
		:.heads-to LEFTWARD
		:.set-width 0 STROKE
		:.line-to [x - length + globalTransform.yx * STROKE] y
		:.to-outline
}
define [rightwardTopSerif x y length] : begin {
	return : new Stroke
		:.set-transform globalTransform
		:.start-from [x - HALFSTROKE] y
		:.heads-to RIGHTWARD
		:.set-width 0 STROKE
		:.line-to [x + length - globalTransform.yx * STROKE] y
		:.to-outline
}
define [rightwardBottomSerif x y length] : begin {
	return : new Stroke
		:.set-transform globalTransform
		:.start-from [x - HALFSTROKE] y
		:.heads-to RIGHTWARD
		:.set-width STROKE 0
		:.line-to [x + length + globalTransform.yx * STROKE] y
		:.to-outline
}
define [centerTopSerif x y length] : begin {
	return : new Stroke
		:.set-transform globalTransform
		:.start-from [x + length - globalTransform.yx * STROKE] y
		:.set-width STROKE 0
		:.line-to [x - length - globalTransform.yx * STROKE] y
		:.to-outline
}
define [centerBottomSerif x y length] : begin {
	return : new Stroke
		:.set-transform globalTransform
		:.start-from [x + length + globalTransform.yx * STROKE] y
		:.set-width 0 STROKE
		:.line-to [x - length + globalTransform.yx * STROKE] y
		:.to-outline
}

define [xsStrand _xleft yleft _xright yright _halfstroke0 _halfstroke1 _ess _expansion _roundp] : begin {
	local expansion : _expansion || 0.25
	local halfstroke0 : _halfstroke0 || HALFSTROKE
	local halfstroke1 : _halfstroke1 || HALFSTROKE
	local ess         : _ess || [halfstroke0 + halfstroke1] / 2
	local upright : Upright
	# calculate italic correction
	local outline : [new Stroke
		:.set-transform globalTransform
		:.start-from _xleft yleft
		:.set-width  [2 * halfstroke0] 0
		:.line-to    _xleft [yleft - 1000]
		:.set-samples 1
		:.to-outline].0.map : [p] -> [tp upright p]
	local xItalicCorrection : -[outline.3.x - outline.0.x] / [2 * halfstroke0]
	local yItalicCorrection : [outline.3.y - outline.0.y] / [2 * halfstroke0]

	local roundsize : [_roundp || SMOOTHA * 0.4] * [if [yleft < yright] [-1] 1]
	local roundleft   [yleft - roundsize]
	local roundright  [yright + roundsize]
	local xleft     : _xleft + halfstroke0 * xItalicCorrection
	local xright    : _xright - halfstroke1 * xItalicCorrection
	local sxleft    : mix xleft xright [0.5 - expansion]
	local sxright   : mix xleft xright [0.5 + expansion]
	local syleft    : mix roundleft roundright [0.5 - expansion]
	local syright   : mix roundleft roundright [0.5 + expansion]
	
	return : new Stroke
		:.set-transform globalTransform
		:.start-from xleft [yleft - halfstroke0 * yItalicCorrection]
		:.set-width  halfstroke0 halfstroke0
		:.curve-to   xleft roundleft sxleft syleft
		:.set-width  ess ess
		:.line-to    sxright syright
		:.curve-to   xright roundright xright [yright + halfstroke1 * yItalicCorrection]
		:.set-width  halfstroke1 halfstroke1
		:.to-outline
}
define [sStrand yleft yright _expansion] : begin {
	return : xsStrand SB yleft RIGHTSB yright HALFSTROKE HALFSTROKE HALFSTROKE _expansion [SMOOTHA * 0.4]
}

define [halfXStrand _leftx lefty rightx righty turn straight tension _fine] : begin {
	local leftx : _leftx + [HALFSTROKE * ITALICCOR * [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
	
	return : new Stroke
		:.set-transform globalTransform
		:.start-from leftx lefty
		:.set-width  HALFSTROKE HALFSTROKE
		:.heads-to   [if [lefty < righty] UPWARD DOWNWARD]
		:.line-to    leftx turnyleft
		:.heads-to   [if [lefty < righty] UPWARD DOWNWARD]
		:.curve-to   leftx cyleft straightxleft straightyleft
		:.set-width  fine fine
		:.line-to    rightx righty
		:.to-outline
}

define [xStrand _leftx lefty _rightx righty turn straight tension] : begin {
	local middlex : mix _leftx _rightx 0.5
	local middley : mix lefty righty 0.5
	
	return : halfXStrand _leftx lefty middlex middley turn straight tension
	       :.concat : halfXStrand _rightx righty middlex middley turn straight tension
}

define [nShoulder left middle right fine _top _bottom _sma _smb _wide] : begin {
	local top : fallback _top XH
	local bottom : fallback _bottom 0
	local sma : fallback _sma SMALLSMOOTHA
	local smb : fallback _smb SMALLSMOOTHB
	local stroke : fallback _wide STROKE
	local band : new Stroke
		:.set-transform globalTransform
		:.start-from right bottom
		:.heads-to   UPWARD
		:.set-width  stroke 0
		:.line-to    right [top - smb]
		:.arc-vh-to  middle [top - O]
		:.heads-to   LEFTWARD
		:.to-outline
	local shoulder : new Stroke
		:.set-transform globalTransform
		:.start-from middle [top - O - stroke]
		:.arc-hv-to  left [top - sma]
		:.line-to    [left - fine] [top - sma]
		:.arc-vh-to  middle [top - O]

	return : band.concat (shoulder.points)
}

define [XSHookUpper top left middle right smooth hook] : glyph-construction {
	include : create-stroke
		:.set-transform globalTransform
		:.start-from [right - OXHOOK] [top - hook]
		:.set-width STROKE 0
		:.curve-to [mix middle right KAPPA_HOOK] [top - O] [middle - OMIDCOR_S] [top - O]
		:.arc-hv-to left [top - smooth]
}
define [sHookUpper top smooth hook _middle] : glyph-construction {
	include : XSHookUpper top SB [fallback _middle MIDDLE] RIGHTSB smooth hook
}
define [twoHookUpper top smooth hook _middle] : glyph-construction {
	local middle : _middle || MIDDLE
	include : create-stroke
		:.set-transform globalTransform
		:.start-from [SB + OXHOOK] [top - hook]
		:.set-width 0 STROKE
		:.curve-to [mix middle SB KAPPA_HOOK] [top - O] [middle - OMIDCOR_S] [top - O]
		:.arc-hv-to RIGHTSB [top - smooth]
}
define [sHookLower bottom smooth hook _middle] : glyph-construction {
	include : XSHookLower bottom SB [fallback _middle MIDDLE] RIGHTSB smooth hook
}
define [XSHookLower bottom left middle right smooth hook] : glyph-construction {
	include : create-stroke
		:.set-transform globalTransform
		:.start-from right [bottom + smooth]
		:.set-width [if [left < right] 0 STROKE] [if [left < right] STROKE 0]
		:.arc-vh-to [middle + OMIDCOR_S] [bottom + O]
		:.curve-to [mix middle left KAPPA_HOOK] [bottom + O] [left + OXHOOK] [bottom + hook]
}

define [smallo u d l r _width _sma _smb] : glyph-construction {
	local middle : [l + r] / 2
	local width : fallback _width STROKE
	local sma : fallback _sma SMALLSMOOTHA
	local smb : fallback _smb SMALLSMOOTHB
	local mc : OMIDCOR * width
	if [u - d > sma + smb] {
		then : begin {
			include : create-stroke
				:.set-transform globalTransform
				:.start-from [middle - mc] [u - O]
				:.set-width width 0
				:.arc-hv-to [l + O] [u - sma]
				:.line-to  [l + O] [d + smb]
				:.arc-vh-to [middle + mc] [d + O]
				:.arc-hv-to [r - O] [d + sma]
				:.line-to  [r - O] [u - smb]
				:.arc-vh-to [middle - mc] [u - O]
		}
		else : begin {
			local ymiddlea : mix d u [smb / [sma + smb]]
			local ymiddleb : mix d u [sma / [sma + smb]]
			include : create-stroke
				:.set-transform globalTransform
				:.start-from [middle - mc] [u - O]
				:.set-width width 0
				:.arc-hv-to [l + O] ymiddlea
				:.arc-vh-to [middle + mc] [d + O]
				:.arc-hv-to [r - O] ymiddleb
				:.arc-vh-to [middle - mc] [u - O]
		}
	}
}

define [HBar xleft xright y _fine] : glyph-construction {
	local fine : [fallback _fine STROKE] / 2
	include : create-stroke
		:.set-transform globalTransform
		:.start-from xleft y
		:.heads-to RIGHTWARD
		:.set-width fine fine
		:.line-to xright y
		:.heads-to 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] : HBar xleft xright y [adviceBlackness 4]
define [VBar x ydown yup _fine] : glyph-construction {
	local fine : [fallback _fine STROKE] / 2
	include : create-stroke
		:.set-transform globalTransform
		:.start-from x ydown
		:.heads-to [if [ydown < yup] UPWARD DOWNWARD]
		:.set-width fine fine
		:.line-to x yup
		:.heads-to [if [ydown < yup] UPWARD DOWNWARD]
}
define [VBarLeft x yd yu _fine] : VBar [x + [fallback _fine STROKE] * 0.5 * ITALICCOR] yd yu _fine
define [VBarRight x yd yu _fine] : VBar [x - [fallback _fine STROKE] * 0.5 * ITALICCOR] yd yu _fine

# Common 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
}

define [VerticalHook x y extend depth] : glyph-construction {
	include : create-stroke
		:.start-from x y
		:.heads-to   [if [depth > 0] DOWNWARD UPWARD]
		:.set-width  HALFSTROKE HALFSTROKE
		:.arc-vh-to  [x + extend] [y - depth]
}

define [LegShape xt xb xs top bottom _fine] : glyph-construction {
	local fine : fallback _fine STROKE
	include : create-stroke
		:.start-from xt top
		:.heads-to   DOWNWARD
		:.set-width  fine 0
		:.line-to    xb [bottom + LONGJUT]
		:.curve-to   [linreg top xt [bottom + LONGJUT] xb [bottom + fine]] [bottom + fine] xs [bottom + fine]
		:.heads-to   LEFTWARD
}

# Derived subfonts
define [Miniature glyphs fold scale] : begin {
	local forkedPara : Object.create para
	forkedPara.upmscale = 1
	forkedPara.stroke = [adviceBlackness fold] / scale
	forkedPara.sb = SB / 2
	local shouldBuildList ()
	foreach glyphid [items-of glyphs] : set shouldBuildList : shouldBuildList.concat (glyphid :: dependencyProfile.(glyphid))
	local forkFont : buildFont forkedPara shouldBuildList
	return forkFont.glyfMap
}
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]
	if mark : include mark
	include : FlipAround x y
}
define [dual newid unicode id spacing] : create-glyph [fallback newid : 'double' + id] : glyph-construction {
	if unicode : assign-unicode unicode
	include glyphs.(id)
	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
	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
}