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

import [mix linreg clamp fallback] from "@iosevka/util"
import [DesignParameters] from "../meta/aesthetics.mjs"

glyph-module

glyph-block Mark-Horn-And-Angle : begin
	glyph-block-import CommonShapes
	glyph-block-import Common-Derivatives

	glyph-block-import Mark-Shared-Metrics : markExtend markStroke markStress markFine
	glyph-block-import Mark-Shared-Metrics : markHalfStroke markMiddle markDotsRadius
	glyph-block-import Mark-Above : aboveMarkTop aboveMarkBot aboveMarkMid aboveMarkStack
	glyph-block-import Mark-Above : BreveShape commaAboveRadius
	glyph-block-import Mark-Below : belowMarkBot belowMarkTop belowMarkMid

	# horn and angle marks
	define [HornDim attX attY overshootX overshootY yrP] : begin
		local radius commaAboveRadius
		local hornFine   : Math.min (radius * 0.75) (markFine * 1.75)
		local hornStroke : Math.min (radius * 1)    (markFine * 1.75)
		local startX : attX + 2 * radius
		local startY : attY + yrP * radius + (aboveMarkTop - aboveMarkBot) / 2
		return : object radius hornFine hornStroke startX startY

	define [HornMarkAnchor attX attY overshootX overshootY yrP] : glyph-proc
		local [object radius hornFine startX startY] : HornDim attX attY overshootX overshootY yrP
		set-mark-anchor 'topRight' attX attY startX startY
		set-base-anchor 'aboveBraceL' (startX - radius) startY
		set-base-anchor 'aboveBraceR' (startX - radius) startY

	glyph-block-export HornBaseAnchor
	define [HornBaseAnchor attX attY overshootX overshootY yrP] : glyph-proc
		local [object radius hornFine startX startY] : HornDim attX attY overshootX overshootY yrP
		set-base-anchor 'topRight' startX startY
		set-base-anchor 'aboveBraceL' (startX - radius) startY
		set-base-anchor 'aboveBraceR' (startX - radius) startY

	define [HornShape attX attY overshootX overshootY yrP] : glyph-proc
		local [object radius hornFine hornStroke startX startY] : HornDim attX attY overshootX overshootY yrP
		include : union
			RingAt (startX - radius) startY (radius - hornFine / 8)
			dispiro
				g4 (startX + OX) (startY) [widths.rhs : hornFine / 4]
				arcvh
				g4 (startX - radius) (startY - radius)
				archv
				g4 (startX - 2 * radius) (startY)
				arcvh
				g4 (startX - radius) (startY + radius) [widths.rhs : hornFine / 2]
				archv
				g4 startX startY [widths.rhs hornFine]
				quadControls 0 0.75 16 : object : blend : lambda [t]
					widths.rhs [mix hornFine hornStroke t]
				g4 (attX - overshootX - [HSwToV HalfStroke]) (attY - overshootY - Stroke) [widths.rhs hornStroke]

	define [SquareHornShape attX attY overshootX overshootY yrP] : glyph-proc
		local [object [radius r] hornFine hornStroke startX startY] : HornDim attX attY overshootX overshootY yrP
		local radius : r * DesignParameters.squareDotScalar
		include : union
			SquareAt (startX - radius) startY radius
			dispiro
				flat startX (startY + radius) [widths.rhs.heading hornFine Downward]
				curl startX (startY - radius)
				quadControls 0 0.8 8 : object : blend : lambda [t]
					widths.rhs [mix hornFine hornStroke t]
				g4 (attX - overshootX - [HSwToV HalfStroke]) (attY - overshootY - Stroke) [widths.rhs hornStroke]

	create-glyph 'horn.round' : glyph-proc
		set-width 0
		include : HornShape      0 XH 0 0 0.5
		include : HornMarkAnchor 0 XH 0 0 0.5

	create-glyph 'horn.square' : glyph-proc
		set-width 0
		include : SquareHornShape 0 XH 0 0 0.5
		include : HornMarkAnchor  0 XH 0 0 0.5

	select-variant 'horn' 0x31B (follow -- 'diacriticDot')

	create-glyph 'longHorn.round' : glyph-proc
		set-width 0
		include : HornShape      0 XH (Width / 2) (ArchDepthB) 0.5
		include : HornMarkAnchor 0 XH (Width / 2) (ArchDepthB) 0.5

	create-glyph 'longHorn.square' : glyph-proc
		set-width 0
		include : SquareHornShape 0 XH (Width / 2) (ArchDepthB) 0.5
		include : HornMarkAnchor  0 XH (Width / 2) (ArchDepthB) 0.5

	select-variant 'longHorn' null (follow -- 'diacriticDot')

	create-glyph 'leftangleTR' 0x31A : glyph-proc
		set-width 0
		include : VBar.l 0 aboveMarkBot aboveMarkTop (markFine * 2)
		include : HBar.t ((-1.5) * markExtend) 0 aboveMarkTop (markFine * 2)
		set-mark-anchor 'topRight' 0 XH 0 aboveMarkTop
		set-base-anchor 'aboveBraceL' ((-0.75) * markExtend) aboveMarkMid
		set-base-anchor 'aboveBraceR' 0 aboveMarkMid

	create-glyph 'ltailBR' 0x321 : glyph-proc
		set-width 0
		set-mark-anchor 'bottomRight' 0 0 0 belowMarkBot
		set-base-anchor 'belowBraceL' ((-0.5) * HookX - 0.25 * markExtend - [HSwToV : 0.25 * Stroke]) ((-0.5) * Hook - HalfStroke)
		set-base-anchor 'belowBraceR' ((-0.5) * HookX + 0.25 * markExtend - [HSwToV : 0.25 * Stroke]) ((-0.5) * Hook - HalfStroke)
		include : dispiro
			widths.rhs
			flat 0 (-O) [heading Downward]
			curl 0 0 [heading Downward]
			straight.left.end ((-HookX) - [HSwToV HalfStroke]) ((-Hook) - HalfStroke)

	create-glyph 'rtailBR' 0x322 : glyph-proc
		set-width 0
		set-mark-anchor 'bottomRight' 0 0 0 belowMarkBot
		set-base-anchor 'belowBraceL' (0.5 * HookX - 0.25 * markExtend - [HSwToV : 0.75 * Stroke]) ((-0.5) * Hook - HalfStroke)
		set-base-anchor 'belowBraceR' (0.5 * HookX + 0.25 * markExtend - [HSwToV : 0.5  * Stroke]) ((-0.5) * Hook - HalfStroke)
		include : dispiro
			widths.rhs
			flat 0 (-O) [heading Downward]
			curl 0 0 [heading Downward]
			straight.right.end (HookX - [HSwToV HalfStroke]) (-Hook + HalfStroke)

	foreach { suffix { DrawAt kdr } } [Object.entries DotVariants] : do
		create-glyph "dotTL.\(suffix)" : glyph-proc
			set-width 0
			local [object radius attX attY startX startY] : HornDim 0 XH 0 0 0.5
			local r : mix radius DotRadius 0.5
			include : DrawAt ((-startX) + r) startY (r * kdr)
			set-mark-anchor 'topLeft' 0 XH (-startX) startY
			set-base-anchor 'aboveBraceL' (startX - r) startY
			set-base-anchor 'aboveBraceR' (startX - r) startY
		create-glyph "dotTR.\(suffix)" : glyph-proc
			set-width 0
			local [object radius attX attY startX startY] : HornDim 0 XH 0 0 0.5
			local r : mix radius DotRadius 0.5
			include : DrawAt (startX - r) startY (r * kdr)
			set-mark-anchor 'topRight' 0 XH startX startY
			set-base-anchor 'aboveBraceL' (startX - r) startY
			set-base-anchor 'aboveBraceR' (startX - r) startY
		create-glyph "dotBL.\(suffix)" : glyph-proc
			set-width 0
			local [object radius attX attY startX startY] : HornDim 0 XH 0 0 0.5
			local r : mix radius DotRadius 0.5
			include : DrawAt ((-startX) + r) (XH - startY) (r * kdr)
			set-mark-anchor 'bottomLeft' 0 0 (-startX) (XH - startY)
			set-base-anchor 'belowBraceL' (startX - r) startY
			set-base-anchor 'belowBraceR' (startX - r) startY

	select-variant "dotBL" 0x1DFA (follow -- "diacriticDot")
	select-variant "dotTL" 0x1DF8 (follow -- "diacriticDot")
	select-variant "dotTR" 0x358 (follow -- "diacriticDot")

	derive-glyphs 'commaTR' 0x315 'commaAbove' : function [src gr] : glyph-proc
		set-width 0
		include : refer-glyph src
		include : ApparentTranslate (RightSB - Middle + DotRadius) 0
		set-mark-anchor 'topRight' 0 XH 0 aboveMarkTop
		set-base-anchor 'aboveBraceL' ((-SB) + DotRadius) aboveMarkMid
		set-base-anchor 'aboveBraceR' ((-SB) + DotRadius) aboveMarkMid

	create-glyph 'cyrlKavykaTR' 0x1DF6 : glyph-proc
		set-width 0
		include : BreveShape
			xMiddle -- 0
			width   -- 2 * (markExtend * 1.5 - [HSwToV markHalfStroke])
			top     -- aboveMarkTop
			bottom  -- aboveMarkBot
			hs      -- markHalfStroke
		set-mark-anchor 'topRight' 0 XH 0 aboveMarkTop
		set-base-anchor 'aboveBraceL' ((-0.75) * markExtend) aboveMarkMid
		set-base-anchor 'aboveBraceR' ((+0.75) * markExtend) aboveMarkMid

	create-glyph 'cyrlKavykaTL' 0x1DF7 : glyph-proc
		set-width 0
		include : BreveShape
			xMiddle -- 0
			width   -- 2 * (markExtend * 1.5 - [HSwToV markHalfStroke])
			top     -- aboveMarkTop
			bottom  -- aboveMarkBot
			hs      -- markHalfStroke
		set-mark-anchor 'topLeft' 0 XH 0 aboveMarkTop
		set-base-anchor 'aboveBraceL' ((-0.75) * markExtend) aboveMarkMid
		set-base-anchor 'aboveBraceR' ((+0.75) * markExtend) aboveMarkMid

	create-glyph 'rightHalfCircleTR' : glyph-proc
		set-width 0

		include : refer-glyph "leftHalfCircleBelow"
		include : FlipAround markMiddle (XH / 2)
		currentGlyph.clearAnchors

		set-mark-anchor 'topRight' markMiddle XH markMiddle aboveMarkStack
		set-base-anchor 'aboveBraceL' markMiddle aboveMarkMid
		set-base-anchor 'aboveBraceR' markMiddle aboveMarkMid

	define ogonekTrConfig : object
		'ogonekTR'   { (7/16) (1/8) 1 0   }
		'ogonekTR_Y' { (3/16) 1     6 0.5 }

	foreach { glyphName { pExtL pExtR cwMidStrokeWidth paren } } [Object.entries ogonekTrConfig] : do
		local depth : 0 - Descender - markStroke

		create-glyph glyphName : glyph-proc
			set-width 0

			local fine : AdviceStroke 8
			local extL : pExtL * depth + 0.125 * markStress
			local extR : Math.max (pExtR * markExtend) (1.5 * TanSlope * markStroke)

			local turnSlope : 0.5 * ((markStroke - fine) / markStroke - (ArchDepthB - ArchDepth) / ArchDepth)
			local swMid : Math.min markStroke [AdviceStroke cwMidStrokeWidth]

			include : difference
				dispiro
					g4 markMiddle 0 [widths.rhs.heading fine Leftward]
					alsoThru 0.5 (0.375 - 0.2 * markStroke / depth) [widths.rhs : mix fine swMid 0.25]
					g4.down.mid (markMiddle - extL) ((-0.75) * depth) [widths.rhs.heading swMid {.x HVContrast .y turnSlope}]
					arcvh
					g4 (markMiddle + [mix (-extL) extR (11/16)]) ((-depth) + O) [widths.rhs.heading markStroke Rightward]
					g4 (markMiddle + extR) ((-depth) + 0.5 * O) [heading Rightward]
				intersection
					MaskAbove 0
					MaskRight markMiddle

			set-mark-anchor 'trailing' markMiddle 0 (markMiddle + extR) ((-depth) - 0.5 * O - markStroke)
			set-base-anchor 'belowBraceL' (markMiddle - extL - paren * markExtend - [HSwToV : 0.25 * swMid]) ((-0.75) * depth)
			set-base-anchor 'belowBraceR' (markMiddle - 0.75 * extL + paren * markExtend) ((-0.75) * depth)

		create-glyph "\(glyphName)/spacer" : glyph-proc
			set-width 0
			set-mark-anchor 'below' 0 0 0 ((-depth) - 0.5 * O - markStroke)
