Trying [params] and named parameters :)
This commit is contained in:
be5invis
parent
458a4804d5
commit
0004fada77
|
|
@ -27,6 +27,39 @@ define-macro $$include : syntax-rules
|
|||
return {'.syntactic-closure' ast env}
|
||||
otherwise `nothing
|
||||
|
||||
### Autoarg macro
|
||||
define [$NamedParameterPair$ l r] : begin
|
||||
set this.left l
|
||||
set this.right r
|
||||
return this
|
||||
|
||||
define-macro "--" : syntax-rules
|
||||
`(@l -- @r) [atom l] `[new $NamedParameterPair$ @{".quote" [formOf l]} @r]
|
||||
|
||||
define-macro params : syntax-rules
|
||||
`[params @_pairs @body] : begin
|
||||
local ta : env.newt
|
||||
local t : env.newt
|
||||
local ps `[begin [local @ta : {}.slice.call arguments 0]]
|
||||
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 (@ta).(@{".quote" j})]
|
||||
set name pf
|
||||
: else
|
||||
ps.push `[local @(pf.0) : fallback @(pf.0) @(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
|
||||
|
||||
# A symbol block defines a group of similar glyphs. They may expose some functions used in glyphs in other blocks.
|
||||
define-macro symbol-block : syntax-rules
|
||||
`[symbol-block @name @::steps] : let [t : env.newt] : dirty `[begin [let : set @t : begin @::[steps.map formOf]] [progress @name] @t]
|
||||
|
|
|
|||
|
|
@ -88,7 +88,6 @@ define [dwc newid unicode id] : create-glyph [fallback newid : 'dwc' + id] : gly
|
|||
|
||||
|
||||
###### COMMON SHAPES
|
||||
|
||||
define [Ring u d l r transformShiftOnly] : create-glyph : glyph-construction
|
||||
local my ((u + d) / 2)
|
||||
local mx ((l + r) / 2)
|
||||
|
|
@ -321,7 +320,7 @@ define [nShoulder left right fine _top _bottom _sma _smb _wide] : let [a argumen
|
|||
include : dispiro : nShoulderKnots.apply null a
|
||||
|
||||
|
||||
define [mShoulderSpiro left right top bottom width fine] : glyph-construction
|
||||
define [mShoulderSpiro] : params [left right top bottom width fine] : glyph-construction
|
||||
local fix : TANSLANT * STROKE * HVCONTRAST * width / STROKE
|
||||
local sm : SMALLSMOOTH * 0.75
|
||||
include : spiro-outline
|
||||
|
|
@ -372,8 +371,7 @@ define [VerticalHook x y extend depth fine strg] : glyph-construction
|
|||
flat (x + extend - [if (extend > 0) 0.01 (-0.01)]) (y - depth)
|
||||
curl (x + extend) (y - depth)
|
||||
|
||||
define [LegShape xt xb xs top bottom _fine] : glyph-construction
|
||||
local fine : fallback _fine STROKE
|
||||
define [LegShape] : params [xt xb xs top bottom [fine STROKE]] : glyph-construction
|
||||
include : dispiro
|
||||
widths.lhs fine
|
||||
flat xt top [heading DOWNWARD]
|
||||
|
|
@ -399,12 +397,13 @@ define [HooktopLeftBar stroke bottom] : glyph-construction
|
|||
flat SB (CAP - SMALLSMOOTHA)
|
||||
curl SB [fallback bottom 0] [heading DOWNWARD]
|
||||
|
||||
define [CurlyTail fine rinner m1 bottom _right x2 y2 adj adj2 adj3] : begin
|
||||
local right : _right - fine * [if (_right > m1) 1 (-1)]
|
||||
local mid : mix [mix m1 right 0.5] (right - rinner * [if (_right > m1) 1 (-1)]) [fallback adj 0.4]
|
||||
local midu : mix [mix m1 right 0.5] (right - rinner * [if (_right > m1) 1 (-1)]) [fallback adj2 0.4]
|
||||
define [CurlyTail] : params [fine rinner xleft bottom right x2 y2 [adj 0.4] [adj2 0.4] [adj3 0]] : begin
|
||||
local ltr : right > xleft
|
||||
set right : right - fine * [if ltr 1 (-1)]
|
||||
local mid : mix [mix xleft right 0.5] (right - rinner * [if ltr 1 (-1)]) adj
|
||||
local midu : mix [mix xleft right 0.5] (right - rinner * [if ltr 1 (-1)]) adj2
|
||||
return : list
|
||||
g4.[if (_right > m1) 'right' 'left'].mid (mid + CORRECTION_OMIDX * fine * [fallback adj3 0] * [if (_right > m1) 1 (-1)]) (bottom + fine + O) [widths [if (_right > m1) 0 fine] [if (_right > m1) fine 0]]
|
||||
g4.[if ltr 'right' 'left'].mid (mid + CORRECTION_OMIDX * fine * adj3 * [if ltr 1 (-1)]) (bottom + fine + O) [widths [if ltr 0 fine] [if ltr fine 0]]
|
||||
archv 2
|
||||
g4 right (bottom + fine + rinner - 0.1)
|
||||
g4 right (bottom + fine + rinner + 0.1)
|
||||
|
|
@ -495,10 +494,16 @@ define [HookShape toStraight toFinish isStart y tight s kkaf] : begin
|
|||
* keyKnot
|
||||
* segAfter
|
||||
|
||||
define [hookstart y tight s kkaf] : return {.type 'interpolate' .af [lambda [before after] [HookShape after before true y tight s kkaf]]}
|
||||
define [hookend y tight s kkaf] : return {.type 'interpolate' .af [lambda [before after] [HookShape before after false y tight s kkaf]]}
|
||||
define [hookstart] : params [y tight sw kkaf] : return {
|
||||
.type 'interpolate'
|
||||
.af [lambda [before after] [HookShape after before true y tight sw kkaf]]
|
||||
}
|
||||
define [hookend] : params [y tight sw kkaf] : return {
|
||||
.type 'interpolate'
|
||||
.af [lambda [before after] [HookShape before after false y tight sw kkaf]]
|
||||
}
|
||||
|
||||
define [WaveShape l r cy extendy tension sw] : glyph-construction
|
||||
define [WaveShape] : params [l r cy extendy tension sw] : glyph-construction
|
||||
local cx : mix l r 0.5
|
||||
local wavex : (r - l) * tension
|
||||
local endwavey : extendy * 0.97
|
||||
|
|
|
|||
|
|
@ -2145,8 +2145,20 @@ symbol-block 'm'
|
|||
define [SmallMShape top bot] : glyph-construction
|
||||
local m1 : mix (SB + O) (MIDDLE + MVERTSTROKE / 2 * HVCONTRAST) 0.5
|
||||
local m2 : mix (RIGHTSB - O) (MIDDLE - MVERTSTROKE / 2 * HVCONTRAST) 0.5
|
||||
include : mShoulderSpiro (SB + O + MVERTSTROKE * HVCONTRAST) (MIDDLE + MVERTSTROKE / 2 * HVCONTRAST) top bot MVERTSTROKE (MVERTSTROKE * SHOULDERFINE / STROKE)
|
||||
include : mShoulderSpiro (MIDDLE + MVERTSTROKE * 0.5 * HVCONTRAST) (RIGHTSB - O) top bot MVERTSTROKE (MVERTSTROKE * SHOULDERFINE / STROKE)
|
||||
include : mShoulderSpiro
|
||||
left -- (SB + O + MVERTSTROKE * HVCONTRAST)
|
||||
right -- (MIDDLE + MVERTSTROKE / 2 * HVCONTRAST)
|
||||
top -- top
|
||||
bottom -- bot
|
||||
width -- MVERTSTROKE
|
||||
fine -- (MVERTSTROKE * SHOULDERFINE / STROKE)
|
||||
include : mShoulderSpiro
|
||||
left -- (MIDDLE + MVERTSTROKE * 0.5 * HVCONTRAST)
|
||||
right -- (RIGHTSB - O)
|
||||
top -- top
|
||||
bottom -- bot
|
||||
width -- MVERTSTROKE
|
||||
fine -- (MVERTSTROKE * SHOULDERFINE / STROKE)
|
||||
include : VBarLeft (SB + O) bot top MVERTSTROKE
|
||||
if SLAB : begin
|
||||
include : LeftwardTopSerif SB top SIDEJUT
|
||||
|
|
@ -2406,7 +2418,14 @@ define {LongSShape} : symbol-block 'f'
|
|||
widths.lhs
|
||||
flat m1 XH [heading DOWNWARD]
|
||||
curl m1 (DESCENDER + fine + rinner * 2)
|
||||
CurlyTail fine rinner m1 DESCENDER (m1 - LONGJUT) x2 y2
|
||||
CurlyTail
|
||||
fine -- fine
|
||||
rinner -- rinner
|
||||
xleft -- m1
|
||||
bottom -- DESCENDER
|
||||
right -- (m1 - LONGJUT)
|
||||
x2 -- x2
|
||||
y2 -- y2
|
||||
|
||||
create-glyph 'ifishhook' : glyph-construction
|
||||
assign-unicode 0x27F
|
||||
|
|
|
|||
|
|
@ -933,7 +933,12 @@ symbol-block 'CyrEl'
|
|||
local cutright : mix SB RIGHTSB 0.95
|
||||
include : VBarRight cutright 0 top
|
||||
include : HBar cutleft cutright (top - HALFSTROKE)
|
||||
include : LegShape cutleft cutleft2 [mix SB 0 [if SLAB 0.5 0.25]] top 0
|
||||
include : LegShape
|
||||
xt -- cutleft
|
||||
xb -- cutleft2
|
||||
xs -- [mix SB 0 [if SLAB 0.5 0.25]]
|
||||
top -- top
|
||||
bottom -- 0
|
||||
if SLAB : begin
|
||||
include : RightwardTopSerif cutright top SIDEJUT
|
||||
include : LeftwardTopSerif cutleft top SIDEJUT
|
||||
|
|
@ -1094,7 +1099,13 @@ symbol-block 'CyrLje and CyrNje'
|
|||
define [CyrLjeShape top] : glyph-construction
|
||||
local xlefttop : mix SB RIGHTSB 0.075
|
||||
local jut : JUT * 0.72
|
||||
include : LegShape xlefttop [mix SB RIGHTSB 0.025] [mix SB 0 [if SLAB 0.75 0.5]] top 0 MVERTSTROKE
|
||||
include : LegShape
|
||||
xt -- xlefttop
|
||||
xb -- [mix SB RIGHTSB 0.025]
|
||||
xs -- [mix SB 0 [if SLAB 0.75 0.5]]
|
||||
top -- top
|
||||
bottom -- 0
|
||||
fine -- MVERTSTROKE
|
||||
include : CyrYeriShape top (MIDDLE - MVERTSTROKE / 2 * HVCONTRAST) (RIGHTSB - O) MVERTSTROKE jut
|
||||
include : HBarTop xlefttop MIDDLE top
|
||||
if SLAB : begin
|
||||
|
|
|
|||
|
|
@ -234,7 +234,13 @@ symbol-block 'Mathematical Operators'
|
|||
|
||||
create-glyph 'sym' : glyph-construction
|
||||
assign-unicode 0x223C
|
||||
include : WaveShape SB RIGHTSB parenMid ((operTop - parenMid) * 0.17) 0.15 OPERATORSTROKE
|
||||
include : WaveShape
|
||||
l -- SB
|
||||
r -- RIGHTSB
|
||||
cy -- parenMid
|
||||
extendy -- ((operTop - parenMid) * 0.17)
|
||||
tension -- 0.15
|
||||
sw -- OPERATORSTROKE
|
||||
|
||||
create-glyph 'ident' : glyph-construction
|
||||
assign-unicode 0x2261
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user