diff options
Diffstat (limited to 'include')
| -rw-r--r-- | include/bookf | 14 | ||||
| -rw-r--r-- | include/bsf | 21 | ||||
| -rw-r--r-- | include/bsf.bk | 1618 | ||||
| -rw-r--r-- | include/dsf | 130 | ||||
| -rw-r--r-- | include/old.diag.lpg | 2899 |
5 files changed, 1760 insertions, 2922 deletions
diff --git a/include/bookf b/include/bookf index 1bd6136..dac4bdd 100644 --- a/include/bookf +++ b/include/bookf @@ -1040,7 +1040,12 @@ def @BookSetup } @PartNumber @Case { - "" @Yield @Null + "" @Yield { + @PartTitle @Case { + "" @Yield @Null + else @Yield @Part + } + } else @Yield @Part } // @@ -1239,7 +1244,12 @@ def @BookSetup } @PartNumber @Case { - "" @Yield @Null + "" @Yield { + @PartTitle @Case { + "" @Yield @Null + else @Yield @Part + } + } else @Yield @Part } // diff --git a/include/bsf b/include/bsf index 8158c22..d27b52a 100644 --- a/include/bsf +++ b/include/bsf @@ -133,8 +133,8 @@ export @CopyRight @TradeMark @Euro @Date @Time @DateTimeFormat @DropCapTwo @DropCapThree @Centre @Right - @NoDotSep @NoDotJoin @Join @Sep @DotSep @DotJoin @DashJoin @NumSep - @OverStrike @Sup @Sub @FullWidthRule @LocalWidthRule + @NoDotSep @NoDotJoin @Join @Sep @DotSep @ColonSep @DotJoin @DashJoin + @NumSep @OverStrike @Sup @Sub @FullWidthRule @LocalWidthRule @Box @CurveBox @ShadowBox @BoundaryMarks @NumberMarker @NumberOf @TitleMarker @TitleOf @PageMarker @PageMark @NoLinkPageMark @PageOf @CrossLink @ExternalLink @@ -588,7 +588,7 @@ def @BasicSetup ########################################################################### # # # @Centre, @Center, @Right, @NoDotSep, @NoDotJoin, @DotSep, # - # @DotJoin, @DashJoin, @NumSep # + # @ColonSep, @DotJoin, @DashJoin, @NumSep # # # ########################################################################### @@ -639,6 +639,19 @@ def @BasicSetup } } + def @ColonSep left x right y + { + x @Case { + {} @Yield y + else @Yield { + y @Case { + {} @Yield x + else @Yield { x: |2s y } + } + } + } + } + def @DotJoin left x right y { x @Case { @@ -1518,7 +1531,7 @@ def @BasicSetup { def sendtag into { @TagPlace&&preceding } { tag } - sendtag // //1vx x + sendtag // //1vxu x } def endlist force into { @EndListPlace&&preceding } {} diff --git a/include/bsf.bk b/include/bsf.bk new file mode 100644 index 0000000..90b8143 --- /dev/null +++ b/include/bsf.bk @@ -0,0 +1,1618 @@ + +############################################################################### +# # +# Lout @BasicSetup package (Version 3.13) # +# # +# Jeffrey H. Kingston # +# 5 February 1999 # +# # +# Based on the first part of the @DocumentLayout package, version 3.11. # +# # +# This package contains basic symbols used widely throughout many # +# documents, for font changes, particular characters, standard words in # +# the current language, date and time, paragraphs, lists, colours, # +# rules, and boxes. # +# # +############################################################################### + +@SysPrependGraphic { "bsf.lpg" } # rules, boxes, margin note setup + + +############################################################################### +# # +# The following symbols are defined outside @BasicSetup so that # +# they can be invoked when setting its parameters in the @Use clause. # +# # +############################################################################### + +def @OrIfPlain + precedence 80 + left x + right y +{ + @BackEnd @Case { + PlainText @Yield y + else @Yield x + } +} + +########################################################################### +# # +# @ColourCommand, @Colour, @Color # +# # +########################################################################### + +@SysInclude { ccommand } + + def @Colour @Color left col right y { {@ColourCommand col} @SetColour y } + + export i c p m s v f + def @LengthUnits + { + def i left x { + @BackEnd @Case { + PostScript @Yield { x" in" } + PDF @Yield { "__mul(__in, "x")" } + PlainText @Yield "" + } + } + + def c left x { + @BackEnd @Case { + PostScript @Yield { x" cm" } + PDF @Yield { "__mul(__cm, "x")" } + PlainText @Yield "" + } + } + + def p left x { + @BackEnd @Case { + PostScript @Yield { x" pt" } + PDF @Yield { "__mul(__pt, "x")" } + PlainText @Yield "" + } + } + + def m left x { + @BackEnd @Case { + PostScript @Yield { x" em" } + PDF @Yield { "__mul(__em, "x")" } + PlainText @Yield "" + } + } + + def s left x { + @BackEnd @Case { + PostScript @Yield { x" sp" } + PDF @Yield { "__mul(__louts, "x")" } + PlainText @Yield "" + } + } + + def v left x { + @BackEnd @Case { + PostScript @Yield { x" vs" } + PDF @Yield { "__mul(__loutv, "x")" } + PlainText @Yield "" + } + } + + def f left x { + @BackEnd @Case { + PostScript @Yield { x" ft" } + PDF @Yield { "__mul(__loutf, "x")" } + PlainText @Yield "" + } + } + } + + +############################################################################### +# # +# Symbols exported by @BasicSetup. # +# # +############################################################################### + +export + + @InitialFont @InitialBreak @InitialOutdent @InitialSpace @InitialLanguage + @InitialColour @OptimizePages @HeadingFont + @ParaGap @ParaIndent @DisplayGap @DisplayIndent @DefaultIndent + @DisplayNumStyle @WideIndent @VeryWideIndent + @ListGap @ListIndent @ListRightIndent @ListLabelWidth + @NumberSeparator + + @Word @Roman @UCRoman @Alpha @UCAlpha @Months @ShortMonths @WeekDays + @ShortWeekDays @TwelveHours @ShortHours @MeriDiems @ShortMeriDiems + + @Sym @R @I @B @BI @S @F @II + "~" "~~" "``" "''" ",," "--" "---" "..." + + @Bullet @ParSym @SectSym @Dagger @DaggerDbl @CDot @Sterling @Yen @Florin + @Star @Degree @Minute @Second @Multiply @Divide @Lozenge @Register + @CopyRight @TradeMark @Euro + + @Date @Time @DateTimeFormat @DropCapTwo @DropCapThree @Centre @Right + @NoDotSep @NoDotJoin @Join @Sep @DotSep @ColonSep @DotJoin @DashJoin + @NumSep @OverStrike @Sup @Sub @FullWidthRule @LocalWidthRule + @Box @CurveBox @ShadowBox @BoundaryMarks + @NumberMarker @NumberOf @TitleMarker @TitleOf + @PageMarker @PageMark @NoLinkPageMark @PageOf @CrossLink @ExternalLink + + @BeginDisplayCounter + + @Heading "^" "&-" @If @Not @And @Or @True + @PP @LP @LLP @DP @LOP @NP @CNP + + @BeginAlignedDisplays + @EndAlignedDisplays + + @Display + @LeftDisplay + @IndentedDisplay + @QuotedDisplay + @CentredDisplay + @RightDisplay + @AlignedDisplay + @LeftAlignedDisplay + @IndentedAlignedDisplay + @QuotedAlignedDisplay + @CentredAlignedDisplay + @RightAlignedDisplay + @NumberedDisplay + @LeftNumberedDisplay + @IndentedNumberedDisplay + @QuotedNumberedDisplay + @CentredNumberedDisplay + @RightNumberedDisplay + @AlignedNumberedDisplay + @LeftAlignedNumberedDisplay + @IndentedAlignedNumberedDisplay + @QuotedAlignedNumberedDisplay + @CentredAlignedNumberedDisplay + @RightAlignedNumberedDisplay + + @RawDisplay + @RawLeftDisplay + @RawIndentedDisplay + @RawQuotedDisplay + @RawCentredDisplay + @RawRightDisplay + @RawAlignedDisplay + @RawLeftAlignedDisplay + @RawIndentedAlignedDisplay + @RawQuotedAlignedDisplay + @RawCentredAlignedDisplay + @RawRightAlignedDisplay + @RawNumberedDisplay + @RawLeftNumberedDisplay + @RawIndentedNumberedDisplay + @RawQuotedNumberedDisplay + @RawCentredNumberedDisplay + @RawRightNumberedDisplay + @RawAlignedNumberedDisplay + @RawLeftAlignedNumberedDisplay + @RawIndentedAlignedNumberedDisplay + @RawQuotedAlignedNumberedDisplay + @RawCentredAlignedNumberedDisplay + @RawRightAlignedNumberedDisplay + + @ListItem + @ListInterruptItem + @ListNewPage + @DropListItem + @TagItem + @DropTagItem + + @EndList + @RawEndList + + @RawList + @RawLeftList + @RawIndentedList + @RawQuotedList + @RawCentredList @RawCenteredList + @RawNumberedList + @RawParenNumberedList + @RawRomanList + @RawParenRomanList + @RawUCRomanList + @RawParenUCRomanList + @RawAlphaList + @RawParenAlphaList + @RawUCAlphaList + @RawParenUCAlphaList + @RawBulletList + @RawStarList + @RawDashList + @RawTaggedList + @RawWideTaggedList + @RawVeryWideTaggedList + + @List + @LeftList + @IndentedList + @QuotedList + @CentredList @CenteredList + @NumberedList + @ParenNumberedList + @RomanList + @ParenRomanList + @UCRomanList + @ParenUCRomanList + @AlphaList + @ParenAlphaList + @UCAlphaList + @ParenUCAlphaList + @BulletList + @StarList + @DashList + @TaggedList + @WideTaggedList + @VeryWideTaggedList + + +############################################################################### +# # +# The @BasicSetup package. # +# # +############################################################################### + +def @BasicSetup + named @InitialFont { Times Base 12p } # initial font + named @InitialBreak { {adjust 1.20fx hyphen} @OrIfPlain + {ragged 1fx nohyphen} } # initial break + named @InitialOutdent { 2f @OrIfPlain 4s } # initial outdent + named @InitialSpace { lout } # initial space style + named @InitialLanguage{ English } # initial language + named @InitialColour { black } # initial colour + named @OptimizePages { No } # optimize page breaks? + named @HeadingFont { Bold } # font for @Heading + named @FixedWidthFont { Courier Base -1p } # font for @F + named @ParaGap { 1.3vx @OrIfPlain 1f } # gap between paragraphs + named @ParaIndent { 2.0f @OrIfPlain 5s } # first-line indent for @PP + named @DisplayGap { 1.0v @OrIfPlain 1f } # gap above, below displays + named @DisplayIndent { 2.0f @OrIfPlain 5s } # @IndentedDisplay indent + named @DefaultIndent { 0.5rt } # @Display indent + named @DisplayNumStyle + right num { (num) } # display number style + named @WideIndent { 4.0f @OrIfPlain 10s } # @WideTaggedList indent + named @VeryWideIndent { 8.0f @OrIfPlain 20s } # @VeryWideTaggedList indent + named @ListOuterGap { 1.0v @OrIfPlain 1f } # gap before, after list + named @ListGap { 1.0v @OrIfPlain 1f } # gap between list items + named @ListIndent { 0s } # indent of list items + named @ListRightIndent{ 0s } # right indent of list items + named @ListLabelWidth { 2.0f @OrIfPlain 5s } # width allowed for list tags + named @NumberSeparator{ . } # separates numbers like 2.3.7 + import @BasicSetup + named @CrossLinkFormat + right @Body { @Body } # format for cross links + import @BasicSetup + named @ExternalLinkFormat + right @Body { @Body } # format for external links +@Begin + + ########################################################################### + # # + # @Sym, font symbols, and miscellaneous special characters. # + # # + ########################################################################### + + def @Sym right x { { Symbol Base } @Font @Char x } + + def @R right x { Base @Font x } + def @I right x { Slope @Font x } + def @B right x { Bold @Font x } + def @BI right x { BoldSlope @Font x } + def @S right x { smallcaps @Font x } + def @F right x { @FixedWidthFont @Font x } + + def @II + right x + { + { @CurrFace @Case { + Bold @Yield BoldSlope + else @Yield Slope + } } @Font x + } + + def "~" left x right y { x &1su y } + def "~~" left x right y { x &2s y } + + def "``" { @Char "quotedblleft" @OrIfPlain "``" } + def "''" { @Char "quotedblright" @OrIfPlain "''" } + def ",," { @Char "quotedblbase" @OrIfPlain ",," } + def "--" { @Char "endash" @OrIfPlain "--" } + def "---" { @Char "emdash" @OrIfPlain "---"} + def "..." { @Char "ellipsis" @OrIfPlain "..."} + def @Bullet { @Char "bullet" @OrIfPlain "o" } + def @ParSym { @Char "paragraph" @OrIfPlain "P" } + def @SectSym { @Char "section" @OrIfPlain "$" } + def @Dagger { @Char "dagger" @OrIfPlain "+" } + def @DaggerDbl { @Char "daggerdbl" @OrIfPlain "++" } + def @CDot { @Char "periodcentered" @OrIfPlain "." } + def @Sterling { @Char "sterling" @OrIfPlain "&" } + def @Yen { @Char "yen" @OrIfPlain "Y" } + def @Florin { @Char "florin" @OrIfPlain "f" } + + def @Star { @Sym "asteriskmath" @OrIfPlain "*" } + def @Degree { @Sym "degree" @OrIfPlain "o" } + def @Minute { @Sym "minute" @OrIfPlain "'" } + def @Second { @Sym "second" @OrIfPlain "''" } + def @Multiply { @Sym "multiply" @OrIfPlain "x" } + def @Divide { @Sym "divide" @OrIfPlain "/" } + def @Lozenge { @Sym "lozenge" @OrIfPlain "O" } + def @Register { @Sym "registersans" @OrIfPlain "R" } + def @CopyRight { @Sym "copyrightsans" @OrIfPlain "C" } + def @TradeMark { @Sym "trademarksans" @OrIfPlain "TM" } + + def @Euro + { + @BackEnd @Case { + + PostScript @Yield { + 0.65w @VShift @VContract @HContract + "xsize ysize ysize 0.07 mul louteuro" @Graphic { + 0.7f @High 0.735f @Wide + } + } + + PDF @Yield { EUR } + + PlainText @Yield { EUR } + } + } + + + ########################################################################### + # # + # Symbols stored in the "standard" database # + # # + # @Word language-spacific words such as Chapter, etc. # + # @Roman lower case Roman numerals i, ii, ... , cc # + # @UCRoman upper case Roman numerals I, II, ... , CC # + # @Alpha lower case Roman alphabet a, b, ... , z # + # @UCAlpha upper case Roman alphabet A, B, ... , Z # + # @Months months of the year: January, ... , December # + # @ShortMonths months of the year, abbreviated: Jan, ..., Dec # + # @WeekDays days of the week: Sunday, ... , Saturday # + # @ShortWeekDays days of the week, abbreviated: Sun, ... , Sat # + # @TwelveHours hours, from 1 to 12 # + # @ShortHours hours, from 0 to 23 # + # @DateTimeFormat format of results of @Date and @Time # + # # + ########################################################################### + + def @Word left @Tag right @Val { @Val } + def @Roman left @Tag right @Val { @Val } + def @UCRoman left @Tag right @Val { @Val } + def @Alpha left @Tag right @Val { @Val } + def @UCAlpha left @Tag right @Val { @Val } + def @Months left @Tag right @Val { @Val } + def @ShortMonths left @Tag right @Val { @Val } + def @WeekDays left @Tag right @Val { @Val } + def @ShortWeekDays left @Tag right @Val { @Val } + def @TwelveHours left @Tag right @Val { @Val } + def @ShortHours left @Tag right @Val { @Val } + def @MeriDiems left @Tag right @Val { @Val } + def @ShortMeriDiems left @Tag right @Val { @Val } + + export @Value + def @DateTimeFormat left @Tag + named @Value + named @Year {} + named @ShortYear {} + named @Month {} + named @ShortMonth {} + named @MonthNum {} + named @Day {} + named @ShortDay {} + named @DayNum {} + named @MeriDiem {} + named @ShortMeriDiem {} + named @Hour {} + named @TwelveHour {} + named @ShortHour {} + named @Minute {} + named @Second {} + {} + {} + + @SysDatabase @Word @Roman @UCRoman @Alpha @UCAlpha @Months + @ShortMonths @WeekDays @ShortWeekDays @TwelveHours + @ShortHours @MeriDiems @ShortMeriDiems @DateTimeFormat + { standard } + + + ########################################################################### + # # + # @Date and @Time: the date and time now. # + # # + ########################################################################### + + def @Date + named @Format + named @Year { @Moment&&now @Open { {@Century}@Year }} + named @ShortYear { @Moment&&now @Open { @Year }} + named @Month { @Moment&&now @Open { @Months&&@Month }} + named @ShortMonth { @Moment&&now @Open { @ShortMonths&&@Month }} + named @MonthNum { @Moment&&now @Open { @Month }} + named @Day { @Moment&&now @Open { @WeekDays&&@WeekDay }} + named @ShortDay { @Moment&&now @Open { @ShortWeekDays&&@WeekDay}} + named @DayNum { @Moment&&now @Open { @Day }} + named @MeriDiem { @Moment&&now @Open { @MeriDiems&&@Hour }} + named @ShortMeriDiem{ @Moment&&now @Open { @ShortMeriDiems&&@Hour }} + named @Hour { @Moment&&now @Open { @Hour }} + named @TwelveHour { @Moment&&now @Open { @TwelveHours&&@Hour }} + named @ShortHour { @Moment&&now @Open { @ShortHours&&@Hour }} + named @Minute { @Moment&&now @Open { @Minute }} + named @Second { @Moment&&now @Open { @Second }} + { + @DateTimeFormat&&date @Open { @Value + @Year { @Year } + @ShortYear { @ShortYear } + @Month { @Month } + @ShortMonth { @ShortMonth } + @MonthNum { @MonthNum } + @Day { @Day } + @ShortDay { @ShortDay } + @DayNum { @DayNum } + @MeriDiem { @MeriDiem } + @ShortMeriDiem { @ShortMeriDiem } + @Hour { @Hour } + @TwelveHour { @TwelveHour } + @ShortHour { @ShortHour } + @Minute { @Minute } + @Second { @Second } + } + } + { @Format } + + def @Time + named @Format + named @Year { @Moment&&now @Open { {@Century}@Year }} + named @ShortYear { @Moment&&now @Open { @Year }} + named @Month { @Moment&&now @Open { @Months&&@Month }} + named @ShortMonth { @Moment&&now @Open { @ShortMonths&&@Month }} + named @MonthNum { @Moment&&now @Open { @Month }} + named @Day { @Moment&&now @Open { @WeekDays&&@WeekDay }} + named @ShortDay { @Moment&&now @Open { @ShortWeekDays&&@WeekDay}} + named @DayNum { @Moment&&now @Open { @Day }} + named @MeriDiem { @Moment&&now @Open { @MeriDiems&&@Hour }} + named @ShortMeriDiem{ @Moment&&now @Open { @ShortMeriDiems&&@Hour }} + named @Hour { @Moment&&now @Open { @Hour }} + named @TwelveHour { @Moment&&now @Open { @TwelveHours&&@Hour }} + named @ShortHour { @Moment&&now @Open { @ShortHours&&@Hour }} + named @Minute { @Moment&&now @Open { @Minute }} + named @Second { @Moment&&now @Open { @Second }} + { + @DateTimeFormat&&time @Open { @Value + @Year { @Year } + @ShortYear { @ShortYear } + @Month { @Month } + @ShortMonth { @ShortMonth } + @MonthNum { @MonthNum } + @Day { @Day } + @ShortDay { @ShortDay } + @DayNum { @DayNum } + @MeriDiem { @MeriDiem } + @ShortMeriDiem { @ShortMeriDiem } + @Hour { @Hour } + @TwelveHour { @TwelveHour } + @ShortHour { @ShortHour } + @Minute { @Minute } + @Second { @Second } + } + } + { @Format } + + + ########################################################################### + # # + # @DropCapTwo and @DropCapThree # + # # + ########################################################################### + + def @DropCapTwo + left y + named height { 1.5v } + right x + { + def @ParPlace { @Galley } + def @EndParPlace { @Galley } + + def @LineList + { + @PAdjust @ParPlace + //1vx @LineList + } + + def @ParGalley horizontally into { @ParPlace&&preceding } + right x + { + x + } + + def @EndPar force into { @EndParPlace&&following } { @Null } + + def @Cap + { + -0.25f @VShift 1.0w @VShift { + -90d @Rotate height @Wide @Scale 90d @Rotate y + } + } + + |1s @PAdjust @ParPlace + /1vo @Cap @ParGalley {x & @EndPar &1rt } | @PAdjust @ParPlace + //1vx @LineList + // @EndParPlace + } + + def @DropCapThree + left y + named height { 2.5v } + right x + { + def @ParPlace { @Galley } + def @EndParPlace { @Galley } + + def @LineList + { + @PAdjust @ParPlace + //1vx @LineList + } + + def @ParGalley force horizontally into { @ParPlace&&preceding } + right x + { + x + } + + def @EndPar force into { @EndParPlace&&following } { @Null } + + def @Cap + { + -0.25f @VShift 1.0w @VShift { + -90d @Rotate height @Wide @Scale 90d @Rotate y + } + } + + |1s @PAdjust @ParPlace + /1vo @ParGalley { x & @EndPar &1rt } | @PAdjust @ParPlace + /1vo @Cap | @PAdjust @ParPlace + //1vx @LineList + // @EndParPlace + } + + + ########################################################################### + # # + # @Centre, @Center, @Right, @NoDotSep, @NoDotJoin, @DotSep, # + # @ColonSep, @DotJoin, @DashJoin, @NumSep # + # # + ########################################################################### + + macro @Centre @Center { |0.5rt @HContract } + + def @Right + precedence 50 + left x + right y + { x |1.0rt @OneCol { 2f @Wide {} | y } } + + def @NoDotSep left x right y + { + x @Case { + {} @Yield y + else @Yield { + y @Case { + {} @Yield x + else @Yield { x |2s y } + } + } + } + } + + def @NoDotJoin left x right y + { + x @Case { + {} @Yield y + else @Yield { + y @Case { + {} @Yield x + else @Yield { x{y} } + } + } + } + } + + def @DotSep left x right y + { + x @Case { + {} @Yield y + else @Yield { + y @Case { + {} @Yield x + else @Yield { x. |2s y } + } + } + } + } + + def @ColonSep left x right y + { + x @Case { + {} @Yield y + else @Yield { + y @Case { + {} @Yield x + else @Yield { x: |2s y } + } + } + } + } + + def @DotJoin left x right y + { + x @Case { + {} @Yield y + else @Yield { + y @Case { + {} @Yield x + else @Yield { x.y } + } + } + } + } + + def @DashJoin left x right y + { + x @Case { + {} @Yield y + else @Yield { + y @Case { + {} @Yield x + else @Yield { x--y } + } + } + } + } + + def @NumSep left x right y + { + x @Case { + {} @Yield y + else @Yield { + y @Case { + {} @Yield x + else @Yield { + @CurrLang @Case { + Hungarian @Yield { y. x } + else @Yield { x y } + } + } + } + } + } + } + + + ########################################################################### + # # + # @OverStrike, @Sup and @Sub # + # # + ########################################################################### + + def @OverStrike left x right y + { + @OneRow { @HContract @VContract x /0io @HContract @VContract y } + } + + def @Sup + left x + named gap { 0.40fk } + right y + { + @HContract @VContract + { + | 0.7f @Font y ^/gap x + } + } + + def @Sub + left x + named gap { 0.40fk } + right y + { + @HContract @VContract + { + x /gap | 0.7f @Font y + } + } + + + ########################################################################### + # # + # @AddPaint, @LineWidth (obsolete), @StrokeCommand # + # # + ########################################################################### + + def @AddPaint right col + { + col @Case { + none @Yield "" + nochange @Yield { + @BackEnd @Case { + PostScript @Yield "gsave fill grestore" + PDF @Yield "q f Q" + PlainText @Yield "" + } + } + else @Yield { + @BackEnd @Case { + PostScript @Yield {"gsave" @ColourCommand col "fill grestore"} + PDF @Yield { "q" @ColourCommand col "f Q" } + PlainText @Yield "" + } + } + } + } + + def @LineWidth right lw + { + lw @Case { + "" @Yield "" + else @Yield { + @BackEnd @Case { + PostScript @Yield { lw "setlinewidth" } + PDF @Yield { lw "w" } + PlainText @Yield "" + } + } + } + } + + def @StrokeCommand right linewidth + { + @BackEnd @Case { + PostScript @Yield { + linewidth @Case { + "" @Yield { "stroke" } + none @Yield { } + else @Yield { linewidth "setlinewidth stroke" } + } + } + PDF @Yield { + linewidth @Case { + "" @Yield { "S" } + none @Yield { } + else @Yield { linewidth "w S" } + } + } + else @Yield "" + } + } + + + + ########################################################################### + # # + # @FullWidthRule, @Box, @CurveBox, and @ShadowBox # + # # + ########################################################################### + + def @FullWidthRule + import @LengthUnits named linewidth {} + { + @BackEnd @Case { + + PostScript @Yield @HExpand { + { "LoutRule" @StrokeCommand linewidth } @Graphic { 0.5p @High } + } + + PDF @Yield @HExpand { + { "0 0 m __xsize 0 l" @StrokeCommand linewidth } @Graphic { 0.5p @High } + } + + PlainText @Yield { "-" @PlainGraphic 1f @High } + } + } + + def @LocalWidthRule + import @LengthUnits named linewidth {} + { + @BackEnd @Case { + + PostScript @Yield { + { "LoutRule" @StrokeCommand linewidth } @Graphic { 0.5p @High } + } + + PDF @Yield { + { "0 0 m __xsize 0 l" @StrokeCommand linewidth } @Graphic { 0.5p @High } + } + + PlainText @Yield { "-" @PlainGraphic 1f @High } + } + } + + def @Box + named margin { 0.3f } + import @LengthUnits named linewidth {} + named paint { none } + right x + { + @BackEnd @Case { + + PostScript @Yield @VContract @HContract 0c @HShift { + {"LoutBox" @AddPaint paint @StrokeCommand linewidth } + @Graphic + { ^/margin ^|margin 0c @HShift @OneRow x |margin /margin } + } + + PDF @Yield @VContract @HContract 0c @HShift { + { "0 0 m __xsize 0 l __xsize __ysize l 0 __ysize l h" + @AddPaint paint @StrokeCommand linewidth } @Graphic + { ^/margin ^|margin 0c @HShift @OneRow x |margin /margin } + } + + PlainText @Yield @VContract @HContract 0c @HShift { + ^/margin ^|margin 0c @HShift @OneRow x |margin /margin + } + } + } + + def @CurveBox + named margin { 0.3f } + import @LengthUnits named linewidth {} + named paint { none } + right x + { + def @PDFStuff + { + "__xmark 0 m" + "__sub(__xsize, __xmark) 0 l" + "__sub(__xsize, __div(__mul(11, __xmark), 24)) 0" + "__xsize __div(__mul(11, __xmark), 24)" + "__xsize __xmark c" + "__xsize __sub(__ysize, __xmark) l" + "__xsize __sub(__ysize, __div(__mul(11, __xmark), 24))" + "__sub(__xsize, __div(__mul(11, __xmark), 24)) __ysize" + "__sub(__xsize, __xmark) __ysize c" + "__xmark __ysize l" + "__div(__mul(11, __xmark), 24) __ysize" + "0 __sub(__ysize, __div(__mul(11, __xmark), 24))" + "0 __sub(__ysize, __xmark) c" + "0 __xmark l" + "0 __div(__mul(11, __xmark), 24)" + "__div(__mul(11, __xmark), 24) 0" + "__xmark 0 c" + "h" + @AddPaint paint @StrokeCommand linewidth + } + + @VContract @HContract 0c @HShift @BackEnd @Case { + + PostScript @Yield { + {"LoutCurveBox" @AddPaint paint @StrokeCommand linewidth } + @Graphic + { ^/margin ^|margin 0c @HShift @OneRow x |margin /margin } + } + + PlainText @Yield { + ^/margin ^|margin 0c @HShift @OneRow x |margin /margin + } + + PDF @Yield { + @PDFStuff @Graphic + { ^/margin ^|margin 0c @HShift @OneRow x |margin /margin } + } + } + } + + def @ShadowBox + named margin { 0.3f } + import @LengthUnits named linewidth {} + named paint { none } + named shadow { 0.2f } + right x + { + @VContract @HContract 0c @HShift @BackEnd @Case { + + PostScript @Yield { + "LoutShadowBox fill" @Graphic + { ^/shadow ^|shadow 0c @HShift + @Box margin {margin} paint {paint} linewidth {linewidth} x + |shadow /shadow + } + } + + PlainText @Yield { + ^/shadow ^|shadow 0c @HShift + @Box margin {margin} paint {paint} linewidth {linewidth} x + |shadow /shadow + } + + PDF @Yield { + { + "__mul(__xmark, 2) 0 m __xsize 0 l" + "__xsize __sub(__ysize, __mul(__xmark, 2)) l" + "__sub(__xsize, __xmark) __sub(__ysize, __mul(__xmark, 2)) l" + "__sub(__xsize, __xmark) __xmark l" + "__mul(__xmark, 2) __xmark l h f" + } + @Graphic + { ^/shadow ^|shadow 0c @HShift + @Box margin {margin} paint {paint} linewidth {linewidth} x + |shadow /shadow + } + } + } + } + + + ########################################################################### + # # + # @BoundaryMarks # + # # + ########################################################################### + + def @BoundaryMarks + import @LengthUnits named linewidth { 0.2p } + import @LengthUnits named length { 0.5c } + import @LengthUnits named gap { 0.5c } + import @LengthUnits named lout { 0c } + import @LengthUnits named rout { 0c } + import @LengthUnits named uout { 0c } + import @LengthUnits named dout { 0c } + { + def @UpStroke { "0" gap "rmoveto" "0" length "rlineto" } + def @DownStroke { "0" gap "neg" "rmoveto" "0" length "neg rlineto" } + def @LeftStroke { gap "neg" "0" "rmoveto" length "neg" "0 rlineto" } + def @RightStroke { gap "0" "rmoveto" length "0 rlineto" } + + def @LLSpot { lout "neg" dout "neg" moveto } + def @LRSpot { xsize rout "add" dout "neg" moveto } + def @ULSpot { lout "neg" ysize uout "add" moveto } + def @URSpot { xsize rout "add" ysize uout "add" moveto } + + def @PDFStuff { + "__sub(-"gap", "lout") __sub(0, "dout") m " + "__sub(__sub(-"gap", "lout"), "length") __sub(0, "dout") l" + "__sub(0, "lout") __sub(-"gap", "dout") m " + "__sub(0, "lout") __sub(__sub(-"gap", "dout"), "length") l" + "__add(__xsize,"rout") __sub(-"gap", "dout") m " + "__add(__xsize,"rout") __sub(__sub(-"gap", "dout"), "length") l" + "__add(__add(__xsize,"rout"),"gap") __sub(0, "dout") m " + "__add(__add(__add(__xsize,"rout"),"gap"),"length") __sub(0, "dout") l" + " __sub(__sub(0, "lout"), "gap") __add(__ysize, "uout") m " + "__sub(__sub(__sub(0, "lout"), "gap"), "length") __add(__ysize, "uout") l" + "__sub(0, "lout") __add(__add(__ysize, "uout"), "gap") m " + "__sub(0, "lout") __add(__add(__add(__ysize, "uout"), "gap"), "length") l" + " __add(__add(__xsize, "rout"), "gap") __add(__ysize, "uout") m " + "__add(__add(__add(__xsize, "rout"), "gap"), "length") __add(__ysize, "uout") l" + "__add(__xsize, "rout") __add(__add(__ysize, "uout"), "gap") m " + "__add(__xsize, "rout") __add(__add(__add(__ysize, "uout"), "gap"), "length") l" + + linewidth "w S" + } + + @BackEnd @Case { + + PostScript @Yield { + { + @LLSpot @LeftStroke + @LLSpot @DownStroke + @LRSpot @DownStroke + @LRSpot @RightStroke + @ULSpot @LeftStroke + @ULSpot @UpStroke + @URSpot @RightStroke + @URSpot @UpStroke + + linewidth "setlinewidth stroke" + } @Graphic {} + } + + PlainText @Yield "" + + PDF @Yield { @PDFStuff @Graphic {} } + } + } + + ########################################################################## + # # + # @NumberMarker, @NumberOf, @TitleMarker, @TitleOf, # + # @PageMark, @PageOf, @CrossLink, @ExternalLink # + # # + # NB the default value ?? is desperately important for unsorted # + # reference lists numbered by first appearance (@NumberOf @Tag), # + # because it is the special sort key value that prevents merging, # + # hence allowing all the references to be printed even though # + # their sort keys are all ?? initially. # + # # + ########################################################################## + + export @Tag @Value + def @NumberMarker + named @Tag {} + named @Value { "??" } + { + @Null + } + + def @NumberOf + right tag + { + @NumberMarker&&tag @Open { @Value } + } + + + export @Tag @Value + def @TitleMarker + named @Tag {} + named @Value { "??" } + { + @Null + } + + def @TitleOf + right tag + { + @TitleMarker&&tag @Open { @Value } + } + + + export num rawnum @Tag + def @PageMarker + named @Tag {} + named num {} + named rawnum {} + { + @PageLabel num + } + + def @PageMark + right tag + { + @Null & tag @LinkDest & @PageMarker&&preceding @Tagged tag + } + + def @NoLinkPageMark + right tag + { + @PageMarker&&preceding @Tagged tag + } + + def @PageOf + right tag + { + @PageMarker&&tag @Open { num } + } + + def @CrossLink + left tag + named @Format right @Body { @CrossLinkFormat @Body } + right obj + { + @HContract @VContract { + tag @LinkSource @Format obj + } + } + + def @ExternalLink + left tag + named @Format right @Body { @ExternalLinkFormat @Body } + right obj + { + @HContract @VContract { + tag @URLLink @Format obj + } + } + + + ########################################################################### + # # + # @Join and @Sep # + # # + # Join two objects together with @NumberSeparator, unless one is # + # empty in which case just return the other. # + # # + ########################################################################### + + def @Join left x right y + { + x @Case { + {} @Yield y + else @Yield { + y @Case { + {} @Yield x + else @Yield { x{@NumberSeparator}y } + } + } + } + } + + def @Sep left x right y + { + x @Case { + {} @Yield y + else @Yield { + y @Case { + {} @Yield x + else @Yield { x{@NumberSeparator} |2s y } + } + } + } + } + + + ########################################################################### + # # + # Miscellaneous. # + # # + ########################################################################### + + def @Heading right x { ragged @Break @HeadingFont @Font x } + def "^" { {} ^& {} } + def "&-" left x right y { x &0ch y } + + + ########################################################################### + # # + # @If @Not @And @Or @True # + # # + # Used in databases to make optional fields format nicely. # + # # + ########################################################################### + + def @If + precedence 97 + left x + right y + { + y @Case { + {} @Yield @Null + else @Yield { @Null{x} } + } + } + + def @Not + precedence 100 + right y + { + y @Case { + {} @Yield "*" + else @Yield "" + } + } + + def @And + precedence 99 + left x + right y + { + x @Case { + {} @Yield {} + else @Yield y + } + } + + def @Or + precedence 98 + left x + right y + { + x @Case { + {} @Yield y + else @Yield x + } + } + + def @True { "*" } + + + ########################################################################### + # # + # Paragraphs. # + # # + ########################################################################### + + macro @PP { //@ParaGap @ParaIndent @Wide &{0i} } + macro @LP { //{@ParaGap} } + macro @LLP { //{1vx} } + macro @DP { //{@DisplayGap} } + macro @LOP { //{@ListOuterGap} } + macro @NP { //{1.1b} } + macro @CNP { // 3.2v @High //0io //{} } + + + ########################################################################### + # # + # Beginning and ending of aligned displays. # + # # + ########################################################################### + + def @APlace { @Galley } + def @EndAlignedPlace { @Galley } + def @AlignedPlace { @Galley } + + def @BAligned into { @APlace&&preceding } + { + def @AlignedList { @AlignedPlace /1.1b @AlignedList } + + //1.1b @AlignedList + // @EndAlignedPlace + } + + macro @BAD @BeginAlignedDisplays { // @APlace | @BAligned } + def @EAD @EndAlignedDisplays force into { @EndAlignedPlace&&preceding } {} + + + ########################################################################### + # # + # New code for numbered displays that will cross section boundaries # + # # + ########################################################################### + + export @Tag val + def @NumDispCounterMarker + named @Tag {} + named val {} + { + @Null + } + + def @NumDispNum right tag + { + @NumDispCounterMarker&&tag @Open { @Next val } + } + + def @NumDispCounterIncrement + right tag + { + @NumDispCounterMarker&&preceding @Tagged tag + @NumDispCounterMarker val { @NumDispNum tag } + @NumberMarker @Tag { tag } @Value { @NumDispNum tag } + } + + def @NN + { + @NumDispCounterMarker&&preceding @Open { @DisplayNumStyle val } + } + + def @Do + left x + right y + { + x @Case { + { No None } @Yield @Null + else @Yield y + } + } + + def @BeginDisplayCounter + left condition + right prefix + { + condition @Do @NumDispCounterMarker val { prefix @Join 0 } + } + + + ########################################################################### + # # + # Galleys that carry displays to their places. # + # # + ########################################################################### + + def @DispPlace { @Galley } + + def @Disp into { @DispPlace&&preceding } + right x + { + x + } + + def @NDisp into { @DispPlace&&preceding } + named @Tag {} + right x + { + @OneRow { + @NumDispCounterIncrement @Tag + @PageMark @Tag + ^// + @OneRow x + } + } + + def @ADisp into { @AlignedPlace&&preceding } + right x + { + x + } + + def @ANDisp into { @AlignedPlace&&preceding } + named @Tag {} + right x + { + @OneRow { + @NumDispCounterIncrement @Tag + @PageMark @Tag + ^/ + @OneRow x + } + } + + + ########################################################################### + # # + # Displays and raw displays. # + # # + ########################################################################### + + macro @G { |@DefaultIndent } + macro @LG { | } + macro @IG { |@DisplayIndent } + macro @CG { |0.5rt } + macro @RG { |1.0rt } + macro @QR { @DisplayIndent @Wide { |1rt @NN } } + macro @DX { @DispPlace } + macro @DY { @Disp } + macro @AX { @APlace } + macro @AY { @ADisp } + macro @NY { @NDisp } + macro @MY { @ANDisp } + + macro @D @Display { @DP @G @DX | @DP // @DY } + macro @LD @LeftDisplay { @DP @LG @DX | @DP // @DY } + macro @ID @IndentedDisplay { @DP @IG @DX | @DP // @DY } + macro @QD @QuotedDisplay { @DP @IG @DX @IG @DP // @DY } + macro @CD @CentredDisplay + @CenteredDisplay { @DP @CG @DX | @DP // @DY } + macro @RightDisplay { @DP @RG @DX | @DP // @DY } + + + macro @AD @AlignedDisplay { @DP @G @AX | @DP // @AY } + macro @LAD @LeftAlignedDisplay { @DP @LG @AX | @DP // @AY } + macro @IAD @IndentedAlignedDisplay { @DP @IG @AX | @DP // @AY } + macro @QAD @QuotedAlignedDisplay { @DP @IG @AX @IG @DP // @AY } + macro @CAD @CentredAlignedDisplay + @CenteredAlignedDisplay { @DP @CG @AX | @DP // @AY } + macro @RightAlignedDisplay { @DP @RG @AX | @DP // @AY } + + macro @ND @NumberedDisplay { @DP @G @DX |1rt @NN @DP // @NY } + macro @LND @LeftNumberedDisplay { @DP @LG @DX |1rt @NN @DP // @NY } + macro @IND @IndentedNumberedDisplay { @DP @IG @DX |1rt @NN @DP // @NY } + macro @QND @QuotedNumberedDisplay { @DP @IG @DX |1rt @QR @DP // @NY } + macro @CND @CentredNumberedDisplay + @CenteredNumberedDisplay { @DP @CG @DX |1rt @NN @DP // @NY } + macro @RightNumberedDisplay { @DP @RG @DX |1rt @NN @DP // @NY } + + macro @AND @AlignedNumberedDisplay { @DP @G @AX |1rt @NN @DP // @MY } + macro @LAND @LeftAlignedNumberedDisplay { @DP @LG @AX |1rt @NN @DP // @MY } + macro @IAND @IndentedAlignedNumberedDisplay{ @DP @IG @AX |1rt @NN @DP // @MY } + macro @QAND @QuotedAlignedNumberedDisplay { @DP @IG @AX |1rt @QR @DP // @MY } + macro @CAND @CentredAlignedNumberedDisplay + @CenteredAlignedNumberedDisplay{ @DP @CG @AX |1rt @NN @DP // @MY } + macro @RightAlignedNumberedDisplay { @DP @RG @AX |1rt @NN @DP // @MY } + + + macro @RD @RawDisplay { @G @DX | // @DY } + macro @RLD @RawLeftDisplay { @LG @DX | // @DY } + macro @RID @RawIndentedDisplay { @IG @DX | // @DY } + macro @RQD @RawQuotedDisplay { @IG @DX @IG | // @DY } + macro @RCD @RawCentredDisplay + @RawCenteredDisplay { @CG @DX | | // @DY } + macro @RRD @RawRightDisplay { @RG @DX | // @DY } + + + macro @RAD @RawAlignedDisplay { @G @AX | // @AY } + macro @RLAD @RawLeftAlignedDisplay { @LG @AX | // @AY } + macro @RIAD @RawIndentedAlignedDisplay { @IG @AX | // @AY } + macro @RQAD @RawQuotedAlignedDisplay { @IG @AX @IG | // @AY } + macro @RCAD @RawCentredAlignedDisplay + @RawCenteredAlignedDisplay { @CG @AX | // @AY } + macro @RRAD @RawRightAlignedDisplay { @RG @AX | // @AY } + + macro @RND @RawNumberedDisplay { @G @DX |1rt @NN // @NY } + macro @RLND @RawLeftNumberedDisplay { @LG @DX |1rt @NN // @NY } + macro @RIND @RawIndentedNumberedDisplay { @IG @DX |1rt @NN // @NY } + macro @RQND @RawQuotedNumberedDisplay { @IG @DX |1rt @QR // @NY } + macro @RCND @RawCentredNumberedDisplay + @RawCenteredNumberedDisplay { @CG @DX |1rt @NN // @NY } + macro @RRND @RawRightNumberedDisplay { @RG @DX |1rt @NN // @NY } + + macro @RAND @RawAlignedNumberedDisplay { @G @AX |1rt @NN // @MY } + macro @RLAND @RawLeftAlignedNumberedDisplay { @LG @AX |1rt @NN // @MY } + macro @RIAND @RawIndentedAlignedNumberedDisplay { @IG @AX |1rt @NN // @MY } + macro @RQAND @RawQuotedAlignedNumberedDisplay { @IG @AX |1rt @QR // @MY } + macro @RCAND @RawCentredAlignedNumberedDisplay + @RawCenteredAlignedNumberedDisplay { @CG @AX |1rt @NN // @MY } + macro @RRAND @RawRightAlignedNumberedDisplay{ @RG @AX |1rt @NN // @MY } + + + ########################################################################### + # # + # Lists and raw lists. # + # # + ########################################################################### + + + def @ItemPlace { @Galley } + def @InterruptItemPlace { @Galley } + def @NewPageItemPlace { @Galley } + def @TagPlace { @Galley } + def @EndListPlace { @Galley } + + def @RawList + named style right num { num } + named type right num { num } + named gap { @ListGap } + named indent { @ListIndent } + named itemindent { 0c } + named rightindent { @ListRightIndent } + named labelwidth { @ListLabelWidth } + named start { 1 } + { + def @MakeList right num + { + def @NormalItem + { + |indent + labelwidth @Wide { + # @NumberMarker @Value {style num} {style num} &0io + @NumberMarker @Value {num} {style type num} &0io + } + |itemindent @ItemPlace |rightindent + //gap @MakeList @NotRevealed @Next num + } + + def @InterruptItem + { + @InterruptItemPlace + //gap @MakeList @NotRevealed num + } + + def @NewPageItem + { + @NewPageItemPlace + //1.1b @MakeList @NotRevealed num + } + + @OneOf + { + @NormalItem + @InterruptItem + @NewPageItem + } + } + + def @ListGalleyPlace { @Galley } + + def @ListGalley into { @ListGalleyPlace&&preceding } + { + @MakeList start // @EndListPlace + } + + @ListGalleyPlace + // + @ListGalley + } + + def listitem into { @ItemPlace&&preceding } + named @Tag {} + right x + { + @NumberMarker&&preceding @Tagged @Tag + // x + // @PageMark @Tag # weird placement, but @PageMark is definite now + } + + def droplistitem into { @ItemPlace&&preceding } + named @Tag {} + right x + { + @NumberMarker&&preceding @Tagged @Tag + // @PageMark @Tag + //1vx x + } + + def tagitem into { @ItemPlace&&preceding } + named tag {} + right x + { + def sendtag into { @TagPlace&&preceding } { tag } + + sendtag // x + } + + def droptagitem into { @ItemPlace&&preceding } + named tag {} + right x + { + def sendtag into { @TagPlace&&preceding } { tag } + + sendtag // //1vx x + } + + def endlist force into { @EndListPlace&&preceding } {} + + def listnewpage into { @NewPageItemPlace&&preceding } {} + + def listinterruptitem into { @InterruptItemPlace&&preceding } + right x + { + x + } + + + macro @LI @ListItem { // listitem } + macro @LII @ListInterruptItem { // listinterruptitem } + macro @LNP @ListNewPage { // listnewpage } + macro @DLI @DropListItem { // droplistitem } + macro @TI @TagItem { // tagitem tag } + macro @DTI @DropTagItem { // droptagitem tag } + macro @REL @RawEndList { // & endlist // } + macro @EL @EndList { // & endlist @LOP } + + + macro @RLL @RawLeftList { @RawList style {} + labelwidth { 0c } } + macro @RIL @RawIndentedList { @RawList style {} } + macro @RQL @RawQuotedList { @RawList style {} + rightindent {@DisplayIndent}} + macro @RCL @RawCentredList { @RawList style {} + labelwidth {0c} + itemindent {0.5rt} } + macro @RawCenteredList { @RawCentredList } + macro @RNL @RawNumberedList { @RawList style { num. } } + macro @RPNL @RawParenNumberedList { @RawList style { (num) } } + macro @RRL @RawRomanList { @RawList type { @Roman&&num } + style { num. } } + macro @RPRL @RawParenRomanList { @RawList type { @Roman&&num } + style { (num) } } + macro @RUCRL @RawUCRomanList { @RawList type { @UCRoman&&num } + style { num. } } + macro @RPUCRL @RawParenUCRomanList { @RawList type { @UCRoman&&num } + style { (num) } } + macro @RAL @RawAlphaList { @RawList type { @Alpha&&num } + style { num. } } + macro @RPAL @RawParenAlphaList { @RawList type { @Alpha&&num } + style { (num) } } + macro @RUCAL @RawUCAlphaList { @RawList type { @UCAlpha&&num } + style { num. } } + macro @RPUCAL @RawParenUCAlphaList { @RawList type { @UCAlpha&&num } + style { (num) } } + macro @RBL @RawBulletList { @RawList style { @Bullet } } + macro @RSL @RawStarList { @RawList style { @Star } } + macro @RDL @RawDashList { @RawList style { -- } } + macro @RTL @RawTaggedList { @RawList type { @TagPlace } } + macro @RWTL @RawWideTaggedList { @RawList type { @TagPlace } + labelwidth { @WideIndent } } + macro @RVWTL @RawVeryWideTaggedList{ @RawList type { @TagPlace } + labelwidth { @VeryWideIndent } } + + + macro @L @List { @LOP @RawList } + macro @LL @LeftList { @LOP @RawLeftList } + macro @IL @IndentedList { @LOP @RawIndentedList } + macro @QL @QuotedList { @LOP @RawQuotedList } + macro @CL @CentredList { @LOP @RawCentredList } + macro @CenteredList { @LOP @RawCenteredList } + macro @NL @NumberedList { @LOP @RawNumberedList } + macro @PNL @ParenNumberedList { @LOP @RawParenNumberedList } + macro @RL @RomanList { @LOP @RawRomanList } + macro @PRL @ParenRomanList { @LOP @RawParenRomanList } + macro @UCRL @UCRomanList { @LOP @RawUCRomanList } + macro @PUCRL @ParenUCRomanList { @LOP @RawParenUCRomanList } + macro @AL @AlphaList { @LOP @RawAlphaList } + macro @PAL @ParenAlphaList { @LOP @RawParenAlphaList } + macro @UCAL @UCAlphaList { @LOP @RawUCAlphaList } + macro @PUCAL @ParenUCAlphaList { @LOP @RawParenUCAlphaList } + macro @BL @BulletList { @LOP @RawBulletList } + macro @SL @StarList { @LOP @RawStarList } + macro @DL @DashList { @LOP @RawDashList } + macro @TL @TaggedList { @LOP @RawTaggedList } + macro @WTL @WideTaggedList { @LOP @RawWideTaggedList } + macro @VWTL @VeryWideTaggedList { @LOP @RawVeryWideTaggedList } + +@End @BasicSetup diff --git a/include/dsf b/include/dsf index bc6954e..b0fa61b 100644 --- a/include/dsf +++ b/include/dsf @@ -4045,10 +4045,10 @@ def @DocumentSetup def @Merge left x right y { - {x @Rump y} @Case + { x @Rump { x @Meld y } } @Case { "" @Yield x - else @Yield { { x &"0.03fu" , } @Meld y } + else @Yield { { x{@OneCol ,} } @Meld y } } } @@ -4063,7 +4063,13 @@ def @DocumentSetup right y { @MakeIndex @Case { - Yes @Yield { @PageMark @Tag & x @DoIndex stem { y } indent { indent } y } + Yes @Yield { + @PageMark @Tag & + x @DoIndex stem { y } indent { indent } + { + y &"0.03fu" {} + } + } else @Yield @Null } } @@ -4101,8 +4107,11 @@ def @DocumentSetup @MakeIndex @Case { Yes @Yield { - @PageMark @Tag & - x @DoIndex stem { y } indent { indent } { y &"0.03fu" , @PgRange } + @PageMark @Tag & + x @DoIndex stem { y } indent { indent } + { + y &"0.03fu" {}{@OneCol ,} @PgRange + } } else @Yield @Null } @@ -4157,13 +4166,47 @@ def @DocumentSetup named indent { 0f } right @Body { + def @Enclose right x + { + @IndexACtd.indent @Case { + + Yes.0f @Yield { + @ClearHeaderComponent + //1vx + x + //1vx + 1vx @SetHeaderComponent { + indent @Wide & + stem @IndexACtdFormat {continued @WordVal @IndexACtdWord} + } + //1vx + 1vx @BeginHeaderComponent (unused) + } + + Yes.1f @Yield { + @EndHeaderComponent + //1vx + x + //1vx + 1vx @BeginHeaderComponent { + indent @Wide & + stem @IndexACtdFormat {continued @WordVal @IndexACtdWord} + } + } + + else @Yield x + + } + } + def @Merge left x right y { - {x @Rump y} @Case + { x @Rump { x @Meld y } } @Case { "" @Yield x - else @Yield { { x &"0.03fu" , } @Meld y } + else @Yield { { x{@OneCol ,} } @Meld y } } + } @IndexAFont @Font @IndexABreak @Break { indent @Wide & @Body } @@ -4176,7 +4219,13 @@ def @DocumentSetup right y { @MakeIndexA @Case { - Yes @Yield { @PageMark @Tag & x @DoIndexA indent { indent } y } + Yes @Yield { + @PageMark @Tag & + x @DoIndexA stem { y } indent { indent } + { + y &"0.03fu" {} + } + } else @Yield @Null } } @@ -4211,14 +4260,17 @@ def @DocumentSetup } } - @MakeIndexA @Case { Yes @Yield { - @PageMark @Tag & - x @DoIndexA indent { indent } { y &"0.03fu" , @PgRange } + @PageMark @Tag & + x @DoIndexA stem { y } indent { indent } + { + y &"0.03fu" {}{@OneCol ,} @PgRange + } } else @Yield @Null } + } macro @SubIndexA { @IndexA indent { "1f" } } @@ -4270,13 +4322,47 @@ def @DocumentSetup named indent { 0f } right @Body { + def @Enclose right x + { + @IndexBCtd.indent @Case { + + Yes.0f @Yield { + @ClearHeaderComponent + //1vx + x + //1vx + 1vx @SetHeaderComponent { + indent @Wide & + stem @IndexBCtdFormat {continued @WordVal @IndexBCtdWord} + } + //1vx + 1vx @BeginHeaderComponent (unused) + } + + Yes.1f @Yield { + @EndHeaderComponent + //1vx + x + //1vx + 1vx @BeginHeaderComponent { + indent @Wide & + stem @IndexBCtdFormat {continued @WordVal @IndexBCtdWord} + } + } + + else @Yield x + + } + } + def @Merge left x right y { - {x @Rump y} @Case + { x @Rump { x @Meld y } } @Case { "" @Yield x - else @Yield { { x &"0.03fu" , } @Meld y } + else @Yield { { x{@OneCol ,} } @Meld y } } + } @IndexBFont @Font @IndexBBreak @Break { indent @Wide & @Body } @@ -4289,7 +4375,13 @@ def @DocumentSetup right y { @MakeIndexB @Case { - Yes @Yield { @PageMark @Tag & x @DoIndexB indent { indent } y } + Yes @Yield { + @PageMark @Tag & + x @DoIndexB stem { y } indent { indent } + { + y &"0.03fu" {} + } + } else @Yield @Null } } @@ -4324,14 +4416,17 @@ def @DocumentSetup } } - @MakeIndexB @Case { Yes @Yield { @PageMark @Tag & - x @DoIndexB indent { indent } { y &"0.03fu" , @PgRange } + x @DoIndexB stem { y } indent { indent } + { + y &"0.03fu" {}{@OneCol ,} @PgRange + } } else @Yield @Null } + } macro @SubIndexB { @IndexB indent { "1f" } } @@ -4502,7 +4597,8 @@ def @DocumentSetup { Yes.VeryMajor } @Yield { incontents @VeryMajorContentsEntry - title { initiallanguage @Language { bypassnumber: &2s title } } + title { initiallanguage @Language { + bypassnumber @ColonSep title } } } else @Yield @Null diff --git a/include/old.diag.lpg b/include/old.diag.lpg deleted file mode 100644 index 05a067f..0000000 --- a/include/old.diag.lpg +++ /dev/null @@ -1,2899 +0,0 @@ -%%BeginResource: procset LoutDiagPrependGraphic -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% % -% PostScript @SysPrependGraphic file for @Diag Jeffrey H. Kingston % -% Version 2.0 (includes CIRCUM label) September 1996 % -% % -% To assist in avoiding name clashes, the names of all symbols % -% defined here begin with "ldiag". However, this is not feasible % -% with user-defined labels and some labels used by users. % -% % -% <point> is two numbers, a point. % -% <length> is one number, a length % -% <angle> is one number, an angle in degrees % -% <dashlength> is one number, the preferred length of a dash % -% % -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -errordict begin - /handleerror - { - { /Times-Roman findfont 8 pt scalefont setfont - 0 setgray 4 pt 4 pt moveto - $error /errorname get - dup ldiagdict exch known - { ldiagdict exch get } - { 100 string cvs } ifelse - show - ( Command: ) show - $error /command get 100 string cvs show - } stopped {} if - showpage stop - } def -end - -% begin diagram: <maxlabels> ldiagbegin - -% must be defined outside ldiagdict since it loads it -/ldiagbegin -{ xsize 0 0 ysize ldiagdict begin - 5 -1 roll /ldiagmaxlabels exch def - (@Diag) ldiagpushtagdict - /OOY ldiagpointdef /OOX ldiagpointdef 0 0 /OOO ldiagpointdef -} def - -% end diagram: - ldiagend - -/ldiagend -{ ldiagpoptagdict end -} def - -% concat strings: <string> <string> ldiagconcat <string> -% must be defined outside ldiagdict since used in ldiagpromotelabels -/ldiagconcat -{ 2 copy length exch length add string - dup 0 4 index putinterval - dup 3 index length 3 index putinterval - 3 1 roll pop pop -} def - -% show string in format start ... end: <string> ldiagsends <string> -/ldiagsends -{ - dup length 20 string cvs (: ) ldiagconcat exch - dup 0 20 getinterval ( ... ) ldiagconcat - 3 -1 roll exch ldiagconcat - exch dup length 20 sub 20 getinterval ldiagconcat -} def - -/ldiagdebugposy 432 def -/ldiagdebugposx 72 def - -% <string> <int> ldiagdebugprint - -% must be defined outside ldiagdict since used in arbitrary places -% print <string> plus count or <int> stack entries, whichever is the smaller -/ldiagdebugprint -{ - exch - gsave - initgraphics - ldiagdebugposy 72 lt - { /ldiagdebugposx ldiagdebugposx 144 add store - /ldiagdebugposy 432 store - } - { - /ldiagdebugposy ldiagdebugposy 12 sub store - } ifelse - ldiagdebugposx ldiagdebugposy moveto - /Times-Roman findfont 10 scalefont setfont - 0 setgray show - count 1 sub 2 copy lt { pop } { exch pop } ifelse 1 sub - 0 exch 1 exch - { - /ldiagdebugposy ldiagdebugposy 12 sub store - ldiagdebugposx 12 add ldiagdebugposy moveto - index 100 string cvs show - } for - grestore -} def - -/ldiagdict 200 dict def -ldiagdict begin - -% error messages -/dictfull (dictfull error: too many labels?) def -/dictstackoverflow (dictstackoverflow error: labels nested too deeply?) def -/execstackoverflow (execstackoverflow error: figure nested too deeply?) def -/limitcheck (limitcheck error: figure nested too deeply or too large?) def -/syntaxerror (syntaxerror error: syntax error in text of figure?) def -/typecheck (typecheck error: syntax error in text of figure?) def -/undefined (undefined error: unknown or misspelt label?) def -/VMError (VMError error: run out of memory?) def - -% push pi onto stack: - ldiagpi <num> -/ldiagpi 3.14159 def - -% push e onto stack: - ldiage <num> -/ldiage 2.71828 def - -% arc directions -/clockwise false def -/anticlockwise true def - -% test equality between two angles: <angle> <angle> ldiagangleeq <bool> -/ldiagangleeq { ldiagfixangle exch ldiagfixangle eq } def - -% test inequality between two angles: <angle> <angle> ldiaganglene <bool> -/ldiaganglene { ldiagangleeq not } def - -% maximum of two numbers: <num> <num> ldiagmax <num> -/ldiagmax { 2 copy gt { pop } { exch pop } ifelse } def - -% minimum of two numbers: <num> <num> ldiagmin <num> -/ldiagmin { 2 copy lt { pop } { exch pop } ifelse } def - -% add two points: <point> <point> ldiagpadd <point> -/ldiagpadd -{ - % (Entering padd) 4 ldiagdebugprint - exch 3 1 roll add 3 1 roll add exch - % (Leaving padd) 2 ldiagdebugprint -} def - -% subtract first point from second: <point> <point> ldiagpsub <point> -/ldiagpsub { 3 2 roll sub 3 1 roll exch sub exch } def - -% max two points: <point> <point> ldiagpmax <point> -/ldiagpmax { exch 3 1 roll ldiagmax 3 1 roll ldiagmax exch } def - -% min two points: <point> <point> ldiagpmin <point> -/ldiagpmin { exch 3 1 roll ldiagmin 3 1 roll ldiagmin exch } def - -% scalar multiplication: <point> <num> ldiagpmul <point> -/ldiagpmul { dup 3 1 roll mul 3 1 roll mul exch } def - -% point at angle and distance: <point> <length> <angle> ldiagatangle <point> -/ldiagatangle { 2 copy cos mul 3 1 roll sin mul ldiagpadd } def - -% angle from one point to another: <point> <point> ldiagangleto <angle> -/ldiagangleto { ldiagpsub 2 copy 0 eq exch 0 eq and {pop} {exch atan} ifelse } def - -% distance between two points: <point> <point> ldiagdistance <length> -/ldiagdistance { ldiagpsub dup mul exch dup mul add sqrt } def - -% stroke a solid line: <length> <dashlength> ldiagsolid - -/ldiagsolid -{ pop pop [] 0 setdash 1 setlinecap stroke -} def - -% stroke a dashed line: <length> <dashlength> ldiagdashed - -/ldiagdashed -{ 2 copy div 2 le 1 index 0 le or - { exch pop 1 pt ldiagmax [ exch dup ] 0 setdash } - { dup [ exch 4 2 roll 2 copy div - 1 sub 2 div ceiling dup 4 1 roll - 1 add mul sub exch div ] 0 setdash - } ifelse 0 setlinecap stroke -} def - -% stroke a cdashed line: <length> <dashlength> ldiagcdashed - -/ldiagcdashed -{ % (Entering ldiagcdashed) 2 ldiagdebugprint - 2 copy le 1 index 0 le or - { exch pop 1 pt ldiagmax [ exch dup ] dup 0 get 2 div setdash } - { dup [ 4 2 roll exch 2 copy exch div - 2 div ceiling div 1 index sub - ] exch 2 div setdash - } ifelse 0 setlinecap stroke - % (Leaving ldiagcdashed) 0 ldiagdebugprint -} def - -% stroke a dotted line: <length> <dashlength> ldiagdotted - -/ldiagdotted -{ 2 copy le 1 index 0 le or - { exch pop 1 pt ldiagmax [ exch 0 exch ] 0 setdash } - { 1 index exch div ceiling div - [ 0 3 2 roll ] 0 setdash - } ifelse 1 setlinecap stroke -} def - -% stroke a noline line: <length> <dashlength> ldiagnoline - -/ldiagnoline -{ pop pop -} def - -/ldiagbox -{ - 0 0 /SW ldiagpointdef - xsize 0 /SE ldiagpointdef - xsize ysize /NE ldiagpointdef - 0 ysize /NW ldiagpointdef - SE 0.5 ldiagpmul /S ldiagpointdef - NW 0.5 ldiagpmul /W ldiagpointdef - W SE ldiagpadd /E ldiagpointdef - S NW ldiagpadd /N ldiagpointdef - NE 0.5 ldiagpmul /CTR ldiagpointdef - - 0 dg /S@ANGLE ldiagangledef - 45 dg /SE@ANGLE ldiagangledef - 90 dg /E@ANGLE ldiagangledef - 135 dg /NE@ANGLE ldiagangledef - 180 dg /N@ANGLE ldiagangledef - 225 dg /NW@ANGLE ldiagangledef - 270 dg /W@ANGLE ldiagangledef - 315 dg /SW@ANGLE ldiagangledef - - [ CTR NE ldiagpsub /ldiagboxcircum cvx ] ldiagcircumdef - SW SE NE NW SW -} def - -% shape and labels of the @CurveBox symbol -% <margin> ldiagcurvebox <shape> -/ldiagcurvebox -{ - - % (Entering ldiagcurvebox) 1 ldiagdebugprint - ldiagdecodelength /cbmgn exch def - - xsize 0.5 mul ysize 0.5 mul /CTR ldiagpointdef - xsize 0.5 mul 0 /S ldiagpointdef - xsize ysize 0.5 mul /E ldiagpointdef - xsize 0.5 mul ysize /N ldiagpointdef - 0 ysize 0.5 mul /W ldiagpointdef - - cbmgn 0.293 mul cbmgn 0.293 mul /SW ldiagpointdef - xsize cbmgn 0.293 mul sub cbmgn 0.293 mul /SE ldiagpointdef - xsize cbmgn 0.293 mul sub ysize cbmgn 0.293 mul sub /NE ldiagpointdef - cbmgn 0.293 mul ysize cbmgn 0.293 mul sub /NW ldiagpointdef - - 0 dg /S@ANGLE ldiagangledef - 45 dg /SE@ANGLE ldiagangledef - 90 dg /E@ANGLE ldiagangledef - 135 dg /NE@ANGLE ldiagangledef - 180 dg /N@ANGLE ldiagangledef - 225 dg /NW@ANGLE ldiagangledef - 270 dg /W@ANGLE ldiagangledef - 315 dg /SW@ANGLE ldiagangledef - - [ xsize ysize 0.5 ldiagpmul cbmgn /ldiagcurveboxcircum cvx ] ldiagcircumdef - - cbmgn 0 - xsize cbmgn sub 0 - [ xsize cbmgn sub cbmgn ] - xsize cbmgn - xsize ysize cbmgn sub - [ xsize cbmgn sub ysize cbmgn sub ] - xsize cbmgn sub ysize - cbmgn ysize - [ cbmgn ysize cbmgn sub ] - 0 ysize cbmgn sub - 0 cbmgn - [ cbmgn cbmgn ] - cbmgn 0 - - % (Leaving ldiagcurvebox) 0 ldiagdebugprint -} def - -% shadow of the @ShadowBox symbol -% its shape and labels are done, somewhat inaccurately, with ldiagbox -% <shadowmargin> ldiagshadow - -/ldiagshadow -{ - /lfshm exch def - - lfshm 0 moveto - 0 lfshm neg rlineto - xsize 0 rlineto - 0 ysize rlineto - lfshm neg 0 rlineto - xsize 0 lineto - closepath fill - -} def - -% shape and labels of the @Square symbol -/ldiagsquare -{ - xsize ysize 0.5 ldiagpmul /CTR ldiagpointdef - CTR xsize xsize ysize ysize ldiagpmax 0.5 ldiagpmul ldiagpadd /NE ldiagpointdef - CTR 0 0 CTR NE ldiagdistance 135 ldiagatangle ldiagpadd /NW ldiagpointdef - CTR 0 0 CTR NE ldiagdistance 225 ldiagatangle ldiagpadd /SW ldiagpointdef - CTR 0 0 CTR NE ldiagdistance 315 ldiagatangle ldiagpadd /SE ldiagpointdef - SW 0.5 ldiagpmul SE 0.5 ldiagpmul ldiagpadd /S ldiagpointdef - NW 0.5 ldiagpmul NE 0.5 ldiagpmul ldiagpadd /N ldiagpointdef - SW 0.5 ldiagpmul NW 0.5 ldiagpmul ldiagpadd /W ldiagpointdef - SE 0.5 ldiagpmul NE 0.5 ldiagpmul ldiagpadd /E ldiagpointdef - - 0 dg /S@ANGLE ldiagangledef - 45 dg /SE@ANGLE ldiagangledef - 90 dg /E@ANGLE ldiagangledef - 135 dg /NE@ANGLE ldiagangledef - 180 dg /N@ANGLE ldiagangledef - 225 dg /NW@ANGLE ldiagangledef - 270 dg /W@ANGLE ldiagangledef - 315 dg /SW@ANGLE ldiagangledef - - [ CTR NE ldiagpsub /ldiagboxcircum cvx ] ldiagcircumdef - SW SE NE NW SW -} def - -% shape and labels of the @Diamond symbol -/ldiagdiamond -{ - xsize 0 0.5 ldiagpmul /S ldiagpointdef - 0 ysize 0.5 ldiagpmul /W ldiagpointdef - S W ldiagpadd /CTR ldiagpointdef - CTR W ldiagpadd /N ldiagpointdef - CTR S ldiagpadd /E ldiagpointdef - E N ldiagpadd 0.5 ldiagpmul /NE ldiagpointdef - N W ldiagpadd 0.5 ldiagpmul /NW ldiagpointdef - S W ldiagpadd 0.5 ldiagpmul /SW ldiagpointdef - S E ldiagpadd 0.5 ldiagpmul /SE ldiagpointdef - - 0 dg /S@ANGLE ldiagangledef - 90 dg /E@ANGLE ldiagangledef - 180 dg /N@ANGLE ldiagangledef - 270 dg /W@ANGLE ldiagangledef - S E ldiagangleto /SE@ANGLE ldiagangledef - E N ldiagangleto /NE@ANGLE ldiagangledef - N W ldiagangleto /NW@ANGLE ldiagangledef - W S ldiagangleto /SW@ANGLE ldiagangledef - - [ xsize ysize 0.5 ldiagpmul /ldiagdiamondcircum cvx ] ldiagcircumdef - S E N W S -} def - -% shape and labels of the @Ellipse symbol -/ldiagellipse -{ - xsize 0 0.5 ldiagpmul /S ldiagpointdef - 0 ysize 0.5 ldiagpmul /W ldiagpointdef - S W ldiagpadd /CTR ldiagpointdef - CTR W ldiagpadd /N ldiagpointdef - CTR S ldiagpadd /E ldiagpointdef - CTR xsize 0 0.3536 ldiagpmul ldiagpadd 0 ysize 0.3536 ldiagpmul ldiagpadd /NE ldiagpointdef - 0 ysize 0.3536 ldiagpmul CTR xsize 0 0.3536 ldiagpmul ldiagpadd ldiagpsub /SE ldiagpointdef - xsize 0 0.3536 ldiagpmul CTR ldiagpsub 0 ysize 0.3536 ldiagpmul ldiagpadd /NW ldiagpointdef - 0 ysize 0.3536 ldiagpmul xsize 0 0.3536 ldiagpmul CTR ldiagpsub ldiagpsub /SW ldiagpointdef - [ xsize ysize 0.5 ldiagpmul /ldiagellipsecircum cvx ] ldiagcircumdef - - 0 dg /S@ANGLE ldiagangledef - 90 dg /E@ANGLE ldiagangledef - 180 dg /N@ANGLE ldiagangledef - 270 dg /W@ANGLE ldiagangledef - - S E ldiagangleto /SE@ANGLE ldiagangledef - E N ldiagangleto /NE@ANGLE ldiagangledef - N W ldiagangleto /NW@ANGLE ldiagangledef - W S ldiagangleto /SW@ANGLE ldiagangledef - - S [ CTR ] E [ CTR ] N [ CTR ] W [ CTR ] S -} def - -% shape and labels of the @Circle symbol -/ldiagcircle -{ - xsize ysize 0.5 ldiagpmul /CTR ldiagpointdef - CTR xsize 0 ysize 0 ldiagpmax 0.5 ldiagpmul ldiagpadd /E ldiagpointdef - CTR 0 0 CTR E ldiagdistance 45 ldiagatangle ldiagpadd /NE ldiagpointdef - CTR 0 0 CTR E ldiagdistance 90 ldiagatangle ldiagpadd /N ldiagpointdef - CTR 0 0 CTR E ldiagdistance 135 ldiagatangle ldiagpadd /NW ldiagpointdef - CTR 0 0 CTR E ldiagdistance 180 ldiagatangle ldiagpadd /W ldiagpointdef - CTR 0 0 CTR E ldiagdistance 225 ldiagatangle ldiagpadd /SW ldiagpointdef - CTR 0 0 CTR E ldiagdistance 270 ldiagatangle ldiagpadd /S ldiagpointdef - CTR 0 0 CTR E ldiagdistance 315 ldiagatangle ldiagpadd /SE ldiagpointdef - [ S E ldiagpsub /ldiagellipsecircum cvx ] ldiagcircumdef - - 0 dg /S@ANGLE ldiagangledef - 45 dg /SE@ANGLE ldiagangledef - 90 dg /E@ANGLE ldiagangledef - 135 dg /NE@ANGLE ldiagangledef - 180 dg /N@ANGLE ldiagangledef - 225 dg /NW@ANGLE ldiagangledef - 270 dg /W@ANGLE ldiagangledef - 315 dg /SW@ANGLE ldiagangledef - - S [ CTR ] E [ CTR ] N [ CTR ] W [ CTR ] S -} def - -% shape and labels of the @VLine and @VArrow symbols -/ldiagvline -{ - xmark ysize ldiagprevious /FROM ldiagpointdef - xmark 0 ldiagprevious /TO ldiagpointdef -} def - -% points of a polygon around base with given no of sides, vert init angle: -% <sides> <angle> ldiagpolygon <point> ... <point> -/ldiagpolygon -{ exch round cvi exch - xsize ysize 0.5 ldiagpmul /CTR ldiagpointdef - 90 sub CTR 2 copy ldiagmax 5 3 roll - [ 4 copy pop /ldiagpolycircum cvx ] ldiagcircumdef - exch dup 360 exch div exch - 1 1 3 2 roll - { 4 string cvs (P) exch ldiagconcat - 3 copy exch pop (@ANGLE) ldiagconcat cvn exch 90 add exch ldiagangledef - cvn 6 copy pop pop ldiagatangle 2 copy 10 2 roll - 3 2 roll ldiagpointdef - dup 3 1 roll add exch - } for - pop ldiagatangle -} def - -% shape and labels of the @Isosceles triangle symbol -/ldiagisosceles -{ - xsize ysize 0.5 ldiagpmul /CTR ldiagpointdef - 0 0 /SW ldiagpointdef - xsize 0 /SE ldiagpointdef - xsize 0.5 mul ysize /N ldiagpointdef - xsize 0.5 mul 0 /S ldiagpointdef - SE 0.5 ldiagpmul N 0.5 ldiagpmul ldiagpadd /NE ldiagpointdef - SW 0.5 ldiagpmul N 0.5 ldiagpmul ldiagpadd /NW ldiagpointdef - - [ xsize ysize /ldiagisoscelescircum cvx ] ldiagcircumdef - - 0 dg /SW@ANGLE ldiagangledef - 0 dg /SE@ANGLE ldiagangledef - 180 dg /N@ANGLE ldiagangledef - 0 dg /S@ANGLE ldiagangledef - SE N ldiagangleto /NE@ANGLE ldiagangledef - N SW ldiagangleto /NW@ANGLE ldiagangledef - - SW SE N SW -} def - -% next array element: <array> <index> ldiaggetnext <array> <index> <any> true -% or <array> <index> false -/ldiaggetnext -{ 2 copy exch length ge - { false } - { 2 copy get exch 1 add exch true } ifelse -} def - -% check whether thing is number: <any> ldiagisnumbertype <any> <bool> -/ldiagisnumbertype -{ dup type dup - /integertype eq exch /realtype eq or -} def - -% check whether thing is an array: <any> ldiagisarraytype <any> <bool> -/ldiagisarraytype { dup type /arraytype eq } def - -% check whether thing is an array: <any> ldiagisnametype <any> <bool> -/ldiagisnametype { dup type /nametype eq } def - -% get next item: <array> <index> ldiaggetnextitem <array> <index> 0 -% or <array> <index> <array> 1 -% or <array> <index> <point> 2 -/ldiaggetnextitem -{ ldiaggetnext - { ldiagisarraytype - { 1 - } - { ldiagisnumbertype - { 3 1 roll - ldiaggetnext - { ldiagisnumbertype - { 4 3 roll exch 2 - } - { pop 3 2 roll pop 0 - } ifelse - } - { 3 2 roll pop 0 - } ifelse - } - { pop 0 - } ifelse - } ifelse - } - { 0 - } ifelse -} def - -% approximate equality: num1 num2 approxeq <boolean> -/approxeq -{ dup 0 eq - { pop 0 eq - } - { dup 3 1 roll sub exch div abs 0.001 lt - } ifelse -} def - -% set arc path: bool x1 y1 x2 y2 x0 y0 ldiagsetarc <angle> <angle> <dist> -% the path goes from x1 y1 to x2 y2 about centre x0 y0, -% anticlockwise if bool is true else clockwise. -% The orientations of backwards pointing and forwards pointing -% arrowheads are returned in the two angles, and -% the length of the arc is returned in <dist>. -/ldiagsetarc -{ - % (Entering ldiagsetarc) 7 ldiagdebugprint - 20 dict begin - matrix currentmatrix 8 1 roll - 2 copy translate 2 copy 8 2 roll - 4 2 roll ldiagpsub 6 2 roll ldiagpsub - dup /y1 exch def dup mul /y1s exch def - dup /x1 exch def dup mul /x1s exch def - dup /y2 exch def dup mul /y2s exch def - dup /x2 exch def dup mul /x2s exch def - /dist1 0 0 x1 y1 ldiagdistance def - /dist2 0 0 x2 y2 ldiagdistance def - - y1s y2s approxeq - { -1 - } - { y1s x2s mul y2s x1s mul sub y1s y2s sub div - } ifelse - /da exch def - - x1s x2s approxeq - { -1 - } - { x1s y2s mul x2s y1s mul sub x1s x2s sub div - } ifelse - /db exch def - - da 0 gt db 0 gt and - { - % ( case 1, ellipse) 0 ldiagdebugprint - /LMax da sqrt db sqrt ldiagmax def - /scalex da sqrt LMax div def - /scaley db sqrt LMax div def - scalex scaley scale - 0 0 LMax - 0 0 x1 scalex mul y1 scaley mul ldiagangleto - 0 0 x2 scalex mul y2 scaley mul ldiagangleto - 2 copy eq { 360 add } if - 2 copy 8 2 roll - 5 index { arc } { arcn } ifelse - 2 index 1 index - { 90 sub } { 90 add } ifelse - dup sin scaley mul exch cos scalex mul atan - 2 index 2 index - { 90 add } { 90 sub } ifelse - dup sin scaley mul exch cos scalex mul atan - 5 2 roll % res1 res2 ang1 ang2 anticlockwise - { exch sub } { sub } ifelse - dup 0 le { 360 add } if ldiagpi mul LMax mul 180 div - } - { - dist1 dist2 approxeq - % x1 y1 dist1 ( x1 y1, d) 3 ldiagdebugprint pop pop pop - % x2 y2 dist2 ( x2 y2, d) 3 ldiagdebugprint pop pop pop - { - % ( case 2, circle) 0 ldiagdebugprint - 0 0 - dist1 - 0 0 x1 y1 ldiagangleto - 0 0 x2 y2 ldiagangleto - 2 copy eq { 360 add } if - 2 copy 8 2 roll - 5 index { arc } { arcn } ifelse - 2 index 1 index - { 90 sub } { 90 add } ifelse - 2 index 2 index - { 90 add } { 90 sub } ifelse - 5 2 roll % res1 res2 ang1 ang2 clockwise - { exch sub } { sub } ifelse - dup 0 le { 360 add } if - ldiagpi mul dist1 mul 180 div - } - { - % ( case 3, line) 0 ldiagdebugprint - x2 y2 lineto pop - x2 y2 x1 y1 ldiagangleto - x1 y1 x2 y2 ldiagangleto - x1 y1 x2 y2 ldiagdistance - } ifelse - } ifelse - 4 -1 roll setmatrix - end - % (Leaving ldiagsetarc) 3 ldiagdebugprint -} def - -% ldiagsetcurve: set up a Bezier curve from x0 y0 to x3 y3 -% and return arrowhead angles and length of curve (actually 0) -% x0 y0 x1 y1 x2 y2 x3 y3 ldiagsetcurve <angle> <angle> <length> -/ldiagsetcurve -{ 8 copy curveto pop pop - ldiagangleto - 5 1 roll - 4 2 roll ldiagangleto - exch - 0 -} def - -% ldiagsetpath: convert a Diag path into a PostScript path -% [ shape ] ldiagsetpath -/ldiagsetpath -{ - 10 dict begin - 0 newpath - /prevseen false def - /curveseen false def - { ldiaggetnextitem - dup 0 eq { pop exit } - { 1 eq - { /curveseen true def - /curve exch def - curve length 0 eq { /curveseen false def } if - } - { /ycurr exch def - /xcurr exch def - prevseen - { curveseen - { curve length 4 eq - { xprev yprev - curve 0 get curve 1 get - curve 2 get curve 3 get - xcurr ycurr - ldiagsetcurve pop pop pop - } - { xprev yprev xcurr ycurr - curve length 1 ge { curve 0 get } { 0 } ifelse - curve length 2 ge { curve 1 get } { 0 } ifelse - curve length 3 ge { curve 2 get } { true } ifelse - 7 1 roll - ldiagsetarc pop pop pop - } ifelse - } - { xcurr ycurr lineto - } ifelse - } - { xcurr ycurr moveto - } ifelse - /xprev xcurr def - /yprev ycurr def - /prevseen true def - /curveseen false def - } ifelse - } ifelse - } loop pop pop - end -} def - -% ldiagpaintpath: paint a path of the given shape -% /paint [ shape ] ldiagpaintpath - -/ldiagpaintpath -{ - ldiagsetpath cvx exec -} def - -% stroke a path of the given shape in the given linestyle and dash length. -% Return the origin and angle of the backward and forward arrow heads. -% dashlength /linestyle [shape] ldiagdopath [<point> <angle>] [<point> <angle>] -/ldiagdopath -{ - 10 dict begin - 0 - /prevseen false def - /curveseen false def - /backarrow [] def - /fwdarrow [] def - { - ldiaggetnextitem - dup 0 eq { pop exit } - { - 1 eq - { /curveseen true def - /curve exch def - curve length 0 eq { /prevseen false def } if - } - { /ycurr exch def - /xcurr exch def - prevseen - { newpath xprev yprev moveto - curveseen - { curve length 4 eq - { xprev yprev - curve 0 get curve 1 get - curve 2 get curve 3 get - xcurr ycurr ldiagsetcurve - } - { xprev yprev xcurr ycurr - curve length 1 ge { curve 0 get } { 0 } ifelse - curve length 2 ge { curve 1 get } { 0 } ifelse - curve length 3 ge { curve 2 get } { true } ifelse - 7 1 roll - ldiagsetarc - } ifelse - } - { xcurr ycurr lineto - xcurr ycurr xprev yprev ldiagangleto dup 180 sub - xprev yprev xcurr ycurr ldiagdistance - } ifelse - 6 index 6 index cvx exec - [ xprev yprev 5 -1 roll ] - backarrow length 0 eq - { /backarrow exch def } - { pop } ifelse - [ xcurr ycurr 4 -1 roll ] /fwdarrow exch def - } if - /xprev xcurr def - /yprev ycurr def - /prevseen true def - /curveseen false def - } ifelse - } ifelse - } loop - pop pop pop pop - backarrow length 0 eq { [ 0 0 0 ] } { backarrow } ifelse - fwdarrow length 0 eq { [ 0 0 0 ] } { fwdarrow } ifelse - end -} def - - -% stroke a path of the given shape in the given linestyle and dash length. -% dashlength [ /linestyle ] [shape] ldiagdosegpath - -/ldiagdosegpath -{ - 12 dict begin - 1 index /seg exch def - 1 index length /seglength exch def - 0 /segcount exch def - 0 - /prevseen false def - /curveseen false def - /backarrow [] def - /fwdarrow [] def - { - ldiaggetnextitem - dup 0 eq { pop exit } - { - 1 eq - { /curveseen true def - /curve exch def - curve length 0 eq { /prevseen false def } if - } - { /ycurr exch def - /xcurr exch def - prevseen - { newpath xprev yprev moveto - curveseen - { curve length 4 eq - { xprev yprev - curve 0 get curve 1 get - curve 2 get curve 3 get - xcurr ycurr ldiagsetcurve - } - { xprev yprev xcurr ycurr - curve length 1 ge { curve 0 get } { 0 } ifelse - curve length 2 ge { curve 1 get } { 0 } ifelse - curve length 3 ge { curve 2 get } { true } ifelse - 7 1 roll - ldiagsetarc - } ifelse - } - { xcurr ycurr lineto - xcurr ycurr xprev yprev ldiagangleto dup 180 sub - xprev yprev xcurr ycurr ldiagdistance - } ifelse - 6 index seg segcount seglength mod get cvx exec - /segcount segcount 1 add def - [ xprev yprev 5 -1 roll ] - backarrow length 0 eq - { /backarrow exch def } - { pop } ifelse - [ xcurr ycurr 4 -1 roll ] /fwdarrow exch def - } if - /xprev xcurr def - /yprev ycurr def - /prevseen true def - /curveseen false def - } ifelse - } ifelse - } loop - pop pop pop pop - end -} def - -% ldiagnodebegin: start of node parameters -% ldiagnodebegin - -/ldiagnodebegin -{ % (Entering ldiagnodebegin) 0 ldiagdebugprint - ldiagmaxlabels dict begin -} def - -% ldiagnodeend: end of node parameters (so do the node) -% <outline> <dashlength> <style> <linewidth> <paint> ldiagnodeend - -/ldiagnodeend -{ - % (Entering ldiagnodeend) 0 ldiagdebugprint - end % matches begin in ldiagnodebegin - 4 index gsave ldiagpaintpath grestore - 3 index ldiagsetpath clip newpath - 2 mul setlinewidth - 3 -1 roll ldiagdosegpath - % (Leaving ldiagnodeend) 0 ldiagdebugprint -} def - -% ldiaglinkbegin: start of link parameters -% <direct> ldiaglinkbegin - -/ldiaglinkbegin -{ ldiagmaxlabels dict begin - 1 eq /direct exch def -} def - -% ldiaglinkend: end of link parameters (so do the link) -% <outline> <dashlength> <style> <linewidth> ldiaglinkend - -/ldiaglinkend -{ - end % matches begin in ldiaglinkbegin - setlinewidth - 3 -1 roll ldiagdosegpath -} def - -% ldiagdoarrow: draw an arrow head of given form -% dashlength /lstyle /pstyle hfrac height width [ <point> <angle> ] ldiagdoarrow - -/ldiagdoarrow -{ matrix currentmatrix 8 1 roll - dup 0 get 1 index 1 get translate - 2 get rotate - [ 2 index neg 2 index 0 0 - 3 index 3 index neg - 1 index 10 index mul 0 - 7 index 7 index ] - 4 1 roll pop pop pop - dup 3 1 roll - gsave ldiagpaintpath grestore ldiagdopath pop pop - setmatrix -} def - -% arrow head styles -/ldiagopen 0.0 def -/ldiaghalfopen 0.5 def -/ldiagclosed 1.0 def - -% stroke no arrows, forward, back, and both -/ldiagnoarrow { pop pop pop pop pop pop pop pop } def -/ldiagforward { 7 -1 roll ldiagdoarrow pop } def -/ldiagback { 8 -2 roll pop ldiagdoarrow } def -/ldiagboth { 8 -1 roll 7 copy ldiagdoarrow pop 7 -1 roll ldiagdoarrow } def - -% ldiagprevious: return previous point on path -/ldiagprevious -{ ldiagisnumbertype - { 2 copy } - { ldiagisarraytype - { 2 index 2 index } - { 0 0 } - ifelse - } ifelse -} def - -% Tag dictionary operators -% -% Diag's tag dictionaries are kept on the same stack as other dictionaries, -% since there is nowhere else to put them. However, they are managed like -% a separate stack using the following operators: -% -% <tag> ldiagpushtagdict - Push a new, empty tag dictionary -% ldiagtoptagdict dict Find the top tag dictionary -% ldiagpoptagdict - Pop and destroy the top tag dictionary -% ldiagpopuptagdict - Pop top tag dict and promote its entries -% ldiagdebugtagdict - Debug print of dictionary stack -% -% They are distinguished from other dictionaries by containing /ldiagtagdict, -% whose value is the <tag> which is used by ldiagpopuptagdict, -% and they are hopefully never the target of any non-tag definition because -% they are never the top dictionary, since push places the new dict second. - -/ldiagpushtagdict -{ ldiagmaxlabels dict dup - currentdict end exch begin begin - exch /ldiagtagdict exch put -} def - -/ldiagtoptagdict -{ /ldiagtagdict where not - { (Diag internal error: no tag dictionary) show stop - } if -} def - -/ldiagpoptagdict -{ - % (Entering poptagdict) 0 ldiagdebugprint - % ldiagdebugtagdict - mark - { currentdict end - dup /ldiagtagdict known - { exit - } if - } loop - pop - counttomark - { begin - } repeat - pop - % (Leaving poptagdict) 0 ldiagdebugprint - % ldiagdebugtagdict -} def - -% promote labels from top tag dictionary to second top tag dictionary -% each prefixed by <string>@ if <string> (value of /ldiagtagdict) is not empty -% - ldiagpopuptagdict - -/ldiagpopuptagdict -{ - ldiagtagdict - % (Entering ldiagpopuptagdict) 1 ldiagdebugprint - % ldiagdebugtagdict - ldiagtoptagdict ldiagpoptagdict ldiagtoptagdict exch - { exch 100 string cvs 3 index - dup length 0 ne - { (@) ldiagconcat - } if - exch ldiagconcat cvn exch 2 index 3 1 roll put - } forall - pop pop - % (Leaving ldiagpopuptagdict) 0 ldiagdebugprint - % ldiagdebugtagdict -} def - -% debug tag dictionary stack -/ldiagdebugtagdict -{ (Entering ldiagdebugtagdict) 0 ldiagdebugprint - 30 array dictstack - { dup /ldiagtagdict known - { dup /ldiagtagdict get 0 ldiagdebugprint - { pop 100 string cvs ( ) exch ldiagconcat - dup 0 ldiagdebugprint - pop - } - forall - } - { pop (other) 0 ldiagdebugprint - } ifelse - } forall - (Leaving ldiagdebugtagdict) 0 ldiagdebugprint -} def - -% label a point in top tag dictionary: <point> /name ldiagpointdef - -/ldiagpointdef -{ - % (Entering ldiagpointdef) 3 ldiagdebugprint - [ 4 2 roll transform /itransform cvx ] cvx - ldiagtoptagdict 3 1 roll put - % (Leaving ldiagpointdef) 0 ldiagdebugprint -} def - -% label an angle in top tag dictionary: <angle> /name ldiagangledef - -/ldiagangledef -{ - % (Entering ldiagangledef) 2 ldiagdebugprint - exch ldiagfixangle ldiagtoptagdict 3 1 roll put - % (Leaving ldiagangledef) 0 ldiagdebugprint -} def - -% add CIRCUM operator with this body: <array> ldiagcircumdef - -/ldiagcircumdef -{ % (Entering ldiagcircumdef) 1 ldiagdebugprint - /CIRCUM exch cvx - ldiagtoptagdict 3 1 roll put - % currentdict end - % 3 1 roll - % def - % begin - % (Leaving ldiagcircumdef) 0 ldiagdebugprint -} def - -% show points (except CIRCUM and ANGLE): - ldiagshowpoints - -/ldiagshowpoints -{ - % (Entering ldiagshowpoints) 0 ldiagdebugprint - ldiagtoptagdict - { 1 index 100 string cvs - (ldiagdebugpos) search - { pop pop pop pop pop } - { - (CIRCUM) search % if CIRCUM in key - { pop pop pop pop pop } - { - (ANGLE) search % if ANGLE in key - { - pop pop pop pop pop - } - { - (ldiagtagdict) search - { - pop pop pop pop pop - } - { - pop cvx exec - newpath 2.0 pt 0 360 arc 0 setgray fill pop - } ifelse - } ifelse - } ifelse - } ifelse - } forall - % (Leaving ldiagshowpoints) 0 ldiagdebugprint -} def - - -/ldiagshowtags -{ - % (Entering ldiagshowtags) 0 ldiagdebugprint - ldiagtoptagdict - { 1 index 100 string cvs - % dup 0 ldiagdebugprint - (ldiagdebugpos) search - { pop pop pop pop pop } - { - (CIRCUM) search % if CIRCUM in key - { pop pop pop pop pop } - { - (ANGLE) search % if ANGLE in key - { - pop pop pop pop pop - } - { - (ldiagtagdict) search - { - pop pop pop pop pop - } - { - pop cvx exec 2 copy - gsave - newpath 2.0 pt 0 360 arc 0 setgray fill - /Times-Roman findfont 8 pt scalefont setfont - translate 40 rotate 0.2 cm 0.1 cm moveto 100 string cvs show - grestore - } ifelse - } ifelse - } ifelse - } ifelse - } forall - % (Leaving ldiagshowtags) 0 ldiagdebugprint -} def - - -% show angles: - ldiagshowangles - -/ldiagshowangles -{ - % (Entering ldiagshowangles) 0 ldiagdebugprint - ldiagtoptagdict - { 1 index 100 string cvs - % dup 0 ldiagdebugprint - (ldiagdebugpos) search - { pop pop pop pop pop } - { - (ldiagtagdict) search - { - pop pop pop pop pop - } - { - (CIRCUM) search % if CIRCUM in key - { pop pop pop pop pop } - { - (@ANGLE) search % if ANGLE in key, draw the angle at the point - { - % (showing ANGLE) 5 ldiagdebugprint - gsave exch pop exch pop cvx - % (about to execute) 1 ldiagdebugprint - exec translate rotate 0.8 0.8 scale pop - newpath 0 0 2.0 pt 0 360 arc 0 setgray fill - newpath 4 pt 0 moveto 9 pt 0 lineto - 9 pt 1.5 pt lineto 11 pt 0 lineto 9 pt -1.5 pt lineto - 9 pt 0 lineto [] 0 setdash 4 pt setlinewidth 0 setlinejoin - stroke grestore - % (finished ANGLE) 5 ldiagdebugprint - } - { - % else must be a point, we aren't showing those - pop pop pop - } ifelse - } ifelse - } ifelse - } ifelse - } forall - % (Leaving ldiagshowangles) 0 ldiagdebugprint -} def - -% fix an angle to 0 <= res < 360: <angle> ldiagfixangle <angle> -/ldiagfixangle -{ - % (Entering ldiagfixangle) 1 ldiagdebugprint - { dup 0 ge { exit } if - 360 add - } loop - { dup 360 lt { exit } if - 360 sub - } loop - % (Leaving ldiagfixangle) 1 ldiagdebugprint -} def - -% find point on circumference of box: alpha a b ldiagboxcircum x y -/ldiagboxcircum -{ - % (Entering ldiagboxcircum) 3 ldiagdebugprint - 4 dict begin - /b exch def - /a exch def - ldiagfixangle /alpha exch def - 0 0 a b ldiagangleto /theta exch def - - % if alpha <= theta, return (a, a*tan(alpha)) - alpha theta le - { a a alpha sin mul alpha cos div } - { - % else if alpha <= 180 - theta, return (b*cot(alpha), b) - alpha 180 theta sub le - { b alpha cos mul alpha sin div b } - { - % else if alpha <= 180 + theta, return (-a, -a*tan(alpha)) - alpha 180 theta add le - { a neg a neg alpha sin mul alpha cos div } - { - % else if alpha <= 360 - theta, return (-b*cot(alpha), -b) - alpha 360 theta sub le - { b neg alpha cos mul alpha sin div b neg } - { - % else 360 - theta <= alpha, return (a, a*tan(alpha)) - a a alpha sin mul alpha cos div - } ifelse - } ifelse - } ifelse - } ifelse - end - % (Leaving ldiagboxcircum) 2 ldiagdebugprint -} def - -% find quadratic roots (assume a != 0): a b c ldiagqroots x1 x2 2 -% or x2 1 -% or 0 -/ldiagqroots -{ - 4 dict begin - /c exch def - /b exch def - /a exch def - /disc b b mul 4 a c mul mul sub def - disc 0 lt - { 0 - } - { disc 0 eq - { b neg 2 a mul div - 1 - } - { b neg disc sqrt add 2 a mul div - b neg disc sqrt sub 2 a mul div - 2 - } - ifelse - } - ifelse - end -} def - -% work our which quadrant: <angle> ldiagquadrant <0-3> -/ldiagquadrant -{ dup 90 lt - { pop 0 - } - { dup 180 lt - { pop 1 - } - { 270 lt - { 2 - } - { 3 - } ifelse - } ifelse - } ifelse -} def - -% find curvebox circum, assuming upper right quadrant: alpha a b xmk ldiagcb x y -/ldiagcb -{ - 6 dict begin - /xmk exch def - /b exch def - /a exch def - /alpha exch def - /theta1 0 0 a b xmk sub ldiagangleto def - /theta2 0 0 a xmk sub b ldiagangleto def - alpha theta1 le - { % if alpha <= theta1, return (a, a*tan(alpha)) - a a alpha sin mul alpha cos div - } - { alpha theta2 ge - { % else if alpha > theta2, return (b*cot(alpha), b) - b alpha cos mul alpha sin div b - } - { - % else, return the intersection of line and circle - a xmk sub b xmk sub xmk 0 0 alpha ldiagcircleintersect - dup 0 eq - { % should never happen, just return any reasonable point - pop - a b 0.5 ldiagpmul - } - { 1 eq - { % should never happen, just return the point on top of stack - } - { % the usual case, two points on stack, return the larger - ldiagpmax - } ifelse - } ifelse - } ifelse - } ifelse - end -} def - -% find point on circumference of curvebox: alpha a b xmk ldiagcurveboxcircum x y -/ldiagcurveboxcircum -{ - % (Entering ldiagcurveboxcircum) 4 ldiagdebugprint - 5 dict begin - /xmk exch def - /b exch def - /a exch def - ldiagfixangle /alpha exch def - - % work out which quadrant we are in, and reflect accordingly - /quad alpha ldiagquadrant def - quad 0 eq - { alpha a b xmk ldiagcb - } - { quad 1 eq - { 180 alpha sub a b xmk ldiagcb exch neg exch - } - { quad 2 eq - { alpha 180 sub a b xmk ldiagcb neg exch neg exch - } - { 360 alpha sub a b xmk ldiagcb neg - } ifelse - } ifelse - } ifelse - end - % (Leaving ldiagcurveboxcircum) 2 ldiagdebugprint -} def - -% find point on circumference of diamond: alpha a b ldiagdiamondcircum x y -/ldiagdiamondcircum -{ - % (Entering ldiagdiamondcircum) 3 ldiagdebugprint - 4 dict begin - /b exch def - /a exch def - ldiagfixangle /alpha exch def - b alpha cos abs mul a alpha sin abs mul add /denom exch def - a b mul alpha cos mul denom div - a b mul alpha sin mul denom div - end - % (Leaving ldiagdiamondcircum) 2 ldiagdebugprint -} def - -% find point on circumference of ellipse: alpha a b ldiagellipsecircum x y -/ldiagellipsecircum -{ - % (Entering ldiagellipsecircum) 3 ldiagdebugprint - 4 dict begin - /b exch def - /a exch def - ldiagfixangle /alpha exch def - b alpha cos mul dup mul a alpha sin mul dup mul add sqrt /denom exch def - a b mul alpha cos mul denom div - a b mul alpha sin mul denom div - end - % (Leaving ldiagellipsecircum) 2 ldiagdebugprint -} def - -% find point on circumference of isosceles: alpha a b ldiagisoscelescircum x y -/ldiagisoscelescircum -{ - % (Entering ldiagisoscelescircum) 3 ldiagdebugprint - 7 dict begin - /b exch def - /a exch def - /alpha exch ldiagfixangle def - /theta1 90 def - /theta2 a b 0.5 ldiagpmul 0 0 ldiagangleto def - /theta3 a b 0.5 ldiagpmul a 0 ldiagangleto def - alpha theta1 ge alpha theta2 le and - { 0 0 a 2 div b - } - { alpha theta2 ge alpha theta3 le and - { 0 0 a 0 - } - { a 0 a 2 div b - } ifelse - } ifelse - a 2 div b 2 div 2 copy 1 ft alpha ldiagatangle ldiaglineintersect - a 2 div b 2 div 4 2 roll ldiagpsub - end - % (Leaving ldiagisoscelescircum) 2 ldiagdebugprint -} def - -% find point of intersection of two lines each defined by two points -% x1 y1 x2 y2 x3 y3 x4 y4 ldiaglineintersect x y -/ldiaglineintersect -{ - % (Entering ldiaglineintersect) 8 ldiagdebugprint - 13 dict begin - /y4 exch def - /x4 exch def - /y3 exch def - /x3 exch def - /y2 exch def - /x2 exch def - /y1 exch def - /x1 exch def - x2 x1 sub /x21 exch def - x4 x3 sub /x43 exch def - y2 y1 sub /y21 exch def - y4 y3 sub /y43 exch def - y21 x43 mul y43 x21 mul sub /det exch def - - % calculate x - y21 x43 mul x1 mul - y43 x21 mul x3 mul sub - y3 y1 sub x21 mul x43 mul add - det div - - % calculate y - x21 y43 mul y1 mul - x43 y21 mul y3 mul sub - x3 x1 sub y21 mul y43 mul add - det neg div - - end - % (Leaving ldiaglineintersect) 2 ldiagdebugprint -} def - -% find point on circumference of polygon -% alpha radius num theta ldiagpolycircum x y -/ldiagpolycircum -{ - % (Entering ldiagpolycircum) 4 ldiagdebugprint - 13 dict begin - /theta exch def - /num exch def - /radius exch def - /alpha exch def - - % calculate delta, the angle from theta to alpha - alpha theta sub ldiagfixangle - - % calculate the angle which is the multiple of 360/num closest to delta - 360 num div div truncate 360 num div mul theta add /anglea exch def - - % calculate the next multiple of 360/num after anglea - anglea 360 num div add /angleb exch def - - % intersect the line through these two points with the alpha line - anglea cos anglea sin angleb cos angleb sin - 0 0 alpha cos 2 mul alpha sin 2 mul - ldiaglineintersect radius ldiagpmul - - end - % (Leaving ldiagpolycircum) 2 ldiagdebugprint -} def - -% find point of intersection of a line and a circle -% x0 y0 r x1 y1 theta ldiagcircleintersect xa ya xb yb 2 -% or xb yb 1 -% or 0 -/ldiagcircleintersect -{ - % (Entering ldiagcircleintersect) 6 ldiagdebugprint - 15 dict begin - /theta exch def - /y1 exch def - /x1 exch def - /r exch def - /y0 exch def - /x0 exch def - - % if sin(theta) = 0 then line is horizontal and y must be y1 - theta sin abs 0.00001 lt - { - /a 1 def - /b -2 x0 mul def - /c x0 dup mul y1 y0 sub dup mul add r dup mul sub def - a b c ldiagqroots dup - 0 eq - { pop - 0 - } - { 1 eq - { y1 1 - } - { y1 exch y1 2 - } ifelse - } ifelse - } - { - /ct theta cos theta sin div def - /a ct ct mul 1 add def - /b ct x1 x0 sub mul y1 add y0 sub 2 mul def - /c x1 x0 sub dup mul y1 y0 sub dup mul add r dup mul sub def - a b c ldiagqroots dup - 0 eq - { pop - 0 - } - { 1 eq - { y1 add /yb exch def - yb y1 sub ct mul x1 add /xb exch def - xb yb 1 - } - { y1 add /ya exch def - ya y1 sub ct mul x1 add /xa exch def - y1 add /yb exch def - yb y1 sub ct mul x1 add /xb exch def - xa ya xb yb 2 - } ifelse - } ifelse - } ifelse - end - % (Leaving ldiagcircleintersect) 1 ldiagdebugprint -} def - -% find line which is the perpendicular bisector of two points, defined -% by two points -% x1 y1 x2 y2 ldiaglinebetween x3 y3 x4 y4 -/ldiaglinebetween -{ % (Entering ldiaglinebetween) 4 ldiagdebugprint - /y2 exch def /x2 exch def - /y1 exch def /x1 exch def - - % let x3, y3 be the point halfway between the two points - x1 y1 x2 y2 ldiagpadd 0.5 ldiagpmul - /y3 exch def /x3 exch def - - % find a point perpendicular to x3, y3 - x3 y3 50 x1 y1 x2 y2 ldiagangleto 90 dg add ldiagatangle - - % plus x3 y3 gives the two points - x3 y3 - - % (Leaving ldiaglinebetween) 4 ldiagdebugprint -} def - -% find <proc>@<string>: <proc> <string> ldiagfindlabel <any> true -% <proc> <string> false -/ldiagfindlabel -{ - % (Entering ldiagfindlabel) 2 ldiagdebugprint - exch dup length 1 ne - { exch false - % (Leaving ldiagfindabel (length not 1)) 3 ldiagdebugprint - } - { dup 0 get type /nametype ne - { exch false - % (Leaving ldiagfindabel (not a name)) 3 ldiagdebugprint - } - { dup 0 get 100 string cvs (@) ldiagconcat 2 index ldiagconcat dup where - { exch get exch pop exch pop cvx exec true - % (Leaving ldiagfindlabel with success) 100 ldiagdebugprint - } - { - pop exch false - % (Leaving ldiagfindabel (concat not sensible)) 3 ldiagdebugprint - } ifelse - } ifelse - } ifelse -} bind def - -% execute <proc>@<string> or else default: <proc> <string> ldiagdolabel <various> -/ldiagdolabel -{ - % (Entering ldiagdolabel) 2 ldiagdebugprint - ldiagfindlabel not - { - dup (CIRCUM) eq - { pop pop pop 0 0 - } - { - dup (ANGLE) eq - { pop pop 0 - } - { pop cvx exec - } ifelse - } ifelse - } if - % (Leaving ldiagdolabel) 2 ldiagdebugprint -} bind def - -% execute a proc depending on whether number is negative, zero, or positive -% procneg proczero procpos number ldiagsigncase <anything> -/ldiagsigncase -{ - % (Entering ldiagsigncase) 4 ldiagdebugprint - dup 0 lt - { pop pop pop exec - } - { 0 gt - { exch pop exch pop exec - } - { pop exch pop exec - } ifelse - } ifelse - % (Leaving ldiagsigncase) 0 ldiagdebugprint -} bind def - -% execute proci if angle is in ith quadrant -% proc45 proc270 proc180 proc90 proc0 proc315 proc225 proc135 angle ldiagquadcase <anything> -/ldiagquadcase -{ - % (Entering ldiagquadcase) 9 ldiagdebugprint - round ldiagfixangle cvi dup 90 mod 0 eq - { 90 idiv 4 add } { 90 idiv } ifelse - 8 exch roll pop pop pop pop pop pop pop exec - % (Leaving ldiagquadcase) 0 ldiagdebugprint -} bind def - -% decode Lout length into PostScript length -% <string> ldiagdecodelength <number> -/ldiagdecodelength -{ - % (Entering ldiagdecodelength) 1 ldiagdebugprint - (f) search - { exch pop exch pop cvr ft - } - { (c) search - { exch pop exch pop cvr cm - } - { (p) search - { exch pop exch pop cvr pt - } - { (m) search - { exch pop exch pop cvr em - } - { (s) search - { exch pop exch pop cvr sp - } - { (v) search - { exch pop exch pop cvr vs - } - { (i) search - { exch pop exch pop cvr in - } - { pop 0 - } ifelse - } ifelse - } ifelse - } ifelse - } ifelse - } ifelse - } ifelse - % (Leaving ldiagdecodelength) 1 ldiagdebugprint -} def - -% implement aabout function -% logical form: <circum> <extra> <centre> aabout <point> -% actual form: { <labelorpoint> } cvlit <length> [ <point> ] cvx aabout <point> -/ldiagaabout -{ - /centre exch def - /extra exch def - /circum exch def - - /ZXCTR [ centre ] cvx def - /ZFCTR [ circum (CTR) ldiagdolabel ] cvx def - /ZAREF ZFCTR ZXCTR ldiagangleto def - /ZAMIN 0 dg def - /ZPMIN [ circum (CTR) ldiagdolabel ZAREF ZAMIN sub - circum (CIRCUM) ldiagdolabel ldiagpadd - 0 0 extra ZAREF ZAMIN sub ldiagatangle - ldiagpadd ] cvx def - - /ZAMAX 90 dg def - /ZPMAX [ circum (CTR) ldiagdolabel ZAREF ZAMAX sub - circum (CIRCUM) ldiagdolabel ldiagpadd - 0 0 extra ZAREF ZAMAX sub ldiagatangle - ldiagpadd ] cvx def - - 1 1 20 - { /xval exch def - /ZAMID ZAMIN ZAMAX add 0.5 mul def - /ZPMID [ circum (CTR) ldiagdolabel ZAREF ZAMID sub - circum (CIRCUM) ldiagdolabel ldiagpadd - 0 0 extra ZAREF ZAMID sub ldiagatangle - ldiagpadd ] cvx def - ZPMID ZXCTR ldiagdistance ZFCTR ZXCTR ldiagdistance gt - { - /ZAMAX [ ZAMID ] cvx def - /ZPMAX [ ZPMID ] cvx def - } - { - /ZAMIN [ ZAMID ] cvx def - /ZPMIN [ ZPMID ] cvx def - } ifelse - } for - ZPMID -} def - -% implement cabout function -% logical form: <circum> <extra> <centre> cabout <point> -% actual form: { <labelorpoint> } cvlit <length> [ <point> ] cvx cabout <point> -/ldiagcabout -{ - /centre exch def - /extra exch def - /circum exch def - - /ZXCTR [ centre ] cvx def - /ZFCTR [ circum (CTR) ldiagdolabel ] cvx def - /ZAREF ZFCTR ZXCTR ldiagangleto def - /ZAMIN 0 dg def - /ZPMIN [ circum (CTR) ldiagdolabel ZAREF ZAMIN add - circum (CIRCUM) ldiagdolabel ldiagpadd - 0 0 extra ZAREF ZAMIN add ldiagatangle - ldiagpadd ] cvx def - - /ZAMAX 90 dg def - /ZPMAX [ circum (CTR) ldiagdolabel ZAREF ZAMAX add - circum (CIRCUM) ldiagdolabel ldiagpadd - 0 0 extra ZAREF ZAMAX add ldiagatangle - ldiagpadd ] cvx def - - 1 1 20 - { /xval exch def - /ZAMID ZAMIN ZAMAX add 0.5 mul def - /ZPMID [ circum (CTR) ldiagdolabel ZAREF ZAMID add - circum (CIRCUM) ldiagdolabel ldiagpadd - 0 0 extra ZAREF ZAMID add ldiagatangle - ldiagpadd ] cvx def - ZPMID ZXCTR ldiagdistance ZFCTR ZXCTR ldiagdistance gt - { - /ZAMAX [ ZAMID ] cvx def - /ZPMAX [ ZPMID ] cvx def - } - { - /ZAMIN [ ZAMID ] cvx def - /ZPMIN [ ZPMID ] cvx def - } ifelse - } for - ZPMID -} def - -% fromarrowlength toarrowlength { from } { to } xindent zindent ldiaglinepath - -/ldiaglinepath -{ - % (entering ldiaglinepath) 0 ldiagdebugprint - /zindent exch def - /xindent exch def - cvlit /to exch def - cvlit /from exch def - /toarrowlength exch def - /fromarrowlength exch def - - from (CTR) ldiagdolabel to (CTR) ldiagdolabel ldiagangleto - /FROM@ANGLE ldiagangledef - from (CTR) ldiagdolabel FROM@ANGLE from (CIRCUM) ldiagdolabel ldiagpadd - 0 0 fromarrowlength FROM@ANGLE ldiagatangle ldiagpadd - /FROM ldiagpointdef - - FROM@ANGLE /TO@ANGLE ldiagangledef - to (CTR) ldiagdolabel TO@ANGLE 180 dg sub to (CIRCUM) ldiagdolabel ldiagpadd - 0 0 toarrowlength TO@ANGLE 180 dg sub ldiagatangle ldiagpadd /TO ldiagpointdef - - FROM 0.5 ldiagpmul TO 0.5 ldiagpmul ldiagpadd /LMID ldiagpointdef - FROM@ANGLE /LMID@ANGLE ldiagangledef - - /XINDENT xindent FROM LMID ldiagdistance ldiagmin def - FROM 0 0 XINDENT FROM@ANGLE ldiagatangle ldiagpadd /LFROM ldiagpointdef - FROM@ANGLE /LFROM@ANGLE ldiagangledef - - /ZINDENT zindent TO LMID ldiagdistance ldiagmin def - 0 0 ZINDENT FROM@ANGLE ldiagatangle TO ldiagpsub /LTO ldiagpointdef - FROM@ANGLE /LTO@ANGLE ldiagangledef - - direct { FROM TO } { FROM LFROM LMID LTO TO } ifelse - - % (leaving ldiaglinepath) 0 ldiagdebugprint -} def - -% fromarrowlength toarrowlength { from } { to } xindent zindent pathgap ldiagdoublelinepath - -/ldiagdoublelinepath -{ - % (entering ldiagdoublelinepath) 0 ldiagdebugprint - /pathgap exch def - /zindent exch def - /xindent exch def - cvlit /to exch def - cvlit /from exch def - /toarrowlength exch def - /fromarrowlength exch def - - from (CTR) ldiagdolabel to (CTR) ldiagdolabel ldiagangleto - /FROM@ANGLE ldiagangledef - from (CTR) ldiagdolabel FROM@ANGLE from (CIRCUM) ldiagdolabel ldiagpadd - 0 0 fromarrowlength FROM@ANGLE ldiagatangle ldiagpadd - /FROM ldiagpointdef - - FROM@ANGLE /TO@ANGLE ldiagangledef - to (CTR) ldiagdolabel TO@ANGLE 180 dg sub to (CIRCUM) ldiagdolabel ldiagpadd - 0 0 toarrowlength TO@ANGLE 180 dg sub ldiagatangle ldiagpadd /TO ldiagpointdef - - FROM 0.5 ldiagpmul TO 0.5 ldiagpmul ldiagpadd /LMID ldiagpointdef - FROM@ANGLE /LMID@ANGLE ldiagangledef - - /XINDENT xindent FROM LMID ldiagdistance ldiagmin def - FROM 0 0 XINDENT FROM@ANGLE ldiagatangle ldiagpadd /LFROM ldiagpointdef - FROM@ANGLE /LFROM@ANGLE ldiagangledef - - /ZINDENT zindent TO LMID ldiagdistance ldiagmin def - 0 0 ZINDENT FROM@ANGLE ldiagatangle TO ldiagpsub /LTO ldiagpointdef - FROM@ANGLE /LTO@ANGLE ldiagangledef - - direct { - FROM pathgap 2 div FROM@ANGLE 90 dg sub ldiagatangle - TO pathgap 2 div FROM@ANGLE 90 dg sub ldiagatangle - [] - FROM pathgap 2 div FROM@ANGLE 90 dg add ldiagatangle - TO pathgap 2 div FROM@ANGLE 90 dg add ldiagatangle - } - { - FROM pathgap 2 div FROM@ANGLE 90 dg sub ldiagatangle - LFROM pathgap 2 div FROM@ANGLE 90 dg sub ldiagatangle - LMID pathgap 2 div FROM@ANGLE 90 dg sub ldiagatangle - LTO pathgap 2 div FROM@ANGLE 90 dg sub ldiagatangle - TO pathgap 2 div FROM@ANGLE 90 dg sub ldiagatangle - [] - FROM pathgap 2 div FROM@ANGLE 90 dg add ldiagatangle - LFROM pathgap 2 div FROM@ANGLE 90 dg add ldiagatangle - LMID pathgap 2 div FROM@ANGLE 90 dg add ldiagatangle - LTO pathgap 2 div FROM@ANGLE 90 dg add ldiagatangle - TO pathgap 2 div FROM@ANGLE 90 dg add ldiagatangle - } ifelse - - % (leaving ldiagdoublelinepath) 0 ldiagdebugprint -} def - -% fromarrowlen toarrowlen { from } { to } xindent zindent bias ldiagacurvepath - -/ldiagacurvepath -{ - % (entering ldiagacurvepath) 0 ldiagdebugprint - /bias exch def - /zindent exch def - /xindent exch def - cvlit /to exch def - cvlit /from exch def - /toarrowlength exch def - /fromarrowlength exch def - - %/B1 bias 0.02 ft ldiagmax def - %/B2 from (CTR) ldiagdolabel to (CTR) ldiagdolabel ldiagdistance 0.5 mul def - %/BIAS B1 B2 ldiagmin def - /BIAS bias 0.02 ft ldiagmax def - /XMID [ from (CTR) ldiagdolabel 0.5 ldiagpmul - to (CTR) ldiagdolabel 0.5 ldiagpmul ldiagpadd ] cvx def - /XTOP [ XMID 0 0 BIAS from (CTR) ldiagdolabel to (CTR) ldiagdolabel - ldiagangleto 90 dg sub ldiagatangle ldiagpadd ] cvx def - /CTR [ from (CTR) ldiagdolabel XTOP ldiaglinebetween - to (CTR) ldiagdolabel XTOP ldiaglinebetween - ldiaglineintersect ] cvx def - - from fromarrowlength [ CTR ] cvx ldiagaabout /FROM ldiagpointdef - from (CTR) ldiagdolabel FROM ldiagdistance 0 gt - { from (CTR) ldiagdolabel FROM ldiagangleto - } - { CTR FROM ldiagangleto 90 dg add - } ifelse /FROM@ANGLE ldiagangledef - - to toarrowlength [ CTR ] cvx ldiagcabout /TO ldiagpointdef - TO to (CTR) ldiagdolabel ldiagdistance 0 gt - { TO to (CTR) ldiagdolabel ldiagangleto - } - { CTR TO ldiagangleto 90 dg add - } ifelse /TO@ANGLE ldiagangledef - - /RADIUS CTR FROM ldiagdistance def - CTR 0 0 RADIUS CTR FROM ldiagangleto 360 dg CTR TO ldiagangleto - add CTR FROM ldiagangleto sub cvi 360 mod 0.5 mul add - ldiagatangle ldiagpadd /LMID ldiagpointdef - CTR LMID ldiagangleto 90 dg add /LMID@ANGLE ldiagangledef - - /XINDENT xindent FROM LMID ldiagdistance ldiagmin def - CTR 0 0 RADIUS CTR FROM 0 0 XINDENT FROM@ANGLE ldiagatangle - ldiagpadd ldiagangleto ldiagatangle ldiagpadd /LFROM ldiagpointdef - CTR LFROM ldiagangleto 90 dg add /LFROM@ANGLE ldiagangledef - - /ZINDENT zindent TO LMID ldiagdistance ldiagmin def - CTR 0 0 RADIUS CTR TO 0 0 ZINDENT TO@ANGLE 180 dg add - ldiagatangle ldiagpadd ldiagangleto ldiagatangle ldiagpadd /LTO ldiagpointdef - CTR LTO ldiagangleto 90 dg add /LTO@ANGLE ldiagangledef - - direct - { FROM [CTR] TO } - { FROM [CTR] LFROM [CTR] LMID [CTR] LTO [CTR] TO } - ifelse - - % (leaving ldiagacurvepath) 0 ldiagdebugprint -} def - -% fromarrowlen toarrowlen { from } { to } xindent zindent bias ldiagccurvepath - -/ldiagccurvepath -{ - % (entering ldiagccurvepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop - /bias exch def - /zindent exch def - /xindent exch def - cvlit /to exch def - cvlit /from exch def - /toarrowlength exch def - /fromarrowlength exch def - - %/B1 bias 0.02 ft ldiagmax def - %/B2 from (CTR) ldiagdolabel to (CTR) ldiagdolabel ldiagdistance 0.5 mul def - %/BIAS B1 B2 ldiagmin def - /BIAS bias 0.02 ft ldiagmax def - /XMID [ from (CTR) ldiagdolabel 0.5 ldiagpmul - to (CTR) ldiagdolabel 0.5 ldiagpmul ldiagpadd ] cvx def - /XTOP [ XMID 0 0 BIAS from (CTR) ldiagdolabel to (CTR) ldiagdolabel - ldiagangleto 90 dg add ldiagatangle ldiagpadd ] cvx def - /CTR [ from (CTR) ldiagdolabel XTOP ldiaglinebetween - to (CTR) ldiagdolabel XTOP ldiaglinebetween ldiaglineintersect ] cvx def - - from fromarrowlength [ CTR ] cvx ldiagcabout /FROM ldiagpointdef - from (CTR) ldiagdolabel FROM ldiagdistance 0 gt - { from (CTR) ldiagdolabel FROM ldiagangleto } - { CTR FROM ldiagangleto 90 dg sub } - ifelse /FROM@ANGLE ldiagangledef - - to toarrowlength [ CTR ] cvx ldiagaabout /TO ldiagpointdef - TO to (CTR) ldiagdolabel ldiagdistance 0 gt - { TO to (CTR) ldiagdolabel ldiagangleto } - { CTR TO ldiagangleto 90 dg sub } - ifelse /TO@ANGLE ldiagangledef - - /RADIUS [ CTR FROM ldiagdistance ] cvx def - CTR 0 0 RADIUS CTR TO ldiagangleto 360 dg CTR FROM ldiagangleto add - CTR TO ldiagangleto sub cvi 360 cvi mod 2 div add ldiagatangle - ldiagpadd /LMID ldiagpointdef - CTR LMID ldiagangleto 90 dg sub /LMID@ANGLE ldiagangledef - - /XINDENT [ xindent FROM LMID ldiagdistance ldiagmin ] cvx def - CTR 0 0 RADIUS CTR FROM 0 0 XINDENT FROM@ANGLE ldiagatangle ldiagpadd - ldiagangleto ldiagatangle ldiagpadd /LFROM ldiagpointdef - CTR LFROM ldiagangleto 90 dg sub /LFROM@ANGLE ldiagangledef - - /ZINDENT [ zindent TO LMID ldiagdistance ldiagmin ] cvx def - CTR 0 0 RADIUS CTR TO 0 0 ZINDENT TO@ANGLE 180 dg add ldiagatangle - ldiagpadd ldiagangleto ldiagatangle ldiagpadd /LTO ldiagpointdef - CTR LTO ldiagangleto 90 dg sub /LTO@ANGLE ldiagangledef - - direct - { FROM [CTR clockwise] TO } - { FROM [CTR clockwise] LFROM [CTR clockwise] - LMID [CTR clockwise] LTO [CTR clockwise] TO } - ifelse - % (leaving ldiagccurvepath) 0 ldiagdebugprint -} def - - -% farr tarr { from } { to } xindent zindent [frompt] [topt] ldiagbezierpath - -/ldiagbezierpath -{ - % (entering ldiagbezierpath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop - cvx /topt exch def - cvx /frompt exch def - /zindent exch def - /xindent exch def - cvlit /to exch def - cvlit /from exch def - /toarrowlength exch def - /fromarrowlength exch def - - from (CTR) ldiagdolabel frompt ldiagangleto /FROM@ANGLE ldiagangledef - from (CTR) ldiagdolabel FROM@ANGLE from (CIRCUM) ldiagdolabel - ldiagpadd 0 0 fromarrowlength FROM@ANGLE ldiagatangle ldiagpadd - /FROM ldiagpointdef - - topt to (CTR) ldiagdolabel ldiagangleto /TO@ANGLE ldiagangledef - to (CTR) ldiagdolabel TO@ANGLE 180 dg add to (CIRCUM) ldiagdolabel - ldiagpadd 0 0 toarrowlength TO@ANGLE 180 dg add ldiagatangle ldiagpadd - /TO ldiagpointdef - - FROM 0 0 xindent FROM@ANGLE ldiagatangle ldiagpadd - /LFROM ldiagpointdef - FROM@ANGLE /LFROM@ANGLE ldiagangledef - - TO 0 0 zindent TO@ANGLE 180 dg add ldiagatangle ldiagpadd - /LTO ldiagpointdef - TO@ANGLE /LTO@ANGLE ldiagangledef - - FROM TO ldiagpadd frompt ldiagpadd topt ldiagpadd 0.25 ldiagpmul - /LMID ldiagpointdef - - FROM [frompt topt] TO - - % (leaving ldiagbezierpath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop -} def - - -% farr tarr { from } { to } xindent zindent ldiagvhlinepath - -/ldiagvhlinepath -{ - % (entering ldiagvhlinepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop - /zindent exch def - /xindent exch def - cvlit /to exch def - cvlit /from exch def - /toarrowlength exch def - /fromarrowlength exch def - - /CTR [ from (CTR) ldiagdolabel pop to (CTR) ldiagdolabel exch pop ] cvx def - /FANG [ from (CTR) ldiagdolabel CTR ldiagangleto ] cvx def - /TANG [ to (CTR) ldiagdolabel CTR ldiagangleto ] cvx def - - from (CTR) ldiagdolabel FANG from (CIRCUM) ldiagdolabel ldiagpadd - 0 0 fromarrowlength FANG ldiagatangle ldiagpadd /FROM ldiagpointdef - FANG /FROM@ANGLE ldiagangledef - - to (CTR) ldiagdolabel TANG to (CIRCUM) ldiagdolabel ldiagpadd - 0 0 toarrowlength TANG ldiagatangle ldiagpadd /TO ldiagpointdef - TANG 180 dg add /TO@ANGLE ldiagangledef - - /FDIST [ FROM CTR ldiagdistance ] cvx def - /TDIST [ TO CTR ldiagdistance ] cvx def - /XINDENT [ xindent FDIST ldiagmin ] cvx def - /ZINDENT [ zindent TDIST ldiagmin ] cvx def - FROM 0 0 XINDENT FANG ldiagatangle ldiagpadd /LFROM ldiagpointdef - FROM@ANGLE /LFROM@ANGLE ldiagangledef - TO 0 0 ZINDENT TANG ldiagatangle ldiagpadd /LTO ldiagpointdef - TO@ANGLE /LTO@ANGLE ldiagangledef - - CTR /LMID ldiagpointdef - 0 0 1 ft FANG 180 dg add ldiagatangle - 0 0 1 ft TANG 180 dg add ldiagatangle - ldiagangleto /LMID@ANGLE ldiagangledef - - FROM LFROM LMID LTO TO - - % (leaving ldiagvhlinepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop -} def - -% farr tarr { from } { to } xindent zindent radius ldiagvhcurvepath - -/ldiagvhcurvepath -{ - % (entering ldiagvhcurvepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop - /radius exch def - /zindent exch def - /xindent exch def - cvlit /to exch def - cvlit /from exch def - /toarrowlength exch def - /fromarrowlength exch def - - /CTR [ from (CTR) ldiagdolabel pop to (CTR) ldiagdolabel exch pop ] cvx def - /FANG [ from (CTR) ldiagdolabel CTR ldiagangleto ] cvx def - /TANG [ to (CTR) ldiagdolabel CTR ldiagangleto ] cvx def - - from (CTR) ldiagdolabel FANG from (CIRCUM) ldiagdolabel ldiagpadd - 0 0 fromarrowlength FANG ldiagatangle ldiagpadd /FROM ldiagpointdef - FANG /FROM@ANGLE ldiagangledef - - to (CTR) ldiagdolabel TANG to (CIRCUM) ldiagdolabel ldiagpadd - 0 0 toarrowlength TANG ldiagatangle ldiagpadd /TO ldiagpointdef - TANG 180 dg add /TO@ANGLE ldiagangledef - - /FDIST [ FROM CTR ldiagdistance ] cvx def - /TDIST [ TO CTR ldiagdistance ] cvx def - /RADIUS [ radius FDIST TDIST ldiagmin ldiagmin ] cvx def - /XINDENT [ xindent FDIST RADIUS sub ldiagmin ] cvx def - /ZINDENT [ zindent TDIST RADIUS sub ldiagmin ] cvx def - - FROM 0 0 XINDENT FANG ldiagatangle ldiagpadd /LFROM ldiagpointdef - FROM@ANGLE /LFROM@ANGLE ldiagangledef - TO 0 0 ZINDENT TANG ldiagatangle ldiagpadd /LTO ldiagpointdef - TO@ANGLE /LTO@ANGLE ldiagangledef - - /FCTR [ CTR 0 0 RADIUS FROM@ANGLE 180 dg add ldiagatangle ldiagpadd ] cvx def - /TCTR [ CTR 0 0 RADIUS TO@ANGLE ldiagatangle ldiagpadd ] cvx def - /XCTR [ CTR 0 0 RADIUS FROM@ANGLE 180 dg add ldiagatangle ldiagpadd - 0 0 RADIUS TO@ANGLE ldiagatangle ldiagpadd ] cvx def - XCTR 0 0 RADIUS XCTR CTR ldiagangleto ldiagatangle ldiagpadd - /LMID ldiagpointdef - FCTR TCTR ldiagangleto /LMID@ANGLE ldiagangledef - - FROM LFROM FCTR - {[XCTR clockwise]} {} {} {} {} {[XCTR]} {[XCTR clockwise]} {[XCTR]} - FCTR TCTR ldiagangleto ldiagquadcase - TCTR LTO TO - - % (leaving ldiagvhcurvepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop -} def - -% farr tarr { from } { to } xindent zindent ldiaghvlinepath - -/ldiaghvlinepath -{ - % (entering ldiaghvlinepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop - /zindent exch def - /xindent exch def - cvlit /to exch def - cvlit /from exch def - /toarrowlength exch def - /fromarrowlength exch def - - /CTR [ to (CTR) ldiagdolabel pop from (CTR) ldiagdolabel exch pop ] cvx def - /FANG [ from (CTR) ldiagdolabel CTR ldiagangleto ] cvx def - /TANG [ to (CTR) ldiagdolabel CTR ldiagangleto ] cvx def - - from (CTR) ldiagdolabel FANG from (CIRCUM) ldiagdolabel ldiagpadd - 0 0 fromarrowlength FANG ldiagatangle ldiagpadd /FROM ldiagpointdef - FANG /FROM@ANGLE ldiagangledef - - to (CTR) ldiagdolabel TANG to (CIRCUM) ldiagdolabel ldiagpadd - 0 0 toarrowlength TANG ldiagatangle ldiagpadd /TO ldiagpointdef - TANG 180 dg add /TO@ANGLE ldiagangledef - - /FDIST [ FROM CTR ldiagdistance ] cvx def - /TDIST [ TO CTR ldiagdistance ] cvx def - /XINDENT [ xindent FDIST ldiagmin ] cvx def - /ZINDENT [ zindent TDIST ldiagmin ] cvx def - - FROM 0 0 XINDENT FANG ldiagatangle ldiagpadd /LFROM ldiagpointdef - FROM@ANGLE /LFROM@ANGLE ldiagangledef - TO 0 0 ZINDENT TANG ldiagatangle ldiagpadd /LTO ldiagpointdef - TO@ANGLE /LTO@ANGLE ldiagangledef - - CTR /LMID ldiagpointdef - 0 0 1 ft FANG 180 dg add ldiagatangle - 0 0 1 ft TANG 180 dg add ldiagatangle ldiagangleto - /LMID@ANGLE ldiagangledef - - FROM LFROM LMID LTO TO - - % (leaving ldiaghvlinepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop -} def - -% farr tarr { from } { to } xindent zindent radius ldiaghvcurvepath - -/ldiaghvcurvepath -{ - % (entering ldiaghvcurvepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop - /radius exch def - /zindent exch def - /xindent exch def - cvlit /to exch def - cvlit /from exch def - /toarrowlength exch def - /fromarrowlength exch def - - /CTR [ to (CTR) ldiagdolabel pop from (CTR) ldiagdolabel exch pop ] cvx def - /FANG [ from (CTR) ldiagdolabel CTR ldiagangleto ] cvx def - /TANG [ to (CTR) ldiagdolabel CTR ldiagangleto ] cvx def - - from (CTR) ldiagdolabel FANG from (CIRCUM) ldiagdolabel ldiagpadd - 0 0 fromarrowlength FANG ldiagatangle ldiagpadd /FROM ldiagpointdef - FANG /FROM@ANGLE ldiagangledef - - to (CTR) ldiagdolabel TANG to (CIRCUM) ldiagdolabel ldiagpadd - 0 0 toarrowlength TANG ldiagatangle ldiagpadd /TO ldiagpointdef - TANG 180 dg add /TO@ANGLE ldiagangledef - - /FDIST [ FROM CTR ldiagdistance ] cvx def - /TDIST [ TO CTR ldiagdistance ] cvx def - /RADIUS [ radius FDIST TDIST ldiagmin ldiagmin ] cvx def - /XINDENT [ xindent FDIST RADIUS sub ldiagmin ] cvx def - /ZINDENT [ zindent TDIST RADIUS sub ldiagmin ] cvx def - FROM 0 0 XINDENT FANG ldiagatangle ldiagpadd /LFROM ldiagpointdef - FROM@ANGLE /LFROM@ANGLE ldiagangledef - TO 0 0 ZINDENT TANG ldiagatangle ldiagpadd /LTO ldiagpointdef - TO@ANGLE /LTO@ANGLE ldiagangledef - - /FCTR [ CTR 0 0 RADIUS FROM@ANGLE 180 dg add ldiagatangle ldiagpadd ] cvx def - /TCTR [ CTR 0 0 RADIUS TO@ANGLE ldiagatangle ldiagpadd ] cvx def - /XCTR [ CTR 0 0 RADIUS FROM@ANGLE 180 dg add ldiagatangle ldiagpadd - 0 0 RADIUS TO@ANGLE ldiagatangle ldiagpadd ] cvx def - XCTR 0 0 RADIUS XCTR CTR ldiagangleto ldiagatangle ldiagpadd - /LMID ldiagpointdef - FCTR TCTR ldiagangleto /LMID@ANGLE ldiagangledef - - FROM LFROM FCTR - {[XCTR]} {} {} {} {} {[XCTR clockwise]} {[XCTR]} {[XCTR clockwise]} - FCTR TCTR ldiagangleto ldiagquadcase - TCTR LTO TO - - % (leaving ldiaghvcurvepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop -} def - -% farr tarr { from } { to } xindent zindent bias ldiaglvrlinepath - -/ldiaglvrlinepath -{ - % (entering ldiaglvrlinepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop - /bias exch def - /zindent exch def - /xindent exch def - cvlit /to exch def - cvlit /from exch def - /toarrowlength exch def - /fromarrowlength exch def - - from (CTR) ldiagdolabel 180 dg from (CIRCUM) ldiagdolabel ldiagpadd - 0 0 fromarrowlength 180 dg ldiagatangle ldiagpadd /FROM ldiagpointdef - 180 dg /FROM@ANGLE ldiagangledef - - to (CTR) ldiagdolabel 180 dg to (CIRCUM) ldiagdolabel ldiagpadd - 0 0 toarrowlength 180 dg ldiagatangle ldiagpadd /TO ldiagpointdef - 0 dg /TO@ANGLE ldiagangledef - - /XLEFT [ FROM pop TO pop ldiagmin bias sub ] cvx def - XLEFT FROM exch pop /P1 ldiagpointdef - XLEFT TO exch pop /P2 ldiagpointdef - /VERT [ P1 P2 ldiagangleto ] cvx def - P1 P1 0 0 1 ft 180 dg ldiagatangle ldiagpadd 0 0 1 ft VERT ldiagatangle - ldiagpadd ldiagangleto /P1@ANGLE ldiagangledef - P2 P2 0 0 1 ft 0 dg ldiagatangle ldiagpadd 0 0 1 ft VERT ldiagatangle - ldiagpadd ldiagangleto /P2@ANGLE ldiagangledef - - P1 0.5 ldiagpmul P2 0.5 ldiagpmul ldiagpadd /LMID ldiagpointdef - VERT /LMID@ANGLE ldiagangledef - - /XINDENT [ xindent FROM P1 ldiagdistance ldiagmin ] cvx def - /ZINDENT [ zindent P2 TO ldiagdistance ldiagmin ] cvx def - XINDENT 0 FROM ldiagpsub /LFROM ldiagpointdef - 180 dg /LFROM@ANGLE ldiagangledef - ZINDENT 0 TO ldiagpsub /LTO ldiagpointdef - 0 dg /LTO@ANGLE ldiagangledef - - FROM LFROM P1 LMID P2 LTO TO - - % (leaving ldiaglvrlinepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop -} def - -% farr tarr { from } { to } xindent zindent bias radius ldiaglvrcurvepath - -/ldiaglvrcurvepath -{ - % (entering ldiaglvrcurvepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop - /radius exch def - /bias exch def - /zindent exch def - /xindent exch def - cvlit /to exch def - cvlit /from exch def - /toarrowlength exch def - /fromarrowlength exch def - - from (CTR) ldiagdolabel 180 dg from (CIRCUM) ldiagdolabel ldiagpadd 0 0 - fromarrowlength 180 dg ldiagatangle ldiagpadd /FROM ldiagpointdef - 180 dg /FROM@ANGLE ldiagangledef - to (CTR) ldiagdolabel 180 dg to (CIRCUM) ldiagdolabel ldiagpadd 0 0 - toarrowlength 180 dg ldiagatangle ldiagpadd /TO ldiagpointdef - 0 dg /TO@ANGLE ldiagangledef - /XLEFT [ FROM pop TO pop ldiagmin bias sub ] cvx def - /XP1 [ XLEFT FROM exch pop ] cvx def - /XP2 [ XLEFT TO exch pop ] cvx def - /VERT [ XP1 XP2 ldiagangleto ] cvx def - XP1 0.5 ldiagpmul XP2 0.5 ldiagpmul ldiagpadd /LMID ldiagpointdef - VERT /LMID@ANGLE ldiagangledef - /XINDENT [ xindent FROM XP1 ldiagdistance ldiagmin ] cvx def - /ZINDENT [ zindent XP2 TO ldiagdistance ldiagmin ] cvx def - XINDENT 0 FROM ldiagpsub /LFROM ldiagpointdef - 180 dg /LFROM@ANGLE ldiagangledef - ZINDENT 0 TO ldiagpsub /LTO ldiagpointdef - 0 dg /LTO@ANGLE ldiagangledef - /RADIUS [ radius XP1 XP2 ldiagdistance 2 div ldiagmin ] cvx def - /XP1PRE [ XP1 0 0 RADIUS 0 dg 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 0 dg ldiagatangle ldiagpadd ] cvx def - /XP2CTR [ XP2PRE 0 0 RADIUS 0 dg ldiagatangle ldiagpadd ] cvx def - XP2CTR 0 0 RADIUS XP2CTR XP2 ldiagangleto ldiagatangle ldiagpadd - /P2 ldiagpointdef - XP2PRE XP2POST ldiagangleto /P2@ANGLE ldiagangledef - FROM LFROM XP1PRE - { } { [XP1CTR] P1 [XP1CTR] } { } { [XP1CTR clockwise] P1 [XP1CTR clockwise] } - { } { } { } { } VERT round ldiagquadcase - XP1POST LMID XP2PRE - { } { [XP2CTR] P2 [XP2CTR] } { } { [XP2CTR clockwise] P2 [XP2CTR clockwise] } - { } { } { } { } VERT round ldiagquadcase - XP2POST LTO TO - - % (leaving ldiaglvrcurvepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop -} def - -% farr tarr { from } { to } xindent zindent bias ldiagrvllinepath - -/ldiagrvllinepath -{ - % (entering ldiagrvllinepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop - /bias exch def - /zindent exch def - /xindent exch def - cvlit /to exch def - cvlit /from exch def - /toarrowlength exch def - /fromarrowlength exch def - - from (CTR) ldiagdolabel 0 dg from (CIRCUM) ldiagdolabel ldiagpadd - 0 0 fromarrowlength 0 dg ldiagatangle ldiagpadd /FROM ldiagpointdef - 0 dg /FROM@ANGLE ldiagangledef - to (CTR) ldiagdolabel 0 dg to (CIRCUM) ldiagdolabel ldiagpadd - 0 0 toarrowlength 0 dg ldiagatangle ldiagpadd /TO ldiagpointdef - 180 dg /TO@ANGLE ldiagangledef - /XRIGHT [ FROM pop TO pop ldiagmax bias add ] cvx def - XRIGHT FROM exch pop /P1 ldiagpointdef - XRIGHT TO exch pop /P2 ldiagpointdef - /VERT [ P1 P2 ldiagangleto ] cvx def - P1 P1 0 0 1 ft 0 dg ldiagatangle ldiagpadd 0 0 1 ft VERT ldiagatangle - ldiagpadd ldiagangleto /P1@ANGLE ldiagangledef - P2 P2 0 0 1 ft 180 dg ldiagatangle ldiagpadd 0 0 1 ft VERT ldiagatangle - ldiagpadd ldiagangleto /P2@ANGLE ldiagangledef - P1 0.5 ldiagpmul P2 0.5 ldiagpmul ldiagpadd /LMID ldiagpointdef - VERT /LMID@ANGLE ldiagangledef - /XINDENT [ xindent FROM P1 ldiagdistance ldiagmin ] cvx def - /ZINDENT [ zindent P2 TO ldiagdistance ldiagmin ] cvx def - FROM XINDENT 0 ldiagpadd /LFROM ldiagpointdef - 0 dg /LFROM@ANGLE ldiagangledef - TO ZINDENT 0 ldiagpadd /LTO ldiagpointdef - 180 dg /LTO@ANGLE ldiagangledef - FROM LFROM P1 LMID P2 LTO TO - - % (leaving ldiagrvllinepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop -} def - - -% farr tarr { from } { to } xindent zindent bias radius ldiagrvlcurvepath - -/ldiagrvlcurvepath -{ - % (entering ldiagrvlcurvepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop - /radius exch def - /bias exch def - /zindent exch def - /xindent exch def - cvlit /to exch def - cvlit /from exch def - /toarrowlength exch def - /fromarrowlength exch def - - from (CTR) ldiagdolabel 0 dg from (CIRCUM) ldiagdolabel ldiagpadd - 0 0 fromarrowlength 0 dg ldiagatangle ldiagpadd /FROM ldiagpointdef - 0 dg /FROM@ANGLE ldiagangledef - to (CTR) ldiagdolabel 0 dg to (CIRCUM) ldiagdolabel ldiagpadd - 0 0 toarrowlength 0 dg ldiagatangle ldiagpadd /TO ldiagpointdef - 180 dg /TO@ANGLE ldiagangledef - /XRIGHT [ FROM pop TO pop ldiagmax bias add ] cvx def - /XP1 [ XRIGHT FROM exch pop ] cvx def - /XP2 [ XRIGHT TO exch pop ] cvx def - /VERT [ XP1 XP2 ldiagangleto ] cvx def - XP1 0.5 ldiagpmul XP2 0.5 ldiagpmul ldiagpadd /LMID ldiagpointdef - VERT /LMID@ANGLE ldiagangledef - /XINDENT [ xindent FROM XP1 ldiagdistance ldiagmin ] cvx def - /ZINDENT [ zindent XP2 TO ldiagdistance ldiagmin ] cvx def - FROM XINDENT 0 ldiagpadd /LFROM ldiagpointdef - 0 dg /LFROM@ANGLE ldiagangledef - TO ZINDENT 0 ldiagpadd /LTO ldiagpointdef - 180 dg /LTO@ANGLE ldiagangledef - /RADIUS [ radius XP1 XP2 ldiagdistance 0.5 mul ldiagmin ] cvx def - /XP1PRE [ XP1 0 0 RADIUS 180 dg 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 180 dg ldiagatangle ldiagpadd ] cvx def - /XP2CTR [ XP2PRE 0 0 RADIUS 180 dg ldiagatangle ldiagpadd ] cvx def - XP2CTR 0 0 RADIUS XP2CTR XP2 ldiagangleto ldiagatangle ldiagpadd - /P2 ldiagpointdef - XP2PRE XP2POST ldiagangleto /P2@ANGLE ldiagangledef - FROM LFROM XP1PRE - {} {[XP1CTR clockwise] P1 [XP1CTR clockwise]} {} {[XP1CTR] P1 [XP1CTR]} - {} {} {} {} VERT round ldiagquadcase - XP1POST LMID XP2PRE - {} {[XP2CTR clockwise] P2 [XP2CTR clockwise]} {} {[XP2CTR] P2 [XP2CTR]} - {} {} {} {} VERT round ldiagquadcase - XP2POST LTO TO - - % (leaving ldiagrvlcurvepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop -} def - -% farr tarr { from } { to } xindent zindent hfrac hbias ldiaghvhlinepath - -/ldiaghvhlinepath % still to do -{ - % (entering ldiaghvhlinepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop - /hbias exch def - /hfrac exch def - /zindent exch def - /xindent exch def - cvlit /to exch def - cvlit /from exch def - /toarrowlength exch def - /fromarrowlength exch def - - /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 - FROM 0 0 BIAS FRDIRN ldiagatangle ldiagpadd /P1 ldiagpointdef - P1 pop TO exch pop /P2 ldiagpointdef - P1 0.5 ldiagpmul P2 0.5 ldiagpmul ldiagpadd /LMID ldiagpointdef - P1 P2 ldiagangleto /LMID@ANGLE ldiagangledef - /XINDENT [ xindent FROM P1 ldiagdistance ldiagmin ] cvx def - /ZINDENT [ zindent P2 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 - FROM LFROM P1 LMID P2 LTO TO - - % (leaving ldiaghvhlinepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop -} def - - -% farr tarr { from } { to } xindent zindent hfrac hbias radius ldiaghvhcurvepath - -/ldiaghvhcurvepath % still to do -{ - % (entering ldiaghvhcurvepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop - /radius exch def - /hbias exch def - /hfrac exch def - /zindent exch def - /xindent exch def - cvlit /to exch def - cvlit /from exch def - /toarrowlength exch def - /fromarrowlength exch def - - /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 - - % (leaving ldiaghvhcurvepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop -} def - -% farr tarr { from } { to } xindent zindent hfrac hbias ldiagvhvlinepath - -/ldiagvhvlinepath % still to do -{ - % (entering ldiagvhvlinepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop - /hbias exch def - /hfrac exch def - /zindent exch def - /xindent exch def - cvlit /to exch def - cvlit /from exch def - /toarrowlength exch def - /fromarrowlength exch def - - /FRDIRN [ { 90 dg } { 270 dg } { 270 dg } { 0 dg } - { 90 dg } { 270 dg } { 270 dg } { 90 dg } - from (CTR) ldiagdolabel to (CTR) ldiagdolabel - ldiagangleto ldiagquadcase ] cvx def - /TODIRN [ FRDIRN 180 dg sub ] 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 exch pop TO exch pop sub abs hfrac mul hbias ft add ] cvx def - FROM 0 0 BIAS FRDIRN ldiagatangle ldiagpadd /P1 ldiagpointdef - TO pop P1 exch pop /P2 ldiagpointdef - P1 0.5 ldiagpmul P2 0.5 ldiagpmul ldiagpadd /LMID ldiagpointdef - P1 P2 ldiagangleto /LMID@ANGLE ldiagangledef - /XINDENT [ xindent FROM P1 ldiagdistance ldiagmin ] cvx def - /ZINDENT [ zindent P2 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 - FROM LFROM P1 LMID P2 LTO TO - - % (leaving ldiagvhvlinepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop -} def - - -% farr tarr { from } { to } xindent zindent hfrac hbias radius ldiagvhvcurvepath - -/ldiagvhvcurvepath % still to do -{ - % (entering ldiagvhvcurvepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop - /radius exch def - /hbias exch def - /hfrac exch def - /zindent exch def - /xindent exch def - cvlit /to exch def - cvlit /from exch def - /toarrowlength exch def - /fromarrowlength exch def - - /FRDIRN [ { 90 dg } { 270 dg } { 270 dg } { 0 dg } - { 90 dg } { 270 dg } { 270 dg } { 90 dg } - from (CTR) ldiagdolabel to (CTR) ldiagdolabel - ldiagangleto ldiagquadcase ] cvx def - /TODIRN [ FRDIRN 180 dg sub ] 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 exch pop TO exch pop sub abs hfrac mul hbias add ] cvx def - /XP1 [ FROM 0 0 BIAS FRDIRN ldiagatangle ldiagpadd ] cvx def - /XP2 [ TO pop XP1 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 - FRDIRN VERT sub 90 eq - { /P1GO [ clockwise ] cvx def /P2GO [ anticlockwise ] cvx def } - { /P1GO [ anticlockwise ] cvx def /P2GO [ clockwise ] cvx def } - ifelse - FROM LFROM - XP1PRE [XP1CTR P1GO] P1 [XP1CTR P1GO] XP1POST - LMID - XP2PRE [XP2CTR P2GO] P2 [XP2CTR P2GO] XP2POST - LTO TO - - - % (leaving ldiagvhvcurvepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop -} def - -% farr tarr { from } { to } xindent zindent bias fbias tbias ldiagdwraplinepath - -/ldiagdwraplinepath -{ - % (entering ldiagdwraplinepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop - /tbias exch def - /fbias exch def - /bias exch def - /zindent exch def - /xindent exch def - cvlit /to exch def - cvlit /from exch def - /toarrowlength exch def - /fromarrowlength exch def - - /DIRN [ from (CTR) ldiagdolabel pop to (CTR) ldiagdolabel pop - lt { 180 dg } { 0 dg } ifelse ] cvx def - from (CTR) ldiagdolabel DIRN from (CIRCUM) ldiagdolabel ldiagpadd 0 0 - fromarrowlength DIRN ldiagatangle ldiagpadd /FROM ldiagpointdef - DIRN /FROM@ANGLE ldiagangledef - to (CTR) ldiagdolabel DIRN 180 dg add to (CIRCUM) ldiagdolabel ldiagpadd - 0 0 toarrowlength DIRN 180 dg add ldiagatangle ldiagpadd /TO ldiagpointdef - DIRN /TO@ANGLE ldiagangledef - FROM 0 0 fbias 0 ldiagmax DIRN ldiagatangle ldiagpadd /P1 ldiagpointdef - DIRN 180 dg eq { 225 dg } { -45 dg } ifelse /P1@ANGLE ldiagangledef - TO 0 0 tbias 0 ldiagmax DIRN 180 dg add ldiagatangle ldiagpadd - /P4 ldiagpointdef - DIRN 180 dg eq { 135 dg } { 45 dg } ifelse /P4@ANGLE ldiagangledef - /YC [ from (CTR) ldiagdolabel 270 dg from (CIRCUM) ldiagdolabel ldiagpadd - exch pop to (CTR) ldiagdolabel 270 dg to (CIRCUM) ldiagdolabel ldiagpadd - exch pop ldiagmin bias 0 ldiagmax sub ] cvx def - P1 pop YC /P2 ldiagpointdef - P4@ANGLE 180 dg sub /P2@ANGLE ldiagangledef - P4 pop YC /P3 ldiagpointdef - P1@ANGLE 180 dg sub /P3@ANGLE ldiagangledef - /XINDENT [ xindent FROM P1 ldiagdistance ldiagmin ] cvx def - FROM 0 0 XINDENT DIRN ldiagatangle ldiagpadd /LFROM ldiagpointdef - FROM@ANGLE /LFROM@ANGLE ldiagangledef - /ZINDENT [ zindent TO P4 ldiagdistance ldiagmin ] cvx def - TO 0 0 ZINDENT DIRN 180 dg add ldiagatangle ldiagpadd /LTO ldiagpointdef - TO@ANGLE /LTO@ANGLE ldiagangledef - P2 0.5 ldiagpmul P3 0.5 ldiagpmul ldiagpadd /LMID ldiagpointdef - DIRN 180 dg sub /LMID@ANGLE ldiagangledef - FROM P1 P2 P3 P4 TO - - % (leaving ldiagdwraplinepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop -} def - -% farr tarr { from } { to } xindent zindent bias fbias tbias radius -% ldiagdwrapcurvepath - -/ldiagdwrapcurvepath -{ - % (entering ldiagdwrapcurvepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop - /radius exch def - /tbias exch def - /fbias exch def - /bias exch def - /zindent exch def - /xindent exch def - cvlit /to exch def - cvlit /from exch def - /toarrowlength exch def - /fromarrowlength exch def - - /DIRN [ from (CTR) ldiagdolabel pop to (CTR) ldiagdolabel pop lt - { 180 dg } { 0 dg } ifelse ] cvx def - /CLOCK [ from (CTR) ldiagdolabel pop to (CTR) ldiagdolabel pop lt - { anticlockwise } { clockwise } ifelse ] cvx def - from (CTR) ldiagdolabel DIRN from (CIRCUM) ldiagdolabel ldiagpadd - 0 0 fromarrowlength DIRN ldiagatangle ldiagpadd /FROM ldiagpointdef - DIRN /FROM@ANGLE ldiagangledef - to (CTR) ldiagdolabel DIRN 180 dg add to (CIRCUM) ldiagdolabel ldiagpadd - 0 0 toarrowlength DIRN 180 dg add ldiagatangle ldiagpadd /TO ldiagpointdef - DIRN /TO@ANGLE ldiagangledef - /XP1 [ FROM 0 0 fbias 0 ldiagmax DIRN ldiagatangle ldiagpadd ] cvx def - /XP4 [ TO 0 0 tbias 0 ldiagmax DIRN 180 dg add ldiagatangle ldiagpadd ] cvx def - /YC [ from (CTR) ldiagdolabel 270 dg from (CIRCUM) ldiagdolabel ldiagpadd - exch pop to (CTR) ldiagdolabel 270 dg to (CIRCUM) ldiagdolabel ldiagpadd - exch pop ldiagmin bias 0 ldiagmax sub ] cvx def - /XP2 [ XP1 pop YC ] cvx def - /XP3 [ XP4 pop YC ] cvx def - /RP1 [ radius XP1 FROM ldiagdistance XP1 XP2 ldiagdistance 2 div - ldiagmin ldiagmin ] cvx def - /XP1PRE [ XP1 0 0 RP1 XP1 FROM ldiagangleto ldiagatangle ldiagpadd ] cvx def - /XP1POST [ XP1 0 0 RP1 XP1 XP2 ldiagangleto ldiagatangle ldiagpadd ] cvx def - /XP1CTR [ XP1PRE 0 0 RP1 XP1 XP2 ldiagangleto ldiagatangle ldiagpadd ] cvx def - XP1CTR 0 0 RP1 XP1CTR XP1 ldiagangleto ldiagatangle ldiagpadd /P1 ldiagpointdef - XP1CTR P1 ldiagangleto DIRN add 90 dg sub /P1@ANGLE ldiagangledef - /RP2 [ radius XP1 XP2 ldiagdistance 2 div XP2 XP3 ldiagdistance 2 div - ldiagmin ldiagmin ] cvx def - /XP2PRE [ XP2 0 0 RP2 XP2 XP1 ldiagangleto ldiagatangle ldiagpadd ] cvx def - /XP2POST [ XP2 0 0 RP2 XP2 XP3 ldiagangleto ldiagatangle ldiagpadd ] cvx def - /XP2CTR [ XP2PRE 0 0 RP2 XP2 XP3 ldiagangleto ldiagatangle ldiagpadd ] cvx def - XP2CTR 0 0 RP2 XP2CTR XP2 ldiagangleto ldiagatangle ldiagpadd /P2 ldiagpointdef - XP2CTR P2 ldiagangleto DIRN add 90 dg sub /P2@ANGLE ldiagangledef - /RP3 [ radius XP2 XP3 ldiagdistance 2 div XP3 XP4 ldiagdistance 2 div - ldiagmin ldiagmin ] cvx def - /XP3PRE [ XP3 0 0 RP3 XP3 XP2 ldiagangleto ldiagatangle ldiagpadd ] cvx def - /XP3POST [ XP3 0 0 RP3 XP3 XP4 ldiagangleto ldiagatangle ldiagpadd ] cvx def - /XP3CTR [ XP3PRE 0 0 RP3 XP3 XP4 ldiagangleto ldiagatangle ldiagpadd ] cvx def - XP3CTR 0 0 RP3 XP3CTR XP3 ldiagangleto ldiagatangle ldiagpadd /P3 ldiagpointdef - XP3CTR P3 ldiagangleto DIRN add 90 dg sub /P3@ANGLE ldiagangledef - /RP4 [ radius XP4 XP3 ldiagdistance 2 div XP4 TO ldiagdistance - ldiagmin ldiagmin ] cvx def - /XP4PRE [ XP4 0 0 RP4 XP4 XP3 ldiagangleto ldiagatangle ldiagpadd ] cvx def - /XP4POST [ XP4 0 0 RP4 XP4 TO ldiagangleto ldiagatangle ldiagpadd ] cvx def - /XP4CTR [ XP4PRE 0 0 RP4 XP4 TO ldiagangleto ldiagatangle ldiagpadd ] cvx def - XP4CTR 0 0 RP4 XP4CTR XP4 ldiagangleto ldiagatangle ldiagpadd /P4 ldiagpointdef - XP4CTR P4 ldiagangleto DIRN add 90 dg sub /P4@ANGLE ldiagangledef - /XINDENT [ xindent FROM XP1PRE ldiagdistance ldiagmin ] cvx def - FROM 0 0 XINDENT DIRN ldiagatangle ldiagpadd /LFROM ldiagpointdef - FROM@ANGLE /LFROM@ANGLE ldiagangledef - XP2 0.5 ldiagpmul XP3 0.5 ldiagpmul ldiagpadd /LMID ldiagpointdef - DIRN 180 dg sub /LMID@ANGLE ldiagangledef - /ZINDENT [ zindent TO XP4POST ldiagdistance ldiagmin ] cvx def - TO 0 0 ZINDENT DIRN 180 dg add ldiagatangle ldiagpadd /LTO ldiagpointdef - TO@ANGLE /LTO@ANGLE ldiagangledef - FROM LFROM - XP1PRE [XP1CTR CLOCK] XP1POST - XP2PRE [XP2CTR CLOCK] XP2POST - LMID - XP3PRE [XP3CTR CLOCK] XP3POST - XP4PRE [XP4CTR CLOCK] XP4POST - LTO TO - - % (leaving ldiagdwrapcurvepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop -} def - -% farr tarr { from } { to } xindent zindent bias fbias tbias ldiaguwraplinepath - -/ldiaguwraplinepath -{ - % (entering ldiaguwraplinepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop - /tbias exch def - /fbias exch def - /bias exch def - /zindent exch def - /xindent exch def - cvlit /to exch def - cvlit /from exch def - /toarrowlength exch def - /fromarrowlength exch def - - /DIRN [ from (CTR) ldiagdolabel pop to (CTR) ldiagdolabel pop lt - { 180 dg } { 0 dg } ifelse ] cvx def - from (CTR) ldiagdolabel DIRN from (CIRCUM) ldiagdolabel ldiagpadd - 0 0 fromarrowlength DIRN ldiagatangle ldiagpadd /FROM ldiagpointdef - DIRN /FROM@ANGLE ldiagangledef - to (CTR) ldiagdolabel DIRN 180 dg add to (CIRCUM) ldiagdolabel ldiagpadd - 0 0 toarrowlength DIRN 180 dg add ldiagatangle ldiagpadd /TO ldiagpointdef - DIRN /TO@ANGLE ldiagangledef - FROM 0 0 fbias 0 ldiagmax DIRN ldiagatangle ldiagpadd /P1 ldiagpointdef - DIRN 180 dg eq { 135 dg } { 45 dg } ifelse /P1@ANGLE ldiagangledef - TO 0 0 tbias 0 ldiagmax DIRN 180 dg add ldiagatangle ldiagpadd - /P4 ldiagpointdef - DIRN 180 dg eq { 225 dg } { -45 dg } ifelse /P4@ANGLE ldiagangledef - /YC [ from (CTR) ldiagdolabel 90 dg from (CIRCUM) ldiagdolabel ldiagpadd - exch pop to (CTR) ldiagdolabel 90 dg to (CIRCUM) ldiagdolabel ldiagpadd - exch pop ldiagmax bias 0 ldiagmax add ] cvx def - P1 pop YC /P2 ldiagpointdef - P4@ANGLE 180 dg sub /P2@ANGLE ldiagangledef - P4 pop YC /P3 ldiagpointdef - P1@ANGLE 180 dg sub /P3@ANGLE ldiagangledef - /XINDENT [ xindent FROM P1 ldiagdistance ldiagmin ] cvx def - FROM 0 0 XINDENT DIRN ldiagatangle ldiagpadd /LFROM ldiagpointdef - FROM@ANGLE /LFROM@ANGLE ldiagangledef - /ZINDENT [ zindent TO P4 ldiagdistance ldiagmin ] cvx def - TO 0 0 ZINDENT DIRN 180 dg add ldiagatangle ldiagpadd /LTO ldiagpointdef - TO@ANGLE /LTO@ANGLE ldiagangledef - P2 0.5 ldiagpmul P3 0.5 ldiagpmul ldiagpadd /LMID ldiagpointdef - DIRN 180 dg sub /LMID@ANGLE ldiagangledef - FROM P1 P2 P3 P4 TO - - % (leaving ldiaguwraplinepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop -} def - -% farr tarr { from } { to } xindent zindent bias fbias tbias radius -% ldiaguwrapcurvepath - -/ldiaguwrapcurvepath -{ - % (entering ldiaguwrapcurvepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop - /radius exch def - /tbias exch def - /fbias exch def - /bias exch def - /zindent exch def - /xindent exch def - cvlit /to exch def - cvlit /from exch def - /toarrowlength exch def - /fromarrowlength exch def - - /DIRN [ from (CTR) ldiagdolabel pop to (CTR) ldiagdolabel pop lt - { 180 dg } { 0 dg } ifelse ] cvx def - /CLOCK [ from (CTR) ldiagdolabel pop to (CTR) ldiagdolabel pop lt - { clockwise } { anticlockwise } ifelse ] cvx def - from (CTR) ldiagdolabel DIRN from (CIRCUM) ldiagdolabel ldiagpadd - 0 0 fromarrowlength DIRN ldiagatangle ldiagpadd /FROM ldiagpointdef - DIRN /FROM@ANGLE ldiagangledef - to (CTR) ldiagdolabel DIRN 180 dg add to (CIRCUM) ldiagdolabel ldiagpadd - 0 0 toarrowlength DIRN 180 dg add ldiagatangle ldiagpadd /TO ldiagpointdef - DIRN /TO@ANGLE ldiagangledef - /XP1 [ FROM 0 0 fbias 0 ldiagmax DIRN ldiagatangle ldiagpadd ] cvx def - /XP4 [ TO 0 0 tbias 0 ldiagmax DIRN 180 dg add ldiagatangle ldiagpadd ] cvx def - /YC [ from (CTR) ldiagdolabel 90 dg from (CIRCUM) ldiagdolabel ldiagpadd - exch pop to (CTR) ldiagdolabel 90 dg to (CIRCUM) ldiagdolabel ldiagpadd - exch pop ldiagmax bias 0 ldiagmax add ] cvx def - /XP2 [ XP1 pop YC ] cvx def - /XP3 [ XP4 pop YC ] cvx def - /RP1 [ radius XP1 FROM ldiagdistance XP1 XP2 ldiagdistance 2 div - ldiagmin ldiagmin ] cvx def - /XP1PRE [ XP1 0 0 RP1 XP1 FROM ldiagangleto ldiagatangle ldiagpadd ] cvx def - /XP1POST [ XP1 0 0 RP1 XP1 XP2 ldiagangleto ldiagatangle ldiagpadd ] cvx def - /XP1CTR [ XP1PRE 0 0 RP1 XP1 XP2 ldiagangleto ldiagatangle ldiagpadd ] cvx def - XP1CTR 0 0 RP1 XP1CTR XP1 ldiagangleto ldiagatangle ldiagpadd /P1 ldiagpointdef - XP1CTR P1 ldiagangleto DIRN add 90 dg add /P1@ANGLE ldiagangledef - /RP2 [ radius XP1 XP2 ldiagdistance 2 div XP2 XP3 ldiagdistance 2 div - ldiagmin ldiagmin ] cvx def - /XP2PRE [ XP2 0 0 RP2 XP2 XP1 ldiagangleto ldiagatangle ldiagpadd ] cvx def - /XP2POST [ XP2 0 0 RP2 XP2 XP3 ldiagangleto ldiagatangle ldiagpadd ] cvx def - /XP2CTR [ XP2PRE 0 0 RP2 XP2 XP3 ldiagangleto ldiagatangle ldiagpadd ] cvx def - XP2CTR 0 0 RP2 XP2CTR XP2 ldiagangleto ldiagatangle ldiagpadd /P2 ldiagpointdef - XP2CTR P2 ldiagangleto DIRN add 90 dg add /P2@ANGLE ldiagangledef - /RP3 [ radius XP2 XP3 ldiagdistance 2 div XP3 XP4 ldiagdistance 2 div - ldiagmin ldiagmin ] cvx def - /XP3PRE [ XP3 0 0 RP3 XP3 XP2 ldiagangleto ldiagatangle ldiagpadd ] cvx def - /XP3POST [ XP3 0 0 RP3 XP3 XP4 ldiagangleto ldiagatangle ldiagpadd ] cvx def - /XP3CTR [ XP3PRE 0 0 RP3 XP3 XP4 ldiagangleto ldiagatangle ldiagpadd ] cvx def - XP3CTR 0 0 RP3 XP3CTR XP3 ldiagangleto ldiagatangle ldiagpadd /P3 ldiagpointdef - XP3CTR P3 ldiagangleto DIRN add 90 dg add /P3@ANGLE ldiagangledef - /RP4 [ radius XP4 XP3 ldiagdistance 2 div XP4 TO ldiagdistance - ldiagmin ldiagmin ] cvx def - /XP4PRE [ XP4 0 0 RP4 XP4 XP3 ldiagangleto ldiagatangle ldiagpadd ] cvx def - /XP4POST [ XP4 0 0 RP4 XP4 TO ldiagangleto ldiagatangle ldiagpadd ] cvx def - /XP4CTR [ XP4PRE 0 0 RP4 XP4 TO ldiagangleto ldiagatangle ldiagpadd ] cvx def - XP4CTR 0 0 RP4 XP4CTR XP4 ldiagangleto ldiagatangle ldiagpadd /P4 ldiagpointdef - XP4CTR P4 ldiagangleto DIRN add 90 dg add /P4@ANGLE ldiagangledef - /XINDENT [ xindent FROM XP1PRE ldiagdistance ldiagmin ] cvx def - FROM 0 0 XINDENT DIRN ldiagatangle ldiagpadd /LFROM ldiagpointdef - FROM@ANGLE /LFROM@ANGLE ldiagangledef - XP2 0.5 ldiagpmul XP3 0.5 ldiagpmul ldiagpadd /LMID ldiagpointdef - DIRN 180 dg sub /LMID@ANGLE ldiagangledef - /ZINDENT [ zindent TO XP4POST ldiagdistance ldiagmin ] cvx def - TO 0 0 ZINDENT DIRN 180 dg add ldiagatangle ldiagpadd /LTO ldiagpointdef - TO@ANGLE /LTO@ANGLE ldiagangledef - FROM LFROM - XP1PRE [XP1CTR CLOCK] XP1POST - XP2PRE [XP2CTR CLOCK] XP2POST - LMID - XP3PRE [XP3CTR CLOCK] XP3POST - XP4PRE [XP4CTR CLOCK] XP4POST - LTO TO - - % (leaving ldiaguwrapcurvepath) 0 ldiagdebugprint - % count ( stack size is) 1 ldiagdebugprint pop -} def - -% shape and labels of the @SolidArrowHead symbol -% - ldiagsolidarrowhead - -/ldiagsolidarrowhead -{ - 0 0 xsize ysize 0.5 mul 0 ysize -} def - -% shape and labels of the @OpenArrowHead symbol -% <pathwidth> ldiagopenarrowhead - -/ldiagopenarrowhead -{ - /pathwidth exch def - /PSW [ 0 0 ] cvx def - /PNW [ 0 ysize ] cvx def - /PE [ xsize ysize 0.5 mul ] cvx def - /REL [ 0 0 pathwidth PE PNW ldiagangleto 90 add ldiagatangle ] cvx def - /PNA [ 0 ysize 0.5 mul pathwidth 0.5 mul add ] cvx def - /PSA [ 0 ysize 0.5 mul pathwidth 0.5 mul sub ] cvx def - /PNI [ PNA PNA xsize 0 ldiagpadd PNW REL ldiagpadd - PE REL ldiagpadd ldiaglineintersect ] cvx def - /PSI [ 0 pathwidth PNI ldiagpsub ] cvx def - - PSW PE PNW PNI PNA PSA PSI PSW -} def - -% shape and labels of the @HalfOpenArrowHead symbol -% <pathwidth> ldiaghalfopenarrowhead - -/ldiaghalfopenarrowhead -{ - /pathwidth exch def - 0 0 - xsize ysize 0.5 mul - 0 ysize - xsize 0.3 mul ysize 0.5 mul pathwidth 0.5 mul add - 0 ysize 0.5 mul pathwidth 0.5 mul add - 0 ysize 0.5 mul pathwidth 0.5 mul sub - xsize 0.3 mul ysize 0.5 mul pathwidth 0.5 mul sub - 0 0 -} def - -% shape and labels of the @SolidCurvedArrowHead symbol -% - ldiagsolidcurvedarrowhead - -/ldiagsolidcurvedarrowhead -{ - 0 0 - [0 0 xsize ysize 0.5 mul ldiaglinebetween - xsize 0 xsize ysize ldiaglineintersect clockwise] - xsize ysize 0.5 mul - [xsize ysize 0.5 mul 0 ysize ldiaglinebetween - xsize 0 xsize ysize ldiaglineintersect clockwise] - 0 ysize -} def - -% shape and labels of the @OpenCurvedArrowHead symbol -% <pathwidth> ldiagopencurvedarrowhead - -/ldiagopencurvedarrowhead -{ - /pathwidth exch def - /LR [ 0 0 xsize ysize 0.5 mul ldiaglinebetween - xsize 0 xsize ysize ldiaglineintersect - ] cvx def - /UR [ xsize ysize 0.5 mul 0 ysize ldiaglinebetween - xsize 0 xsize ysize ldiaglineintersect - ] cvx def - /PW2 [ pathwidth 0.5 mul ] cvx def - /UMID [ - 0 ysize 0.5 mul PW2 add - xsize ysize 0.5 mul PW2 add - 0 ysize 0 0 1 ft UR 0 ysize ldiagangleto 90 add ldiagatangle - ldiagpadd 0 ysize ldiaglineintersect - ] cvx def - /LMID [ 0 pathwidth UMID ldiagpsub ] cvx def - 0 0 - [LR clockwise] - xsize ysize 0.5 mul - [UR clockwise] - 0 ysize - UMID - 0 ysize 0.5 mul PW2 add - 0 ysize 0.5 mul PW2 sub - LMID - 0 0 -} def - -% shape and labels of the @HalfOpenCurvedArrowHead symbol -% <pathwidth> ldiaghalfopencurvedarrowhead - -/ldiaghalfopencurvedarrowhead -{ - /pathwidth exch def - /LR [ 0 0 xsize ysize 0.5 mul ldiaglinebetween - xsize 0 xsize ysize ldiaglineintersect - ] cvx def - /UR [ xsize ysize 0.5 mul 0 ysize ldiaglinebetween - xsize 0 xsize ysize ldiaglineintersect - ] cvx def - /BR [ 0 0 LR 0 ysize UR ldiaglineintersect ] cvx def - /BRAD [ 0 0 BR ldiagdistance ] cvx def - /PW2 [ pathwidth 0.5 mul ] cvx def - /XDIST [ BRAD dup mul PW2 dup mul sub sqrt ] cvx def - /UMID [ BR XDIST PW2 ldiagpadd ] cvx def - /LMID [ BR XDIST 0 PW2 sub ldiagpadd ] cvx def - 0 0 - [LR clockwise] - xsize ysize 0.5 mul - [UR clockwise] - 0 ysize - [BR clockwise] - UMID - 0 ysize 0.5 mul PW2 add - 0 ysize 0.5 mul PW2 sub - LMID - [BR clockwise] - 0 0 -} def - -end -%%EndResource |