### Autoarg macro
define-operator "--" 890 'right' : syntax-rules
	`(@l -- @r) [atom l] : dirty `[new $NamedParameterPair$ @{".quote" [formOf l]} @r]
	`(@{".quote" l} -- @r) : dirty `[new $NamedParameterPair$ @l @r]

### Arbitrary pair operator
define-operator "~>" 880 'right' : syntax-rules
	`(@l ~> @r) `{.left @l .right @r}

### Macro for identity match
define-macro Just : begin
	local m : syntax-rules
		`[Just @x] : dirty x

	set coinit.initFn : lambda [m] : begin
		set m.toPattern : lambda [form env w] : match form
			`[Just @x] : object
				whether : lambda [t] : ex `(@t === @x) env
				assign  : lambda [t locallyQ] : ex `[begin] env

	return m

define-macro postulate : syntax-rules
	`[postulate @::$pairs] : begin
		local ta : env.newt
		local tb : env.newt
		local t : env.newt

		local ps `[begin
			[local @ta : {}.slice.call arguments 0]
			[local @tb {}]
			[for [local @t 0] (@t < @ta.length) [inc @t] : if [not : @ta.(@t) <@ $NamedParameterPair$] : @tb.push @ta.(@t)]
		]

		local declarations `[begin]
		local namedAssigns `[begin]
		local indexAssigns `[begin]
		local tearDowns    `[begin]

		local j 0
		foreach $pf [items-of $pairs] : begin
			local name
			local pf : formOf $pf

			match [formOf $pf]
				pf [atom pf] : begin
					declarations.push `[local @pf]
					indexAssigns.push `[set @pf : fallback @pf (@tb).(@{".quote" j})]
					set name pf
				`[@pf] : begin
					declarations.push `[local @pf]
					indexAssigns.push `[set @pf : fallback @pf (@tb).(@{".quote" j})]
					set name pf
				`[@decl @dflt] : begin
					declarations.push `[local @decl]
					indexAssigns.push `[set @decl : fallback @decl (@tb).(@{".quote" j}) @dflt]
					set name decl
				`(@decl -- @dflt) : begin
					declarations.push `[local @decl]
					indexAssigns.push `[set @decl : fallback @decl (@tb).(@{".quote" j}) @dflt]
					set name decl
				{".operatorPiece" decl '--' dflt} : begin
					declarations.push `[local @decl]
					indexAssigns.push `[set @decl : fallback @decl (@tb).(@{".quote" j}) @dflt]
					set name decl
				true : throw : new Error "Invalid postulation syntax"

			namedAssigns.push `[if (@t && @t <@ $NamedParameterPair$ && @t.left == @{".quote" name})
				[set @name @t.right]]
			inc j

		ps.push declarations
		ps.push `[foreach [@t : items-of @ta] @namedAssigns]
		ps.push indexAssigns
		ps.push tearDowns

		return : dirty ps

define-macro with-params : syntax-rules
	`[with-params @_pairs @body] : dirty `[begin [postulate @::[formOf _pairs]] @[formOf body]]

### Necessary macros
# A glyph construction is a function which "modifies" a glyph.
define-macro glyph-proc : syntax-rules
	`[glyph-proc @::steps] : dirty `[lambda [] [begin \\
		local currentGlyph this
		begin @::[steps.map formOf]
		return nothing
	]]

define-macro composite-proc : syntax-rules
	`[composite-proc @::steps] : dirty `[lambda [] [begin \\
		local currentGlyph this
		begin @::[steps.map : lambda [x j] : if j `[include @[formOf x]] `[include @[formOf x] true true]]
		return nothing
	]]

# Remap Glyph's methods to macros in order to simplify writing
define-macro set-width : syntax-rules
	`[set-width @::args] {'.syntactic-closure' `[currentGlyph.setWidth @::args] env}
define-macro include : syntax-rules
	`[include @::args] {'.syntactic-closure' `[currentGlyph.include @::args] env}
define-macro set-mark-anchor : syntax-rules
	`[set-mark-anchor @::args] {'.syntactic-closure' `[currentGlyph.setMarkAnchor @::args] env}
define-macro set-base-anchor : syntax-rules
	`[set-base-anchor @::args] {'.syntactic-closure' `[currentGlyph.setBaseAnchor @::args] env}
define-macro eject-contour : syntax-rules
	`[eject-contour @::args] {'.syntactic-closure' `[currentGlyph.ejectTagged @::args] env}

###### Canvas-based mechanism
define-macro new-glyph : syntax-rules
	`[new-glyph @body] : begin
		dirty `[$createAndSaveGlyphImpl$ null null @[formOf body]]

define-macro create-glyph : syntax-rules
	`[create-glyph @body] : begin
		if [not externEnv.$nWFGlyphs$] : set externEnv.$nWFGlyphs$ 0
		inc externEnv.$nWFGlyphs$
		local f0 : '.' + [[env.macros.get 'input-path']].1 + '.'
		local tcn {".quote" (".WF" + f0 + externEnv.$nWFGlyphs$)}
		dirty `[$createAndSaveGlyphImpl$ @tcn null @[formOf body]]
	`[create-glyph @name @body] : begin
		dirty `[$createAndSaveGlyphImpl$ @[formOf name] null @[formOf body]]
	`[create-glyph @name @code @body] : begin
		dirty `[$createAndSaveGlyphImpl$ @[formOf name] @[formOf code] @[formOf body]]

define-macro create-aliased-glyph : syntax-rules
	`[create-aliased-glyph @name] : begin
		dirty `[create-aliased-glyph @[formOf name] null]
	`[create-aliased-glyph @name @code] : begin
		dirty `[$createAndSaveGlyphImpl$ @[formOf name] @[formOf code] [lambda : begin
			[this.include currentGlyph true true]
			[this.cloneRankFromGlyph currentGlyph] ]]

define-macro create-forked-glyph : syntax-rules
	`[create-forked-glyph @body] : begin
		if [not externEnv.$nWFGlyphs$] : set externEnv.$nWFGlyphs$ 0
		inc externEnv.$nWFGlyphs$
		local f0 : '.' + [[env.macros.get 'input-path']].1 + '.'
		local tcn {".quote" (".WF" + f0 + externEnv.$nWFGlyphs$)}
		dirty `[create-forked-glyph @tcn null @[formOf body]]
	`[create-forked-glyph @name @body] : begin
		dirty `[create-forked-glyph @[formOf name] null @[formOf body]]
	`[create-forked-glyph @name @code @body] : begin
		dirty `[$createAndSaveGlyphImpl$ @[formOf name] @[formOf code] [lambda : begin
			[this.include currentGlyph true true]
			[this.cloneRankFromGlyph currentGlyph]
			[this.include @[formOf body]] ]]

###### Glyph modules and Glyph blocks

define-macro glyph-module : syntax-rules
	`[glyph-module] : dirty `[begin \\
		define $GlyphBlocks$ {}
		export : define [apply] : begin
			foreach [block : items-of $GlyphBlocks$] : block this
		]

define-macro run-glyph-module : syntax-rules
	`[run-glyph-module @{'.quote' path}] : dirty `[@{'.import' [formOf path]}.apply.call $$Capture$$]

define-macro glyph-block-import : syntax-rules
	`[glyph-block-import @_blockName] : begin

		define allExports : object
			Common-Derivatives `[select-variant orthographic-italic orthographic-slanted
			refer-glyph query-glyph alias turned HDual HCombine VDual VCombine derive-glyphs
			derive-composites link-reduced-variant alias-reduced-variant HalfAdvance TurnMarks
			derive-multi-part-glyphs DeriveMeshT add-glyph-dependency]

			CommonShapes `[no-shape KnotAdj Rect SquareAt Ring RingAt DotAt RingStroke RingStrokeAt
			DotStrokeAt CircleRing CircleRingAt CircleDotAt RoundStrokeTerminalAt OShapeT OShape
			OShapeOutline OShapeFlatTB HSerif VSerif NeedSlab NeedNotItalic HBar HOverlayBar VBar
			FlatSlashShape hookstart hookend Ungizmo Regizmo FlipAround ScaleAround Realign
			ForceUpright DiagCor NameUni PointingTo with-transform clear-geometry clear-anchors
			AsRadical ExtLineCenter ExtLineLhs ExtLineRhs DiagCorDs HCrossBar VERY-FAR MaskAbove
			MaskBelow MaskLeft MaskRight HalfRectTriangle MaskAboveLine MaskBelowLine MaskLeftLine
			MaskRightLine DotVariants WithDotVariants]

		define vartiableFilter : if externEnv.$glyphBlockVariableUsage$
			lambda [x] externEnv.$glyphBlockVariableUsage$.(x)
			lambda [x] true

		local blockName : formOf _blockName
		if allExports.(blockName)
			dirty `[define [object @::[allExports.(blockName).filter vartiableFilter]] : $Capture$.(@({".quote" blockName})).resolve]
			dirty `[$Capture$.(@({".quote" blockName})).resolve]

	`[glyph-block-import @_blockName @_variables] : begin
		local blockName {'.quote' [formOf _blockName]}
		local variables : formOf _variables
		dirty `[define [object @::variables] : $Capture$.(@blockName).resolve]

define-macro glyph-block-export : syntax-rules
	`[glyph-block-export @::obj] : begin
		dirty `[$ExportCapture$ : lambda [] : object @::[obj.map formOf]]

define-macro for-width-kinds : syntax-rules
	`[for-width-kinds @_desired @::_body] : dirty `[ do \\
		define WidthKinds {
			{ 0 '.NWID' $Capture$.Metrics.Width      1 }
			{ 1 '.WWID' $Capture$.Metrics.WideWidth0 2 }
		}
		foreach {FMosaicWide MosaicNameSuffix MosaicWidth MosaicWidthScalar} [items-of WidthKinds] : do
			define MosaicDesiredWidth @[formOf _desired]
			define MosaicMiddle : MosaicWidth / 2
			define MosaicUnitWidth : MosaicWidth / MosaicWidthScalar
			define [MangleUnicode unicode _desiredOverride]
				if (MosaicWidth == (_desiredOverride || MosaicDesiredWidth)) unicode nothing
			define [MangleName name] : name + MosaicNameSuffix
			begin @::[_body.map formOf]
	]

define-macro end-glyph-block : syntax-rules
	`[end-glyph-block] : begin
		set externEnv.$glyphBlockVariableUsage$ null
		dirty `[begin nothing]

### Do not nest
define-macro glyph-block : syntax-rules
	`[glyph-block @_blockName @_body] : begin
		local blockName {'.quote' [formOf _blockName]}
		local body : formOf _body

		# Trace every variable name in the body
		local variableSet : Object.create null
		define [traceBody form] : piecewise
			(form <@ Array) : form.forEach traceBody
			([typeof form] === "string") : set variableSet.(form) true

		traceBody body
		traceBody `[$NamedParameterPair$ $createAndSaveGlyphImpl$ $assignUnicodeImpl$ $execState$]

		set externEnv.$glyphBlockVariableUsage$ variableSet

		define captureImports `[$createAndSaveGlyphImpl$ $NamedParameterPair$ $assignUnicodeImpl$
			$execState$ Metrics para recursive glyphStore glyph-is-needed SpiroFns BooleFns
			MarkSet AS_BASE ALSO_METRICS buildGlyphs tagged DivFrame fontMetrics]

		define metricImports `[DesignParameters UPM HalfUPM Width SB CAP XH Ascender Descender
			Contrast SymbolMid ParenTop ParenBot OperTop OperBot TackTop TackBot PlusTop PlusBot
			PictTop PictBot BgOpTop BgOpBot Italify Upright Scale Translate ApparentTranslate Rotate
			GlobalTransform TanSlope HVContrast Upward Downward Rightward Leftward
			O OX OXHook Hook AHook SHook RHook JHook FHook HookX TailX TailY
			ArchDepth SmallArchDepth Stroke DotSize PeriodSize HBarPos OverlayPos LongJut Jut VJut
			VJutStroke AccentStackOffset AccentWidth AccentClearance AccentHeight CThin CThinB SLAB
			TailAdjX TailAdjY IBalance IBalance2 JBalance JBalance2 TBalance TBalance2 RBalance
			RBalance2 FBalance OneBalance WideWidth0 WideWidth1 WideWidth2 WideWidth3 WideWidth4
			EssUpper EssLower EssQuestion HalfStroke RightSB Middle DotRadius PeriodRadius SideJut
			ArchDepthA ArchDepthB SmallArchDepthA SmallArchDepthB CorrectionOMidX CorrectionOMidS
			ArchXAdjust AdviceStroke AdviceStroke2 OverlayStroke OperatorStroke GeometryStroke
			ShoulderFine _SuperXY AdviceGlottalStopArchDepth shoulderMidSkew
			StrokeWidthBlend ArchDepthAOf ArchDepthBOf SmoothAdjust MidJutSide MidJutCenter
			compositeBaseAnchors YSmoothMidR YSmoothMidL HSwToV NarrowUnicodeT WideUnicodeT]
		define spiroFnImports `[g4 g2 corner flat curl close end straight widths
			disable-contrast heading unimportant important alsoThru alsoThruThem bezControls
			quadControls archv arcvh dispiro spiro-outline CursiveBuilder]
		define booleFnImports `[union intersection difference]

		dirty `[$GlyphBlocks$.push : lambda [$Capture_Ext$] : begin \\
			$Capture_Ext$.$defineGlyphBlockImpl$ $Capture_Ext$ @blockName
				function [$Capture$ $ExportCapture$] : begin
					define [object @::[captureImports.filter : lambda [x] variableSet.(x)]] $Capture$
					define [object @::[metricImports.filter  : lambda [x] variableSet.(x)]] $Capture$.Metrics
					define [object @::[spiroFnImports.filter : lambda [x] variableSet.(x)]] $Capture$.SpiroFns
					define [object @::[booleFnImports.filter : lambda [x] variableSet.(x)]] $Capture$.BooleFns

					* @body

			end-glyph-block
		]