aboutsummaryrefslogtreecommitdiffstats
path: root/include/diagf
diff options
context:
space:
mode:
authorJeffrey H. Kingston <jeff@it.usyd.edu.au>2010-09-14 19:36:16 +0000
committerJeffrey H. Kingston <jeff@it.usyd.edu.au>2010-09-14 19:36:16 +0000
commita0423a5c6e7ae16023d22892ce2124989745c7a1 (patch)
tree26e8947ef0a82e8150e46ebd0b257ec5cd13c0ed /include/diagf
parent71bdb35d52747e6d7d9f55df4524d57c2966be94 (diff)
downloadlout-9dfa592c826fb82b23c363768e70ac1c763e9439.tar.gz
Lout 3.18 tag.3.18
git-svn-id: http://svn.savannah.nongnu.org/svn/lout/tags/3.18@6 9365b830-b601-4143-9ba8-b4a8e2c3339c
Diffstat (limited to 'include/diagf')
-rw-r--r--include/diagf2648
1 files changed, 2631 insertions, 17 deletions
diff --git a/include/diagf b/include/diagf
index 18b888a..999c82e 100644
--- a/include/diagf
+++ b/include/diagf
@@ -2,9 +2,10 @@
###############################################################################
# #
# Lout @Diag package for drawing diagrams #
-# Version 1.0 (July 1996) #
+# Version 1.1 (February 2000) #
# Jeffrey H. Kingston #
# #
+# Version 1.0 (July 1996) #
# Based on Version 2.0 of the @Fig package (Jeffrey H. Kingston, Dec 1992). #
# #
###############################################################################
@@ -12,10 +13,27 @@
@SysPrependGraphic { diagf.lpg }
@SysInclude { diagf.etc }
-export @Diag
+###############################################################################
+# #
+# @DiagSetup symbol #
+# #
+###############################################################################
+
+export @Diag @SyntaxDiag
def @DiagSetup
named save { no }
named maxlabels { 200 }
+ named title { "--titledft--" }
+ named titleformat
+ left @Title
+ right @Body
+ { Italic @Font @Title //0.7f ||0.35f @Body }
+
+ ###########################################################################
+ # #
+ # @Node options of @DiagSetup #
+ # #
+ ###########################################################################
import @Geometry named outline
named margin {}
@@ -123,6 +141,348 @@ def @DiagSetup
named dlabelctr { }
import @Geometry named dlabeladjust { }
+ ###########################################################################
+ # #
+ # @ANode options of @DiagSetup #
+ # #
+ ###########################################################################
+
+ import @Geometry named aoutline
+ named margin {}
+ named shadow {}
+ named sides {}
+ named angle {}
+ { box }
+ named amargin { 0.6f }
+ import @Geometry named ashadow { 0.4f }
+ import @Geometry named asides { 3 }
+ import @Geometry named aangle { "dup 180 exch div" }
+ named atranslate { }
+ named aoutlinestyle
+ named solid { "/ldiagsolid" }
+ named dashed { "/ldiagdashed" }
+ named cdashed { "/ldiagcdashed" }
+ named dotted { "/ldiagdotted" }
+ named noline { "/ldiagnoline" }
+ { solid }
+ import @Geometry named aoutlinedashlength { 0.2f }
+ import @Geometry named aoutlinewidth
+ named thin { 0.04 ft }
+ named medium { 0.08 ft }
+ named thick { 0.12 ft }
+ { thin }
+ named apaint { nopaint }
+ named afont { }
+ named abreak { }
+ named aformat right @Body { @Body }
+
+ named avalign { ctr }
+ named avsize { }
+ named avindent { ctr }
+ named avstrut
+ named no { 0.0f }
+ named yes { 1.0f }
+ { no }
+ named avmargin { }
+ named atopmargin { }
+ named afootmargin { }
+
+ named ahalign { ctr }
+ named ahsize { }
+ named ahindent { ctr }
+ named ahstrut
+ named no { 0.0f }
+ named yes { 1.0f }
+ { no }
+ named ahmargin { }
+ named aleftmargin { }
+ named arightmargin { }
+
+ named anodelabel { }
+ named anodelabelmargin { 0.2f }
+ named anodelabelfont { -2p }
+ named anodelabelbreak { ragged nohyphen }
+ named anodelabelformat right @Body { @Body }
+ import @Geometry named anodelabelpos{ }
+ named anodelabelprox { outside }
+ import @Geometry named anodelabelangle { horizontal }
+ named anodelabelctr { no }
+ import @Geometry named anodelabeladjust { 0 0 }
+
+ named aalabel { }
+ named aalabelmargin { }
+ named aalabelfont { }
+ named aalabelbreak { }
+ named aalabelformat right @Body { }
+ import @Geometry named aalabelpos { NE }
+ named aalabelprox { }
+ import @Geometry named aalabelangle { }
+ named aalabelctr { }
+ import @Geometry named aalabeladjust{ }
+
+ named ablabel { }
+ named ablabelmargin { }
+ named ablabelfont { }
+ named ablabelbreak { }
+ named ablabelformat right @Body { }
+ import @Geometry named ablabelpos { NW }
+ named ablabelprox { }
+ import @Geometry named ablabelangle { }
+ named ablabelctr { }
+ import @Geometry named ablabeladjust{ }
+
+ named aclabel { }
+ named aclabelmargin { }
+ named aclabelfont { }
+ named aclabelbreak { }
+ named aclabelformat right @Body { }
+ import @Geometry named aclabelpos { SW }
+ named aclabelprox { }
+ import @Geometry named aclabelangle { }
+ named aclabelctr { }
+ import @Geometry named aclabeladjust{ }
+
+ named adlabel { }
+ named adlabelmargin { }
+ named adlabelfont { }
+ named adlabelbreak { }
+ named adlabelformat right @Body { }
+ import @Geometry named adlabelpos { SE }
+ named adlabelprox { }
+ import @Geometry named adlabelangle { }
+ named adlabelctr { }
+ import @Geometry named adlabeladjust{ }
+
+ ###########################################################################
+ # #
+ # @BNode options of @DiagSetup #
+ # #
+ ###########################################################################
+
+ import @Geometry named boutline
+ named margin {}
+ named shadow {}
+ named sides {}
+ named angle {}
+ { box }
+ named bmargin { 0.6f }
+ import @Geometry named bshadow { 0.4f }
+ import @Geometry named bsides { 3 }
+ import @Geometry named bangle { "dup 180 exch div" }
+ named btranslate { }
+ named boutlinestyle
+ named solid { "/ldiagsolid" }
+ named dashed { "/ldiagdashed" }
+ named cdashed { "/ldiagcdashed" }
+ named dotted { "/ldiagdotted" }
+ named noline { "/ldiagnoline" }
+ { solid }
+ import @Geometry named boutlinedashlength { 0.2f }
+ import @Geometry named boutlinewidth
+ named thin { 0.04 ft }
+ named medium { 0.08 ft }
+ named thick { 0.12 ft }
+ { thin }
+ named bpaint { nopaint }
+ named bfont { }
+ named bbreak { }
+ named bformat right @Body { @Body }
+
+ named bvalign { ctr }
+ named bvsize { }
+ named bvindent { ctr }
+ named bvstrut
+ named no { 0.0f }
+ named yes { 1.0f }
+ { no }
+ named bvmargin { }
+ named btopmargin { }
+ named bfootmargin { }
+
+ named bhalign { ctr }
+ named bhsize { }
+ named bhindent { ctr }
+ named bhstrut
+ named no { 0.0f }
+ named yes { 1.0f }
+ { no }
+ named bhmargin { }
+ named bleftmargin { }
+ named brightmargin { }
+
+ named bnodelabel { }
+ named bnodelabelmargin { 0.2f }
+ named bnodelabelfont { -2p }
+ named bnodelabelbreak { ragged nohyphen }
+ named bnodelabelformat right @Body { @Body }
+ import @Geometry named bnodelabelpos{ }
+ named bnodelabelprox { outside }
+ import @Geometry named bnodelabelangle { horizontal }
+ named bnodelabelctr { no }
+ import @Geometry named bnodelabeladjust { 0 0 }
+
+ named balabel { }
+ named balabelmargin { }
+ named balabelfont { }
+ named balabelbreak { }
+ named balabelformat right @Body { }
+ import @Geometry named balabelpos { NE }
+ named balabelprox { }
+ import @Geometry named balabelangle { }
+ named balabelctr { }
+ import @Geometry named balabeladjust{ }
+
+ named bblabel { }
+ named bblabelmargin { }
+ named bblabelfont { }
+ named bblabelbreak { }
+ named bblabelformat right @Body { }
+ import @Geometry named bblabelpos { NW }
+ named bblabelprox { }
+ import @Geometry named bblabelangle { }
+ named bblabelctr { }
+ import @Geometry named bblabeladjust{ }
+
+ named bclabel { }
+ named bclabelmargin { }
+ named bclabelfont { }
+ named bclabelbreak { }
+ named bclabelformat right @Body { }
+ import @Geometry named bclabelpos { SW }
+ named bclabelprox { }
+ import @Geometry named bclabelangle { }
+ named bclabelctr { }
+ import @Geometry named bclabeladjust{ }
+
+ named bdlabel { }
+ named bdlabelmargin { }
+ named bdlabelfont { }
+ named bdlabelbreak { }
+ named bdlabelformat right @Body { }
+ import @Geometry named bdlabelpos { SE }
+ named bdlabelprox { }
+ import @Geometry named bdlabelangle { }
+ named bdlabelctr { }
+ import @Geometry named bdlabeladjust{ }
+
+ ###########################################################################
+ # #
+ # @CNode options of @DiagSetup #
+ # #
+ ###########################################################################
+
+ import @Geometry named coutline
+ named margin {}
+ named shadow {}
+ named sides {}
+ named angle {}
+ { box }
+ named cmargin { 0.6f }
+ import @Geometry named cshadow { 0.4f }
+ import @Geometry named csides { 3 }
+ import @Geometry named cangle { "dup 180 exch div" }
+ named ctranslate { }
+ named coutlinestyle
+ named solid { "/ldiagsolid" }
+ named dashed { "/ldiagdashed" }
+ named cdashed { "/ldiagcdashed" }
+ named dotted { "/ldiagdotted" }
+ named noline { "/ldiagnoline" }
+ { solid }
+ import @Geometry named coutlinedashlength { 0.2f }
+ import @Geometry named coutlinewidth
+ named thin { 0.04 ft }
+ named medium { 0.08 ft }
+ named thick { 0.12 ft }
+ { thin }
+ named cpaint { nopaint }
+ named cfont { }
+ named cbreak { }
+ named cformat right @Body { @Body }
+
+ named cvalign { ctr }
+ named cvsize { }
+ named cvindent { ctr }
+ named cvstrut
+ named no { 0.0f }
+ named yes { 1.0f }
+ { no }
+ named cvmargin { }
+ named ctopmargin { }
+ named cfootmargin { }
+
+ named chalign { ctr }
+ named chsize { }
+ named chindent { ctr }
+ named chstrut
+ named no { 0.0f }
+ named yes { 1.0f }
+ { no }
+ named chmargin { }
+ named cleftmargin { }
+ named crightmargin { }
+
+ named cnodelabel { }
+ named cnodelabelmargin { 0.2f }
+ named cnodelabelfont { -2p }
+ named cnodelabelbreak { ragged nohyphen }
+ named cnodelabelformat right @Body { @Body }
+ import @Geometry named cnodelabelpos{ }
+ named cnodelabelprox { outside }
+ import @Geometry named cnodelabelangle { horizontal }
+ named cnodelabelctr { no }
+ import @Geometry named cnodelabeladjust { 0 0 }
+
+ named calabel { }
+ named calabelmargin { }
+ named calabelfont { }
+ named calabelbreak { }
+ named calabelformat right @Body { }
+ import @Geometry named calabelpos { NE }
+ named calabelprox { }
+ import @Geometry named calabelangle { }
+ named calabelctr { }
+ import @Geometry named calabeladjust{ }
+
+ named cblabel { }
+ named cblabelmargin { }
+ named cblabelfont { }
+ named cblabelbreak { }
+ named cblabelformat right @Body { }
+ import @Geometry named cblabelpos { NW }
+ named cblabelprox { }
+ import @Geometry named cblabelangle { }
+ named cblabelctr { }
+ import @Geometry named cblabeladjust{ }
+
+ named cclabel { }
+ named cclabelmargin { }
+ named cclabelfont { }
+ named cclabelbreak { }
+ named cclabelformat right @Body { }
+ import @Geometry named cclabelpos { SW }
+ named cclabelprox { }
+ import @Geometry named cclabelangle { }
+ named cclabelctr { }
+ import @Geometry named cclabeladjust{ }
+
+ named cdlabel { }
+ named cdlabelmargin { }
+ named cdlabelfont { }
+ named cdlabelbreak { }
+ named cdlabelformat right @Body { }
+ import @Geometry named cdlabelpos { SE }
+ named cdlabelprox { }
+ import @Geometry named cdlabelangle { }
+ named cdlabelctr { }
+ import @Geometry named cdlabeladjust{ }
+
+ ###########################################################################
+ # #
+ # @Link options of @DiagSetup #
+ # #
+ ###########################################################################
+
import @Geometry named path
named from {}
named to {}
@@ -236,6 +596,12 @@ def @DiagSetup
named tolabelctr { no }
import @Geometry named tolabeladjust { 0 0 }
+ ###########################################################################
+ # #
+ # Tree and syntax diagram options of @DiagSetup #
+ # #
+ ###########################################################################
+
named treehsep { 0.5f }
named treevsep { 0.5f }
named treehindent
@@ -249,13 +615,21 @@ def @DiagSetup
named foot { 1.0rt }
{ ctr }
+ named syntaxgap { 0.35f }
+ named syntaxbias { 1.0f }
+ named syntaxradius { 0.3f }
{
- export "::" @ShowPoints @ShowTags @ShowDirections @CatchTags @Transform
- @Tree @HTree
+ ###########################################################################
+ # #
+ # @Diag symbol #
+ # #
+ ###########################################################################
+
+ export "::" @ShowPoints @ShowTags @ShowDirections @CatchTags @Transform
- @Node
+ @Node @ANode @BNode @CNode
@Box @CurveBox @ShadowBox @Square @Diamond @Polygon
@Isosceles @Ellipse @Circle
@ArrowHead @SolidArrowHead @OpenArrowHead @HalfOpenArrowHead
@@ -273,9 +647,28 @@ def @DiagSetup
@DWrapLine @DWrapArrow @UWrapLine @UWrapArrow
@DWrapCurve @DWrapCurveArrow @UWrapCurve @UWrapCurveArrow
+ @Tree @HTree
+
+ @StartRight @StartUp @StartLeft @StartDown
+ @StartRightRight @StartRightDown
+ @Skip @XCell @ACell @BCell @CCell
+ @Sequence @Select @Optional @OptionalDiverted @Diverted
+ @Loop @LoopOpposite @Repeat @RepeatOpposite @RepeatDiverted
+
def @Diag
named save { save }
named maxlabels { maxlabels }
+ named title { title }
+ named titleformat
+ left @Title
+ right @Body
+ { @Title titleformat @Body }
+
+ #######################################################################
+ # #
+ # @Node options of @Diag #
+ # #
+ #######################################################################
import @Geometry named outline
named margin {}
@@ -332,6 +725,195 @@ def @DiagSetup
named leftmargin { leftmargin }
named rightmargin { rightmargin }
+ #######################################################################
+ # #
+ # @ANode options of @Diag #
+ # #
+ #######################################################################
+
+ import @Geometry named aoutline
+ named margin {}
+ named shadow {}
+ named sides {}
+ named angle {}
+ { aoutline
+ margin { margin }
+ shadow { shadow }
+ sides { sides }
+ angle { angle }
+ }
+ named amargin { amargin }
+ import @Geometry named ashadow { ashadow }
+ import @Geometry named asides { asides }
+ import @Geometry named aangle { aangle }
+ named atranslate { atranslate }
+ named anodetag { }
+ named aoutlinestyle
+ named solid { "/ldiagsolid" }
+ named dashed { "/ldiagdashed" }
+ named cdashed { "/ldiagcdashed" }
+ named dotted { "/ldiagdotted" }
+ named noline { "/ldiagnoline" }
+ { aoutlinestyle }
+ import @Geometry named aoutlinedashlength{ aoutlinedashlength }
+ import @Geometry named aoutlinewidth
+ named thin { 0.04 ft }
+ named medium { 0.08 ft }
+ named thick { 0.12 ft }
+ { aoutlinewidth }
+ named apaint { apaint }
+ named afont { afont }
+ named abreak { abreak }
+ named aformat right @Body { aformat @Body }
+ named avalign { avalign }
+ named avsize { avsize }
+ named avindent { avindent }
+ named avstrut
+ named no { 0.0f }
+ named yes { 1.0f }
+ { avstrut }
+ named avmargin { avmargin }
+ named atopmargin { atopmargin }
+ named afootmargin { afootmargin }
+ named ahalign { ahalign }
+ named ahsize { ahsize }
+ named ahindent { ahindent }
+ named ahstrut
+ named no { 0.0f }
+ named yes { 1.0f }
+ { ahstrut }
+ named ahmargin { ahmargin }
+ named aleftmargin { aleftmargin }
+ named arightmargin { arightmargin }
+
+ #######################################################################
+ # #
+ # @BNode options of @Diag #
+ # #
+ #######################################################################
+
+ import @Geometry named boutline
+ named margin {}
+ named shadow {}
+ named sides {}
+ named angle {}
+ { boutline
+ margin { margin }
+ shadow { shadow }
+ sides { sides }
+ angle { angle }
+ }
+ named bmargin { bmargin }
+ import @Geometry named bshadow { bshadow }
+ import @Geometry named bsides { bsides }
+ import @Geometry named bangle { bangle }
+ named btranslate { btranslate }
+ named bnodetag { }
+ named boutlinestyle
+ named solid { "/ldiagsolid" }
+ named dashed { "/ldiagdashed" }
+ named cdashed { "/ldiagcdashed" }
+ named dotted { "/ldiagdotted" }
+ named noline { "/ldiagnoline" }
+ { boutlinestyle }
+ import @Geometry named boutlinedashlength{ boutlinedashlength }
+ import @Geometry named boutlinewidth
+ named thin { 0.04 ft }
+ named medium { 0.08 ft }
+ named thick { 0.12 ft }
+ { boutlinewidth }
+ named bpaint { bpaint }
+ named bfont { bfont }
+ named bbreak { bbreak }
+ named bformat right @Body { bformat @Body }
+ named bvalign { bvalign }
+ named bvsize { bvsize }
+ named bvindent { bvindent }
+ named bvstrut
+ named no { 0.0f }
+ named yes { 1.0f }
+ { bvstrut }
+ named bvmargin { bvmargin }
+ named btopmargin { btopmargin }
+ named bfootmargin { bfootmargin }
+ named bhalign { bhalign }
+ named bhsize { bhsize }
+ named bhindent { bhindent }
+ named bhstrut
+ named no { 0.0f }
+ named yes { 1.0f }
+ { bhstrut }
+ named bhmargin { bhmargin }
+ named bleftmargin { bleftmargin }
+ named brightmargin { brightmargin }
+
+ #######################################################################
+ # #
+ # @CNode options of @Diag #
+ # #
+ #######################################################################
+
+ import @Geometry named coutline
+ named margin {}
+ named shadow {}
+ named sides {}
+ named angle {}
+ { coutline
+ margin { margin }
+ shadow { shadow }
+ sides { sides }
+ angle { angle }
+ }
+ named cmargin { cmargin }
+ import @Geometry named cshadow { cshadow }
+ import @Geometry named csides { csides }
+ import @Geometry named cangle { cangle }
+ named ctranslate { ctranslate }
+ named cnodetag { }
+ named coutlinestyle
+ named solid { "/ldiagsolid" }
+ named dashed { "/ldiagdashed" }
+ named cdashed { "/ldiagcdashed" }
+ named dotted { "/ldiagdotted" }
+ named noline { "/ldiagnoline" }
+ { coutlinestyle }
+ import @Geometry named coutlinedashlength{ coutlinedashlength }
+ import @Geometry named coutlinewidth
+ named thin { 0.04 ft }
+ named medium { 0.08 ft }
+ named thick { 0.12 ft }
+ { coutlinewidth }
+ named cpaint { cpaint }
+ named cfont { cfont }
+ named cbreak { cbreak }
+ named cformat right @Body { cformat @Body }
+ named cvalign { cvalign }
+ named cvsize { cvsize }
+ named cvindent { cvindent }
+ named cvstrut
+ named no { 0.0f }
+ named yes { 1.0f }
+ { cvstrut }
+ named cvmargin { cvmargin }
+ named ctopmargin { ctopmargin }
+ named cfootmargin { cfootmargin }
+ named chalign { chalign }
+ named chsize { chsize }
+ named chindent { chindent }
+ named chstrut
+ named no { 0.0f }
+ named yes { 1.0f }
+ { chstrut }
+ named chmargin { chmargin }
+ named cleftmargin { cleftmargin }
+ named crightmargin { crightmargin }
+
+ #######################################################################
+ # #
+ # @Link options of @Diag #
+ # #
+ #######################################################################
+
import @Geometry named path
named from {}
named to {}
@@ -513,6 +1095,12 @@ def @DiagSetup
named tolabelctr { tolabelctr }
import @Geometry named tolabeladjust { tolabeladjust }
+ #######################################################################
+ # #
+ # Tree and syntax diagram options of @Diag #
+ # #
+ #######################################################################
+
named treehsep { treehsep }
named treevsep { treevsep }
named treehindent
@@ -525,9 +1113,19 @@ def @DiagSetup
named ctr { 0.5rt }
named foot { 1.0rt }
{ treevindent }
+ named syntaxgap { syntaxgap }
+ named syntaxbias { syntaxbias }
+ named syntaxradius { syntaxradius }
body @Body
@Begin
+
+ #######################################################################
+ # #
+ # Miscellaneous helper definitions #
+ # #
+ #######################################################################
+
# Like @Graphic, but affects the graphics state of right parameter
def @InnerGraphic
left ps
@@ -615,6 +1213,12 @@ def @DiagSetup
}
}
+ def @ShowMarks right x
+ {
+ { "xmark -0.5 cm moveto xmark ysize 0.5 cm add lineto stroke" } @Graphic x
+ }
+
+
def "::"
precedence 33
associativity right
@@ -759,6 +1363,13 @@ def @DiagSetup
}
}
+
+ #######################################################################
+ # #
+ # @DoLabel definition for drawing one label #
+ # #
+ #######################################################################
+
def @DoLabel
named which {}
named labeltag { LABEL }
@@ -1571,9 +2182,14 @@ def @DiagSetup
}
+ #######################################################################
+ # #
+ # @Node #
+ # #
+ #######################################################################
+
def @Node
import @Geometry named translate
-# named to precedence 10 left x right y { x y "ldiagpsub" }
named to precedence 10 left x right y {
@BackEnd @Case {
PostScript @Yield { x y "ldiagpsub" }
@@ -1908,6 +2524,1042 @@ def @DiagSetup
}
}
+
+ #######################################################################
+ # #
+ # @ANode #
+ # #
+ #######################################################################
+
+ def @ANode
+ import @Geometry named translate
+ named to precedence 10 left x right y {
+ @BackEnd @Case {
+ PostScript @Yield { x y "ldiagpsub" }
+ PDF @Yield {""}
+ }
+ }
+ {}
+ import @Geometry named rotate { 0d }
+ import @Geometry named outline
+ named margin {}
+ named shadow {}
+ named sides {}
+ named angle {}
+ { aoutline
+ margin { margin }
+ shadow { shadow }
+ sides { sides }
+ angle { angle }
+ }
+ named margin { amargin }
+ import @Geometry named shadow { ashadow }
+ import @Geometry named sides { asides }
+ import @Geometry named angle { aangle }
+ named nodetag { anodetag }
+ named outlinestyle
+ named solid { "/ldiagsolid" }
+ named dashed { "/ldiagdashed" }
+ named cdashed { "/ldiagcdashed" }
+ named dotted { "/ldiagdotted" }
+ named noline { "/ldiagnoline" }
+ { aoutlinestyle }
+ import @Geometry named outlinedashlength { aoutlinedashlength}
+ import @Geometry named outlinewidth
+ named thin { 0.04 ft }
+ named medium { 0.08 ft }
+ named thick { 0.12 ft }
+ { aoutlinewidth }
+ named paint { apaint }
+ named font { afont }
+ named break { abreak }
+ named format right @Body { aformat @Body }
+ named valign { avalign }
+ named vsize { avsize }
+ named vindent { avindent }
+ named vstrut
+ named no { 0.0f }
+ named yes { 1.0f }
+ { avstrut }
+ named vmargin { avmargin }
+ named topmargin { atopmargin }
+ named footmargin { afootmargin }
+
+ named halign { ahalign }
+ named hsize { ahsize }
+ named hindent { ahindent }
+ named hstrut
+ named no { 0.0f }
+ named yes { 1.0f }
+ { ahstrut }
+ named hmargin { ahmargin }
+ named leftmargin { aleftmargin }
+ named rightmargin { arightmargin }
+
+ named nodelabel { anodelabel }
+ named nodelabelmargin { anodelabelmargin }
+ named nodelabelfont { anodelabelfont }
+ named nodelabelbreak { anodelabelbreak }
+ named nodelabelformat right @Body { anodelabelformat @Body }
+ import @Geometry named nodelabelpos { anodelabelpos }
+ named nodelabelprox { anodelabelprox }
+ import @Geometry named nodelabelangle { anodelabelangle }
+ named nodelabelctr { anodelabelctr }
+ import @Geometry named nodelabeladjust { anodelabeladjust }
+
+ named alabel { aalabel }
+ named alabelmargin { aalabelmargin }
+ named alabelfont { aalabelfont }
+ named alabelbreak { aalabelbreak }
+ named alabelformat right @Body { aalabelformat @Body }
+ import @Geometry named alabelpos { aalabelpos }
+ named alabelprox { aalabelprox }
+ import @Geometry named alabelangle { aalabelangle }
+ named alabelctr { aalabelctr }
+ import @Geometry named alabeladjust { aalabeladjust }
+
+ named blabel { ablabel }
+ named blabelmargin { ablabelmargin }
+ named blabelfont { ablabelfont }
+ named blabelbreak { ablabelbreak }
+ named blabelformat right @Body { ablabelformat @Body }
+ import @Geometry named blabelpos { ablabelpos }
+ named blabelprox { ablabelprox }
+ import @Geometry named blabelangle { ablabelangle }
+ named blabelctr { ablabelctr }
+ import @Geometry named blabeladjust { ablabeladjust }
+
+ named clabel { aclabel }
+ named clabelmargin { aclabelmargin }
+ named clabelfont { aclabelfont }
+ named clabelbreak { aclabelbreak }
+ named clabelformat right @Body { aclabelformat @Body }
+ import @Geometry named clabelpos { aclabelpos }
+ named clabelprox { aclabelprox }
+ import @Geometry named clabelangle { aclabelangle }
+ named clabelctr { aclabelctr }
+ import @Geometry named clabeladjust { aclabeladjust }
+
+ named dlabel { adlabel }
+ named dlabelmargin { adlabelmargin }
+ named dlabelfont { adlabelfont }
+ named dlabelbreak { adlabelbreak }
+ named dlabelformat right @Body { adlabelformat @Body }
+ import @Geometry named dlabelpos { adlabelpos }
+ named dlabelprox { adlabelprox }
+ import @Geometry named dlabelangle { adlabelangle }
+ named dlabelctr { adlabelctr }
+ import @Geometry named dlabeladjust { adlabeladjust }
+
+ right @Body
+ {
+
+ def @LabelPos
+ left x
+ right y
+ {
+ nodelabelpos @Case {
+ x @Yield y
+ else @Yield ""
+ }
+ }
+
+ def @If
+ left cond
+ right x
+ {
+ cond @Case {
+ { yes Yes } @Yield x
+ else @Yield ""
+ }
+ }
+
+
+ def @Strut right x
+ {
+ def vs { 0.5w @VShift { vstrut @High } }
+ def hs { hstrut @Wide }
+
+ @HContract @VContract {
+ @HContract @VContract x | vs / hs |
+ }
+ }
+
+ def @Indent right x
+ {
+ x @Case {
+ { top left } @Yield 0.0rt
+ { ctr } @Yield 0.5rt
+ { foot right } @Yield 1.0rt
+ { mctr } @Yield 0.5bx
+ else @Yield x
+ }
+ }
+
+ def @VSize right x
+ {
+ vsize @Case {
+ "" @Yield x
+ else @Yield { vsize @High { /{@Indent vindent} x / } }
+ }
+ }
+
+ def @HSize right x
+ {
+ hsize @Case {
+ "" @Yield x
+ else @Yield { hsize @Wide { |{@Indent hindent} x | } }
+ }
+ }
+
+ def @Align right x
+ {
+ x @Case {
+ { top left } @Yield 0.0w
+ { ctr } @Yield 0.5w
+ { foot right } @Yield 1.0w
+ { mark } @Yield "+0i"
+ else @Yield x
+ }
+ }
+
+ def @ALabel
+ {
+ @DoLabel
+ which { "a" }
+ label { alabel @Else nodelabel }
+ labelmargin { alabelmargin @Else nodelabelmargin }
+ labelfont { alabelfont @Else nodelabelfont }
+ labelbreak { alabelbreak @Else nodelabelbreak }
+ labelformat { alabelformat @Body @Else nodelabelformat @Body}
+ labelpos { alabelpos @Else nodelabelpos }
+ labelprox { alabelprox @Else nodelabelprox }
+ labelangle { alabelangle @Else nodelabelangle }
+ labelctr { alabelctr @Else nodelabelctr }
+ labeladjust { alabeladjust @Else nodelabeladjust }
+ }
+
+ def @BLabel
+ {
+ @DoLabel
+ which { "b" }
+ label { blabel @Else nodelabel }
+ labelmargin { blabelmargin @Else nodelabelmargin }
+ labelfont { blabelfont @Else nodelabelfont }
+ labelbreak { blabelbreak @Else nodelabelbreak }
+ labelformat { blabelformat @Body @Else nodelabelformat @Body}
+ labelpos { blabelpos @Else nodelabelpos }
+ labelprox { blabelprox @Else nodelabelprox }
+ labelangle { blabelangle @Else nodelabelangle }
+ labelctr { blabelctr @Else nodelabelctr }
+ labeladjust { blabeladjust @Else nodelabeladjust }
+ }
+
+ def @CLabel
+ {
+ @DoLabel
+ which { "c" }
+ label { clabel @Else nodelabel }
+ labelmargin { clabelmargin @Else nodelabelmargin }
+ labelfont { clabelfont @Else nodelabelfont }
+ labelbreak { clabelbreak @Else nodelabelbreak }
+ labelformat { clabelformat @Body @Else nodelabelformat @Body}
+ labelpos { clabelpos @Else nodelabelpos }
+ labelprox { clabelprox @Else nodelabelprox }
+ labelangle { clabelangle @Else nodelabelangle }
+ labelctr { clabelctr @Else nodelabelctr }
+ labeladjust { clabeladjust @Else nodelabeladjust }
+ }
+
+ def @DLabel
+ {
+ @DoLabel
+ which { "d" }
+ label { dlabel @Else nodelabel }
+ labelmargin { dlabelmargin @Else nodelabelmargin }
+ labelfont { dlabelfont @Else nodelabelfont }
+ labelbreak { dlabelbreak @Else nodelabelbreak }
+ labelformat { dlabelformat @Body @Else nodelabelformat @Body}
+ labelpos { dlabelpos @Else nodelabelpos }
+ labelprox { dlabelprox @Else nodelabelprox }
+ labelangle { dlabelangle @Else nodelabelangle }
+ labelctr { dlabelctr @Else nodelabelctr }
+ labeladjust { dlabeladjust @Else nodelabeladjust }
+ }
+
+ import @Geometry
+ def @OutLine
+ {
+ @BackEnd @Case {
+ PostScript @Yield {
+ outline @Case {
+ box @Yield { "ldiagbox" }
+ curvebox @Yield { "("margin") ldiagcurvebox" }
+ shadowbox @Yield { shadow "ldiagshadow ldiagbox" }
+ square @Yield { "ldiagsquare" }
+ diamond @Yield { "ldiagdiamond" }
+ polygon @Yield { sides angle "ldiagpolygon" }
+ isosceles @Yield { "ldiagisosceles" }
+ ellipse @Yield { "ldiagellipse" }
+ circle @Yield { "ldiagcircle" }
+ else @Yield {
+ outline
+ margin { "("margin") ldiagdecodelength" }
+ shadow { shadow }
+ sides { sides }
+ angle { angle }
+ }
+ }
+ }
+ PDF @Yield {}
+ }
+ }
+
+ def @Value
+ {
+ @BackEnd @Case {
+ PostScript @Yield {
+ @HContract @VContract
+ {
+ {
+ "ldiagnodebegin [" @OutLine "]"
+ outlinedashlength "[" outlinestyle "]"
+ outlinewidth "/ldiag"paint "ldiagnodeend"
+ "(IN) ldiagpushtagdict"
+ //
+ "ldiagpopuptagdict"
+ }
+ @Graphic
+ {
+ {@Align valign} @VShift {@Align halign} @HShift
+ @AddMargins
+ mtop { topmargin @Else vmargin @Else margin }
+ mfoot { footmargin @Else vmargin @Else margin }
+ mleft { leftmargin @Else hmargin @Else margin }
+ mright { rightmargin @Else hmargin @Else margin }
+ @HSize @VSize @HContract @VContract
+ font @Font break @Break format @Strut @Body
+ }
+ / {alabel @Else nodelabel} @IfNonEmpty @ALabel
+ / {blabel @Else nodelabel} @IfNonEmpty @BLabel
+ / {clabel @Else nodelabel} @IfNonEmpty @CLabel
+ / {dlabel @Else nodelabel} @IfNonEmpty @DLabel
+ }
+ }
+ PDF @Yield {}
+ }
+ }
+
+ def @TValue
+ {
+ nodetag @Case {
+ "" @Yield @Value
+ else @Yield { nodetag:: @Value }
+ }
+ }
+
+ translate @Case {
+ "" @Yield @TValue
+ else @Yield {
+ @Null & # so that preceding space gets chewed up
+ @Transform translate { translate } rotate { rotate } @TValue
+ }
+ }
+ }
+
+
+ #######################################################################
+ # #
+ # @BNode #
+ # #
+ #######################################################################
+
+ def @BNode
+ import @Geometry named translate
+ named to precedence 10 left x right y {
+ @BackEnd @Case {
+ PostScript @Yield { x y "ldiagpsub" }
+ PDF @Yield {""}
+ }
+ }
+ {}
+ import @Geometry named rotate { 0d }
+ import @Geometry named outline
+ named margin {}
+ named shadow {}
+ named sides {}
+ named angle {}
+ { boutline
+ margin { margin }
+ shadow { shadow }
+ sides { sides }
+ angle { angle }
+ }
+ named margin { bmargin }
+ import @Geometry named shadow { bshadow }
+ import @Geometry named sides { bsides }
+ import @Geometry named angle { bangle }
+ named nodetag { bnodetag }
+ named outlinestyle
+ named solid { "/ldiagsolid" }
+ named dashed { "/ldiagdashed" }
+ named cdashed { "/ldiagcdashed" }
+ named dotted { "/ldiagdotted" }
+ named noline { "/ldiagnoline" }
+ { boutlinestyle }
+ import @Geometry named outlinedashlength { boutlinedashlength}
+ import @Geometry named outlinewidth
+ named thin { 0.04 ft }
+ named medium { 0.08 ft }
+ named thick { 0.12 ft }
+ { boutlinewidth }
+ named paint { bpaint }
+ named font { bfont }
+ named break { bbreak }
+ named format right @Body { bformat @Body }
+ named valign { bvalign }
+ named vsize { bvsize }
+ named vindent { bvindent }
+ named vstrut
+ named no { 0.0f }
+ named yes { 1.0f }
+ { bvstrut }
+ named vmargin { bvmargin }
+ named topmargin { btopmargin }
+ named footmargin { bfootmargin }
+
+ named halign { bhalign }
+ named hsize { bhsize }
+ named hindent { bhindent }
+ named hstrut
+ named no { 0.0f }
+ named yes { 1.0f }
+ { bhstrut }
+ named hmargin { bhmargin }
+ named leftmargin { bleftmargin }
+ named rightmargin { brightmargin }
+
+ named nodelabel { bnodelabel }
+ named nodelabelmargin { bnodelabelmargin }
+ named nodelabelfont { bnodelabelfont }
+ named nodelabelbreak { bnodelabelbreak }
+ named nodelabelformat right @Body { bnodelabelformat @Body }
+ import @Geometry named nodelabelpos { bnodelabelpos }
+ named nodelabelprox { bnodelabelprox }
+ import @Geometry named nodelabelangle { bnodelabelangle }
+ named nodelabelctr { bnodelabelctr }
+ import @Geometry named nodelabeladjust { bnodelabeladjust }
+
+ named alabel { balabel }
+ named alabelmargin { balabelmargin }
+ named alabelfont { balabelfont }
+ named alabelbreak { balabelbreak }
+ named alabelformat right @Body { balabelformat @Body }
+ import @Geometry named alabelpos { balabelpos }
+ named alabelprox { balabelprox }
+ import @Geometry named alabelangle { balabelangle }
+ named alabelctr { balabelctr }
+ import @Geometry named alabeladjust { balabeladjust }
+
+ named blabel { bblabel }
+ named blabelmargin { bblabelmargin }
+ named blabelfont { bblabelfont }
+ named blabelbreak { bblabelbreak }
+ named blabelformat right @Body { bblabelformat @Body }
+ import @Geometry named blabelpos { bblabelpos }
+ named blabelprox { bblabelprox }
+ import @Geometry named blabelangle { bblabelangle }
+ named blabelctr { bblabelctr }
+ import @Geometry named blabeladjust { bblabeladjust }
+
+ named clabel { bclabel }
+ named clabelmargin { bclabelmargin }
+ named clabelfont { bclabelfont }
+ named clabelbreak { bclabelbreak }
+ named clabelformat right @Body { bclabelformat @Body }
+ import @Geometry named clabelpos { bclabelpos }
+ named clabelprox { bclabelprox }
+ import @Geometry named clabelangle { bclabelangle }
+ named clabelctr { bclabelctr }
+ import @Geometry named clabeladjust { bclabeladjust }
+
+ named dlabel { bdlabel }
+ named dlabelmargin { bdlabelmargin }
+ named dlabelfont { bdlabelfont }
+ named dlabelbreak { bdlabelbreak }
+ named dlabelformat right @Body { bdlabelformat @Body }
+ import @Geometry named dlabelpos { bdlabelpos }
+ named dlabelprox { bdlabelprox }
+ import @Geometry named dlabelangle { bdlabelangle }
+ named dlabelctr { bdlabelctr }
+ import @Geometry named dlabeladjust { bdlabeladjust }
+
+ right @Body
+ {
+
+ def @LabelPos
+ left x
+ right y
+ {
+ nodelabelpos @Case {
+ x @Yield y
+ else @Yield ""
+ }
+ }
+
+ def @If
+ left cond
+ right x
+ {
+ cond @Case {
+ { yes Yes } @Yield x
+ else @Yield ""
+ }
+ }
+
+
+ def @Strut right x
+ {
+ def vs { 0.5w @VShift { vstrut @High } }
+ def hs { hstrut @Wide }
+
+ @HContract @VContract {
+ @HContract @VContract x | vs / hs |
+ }
+ }
+
+ def @Indent right x
+ {
+ x @Case {
+ { top left } @Yield 0.0rt
+ { ctr } @Yield 0.5rt
+ { foot right } @Yield 1.0rt
+ { mctr } @Yield 0.5bx
+ else @Yield x
+ }
+ }
+
+ def @VSize right x
+ {
+ vsize @Case {
+ "" @Yield x
+ else @Yield { vsize @High { /{@Indent vindent} x / } }
+ }
+ }
+
+ def @HSize right x
+ {
+ hsize @Case {
+ "" @Yield x
+ else @Yield { hsize @Wide { |{@Indent hindent} x | } }
+ }
+ }
+
+ def @Align right x
+ {
+ x @Case {
+ { top left } @Yield 0.0w
+ { ctr } @Yield 0.5w
+ { foot right } @Yield 1.0w
+ { mark } @Yield "+0i"
+ else @Yield x
+ }
+ }
+
+ def @ALabel
+ {
+ @DoLabel
+ which { "a" }
+ label { alabel @Else nodelabel }
+ labelmargin { alabelmargin @Else nodelabelmargin }
+ labelfont { alabelfont @Else nodelabelfont }
+ labelbreak { alabelbreak @Else nodelabelbreak }
+ labelformat { alabelformat @Body @Else nodelabelformat @Body}
+ labelpos { alabelpos @Else nodelabelpos }
+ labelprox { alabelprox @Else nodelabelprox }
+ labelangle { alabelangle @Else nodelabelangle }
+ labelctr { alabelctr @Else nodelabelctr }
+ labeladjust { alabeladjust @Else nodelabeladjust }
+ }
+
+ def @BLabel
+ {
+ @DoLabel
+ which { "b" }
+ label { blabel @Else nodelabel }
+ labelmargin { blabelmargin @Else nodelabelmargin }
+ labelfont { blabelfont @Else nodelabelfont }
+ labelbreak { blabelbreak @Else nodelabelbreak }
+ labelformat { blabelformat @Body @Else nodelabelformat @Body}
+ labelpos { blabelpos @Else nodelabelpos }
+ labelprox { blabelprox @Else nodelabelprox }
+ labelangle { blabelangle @Else nodelabelangle }
+ labelctr { blabelctr @Else nodelabelctr }
+ labeladjust { blabeladjust @Else nodelabeladjust }
+ }
+
+ def @CLabel
+ {
+ @DoLabel
+ which { "c" }
+ label { clabel @Else nodelabel }
+ labelmargin { clabelmargin @Else nodelabelmargin }
+ labelfont { clabelfont @Else nodelabelfont }
+ labelbreak { clabelbreak @Else nodelabelbreak }
+ labelformat { clabelformat @Body @Else nodelabelformat @Body}
+ labelpos { clabelpos @Else nodelabelpos }
+ labelprox { clabelprox @Else nodelabelprox }
+ labelangle { clabelangle @Else nodelabelangle }
+ labelctr { clabelctr @Else nodelabelctr }
+ labeladjust { clabeladjust @Else nodelabeladjust }
+ }
+
+ def @DLabel
+ {
+ @DoLabel
+ which { "d" }
+ label { dlabel @Else nodelabel }
+ labelmargin { dlabelmargin @Else nodelabelmargin }
+ labelfont { dlabelfont @Else nodelabelfont }
+ labelbreak { dlabelbreak @Else nodelabelbreak }
+ labelformat { dlabelformat @Body @Else nodelabelformat @Body}
+ labelpos { dlabelpos @Else nodelabelpos }
+ labelprox { dlabelprox @Else nodelabelprox }
+ labelangle { dlabelangle @Else nodelabelangle }
+ labelctr { dlabelctr @Else nodelabelctr }
+ labeladjust { dlabeladjust @Else nodelabeladjust }
+ }
+
+ import @Geometry
+ def @OutLine
+ {
+ @BackEnd @Case {
+ PostScript @Yield {
+ outline @Case {
+ box @Yield { "ldiagbox" }
+ curvebox @Yield { "("margin") ldiagcurvebox" }
+ shadowbox @Yield { shadow "ldiagshadow ldiagbox" }
+ square @Yield { "ldiagsquare" }
+ diamond @Yield { "ldiagdiamond" }
+ polygon @Yield { sides angle "ldiagpolygon" }
+ isosceles @Yield { "ldiagisosceles" }
+ ellipse @Yield { "ldiagellipse" }
+ circle @Yield { "ldiagcircle" }
+ else @Yield {
+ outline
+ margin { "("margin") ldiagdecodelength" }
+ shadow { shadow }
+ sides { sides }
+ angle { angle }
+ }
+ }
+ }
+ PDF @Yield {}
+ }
+ }
+
+ def @Value
+ {
+ @BackEnd @Case {
+ PostScript @Yield {
+ @HContract @VContract
+ {
+ {
+ "ldiagnodebegin [" @OutLine "]"
+ outlinedashlength "[" outlinestyle "]"
+ outlinewidth "/ldiag"paint "ldiagnodeend"
+ "(IN) ldiagpushtagdict"
+ //
+ "ldiagpopuptagdict"
+ }
+ @Graphic
+ {
+ {@Align valign} @VShift {@Align halign} @HShift
+ @AddMargins
+ mtop { topmargin @Else vmargin @Else margin }
+ mfoot { footmargin @Else vmargin @Else margin }
+ mleft { leftmargin @Else hmargin @Else margin }
+ mright { rightmargin @Else hmargin @Else margin }
+ @HSize @VSize @HContract @VContract
+ font @Font break @Break format @Strut @Body
+ }
+ / {alabel @Else nodelabel} @IfNonEmpty @ALabel
+ / {blabel @Else nodelabel} @IfNonEmpty @BLabel
+ / {clabel @Else nodelabel} @IfNonEmpty @CLabel
+ / {dlabel @Else nodelabel} @IfNonEmpty @DLabel
+ }
+ }
+ PDF @Yield {}
+ }
+ }
+
+ def @TValue
+ {
+ nodetag @Case {
+ "" @Yield @Value
+ else @Yield { nodetag:: @Value }
+ }
+ }
+
+ translate @Case {
+ "" @Yield @TValue
+ else @Yield {
+ @Null & # so that preceding space gets chewed up
+ @Transform translate { translate } rotate { rotate } @TValue
+ }
+ }
+ }
+
+
+ #######################################################################
+ # #
+ # @CNode #
+ # #
+ #######################################################################
+
+ def @CNode
+ import @Geometry named translate
+ named to precedence 10 left x right y {
+ @BackEnd @Case {
+ PostScript @Yield { x y "ldiagpsub" }
+ PDF @Yield {""}
+ }
+ }
+ {}
+ import @Geometry named rotate { 0d }
+ import @Geometry named outline
+ named margin {}
+ named shadow {}
+ named sides {}
+ named angle {}
+ { coutline
+ margin { margin }
+ shadow { shadow }
+ sides { sides }
+ angle { angle }
+ }
+ named margin { cmargin }
+ import @Geometry named shadow { cshadow }
+ import @Geometry named sides { csides }
+ import @Geometry named angle { cangle }
+ named nodetag { cnodetag }
+ named outlinestyle
+ named solid { "/ldiagsolid" }
+ named dashed { "/ldiagdashed" }
+ named cdashed { "/ldiagcdashed" }
+ named dotted { "/ldiagdotted" }
+ named noline { "/ldiagnoline" }
+ { coutlinestyle }
+ import @Geometry named outlinedashlength { coutlinedashlength}
+ import @Geometry named outlinewidth
+ named thin { 0.04 ft }
+ named medium { 0.08 ft }
+ named thick { 0.12 ft }
+ { coutlinewidth }
+ named paint { cpaint }
+ named font { cfont }
+ named break { cbreak }
+ named format right @Body { cformat @Body }
+ named valign { cvalign }
+ named vsize { cvsize }
+ named vindent { cvindent }
+ named vstrut
+ named no { 0.0f }
+ named yes { 1.0f }
+ { cvstrut }
+ named vmargin { cvmargin }
+ named topmargin { ctopmargin }
+ named footmargin { cfootmargin }
+
+ named halign { chalign }
+ named hsize { chsize }
+ named hindent { chindent }
+ named hstrut
+ named no { 0.0f }
+ named yes { 1.0f }
+ { chstrut }
+ named hmargin { chmargin }
+ named leftmargin { cleftmargin }
+ named rightmargin { crightmargin }
+
+ named nodelabel { cnodelabel }
+ named nodelabelmargin { cnodelabelmargin }
+ named nodelabelfont { cnodelabelfont }
+ named nodelabelbreak { cnodelabelbreak }
+ named nodelabelformat right @Body { cnodelabelformat @Body }
+ import @Geometry named nodelabelpos { cnodelabelpos }
+ named nodelabelprox { cnodelabelprox }
+ import @Geometry named nodelabelangle { cnodelabelangle }
+ named nodelabelctr { cnodelabelctr }
+ import @Geometry named nodelabeladjust { cnodelabeladjust }
+
+ named alabel { calabel }
+ named alabelmargin { calabelmargin }
+ named alabelfont { calabelfont }
+ named alabelbreak { calabelbreak }
+ named alabelformat right @Body { calabelformat @Body }
+ import @Geometry named alabelpos { calabelpos }
+ named alabelprox { calabelprox }
+ import @Geometry named alabelangle { calabelangle }
+ named alabelctr { calabelctr }
+ import @Geometry named alabeladjust { calabeladjust }
+
+ named blabel { cblabel }
+ named blabelmargin { cblabelmargin }
+ named blabelfont { cblabelfont }
+ named blabelbreak { cblabelbreak }
+ named blabelformat right @Body { cblabelformat @Body }
+ import @Geometry named blabelpos { cblabelpos }
+ named blabelprox { cblabelprox }
+ import @Geometry named blabelangle { cblabelangle }
+ named blabelctr { cblabelctr }
+ import @Geometry named blabeladjust { cblabeladjust }
+
+ named clabel { cclabel }
+ named clabelmargin { cclabelmargin }
+ named clabelfont { cclabelfont }
+ named clabelbreak { cclabelbreak }
+ named clabelformat right @Body { cclabelformat @Body }
+ import @Geometry named clabelpos { cclabelpos }
+ named clabelprox { cclabelprox }
+ import @Geometry named clabelangle { cclabelangle }
+ named clabelctr { cclabelctr }
+ import @Geometry named clabeladjust { cclabeladjust }
+
+ named dlabel { cdlabel }
+ named dlabelmargin { cdlabelmargin }
+ named dlabelfont { cdlabelfont }
+ named dlabelbreak { cdlabelbreak }
+ named dlabelformat right @Body { cdlabelformat @Body }
+ import @Geometry named dlabelpos { cdlabelpos }
+ named dlabelprox { cdlabelprox }
+ import @Geometry named dlabelangle { cdlabelangle }
+ named dlabelctr { cdlabelctr }
+ import @Geometry named dlabeladjust { cdlabeladjust }
+
+ right @Body
+ {
+
+ def @LabelPos
+ left x
+ right y
+ {
+ nodelabelpos @Case {
+ x @Yield y
+ else @Yield ""
+ }
+ }
+
+ def @If
+ left cond
+ right x
+ {
+ cond @Case {
+ { yes Yes } @Yield x
+ else @Yield ""
+ }
+ }
+
+
+ def @Strut right x
+ {
+ def vs { 0.5w @VShift { vstrut @High } }
+ def hs { hstrut @Wide }
+
+ @HContract @VContract {
+ @HContract @VContract x | vs / hs |
+ }
+ }
+
+ def @Indent right x
+ {
+ x @Case {
+ { top left } @Yield 0.0rt
+ { ctr } @Yield 0.5rt
+ { foot right } @Yield 1.0rt
+ { mctr } @Yield 0.5bx
+ else @Yield x
+ }
+ }
+
+ def @VSize right x
+ {
+ vsize @Case {
+ "" @Yield x
+ else @Yield { vsize @High { /{@Indent vindent} x / } }
+ }
+ }
+
+ def @HSize right x
+ {
+ hsize @Case {
+ "" @Yield x
+ else @Yield { hsize @Wide { |{@Indent hindent} x | } }
+ }
+ }
+
+ def @Align right x
+ {
+ x @Case {
+ { top left } @Yield 0.0w
+ { ctr } @Yield 0.5w
+ { foot right } @Yield 1.0w
+ { mark } @Yield "+0i"
+ else @Yield x
+ }
+ }
+
+ def @ALabel
+ {
+ @DoLabel
+ which { "a" }
+ label { alabel @Else nodelabel }
+ labelmargin { alabelmargin @Else nodelabelmargin }
+ labelfont { alabelfont @Else nodelabelfont }
+ labelbreak { alabelbreak @Else nodelabelbreak }
+ labelformat { alabelformat @Body @Else nodelabelformat @Body}
+ labelpos { alabelpos @Else nodelabelpos }
+ labelprox { alabelprox @Else nodelabelprox }
+ labelangle { alabelangle @Else nodelabelangle }
+ labelctr { alabelctr @Else nodelabelctr }
+ labeladjust { alabeladjust @Else nodelabeladjust }
+ }
+
+ def @BLabel
+ {
+ @DoLabel
+ which { "b" }
+ label { blabel @Else nodelabel }
+ labelmargin { blabelmargin @Else nodelabelmargin }
+ labelfont { blabelfont @Else nodelabelfont }
+ labelbreak { blabelbreak @Else nodelabelbreak }
+ labelformat { blabelformat @Body @Else nodelabelformat @Body}
+ labelpos { blabelpos @Else nodelabelpos }
+ labelprox { blabelprox @Else nodelabelprox }
+ labelangle { blabelangle @Else nodelabelangle }
+ labelctr { blabelctr @Else nodelabelctr }
+ labeladjust { blabeladjust @Else nodelabeladjust }
+ }
+
+ def @CLabel
+ {
+ @DoLabel
+ which { "c" }
+ label { clabel @Else nodelabel }
+ labelmargin { clabelmargin @Else nodelabelmargin }
+ labelfont { clabelfont @Else nodelabelfont }
+ labelbreak { clabelbreak @Else nodelabelbreak }
+ labelformat { clabelformat @Body @Else nodelabelformat @Body}
+ labelpos { clabelpos @Else nodelabelpos }
+ labelprox { clabelprox @Else nodelabelprox }
+ labelangle { clabelangle @Else nodelabelangle }
+ labelctr { clabelctr @Else nodelabelctr }
+ labeladjust { clabeladjust @Else nodelabeladjust }
+ }
+
+ def @DLabel
+ {
+ @DoLabel
+ which { "d" }
+ label { dlabel @Else nodelabel }
+ labelmargin { dlabelmargin @Else nodelabelmargin }
+ labelfont { dlabelfont @Else nodelabelfont }
+ labelbreak { dlabelbreak @Else nodelabelbreak }
+ labelformat { dlabelformat @Body @Else nodelabelformat @Body}
+ labelpos { dlabelpos @Else nodelabelpos }
+ labelprox { dlabelprox @Else nodelabelprox }
+ labelangle { dlabelangle @Else nodelabelangle }
+ labelctr { dlabelctr @Else nodelabelctr }
+ labeladjust { dlabeladjust @Else nodelabeladjust }
+ }
+
+ import @Geometry
+ def @OutLine
+ {
+ @BackEnd @Case {
+ PostScript @Yield {
+ outline @Case {
+ box @Yield { "ldiagbox" }
+ curvebox @Yield { "("margin") ldiagcurvebox" }
+ shadowbox @Yield { shadow "ldiagshadow ldiagbox" }
+ square @Yield { "ldiagsquare" }
+ diamond @Yield { "ldiagdiamond" }
+ polygon @Yield { sides angle "ldiagpolygon" }
+ isosceles @Yield { "ldiagisosceles" }
+ ellipse @Yield { "ldiagellipse" }
+ circle @Yield { "ldiagcircle" }
+ else @Yield {
+ outline
+ margin { "("margin") ldiagdecodelength" }
+ shadow { shadow }
+ sides { sides }
+ angle { angle }
+ }
+ }
+ }
+ PDF @Yield {}
+ }
+ }
+
+ def @Value
+ {
+ @BackEnd @Case {
+ PostScript @Yield {
+ @HContract @VContract
+ {
+ {
+ "ldiagnodebegin [" @OutLine "]"
+ outlinedashlength "[" outlinestyle "]"
+ outlinewidth "/ldiag"paint "ldiagnodeend"
+ "(IN) ldiagpushtagdict"
+ //
+ "ldiagpopuptagdict"
+ }
+ @Graphic
+ {
+ {@Align valign} @VShift {@Align halign} @HShift
+ @AddMargins
+ mtop { topmargin @Else vmargin @Else margin }
+ mfoot { footmargin @Else vmargin @Else margin }
+ mleft { leftmargin @Else hmargin @Else margin }
+ mright { rightmargin @Else hmargin @Else margin }
+ @HSize @VSize @HContract @VContract
+ font @Font break @Break format @Strut @Body
+ }
+ / {alabel @Else nodelabel} @IfNonEmpty @ALabel
+ / {blabel @Else nodelabel} @IfNonEmpty @BLabel
+ / {clabel @Else nodelabel} @IfNonEmpty @CLabel
+ / {dlabel @Else nodelabel} @IfNonEmpty @DLabel
+ }
+ }
+ PDF @Yield {}
+ }
+ }
+
+ def @TValue
+ {
+ nodetag @Case {
+ "" @Yield @Value
+ else @Yield { nodetag:: @Value }
+ }
+ }
+
+ translate @Case {
+ "" @Yield @TValue
+ else @Yield {
+ @Null & # so that preceding space gets chewed up
+ @Transform translate { translate } rotate { rotate } @TValue
+ }
+ }
+ }
+
+
+ #######################################################################
+ # #
+ # @Box, @CurveBox, and other standard node abbreviations #
+ # #
+ #######################################################################
+
macro @@Node { @Node }
macro @Box { @Node outline { box } }
macro @CurveBox { @Node outline { curvebox } }
@@ -1920,6 +3572,12 @@ def @DiagSetup
macro @Circle { @Node outline { circle } }
+ #######################################################################
+ # #
+ # Arrowheads #
+ # #
+ #######################################################################
+
macro @InsulatedNode {
@Node
topmargin { 0i }
@@ -2202,6 +3860,13 @@ def @DiagSetup
}
}
+
+ #######################################################################
+ # #
+ # @Link #
+ # #
+ #######################################################################
+
def @Link
import @Geometry named path
named from {}
@@ -3575,6 +5240,13 @@ def @DiagSetup
}
}
+
+ #######################################################################
+ # #
+ # Abbreviations for standard link types #
+ # #
+ #######################################################################
+
macro @Line { @Link path { line } }
macro @DoubleLine { @Link path { doubleline } }
macro @Arrow { @Link path { line } arrow { yes } }
@@ -3616,6 +5288,13 @@ def @DiagSetup
macro @UWrapCurve { @Link path {uwrapcurve} }
macro @UWrapCurveArrow { @Link path {uwrapcurve} arrow { yes } }
+
+ #######################################################################
+ # #
+ # Tree code. #
+ # #
+ #######################################################################
+
export
@Node @Box @CurveBox @ShadowBox @Square @Diamond
@@ -3828,18 +5507,953 @@ def @DiagSetup
@HContract @VContract x
}
- @BackEnd @Case {
- PostScript @Yield {
- {
- save @Case { { yes Yes } @Yield "grestore save gsave" else @Yield {} }
- maxlabels "ldiagbegin"
- //
- "ldiagend"
- save @Case { { yes Yes } @Yield "restore" else @Yield {} }
- } @Graphic @Body
- }
- PDF @Yield {}
+
+ #######################################################################
+ # #
+ # Syntax diagrams code #
+ # #
+ # Helper definitions; also skips #
+ # #
+ #######################################################################
+
+ def pslength right x { "("x") ldiagdecodelength" }
+ def pssyntaxgap { "("syntaxgap") ldiagdecodelength" }
+ def pssyntaxbias { "("syntaxbias") ldiagdecodelength" }
+ def pssyntaxradius { "("syntaxradius") ldiagdecodelength" }
+
+ def @ArrowLeftFrom left direction right pt
+ {
+ @Line arrow { direction } from { pt } to { pt -- { pssyntaxgap 0 } }
+ }
+
+ def @ArrowRightFrom left direction right pt
+ {
+ @Line arrow { direction } from { pt } to { pt ++ { pssyntaxgap 0 } }
+ }
+
+ def @ArrowUpFrom left direction right pt
+ {
+ @Line arrow { direction } from { pt } to { pt ++ { 0 pssyntaxgap } }
+ }
+
+ def @ArrowDownFrom left direction right pt
+ {
+ @Line arrow { direction } from { pt } to { pt -- { 0 pssyntaxgap } }
+ }
+
+ macro @LineLeftFrom { no @ArrowLeftFrom }
+ macro @LineRightFrom { no @ArrowRightFrom }
+ macro @LineUpFrom { no @ArrowUpFrom }
+ macro @LineDownFrom { no @ArrowDownFrom }
+
+ macro @Right { "1p" }
+ macro @Up { "2p" }
+ macro @Left { "3p" }
+ macro @Down { "4p" }
+
+ macro @CurrDirection { @CurrZUnit }
+
+ def @GoRight right x { @Right @ZUnit x }
+ def @GoUp right x { @Up @ZUnit x }
+ def @GoLeft right x { @Left @ZUnit x }
+ def @GoDown right x { @Down @ZUnit x }
+
+ def @GoReverse right x
+ {
+ @CurrDirection @Case {
+ @Right @Yield @GoLeft x
+ @Up @Yield @GoDown x
+ @Left @Yield @GoRight x
+ @Down @Yield @GoUp x
+ }
+ }
+
+
+ def @LabelMarks right x {
+ @HContract @VContract @ANode
+ outline {
+ NMK:: { xmark ysize }
+ SMK:: { xmark 0 }
+ WMK:: { 0 ymark }
+ EMK:: { xsize ymark }
+ NW:: { 0 ysize }
+ SW:: { 0 0 }
+ SE:: { xsize 0 }
+ NE:: { xsize ysize }
+ }
+ font {}
+ margin { 0c }
+ vstrut { no }
+ outlinestyle { noline }
+ halign { mark }
+ valign { mark }
+ x
+ }
+
+ def @HSkip
+ {
+ OX:: @LabelMarks { syntaxgap @Wide {} }
+ / @Line from { "OX@WMK" } to { "OX@EMK" }
+ }
+
+ def @VSkip
+ {
+ OX:: @LabelMarks { syntaxgap @High {} }
+ / @Line from { "OX@NMK" } to { "OX@SMK" }
+ }
+
+ def @Skip
+ {
+ @CurrDirection @Case {
+ { @Left @Right } @Yield @HSkip
+ { @Up @Down } @Yield @VSkip
+ }
+ }
+
+ def @LRLine right x
+ {
+ @HContract @VContract { @HSkip | x | @HSkip }
+ }
+
+ def @UDLine right x
+ {
+ @HContract @VContract { @VSkip / x / @VSkip }
+ }
+
+
+ #######################################################################
+ # #
+ # Ordinary starts: @StartRight, @StartUp, @StartLeft, @StartDown #
+ # #
+ #######################################################################
+
+ def @StartRight right x
+ {
+ @VContract {
+ @LabelMarks {
+ |syntaxgap @GoRight x |syntaxgap
+ }
+ / @LineRightFrom WMK
+ / back @ArrowLeftFrom EMK
+ }
+ }
+
+ def @StartUp right x
+ {
+ @VContract {
+ @LabelMarks {
+ ^/syntaxgap @GoUp x /syntaxgap
+ }
+ / @LineUpFrom SMK
+ / back @ArrowDownFrom NMK
+ }
+ }
+
+ def @StartLeft right x
+ {
+ @VContract {
+ @LabelMarks {
+ |syntaxgap @GoLeft x |syntaxgap
+ }
+ / @LineLeftFrom EMK
+ / back @ArrowRightFrom WMK
+ }
+ }
+
+ def @StartDown right x
+ {
+ @VContract {
+ @LabelMarks {
+ ^/syntaxgap @GoDown x /syntaxgap
+ }
+ / @LineDownFrom NMK
+ / back @ArrowUpFrom SMK
+ }
+ }
+
+
+ #######################################################################
+ # #
+ # Fancy starts: @StartRightRight, @StartRightDown #
+ # #
+ #######################################################################
+
+ def @StartRightRight
+ named A {}
+ named B {}
+ {
+ AA:: @LabelMarks { @HSkip & @GoRight A }
+ //syntaxgap
+ //syntaxgap
+ |syntaxgap |syntaxgap |syntaxgap |syntaxgap |syntaxgap |syntaxgap
+ CC:: @LabelMarks {}
+ //syntaxgap
+ //syntaxgap
+ |syntaxgap |syntaxgap |syntaxgap |syntaxgap |syntaxgap |syntaxgap
+ BB:: @LabelMarks { @GoRight B & @HSkip }
+ // @RVLCurve from { AA@EMK } to { CC@WMK }
+ bias { pssyntaxbias } radius { pssyntaxradius }
+ // @LVRCurve from { CC@WMK } to { BB@WMK }
+ bias { pssyntaxbias } radius { pssyntaxradius }
+ back @ArrowLeftFrom BB@EMK
+ }
+
+ def @StartRightDown
+ named A {}
+ named B {}
+ {
+ @HContract @VContract {
+ / BB:: @LabelMarks |syntaxgap AA::@LabelMarks @GoRight A |syntaxbias
+ /syntaxgap | |
+ /syntaxgap | |
+ }
+ / @Line from { BB@EMK } to { AA@WMK }
+ / @RVLCurve from { AA@EMK } to { xcoord AA@EMK pssyntaxgap }
+ bias { pssyntaxbias } radius { pssyntaxradius }
+ / @HVCurve from { xcoord AA@EMK pssyntaxgap } to { 0 0 }
+ bias { pssyntaxbias } radius { pssyntaxradius }
+ / @GoDown B
+ / @VSkip
+ / CC:: @LabelMarks {}
+ / back @ArrowUpFrom CC@NMK
+ }
+
+
+ #######################################################################
+ # #
+ # Cells: @XCell, @ACell, @BCell, @CCell #
+ # #
+ #######################################################################
+
+ def @RightCell right x
+ {
+ @VContract {
+ @LabelMarks {
+ |syntaxgap x |syntaxgap
+ }
+ / forward @ArrowRightFrom WMK
+ / @LineLeftFrom EMK
+ }
+ }
+
+ def @LeftCell right x
+ {
+ @VContract {
+ @LabelMarks {
+ |syntaxgap x |syntaxgap
+ }
+ / forward @ArrowLeftFrom EMK
+ / @LineRightFrom WMK
+ }
+ }
+
+ def @DownCell right x
+ {
+ @VContract {
+ @LabelMarks {
+ ^/syntaxgap x /syntaxgap
+ }
+ / forward @ArrowDownFrom NMK
+ / @LineUpFrom SMK
+ }
+ }
+
+ def @UpCell right x
+ {
+ @VContract {
+ @LabelMarks {
+ ^/syntaxgap x /syntaxgap
+ }
+ / forward @ArrowUpFrom SMK
+ / @LineDownFrom NMK
+ }
+ }
+
+ def @XCell right x
+ {
+ @CurrDirection @Case {
+ @Right @Yield @RightCell x
+ @Up @Yield @UpCell x
+ @Left @Yield @LeftCell x
+ @Down @Yield @DownCell x
+ }
+ }
+
+ macro @ACell { @XCell @ANode }
+ macro @BCell { @XCell @BNode }
+ macro @CCell { @XCell @CNode }
+
+
+ #######################################################################
+ # #
+ # @Sequence #
+ # #
+ #######################################################################
+
+ def @Sequence
+ named A {}
+ named B {}
+ named C {}
+ named D {}
+ named E {}
+ named F {}
+ named G {}
+ named H {}
+ named I {}
+ named J {}
+ named K {}
+ named L {}
+ {
+
+ @CurrDirection @Case {
+ @Right @Yield
+ @HContract { A | B | C | D | E | F | G | H | I | J | K | L }
+ @Up @Yield
+ @VContract { L / K / J / I / H / G / F / E / D / C / B / A }
+ @Left @Yield
+ @HContract { L | K | J | I | H | G | F | E | D | C | B | A }
+ @Down @Yield
+ @VContract { A / B / C / D / E / F / G / H / I / J / K / L }
+ }
+ }
+
+
+ #######################################################################
+ # #
+ # @Select and @Optional #
+ # #
+ #######################################################################
+
+ def @Select
+ named A {}
+ named B {}
+ named C {}
+ named D {}
+ named E {}
+ named F {}
+ named G {}
+ named H {}
+ named I {}
+ named J {}
+ named K {}
+ named L {}
+ {
+
+ def @RLFirstOrMiddle
+ left label
+ named i { 0i }
+ named al { no }
+ named ar { no }
+ right x
+ {
+ {|i @HContract { |syntaxgap label:: @LabelMarks x |syntaxgap }}
+ // @Line from { label"@WMK" } to { 0 ycoord label"@WMK" }
+ arrow { al }
+ // @Line from { label"@EMK" } to { xsize ycoord label"@EMK" }
+ arrow { ar }
+ }
+
+ def @UDFirstOrMiddle
+ left label
+ named i { 0i }
+ named au { no }
+ named ad { no }
+ right x
+ {
+ {/i @VContract { /syntaxgap label:: @LabelMarks x /syntaxgap }}
+ || @Line from { label"@NMK" } to { xcoord label"@NMK" ysize }
+ arrow { au }
+ || @Line from { label"@SMK" } to { xcoord label"@SMK" 0 }
+ arrow { ad }
+ }
+
+ def @RLLast
+ left label
+ named i { 0i }
+ named al { no }
+ named ar { no }
+ right x
+ {
+ {|i @HContract { |syntaxgap label:: @LabelMarks x |syntaxgap }}
+ // @HVCurve from { label"@WMK" } to { 0 ycoord "AX@WMK" }
+ arrow { al } bias { pssyntaxbias } radius { pssyntaxradius }
+ // @HVCurve from { label"@EMK" } to { xsize ycoord "AX@WMK" }
+ arrow { ar } bias { pssyntaxbias } radius { pssyntaxradius }
+ }
+
+ def @UDLast
+ left label
+ named i { 0i }
+ named au { no }
+ named ad { no }
+ right x
+ {
+ {/i @VContract { /syntaxgap label:: @LabelMarks x /syntaxgap }}
+ || @VHCurve from { label"@NMK" } to { xcoord "AX@NMK" ysize }
+ arrow { au } bias { pssyntaxbias } radius { pssyntaxradius }
+ || @VHCurve from { label"@SMK" } to { xcoord "AX@SMK" 0 }
+ arrow { ad } bias { pssyntaxbias } radius { pssyntaxradius }
+ }
+
+ def @DirectedSelect
+ named @First left label right x {}
+ named @Middle left label right x {}
+ named @Last left label right x {}
+ named @Join precedence 90 left x right y {}
+ {
+
+ def @LastIsA
+ {
+ A
+ }
+
+ def @LastIsB
+ {
+ AX @First A
+ @Join BX @Last B
+ }
+
+ def @LastIsC
+ {
+ AX @First A
+ @Join BX @Middle B
+ @Join CX @Last C
+ }
+
+ def @LastIsD
+ {
+ AX @First A
+ @Join BX @Middle B
+ @Join CX @Middle C
+ @Join DX @Last D
+ }
+
+ def @LastIsE
+ {
+ AX @First A
+ @Join BX @Middle B
+ @Join CX @Middle C
+ @Join DX @Middle D
+ @Join EX @Last E
+ }
+
+ def @LastIsF
+ {
+ AX @First A
+ @Join BX @Middle B
+ @Join CX @Middle C
+ @Join DX @Middle D
+ @Join EX @Middle E
+ @Join FX @Last F
+ }
+
+ def @UpToF
+ {
+ AX @First A
+ @Join BX @Middle B
+ @Join CX @Middle C
+ @Join DX @Middle D
+ @Join EX @Middle E
+ @Join FX @Middle F
+ }
+
+ def @LastIsG
+ {
+ @UpToF
+ @Join GX @Last G
+ }
+
+ def @LastIsH
+ {
+ @UpToF
+ @Join GX @Middle G
+ @Join HX @Last H
+ }
+
+ def @LastIsI
+ {
+ @UpToF
+ @Join GX @Middle G
+ @Join HX @Middle H
+ @Join IX @Last I
+ }
+
+ def @LastIsJ
+ {
+ @UpToF
+ @Join GX @Middle G
+ @Join HX @Middle H
+ @Join IX @Middle I
+ @Join JX @Last J
+ }
+
+ def @LastIsK
+ {
+ @UpToF
+ @Join GX @Middle G
+ @Join HX @Middle H
+ @Join IX @Middle I
+ @Join JX @Middle J
+ @Join KX @Last K
+ }
+
+ def @LastIsL
+ {
+ @UpToF
+ @Join GX @Middle G
+ @Join HX @Middle H
+ @Join IX @Middle I
+ @Join JX @Middle J
+ @Join KX @Middle K
+ @Join LX @Last L
+ }
+
+ def @TryA { A @Case { {} @Yield @Skip else @Yield @LastIsA } }
+ def @TryB { B @Case { {} @Yield @TryA else @Yield @LastIsB } }
+ def @TryC { C @Case { {} @Yield @TryB else @Yield @LastIsC } }
+ def @TryD { D @Case { {} @Yield @TryC else @Yield @LastIsD } }
+ def @TryE { E @Case { {} @Yield @TryD else @Yield @LastIsE } }
+ def @TryF { F @Case { {} @Yield @TryE else @Yield @LastIsF } }
+ def @TryG { G @Case { {} @Yield @TryF else @Yield @LastIsG } }
+ def @TryH { H @Case { {} @Yield @TryG else @Yield @LastIsH } }
+ def @TryI { I @Case { {} @Yield @TryH else @Yield @LastIsI } }
+ def @TryJ { J @Case { {} @Yield @TryI else @Yield @LastIsJ } }
+ def @TryK { K @Case { {} @Yield @TryJ else @Yield @LastIsK } }
+ def @TryL { L @Case { {} @Yield @TryK else @Yield @LastIsL } }
+
+ @TryL
+ }
+
+ def @RightSelect
+ {
+ @LRLine @DirectedSelect
+ @First { label @RLFirstOrMiddle x }
+ @Middle { label @RLFirstOrMiddle ar { yes } x }
+ @Last { label @RLLast ar { yes } x }
+ @Join { x //syntaxgap y }
+ }
+
+ def @UpSelect
+ {
+ @UDLine @DirectedSelect
+ @First { label @UDFirstOrMiddle i { 1r } x }
+ @Middle { label @UDFirstOrMiddle i { 1r } au { yes } x }
+ @Last { label @UDLast i { 1r } au { yes } x }
+ @Join { x ||syntaxgap y }
+ }
+
+ def @LeftSelect
+ {
+ @LRLine @DirectedSelect
+ @First { label @RLFirstOrMiddle i { 1r } x }
+ @Middle { label @RLFirstOrMiddle i { 1r } al { yes } x }
+ @Last { label @RLLast i { 1r } al { yes } x }
+ @Join { x //syntaxgap y }
+ }
+
+ def @DownSelect
+ {
+ @UDLine @DirectedSelect
+ @First { label @UDFirstOrMiddle x }
+ @Middle { label @UDFirstOrMiddle ad { yes } x }
+ @Last { label @UDLast ad { yes } x }
+ @Join { x ||syntaxgap y }
+ }
+
+ @CurrDirection @Case {
+ @Right @Yield @RightSelect
+ @Up @Yield @UpSelect
+ @Left @Yield @LeftSelect
+ @Down @Yield @DownSelect
+ }
+ }
+
+
+ def @Optional right x
+ {
+ @Select A { @Skip } B { x }
+ }
+
+
+ #######################################################################
+ # #
+ # @OptionalDiverted #
+ # #
+ #######################################################################
+
+ def @DownRightOptionalDiverted right x
+ {
+ @UDLine {
+ OX:: @LabelMarks {
+ |syntaxgap AX:: @LabelMarks @GoRight x |syntaxbias
+ /syntaxgap
+ }
+ / @Line from { "OX@NW" } to { "OX@SW" }
+ / @Line from { "OX@WMK" } to { "OX@IN@AX@WMK" }
+ / @RVLCurveArrow from { "OX@IN@AX@EMK" } to { "OX@SW" }
+ bias { pssyntaxbias } radius { pssyntaxradius }
+ }
+ }
+
+ def @UpRightOptionalDiverted right x
+ {
+ @UDLine {
+ OX:: @LabelMarks {
+ ^/syntaxgap
+ |syntaxgap AX:: @LabelMarks @GoRight x |syntaxbias
+ }
+ / @Line from { "OX@NW" } to { "OX@SW" }
+ / @Line from { "OX@WMK" } to { "OX@IN@AX@WMK" }
+ / @RVLCurveArrow from { "OX@IN@AX@EMK" } to { "OX@NW" }
+ bias { pssyntaxbias } radius { pssyntaxradius }
+ }
+ }
+
+ def @RightDownOptionalDiverted right x
+ {
+ @LRLine {
+ OX:: @LabelMarks {
+ { /syntaxgap AX:: @LabelMarks @GoDown x /syntaxbias }
+ |syntaxgap
+ }
+ / @Line from { "OX@NW" } to { "OX@NE" }
+ / @Line from { "OX@NMK" } to { "OX@IN@AX@NMK" }
+ / @VHCurve from {"OX@IN@AX@SMK"} to { "OX@SE"--{pssyntaxgap 0} }
+ bias { pssyntaxbias } radius { pssyntaxradius }
+ / @HVCurve from { "OX@SE" -- {pssyntaxgap 0} } to { "OX@NE" }
+ arrow { yes } bias { pssyntaxbias } radius { pssyntaxradius }
+ }
+ }
+
+ def @LeftDownOptionalDiverted right x
+ {
+ @LRLine {
+ OX:: @LabelMarks {
+ ^|syntaxgap
+ { /syntaxgap AX:: @LabelMarks @GoDown x /syntaxbias }
+ }
+ / @Line from { "OX@NW" } to { "OX@NE" }
+ / @Line from { "OX@NMK" } to { "OX@IN@AX@NMK" }
+ / @VHCurve from {"OX@IN@AX@SMK"} to { "OX@SW"++{pssyntaxgap 0} }
+ bias { pssyntaxbias } radius { pssyntaxradius }
+ / @HVCurve from { "OX@SW" ++ {pssyntaxgap 0} } to { "OX@NW" }
+ arrow { yes } bias { pssyntaxbias } radius { pssyntaxradius }
+ }
+ }
+
+ def @OptionalDiverted right x
+ {
+ @CurrDirection @Case {
+ @Right @Yield @RightDownOptionalDiverted x
+ @Up @Yield @UpRightOptionalDiverted x
+ @Left @Yield @LeftDownOptionalDiverted x
+ @Down @Yield @DownRightOptionalDiverted x
+ }
+ }
+
+
+ #######################################################################
+ # #
+ # @Diverted #
+ # #
+ #######################################################################
+
+ def @DownRightDiverted right x
+ {
+ @UDLine {
+ OX:: @LabelMarks {
+ |syntaxgap AX:: @LabelMarks @GoRight x |syntaxbias
+ ^/syntaxgap
+ /syntaxgap
+ }
+ / @VHCurve from { "OX@NW" } to { "OX@IN@AX@WMK" }
+ bias { pssyntaxbias } radius { pssyntaxradius }
+ / @RVLCurve from { "OX@IN@AX@EMK" }
+ to { xcoord "OX@IN@AX@WMK" ycoord "OX@EMK" }
+ bias { pssyntaxbias } radius { pssyntaxradius }
+ / @HVCurve from { xcoord "OX@IN@AX@WMK" ycoord "OX@EMK" }
+ to { "OX@SW" } bias { pssyntaxbias } radius {pssyntaxradius}
+ }
+ }
+
+ def @UpRightDiverted right x
+ {
+ @UDLine {
+ OX:: @LabelMarks {
+ ^/syntaxgap
+ /syntaxgap
+ |syntaxgap AX:: @LabelMarks @GoRight x |syntaxbias
+ }
+ / @VHCurve from { "OX@SW" } to { "OX@IN@AX@WMK" }
+ bias { pssyntaxbias } radius { pssyntaxradius }
+ / @RVLCurve from { "OX@IN@AX@EMK" }
+ to { xcoord "OX@IN@AX@WMK" ycoord "OX@EMK" }
+ bias { pssyntaxbias } radius { pssyntaxradius }
+ / @HVCurve from { xcoord "OX@IN@AX@WMK" ycoord "OX@EMK" }
+ to { "OX@NW" } bias { pssyntaxbias } radius {pssyntaxradius}
+ }
+ }
+
+ def @RightDownDiverted right x
+ {
+ @LRLine {
+ OX:: @LabelMarks {
+ { /syntaxgap AX:: @LabelMarks @GoDown x /syntaxbias }
+ ^|syntaxgap
+ |syntaxgap
+ }
+ / @HVCurve from { "OX@NW" } to { "OX@IN@AX@NMK" }
+ bias { pssyntaxbias } radius { pssyntaxradius }
+ / @VHCurve from { "OX@IN@AX@SMK" }
+ to { xcoord "OX@IN@AX@EMK" ycoord "OX@SMK" }
+ bias { pssyntaxbias } radius { pssyntaxradius }
+ / @HVCurve from { xcoord "OX@IN@AX@EMK" ycoord "OX@SMK" }
+ to { "OX@IN@AX@EMK" ++ { pssyntaxgap 0 } }
+ bias { pssyntaxbias } radius {pssyntaxradius}
+ / @VHCurve from { "OX@IN@AX@EMK" ++ { pssyntaxgap 0 } }
+ to { "OX@NE" } bias { pssyntaxbias } radius {pssyntaxradius}
+ }
+ }
+
+ def @LeftDownDiverted right x
+ {
+ @LRLine {
+ OX:: @LabelMarks {
+ |syntaxgap
+ ^|syntaxgap
+ { /syntaxgap AX:: @LabelMarks @GoDown x /syntaxbias }
+ }
+ / @HVCurve from { "OX@NE" } to { "OX@IN@AX@NMK" }
+ bias { pssyntaxbias } radius { pssyntaxradius }
+ / @VHCurve from { "OX@IN@AX@SMK" }
+ to { xcoord "OX@IN@AX@WMK" ycoord "OX@SMK" }
+ bias { pssyntaxbias } radius { pssyntaxradius }
+ / @HVCurve from { xcoord "OX@IN@AX@WMK" ycoord "OX@SMK" }
+ to { "OX@IN@AX@WMK" -- { pssyntaxgap 0 } }
+ bias { pssyntaxbias } radius {pssyntaxradius}
+ / @VHCurve from { "OX@IN@AX@WMK" -- { pssyntaxgap 0 } }
+ to { "OX@NW" } bias { pssyntaxbias } radius {pssyntaxradius}
+ }
+ }
+
+ def @Diverted right x
+ {
+ @CurrDirection @Case {
+ @Right @Yield @RightDownDiverted x
+ @Up @Yield @UpRightDiverted x
+ @Left @Yield @LeftDownDiverted x
+ @Down @Yield @DownRightDiverted x
+ }
+ }
+
+
+ #######################################################################
+ # #
+ # @RepeatDiverted #
+ # #
+ #######################################################################
+
+ def @RepeatDiverted right x
+ {
+ # this implementation exploits the coincidental similarity
+ # of @RepeatDiverted to @OptionalDiverted
+
+ @CurrDirection @Case {
+ @Right @Yield @LeftDownOptionalDiverted x
+ @Up @Yield @DownRightOptionalDiverted x
+ @Left @Yield @RightDownOptionalDiverted x
+ @Down @Yield @UpRightOptionalDiverted x
+ }
+ }
+
+
+
+ #######################################################################
+ # #
+ # @Loop and @Repeat #
+ # #
+ #######################################################################
+
+ def @Loop
+ named A {}
+ named B {}
+ {
+ def @LeftOrRightLoop
+ named al { no }
+ named ar { no }
+ {
+ @LRLine {
+ @HContract @VContract { OX:: @LabelMarks {
+ { |syntaxgap AX:: @LabelMarks A |syntaxgap }
+ //syntaxgap
+ { |0.5rt BX:: @LabelMarks @GoReverse B |syntaxgap }
+ } }
+ / @Line from { "OX@WMK" } to { "OX@IN@AX@WMK" }
+ / @Line from { "OX@EMK" } to { "OX@IN@AX@EMK" }
+ / @HVCurve from { "OX@IN@BX@EMK" } to { "OX@EMK" }
+ arrow { ar } bias {pssyntaxbias} radius {pssyntaxradius}
+ / @HVCurve from { "OX@IN@BX@WMK" } to { "OX@WMK" }
+ arrow { al } bias {pssyntaxbias} radius {pssyntaxradius}
+ }
+ }
+
+ def @UpOrDownLoop
+ named au { no }
+ named ad { no }
+ {
+ @UDLine {
+ @HContract @VContract { OX:: @LabelMarks {
+ { /syntaxgap AX:: @LabelMarks A /syntaxgap }
+ ||syntaxgap
+ { /0.5rt BX:: @LabelMarks @GoReverse B /syntaxgap }
+ } }
+ / @Line from { "OX@NMK" } to { "OX@IN@AX@NMK" }
+ / @Line from { "OX@SMK" } to { "OX@IN@AX@SMK" }
+ / @VHCurve from { "OX@IN@BX@NMK" } to { "OX@NMK" }
+ arrow { au } bias {pssyntaxbias} radius {pssyntaxradius}
+ / @VHCurve from { "OX@IN@BX@SMK" } to { "OX@SMK" }
+ arrow { ad } bias {pssyntaxbias} radius {pssyntaxradius}
+ }
+ }
+
+ @CurrDirection @Case {
+ @Right @Yield @LeftOrRightLoop al { yes }
+ @Up @Yield @UpOrDownLoop ad { yes }
+ @Left @Yield @LeftOrRightLoop ar { yes }
+ @Down @Yield @UpOrDownLoop au { yes }
+ }
+ }
+
+ def @Repeat right x
+ {
+ @Loop
+ A { x }
+ B { @Skip }
+ }
+
+
+ #######################################################################
+ # #
+ # @LoopOpposite and @RepeatOpposite #
+ # #
+ #######################################################################
+
+ def @LoopOpposite
+ named A {}
+ named B {}
+ {
+ def @LeftOrRightLoopOpposite
+ named al { no }
+ named ar { no }
+ {
+ @LRLine {
+ @HContract @VContract { OX:: @LabelMarks {
+ { |0.5rt BX:: @LabelMarks @GoReverse B |syntaxgap }
+ ^//syntaxgap
+ { |syntaxgap AX:: @LabelMarks A |syntaxgap }
+ } }
+ / @Line from { "OX@WMK" } to { "OX@IN@AX@WMK" }
+ / @Line from { "OX@EMK" } to { "OX@IN@AX@EMK" }
+ / @HVCurve from { "OX@IN@BX@EMK" } to { "OX@EMK" }
+ arrow { ar } bias {pssyntaxbias} radius {pssyntaxradius}
+ / @HVCurve from { "OX@IN@BX@WMK" } to { "OX@WMK" }
+ arrow { al } bias {pssyntaxbias} radius {pssyntaxradius}
+ }
+ }
+
+ def @UpOrDownLoopOpposite
+ named au { no }
+ named ad { no }
+ {
+ @UDLine {
+ @HContract @VContract { OX:: @LabelMarks {
+ { /0.5rt BX:: @LabelMarks @GoReverse B /syntaxgap }
+ ^||syntaxgap
+ { /syntaxgap AX:: @LabelMarks A /syntaxgap }
+ } }
+ / @Line from { "OX@NMK" } to { "OX@IN@AX@NMK" }
+ / @Line from { "OX@SMK" } to { "OX@IN@AX@SMK" }
+ / @VHCurve from { "OX@IN@BX@NMK" } to { "OX@NMK" }
+ arrow { au } bias {pssyntaxbias} radius {pssyntaxradius}
+ / @VHCurve from { "OX@IN@BX@SMK" } to { "OX@SMK" }
+ arrow { ad } bias {pssyntaxbias} radius {pssyntaxradius}
+ }
+ }
+
+ @CurrDirection @Case {
+ @Right @Yield @LeftOrRightLoopOpposite al { yes }
+ @Up @Yield @UpOrDownLoopOpposite ad { yes }
+ @Left @Yield @LeftOrRightLoopOpposite ar { yes }
+ @Down @Yield @UpOrDownLoopOpposite au { yes }
+ }
+ }
+
+ def @RepeatOpposite right x
+ {
+ @LoopOpposite
+ A { x }
+ B { @Skip }
+ }
+
+
+ #######################################################################
+ # #
+ # Value of whole diagram #
+ # #
+ #######################################################################
+
+ def @DiagValue right x
+ {
+ @BackEnd @Case {
+ PostScript @Yield {
+ {
+ save @Case {
+ { yes Yes } @Yield "grestore save gsave"
+ else @Yield {}
+ }
+ maxlabels "ldiagbegin"
+ //
+ "ldiagend"
+ save @Case {
+ { yes Yes } @Yield "restore"
+ else @Yield {}
+ }
+ } @Graphic x }
+
+ PDF @Yield {}
+ }
+ }
+
+ title @Case {
+
+ "--titledft--" @Yield @DiagValue @Body
+
+ else @Yield { title titleformat @DiagValue @Body }
}
@End @Diag
+
+
+ macro @SyntaxDiag {
+ @Diag
+ avalign { mark }
+ avstrut { yes }
+ amargin { 0.2f }
+ aoutline { box }
+ afont { Italic }
+
+ bvalign { mark }
+ bvstrut { yes }
+ bmargin { 0.2f }
+ boutline { curvebox }
+ bfont { Bold }
+
+ cvalign { mark }
+ cvstrut { yes }
+ cmargin { 0.2f }
+ coutline { circle }
+ chsize { 1f }
+
+ arrowlength { 0.4f }
+ }
}
generated by cgit (git 2.34.1) at 2024-11-08 20:37:29 +0000