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