251 lines
11 KiB
Text
251 lines
11 KiB
Text
### 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 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 declarations `[begin]
|
|
local namedAssigns `[begin]
|
|
local indexAssigns `[begin]
|
|
local tearDowns `[begin]
|
|
|
|
local j 0
|
|
foreach [pf : items-of : formOf _pairs] : begin
|
|
local name
|
|
if [atom pf] : then
|
|
declarations.push `[local @pf]
|
|
indexAssigns.push `[set @pf : fallback @pf (@tb).(@{".quote" j})]
|
|
set name pf
|
|
: else
|
|
declarations.push `[local @(pf.0)]
|
|
indexAssigns.push `[set @(pf.0) : fallback @(pf.0) (@tb).(@{".quote" j}) @(pf.1)]
|
|
set name pf.0
|
|
if pf.2 : tearDowns.push `[local @(pf.2) @name]
|
|
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
|
|
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] : 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
|
|
LeftHook FlatSlashShape hookstart hookend Ungizmo Regizmo FlipAround ScaleAround Realign
|
|
ForceUpright DiagCor NameUni PointingTo WithTransform 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
|
|
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
|
|
]
|