diff options
author | Jeffrey H. Kingston <jeff@it.usyd.edu.au> | 2010-09-14 19:21:41 +0000 |
---|---|---|
committer | Jeffrey H. Kingston <jeff@it.usyd.edu.au> | 2010-09-14 19:21:41 +0000 |
commit | 71bdb35d52747e6d7d9f55df4524d57c2966be94 (patch) | |
tree | 480ee5eefccc40d5f3331cc52d66f722fd19bfb9 /include/diagf | |
parent | b41263ea7578fa9742486135c762803b52794105 (diff) | |
download | lout-71bdb35d52747e6d7d9f55df4524d57c2966be94.tar.gz |
Lout 3.17.
git-svn-id: http://svn.savannah.nongnu.org/svn/lout/trunk@2 9365b830-b601-4143-9ba8-b4a8e2c3339c
Diffstat (limited to 'include/diagf')
-rw-r--r-- | include/diagf | 3845 |
1 files changed, 3845 insertions, 0 deletions
diff --git a/include/diagf b/include/diagf new file mode 100644 index 0000000..18b888a --- /dev/null +++ b/include/diagf @@ -0,0 +1,3845 @@ + +############################################################################### +# # +# Lout @Diag package for drawing diagrams # +# Version 1.0 (July 1996) # +# Jeffrey H. Kingston # +# # +# Based on Version 2.0 of the @Fig package (Jeffrey H. Kingston, Dec 1992). # +# # +############################################################################### + +@SysPrependGraphic { diagf.lpg } +@SysInclude { diagf.etc } + +export @Diag +def @DiagSetup + named save { no } + named maxlabels { 200 } + + import @Geometry named outline + named margin {} + named shadow {} + named sides {} + named angle {} + { box } + named margin { 0.6f } + import @Geometry named shadow { 0.4f } + import @Geometry named sides { 3 } + import @Geometry named angle { "dup 180 exch div" } + named translate { } + named outlinestyle + named solid { "/ldiagsolid" } + named dashed { "/ldiagdashed" } + named cdashed { "/ldiagcdashed" } + named dotted { "/ldiagdotted" } + named noline { "/ldiagnoline" } + { solid } + import @Geometry named outlinedashlength { 0.2f } + import @Geometry named outlinewidth + named thin { 0.04 ft } + named medium { 0.08 ft } + named thick { 0.12 ft } + { thin } + named paint { nopaint } + named font { } + named break { } + named format right @Body { @Body } + + named valign { ctr } + named vsize { } + named vindent { ctr } + named vstrut + named no { 0.0f } + named yes { 1.0f } + { no } + named vmargin { } + named topmargin { } + named footmargin { } + + named halign { ctr } + named hsize { } + named hindent { ctr } + named hstrut + named no { 0.0f } + named yes { 1.0f } + { no } + named hmargin { } + named leftmargin { } + named rightmargin { } + + named nodelabel { } + named nodelabelmargin { 0.2f } + named nodelabelfont { -2p } + named nodelabelbreak { ragged nohyphen } + named nodelabelformat right @Body { @Body } + import @Geometry named nodelabelpos { } + named nodelabelprox { outside } + import @Geometry named nodelabelangle { horizontal } + named nodelabelctr { no } + import @Geometry named nodelabeladjust { 0 0 } + + named alabel { } + named alabelmargin { } + named alabelfont { } + named alabelbreak { } + named alabelformat right @Body { } + import @Geometry named alabelpos { NE } + named alabelprox { } + import @Geometry named alabelangle { } + named alabelctr { } + import @Geometry named alabeladjust { } + + named blabel { } + named blabelmargin { } + named blabelfont { } + named blabelbreak { } + named blabelformat right @Body { } + import @Geometry named blabelpos { NW } + named blabelprox { } + import @Geometry named blabelangle { } + named blabelctr { } + import @Geometry named blabeladjust { } + + named clabel { } + named clabelmargin { } + named clabelfont { } + named clabelbreak { } + named clabelformat right @Body { } + import @Geometry named clabelpos { SW } + named clabelprox { } + import @Geometry named clabelangle { } + named clabelctr { } + import @Geometry named clabeladjust { } + + named dlabel { } + named dlabelmargin { } + named dlabelfont { } + named dlabelbreak { } + named dlabelformat right @Body { } + import @Geometry named dlabelpos { SE } + named dlabelprox { } + import @Geometry named dlabelangle { } + named dlabelctr { } + import @Geometry named dlabeladjust { } + + import @Geometry named path + named from {} + named to {} + named bias {} + named fbias {} + named tbias {} + named radius {} + named xindent {} + named zindent {} + named frompt {} + named topt {} + named arrow {} + named arrowlength {} + { line } + import @Geometry named from { 0,0 } + import @Geometry named to { 1,1 } + import @Geometry named bias { 2.0f } + import @Geometry named fbias { 2.0f } + import @Geometry named tbias { 2.0f } + import @Geometry named radius { 1.0f } + import @Geometry named xindent { 0.8f } + import @Geometry named zindent { 0.8f } + import @Geometry named frompt { 0 0 } + import @Geometry named topt { 0 0 } + named pathstyle + named solid { "/ldiagsolid" } + named dashed { "/ldiagdashed" } + named cdashed { "/ldiagcdashed" } + named dotted { "/ldiagdotted" } + named noline { "/ldiagnoline" } + { solid } + import @Geometry named pathdashlength { 0.2f } + import @Geometry named pathwidth + named thin { 0.04 ft } + named medium { 0.08 ft } + named thick { 0.12 ft } + { thin } + import @Geometry named pathgap + named thin { 0.08 ft } + named medium { 0.16 ft } + named thick { 0.24 ft } + { thin } + named arrow { no } + named arrowstyle { solid } + named arrowwidth { 0.3f } + named arrowlength { 0.5f } + + named linklabel { } + named linklabelmargin { 0.2f } + named linklabelfont { -2p } + named linklabelbreak { ragged nohyphen } + named linklabelformat right @Body { @Body } + import @Geometry named linklabelpos { } + named linklabelprox { above } + import @Geometry named linklabelangle { horizontal } + named linklabelctr { no } + import @Geometry named linklabeladjust { 0 0 } + + named xlabel { } + named xlabelmargin { } + named xlabelfont { } + named xlabelbreak { } + named xlabelformat right @Body { } + import @Geometry named xlabelpos { LFROM } + named xlabelprox { } + import @Geometry named xlabelangle { } + named xlabelctr { } + import @Geometry named xlabeladjust { } + + named ylabel { } + named ylabelmargin { } + named ylabelfont { } + named ylabelbreak { } + named ylabelformat right @Body { } + import @Geometry named ylabelpos { LMID } + named ylabelprox { } + import @Geometry named ylabelangle { } + named ylabelctr { yes } + import @Geometry named ylabeladjust { } + + named zlabel { } + named zlabelmargin { } + named zlabelfont { } + named zlabelbreak { } + named zlabelformat right @Body { } + import @Geometry named zlabelpos { LTO } + named zlabelprox { } + import @Geometry named zlabelangle { } + named zlabelctr { } + import @Geometry named zlabeladjust { } + + named fromlabel { } + named fromlabelmargin { 0f } + named fromlabelfont { } + named fromlabelbreak { ragged nohyphen } + named fromlabelformat right @Body { @Body } + import @Geometry named fromlabelpos { FROM } + named fromlabelprox { W } + import @Geometry named fromlabelangle { antiparallel } + named fromlabelctr { no } + import @Geometry named fromlabeladjust { 0 0 } + + named tolabel { } + named tolabelmargin { 0f } + named tolabelfont { } + named tolabelbreak { ragged nohyphen } + named tolabelformat right @Body { @Body } + import @Geometry named tolabelpos { TO } + named tolabelprox { W } + import @Geometry named tolabelangle { parallel } + named tolabelctr { no } + import @Geometry named tolabeladjust { 0 0 } + + named treehsep { 0.5f } + named treevsep { 0.5f } + named treehindent + named left { 0.0rt } + named ctr { 0.5rt } + named right { 1.0rt } + { ctr } + named treevindent + named top { 0.0rt } + named ctr { 0.5rt } + named foot { 1.0rt } + { ctr } + +{ + + export "::" @ShowPoints @ShowTags @ShowDirections @CatchTags @Transform + + @Tree @HTree + + @Node + @Box @CurveBox @ShadowBox @Square @Diamond @Polygon + @Isosceles @Ellipse @Circle + @ArrowHead @SolidArrowHead @OpenArrowHead @HalfOpenArrowHead + @SolidCurvedArrowHead @OpenCurvedArrowHead @HalfOpenCurvedArrowHead + @CircleArrowHead @BoxArrowHead + + @Link + @Line @DoubleLine @Arrow @DoubleArrow @Curve @CurveArrow + @ACurve @ACurveArrow @CCurve @CCurveArrow + @Bezier @BezierArrow + @HVLine @HVArrow @VHLine @VHArrow + @HVCurve @HVCurveArrow @VHCurve @VHCurveArrow + @LVRLine @LVRArrow @RVLLine @RVLArrow + @LVRCurve @LVRCurveArrow @RVLCurve @RVLCurveArrow + @DWrapLine @DWrapArrow @UWrapLine @UWrapArrow + @DWrapCurve @DWrapCurveArrow @UWrapCurve @UWrapCurveArrow + + def @Diag + named save { save } + named maxlabels { maxlabels } + + import @Geometry named outline + named margin {} + named shadow {} + named sides {} + named angle {} + { outline + margin { margin } + shadow { shadow } + sides { sides } + angle { angle } + } + named margin { margin } + import @Geometry named shadow { shadow } + import @Geometry named sides { sides } + import @Geometry named angle { angle } + named translate { translate } + named nodetag { } + named outlinestyle + named solid { "/ldiagsolid" } + named dashed { "/ldiagdashed" } + named cdashed { "/ldiagcdashed" } + named dotted { "/ldiagdotted" } + named noline { "/ldiagnoline" } + { outlinestyle } + import @Geometry named outlinedashlength{ outlinedashlength } + import @Geometry named outlinewidth + named thin { 0.04 ft } + named medium { 0.08 ft } + named thick { 0.12 ft } + { outlinewidth } + named paint { paint } + named font { font } + named break { break } + named format right @Body { format @Body } + named valign { valign } + named vsize { vsize } + named vindent { vindent } + named vstrut + named no { 0.0f } + named yes { 1.0f } + { vstrut } + named vmargin { vmargin } + named topmargin { topmargin } + named footmargin { footmargin } + named halign { halign } + named hsize { hsize } + named hindent { hindent } + named hstrut + named no { 0.0f } + named yes { 1.0f } + { hstrut } + named hmargin { hmargin } + named leftmargin { leftmargin } + named rightmargin { rightmargin } + + import @Geometry named path + named from {} + named to {} + named bias {} + named fbias {} + named tbias {} + named radius {} + named xindent {} + named zindent {} + named frompt {} + named topt {} + named arrow {} + named arrowlength {} + { path + from { from } + to { to } + bias { bias } + fbias { fbias } + tbias { tbias } + radius { radius } + xindent { xindent } + zindent { zindent } + frompt { frompt } + topt { topt } + arrow { arrow } + arrowlength { arrowlength } + } + import @Geometry named from { from } + import @Geometry named to { to } + import @Geometry named bias { bias } + import @Geometry named fbias { fbias } + import @Geometry named tbias { tbias } + import @Geometry named radius { radius } + import @Geometry named xindent { xindent } + import @Geometry named zindent { zindent } + import @Geometry named frompt { frompt } + import @Geometry named topt { topt } + named pathstyle + named solid { "/ldiagsolid" } + named dashed { "/ldiagdashed" } + named cdashed { "/ldiagcdashed" } + named dotted { "/ldiagdotted" } + named noline { "/ldiagnoline" } + { pathstyle } + import @Geometry named pathdashlength { pathdashlength } + import @Geometry named pathwidth + named thin { 0.04 ft } + named medium { 0.08 ft } + named thick { 0.12 ft } + { pathwidth } + import @Geometry named pathgap + named thin { 0.08 ft } + named medium { 0.16 ft } + named thick { 0.24 ft } + { pathgap } + named arrow { arrow } + named arrowstyle { arrowstyle } + named arrowwidth { arrowwidth } + named arrowlength { arrowlength } + + named nodelabel { nodelabel } + named nodelabelmargin { nodelabelmargin } + named nodelabelfont { nodelabelfont } + named nodelabelbreak { nodelabelbreak } + named nodelabelformat right @Body { nodelabelformat @Body } + import @Geometry named nodelabelpos { nodelabelpos } + named nodelabelprox { nodelabelprox } + import @Geometry named nodelabelangle { nodelabelangle } + named nodelabelctr { nodelabelctr } + import @Geometry named nodelabeladjust { nodelabeladjust } + + named alabel { alabel } + named alabelmargin { alabelmargin } + named alabelfont { alabelfont } + named alabelbreak { alabelbreak } + named alabelformat right @Body { alabelformat @Body } + import @Geometry named alabelpos { alabelpos } + named alabelprox { alabelprox } + import @Geometry named alabelangle { alabelangle } + named alabelctr { alabelctr } + import @Geometry named alabeladjust { alabeladjust } + + named blabel { blabel } + named blabelmargin { blabelmargin } + named blabelfont { blabelfont } + named blabelbreak { blabelbreak } + named blabelformat right @Body { blabelformat @Body } + import @Geometry named blabelpos { blabelpos } + named blabelprox { blabelprox } + import @Geometry named blabelangle { blabelangle } + named blabelctr { blabelctr } + import @Geometry named blabeladjust { blabeladjust } + + named clabel { clabel } + named clabelmargin { clabelmargin } + named clabelfont { clabelfont } + named clabelbreak { clabelbreak } + named clabelformat right @Body { clabelformat @Body } + import @Geometry named clabelpos { clabelpos } + named clabelprox { clabelprox } + import @Geometry named clabelangle { clabelangle } + named clabelctr { clabelctr } + import @Geometry named clabeladjust { clabeladjust } + + named dlabel { dlabel } + named dlabelmargin { dlabelmargin } + named dlabelfont { dlabelfont } + named dlabelbreak { dlabelbreak } + named dlabelformat right @Body { dlabelformat @Body } + import @Geometry named dlabelpos { dlabelpos } + named dlabelprox { dlabelprox } + import @Geometry named dlabelangle { dlabelangle } + named dlabelctr { dlabelctr } + import @Geometry named dlabeladjust { dlabeladjust } + + named fromlabel { fromlabel } + named fromlabelmargin { fromlabelmargin } + named fromlabelfont { fromlabelfont } + named fromlabelbreak { fromlabelbreak } + named fromlabelformat right @Body { fromlabelformat @Body } + import @Geometry named fromlabelpos { fromlabelpos } + named fromlabelprox { fromlabelprox } + import @Geometry named fromlabelangle { fromlabelangle } + named fromlabelctr { fromlabelctr } + import @Geometry named fromlabeladjust { fromlabeladjust } + + named linklabel { linklabel } + named linklabelmargin { linklabelmargin } + named linklabelfont { linklabelfont } + named linklabelbreak { linklabelbreak } + named linklabelformat right @Body { linklabelformat @Body } + import @Geometry named linklabelpos { linklabelpos } + named linklabelprox { linklabelprox } + import @Geometry named linklabelangle { linklabelangle } + named linklabelctr { linklabelctr } + import @Geometry named linklabeladjust { linklabeladjust } + + named xlabel { xlabel } + named xlabelmargin { xlabelmargin } + named xlabelfont { xlabelfont } + named xlabelbreak { xlabelbreak } + named xlabelformat right @Body { xlabelformat @Body } + import @Geometry named xlabelpos { xlabelpos } + named xlabelprox { xlabelprox } + import @Geometry named xlabelangle { xlabelangle } + named xlabelctr { xlabelctr } + import @Geometry named xlabeladjust { xlabeladjust } + + named ylabel { ylabel } + named ylabelmargin { ylabelmargin } + named ylabelfont { ylabelfont } + named ylabelbreak { ylabelbreak } + named ylabelformat right @Body { ylabelformat @Body } + import @Geometry named ylabelpos { ylabelpos } + named ylabelprox { ylabelprox } + import @Geometry named ylabelangle { ylabelangle } + named ylabelctr { ylabelctr } + import @Geometry named ylabeladjust { ylabeladjust } + + named zlabel { zlabel } + named zlabelmargin { zlabelmargin } + named zlabelfont { zlabelfont } + named zlabelbreak { zlabelbreak } + named zlabelformat right @Body { zlabelformat @Body } + import @Geometry named zlabelpos { zlabelpos } + named zlabelprox { zlabelprox } + import @Geometry named zlabelangle { zlabelangle } + named zlabelctr { zlabelctr } + import @Geometry named zlabeladjust { zlabeladjust } + + named tolabel { tolabel } + named tolabelmargin { tolabelmargin } + named tolabelfont { tolabelfont } + named tolabelbreak { tolabelbreak } + named tolabelformat right @Body { tolabelformat @Body } + import @Geometry named tolabelpos { tolabelpos } + named tolabelprox { tolabelprox } + import @Geometry named tolabelangle { tolabelangle } + named tolabelctr { tolabelctr } + import @Geometry named tolabeladjust { tolabeladjust } + + named treehsep { treehsep } + named treevsep { treevsep } + named treehindent + named left { 0.0rt } + named ctr { 0.5rt } + named right { 1.0rt } + { treehindent } + named treevindent + named top { 0.0rt } + named ctr { 0.5rt } + named foot { 1.0rt } + { treevindent } + body @Body + @Begin + + # Like @Graphic, but affects the graphics state of right parameter + def @InnerGraphic + left ps + right x + { + @BackEnd @Case { + PostScript @Yield { + { ps gsave // grestore } @Graphic x + } + PDF @Yield { + { ps q // Q } @Graphic x + } + } + } + + def @BoxLabels right x + { + @BackEnd @Case { + PostScript @Yield { + "[ ldiagbox ] pop" @Graphic x + } + PDF @Yield {} + } + } + + def @IfNonEmpty + left x + right y + { + x @Case { + "" @Yield @Null + else @Yield y + } + } + + def @Else + precedence 20 + associativity right + left x + right y + { + x @Case { + "" @Yield y + else @Yield x + } + } + + def @ShowTags + right x + { + @BackEnd @Case { + PostScript @Yield { + { + "() ldiagpushtagdict" + // "ldiagshowtags ldiagpopuptagdict" + } @Graphic x + } + PDF @Yield {} + } + } + + def @ShowPoints + right x + { + @BackEnd @Case { + PostScript @Yield { + { + "() ldiagpushtagdict" + // "ldiagshowpoints ldiagpopuptagdict" + } @Graphic x + } + PDF @Yield {} + } + } + + def @ShowDirections + right x + { + @BackEnd @Case { + PostScript @Yield { + { "() ldiagpushtagdict" + // "ldiagshowangles ldiagpopuptagdict" } @Graphic x + } + PDF @Yield {} + } + } + + def "::" + precedence 33 + associativity right + left name + right x + { + @BackEnd @Case { + PostScript @Yield { + { "("name") ldiagpushtagdict" + // "ldiagpopuptagdict" } @Graphic x + } + PDF @Yield {} + } + } + + def @CatchTags + precedence 33 + associativity right + right x + { + @BackEnd @Case { + PostScript @Yield { + { + "() ldiagpushtagdict" + // "ldiagpoptagdict" + } + @Graphic x + } + PDF @Yield {} + } + } + + def @ZeroWidth right x + { + @HContract @VContract { + ^|0io @HContract @VContract x |0io + } + } + + def @ZeroSize right x + { + @HContract @VContract { + ^/0io ^|0io @HContract @VContract x |0io /0io + } + } + + def @FromArrowLength + left arrow + right arrowlength + { + @BackEnd @Case { + PostScript @Yield { + arrow @Case { + { no yes forward } @Yield 0 + { back both } @Yield {"("arrowlength") ldiagdecodelength"} + } + } + PDF @Yield {} + } + } + + def @ToArrowLength + left arrow + right arrowlength + { + @BackEnd @Case { + PostScript @Yield { + arrow @Case { + { no back } @Yield 0 + { yes forward both } @Yield {"("arrowlength") ldiagdecodelength"} + } + } + PDF @Yield {} + } + } + + def @AddMargins + named mtop {} + named mfoot {} + named mleft {} + named mright {} + right x + { + + @HContract @VContract { + ^|mleft |mright + ^/mtop | x | + /mfoot | | + } + } + + def @Transform + precedence 32 + 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" } + PDF @Yield {""} + } + } + {} + import @Geometry named rotate { 0d } + named scale { 1 1 } + right x + { + @BackEnd @Case { + + PostScript @Yield { + { rotate "rotate" scale "scale newpath clip" } + @InnerGraphic + { + @ZeroSize x + } + // + # { rotate "rotate" scale "scale" translate "translate" } + { translate "translate" rotate "rotate" scale "scale" } + @InnerGraphic + { + @ZeroSize x + } + } + + PDF @Yield { # presume that "rotate", "scale" and "translate" are not matrices + { "__cos("rotate") __sin("rotate") __sub(0, __sin("rotate")) __cos("rotate") 0 0 cm" + "__pick(1, "scale") 0 0 __pick(2, "scale") 0 0 cm n W" } + @InnerGraphic + { + @ZeroSize x + } + // + # { rotate "rotate" scale "scale" translate "translate" } + { "1 0 0 1 "translate" cm" + "__cos("rotate") __sin("rotate") __sub(0, __sin("rotate")) __cos("rotate") 0 0 cm" + "__pick(1, "scale") 0 0 __pick(2, "scale") 0 0 cm" } + @InnerGraphic + { + @ZeroSize x + } + } + + } + } + + def @DoLabel + named which {} + named labeltag { LABEL } + named label {} + named labelmargin {} + named labelfont {} + named labelbreak {} + named labelformat right @Body {} + named labelpos {} + named labelprox {} + named labelangle {} + named labelctr {} + named labeladjust {} + { + + import @Geometry + def alignedangle + { + labelpos??"ANGLE" quadcase + 0 { labelpos??"ANGLE" } + 0-90 { labelpos??"ANGLE" } + 90 { labelpos??"ANGLE" } + 90-180 { labelpos??"ANGLE" + 180d } + 180 { labelpos??"ANGLE" + 180d } + 180-270 { labelpos??"ANGLE" + 180d } + 270 { labelpos??"ANGLE" + 180d } + 270-360 { labelpos??"ANGLE" } + } + + import @Geometry + def perpalignedangle + { + labelpos??"ANGLE" quadcase + 0 { labelpos??"ANGLE" - 90d } + 0-90 { labelpos??"ANGLE" - 90d } + 90 { labelpos??"ANGLE" - 90d } + 90-180 { labelpos??"ANGLE" - 90d } + 180 { labelpos??"ANGLE" + 90d } + 180-270 { labelpos??"ANGLE" + 90d } + 270 { labelpos??"ANGLE" + 90d } + 270-360 { labelpos??"ANGLE" + 90d } + + } + + import @Geometry + def finalangle + { + labelangle @Case { + + "horizontal" @Yield { 0d } + "aligned" @Yield { alignedangle } + "perpendicular" @Yield { perpalignedangle } + "parallel" @Yield { labelpos??"ANGLE" } + "antiparallel" @Yield { labelpos??"ANGLE" + 180d } + else @Yield labelangle + } + } + + import @Geometry + def @AlignedAboveProximity + { + which @Case { + { x f } @Yield { labelpos??ANGLE quadcase + 0 { (SW) } + 0-90 { (SW) } + 90 { (SW) } + 90-180 { (SE) } + 180 { (SE) } + 180-270 { (SE) } + 270 { (SE) } + 270-360 { (SW) } + } + { z t } @Yield { labelpos??ANGLE quadcase + 0 { (SE) } + 0-90 { (SE) } + 90 { (SE) } + 90-180 { (SW) } + 180 { (SW) } + 180-270 { (SW) } + 270 { (SW) } + 270-360 { (SE) } + } + else @Yield (S) + } + } + + import @Geometry + def @AlignedBelowProximity + { + which @Case { + { x f } @Yield { labelpos??ANGLE quadcase + 0 { (NW) } + 0-90 { (NW) } + 90 { (NW) } + 90-180 { (NE) } + 180 { (NE) } + 180-270 { (NE) } + 270 { (NE) } + 270-360 { (NW) } + } + { z t } @Yield { labelpos??ANGLE quadcase + 0 { (NE) } + 0-90 { (NE) } + 90 { (NE) } + 90-180 { (NW) } + 180 { (NW) } + 180-270 { (NW) } + 270 { (NW) } + 270-360 { (NE) } + } + else @Yield (N) + } + } + + import @Geometry + def @AlignedLeftProximity + { + which @Case { + { x f } @Yield { labelpos??ANGLE quadcase + 0 { (SW) } + 0-90 { (SW) } + 90 { (SW) } + 90-180 { (NE) } + 180 { (SE) } + 180-270 { (SE) } + 270 { (SE) } + 270-360 { (NW) } + } + { z t } @Yield { labelpos??ANGLE quadcase + 0 { (SE) } + 0-90 { (SE) } + 90 { (SE) } + 90-180 { (NW) } + 180 { (SW) } + 180-270 { (SW) } + 270 { (SW) } + 270-360 { (NE) } + } + else @Yield { labelpos??ANGLE quadcase + 0 { (S) } + 0-90 { (S) } + 90 { (S) } + 90-180 { (N) } + 180 { (S) } + 180-270 { (S) } + 270 { (S) } + 270-360 { (N) } + } + } + } + + import @Geometry + def @AlignedRightProximity + { + which @Case { + { x f } @Yield { labelpos??ANGLE quadcase + 0 { (SW) } + 0-90 { (NW) } + 90 { (NW) } + 90-180 { (SE) } + 180 { (SE) } + 180-270 { (NE) } + 270 { (NE) } + 270-360 { (SW) } + } + { z t } @Yield { labelpos??ANGLE quadcase + 0 { (SE) } + 0-90 { (NE) } + 90 { (NE) } + 90-180 { (SW) } + 180 { (SW) } + 180-270 { (NW) } + 270 { (NW) } + 270-360 { (SE) } + } + else @Yield { labelpos??ANGLE quadcase + 0 { (S) } + 0-90 { (N) } + 90 { (N) } + 90-180 { (S) } + 180 { (S) } + 180-270 { (N) } + 270 { (N) } + 270-360 { (S) } + } + } + } + + import @Geometry + def @AlignedInsideProximity + { + which @Case { + { x f } @Yield { labelpos??ANGLE quadcase + 0 { (SW) } + 0-90 { (SW) } + 90 { (SW) } + 90-180 { (NE) } + 180 { (NE) } + 180-270 { (NE) } + 270 { (NE) } + 270-360 { (SW) } + } + { z t } @Yield { labelpos??ANGLE quadcase + 0 { (SE) } + 0-90 { (SE) } + 90 { (SE) } + 90-180 { (NW) } + 180 { (NW) } + 180-270 { (NW) } + 270 { (NW) } + 270-360 { (SE) } + } + else @Yield { labelpos??ANGLE quadcase + 0 { (S) } + 0-90 { (S) } + 90 { (S) } + 90-180 { (N) } + 180 { (N) } + 180-270 { (N) } + 270 { (N) } + 270-360 { (S) } + } + } + } + + import @Geometry + def @AlignedOutsideProximity + { + which @Case { + { x f } @Yield { labelpos??ANGLE quadcase + 0 { (NW) } + 0-90 { (NW) } + 90 { (NW) } + 90-180 { (SE) } + 180 { (SE) } + 180-270 { (SE) } + 270 { (SE) } + 270-360 { (NW) } + } + { z t } @Yield { labelpos??ANGLE quadcase + 0 { (NE) } + 0-90 { (NE) } + 90 { (NE) } + 90-180 { (SW) } + 180 { (SW) } + 180-270 { (SW) } + 270 { (SW) } + 270-360 { (NE) } + } + else @Yield { labelpos??ANGLE quadcase + 0 { (N) } + 0-90 { (N) } + 90 { (N) } + 90-180 { (S) } + 180 { (S) } + 180-270 { (S) } + 270 { (S) } + 270-360 { (N) } + } + } + } + + + import @Geometry + def @PerpendicularAboveProximity + { + which @Case { + { x f } @Yield { labelpos??ANGLE quadcase + 0 { (SE) } + 0-90 { (SE) } + 90 { (SE) } + 90-180 { (SW) } + 180 { (NE) } + 180-270 { (NE) } + 270 { (NE) } + 270-360 { (NW) } + } + { z t } @Yield { labelpos??ANGLE quadcase + 0 { (NE) } + 0-90 { (NE) } + 90 { (NE) } + 90-180 { (NW) } + 180 { (SE) } + 180-270 { (SE) } + 270 { (SE) } + 270-360 { (SW) } + } + else @Yield { labelpos??ANGLE quadcase + 0 { (E) } + 0-90 { (E) } + 90 { (E) } + 90-180 { (W) } + 180 { (E) } + 180-270 { (E) } + 270 { (E) } + 270-360 { (W) } + } + } + } + + import @Geometry + def @PerpendicularBelowProximity + { + which @Case { + { x f } @Yield { labelpos??ANGLE quadcase + 0 { (SW) } + 0-90 { (SW) } + 90 { (SW) } + 90-180 { (SE) } + 180 { (NW) } + 180-270 { (NW) } + 270 { (NW) } + 270-360 { (NE) } + } + { z t } @Yield { labelpos??ANGLE quadcase + 0 { (NW) } + 0-90 { (NW) } + 90 { (NW) } + 90-180 { (NE) } + 180 { (SW) } + 180-270 { (SW) } + 270 { (SW) } + 270-360 { (SE) } + } + else @Yield { labelpos??ANGLE quadcase + 0 { (W) } + 0-90 { (W) } + 90 { (W) } + 90-180 { (E) } + 180 { (W) } + 180-270 { (W) } + 270 { (W) } + 270-360 { (E) } + } + } + } + + import @Geometry + def @PerpendicularLeftProximity + { + which @Case { + { x f } @Yield { labelpos??ANGLE quadcase + 0 { (SE) } + 0-90 { (SE) } + 90 { (SE) } + 90-180 { (SE) } + 180 { (NE) } + 180-270 { (NE) } + 270 { (NE) } + 270-360 { (NE) } + } + { z t } @Yield { labelpos??ANGLE quadcase + 0 { (NE) } + 0-90 { (NE) } + 90 { (NE) } + 90-180 { (NE) } + 180 { (SE) } + 180-270 { (SE) } + 270 { (SE) } + 270-360 { (SE) } + } + else @Yield (E) + } + } + + import @Geometry + def @PerpendicularRightProximity + { + which @Case { + { x f } @Yield { labelpos??ANGLE quadcase + 0 { (SW) } + 0-90 { (SW) } + 90 { (SW) } + 90-180 { (SW) } + 180 { (NW) } + 180-270 { (NW) } + 270 { (NW) } + 270-360 { (NW) } + } + { z t } @Yield { labelpos??ANGLE quadcase + 0 { (NW) } + 0-90 { (NW) } + 90 { (NW) } + 90-180 { (NW) } + 180 { (SW) } + 180-270 { (SW) } + 270 { (SW) } + 270-360 { (SW) } + } + else @Yield (W) + } + } + + import @Geometry + def @PerpendicularInsideProximity + { + which @Case { + { x f } @Yield { labelpos??ANGLE quadcase + 0 { (SE) } + 0-90 { (SE) } + 90 { (SE) } + 90-180 { (SE) } + 180 { (NW) } + 180-270 { (NW) } + 270 { (NW) } + 270-360 { (NW) } + } + { z t } @Yield { labelpos??ANGLE quadcase + 0 { (NE) } + 0-90 { (NE) } + 90 { (NE) } + 90-180 { (NE) } + 180 { (SW) } + 180-270 { (SW) } + 270 { (SW) } + 270-360 { (SW) } + } + else @Yield { labelpos??ANGLE quadcase + 0 { (E) } + 0-90 { (E) } + 90 { (E) } + 90-180 { (E) } + 180 { (W) } + 180-270 { (W) } + 270 { (W) } + 270-360 { (W) } + } + } + } + + import @Geometry + def @PerpendicularOutsideProximity + { + which @Case { + { x f } @Yield { labelpos??ANGLE quadcase + 0 { (SW) } + 0-90 { (SW) } + 90 { (SW) } + 90-180 { (SW) } + 180 { (NE) } + 180-270 { (NE) } + 270 { (NE) } + 270-360 { (NE) } + } + { z t } @Yield { labelpos??ANGLE quadcase + 0 { (NW) } + 0-90 { (NW) } + 90 { (NW) } + 90-180 { (NW) } + 180 { (SE) } + 180-270 { (SE) } + 270 { (SE) } + 270-360 { (SE) } + } + else @Yield { labelpos??ANGLE quadcase + 0 { (W) } + 0-90 { (W) } + 90 { (W) } + 90-180 { (W) } + 180 { (E) } + 180-270 { (E) } + 270 { (E) } + 270-360 { (E) } + } + } + } + + + import @Geometry + def @OtherAboveProximity + { + which @Case { + { x f } @Yield { labelpos??ANGLE quadcase + 0 { (SW) } + 0-90 { (SE) } + 90 { (SW) } + 90-180 { (SW) } + 180 { (SE) } + 180-270 { (SE) } + 270 { (NW) } + 270-360 { (SW) } + } + { z t } @Yield { labelpos??ANGLE quadcase + 0 { (SE) } + 0-90 { (SE) } + 90 { (NW) } + 90-180 { (SW) } + 180 { (SW) } + 180-270 { (SE) } + 270 { (SW) } + 270-360 { (SW) } + } + else @Yield { labelpos??ANGLE quadcase + 0 { (S) } + 0-90 { (SE) } + 90 { (W) } + 90-180 { (SW) } + 180 { (S) } + 180-270 { (SE) } + 270 { (W) } + 270-360 { (SW) } + } + } + } + + import @Geometry + def @OtherBelowProximity + { + which @Case { + { x f } @Yield { labelpos??ANGLE quadcase + 0 { (NW) } + 0-90 { (NW) } + 90 { (SW) } + 90-180 { (NE) } + 180 { (NE) } + 180-270 { (NW) } + 270 { (NW) } + 270-360 { (NE) } + } + { z t } @Yield { labelpos??ANGLE quadcase + 0 { (NE) } + 0-90 { (NW) } + 90 { (NW) } + 90-180 { (NE) } + 180 { (NW) } + 180-270 { (NW) } + 270 { (SW) } + 270-360 { (NE) } + } + else @Yield { labelpos??ANGLE quadcase + 0 { (N) } + 0-90 { (NW) } + 90 { (W) } + 90-180 { (NE) } + 180 { (N) } + 180-270 { (NW) } + 270 { (W) } + 270-360 { (NE) } + } + } + } + + import @Geometry + def @OtherLeftProximity + { + which @Case { + { x f } @Yield { labelpos??ANGLE quadcase + 0 { (SW) } + 0-90 { (SE) } + 90 { (SE) } + 90-180 { (NE) } + 180 { (SE) } + 180-270 { (SE) } + 270 { (NE) } + 270-360 { (NE) } + } + { z t } @Yield { labelpos??ANGLE quadcase + 0 { (SE) } + 0-90 { (SE) } + 90 { (NE) } + 90-180 { (NE) } + 180 { (SW) } + 180-270 { (SE) } + 270 { (SE) } + 270-360 { (NE) } + } + else @Yield { labelpos??ANGLE quadcase + 0 { (S) } + 0-90 { (SE) } + 90 { (E) } + 90-180 { (NE) } + 180 { (S) } + 180-270 { (SE) } + 270 { (E) } + 270-360 { (NE) } + } + } + } + + import @Geometry + def @OtherRightProximity + { + which @Case { + { x f } @Yield { labelpos??ANGLE quadcase + 0 { (SW) } + 0-90 { (NW) } + 90 { (SW) } + 90-180 { (SW) } + 180 { (SE) } + 180-270 { (NW) } + 270 { (NW) } + 270-360 { (SW) } + } + { z t } @Yield { labelpos??ANGLE quadcase + 0 { (SE) } + 0-90 { (NW) } + 90 { (NW) } + 90-180 { (SW) } + 180 { (SW) } + 180-270 { (NW) } + 270 { (SW) } + 270-360 { (SW) } + } + else @Yield { labelpos??ANGLE quadcase + 0 { (S) } + 0-90 { (NW) } + 90 { (W) } + 90-180 { (SW) } + 180 { (S) } + 180-270 { (NW) } + 270 { (W) } + 270-360 { (SW) } + } + } + } + + import @Geometry + def @OtherInsideProximity + { + which @Case { + { x f } @Yield { labelpos??ANGLE quadcase + 0 { (SW) } + 0-90 { (SE) } + 90 { (SE) } + 90-180 { (NE) } + 180 { (NE) } + 180-270 { (NW) } + 270 { (NW) } + 270-360 { (SW) } + } + { z t } @Yield { labelpos??ANGLE quadcase + 0 { (SE) } + 0-90 { (SE) } + 90 { (NE) } + 90-180 { (NE) } + 180 { (NW) } + 180-270 { (NW) } + 270 { (SW) } + 270-360 { (SW) } + } + else @Yield { labelpos??ANGLE quadcase + 0 { (S) } + 0-90 { (SE) } + 90 { (E) } + 90-180 { (NE) } + 180 { (N) } + 180-270 { (NW) } + 270 { (W) } + 270-360 { (SW) } + } + } + } + + import @Geometry + def @OtherOutsideProximity + { + which @Case { + { x f } @Yield { labelpos??ANGLE quadcase + 0 { (NW) } + 0-90 { (NW) } + 90 { (SW) } + 90-180 { (SW) } + 180 { (SE) } + 180-270 { (SE) } + 270 { (NE) } + 270-360 { (NE) } + } + { z t } @Yield { labelpos??ANGLE quadcase + 0 { (NE) } + 0-90 { (NW) } + 90 { (NW) } + 90-180 { (SW) } + 180 { (SW) } + 180-270 { (SE) } + 270 { (SE) } + 270-360 { (NE) } + } + else @Yield { labelpos??ANGLE quadcase + 0 { (N) } + 0-90 { (NW) } + 90 { (W) } + 90-180 { (SW) } + 180 { (S) } + 180-270 { (SE) } + 270 { (E) } + 270-360 { (NE) } + } + } + } + + + import @Geometry + def @AboveProximity + { + labelangle @Case { + "aligned" @Yield @AlignedAboveProximity + "perpendicular" @Yield @PerpendicularAboveProximity + else @Yield @OtherAboveProximity + } + } + + import @Geometry + def @BelowProximity + { + labelangle @Case { + "aligned" @Yield @AlignedBelowProximity + "perpendicular" @Yield @PerpendicularBelowProximity + else @Yield @OtherBelowProximity + } + } + + import @Geometry + def @LeftProximity + { + labelangle @Case { + "aligned" @Yield @AlignedLeftProximity + "perpendicular" @Yield @PerpendicularLeftProximity + else @Yield @OtherLeftProximity + } + } + + import @Geometry + def @RightProximity + { + labelangle @Case { + "aligned" @Yield @AlignedRightProximity + "perpendicular" @Yield @PerpendicularRightProximity + else @Yield @OtherRightProximity + } + } + + import @Geometry + def @InsideProximity + { + labelangle @Case { + "aligned" @Yield @AlignedInsideProximity + "perpendicular" @Yield @PerpendicularInsideProximity + else @Yield @OtherInsideProximity + } + } + + import @Geometry + def @OutsideProximity + { + labelangle @Case { + "aligned" @Yield @AlignedOutsideProximity + "perpendicular" @Yield @PerpendicularOutsideProximity + else @Yield @OtherOutsideProximity + } + } + + import @Geometry + def proximity + { + labelprox @Case { + above @Yield @AboveProximity + below @Yield @BelowProximity + left @Yield @LeftProximity + right @Yield @RightProximity + inside @Yield @InsideProximity + outside @Yield @OutsideProximity + else @Yield { "("labelprox")" } + } + } + + import @Geometry + def dorotate + left point + right angle + { + { {0 0} distance point } atangle { {0 0} angleto point + angle } + } + + import @Geometry + def translation + { + labelctr @Case { + { no No } @Yield { + labelpos -- labeltag?!?proximity + } + { yes Yes } @Yield { + #P0 := labelpos + #P1 := labeltag?!?proximity -- P0 + #P2 := labeltag??CTR -- P0 + #TH := labelpos??ANGLE + #P1A := P1 dorotate { 0 - TH } + #P2A := P2 dorotate { 0 - TH } + #PRA := { 0 - xcoord P2A 0 - ycoord P1A } + #PRA dorotate TH ++ P0 + XP1 := labeltag?!?proximity + XP2 := labeltag??CTR + XANG := labelpos??ANGLE + XTH := XANG - 90d - { XP1 angleto XP2 } + XDIST := { XP1 distance XP2 } * sin XTH + labelpos -- XP1 ++ XDIST atangle XANG + } + } + } + + @CatchTags @ZeroSize @Transform + translate { translation ++ labeladjust } + rotate { finalangle } + scale { 1 1 } + labeltag:: @BoxLabels @CatchTags @AddMargins + mtop { labelmargin } + mfoot { labelmargin } + mleft { labelmargin } + mright { labelmargin } + labelfont @Font labelbreak @Break labelformat label + } + + + 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" } + PDF @Yield {""} + } + } + {} + import @Geometry named rotate { 0d } + import @Geometry named outline + named margin {} + named shadow {} + named sides {} + named angle {} + { outline + margin { margin } + shadow { shadow } + sides { sides } + angle { angle } + } + named margin { margin } + import @Geometry named shadow { shadow } + import @Geometry named sides { sides } + import @Geometry named angle { angle } + named nodetag { nodetag } + named outlinestyle + named solid { "/ldiagsolid" } + named dashed { "/ldiagdashed" } + named cdashed { "/ldiagcdashed" } + named dotted { "/ldiagdotted" } + named noline { "/ldiagnoline" } + { outlinestyle } + import @Geometry named outlinedashlength { outlinedashlength} + import @Geometry named outlinewidth + named thin { 0.04 ft } + named medium { 0.08 ft } + named thick { 0.12 ft } + { outlinewidth } + named paint { paint } + named font { font } + named break { break } + named format right @Body { format @Body } + named valign { valign } + named vsize { vsize } + named vindent { vindent } + named vstrut + named no { 0.0f } + named yes { 1.0f } + { vstrut } + named vmargin { vmargin } + named topmargin { topmargin } + named footmargin { footmargin } + + named halign { halign } + named hsize { hsize } + named hindent { hindent } + named hstrut + named no { 0.0f } + named yes { 1.0f } + { hstrut } + named hmargin { hmargin } + named leftmargin { leftmargin } + named rightmargin { rightmargin } + + named nodelabel { nodelabel } + named nodelabelmargin { nodelabelmargin } + named nodelabelfont { nodelabelfont } + named nodelabelbreak { nodelabelbreak } + named nodelabelformat right @Body { nodelabelformat @Body } + import @Geometry named nodelabelpos { nodelabelpos } + named nodelabelprox { nodelabelprox } + import @Geometry named nodelabelangle { nodelabelangle } + named nodelabelctr { nodelabelctr } + import @Geometry named nodelabeladjust { nodelabeladjust } + + named alabel { alabel } + named alabelmargin { alabelmargin } + named alabelfont { alabelfont } + named alabelbreak { alabelbreak } + named alabelformat right @Body { alabelformat @Body } + import @Geometry named alabelpos { alabelpos } + named alabelprox { alabelprox } + import @Geometry named alabelangle { alabelangle } + named alabelctr { alabelctr } + import @Geometry named alabeladjust { alabeladjust } + + named blabel { blabel } + named blabelmargin { blabelmargin } + named blabelfont { blabelfont } + named blabelbreak { blabelbreak } + named blabelformat right @Body { blabelformat @Body } + import @Geometry named blabelpos { blabelpos } + named blabelprox { blabelprox } + import @Geometry named blabelangle { blabelangle } + named blabelctr { blabelctr } + import @Geometry named blabeladjust { blabeladjust } + + named clabel { clabel } + named clabelmargin { clabelmargin } + named clabelfont { clabelfont } + named clabelbreak { clabelbreak } + named clabelformat right @Body { clabelformat @Body } + import @Geometry named clabelpos { clabelpos } + named clabelprox { clabelprox } + import @Geometry named clabelangle { clabelangle } + named clabelctr { clabelctr } + import @Geometry named clabeladjust { clabeladjust } + + named dlabel { dlabel } + named dlabelmargin { dlabelmargin } + named dlabelfont { dlabelfont } + named dlabelbreak { dlabelbreak } + named dlabelformat right @Body { dlabelformat @Body } + import @Geometry named dlabelpos { dlabelpos } + named dlabelprox { dlabelprox } + import @Geometry named dlabelangle { dlabelangle } + named dlabelctr { dlabelctr } + import @Geometry named dlabeladjust { dlabeladjust } + + 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 + } + } + } + + macro @@Node { @Node } + macro @Box { @Node outline { box } } + macro @CurveBox { @Node outline { curvebox } } + macro @ShadowBox { @Node outline { shadowbox } } + macro @Square { @Node outline { square } } + macro @Diamond { @Node outline { diamond } } + macro @Polygon { @Node outline { polygon } } + macro @Isosceles { @Node outline { isosceles } } + macro @Ellipse { @Node outline { ellipse } } + macro @Circle { @Node outline { circle } } + + + macro @InsulatedNode { + @Node + topmargin { 0i } + footmargin { 0i } + leftmargin { 0i } + rightmargin { 0i } + alabel {} + blabel {} + clabel {} + dlabel {} + hsize {} + vsize {} + vstrut { no } + hstrut { no } + } + + def @SolidArrowHead + named width { arrowwidth } + named length { arrowlength } + named pathwidth { pathwidth } + { + @InsulatedNode + paint { nochange } + outlinestyle { noline } + outlinewidth { pathwidth } + outline { + @BackEnd @Case { + PostScript @Yield { + "ldiagsolidarrowhead" + # 0 0 xsize ysize * 0.5 0 ysize + } + PDF @Yield {} + } + } + { + length @Wide width @High + } + } + + def @OpenArrowHead + named width { arrowwidth } + named length { arrowlength } + named pathwidth { pathwidth } + { + @InsulatedNode + outlinewidth { pathwidth } + outlinestyle { noline } + paint { nochange } + outline { + @BackEnd @Case { + PostScript @Yield { + pathwidth "ldiagopenarrowhead" + + # PSW := { 0 0 } + # PNW := { 0 ysize } + # PE := { xsize ysize*0.5 } + # REL := pathwidth atangle { PE angleto PNW + 90d } + # PNA := { 0 ysize*0.5 + pathwidth*0.5 } + # PSA := { 0 ysize*0.5 - pathwidth*0.5 } + # PNI := { + # PNA PNA ++ { xsize 0 } + # PNW ++ REL PE ++ REL ldiaglineintersect + # } + # PSI := PNI -- { 0 pathwidth } + # + # PSW PE PNW PNI PNA PSA PSI PSW + } + PDF @Yield {} + } + } + { + length @Wide width @High + } + } + + def @HalfOpenArrowHead + named width { arrowwidth } + named length { arrowlength } + named pathwidth { pathwidth } + { + @InsulatedNode + paint { nochange } + outlinestyle { noline } + outlinewidth { pathwidth } + outline { + @BackEnd @Case { + PostScript @Yield { + pathwidth "ldiaghalfopenarrowhead" + + # 0 0 + # xsize ysize * 0.5 + # 0 ysize + # xsize*0.3 ysize*0.5 + pathwidth*0.5 + # 0 ysize*0.5 + pathwidth*0.5 + # 0 ysize*0.5 - pathwidth*0.5 + # xsize*0.3 ysize*0.5 - pathwidth*0.5 + # 0 0 + } + PDF @Yield {} + } + } + { + length @Wide width @High + } + } + + def @SolidCurvedArrowHead + named width { arrowwidth } + named length { arrowlength } + named pathwidth { pathwidth } + { + @InsulatedNode + outlinestyle { noline } + paint { nochange } + outlinewidth { pathwidth } + outline { + @BackEnd @Case { + PostScript @Yield { + "ldiagsolidcurvedarrowhead" + # 0 0 + # [0 0 xsize ysize * 0.5 "ldiaglinebetween" + # xsize 0 xsize ysize "ldiaglineintersect" clockwise] + # xsize ysize * 0.5 + # [xsize ysize * 0.5 0 ysize "ldiaglinebetween" + # xsize 0 xsize ysize "ldiaglineintersect" clockwise] + # 0 ysize + } + PDF @Yield {} + } + } + { + length @Wide width @High + } + } + + def @OpenCurvedArrowHead + named width { arrowwidth } + named length { arrowlength } + named pathwidth { pathwidth } + { + @InsulatedNode + outlinestyle { noline } + paint { nochange } + outlinewidth { pathwidth } + outline { + @BackEnd @Case { + PostScript @Yield { + pathwidth "ldiagopencurvedarrowhead" + # LR:= { 0 0 xsize ysize * 0.5 "ldiaglinebetween" + # xsize 0 xsize ysize "ldiaglineintersect" } + # UR:= { xsize ysize * 0.5 0 ysize "ldiaglinebetween" + # xsize 0 xsize ysize "ldiaglineintersect" } + # PW2 := pathwidth * 0.5 + # UMID := { + # 0 ysize * 0.5 + PW2 xsize ysize * 0.5 + PW2 + # {0 ysize} ++ 1f atangle { UR angleto {0 ysize} + 90d } + # { 0 ysize } ldiaglineintersect + # } + # LMID := UMID -- { 0 pathwidth } + # 0 0 + # [LR clockwise] + # xsize ysize * 0.5 + # [UR clockwise] + # 0 ysize + # UMID + # 0 ysize * 0.5 + PW2 + # 0 ysize * 0.5 - PW2 + # LMID + # 0 0 + } + PDF @Yield {} + } + } + { + length @Wide width @High + } + } + + def @HalfOpenCurvedArrowHead + named width { arrowwidth } + named length { arrowlength } + named pathwidth { pathwidth } + { + @InsulatedNode + outlinestyle { noline } + paint { nochange } + outlinewidth { pathwidth } + outline { + @BackEnd @Case { + PostScript @Yield { + pathwidth "ldiaghalfopencurvedarrowhead" + # LR:= { 0 0 xsize ysize * 0.5 "ldiaglinebetween" + # xsize 0 xsize ysize "ldiaglineintersect" } + # UR:= { xsize ysize * 0.5 0 ysize "ldiaglinebetween" + # xsize 0 xsize ysize "ldiaglineintersect" } + # BR:= { 0 0 LR 0 ysize UR "ldiaglineintersect" } + # BRAD := { 0 0 } distance BR + # PW2 := pathwidth * 0.5 + # XDIST := sqrt { BRAD*BRAD - PW2*PW2 } + # UMID := BR ++ { XDIST PW2 } + # LMID := BR ++ { XDIST 0 - PW2 } + # 0 0 + # [LR clockwise] + # xsize ysize * 0.5 + # [UR clockwise] + # 0 ysize + # [BR clockwise ] + # UMID + # 0 ysize * 0.5 + PW2 + # 0 ysize * 0.5 - PW2 + # LMID + # [BR clockwise ] + # 0 0 + } + PDF @Yield {} + } + } + { + length @Wide width @High + } + } + + def @CircleArrowHead + named width { arrowwidth } + named length { arrowlength } + named pathwidth { pathwidth } + { + @InsulatedNode + outlinestyle { noline } + paint { nochange } + outlinewidth { pathwidth } + outline { circle } + { length @Wide length @High } + } + + def @BoxArrowHead + named width { arrowwidth } + named length { arrowlength } + named pathwidth { pathwidth } + { + @InsulatedNode + outlinestyle { noline } + paint { nochange } + outlinewidth { pathwidth } + outline { box } + { length @Wide width @High } + } + + def @ArrowHead + named style { arrowstyle } + named width { arrowwidth } + named length { arrowlength } + named pathwidth { pathwidth } + { + style @Case { + solid @Yield @SolidArrowHead + width { width } length { length } + pathwidth { pathwidth } + halfopen @Yield @HalfOpenArrowHead + width { width } length { length } + pathwidth { pathwidth } + open @Yield @OpenArrowHead + width { width } length { length } + pathwidth { pathwidth } + curvedsolid @Yield @SolidCurvedArrowHead + width { width } length { length } + pathwidth { pathwidth } + curvedhalfopen @Yield @HalfOpenCurvedArrowHead + width { width } length { length } + pathwidth { pathwidth } + curvedopen @Yield @OpenCurvedArrowHead + width { width } length { length } + pathwidth { pathwidth } + circle @Yield @CircleArrowHead + width { width } length { length } + pathwidth { pathwidth } + box @Yield @BoxArrowHead + width { width } length { length } + pathwidth { pathwidth } + } + } + + def @Link + import @Geometry named path + named from {} + named to {} + named bias {} + named fbias {} + named tbias {} + named radius {} + named xindent {} + named zindent {} + named frompt {} + named topt {} + named arrow {} + named arrowlength {} + { path + from { from } + to { to } + bias { bias } + fbias { fbias } + tbias { tbias } + radius { radius } + xindent { xindent } + zindent { zindent } + frompt { frompt } + topt { topt } + arrow { arrow } + arrowlength { arrowlength } + } + import @Geometry named from { from } + import @Geometry named to { to } + import @Geometry named bias { bias } + import @Geometry named fbias { fbias } + import @Geometry named tbias { tbias } + import @Geometry named radius { radius } + import @Geometry named xindent { xindent } + import @Geometry named zindent { zindent } + import @Geometry named frompt { frompt } + import @Geometry named topt { topt } + named pathstyle + named solid { "/ldiagsolid" } + named dashed { "/ldiagdashed" } + named cdashed { "/ldiagcdashed" } + named dotted { "/ldiagdotted" } + named noline { "/ldiagnoline" } + { pathstyle } + import @Geometry named pathdashlength { pathdashlength } + import @Geometry named pathwidth + named thin { 0.04 ft } + named medium { 0.08 ft } + named thick { 0.12 ft } + { pathwidth } + import @Geometry named pathgap + named thin { 0.08 ft } + named medium { 0.16 ft } + named thick { 0.24 ft } + { pathgap } + + named arrow { arrow } + named arrowstyle { arrowstyle } + named arrowwidth { arrowwidth } + named arrowlength { arrowlength } + + named linklabel { linklabel } + named linklabelmargin { linklabelmargin } + named linklabelfont { linklabelfont } + named linklabelbreak { linklabelbreak } + named linklabelformat right @Body { linklabelformat @Body } + import @Geometry named linklabelpos { linklabelpos } + named linklabelprox { linklabelprox } + import @Geometry named linklabelangle { linklabelangle } + named linklabelctr { linklabelctr } + import @Geometry named linklabeladjust { linklabeladjust } + + named xlabel { xlabel } + named xlabelmargin { xlabelmargin } + named xlabelfont { xlabelfont } + named xlabelbreak { xlabelbreak } + named xlabelformat right @Body { xlabelformat @Body } + import @Geometry named xlabelpos { xlabelpos } + named xlabelprox { xlabelprox } + import @Geometry named xlabelangle { xlabelangle } + named xlabelctr { xlabelctr } + import @Geometry named xlabeladjust { xlabeladjust } + + named ylabel { ylabel } + named ylabelmargin { ylabelmargin } + named ylabelfont { ylabelfont } + named ylabelbreak { ylabelbreak } + named ylabelformat right @Body { ylabelformat @Body } + import @Geometry named ylabelpos { ylabelpos } + named ylabelprox { ylabelprox } + import @Geometry named ylabelangle { ylabelangle } + named ylabelctr { ylabelctr } + import @Geometry named ylabeladjust { ylabeladjust } + + named zlabel { zlabel } + named zlabelmargin { zlabelmargin } + named zlabelfont { zlabelfont } + named zlabelbreak { zlabelbreak } + named zlabelformat right @Body { zlabelformat @Body } + import @Geometry named zlabelpos { zlabelpos } + named zlabelprox { zlabelprox } + import @Geometry named zlabelangle { zlabelangle } + named zlabelctr { zlabelctr } + import @Geometry named zlabeladjust { zlabeladjust } + + named fromlabel { fromlabel } + named fromlabelmargin { fromlabelmargin } + named fromlabelfont { fromlabelfont } + named fromlabelbreak { fromlabelbreak } + named fromlabelformat right @Body { fromlabelformat @Body } + import @Geometry named fromlabelpos { fromlabelpos } + named fromlabelprox { fromlabelprox } + import @Geometry named fromlabelangle { fromlabelangle } + named fromlabelctr { fromlabelctr } + import @Geometry named fromlabeladjust { fromlabeladjust } + + named tolabel { tolabel } + named tolabelmargin { tolabelmargin } + named tolabelfont { tolabelfont } + named tolabelbreak { tolabelbreak } + named tolabelformat right @Body { tolabelformat @Body } + import @Geometry named tolabelpos { tolabelpos } + named tolabelprox { tolabelprox } + import @Geometry named tolabelangle { tolabelangle } + named tolabelctr { tolabelctr } + import @Geometry named tolabeladjust{ tolabeladjust } + + { + def @XLabel + { + @DoLabel + which { "x" } + label { xlabel @Else linklabel } + labelmargin { xlabelmargin @Else linklabelmargin } + labelfont { xlabelfont @Else linklabelfont } + labelbreak { xlabelbreak @Else linklabelbreak } + labelformat { xlabelformat @Body @Else linklabelformat @Body} + labelpos { xlabelpos @Else linklabelpos } + labelprox { xlabelprox @Else linklabelprox } + labelangle { xlabelangle @Else linklabelangle } + labelctr { xlabelctr @Else linklabelctr } + labeladjust { xlabeladjust @Else linklabeladjust } + } + + def @YLabel + { + @DoLabel + which { "y" } + label { ylabel @Else linklabel } + labelmargin { ylabelmargin @Else linklabelmargin } + labelfont { ylabelfont @Else linklabelfont } + labelbreak { ylabelbreak @Else linklabelbreak } + labelformat { ylabelformat @Body @Else linklabelformat @Body} + labelpos { ylabelpos @Else linklabelpos } + labelprox { ylabelprox @Else linklabelprox } + labelangle { ylabelangle @Else linklabelangle } + labelctr { ylabelctr @Else linklabelctr } + labeladjust { ylabeladjust @Else linklabeladjust } + } + + def @ZLabel + { + @DoLabel + which { "z" } + label { zlabel @Else linklabel } + labelmargin { zlabelmargin @Else linklabelmargin } + labelfont { zlabelfont @Else linklabelfont } + labelbreak { zlabelbreak @Else linklabelbreak } + labelformat { zlabelformat @Body @Else linklabelformat @Body} + labelpos { zlabelpos @Else linklabelpos } + labelprox { zlabelprox @Else linklabelprox } + labelangle { zlabelangle @Else linklabelangle } + labelctr { zlabelctr @Else linklabelctr } + labeladjust { zlabeladjust @Else linklabeladjust } + } + + def @FromArrow + { + arrow @Case { + { back both } @Yield { + @ArrowHead + style { arrowstyle } + width { arrowwidth } + length { arrowlength } + pathwidth { pathwidth } + } + else @Yield "" + } + } + + def @ToArrow + { + arrow @Case { + { yes forward both } @Yield { + @ArrowHead + style { arrowstyle } + width { arrowwidth } + length { arrowlength } + pathwidth { pathwidth } + } + else @Yield "" + } + } + + import @Geometry + def @LinePath + { + @BackEnd @Case { + PostScript @Yield { + {arrow @FromArrowLength arrowlength} + {arrow @ToArrowLength arrowlength} + "{" from "}" "{" to "}" + xindent zindent "ldiaglinepath" + # FROM :< {from??CTR angleto to??CTR} + # FROM :: from boundaryatangle FROM@ANGLE + # ++ {arrow @FromArrowLength arrowlength}atangle FROM@ANGLE + # TO :< FROM@ANGLE + # TO :: to boundaryatangle { TO@ANGLE - 180d } + # ++ {arrow @ToArrowLength arrowlength} atangle {TO@ANGLE - 180d} + # + # LMID :: FROM ** 0.5 ++ TO ** 0.5 + # LMID :< FROM@ANGLE + # XINDENT := xindent min { FROM distance LMID } + # LFROM :: FROM ++ XINDENT atangle FROM@ANGLE + # LFROM :< FROM@ANGLE + # ZINDENT := zindent min { TO distance LMID } + # LTO :: TO -- ZINDENT atangle FROM@ANGLE + # LTO :< FROM@ANGLE + # + # if cond { direct } + # then { FROM TO } + # else { FROM LFROM LMID LTO TO } + } + PDF @Yield {} + } + } + + import @Geometry + def @DoubleLinePath + { + @BackEnd @Case { + PostScript @Yield { + {arrow @FromArrowLength arrowlength} + {arrow @ToArrowLength arrowlength} + "{" from "}" "{" to "}" + xindent zindent pathgap "ldiagdoublelinepath" + # FROM :< {from??CTR angleto to??CTR} + # FROM :: from boundaryatangle FROM@ANGLE + # ++ {arrow @FromArrowLength arrowlength}atangle FROM@ANGLE + # TO :< FROM@ANGLE + # TO :: to boundaryatangle { TO@ANGLE - 180d } + # ++ {arrow @ToArrowLength arrowlength} atangle {TO@ANGLE - 180d} + # + # LMID :: FROM ** 0.5 ++ TO ** 0.5 + # LMID :< FROM@ANGLE + # XINDENT := xindent min { FROM distance LMID } + # LFROM :: FROM ++ XINDENT atangle FROM@ANGLE + # LFROM :< FROM@ANGLE + # ZINDENT := zindent min { TO distance LMID } + # LTO :: TO -- ZINDENT atangle FROM@ANGLE + # LTO :< FROM@ANGLE + # + # if cond { direct } + # then { FROM TO } + # else { FROM LFROM LMID LTO TO } + } + PDF @Yield {} + } + } + + import @Geometry + def @ACurvePath + { + @BackEnd @Case { + PostScript @Yield { + {arrow @FromArrowLength arrowlength} + {arrow @ToArrowLength arrowlength} + "{" from "}" "{" to "}" + xindent zindent bias "ldiagacurvepath" + # #B1 := bias max 0.02f + # #B2 := { from??CTR distance to??CTR } * 0.5 + # #BIAS := B1 min B2 + # BIAS := bias max 0.02f + # XMID := from??CTR ** 0.5 ++ to??CTR ** 0.5 + # XTOP := XMID ++ BIAS atangle {from??CTR angleto to??CTR - 90d} + # CTR := { from??CTR XTOP ldiaglinebetween + # to??CTR XTOP ldiaglinebetween ldiaglineintersect } + # FROM :: aabout + # circum { from } + # extra { arrow @FromArrowLength arrowlength } + # centre { CTR } + # FROM :< if cond { from??CTR distance FROM > 0 } + # then { from??CTR angleto FROM } + # else { CTR angleto FROM + 90d } + # TO :: cabout + # circum { to } + # extra { arrow @ToArrowLength arrowlength } + # centre { CTR } + # TO :< if cond { TO distance to??CTR > 0 } + # then { TO angleto to??CTR } + # else { CTR angleto TO + 90d } + # + # RADIUS := CTR distance FROM + # LMID :: CTR ++ RADIUS atangle { + # CTR angleto FROM + + # { {360d + {CTR angleto TO} - {CTR angleto FROM}} mod 360 } / 2 + # } + # LMID :< CTR angleto LMID + 90d + # + # XINDENT := xindent min { FROM distance LMID } + # LFROM :: CTR ++ RADIUS atangle { + # CTR angleto { FROM ++ XINDENT atangle FROM@ANGLE } } + # LFROM :< CTR angleto LFROM + 90d + # ZINDENT := zindent min { TO distance LMID } + # LTO :: CTR ++ RADIUS atangle { + # CTR angleto { TO ++ ZINDENT atangle {TO@ANGLE+180d}}} + # LTO :< CTR angleto LTO + 90d + # + # if cond { direct } + # then { FROM [CTR] TO } + # else { FROM [CTR] LFROM [CTR] LMID [CTR] LTO [CTR] TO } + } + PDF @Yield {} + } + } + + import @Geometry + def @CCurvePath + { + @BackEnd @Case { + PostScript @Yield { + {arrow @FromArrowLength arrowlength} + {arrow @ToArrowLength arrowlength} + "{" from "}" "{" to "}" + xindent zindent bias "ldiagccurvepath" + # #B1 := bias max 0.02f + # #B2 := { from??CTR distance to??CTR } * 0.5 + # #BIAS := B1 min B2 + # BIAS := bias max 0.02f + # XMID := from??CTR ** 0.5 ++ to??CTR ** 0.5 + # XTOP := XMID ++ BIAS atangle {from??CTR angleto to??CTR + 90d} + # CTR := { from??CTR XTOP ldiaglinebetween + # to??CTR XTOP ldiaglinebetween ldiaglineintersect } + # FROM :: cabout + # circum { from } + # extra { arrow @FromArrowLength arrowlength } + # centre { CTR } + # FROM :< if cond { from??CTR distance FROM > 0 } + # then { from??CTR angleto FROM } + # else { CTR angleto FROM - 90d } + # TO :: aabout + # circum { to } + # extra { arrow @ToArrowLength arrowlength } + # centre { CTR } + # TO :< if cond { TO distance to??CTR > 0 } + # then { TO angleto to??CTR } + # else { CTR angleto TO - 90d } + # + # RADIUS := CTR distance FROM + # LMID :: CTR ++ RADIUS atangle { + # CTR angleto TO + + # { {360d + {CTR angleto FROM} - {CTR angleto TO} } mod 360 } / 2 + # } + # LMID :< CTR angleto LMID - 90d + # + # XINDENT := xindent min { FROM distance LMID } + # LFROM :: CTR ++ RADIUS atangle { + # CTR angleto { FROM ++ XINDENT atangle FROM@ANGLE } } + # LFROM :< CTR angleto LFROM - 90d + # ZINDENT := zindent min { TO distance LMID } + # LTO :: CTR ++ RADIUS atangle { + # CTR angleto { TO ++ ZINDENT atangle {TO@ANGLE+180d}}} + # LTO :< CTR angleto LTO - 90d + # + # if cond { direct } + # then { FROM [CTR clockwise] TO } + # else { FROM [CTR clockwise] LFROM [CTR clockwise] + # LMID [CTR clockwise] LTO [CTR clockwise] TO } + } + PDF @Yield {} + } + } + + import @Geometry + def @BezierPath + { + @BackEnd @Case { + PostScript @Yield { + {arrow @FromArrowLength arrowlength} + {arrow @ToArrowLength arrowlength} + "{" from "}" "{" to "}" + xindent zindent [ frompt ] [ topt ] "ldiagbezierpath" + # FROM :< from??CTR angleto frompt + # FROM :: from boundaryatangle FROM@ANGLE + # ++ {arrow @FromArrowLength arrowlength} atangle FROM@ANGLE + # TO :< topt angleto to??CTR + # TO :: to boundaryatangle { TO@ANGLE + 180d } + # ++ {arrow @ToArrowLength arrowlength} atangle { TO@ANGLE + 180d } + # LFROM :: FROM ++ { xindent atangle FROM@ANGLE } + # LFROM :< FROM@ANGLE + # LTO :: TO ++ zindent atangle { TO@ANGLE + 180d } + # LTO :< TO@ANGLE + # LMID :: { FROM ++ TO ++ frompt ++ topt } ** 0.25 + # FROM [frompt topt] TO + } + PDF @Yield {} + } + } + + import @Geometry + def @VHLinePath + { + @BackEnd @Case { + PostScript @Yield { + {arrow @FromArrowLength arrowlength} + {arrow @ToArrowLength arrowlength} + "{" from "}" "{" to "}" + xindent zindent "ldiagvhlinepath" + # CTR := { {xcoord from??CTR} {ycoord to??CTR} } + # FANG := from??CTR angleto CTR + # TANG := to??CTR angleto CTR + # FROM :: from boundaryatangle FANG + # ++ {arrow @FromArrowLength arrowlength} atangle FANG + # FROM :< FANG + # TO :: to boundaryatangle TANG + # ++ {arrow @ToArrowLength arrowlength} atangle TANG + # TO :< TANG + 180d + # FDIST := FROM distance CTR + # TDIST := TO distance CTR + # XINDENT := xindent min FDIST + # ZINDENT := zindent min TDIST + # LFROM :: FROM ++ XINDENT atangle FANG + # LFROM :< FROM@ANGLE + # LTO :: TO ++ ZINDENT atangle TANG + # LTO :< TO@ANGLE + # LMID :: CTR + # LMID :< {1f atangle {FANG + 180d}} angleto + # {1f atangle {TANG + 180d}} + # FROM LFROM LMID LTO TO + } + PDF @Yield {} + } + } + + import @Geometry + def @VHCurvePath + { + @BackEnd @Case { + PostScript @Yield { + {arrow @FromArrowLength arrowlength} + {arrow @ToArrowLength arrowlength} + "{" from "}" "{" to "}" + xindent zindent radius "ldiagvhcurvepath" + # CTR := { {xcoord from??CTR} {ycoord to??CTR} } + # FANG := from??CTR angleto CTR + # TANG := to??CTR angleto CTR + # FROM :: from boundaryatangle FANG + # ++ {arrow @FromArrowLength arrowlength} atangle FANG + # FROM :< FANG + # TO :: to boundaryatangle TANG + # ++ {arrow @ToArrowLength arrowlength} atangle TANG + # TO :< TANG + 180d + # FDIST := FROM distance CTR + # TDIST := TO distance CTR + # RADIUS := radius min FDIST min TDIST + # XINDENT := xindent min { FDIST - RADIUS } + # ZINDENT := zindent min { TDIST - RADIUS } + # LFROM :: FROM ++ XINDENT atangle FANG + # LFROM :< FROM@ANGLE + # LTO :: TO ++ ZINDENT atangle TANG + # LTO :< TO@ANGLE + # FCTR := CTR ++ RADIUS atangle { FROM@ANGLE + 180d } + # TCTR := CTR ++ RADIUS atangle { TO@ANGLE } + # XCTR := CTR ++ RADIUS atangle { FROM@ANGLE + 180d } + # ++ RADIUS atangle { TO@ANGLE } + # LMID :: XCTR ++ RADIUS atangle { XCTR angleto CTR } + # LMID :< FCTR angleto TCTR + # FROM LFROM FCTR + # { FCTR angleto TCTR } quadcase + # 0 { } + # 0-90 { [XCTR clockwise] } + # 90 { } + # 90-180 { [XCTR] } + # 180 { } + # 180-270 { [XCTR clockwise] } + # 270 { } + # 270-360 { [XCTR] } + # TCTR LTO TO + } + PDF @Yield {} + } + } + + import @Geometry + def @HVLinePath + { + @BackEnd @Case { + PostScript @Yield { + {arrow @FromArrowLength arrowlength} + {arrow @ToArrowLength arrowlength} + "{" from "}" "{" to "}" + xindent zindent "ldiaghvlinepath" + # CTR := { {xcoord to??CTR} {ycoord from??CTR} } + # FANG := from??CTR angleto CTR + # TANG := to??CTR angleto CTR + # FROM :: from boundaryatangle FANG + # ++ {arrow @FromArrowLength arrowlength} atangle FANG + # FROM :< FANG + # TO :: to boundaryatangle TANG + # ++ {arrow @ToArrowLength arrowlength} atangle TANG + # TO :< TANG + 180d + # FDIST := FROM distance CTR + # TDIST := TO distance CTR + # XINDENT := xindent min FDIST + # ZINDENT := zindent min TDIST + # LFROM :: FROM ++ XINDENT atangle FANG + # LFROM :< FROM@ANGLE + # LTO :: TO ++ ZINDENT atangle TANG + # LTO :< TO@ANGLE + # LMID :: CTR + # LMID :< {1f atangle {FANG + 180d}} angleto + # {1f atangle {TANG + 180d}} + # FROM LFROM LMID LTO TO + } + PDF @Yield {} + } + } + + import @Geometry + def @HVCurvePath + { + @BackEnd @Case { + PostScript @Yield { + {arrow @FromArrowLength arrowlength} + {arrow @ToArrowLength arrowlength} + "{" from "}" "{" to "}" + xindent zindent radius "ldiaghvcurvepath" + # CTR := { {xcoord to??CTR} {ycoord from??CTR} } + # FANG := from??CTR angleto CTR + # TANG := to??CTR angleto CTR + # FROM :: from boundaryatangle FANG + # ++ {arrow @FromArrowLength arrowlength} atangle FANG + # FROM :< FANG + # TO :: to boundaryatangle TANG + # ++ {arrow @ToArrowLength arrowlength} atangle TANG + # TO :< TANG + 180d + # FDIST := FROM distance CTR + # TDIST := TO distance CTR + # RADIUS := radius min FDIST min TDIST + # XINDENT := xindent min { FDIST - RADIUS } + # ZINDENT := zindent min { TDIST - RADIUS } + # LFROM :: FROM ++ XINDENT atangle FANG + # LFROM :< FROM@ANGLE + # LTO :: TO ++ ZINDENT atangle TANG + # LTO :< TO@ANGLE + # FCTR := CTR ++ RADIUS atangle { FROM@ANGLE + 180d } + # TCTR := CTR ++ RADIUS atangle { TO@ANGLE } + # XCTR := CTR ++ RADIUS atangle { FROM@ANGLE + 180d } + # ++ RADIUS atangle { TO@ANGLE } + # LMID :: XCTR ++ RADIUS atangle { XCTR angleto CTR } + # LMID :< FCTR angleto TCTR + # FROM LFROM FCTR + # { FCTR angleto TCTR } quadcase + # 0 { } + # 0-90 { [XCTR] } + # 90 { } + # 90-180 { [XCTR clockwise] } + # 180 { } + # 180-270 { [XCTR] } + # 270 { } + # 270-360 { [XCTR clockwise] } + # TCTR LTO TO + } + PDF @Yield {} + } + } + + import @Geometry + def @LVRLinePath + { + @BackEnd @Case { + PostScript @Yield { + {arrow @FromArrowLength arrowlength} + {arrow @ToArrowLength arrowlength} + "{" from "}" "{" to "}" + xindent zindent bias "ldiaglvrlinepath" + # FROM :: from boundaryatangle 180d + # ++ {arrow @FromArrowLength arrowlength} atangle 180d + # FROM :< 180d + # TO :: to boundaryatangle 180d + # ++ {arrow @ToArrowLength arrowlength} atangle 180d + # TO :< 0d + # XLEFT := {{xcoord FROM} min {xcoord TO}} - bias + # P1 :: { XLEFT ycoord FROM } + # P2 :: { XLEFT ycoord TO } + # VERT := P1 angleto P2 + # P1 :< P1 angleto {P1++{1f atangle 180d}++{1f atangle VERT}} + # P2 :< P2 angleto {P2++{1f atangle 0d} ++{1f atangle VERT}} + # LMID :: P1 ** 0.5 ++ P2 ** 0.5 + # LMID :< VERT + # XINDENT := xindent min {FROM distance P1} + # ZINDENT := zindent min {P2 distance TO} + # LFROM :: FROM -- { XINDENT 0 } + # LFROM :< 180d + # LTO :: TO -- { ZINDENT 0 } + # LTO :< 0d + # FROM LFROM P1 LMID P2 LTO TO + } + PDF @Yield {} + } + } + + import @Geometry + def @LVRCurvePath + { + @BackEnd @Case { + PostScript @Yield { + {arrow @FromArrowLength arrowlength} + {arrow @ToArrowLength arrowlength} + "{" from "}" "{" to "}" + xindent zindent bias radius "ldiaglvrcurvepath" + # FROM :: from boundaryatangle 180d + # ++ {arrow @FromArrowLength arrowlength} atangle 180d + # FROM :< 180d + # TO :: to boundaryatangle 180d + # ++ {arrow @ToArrowLength arrowlength} atangle 180d + # TO :< 0d + # XLEFT := {{xcoord FROM} min {xcoord TO}} - bias + # XP1 := { XLEFT ycoord FROM } + # XP2 := { XLEFT ycoord TO } + # VERT := XP1 angleto XP2 + # LMID :: XP1 ** 0.5 ++ XP2 ** 0.5 + # LMID :< VERT + # XINDENT := xindent min {FROM distance XP1} + # ZINDENT := zindent min {XP2 distance TO} + # LFROM :: FROM -- { XINDENT 0 } + # LFROM :< 180d + # LTO :: TO -- { ZINDENT 0 } + # LTO :< 0d + # RADIUS := radius min { { XP1 distance XP2 } / 2 } + # XP1PRE := XP1 ++ { RADIUS atangle 0d } + # XP1POST := XP1 ++ { RADIUS atangle VERT } + # XP1CTR := XP1PRE ++ { RADIUS atangle VERT } + # P1 :: XP1CTR ++ { RADIUS atangle { XP1CTR angleto XP1 } } + # P1 :< XP1PRE angleto XP1POST + # XP2PRE := XP2 -- { RADIUS atangle VERT } + # XP2POST := XP2 ++ { RADIUS atangle 0d } + # XP2CTR := XP2PRE ++ { RADIUS atangle 0d } + # P2 :: XP2CTR ++ { RADIUS atangle { XP2CTR angleto XP2 } } + # P2 :< XP2PRE angleto XP2POST + # FROM LFROM XP1PRE + # {round VERT} quadcase + # 90 { [XP1CTR clockwise] P1 [XP1CTR clockwise] } + # 270 { [XP1CTR] P1 [XP1CTR] } + # XP1POST LMID XP2PRE + # {round VERT} quadcase + # 90 { [XP2CTR clockwise] P2 [XP2CTR clockwise] } + # 270 { [XP2CTR] P2 [XP2CTR] } + # XP2POST LTO TO + } + PDF @Yield {} + } + } + + import @Geometry + def @RVLLinePath + { + @BackEnd @Case { + PostScript @Yield { + {arrow @FromArrowLength arrowlength} + {arrow @ToArrowLength arrowlength} + "{" from "}" "{" to "}" + xindent zindent bias "ldiagrvllinepath" + # FROM :: from boundaryatangle 0d + # ++ {arrow @FromArrowLength arrowlength} atangle 0d + # FROM :< 0d + # TO :: to boundaryatangle 0d + # ++ {arrow @ToArrowLength arrowlength} atangle 0d + # TO :< 180d + # XRIGHT := {{xcoord FROM} max {xcoord TO}} + bias + # P1 :: { XRIGHT ycoord FROM } + # P2 :: { XRIGHT ycoord TO } + # VERT := P1 angleto P2 + # P1 :< P1 angleto {P1++{1f atangle 0d} ++{1f atangle VERT}} + # P2 :< P2 angleto {P2++{1f atangle 180d}++{1f atangle VERT}} + # LMID :: P1 ** 0.5 ++ P2 ** 0.5 + # LMID :< VERT + # XINDENT := xindent min {FROM distance P1} + # ZINDENT := zindent min {P2 distance TO} + # LFROM :: FROM ++ { XINDENT 0 } + # LFROM :< 0d + # LTO :: TO ++ { ZINDENT 0 } + # LTO :< 180d + # FROM LFROM P1 LMID P2 LTO TO + } + PDF @Yield {} + } + } + + import @Geometry + def @RVLCurvePath + { + @BackEnd @Case { + PostScript @Yield { + {arrow @FromArrowLength arrowlength} + {arrow @ToArrowLength arrowlength} + "{" from "}" "{" to "}" + xindent zindent bias radius "ldiagrvlcurvepath" + # FROM :: from boundaryatangle 0d + # ++ {arrow @FromArrowLength arrowlength} atangle 0d + # FROM :< 0d + # TO :: to boundaryatangle 0d + # ++ {arrow @ToArrowLength arrowlength} atangle 0d + # TO :< 180d + # XRIGHT := {{xcoord FROM} max {xcoord TO}} + bias + # XP1 := { XRIGHT ycoord FROM } + # XP2 := { XRIGHT ycoord TO } + # VERT := XP1 angleto XP2 + # LMID :: XP1 ** 0.5 ++ XP2 ** 0.5 + # LMID :< VERT + # XINDENT := xindent min {FROM distance XP1} + # ZINDENT := zindent min {XP2 distance TO} + # LFROM :: FROM ++ { XINDENT 0 } + # LFROM :< 0d + # LTO :: TO ++ { ZINDENT 0 } + # LTO :< 180d + # RADIUS := radius min { { XP1 distance XP2 } * 0.5 } + # XP1PRE := XP1 ++ { RADIUS atangle 180d } + # XP1POST := XP1 ++ { RADIUS atangle VERT } + # XP1CTR := XP1PRE ++ { RADIUS atangle VERT } + # P1 :: XP1CTR ++ { RADIUS atangle { XP1CTR angleto XP1 } } + # P1 :< XP1PRE angleto XP1POST + # XP2PRE := XP2 -- { RADIUS atangle VERT } + # XP2POST := XP2 ++ { RADIUS atangle 180d } + # XP2CTR := XP2PRE ++ { RADIUS atangle 180d } + # P2 :: XP2CTR ++ { RADIUS atangle { XP2CTR angleto XP2 } } + # P2 :< XP2PRE angleto XP2POST + # FROM LFROM XP1PRE + # {round VERT} quadcase + # 90 { [XP1CTR] P1 [XP1CTR] } + # 270 { [XP1CTR clockwise] P1 [XP1CTR clockwise] } + # XP1POST LMID XP2PRE + # {round VERT} quadcase + # 90 { [XP2CTR] P2 [XP2CTR] } + # 270 { [XP2CTR clockwise] P2 [XP2CTR clockwise] } + # XP2POST LTO TO + } + PDF @Yield {} + } + } + + import @Geometry + def @DWrapLinePath + { + @BackEnd @Case { + PostScript @Yield { + {arrow @FromArrowLength arrowlength} + {arrow @ToArrowLength arrowlength} + "{" from "}" "{" to "}" + xindent zindent bias fbias tbias "ldiagdwraplinepath" + # DIRN := if cond { xcoord from??CTR < xcoord to??CTR } + # then { 180d } else { 0d } + # FROM :: from boundaryatangle DIRN + # ++ {arrow @FromArrowLength arrowlength} atangle DIRN + # FROM :< DIRN + # TO :: to boundaryatangle { DIRN + 180d } + # ++ {arrow @ToArrowLength arrowlength} atangle { DIRN + 180d } + # TO :< DIRN + # P1 :: FROM ++ {fbias max 0} atangle DIRN + # P1 :< if cond { DIRN = 180d } then { 225d } else { -45d } + # P4 :: TO ++ {tbias max 0} atangle { DIRN + 180d } + # P4 :< if cond { DIRN = 180d } then { 135d } else { 45d } + # YC := ycoord { from boundaryatangle 270d } min + # ycoord { to boundaryatangle 270d } + # - { bias max 0 } + # P2 :: { xcoord P1 YC } + # P2 :< P4@ANGLE - 180d + # P3 :: { xcoord P4 YC } + # P3 :< P1@ANGLE - 180d + # XINDENT := xindent min { FROM distance P1 } + # LFROM :: FROM ++ XINDENT atangle DIRN + # LFROM :< FROM@ANGLE + # ZINDENT := zindent min { TO distance P4 } + # LTO :: TO ++ ZINDENT atangle { DIRN + 180d } + # LTO :< TO@ANGLE + # LMID :: P2 ** 0.5 ++ P3 ** 0.5 + # LMID :< DIRN - 180d + # FROM P1 P2 P3 P4 TO + } + PDF @Yield {} + } + } + + import @Geometry + def @DWrapCurvePath + { + @BackEnd @Case { + PostScript @Yield { + {arrow @FromArrowLength arrowlength} + {arrow @ToArrowLength arrowlength} + "{" from "}" "{" to "}" + xindent zindent bias fbias tbias radius "ldiagdwrapcurvepath" + # DIRN := if cond { xcoord from??CTR < xcoord to??CTR } + # then { 180d } else { 0d } + # CLOCK := if cond { xcoord from??CTR < xcoord to??CTR } + # then { anticlockwise } else { clockwise } + # FROM :: from boundaryatangle DIRN + # ++ {arrow @FromArrowLength arrowlength} atangle DIRN + # FROM :< DIRN + # TO :: to boundaryatangle { DIRN + 180d } + # ++ {arrow @ToArrowLength arrowlength} atangle { DIRN + 180d } + # TO :< DIRN + # + # XP1 := FROM ++ {fbias max 0} atangle DIRN + # XP4 := TO ++ {tbias max 0} atangle { DIRN + 180d } + # YC := ycoord { from boundaryatangle 270d } min + # ycoord { to boundaryatangle 270d } + # - { bias max 0 } + # XP2 := { xcoord XP1 YC } + # XP3 := { xcoord XP4 YC } + # + # RP1 := radius min { XP1 distance FROM } min + # { { XP1 distance XP2 } / 2 } + # XP1PRE := XP1 ++ RP1 atangle { XP1 angleto FROM } + # XP1POST := XP1 ++ RP1 atangle { XP1 angleto XP2 } + # XP1CTR := XP1PRE ++ RP1 atangle { XP1 angleto XP2 } + # P1 :: XP1CTR ++ RP1 atangle { XP1CTR angleto XP1 } + # P1 :< XP1CTR angleto P1 + DIRN - 90d + # + # RP2 := radius min { { XP1 distance XP2 } / 2 } + # min { { XP2 distance XP3 } / 2 } + # XP2PRE := XP2 ++ RP2 atangle { XP2 angleto XP1 } + # XP2POST := XP2 ++ RP2 atangle { XP2 angleto XP3 } + # XP2CTR := XP2PRE ++ RP2 atangle { XP2 angleto XP3 } + # P2 :: XP2CTR ++ RP2 atangle { XP2CTR angleto XP2 } + # P2 :< XP2CTR angleto P2 + DIRN - 90d + # + # RP3 := radius min { { XP2 distance XP3 } / 2 } + # min { { XP3 distance XP4 } / 2 } + # XP3PRE := XP3 ++ RP3 atangle { XP3 angleto XP2 } + # XP3POST := XP3 ++ RP3 atangle { XP3 angleto XP4 } + # XP3CTR := XP3PRE ++ RP3 atangle { XP3 angleto XP4 } + # P3 :: XP3CTR ++ RP3 atangle { XP3CTR angleto XP3 } + # P3 :< XP3CTR angleto P3 + DIRN - 90d + # + # RP4 := radius min { { XP4 distance XP3 } / 2 } + # min { XP4 distance TO } + # XP4PRE := XP4 ++ RP4 atangle { XP4 angleto XP3 } + # XP4POST := XP4 ++ RP4 atangle { XP4 angleto TO } + # XP4CTR := XP4PRE ++ RP4 atangle { XP4 angleto TO } + # P4 :: XP4CTR ++ RP4 atangle { XP4CTR angleto XP4 } + # P4 :< XP4CTR angleto P4 + DIRN - 90d + # + # XINDENT := xindent min { FROM distance XP1PRE } + # LFROM :: FROM ++ XINDENT atangle DIRN + # LFROM :< FROM@ANGLE + # + # LMID :: XP2 ** 0.5 ++ XP3 ** 0.5 + # LMID :< DIRN - 180d + # + # ZINDENT := zindent min { TO distance XP4POST } + # LTO :: TO ++ ZINDENT atangle { DIRN + 180d } + # LTO :< TO@ANGLE + # + # FROM LFROM + # XP1PRE [XP1CTR CLOCK] XP1POST + # XP2PRE [XP2CTR CLOCK] XP2POST + # LMID + # XP3PRE [XP3CTR CLOCK] XP3POST + # XP4PRE [XP4CTR CLOCK] XP4POST + # LTO TO + } + PDF @Yield {} + } + } + + import @Geometry + def @UWrapLinePath + { + @BackEnd @Case { + PostScript @Yield { + {arrow @FromArrowLength arrowlength} + {arrow @ToArrowLength arrowlength} + "{" from "}" "{" to "}" + xindent zindent bias fbias tbias "ldiaguwraplinepath" + # DIRN := if cond { xcoord from??CTR < xcoord to??CTR } + # then { 180d } else { 0d } + # FROM :: from boundaryatangle DIRN + # ++ {arrow @FromArrowLength arrowlength} atangle DIRN + # FROM :< DIRN + # TO :: to boundaryatangle { DIRN + 180d } + # ++ {arrow @ToArrowLength arrowlength} atangle { DIRN + 180d } + # TO :< DIRN + # P1 :: FROM ++ {fbias max 0} atangle DIRN + # P1 :< if cond { DIRN = 180d } then { 135d } else { 45d } + # P4 :: TO ++ {tbias max 0} atangle { DIRN + 180d } + # P4 :< if cond { DIRN = 180d } then { 225d } else { -45d } + # YC := ycoord { from boundaryatangle 90d } max + # ycoord { to boundaryatangle 90d } + # + { bias max 0 } + # P2 :: { xcoord P1 YC } + # P2 :< P4@ANGLE - 180d + # P3 :: { xcoord P4 YC } + # P3 :< P1@ANGLE - 180d + # XINDENT := xindent min { FROM distance P1 } + # LFROM :: FROM ++ XINDENT atangle DIRN + # LFROM :< FROM@ANGLE + # ZINDENT := zindent min { TO distance P4 } + # LTO :: TO ++ ZINDENT atangle { DIRN + 180d } + # LTO :< TO@ANGLE + # LMID :: P2 ** 0.5 ++ P3 ** 0.5 + # LMID :< DIRN - 180d + # FROM P1 P2 P3 P4 TO + } + PDF @Yield {} + } + } + + import @Geometry + def @UWrapCurvePath + { + @BackEnd @Case { + PostScript @Yield { + {arrow @FromArrowLength arrowlength} + {arrow @ToArrowLength arrowlength} + "{" from "}" "{" to "}" + xindent zindent bias fbias tbias radius "ldiaguwrapcurvepath" + # DIRN := if cond { xcoord from??CTR < xcoord to??CTR } + # then { 180d } else { 0d } + # CLOCK := if cond { xcoord from??CTR < xcoord to??CTR } + # then { clockwise } else { anticlockwise } + # FROM :: from boundaryatangle DIRN + # ++ {arrow @FromArrowLength arrowlength} atangle DIRN + # FROM :< DIRN + # TO :: to boundaryatangle { DIRN + 180d } + # ++ {arrow @ToArrowLength arrowlength} atangle { DIRN + 180d } + # TO :< DIRN + # + # XP1 := FROM ++ {fbias max 0} atangle DIRN + # XP4 := TO ++ {tbias max 0} atangle { DIRN + 180d } + # YC := ycoord { from boundaryatangle 90d } max + # ycoord { to boundaryatangle 90d } + # + { bias max 0 } + # XP2 := { xcoord XP1 YC } + # XP3 := { xcoord XP4 YC } + # + # RP1 := radius min { XP1 distance FROM } min + # { { XP1 distance XP2 } / 2 } + # XP1PRE := XP1 ++ RP1 atangle { XP1 angleto FROM } + # XP1POST := XP1 ++ RP1 atangle { XP1 angleto XP2 } + # XP1CTR := XP1PRE ++ RP1 atangle { XP1 angleto XP2 } + # P1 :: XP1CTR ++ RP1 atangle { XP1CTR angleto XP1 } + # P1 :< XP1CTR angleto P1 + DIRN + 90d + # + # RP2 := radius min { { XP1 distance XP2 } / 2 } + # min { { XP2 distance XP3 } / 2 } + # XP2PRE := XP2 ++ RP2 atangle { XP2 angleto XP1 } + # XP2POST := XP2 ++ RP2 atangle { XP2 angleto XP3 } + # XP2CTR := XP2PRE ++ RP2 atangle { XP2 angleto XP3 } + # P2 :: XP2CTR ++ RP2 atangle { XP2CTR angleto XP2 } + # P2 :< XP2CTR angleto P2 + DIRN + 90d + # + # RP3 := radius min { { XP2 distance XP3 } / 2 } + # min { { XP3 distance XP4 } / 2 } + # XP3PRE := XP3 ++ RP3 atangle { XP3 angleto XP2 } + # XP3POST := XP3 ++ RP3 atangle { XP3 angleto XP4 } + # XP3CTR := XP3PRE ++ RP3 atangle { XP3 angleto XP4 } + # P3 :: XP3CTR ++ RP3 atangle { XP3CTR angleto XP3 } + # P3 :< XP3CTR angleto P3 + DIRN + 90d + # + # RP4 := radius min { { XP4 distance XP3 } / 2 } + # min { XP4 distance TO } + # XP4PRE := XP4 ++ RP4 atangle { XP4 angleto XP3 } + # XP4POST := XP4 ++ RP4 atangle { XP4 angleto TO } + # XP4CTR := XP4PRE ++ RP4 atangle { XP4 angleto TO } + # P4 :: XP4CTR ++ RP4 atangle { XP4CTR angleto XP4 } + # P4 :< XP4CTR angleto P4 + DIRN + 90d + # + # XINDENT := xindent min { FROM distance XP1PRE } + # LFROM :: FROM ++ XINDENT atangle DIRN + # LFROM :< FROM@ANGLE + # + # LMID :: XP2 ** 0.5 ++ XP3 ** 0.5 + # LMID :< DIRN - 180d + # + # ZINDENT := zindent min { TO distance XP4POST } + # LTO :: TO ++ ZINDENT atangle { DIRN + 180d } + # LTO :< TO@ANGLE + # + # FROM LFROM + # XP1PRE [XP1CTR CLOCK] XP1POST + # XP2PRE [XP2CTR CLOCK] XP2POST + # LMID + # XP3PRE [XP3CTR CLOCK] XP3POST + # XP4PRE [XP4CTR CLOCK] XP4POST + # LTO TO + } + PDF @Yield {} + } + } + + import @Geometry + def @Path + { + path @Case { + line @Yield @LinePath + doubleline @Yield @DoubleLinePath + { acurve curve } @Yield @ACurvePath + ccurve @Yield @CCurvePath + bezier @Yield @BezierPath + vhline @Yield @VHLinePath + vhcurve @Yield @VHCurvePath + hvline @Yield @HVLinePath + hvcurve @Yield @HVCurvePath + lvrline @Yield @LVRLinePath + lvrcurve @Yield @LVRCurvePath + rvlline @Yield @RVLLinePath + rvlcurve @Yield @RVLCurvePath + dwrapline @Yield @DWrapLinePath + dwrapcurve @Yield @DWrapCurvePath + uwrapline @Yield @UWrapLinePath + uwrapcurve @Yield @UWrapCurvePath + else @Yield { + path + from { from } + to { to } + bias { bias } + fbias { fbias } + tbias { tbias } + radius { radius } + xindent { xindent } + zindent { zindent } + frompt { frompt } + topt { topt } + arrow { arrow } + arrowlength { arrowlength } + } + } + } + + def @FromLabel + { + @DoLabel + which { "f" } + label { fromlabel @Else @FromArrow } + labelmargin { fromlabelmargin } + labelfont { fromlabelfont } + labelbreak { fromlabelbreak } + labelformat { fromlabelformat @Body } + labelpos { fromlabelpos } + labelprox { fromlabelprox } + labelangle { fromlabelangle } + labelctr { fromlabelctr } + labeladjust { fromlabeladjust } + } + + def @ToLabel + { + @DoLabel + which { "t" } + label { tolabel @Else @ToArrow } + labelmargin { tolabelmargin } + labelfont { tolabelfont } + labelbreak { tolabelbreak } + labelformat { tolabelformat @Body } + labelpos { tolabelpos } + labelprox { tolabelprox } + labelangle { tolabelangle } + labelctr { tolabelctr } + labeladjust { tolabeladjust } + } + + def @Direct + { + pathstyle @Case { + { "/ldiagsolid" "/ldiagdashed" "/ldiagcdashed" + "/ldiagdotted" "/ldiagnoline" } @Yield 1 + else @Yield 0 + } + } + + @BackEnd @Case { + PostScript @Yield { + + @Null & # so that preceding space gets chewed up + { + @Direct "ldiaglinkbegin [" @Path "]" pathdashlength + "[" pathstyle "]" pathwidth "ldiaglinkend" + } + @Graphic + { + / { fromlabel @Else @FromArrow} @IfNonEmpty @FromLabel + / { xlabel @Else linklabel } @IfNonEmpty @XLabel + / { ylabel @Else linklabel } @IfNonEmpty @YLabel + / { zlabel @Else linklabel } @IfNonEmpty @ZLabel + / { tolabel @Else @ToArrow } @IfNonEmpty @ToLabel + } + + } + PDF @Yield {} + } + } + + + def @ObjectLink + precedence 90 + associativity left + left x + named treehsep { treehsep } + named treevsep { treevsep } + named format + named x {} + named y {} + named insinuatelink {} + named treehsep {} + named treevsep {} + { x | y | insinuatelink } + import @Geometry named path + named from {} + named to {} + named bias {} + named fbias {} + named tbias {} + named radius {} + named xindent {} + named zindent {} + named frompt {} + named topt {} + named arrow {} + named arrowlength {} + { path + from { from } + to { to } + bias { bias } + fbias { fbias } + tbias { tbias } + radius { radius } + xindent { xindent } + zindent { zindent } + frompt { frompt } + topt { topt } + arrow { arrow } + arrowlength { arrowlength } + } + import @Geometry named basefrom { } + import @Geometry named baseto { } + import @Geometry named from { } + import @Geometry named to { } + import @Geometry named bias { bias } + import @Geometry named fbias { fbias } + import @Geometry named tbias { tbias } + import @Geometry named radius { radius } + import @Geometry named xindent { xindent } + import @Geometry named zindent { zindent } + import @Geometry named frompt { frompt } + import @Geometry named topt { topt } + named pathstyle + named solid { "/ldiagsolid" } + named dashed { "/ldiagdashed" } + named cdashed { "/ldiagcdashed" } + named dotted { "/ldiagdotted" } + named noline { "/ldiagnoline" } + { pathstyle } + import @Geometry named pathdashlength { pathdashlength } + import @Geometry named pathwidth + named thin { 0.04 ft } + named medium { 0.08 ft } + named thick { 0.12 ft } + { pathwidth } + import @Geometry named pathgap + named thin { 0.08 ft } + named medium { 0.16 ft } + named thick { 0.24 ft } + { pathgap } + + named arrow { arrow } + named arrowstyle { arrowstyle } + named arrowwidth { arrowwidth } + named arrowlength { arrowlength } + + named linklabel { linklabel } + named linklabelmargin { linklabelmargin } + named linklabelfont { linklabelfont } + named linklabelbreak { linklabelbreak } + named linklabelformat right @Body { linklabelformat @Body } + import @Geometry named linklabelpos { linklabelpos } + named linklabelprox { linklabelprox } + import @Geometry named linklabelangle { linklabelangle } + named linklabelctr { linklabelctr } + import @Geometry named linklabeladjust { linklabeladjust } + + named xlabel { xlabel } + named xlabelmargin { xlabelmargin } + named xlabelfont { xlabelfont } + named xlabelbreak { xlabelbreak } + named xlabelformat right @Body { xlabelformat @Body } + import @Geometry named xlabelpos { xlabelpos } + named xlabelprox { xlabelprox } + import @Geometry named xlabelangle { xlabelangle } + named xlabelctr { xlabelctr } + import @Geometry named xlabeladjust { xlabeladjust } + + named ylabel { ylabel } + named ylabelmargin { ylabelmargin } + named ylabelfont { ylabelfont } + named ylabelbreak { ylabelbreak } + named ylabelformat right @Body { ylabelformat @Body } + import @Geometry named ylabelpos { ylabelpos } + named ylabelprox { ylabelprox } + import @Geometry named ylabelangle { ylabelangle } + named ylabelctr { ylabelctr } + import @Geometry named ylabeladjust { ylabeladjust } + + named zlabel { zlabel } + named zlabelmargin { zlabelmargin } + named zlabelfont { zlabelfont } + named zlabelbreak { zlabelbreak } + named zlabelformat right @Body { zlabelformat @Body } + import @Geometry named zlabelpos { zlabelpos } + named zlabelprox { zlabelprox } + import @Geometry named zlabelangle { zlabelangle } + named zlabelctr { zlabelctr } + import @Geometry named zlabeladjust { zlabeladjust } + + named fromlabel { fromlabel } + named fromlabelmargin { fromlabelmargin } + named fromlabelfont { fromlabelfont } + named fromlabelbreak { fromlabelbreak } + named fromlabelformat right @Body { fromlabelformat @Body } + import @Geometry named fromlabelpos { fromlabelpos } + named fromlabelprox { fromlabelprox } + import @Geometry named fromlabelangle { fromlabelangle } + named fromlabelctr { fromlabelctr } + import @Geometry named fromlabeladjust { fromlabeladjust } + + named tolabel { tolabel } + named tolabelmargin { tolabelmargin } + named tolabelfont { tolabelfont } + named tolabelbreak { tolabelbreak } + named tolabelformat right @Body { tolabelformat @Body } + import @Geometry named tolabelpos { tolabelpos } + named tolabelprox { tolabelprox } + import @Geometry named tolabelangle { tolabelangle } + named tolabelctr { tolabelctr } + import @Geometry named tolabeladjust{ tolabeladjust } + right y + + { + def @From + { + from @Case { + "" @Yield basefrom + else @Yield { basefrom"@"from } + } + } + + def @To + { + to @Case { + "" @Yield baseto + else @Yield { baseto"@"to } + } + } + + format + x { x } + y { y } + treehsep { treehsep } + treevsep { treevsep } + insinuatelink { + @Link + from { @From } + to { @To } + bias { bias } + fbias { fbias } + tbias { tbias } + radius { radius } + xindent { xindent } + zindent { zindent } + frompt { frompt } + topt { topt } + path { path + from { @From } + to { @To } + bias { bias } + fbias { fbias } + tbias { tbias } + radius { radius } + xindent { xindent } + zindent { zindent } + frompt { frompt } + topt { topt } + arrow { arrow } + arrowlength { arrowlength } + } + pathstyle { pathstyle } + pathdashlength { pathdashlength } + pathwidth { pathwidth } + pathgap { pathgap } + arrow { arrow } + arrowstyle { arrowstyle } + arrowwidth { arrowwidth } + arrowlength { arrowlength } + + linklabel { linklabel } + linklabelmargin { linklabelmargin } + linklabelfont { linklabelfont } + linklabelbreak { linklabelbreak } + linklabelformat { linklabelformat @Body } + linklabelpos { linklabelpos } + linklabelprox { linklabelprox } + linklabelangle { linklabelangle } + linklabelctr { linklabelctr } + linklabeladjust { linklabeladjust } + + xlabel { xlabel } + xlabelmargin { xlabelmargin } + xlabelfont { xlabelfont } + xlabelbreak { xlabelbreak } + xlabelformat { xlabelformat @Body } + xlabelpos { xlabelpos } + xlabelprox { xlabelprox } + xlabelangle { xlabelangle } + xlabelctr { xlabelctr } + xlabeladjust { xlabeladjust } + + ylabel { ylabel } + ylabelmargin { ylabelmargin } + ylabelfont { ylabelfont } + ylabelbreak { ylabelbreak } + ylabelformat { ylabelformat @Body } + ylabelpos { ylabelpos } + ylabelprox { ylabelprox } + ylabelangle { ylabelangle } + ylabelctr { ylabelctr } + ylabeladjust { ylabeladjust } + + zlabel { zlabel } + zlabelmargin { zlabelmargin } + zlabelfont { zlabelfont } + zlabelbreak { zlabelbreak } + zlabelformat { zlabelformat @Body } + zlabelpos { zlabelpos } + zlabelprox { zlabelprox } + zlabelangle { zlabelangle } + zlabelctr { zlabelctr } + zlabeladjust { zlabeladjust } + + fromlabel { fromlabel } + fromlabelmargin { fromlabelmargin } + fromlabelfont { fromlabelfont } + fromlabelbreak { fromlabelbreak } + fromlabelformat { fromlabelformat @Body } + fromlabelpos { fromlabelpos } + fromlabelprox { fromlabelprox } + fromlabelangle { fromlabelangle } + fromlabelctr { fromlabelctr } + fromlabeladjust { fromlabeladjust } + + tolabel { tolabel } + tolabelmargin { tolabelmargin } + tolabelfont { tolabelfont } + tolabelbreak { tolabelbreak } + tolabelformat { tolabelformat @Body } + tolabelpos { tolabelpos } + tolabelprox { tolabelprox } + tolabelangle { tolabelangle } + tolabelctr { tolabelctr } + tolabeladjust { tolabeladjust } + } + } + + macro @Line { @Link path { line } } + macro @DoubleLine { @Link path { doubleline } } + macro @Arrow { @Link path { line } arrow { yes } } + macro @DoubleArrow { @Link path {doubleline} arrow { yes } } + macro @Curve { @Link path { curve } } + macro @CurveArrow { @Link path { curve } arrow { yes } } + macro @ACurve { @Link path { acurve } } + macro @ACurveArrow { @Link path { acurve } arrow { yes } } + macro @CCurve { @Link path { ccurve } } + macro @CCurveArrow { @Link path { ccurve } arrow { yes } } + + macro @Bezier { @Link path { bezier } } + macro @BezierArrow { @Link path { bezier } arrow { yes } } + + macro @HVLine { @Link path { hvline } } + macro @HVArrow { @Link path { hvline } arrow { yes } } + macro @VHLine { @Link path { vhline } } + macro @VHArrow { @Link path { vhline } arrow { yes } } + macro @HVCurve { @Link path { hvcurve } } + macro @HVCurveArrow { @Link path { hvcurve } arrow { yes } } + macro @VHCurve { @Link path { vhcurve } } + macro @VHCurveArrow { @Link path { vhcurve } arrow { yes } } + + macro @LVRLine { @Link path { lvrline } } + macro @LVRArrow { @Link path { lvrline } arrow { yes } } + macro @RVLLine { @Link path { rvlline } } + macro @RVLArrow { @Link path { rvlline } arrow { yes } } + macro @LVRCurve { @Link path { lvrcurve } } + macro @LVRCurveArrow { @Link path { lvrcurve } arrow { yes } } + macro @RVLCurve { @Link path { rvlcurve } } + macro @RVLCurveArrow { @Link path { rvlcurve } arrow { yes } } + + macro @DWrapLine { @Link path { dwrapline} } + macro @DWrapArrow { @Link path { dwrapline} arrow { yes } } + macro @UWrapLine { @Link path { uwrapline} } + macro @UWrapArrow { @Link path { uwrapline} arrow { yes } } + macro @DWrapCurve { @Link path {dwrapcurve} } + macro @DWrapCurveArrow { @Link path {dwrapcurve} arrow { yes } } + macro @UWrapCurve { @Link path {uwrapcurve} } + macro @UWrapCurveArrow { @Link path {uwrapcurve} arrow { yes } } + + export + + @Node @Box @CurveBox @ShadowBox @Square @Diamond + @Polygon @Isosceles @Ellipse @Circle + @LeftSub @ZeroWidthLeftSub @RightSub @ZeroWidthRightSub + @FirstSub @NextSub @StubSub + + def @Tree + named treehindent + named left { 0.0rt } + named ctr { 0.5rt } + named right { 1.0rt } + { treehindent } + body x + { + + macro @TNode { @@Node nodetag { T } } + macro @Node { @TNode } + macro @Box { @TNode outline { box } } + macro @CurveBox { @TNode outline { curvebox } } + macro @ShadowBox { @TNode outline { shadowbox } } + macro @Square { @TNode outline { square } } + macro @Diamond { @TNode outline { diamond } } + macro @Polygon { @TNode outline { polygon } } + macro @Isosceles { @TNode outline { isosceles } } + macro @Ellipse { @TNode outline { ellipse } } + macro @Circle { @TNode outline { circle } } + + def fixroot + precedence 90 + left root + { + |treehindent root + } + + macro @LeftSub + { + @ObjectLink + basefrom { T } + baseto { L@T } + format { { /treevsep {L::y} } |treehsep x | insinuatelink } + } + + macro @ZeroWidthLeftSub + { + @ObjectLink + basefrom { T } + baseto { L@T } + format { { /treevsep @ZeroWidth { {L::y} ^|treehsep } } | + x | insinuatelink } + } + + macro @FirstSub + { + fixroot // + @ObjectLink + basefrom { T } + baseto { S@T } + format { //treevsep {S::y} | insinuatelink | } + } + + macro @NextSub + { + @ObjectLink + basefrom { T } + baseto { S@T } + format { x |treehsep { / {S::y} | insinuatelink | } } + } + + macro @RightSub + { + @ObjectLink + basefrom { T } + baseto { R@T } + format { x |treehsep { /treevsep {R::y} } | insinuatelink } + } + + macro @ZeroWidthRightSub + { + @ObjectLink + basefrom { T } + baseto { R@T } + format { x | { /treevsep @ZeroWidth { |treehsep {R::y} } } + | insinuatelink } + } + + macro @StubSub + { + @ObjectLink + basefrom { T } + baseto { T } + format { @VContract { |0.5rt x | // |0.5rt + S:: @BoxLabels @CatchTags y | } | insinuatelink } + # path { from S@T@SW S@T@SE to } + path { + P1:: S@SW + P2:: S@SE + FROM:: from boundaryatangle { from??CTR angleto P1 } + TO:: to boundaryatangle { to??CTR angleto P2 } + FROM P1 P2 TO + } + } + + @HContract @VContract x + } + + export + + @Node @Box @CurveBox @ShadowBox @Square @Diamond + @Polygon @Isosceles @Ellipse @Circle + @LeftSub @ZeroWidthLeftSub @RightSub @ZeroWidthRightSub + @FirstSub @NextSub @StubSub + + def @HTree + named treevindent + named top { 0.0rt } + named ctr { 0.5rt } + named foot { 1.0rt } + { treevindent } + body x + { + + macro @TNode { @@Node nodetag { T } } + macro @Node { @TNode } + macro @Box { @TNode outline { box } } + macro @CurveBox { @TNode outline { curvebox } } + macro @ShadowBox { @TNode outline { shadowbox } } + macro @Square { @TNode outline { square } } + macro @Diamond { @TNode outline { diamond } } + macro @Polygon { @TNode outline { polygon } } + macro @Isosceles { @TNode outline { isosceles } } + macro @Ellipse { @TNode outline { ellipse } } + macro @Circle { @TNode outline { circle } } + + def fixroot + precedence 90 + left root + { + /treevindent root + } + + macro @LeftSub + { + @ObjectLink + basefrom { T } + baseto { L@T } + format { { |treehsep {L::y} } /treevsep x / insinuatelink } + } + + macro @ZeroWidthLeftSub + { + @ObjectLink + basefrom { T } + baseto { L@T } + format { { |treehsep @ZeroWidth { {L::y} ^/treevsep } } / + x / insinuatelink } + } + + macro @FirstSub + { + fixroot || + @ObjectLink + basefrom { T } + baseto { S@T } + format { ||treehsep { {S::y} / insinuatelink / } } + } + + macro @NextSub + { + @ObjectLink + basefrom { T } + baseto { S@T } + format { x /treevsep { | {S::y} { / insinuatelink / } } } + } + + macro @RightSub + { + @ObjectLink + basefrom { T } + baseto { R@T } + format { x /treevsep { |treehsep {R::y} } / insinuatelink } + } + + macro @ZeroWidthRightSub + { + @ObjectLink + basefrom { T } + baseto { R@T } + format { x / { |treehsep @ZeroWidth { /treevsep {R::y} } } + / insinuatelink } + } + + macro @StubSub + { + @ObjectLink + basefrom { T } + baseto { T } + format { @VContract { { /0.5rt x / } || { /0.5rt + S:: @BoxLabels @CatchTags y / } } / insinuatelink } + # path { from S@T@SW S@T@SE to } + path { + P1:: S@NE + P2:: S@SE + FROM:: from boundaryatangle { from??CTR angleto P1 } + TO:: to boundaryatangle { to??CTR angleto P2 } + FROM P1 P2 TO + } + } + + @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 {} + } + + @End @Diag +} |