###### GEOMETRIC SHAPES
$$include '../meta/macros.ptl'

import '../support/transform' as : Transform && [object [transformPoint tp] [untransform utp] inverse]
import [mix linreg clamp fallback] from '../support/utils'
import [designParameters] from '../meta/aesthetics'

export : define [apply] : begin
	glyph-module-entry commonShapes overmarks
	### Arrowheads
	define arrowWidth FULLWIDTH2
	define arrowMidX : arrowWidth / 2
	define arrowRSB : arrowWidth - SB
	define hwArrowRSB : WIDTH - SB
	define hwArrowMidX : WIDTH / 2

	local arrowSize : (RIGHTSB - SB) * designParameters.arrow_size * [Math.pow (arrowWidth / WIDTH) 0.4]
	local halfstroke : OPERATORSTROKE / 2
	local fine : adviceBlackness 4
	local terminal : adviceBlackness 6
	local arrowTop : mix parenMid parenTop 0.85
	local arrowBot : mix parenMid parenBot 0.85

	define [ArrowHead x1 y1 x2 y2 _size] : create-glyph : glyph-construction
		local size : fallback _size arrowSize
		local g this.gizmo
		set this.gizmo : Translate 0 0
		include : dispiro
			function [set this.gizmo [Transform.Id]]
			widths.rhs fine
			flat 0 0 [heading UPWARD]
			curl (size * 1) size [widths.rhs terminal]
			end [[] => (this.contrast = 1)]
		include : dispiro
			function [set this.gizmo [Transform.Id]]
			widths.lhs fine
			flat 0 0 [heading DOWNWARD]
			curl (size * 1) (-size) [widths.lhs terminal]
			end [[] => (this.contrast = 1)]
		apply-transform : Translate O 0
		local {.x xo .y yo} : tp g {.x x1 .y y1}
		local {.x xt .y yt} : tp g {.x x2 .y y2}
		apply-transform : Rotate : Math.atan2 (yo - yt) (xo - xt)
		apply-transform : Translate xt yt
		set this.gizmo g

	define [ArrowShape x1 y1 x2 y2 size] : glyph-construction
		local mag : Math.hypot (y2 - y1) (x2 - x1)
		local p : (mag - halfstroke * 1.1) / mag
		include : ArrowHead x1 y1 x2 y2 size
		include : dispiro
			widths.center (halfstroke * 2)
			flat x1 y1
			curl [mix x1 x2 p] [mix y1 y2 p]
			end [[] => (this.contrast = 1)]

	define [dhArrowShape x1 y1 x2 y2 size] : glyph-construction
		local mag : Math.hypot (y2 - y1) (x2 - x1)
		local p : (mag - size) / mag
		include : ArrowShape x1 y1 x2 y2 size
		include : ArrowHead x1 y1 [mix x1 x2 p] [mix y1 y2 p] size
	define [htArrowShape x1 y1 x2 y2 size] : glyph-construction
		local mag : Math.hypot (y2 - y1) (x2 - x1)
		local p1 : (size - halfstroke * 1.1) / mag
		local p2 : size / mag
		include : ArrowShape [mix x1 x2 p1] [mix y1 y2 p1] x2 y2 size
		include : ArrowHead x1 y1 [mix x1 x2 p2] [mix y1 y2 p2] size

	define [arrow shape id unicode x1 y1 x2 y2 width gwidth] : sketch
		set-width [fallback gwidth arrowWidth]
		set-anchor "slash" BASE arrowMidX parenMid
		include : shape x1 y1 x2 y2 arrowSize
		if width : set-width width
		save id unicode
	define [doublearrow shape id unicode x1 y1 x2 y2] : sketch
		set-width arrowWidth
		set-anchor "slash" BASE arrowMidX parenMid
		local xm : mix x1 x2 0.5
		local ym : mix y1 y2 0.5
		include : shape xm ym x1 y1 arrowSize
		include : shape xm ym x2 y2 arrowSize
		save id unicode

	arrow ArrowShape 'arrowleft'       0x2190 arrowRSB parenMid SB parenMid
	arrow ArrowShape 'arrowright.dflt' null   SB parenMid arrowRSB parenMid
	arrow ArrowShape 'arrowup'         0x2191 arrowMidX arrowBot arrowMidX arrowTop
	arrow ArrowShape 'arrowdown'       0x2193 arrowMidX arrowTop arrowMidX arrowBot
	arrow ArrowShape 'hwarrowleft'     null   hwArrowRSB parenMid SB parenMid nothing WIDTH
	arrow ArrowShape 'hwarrowright'    null   SB parenMid hwArrowRSB parenMid nothing WIDTH
	arrow ArrowShape 'hwarrowup'       null   hwArrowMidX arrowBot hwArrowMidX arrowTop nothing WIDTH
	arrow ArrowShape 'hwarrowdown'     null   hwArrowMidX arrowTop hwArrowMidX arrowBot nothing WIDTH
	arrow ArrowShape 'arrowupleft'     0x2196 arrowRSB arrowBot SB arrowTop
	arrow ArrowShape 'arrowupright'    0x2197 SB arrowBot arrowRSB arrowTop
	arrow ArrowShape 'arrowdownright'  0x2198 SB arrowTop arrowRSB arrowBot
	arrow ArrowShape 'arrowdownleft'   0x2199 arrowRSB arrowTop SB arrowBot

	arrow ArrowShape 'arrowright.IDT2' null SB parenMid (WIDTH * 2 - SB) parenMid WIDTH
	arrow ArrowShape 'arrowright.IDT4' null SB parenMid (WIDTH * 4 - SB) parenMid WIDTH
	arrow ArrowShape 'arrowright.IDT8' null SB parenMid (WIDTH * 8 - SB) parenMid WIDTH

	select-variant 'arrowright' 0x2192 'dflt' {
		.IDT2 'arrowright.IDT2'
		.IDT4 'arrowright.IDT4'
		.IDT8 'arrowright.IDT8'
	}

	doublearrow ArrowShape 'arrowleftright' 0x2194 SB parenMid arrowRSB parenMid
	doublearrow ArrowShape 'arrowupdown' 0x2195 arrowMidX arrowTop arrowMidX arrowBot
	doublearrow ArrowShape 'arrowupleftdownright' 0x2921 SB arrowTop arrowRSB arrowBot
	doublearrow ArrowShape 'arrowuprightdownleft' 0x2922 arrowRSB arrowTop SB arrowBot

	arrow dhArrowShape 'dharrowleft' 0x219E arrowRSB parenMid SB parenMid
	arrow dhArrowShape 'dharrowright' 0x21A0 SB parenMid arrowRSB parenMid
	arrow dhArrowShape 'dharrowup' 0x219F arrowMidX arrowBot arrowMidX arrowTop
	arrow dhArrowShape 'dharrowdown' 0x21A1 arrowMidX arrowTop arrowMidX arrowBot

	arrow htArrowShape 'htarrowleft' 0x21A2 arrowRSB parenMid SB parenMid
	arrow htArrowShape 'htarrowright' 0x21A3 SB parenMid arrowRSB parenMid

	### Standard geometric shapes
	### 'Geometric'
	define shapeWidth FULLWIDTH2

	define left : mix MIDDLE SB 1.1
	define right : mix MIDDLE RIGHTSB 1.1
	define squareRadius : (right - left) / 2

	local hollowSW : adviceBlackness 5
	define [hollowScale w d s] : (w - [fallback s hollowSW] * [fallback d : WIDTH / shapeWidth]) / w
	define [hollow newid unicode oldid zx zy cx cy] : sketch
		local isWide : glyphs.(oldid).advanceWidth > WIDTH
		include : create-glyph : glyph-construction
			include glyphs.(oldid)
			if isWide : include UnFullWidthify
		reverse-last
		local zoom : hollowScale squareRadius (WIDTH / glyphs.(oldid).advanceWidth)
		include : FlipAround [fallback cx MIDDLE] [fallback cy parenMid] [fallback zx zoom] [fallback zy zx zoom]
		include : create-glyph : glyph-construction
			include glyphs.(oldid)
			if isWide : include UnFullWidthify
		if isWide : include FullWidthify
		save newid unicode

	define [resized newid unicode id x y s sy] : sketch
		include glyphs.(id) AS_BASE
		include UnFullWidthify
		include : FlipAround x y s [fallback sy s]
		include FullWidthify

		save [fallback newid : [if (s < 1) 'small' 'large'] + id] unicode

	define FullWidthify : glyph-construction
		apply-transform [Upright] true
		apply-transform [Translate (-MIDDLE) (-parenMid)] true
		apply-transform [Scale (shapeWidth / WIDTH)] true
		apply-transform [Translate (shapeWidth / 2) parenMid] true
		apply-transform [Italify] true
		set-width shapeWidth

	define UnFullWidthify : glyph-construction
		apply-transform [Upright] true
		apply-transform [Translate (-shapeWidth / 2) (-parenMid)] true
		apply-transform [Scale (WIDTH / shapeWidth)] true
		apply-transform [Translate MIDDLE parenMid] true
		apply-transform [Italify] true
		set-width WIDTH

	sketch # blacksquare
		start-from left (parenMid + squareRadius)
		line-to    right (parenMid + squareRadius)
		line-to    right (parenMid - squareRadius)
		line-to    left (parenMid - squareRadius)
		include FullWidthify
		save 'blacksquare' 0x25A0
	sketch # blacktrianglerb
		start-from right (parenMid + squareRadius)
		line-to    right (parenMid - squareRadius)
		line-to    left (parenMid - squareRadius)
		include FullWidthify
		save 'blacktrianglerb' 0x25E2
	sketch # blacktrianglelb
		start-from left (parenMid + squareRadius)
		line-to    right (parenMid - squareRadius)
		line-to    left (parenMid - squareRadius)
		include FullWidthify
		save 'blacktrianglelb' 0x25E3
	sketch # blacktrianglelt
		start-from left (parenMid + squareRadius)
		line-to    right (parenMid + squareRadius)
		line-to    left (parenMid - squareRadius)
		include FullWidthify
		save 'blacktrianglelt' 0x25E4
	sketch # blacktrianglert
		start-from left (parenMid + squareRadius)
		line-to    right (parenMid + squareRadius)
		line-to    right (parenMid - squareRadius)
		include FullWidthify
		save 'blacktrianglert' 0x25E5

	sketch # blackrectangle
		start-from left (parenMid + squareRadius / 1.5)
		line-to    right (parenMid + squareRadius / 1.5)
		line-to    right (parenMid - squareRadius / 1.5)
		line-to    left (parenMid - squareRadius / 1.5)
		include FullWidthify
		save 'blackrectangle' 0x25AC

	sketch # blacklongrectangle
		start-from left (parenMid + squareRadius * 1.5)
		line-to    right (parenMid + squareRadius * 1.5)
		line-to    right (parenMid - squareRadius * 1.5)
		line-to    left (parenMid - squareRadius * 1.5)
		include FullWidthify
		save 'blacklongrectangle' 0x25AE
	local triangleOvershoot : 2 / [Math.sqrt 3]

	sketch # blacktriangleup
		start-from MIDDLE (parenMid + squareRadius)
		line-to    [mix MIDDLE right triangleOvershoot] (parenMid - squareRadius)
		line-to    [mix MIDDLE left triangleOvershoot] (parenMid - squareRadius)
		include FullWidthify
		save 'blacktriangleup' 0x25B2

	sketch # blacktriangledown
		start-from MIDDLE (parenMid - squareRadius)
		line-to    [mix MIDDLE left triangleOvershoot] (parenMid + squareRadius)
		line-to    [mix MIDDLE right triangleOvershoot] (parenMid + squareRadius)
		include FullWidthify
		save 'blacktriangledown' 0x25BC

	sketch # blacktriangleleft
		start-from left parenMid
		line-to    right (parenMid - squareRadius * triangleOvershoot)
		line-to    right (parenMid + squareRadius * triangleOvershoot)
		include FullWidthify
		save 'blacktriangleleft' 0x25C0

	sketch # blacktriangleright
		start-from right parenMid
		line-to    left (parenMid + squareRadius * triangleOvershoot)
		line-to    left (parenMid - squareRadius * triangleOvershoot)
		include FullWidthify
		save 'blacktriangleright' 0x25B6

	sketch # blackdiamond
		start-from MIDDLE (parenMid + squareRadius)
		line-to    right parenMid
		line-to    MIDDLE (parenMid - squareRadius)
		line-to    left parenMid
		save 'hwblackdiamond'
		include FullWidthify
		save 'blackdiamond' 0x25C6

	sketch # blackcircle
		include markset.plus
		include : spiro-outline
			g4 MIDDLE (parenMid + squareRadius)
			g4 left parenMid
			g4 MIDDLE (parenMid - squareRadius)
			g4 right parenMid
			close
		reverse-last
		save 'hwblackcircle'
		include FullWidthify
		save 'blackcircle' 0x25CF

	sketch # smallblackcircle
		include : spiro-outline
			g4 MIDDLE (parenMid + squareRadius * designParameters.geometric_small_x)
			g4 (MIDDLE - squareRadius * designParameters.geometric_small_x) parenMid
			g4 MIDDLE (parenMid - squareRadius * designParameters.geometric_small_x)
			g4 (MIDDLE + squareRadius * designParameters.geometric_small_x) parenMid
			close
		reverse-last
		save 'hwsmallblackcircle'
		include FullWidthify
		save 'smallblackcircle'

	sketch # bigblackcircle
		include : spiro-outline
			g4 MIDDLE (parenMid + squareRadius * designParameters.geometric_large_x)
			g4 (MIDDLE - squareRadius * designParameters.geometric_large_x) parenMid
			g4 MIDDLE (parenMid - squareRadius * designParameters.geometric_large_x)
			g4 (MIDDLE + squareRadius * designParameters.geometric_large_x) parenMid
			close
		reverse-last
		save 'hwbigblackcircle'
		include FullWidthify
		save 'bigblackcircle'

	let
	: configurations : list
		* {.sides 5 .skip 2 .name 'blackstar' .unicode 0x2605 .overflow 1.1 .phase 0}
		* {.sides 5 .skip 1 .name 'blackpentagon' .unicode 0x2B1F .overflow 1.05 .phase 0}
		* {.sides 6 .skip 1 .name 'blackhexagon' .unicode 0x2B22 .overflow 1.05 .phase 0}
		* {.sides 5 .skip 1 .name 'rhblackpentagon' .unicode 0x2B53 .overflow 1.05 .phase (-Math.PI / 2)}
		* {.sides 6 .skip 1 .name 'hblackhexagon' .unicode 0x2B23 .overflow 1.05 .phase (Math.PI / 2)}
	: foreach [{.sides sides .skip skip .name name .unicode unicode .overflow overflow .phase phase} : items-of configurations] : sketch
		include markset.plus
		foreach [j : range 0 sides] : begin
			local angle : 2 * Math.PI * j * skip / sides + phase
			currentGlyph.([if j 'line-to' 'start-from'])
				mix left right (0.5 - 0.5 * overflow * [Math.sin angle])
				parenMid + squareRadius * [Math.cos angle] * overflow
		save "hw\(name)"
		include FullWidthify
		save name unicode

	sketch # dottedcircle
		local n 12
		local fine : adviceBlackness 10
		foreach j [range 0 n] : begin
			local angle : Math.PI * 2 * j / n
			local cx : MIDDLE + (right - MIDDLE) * [Math.cos angle]
			local cy : (XH / 2) + (right - MIDDLE) * [Math.sin angle]
			include : spiro-outline
				g4 cx (cy + fine)
				g4 (cx + fine) cy
				g4 cx (cy - fine)
				g4 (cx - fine) cy
				close
			#include : Ring (cy + fine) (cy - fine) (cx - fine) (cx + fine) true
		include markset.e
		apply-transform [Upright] true
		apply-transform [Translate 0 (parenMid - (XH / 2))] true
		apply-transform [Italify] true
		include FullWidthify

		save 'dottedcircle' 0x25CC

	hollow 'whitesquare' 0x25A1 'blacksquare'
	hollow 'whitehexagon' 0x2B21 'blackhexagon'
	hollow 'whitepentagon' 0x2B20 'blackpentagon'
	hollow 'rhwhitepentagon' 0x2B54 'rhblackpentagon'
	hollow 'whiterectangle' 0x25AD 'blackrectangle' [hollowScale squareRadius] [hollowScale (squareRadius / 1.5)]
	hollow 'whitelongrectangle' 0x25AF 'blacklongrectangle' [hollowScale squareRadius] [hollowScale (squareRadius * 1.5)]
	hollow 'whitecircle' 0x25CB 'blackcircle'
	hollow 'bigwhitecircle' 0x25EF 'bigblackcircle' [hollowScale : squareRadius * designParameters.geometric_large_x]
	hollow 'hwbigwhitecircle' null 'hwbigblackcircle' [hollowScale (squareRadius * designParameters.geometric_large_x) 1]
	hollow 'smallwhitecircle' null 'smallblackcircle' [hollowScale : squareRadius * designParameters.geometric_small_x]
	hollow 'hwsmallwhitecircle' null 'hwsmallblackcircle' [hollowScale (squareRadius * designParameters.geometric_small_x) 1]
	hollow 'hwwhitecircle' null 'hwblackcircle'
	hollow 'hwwhitediamond' null 'hwblackdiamond' [hollowScale squareRadius nothing (hollowSW * [Math.sqrt 2])]
	hollow 'whitediamond' 0x25C7 'blackdiamond' [hollowScale squareRadius nothing (hollowSW * [Math.sqrt 2])]

	let [sts 0.75]
	: begin
		resized 'smallblacktriangleup' 0x25B4 'blacktriangleup' MIDDLE parenMid 0.75
		resized 'smallblacktriangleright' 0x25B8 'blacktriangleright' MIDDLE parenMid 0.75
		resized 'smallblacktriangledown' 0x25BE 'blacktriangledown' MIDDLE parenMid 0.75
		resized 'smallblacktriangleleft' 0x25C2 'blacktriangleleft' MIDDLE parenMid 0.75

		let
		: sl : hollowScale (squareRadius * 2 / [Math.sqrt 3]) nothing (hollowSW * [Math.sqrt 3])
		: ss : hollowScale (squareRadius * sts * 2 / [Math.sqrt 3]) nothing (hollowSW * [Math.sqrt 3])
		: begin
			hollow 'whitetriangleup' 0x25B3 'blacktriangleup' sl nothing MIDDLE (parenMid - squareRadius / 3)
			hollow 'whitetriangledown' 0x25BD 'blacktriangledown' sl nothing MIDDLE (parenMid + squareRadius / 3)
			hollow 'whitetriangleleft' 0x25C1 'blacktriangleleft' sl nothing [mix MIDDLE right (1 / 3)] parenMid
			hollow 'whitetriangleright' 0x25B7 'blacktriangleright' sl nothing [mix MIDDLE left (1 / 3)] parenMid
			hollow 'smallwhitetriangleup' 0x25B5 'smallblacktriangleup' ss nothing MIDDLE (parenMid - squareRadius / 3 * sts)
			hollow 'smallwhitetriangledown' 0x25BF 'smallblacktriangledown' ss nothing MIDDLE (parenMid + squareRadius / 3 * sts)
			hollow 'smallwhitetriangleleft' 0x25C3 'smallblacktriangleleft' ss nothing [mix MIDDLE right (sts / 3)] parenMid
			hollow 'smallwhitetriangleright' 0x25B9 'smallblacktriangleright' ss nothing [mix MIDDLE left (sts / 3)] parenMid

	# Mark sampler
	sketch
		include markset.e
		include : spiro-outline
			g4 MIDDLE XH
			g4 (MIDDLE - XH / 2) (XH / 2)
			g4 MIDDLE 0
			close

		include : spiro-outline
			g4 MIDDLE (XH * 0.9)
			g4 (MIDDLE + XH * 0.4) (XH * 0.5)
			g4 MIDDLE (XH * 0.1)
			close
		save 'marksampler' 0xE09E

	### Blocks
	### 'Block Shapes'
	sketch # fullblock
		set-width FULLWIDTH
		start-from 0 font.OS_2.usWinAscent
		line-to    FULLWIDTH font.OS_2.usWinAscent
		line-to    FULLWIDTH (-font.OS_2.usWinDescent)
		line-to    0 (-font.OS_2.usWinDescent)
		save 'fullblock' 0x2588
	define [Shade fn] : glyph-construction
		local top font.OS_2.usWinAscent
		local bottom (-font.OS_2.usWinDescent)
		local segx 6
		local segy 16
		local g : create-glyph : glyph-construction : foreach j [range 0 segx] : foreach k [range 0 segy] : if [fn j k] : begin
			start-from [mix 0 WIDTH (j / segx)] [mix bottom top (k / segy)]
			line-to    [mix 0 WIDTH (j / segx)] [mix bottom top ((k + 1) / segy)]
			line-to    [mix 0 WIDTH ((j + 1) / segx)] [mix bottom top ((k + 1) / segy)]
			line-to    [mix 0 WIDTH ((j + 1) / segx)] [mix bottom top (k / segy)]
		include g
		if (FULLWIDTH > WIDTH) : begin
			apply-transform : Translate (FULLWIDTH - WIDTH) 0
			include g

	sketch # lightshade
		set-width FULLWIDTH
		include : Shade ([j k] => ((k % 2) && (j + (k - 1) / 2) % 2))
		save 'lightshade' 0x2591

	sketch # mediumshade
		set-width FULLWIDTH
		include : Shade ([j k] => ((j + k) % 2))
		save 'mediumshade' 0x2592

	sketch # heavyshade
		set-width FULLWIDTH
		include : Shade ([j k] => ((k % 2) || (j + k / 2) % 2))
		save 'heavyshade' 0x2593

	foreach [fill : range 1 8] : begin
		sketch # Vertical fill
			set-width FULLWIDTH
			start-from 0 [mix (-font.OS_2.usWinDescent) font.OS_2.usWinAscent (fill / 8)]
			line-to    FULLWIDTH [mix (-font.OS_2.usWinDescent) font.OS_2.usWinAscent (fill / 8)]
			line-to    FULLWIDTH (-font.OS_2.usWinDescent)
			line-to    0 (-font.OS_2.usWinDescent)
			save ('vfill' + fill) (0x2580 + fill)
		sketch # Horizontal fill
			set-width FULLWIDTH
			start-from 0 font.OS_2.usWinAscent
			line-to    (FULLWIDTH * fill / 8) font.OS_2.usWinAscent
			line-to    (FULLWIDTH * fill / 8) (-font.OS_2.usWinDescent)
			line-to    0 (-font.OS_2.usWinDescent)
			save ('hfill' + fill) (0x2590 - fill)

	sketch # upHalfblock
		set-width FULLWIDTH
		start-from 0 font.OS_2.usWinAscent
		line-to    FULLWIDTH font.OS_2.usWinAscent
		line-to    FULLWIDTH [mix (-font.OS_2.usWinDescent) font.OS_2.usWinAscent 0.5]
		line-to    0 [mix (-font.OS_2.usWinDescent) font.OS_2.usWinAscent 0.5]
		save 'upHalfblock' 0x2580

	sketch # rightHalfBlock
		set-width FULLWIDTH
		start-from (FULLWIDTH * 0.5) font.OS_2.usWinAscent
		line-to    FULLWIDTH font.OS_2.usWinAscent
		line-to    FULLWIDTH (-font.OS_2.usWinDescent)
		line-to    (FULLWIDTH * 0.5) (-font.OS_2.usWinDescent)

		save 'rightHalfBlock' 0x2590
	### Box drawing glyphs
	do "Box Drawing"
		local light : adviceBlackness 3.5
		local heavy : Math.max (light * 2) (WIDTH * 0.15)
		local width FULLWIDTH
		local midx : FULLWIDTH / 2
		local topy font.OS_2.usWinAscent
		local boty (-font.OS_2.usWinDescent)
		local midy : mix boty topy 0.5

		define [boxdraw unicode u d l r] : sketch
			set-width width
			local stopH : [Math.max u d] / 2
			local stopV : [Math.max l r] / 2
			if l : include : HBar 0 (midx + stopH) midy l
			if r : include : HBar (midx - stopH) width midy r
			if d : include : VBar midx (-font.OS_2.usWinDescent) (midy + stopV) d
			if u : include : VBar midx (midy - stopV) font.OS_2.usWinAscent u

			save ('bd' + [unicode.toString 16 :.toUpperCase]) unicode

		define [dlboxdraw unicode u d l r] : sketch
			set-width width
			local stopH : [Math.max u d] - light * 1 - light * 0.5 * HVCONTRAST
			local stopV : [Math.max l r] - light * 1.5
			local capH  : [Math.max u d] - light * 1
			local capV  : [Math.max l r] - light * 1
			if l : begin
				include : HBar 0 (midx - stopH) (midy + (l - light)) light
				if (l > light) : include : HBar 0 (midx - stopH) (midy - (l - light)) light
			if r : begin
				include : HBar (midx + stopH) width (midy + (r - light)) light
				if (r > light) : include : HBar (midx + stopH) width (midy - (r - light)) light
			if d : begin
				include : VBar (midx + (d - light)) (-font.OS_2.usWinDescent) (midy - stopV) light
				if (d > light) : include : VBar (midx - (d - light)) (-font.OS_2.usWinDescent) (midy - stopV) light
			if u : begin
				include : VBar (midx + (u - light)) (midy + stopV) font.OS_2.usWinAscent light
				if (u > light) : include : VBar (midx - (u - light)) (midy + stopV) font.OS_2.usWinAscent light
			if (stopH > 0 && [not u]) : include : HBar (midx - stopH - light * HVCONTRAST) (midx + stopH + light * HVCONTRAST) (midy + capV) light
			if (stopH > 0 && [not d]) : include : HBar (midx - stopH - light * HVCONTRAST) (midx + stopH + light * HVCONTRAST) (midy - capV) light
			if (stopV > 0 && [not l]) : include : VBar (midx - capH) (midy - stopV - light) (midy + stopV + light) light
			if (stopV > 0 && [not r]) : include : VBar (midx + capH) (midy - stopV - light) (midy + stopV + light) light

			save ('bd' + [unicode.toString 16 :.toUpperCase]) unicode

		define [complexBoxDraw unicodeStart U D L R fn dl] : begin
			local order {
			{light light light light}
				{light light heavy light}
				{light light light heavy}
				{light light heavy heavy}
				{heavy light light light}
				{light heavy light light}
				{heavy heavy light light}
				{heavy light heavy light}
				{heavy light light heavy}
				{light heavy heavy light}
				{light heavy light heavy}
				{heavy light heavy heavy}
				{light heavy heavy heavy}
				{heavy heavy heavy light}
				{heavy heavy light heavy}
				{heavy heavy heavy heavy}
			}
			local existings {}
			local n 0
			foreach {u d l r} [items-of order] : begin
				local newcome true
				local masked {(U * u) (D * d) (L * l) (R * r)}
				foreach existing [items-of existings] : if ('' + existing === '' + masked) : set newcome false
				if newcome : begin
					if ([not dl]
						||  ([not masked.0] || [not masked.1] || (masked.0 === masked.1))
						&& ([not masked.2] || [not masked.3] || (masked.2 === masked.3))
						&& (masked.0 > light || masked.1 > light || masked.2 > light || masked.3 > light)
					) : begin
						[fallback fn boxdraw].apply null {(unicodeStart + n) :: masked}
						inc n
					existings.push masked

		# Straight
		boxdraw 0x2500 0 0 light light
		boxdraw 0x2501 0 0 heavy heavy
		boxdraw 0x2502 light light 0 0
		boxdraw 0x2503 heavy heavy 0 0
		boxdraw 0x2574 0 0 light 0
		boxdraw 0x2575 light 0 0 0
		boxdraw 0x2576 0 0 0 light
		boxdraw 0x2577 0 light 0 0
		boxdraw 0x2578 0 0 heavy 0
		boxdraw 0x2579 heavy 0 0 0
		boxdraw 0x257A 0 0 0 heavy
		boxdraw 0x257B 0 heavy 0 0
		boxdraw 0x257C 0 0 light heavy
		boxdraw 0x257D light heavy 0 0
		boxdraw 0x257E 0 0 heavy light
		boxdraw 0x257F heavy light 0 0
		dlboxdraw 0x2550 0 0 heavy heavy
		dlboxdraw 0x2551 heavy heavy 0 0

		# Complex
		complexBoxDraw 0x250C 0 1 0 1
		complexBoxDraw 0x2510 0 1 1 0
		complexBoxDraw 0x2514 1 0 0 1
		complexBoxDraw 0x2518 1 0 1 0
		complexBoxDraw 0x251C 1 1 0 1
		complexBoxDraw 0x2524 1 1 1 0
		complexBoxDraw 0x252C 0 1 1 1
		complexBoxDraw 0x2534 1 0 1 1
		complexBoxDraw 0x253C 1 1 1 1
		complexBoxDraw 0x2552 0 1 0 1 dlboxdraw 1
		complexBoxDraw 0x2555 0 1 1 0 dlboxdraw 1
		complexBoxDraw 0x2558 1 0 0 1 dlboxdraw 1
		complexBoxDraw 0x255B 1 0 1 0 dlboxdraw 1
		complexBoxDraw 0x255E 1 1 0 1 dlboxdraw 1
		complexBoxDraw 0x2561 1 1 1 0 dlboxdraw 1
		complexBoxDraw 0x2564 0 1 1 1 dlboxdraw 1
		complexBoxDraw 0x2567 1 0 1 1 dlboxdraw 1
		complexBoxDraw 0x256A 1 1 1 1 dlboxdraw 1

		# Dashed
		define [hDashed unicode segments weight] : sketch
			set-width width
			foreach j [range 0 segments] : include : HBar [mix (width * j / segments) (width * (j + 1) / segments) 0.2] [mix (width * j / segments) (width * (j + 1) / segments) 0.8] midy weight

			save ('bd' + [unicode.toString 16 :.toUpperCase]) unicode

		define [vDashed unicode segments weight] : sketch
			set-width width
			foreach j [range 0 segments] : include : VBar midx [mix [mix (-font.OS_2.usWinDescent) font.OS_2.usWinAscent (j / segments)] [mix (-font.OS_2.usWinDescent) font.OS_2.usWinAscent ((j + 1) / segments)] 0.2] [mix [mix (-font.OS_2.usWinDescent) font.OS_2.usWinAscent (j / segments)] [mix (-font.OS_2.usWinDescent) font.OS_2.usWinAscent ((j + 1) / segments)] 0.8] weight

			save ('bd' + [unicode.toString 16 :.toUpperCase]) unicode

		hDashed 0x2504 3 light
		hDashed 0x2505 3 heavy
		hDashed 0x2508 4 light
		hDashed 0x2509 4 heavy
		hDashed 0x254C 2 light
		hDashed 0x254D 2 heavy
		vDashed 0x2506 3 light
		vDashed 0x2507 3 heavy
		vDashed 0x250A 4 light
		vDashed 0x250B 4 heavy
		vDashed 0x254E 2 light
		vDashed 0x254F 2 heavy

		# Arcs
		local bdArcRadius : Math.min (midx + O * 2) ((midy - boty) / 2)
		sketch # bd256D
			set-width width
			include : dispiro
				widths.center light
				flat midx boty                 [heading UPWARD]
				curl midx (midy - bdArcRadius) [heading UPWARD]
				arcvh
				flat (midx + bdArcRadius) midy [heading RIGHTWARD]
				curl width midy                [heading RIGHTWARD]
			save 'bd256D' 0x256D

		sketch # bd256E
			set-width width
			include : dispiro
				widths.center light
				flat midx boty                 [heading UPWARD]
				curl midx (midy - bdArcRadius) [heading UPWARD]
				arcvh
				flat (midx - bdArcRadius) midy [heading LEFTWARD]
				curl 0 midy                    [heading LEFTWARD]
			save 'bd256E' 0x256E

		sketch # bd256F
			set-width width
			include : dispiro
				widths.center light
				flat midx topy                 [heading DOWNWARD]
				curl midx (midy + bdArcRadius) [heading DOWNWARD]
				arcvh
				flat (midx - bdArcRadius) midy [heading LEFTWARD]
				curl 0 midy                    [heading LEFTWARD]
			save 'bd256F' 0x256F

		sketch # bd2570
			set-width width
			include : dispiro
				widths.center light
				flat midx topy                 [heading DOWNWARD]
				curl midx (midy + bdArcRadius) [heading DOWNWARD]
				arcvh
				flat (midx + bdArcRadius) midy [heading RIGHTWARD]
				curl width midy                [heading RIGHTWARD]
			save 'bd2570' 0x2570

		sketch # bd2571
			set-width width
			include : dispiro
				widths.center light
				flat width font.OS_2.usWinAscent
				curl 0 (-font.OS_2.usWinDescent)
			save 'bd2571' 0x2571

		sketch # bd2572
			set-width width
			include : dispiro
				widths.center light
				flat 0 font.OS_2.usWinAscent
				curl width (-font.OS_2.usWinDescent)
			save 'bd2572' 0x2572

		sketch # bd2573
			set-width width
			include glyphs.bd2571
			include glyphs.bd2572
			save 'bd2573' 0x2573

	### POWERLINE glyphs
	### 'Powerline'
	sketch # branch
		local fine : adviceBlackness 3.5
		local y1 : mix parenBot parenTop 0.8
		local y2 : mix parenBot parenTop 0.2
		include : VBarLeft SB parenBot parenTop fine
		include : dispiro
			widths.rhs fine
			flat RIGHTSB y1
			curl RIGHTSB [mix y1 y2 0.4]
			g4 (SB + fine * HVCONTRAST) y2 [heading LEFTWARD]
		include : DotAt (RIGHTSB - fine * HVCONTRAST / 2) y1 [Math.max (fine * 1.5) PERIODRADIUS]
		save 'branch' 0xE0A0

	local pwlMid : (font.OS_2.usWinAscent - font.OS_2.usWinDescent) / 2
	local pwlTop : (font.OS_2.usWinAscent - pwlMid) * para.powerlineScaleY + para.powerlineShiftY + pwlMid
	local pwlBot : (-font.OS_2.usWinDescent - pwlMid) * para.powerlineScaleY + para.powerlineShiftY + pwlMid
	local pwlNear : 0 * para.powerlineScaleX + para.powerlineShiftX
	local pwlFar : WIDTH * para.powerlineScaleX + para.powerlineShiftX
	sketch # pwlTriangleRight
		start-from (pwlNear + O) pwlTop
		line-to    pwlNear pwlTop
		line-to    pwlFar [mix pwlTop pwlBot 0.5]
		line-to    pwlNear pwlBot
		line-to    (pwlNear + O) pwlBot
		save 'pwlTriangleRight' 0xE0B0

	sketch # pwlAngleRight
		local fine : adviceBlackness 4
		include : dispiro
			widths.rhs fine
			flat pwlNear pwlTop
			curl pwlFar [mix pwlTop pwlBot 0.5]
		include : dispiro
			widths.rhs fine
			flat pwlFar [mix pwlTop pwlBot 0.5]
			curl pwlNear pwlBot
		save 'pwlAngleRight' 0xE0B1

	sketch # pwlTriangleLeft
		include glyphs.pwlTriangleRight
		include : FlipAround MIDDLE [mix pwlTop pwlBot 0.5]
		save 'pwlTriangleLeft' 0xE0B2

	sketch # pwlAngleLeft
		include glyphs.pwlAngleRight
		include : FlipAround MIDDLE [mix pwlTop pwlBot 0.5]
		save 'pwlAngleLeft' 0xE0B3

	sketch # pwlUnderline
		local fine : adviceBlackness 4
		include : HBarBottom 0 WIDTH pwlBot
		save 'pwlUnderline' 0xE0AE

	sketch # pwlOverline
		local fine : adviceBlackness 4
		include : HBarTop 0 WIDTH pwlTop
		save 'pwlOverline' 0xE0AF

	sketch # pwlLock
		local fine : adviceBlackness 3.5
		include glyphs.O
		start-from (SB + OX) parenMid
		line-to    (RIGHTSB - OX) parenMid
		line-to    (RIGHTSB - OX) parenBot
		line-to    (SB + OX) parenBot
		save 'pwlLock' 0xE0A2
	
	return [object ArrowShape]
