diff options
author | Jeffrey H. Kingston <jeff@it.usyd.edu.au> | 2010-09-14 19:35:24 +0000 |
---|---|---|
committer | Jeffrey H. Kingston <jeff@it.usyd.edu.au> | 2010-09-14 19:35:24 +0000 |
commit | d4b68bb27f42afb8338f35f9fda0c467ec5d8787 (patch) | |
tree | 26e8947ef0a82e8150e46ebd0b257ec5cd13c0ed /include/diagf | |
parent | 2c0ebbabd66ba21d3224bf58678bf62998b94c2c (diff) | |
download | lout-d4b68bb27f42afb8338f35f9fda0c467ec5d8787.tar.gz |
Lout 3.18.
git-svn-id: http://svn.savannah.nongnu.org/svn/lout/trunk@5 9365b830-b601-4143-9ba8-b4a8e2c3339c
Diffstat (limited to 'include/diagf')
-rw-r--r-- | include/diagf | 2648 |
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 } + } } |