### Autoarg macro define-operator "--" 890 'right' : syntax-rules `(@l -- @r) [atom l] : dirty `[new $NamedParameterPair$ @{".quote" [formOf l]} @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 params : syntax-rules `[params @_pairs @body] : 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 aps `[begin] local dps `[begin] local j 0 foreach [pf : items-of : formOf _pairs] : begin local name if [atom pf] : then ps.push `[local @pf : fallback @pf (@tb).(@{".quote" j})] set name pf : else ps.push `[local @(pf.0) : fallback @(pf.0) (@tb).(@{".quote" j}) @(pf.1)] set name pf.0 aps.push `[if (@t && @t <@ $NamedParameterPair$ && @t.left == @{".quote" name}) [set @name @t.right]] if pf.2 : dps.push `[local @(pf.2) @name] inc j ps.push `[foreach [@t : items-of @ta] @aps] ps.push dps ps.push : formOf body return : dirty ps ### Necessary macros # A glyph construction is a function which "modifies" a glyph. define-macro glyph-proc : syntax-rules `[glyph-proc @::steps] {'.syntactic-closure' `[lambda [] [begin \\ local currentGlyph this begin @::[steps.map formOf] return nothing ]] env} 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.ejectContour @::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-derived : syntax-rules `[create-derived @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-derived @tcn null @[formOf body]] `[create-derived @name @body] : begin dirty `[create-derived @[formOf name] null @[formOf body]] `[create-derived @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 @path] : dirty `[[import @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 refer-glyph query-glyph alias turned HDual HCombine VDual VCombine with-related-glyphs glyph-is-needed] CommonShapes `[Rect SquareAt Ring RingAt DotAt RingStroke RingStrokeAt DotStrokeAt CircleRing CircleRingAt CircleDotAt OShape OShapeOutline OBarLeftShape OBarRightShape LeftwardTopSerif LeftwardBottomSerif RightwardTopSerif RightwardBottomSerif CenterTopSerif CenterBottomSerif DownwardRightSerif UpwardRightSerif DownwardLeftSerif UpwardLeftSerif AIVSerifs AIHSerifs AINSerifs AICyrISerifs AIMSerifs HBar HBarTop HBarBottom HOverlayBar VBar VBarLeft VBarRight VerticalHook LegShape LeftHook HooktopLeftBar FlatSlashShape hookstart hookend CyrDescender CyrLeftDescender FlipAround ScaleAround Realign ForceUpright DiagCor CreateWaveShape NameUni PointingTo WithAIHSerifsMask WithTransform clear-anchors OBarLeftToothlessShape OBarLeftRoundedShape OBarRightToothlessShape OBarRightRoundedShape AsRadical ExtLineCenter DiagCorDs HCrossBar VERY-FAR MaskAbove MaskBelow MaskLeft MaskRight] 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$ $donothing$ $createAndSaveGlyphImpl$ $assignUnicodeImpl$] set externEnv.$glyphBlockVariableUsage$ variableSet define captureImports `[metrics $NamedParameterPair$ $donothing$ para recursive recursiveCodes glyphStore $createAndSaveGlyphImpl$ spirofns booleFns MarkSet AS_BASE ALSO_METRICS pickHash buildGlyphs tagged DivFrame fontMetrics $assignUnicodeImpl$] define metricImports `[UPM HalfUPM Width SB CAP XH Descender Contrast SymbolMid ParenTop ParenBot OperTop OperBot TackTop TackBot PlusTop PlusBot PictTop PictBot BgOpTop BgOpBot Italify Upright Scale Translate Rotate GlobalTransform TanSlope HVContrast Upward Downward Rightward Leftward UpwardT DownwardT LeftwardT RightwardT O OX OXHook Hook AHook SHook RHook JHook FHook HookX Smooth SmallSmooth Stroke DotSize PeriodSize HBarPos OverlayPos LongJut Jut VJut Accent AccentX CThin CThinB SLAB TailAdjX TailAdjY LBalance IBalance LBalance2 IBalance2 JBalance JBalance2 TBalance TBalance2 RBalance RBalance2 FBalance OneBalance WideWidth0 WideWidth1 WideWidth2 Ess EssQuestion HalfStroke RightSB Middle CapMiddle DotRadius PeriodRadius SideJut SmoothA SmoothB SmallSmoothA SmallSmoothB CorrectionOMidX CorrectionOMidS AdviceStroke AdviceStroke2 MVertStroke OverlayStroke OperatorStroke GeometryStroke ShoulderFine _SuperXY adviceSSmooth adviceGlottalStopSmooth shoulderMidSlope StrokeWidthBlend SmoothAOf SmoothBOf SmoothAdjust MidJutSide MidJutCenter compositeBaseAnchors YSmoothMidR YSmoothMidL] define spiroFnImports `[g4 g2 corner flat curl close end straight widths disable-contrast heading unimportant important alsoThru alsoThruThem bezcontrols quadcontrols archv arcvh complexThru dispiro spiro-outline] 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 ]