|
###############################################################################
# #
# Lout @Diag package for drawing diagrams #
# Version 1.1 (February 2000) #
# Jeffrey H. Kingston #
# #
# Version 1.0 (July 1996) #
# Based on Version 2.0 of the @Fig package (Jeffrey H. Kingston, Dec 1992). #
# #
###############################################################################
@SysInclude { diagf.etc } # @Geometry
@SysInclude { coltex } # @ColourCommand and @TextureCommand
@SysPrependGraphic { diagf.lpg }
###############################################################################
# #
# @DiagSetup symbol #
# #
###############################################################################
export @Diag @SyntaxDiag
def @DiagSetup
named save { no }
named maxlabels { 200 }
named title { "--titledft--" }
named titleformat
left @Title
right @Body
{ Slope @Font @Title //0.7f ||0.35f @Body }
###########################################################################
# #
# @Node options of @DiagSetup #
# #
###########################################################################
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 dotdashed { "/ldiagdotdashed" }
named dotcdashed { "/ldiagdotcdashed" }
named dotdotdashed { "/ldiagdotdotdashed" }
named dotdotcdashed { "/ldiagdotdotcdashed" }
named dotdotdotdashed { "/ldiagdotdotdotdashed" }
named dotdotdotcdashed { "/ldiagdotdotdotcdashed" }
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 { none }
import @TextureImport named texture { solid }
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 { }
import @Geometry named nodelabelangle { horizontal }
named nodelabelprox { outside }
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 }
import @Geometry named alabelangle { }
named alabelprox { }
named alabelctr { }
import @Geometry named alabeladjust { }
named blabel { }
named blabelmargin { }
named blabelfont { }
named blabelbreak { }
named blabelformat right @Body { }
import @Geometry named blabelpos { NW }
import @Geometry named blabelangle { }
named blabelprox { }
named blabelctr { }
import @Geometry named blabeladjust { }
named clabel { }
named clabelmargin { }
named clabelfont { }
named clabelbreak { }
named clabelformat right @Body { }
import @Geometry named clabelpos { SW }
import @Geometry named clabelangle { }
named clabelprox { }
named clabelctr { }
import @Geometry named clabeladjust { }
named dlabel { }
named dlabelmargin { }
named dlabelfont { }
named dlabelbreak { }
named dlabelformat right @Body { }
import @Geometry named dlabelpos { SE }
import @Geometry named dlabelangle { }
named dlabelprox { }
named dlabelctr { }
import @Geometry named dlabeladjust { }
###########################################################################
# #
# @ANode options of @DiagSetup #
# #
###########################################################################
import @Geometry named aoutline
named margin {}
named shadow {}
named sides {}
named angle {}
{ box }
named amargin { 0.6f }
import @Geometry named ashadow { 0.4f }
import @Geometry named asides { 3 }
import @Geometry named aangle { "dup 180 exch div" }
named atranslate { }
named aoutlinestyle
named solid { "/ldiagsolid" }
named dashed { "/ldiagdashed" }
named cdashed { "/ldiagcdashed" }
named dotdashed { "/ldiagdotdashed" }
named dotcdashed { "/ldiagdotcdashed" }
named dotdotdashed { "/ldiagdotdotdashed" }
named dotdotcdashed { "/ldiagdotdotcdashed" }
named dotdotdotdashed { "/ldiagdotdotdotdashed" }
named dotdotdotcdashed { "/ldiagdotdotdotcdashed" }
named dotted { "/ldiagdotted" }
named noline { "/ldiagnoline" }
{ solid }
import @Geometry named aoutlinedashlength { 0.2f }
import @Geometry named aoutlinewidth
named thin { 0.04 ft }
named medium { 0.08 ft }
named thick { 0.12 ft }
{ thin }
named apaint { none }
import @TextureImport named atexture{ solid }
named afont { }
named abreak { }
named aformat right @Body { @Body }
named avalign { ctr }
named avsize { }
named avindent { ctr }
named avstrut
named no { 0.0f }
named yes { 1.0f }
{ no }
named avmargin { }
named atopmargin { }
named afootmargin { }
named ahalign { ctr }
named ahsize { }
named ahindent { ctr }
named ahstrut
named no { 0.0f }
named yes { 1.0f }
{ no }
named ahmargin { }
named aleftmargin { }
named arightmargin { }
named anodelabel { }
named anodelabelmargin { 0.2f }
named anodelabelfont { -2p }
named anodelabelbreak { ragged nohyphen }
named anodelabelformat right @Body { @Body }
import @Geometry named anodelabelpos{ }
import @Geometry named anodelabelangle { horizontal }
named anodelabelprox { outside }
named anodelabelctr { no }
import @Geometry named anodelabeladjust { 0 0 }
named aalabel { }
named aalabelmargin { }
named aalabelfont { }
named aalabelbreak { }
named aalabelformat right @Body { }
import @Geometry named aalabelpos { NE }
import @Geometry named aalabelangle { }
named aalabelprox { }
named aalabelctr { }
import @Geometry named aalabeladjust{ }
named ablabel { }
named ablabelmargin { }
named ablabelfont { }
named ablabelbreak { }
named ablabelformat right @Body { }
import @Geometry named ablabelpos { NW }
import @Geometry named ablabelangle { }
named ablabelprox { }
named ablabelctr { }
import @Geometry named ablabeladjust{ }
named aclabel { }
named aclabelmargin { }
named aclabelfont { }
named aclabelbreak { }
named aclabelformat right @Body { }
import @Geometry named aclabelpos { SW }
import @Geometry named aclabelangle { }
named aclabelprox { }
named aclabelctr { }
import @Geometry named aclabeladjust{ }
named adlabel { }
named adlabelmargin { }
named adlabelfont { }
named adlabelbreak { }
named adlabelformat right @Body { }
import @Geometry named adlabelpos { SE }
import @Geometry named adlabelangle { }
named adlabelprox { }
named adlabelctr { }
import @Geometry named adlabeladjust{ }
###########################################################################
# #
# @BNode options of @DiagSetup #
# #
###########################################################################
import @Geometry named boutline
named margin {}
named shadow {}
named sides {}
named angle {}
{ box }
named bmargin { 0.6f }
import @Geometry named bshadow { 0.4f }
import @Geometry named bsides { 3 }
import @Geometry named bangle { "dup 180 exch div" }
named btranslate { }
named boutlinestyle
named solid { "/ldiagsolid" }
named dashed { "/ldiagdashed" }
named cdashed { "/ldiagcdashed" }
named dotdashed { "/ldiagdotdashed" }
named dotcdashed { "/ldiagdotcdashed" }
named dotdotdashed { "/ldiagdotdotdashed" }
named dotdotcdashed { "/ldiagdotdotcdashed" }
named dotdotdotdashed { "/ldiagdotdotdotdashed" }
named dotdotdotcdashed { "/ldiagdotdotdotcdashed" }
named dotted { "/ldiagdotted" }
named noline { "/ldiagnoline" }
{ solid }
import @Geometry named boutlinedashlength { 0.2f }
import @Geometry named boutlinewidth
named thin { 0.04 ft }
named medium { 0.08 ft }
named thick { 0.12 ft }
{ thin }
named bpaint { none }
import @TextureImport named btexture{ solid }
named bfont { }
named bbreak { }
named bformat right @Body { @Body }
named bvalign { ctr }
named bvsize { }
named bvindent { ctr }
named bvstrut
named no { 0.0f }
named yes { 1.0f }
{ no }
named bvmargin { }
named btopmargin { }
named bfootmargin { }
named bhalign { ctr }
named bhsize { }
named bhindent { ctr }
named bhstrut
named no { 0.0f }
named yes { 1.0f }
{ no }
named bhmargin { }
named bleftmargin { }
named brightmargin { }
named bnodelabel { }
named bnodelabelmargin { 0.2f }
named bnodelabelfont { -2p }
named bnodelabelbreak { ragged nohyphen }
named bnodelabelformat right @Body { @Body }
import @Geometry named bnodelabelpos{ }
import @Geometry named bnodelabelangle { horizontal }
named bnodelabelprox { outside }
named bnodelabelctr { no }
import @Geometry named bnodelabeladjust { 0 0 }
named balabel { }
named balabelmargin { }
named balabelfont { }
named balabelbreak { }
named balabelformat right @Body { }
import @Geometry named balabelpos { NE }
named balabelprox { }
import @Geometry named balabelangle { }
named balabelctr { }
import @Geometry named balabeladjust{ }
named bblabel { }
named bblabelmargin { }
named bblabelfont { }
named bblabelbreak { }
named bblabelformat right @Body { }
import @Geometry named bblabelpos { NW }
named bblabelprox { }
import @Geometry named bblabelangle { }
named bblabelctr { }
import @Geometry named bblabeladjust{ }
named bclabel { }
named bclabelmargin { }
named bclabelfont { }
named bclabelbreak { }
named bclabelformat right @Body { }
import @Geometry named bclabelpos { SW }
named bclabelprox { }
import @Geometry named bclabelangle { }
named bclabelctr { }
import @Geometry named bclabeladjust{ }
named bdlabel { }
named bdlabelmargin { }
named bdlabelfont { }
named bdlabelbreak { }
named bdlabelformat right @Body { }
import @Geometry named bdlabelpos { SE }
named bdlabelprox { }
import @Geometry named bdlabelangle { }
named bdlabelctr { }
import @Geometry named bdlabeladjust{ }
###########################################################################
# #
# @CNode options of @DiagSetup #
# #
###########################################################################
import @Geometry named coutline
named margin {}
named shadow {}
named sides {}
named angle {}
{ box }
named cmargin { 0.6f }
import @Geometry named cshadow { 0.4f }
import @Geometry named csides { 3 }
import @Geometry named cangle { "dup 180 exch div" }
named ctranslate { }
named coutlinestyle
named solid { "/ldiagsolid" }
named dashed { "/ldiagdashed" }
named cdashed { "/ldiagcdashed" }
named dotdashed { "/ldiagdotdashed" }
named dotcdashed { "/ldiagdotcdashed" }
named dotdotdashed { "/ldiagdotdotdashed" }
named dotdotcdashed { "/ldiagdotdotcdashed" }
named dotdotdotdashed { "/ldiagdotdotdotdashed" }
named dotdotdotcdashed { "/ldiagdotdotdotcdashed" }
named dotted { "/ldiagdotted" }
named noline { "/ldiagnoline" }
{ solid }
import @Geometry named coutlinedashlength { 0.2f }
import @Geometry named coutlinewidth
named thin { 0.04 ft }
named medium { 0.08 ft }
named thick { 0.12 ft }
{ thin }
named cpaint { none }
import @TextureImport named ctexture{ solid }
named cfont { }
named cbreak { }
named cformat right @Body { @Body }
named cvalign { ctr }
named cvsize { }
named cvindent { ctr }
named cvstrut
named no { 0.0f }
named yes { 1.0f }
{ no }
named cvmargin { }
named ctopmargin { }
named cfootmargin { }
named chalign { ctr }
named chsize { }
named chindent { ctr }
named chstrut
named no { 0.0f }
named yes { 1.0f }
{ no }
named chmargin { }
named cleftmargin { }
named crightmargin { }
named cnodelabel { }
named cnodelabelmargin { 0.2f }
named cnodelabelfont { -2p }
named cnodelabelbreak { ragged nohyphen }
named cnodelabelformat right @Body { @Body }
import @Geometry named cnodelabelpos{ }
import @Geometry named cnodelabelangle { horizontal }
named cnodelabelprox { outside }
named cnodelabelctr { no }
import @Geometry named cnodelabeladjust { 0 0 }
named calabel { }
named calabelmargin { }
named calabelfont { }
named calabelbreak { }
named calabelformat right @Body { }
import @Geometry named calabelpos { NE }
import @Geometry named calabelangle { }
named calabelprox { }
named calabelctr { }
import @Geometry named calabeladjust{ }
named cblabel { }
named cblabelmargin { }
named cblabelfont { }
named cblabelbreak { }
named cblabelformat right @Body { }
import @Geometry named cblabelpos { NW }
import @Geometry named cblabelangle { }
named cblabelprox { }
named cblabelctr { }
import @Geometry named cblabeladjust{ }
named cclabel { }
named cclabelmargin { }
named cclabelfont { }
named cclabelbreak { }
named cclabelformat right @Body { }
import @Geometry named cclabelpos { SW }
import @Geometry named cclabelangle { }
named cclabelprox { }
named cclabelctr { }
import @Geometry named cclabeladjust{ }
named cdlabel { }
named cdlabelmargin { }
named cdlabelfont { }
named cdlabelbreak { }
named cdlabelformat right @Body { }
import @Geometry named cdlabelpos { SE }
import @Geometry named cdlabelangle { }
named cdlabelprox { }
named cdlabelctr { }
import @Geometry named cdlabeladjust{ }
###########################################################################
# #
# @Link options of @DiagSetup #
# #
###########################################################################
import @Geometry named path
named from {}
named to {}
named bias {}
named fbias {}
named tbias {}
named hfrac {}
named hbias {}
named radius {}
named xindent {}
named zindent {}
named frompt {}
named topt {}
named arrow {}
named arrowlength {}
named backarrowlength {}
{ 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 hfrac { 0.5 }
import @Geometry named hbias { 0.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 dotdashed { "/ldiagdotdashed" }
named dotcdashed { "/ldiagdotcdashed" }
named dotdotdashed { "/ldiagdotdotdashed" }
named dotdotcdashed { "/ldiagdotdotcdashed" }
named dotdotdotdashed { "/ldiagdotdotdotdashed" }
named dotdotdotcdashed { "/ldiagdotdotdotcdashed" }
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 backarrowstyle { solid }
named backarrowwidth { 0.3f }
named backarrowlength { 0.5f }
named linklabel { }
named linklabelmargin { 0.2f }
named linklabelfont { -2p }
named linklabelbreak { ragged nohyphen }
named linklabelformat right @Body { @Body }
import @Geometry named linklabelpos { }
import @Geometry named linklabelangle { horizontal }
named linklabelprox { above }
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 }
import @Geometry named xlabelangle { }
named xlabelprox { }
named xlabelctr { }
import @Geometry named xlabeladjust { }
named ylabel { }
named ylabelmargin { }
named ylabelfont { }
named ylabelbreak { }
named ylabelformat right @Body { }
import @Geometry named ylabelpos { LMID }
import @Geometry named ylabelangle { }
named ylabelprox { }
named ylabelctr { yes }
import @Geometry named ylabeladjust { }
named zlabel { }
named zlabelmargin { }
named zlabelfont { }
named zlabelbreak { }
named zlabelformat right @Body { }
import @Geometry named zlabelpos { LTO }
import @Geometry named zlabelangle { }
named zlabelprox { }
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 }
import @Geometry named fromlabelangle { antiparallel }
named fromlabelprox { W }
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 }
import @Geometry named tolabelangle { parallel }
named tolabelprox { W }
named tolabelctr { no }
import @Geometry named tolabeladjust { 0 0 }
###########################################################################
# #
# Tree and syntax diagram options of @DiagSetup #
# #
###########################################################################
named treehsep { 0.5f }
named treevsep { 0.5f }
named treehindent
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 }
named syntaxgap { 0.35f }
named syntaxbias { 1.0f }
named syntaxradius { 0.3f }
{
###########################################################################
# #
# @Diag symbol #
# #
###########################################################################
export "::" @ShowPoints @ShowTags @ShowDirections @CatchTags @Transform
@Node @ANode @BNode @CNode
@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
@HVHLine @HVHArrow @VHVLine @VHVArrow
@HVHCurve @HVHCurveArrow @VHVCurve @VHVCurveArrow
@DWrapLine @DWrapArrow @UWrapLine @UWrapArrow
@DWrapCurve @DWrapCurveArrow @UWrapCurve @UWrapCurveArrow
@Tree @HTree
@StartRight @StartUp @StartLeft @StartDown
@StartRightRight @StartRightRightRight @StartRightDown
@Skip @XCell @ACell @BCell @CCell
@Sequence @OneOrBoth @Select @Optional @OptionalDiverted @Diverted
@Loop @LoopOpposite @Repeat @RepeatOpposite @RepeatDiverted
def @Diag
named save { save }
named maxlabels { maxlabels }
named title { title }
named titleformat
left @Title
right @Body
{ @Title titleformat @Body }
#######################################################################
# #
# @Node options of @Diag #
# #
#######################################################################
import @Geometry named outline
named margin {}
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 dotdashed { "/ldiagdotdashed" }
named dotcdashed { "/ldiagdotcdashed" }
named dotdotdashed { "/ldiagdotdotdashed" }
named dotdotcdashed { "/ldiagdotdotcdashed" }
named dotdotdotdashed { "/ldiagdotdotdotdashed" }
named dotdotdotcdashed { "/ldiagdotdotdotcdashed" }
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 }
import @TextureImport named texture { texture }
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 }
#######################################################################
# #
# @ANode options of @Diag #
# #
#######################################################################
import @Geometry named aoutline
named margin {}
named shadow {}
named sides {}
named angle {}
{ aoutline
margin { margin }
shadow { shadow }
sides { sides }
angle { angle }
}
named amargin { amargin }
import @Geometry named ashadow { ashadow }
import @Geometry named asides { asides }
import @Geometry named aangle { aangle }
named atranslate { atranslate }
named anodetag { }
named aoutlinestyle
named solid { "/ldiagsolid" }
named dashed { "/ldiagdashed" }
named cdashed { "/ldiagcdashed" }
named dotdashed { "/ldiagdotdashed" }
named dotcdashed { "/ldiagdotcdashed" }
named dotdotdashed { "/ldiagdotdotdashed" }
named dotdotcdashed { "/ldiagdotdotcdashed" }
named dotdotdotdashed { "/ldiagdotdotdotdashed" }
named dotdotdotcdashed { "/ldiagdotdotdotcdashed" }
named dotted { "/ldiagdotted" }
named noline { "/ldiagnoline" }
{ aoutlinestyle }
import @Geometry named aoutlinedashlength{ aoutlinedashlength }
import @Geometry named aoutlinewidth
named thin { 0.04 ft }
named medium { 0.08 ft }
named thick { 0.12 ft }
{ aoutlinewidth }
named apaint { apaint }
import @TextureImport named atexture { atexture }
named afont { afont }
named abreak { abreak }
named aformat right @Body { aformat @Body }
named avalign { avalign }
named avsize { avsize }
named avindent { avindent }
named avstrut
named no { 0.0f }
named yes { 1.0f }
{ avstrut }
named avmargin { avmargin }
named atopmargin { atopmargin }
named afootmargin { afootmargin }
named ahalign { ahalign }
named ahsize { ahsize }
named ahindent { ahindent }
named ahstrut
named no { 0.0f }
named yes { 1.0f }
{ ahstrut }
named ahmargin { ahmargin }
named aleftmargin { aleftmargin }
named arightmargin { arightmargin }
#######################################################################
# #
# @BNode options of @Diag #
# #
#######################################################################
import @Geometry named boutline
named margin {}
named shadow {}
named sides {}
named angle {}
{ boutline
margin { margin }
shadow { shadow }
sides { sides }
angle { angle }
}
named bmargin { bmargin }
import @Geometry named bshadow { bshadow }
import @Geometry named bsides { bsides }
import @Geometry named bangle { bangle }
named btranslate { btranslate }
named bnodetag { }
named boutlinestyle
named solid { "/ldiagsolid" }
named dashed { "/ldiagdashed" }
named cdashed { "/ldiagcdashed" }
named dotdashed { "/ldiagdotdashed" }
named dotcdashed { "/ldiagdotcdashed" }
named dotdotdashed { "/ldiagdotdotdashed" }
named dotdotcdashed { "/ldiagdotdotcdashed" }
named dotdotdotdashed { "/ldiagdotdotdotdashed" }
named dotdotdotcdashed { "/ldiagdotdotdotcdashed" }
named dotted { "/ldiagdotted" }
named noline { "/ldiagnoline" }
{ boutlinestyle }
import @Geometry named boutlinedashlength{ boutlinedashlength }
import @Geometry named boutlinewidth
named thin { 0.04 ft }
named medium { 0.08 ft }
named thick { 0.12 ft }
{ boutlinewidth }
named bpaint { bpaint }
import @TextureImport named btexture { btexture }
named bfont { bfont }
named bbreak { bbreak }
named bformat right @Body { bformat @Body }
named bvalign { bvalign }
named bvsize { bvsize }
named bvindent { bvindent }
named bvstrut
named no { 0.0f }
named yes { 1.0f }
{ bvstrut }
named bvmargin { bvmargin }
named btopmargin { btopmargin }
named bfootmargin { bfootmargin }
named bhalign { bhalign }
named bhsize { bhsize }
named bhindent { bhindent }
named bhstrut
named no { 0.0f }
named yes { 1.0f }
{ bhstrut }
named bhmargin { bhmargin }
named bleftmargin { bleftmargin }
named brightmargin { brightmargin }
#######################################################################
# #
# @CNode options of @Diag #
# #
#######################################################################
import @Geometry named coutline
named margin {}
named shadow {}
named sides {}
named angle {}
{ coutline
margin { margin }
shadow { shadow }
sides { sides }
angle { angle }
}
named cmargin { cmargin }
import @Geometry named cshadow { cshadow }
import @Geometry named csides { csides }
import @Geometry named cangle { cangle }
named ctranslate { ctranslate }
named cnodetag { }
named coutlinestyle
named solid { "/ldiagsolid" }
named dashed { "/ldiagdashed" }
named cdashed { "/ldiagcdashed" }
named dotdashed { "/ldiagdotdashed" }
named dotcdashed { "/ldiagdotcdashed" }
named dotdotdashed { "/ldiagdotdotdashed" }
named dotdotcdashed { "/ldiagdotdotcdashed" }
named dotdotdotdashed { "/ldiagdotdotdotdashed" }
named dotdotdotcdashed { "/ldiagdotdotdotcdashed" }
named dotted { "/ldiagdotted" }
named noline { "/ldiagnoline" }
{ coutlinestyle }
import @Geometry named coutlinedashlength{ coutlinedashlength }
import @Geometry named coutlinewidth
named thin { 0.04 ft }
named medium { 0.08 ft }
named thick { 0.12 ft }
{ coutlinewidth }
named cpaint { cpaint }
import @TextureImport named ctexture { ctexture }
named cfont { cfont }
named cbreak { cbreak }
named cformat right @Body { cformat @Body }
named cvalign { cvalign }
named cvsize { cvsize }
named cvindent { cvindent }
named cvstrut
named no { 0.0f }
named yes { 1.0f }
{ cvstrut }
named cvmargin { cvmargin }
named ctopmargin { ctopmargin }
named cfootmargin { cfootmargin }
named chalign { chalign }
named chsize { chsize }
named chindent { chindent }
named chstrut
named no { 0.0f }
named yes { 1.0f }
{ chstrut }
named chmargin { chmargin }
named cleftmargin { cleftmargin }
named crightmargin { crightmargin }
#######################################################################
# #
# @Link options of @Diag #
# #
#######################################################################
import @Geometry named path
named from {}
named to {}
named bias {}
named fbias {}
named tbias {}
named hfrac {}
named hbias {}
named radius {}
named xindent {}
named zindent {}
named frompt {}
named topt {}
named arrow {}
named arrowlength {}
named backarrowlength {}
{ path
from { from }
to { to }
bias { bias }
fbias { fbias }
tbias { tbias }
hfrac { hfrac }
hbias { hbias }
radius { radius }
xindent { xindent }
zindent { zindent }
frompt { frompt }
topt { topt }
arrow { arrow }
arrowlength { arrowlength }
backarrowlength{ backarrowlength }
}
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 hfrac { hfrac }
import @Geometry named hbias { hbias }
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 dotdashed { "/ldiagdotdashed" }
named dotcdashed { "/ldiagdotcdashed" }
named dotdotdashed { "/ldiagdotdotdashed" }
named dotdotcdashed { "/ldiagdotdotcdashed" }
named dotdotdotdashed { "/ldiagdotdotdotdashed" }
named dotdotdotcdashed { "/ldiagdotdotdotcdashed" }
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 backarrowstyle { backarrowstyle }
named backarrowwidth { backarrowwidth }
named backarrowlength { backarrowlength }
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 }
#######################################################################
# #
# Tree and syntax diagram options of @Diag #
# #
#######################################################################
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 }
named syntaxgap { syntaxgap }
named syntaxbias { syntaxbias }
named syntaxradius { syntaxradius }
body @Body
@Begin
#######################################################################
# #
# Miscellaneous helper definitions #
# #
#######################################################################
def @PSAddPaint left col right tex
{
col @Case {
{ "no" "none" "nopaint" } @Yield "{}"
else @Yield { "{" @ColourCommand col tex "fill }" }
}
}
# 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 @ShowMarks right x
{
{ "xmark -0.5 cm moveto xmark ysize 0.5 cm add lineto stroke" } @Graphic x
}
def "::"
precedence 33
associativity right
left name
named restrict {}
right x
{
def @PushCommand
{
"("name") ldiagpushtagdict"
}
def @PopCommand
{
restrict @Case {
"" @Yield "ldiagpopuptagdict"
else @Yield { "[" restrict "] ldiagpopsometagdict" }
}
# "ldiagpopuptagdict"
}
@BackEnd @Case {
PostScript @Yield { {@PushCommand // @PopCommand} @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
}
}
}
}
#######################################################################
# #
# @DoLabel definition for drawing one label #
# #
#######################################################################
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
}
#######################################################################
# #
# @Node #
# #
#######################################################################
def @Node
import @Geometry named translate
named to precedence 10 left x right y {
@BackEnd @Case {
PostScript @Yield { x y "ldiagpsub" }
PDF @Yield {""}
}
}
{}
import @Geometry named rotate { 0d }
import @Geometry named outline
named margin {}
named shadow {}
named sides {}
named angle {}
{ 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 dotdashed { "/ldiagdotdashed" }
named dotcdashed { "/ldiagdotcdashed" }
named dotdotdashed { "/ldiagdotdotdashed" }
named dotdotcdashed { "/ldiagdotdotcdashed" }
named dotdotdotdashed { "/ldiagdotdotdotdashed" }
named dotdotdotcdashed { "/ldiagdotdotdotcdashed" }
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 }
import @TextureImport named texture { texture }
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 paint @PSAddPaint texture "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
}
}
}
#######################################################################
# #
# @ANode #
# #
#######################################################################
def @ANode
import @Geometry named translate
named to precedence 10 left x right y {
@BackEnd @Case {
PostScript @Yield { x y "ldiagpsub" }
PDF @Yield {""}
}
}
{}
import @Geometry named rotate { 0d }
import @Geometry named outline
named margin {}
named shadow {}
named sides {}
named angle {}
{ aoutline
margin { margin }
shadow { shadow }
sides { sides }
angle { angle }
}
named margin { amargin }
import @Geometry named shadow { ashadow }
import @Geometry named sides { asides }
import @Geometry named angle { aangle }
named nodetag { anodetag }
named outlinestyle
named solid { "/ldiagsolid" }
named dashed { "/ldiagdashed" }
named cdashed { "/ldiagcdashed" }
named dotdashed { "/ldiagdotdashed" }
named dotcdashed { "/ldiagdotcdashed" }
named dotdotdashed { "/ldiagdotdotdashed" }
named dotdotcdashed { "/ldiagdotdotcdashed" }
named dotdotdotdashed { "/ldiagdotdotdotdashed" }
named dotdotdotcdashed { "/ldiagdotdotdotcdashed" }
named dotted { "/ldiagdotted" }
named noline { "/ldiagnoline" }
{ aoutlinestyle }
import @Geometry named outlinedashlength { aoutlinedashlength}
import @Geometry named outlinewidth
named thin { 0.04 ft }
named medium { 0.08 ft }
named thick { 0.12 ft }
{ aoutlinewidth }
named paint { apaint }
import @TextureImport named texture { atexture }
named font { afont }
named break { abreak }
named format right @Body { aformat @Body }
named valign { avalign }
named vsize { avsize }
named vindent { avindent }
named vstrut
named no { 0.0f }
named yes { 1.0f }
{ avstrut }
named vmargin { avmargin }
named topmargin { atopmargin }
named footmargin { afootmargin }
named halign { ahalign }
named hsize { ahsize }
named hindent { ahindent }
named hstrut
named no { 0.0f }
named yes { 1.0f }
{ ahstrut }
named hmargin { ahmargin }
named leftmargin { aleftmargin }
named rightmargin { arightmargin }
named nodelabel { anodelabel }
named nodelabelmargin { anodelabelmargin }
named nodelabelfont { anodelabelfont }
named nodelabelbreak { anodelabelbreak }
named nodelabelformat right @Body { anodelabelformat @Body }
import @Geometry named nodelabelpos { anodelabelpos }
named nodelabelprox { anodelabelprox }
import @Geometry named nodelabelangle { anodelabelangle }
named nodelabelctr { anodelabelctr }
import @Geometry named nodelabeladjust { anodelabeladjust }
named alabel { aalabel }
named alabelmargin { aalabelmargin }
named alabelfont { aalabelfont }
named alabelbreak { aalabelbreak }
named alabelformat right @Body { aalabelformat @Body }
import @Geometry named alabelpos { aalabelpos }
named alabelprox { aalabelprox }
import @Geometry named alabelangle { aalabelangle }
named alabelctr { aalabelctr }
import @Geometry named alabeladjust { aalabeladjust }
named blabel { ablabel }
named blabelmargin { ablabelmargin }
named blabelfont { ablabelfont }
named blabelbreak { ablabelbreak }
named blabelformat right @Body { ablabelformat @Body }
import @Geometry named blabelpos { ablabelpos }
named blabelprox { ablabelprox }
import @Geometry named blabelangle { ablabelangle }
named blabelctr { ablabelctr }
import @Geometry named blabeladjust { ablabeladjust }
named clabel { aclabel }
named clabelmargin { aclabelmargin }
named clabelfont { aclabelfont }
named clabelbreak { aclabelbreak }
named clabelformat right @Body { aclabelformat @Body }
import @Geometry named clabelpos { aclabelpos }
named clabelprox { aclabelprox }
import @Geometry named clabelangle { aclabelangle }
named clabelctr { aclabelctr }
import @Geometry named clabeladjust { aclabeladjust }
named dlabel { adlabel }
named dlabelmargin { adlabelmargin }
named dlabelfont { adlabelfont }
named dlabelbreak { adlabelbreak }
named dlabelformat right @Body { adlabelformat @Body }
import @Geometry named dlabelpos { adlabelpos }
named dlabelprox { adlabelprox }
import @Geometry named dlabelangle { adlabelangle }
named dlabelctr { adlabelctr }
import @Geometry named dlabeladjust { adlabeladjust }
right @Body
{
def @LabelPos
left x
right y
{
nodelabelpos @Case {
x @Yield y
else @Yield ""
}
}
def @If
left cond
right x
{
cond @Case {
{ yes Yes } @Yield x
else @Yield ""
}
}
def @Strut right x
{
def vs { 0.5w @VShift { vstrut @High } }
def hs { hstrut @Wide }
@HContract @VContract {
@HContract @VContract x | vs / hs |
}
}
def @Indent right x
{
x @Case {
{ top left } @Yield 0.0rt
{ ctr } @Yield 0.5rt
{ foot right } @Yield 1.0rt
{ mctr } @Yield 0.5bx
else @Yield x
}
}
def @VSize right x
{
vsize @Case {
"" @Yield x
else @Yield { vsize @High { /{@Indent vindent} x / } }
}
}
def @HSize right x
{
hsize @Case {
"" @Yield x
else @Yield { hsize @Wide { |{@Indent hindent} x | } }
}
}
def @Align right x
{
x @Case {
{ top left } @Yield 0.0w
{ ctr } @Yield 0.5w
{ foot right } @Yield 1.0w
{ mark } @Yield "+0i"
else @Yield x
}
}
def @ALabel
{
@DoLabel
which { "a" }
label { alabel @Else nodelabel }
labelmargin { alabelmargin @Else nodelabelmargin }
labelfont { alabelfont @Else nodelabelfont }
labelbreak { alabelbreak @Else nodelabelbreak }
labelformat { alabelformat @Body @Else nodelabelformat @Body}
labelpos { alabelpos @Else nodelabelpos }
labelprox { alabelprox @Else nodelabelprox }
labelangle { alabelangle @Else nodelabelangle }
labelctr { alabelctr @Else nodelabelctr }
labeladjust { alabeladjust @Else nodelabeladjust }
}
def @BLabel
{
@DoLabel
which { "b" }
label { blabel @Else nodelabel }
labelmargin { blabelmargin @Else nodelabelmargin }
labelfont { blabelfont @Else nodelabelfont }
labelbreak { blabelbreak @Else nodelabelbreak }
labelformat { blabelformat @Body @Else nodelabelformat @Body}
labelpos { blabelpos @Else nodelabelpos }
labelprox { blabelprox @Else nodelabelprox }
labelangle { blabelangle @Else nodelabelangle }
labelctr { blabelctr @Else nodelabelctr }
labeladjust { blabeladjust @Else nodelabeladjust }
}
def @CLabel
{
@DoLabel
which { "c" }
label { clabel @Else nodelabel }
labelmargin { clabelmargin @Else nodelabelmargin }
labelfont { clabelfont @Else nodelabelfont }
labelbreak { clabelbreak @Else nodelabelbreak }
labelformat { clabelformat @Body @Else nodelabelformat @Body}
labelpos { clabelpos @Else nodelabelpos }
labelprox { clabelprox @Else nodelabelprox }
labelangle { clabelangle @Else nodelabelangle }
labelctr { clabelctr @Else nodelabelctr }
labeladjust { clabeladjust @Else nodelabeladjust }
}
def @DLabel
{
@DoLabel
which { "d" }
label { dlabel @Else nodelabel }
labelmargin { dlabelmargin @Else nodelabelmargin }
labelfont { dlabelfont @Else nodelabelfont }
labelbreak { dlabelbreak @Else nodelabelbreak }
labelformat { dlabelformat @Body @Else nodelabelformat @Body}
labelpos { dlabelpos @Else nodelabelpos }
labelprox { dlabelprox @Else nodelabelprox }
labelangle { dlabelangle @Else nodelabelangle }
labelctr { dlabelctr @Else nodelabelctr }
labeladjust { dlabeladjust @Else nodelabeladjust }
}
import @Geometry
def @OutLine
{
@BackEnd @Case {
PostScript @Yield {
outline @Case {
box @Yield { "ldiagbox" }
curvebox @Yield { "("margin") ldiagcurvebox" }
shadowbox @Yield { shadow "ldiagshadow ldiagbox" }
square @Yield { "ldiagsquare" }
diamond @Yield { "ldiagdiamond" }
polygon @Yield { sides angle "ldiagpolygon" }
isosceles @Yield { "ldiagisosceles" }
ellipse @Yield { "ldiagellipse" }
circle @Yield { "ldiagcircle" }
else @Yield {
outline
margin { "("margin") ldiagdecodelength" }
shadow { shadow }
sides { sides }
angle { angle }
}
}
}
PDF @Yield {}
}
}
def @Value
{
@BackEnd @Case {
PostScript @Yield {
@HContract @VContract
{
{
"ldiagnodebegin [" @OutLine "]"
outlinedashlength "[" outlinestyle "]"
outlinewidth paint @PSAddPaint texture "ldiagnodeend"
"(IN) ldiagpushtagdict"
//
"ldiagpopuptagdict"
}
@Graphic
{
{@Align valign} @VShift {@Align halign} @HShift
@AddMargins
mtop { topmargin @Else vmargin @Else margin }
mfoot { footmargin @Else vmargin @Else margin }
mleft { leftmargin @Else hmargin @Else margin }
mright { rightmargin @Else hmargin @Else margin }
@HSize @VSize @HContract @VContract
font @Font break @Break format @Strut @Body
}
/ {alabel @Else nodelabel} @IfNonEmpty @ALabel
/ {blabel @Else nodelabel} @IfNonEmpty @BLabel
/ {clabel @Else nodelabel} @IfNonEmpty @CLabel
/ {dlabel @Else nodelabel} @IfNonEmpty @DLabel
}
}
PDF @Yield {}
}
}
def @TValue
{
nodetag @Case {
"" @Yield @Value
else @Yield { nodetag:: @Value }
}
}
translate @Case {
"" @Yield @TValue
else @Yield {
@Null & # so that preceding space gets chewed up
@Transform translate { translate } rotate { rotate } @TValue
}
}
}
#######################################################################
# #
# @BNode #
# #
#######################################################################
def @BNode
import @Geometry named translate
named to precedence 10 left x right y {
@BackEnd @Case {
PostScript @Yield { x y "ldiagpsub" }
PDF @Yield {""}
}
}
{}
import @Geometry named rotate { 0d }
import @Geometry named outline
named margin {}
named shadow {}
named sides {}
named angle {}
{ boutline
margin { margin }
shadow { shadow }
sides { sides }
angle { angle }
}
named margin { bmargin }
import @Geometry named shadow { bshadow }
import @Geometry named sides { bsides }
import @Geometry named angle { bangle }
named nodetag { bnodetag }
named outlinestyle
named solid { "/ldiagsolid" }
named dashed { "/ldiagdashed" }
named cdashed { "/ldiagcdashed" }
named dotdashed { "/ldiagdotdashed" }
named dotcdashed { "/ldiagdotcdashed" }
named dotdotdashed { "/ldiagdotdotdashed" }
named dotdotcdashed { "/ldiagdotdotcdashed" }
named dotdotdotdashed { "/ldiagdotdotdotdashed" }
named dotdotdotcdashed { "/ldiagdotdotdotcdashed" }
named dotted { "/ldiagdotted" }
named noline { "/ldiagnoline" }
{ boutlinestyle }
import @Geometry named outlinedashlength { boutlinedashlength}
import @Geometry named outlinewidth
named thin { 0.04 ft }
named medium { 0.08 ft }
named thick { 0.12 ft }
{ boutlinewidth }
named paint { bpaint }
import @TextureImport named texture { btexture }
named font { bfont }
named break { bbreak }
named format right @Body { bformat @Body }
named valign { bvalign }
named vsize { bvsize }
named vindent { bvindent }
named vstrut
named no { 0.0f }
named yes { 1.0f }
{ bvstrut }
named vmargin { bvmargin }
named topmargin { btopmargin }
named footmargin { bfootmargin }
named halign { bhalign }
named hsize { bhsize }
named hindent { bhindent }
named hstrut
named no { 0.0f }
named yes { 1.0f }
{ bhstrut }
named hmargin { bhmargin }
named leftmargin { bleftmargin }
named rightmargin { brightmargin }
named nodelabel { bnodelabel }
named nodelabelmargin { bnodelabelmargin }
named nodelabelfont { bnodelabelfont }
named nodelabelbreak { bnodelabelbreak }
named nodelabelformat right @Body { bnodelabelformat @Body }
import @Geometry named nodelabelpos { bnodelabelpos }
named nodelabelprox { bnodelabelprox }
import @Geometry named nodelabelangle { bnodelabelangle }
named nodelabelctr { bnodelabelctr }
import @Geometry named nodelabeladjust { bnodelabeladjust }
named alabel { balabel }
named alabelmargin { balabelmargin }
named alabelfont { balabelfont }
named alabelbreak { balabelbreak }
named alabelformat right @Body { balabelformat @Body }
import @Geometry named alabelpos { balabelpos }
named alabelprox { balabelprox }
import @Geometry named alabelangle { balabelangle }
named alabelctr { balabelctr }
import @Geometry named alabeladjust { balabeladjust }
named blabel { bblabel }
named blabelmargin { bblabelmargin }
named blabelfont { bblabelfont }
named blabelbreak { bblabelbreak }
named blabelformat right @Body { bblabelformat @Body }
import @Geometry named blabelpos { bblabelpos }
named blabelprox { bblabelprox }
import @Geometry named blabelangle { bblabelangle }
named blabelctr { bblabelctr }
import @Geometry named blabeladjust { bblabeladjust }
named clabel { bclabel }
named clabelmargin { bclabelmargin }
named clabelfont { bclabelfont }
named clabelbreak { bclabelbreak }
named clabelformat right @Body { bclabelformat @Body }
import @Geometry named clabelpos { bclabelpos }
named clabelprox { bclabelprox }
import @Geometry named clabelangle { bclabelangle }
named clabelctr { bclabelctr }
import @Geometry named clabeladjust { bclabeladjust }
named dlabel { bdlabel }
named dlabelmargin { bdlabelmargin }
named dlabelfont { bdlabelfont }
named dlabelbreak { bdlabelbreak }
named dlabelformat right @Body { bdlabelformat @Body }
import @Geometry named dlabelpos { bdlabelpos }
named dlabelprox { bdlabelprox }
import @Geometry named dlabelangle { bdlabelangle }
named dlabelctr { bdlabelctr }
import @Geometry named dlabeladjust { bdlabeladjust }
right @Body
{
def @LabelPos
left x
right y
{
nodelabelpos @Case {
x @Yield y
else @Yield ""
}
}
def @If
left cond
right x
{
cond @Case {
{ yes Yes } @Yield x
else @Yield ""
}
}
def @Strut right x
{
def vs { 0.5w @VShift { vstrut @High } }
def hs { hstrut @Wide }
@HContract @VContract {
@HContract @VContract x | vs / hs |
}
}
def @Indent right x
{
x @Case {
{ top left } @Yield 0.0rt
{ ctr } @Yield 0.5rt
{ foot right } @Yield 1.0rt
{ mctr } @Yield 0.5bx
else @Yield x
}
}
def @VSize right x
{
vsize @Case {
"" @Yield x
else @Yield { vsize @High { /{@Indent vindent} x / } }
}
}
def @HSize right x
{
hsize @Case {
"" @Yield x
else @Yield { hsize @Wide { |{@Indent hindent} x | } }
}
}
def @Align right x
{
x @Case {
{ top left } @Yield 0.0w
{ ctr } @Yield 0.5w
{ foot right } @Yield 1.0w
{ mark } @Yield "+0i"
else @Yield x
}
}
def @ALabel
{
@DoLabel
which { "a" }
label { alabel @Else nodelabel }
labelmargin { alabelmargin @Else nodelabelmargin }
labelfont { alabelfont @Else nodelabelfont }
labelbreak { alabelbreak @Else nodelabelbreak }
labelformat { alabelformat @Body @Else nodelabelformat @Body}
labelpos { alabelpos @Else nodelabelpos }
labelprox { alabelprox @Else nodelabelprox }
labelangle { alabelangle @Else nodelabelangle }
labelctr { alabelctr @Else nodelabelctr }
labeladjust { alabeladjust @Else nodelabeladjust }
}
def @BLabel
{
@DoLabel
which { "b" }
label { blabel @Else nodelabel }
labelmargin { blabelmargin @Else nodelabelmargin }
labelfont { blabelfont @Else nodelabelfont }
labelbreak { blabelbreak @Else nodelabelbreak }
labelformat { blabelformat @Body @Else nodelabelformat @Body}
labelpos { blabelpos @Else nodelabelpos }
labelprox { blabelprox @Else nodelabelprox }
labelangle { blabelangle @Else nodelabelangle }
labelctr { blabelctr @Else nodelabelctr }
labeladjust { blabeladjust @Else nodelabeladjust }
}
def @CLabel
{
@DoLabel
which { "c" }
label { clabel @Else nodelabel }
labelmargin { clabelmargin @Else nodelabelmargin }
labelfont { clabelfont @Else nodelabelfont }
labelbreak { clabelbreak @Else nodelabelbreak }
labelformat { clabelformat @Body @Else nodelabelformat @Body}
labelpos { clabelpos @Else nodelabelpos }
labelprox { clabelprox @Else nodelabelprox }
labelangle { clabelangle @Else nodelabelangle }
labelctr { clabelctr @Else nodelabelctr }
labeladjust { clabeladjust @Else nodelabeladjust }
}
def @DLabel
{
@DoLabel
which { "d" }
label { dlabel @Else nodelabel }
labelmargin { dlabelmargin @Else nodelabelmargin }
labelfont { dlabelfont @Else nodelabelfont }
labelbreak { dlabelbreak @Else nodelabelbreak }
labelformat { dlabelformat @Body @Else nodelabelformat @Body}
labelpos { dlabelpos @Else nodelabelpos }
labelprox { dlabelprox @Else nodelabelprox }
labelangle { dlabelangle @Else nodelabelangle }
labelctr { dlabelctr @Else nodelabelctr }
labeladjust { dlabeladjust @Else nodelabeladjust }
}
import @Geometry
def @OutLine
{
@BackEnd @Case {
PostScript @Yield {
outline @Case {
box @Yield { "ldiagbox" }
curvebox @Yield { "("margin") ldiagcurvebox" }
shadowbox @Yield { shadow "ldiagshadow ldiagbox" }
square @Yield { "ldiagsquare" }
diamond @Yield { "ldiagdiamond" }
polygon @Yield { sides angle "ldiagpolygon" }
isosceles @Yield { "ldiagisosceles" }
ellipse @Yield { "ldiagellipse" }
circle @Yield { "ldiagcircle" }
else @Yield {
outline
margin { "("margin") ldiagdecodelength" }
shadow { shadow }
sides { sides }
angle { angle }
}
}
}
PDF @Yield {}
}
}
def @Value
{
@BackEnd @Case {
PostScript @Yield {
@HContract @VContract
{
{
"ldiagnodebegin [" @OutLine "]"
outlinedashlength "[" outlinestyle "]"
outlinewidth paint @PSAddPaint texture "ldiagnodeend"
"(IN) ldiagpushtagdict"
//
"ldiagpopuptagdict"
}
@Graphic
{
{@Align valign} @VShift {@Align halign} @HShift
@AddMargins
mtop { topmargin @Else vmargin @Else margin }
mfoot { footmargin @Else vmargin @Else margin }
mleft { leftmargin @Else hmargin @Else margin }
mright { rightmargin @Else hmargin @Else margin }
@HSize @VSize @HContract @VContract
font @Font break @Break format @Strut @Body
}
/ {alabel @Else nodelabel} @IfNonEmpty @ALabel
/ {blabel @Else nodelabel} @IfNonEmpty @BLabel
/ {clabel @Else nodelabel} @IfNonEmpty @CLabel
/ {dlabel @Else nodelabel} @IfNonEmpty @DLabel
}
}
PDF @Yield {}
}
}
def @TValue
{
nodetag @Case {
"" @Yield @Value
else @Yield { nodetag:: @Value }
}
}
translate @Case {
"" @Yield @TValue
else @Yield {
@Null & # so that preceding space gets chewed up
@Transform translate { translate } rotate { rotate } @TValue
}
}
}
#######################################################################
# #
# @CNode #
# #
#######################################################################
def @CNode
import @Geometry named translate
named to precedence 10 left x right y {
@BackEnd @Case {
PostScript @Yield { x y "ldiagpsub" }
PDF @Yield {""}
}
}
{}
import @Geometry named rotate { 0d }
import @Geometry named outline
named margin {}
named shadow {}
named sides {}
named angle {}
{ coutline
margin { margin }
shadow { shadow }
sides { sides }
angle { angle }
}
named margin { cmargin }
import @Geometry named shadow { cshadow }
import @Geometry named sides { csides }
import @Geometry named angle { cangle }
named nodetag { cnodetag }
named outlinestyle
named solid { "/ldiagsolid" }
named dashed { "/ldiagdashed" }
named cdashed { "/ldiagcdashed" }
named dotdashed { "/ldiagdotdashed" }
named dotcdashed { "/ldiagdotcdashed" }
named dotdotdashed { "/ldiagdotdotdashed" }
named dotdotcdashed { "/ldiagdotdotcdashed" }
named dotdotdotdashed { "/ldiagdotdotdotdashed" }
named dotdotdotcdashed { "/ldiagdotdotdotcdashed" }
named dotted { "/ldiagdotted" }
named noline { "/ldiagnoline" }
{ coutlinestyle }
import @Geometry named outlinedashlength { coutlinedashlength}
import @Geometry named outlinewidth
named thin { 0.04 ft }
named medium { 0.08 ft }
named thick { 0.12 ft }
{ coutlinewidth }
named paint { cpaint }
import @TextureImport named texture { ctexture }
named font { cfont }
named break { cbreak }
named format right @Body { cformat @Body }
named valign { cvalign }
named vsize { cvsize }
named vindent { cvindent }
named vstrut
named no { 0.0f }
named yes { 1.0f }
{ cvstrut }
named vmargin { cvmargin }
named topmargin { ctopmargin }
named footmargin { cfootmargin }
named halign { chalign }
named hsize { chsize }
named hindent { chindent }
named hstrut
named no { 0.0f }
named yes { 1.0f }
{ chstrut }
named hmargin { chmargin }
named leftmargin { cleftmargin }
named rightmargin { crightmargin }
named nodelabel { cnodelabel }
named nodelabelmargin { cnodelabelmargin }
named nodelabelfont { cnodelabelfont }
named nodelabelbreak { cnodelabelbreak }
named nodelabelformat right @Body { cnodelabelformat @Body }
import @Geometry named nodelabelpos { cnodelabelpos }
named nodelabelprox { cnodelabelprox }
import @Geometry named nodelabelangle { cnodelabelangle }
named nodelabelctr { cnodelabelctr }
import @Geometry named nodelabeladjust { cnodelabeladjust }
named alabel { calabel }
named alabelmargin { calabelmargin }
named alabelfont { calabelfont }
named alabelbreak { calabelbreak }
named alabelformat right @Body { calabelformat @Body }
import @Geometry named alabelpos { calabelpos }
named alabelprox { calabelprox }
import @Geometry named alabelangle { calabelangle }
named alabelctr { calabelctr }
import @Geometry named alabeladjust { calabeladjust }
named blabel { cblabel }
named blabelmargin { cblabelmargin }
named blabelfont { cblabelfont }
named blabelbreak { cblabelbreak }
named blabelformat right @Body { cblabelformat @Body }
import @Geometry named blabelpos { cblabelpos }
named blabelprox { cblabelprox }
import @Geometry named blabelangle { cblabelangle }
named blabelctr { cblabelctr }
import @Geometry named blabeladjust { cblabeladjust }
named clabel { cclabel }
named clabelmargin { cclabelmargin }
named clabelfont { cclabelfont }
named clabelbreak { cclabelbreak }
named clabelformat right @Body { cclabelformat @Body }
import @Geometry named clabelpos { cclabelpos }
named clabelprox { cclabelprox }
import @Geometry named clabelangle { cclabelangle }
named clabelctr { cclabelctr }
import @Geometry named clabeladjust { cclabeladjust }
named dlabel { cdlabel }
named dlabelmargin { cdlabelmargin }
named dlabelfont { cdlabelfont }
named dlabelbreak { cdlabelbreak }
named dlabelformat right @Body { cdlabelformat @Body }
import @Geometry named dlabelpos { cdlabelpos }
named dlabelprox { cdlabelprox }
import @Geometry named dlabelangle { cdlabelangle }
named dlabelctr { cdlabelctr }
import @Geometry named dlabeladjust { cdlabeladjust }
right @Body
{
def @LabelPos
left x
right y
{
nodelabelpos @Case {
x @Yield y
else @Yield ""
}
}
def @If
left cond
right x
{
cond @Case {
{ yes Yes } @Yield x
else @Yield ""
}
}
def @Strut right x
{
def vs { 0.5w @VShift { vstrut @High } }
def hs { hstrut @Wide }
@HContract @VContract {
@HContract @VContract x | vs / hs |
}
}
def @Indent right x
{
x @Case {
{ top left } @Yield 0.0rt
{ ctr } @Yield 0.5rt
{ foot right } @Yield 1.0rt
{ mctr } @Yield 0.5bx
else @Yield x
}
}
def @VSize right x
{
vsize @Case {
"" @Yield x
else @Yield { vsize @High { /{@Indent vindent} x / } }
}
}
def @HSize right x
{
hsize @Case {
"" @Yield x
else @Yield { hsize @Wide { |{@Indent hindent} x | } }
}
}
def @Align right x
{
x @Case {
{ top left } @Yield 0.0w
{ ctr } @Yield 0.5w
{ foot right } @Yield 1.0w
{ mark } @Yield "+0i"
else @Yield x
}
}
def @ALabel
{
@DoLabel
which { "a" }
label { alabel @Else nodelabel }
labelmargin { alabelmargin @Else nodelabelmargin }
labelfont { alabelfont @Else nodelabelfont }
labelbreak { alabelbreak @Else nodelabelbreak }
labelformat { alabelformat @Body @Else nodelabelformat @Body}
labelpos { alabelpos @Else nodelabelpos }
labelprox { alabelprox @Else nodelabelprox }
labelangle { alabelangle @Else nodelabelangle }
labelctr { alabelctr @Else nodelabelctr }
labeladjust { alabeladjust @Else nodelabeladjust }
}
def @BLabel
{
@DoLabel
which { "b" }
label { blabel @Else nodelabel }
labelmargin { blabelmargin @Else nodelabelmargin }
labelfont { blabelfont @Else nodelabelfont }
labelbreak { blabelbreak @Else nodelabelbreak }
labelformat { blabelformat @Body @Else nodelabelformat @Body}
labelpos { blabelpos @Else nodelabelpos }
labelprox { blabelprox @Else nodelabelprox }
labelangle { blabelangle @Else nodelabelangle }
labelctr { blabelctr @Else nodelabelctr }
labeladjust { blabeladjust @Else nodelabeladjust }
}
def @CLabel
{
@DoLabel
which { "c" }
label { clabel @Else nodelabel }
labelmargin { clabelmargin @Else nodelabelmargin }
labelfont { clabelfont @Else nodelabelfont }
labelbreak { clabelbreak @Else nodelabelbreak }
labelformat { clabelformat @Body @Else nodelabelformat @Body}
labelpos { clabelpos @Else nodelabelpos }
labelprox { clabelprox @Else nodelabelprox }
labelangle { clabelangle @Else nodelabelangle }
labelctr { clabelctr @Else nodelabelctr }
labeladjust { clabeladjust @Else nodelabeladjust }
}
def @DLabel
{
@DoLabel
which { "d" }
label { dlabel @Else nodelabel }
labelmargin { dlabelmargin @Else nodelabelmargin }
labelfont { dlabelfont @Else nodelabelfont }
labelbreak { dlabelbreak @Else nodelabelbreak }
labelformat { dlabelformat @Body @Else nodelabelformat @Body}
labelpos { dlabelpos @Else nodelabelpos }
labelprox { dlabelprox @Else nodelabelprox }
labelangle { dlabelangle @Else nodelabelangle }
labelctr { dlabelctr @Else nodelabelctr }
labeladjust { dlabeladjust @Else nodelabeladjust }
}
import @Geometry
def @OutLine
{
@BackEnd @Case {
PostScript @Yield {
outline @Case {
box @Yield { "ldiagbox" }
curvebox @Yield { "("margin") ldiagcurvebox" }
shadowbox @Yield { shadow "ldiagshadow ldiagbox" }
square @Yield { "ldiagsquare" }
diamond @Yield { "ldiagdiamond" }
polygon @Yield { sides angle "ldiagpolygon" }
isosceles @Yield { "ldiagisosceles" }
ellipse @Yield { "ldiagellipse" }
circle @Yield { "ldiagcircle" }
else @Yield {
outline
margin { "("margin") ldiagdecodelength" }
shadow { shadow }
sides { sides }
angle { angle }
}
}
}
PDF @Yield {}
}
}
def @Value
{
@BackEnd @Case {
PostScript @Yield {
@HContract @VContract
{
{
"ldiagnodebegin [" @OutLine "]"
outlinedashlength "[" outlinestyle "]"
outlinewidth paint @PSAddPaint texture "ldiagnodeend"
"(IN) ldiagpushtagdict"
//
"ldiagpopuptagdict"
}
@Graphic
{
{@Align valign} @VShift {@Align halign} @HShift
@AddMargins
mtop { topmargin @Else vmargin @Else margin }
mfoot { footmargin @Else vmargin @Else margin }
mleft { leftmargin @Else hmargin @Else margin }
mright { rightmargin @Else hmargin @Else margin }
@HSize @VSize @HContract @VContract
font @Font break @Break format @Strut @Body
}
/ {alabel @Else nodelabel} @IfNonEmpty @ALabel
/ {blabel @Else nodelabel} @IfNonEmpty @BLabel
/ {clabel @Else nodelabel} @IfNonEmpty @CLabel
/ {dlabel @Else nodelabel} @IfNonEmpty @DLabel
}
}
PDF @Yield {}
}
}
def @TValue
{
nodetag @Case {
"" @Yield @Value
else @Yield { nodetag:: @Value }
}
}
translate @Case {
"" @Yield @TValue
else @Yield {
@Null & # so that preceding space gets chewed up
@Transform translate { translate } rotate { rotate } @TValue
}
}
}
#######################################################################
# #
# @Box, @CurveBox, and other standard node abbreviations #
# #
#######################################################################
macro @@Node { @Node }
macro @Box { @Node outline { box } }
macro @CurveBox { @Node outline { curvebox } }
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 } }
#######################################################################
# #
# Arrowheads #
# #
#######################################################################
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 }
texture { solid }
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 }
texture { solid }
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 }
texture { solid }
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 }
texture { solid }
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 }
texture { solid }
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 }
texture { solid }
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 }
texture { solid }
outlinewidth { pathwidth }
outline { circle }
{ length @Wide length @High }
}
def @BoxArrowHead
named width { arrowwidth }
named length { arrowlength }
named pathwidth { pathwidth }
{
@InsulatedNode
outlinestyle { noline }
paint { nochange }
texture { solid }
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 }
}
}
#######################################################################
# #
# @Link #
# #
#######################################################################
def @Link
import @Geometry named path
named from {}
named to {}
named bias {}
named fbias {}
named tbias {}
named hfrac {}
named hbias {}
named radius {}
named xindent {}
named zindent {}
named frompt {}
named topt {}
named arrow {}
named arrowlength {}
named backarrowlength {}
{ path
from { from }
to { to }
bias { bias }
fbias { fbias }
tbias { tbias }
hfrac { hfrac }
hbias { hbias }
radius { radius }
xindent { xindent }
zindent { zindent }
frompt { frompt }
topt { topt }
arrow { arrow }
backarrowlength { backarrowlength }
}
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 hfrac { hfrac }
import @Geometry named hbias { hbias }
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 dotdashed { "/ldiagdotdashed" }
named dotcdashed { "/ldiagdotcdashed" }
named dotdotdashed { "/ldiagdotdotdashed" }
named dotdotcdashed { "/ldiagdotdotcdashed" }
named dotdotdotdashed { "/ldiagdotdotdotdashed" }
named dotdotdotcdashed { "/ldiagdotdotdotcdashed" }
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 backarrowstyle { backarrowstyle }
named backarrowwidth { backarrowwidth }
named backarrowlength { backarrowlength }
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 { backarrowstyle }
width { backarrowwidth }
length { backarrowlength }
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 backarrowlength}
{arrow @ToArrowLength arrowlength}
"{" from "}" "{" to "}"
xindent zindent "ldiaglinepath"
# FROM :< {from??CTR angleto to??CTR}
# FROM :: from boundaryatangle FROM@ANGLE
# ++ {arrow @FromArrowLength backarrowlength}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 backarrowlength}
{arrow @ToArrowLength arrowlength}
"{" from "}" "{" to "}"
xindent zindent pathgap "ldiagdoublelinepath"
# FROM :< {from??CTR angleto to??CTR}
# FROM :: from boundaryatangle FROM@ANGLE
# ++ {arrow @FromArrowLength backarrowlength}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 backarrowlength}
{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 backarrowlength }
# 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 backarrowlength}
{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 backarrowlength }
# 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 backarrowlength}
{arrow @ToArrowLength arrowlength}
"{" from "}" "{" to "}"
xindent zindent [ frompt ] [ topt ] "ldiagbezierpath"
# FROM :< from??CTR angleto frompt
# FROM :: from boundaryatangle FROM@ANGLE
# ++ {arrow @FromArrowLength backarrowlength} 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 backarrowlength}
{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 backarrowlength} 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 backarrowlength}
{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 backarrowlength} 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 backarrowlength}
{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 backarrowlength} 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 backarrowlength}
{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 backarrowlength} 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 backarrowlength}
{arrow @ToArrowLength arrowlength}
"{" from "}" "{" to "}"
xindent zindent bias "ldiaglvrlinepath"
# FROM :: from boundaryatangle 180d
# ++ {arrow @FromArrowLength backarrowlength} 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 backarrowlength}
{arrow @ToArrowLength arrowlength}
"{" from "}" "{" to "}"
xindent zindent bias radius "ldiaglvrcurvepath"
# FROM :: from boundaryatangle 180d
# ++ {arrow @FromArrowLength backarrowlength} 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 backarrowlength}
{arrow @ToArrowLength arrowlength}
"{" from "}" "{" to "}"
xindent zindent bias "ldiagrvllinepath"
# FROM :: from boundaryatangle 0d
# ++ {arrow @FromArrowLength backarrowlength} 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 backarrowlength}
{arrow @ToArrowLength arrowlength}
"{" from "}" "{" to "}"
xindent zindent bias radius "ldiagrvlcurvepath"
# FROM :: from boundaryatangle 0d
# ++ {arrow @FromArrowLength backarrowlength} 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 @HVHLinePath # still to do
{
@BackEnd @Case {
PostScript @Yield {
{arrow @FromArrowLength backarrowlength}
{arrow @ToArrowLength arrowlength}
"{" from "}" "{" to "}"
xindent zindent hfrac hbias "ldiaghvhlinepath"
# FRDIRN := {{from??CTR angleto to??CTR} quadcase
# 0 { 0d } 0-90 { 0d } 90 { 0d } 90-180 { 180d }
# 180 { 180d } 180-270 { 180d } 270 { 180d } 270-360 { 0d }}
# TODIRN := {FRDIRN + 180d}
# FROM :: from boundaryatangle FRDIRN ++
# {arrow @FromArrowLength backarrowlength} atangle FRDIRN
# FROM :< FRDIRN
# TO :: to boundaryatangle TODIRN ++
# {arrow @ToArrowLength arrowlength} atangle TODIRN
# TO :< FRDIRN
# BIAS := abs { xcoord FROM - xcoord TO } * hfrac + hbias
# P1 :: FROM ++ BIAS atangle FRDIRN
# P2 :: { xcoord P1 ycoord TO }
# LMID :: { P1 ** 0.5 ++ P2 ** 0.5 }
# LMID :< P1 angleto P2
# XINDENT := xindent min {FROM distance P1}
# ZINDENT := zindent min {P2 distance TO}
# LFROM :: FROM ++ {XINDENT atangle FRDIRN}
# LFROM :< FRDIRN
# LTO :: TO ++ {ZINDENT atangle TODIRN}
# LTO :< FRDIRN
# FROM LFROM P1 LMID P2 LTO TO
}
PDF @Yield {}
}
}
import @Geometry
def @HVHCurvePath # still to do
{
@BackEnd @Case {
PostScript @Yield {
{arrow @FromArrowLength backarrowlength}
{arrow @ToArrowLength arrowlength}
"{" from "}" "{" to "}"
xindent zindent hfrac hbias radius "ldiaghvhcurvepath"
# FRDIRN := {{from??CTR angleto to??CTR} quadcase
# 0 { 0d } 0-90 { 0d } 90 { 0d } 90-180 { 180d }
# 180 { 180d } 180-270 { 180d } 270 { 180d } 270-360 { 0d }}
# TODIRN := {FRDIRN + 180d}
# FROM :: from boundaryatangle FRDIRN ++
# {arrow @FromArrowLength backarrowlength} atangle FRDIRN
# FROM :< FRDIRN
# TO :: to boundaryatangle TODIRN ++
# {arrow @ToArrowLength arrowlength} atangle TODIRN
# TO :< FRDIRN
# BIAS := abs { xcoord FROM - xcoord TO } * hfrac + hbias
# XP1 := FROM ++ BIAS atangle FRDIRN
# XP2 := { xcoord XP1 ycoord TO }
# LMID :: { XP1 ** 0.5 ++ XP2 ** 0.5 }
# VERT := round { XP1 angleto XP2 }
# LMID :< VERT
# XINDENT := xindent min {FROM distance XP1}
# ZINDENT := zindent min {XP2 distance TO}
# LFROM :: FROM ++ {XINDENT atangle FRDIRN}
# LFROM :< FRDIRN
# LTO :: TO ++ {ZINDENT atangle TODIRN}
# LTO :< FRDIRN
# RADIUS := radius min { { XP1 distance XP2 } / 2 }
# XP1PRE := XP1 ++ { RADIUS atangle TODIRN }
# 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 FRDIRN }
# XP2CTR := XP2POST -- { RADIUS atangle VERT }
# P2 :: XP2CTR ++ { RADIUS atangle { XP2CTR angleto XP2 } }
# P2 :< XP2PRE angleto XP2POST
# if cond { {VERT - FRDIRN} = 90 }
# then { P1GO := "anticlockwise" P2GO := "clockwise" }
# else { P1GO := "clockwise" P2GO := "anticlockwise" }
# FROM LFROM
# XP1PRE [XP1CTR P1GO] P1 [XP1CTR P1GO] XP1POST
# LMID
# XP2PRE [XP2CTR P2GO] P2 [XP2CTR P2GO] XP2POST
# LTO TO
}
PDF @Yield {}
}
}
import @Geometry
def @VHVLinePath # still to do
{
@BackEnd @Case {
PostScript @Yield {
{arrow @FromArrowLength backarrowlength}
{arrow @ToArrowLength arrowlength}
"{" from "}" "{" to "}"
xindent zindent hfrac hbias "ldiagvhvlinepath"
# FROM :: from boundaryatangle 0d
# ++ {arrow @FromArrowLength backarrowlength} 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 @VHVCurvePath # still to do
{
@BackEnd @Case {
PostScript @Yield {
{arrow @FromArrowLength backarrowlength}
{arrow @ToArrowLength arrowlength}
"{" from "}" "{" to "}"
xindent zindent hfrac hbias radius "ldiagvhvcurvepath"
# /FRDIRN [ { 0 dg } { 180 dg } { 180 dg } { 0 dg }
# { 0 dg } { 0 dg } { 180 dg } { 180 dg }
# from (CTR) ldiagdolabel to (CTR) ldiagdolabel
# ldiagangleto ldiagquadcase ] cvx def
# /TODIRN [ FRDIRN 180 dg add ] cvx def
# from (CTR) ldiagdolabel FRDIRN from (CIRCUM) ldiagdolabel ldiagpadd
# 0 0 fromarrowlength FRDIRN ldiagatangle ldiagpadd /FROM ldiagpointdef
# FRDIRN /FROM@ANGLE ldiagangledef
# to (CTR) ldiagdolabel TODIRN to (CIRCUM) ldiagdolabel ldiagpadd
# 0 0 toarrowlength TODIRN ldiagatangle ldiagpadd /TO ldiagpointdef
# FRDIRN /TO@ANGLE ldiagangledef
# /BIAS [ FROM pop TO pop sub abs hfrac mul hbias add ] cvx def
# /XP1 [ FROM 0 0 BIAS FRDIRN ldiagatangle ldiagpadd ] cvx def
# /XP2 [ XP1 pop TO exch pop ] cvx def
# XP1 0.5 ldiagpmul XP2 0.5 ldiagpmul ldiagpadd /LMID ldiagpointdef
# /VERT [ XP1 XP2 ldiagangleto round ] cvx def
# VERT /LMID@ANGLE ldiagangledef
# /XINDENT [ xindent FROM XP1 ldiagdistance ldiagmin ] cvx def
# /ZINDENT [ zindent XP2 TO ldiagdistance ldiagmin ] cvx def
# FROM 0 0 XINDENT FRDIRN ldiagatangle ldiagpadd /LFROM ldiagpointdef
# FRDIRN /LFROM@ANGLE ldiagangledef
# TO 0 0 ZINDENT TODIRN ldiagatangle ldiagpadd /LTO ldiagpointdef
# FRDIRN /LTO@ANGLE ldiagangledef
# /RADIUS [ radius XP1 XP2 ldiagdistance 2 div ldiagmin ] cvx def
# /XP1PRE [ XP1 0 0 RADIUS TODIRN ldiagatangle ldiagpadd ] cvx def
# /XP1POST [ XP1 0 0 RADIUS VERT ldiagatangle ldiagpadd ] cvx def
# /XP1CTR [ XP1PRE 0 0 RADIUS VERT ldiagatangle ldiagpadd ] cvx def
# XP1CTR 0 0 RADIUS XP1CTR XP1 ldiagangleto ldiagatangle ldiagpadd /P1 ldiagpointdef
# XP1PRE XP1POST ldiagangleto /P1@ANGLE ldiagangledef
# /XP2PRE [ 0 0 RADIUS VERT ldiagatangle XP2 ldiagpsub ] cvx def
# /XP2POST [ XP2 0 0 RADIUS FRDIRN ldiagatangle ldiagpadd ] cvx def
# /XP2CTR [ 0 0 RADIUS VERT ldiagatangle XP2POST ldiagpsub ] cvx def
# XP2CTR 0 0 RADIUS XP2CTR XP2 ldiagangleto ldiagatangle ldiagpadd /P2 ldiagpointdef
# XP2PRE XP2POST ldiagangleto /P2@ANGLE ldiagangledef
# VERT FRDIRN sub 90 eq
# { /P1GO [ anticlockwise ] cvx def /P2GO [ clockwise ] cvx def }
# { /P1GO [ clockwise ] cvx def /P2GO [ anticlockwise ] cvx def }
# ifelse
# FROM LFROM
# XP1PRE [XP1CTR P1GO] P1 [XP1CTR P1GO] XP1POST
# LMID
# XP2PRE [XP2CTR P2GO] P2 [XP2CTR P2GO] XP2POST
# LTO TO
}
PDF @Yield {}
}
}
import @Geometry
def @DWrapLinePath
{
@BackEnd @Case {
PostScript @Yield {
{arrow @FromArrowLength backarrowlength}
{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 backarrowlength} 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 backarrowlength}
{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 backarrowlength} 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 backarrowlength}
{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 backarrowlength} 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 backarrowlength}
{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 backarrowlength} 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
hvhline @Yield @HVHLinePath
hvhcurve @Yield @HVHCurvePath
vhvline @Yield @VHVLinePath
vhvcurve @Yield @VHVCurvePath
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 }
hfrac { hfrac }
hbias { hbias }
radius { radius }
xindent { xindent }
zindent { zindent }
frompt { frompt }
topt { topt }
arrow { arrow }
arrowlength { arrowlength }
backarrowlength { backarrowlength }
}
}
}
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"
"/ldiagdotted"
"/ldiagnoline"
"/ldiagcdashed"
"/ldiagdotdashed"
"/ldiagdotcdashed"
"/ldiagdotdotdashed"
"/ldiagdotdotcdashed"
"/ldiagdotdotdotdashed"
"/ldiagdotdotdotcdashed"
} @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 hfrac {}
named hbias {}
named radius {}
named xindent {}
named zindent {}
named frompt {}
named topt {}
named arrow {}
named arrowlength {}
named backarrowlength {}
{ path
from { from }
to { to }
bias { bias }
fbias { fbias }
tbias { tbias }
hfrac { hfrac }
hbias { hbias }
radius { radius }
xindent { xindent }
zindent { zindent }
frompt { frompt }
topt { topt }
arrow { arrow }
arrowlength { arrowlength }
backarrowlength { backarrowlength }
}
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 hfrac { hfrac }
import @Geometry named hbias { hbias }
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 dotdashed { "/ldiagdotdashed" }
named dotcdashed { "/ldiagdotcdashed" }
named dotdotdashed { "/ldiagdotdotdashed" }
named dotdotcdashed { "/ldiagdotdotcdashed" }
named dotdotdotdashed { "/ldiagdotdotdotdashed" }
named dotdotdotcdashed { "/ldiagdotdotdotcdashed" }
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 backarrowstyle { backarrowstyle }
named backarrowwidth { backarrowwidth }
named backarrowlength { backarrowlength }
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 }
hfrac { hfrac }
hbias { hbias }
radius { radius }
xindent { xindent }
zindent { zindent }
frompt { frompt }
topt { topt }
path { path
from { @From }
to { @To }
bias { bias }
fbias { fbias }
tbias { tbias }
hfrac { hfrac }
hbias { hbias }
radius { radius }
xindent { xindent }
zindent { zindent }
frompt { frompt }
topt { topt }
arrow { arrow }
arrowlength { arrowlength }
backarrowlength { backarrowlength }
}
pathstyle { pathstyle }
pathdashlength { pathdashlength }
pathwidth { pathwidth }
pathgap { pathgap }
arrow { arrow }
arrowstyle { arrowstyle }
arrowwidth { arrowwidth }
arrowlength { arrowlength }
backarrowstyle { backarrowstyle }
backarrowwidth { backarrowwidth }
backarrowlength { backarrowlength }
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 }
}
}
#######################################################################
# #
# Abbreviations for standard link types #
# #
#######################################################################
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 @HVHLine { @Link path { hvhline } }
macro @HVHArrow { @Link path { hvhline } arrow { yes } }
macro @VHVLine { @Link path { vhvline } }
macro @VHVArrow { @Link path { vhvline } arrow { yes } }
macro @HVHCurve { @Link path { hvhcurve } }
macro @HVHCurveArrow { @Link path { hvhcurve } arrow { yes } }
macro @VHVCurve { @Link path { vhvcurve } }
macro @VHVCurveArrow { @Link path { vhvcurve } 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 } }
#######################################################################
# #
# Tree code. #
# #
#######################################################################
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
}
#######################################################################
# #
# Syntax diagrams code #
# #
# Helper definitions; also skips #
# #
#######################################################################
def pslength right x { "("x") ldiagdecodelength" }
def pssyntaxgap { "("syntaxgap") ldiagdecodelength" }
def pssyntaxbias { "("syntaxbias") ldiagdecodelength" }
def pssyntaxradius { "("syntaxradius") ldiagdecodelength" }
def @ArrowLeftFrom left direction right pt
{
@Line arrow { direction } from { pt } to { pt -- { pssyntaxgap 0 } }
}
def @ArrowRightFrom left direction right pt
{
@Line arrow { direction } from { pt } to { pt ++ { pssyntaxgap 0 } }
}
def @ArrowUpFrom left direction right pt
{
@Line arrow { direction } from { pt } to { pt ++ { 0 pssyntaxgap } }
}
def @ArrowDownFrom left direction right pt
{
@Line arrow { direction } from { pt } to { pt -- { 0 pssyntaxgap } }
}
macro @LineLeftFrom { no @ArrowLeftFrom }
macro @LineRightFrom { no @ArrowRightFrom }
macro @LineUpFrom { no @ArrowUpFrom }
macro @LineDownFrom { no @ArrowDownFrom }
macro @Right { "1p" }
macro @Up { "2p" }
macro @Left { "3p" }
macro @Down { "4p" }
macro @CurrDirection { @CurrZUnit }
def @GoRight right x { @Right @ZUnit x }
def @GoUp right x { @Up @ZUnit x }
def @GoLeft right x { @Left @ZUnit x }
def @GoDown right x { @Down @ZUnit x }
def @GoReverse right x
{
@CurrDirection @Case {
@Right @Yield @GoLeft x
@Up @Yield @GoDown x
@Left @Yield @GoRight x
@Down @Yield @GoUp x
}
}
def @LabelMarks right x {
@HContract @VContract @ANode
outline {
NMK:: { xmark ysize }
SMK:: { xmark 0 }
WMK:: { 0 ymark }
EMK:: { xsize ymark }
NW:: { 0 ysize }
SW:: { 0 0 }
SE:: { xsize 0 }
NE:: { xsize ysize }
}
font {}
margin { 0c }
vstrut { no }
outlinestyle { noline }
halign { mark }
valign { mark }
x
}
def @HSkip
{
OX:: @LabelMarks { syntaxgap @Wide {} }
/ @Line from { "OX@WMK" } to { "OX@EMK" }
}
def @VSkip
{
OX:: @LabelMarks { syntaxgap @High {} }
/ @Line from { "OX@NMK" } to { "OX@SMK" }
}
def @Skip
{
@CurrDirection @Case {
{ @Left @Right } @Yield @HSkip
{ @Up @Down } @Yield @VSkip
}
}
def @LRLine right x
{
@HContract @VContract { @HSkip | x | @HSkip }
}
def @UDLine right x
{
@HContract @VContract { @VSkip / x / @VSkip }
}
#######################################################################
# #
# Ordinary starts: @StartRight, @StartUp, @StartLeft, @StartDown #
# #
#######################################################################
def @StartRight right x
{
@VContract {
@LabelMarks {
|syntaxgap @GoRight x |syntaxgap
}
/ @LineRightFrom WMK
/ back @ArrowLeftFrom EMK
}
}
def @StartUp right x
{
@VContract {
@LabelMarks {
^/syntaxgap @GoUp x /syntaxgap
}
/ @LineUpFrom SMK
/ back @ArrowDownFrom NMK
}
}
def @StartLeft right x
{
@VContract {
@LabelMarks {
|syntaxgap @GoLeft x |syntaxgap
}
/ @LineLeftFrom EMK
/ back @ArrowRightFrom WMK
}
}
def @StartDown right x
{
@VContract {
@LabelMarks {
^/syntaxgap @GoDown x /syntaxgap
}
/ @LineDownFrom NMK
/ back @ArrowUpFrom SMK
}
}
#######################################################################
# #
# Fancy starts: @StartRightRight, @StartRightDown #
# #
#######################################################################
def @StartRightRight
named A {}
named B {}
{
AA:: @LabelMarks { @HSkip & @GoRight A }
//syntaxgap
//syntaxgap
|syntaxgap |syntaxgap |syntaxgap |syntaxgap |syntaxgap |syntaxgap
CC:: @LabelMarks {}
//syntaxgap
//syntaxgap
|syntaxgap |syntaxgap |syntaxgap |syntaxgap |syntaxgap |syntaxgap
BB:: @LabelMarks { @GoRight B & @HSkip }
// @RVLCurve from { AA@EMK } to { CC@WMK }
bias { pssyntaxbias } radius { pssyntaxradius }
// @LVRCurve from { CC@WMK } to { BB@WMK }
bias { pssyntaxbias } radius { pssyntaxradius }
back @ArrowLeftFrom BB@EMK
}
def @StartRightRightRight
named A {}
named B {}
named C {}
{
AA:: @LabelMarks { @HSkip & @GoRight A }
//syntaxgap
//syntaxgap
|syntaxgap |syntaxgap |syntaxgap |syntaxgap |syntaxgap |syntaxgap
XX:: @LabelMarks {}
//syntaxgap
//syntaxgap
|syntaxgap |syntaxgap |syntaxgap |syntaxgap |syntaxgap |syntaxgap
BB:: @LabelMarks { @GoRight B & @HSkip }
//syntaxgap
//syntaxgap
|syntaxgap |syntaxgap |syntaxgap |syntaxgap |syntaxgap |syntaxgap
YY:: @LabelMarks {}
//syntaxgap
//syntaxgap
|syntaxgap |syntaxgap |syntaxgap |syntaxgap |syntaxgap |syntaxgap
CC:: @LabelMarks { @GoRight C & @HSkip }
//syntaxgap
//syntaxgap
// @RVLCurve from { AA@EMK } to { XX@WMK }
bias { pssyntaxbias } radius { pssyntaxradius }
// @LVRCurve from { XX@WMK } to { BB@WMK }
bias { pssyntaxbias } radius { pssyntaxradius }
// @RVLCurve from { BB@EMK } to { YY@WMK }
bias { pssyntaxbias } radius { pssyntaxradius }
// @LVRCurve from { YY@WMK } to { CC@WMK }
bias { pssyntaxbias } radius { pssyntaxradius }
back @ArrowLeftFrom CC@EMK
}
def @StartRightDown
named A {}
named B {}
{
@HContract @VContract {
/ BB:: @LabelMarks |syntaxgap AA::@LabelMarks @GoRight A |syntaxbias
/syntaxgap | |
/syntaxgap | |
}
/ @Line from { BB@EMK } to { AA@WMK }
/ @RVLCurve from { AA@EMK } to { xcoord AA@EMK pssyntaxgap }
bias { pssyntaxbias } radius { pssyntaxradius }
/ @HVCurve from { xcoord AA@EMK pssyntaxgap } to { 0 0 }
bias { pssyntaxbias } radius { pssyntaxradius }
/ @GoDown B
/ @VSkip
/ CC:: @LabelMarks {}
/ back @ArrowUpFrom CC@NMK
}
#######################################################################
# #
# Cells: @XCell, @ACell, @BCell, @CCell #
# #
#######################################################################
def @RightCell right x
{
@VContract {
@LabelMarks {
|syntaxgap x |syntaxgap
}
/ forward @ArrowRightFrom WMK
/ @LineLeftFrom EMK
}
}
def @LeftCell right x
{
@VContract {
@LabelMarks {
|syntaxgap x |syntaxgap
}
/ forward @ArrowLeftFrom EMK
/ @LineRightFrom WMK
}
}
def @DownCell right x
{
@VContract {
@LabelMarks {
^/syntaxgap x /syntaxgap
}
/ forward @ArrowDownFrom NMK
/ @LineUpFrom SMK
}
}
def @UpCell right x
{
@VContract {
@LabelMarks {
^/syntaxgap x /syntaxgap
}
/ forward @ArrowUpFrom SMK
/ @LineDownFrom NMK
}
}
def @XCell right x
{
@CurrDirection @Case {
@Right @Yield @RightCell x
@Up @Yield @UpCell x
@Left @Yield @LeftCell x
@Down @Yield @DownCell x
}
}
macro @ACell { @XCell @ANode }
macro @BCell { @XCell @BNode }
macro @CCell { @XCell @CNode }
#######################################################################
# #
# @Sequence #
# #
#######################################################################
def @Sequence
named A {}
named B {}
named C {}
named D {}
named E {}
named F {}
named G {}
named H {}
named I {}
named J {}
named K {}
named L {}
{
@CurrDirection @Case {
@Right @Yield
@HContract { A | B | C | D | E | F | G | H | I | J | K | L }
@Up @Yield
@VContract { L / K / J / I / H / G / F / E / D / C / B / A }
@Left @Yield
@HContract { L | K | J | I | H | G | F | E | D | C | B | A }
@Down @Yield
@VContract { A / B / C / D / E / F / G / H / I / J / K / L }
}
}
#######################################################################
# #
# @OneOrBoth #
# #
#######################################################################
def @OneOrBoth
named A {}
named B {}
{
def @ALH {
@HContract {
|syntaxgap
"AX":: restrict { "(WMK) (EMK)" } @LabelMarks A
|syntaxgap
}
}
def @BLH {
@HContract {
|syntaxgap
"BX":: restrict { "(WMK) (EMK)" } @LabelMarks B
|syntaxgap
}
}
def @ALV {
@VContract {
/syntaxgap
"AX":: restrict { "(NMK) (SMK)" } @LabelMarks A
/syntaxgap
}
}
def @BLV {
@VContract {
/syntaxgap
"BX":: restrict { "(NMK) (SMK)" } @LabelMarks B
/syntaxgap
}
}
def @RightOneOrBoth
{
@LRLine {
@HContract @VContract { @ALH | /syntaxgap | @BLH }
//
@HVCurve from { "BX@WMK" } to { 0 ycoord "AX@WMK" }
arrow { no } bias { pssyntaxbias } radius { pssyntaxradius }
//
@HVCurve from { "BX@EMK" } to { xsize ycoord "AX@WMK" }
arrow { yes } bias { pssyntaxbias } radius { pssyntaxradius }
//
@Line from { 0 ycoord "AX@WMK" } to { "AX@WMK" }
//
@Line from { "AX@EMK" } to { xsize ycoord "AX@WMK" }
//
@Arrow
from { {xcoord "AX@EMK" * 0.5 + xcoord "BX@WMK" * 0.5}
ycoord "AX@EMK" }
to { {xcoord "AX@EMK" * 0.5 + xcoord "BX@WMK" * 0.5}
ycoord "BX@WMK" }
}
}
def @LeftOneOrBoth
{
@LRLine {
@HContract @VContract { | @ALH /syntaxgap @BLH | }
//
@HVCurve from { "BX@WMK" } to { 0 ycoord "AX@WMK" }
arrow { yes } bias { pssyntaxbias } radius { pssyntaxradius }
//
@HVCurve from { "BX@EMK" } to { xsize ycoord "AX@WMK" }
arrow { no } bias { pssyntaxbias } radius { pssyntaxradius }
//
@Line from { 0 ycoord "AX@WMK" } to { "AX@WMK" }
//
@Line from { "AX@EMK" } to { xsize ycoord "AX@WMK" }
//
@Arrow
from { {xcoord "AX@WMK" * 0.5 + xcoord "BX@EMK" * 0.5}
ycoord "AX@WMK" }
to { {xcoord "AX@WMK" * 0.5 + xcoord "BX@EMK" * 0.5}
ycoord "BX@EMK" }
}
}
def @DownOneOrBoth
{
@UDLine {
@HContract @VContract { @ALV |syntaxgap / | @BLV }
||
@VHCurve from { "BX@NMK" } to { xcoord "AX@NMK" ysize }
arrow { no } bias { pssyntaxbias } radius { pssyntaxradius }
||
@VHCurve from { "BX@SMK" } to { xcoord "AX@NMK" 0 }
arrow { yes } bias { pssyntaxbias } radius { pssyntaxradius }
||
@Line from { xcoord "AX@NMK" ysize } to { "AX@NMK" }
||
@Line from { "AX@SMK" } to { xcoord "AX@SMK" 0 }
||
@Arrow
from { xcoord "AX@SMK"
{ycoord "AX@SMK" * 0.5 + ycoord "BX@NMK" * 0.5} }
to { xcoord "BX@NMK"
{ycoord "AX@SMK" * 0.5 + ycoord "BX@NMK" * 0.5} }
}
}
def @UpOneOrBoth
{
@UDLine {
@HContract @VContract { |syntaxgap @BLV / @ALV | }
||
@VHCurve from { "BX@NMK" } to { xcoord "AX@NMK" ysize }
arrow { yes } bias { pssyntaxbias } radius { pssyntaxradius }
||
@VHCurve from { "BX@SMK" } to { xcoord "AX@NMK" 0 }
arrow { no } bias { pssyntaxbias } radius { pssyntaxradius }
||
@Line from { xcoord "AX@NMK" ysize } to { "AX@NMK" }
||
@Line from { "AX@SMK" } to { xcoord "AX@SMK" 0 }
||
@Arrow
from { xcoord "AX@NMK"
{ycoord "AX@NMK" * 0.5 + ycoord "BX@SMK" * 0.5} }
to { xcoord "BX@SMK"
{ycoord "AX@NMK" * 0.5 + ycoord "BX@SMK" * 0.5} }
}
}
@CurrDirection @Case {
@Right @Yield @RightOneOrBoth
@Up @Yield @UpOneOrBoth
@Left @Yield @LeftOneOrBoth
@Down @Yield @DownOneOrBoth
}
}
#######################################################################
# #
# @Select and @Optional #
# #
#######################################################################
def @Select
named A {}
named B {}
named C {}
named D {}
named E {}
named F {}
named G {}
named H {}
named I {}
named J {}
named K {}
named L {}
{
def @RLFirstOrMiddle
left label
named i { 0i }
named al { no }
named ar { no }
right x
{
{|i @HContract { |syntaxgap label:: restrict { "(WMK) (EMK)" }
@LabelMarks x |syntaxgap }}
// @Line from { label"@WMK" } to { 0 ycoord label"@WMK" }
arrow { al }
// @Line from { label"@EMK" } to { xsize ycoord label"@EMK" }
arrow { ar }
}
def @UDFirstOrMiddle
left label
named i { 0i }
named au { no }
named ad { no }
right x
{
{/i @VContract { /syntaxgap label:: restrict { "(NMK) (SMK)" }
@LabelMarks x /syntaxgap }}
|| @Line from { label"@NMK" } to { xcoord label"@NMK" ysize }
arrow { au }
|| @Line from { label"@SMK" } to { xcoord label"@SMK" 0 }
arrow { ad }
}
def @RLLast
left label
named i { 0i }
named al { no }
named ar { no }
right x
{
{|i @HContract { |syntaxgap label:: restrict { "(WMK) (EMK)" }
@LabelMarks x |syntaxgap }}
// @HVCurve from { label"@WMK" } to { 0 ycoord "AX@WMK" }
arrow { al } bias { pssyntaxbias } radius { pssyntaxradius }
// @HVCurve from { label"@EMK" } to { xsize ycoord "AX@WMK" }
arrow { ar } bias { pssyntaxbias } radius { pssyntaxradius }
}
def @UDLast
left label
named i { 0i }
named au { no }
named ad { no }
right x
{
{/i @VContract { /syntaxgap label:: restrict { "(NMK) (SMK)" }
@LabelMarks x /syntaxgap }}
|| @VHCurve from { label"@NMK" } to { xcoord "AX@NMK" ysize }
arrow { au } bias { pssyntaxbias } radius { pssyntaxradius }
|| @VHCurve from { label"@SMK" } to { xcoord "AX@SMK" 0 }
arrow { ad } bias { pssyntaxbias } radius { pssyntaxradius }
}
def @DirectedSelect
named @First left label right x {}
named @Middle left label right x {}
named @Last left label right x {}
named @Join precedence 90 left x right y {}
{
def @LastIsA
{
A
}
def @LastIsB
{
AX @First A
@Join BX @Last B
}
def @LastIsC
{
AX @First A
@Join BX @Middle B
@Join CX @Last C
}
def @LastIsD
{
AX @First A
@Join BX @Middle B
@Join CX @Middle C
@Join DX @Last D
}
def @LastIsE
{
AX @First A
@Join BX @Middle B
@Join CX @Middle C
@Join DX @Middle D
@Join EX @Last E
}
def @LastIsF
{
AX @First A
@Join BX @Middle B
@Join CX @Middle C
@Join DX @Middle D
@Join EX @Middle E
@Join FX @Last F
}
def @UpToF
{
AX @First A
@Join BX @Middle B
@Join CX @Middle C
@Join DX @Middle D
@Join EX @Middle E
@Join FX @Middle F
}
def @LastIsG
{
@UpToF
@Join GX @Last G
}
def @LastIsH
{
@UpToF
@Join GX @Middle G
@Join HX @Last H
}
def @LastIsI
{
@UpToF
@Join GX @Middle G
@Join HX @Middle H
@Join IX @Last I
}
def @LastIsJ
{
@UpToF
@Join GX @Middle G
@Join HX @Middle H
@Join IX @Middle I
@Join JX @Last J
}
def @LastIsK
{
@UpToF
@Join GX @Middle G
@Join HX @Middle H
@Join IX @Middle I
@Join JX @Middle J
@Join KX @Last K
}
def @LastIsL
{
@UpToF
@Join GX @Middle G
@Join HX @Middle H
@Join IX @Middle I
@Join JX @Middle J
@Join KX @Middle K
@Join LX @Last L
}
def @TryA { A @Case { {} @Yield @Skip else @Yield @LastIsA } }
def @TryB { B @Case { {} @Yield @TryA else @Yield @LastIsB } }
def @TryC { C @Case { {} @Yield @TryB else @Yield @LastIsC } }
def @TryD { D @Case { {} @Yield @TryC else @Yield @LastIsD } }
def @TryE { E @Case { {} @Yield @TryD else @Yield @LastIsE } }
def @TryF { F @Case { {} @Yield @TryE else @Yield @LastIsF } }
def @TryG { G @Case { {} @Yield @TryF else @Yield @LastIsG } }
def @TryH { H @Case { {} @Yield @TryG else @Yield @LastIsH } }
def @TryI { I @Case { {} @Yield @TryH else @Yield @LastIsI } }
def @TryJ { J @Case { {} @Yield @TryI else @Yield @LastIsJ } }
def @TryK { K @Case { {} @Yield @TryJ else @Yield @LastIsK } }
def @TryL { L @Case { {} @Yield @TryK else @Yield @LastIsL } }
@TryL
}
def @RightSelect
{
@LRLine @DirectedSelect
@First { label @RLFirstOrMiddle x }
@Middle { label @RLFirstOrMiddle ar { yes } x }
@Last { label @RLLast ar { yes } x }
@Join { x //syntaxgap y }
}
def @UpSelect
{
@UDLine @DirectedSelect
@First { label @UDFirstOrMiddle i { 1r } x }
@Middle { label @UDFirstOrMiddle i { 1r } au { yes } x }
@Last { label @UDLast i { 1r } au { yes } x }
@Join { x ||syntaxgap y }
}
def @LeftSelect
{
@LRLine @DirectedSelect
@First { label @RLFirstOrMiddle i { 1r } x }
@Middle { label @RLFirstOrMiddle i { 1r } al { yes } x }
@Last { label @RLLast i { 1r } al { yes } x }
@Join { x //syntaxgap y }
}
def @DownSelect
{
@UDLine @DirectedSelect
@First { label @UDFirstOrMiddle x }
@Middle { label @UDFirstOrMiddle ad { yes } x }
@Last { label @UDLast ad { yes } x }
@Join { x ||syntaxgap y }
}
@CurrDirection @Case {
@Right @Yield @RightSelect
@Up @Yield @UpSelect
@Left @Yield @LeftSelect
@Down @Yield @DownSelect
}
}
def @Optional right x
{
@Select A { @Skip } B { x }
}
#######################################################################
# #
# @OptionalDiverted #
# #
#######################################################################
def @DownRightOptionalDiverted right x
{
@UDLine {
OX:: @LabelMarks {
|syntaxgap AX:: @LabelMarks @GoRight x |syntaxbias
/syntaxgap
}
/ @Line from { "OX@NW" } to { "OX@SW" }
/ @Line from { "OX@WMK" } to { "OX@IN@AX@WMK" }
/ @RVLCurveArrow from { "OX@IN@AX@EMK" } to { "OX@SW" }
bias { pssyntaxbias } radius { pssyntaxradius }
}
}
def @UpRightOptionalDiverted right x
{
@UDLine {
OX:: @LabelMarks {
^/syntaxgap
|syntaxgap AX:: @LabelMarks @GoRight x |syntaxbias
}
/ @Line from { "OX@NW" } to { "OX@SW" }
/ @Line from { "OX@WMK" } to { "OX@IN@AX@WMK" }
/ @RVLCurveArrow from { "OX@IN@AX@EMK" } to { "OX@NW" }
bias { pssyntaxbias } radius { pssyntaxradius }
}
}
def @RightDownOptionalDiverted right x
{
@LRLine {
OX:: @LabelMarks {
{ /syntaxgap AX:: @LabelMarks @GoDown x /syntaxbias }
|syntaxgap
}
/ @Line from { "OX@NW" } to { "OX@NE" }
/ @Line from { "OX@NMK" } to { "OX@IN@AX@NMK" }
/ @VHCurve from {"OX@IN@AX@SMK"} to { "OX@SE"--{pssyntaxgap 0} }
bias { pssyntaxbias } radius { pssyntaxradius }
/ @HVCurve from { "OX@SE" -- {pssyntaxgap 0} } to { "OX@NE" }
arrow { yes } bias { pssyntaxbias } radius { pssyntaxradius }
}
}
def @LeftDownOptionalDiverted right x
{
@LRLine {
OX:: @LabelMarks {
^|syntaxgap
{ /syntaxgap AX:: @LabelMarks @GoDown x /syntaxbias }
}
/ @Line from { "OX@NW" } to { "OX@NE" }
/ @Line from { "OX@NMK" } to { "OX@IN@AX@NMK" }
/ @VHCurve from {"OX@IN@AX@SMK"} to { "OX@SW"++{pssyntaxgap 0} }
bias { pssyntaxbias } radius { pssyntaxradius }
/ @HVCurve from { "OX@SW" ++ {pssyntaxgap 0} } to { "OX@NW" }
arrow { yes } bias { pssyntaxbias } radius { pssyntaxradius }
}
}
def @OptionalDiverted right x
{
@CurrDirection @Case {
@Right @Yield @RightDownOptionalDiverted x
@Up @Yield @UpRightOptionalDiverted x
@Left @Yield @LeftDownOptionalDiverted x
@Down @Yield @DownRightOptionalDiverted x
}
}
#######################################################################
# #
# @Diverted #
# #
#######################################################################
def @DownRightDiverted right x
{
@UDLine {
OX:: @LabelMarks {
|syntaxgap AX:: @LabelMarks @GoRight x |syntaxbias
^/syntaxgap
/syntaxgap
}
/ @VHCurve from { "OX@NW" } to { "OX@IN@AX@WMK" }
bias { pssyntaxbias } radius { pssyntaxradius }
/ @RVLCurve from { "OX@IN@AX@EMK" }
to { xcoord "OX@IN@AX@WMK" ycoord "OX@EMK" }
bias { pssyntaxbias } radius { pssyntaxradius }
/ @HVCurve from { xcoord "OX@IN@AX@WMK" ycoord "OX@EMK" }
to { "OX@SW" } bias { pssyntaxbias } radius {pssyntaxradius}
}
}
def @UpRightDiverted right x
{
@UDLine {
OX:: @LabelMarks {
^/syntaxgap
/syntaxgap
|syntaxgap AX:: @LabelMarks @GoRight x |syntaxbias
}
/ @VHCurve from { "OX@SW" } to { "OX@IN@AX@WMK" }
bias { pssyntaxbias } radius { pssyntaxradius }
/ @RVLCurve from { "OX@IN@AX@EMK" }
to { xcoord "OX@IN@AX@WMK" ycoord "OX@EMK" }
bias { pssyntaxbias } radius { pssyntaxradius }
/ @HVCurve from { xcoord "OX@IN@AX@WMK" ycoord "OX@EMK" }
to { "OX@NW" } bias { pssyntaxbias } radius {pssyntaxradius}
}
}
def @RightDownDiverted right x
{
@LRLine {
OX:: @LabelMarks {
{ /syntaxgap AX:: @LabelMarks @GoDown x /syntaxbias }
^|syntaxgap
|syntaxgap
}
/ @HVCurve from { "OX@NW" } to { "OX@IN@AX@NMK" }
bias { pssyntaxbias } radius { pssyntaxradius }
/ @VHCurve from { "OX@IN@AX@SMK" }
to { xcoord "OX@IN@AX@EMK" ycoord "OX@SMK" }
bias { pssyntaxbias } radius { pssyntaxradius }
/ @HVCurve from { xcoord "OX@IN@AX@EMK" ycoord "OX@SMK" }
to { "OX@IN@AX@EMK" ++ { pssyntaxgap 0 } }
bias { pssyntaxbias } radius {pssyntaxradius}
/ @VHCurve from { "OX@IN@AX@EMK" ++ { pssyntaxgap 0 } }
to { "OX@NE" } bias { pssyntaxbias } radius {pssyntaxradius}
}
}
def @LeftDownDiverted right x
{
@LRLine {
OX:: @LabelMarks {
|syntaxgap
^|syntaxgap
{ /syntaxgap AX:: @LabelMarks @GoDown x /syntaxbias }
}
/ @HVCurve from { "OX@NE" } to { "OX@IN@AX@NMK" }
bias { pssyntaxbias } radius { pssyntaxradius }
/ @VHCurve from { "OX@IN@AX@SMK" }
to { xcoord "OX@IN@AX@WMK" ycoord "OX@SMK" }
bias { pssyntaxbias } radius { pssyntaxradius }
/ @HVCurve from { xcoord "OX@IN@AX@WMK" ycoord "OX@SMK" }
to { "OX@IN@AX@WMK" -- { pssyntaxgap 0 } }
bias { pssyntaxbias } radius {pssyntaxradius}
/ @VHCurve from { "OX@IN@AX@WMK" -- { pssyntaxgap 0 } }
to { "OX@NW" } bias { pssyntaxbias } radius {pssyntaxradius}
}
}
def @Diverted right x
{
@CurrDirection @Case {
@Right @Yield @RightDownDiverted x
@Up @Yield @UpRightDiverted x
@Left @Yield @LeftDownDiverted x
@Down @Yield @DownRightDiverted x
}
}
#######################################################################
# #
# @RepeatDiverted #
# #
#######################################################################
def @RepeatDiverted right x
{
# this implementation exploits the coincidental similarity
# of @RepeatDiverted to @OptionalDiverted
@CurrDirection @Case {
@Right @Yield @LeftDownOptionalDiverted x
@Up @Yield @DownRightOptionalDiverted x
@Left @Yield @RightDownOptionalDiverted x
@Down @Yield @UpRightOptionalDiverted x
}
}
#######################################################################
# #
# @Loop and @Repeat #
# #
#######################################################################
def @Loop
named A {}
named B {}
{
def @LeftOrRightLoop
named al { no }
named ar { no }
{
@LRLine {
@HContract @VContract { OX:: @LabelMarks {
{ |syntaxgap AX:: @LabelMarks A |syntaxgap }
//syntaxgap
{ |0.5rt BX:: @LabelMarks @GoReverse B |syntaxgap }
} }
/ @Line from { "OX@WMK" } to { "OX@IN@AX@WMK" }
/ @Line from { "OX@EMK" } to { "OX@IN@AX@EMK" }
/ @HVCurve from { "OX@IN@BX@EMK" } to { "OX@EMK" }
arrow { ar } bias {pssyntaxbias} radius {pssyntaxradius}
/ @HVCurve from { "OX@IN@BX@WMK" } to { "OX@WMK" }
arrow { al } bias {pssyntaxbias} radius {pssyntaxradius}
}
}
def @UpOrDownLoop
named au { no }
named ad { no }
{
@UDLine {
@HContract @VContract { OX:: @LabelMarks {
{ /syntaxgap AX:: @LabelMarks A /syntaxgap }
||syntaxgap
{ /0.5rt BX:: @LabelMarks @GoReverse B /syntaxgap }
} }
/ @Line from { "OX@NMK" } to { "OX@IN@AX@NMK" }
/ @Line from { "OX@SMK" } to { "OX@IN@AX@SMK" }
/ @VHCurve from { "OX@IN@BX@NMK" } to { "OX@NMK" }
arrow { au } bias {pssyntaxbias} radius {pssyntaxradius}
/ @VHCurve from { "OX@IN@BX@SMK" } to { "OX@SMK" }
arrow { ad } bias {pssyntaxbias} radius {pssyntaxradius}
}
}
@CurrDirection @Case {
@Right @Yield @LeftOrRightLoop al { yes }
@Up @Yield @UpOrDownLoop ad { yes }
@Left @Yield @LeftOrRightLoop ar { yes }
@Down @Yield @UpOrDownLoop au { yes }
}
}
def @Repeat right x
{
@Loop
A { x }
B { @Skip }
}
#######################################################################
# #
# @LoopOpposite and @RepeatOpposite #
# #
#######################################################################
def @LoopOpposite
named A {}
named B {}
{
def @LeftOrRightLoopOpposite
named al { no }
named ar { no }
{
@LRLine {
@HContract @VContract { OX:: @LabelMarks {
{ |0.5rt BX:: @LabelMarks @GoReverse B |syntaxgap }
//syntaxgap
^//syntaxgap
{ |syntaxgap AX:: @LabelMarks A |syntaxgap }
} }
/ @Line from { "OX@WMK" } to { "OX@IN@AX@WMK" }
/ @Line from { "OX@EMK" } to { "OX@IN@AX@EMK" }
/ @HVCurve from { "OX@IN@BX@EMK" } to { "OX@EMK" }
arrow { ar } bias {pssyntaxbias} radius {pssyntaxradius}
/ @HVCurve from { "OX@IN@BX@WMK" } to { "OX@WMK" }
arrow { al } bias {pssyntaxbias} radius {pssyntaxradius}
}
}
def @UpOrDownLoopOpposite
named au { no }
named ad { no }
{
@UDLine {
@HContract @VContract { OX:: @LabelMarks {
{ /0.5rt BX:: @LabelMarks @GoReverse B /syntaxgap }
^||syntaxgap
{ /syntaxgap AX:: @LabelMarks A /syntaxgap }
} }
/ @Line from { "OX@NMK" } to { "OX@IN@AX@NMK" }
/ @Line from { "OX@SMK" } to { "OX@IN@AX@SMK" }
/ @VHCurve from { "OX@IN@BX@NMK" } to { "OX@NMK" }
arrow { au } bias {pssyntaxbias} radius {pssyntaxradius}
/ @VHCurve from { "OX@IN@BX@SMK" } to { "OX@SMK" }
arrow { ad } bias {pssyntaxbias} radius {pssyntaxradius}
}
}
@CurrDirection @Case {
@Right @Yield @LeftOrRightLoopOpposite al { yes }
@Up @Yield @UpOrDownLoopOpposite ad { yes }
@Left @Yield @LeftOrRightLoopOpposite ar { yes }
@Down @Yield @UpOrDownLoopOpposite au { yes }
}
}
def @RepeatOpposite right x
{
@LoopOpposite
A { x }
B { @Skip }
}
#######################################################################
# #
# Value of whole diagram #
# #
#######################################################################
def @DiagValue right x
{
@BackEnd @Case {
PostScript @Yield {
{
save @Case {
{ yes Yes } @Yield "grestore save gsave"
else @Yield {}
}
maxlabels "ldiagbegin"
//
"ldiagend"
save @Case {
{ yes Yes } @Yield "restore"
else @Yield {}
}
} @Graphic x }
PDF @Yield {}
}
}
title @Case {
"--titledft--" @Yield @DiagValue @Body
else @Yield { title titleformat @DiagValue @Body }
}
@End @Diag
macro @SyntaxDiag {
@Diag
avalign { mark }
avstrut { yes }
amargin { 0.2f }
aoutline { box }
afont { Slope }
bvalign { mark }
bvstrut { yes }
bmargin { 0.2f }
boutline { curvebox }
bfont { Bold }
cvalign { mark }
cvstrut { yes }
cmargin { 0.2f }
coutline { circle }
chsize { 1f }
arrowlength { 0.4f }
backarrowlength { 0.4f }
}
}
|