%!PS % This version 19:45 Sunday 14th April 2024 % Copyright Julian D. A. Wiseman 1988 to 2024. % This sofware is licensed under the GNU General Public License v3.0. % Permissions of this strong copyleft license are conditioned on making available complete source code of % licensed works and modifications, which include larger works using a licensed work, under the same license. % Copyright and license notices must be preserved. Contributors provide an express grant of patent rights. % For these purposes a change in the parameters of the code does not need to be released. Nor does any output: % not PDF; nor images of such a document. But it does include re-usable improvements to the body of the code. % Recommendation: move changed parameters to just above this line. % % % % % % % % % Essentials % % % % % % % % % /ParametersVersionDateTimeAdobeFormat (D:202404141945) def /Circlearrays [ [ (Quinta do Noval) (1970) (bot. The Wine Society) ] [ (Kopke) (1970) (bot. Dolamore) ] [ [(W) {-0.07 Kern} (arre)] (1970) (bot. Peatling & Cawdron) ] [ (Sandeman) (1970) [(bot. A) {-0.06 Kern} (very)] ] [ (Fonseca) (1970) (bot. Justerini & Brooks) ] ] def % /Circlearrays /Titles [ (N70) (K70) (W70) (S70) (F70) ] def % /Titles /Belowtitles [ (Wine Society) (Dolamore) (Peatling & Cawdron) [(A) {-0.04 Kern} (very)] (Justerini & Brooks) ] def % /Belowtitles /Names [ (JDAW) [(G) /uacute /edieresis (st ) /Ocircumflex /ntilde /egrave] (Guest Two) () ] def % /Names /LeftHanders [ (RMW) (SRG) (Simon G.) (HEG) (Helen G.) (CSD) (Chris D.) (JG) (Jeff G.) (ZDR) (Zak R.) (DWP) (Douglas P.) (LAB) (Lee B.) ] def /PaperType /A4 def % /A4 /A3 /USL = 8.5"x11", /USLegal = 8.5"x14", /Tabloid = 11"x17", [SmallerPts LargerPts] /TastingNotesPaperType /A4 def % If this is /USL then the distiller log is also on 8.5"x11", otherwise log on /A4 /ThePortForumIconPlacement /LowerNonWaterBox def % /None /ThePortForumIconTastingNotePlacement /LowerNonName def % /None /PDF_title (Placemats) def % Names PDF file; appears as tab name in browser, and in search results % Headers... are arrays of even length, alternately an item of PageOrdering, and the relevant compound string. /HeadersLeft [ 0 [(Boot & Flogger, T) {-0.08 Kern} (uesday 19) {SuperscriptOn} (th) {SuperscriptOff} ( November 2024)] ] def % /HeadersLeft /HeadersCenter [ 0 [(1970s)] ] def % /HeadersCenter /HeadersRight [ 0 [ (www) {-0.12 Kern} (.) {-0.12 Kern} (ThePortForum.com, ) % (www) {-0.08 Kern} (.) {-0.12 Kern} (W) {-0.08 Kern} (orldOf) {+0.12 Kern} (Port.de, ) (www) {-0.12 Kern} (.jdawiseman.com) ] ] def % /HeadersRight % Array, length a multiple of three: indented0-boolean, (Descriptor0), (http://URL0); indented1-boolean, (Descriptor1), (http://URL1); ... % Links for some restaurants and many Port houses at http://github.com/jdaw1/placemat/blob/main/PostScript/ExternalLinks_data.ps /ExternalLinks [ false (Thread on ThePortForum.com) (http://www.theportforum.com/viewtopic.php?t=00175&view=unread#unread) % false (Latest version this placemat) (http://www.jdawiseman.com/2024/ .pdf) % true (in list of placemats) (http://www.jdawiseman.com/papers/placemat/placemats_list.html#a2024MMDD) false (Boot & Flogger) (http://www.davy.co.uk/wine-bar/boot-and-flogger/) true [/ellipsis (OpenStreetMap)] (http://www.openstreetmap.org/node/534961998) true [/ellipsis (google.co.uk)] (http://goo.gl/maps/7NEiwAMEZpG2) true [/ellipsis (What3Words: cafe.humid.palace)] (http://map.what3words.com/cafe.humid.palace) true [/ellipsis (StreetMap.co.uk)] (http://www.streetmap.co.uk/map.srf?x=532409&y=180083&z=106&pc=SE1+1TA) true [/ellipsis (bing.com)] (http://www.bing.com/maps?where1=SE1+1TA) ] def % /ExternalLinks /CopyrightStatementPlacemats (Copyright 2024 Julian D. A. Wiseman of www.jdawiseman.com) def % % % % % % % % % % % % Non-Glasses Pages % % % % % % % % % % % % /VoteRecorders true def /CorkDisplayNumCopies 1 def /NeckTagsNumCopies 1 def /PrePourNumCopies Names length 12 ge {1} {0} ifelse def /PlaceNames false def /DecanterLabelsNumCopies 0 def /GlassesNumCopies 1 def /TastingNotePagesNumCopies 1 def /DecantingNotesNumCopies Circlearrays length 15 ge {1} {0} ifelse def /AccountsNumCopies Names length 8 ge {1} {0} ifelse def /StickyLabelsNumCopies 0 def /StickyLabelsTypes [0 1] def % 0 = 2x4 on A4; 1 = 5x13 on A4 /BottleWrapNumCopies 0 def % Activates BottleWrapSuppressOtherPageTypes /OneCircles false def % Activates OneCircleSuppressOtherPageTypes /Abovetitles [ Titles length {()} repeat ] def /Overtitles [ Titles length {()} repeat ] def /TitlesTastingNotes Titles def /TitlesVoteRecorder Titles def /TitlesDecantingNotes TitlesVoteRecorder def /TitlesCorkDisplay TitlesTastingNotes def /SubtitlesTastingNotes [ 0 1 Titles length 1 sub {dup Overtitles exch get dup length 0 gt {exch pop} {pop dup Belowtitles exch get dup length 0 gt {exch pop} {pop Abovetitles exch get} ifelse} ifelse} for ] def /SubtitlesVoteRecorder SubtitlesTastingNotes def /SubtitlesDecantingNotes SubtitlesVoteRecorder def /SubtitlesCorkDisplay SubtitlesTastingNotes def /CirclearraysTastingNotes Circlearrays def /CirclearraysVoteRecorder CirclearraysTastingNotes def /CirclearraysDecantingNotes CirclearraysVoteRecorder def /CirclearraysCorkDisplay CirclearraysDecantingNotes def /CirclearraysPrePour CirclearraysDecantingNotes def /CirclearraysNeckTags CirclearraysDecantingNotes def % Multiple copies? /CirclearraysNeckTags [ Circlearrays {[ exch aload pop [(Bottle #) {NeckTagsCopyNum 1 add}] ]} forall ] def /CirclearraysBottleWrap CirclearraysDecantingNotes def /CirclearraysStickyLabels CirclearraysDecantingNotes def /NamesTastingNotes Names def /NamesVoteRecorder Names def /NamesAccounts Names def /NamesStickyLabels Names def /NamesPlaceNames [ Names ] def % % % % % % % % % % % % % % % % % % % % % % % % Page Organisation and Page-Level Features % % % % % % % % % % % % % % % % % % % % % % % % % GlassesOnSheetsMaxPerSheet: 6 default, USLegal => 9; A3 or Tabloid => 13. For all on one sheet replace with "/GlassesOnSheetsMaxPerSheet 999 def". /GlassesOnSheetsMaxPerSheet 6 /PaperType load dup /A3 eq exch /Tabloid eq or {pop 15} if /PaperType load /USLegal eq {pop 9} if def /GlassesOnSheets [ % For a custom arrangement replace the next line with something of the form "[0 1 2 3] [4 5 6 7 8 9] [10 11 12 13]" % The code below spreads glasses evenly over the sheets, the sheets one glass larger being last. Replace "floor": with "ceiling" for larger sheets to be early; with "round" for them to be scattered. << /p Titles length GlassesOnSheetsMaxPerSheet div ceiling cvi /g 0 >> begin 0 1 p 1 sub {[exch p sub g Titles length sub exch div floor cvi {g /g g 1 add store} repeat]} for end ] def % /GlassesOnSheets /GlassesOnSheetsMaxPerTNSheet /TastingNotesPaperType load /PaperType load eq {GlassesOnSheetsMaxPerSheet} {7} ifelse def % just enough writing space for 8 TNs per page. /GlassesOnTastingNotePages [ % Consider "/GlassesOnTastingNotePages GlassesOnSheets def"; and see comment in GlassesOnSheets. << /p Titles length GlassesOnSheetsMaxPerTNSheet div ceiling cvi /g 0 >> begin 0 1 p 1 sub {[exch p sub g Titles length sub exch div floor cvi {g /g g 1 add store} repeat]} for end ] def % /GlassesOnTastingNotePages % Base styles: /RectangularDislocation /Diamonds /DiamondsPlus /Bespoke5 /Bespoke7 /Temple /PostsAndLintel /Arch /RectangularAlternateNudge /SquareGrid /TopRow /MiddleRow /BottomRow /Sides /LeftSide /RightSide [ /Array ... /Positions ... ] % Variations, those on this line taking no parameters, those on the next two lines taking one: /Mirror /ShoveLeft /ShoveRight /ProhibitVerticalNudging /ProhibitHorizontalNudging % /OnlyIfSheetNumMin /OnlyIfSheetNumMax /OnlyIfOrientation /GlassesNumMin /GlassesNumMax /ImprovementPointsMin /ImprovementProportionMin % /PackingDirectionTopToBottom /PackingDirectionLeftToRight /PackingNestingColumnMajor /RowsNumMin /RowsNumMax /CentralGlasses /RectColsToLeftOrRowsBelow /TempleExtraColsToLeftOrRowsBelow % /SquareGrid only, /HorizontalAlignment is followed by one of /Left /Right /Centre /Justify; and /VerticalAlignment by one of /Top /Bottom /Middle /Justify. % To suppress, by placement, headers, icons, and water boxes, use flags /SuppressOrnamentsLeft, /SuppressOrnamentsRight, and /SuppressOrnamentsCentre. /PackingNestingColumnMajor {Orientation /Landscape eq SideBySideGlassesTastingNotes not and} def % Default value, which can be overridden at the level of the individual item of PackingStyles /PackingDirectionTopToBottom true def % Ditto /PackingDirectionLeftToRight true def % Ditto /PackingStyles [ /RectangularDislocation /Diamonds /DiamondsAndRectangular [ /Bespoke5 /OnlyIfOrientation /Landscape ] [ /Bespoke7 /OnlyIfOrientation /Landscape ] [ /RectangularAlternateSplitNudge /ImprovementPointsMin 2 ] [ /DiamondsPlus /OnlyIfOrientation /Portrait ] [ /DiamondsPlus /OnlyIfOrientation /Landscape /ImprovementPointsMin 2 ] [ /Temple /OnlyIfOrientation /Landscape /ImprovementPointsMin 1 ] [ /Temple /OnlyIfOrientation /Portrait /ImprovementPointsMin 2 ] [ /RectangularAlternateNudge /ImprovementPointsMin 2 ] % [ /RightSide /GlassesNumMax 3 /OnlyIfOrientation /Portrait /VerticalAlignment /Justify /SuppressOrnamentsLeft /SuppressOrnamentsCentre ] % [ /PostsAndLintel /CentralGlasses 1 /GlassesNumMin 7 /OnlyIfOrientation /Landscape ] % [ /Arch /CentralGlasses 1 /GlassesNumMin 6 /OnlyIfOrientation /Landscape ] ] def % /PackingStyles /WaterBoxes { {GlassesNumCopies 0 le} MightBeTrue {/Both} {/Glasses} ifelse} bind def % /Glasses /TastingNotes /Both, any other value being none /SideBySideGlassesTastingNotes false def % If true TastingNotesPaperType and TastingNotesOrientation ignored /VoteRecorderTopTexts [ % Must be same length as GlassesClusteredOnVoteRecorders, each sub-array containing some number of TopTexts [ (Wine Of The Night?) /questiondown ] % [ (What is it?) ] % If uncommenting this, insert a 'true' into the VoteRecorderShowTotalRow array. ] def % /VoteRecorderTopTexts, Must be same length as GlassesClusteredOnVoteRecorders /VoteRecorderShowTotalRow [ false ] def % Same length as VoteRecorderTopTexts /GlassesClusteredOnVoteRecorders [ VoteRecorderTopTexts length {GlassesOnTastingNotePages} repeat ] def % triple-depth array, same length as VoteRecorderTopTexts and VoteRecorderShowTotalRow /VoteRecorderCrossedBox {VoteRecorderShowTotalRow VoteRecorderSheetNum GetEU dup {pop TitlesVoteRecorder WithinTitles get ASCIIfy ThisName ASCIIfy eq ThisName length 0 gt and} if} bind def % /VoteRecorderCrossedBox /Rotate180AlternateNames false def /PageOrderingGlasses [ GlassesOnSheets length {1} repeat ] def /PageOrderingTastingNotePages [ GlassesOnTastingNotePages length {1} repeat ] def /TastingNotesStarsNameColsRowsArrangement % (ASCIIfied Name) NumCols NumRows /Alternating|/Sideways|/Upright [ (JDAW) 5 1 /Upright (Julian W.) 4 copy pop (DRT) 5 1 /Upright (Derek T.) 4 copy pop (NAC) 5 1 /Upright (Neil C.) 4 copy pop (CSD) 5 1 /Upright (Chris D.) 4 copy pop (WPS) 5 1 /Sideways (Wolfgang S.) 4 copy pop (PW) 5 1 /Sideways (Phil W.) 4 copy pop (DJ) 5 1 /Sideways (Daniel J.) 4 copy pop (IDJ) 5 1 /Alternating (Ian J.) 4 copy pop (DRL) 5 1 /Alternating (Dave L.) 4 copy pop (TC) 5 1 /Alternating (Tony C.) 4 copy pop (MPM) 5 1 /Alternating (Mike M.) 4 copy pop ] def % /TastingNotesStarsNameColsRowsArrangement /PlaceNamesFirstAndThirdFoldsFromEdge 0 def % Use 0 if printing on stiff card, 36 if printing on paper. % % % % % % % % % % % % % % % % % % % % % % % % % % % % Fonts, Colour Schemes, and Font-Size Constraints % % % % % % % % % % % % % % % % % % % % % % % % % % % % % Fonts the author has used: % /TrebuchetMS-Bold /Garamond /Garamond-Bold /Cochin /Cochin-Bold /Didot /Didot-Bold /DejaVuSerifCondensed /DejaVuSerif-Bold /DejaVuSerif % /Harrington /AmazeNormal /LiberateBold /GillSansMT-Condensed /GillSans-CondensedBold /GillSansMT-ExtCondensedBold /GillSans-Light % /Optima-Regular /Optima-Bold /AvenirNextCondensed-DemiBold /LucidaSans /LucidaSans-Demi % Others might be available to your interpreter; a list of PostScript names can be generated by decommenting the next line: % (*) {=} 255 string /Font resourceforall /TitlesFont /GothamNarrow-Bold def /CircletextFont /DejaVuSerif def /AbovetitlesFont {TitlesFont} def /BelowtitlesFont {AbovetitlesFont} def /OvertitlesFont {TitlesFont} def /NamesFont {PlaceNames {TitlesFont} {CircletextFont} ifelse} bind def /SubtitlesFont {OvertitlesFont} def /FillTextFont {TitlesFont} def /PlaceNamesFont {NamesFont} def /BackgroundTextsFont {TitlesFont} def % /UniversalisADFStd-BoldCond a good choice, http://typophile.com/node/82379 /HeaderFont {CircletextFont} def /FooterFont {HeaderFont} def /ColourSchemeTitles /Black def % /MidGrey /Black /ColourSchemeAbovetitles /Black def % /MidGrey /Black /ColourSchemeBelowtitles /Black def % /MidGrey /Black /ColourSchemeOvertitles /Black def % /MidGrey /Black /TitleMaxHeightProportionInnerRadius 1.5 def /AbovetitleMaxFontSizeProportionTitles 0.25 def /BelowtitleMaxFontSizeProportionTitles 0.25 def /OvertitleMaxFontSizeProportionTitles 0.25 def /TitleMinHeightForAbovetitleProportionInnerRadius 1 3 div def /TitleMinHeightForBelowtitleProportionInnerRadius 1 3 div def /ExclusionAnnulusProportionInnerRadiusTitlesAboveBelow 0 def /ExclusionAnnulusProportionInnerRadiusOvertitles 0 def /FontSizesSetsGlassesPages {PageOrderingGlasses} def /FontSizesSetsAboveBelowOver [ 0 0 0 ] def % Array of length 3, representing which of Abovetitles, Belowtitles, and Overtitles are considered together for font-size purposes /FontSizesRatioTitlesMin 1.166666 def % If font sizes closer than this ratio, then collapsed to smaller. /FontSizesRatioAboveBelowOverMin 999 def % If font sizes closer than this ratio, then collapsed to smaller. /FontSizesTitlesNotSmallerIfTitlesNotLonger false def % If using FontSizesTitlesEquivalences then this probably should be false. If true then font size of "W" cannot be smaller than that of "II"; and "Df" must be same as "Dl". /FontSizesAboveBelowOverNotSmallerIfTitlesNotLonger false def /FontSizesTitlesEquivalences [ 0 1 Titles length 1 sub {} for ] def % If using this then FontSizesTitlesNotSmallerIfTitlesNotLonger probably should be false. /FontSizesAbovetitlesEquivalences FontSizesTitlesEquivalences def /FontSizesBelowtitlesEquivalences FontSizesTitlesEquivalences def /FontSizesOvertitlesEquivalences FontSizesTitlesEquivalences def /RotationTitlesAboveBelowOverCirclearray 0 def /CircletextsMinNumSpacesBetween 3 def /CircletextsMinCopies 2 def /CircletextsTweakSize true def /CircletextMaxFontSizeMayBeSlightlyExceeded true def /CircletextFontSize 8 def /CircletextsSameFontSizeIfRadiiShrunkToBeSame true def % % % % % % % % % % % % % Glasses: Decoration % % % % % % % % % % % % % /ShapesInTitles false def /ShapesInAbovetitles {ShapesInTitles} def /ShapesInBelowtitles {ShapesInTitles} def /ShapesInOvertitles {ShapesInTitles} def /ShapesInPlaceNames {ShapesInTitles} def /ShapesToUse [ /Flower /Star /Heart /Circle ] def % At least one of: /Flower /Star /Heart /Circle /ShapesStarsPointsAndStepsArray [[5 2] [6 2] [7 2] [7 3] [8 3]] def % Less-polygonal more-pointy: [[3 1.31844] [4 1.79214] [5 2.27823] [6 2.77012] [7 3.26502] [8 3.76162] [9 4.25925]] /CrossHatchingOutside false def /CrossHatchingInside false def /CrossHatchingTitles false def /CrossHatchingAbovetitles {CrossHatchingTitles} def /CrossHatchingBelowtitles {CrossHatchingTitles} def /CrossHatchingOvertitles {CrossHatchingTitles} def /CrossHatchingPlaceNames {CrossHatchingTitles} def /InlineTitles true def /InlineAbovetitles false def /InlineBelowtitles false def /InlineOvertitles false def /InlinePlaceNames {ShapesInTitles CrossHatchingTitles or InlineTitles and} bind def /InlineTitlesMaxNumberContours 1 def /InlineAbovetitlesMaxNumberContours 1 def /InlineBelowtitlesMaxNumberContours 1 def /InlineOvertitlesMaxNumberContours 1 def /OutlineTitles false def /OutlineTitlesAlsoAbovetitles true def % ignored if OutlineTitles is false /OutlineTitlesAlsoBelowtitles true def % ignored if OutlineTitles is false /OutlineTitlesAlsoOvertitles true def % ignored if OutlineTitles is false /Spirals false def /SpiralNumArms 5 def /SpiralAngleOffset 0 def /SpiralRadiusBetweenArms 30 def /SpiralClockwise true def /SpiralCentreFromCentreProportionRadiiInside 0 def /SpiralCentreFromCentreAngle 0 def /SpiralStrokeCode {stroke} def /FillTextPedantry /Sensible def % /Quick, /Sensible, /Fussy. Production version ==> /Sensible or /Fussy. /FillTitles false def /FillAbovetitles {FillTitles} def /FillBelowtitles {FillTitles} def /FillOvertitles {FillTitles} def /FillPlaceNames FillTitles def /FillTextAngle {GlassesOnSheets length 2 eq {SheetNum 0 eq {/LowerRight} {/LowerLeft} ifelse} {NamesShowTop SheetNum get {/LowerCenter} {/Name} ifelse} ifelse} bind def % E.g., /Name /LowerLeft /LowerRight /MiddleLeft /UpperCenter /UpperRight /FillTexts /Titles load def % ignored if no filling. If used typically set to a custom array (of same length as Titles). /FillTextPlaceNames {ThisName} def % % % % % % % % % % % Page background % % % % % % % % % % % /BackgroundTextsGlasses false def /BackgroundTextsGlassesTexts [ GlassesOnSheets length {()} repeat ] def /BackgroundTextsTNsTexts [ 0 1 GlassesOnTastingNotePages length 1 sub {BackgroundTextsGlassesTexts exch 1 index length mul GlassesOnTastingNotePages length div floor cvi get} for ] def /BackgroundTextsAlignmentVertical {1 TypeOfPagesBeingRendered /TastingNotes eq {TNSheetNum GlassesOnTastingNotePages} {SheetNum GlassesOnSheets} ifelse length dup 1 le {pop pop pop 0.5} {1 sub div sub} ifelse} bind def % number /Middle /Bottom /Top /BackgroundTextsAlignmentHorizontal /Centre def % number /Centre /Left /Right /BackgroundTextsSquooshMax 1 def % y/x scaling, bigger being taller, smaller being fatter /BackgroundTextsSquooshMin 1 BackgroundTextsSquooshMax dup 1 eq {pop} {div} ifelse def /BackgroundTextsTastingNotes BackgroundTextsGlasses def /BackgroundTextsOrientation /Landscape def % /Landscape /Portrait /Natural /Rotated /BackgroundTextsGlassesPaintCode {clip 4.32 setlinewidth 0.9375 setgray stroke} def /Droplets false def /DropletsCharges [ % Length a multiple of 4 /All [297.638 777.685] -1 0 % SheetNum Location Charge Spin. SheetNum can be /All; location is WithinPage, or reals [x y], or integers [WithinPage0, WithinPag1, ...]. /All [160.819 538.760] 4 300 % Default settings look best for A4, 5 glasses, RectangularDislocation. /All [365.625 298.482] -1 0 ] def % DropletsCharges /DropletsProportionBackwards 0.0204 def % Keeping this small adds humour to their discovery. ("Naughty creatures being rebellious. It's like herding cats!") /FlightSeparations false def % The usual error is too shallow nesting of arrays. There is the outer array. Containing an array for each SheetNum. Each containing arrays, one per line. Each containing the line pieces. % Example line descriptions (so FlightSeparations to be two deeper): % -- [ [/Left 3] [0 3] [/Top 3] ] % -- [ [/Top 4] [1 4] [/VerticalUp 1 1 1 1 4] [4 6] [/Bottom 4] ] /FlightSeparationLines [ GlassesOnSheets length {[]} repeat ] def % /FlightSeparationLines /FlightSeparationPaintCode {gsave 2.4 setlinewidth 0.75 setgray 0 setlinecap stroke grestore 0.96 setlinewidth 1 setgray 1 setlinecap stroke} def /FlightSeparationPaintSeparately false def /FlightSeparationsArcProportionRadius 0.25 def % strictly >0; <=1 /PaintBackgroundInsideGlassCircles {} def % Paints a background pattern. Called with centre of circle translated to 0,0; and clipped to radius Radii SheetNum get. /PaintBackgroundCode {} def % Paints a background pattern. Will probably refer to TypeOfPagesBeingRendered and then to SheetNum or TNSheetNum. /PaintForegroundCode {} def % Paints a pattern on top of everything. Will probably refer to TypeOfPagesBeingRendered and then to SheetNum or TNSheetNum. % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % These parameters, and VoteRecorderTopTexts etc above, might need to be translated. % % Some translations at http://github.com/jdaw1/placemat/blob/main/Documentation/translations.md % % Please submit others to http://github.com/jdaw1/placemat/issues % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % % /VoteRecorderInstruction {VoteRecorderShowTotalRow VoteRecorderSheetNum GetEU {()} {(Record points, not rank.)} ifelse} bind def /VoteRecorderTotalColTitle [(T) {-0.06 Kern} (otal)] def /VoteRecorderTotalRowTitle [(T) {-0.09 Kern} (otal)] def /VoteRecorderMonkeyName (Monkey) def /VoteRecorderMonkeyVote (D70) def % Can refer to WithinTitles /TastingNotesColumnHeadings [ (Times) (Eye) (Nose) (Mouth) (Score) ] def /TastingNotesPageNumCompoundString [(Page ) {TNSheetNum 1 add 5 string cvs}] def /DecantingNotesTopText (Decanting Notes) def /DecantingNotesColumnHeadingTimes (Decant Time) def /DecantingNotesColumnHeadingNotes (Cork condition, branding, etc) def /AccountsTopText (The Accounts) def /AccountsColumnGroupHeadings [ [/emdash ( Bestowals ) /emdash] [/emdash ( Share of costs ) /emdash] [/emdash ( Settlement ) /emdash] ] def /AccountsSubColumnHeadings [ [ (Already paid) (Wines) ] [ (Wines) (Food etc) ] [ (Owes) (Is owed) [(P) {-0.02 Kern} (aid?)] ] ] def % Must be same length as AccountsColumnGroupHeadings /CorkDisplayTopText (The Corks) def /DecanterLabelsTopText (Decanter labels: cut; paste to business cards; allow to dry; punch holes; hang on clean decanters; fill decanters; wait; pour; drink; enjoy. Also drink plenty of water.) def /EmptyPageString (Fewer pages than before, so this page now omitted.) def /LicensingAgreementTextPlacemats (This work is licensed under a Creative Commons Attribution-ShareAlike 4.0 International Licence.) def % To be consistent with LicensingAgreementLinkPlacemats % % % % % % % % % % % % % % % % % % % % % Obscure and Little-Used Parameters % % % % % % % % % % % % % % % % % % % % % /CMYK0001replacesRGB000 false def % True printers' CMYK black, rather than screen-optimal RGB black? Default = false because of HP Officejet Pro 8600 Plus: www.theportforum.com/viewtopic.php?t=175&start=1094 % Add annotations, perhaps a correction of a wine's information, without changing the printed PDF. % Array of length a multiple of two, alternately elements of WithinTitles, and compound strings. /GlassesAnnotations [ ] def /NamesShowTop [ GlassesOnSheets length {false} repeat ] def /NamesShowBottom [ GlassesOnSheets length {true } repeat ] def /GlassesPageWhiteCirclesBehind false def /HeaderFontSize 6 def /HeaderBaselineFromPageTop {MgnT HeaderFontSize 2 div sub} bind def /FootersLeft [] def /FootersRight [] def /FootersCenter [] def /FooterFontSize {HeaderFontSize} def /FooterTopFromPageBottom {MarginB FooterFontSize 8 div sub} bind def /HeaderFooterCenterX {PageWidth MgnL MgnR sub add 2 div} bind def /MarginL 24 def % For five on A4 consider 19.86386432719 = 3 sqrt 2 sqrt 2 copy 4 mul 8 sub mul 1 index 3 mul add exch sqrt mul 7500 mul 127 div exch 4 mul add /MarginR MarginL def /MarginT MarginL [ /HeadersLeft /HeadersCenter /HeadersRight ] {load length 0 ne {HeaderFontSize add exit} if} forall def /MarginB MarginL [ /FootersLeft /FootersCenter /FootersRight ] {load length 0 ne {FooterFontSize add exit} if} forall def /Orientation {SideBySideGlassesTastingNotes {/Landscape} {PaperType /A4 eq PaperType /USL eq or {/Portrait} {/Landscape} ifelse} ifelse} bind def % /Landscape /Portrait % ShrinkRadii can take values: % /NotAtAll, so each page's radius is determined independently; % /ToSmallest, so all pages have the same radius; or % /ToSmallestSamePageOrdering, so the radius of each page in the same session, presumed to be equivalent to having the same value of PageOrderingGlasses, is shrunk to the smallest of that session's radii; % array the same length as GlassesOnSheets, each radius being shrunk to the smallest of the pages with equal array element. /ShrinkRadii /ToSmallestSamePageOrdering def % /NotAtAll | /ToSmallest | /ToSmallestSamePageOrdering | array denoting equivalence classes /MaxRadius 150 def % Maximum radius of circles /DecantersLabelsMinSpaceForAbovetitlesProportionSmaller 0.2 def /DecantersLabelsMinSpaceForBelowtitlesProportionSmaller 0.2 def /GlassesCirclesFadingFactor 1 def % Person not drinking some wines? Use code returning a real >=0 <=1, depending on NameNum SheetNum WithinTitles WithinPage /GlassesCrossedOut {GlassesCirclesFadingFactor 0.5 le} bind def /GlassesDestForEachCircle {NameNum 0 eq} bind def % For URL # tags. Always true typically adds 10%-12% to file size versus always false; {NameNum 0 eq} a compromise. /CirclearraysFillBehind false def /CirclearraysFillBehindCode {0.9375 setgray fill} def /VerticalMiddlingTitles /MatchString def % /MatchNone /MatchRow /MatchPage /MatchAll /MatchString /VerticalMiddlingIncludeBaselineTitles false def /VerticalMiddlingStringTitles (D20T83) def % Benchmark characters, deliberately not including those prone to having a 'tail' in some fonts /VerticalMiddlingOvertitles {VerticalMiddlingTitles} def % /MatchNone /MatchRow /MatchPage /MatchAll /MatchString /VerticalMiddlingTitlesAlwaysMatchNone [ /dagger /daggerdbl ($) /dollar /sterling /Euro /yen (*) (+) (++) (+++) (++++) (+++++) (?) (??) (???) (????) (?????) /spade /heart /diamond /club /multiply /bullet /periodcentered /lozenge /alpha /beta /gamma /delta /epsilon /zeta /eta /theta /iota /kappa /lambda /mu /nu /xi /omicron /pi /rho /sigma /tau /upsilon /phi /chi /psi /omega /uni2609 /uni263F /uni2640 /uni2641 /uni2642 /uni2643 /uni2644 /uni2645 /uni2646 /uni2647 % Astronomical symbols ] def % /VerticalMiddlingTitlesAlwaysMatchNone /VerticalMiddlingOvertitlesAlwaysMatchNone VerticalMiddlingTitlesAlwaysMatchNone def /VerticalMiddlingIncludeBaselineOvertitles {VerticalMiddlingIncludeBaselineTitles} def /VerticalMiddlingStringOvertitles {VerticalMiddlingStringTitles} def /ShapesAverageSeparation 12.5 def /ShapesEnclosingCircleRadiusMin {ShapesAverageSeparation 0.4 mul} bind def /ShapesEnclosingCircleRadiusMax {ShapesAverageSeparation 0.6 mul} bind def /ShapesAverageMaxTweakPlusMinus {ShapesAverageSeparation 0.3 mul} bind def /ShapesFlowersNumPetalsMin 5 def /ShapesFlowersNumPetalsMax 9 def /ShapesFlowersAngularWidthMin 0.8 def % as a proportion of 360 / num petals /ShapesFlowersAngularWidthMax 2 def % as a proportion of 360 / num petals, and an upper limit of 109.47122 degrees is also applied /ShapesTitlesFill {1 setgray fill} def /ShapesTitlesStroke {ColourSchemeCurrent /MidGrey eq {0 setgray stroke} {InlineTitles {0.4 setgray stroke} {newpath} ifelse} ifelse} def /ShapesAbovetitlesFill {ShapesTitlesFill} def /ShapesBelowtitlesFill {ShapesTitlesFill} def /ShapesOvertitlesFill {ShapesTitlesFill} def /ShapesAbovetitlesStroke {ShapesTitlesStroke} def /ShapesBelowtitlesStroke {ShapesTitlesStroke} def /ShapesOvertitlesStroke {ShapesTitlesStroke} def /ShapesTitlesClip true def /ShapesPlaceNamesClip ShapesTitlesClip def % If shapes filled white with no border so identical to background, then def to false, to avoid bleed between clip and fill. /ShapesAbovetitlesClip ShapesTitlesClip def /ShapesBelowtitlesClip ShapesTitlesClip def /ShapesOvertitlesClip ShapesTitlesClip def % Ditto. /ShapesPrintQuickerDistillSlower true def /CrossHatchingOutsideStrokeCode {0 setgray 0.12 setlinewidth stroke} def /CrossHatchingOutsideToPaperEdge false def /CrossHatchingInsideStrokeCode {0 setgray 0.12 setlinewidth stroke} def /CrossHatchingTitlesStrokeCode {InlineTitles ColourSchemeCurrent /MidGrey eq {{0.4 0.15} {0 0.24}} {{0 0.06} {1 0.24}} ifelse ifelse TypeOfPagesBeingRendered /PlaceName eq {PlaceNamesDetailsScalingFactor mul} if setlinewidth setgray stroke} def /CrossHatchingAbovetitlesStrokeCode {InlineAbovetitles ColourSchemeCurrent /MidGrey eq {{0.4 0.15} {0 0.24}} {{0 0.06} {1 0.24}} ifelse ifelse TypeOfPagesBeingRendered /PlaceName eq {PlaceNamesDetailsScalingFactor mul} if setlinewidth setgray stroke} def /CrossHatchingBelowtitlesStrokeCode {InlineBelowtitles ColourSchemeCurrent /MidGrey eq {{0.4 0.15} {0 0.24}} {{0 0.06} {1 0.24}} ifelse ifelse TypeOfPagesBeingRendered /PlaceName eq {PlaceNamesDetailsScalingFactor mul} if setlinewidth setgray stroke} def /CrossHatchingOvertitlesStrokeCode {InlineOvertitles ColourSchemeCurrent /MidGrey eq {{0.4 0.15} {0 0.24}} {{0 0.06} {1 0.24}} ifelse ifelse TypeOfPagesBeingRendered /PlaceName eq {PlaceNamesDetailsScalingFactor mul} if setlinewidth setgray stroke} def /CrossHatchingNumRadialLines 80 def % Best that this be a multiple of 4. /CrossHatchingCellArea 1296 def % (36pt)^2 = (0.5")^2 = (12.7mm)^2 /CrossHatchingCentreX /CenterSheetsSamePageOrdering def % number /Name /Left /Center /Right /CenterSheetsSamePageOrdering /CrossHatchingCentreY /Bottom def % number /Name /Bottom /Middle /Top /InlineTitlesPrefillWhite {CrossHatchingInside Spirals or} def /InlineAbovetitlesPrefillWhite /InlineTitlesPrefillWhite load def /InlineBelowtitlesPrefillWhite /InlineTitlesPrefillWhite load def /InlineOvertitlesPrefillWhite true def /InlineTitlesBlackWidth {InlineTitlesMaxNumberContours 1 gt {0.96} {1.44} ifelse} bind def % Black isn't always black. Sometimes it's grey. /InlineTitlesWhiteWidth {InlineTitlesBlackWidth 2 mul} bind def % White isn't always white. Sometimes it's grey. /InlineAbovetitlesBlackWidth {InlineTitlesBlackWidth 2 div} bind def % Black isn't always black. Sometimes it's grey. /InlineAbovetitlesWhiteWidth {InlineTitlesWhiteWidth 2 div} bind def % White isn't always white. Sometimes it's grey. /InlineBelowtitlesBlackWidth {InlineTitlesBlackWidth 2 div} bind def % Black isn't always black. Sometimes it's grey. /InlineBelowtitlesWhiteWidth {InlineTitlesWhiteWidth 2 div} bind def % White isn't always white. Sometimes it's grey. /InlineOvertitlesBlackWidth {InlineTitlesBlackWidth 2 div} bind def % Black isn't always black. Sometimes it's grey. /InlineOvertitlesWhiteWidth {InlineTitlesWhiteWidth 2 div} bind def % White isn't always white. Sometimes it's grey. % Inline...AttemptMinimiseNumContours is crushingly slow in Ghostscript, so when using online distillation. % See http://www.ThePortForum.com/viewtopic.php?t=175&start=913 /InlineTitlesAttemptMinimiseNumContours {InlineTitlesMaxNumberContours 3 gt IsDistiller and} bind def /InlineAboveBelowOverAttemptMinimiseNumContours {InlineAbovetitlesMaxNumberContours 3 gt InlineBelowtitlesMaxNumberContours 3 gt InlineOvertitlesMaxNumberContours 3 gt or or IsDistiller and} bind def /InlinePlaceNamesAttemptMinimiseNumContours {InlineTitlesMaxNumberContours 3 gt IsDistiller and} bind def /OutlineTitlesInnerWidthWhite 3.6 def % Ignored if OutlineTitles is false /OutlineTitlesInnerWidthBlack 0.3 def % Ditto /OutlineTitlesMultiplierWhite 5 sqrt 1 add 2 div def % Ditto /OutlineTitlesMultiplierBlack 1 def % Ditto /OutlineTitlesMaxNum 96 def % Ditto /FillTextNumSpaces 2 def /FillTextNumOutlines {TypeOfPagesBeingRendered /PlaceName eq {2} {2} ifelse} bind def /FillTextMinFontSizeAbsolute 6 def /FillTextMinFontSizeProportionLargestTitleAboveBelowOver 0.03333333 def /FillTextAnglePlaceNames 30 def /FillPrioritiseSmallFileSizeOverPortability true def /DropletsReversedHighlight {-1 NameNum eq} def % Default always false. Typical use case is testing for being 0. /DropletsPathLength 12 def /DropletsAverageSeparation DropletsPathLength 2 mul def % If <10 then far too crowded. And <4, such that there are >65k droplets on an A3, might cause stack overflow. /DropletsAverageMaxTweakPlusMinus {DropletsAverageSeparation 0.25 mul} bind def /DropletsOuterWidthEnd 4.32 def /DropletsOuterWidthStart 0.48 def /DropletsInnerWidthEnd DropletsOuterWidthEnd 4 div def /DropletsInnerWidthStart {DropletsInnerWidthEnd DropletsOuterWidthEnd sub DropletsOuterWidthStart add} bind def /DropletsOuterGrayEnd {DropletNum 4 mod 12 add 16 div} def /DropletsOuterGrayStart {DropletsOuterGrayEnd} def /DropletsInnerGrayEnd 1 def /DropletsInnerGrayStart 1 def /DropletsPaintAtEnd {} def /DropletsPaintAtEndRotate true def % Relevant only if DropletsPaintAtEnd used. If true then 'up' points away from end. /Droplets_SideBySide_UnderTNs true def % Relevant only if SideBySideGlassesTastingNotes is true /CircletextsMaxCopies {dup 32 gt {dup dup 4 mod sub} {65535} ifelse} bind def /SideBySideGlassesTastingNotesWidthGutter 0 def % 0 works well for small numbers of glasses /SideBySideGlassesTastingNotesProportionPageGlasses 0.5 def /BackgroundTextsFontSizeMax 9999 def /BackgroundTextsGlassesSameSizeIfAllOf [ /SamePageOrdering /SamePaperSize /TextSameLength ] def % /False /OnSheetWithSameNumberGlasses /RadiiShrunkToBeSame /OnSheetWithSameRadius /SamePaperSize /TextSameLength /SamePageOrdering /BackgroundTextsGlassesVerticalMiddling /MatchSamePaperSize def % /MatchNone /MatchSamePaperSize /MatchAll /BackgroundTextsDecanterLabels /BackgroundTextsGlasses load def /PrePourShowBackgroundTexts /BackgroundTextsGlasses load def /WaterBoxesNum 15 def % triangle number most elegant: 6, 10, 15, 21 /WaterBoxesOverrideShowEverySheet true def /WaterBoxesShowLeft [ 0 1 GlassesOnSheets length 1 sub {<< exch /i exch >> begin true 0 1 i 1 sub {PageOrderingGlasses exch get PageOrderingGlasses i get eq {pop false exit} if} for end} for ] def /WaterBoxesShowRight [ 0 1 GlassesOnSheets length 1 sub {<< exch /i exch >> begin true i 1 add 1 GlassesOnSheets length 1 sub {PageOrderingGlasses exch get PageOrderingGlasses i get eq {pop false exit} if} for end} for ] def /WaterBoxesShowTN [ 0 1 GlassesOnTastingNotePages length 1 sub {<< exch /i exch >> begin true PageOrderingTastingNotePages 0 i getinterval {PageOrderingTastingNotePages i get eq {pop false exit} if} forall end} for ] def /WaterBoxesSizeMax 15 def /WaterBoxesGapProportionSize 0.25 def /WaterBoxesFormatStroke {stroke} def /NamesFontSize 18 def % GhostScript doesn't pickle settransfer; Preview doesn't see non-pickled settransfer. The bug is in Preview. http://groups.google.com/g/comp.lang.postscript/c/NJLAfvN_jwU /TastingNotes_NumVerticalSections 1 def % If table likely to be very space-constrained, set to 2. /TastingNotesCirclesBehind {IsDistiller {GlassesNumCopies 1 ge} MightBeTrue and BackgroundTextsTastingNotes not and SideBySideGlassesTastingNotes not and} bind def /TastingNotesCirclesBehindFitAndCentreInRow false def /TastingNotesCirclesBehindFadingFactorIfAllBlack 0.125 def /TastingNotesCirclesBehindFadingFactorIfAnyGrey 0.2 def /TastingNotesCirclesBehindTopX {[0 1 0 0.5 1 1 0.5 0.5 0] TNSheetNum 9 mod get} bind def % 0 to 1, this complication giving a nice variety /TastingNotesCirclesBehindBottomX {[0 1 0 0.5 1 1 0.5 0.5 0] TNSheetNum 1 add 9 mod get} bind def % 0 to 1, this complication giving a nice variety /TastingNotesOrientation /Portrait def % /Landscape /Portrait /TastingNotesColumnRelativeWidths [ 1 2 4 8 1 ] def /TastingNotesColumnHeadingsFontSize 6 def /TastingNotesColumnStrokeCode {0 setgray 0.12 setlinewidth 0 setlinecap [2.4 16.8] 0 setdash stroke} def /TastingNotesLineGap 2 def /TastingNotesTitlesFontSizeMax 18 def /TastingNotesSubtitleFontSizeProportionTitles 0.5 def /TastingNotesReplaceNameWithPageNum false def /TastingNotesPageNumFontSizeFactor 0.333333333 def /PlaceNamesShowNameAsFooter [ NamesPlaceNames {/Names load ne} forall ] def /PlaceNamesPaperType {<< /TNSheetNum 0 >> begin TastingNotesPaperType end} bind def % /A4 /A3 /B4 /USL /USLegal /Tabloid /PlaceNamesOrientation /Landscape def % /Landscape /Portrait /PlaceNamesMaxFontSizeAbsolute 192 def /PlaceNamesDetailsScalingFactor 5 sqrt 1 add 2 div def /ColourSchemePlaceNames /Black def % /MidGrey /Black /PrePourReverseOrder true def /PrePourCollate true def /PrePourRemoveDuplicatesByWithinTitles true def /PrePourSortByWithinTitles true def /PrePourPaperType {<< /TNSheetNum 0 >> begin TastingNotesPaperType end} bind def % /A4 /A3 /B4 /USL /USLegal /Tabloid /PrePourOrientation /Landscape def % /Landscape /Portrait /PrePourShowDroplets true def /BottleWrapPadding 12 def /BottleWrapReverseOrder false def /BottleWrapCollate true def /BottleWrapRemoveDuplicatesByWithinTitles true def /BottleWrapSortByWithinTitles true def /BottleWrapPaperType {<< /TNSheetNum 0 >> begin TastingNotesPaperType end} bind def % /A4 /A3 /B4 /USL /USLegal /Tabloid /BottleWrapOrientation /Landscape def % /Landscape /Portrait /BottleWrapScalingMin 0.7071 def % ~=Sqrt[1/2] /BottleWrapShowOutlineTitles true def % ignored if OutlineTitles is false /BottleWrapShowCrossHatchingInside true def % ignored if CrossHatchingInside is false /VoteRecorderNamesOrientation /Either def % /Horizontal /Vertical /Either /VoteRecorderShowTotalCol [ GlassesClusteredOnVoteRecorders length {true} repeat ] def % Must be same length as GlassesClusteredOnVoteRecorders /VoteRecorderPaperType {<< /TNSheetNum 0 >> begin TastingNotesPaperType end} bind def /VoteRecorderOrientation /Portrait def /VoteRecorderTitlesFontSizeMax 24 def /VoteRecorderSubtitleFontSizeProportionTitles /Automatic def /VoteRecorderMonkeyWhenShowTotalRow true def /GlassesClusteredOnDecantingNotes [ GlassesOnTastingNotePages ] def /DecantingNotesPaperType /VoteRecorderPaperType load def /DecantingNotesOrientation /Portrait def /DecantingNotesTitlesFontSizeMax 24 def /DecantingNotesSubtitleFontSizeProportionTitles VoteRecorderSubtitleFontSizeProportionTitles def /AccountsExtraRows [ () VoteRecorderTotalRowTitle () ] def /AccountsColumnRelativeWidths [ 4 4 4 4 4 4 1 ] def /AccountsColumnHeadingsFontSize 8 def /AccountsPaperType /DecantingNotesPaperType load def /AccountsOrientation /Portrait def /GlassesClusteredOnCorkDisplay [ GlassesOnSheets ] def /CorkDisplayMinWidth 216 def /CorkDisplayMinHeight 216 def /CorkDisplayPaperType /DecantingNotesPaperType load def /CorkDisplayTitleFontSizeMax 15 def /NeckTagsMinWidth 250 def /NeckTagsMaxWidth 300 def /NeckTagsMinHeight 350 def /NeckTagsMaxHeight 400 def /NeckTagsHoleRadius {54 //false [Abovetitles Belowtitles Overtitles] {WithinTitles get (Magnum) eq or} forall Circlearrays WithinTitles get {(Magnum) eq {pop //true exit} if} forall {1.2 mul} if} bind def % 19mm/23mm radius /NeckTagsHoleLineWidth 0.12 def /NeckTagsSpaceAboveHole 60 def /NeckTagsSpaceAboveTitlesEtc 48 def /NeckTagsSpaceBelowTitlesEtc 12 def /NeckTagsShowDroplets false def /NeckTagsShowBackgroundTexts true def /NeckTagsShowOutlineTitles false def % ignored if OutlineTitles is false /NeckTagsShowCrossHatchingInside false def % ignored if CrossHatchingInside is false /NeckTagsPaperType /DecantingNotesPaperType load def /DecanterLabelsMaxSmallerDimension 130.337 def % ISO 7810 ID1 = 53.98mm by 85.60mm. /DecanterLabelsMaxLargerDimension 219.969 def % Minus 4mm margins all round, in pt. /DecanterLabelsGuillotineMarks true def /DecanterLabelsShowOutlineTitles false def % ignored if OutlineTitles is false /DecanterLabelsShowCrossHatchingInside false def % ignored if CrossHatchingInside is false /DecanterLabelsPaperType {<< /TNSheetNum 0 >> begin TastingNotesPaperType end} bind def % /A4 /A3 /B4 /USL /USLegal /Tabloid /DecanterLabelsOrientation /Automatic def % of labels, not of paper. /Landscape /Portrait /Automatic % Defaults: % Type 0 = www.ryman.co.uk/0220013460/Product ; % Type 1 = www.amazon.co.uk/exec/obidos/ASIN/B000SHP9OC/jdaw www.avery.co.uk/avery/en_gb/Products/Labels/Labels-for-Letters-%26-Envelopes/White-Address-Labels/White-Mini-Inkjet-Labels_J8651_25.htm /StickyLabelsPaperType {[/A4 /A4] StickyLabelsTypeThis get} bind def /StickyLabelsByNameWhichReplaceCirclearrays {StickyLabelsWithPagePortraitNumRows StickyLabelsWithPagePortraitNumCols mul 24 gt} bind def /StickyLabelsNamesChangeFaster {[false false] StickyLabelsTypeThis get} bind def /StickyLabelsAvoidAcrossColumnsOrRows true def % Ignored unless StickyLabelsByNameWhichReplaceCirclearrays /StickyLabelsAvoidAcrossPages true def % Ignored unless StickyLabelsByNameWhichReplaceCirclearrays /StickyLabelsWithPagePortraitNumRows {[4 13] StickyLabelsTypeThis get} bind def /StickyLabelsWithPagePortraitNumCols {[2 5] StickyLabelsTypeThis get} bind def /StickyLabelsWithPagePortraitGapL 12 def /StickyLabelsWithPagePortraitGapR 12 def /StickyLabelsWithPagePortraitGapT {[36 31] StickyLabelsTypeThis get} bind def /StickyLabelsWithPagePortraitGapB {[36 31] StickyLabelsTypeThis get} bind def /StickyLabelsWithPagePortraitGapBetweenRows 0 def /StickyLabelsWithPagePortraitGapBetweenCols 8 def /StickyLabelsOrientation /Automatic def % of labels, not of paper. /Landscape /Portrait /Automatic /StickyLabelsColumnsChangeFaster {[true false] StickyLabelsTypeThis get} bind def /StickyLabelsFirstPageStartPosition 0 def /StickyLabelsPaddingWithPagePortraitTB {[12 6] StickyLabelsTypeThis get} bind def /StickyLabelsPaddingWithPagePortraitRL {[6 3] StickyLabelsTypeThis get} bind def /StickyLabelsShowBackgroundTexts {[true false] StickyLabelsTypeThis get} bind def /StickyLabelsShowDroplets {[false false] StickyLabelsTypeThis get} bind def /StickyLabelsShowCirclearraysInCircle {[false false] StickyLabelsTypeThis get} bind def /StickyLabelsReverseOrder false def /StickyLabelsRemoveDuplicatesByWithinTitles true def /StickyLabelsSortByWithinTitles true def /ThePortForumIconColour false def /PageOrderingVoteRecorder [ GlassesClusteredOnVoteRecorders length {PageOrderingTastingNotePages length 1 ge {PageOrderingTastingNotePages 0 get} {1} ifelse} repeat ] def /PageOrderingDecantingNotes [ GlassesClusteredOnDecantingNotes length {PageOrderingTastingNotePages length 1 ge {PageOrderingTastingNotePages 0 get} {1} ifelse} repeat ] def /PageOrderingAccounts [ PageOrderingVoteRecorder {counttomark 1 sub -1 1 {index 1 index eq {pop exit} if} for} forall ] def % Removes duplicates /PageOrderingCorkDisplay [ GlassesClusteredOnCorkDisplay length {PageOrderingGlasses length 1 ge {PageOrderingGlasses 0 get} {1} ifelse} repeat ] def /PageOrderingNeckTags [ PageOrderingGlasses length {PageOrderingTastingNotePages length 1 ge {PageOrderingTastingNotePages 0 get} {1} ifelse} repeat ] def /PageOrderingPrePourPages PageOrderingGlasses def % Of length the same as GlassesOnSheets, not necessarily being of length PrePourNumCopies /PageOrderingPlaceNames [ NamesPlaceNames length {100} repeat ] def % Near end to facilitate advance folding /PageOrderingDecanterLabels [ PageOrderingGlasses {200 add} forall ] def % By default decanter-label pages appear together at the end, to facilitate advance manufacture /PageOrderingBottleWrap PageOrderingGlasses def % Of length the same as GlassesOnSheets, not necessarily being of length PrePourNumCopies /PageOrderingStickyLabels [ GlassesOnSheets length {300} repeat ] def % Of length the same as GlassesOnSheets, not necessarily being of length StickyLabelsNumCopies /PageOrderingOneCircle 1 def % Single value /PageOrderingSections [] def % Array of even length, alternately elements of the PageOrder...s, and compound strings /MirrorPagesGlasses [ PageOrderingGlasses length {false} repeat ] def % If printing to the reverse side of acetate, so that wine never causes ink to run /MirrorPagesTastingNotePages [ PageOrderingTastingNotePages length {false} repeat ] def /MirrorPagesVoteRecorder [ PageOrderingVoteRecorder length {false} repeat ] def /MirrorPagesDecantingNotes [ PageOrderingDecantingNotes length {false} repeat ] def /MirrorPagesAccounts [ PageOrderingAccounts length {false} repeat ] def /MirrorPagesCorkDisplay [ PageOrderingCorkDisplay length {false} repeat ] def /MirrorPagesNeckTags false def /MirrorPagesPrePour [ PageOrderingPrePourPages length {false} repeat ] def /MirrorPagesPlaceNames [ PageOrderingPlaceNames length {false} repeat ] def /MirrorPagesDecanterLabels [ PageOrderingDecanterLabels length {false} repeat ] def /MirrorPagesBottleWrap [ PageOrderingPrePourPages length {false} repeat ] def /MirrorPagesStickyLabels [ PageOrderingStickyLabels length {false} repeat ] def /MirrorPagesOneCircle false def /PagesToBeInserted false def /PagesToBeInsertedBeforeInstances [ 0 ] def /PagesToBeInsertedBeforeTypeOneOf [ [/VoteRecorder] ] def /PagesToBeInsertedDests [ /FoodOrder_0 ] def /PagesToBeInsertedNumPages [ 1 ] def /PagesToBeInsertedDescriptions [ (Food order) ] def /LicensingAgreementLinkPlacemats (http://creativecommons.org/licenses/by-sa/4.0/deed.en) def % To be consistent with LicensingAgreementTextPlacemats /PageLabelOverride false def % E.g., {/Glasses TypeOfPagesBeingRendered eq}. So far, used only in the generation of some of the documentation. /PageLabelOverrideWith {[(PageNum) ShownPages 5 string cvs]} def /PrologueCode {} def % Executed once, just before painting pages /EpilogueCode {} def % Executed once, just after painting pages /EmptyGlassesPageAtStart false def % Temporary page, to make PNG, to replace an image of a no-longer existing page on a server. /EmptyGlassesPageOrientation /Portrait def /OneCircleSuppressOtherPageTypes /OneCircles load false ne def % OneCircle always a separate document. /BottleWrapSuppressOtherPageTypes /BottleWrapNumCopies load 0 ne def % BottleWrap usually a separate document, people printing their page(s) in advance. /TestingSuppressPageTypes [ ] def % [ /Glasses 1 /TastingNotes 1 /VoteRecorder 1 /DecantingNotes 1 /Accounts 1 /CorkDisplay 1 /NeckTags 1 /PrePour 1 /PlaceName 1 /DecanterLabels 1 /BottleWrap 1 /OneCircle 1 /StickyLabels 1 ]. Also, no int, /DistillerLog /TestingMaxNumPagesToShow 2147483647 def /TestingShowThesePagesOnly null def % Either null, in which case having no effect, or an array of integers. If making a PDF for insertion to another doc, perhaps also "/pdfmark {cleartomark} def". /LogThisExtra () def /OutputLogToLog true def /OutputLogToPage true def /OutputLogToAnnotation OutputLogToPage not BottleWrapSuppressOtherPageTypes or OneCircleSuppressOtherPageTypes or def % Adds extra space in the logical page around the usual layout. ...Glasses... for glasses pages; other for all others. /OuterGlassesMarginL 0 def /OuterGlassesMarginR 0 def /OuterGlassesMarginT 0 def /OuterGlassesMarginB 0 def /OuterGlassesCropMarks true def /OuterMarginL 0 def /OuterMarginR 0 def /OuterMarginT 0 def /OuterMarginB 0 def /RandomisationSeed 1 def % Change for different randomisation (1 is the initial value for both GhostScript and Adobe Distiller). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Parameters above here; code below. %% Very likely, you don't want to touch anything below here. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % OVERVIEW % Navigation was always a difficult art, / Though with only one ship and one bell: / And he feared he must really decline, for his part, / Undertaking another as well. -- The Hunting of the Snark % Use the parameters to navigate the code. Choose a parameter that would be used in the code of interest, and command/control-F. % Code exists in effectively four layers. % 1. Innermost are various routines, some dedicated to this purpose, others more general in nature. % Those of a general nature work with compound strings (being a string, a glyph, an array of compound strings, % or within some limitations, code). Most of the re-usable code is described in % www.jdawiseman.com/papers/placemat/postscript_routines.html % 2. These are routines and linking code are bundled togther in various forms. A good PS->PDF converter % uses forms to re-use various picture fragments, reducing distil time and the size of the resultant PDF. % 3. The execform commands calling these forms lie in the ..InnerLoop code fragments. % These are not self-contained bits of tidy code: they are very much inline code fragments. % 4. These two are then called from the outermost substantial code, which is a nested loop, calling by % page-ordering parameter, within that by paper size, and within that by Name. % Slightly separate from this hierarchy are various pieces of debugging code. The operators GSave and % GRestore keep track of the size of the graphics stack, just to allow post-execution verification % that nothing remains on it. OutputToLog outputs stuff according to OutputLogToLog and OutputLogToPage. /usertimeStart usertime def /SoftwareVersionDateTimeAdobeFormat (D:202404141945) def /DeBugLevel 65535 def % Smaller numbers are smaller more-core routines. RandomisationSeed srand % Checks whether initial dictionary sizes are sufficient. It is neater that they are, even though redundant. % /dict {dup 1 add dict dup 3 -1 roll /DictionaryOriginalSize exch put} bind def % /end {currentdict /DictionaryOriginalSize known {DictionaryOriginalSize currentdict length 1 sub lt {() = TypeOfPagesBeingRendered = DictionaryOriginalSize = currentdict length 1 sub = (###) =} if} if end} bind def /RandMax 2147483647 def % 2^31 - 1, page 637 of PLRM3 /HalfRandMax RandMax 2 div def /IntegerMax 2147483647 def % 2^31 - 1, page 739 of PLRM3 /Pi 3.14159265358979323846 def /TwoPi 6.2831853071795864769 def /HalfPi 1.57079632679489661923 def /Sqrt2 1.4142135623730950488 def % Sqrt2 SqrtHalf mul not identical to 1. /Sqrt3 1.7320508075688772935 def /Sqrt5 2.2360679774997896964 def /SqrtSqrt2 1.1892071150027210667 def /SqrtSqrt12 1.8612097182041991979 def /SqrtHalf 0.7071067811865475244 def % SqrtHalf Sqrt2 mul not identical to 1. /SqrtSixth 0.4082482904638630163662 def /Sin15 0.2588190451025207623488988376 def % 3 sqrt 1 sub 8 sqrt div /Cos15 0.9659258262890682867497431997 def % 3 sqrt 1 add 8 sqrt div /Cos01Sqd 0.999695413509547865 def % N[Cos[1 Degree]^2, 18] /GoldenRatio 1.6180339887498948482 def % 5 sqrt 1 add 2 div /Root2Root3Minus3 0.68125003863321328 def % N[Sqrt[2 Sqrt[3] - 3], 17] /DegreeInRadians 0.0174532925199432957692369 def % pi / 180 /ArcCosMinusOneThird 109.471220634490691369 def % In degrees /ArcTanOneQuarter 14.03624346792647858289 def % In degrees /ArcTanFiveEighths 32.00538320808349556079 def % In degrees /Infinity 32767 def % 2^15-1, which in pt ~= 455" ~= 38' ~= 11.6m, so ~61% bigger than the ~283" diagonal of the 200"x200" maximum PDF page. Can be '8 exp 256.06251 mul' without overflow, as max float = 2 2 -23 exp sub 2 127 exp mul ~= 3.40282*10^38. /InfinityNeg Infinity neg def /Epsilon 0.00005 def % 23-bit mantissa is one part in 8,388,608. This is one part in 20k, and experimentally 839 times the single-precision minimum increment over 1. /PrinterEpsilon 0.01 def % 0.01 points is half a pixel at 3600 dpi. Also 163.84 times bigger than minimum single-precision increment over 17" = 1224pt. /PrinterEpsilonSquared PrinterEpsilon dup mul def /AsciiTab (\t) 0 get def /AsciiNewline (\n) 0 get def /AsciiSpace ( ) 0 get def /DeSizeRounding 64 def % 1000 just too big. 250 seems OK. This small for safety, and it's good enough for task. /OneThird 1 3 div def /Cbrt {dup dup 0 lt {neg //OneThird exp neg} {//OneThird exp} ifelse dup abs 1290 le {dup cvi dup dup mul mul 3 -1 roll eq {cvi} if} {exch pop} ifelse} bind def % 1290^3 < IntegerMax < 1291^3 /TypeOfPagesBeingRendered /Multiple def % Always being one of /Multiple /Glasses /TastingNotes /PlaceName /PrePour /VoteRecorder /DecantingNotes /Accounts /CorkDisplay /NeckTags /DecanterLabels /BottleWrap /StickyLabels /OneCircle /Empty /DistillerLog /UserScratchDict << >> def % Not 0 dict, to avoid addition of /DictionaryOriginalSize /execU { //UserScratchDict begin exec end} bind def /GetEU {get //UserScratchDict begin exec end} bind def /WithinPage-WithinTitles-def {/WithinPage exch def /WithinTitles //GlassesOnSheets SheetNum get //UserScratchDict begin exec WithinPage get exec end def} bind def /OutputLog 127 array def /OutputtedToLog 1 def OutputLog 0 (!!! Error !!! Error !!! An error occurred. More information below. !!! Error !!! Error !!!) put % This overwritten if all good. % If taking this because other subroutines are being copied, perhaps replace with /OutputToLog {dup type /stringtype eq {=} {==} ifelse flush} bind def /OutputToLog { 4 dict begin /Output exch def /ShowBlankLine //false def OutputLogToLog { /Output load type /stringtype eq { /i 0 def /j -1 def 0 1 Output length 1 sub { /j exch def Output j get //AsciiNewline eq {Output i j i sub getinterval dup length 0 gt /ShowBlankLine exch def = /i j 1 add def} if } for j i sub 1 add 0 ge {Output i j i sub 1 add getinterval dup length 0 gt /ShowBlankLine exch def =} if ShowBlankLine {() =} if } {/Output load ==} ifelse flush % ... /stringtype ... flush } if % OutputLogToLog OutputtedToLog OutputLog length ge {/OutputLog OutputLog length 2 mul 1 add dup 65535 le {array dup 0 OutputLog putinterval store} {pop pop} ifelse} if OutputtedToLog OutputLog length lt {OutputLog OutputtedToLog /Output load put /OutputtedToLog dup load 1 add store} if end } bind def % /OutputToLog /SuppressANN % http://groups.google.com/g/comp.lang.postscript/c/8V9XFDwuLPg /currentdistillerparams where { pop currentdistillerparams /CheckCompliance 2 copy known {get //false exch {dup /PDFX1a:2001 eq exch /PDFX3:2002 eq or or} forall} {pop pop //false} ifelse currentdistillerparams /PDFX1aCheck 2 copy known {get or} {pop pop} ifelse currentdistillerparams /PDFX3Check 2 copy known {get or} {pop pop} ifelse } {false} ifelse def % /SuppressANN /pdfmark where { false % Use testing routine? In user-distributed code should be false. {pop /pdfmark {dup == pdfmark} bind def} {pop /pdfmark {dup /ANN eq //SuppressANN and {cleartomark} {pdfmark} ifelse} bind def} ifelse % Use testing routine } {/globaldict where {pop globaldict} {userdict} ifelse /pdfmark /cleartomark load put} ifelse % /pdfmark where % http://groups.google.com/g/comp.lang.postscript/c/DWky6YmjQQI /NullDevices where {pop} {/NullDevices 31 array def NullDevices 0 0 put} ifelse % 5 would be enough. Done here to allow immediate execution. /CountGraphicsStack where {pop} { /CountGraphicsStack 0 def /GSave {/CountGraphicsStack CountGraphicsStack 1 add store //NullDevices CountGraphicsStack 2 copy 1 sub get put gsave} bind def /GRestore { CountGraphicsStack 0 le {(Error: number of calls of GRestore exceeds those of GSave.) dup = OutputToLog stop} if % So low-level that OutputToLog might fail. Hence also =ing. /CountGraphicsStack CountGraphicsStack 1 sub store grestore } bind def % /GRestore /NullDevice {//NullDevices CountGraphicsStack 2 copy get 1 add put nulldevice} bind def } ifelse % /CountGraphicsStack where /CountClipStack where {pop} { /CountClipStack 0 def /ClipSave {/CountClipStack CountClipStack 1 add store clipsave} bind def /ClipRestore { CountClipStack 0 le {(Error: number of calls of ClipRestore exceeds those of ClipSave.) dup = OutputToLog stop} if % So low-level that OutputToLog might fail. Hence also =ing. /CountClipStack CountClipStack 1 sub store cliprestore } bind def % /ClipRestore } ifelse % /CountClipStack where /Stopped {countdictstack exch /StoppedStackMarker exch stopped {{/StoppedStackMarker eq {exit} if} loop countdictstack sub neg {end} repeat //true} {count 1 sub 0 exch 1 exch {dup 1 add index /StoppedStackMarker eq {exit} {pop} ifelse} for 2 add -2 roll pop pop //false} ifelse} bind def % /Stopped /ShellSortGaps [ % ShellSort is very fast at short arrays, but QuickSort's segregation helps multi-CPU with long arrays. % PostScript's max array size usually 65535 (PLRM3, p739, table B.1), but an implementation could allow longer. % Included are those up to PostScript's max integer = 2^31 - 1, subsequent being commented out. % From http://en.wikipedia.org/wiki/Shellsort % > Gonnet and Baeza-Yates observed that Shellsort makes the fewest comparisons on average when the ratios of successive gaps are % > roughly equal to 2.2. This is why their sequence with ratio 2.2 and Tokuda's sequence with ratio 2.25 prove efficient. However, % > it is not known why this is so. Sedgewick recommends using gaps which have low greatest common divisors or are pairwise coprime. % Here each is closest to immediately previous * Sqrt5 that is coprime to all smaller, % so ratios tend to ~=2.236. From values of 83 the ratios >2.2358 and <2.2531. 1 3 7 16 37 83 187 419 937 2099 4693 10499 23479 52501 % Below 2^16 = 65536, so sufficient for PostScript. 117391 262495 586961 1312481 2934793 6562397 14673961 32811973 73369801 164059859 366848983 820299269 1834244921 % Below 2^31 ~= 2 billion % 4101496331 9171224603 20507481647 45856123009 102537408229 229280615033 512687041133 1146403075157 2563435205663 5732015375783 % 12817176028331 28660076878933 64085880141667 143300384394667 320429400708323 716501921973329 1602147003541613 3582509609866643 % 8010735017708063 17912548049333207 40053675088540303 89562740246666023 200268375442701509 447813701233330109 % 1001341877213507537 2239068506166650537 5006709386067537661 11195342530833252689 % Below 2^64 ~= 18 quintillion ] readonly def % /ShellSortGaps /ShellSortGapsLength1Sub ShellSortGaps length 1 sub def % Immediate dependencies: DeBugLevel; ShellSortGaps; ShellSortGapsLength1Sub. % [ thing thing ... ] {comparison code that takes two things and returns a boolean} ShellSort - % Sorts array such that for elements i and i+1 the comparison code returns true (or equal). % E.g., [1 2 3 4 5 2. 3. 4. 5. 3 4 5 4. 5. 5] dup {le} ShellSort == outputs [1 2 2.0 3 3 3.0 4 4.0 4 4.0 5 5 5.0 5.0 5] % Based on http://www.tutorialspoint.com/data_structures_algorithms/shell_sort_algorithm.htm /ShellSort { //DeBugLevel 25 le {(+ShellSort) OutputToLog} if 8 dict begin /ComparisonCode exch def /Things exch def /n Things length def n 2 ge { 1 1 //ShellSortGapsLength1Sub { /gapNum exch def //ShellSortGaps gapNum get n gt {/gapNum gapNum 1 sub def exit} if } for % gapNum up gapNum -1 0 { //ShellSortGaps exch get /gap exch def gap 1 n 1 sub { /outer exch def /valueToInsert Things outer get def /inner outer def { inner gap lt {exit} if Things inner gap sub get valueToInsert ComparisonCode {exit} if Things inner Things inner gap sub get put /inner inner gap sub def } loop % inner Things inner valueToInsert put } for % outer } for % gap down } if % n 2 ge end //DeBugLevel 25 le {(-ShellSort) OutputToLog} if } bind def % /ShellSort currentdict /ShellSortGaps undef currentdict /ShellSortGapsLength1Subs undef % Immediate dependencies: DeBugLevel; OutputToLog. % [ c0 c1 ... ] LowerLimit UpperLimit Tolerance PolynomialRoot root true | false /PolynomialRoot { //DeBugLevel 5 le {(+PolynomialRoot) OutputToLog} if 10 dict begin /Tolerance exch def /UpperX exch def /LowerX exch def /Coeffs exch def /Alternation //false def 1 { 0 Coeffs length 1 sub -1 0 {exch LowerX mul exch Coeffs exch get add} for /LowerY exch def LowerY 0 eq {LowerX //true exit} if 0 Coeffs length 1 sub -1 0 {exch UpperX mul exch Coeffs exch get add} for /UpperY exch def UpperY 0 eq {UpperX //true exit} if LowerY 0 le UpperY 0 ge and LowerY 0 ge UpperY 0 le and or % Multiplication before testing would risk an overflow error { /StepsRemaining 120 def % ln(0.01/32767)/ln(0.857) ~= 97.2, plus spares is 120. Experimentally, 30 would have been more than enough. { StepsRemaining 0 le {UpperX LowerX sub abs Tolerance le {X //true} {//false} ifelse exit} if /X LowerY dup UpperY sub div Alternation {dup 0.143 lt {pop 0.143} {dup 0.857 gt {pop 0.857} if} ifelse} if UpperX LowerX sub mul LowerX add def % Constant good enough but approximate. Not known whether one/six seventh(s). /Y 0 Coeffs length 1 sub -1 0 {exch X mul exch Coeffs exch get add} for def Y 0 eq {X //true exit} if Y 0 gt LowerY 0 gt and Y 0 lt LowerY 0 lt and or {/LowerX /LowerY} {/UpperX /UpperY} ifelse Y def X def /StepsRemaining StepsRemaining 1 sub def UpperX LowerX sub abs Tolerance le {/Alternation //false def StepsRemaining 2 gt {/StepsRemaining 2 def} if} {/Alternation Alternation not def} ifelse % ... Tolerance le } loop % StepsRemaining } {//false exit} ifelse % LowerY UpperY different sides of 0 } repeat % 1 end //DeBugLevel 5 le {(-PolynomialRoot) OutputToLog} if } bind def % PolynomialRoot % Immediate dependencies: DeBugLevel; OutputToLog; IntegerMax; Epsilon; OneThird; Cbrt; PolynomialRoot; ShellSort; Stopped. % [ c0 c1 ... ] LimitLower StrictLower LimitUpper StrictUpper Tolerance PolynomialRoots [ in-range values of x ] % For polynomials of degree up to cubic, all roots found analytically, and Tolerance ignored. % Of higher degree: to within Tolerance; repeated roots can be problematic; out-of-range errors possible as PostScript's maximum float ~= 1.7 * 10^38. /PolynomialRoots { //DeBugLevel 5 le {(+PolynomialRoots) OutputToLog} if 25 dict begin /Tolerance exch def /StrictUpper exch def /LimitUpper exch def /StrictLower exch def /LimitLower exch def /Coeffs exch def Coeffs length 1 sub -1 0 {Coeffs exch get 0 eq {/Coeffs Coeffs dup length 1 sub 0 exch getinterval def} {exit} ifelse} for % Removes top powers with 0 coefficient. Coeffs length 2 ge { /CoeffsScaled 0 Coeffs {abs 2 copy lt {exch} if pop} forall dup //IntegerMax gt {/MaxAbs exch def [ Coeffs {MaxAbs div} forall ] } {pop Coeffs} ifelse def % Large coeffs risk overflow: rescale; don't add another machine-precision error to small. 0 1 CoeffsScaled length 1 sub {/ExtraZeroes exch def CoeffsScaled ExtraZeroes get 0 ne {exit} if} for ExtraZeroes 0 gt {/CoeffsScaled CoeffsScaled ExtraZeroes CoeffsScaled length ExtraZeroes sub getinterval def} if % Counts and remove roots of 0. 1 { //true 1 2 CoeffsScaled length 1 sub {CoeffsScaled exch get 0 ne {pop //false exit} if} for % Odd coefficients all zero? { [ [ 0 2 CoeffsScaled length 1 sub {CoeffsScaled exch get} for ] LimitLower dup mul LimitUpper dup mul 2 copy gt {exch} if LimitLower LimitUpper mul 0 le {exch pop 0 exch} if //false exch //false % Not strict as later sqrt will introduce machine-precision error. Filtered later. Tolerance 16 div PolynomialRoots {sqrt dup neg} forall % Tolerance not correct here because roots are squares. ] exit } if % Odd coefficients all zero? CoeffsScaled length 4 gt { /DerivCoeffs [1 1 CoeffsScaled length 1 sub {dup CoeffsScaled exch get mul} for] def /DerivRoots DerivCoeffs LimitLower //true LimitUpper //true Tolerance PolynomialRoots dup {le} ShellSort def % Strict because test bounds anyway. [ -1 1 DerivRoots length 1 sub { /i exch def /ThisLower i 0 ge {DerivRoots i get} {LimitLower} ifelse def /ThisUpper i DerivRoots length 2 sub le {DerivRoots i 1 add get} {LimitUpper} ifelse def CoeffsScaled ThisLower ThisUpper Tolerance PolynomialRoot i 0 ge and {dup ThisLower le {pop} if} if } for % i ] exit } if % CoeffsScaled length 4 gt % Otherwise cubic or shorter [ /c0 CoeffsScaled length 0 gt {CoeffsScaled 0 get} {0} ifelse def /c1 CoeffsScaled length 1 gt {CoeffsScaled 1 get} {0} ifelse def /c2 CoeffsScaled length 2 gt {CoeffsScaled 2 get} {0} ifelse def /c3 CoeffsScaled length 3 gt {CoeffsScaled 3 get} {0} ifelse def c3 abs 1e15 lt dup {pop c0 abs c1 abs c2 abs 2 {2 copy lt {exch} if pop} repeat c3 abs 1e15 mul gt} if % c3 ~= 0? { % So c3 is 0 or almost 0. c2 0 eq { c1 0 ne {c0 c1 div neg} if }{ /determ c1 c1 mul c2 c0 mul 4 mul sub def determ 0 ge { c1 -2 c2 mul div determ sqrt 2 c2 mul div 2 copy add 3 1 roll sub }{ % Single-precision limitations can make determ appear to be negative. So check for roots near '-b/2a'. We know 'a' non-zero. [ c0 c1 c2 ] c1 -2 div c2 div dup c1 dup mul c2 c0 mul abs 4 mul add //Epsilon mul 2 mul sqrt 4 copy sub exch 0 PolynomialRoot {5 1 roll} if add 0 PolynomialRoot pop } ifelse % determ 0 ge } ifelse % c2 0 eq }{ % So c3 is materially non-zero. /f c1 c3 div c2 c3 div dup mul 3 div sub def /g c2 c3 div dup dup mul mul 2 mul 9 c1 c3 div mul c2 c3 div mul sub 27 div c0 c3 div add def /h g g mul 4 div f f f mul mul 27 div add def h 0 ge { f 0 eq g 0 eq and { c0 c3 div Cbrt neg dup dup }{ g -2 div h sqrt 2 copy add Cbrt 3 1 roll sub Cbrt add c2 c3 3 mul div sub } ifelse % f 0 eq g 0 eq h 0 eq and and }{ /i f -3 div dup sqrt mul def /j i //OneThird exp def /k g i i mul 4 mul g g mul sub sqrt atan 90 add def /m k 3 div cos def /n 1 m m mul sub 3 mul sqrt def j m mul 2 mul c2 c3 3 mul div sub m n add j mul neg c2 c3 3 mul div sub m n sub j mul neg c2 c3 3 mul div sub } ifelse % h 0 ge } ifelse % c3 is within a machine precision of zero ] exit } repeat % 1 [ % Polish with at most a dozen steps of Newton Raphson, then check limits. For precision polish with Coeffs, not CoeffsScaled. exch { /X exch def /Y 0 Coeffs length 1 sub -1 0 {exch X mul exch Coeffs exch get add} for def Y 0 ne {12} {0} ifelse { /Deriv 0 Coeffs length 1 sub -1 1 {dup 3 -1 roll X mul 3 1 roll Coeffs exch get mul add} for def Deriv abs 0 gt { /NewX X Y Deriv div sub def NewX X eq {exit} if /NewY 0 Coeffs length 1 sub -1 0 {exch NewX mul exch Coeffs exch get add} for def NewY 0 eq {/X NewX def exit} if NewY abs Y abs lt {/X NewX store /Y NewY store} {exit} ifelse } {exit} ifelse % Deriv abs 0 gt } repeat X LimitUpper StrictUpper {lt} {le} ifelse X LimitLower StrictLower {gt} {ge} ifelse and {X} if } forall LimitLower 0 StrictLower {lt} {le} ifelse LimitUpper 0 StrictUpper {gt} {ge} ifelse and {ExtraZeroes {0} repeat} if ] } {[]} ifelse % Coeffs length 1 ge end //DeBugLevel 5 le {(-PolynomialRoots) OutputToLog} if } bind def % /PolynomialRoots /NumSheets GlassesOnSheets length def /SheetLengths [ 0 1 NumSheets 1 sub {/SheetNum exch def GlassesOnSheets SheetNum GetEU length} for ] def % Immediate dependencies: SheetNum, Radii, GlassPositions, PolynomialRoots, PrinterEpsilon % WithinPageFrom WithinPageTo GapFromCircles OffsetRightBool OffsetMin TargetLength HeadLength HeadWidth {PathCode} HeadFromBool HeadToBool {HeadCode} ArrowCircleToCircle - % WithinPageTo is either an integer, or an array [x y]. /ArrowCircleToCircle_CanWarn [ NumSheets {//true} repeat ] def /ArrowCircleToCircle { //DeBugLevel 25 le {(+ArrowCircleToCircle) OutputToLog} if 24 dict begin /HeadCode exch def /HeadTo exch def /HeadFrom exch def /PathCode exch def /HeadWidth exch def /HeadLength exch def /TargetLength exch def /OffsetMin exch def /OffsetRight exch def /GapFromCircles exch def /WithinPageTo exch def /WithinPageFrom exch def GlassPositions SheetNum get WithinPageFrom get aload pop /yF exch def /xF exch def 1 { TargetLength 0 le {exit} if /r Radii SheetNum get GapFromCircles add def /arraytype WithinPageTo type eq {WithinPageTo} {GlassPositions SheetNum get WithinPageTo get} ifelse aload pop /yT exch def /xT exch def /dist2 xF xT sub dup mul yF yT sub dup mul add def dist2 r dup mul le {exit} if % ==> strictly positive /dist dist2 sqrt def /offset dist TargetLength 2 mul mul dist2 sub r dup mul 4 mul add TargetLength dup mul sub dup 0 gt {sqrt -2 OffsetRight {neg} if div} {pop 0} ifelse dup abs OffsetMin abs lt {pop OffsetMin abs OffsetRight not {neg} if} if def % /offset << /offsetX yT yF sub dist div offset mul /offsetY xF xT sub dist div offset mul >> begin /xF dup load offsetX add store /xT dup load offsetX add store /yF dup load offsetY add store /yT dup load offsetY add store end % Boundary from circle /ratio GlassPositions SheetNum get WithinPageFrom get aload pop /yC exch def /xC exch def [ xC xF sub dup mul yC yF sub dup mul add r dup mul sub xC xF sub xF xT sub mul yC yF sub yF yT sub mul add 2 mul xF xT sub dup mul yF yT sub dup mul add ] -0.1 //false 1 //true //Epsilon PolynomialRoots Min def % /ratio ratio 0 le {exit} if % This, and the -0.1, in case starting point very near another circle ratio 1 lt { /xF xT xF sub ratio mul xF add def /yF yT yF sub ratio mul yF add def } if % ratio 1 lt % Trim length to TargetLength /dist xF xT sub dup mul yF yT sub dup mul add sqrt def /ratio TargetLength dist div def ratio 1 lt { /xT xT xF sub ratio mul xF add def /yT yT yF sub ratio mul yF add def } if % ratio 1 lt /ratio mark % Trim to margins xT xF //PrinterEpsilon add gt {PageWidth MgnR sub xF sub xT xF sub div} if yT yF //PrinterEpsilon add gt {PageHeight MgnT sub yF sub yT yF sub div} if xT xF //PrinterEpsilon sub lt { MgnL xF sub xT xF sub div} if yT yF //PrinterEpsilon sub lt { MgnB yF sub yT yF sub div} if MinToMark % Avoid collision with other circles /CanWarn //false def 0 1 GlassPositions SheetNum get length 1 sub { dup WithinPageFrom ne { GlassPositions SheetNum get exch get aload pop /yC exch def /xC exch def [ xC xF sub dup mul yC yF sub dup mul add r dup mul sub xC xF sub xF xT sub mul yC yF sub yF yT sub mul add 2 mul xF xT sub dup mul yF yT sub dup mul add ] -0.1 //false 1 //true //Epsilon PolynomialRoots Min 2 copy gt {exch /CanWarn //true def} if pop } {pop} ifelse % ... WithinPageFrom ne } for % WithinPage def % /ratio ratio 0 le {exit} if % This, and the -0.1, in case starting point very near another circle ratio 1 lt { /xT xT xF sub ratio mul xF add def /yT yT yF sub ratio mul yF add def CanWarn TargetLength r //Root2Root3Minus3 mul ge //ArrowCircleToCircle_CanWarn SheetNum get and and { mark (Warning: in ArrowCircleToCircle, SheetNum=) SheetNum ( WithinPageFrom=) WithinPageFrom /arraytype WithinPageTo type ne {( WithinPageTo=) WithinPageTo} if (, generally recommend TargetLength < \(Radius + GapFromCircles\) * Sqrt[2 Sqrt3 - 3]\n~= ) (\() Radii SheetNum get ( + ) GapFromCircles (\) * ) //Root2Root3Minus3 ( ~= ) r //Root2Root3Minus3 mul (pt.) ConcatenateToMark OutputToLog //ArrowCircleToCircle_CanWarn SheetNum //false put } if % Long, and not yet warned } if % ratio 1 lt /dist xF xT sub dup mul yF yT sub dup mul add sqrt def HeadFrom HeadTo or {HeadFrom HeadTo and {HeadLength dist 2.5 div ge {/HeadWidth dist 2.5 div HeadWidth mul HeadLength div def /HeadLength dist 2.5 div def} if} {HeadLength dist 1.5 div ge {/HeadWidth dist 1.5 div HeadWidth mul HeadLength div def /HeadLength dist 1.5 div def} if} ifelse} if % HeadFrom HeadTo ... 0.48 setlinewidth 0 setgray 0 setlinecap 0 setlinejoin [] 0 setdash GSave /ratio 1 HeadLength 0.06 sub dist div sub def % Bigger overlap than PrinterEpsilon. HeadFrom {xF xT sub ratio mul xT add yF yT sub ratio mul yT add} {xF yF} ifelse moveto HeadTo {xT xF sub ratio mul xF add yT yF sub ratio mul yF add} {xT yT} ifelse lineto PathCode GRestore [ HeadFrom { [xT xF sub yF yT sub atan xF yF] } if HeadTo { [xF xT sub yT yF sub atan xT yT] } if ]{ GSave aload pop translate rotate 0.96 setlinewidth 0 0 moveto HeadWidth 2 div HeadLength neg rlineto HeadWidth neg 0 rlineto closepath HeadCode GRestore } forall % Heads, From and To } repeat % 1 end //DeBugLevel 25 le {(-ArrowCircleToCircle) OutputToLog} if } bind def % /ArrowCircleToCircle currentdict /ArrowCircleToCircle_CanWarn undef % string string Concatenate string /Concatenate { 2 copy length exch length dup 3 1 roll add dup 65535 le {string dup dup 5 3 roll exch putinterval 3 -1 roll 0 exch putinterval} {pop exch pop dup 65532 le {dup 3 add string dup dup 4 -1 roll (...) putinterval 0 4 -1 roll putinterval} {pop} ifelse} ifelse } bind def % /Concatenate % Immediate dependencies: ToString. % mark string|number|other ... string|number|other ConcatenateToMark string /ConcatenateToMark { 4 dict begin counttomark /ctm exch def /n 0 def ctm {ToString dup length n add /n exch def ctm 1 roll} repeat /p 0 def /s n 65535 2 copy gt {exch} if pop string def ctm -1 0 { dup 0 gt { -1 roll dup length p add 65532 le {s exch p exch dup length p add /p exch def putinterval} {s exch p exch 0 65532 p sub getinterval putinterval s 65532 (...) putinterval cleartomark s exit} ifelse % too long } {pop pop s} ifelse } for end } bind def % /ConcatenateToMark % thing DepthOverWhichArraysAndDictsSeparatedWithNewlines ShowStringBrackets ThingToDebugText - /ThingToDebugText {12 ThingToDebugTextRecursive} bind def % Thing DepthOverWhichArraysAndDictsSeparatedWithNewlines ShowStringBrackets DepthMax ThingToDebugTextRecursive - /ThingToDebugTextRecursive { 6 dict begin /DepthMax exch def /ShowStringBrackets exch def /DepthLines exch def /Thing exch def /Separator ( ) def DepthLines 0 gt {Separator 0 12 put} if DepthMax 0 ge { 1 { /Thing load dup xcheck exch cvlit type /arraytype eq and { mark ({ ) /Thing load cvlit {DepthLines ShowStringBrackets DepthMax 1 sub ThingToDebugTextRecursive} forall (} ) ConcatenateToMark % use same DepthLines exit } if % xcheck and array /Thing load type /operatortype eq { /Thing load cvlit 127 string cvs ( ) Concatenate exit } if % /operatortype /Thing load dup xcheck exch cvlit type /nametype eq and { /Thing load cvlit 127 string cvs ( ) Concatenate exit } if % /operatortype /Thing load type /nametype eq { /Thing load 127 string cvs ( ) Concatenate dup 0 1 getinterval (/) ne {(/) exch Concatenate} if exit } if % /nametype /Thing load type /stringtype eq { /Thing load rcheck { mark ShowStringBrackets {(\() /Thing load (\) )} {/Thing load ( )} ifelse ConcatenateToMark exit } {(--string--)} ifelse % /Thing load rcheck } if % /stringtype /Thing load type dup /arraytype eq exch /packedarraytype eq or { /Thing load rcheck { mark ([) Separator /Thing load {DepthLines 0 gt {DepthLines 1 sub} {0} ifelse ShowStringBrackets DepthMax 1 sub ThingToDebugTextRecursive DepthLines 0 gt {Separator} if} forall (]) Separator ConcatenateToMark }{ /Thing load type /arraytype eq {(--array--)} {(--packedarray--)} ifelse } ifelse % /Thing load rcheck exit } if % /arraytype /packedarraytype /Thing load type /dicttype eq { /Thing load rcheck { mark (<) Separator /Thing load {pop DepthLines 0 gt {DepthLines 1 sub} {0} ifelse ShowStringBrackets DepthMax 1 sub ThingToDebugTextRecursive DepthLines 0 gt {Separator} if} forall (>) Separator ConcatenateToMark } {(--dict-- )} ifelse % /Thing load rcheck exit } if % /dicttype /Thing load type /booleantype eq {/Thing load {(true )} {(false )} ifelse exit} if /Thing load type dup /integertype eq exch /realtype eq or { /Thing load 16 string cvs ( ) Concatenate exit } if % /integertype /realtype /Thing load type /marktype eq {(mark ) exit} if % /marktype /Thing load type /nulltype eq {(null ) exit} if /Thing load type /filetype eq {(--file-- ) exit} if /Thing load type /fonttype eq {(--font-- ) exit} if /Thing load type /gstatetype eq {(--gstate-- ) exit} if /Thing load type /savetype eq {(--save-- ) exit} if % otherwise mark (--) /Thing load type 127 string cvs (-- ) ConcatenateToMark exit } repeat % 1 } {( ... )} ifelse % DepthMax 0 ge end } bind def % /ThingToDebugTextRecursive /ToString { 1 dict begin dup type cvlit /Type exch def 1 { Type /integertype eq {11 string cvs exit ( ) Concatenate} if Type /realtype eq {16 string cvs exit ( ) Concatenate} if Type /nametype eq {dup length string cvs exit} if Type /stringtype eq {exit} if Type /booleantype eq {5 string cvs exit} if Type /operatortype eq {127 string cvs exit} if Type /marktype eq {pop (mark) exit} if Type /nulltype eq {pop (null) exit} if 0 //true ThingToDebugText % fall-back } repeat end } bind def % /ToString % Immediate dependencies: ConcatenateToMark. % num int FormatDecimalPlaces string /FormatDecimalPlaces { 3 dict begin /dp exch def /num exch def dp 0 gt { 10 dp exp dup num mul round exch div 15 string cvs 0 1 dp {/i exch def dup dup length 1 sub i sub 1 getinterval (.) eq {exit} if} for i dp lt {mark exch dp i sub {(0)} repeat ConcatenateToMark} if }{ 10 dp neg exp cvi dup num exch div round cvi exch mul 15 string cvs } ifelse % dp 0 gt end } bind def % FormatDecimalPlaces /TruncateTo255 {dup length 255 gt {0 254 getinterval (\203) Concatenate} if} bind def /TerminatingFullStopAppend { counttomark { dup type /stringtype ne {exit} if % Hopefully never reached. dup length {dup dup length 1 sub get //AsciiSpace eq {dup length 1 sub 0 exch getinterval} {exit} ifelse} repeat dup length 0 gt { dup dup length 1 sub 1 getinterval (.) ne {(.)} if exit } {pop} ifelse % length 0 gt } repeat % counttomark } bind def % /TerminatingFullStopAppend % name|code WatchExpression_MakeString (string) /WatchExpression_MakeString { 1 dict begin /param exch def mark /param load ToString /param load dup type /nametype eq exch xcheck or {( = ) param /param load type /nametype eq {dup where {pop cvx exec} {pop (--Undefined--)} ifelse} if} {(WatchExpression: ) exch} ifelse end ConcatenateToMark } bind def % /WatchExpression_MakeString % name|code WatchExpression - /WatchExpression {WatchExpression_MakeString OutputToLog} def % [ name|code ... ] WatchExpressions - /WatchExpressions {mark exch () exch {WatchExpression_MakeString (\n)} forall pop ConcatenateToMark OutputToLog} bind def % WatchExpressions, plural % array, perhaps nested AllEqual, returning either false or value true /AllEqual { 3 dict begin /ValueAssigned //false def /ValuesAllEqual //true def /Value //null def AllEqualRec ValuesAllEqual ValueAssigned and {/Value load //true} {//false} ifelse end } bind def % /AllEqual /AllEqualRec { ValuesAllEqual { 1 dict begin /param exch def /param load dup xcheck not exch type /arraytype eq and { param {AllEqualRec ValuesAllEqual not {exit} if} forall }{ ValueAssigned {/Value load /param load ne {/ValuesAllEqual //false store} if} {/Value /param load store /ValueAssigned //true store} ifelse % ValueAssigned } ifelse % ... xcheck not ... /arraytype end } {pop} ifelse % ValuesAllEqual } bind def % /AllEqualRec /SizeArrayOutput {mark 3 1 roll dup LengthCompoundObject 1 gt {dup AllEqual} {//false} ifelse {exch pop (, all of them)} {0 //false ThingToDebugText} ifelse ConcatenateToMark} bind def /GlyphToASCII << /adieresis (ae) /Adieresis (Ae) /odieresis (oe) /Odieresis (Oe) /udieresis (ue) /Udieresis (Ue) /aring (aa) /Aring (Aa) /oslash (oe) /Oslash (Oe) /scaron (sh) /Scaron (Sh) /zcaron (zh) /Zcaron (Zh) /quotedbl (") /quotedblleft 1 index /quotedblright 1 index /second 1 index /quotesingle (') /quoteleft 1 index /quoteright 1 index /minute 1 index /question (?) /questiondown (?) /exclam (!) /exclamdown (!) /less (<) /greater (>) /lessequal (<=) /greaterequal (>=) /approxequal (~=) /multiply (*) /divide (/) /plus (+) /fraction (/) /dagger (+) /daggerdbl (++) /lozenge (<>) /bullet (O) /bar (|) /verticalbar (|) /brokenbar (|) /periodcentered (.) /club (Club) /diamond (Diamond) /heart (Heart) /spade (Spade) /sterling (GBP) /dollar ($) /Euro (EUR) /euro 1 index /yen (Y) % yen can be JPY or CNY /ellipsis (...) /emdash (--) /endash (-) /minus (-) /eth (d) /Eth (D) /dotlessi (i) /oneeighth ( 1/8 ) /onequarter ( 1/4 ) /onethird ( 1/3 ) /threeeighths ( 3/8 ) /onehalf ( 1/2 ) /fiveeighths ( 5/8 ) /twothirds ( 2/3 ) /threequarters ( 3/4 ) /seveneighths ( 7/8 ) /registered (\(R\)) /trademark (\(TM\)) /arrowup (^) /arrowdown (\\/) /arrowleft (<--) /arrowright (-->) /arrowboth (<-->) /zerosuperior (^0) /onesuperior (^1) /twosuperior (^2) /threesuperior (^3) /foursuperior (^4) /fivesuperior (^5) /sixsuperior (^6) /sevensuperior (^7) /eightsuperior (^8) /ninesuperior (^9) /zeroinferior (_0) /oneinferior (_1) /twoinferior (_2) /threeinferior (_3) /fourinferior (_4) /fiveinferior (_5) /sixinferior (_6) /seveninferior (_7) /eightinferior (_8) /nineinferior (_9) /a (a) /b (b) /c (c) /d (d) /e (e) /f (f) /g (g) /h (h) /i (i) /j (j) /k (k) /l (l) /m (m) /n (n) /o (o) /p (p) /q (q) /r (r) /s (s) /t (t) /u (u) /v (v) /w (w) /x (x) /y (y) /z (z) /A (A) /B (B) /C (C) /D (D) /E (E) /F (F) /G (G) /H (H) /I (I) /J (J) /K (K) /L (L) /M (M) /N (N) /O (O) /P (P) /Q (Q) /R (R) /S (S) /T (T) /U (U) /V (V) /W (W) /X (X) /Y (Y) /Z (Z) /zero (0) /one (1) /two (2) /three (3) /four (4) /five (5) /six (6) /seven (7) /eight (8) /nine (9) /parenleft (\() /parenright (\)) /bracketleft ([) /bracketright (]) /braceleft ({) /braceright (}) /comma (,) /semicolon (;) /colon (:) /period (.) /equal (=) /asterisk (*) /hyphen (-) /percent (%) /asciicircum (^) /ampersand (&) /slash (/) /backslash (\\) /grave (`) /numbersign (#) /at (@) /uni1D00 (A) /uni0299 (B) /uni1D04 (C) /uni1D05 (D) /uni1D07 (E) /uniA730 (F) /uni0262 (G) /uni029C (H) /uni026A (I) /uni1D0A (J) /uni1D0B (K) /uni029F (L) /uni1D0D (M) /uni0274 (N) /uni1D0F (O) /uni1D18 (P) /uni0280 (R) /uniA731 (S) /uni1D1B (T) /uni1D1C (U) /uni1D20 (V) /uni1D21 (W) /uni028F (Y) /uni1D22 (Z) /uni1D01 (AE) /uni0276 (OE) /uni2626 (Orthodox cross) /uni2628 (Lorraine cross) /uni2629 (Jerusalem cross) /uni2670 (West Syriac cross) /uni2671 (East Syriac cross) /uni2720 (Maltese cross) % These few lines best in font /Menlo-Regular or /Menlo-Bold /uni263F (Mercury) /uni2640 (Venus) /uni2641 (Earth) /uni2642 (Mars) /uni2643 (Jupiter) /uni2644 (Saturn) /uni2645 (Uranus) /uni2646 (Neptune) /uni2647 (Pluto) /uni2648 (Aries) /uni2649 (Taurus) /uni264A (Gemini) /uni264B (Cancer) /uni264C (Leo) /uni264D (Virgo) /uni264E (Libra) /uni264F (Scorpius) /uni2650 (Sagittarius) /uni2651 (Capricorn) /uni2652 (Aquarius) /uni2653 (Pisces) /uni2654 (King white) /uni2655 (Queen white) /uni2656 (Rook white) /uni2657 (Bishop white) /uni2658 (Knight white) /uni2659 (Pawn white) /uni265A (King black) /uni265B (Queen black) /uni265C (Rook black) /uni265D (Bishop black) /uni265E (Knight black) /uni265F (Pawn black) >> dup {readonly pop pop} bind forall readonly def % /GlyphToASCII /GlyphToPDFDocEncoding << % Appendix D of PDF 32000-1:2008 /breve (\030) /caron (\031) /circumflex (\032) /dotaccent (\033) /hungarumlaut (\034) /ogonek (\035) /ring (\036) /tilde (\037) /braceleft (\173) /bar (\174) /braceright (\175) /asciitilde (\176) /bullet (\200) /dagger (\201) /daggerdbl (\202) /ellipsis (\203) /emdash (\204) /endash (\205) /florin (\206) /fraction (\207) /guilsinglleft (\210) /guilsinglright (\211) /minus (\212) /perthousand (\213) /quotedblbase (\214) /quotedblleft (\215) /quotedblright (\216) /quoteleft (\217) /quoteright (\220) /quotesinglbase (\221) /trademark (\222) /fi (\223) /fl (\224) /Lslash (\225) /OE (\226) /Scaron (\227) /Ydieresis (\230) /Zcaron (\231) /dotlessi (\232) /lslash (\233) /oe (\234) /scaron (\235) /zcaron (\236) /Euro (\240) /exclamdown (\241) /cent (\242) /sterling (\243) /currency (\244) /yen (\245) /brokenbar (\246) /section (\247) /dieresis (\250) /copyright (\251) /ordfeminine (\252) /guillemotleft (\253) /logicalnot (\254) /registered (\256) /macron (\257) /degree (\260) /plusminus (\261) /twosuperior (\262) /threesuperior (\263) /acute (\264) /mu (\265) /paragraph (\266) /periodcentered (\267) /cedilla (\270) /onesuperior (\271) /ordmasculine (\272) /guillemotright (\273) /onequarter (\274) /onehalf (\275) /threequarters (\276) /questiondown (\277) /Agrave (\300) /Aacute (\301) /Acircumflex (\302) /Atilde (\303) /Adieresis (\304) /Aring (\305) /AE (\306) /Ccedilla (\307) /Egrave (\310) /Eacute (\311) /Ecircumflex (\312) /Edieresis (\313) /Igrave (\314) /Iacute (\315) /Icircumflex (\316) /Idieresis (\317) /Eth (\320) /Ntilde (\321) /Ograve (\322) /Oacute (\323) /Ocircumflex (\324) /Otilde (\325) /Odieresis (\326) /multiply (\327) /Oslash (\330) /Ugrave (\331) /Uacute (\332) /Ucircumflex (\333) /Udieresis (\334) /Yacute (\335) /Thorn (\336) /germandbls (\337) /agrave (\340) /aacute (\341) /acircumflex (\342) /atilde (\343) /adieresis (\344) /aring (\345) /ae (\346) /ccedilla (\347) /egrave (\350) /eacute (\351) /ecircumflex (\352) /edieresis (\353) /igrave (\354) /iacute (\355) /icircumflex (\356) /idieresis (\357) /eth (\360) /ntilde (\361) /ograve (\362) /oacute (\363) /ocircumflex (\364) /otilde (\365) /odieresis (\366) /divide (\367) /oslash (\370) /ugrave (\371) /uacute (\372) /ucircumflex (\373) /udieresis (\374) /yacute (\375) /thorn (\376) /ydieresis (\377) >> dup {readonly pop pop} bind forall readonly def % /GlyphToPDFDocEncoding % CompoundString ASCIIfy string, the string being an all-ASCII approximation to the CompoundString /ASCIIfy { //DeBugLevel 15 le {(+ASCIIfy) OutputToLog} if 3 dict begin /param exch def /param load xcheck { UserScratchDict /AsciiEquivalent undef GSave NullDevice /Courier 10 selectfont 0 0 moveto [ [/param load /execU cvx] cvx Stopped pop] GRestore UserScratchDict /AsciiEquivalent 2 copy known {2 copy get 4 1 roll undef ASCIIfy Concatenate} {pop pop ASCIIfy} ifelse } {1 { param type /stringtype eq {param exit} if param type /arraytype eq {mark param {ASCIIfy} forall ConcatenateToMark exit} if param type /integertype eq {param ToString exit} if param type /realtype eq {param ToString exit} if param type /nametype eq { GlyphToASCII param known {GlyphToASCII param get} { /paramlength param length def param ToString % default [ (acute) (circumflex) (grave) (dieresis) (tilde) (cedilla) (slash) (ring) (ringacute) (breve) (macron) (ogonek) (caron) (dot) (dotaccent) (hungarumlaut) (bar) (commaaccent) (croat) ] { /diacritic exch def paramlength diacritic length sub dup 1 ge exch 2 le and { dup paramlength diacritic length sub diacritic length getinterval diacritic eq {0 paramlength diacritic length sub getinterval exit} if % ... diacritic eq } if % param 1 or 2 longer than diacritic } forall } ifelse % GlyphToASCII param known exit } if % nametype param type /booleantype eq {param {(true)} {(false)} ifelse exit} if mark (Warning: ASCIIfy parameter ) /param load 0 //true ThingToDebugText ( is of type ) /param load type ( rather than executable, string, name, array, number, or boolean.) ConcatenateToMark OutputToLog () } repeat} ifelse % xcheck end //DeBugLevel 15 le {(-ASCIIfy) OutputToLog} if } bind def % /ASCIIfy /PDFDocEncodingify { //DeBugLevel 15 le {(+PDFDocEncodingify) OutputToLog} if 3 dict begin /param exch def /param load xcheck { UserScratchDict /AsciiEquivalent undef GSave NullDevice /Courier 10 selectfont 0 0 moveto [ [/param load /execU cvx] cvx Stopped pop] GRestore UserScratchDict /AsciiEquivalent 2 copy known {2 copy get 4 1 roll undef PDFDocEncodingify Concatenate} {pop pop PDFDocEncodingify} ifelse } {1 { param type /stringtype eq {param exit} if param type /arraytype eq {mark param {PDFDocEncodingify} forall ConcatenateToMark exit} if param type /integertype eq {param ToString exit} if param type /realtype eq {param ToString exit} if param type /nametype eq {GlyphToPDFDocEncoding param 2 copy known {get} {exch pop ASCIIfy} ifelse exit} if mark (Warning: PDFDocEncodingify parameter ) /param load 0 //true ThingToDebugText ( is of type ) /param load type ToString ( rather than executable, string, name or array.) ConcatenateToMark OutputToLog () } repeat} ifelse % xcheck end //DeBugLevel 15 le {(-PDFDocEncodingify) OutputToLog} if } bind def % /PDFDocEncodingify % String Trim StringNeitherStartingNorEndingInASpace /TrimSpaces { 3 dict begin /param exch def /LastNonSpace param length 1 sub def { LastNonSpace 0 lt {exit} if param LastNonSpace get //AsciiSpace ne {exit} if /LastNonSpace LastNonSpace 1 sub def } loop /FirstNonSpace 0 def { FirstNonSpace LastNonSpace ge {exit} if param FirstNonSpace get //AsciiSpace ne {exit} if /FirstNonSpace FirstNonSpace 1 add def } loop param FirstNonSpace LastNonSpace FirstNonSpace sub 1 add getinterval end } bind def % /TrimSpaces /MightBeCompoundString { 1 { dup type /stringtype eq { << /CharsBelow 0 /CharsAbove 0 >> begin dup dup {dup 31 le {/CharsBelow dup load 1 add store} if 128 ge {/CharsAbove dup load 1 add store} if} forall CharsBelow 0 gt CharsAbove 0 gt or { mark exch (Warning: the string fragment ") exch (", perhaps part of a compound string, contains ) CharsBelow 0 gt {(ASCII control characters) CharsAbove 0 gt {(, and )} if} if CharsAbove 0 gt {(non-ASCII characters \(which should be specified in a form resembling "[\(C\) /aacute \(lem\)]"\))} if (. Continuing, but the output should be carefully checked.) ConcatenateToMark OutputToLog } {pop} ifelse end pop //true exit % CharsBelow 0 gt CharsAbove 0 gt or } if % /stringtype dup type /nametype eq {pop //true exit} if dup type /integertype eq {pop //true exit} if dup type /realtype eq {pop //true exit} if dup xcheck {pop //true exit} if % execution can depend on sundry other variables, so not looking inside dup type dup /arraytype eq exch /packedarraytype eq or { //true exch {MightBeCompoundString not {pop //false exit} if} forall } {pop //false} ifelse % array } repeat % 1 } bind def % /MightBeCompoundString mark [ CopyrightStatementPlacemats LicensingAgreementTextPlacemats LicensingAgreementLinkPlacemats ] {dup length 0 eq {pop} {counttomark 2 ge {(\n) exch} if} ifelse} forall ConcatenateToMark dup length 0 eq {pop} {OutputToLog} ifelse mark (product = ) product (; languagelevel = ) /languagelevel where {pop languagelevel} {(undefined and hence 1)} ifelse (; version = ) version (; revision = ) revision ConcatenateToMark OutputToLog /IsDistiller false 1 dict begin /SearchString (Distiller) def 0 1 product length SearchString length sub {product exch SearchString length getinterval SearchString eq {pop //true exit} if} for end def /MonthNames [(Jan) (Feb) (March) (April) (May) (June) (July) (Aug) (Sep) (Oct) (Nov) (Dec)] def % http://en.wikibooks.org/wiki/PostScript_FAQ#How_to_get_date_and_time.3F % http://groups.google.com/g/comp.lang.postscript/c/UAkMrNLakKs (\%Calendar\%) dup /IODevice resourcestatus { pop pop currentdevparams begin Running { mark (Distilled ) Hour 2 string cvs dup length 1 le {(0) exch} if (:) Minute 2 string cvs dup length 1 le {(0) exch} if ( ) [(Sun) (Mon) (Tue) (Wed) (Thu) (Fri) (Sat)] Weekday get ( ) Day 2 string cvs dup length 1 le {(0) exch} if ( ) MonthNames Month 1 sub get ( ) Year (, according to the clock of the computer running the distillation application.) ConcatenateToMark OutputToLog } if % Running end } {pop} ifelse % ... resourcestatus % AdobeFormatDate AdobeFormatDateToString string /AdobeFormatDateToString { 4 dict begin /AdobeFormatDate exch def /YYYY AdobeFormatDate 2 4 getinterval cvi def /MM AdobeFormatDate 6 2 getinterval cvi def /DD AdobeFormatDate 8 2 getinterval cvi def mark AdobeFormatDate 10 2 getinterval (:) % HH AdobeFormatDate 12 2 getinterval ( ) % MM YYYY 2099 le { [ (Mon) (Tue) (Wed) (Thu) (Fri) (Sat) (Sun) ] [ 3 5 6 0 1 3 4 5 6 1 2 3 4 6 0 1 2 4 5 6 0 2 3 4 5 0 1 2 ] YYYY 28 mod get [ 0 31 59 90 120 151 181 212 243 273 304 334 ] MM 1 sub get YYYY 4 mod 0 eq MM 3 ge and {1 add} if DD add add 7 mod get ( ) } if % <= 2099 AdobeFormatDate 8 2 getinterval ( ) % DD MonthNames MM 1 sub get ( ) % Month AdobeFormatDate 2 4 getinterval % YYYY end ConcatenateToMark } bind def % /AdobeFormatDateToString mark [ /SoftwareVersionDateTimeAdobeFormat /ParametersVersionDateTimeAdobeFormat /WizardVersionDateTimeAdobeFormat dup where pop pop ] { /NameDTAF exch def /DTAF NameDTAF load def DTAF length 14 ne {mark (Error: ) NameDTAF ( should be of length 14, in format \(D:YYYYMMDDHHMM\), but isn't.) ConcatenateToMark OutputToLog} if DTAF 0 2 getinterval (D:) ne {mark (Error: ) NameDTAF ( should begin "D:", but doesn't.) ConcatenateToMark OutputToLog} if 2 1 DTAF length 1 sub {/i exch def DTAF i get dup (0) 0 get lt exch (9) 0 get gt exch or {mark (Error: ) NameDTAF ( ) i ( get should be in range 0...9, but isn't.) ConcatenateToMark OutputToLog} if} for } forall (Software version = SoftwareVersionDateTimeAdobeFormat = ) SoftwareVersionDateTimeAdobeFormat ( = ) 1 index AdobeFormatDateToString (\n) (These placemats ~= ParametersVersionDateTimeAdobeFormat = ) ParametersVersionDateTimeAdobeFormat ( = ) 1 index AdobeFormatDateToString ConcatenateToMark OutputToLog /WizardVersionDateTimeAdobeFormat where {pop /WizardLongName where {pop mark WizardLongName (, version = ) WizardVersionDateTimeAdobeFormat ( = ) 1 index AdobeFormatDateToString ConcatenateToMark OutputToLog } if} if TestingMaxNumPagesToShow 2147483647 lt TestingShowThesePagesOnly //null ne TestingSuppressPageTypes length 0 gt or or { mark (Nota bene: some pages might be suppressed = not shown, perhaps because this is an example or a test.) (\nAt the end there might be an extra page, blank, caused by a bug in erasepage.) (\nhttp://github.com/jdaw1/placemat/issues/109) (\nhttp://groups.google.com/g/comp.lang.postscript/c/HVZVz0eBwrw) TestingMaxNumPagesToShow 2147483647 lt {(\nTestingMaxNumPagesToShow = ) TestingMaxNumPagesToShow} if TestingShowThesePagesOnly //null ne {(\nTestingShowThesePagesOnly = ) TestingShowThesePagesOnly} if TestingSuppressPageTypes length 0 gt {(\nTestingSuppressPageTypes = [) TestingSuppressPageTypes {dup type /nametype eq {( /) exch} if ( )} forall (])} if ConcatenateToMark OutputToLog } if % TestingMaxNumPagesToShow ... TestingShowThesePagesOnly ... TestingSuppressPageTypes ... or or % Changes RGB black to proper CMYK printers' black. http://groups.google.com/g/comp.lang.postscript/c/6JW6VamdVlw CMYK0001replacesRGB000 /setcolor load type /operatortype eq and { (Black is a printers' black with "0 0 0 1 setcmykcolor" rather than screen black with "0 setgray", by CMYK0001replacesRGB000.) OutputToLog /ClrSpcOrig currentcolorspace def [ [ /setcolorspace {/ClrSpcOrig 1 index store setcolorspace } ] [ /setgray {/ClrSpcOrig /DeviceGray store dup 0 eq {0 0 1 setcmykcolor} {setgray} ifelse } ] [ /setrgbcolor {/ClrSpcOrig /DeviceRGB store 3 copy 0 eq exch 0 eq and exch 0 eq and { 1 setcmykcolor} {setrgbcolor} ifelse } ] [ /sethsbcolor {/ClrSpcOrig /DeviceRGB store dup 0 eq {pop pop pop 0 0 0 1 setcmykcolor} {sethsbcolor} ifelse } ] [ /setcmykcolor {/ClrSpcOrig /DeviceCMYK store setcmykcolor } ] [ /setpattern {/ClrSpcOrig [/Pattern [currentcolorspace 0 get dup /Pattern eq {pop /DeviceRGB} if] ] store setpattern } ] ] {aload 0 get load type /operatortype eq {bind def} {pop pop} ifelse} forall /setcolor {1 { currentcolorspace /DeviceGray eq {setgray exit} if currentcolorspace /DeviceRGB eq {setrgbcolor exit} if currentcolorspace /DeviceCMYK eq {setcmykcolor exit} if setcolor } repeat} bind def % Without the next, some but not all bitmap images fail. No, I don't know why. And there are no bitmap images from this code, but there could be some in user-inserted code. /image load type /operatortype eq {/image {ClrSpcOrig setcolorspace image } bind def} if /imagemask load type /operatortype eq {/imagemask {ClrSpcOrig setcolorspace imagemask} bind def} if } if % BlackCmykReplacesRgbBlack ... /operatortype ... and (latter condition to lessen chance of self-calling) % This error checking needs to be done early. /ErrorFlag false store GlassesAnnotations length 2 mod 0 ne {mark (GlassesAnnotations is of length ) GlassesAnnotations length (, but must be of even length.) ConcatenateToMark OutputToLog /ErrorFlag //true store} if 0 2 GlassesAnnotations length 1 sub { dup GlassesAnnotations exch GetEU dup type /integertype eq {dup dup 0 ge exch Titles length lt and} {//false} ifelse {pop pop} {mark (GlassesAnnotations, item ) 4 2 roll (, is ) exch 0 //true ThingToDebugText TrimSpaces (, which should be a non-negative integer < the length of Titles = ) Titles length (.) ConcatenateToMark OutputToLog /ErrorFlag //true store} ifelse % suitable integer } for 1 2 GlassesAnnotations length 1 sub {dup GlassesAnnotations exch GetEU dup MightBeCompoundString {pop pop} {mark (GlassesAnnotations, item ) 4 2 roll (, is ) exch (, which should be a compound string.) ConcatenateToMark OutputToLog /ErrorFlag //true store} ifelse} for ErrorFlag {stop} if currentdict /ErrorFlag undef GlassesAnnotations length 2 ge { mark (There ) GlassesAnnotations length 2 idiv 1 eq {(is one glass annotation.)} {(are ) GlassesAnnotations length 2 idiv ( glass annotations.)} ifelse (\n) 0 2 GlassesAnnotations length 2 sub {(\t) exch dup GlassesAnnotations exch GetEU Titles exch get ASCIIfy exch (: ) exch 1 add GlassesAnnotations exch GetEU ASCIIfy (\n)} for pop ConcatenateToMark OutputToLog } if % GlassesAnnotations length 2 ge LogThisExtra ASCIIfy dup length 0 gt {mark exch (\n) exch (\n ) ConcatenateToMark OutputToLog} {pop} ifelse /MightBeTrue {<< >> begin GSave NullDevice Stopped {//true} {//false ne} ifelse GRestore end} bind def % Thing ValueIfAscertainable % false => values depend on variables not currently known % any ... any true => known value(s) /ValueIfAscertainable {GSave NullDevice [exch /execU cvx] cvx Stopped not GRestore} bind def /NonEmptyCompoundObject { //DeBugLevel 5 le {(+NonEmptyCompoundObject) OutputToLog} if 1 dict begin /param exch def 1 { /param load xcheck {/param load length 0 gt exit} if param type /stringtype eq {param length 0 gt exit} if param type /nametype eq {//true exit} if param type /integertype eq {//true exit} if param type /realtype eq {//true exit} if param type /arraytype eq {//false param {NonEmptyCompoundObject {pop //true exit} if} forall exit} if //false param {dup type dup /stringtype ne exch /nametype ne and {NonEmptyCompoundObject {pop //true exit} if} {pop} ifelse} forall mark (Warning: NonEmptyCompoundObject parameter ) /param load 0 //true ThingToDebugText ( is of type ) param type ( rather than executable, string, name, number or array.) ConcatenateToMark OutputToLog //true } repeat end //DeBugLevel 5 le {(-NonEmptyCompoundObject) OutputToLog} if } bind def % /NonEmptyCompoundObject /LengthCompoundObject { //DeBugLevel 5 le {(+LengthCompoundObject) OutputToLog} if 1 dict begin GSave NullDevice 0 0 moveto % in case no currentpoint and code does a rmoveto /param exch def /param load xcheck { UserScratchDict /EffectiveNumCharacters 0 put GSave [/param load execU] GRestore UserScratchDict /EffectiveNumCharacters get exch LengthCompoundObject add UserScratchDict /EffectiveNumCharacters undef } % in case the executable puts something on the stack { param type /stringtype eq {param length} { param type /nametype eq {1} { param type /arraytype eq { 0 param {LengthCompoundObject add} forall } {1} ifelse % /arraytype } ifelse % /nametype } ifelse % /stringtype } ifelse % xcheck GRestore end //DeBugLevel 5 le {(-LengthCompoundObject) OutputToLog} if } bind def % /LengthCompoundObject % Similar to 'for' loop, except numbers out-of-order. Half-way number first, then odd quarter-way numbers, then odd eighth-way numbers, etc. % Start Step End Code ForReverseBinary [anything left by Code, which might be the out-of-order numbers] /ForReverseBinaryDict 8 dict def % Code might do things to operand stack, or to dictionaries on dictionary stack, so variables must be stored elsewhere. /ForReverseBinary { //ForReverseBinaryDict /Code 3 -1 roll put 3 copy //ForReverseBinaryDict /End 3 -1 roll put //ForReverseBinaryDict /Step 3 -1 roll put //ForReverseBinaryDict /Start 3 -1 roll put 3 -1 roll 3 copy ge exch 0 gt and 4 1 roll lt exch 0 lt and or { //ForReverseBinaryDict /N //ForReverseBinaryDict /End get //ForReverseBinaryDict /Start get sub //ForReverseBinaryDict /Step get div floor cvi put % Need 0 ... N //ForReverseBinaryDict /AnyRepeats //false put //ForReverseBinaryDict /Power2 2 put //ForReverseBinaryDict /Odd 1 put { //ForReverseBinaryDict /Power2 get //ForReverseBinaryDict /N get //ForReverseBinaryDict /Odd get 3 copy 3 copy mul exch div round cvi dup dup 9 3 roll 1 add mul exch div round cvi 5 1 roll 1 sub mul exch div round cvi eq 3 1 roll eq or {pop //ForReverseBinaryDict /AnyRepeats //true put} {//ForReverseBinaryDict /Step get mul //ForReverseBinaryDict /Start get add //ForReverseBinaryDict /Code get exec} ifelse % A repeat //ForReverseBinaryDict /Odd //ForReverseBinaryDict /Odd get 2 add dup //ForReverseBinaryDict /Power2 get gt { //ForReverseBinaryDict /AnyRepeats get {pop pop pop exit} if pop 1 put % Restart Odd loop //ForReverseBinaryDict /Power2 //ForReverseBinaryDict /Power2 get 2 mul put % Advance Power2 loop } {put} ifelse % if end of Odd loop then advance Power2 loop } loop % This loop does the work of nested Power2 and Odd loops, but being one loop, is exit'able. 1 { //ForReverseBinaryDict /Start get //ForReverseBinaryDict /Code get exec //ForReverseBinaryDict /N get 0 ne {//ForReverseBinaryDict /Step get //ForReverseBinaryDict /N get mul //ForReverseBinaryDict /Start get add //ForReverseBinaryDict /Code get exec} if } repeat % The 1 ... repeat because exit'able. } if % Any steps to do } bind def % /ForReverseBinary currentdict /ForReverseBinaryDict undef % array KleinSum sum % http://en.wikipedia.org/wiki/Kahan_summation_algorithm#Further_enhancements /KleinSum { 8 dict begin /a exch def /s 0 def /cs 0 def /ccs 0 def 0 1 a length 1 sub { /i exch def /t a i get s add def /c s abs a i get abs ge {s t sub a i get add} {a i get t sub s add} ifelse def /s t def /t cs c add def /cc cs abs c abs ge {cs t sub c add} {c t sub cs add} ifelse def /cs t def /ccs ccs cc add def } for % i s cs add ccs add end } bind def % /KleinSum % These links constitute the signature of the author of the code. Yes, the code is open source, so you have the power to remove them. % Please don't. If you want code to be open source, respect this wish of an author who has released code for free. Thank you. /ExternalLinksExtras [ false (GitHub) (http://github.com/jdaw1/placemat/#readme) false (PostScript) (http://github.com/jdaw1/placemat/blob/main/PostScript/placemat.ps) false (Documentation start) (http://github.com/jdaw1/placemat/blob/main/Documentation/introduction_first_placemat.md#readme) false (Placemats, list) (http://www.jdawiseman.com/papers/placemat/placemats_list.html) false (Author) (http://www.jdawiseman.com/author.html) ] def % /ExternalLinksExtras % Returns true if sole parameter is one of /USL, /USLegal, /Tabloid, /USL2 /NorthAmericanPaperSize {//false [/USL /USLegal /Tabloid /USL2] {2 index eq {pop pop //null //true exit} if} forall exch pop} bind def /mm {2.83464566929 mul} bind def % 360 127 div % PaperType Orientation Dimensions PageWidth PageHeight % http://groups.google.com/g/comp.lang.postscript/c/vlfF8eGOCMA /Dimensions { //DeBugLevel 10 le {(+Dimensions) OutputToLog} if 1 dict begin exch /PaperType exch def 1 { /A4 PaperType eq {595.27559 841.88976 exit} if % 210mm by 297mm. For speed start with the values most often used. /A3 PaperType eq {841.88976 1190.55118 exit} if % 297mm by 420mm /USL PaperType eq {612 792 exit} if % 8.5" by 11" /USLegal PaperType eq {612 1008 exit} if % 8.5" by 14" /Tabloid PaperType eq {792 1224 exit} if % 11" by 17", http://github.com/jdaw1/placemat/issues/159 /Ledger PaperType eq {792 1224 exit} if % 11" by 17" /USL2 PaperType eq {792 1224 exit} if % 11" by 17" /arraytype PaperType type eq {PaperType dup 0 get exch 1 get exit} if % [SmallerPts LargerPts], ignoring anything after first two elements /Berliner PaperType eq {315 mm 470 mm exit} if % http://www.theguardian.com/gpc/berliner-format PaperType type /arraytype eq {PaperType {execU} forall exit} if % [ Small Large ] /A4_USL PaperType eq {210 mm 792 exit} if % Smaller of the A4/USL widths; smaller of the heights /A0 PaperType eq { 841 mm 1189 mm exit} if % A0 can hold 106 glasses slightly larger than five on A4. Which is a large enough page size. /A1 PaperType eq { 594 mm 841 mm exit} if /A2 PaperType eq { 420 mm 594 mm exit} if /A5 PaperType eq { 148 mm 210 mm exit} if /A6 PaperType eq { 105 mm 148 mm exit} if /A7 PaperType eq { 74 mm 105 mm exit} if /A8 PaperType eq { 52 mm 74 mm exit} if /A9 PaperType eq { 37 mm 52 mm exit} if /A10 PaperType eq { 26 mm 37 mm exit} if % Much much smaller than useful. Included for completeness. /B0 PaperType eq {1000 mm 1414 mm exit} if % B0 can hold 152 glasses slightly larger than five on A4. Which is a large enough page size. /B1 PaperType eq { 707 mm 1000 mm exit} if /B2 PaperType eq { 500 mm 707 mm exit} if /B3 PaperType eq { 353 mm 500 mm exit} if /B4 PaperType eq { 250 mm 353 mm exit} if /B5 PaperType eq { 176 mm 250 mm exit} if /B6 PaperType eq { 125 mm 176 mm exit} if /B7 PaperType eq { 88 mm 125 mm exit} if /B8 PaperType eq { 62 mm 88 mm exit} if /B9 PaperType eq { 44 mm 62 mm exit} if /B10 PaperType eq { 31 mm 44 mm exit} if /C0 PaperType eq { 917 mm 1297 mm exit} if % C0 can hold 129 glasses slightly larger than five on A4. Which is a large enough page size. /C1 PaperType eq { 648 mm 917 mm exit} if /C2 PaperType eq { 458 mm 648 mm exit} if /C3 PaperType eq { 324 mm 458 mm exit} if /C4 PaperType eq { 229 mm 324 mm exit} if /C5 PaperType eq { 162 mm 229 mm exit} if /C6 PaperType eq { 114 mm 162 mm exit} if /C7 PaperType eq { 81 mm 114 mm exit} if /C8 PaperType eq { 57 mm 81 mm exit} if /C9 PaperType eq { 40 mm 57 mm exit} if /C10 PaperType eq { 28 mm 40 mm exit} if (Error: unknown paper type in Dimensions) OutputToLog stop } repeat end % 1 3 -1 roll /Landscape eq {exch} if //DeBugLevel 10 le {(-Dimensions) OutputToLog} if } bind def % /Dimensions /PaperTypeStringShortPDF % Unlike PaperTypeString, does not take parameters: uses ThisPaperType { //true [/A4 /A3 /A0 /A1 /A2 /A5 /A6 /A7 /A8 /A9 /A10 /B0 /B1 /B2 /B3 /B4 /B5 /B6 /B7 /B8 /B9 /B10 /C0 /C1 /C2 /C3 /C4 /C5 /C6 /C7 /C8 /C9 /C10] {ThisPaperType eq {pop //false exit} if} forall { 1 dict begin mark [ ThisPaperType /Portrait Dimensions ] { /z exch def 1 { z 18 div dup round sub abs //Epsilon le {z 18 div round cvi dup 4 idiv exch 4 mod [(") (\274") (\275") (\276")] exch get exit} if % quarter inch z 7.2 div dup round sub abs //Epsilon le {z 72 div 1 FormatDecimalPlaces (") exit} if % 0.1 inch z 127 mul 360 div dup round sub abs //Epsilon le {z 127 mul 360 div round cvi (mm) exit} if % mm z dup type /realtype eq {1 FormatDecimalPlaces} if (pt) % othewise in points, rounded to 0.1 } repeat (\327) } forall pop ConcatenateToMark end } {ThisPaperType ToString} ifelse % ISO 216 } bind def % /PaperTypeStringShortPDF /OuterMarginLogs 1024 array def /OuterMarginLogsNum 0 def % string OuterMarginLogsAdd - /OuterMarginLogsAdd { 1 dict begin /str exch ASCIIfy def //true OuterMarginLogs 0 OuterMarginLogsNum getinterval {str eq {pop //false exit} if} forall {OuterMarginLogs OuterMarginLogsNum str put /OuterMarginLogsNum OuterMarginLogsNum 1 add store} if end } bind def % OuterMarginLogsAdd /PaperTypeString % Unlike PaperTypeStringShortPDF, takes one parameter { 2 dict begin /ThisPaperType exch def mark ThisPaperType type /nametype eq {ThisPaperType ( = )} if [ ThisPaperType /Portrait Dimensions ] { /z exch def 1 { z 72 div dup round sub abs //Epsilon le {z 72 div round cvi (") exit} if % 1 inch z 7.2 div dup round sub abs //Epsilon le {z 72 div 1 FormatDecimalPlaces (") exit} if % 0.1 inch z 3.6 div dup round sub abs //Epsilon le {z 72 div 2 FormatDecimalPlaces (") exit} if % 0.05 inch z 127 mul 360 div dup round sub abs //Epsilon le {z 127 mul 360 div round cvi (mm) exit} if % mm z dup type /realtype eq {1 FormatDecimalPlaces} if (pt) % othewise in points, rounded to 0.1 } repeat (*) } forall pop ConcatenateToMark end } bind def % /PaperTypeString /DefaultOutputFaceUp currentpagedevice /OutputFaceUp 2 copy known {get} {pop pop //false} ifelse def % ShowCropMarks Rotate180 Mirror Callsetpagedevice PaperType Orientation SetPaperSize - % First two params ignored if Callsetpagedevice is false /SetPaperSize { //DeBugLevel 16 le {(+SetPaperSize) OutputToLog} if 2 copy Dimensions /PageHeight exch def /PageWidth exch def 15 dict begin pop /PaperType exch def /Callsetpagedevice exch def /Mirror exch def /Rotate180 exch def /ShowCropMarks exch def Callsetpagedevice % Sets the page size; and attempts to disable duplex; draws crop marks { [PageWidth PageHeight] {14400 gt {(Warning: with a paper side > 14400pt = 16'8" = 5.08 metres, about to call setpagedevice, which might fail.) OutputToLog} if} forall << /OutputFaceUp DefaultOutputFaceUp Mirror {not} if /PageSize [PageWidth PageHeight] /ImagingBBox //null //true [/TastingNotes /PrePour /VoteRecorder /DecantingNotes /Accounts /BottleWrap /DistillerLog] {TypeOfPagesBeingRendered eq {pop //false exit} if} forall {/Duplex //false} if >> setpagedevice /InitialMatrix matrix currentmatrix store Mirror {Rotate180 {[1 0 0 -1 0 PageHeight] concat} {[-1 0 0 1 PageWidth 0] concat} ifelse} {Rotate180 {[-1 0 0 -1 PageWidth PageHeight] concat} if} ifelse % Mirror /InitialMatrix matrix currentmatrix store } if % Callsetpagedevice ShowCropMarks { /Glasses TypeOfPagesBeingRendered eq {OuterGlassesMarginL OuterGlassesMarginR OuterGlassesMarginB OuterGlassesMarginT} { OuterMarginL OuterMarginR OuterMarginB OuterMarginT} ifelse /OMT exch def /OMB exch def /OMR exch def /OML exch def OML OMB translate << /PageWidth dup load OML OMR add sub /PageHeight dup load OMB OMT add sub >> begin //false OML 0 gt { OMB 0 gt { OML 108 ge {-36 0 -36 0} {OML -3 div 0 2 copy} ifelse moveto rlineto OMB 108 ge {0 -36 0 -36} {0 OMB -3 div 2 copy} ifelse moveto rlineto pop //true } if % OMB 0 gt OMT 0 gt { OML 108 ge {-36 0 -36} {OML -3 div 0 1 index} ifelse PageHeight moveto rlineto OMT 108 ge {0 36 0 36} {0 OMT 3 div 2 copy} ifelse PageHeight add moveto rlineto pop //true } if % OMB 0 gt } if % OML 0 gt OMR 0 gt { OMB 0 gt { OMR 108 ge {36 0 36} {OMR 3 div 0 1 index} ifelse PageWidth add 0 moveto rlineto OMB 108 ge {0 -36 PageWidth -36} {0 OMB -3 div PageWidth 1 index} ifelse moveto rlineto pop //true } if % OMT 0 gt OMT 0 gt { OMR 108 ge {36 0 36} {OMR 3 div dup 0 exch} ifelse PageWidth add PageHeight moveto rlineto OMT 108 ge {0 36} {0 OMT 3 div} ifelse dup PageHeight add PageWidth exch moveto rlineto pop //true } if % OMT 0 gt } if % OMR 0 gt {0 setgray 0.24 setlinewidth 0 setlinecap stroke} if end InitialMatrix setmatrix /TrimInstructionsFontSize 7 def /Courier TrimInstructionsFontSize selectfont 0.2 setgray OMT MarginT TrimInstructionsFontSize 1.5 mul add gt { PageWidth OML OMR sub add 2 div PageHeight MarginT sub moveto [ (Top trim ) OMT 127 mul 360 div 1 FormatDecimalPlaces (mm ) /approxequal ( ) OMT 72 div 2 FormatDecimalPlaces (" ) /approxequal ( ) OMT round cvi (pt below top edge of ) PaperType 2 string cvs ( paper. Post-trim page height ) /PageSizeDeOutered PageHeight OMB OMT add sub def /approxequal ( ) PageSizeDeOutered 127 mul 360 div 1 FormatDecimalPlaces (mm ) /approxequal ( ) PageSizeDeOutered 72 div 2 FormatDecimalPlaces (" ) /approxequal ( ) PageSizeDeOutered round cvi (pt.) ] dup OuterMarginLogsAdd dup StringPathBBox /T exch def /R exch def pop /L exch def R L sub PageWidth OMR OML add MarginR MarginL add add sub le {R L add -2 div T neg rmoveto ShowRecursive} {pop} ifelse } if % OMT ... gt OML MarginL TrimInstructionsFontSize 1.5 mul add gt { matrix currentmatrix MarginL PageHeight OMB OMT sub add 2 div translate -90 rotate 0 0 moveto [ (Left trim ) OML 127 mul 360 div 1 FormatDecimalPlaces (mm ) /approxequal ( ) OML 72 div 2 FormatDecimalPlaces (" ) /approxequal ( ) OML round cvi (pt from left edge of ) PaperType 2 string cvs ( paper. Post-trim page width ) /PageSizeDeOutered PageWidth OML OMR add sub def /approxequal ( ) PageSizeDeOutered 127 mul 360 div 1 FormatDecimalPlaces (mm ) /approxequal ( ) PageSizeDeOutered 72 div 2 FormatDecimalPlaces (" ) /approxequal ( ) PageSizeDeOutered round cvi (pt.) ] dup OuterMarginLogsAdd dup StringPathBBox pop /R exch def /B exch def /L exch def R L sub PageHeight OMT OMB add MarginT MarginB add add sub le {R L add -2 div B neg rmoveto ShowRecursive} {pop} ifelse setmatrix } if % OML ... gt OMB MarginB TrimInstructionsFontSize 1.5 mul add gt { PageWidth OML OMR sub add 2 div MarginB moveto [ (Bottom trim ) OMB 127 mul 360 div 1 FormatDecimalPlaces (mm ) /approxequal ( ) OMB 72 div 2 FormatDecimalPlaces (" ) /approxequal ( ) OMB round cvi (pt above bottom edge of ) PaperType 2 string cvs ( paper. Post-trim page height ) /PageSizeDeOutered PageHeight OMB OMT add sub def /approxequal ( ) PageSizeDeOutered 127 mul 360 div 1 FormatDecimalPlaces (mm ) /approxequal ( ) PageSizeDeOutered 72 div 2 FormatDecimalPlaces (" ) /approxequal ( ) PageSizeDeOutered round cvi (pt.) ] dup OuterMarginLogsAdd dup StringPathBBox pop /R exch def /B exch def /L exch def R L sub PageWidth OMR OML add MarginR MarginL add add sub le {R L add -2 div B neg rmoveto ShowRecursive} {pop} ifelse } if % OMB ... gt OMR MarginR TrimInstructionsFontSize 1.5 mul add gt { matrix currentmatrix PageWidth MarginR sub PageHeight OMB OMT sub add 2 div translate 90 rotate 0 0 moveto [ (Right trim ) OMR 127 mul 360 div 1 FormatDecimalPlaces (mm ) /approxequal ( ) OMR 72 div 2 FormatDecimalPlaces (" ) /approxequal ( ) OMR round cvi (pt from right edge of ) PaperType 2 string cvs ( paper. Post-trim page width ) /PageSizeDeOutered PageWidth OML OMR add sub def /approxequal ( ) PageSizeDeOutered 127 mul 360 div 1 FormatDecimalPlaces (mm ) /approxequal ( ) PageSizeDeOutered 72 div 2 FormatDecimalPlaces (" ) /approxequal ( ) PageSizeDeOutered round cvi (pt.) ] dup OuterMarginLogsAdd dup StringPathBBox pop /R exch def /B exch def /L exch def R L sub PageHeight OMT OMB add MarginT MarginB add add sub le {R L add -2 div B neg rmoveto ShowRecursive} {pop} ifelse setmatrix } if % OMR ... gt } if % show crop marks end //DeBugLevel 15 le {(-SetPaperSize) OutputToLog} if } bind def % /SetPaperSize //DeBugLevel 100 le {( Main: computing PaperTypes, UsedPaperTypes, UsedPageOrderings) OutputToLog} if /TypeOfPagesBeingRendered /Glasses store /PaperTypes [ 0 1 NumSheets 1 sub {/SheetNum exch def PaperType} for ] def currentdict /SheetNum undef % Duplicates not removed /TypeOfPagesBeingRendered /TastingNotes store /TastingNotesPaperTypes [ 0 1 GlassesOnTastingNotePages length 1 sub {/TNSheetNum exch def TastingNotesPaperType counttomark 1 sub -1 1 {index 1 index eq {pop exit} if} for} for ] def currentdict /TNSheetNum undef % No duplicates /TypeOfPagesBeingRendered /Multiple store /UsedPaperTypes [ [ 7 dict begin /SheetNum 0 def /TNSheetNum 0 def % Construct an array with many duplicates; construct new duplicates-free array. PaperTypes aload pop TastingNotesPaperTypes aload pop {PlaceNames} MightBeTrue {0 1 NamesPlaceNames length 1 sub {/PlaceNameSetNum exch def PlaceNamesPaperType} for} if /VoteRecorders load MightBeTrue {0 1 GlassesClusteredOnVoteRecorders length 1 sub {/VoteRecorderSheetNum exch def /VoteRecorders load MightBeTrue {VoteRecorderPaperType} if} for} if 0 1 NumSheets 1 sub {/SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def {PrePourNumCopies 1 ge} MightBeTrue { PrePourPaperType} if {NeckTagsNumCopies 1 ge} MightBeTrue { NeckTagsPaperType} if {BottleWrapNumCopies 1 ge} MightBeTrue { BottleWrapPaperType} if {DecanterLabelsNumCopies 1 ge} MightBeTrue {DecanterLabelsPaperType} if } for} for {StickyLabelsNumCopies 1 ge} MightBeTrue {StickyLabelsTypes {execU /StickyLabelsTypeThis exch def {StickyLabelsNumCopies 1 ge} MightBeTrue {StickyLabelsPaperType} if } forall} if {CorkDisplayNumCopies 1 ge} MightBeTrue {CorkDisplayPaperType} if {AccountsNumCopies 1 ge} MightBeTrue {AccountsPaperType} if {DecantingNotesNumCopies 1 ge} MightBeTrue {DecantingNotesPaperType} if end ] {counttomark 1 sub -1 1 {index 1 index eq {pop exit} if} for} bind forall ] def % /UsedPaperTypes /UsedPageOrderings [ [ % Construct an array with many duplicates; sort it; construct new duplicates-free array. {OneCircles} MightBeTrue {PageOrderingOneCircle execU } if {BottleWrapNumCopies 1 ge} MightBeTrue {PageOrderingBottleWrap {execU} forall} if {GlassesNumCopies 1 ge} MightBeTrue {PageOrderingGlasses {execU} forall} if {TastingNotePagesNumCopies 1 ge} MightBeTrue {PageOrderingTastingNotePages {execU} forall} if {VoteRecorders} MightBeTrue {PageOrderingVoteRecorder {execU} forall} if {DecantingNotesNumCopies 1 ge} MightBeTrue {PageOrderingDecantingNotes {execU} forall} if {AccountsNumCopies 1 ge} MightBeTrue {PageOrderingAccounts {execU} forall} if {CorkDisplayNumCopies 1 ge} MightBeTrue {PageOrderingCorkDisplay {execU} forall} if {NeckTagsNumCopies 1 ge} MightBeTrue {PageOrderingNeckTags {execU} forall} if {PrePourNumCopies 1 ge} MightBeTrue {PageOrderingPrePourPages {execU} forall} if {PlaceNames} MightBeTrue {PageOrderingPlaceNames {execU} forall} if {DecanterLabelsNumCopies 1 ge} MightBeTrue {PageOrderingDecanterLabels {execU} forall} if {StickyLabelsNumCopies 1 ge} MightBeTrue {PageOrderingStickyLabels {execU} forall} if ] dup {le} ShellSort {2 copy eq {pop} if} bind forall % There is a mark on stack, so the "2 copy" doesn't fail ] def % /UsedPageOrderings mark (Used paper types: ) UsedPaperTypes {PaperTypeString (; )} forall pop (.) ConcatenateToMark dup length 10 gt {OutputToLog} {pop} ifelse 8 dict begin /DesMaxLength -1 def mark (External links for document outline:) 0 1 1 { 0 eq {ExternalLinks} {ExternalLinksExtras} ifelse /A exch def 0 3 A length 3 sub { /i exch def /Des A i 1 add get ASCIIfy TrimSpaces length A i get execU {4 add} if def /URL A i 2 add get ASCIIfy TrimSpaces length def Des URL add 123 gt URL 0 eq or {0} {Des} ifelse dup DesMaxLength gt {/DesMaxLength exch def} {pop} ifelse } for % i = position in array A } bind for % ExternalLinks | ExternalLinksExtras /RowNum 0 def 0 1 1 { 0 eq {ExternalLinks} {ExternalLinksExtras} ifelse /A exch def 0 3 A length 3 sub { /i exch def /Des A i 1 add get ASCIIfy TrimSpaces def /URL A i 2 add get ASCIIfy TrimSpaces def Des length 0 gt { (\n) Des A i get {( ) exch Concatenate} if URL length 0 gt { dup length dup URL length add 127 ge {pop 0} {DesMaxLength exch sub dup 0 lt {pop 0} if} ifelse /Extras exch def Extras 5 mod {( )} repeat Extras 5 idiv {RowNum 3 mod 0 eq {( = )} {( )} ifelse} repeat ( = ) URL } if % URL length 0 gt }{ URL length 0 gt {(\n) A i get execU {( )} if URL} if } ifelse % Descriptor non-zero length /RowNum RowNum 1 add def } for % i = position in array A } bind for % ExternalLinks | ExternalLinksExtras DesMaxLength 0 ge {ConcatenateToMark OutputToLog} {cleartomark} ifelse end /AnyFillTextingAtAll {FillTitles FillAbovetitles or FillBelowtitles or FillOvertitles or FillPlaceNames or} MightBeTrue def /NamesIsLeftHander [ Names length {//false} repeat ] def /NamesIsLeftHanderTN [ NamesTastingNotes length {//false} repeat ] def /NamesIsLeftHanderPN [ NamesPlaceNames { [ exch execU length {//false} repeat ] } forall ] def 3 dict begin 0 1 LeftHanders length 1 sub { LeftHanders exch get PDFDocEncodingify /Leftie exch def Names length 1 sub -1 0 % Glass pages { /NameNum exch def NamesIsLeftHander NameNum get not { Names NameNum get PDFDocEncodingify Leftie eq {NamesIsLeftHander NameNum //true put exit} if } if % NamesIsLeftHander NameNum get not } for % NameNum NamesTastingNotes length 1 sub -1 0 % Tasting-note pages { /NameNum exch def NamesIsLeftHanderTN NameNum get not { NamesTastingNotes NameNum get PDFDocEncodingify Leftie eq {NamesIsLeftHanderTN NameNum //true put exit} if } if % NamesIsLeftHanderTN NameNum get not } for % NameNum 0 1 NamesPlaceNames length 1 sub PlaceNames not {pop -1} if % Place names { /PlaceNameSetNum exch def NamesPlaceNames PlaceNameSetNum GetEU length 1 sub -1 0 { /NameNum exch def NamesIsLeftHanderPN PlaceNameSetNum get NameNum get not { NamesPlaceNames PlaceNameSetNum GetEU NameNum get PDFDocEncodingify Leftie eq {NamesIsLeftHanderPN PlaceNameSetNum get NameNum //true put exit} if } if % NamesIsLeftHanderPN PlaceNameSetNum get NameNum get not } for % NameNum } for % PlaceNameSetNum } bind for % Leftie //false NamesIsLeftHander {{pop //true exit} if} forall { mark (Left-handers amongst Names:) 0 1 NamesIsLeftHander length 1 sub { /NameNum exch def NamesIsLeftHander NameNum get {( NameNum=) NameNum (, ) Names NameNum get ASCIIfy (;)} if } bind for % NameNum (;) eq {TerminatingFullStopAppend} if ConcatenateToMark OutputToLog } if % any lefties //false NamesTastingNotes Names ne {NamesIsLeftHanderTN {{pop //true exit} if} forall} if { mark (Left-handers amongst NamesTastingNotes:) 0 1 NamesIsLeftHanderTN length 1 sub { /NameNum exch def NamesIsLeftHanderTN NameNum get {( NameNum=) NameNum (, ) NamesTastingNotes NameNum get ASCIIfy (;)} if } bind for % NameNum (;) eq {TerminatingFullStopAppend} if ConcatenateToMark OutputToLog } if % any lefties {PlaceNames} MightBeTrue { //false 0 1 NamesPlaceNames length 1 sub {/PlaceNameSetNum exch def NamesPlaceNames PlaceNameSetNum GetEU Names ne {NamesIsLeftHanderPN PlaceNameSetNum get {{pop //true exit} if} forall} if} for { mark (Left-handers amongst NamesPlaceNames, excluding those amongst Names:) 0 1 NamesPlaceNames length 1 sub { /PlaceNameSetNum exch def NamesPlaceNames PlaceNameSetNum GetEU Names ne { 0 1 NamesPlaceNames PlaceNameSetNum GetEU length 1 sub NamesIsLeftHanderPN PlaceNameSetNum get NameNum get {( PlaceNameSetNum=) PlaceNameSetNum (, NameNum=) NameNum (, ) NamesPlaceNames PlaceNameSetNum GetEU NameNum get ASCIIfy (;)} if } for % NameNum } bind for % PlaceNameSetNum (;) eq {TerminatingFullStopAppend} if ConcatenateToMark OutputToLog } if % any lefties } if % ...PlaceNames... end 4 dict begin /FontData [ [ Titles NonEmptyCompoundObject {/TitlesFont} if Abovetitles NonEmptyCompoundObject {/AbovetitlesFont} if Belowtitles NonEmptyCompoundObject {/BelowtitlesFont} if Overtitles NonEmptyCompoundObject {/OvertitlesFont} if Circlearrays NonEmptyCompoundObject {/CircletextFont} if Names NonEmptyCompoundObject {/NamesFont} if SubtitlesTastingNotes NonEmptyCompoundObject {/SubtitlesFont} if AnyFillTextingAtAll {/FillTextFont} if /PlaceNames load MightBeTrue {/PlaceNamesFont} if HeadersLeft length 0 gt HeadersCenter length 0 gt HeadersRight length 0 gt or or {/HeaderFont} if FootersLeft length 0 gt FootersCenter length 0 gt FootersRight length 0 gt or or {/FooterFont} if {BackgroundTextsGlasses PrePourShowBackgroundTexts BackgroundTextsTastingNotes or or} MightBeTrue {/BackgroundTextsFont} if ] {[ exch dup /fv exch def fv load ValueIfAscertainable not {fv load} if ]} forall ] def % FontData mark (Fonts: ) 0 1 FontData length 1 sub {/i exch def FontData i get 1 get dup //null ne {dup type /nametype eq {(/) exch} if ( \() FontData i get 0 get (, ) i 1 add 1 FontData length 1 sub {/j exch def FontData i get 1 get FontData j get 1 get eq {FontData j get 0 get (, ) FontData j get 1 //null put} if} for pop (\)) (; ) } {pop} ifelse} for pop (; and perhaps others.) ConcatenateToMark OutputToLog end % thing1 thing2 eqArray boolean /eqArray { 1 { 2 copy eq {pop pop //true exit} if % So 1 = 1.0 2 copy type dup /arraytype ne exch /packedarraytype ne and exch type dup /arraytype ne exch /packedarraytype ne and or {pop pop //false exit} if 2 copy 2 copy length exch length ne 3 1 roll xcheck exch xcheck ne or {pop pop //false exit} if //true 0 1 3 index length 1 sub << /thing1 8 -2 roll /thing2 exch >> begin {dup /thing1 load exch get exch /thing2 load exch get eqArray not {pop //false exit} if} for end } repeat % 1 } bind def % /eqArray mark (Array equalities: {) 4 dict begin /ArraysToCompare [ /Circlearrays /Titles /Abovetitles /Belowtitles /Overtitles AnyFillTextingAtAll {/FillTexts} if {GlassesOnTastingNotePages length 0 gt} MightBeTrue {TastingNotePagesNumCopies 1 ge} MightBeTrue and {/CirclearraysTastingNotes /TitlesTastingNotes /SubtitlesTastingNotes /Names /NamesTastingNotes} {/Names} ifelse /VoteRecorders load MightBeTrue {/CirclearraysVoteRecorder /TitlesVoteRecorder /SubtitlesVoteRecorder /NamesVoteRecorder} if {DecantingNotesNumCopies 1 ge} MightBeTrue {/CirclearraysDecantingNotes /TitlesDecantingNotes /SubtitlesDecantingNotes} if {AccountsNumCopies 1 ge} MightBeTrue {/NamesAccounts} if {CorkDisplayNumCopies 1 ge} MightBeTrue {/CirclearraysCorkDisplay /TitlesCorkDisplay /SubtitlesCorkDisplay} if {NeckTagsNumCopies 1 ge} MightBeTrue {/CirclearraysNeckTags } if {PrePourNumCopies 1 ge} MightBeTrue {/CirclearraysPrePour } if {BottleWrapNumCopies 1 ge} MightBeTrue {/CirclearraysBottleWrap} if /PlaceNames load MightBeTrue {0 1 NamesPlaceNames length 1 sub {[ exch /NamesPlaceNames cvx exch /get cvx ] cvx} for} if {StickyLabelsNumCopies 1 ge} {StickyLabelsTypes length 0 gt} MightBeTrue exch MightBeTrue and {/CirclearraysStickyLabels} if //false 1 dict begin StickyLabelsTypes {/StickyLabelsTypeThis exch def {StickyLabelsNumCopies 1 ge} MightBeTrue /StickyLabelsByNameWhichReplaceCirclearrays load MightBeTrue and {pop //true exit} if} forall end {/NamesStickyLabels} if 4 dict begin counttomark /i exch 1 sub def { i 1 le {exit} if i index 32 string cvs 0 3 getinterval /is exch def % assumes all of length >=3 i 1 sub -1 0 {/j exch def j index 32 string cvs 0 3 getinterval is ne {exit} if} for % j j 1 sub -1 0 {/k exch def k index 32 string cvs 0 3 getinterval is eq {k 1 add -1 roll j 1 add 1 roll /j j 1 sub def} if} for % k /i j def } loop end ] def % /ArraysToCompare /ArraysRemaining [ ArraysToCompare {dup type /nametype eq {load NonEmptyCompoundObject} {pop //true} ifelse} forall ] def 0 1 ArraysToCompare length 1 sub { /i exch def ArraysRemaining i get { ArraysToCompare i get ToString TrimSpaces i 1 add 1 ArraysToCompare length 1 sub { /j exch def ArraysToCompare i get dup type /nametype eq {load} {exec} ifelse ArraysToCompare j get dup type /nametype eq {load} {exec} ifelse eqArray {( = ) ArraysToCompare j get ToString TrimSpaces ArraysRemaining j //false put} if % ... i ... j ... eq } for % j (}) (; {) } if % ArraysRemaining i get } bind for % i end pop (.) ConcatenateToMark OutputToLog DeBugLevel 100 le % This logging introduced in May 2011. In December 2021 decided to be too much clutter. Hence this de facto disablement. { % Log settings of used decorative parameters [ {ShapesInTitles ShapesInAbovetitles or ShapesInBelowtitles or ShapesInOvertitles or ShapesInPlaceNames or} MightBeTrue {[ /ShapesInTitles /ShapesInAbovetitles /ShapesInBelowtitles /ShapesInOvertitles /ShapesInPlaceNames /ShapesToUse /ShapesStarsPointsAndStepsArray /ShapesAverageSeparation /ShapesEnclosingCircleRadiusMin /ShapesEnclosingCircleRadiusMax /ShapesAverageMaxTweakPlusMinus /ShapesFlowersNumPetalsMin /ShapesFlowersNumPetalsMax /ShapesFlowersAngularWidthMin /ShapesFlowersAngularWidthMax /ShapesInTitles load MightBeTrue {/ShapesTitlesFill /ShapesTitlesStroke} if /ShapesInAbovetitles load MightBeTrue {/ShapesAbovetitlesFill /ShapesAbovetitlesStroke} if /ShapesInBelowtitles load MightBeTrue {/ShapesBelowtitlesFill /ShapesBelowtitlesStroke} if /ShapesInOvertitles load MightBeTrue {/ShapesOvertitlesFill /ShapesOvertitlesStroke} if ]} if % ... ShapesInTitles ... {CrossHatchingOutside CrossHatchingInside or CrossHatchingTitles or CrossHatchingAbovetitles or CrossHatchingBelowtitles or CrossHatchingOvertitles or CrossHatchingPlaceNames or} MightBeTrue {[ /CrossHatchingOutside /CrossHatchingInside /CrossHatchingTitles /CrossHatchingAbovetitles /CrossHatchingBelowtitles /CrossHatchingOvertitles /CrossHatchingPlaceNames /CrossHatchingOutside load MightBeTrue {/CrossHatchingOutsideStrokeCode} if /CrossHatchingInside load MightBeTrue {/DecanterLabelsShowCrossHatchingInside /CrossHatchingInsideStrokeCode} if /CrossHatchingTitles load MightBeTrue {/CrossHatchingTitlesStrokeCode} if /CrossHatchingAbovetitles load MightBeTrue {/CrossHatchingAbovetitlesStrokeCode} if /CrossHatchingBelowtitles load MightBeTrue {/CrossHatchingBelowtitlesStrokeCode} if /CrossHatchingOvertitles load MightBeTrue {/CrossHatchingOvertitlesStrokeCode} if /CrossHatchingNumRadialLines /CrossHatchingCellArea /CrossHatchingCentreX /CrossHatchingCentreY ]} if % ... CrossHatchingTitles ... {InlineTitles InlineAbovetitles or InlineBelowtitles or InlineOvertitles or InlinePlaceNames or} MightBeTrue {[ /InlineTitles /InlineAbovetitles /InlineBelowtitles /InlineOvertitles /InlineTitles load MightBeTrue {/InlineTitlesMaxNumberContours /InlineTitlesBlackWidth /InlineTitlesWhiteWidth} if /InlineAbovetitles load MightBeTrue {/InlineAbovetitlesMaxNumberContours} if /InlineBelowtitles load MightBeTrue {/InlineBelowtitlesMaxNumberContours} if /InlineOvertitles load MightBeTrue {/InlineOvertitlesMaxNumberContours} if /InlineAbovetitles load MightBeTrue {/InlineAbovetitlesBlackWidth /InlineAbovetitlesWhiteWidth} if /InlineBelowtitles load MightBeTrue {/InlineBelowtitlesBlackWidth /InlineBelowtitlesWhiteWidth} if /InlineOvertitles load MightBeTrue {/InlineOvertitlesBlackWidth /InlineOvertitlesWhiteWidth} if ]} if % ... InlineTitles ... /OutlineTitles load MightBeTrue {[ /OutlineTitles /OutlineTitlesAlsoAbovetitles /OutlineTitlesAlsoBelowtitles /OutlineTitlesAlsoOvertitles /OutlineTitlesInnerWidthWhite /OutlineTitlesInnerWidthBlack /OutlineTitlesMultiplierWhite /OutlineTitlesMultiplierBlack /DecanterLabelsShowOutlineTitles /OutlineTitlesMaxNum ]} if % ... OutlineTitles ... AnyFillTextingAtAll {[ /FillTitles /FillAbovetitles /FillBelowtitles /FillOvertitles /FillPlaceNames /FillTextAngle /FillTexts /FillTextPedantry /FillPrioritiseSmallFileSizeOverPortability /FillTextNumSpaces /FillTextNumOutlines /FillTextMinFontSizeAbsolute /FillTextMinFontSizeProportionLargestTitleAboveBelowOver {PlaceNames} MightBeTrue {/FillTextPlaceNames /FillTextAnglePlaceNames} if ]} if % ... FillTitles ... /TastingNotesCirclesBehind load MightBeTrue {[ /TastingNotesCirclesBehind /TastingNotesCirclesBehindFadingFactorIfAllBlack /TastingNotesCirclesBehindFadingFactorIfAnyGrey /TastingNotesCirclesBehindTopX /TastingNotesCirclesBehindBottomX ]} if /BackgroundTextsGlasses load MightBeTrue {[ /BackgroundTextsGlasses /BackgroundTextsGlassesTexts /BackgroundTextsSquooshMin /BackgroundTextsSquooshMax /BackgroundTextsTastingNotes /PrePourShowBackgroundTexts /BackgroundTextsFontSizeMax /BackgroundTextsOrientation /BackgroundTextsGlassesPaintCode /BackgroundTextsGlassesSameSizeIfAllOf /BackgroundTextsGlassesVerticalMiddling ]} if % ... BackgroundTextsGlasses ... /PaintBackgroundCode load length 0 gt {[/PaintBackgroundCode]} if /PaintForegroundCode load length 0 gt {[/PaintForegroundCode]} if ] { 2 dict begin /Parameters exch def mark 0 1 Parameters length 1 sub { /i exch def Parameters i get ( = ) Parameters i get load dup [ exch ValueIfAscertainable ] dup length 1 eq {pop} {aload pop {exch pop} if} ifelse 0 //true ThingToDebugText dup dup length 1 sub get //AsciiSpace eq {dup length 1 sub 0 exch getinterval} if % remove trailing space i Parameters length 1 sub lt {(; )} if } for % i ConcatenateToMark OutputToLog end } bind forall % used sets of decorative parameters } if % DeBugLevel 100 le % Prefixed to the page names visible from within Acrobat /UnnamedAttendee dup where {pop pop} {Names length 1 le {(Everybody)} {(Extra)} ifelse def} ifelse /InitialMatrix matrix currentmatrix def /ShownPages 0 def /ShownPagesData 512 array def /ShownGlassesCircles 0 def /ShownGlassesCirclesData 1024 array def /DestOther 0 def /DestPrefixOther (Other_) def /DestGlasses 0 def /DestPrefixGlasses (Glasses_) def /DestDecanterLabels 0 def /DestPrefixDecanterLabels (DecanterLabels_) def /DestTastingNotes 0 def /DestPrefixTastingNotes (TastingNotes_) def /DestPlaceName 0 def /DestPrefixPlaceName (PlaceName_) def /DestPrePour 0 def /DestPrefixPrePour (PrePour_) def /DestBottleWrap 0 def /DestPrefixBottleWrap (BottleWrap_) def /DestStickyLabels 0 def /DestPrefixStickyLabels (StickyLabels_) def /DestVoteRecorder 0 def /DestPrefixVoteRecorders (VoteRecorder_) def /DestDecantingNotes 0 def /DestPrefixDecantingNotes (DecantingNotes_) def /DestAccounts 0 def /DestPrefixAccounts (Accounts_) def /DestCorkDisplay 0 def /DestPrefixCorkDisplay (CorkDisplay_) def /DestNeckTags 0 def /DestPrefixNeckTags (NeckTags_) def /DestOneCircle 0 def /DestPrefixOneCircle (OneCircle_) def /DestEmpty 0 def /DestPrefixEmpty (Empty_) def PagesToBeInserted {/PagesToBeInsertedInstanceNums [ PagesToBeInsertedDests length {-1} repeat ] def} if /PagesToBeInsertedWarning (\n\nWarning, don't forget to insert pages with named destinations as follows:) def % UpdatePageCount PageSuppressed bool /PageSuppressed { << exch /UpdatePageCount exch /i 0 >> begin ShownPages TestingMaxNumPagesToShow lt { OneCircleSuppressOtherPageTypes % Alas, https://groups.google.com/g/comp.lang.postscript/c/7a_jxsF6Yt8/m/eHyYcwaUwQoJ {/OneCircle TypeOfPagesBeingRendered ne} {BottleWrapSuppressOtherPageTypes {/BottleWrap TypeOfPagesBeingRendered ne} {//false} ifelse} ifelse { i TestingSuppressPageTypes length ge {exit} if TestingSuppressPageTypes i get TypeOfPagesBeingRendered eq { i TestingSuppressPageTypes length 1 sub lt {TestingSuppressPageTypes i 1 add get IsNumber { /i i 1 add store TestingSuppressPageTypes i 2 copy get dup 1 lt {pop pop pop pop //true exit} {UpdatePageCount {1 sub put} {pop pop pop} ifelse} ifelse } {pop //true exit} ifelse} {pop //true exit} ifelse } if % ... TypeOfPagesBeingRendered eq /i i 1 add store } loop % i } {//true} ifelse end } bind def % /PageSuppressed /ShowPage { //true PageSuppressed not { 3 dict begin /PagesToBeInsertedNum 0 def % If a page is to be inserted into the file after this page, then there might be an extra Table-of-Contents entry for it. /PageNum ShownPages 0 eq {0} {ShownPagesData ShownPages 1 sub get /PageNum get 1 add PagesToBeInsertedNum add} ifelse def PagesToBeInserted { /PagesToBeInsertedData [ 0 1 PagesToBeInsertedNumPages length 1 sub { /i exch def % Need this page to be one of set, but not previous page //false PagesToBeInsertedBeforeTypeOneOf i get {TypeOfPagesBeingRendered eq {pop //true exit} if} forall { //true ShownPages 0 gt {PagesToBeInsertedBeforeTypeOneOf i get {ShownPagesData ShownPages 1 sub get /TypeOfPagesBeingRendered get eq {pop //false exit} if} forall} if { PagesToBeInsertedInstanceNums i 2 copy get 1 add dup 4 1 roll put PagesToBeInsertedBeforeInstances i get eq { << /PagesToBeInsertedDest PagesToBeInsertedDests i get dup type /nametype ne {dup mark (Warning: PagesToBeInsertedDests ) i ( get = ) 5 -1 roll ( is not a name. Continuing.) ConcatenateToMark OutputToLog} if /PagesToBeInsertedDescription PagesToBeInsertedDescriptions i get /PagesToBeInsertedPageNum PageNum /PageNum dup load 1 add store >> /PagesToBeInsertedNum dup load PagesToBeInsertedNumPages i GetEU add store } if % correct instance num } if % prev page not of type } if % this page of type } for % i ] def % /PagesToBeInsertedData } if % PagesToBeInserted % User-visible page titles PageLabelOverride { PageLabelOverrideWith }{ ParametersVersionDateTimeAdobeFormat dup length 2 sub 2 exch getinterval TypeOfPagesBeingRendered /Glasses eq TypeOfPagesBeingRendered /TastingNotes eq TypeOfPagesBeingRendered /PlaceName eq or or {pop [ /ThisName load dup NonEmptyCompoundObject not {pop UnnamedAttendee} if TypeOfPagesBeingRendered /Glasses eq {(: Glasses: ) SheetNum (: ) DestGlasses} if TypeOfPagesBeingRendered /TastingNotes eq SideBySideGlassesTastingNotes not and {(: Tasting notes: ) TNSheetNum (: ) DestTastingNotes} if TypeOfPagesBeingRendered /PlaceName eq {(: place-setting names: ) DestPlaceName} if ]} if % ... /Glasses ... /TastingNotes ... /PlaceName ... or or TypeOfPagesBeingRendered /PrePour eq {pop [ Titles WithinTitles get (: Pre-Pour: ) SheetNum (: ) WithinPage (: ) DestPrePour ]} if TypeOfPagesBeingRendered /BottleWrap eq {pop [ Titles WithinTitles get (: Bottle-Wrap: ) SheetNum (: ) WithinPage (: ) DestBottleWrap ]} if TypeOfPagesBeingRendered /OneCircle eq {pop [ Titles WithinTitles get (: One-circle: ) SheetNum (: ) WithinPage (: ) DestOneCircle ]} if TypeOfPagesBeingRendered /VoteRecorder eq {pop [ (Vote recorder: ) VoteRecorderSheetNum (: ) VoteRecorderTopTextNum (: ) DestVoteRecorder]} if TypeOfPagesBeingRendered /Accounts eq {pop [ (Accounts: ) DestAccounts ]} if TypeOfPagesBeingRendered /CorkDisplay eq {pop [ (Cork display: ) DestCorkDisplay ]} if TypeOfPagesBeingRendered /NeckTags eq {pop [ (Neck tags: ) DestNeckTags ]} if TypeOfPagesBeingRendered /DecantingNotes eq {pop [ (Decanting notes: ) DestDecantingNotes ]} if TypeOfPagesBeingRendered /DecanterLabels eq {pop [ (Decanter labels: ) DestDecanterLabels ]} if TypeOfPagesBeingRendered /StickyLabels eq {pop [ (Sticky labels: ) DestStickyLabels ]} if TypeOfPagesBeingRendered /Empty eq {pop [ (Empty: ) EmptyPageString ]} if } ifelse % PageLabelOverride % http://groups.google.com/g/comp.lang.postscript/c/xqXz9g44ATs % http://www.jdawiseman.com/papers/bugs/20151113_PDFDocEncodingify.txt % http://acrobat.uservoice.com/forums/590923-acrobat-for-windows-and-mac/suggestions/19268545--pagelabel-pdfmark-does-not-allow-pdf-encoding IsDistiller {version {cvr} stopped {pop //true} {3018.1009999 gt} ifelse} {//true} ifelse {PDFDocEncodingify} {ASCIIfy} ifelse dup length 255 gt {0 255 getinterval} if mark exch /Label exch /PAGELABEL pdfmark % Former bug in Adobe Distiller affecting /PAGELABELs but not /OUTs % Destination, for use in URLs of the form ...#... DestPrefixOther /DestOther TypeOfPagesBeingRendered /Glasses eq {pop pop DestPrefixGlasses /DestGlasses } if TypeOfPagesBeingRendered /TastingNotes eq {pop pop DestPrefixTastingNotes /DestTastingNotes } if TypeOfPagesBeingRendered /PlaceName eq {pop pop DestPrefixPlaceName /DestPlaceName } if TypeOfPagesBeingRendered /PrePour eq {pop pop DestPrefixPrePour /DestPrePour } if TypeOfPagesBeingRendered /BottleWrap eq {pop pop DestPrefixBottleWrap /DestBottleWrap } if TypeOfPagesBeingRendered /OneCircle eq {pop pop DestPrefixOneCircle /DestOneCircle } if TypeOfPagesBeingRendered /VoteRecorder eq {pop pop DestPrefixVoteRecorders /DestVoteRecorder } if TypeOfPagesBeingRendered /Accounts eq {pop pop DestPrefixAccounts /DestAccounts } if TypeOfPagesBeingRendered /CorkDisplay eq {pop pop DestPrefixCorkDisplay /DestCorkDisplay } if TypeOfPagesBeingRendered /NeckTags eq {pop pop DestPrefixNeckTags /DestNeckTags } if TypeOfPagesBeingRendered /DecantingNotes eq {pop pop DestPrefixDecantingNotes /DestDecantingNotes} if TypeOfPagesBeingRendered /DecanterLabels eq {pop pop DestPrefixDecanterLabels /DestDecanterLabels} if TypeOfPagesBeingRendered /StickyLabels eq {pop pop DestPrefixStickyLabels /DestStickyLabels } if TypeOfPagesBeingRendered /Empty eq {pop pop DestPrefixEmpty /DestEmpty } if dup load dup 3 1 roll 1 add store ToString Concatenate cvn /PageDestName exch def mark /Dest PageDestName /View [TypeOfPagesBeingRendered /VoteRecorder eq {/FitH PageHeight} {/Fit} ifelse] /DEST pdfmark ShownPages ShownPagesData length ge {/ShownPagesData ShownPagesData length 2 mul array dup 0 ShownPagesData putinterval store} if ShownPagesData ShownPages << [ /PageWidth /PageHeight /MgnL /MgnB /MgnR /MgnT /PageDestName /ThisPageOrdering /TypeOfPagesBeingRendered /SideBySideGlassesTastingNotes /NameNum /SheetNum /TNSheetNum /WithinTitles /PlaceNameSetNum /VoteRecorderSheetNum /VoteRecorderTopTextNum /DecantingNotesSheetNum /DecanterLabelsThisPageTitles /CorkDisplayThisPageTitles /NeckTagsThisPageTitles /StickyLabelsTypeThis /StickyLabelsWithPagePortraitNumRows /StickyLabelsWithPagePortraitNumCols /StickyLabelsThisPageTitlesNames ] {dup dup where {exch get} {pop //null} ifelse} forall % Over wanted fields /ThisPaperType //null //null TypeOfPagesBeingRendered /Glasses eq {pop pop PaperType Orientation} if TypeOfPagesBeingRendered /TastingNotes eq {pop pop TastingNotesPaperType TastingNotesOrientation} if TypeOfPagesBeingRendered /PlaceName eq {pop pop PlaceNamesPaperType PlaceNamesOrientation} if TypeOfPagesBeingRendered /PrePour eq {pop pop PrePourPaperType PrePourOrientation} if TypeOfPagesBeingRendered /BottleWrap eq {pop pop BottleWrapPaperType BottleWrapOrientation} if TypeOfPagesBeingRendered /VoteRecorder eq {pop pop VoteRecorderPaperType VoteRecorderOrientation} if TypeOfPagesBeingRendered /DecantingNotes eq {pop pop DecantingNotesPaperType DecantingNotesOrientation} if TypeOfPagesBeingRendered /Accounts eq {pop pop AccountsPaperType AccountsOrientation} if TypeOfPagesBeingRendered /CorkDisplay eq {pop pop CorkDisplayPaperType CDBestOrientation} if TypeOfPagesBeingRendered /Empty eq {pop pop PaperType Orientation} if TypeOfPagesBeingRendered /NeckTags eq {pop pop NeckTagsPaperType /Portrait } if TypeOfPagesBeingRendered /StickyLabels eq {pop pop StickyLabelsPaperType /Portrait } if TypeOfPagesBeingRendered /DecanterLabels eq {pop pop DecanterLabelsPaperType DLOrientation {/Portrait} {/Landscape} ifelse} if /ThisOrientation exch /PageNum PageNum /PagesToBeInsertedData PagesToBeInserted {PagesToBeInsertedData} {[]} ifelse TypeOfPagesBeingRendered /Glasses eq {/ThisName Names dup length NameNum gt {NameNum get} {pop UnnamedAttendee PDFDocEncodingify} ifelse} if TypeOfPagesBeingRendered /TastingNotes eq {/ThisName NamesTastingNotes dup length NameNum gt {NameNum get} {pop UnnamedAttendee PDFDocEncodingify} ifelse} if TypeOfPagesBeingRendered /PlaceName eq {/ThisName NamesPlaceNames PlaceNameSetNum get dup length NameNum gt {NameNum get} {pop UnnamedAttendee PDFDocEncodingify} ifelse} if >> readonly put TypeOfPagesBeingRendered /Glasses eq dup {pop /GlassesDestForEachCircle load MightBeTrue} if { 4 dict begin 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def CircleNonEmpty SheetNum get WithinPage get { [ mark (Circle) [ NameNum SheetNum WithinPage GlassesCopyNum dup 0 le {pop} if ] {(_) exch 5 string cvs dup length 1 eq {(0) exch} if} forall ConcatenateToMark GlassesNumCopies 2 ge GlassesCopyNum 0 le and {dup (_00) Concatenate exch cvn exch} if cvn % If GlassesNumCopies>1 then double DEST, both with and without GlassesCopyNum ] { /GlassesCircleDestName exch def GlassesDestForEachCircle { mark /Dest GlassesCircleDestName /View [/FitR GlassPositions SheetNum get WithinPage get aload pop exch Radii SheetNum get //PrinterEpsilon add exch 1 index % y r x r 4 copy sub 3 1 roll sub 6 2 roll add 3 1 roll add ] /DEST pdfmark } if % GlassesDestForEachCircle } forall ShownGlassesCircles ShownGlassesCirclesData length ge {/ShownGlassesCirclesData ShownGlassesCirclesData length 2 mul array dup 0 ShownGlassesCirclesData putinterval store} if ShownGlassesCirclesData ShownGlassesCircles << /SheetNum SheetNum /PaperType PaperType /WithinPage WithinPage /WithinTitles WithinTitles /NameNum NameNum /GlassesCircleDestName GlassesCircleDestName /PageNum ShownPages >> put /ShownGlassesCircles dup load 1 add store } if % CircleNonEmpty ... } for % WithinPage, WithinTitles end } if % ... /Glasses ...GlassesDestForEachCircle ... end TestingShowThesePagesOnly dup type /arraytype eq {//false exch {execU ShownPages eq {pop //true exit} if} forall} {pop //true} ifelse {showpage} {erasepage initgraphics} ifelse /ShownPages dup load 1 add store } {erasepage initgraphics} ifelse % PageSuppressed not % http://groups.google.com/g/comp.lang.postscript/c/HVZVz0eBwrw } bind def % /ShowPage /IsNumber {type dup /integertype eq exch /realtype eq or} bind def /Min {//Infinity exch {2 copy gt {exch} if pop} forall} bind def /Max {//InfinityNeg exch {2 copy lt {exch} if pop} forall} bind def /MinToMark {//Infinity {exch dup mark eq {pop exit} if 2 copy gt {exch} if pop} loop} bind def /MaxToMark {//InfinityNeg {exch dup mark eq {pop exit} if 2 copy lt {exch} if pop} loop} bind def % array ShuffleArray array /ShuffleArray { 2 dict begin dup length 1 sub -1 1 { /i exch def /j rand i 1 add mod def i j ne {dup dup dup dup i get 3 1 roll j get i exch put j exch put} if } for % i end } bind def % /ShuffleArray % Thing0 Thing1 Code ExecArrays TwoArraysFunction Thing % Builds new array, as deep as deeper, with Code applied to pairwise non-array elements. % If a non-array thing applied to array, it is used with all inner things of the array. % Use: applying the likes of {mul} to two nested arrays. /TwoArraysFunction { 2 dict begin /ExecArrays exch def /Code exch def TwoArraysFunctionRecursive end } bind def % /TwoArraysFunction /TwoArraysFunctionRecursive { 2 dict begin /Thing1 exch def /Thing0 exch def /Thing1 load type /arraytype eq % for inner test /Thing0 load type /arraytype eq { { /Thing0 load length /Thing1 load length eq {[ 0 1 /Thing0 load ExecArrays {execU} if length 1 sub {dup /Thing0 load ExecArrays {execU} if exch get exch /Thing1 load ExecArrays {execU} if exch get TwoArraysFunctionRecursive} for ]} {(Error: TwoArraysFunctionRecursive, arrays of different lengths.) OutputToLog stop} ifelse % equal lengths }{ [ /Thing0 load ExecArrays {execU} if {/Thing1 load TwoArraysFunctionRecursive} forall ] } ifelse % /Thing1 ... /arraytype eq }{ {[ /Thing1 load ExecArrays {execU} if {/Thing0 load exch TwoArraysFunctionRecursive} forall ]} {/Thing0 load /Thing1 load Code} ifelse % /Thing1 ... /arraytype eq } ifelse % /Thing0 ... /arraytype eq end } bind def % /TwoArraysFunctionRecursive /TwoArraysFunctionDiv {dup abs //PrinterEpsilon le {pop abs //PrinterEpsilon le {(0/0)} {(Infinity)} ifelse} {div dup abs 0.01 lt {pop (small)} if} ifelse} bind def % Array AnyMatches boolean /AnyMatches { 4 dict begin /Param exch def //false 1 1 Param length 1 sub { /a exch def 0 1 a 1 sub { /b exch def Param dup a GetEU exch b GetEU eq {pop //true exit} if } for % b dup {exit} if } for % a end } bind def % /AnyMatches % http://bugs.ghostscript.com/show_bug.cgi?id=689664 /CurrentFontSize { //DeBugLevel 5 le {(+CurrentFontSize) OutputToLog} if currentfont dup /FontMatrix get 3 get % current y scale exch /FontName get findfont /FontMatrix get 3 get % original y scale div //DeBugLevel 5 le {(-CurrentFontSize) OutputToLog} if } bind def % /CurrentFontSize % http://groups.google.com/g/comp.lang.postscript/c/cteFkRmWMVg /CurrentFontName {currentfont /FontName get} bind def /SubscriptOn {0 CurrentFontSize -0.25 mul rmoveto CurrentFontName CurrentFontSize 1.7 div selectfont} bind def /SubscriptOff {CurrentFontName CurrentFontSize 1.7 mul selectfont 0 CurrentFontSize 0.25 mul rmoveto} bind def /SuperscriptOn {0 CurrentFontSize 0.375 mul rmoveto CurrentFontName CurrentFontSize 1.7 div selectfont} bind def /SuperscriptOff {CurrentFontName CurrentFontSize 1.7 mul selectfont 0 CurrentFontSize -0.375 mul rmoveto} bind def /Kern {CurrentFontSize mul 0 rmoveto} bind def /UnderlineX0 //null def /UnderlineY0 //null def /UnderlineMatrix //null def /ThroughlineX0 //null def /ThroughlineY0 //null def /ThroughlineMatrix //null def /UnderlineBegin { /UnderlineMatrix matrix currentmatrix store currentpoint /UnderlineY0 exch store /UnderlineX0 exch store} def /ThroughlineBegin {/ThroughlineMatrix matrix currentmatrix store currentpoint /ThroughlineY0 exch store /ThroughlineX0 exch store} def /UnderlinePaint { << /PrepstnlineX0 UnderlineX0 /PrepstnlineY0 UnderlineY0 /PrepstnlineMatrix UnderlineMatrix >> begin /Under PrepositionlinePaint end } def % /UnderlinePaint /ThroughlinePaint { << /PrepstnlineX0 ThroughlineX0 /PrepstnlineY0 ThroughlineY0 /PrepstnlineMatrix ThroughlineMatrix >> begin /Through PrepositionlinePaint end } def % /ThroughlinePaint % /Under|/Through PrepositionlinePaint - /PrepositionlinePaint { //DeBugLevel 15 le {(+PrepositionlinePaint) OutputToLog} if 6 dict begin /PrepositionWhich exch def matrix currentmatrix PrepstnlineMatrix setmatrix currentpoint /PrepstnlineY1 exch def /PrepstnlineX1 exch def setmatrix /PrepstnlineLength PrepstnlineX1 PrepstnlineX0 sub dup mul PrepstnlineY1 PrepstnlineY0 sub dup mul add sqrt def PrepstnlineLength 0 gt { /HalfPrepstnlineWidth currentfont /FontInfo known {currentfont /FontInfo get /UnderlineThickness known} {//false} ifelse {currentfont /FontInfo get /UnderlineThickness get CurrentFontSize mul} {CurrentFontSize 20.48 div} % 20.48 is actual constant for /TimesNewRomanPS-ItalicMT ifelse 2 div def % /HalfPrepstnlineWidth /OffsetY 1 { /Under PrepositionWhich eq { currentfont /FontInfo known {currentfont /FontInfo get /UnderlinePosition known} {//false} ifelse {currentfont /FontInfo get /UnderlinePosition get CurrentFontSize mul} {(Qgjpqy) StringPathBBox pop pop exch pop 3 div currentlinewidth 2 div sub} ifelse exit } if % /Under /Through PrepositionWhich eq {(o) StringPathBBox 2 div 4 1 roll pop pop pop exit} if mark (Error in PrepositionlinePaint: unknown value of PrepositionWhich = ) PrepositionWhich (. Continuing.) ConcatenateToMark OutputToLog 0 } repeat def % /OffsetY matrix currentmatrix PrepstnlineMatrix setmatrix PrepstnlineY0 PrepstnlineY1 sub PrepstnlineLength div OffsetY HalfPrepstnlineWidth add mul PrepstnlineX0 add PrepstnlineX1 PrepstnlineX0 sub PrepstnlineLength div OffsetY HalfPrepstnlineWidth add mul PrepstnlineY0 add moveto % top of arc at start of underline PrepstnlineY0 PrepstnlineY1 sub PrepstnlineLength div % x PrepstnlineX1 PrepstnlineX0 sub PrepstnlineLength div % y 2 copy atan neg /a exch def OffsetY mul exch OffsetY mul 2 copy PrepstnlineX0 add exch PrepstnlineY0 add HalfPrepstnlineWidth a 90 add a 270 add arc PrepstnlineX1 add exch PrepstnlineY1 add HalfPrepstnlineWidth a 90 sub a 90 add arc closepath fill PrepstnlineX1 PrepstnlineY1 moveto setmatrix } if % PrepstnlineLength 0 gt end /PrepstnlineMatrix //null store /PrepstnlineY0 //null store /PrepstnlineX0 //null store //DeBugLevel 15 le {(-PrepositionlinePaint) OutputToLog} if } def % /PrepositionlinePaint % compoundString ToSmallCaps [pieces] % Doesn't touch executable pieces: they not small-caps'd. Works well with font /DejaVuSerifCondensed, and presumably (but not tested) other /DejaVu... fonts. /ToSmallCaps { [ exch ToSmallCapsRecursive ] } bind def % /ToSmallCaps /SmallCapsDict << /a /uni1D00 /b /uni0299 /c /uni1D04 /d /uni1D05 /e /uni1D07 /f /uniA730 /g /uni0262 /h /uni029C /i /uni026A /j /uni1D0A /k /uni1D0B /l /uni029F /m /uni1D0D /n /uni0274 /o /uni1D0F /p /uni1D18 /r /uni0280 /s /uniA731 /t /uni1D1B /u /uni1D1C /v /uni1D20 /w /uni1D21 /y /uni028F /z /uni1D22 /ae /uni1D01 /oe /uni0276 >> readonly def % /SmallCapsDict /ToSmallCapsRecursive { 1 { dup xcheck {exit} if dup type /arraytype eq { [ exch {ToSmallCapsRecursive} forall ] exit} if dup type /nametype eq {dup //SmallCapsDict exch known {//SmallCapsDict exch get} if exit} if dup type /stringtype eq { 3 dict begin /s exch def /iPrev 0 def 0 1 s length 1 sub { /i exch def //SmallCapsDict s i 1 getinterval cvn known { i iPrev gt {s iPrev i iPrev sub getinterval} if //SmallCapsDict s i 1 getinterval cvn get /iPrev i 1 add store }{ i s length 1 sub eq {s iPrev i 1 add iPrev sub getinterval} if } ifelse % //SmallCapsDict ... known } for % i end exit } if % ... /stringtype eq } repeat } bind def % /ToSmallCapsRecursive currentdict /SmallCapsDict undef % X0 Y0 X1 Y1 HeadLength HeadWidth TailWidth Head0 Head1 ArrowPath - % Head0 and Head1 are Booleans; other parameters numeric. Recommend HeadLength:HeadWidth:TailWidth in ratio 3:3:1 ==> tip angle = 2 ArcTan[1/2] ~= 53.13 degrees. /ArrowPath { //DeBugLevel 10 le {(+ArrowPath) OutputToLog} if 9 dict begin /Head1 exch def /Head0 exch def 2 div /TailWidthHalf exch def 2 div /HeadWidthHalf exch def /HeadLength exch def /Y1 exch def /X1 exch def /Y0 exch def /X0 exch def X1 X0 sub dup mul Y1 Y0 sub dup mul add sqrt dup 0 gt { matrix currentmatrix exch X0 Y0 translate X0 X1 sub Y1 Y0 sub atan rotate Head0 {TailWidthHalf HeadLength moveto HeadWidthHalf HeadLength lineto 0 0 lineto HeadWidthHalf neg HeadLength lineto TailWidthHalf neg HeadLength lineto} {TailWidthHalf 0 moveto TailWidthHalf neg 0 lineto} ifelse % Head0 Head1 {dup HeadLength sub TailWidthHalf neg exch lineto dup HeadLength sub HeadWidthHalf neg exch lineto dup 0 exch lineto dup HeadLength sub HeadWidthHalf exch lineto HeadLength sub TailWidthHalf exch lineto} {dup TailWidthHalf neg exch lineto TailWidthHalf exch lineto} ifelse % Head1 closepath setmatrix } {pop} ifelse % Point not the same end //DeBugLevel 10 le {(-ArrowPath) OutputToLog} if } bind def % /ArrowPath % Immediate dependencies: DeBugLevel; OutputToLog; PolynomialRoots; Stopped. % - PathBBox llx lly urx ury % assesses only parts that will show visibly. I.e., proper handling of curves. /PathBBox { //DeBugLevel 10 le {(+PathBBox) OutputToLog} if 22 dict begin 1 { /MinMaxDefinedX //false def /MinMaxDefinedY //false def /b //false def % boolean playing two roles /SetMinMaxX % takes one parameter { /z exch def MinMaxDefinedX {MaxX z lt {/MaxX z def} {MinX z gt {/MinX z def} if} ifelse} % test Max first as charpath typically drawn right-to-left {/MaxX z def /MinX z def /MinMaxDefinedX //true def} ifelse } def % SetMinMaxX /SetMinMaxY % takes one parameter { /z exch def MinMaxDefinedY {MaxY z lt {/MaxY z def} {MinY z gt {/MinY z def} if} ifelse} {/MaxY z def /MinY z def /MinMaxDefinedY //true def} ifelse } def % SetMinMaxY % First rough bounds from a quick run-through, as doing so can save doing needless arithmetic in curve routine. { { % start move /y0 exch def /x0 exch def /b //true def } % end of move { % start line /y1 exch def /x1 exch def b {x0 SetMinMaxX y0 SetMinMaxY /b //false def} if x1 SetMinMaxX y1 SetMinMaxY } % end of line { % start curve /y3 exch def /x3 exch def pop pop pop pop b {x0 SetMinMaxX y0 SetMinMaxY /b //false def} if x3 SetMinMaxX y3 SetMinMaxY } % end of curve { % start close } % end of close pathforall } Stopped {(Warning: protected path in PathBBox, position 1) OutputToLog GSave 0 setflat flattenpath pathbbox GRestore exit} if % Second a slower run-through, not redoing the above, but, where necessary, thinking hard about curves. Different role for b. { { % start move /y0 exch def /x0 exch def /b //true def } % end of move { % start line /y0 exch def /x0 exch def } % end of line { % start curve /y3 exch def /x3 exch def /y2 exch def /x2 exch def /y1 exch def /x1 exch def x1 MaxX gt x1 MinX lt x2 MaxX gt x2 MinX lt or or or { % Cubic: a t^3 + b t^2 + c t + x0 /a x0 neg x1 3 mul add x2 3 mul sub x3 add def /b x0 x1 2 mul sub x2 add 3 mul def /c x1 x0 sub 3 mul def % Solve first differential for zero [ c 2 b mul 3 a mul ] 0 //true 1 //true //Epsilon PolynomialRoots {dup dup a mul b add mul c add mul x0 add SetMinMaxX} forall } if % x bounds outside MinX to MaxX y1 MaxY gt y1 MinY lt y2 MaxY gt y2 MinY lt or or or { /a y0 neg y1 3 mul add y2 3 mul sub y3 add def /b y0 y1 2 mul sub y2 add 3 mul def /c y1 y0 sub 3 mul def [ c 2 b mul 3 a mul ] 0 //true 1 //true //Epsilon PolynomialRoots {dup dup a mul b add mul c add mul y0 add SetMinMaxY} forall } if % y bounds outside MinY to MaxY /y0 y3 def /x0 x3 def } % end of curve { % start close } % end of close pathforall } Stopped {(Warning: protected path in PathBBox, position 2, which is weird unless a routine such as PolynomialRoots is missing.) OutputToLog GSave 0 setflat flattenpath pathbbox GRestore exit} if MinMaxDefinedX MinMaxDefinedY and { MinX MinY MaxX MaxY }{ b { % No lines, no curves, but some moves { {SetMinMaxY SetMinMaxX} {pop pop} {pop pop pop pop pop pop} {} % the pop's should be redundant pathforall } Stopped {(Warning: protected path in PathBBox, position 3) OutputToLog GSave 0 setflat flattenpath pathbbox GRestore exit} if MinX MinY MaxX MaxY }{ % completely empty path emptycurrentpath % this may well cause execution to cease } ifelse % b } ifelse % MinMaxDefinedX MinMaxDefinedY and } repeat % 1 end //DeBugLevel 10 le {(-PathBBox) OutputToLog} if } bind def % PathBBox % Pieces no wider than 30 degrees ==> radius correct to one part in 2,683,397 % So, on a 3600 dpi printer, accurate to half a pixel if radius <= 9.46 metres ~= 31 foot. % (Ignoring machine precision; ignoring De Casteljau's approximation; ignoring paper roller speed.) % https://stackoverflow.com/questions/77855798/postscript-circles-how-accurate-how-improve/ % http://github.com/jdaw1/placemat/issues/164 % http://groups.google.com/g/comp.lang.postscript/c/B23RW2QpIjU /ArcAccurateBoth { 18 dict begin /Widdershins exch def /StartOperator exch def % /m ==> moveto; /l ==> lineto; /n ==> nothing, presumably because already at start /Angle2 exch def /Angle1 exch def /R exch def /Y exch def /X exch def Widdershins {Angle2 Angle1 lt {/Angle2 Angle2 Angle1 Angle2 sub 360 div ceiling cvi 360 mul add def} if} {Angle2 Angle1 gt {/Angle2 Angle2 Angle2 Angle1 sub 360 div ceiling cvi 360 mul sub def} if} ifelse % Widdershins 5 dict begin [ /Ang Angle1 def { Widdershins { /Next90 Ang 90 div floor cvi 1 add 90 mul Angle2 2 copy gt {exch} if pop def /NumToNext90 Next90 Ang sub 30 div ceiling cvi def }{ /Next90 Ang 90 div ceiling cvi 1 sub 90 mul Angle2 2 copy lt {exch} if pop def /NumToNext90 Ang Next90 sub 30 div ceiling cvi def } ifelse % Widdershins /StepSize Next90 Ang sub NumToNext90 div def NumToNext90 { /Next StepSize Ang add dup dup cvi eq {cvi} if def % Can change type from real to integer [ Ang Next ] /Ang Next def } repeat Ang Angle2 Widdershins {ge} {le} ifelse {exit} if } loop ] end % Debugging: dup {==} forall //false [ /m /l /moveto /lineto ] {StartOperator eq {pop //true exit} if} forall { /X0 Angle1 cos R mul X add def /Y0 Angle1 sin R mul Y add def % https://groups.google.com/g/comp.lang.postscript/c/0Wf8UYb-Xqk/m/bT7NnP9fLWgJ % https://groups.google.com/g/comp.lang.postscript/c/KPnF5bKwz5U/m/MLGrZFPfaGoJ X0 Y0 StartOperator dup /m eq exch /moveto eq or {moveto} {{lineto} stopped {$error /newerror //false put moveto} if} ifelse } if % Not /n (/n would mean do nothing as aleady at start of curve) { aload pop /a2 exch def /a1 exch def /speed a2 a1 sub abs 30 eq {0.175536663449861137962 a2 a1 lt {neg} if} % Tan[Pi/24]*4/3 = 6 sqrt 2 sub 3 sqrt sub 2 sqrt add 4 mul 3 div {a2 a1 sub 4 div dup sin exch cos div 4 mul 3 div} ifelse R mul def % /speed /X3 a2 cos R mul X add def /Y3 a2 sin R mul Y add def /X1 X0 a1 sin speed mul sub def /Y1 Y0 a1 cos speed mul add def /X2 X3 a2 sin speed mul add def /Y2 Y3 a2 cos speed mul sub def X1 Y1 X2 Y2 X3 Y3 curveto /X0 X3 def /Y0 Y3 def } forall % [ [a1 a2] ... ] end } bind def % ArcAccurateBoth % x y r angle1 angle2 StartOperator ArcAccurate - % Mostly as arc. % StartOperator is /m or /l or /n. % /m ==> start with a moveto. % /l ==> if there is a currentpoint, start with a lineto; if not, with a moveto. % /n ==> nothing, so may assume already at the start of the arc. If not there, user's problem. /ArcAccurate {//true ArcAccurateBoth} bind def % ArcAccurate % x y r angle1 angle2 StartOperator ArcAccurateN - % Mostly as arcn. StartOperator as ArcAccurate. /ArcAccurateN {//false ArcAccurateBoth} bind def % ArcAccurateN % Immediate dependencies: DeBugLevel; OutputToLog; PolynomialRoots; Stopped; Epsilon. % AngleDeemedStraight PathDistinctiveXY [ Xs ] [ Ys ] /PathDistinctiveXY { //DeBugLevel 10 le {(+PathDistinctiveXY) OutputToLog} if 27 dict begin /cosADS exch cos def /Points 256 array def /PointsNum 0 def /AppendXY { PointsNum Points length lt {[ 3 1 roll ] Points exch PointsNum exch put /PointsNum PointsNum 1 add def} {pop pop} ifelse } def % /AppendXY /DirectionsNotParallel {DirectionX //null ne DirectionY //null ne and { X1 X0 sub Y1 Y0 sub 2 copy 2 {abs //PrinterEpsilon ge exch} repeat or { 2 copy dup mul exch dup mul add 3 1 roll DirectionY DirectionX 2 copy dup mul exch dup mul add 5 1 roll 3 1 roll mul 3 1 roll mul add 3 1 roll mul sqrt div cosADS lt } {pop pop //false} ifelse % ... //PrinterEpsilon ge ... } {//false} ifelse} def % Non-null, /DirectionsNotParallel /DefDirectionsXY % true => success { 2 copy //null eq exch //null eq or { pop pop /DirectionY //null def /DirectionX //null def //true }{ 2 copy 2 {abs //PrinterEpsilon ge exch} repeat or { DirectionY //null eq {dup /DirectionFirstY exch def} if /DirectionY exch def DirectionX //null eq {dup /DirectionFirstX exch def} if /DirectionX exch def //true } {pop pop //false} ifelse % ... //PrinterEpsilon ge ... } ifelse % //null ... or } def % DefDirectionsXY /lineProcess % also used for close { DirectionsNotParallel {X0 Y0 AppendXY} if X1 X0 sub Y1 Y0 sub DefDirectionsXY pop } def % /lineProcess { { % start move dup /Y0 exch def /Ystart exch def /DirectionY //null def dup /X0 exch def /Xstart exch def /DirectionX //null def } % end of move { % start line /Y1 exch def /X1 exch def lineProcess /Y0 Y1 def /X0 X1 def } % end of line { % start curve /Y3 exch def /X3 exch def /Y2 exch def /X2 exch def /Y1 exch def /X1 exch def DirectionsNotParallel {X0 Y0 AppendXY} if % Cubic: a t^3 + b t^2 + c t + x0 /AX X0 neg X1 3 mul add X2 3 mul sub X3 add def /BX X0 X1 2 mul sub X2 add 3 mul def /CX X1 X0 sub 3 mul def /AY Y0 neg Y1 3 mul add Y2 3 mul sub Y3 add def /BY Y0 Y1 2 mul sub Y2 add 3 mul def /CY Y1 Y0 sub 3 mul def % Solve first differential for zero [ [ CX 2 BX mul 3 AX mul ] 0 //false 1 //false //Epsilon PolynomialRoots aload pop [ CY 2 BY mul 3 AY mul ] 0 //false 1 //false //Epsilon PolynomialRoots aload pop ]{ dup dup dup AX mul BX add mul CX add mul X0 add exch dup dup AY mul BY add mul CY add mul Y0 add AppendXY } forall 1 { X3 X2 sub Y3 Y2 sub DefDirectionsXY {exit} if X3 X1 sub Y3 Y1 sub DefDirectionsXY {exit} if X3 X0 sub Y3 Y0 sub DefDirectionsXY pop } repeat % 1 /Y0 Y3 def /X0 X3 def } % end of curve { % start close /Y1 Ystart def /X1 Xstart def lineProcess /X1 X0 DirectionFirstX add /X0 X1 def def /Y1 Y0 DirectionFirstY add /Y0 Y1 def def lineProcess /DirectionY //null def /DirectionX //null def } % end of close pathforall } Stopped {(Warning: protected path in PathDistinctiveXY, or a routine such as PolynomialRoots is missing.) OutputToLog} if Points 0 PointsNum getinterval end //DeBugLevel 10 le {(-PathDistinctiveXY) OutputToLog} if } bind def % /PathDistinctiveXY % CentreX CentreY MinMaxRadiusSquared Tolerance PathBRadiusSquared MaxRadiusSquared % What is largest distance from CentreX,CentreY? /PathBRadiusSquared { //DeBugLevel 10 le {(+PathBRadiusSquared) OutputToLog} if 23 dict begin /Tolerance exch def /MaxRadiusSquared exch def /CentreY exch def /CentreX exch def /SetMaxR % takes two parameters, x y { CentreY sub dup mul exch CentreX sub dup mul add dup MaxRadiusSquared gt {/MaxRadiusSquared exch def} {pop} ifelse } def % SetMaxR 1 { % First rough bounds from a quick run-through, as doing so can save doing needless arithmetic in curve routine. { { % start move /y0 exch def /x0 exch def /b //true def } % end of move { % start line b {x0 y0 SetMaxR /b //false def} if /y0 exch def /x0 exch def x0 y0 SetMaxR } % end of line { % start curve b {x0 y0 SetMaxR /b //false def} if /y0 exch def /x0 exch def pop pop pop pop x0 y0 SetMaxR } % end of curve { % start close } % end of close pathforall } Stopped { (Warning: protected path in PathBRadiusSquared, position 1) OutputToLog GSave flattenpath pathbbox GRestore 4 copy 3 1 roll exch SetMaxR SetMaxR SetMaxR SetMaxR exit } if % Stopped % Second a slower run-through, not redoing the above, but, where necessary, thinking hard about curves. Different role for b. { { % start move /y0 exch def /x0 exch def } % end of move { % start line /y0 exch def /x0 exch def } % end of line { % start curve /y3 exch def /x3 exch def /y2 exch def /x2 exch def /y1 exch def /x1 exch def y2 CentreY sub dup mul x2 CentreX sub dup mul add MaxRadiusSquared gt y1 CentreY sub dup mul x1 CentreX sub dup mul add MaxRadiusSquared gt or { /ax x0 neg x1 3 mul add x2 3 mul sub x3 add def /ay y0 neg y1 3 mul add y2 3 mul sub y3 add def /bx x0 x1 2 mul sub x2 add 3 mul def /by y0 y1 2 mul sub y2 add 3 mul def /cx x1 x0 sub 3 mul def /cy y1 y0 sub 3 mul def /tNumIntervals Tolerance 0 eq {256} { x0 x1 sub abs x0 x2 sub abs x0 x3 sub abs x1 x2 sub abs x1 x3 sub abs x2 x3 sub abs y0 y1 sub abs y0 y2 sub abs y0 y3 sub abs y1 y2 sub abs y1 y3 sub abs y2 y3 sub abs 11 {2 copy lt {exch} if pop} repeat Tolerance add 3 mul Tolerance div ceiling cvi % the 3 mul is slightly excessive } ifelse def % /tNumIntervals 1 1 tNumIntervals 1 sub { tNumIntervals div /t exch def ax t mul bx add t mul cx add t mul x0 add ay t mul by add t mul cy add t mul y0 add SetMaxR } for % t } if % curve might cross current boundary /y0 y3 def /x0 x3 def } % end of curve { % start close } % end of close pathforall } exec //false % Stopped { (Warning: protected path in PathBRadiusSquared, position 2) OutputToLog GSave flattenpath pathbbox GRestore 4 copy 3 1 roll exch SetMaxR SetMaxR SetMaxR SetMaxR exit } if % Stopped } repeat % 1 MaxRadiusSquared end //DeBugLevel 10 le {(-PathBRadiusSquared) OutputToLog} if } bind def % PathBRadiusSquared % ExpansionCentreX ExpansionCentreY CircleCentreX CircleCentreY CircleRadius PathMaxScalingFitCircle Scaling % Given a fixed circle, and a path, buy how what factor can the path be expanded about a fixed point and still fit in circle? /PathMaxScalingFitCircle { //DeBugLevel 10 le {(+PathMaxScalingFitCircle) OutputToLog} if 31 dict begin /CircleRadius exch def /CircleCentreY exch def /CircleCentreX exch def /ExpansionCentreY exch def /ExpansionCentreX exch def /MaxS //Infinity def 1 { /SetMaxS % takes two parameters, x y, returns boolean showing whether an improvement { /yyy exch def /xxx exch def % ( s*(xxx-ExpansionCentreX) + ExpansionCentreX - CircleCentreX )^2 + ( s*(yyy-ExpansionCentreY) + ExpansionCentreY - CircleCentreY )^2 == CircleRadius^2 % Hence: % s^2: (xxx-ExpansionCentreX)^2 + (yyy-ExpansionCentreY)^2 % s^1: 2(xxx-ExpansionCentreX)*(ExpansionCentreX-CircleCentreX) + 2(yyy-ExpansionCentreY)*(ExpansionCentreY-CircleCentreY) % s^0: (ExpansionCentreX-CircleCentreX)^2 + (ExpansionCentreY-CircleCentreY)^2 - CircleRadius^2 /aaa xxx ExpansionCentreX sub dup mul yyy ExpansionCentreY sub dup mul add def //false aaa 0 gt { /bbb xxx ExpansionCentreX sub ExpansionCentreX CircleCentreX sub mul yyy ExpansionCentreY sub ExpansionCentreY CircleCentreY sub mul add 2 mul def /ccc ExpansionCentreX CircleCentreX sub dup mul ExpansionCentreY CircleCentreY sub dup mul add CircleRadius dup mul sub def [ ccc bbb aaa ] 0 //true //Infinity //true //PrinterEpsilon PolynomialRoots {dup MaxS lt {/MaxS exch def pop //true} {pop} ifelse} forall } if % aaa 0 gt } def % SetMaxS % Can't test for bounding box, so only one run-through { { % start move /y0 exch def /x0 exch def /b //true def } % end of move { % start line b {x0 y0 SetMaxS pop /b //false def} if /y0 exch def /x0 exch def x0 y0 SetMaxS pop } % end of line { % start curve /y3 exch def /x3 exch def /y2 exch def /x2 exch def /y1 exch def /x1 exch def b {x0 y0 SetMaxS pop /b //false def} if x3 y3 SetMaxS pop /ax x0 neg x1 3 mul add x2 3 mul sub x3 add def /ay y0 neg y1 3 mul add y2 3 mul sub y3 add def /bx x0 x1 2 mul sub x2 add 3 mul def /by y0 y1 2 mul sub y2 add 3 mul def /cx x1 x0 sub 3 mul def /cy y1 y0 sub 3 mul def /MoreWorkToDo //false def 1 1 7 { 8 div /t exch def ax t mul bx add t mul cx add t mul x0 add ay t mul by add t mul cy add t mul y0 add SetMaxS {/MoreWorkToDo //true def} if } for % t MoreWorkToDo { 1 1 255 { dup 8 mod 0 ne { 256 div /t exch def ax t mul bx add t mul cx add t mul x0 add ay t mul by add t mul cy add t mul y0 add SetMaxS pop } {pop} ifelse % 8 mod 0 ne } for % t } if % MoreWorkToDo /y0 y3 def /x0 x3 def } % end of curve { % start close } % end of close pathforall } Stopped { (Warning: protected path in PathMaxScalingFitCircle) OutputToLog GSave flattenpath pathbbox GRestore 4 copy 3 1 roll exch SetMaxS pop SetMaxS pop SetMaxS pop SetMaxS pop exit } if % Stopped MaxS } repeat % 1 end //DeBugLevel 10 le {(-PathMaxScalingFitCircle) OutputToLog} if } bind def % PathMaxScalingFitCircle % Immediate dependencies: DeBugLevel; OutputToLog; PrinterEpsilon; Epsilon; Infinity; InfinityNeg; PolynomialRoots. % Have functions X[z] and Y[z], for z over some range. ApproximatingCurve approximates such a path with a single cubic Bezier curve. That approximation % has, at the _s_tart and _e_nd points, same position as original function, same tangent, same curvature. ApproximatingCurve returns the middle two % knot points of a cubic Bezier. The calling code might, for example, have the first as the currentpoint, and append the last before calling curveto. % Xs Ys Xe Ye dXs dYs dXe dYe ddXs ddYs ddXe ddYe SpeedUpperLimit ApproximatingCurve X1 Y1 X2 Y2 % http://stackoverflow.com/questions/77862965/how-approximate-xz-yz-functions-as-b%c3%a9zier-cubic/ % http://groups.google.com/g/comp.lang.postscript/c/3RIq0Jnwrbo % https://math.stackexchange.com/a/4810490/822964 /ApproximatingCurve { //DeBugLevel 10 le {(+ApproximatingCurve) OutputToLog} if 29 dict begin /SpeedUpperLimit exch def /ddYe exch def /ddXe exch def /ddYs exch def /ddXs exch def /dYe exch def /dXe exch def /dYs exch def /dXs exch def /Ye exch def /Xe exch def /Ys exch def /Xs exch def 1 { dXs abs 2.5E-10 le dYs abs 2.5E-10 le and % One part in four billion. Just about fourth-powerable without being zero. { ddXs abs 2.5E-10 le ddYs abs 2.5E-10 le and { (Warning in ApproximatingCurve: function to be approximated has zero speed and acceleration at start. Straight line output.) OutputToLog Xs 2 mul Xe add 3 div Ys 2 mul Ye add 3 div Xs Xe 2 mul add 3 div Ys Ye 2 mul add 3 div exit }{ (Warning in ApproximatingCurve: function to be approximated has zero speed at start. Assuming zero curvature.) OutputToLog /dXs ddXs def /dYs ddYs def } ifelse % Zero acceleration at start } if % Zero speed at start dXe abs 2.5E-10 le dYe abs 2.5E-10 le and { ddXe abs 2.5E-10 le ddYe abs 2.5E-10 le and { (Warning in ApproximatingCurve: function to be approximated has zero speed and acceleration at end. Straight line output.) OutputToLog Xe 2 mul Xe add 3 div Ye 2 mul Ye add 3 div Xe Xe 2 mul add 3 div Ye Ye 2 mul add 3 div exit }{ (Warning in ApproximatingCurve: function to be approximated has zero speed at end. Assuming zero curvature.) OutputToLog /dXe ddXe def /dYe ddYe def } ifelse % Zero acceleration at end } if % Zero speed at end /Xgap Xe Xs sub def /Ygap Ye Ys sub def % Implicitly setting (Xs,Ys) to (0,0) lessens accumulated arithmetic errors. % Two equations, each factors into two quartics. Can arrange Speed2 in terms of Speed1, but that has a divide-by-zero if end velocities % parallel. Instead consider the four possibilities of one quartic from each equation, solve pairwise, take best. Inelegant, but functional. /Speed1Coeffs [ [ 4 -2 dXs dup mul mul Xgap mul dYe mul 2 dXe mul dXs mul 2 dYs mul Xgap mul dXs Ygap mul add mul add dYe mul -2 dYs mul dYs Xgap mul dXs Ygap mul 2 mul add mul dXe dup mul mul 3 ddXe mul dYs Xgap mul dXs Ygap mul sub dup mul mul add add dYe mul dXe 3 ddYe mul Xgap dup mul mul 2 dXe dup mul mul Ygap mul sub dYs mul 6 ddYe mul dXs mul Xgap mul Ygap mul sub dYs mul 3 ddYe mul dXs dup mul mul Ygap dup mul mul add mul sub mul % Coeff 0 8 dXs dYe mul dXe dYs mul sub dup dup mul mul mul % Coeff 1 36 ddYe dXe mul ddXe dYe mul sub mul ddYs dXs mul ddXs dYs mul sub mul dXs Ygap mul dYs Xgap mul sub mul % Coeff 2 0 % Coeff 3 -27 ddYe dXe mul ddXe dYe mul sub mul ddYs dXs mul ddXs dYs mul sub dup mul mul % Coeff 4 ][ 4 2 dXs dup mul mul Xgap mul dYe mul 2 dXe mul dXs mul 2 dYs mul Xgap mul dXs Ygap mul add mul sub dYe mul 2 dYs mul dYs Xgap mul dXs Ygap mul 2 mul add mul dXe dup mul mul 3 ddXe mul dYs Xgap mul dXs Ygap mul sub dup mul mul add add dYe mul dXe 3 ddYe mul Xgap dup mul mul 2 dXe dup mul mul Ygap mul add dYs mul 6 ddYe mul dXs mul Xgap mul Ygap mul sub dYs mul 3 ddYe mul dXs dup mul mul Ygap dup mul mul add mul sub mul % Coeff 0 -8 dXs dYe mul dXe dYs mul sub dup dup mul mul mul % Coeff 1 36 ddYe dXe mul ddXe dYe mul sub mul ddYs dXs mul ddXs dYs mul sub mul dXs Ygap mul dYs Xgap mul sub mul % Coeff 2 0 % Coeff 3 -27 ddYe dXe mul ddXe dYe mul sub mul ddYs dXs mul ddXs dYs mul sub dup mul mul % Coeff 4 ][ 4 -2 dXs dup mul mul Xgap mul dYe mul 2 dXe mul dXs mul 2 dYs mul Xgap mul dXs Ygap mul add mul add dYe mul -2 dYs mul dYs Xgap mul dXs Ygap mul 2 mul add mul dXe dup mul mul 3 ddXe mul dYs Xgap mul dXs Ygap mul sub dup mul mul add add dYe mul dXe 3 ddYe mul Xgap dup mul mul 2 dXe dup mul mul Ygap mul sub dYs mul 6 ddYe mul dXs mul Xgap mul Ygap mul sub dYs mul 3 ddYe mul dXs dup mul mul Ygap dup mul mul add mul sub mul % Coeff 0 8 dXs dYe mul dXe dYs mul sub dup dup mul mul mul % Coeff 1 -36 ddYe dXe mul ddXe dYe mul sub mul ddYs dXs mul ddXs dYs mul sub mul dXs Ygap mul dYs Xgap mul sub mul % Coeff 2 0 % Coeff 3 -27 ddYe dXe mul ddXe dYe mul sub mul ddYs dXs mul ddXs dYs mul sub dup mul mul % Coeff 4 ][ 4 2 dXs dup mul mul Xgap mul dYe mul 2 dXe mul dXs mul 2 dYs mul Xgap mul dXs Ygap mul add mul sub dYe mul 2 dYs mul dYs Xgap mul dXs Ygap mul 2 mul add mul dXe dup mul mul 3 ddXe mul dYs Xgap mul dXs Ygap mul sub dup mul mul add add dYe mul dXe 3 ddYe mul Xgap dup mul mul 2 dXe dup mul mul Ygap mul add dYs mul 6 ddYe mul dXs mul Xgap mul Ygap mul sub dYs mul 3 ddYe mul dXs dup mul mul Ygap dup mul mul add mul sub mul % Coeff 0 -8 dXs dYe mul dXe dYs mul sub dup dup mul mul mul % Coeff 1 -36 ddYe dXe mul ddXe dYe mul sub mul ddYs dXs mul ddXs dYs mul sub mul dXs Ygap mul dYs Xgap mul sub mul % Coeff 2 0 % Coeff 3 -27 ddYe dXe mul ddXe dYe mul sub mul ddYs dXs mul ddXs dYs mul sub dup mul mul % Coeff 4 ] ] def % /Speed1Coeffs /Speed2Coeffs [ [ 8 dXe dup mul mul Xgap mul dYs mul 8 dXe mul dXs mul 2 dYe mul Xgap mul dXe Ygap mul add mul sub dYs mul 4 2 dYe mul dYe Xgap mul dXe Ygap mul 2 mul add mul dXs dup mul mul 3 ddXs mul dYe Xgap mul dXe Ygap mul sub dup mul mul sub mul add dYs mul 4 dXs mul 3 ddYs mul Xgap dup mul mul 2 dXs dup mul mul Ygap mul sub dYe mul 6 ddYs mul dXe mul Xgap mul Ygap mul sub dYe mul 3 ddYs mul dXe dup mul mul Ygap dup mul mul add mul add % Coeff 0 8 dXs dYe mul dXe dYs mul sub dup dup mul mul mul % Coeff 1 -36 ddYe dXe mul ddXe dYe mul sub mul ddYs dXs mul ddXs dYs mul sub mul dXe Ygap mul dYe Xgap mul sub mul % Coeff 2 0 % Coeff 3 27 ddYe dXe mul ddXe dYe mul sub dup mul mul ddYs dXs mul ddXs dYs mul sub mul % Coeff 4 ][ 8 dXe dup mul mul Xgap mul dYs mul 8 dXe mul dXs mul 2 dYe mul Xgap mul dXe Ygap mul add mul sub dYs mul 4 2 dYe mul dYe Xgap mul dXe Ygap mul 2 mul add mul dXs dup mul mul 3 ddXs mul dYe Xgap mul dXe Ygap mul sub dup mul mul sub mul add dYs mul 4 dXs mul 3 ddYs mul Xgap dup mul mul 2 dXs dup mul mul Ygap mul sub dYe mul 6 ddYs mul dXe mul Xgap mul Ygap mul sub dYe mul 3 ddYs mul dXe dup mul mul Ygap dup mul mul add mul add % Coeff 0 8 dXs dYe mul dXe dYs mul sub dup dup mul mul mul % Coeff 1 36 ddYe dXe mul ddXe dYe mul sub mul ddYs dXs mul ddXs dYs mul sub mul dXe Ygap mul dYe Xgap mul sub mul % Coeff 2 0 % Coeff 3 27 ddYe dXe mul ddXe dYe mul sub dup mul mul ddYs dXs mul ddXs dYs mul sub mul % Coeff 4 ][ -8 dXe dup mul mul Xgap mul dYs mul 8 dXe mul dXs mul 2 dYe mul Xgap mul dXe Ygap mul add mul add dYs mul 4 2 dYe mul dYe Xgap mul dXe Ygap mul 2 mul add mul dXs dup mul mul 3 ddXs mul dYe Xgap mul dXe Ygap mul sub dup mul mul add mul sub dYs mul 4 dXs mul 3 ddYs mul Xgap dup mul mul 2 dXs dup mul mul Ygap mul add dYe mul 6 ddYs mul dXe mul Xgap mul Ygap mul sub dYe mul 3 ddYs mul dXe dup mul mul Ygap dup mul mul add mul add % Coeff 0 -8 dXs dYe mul dXe dYs mul sub dup dup mul mul mul % Coeff 1 -36 ddYe dXe mul ddXe dYe mul sub mul ddYs dXs mul ddXs dYs mul sub mul dXe Ygap mul dYe Xgap mul sub mul % Coeff 2 0 % Coeff 3 27 ddYe dXe mul ddXe dYe mul sub dup mul mul ddYs dXs mul ddXs dYs mul sub mul % Coeff 4 ][ -8 dXe dup mul mul Xgap mul dYs mul 8 dXe mul dXs mul 2 dYe mul Xgap mul dXe Ygap mul add mul add dYs mul 4 2 dYe mul dYe Xgap mul dXe Ygap mul 2 mul add mul dXs dup mul mul 3 ddXs mul dYe Xgap mul dXe Ygap mul sub dup mul mul add mul sub dYs mul 4 dXs mul 3 ddYs mul Xgap dup mul mul 2 dXs dup mul mul Ygap mul add dYe mul 6 ddYs mul dXe mul Xgap mul Ygap mul sub dYe mul 3 ddYs mul dXe dup mul mul Ygap dup mul mul add mul add % Coeff 0 -8 dXs dYe mul dXe dYs mul sub dup dup mul mul mul % Coeff 1 36 ddYe dXe mul ddXe dYe mul sub mul ddYs dXs mul ddXs dYs mul sub mul dXe Ygap mul dYe Xgap mul sub mul % Coeff 2 0 % Coeff 3 27 ddYe dXe mul ddXe dYe mul sub dup mul mul ddYs dXs mul ddXs dYs mul sub mul % Coeff 4 ] ] def % /Speed2Coeffs /CurvatureWanted_s dXs ddYs mul dYs ddXs mul sub dXs dup mul dYs dup mul add dup sqrt mul div def /CurvatureWanted_e dXe ddYe mul dYe ddXe mul sub dXe dup mul dYe dup mul add dup sqrt mul div def /BestError //Infinity def /BestSpeed1 //InfinityNeg def /BestSpeed2 //InfinityNeg def 0 1 3 { /CoeffsNum exch def /Speed1 Speed1Coeffs CoeffsNum get 0 //false SpeedUpperLimit //true //PrinterEpsilon //Epsilon 2 copy gt {exch} if pop PolynomialRoots Min def /Speed2 Speed2Coeffs CoeffsNum get 0 //false SpeedUpperLimit //true //PrinterEpsilon //Epsilon 2 copy gt {exch} if pop PolynomialRoots Min def Speed1 //Infinity lt Speed2 //Infinity lt and { /X1 Xs Speed1 dXs mul add def /Y1 Ys Speed1 dYs mul add def /X2 Xe Speed2 dXe mul sub def /Y2 Ye Speed2 dYe mul sub def 1 { Ys Y1 sub X2 mul Y1 Y2 sub Xs mul add Y2 Ys sub X1 mul add 2 mul X1 Xs sub dup mul Y1 Ys sub dup mul add dup 0 eq {pop pop //Infinity exit} if dup sqrt mul 3 mul div CurvatureWanted_s sub dup mul Y2 Ye sub X1 mul Y1 Y2 sub Xe mul add Ye Y1 sub X2 mul add 2 mul X2 Xe sub dup mul Y2 Ye sub dup mul add dup 0 eq {pop pop //Infinity exit} if dup sqrt mul 3 mul div CurvatureWanted_e sub dup mul add } repeat % 1 dup BestError lt {/BestError exch def /BestSpeed1 Speed1 def /BestSpeed2 Speed2 def} {pop} ifelse } if % finite solutions } for % CoeffsNum BestError //Infinity lt { Xs BestSpeed1 dXs mul add Ys BestSpeed1 dYs mul add Xe BestSpeed2 dXe mul sub Ye BestSpeed2 dYe mul sub exit % GSave newpath 4 copy 2 {0.24 0 360 arc closepath 0.03 setlinewidth 0 setgray stroke} repeat GRestore }{ ( ApproximatingCurve: failure to find solution. Approximating approximation.) OutputToLog Xs 2 mul Xe add 3 div Ys 2 mul Ye add 3 div Xs Xe 2 mul add 3 div Ys Ye 2 mul add 3 div exit } ifelse % any solution to speeds } repeat % 1 end //DeBugLevel 10 le {(-ApproximatingCurve) OutputToLog} if } bind def % /ApproximatingCurve % Small steps at start. Includes points at which double and triple derivatives of curvature are zero. % If SpiralNumArms=5 and SpiralRadiusBetweenArms=30 then 3-degree point is ~=0.44mm from centre; 180-degree ~=26.5mm. /SpiralAngles [ 0 3 10 31.085889445163445342842 % 201 sqrt 13 sub sqrt 90 mul Pi div, d2Curvature/dAng2 == 0 53.382058785269409276474 % 505 sqrt 19 sub sqrt 90 mul Pi div, d3Curvature/dAng3 == 0 79 108 142 180 ] def % /SpiralAngles /SpiralAnglesLength SpiralAngles length def % Immediate dependencies: DeBugLevel; OutputToLog; PrinterEpsilon; Epsilon; DegreeInRadians. % CentreX CentreY RadiusMax NumArms RadiusBetweenArms AngOffset Clockwise InToOut StartOperator ArchimedeanSpiralPath - % Example use: %/PaintBackgroundInsideGlassCircles %{ % GSave 0 0 RadiiCirclearrayInside SheetNum get 0 360 /m ArcAccurate clip newpath % [ % {gsave 0.875 setgray fill grestore 0.12 setlinewidth 0 setgray stroke} % {} % {gsave 0.96875 setgray fill grestore 0.12 setlinewidth 0 setgray stroke} % ]{ % dup length 0 gt % { % % Each call to ArchimedeanSpiralPath has only one arm, so the "72" is gap from arm to same arm. % 0 0 RadiiCirclearrayInside SheetNum get 0.5 add 1 72 0 true false /m ArchimedeanSpiralPath % Goes in % 0 0 RadiiCirclearrayInside SheetNum get 0.5 add 1 72 90 true true /n ArchimedeanSpiralPath % Goes out % 0 0 RadiiCirclearrayInside SheetNum get 1.0 add currentpoint exch atan dup 90 add arc closepath % A little further out doesn't hurt. % exec % } {pop} ifelse % 90 rotate % } forall % The variations of {... fill ... stroke} % GRestore %} def % /PaintBackgroundInsideGlassCircles /ArchimedeanSpiralPath { //DeBugLevel 1 le {(+ArchimedeanSpiralPath) OutputToLog} if 28 dict begin /StartOperator exch def % /m ==> moveto; /l ==> lineto; /n ==> nothing, presumably because already at start /InToOut exch def % Boolean /Clockwise exch def % Boolean /AngOffset exch def % Small numeric. Typically 0, 72, 144, 216, 288. /RadiusBetweenArms exch def % Numeric, a sensible value being 18 /NumArms exch def % Integer, good values being 5 or 3. /RadiusMax exch def % How big before drawing stops? Should be < 170 * RadiusBetweenArms. /CentreY exch def /CentreX exch def /dRadius RadiusBetweenArms NumArms mul 360 div def % mark (NumArms=) NumArms (; RadiusBetweenArms=) RadiusBetweenArms (: ) //SpiralAngles {(ang=) exch ( ==> radius=) 1 index dRadius mul 127 mul 360 div (mm) (, )} forall pop (\n) ConcatenateToMark = /Angles [ 0 1 1023 % if this many done, so needing >=127 laps, then RadiusBetweenArms tiny relative to RadiusMax. { /i exch def /AngSumSteps i //SpiralAnglesLength lt {//SpiralAngles i get} {45 AngSumSteps add} ifelse def % Terminal 30 degree steps thought too slow; 45 the compromise. /Radius AngSumSteps dRadius mul def Radius abs RadiusMax dup 0 lt {pop 0} if gt { Radius abs RadiusMax abs gt {/AngSumSteps RadiusMax dRadius div def} if dup AngSumSteps exch sub 0.05 gt {AngSumSteps} if % Min increment is a twentieth of a degree. exit } {AngSumSteps} ifelse % Radius ... RadiusMax ... gt } for % i ] def % /Angles 0 1 NumArms 1 sub { /SpiralNum exch def /AngStart SpiralNum 360 mul NumArms div AngOffset add def /FirstLap //true def InToOut {0 1 Angles length 1 sub} {Angles length 1 sub -1 0} ifelse { Angles exch get dup abs dRadius mul /Radius exch def Clockwise not {neg} if 90 sub dup floor cvi 360 idiv 360 mul sub 90 add AngStart add dup sin /SinAng exch def cos /CosAng exch def /Xe SinAng Radius mul CentreX add def /Ye CosAng Radius mul CentreY add def /dXe SinAng dRadius mul CosAng //DegreeInRadians mul Radius mul Clockwise {add} {sub} ifelse InToOut not {neg} if def /dYe CosAng dRadius mul SinAng //DegreeInRadians mul Radius mul Clockwise {sub} {add} ifelse InToOut not {neg} if def /ddXe SinAng //DegreeInRadians dup mul mul Radius mul neg CosAng //DegreeInRadians mul dRadius mul 2 mul Clockwise {add} {sub} ifelse def /ddYe CosAng //DegreeInRadians dup mul mul Radius mul neg SinAng //DegreeInRadians mul dRadius mul 2 mul Clockwise {sub} {add} ifelse def % GSave newpath Xe Ye 0.24 0 360 arc closepath 0.12 setlinewidth 1 0 0 setrgbcolor stroke GRestore FirstLap { /FirstLap //false def 1 { StartOperator dup /m eq exch /moveto eq or {Xe Ye moveto exit} if StartOperator dup /l eq exch /lineto eq or {Xe Ye lineto exit} if } repeat % 1 } {Xs Ys Xe Ye dXs dYs dXe dYe ddXs ddYs ddXe ddYe Radius 24 mul ApproximatingCurve Xe Ye curveto} ifelse % FirstLap /Xs Xe def /dXs dXe def /ddXs ddXe def /Ys Ye def /dYs dYe def /ddYs ddYe def } for % Angles } for % SpiralNum end //DeBugLevel 20 le {(-ArchimedeanSpiralPath) OutputToLog} if } bind def % ArchimedeanSpiralPath currentdict /SpiralAngles undef currentdict /SpiralAnglesLength undef % Two uses. % Bug in Adobe Distiller 8.1.3 (23/10/2006). In attempting to treat paths derived from text as copyable text, it fails to cope with paths made partly thereby and partly from a upath. % Also, eliminates some types of problems with embedding fonts. /DeFontPath { //DeBugLevel 10 le {(+DeFontPath) OutputToLog} if { [ {/moveto cvx} {/lineto cvx} {/curveto cvx} {/closepath cvx} pathforall ] newpath cvx exec } Stopped {(Warning: protected path in DeFontPath) OutputToLog} if //DeBugLevel 10 le {(-DeFontPath) OutputToLog} if } bind def % /DeFontPath % A valid first parameter is a glyph name, a string, or an array of valid parameters. % CharPathRecMoveto computes the path, moving the currentpoint as if after a show. /CharPathRecMoveto { //DeBugLevel 10 le {(+CharPathRecMoveto) OutputToLog} if 2 dict begin /bln exch def /param exch def 1 { /param load xcheck {[/param load ExecUExceptNotBindedPainting] bln CharPathRecMoveto exit} if param type dup /integertype eq exch /realtype eq or {/param param ToString store} if % no 'exit'. param type /stringtype eq {currentpoint exch param stringwidth pop add exch param bln charpath moveto exit} if param type /nametype eq {param bln GlyphPathMoveto exit} if param type /arraytype eq {param {bln CharPathRecMoveto} forall exit} if mark (Error: CharPathRecMoveto parameter ) /param load 0 //true ThingToDebugText ( is of type ) /param load type ( rather than executable, string, name, number or array.) ConcatenateToMark OutputToLog stop } repeat end //DeBugLevel 10 le {(-CharPathRecMoveto) OutputToLog} if } bind def % /CharPathRecMoveto % http://groups.google.com/g/comp.lang.postscript/c/hZmiLPonDl8 /CharPathRecursiveMoveto { //DeBugLevel 10 le {(+CharPathRecursiveMoveto) OutputToLog} if 1 index XcheckRecursive 3 1 roll CharPathRecMoveto {DeFontPath} if //DeBugLevel 10 le {(-CharPathRecursiveMoveto) OutputToLog} if } bind def % /CharPathRecursiveMoveto % A valid first parameter is a glyph name, a string, or an array of valid parameters. % CharPathRec computes the path, destroying the currentpoint. /CharPathRec { //DeBugLevel 9 le {(+CharPathRec) OutputToLog} if 9 dict begin /bln exch def /param exch def 1 { /param load xcheck {[/param load ExecUExceptNotBindedPainting] bln CharPathRec exit} if param type dup /integertype eq exch /realtype eq or {/param param ToString store} if % no 'exit'. param type /stringtype eq {param bln charpath exit} if param type /nametype eq {param bln GlyphPath exit} if param type /arraytype eq {param length 0 gt {0 1 param length 2 sub {param exch get bln CharPathRecMoveto} for param dup length 1 sub get bln CharPathRec} if exit} if mark (Error: CharPathRec parameter ) /param load 0 //true ThingToDebugText ( is of type ) /param load type ( rather than executable, string, name, number, or array.) ConcatenateToMark OutputToLog stop } repeat end //DeBugLevel 9 le {(-CharPathRec) OutputToLog} if } bind def % /CharPathRec % http://groups.google.com/g/comp.lang.postscript/c/hZmiLPonDl8 /CharPathRecursive { //DeBugLevel 10 le {(+CharPathRecursive) OutputToLog} if 1 index XcheckRecursive 3 1 roll CharPathRec {DeFontPath} if //DeBugLevel 10 le {(-CharPathRecursive) OutputToLog} if } bind def % /CharPathRecursive % nulldevice causes some bad rounding: http://groups.google.com/g/comp.lang.postscript/c/7RQ2cQy_k-Y /ExecUExceptNotBindedPainting % executes the one parameter, without painting { //DeBugLevel 5 le {(+ExecUExceptNotBindedPainting) OutputToLog} if << /fill {} /eofill 1 index /stroke 1 index /ufill /uappend load /ueofill 1 index /rectfill {newpath 4 2 roll moveto exch dup 0 rlineto exch 0 exch rlineto neg 0 rlineto currentpoint closepath moveto} bind % per PLRM3 p642 /rectstroke [2 index aload pop /strokepath load] cvx /shfill {pop GSave clippath //false upath GRestore uappend} bind >> begin execU end //DeBugLevel 5 le {(-ExecUExceptNotBindedPainting) OutputToLog} if } bind def % /ExecUExceptNotBindedPainting % (compound string) StringPathBBox llx lly urx ury /StringPathBBox { //DeBugLevel 10 le {(+StringPathBBox) OutputToLog} if GSave //DeSizeRounding dup scale newpath 0 0 moveto //true CharPathRecursive PathBBox GRestore //DeBugLevel 10 le {(-StringPathBBox) OutputToLog} if } bind def % /StringPathBBox % - BaseHeight num, being current font's usual height above baseline /BaseHeight { //DeBugLevel 10 le {(+BaseHeight) OutputToLog} if (AHTfhi1) StringPathBBox 4 1 roll pop pop pop //DeBugLevel 10 le {(-BaseHeight) OutputToLog} if } bind def % /BaseHeight % (compound string) StringHeight num, being top minus bottom for supplied compound string /StringHeight { //DeBugLevel 10 le {(+StringHeight) OutputToLog} if StringPathBBox exch pop sub neg exch pop //DeBugLevel 10 le {(-StringHeight) OutputToLog} if } bind def % /StringHeight % A valid parameter is a glyph name, a string, or an array of valid parameters. % Computes the total width. /StringWidthRec { //DeBugLevel 9 le {(+StringWidthRec) OutputToLog} if 1 { dup xcheck {currentpoint pop exch [exch ExecUExceptNotBindedPainting] StringWidthRec exch currentpoint pop exch sub add exit} if dup type dup /integertype eq exch /realtype eq or {ToString} if % no 'exit' dup type /stringtype eq {stringwidth pop exit} if dup type /nametype eq {matrix currentmatrix GSave newpath setmatrix 0 0 moveto //true GlyphPath currentpoint GRestore pop exit} if % http://groups.google.com/g/comp.lang.postscript/c/gQppSBL-x74 dup type /arraytype eq {0 exch {StringWidthRec add} forall exit} if mark exch dup (Error: StringWidthRec parameter ) counttomark -1 roll 0 //true ThingToDebugText ( is of type ) counttomark -1 roll type ToString ( rather than executable, string, name or array.) ConcatenateToMark OutputToLog stop } repeat //DeBugLevel 9 le {(-StringWidthRec) OutputToLog} if } bind def % /StringWidthRec /StringWidthRecursive { //DeBugLevel 10 le {(+StringWidthRecursive) OutputToLog} if GSave newpath 0 0 moveto % NullDevice //DeSizeRounding dup scale StringWidthRec GRestore //DeBugLevel 10 le {(-StringWidthRecursive) OutputToLog} if } bind def % moveto in case no currentpoint % TargetAccuracy LineWidthThatCoversPath WidthMax WidthMin % Calculates, for the current path, the greatest distance from an interior point to the edge. % WidthMin is known to be less than this distance. WidthMax will be greater. % http://groups.google.com/g/comp.lang.postscript/c/86b7Sg8v7B0 /LineWidthThatCoversPath { //DeBugLevel 25 le {(+LineWidthThatCoversPath) OutputToLog} if 20 dict begin //PrinterEpsilon 2 copy lt {exch} if pop /TargetAccuracy exch def % Target accuracy is split into two equal parts. The grid separation is half. And then the WidthMax-WidthMin separation is allowed the other half, and sometimes less than that. PathBBox /ury exch def /urx exch def /lly exch def /llx exch def urx llx sub //PrinterEpsilon gt ury lly sub //PrinterEpsilon gt and { % For an equilateral triangle the point furthest from the three corners is 2/3 of the height from the corners, which is Sqrt3/3 of the base. /NumRows ury lly sub TargetAccuracy 0.75 mul div def % Error to be <= TargetAccuracy/2, which is 2/3 of row height. So row height = 0.75*TargetAccuracy. /NumCols urx llx sub TargetAccuracy 1.5 mul //Sqrt3 div div def % Error to be <= TargetAccuracy/2, which is Sqrt3/3 of the width. So width = TargetAccuracy * 1.5 / Sqrt3. 30000 NumRows ceiling 1 add NumCols ceiling 1 add mul div dup 1 gt % 30k => max stack of about 60k {sqrt dup NumRows mul ceiling cvi 1 add /NumRows exch def NumCols mul ceiling cvi 1 add /NumCols exch def} {pop /NumRows NumRows ceiling cvi 1 add def /NumCols NumCols ceiling cvi 1 add def} ifelse % NumRows*NumCols small /HalfGapRows ury lly sub NumRows 2 mul div def /HalfGapCols urx llx sub NumCols 2 mul div def /MaxResolutionError HalfGapRows dup 4 mul HalfGapCols dup mul exch div add def //DeBugLevel 15 le {mark ( LineWidthThatCoversPath: NumRows = ) NumRows (; NumCols = ) NumCols (; HalfGapRows = ) HalfGapRows (; HalfGapCols = ) HalfGapCols (; MaxResolutionError = ) MaxResolutionError ConcatenateToMark OutputToLog} if count currentsystemparams /MaxOpStack 2 copy known {get} {pop pop 65535} ifelse exch sub /StackSpaceRemaining exch def /PointsMostDistanceFromEdge [ 1 1 NumCols 2 mul 1 sub { /ColNum exch def /X ColNum HalfGapCols mul llx add def 1 2 NumRows 2 mul { /RowNum exch def /Y RowNum HalfGapRows mul lly add def RowNum 4 mod 2 idiv ColNum 2 mod eq {X Y infill {X Y /StackSpaceRemaining StackSpaceRemaining 2 sub def} if StackSpaceRemaining 2 lt {exit} if} if } for % Y StackSpaceRemaining 2 lt {exit} if } for % X ] def % /PointsMostDistanceFromEdge StackSpaceRemaining 2 lt {(Warning: LineWidthThatCoversPath has incomplete calculation because there might be too little stack space. Increasing TargetAccuracy would help.) OutputToLog} if //DeBugLevel 15 le {mark ( LineWidthThatCoversPath: PointsMostDistanceFromEdge length = ) PointsMostDistanceFromEdge length ConcatenateToMark OutputToLog} if /WidthMin //null def /WidthMax //null def /Width ury lly sub 6 div //PrinterEpsilon 2 copy lt {exch} if pop def { GSave Width setlinewidth strokepath /NewArrayLength 0 def 0 2 PointsMostDistanceFromEdge length 2 sub { dup PointsMostDistanceFromEdge exch get exch 1 add PointsMostDistanceFromEdge exch get 2 copy infill not { PointsMostDistanceFromEdge NewArrayLength 1 add 3 -1 roll put PointsMostDistanceFromEdge NewArrayLength 3 -1 roll put /NewArrayLength NewArrayLength 2 add def } {pop pop} ifelse % infill not } for % PointsMostDistanceFromEdge NewArrayLength 0 gt {/WidthMin Width def /PointsMostDistanceFromEdge PointsMostDistanceFromEdge 0 NewArrayLength getinterval def} {/WidthMax Width def} ifelse GRestore //DeBugLevel 15 le {mark ( LineWidthThatCoversPath: WidthMin = ) WidthMin (; WidthMax = ) WidthMax (; PointsMostDistanceFromEdge length = ) PointsMostDistanceFromEdge length ConcatenateToMark OutputToLog} if WidthMax //null ne { WidthMin //null ne { % Complicated exit conditions. Generally by the time this becomes close, PointsMostDistanceFromEdge is short, so a few extra rounds are fast. WidthMax WidthMin sub MaxResolutionError lt WidthMin TargetAccuracy div cvi WidthMax MaxResolutionError add TargetAccuracy div cvi eq and {exit} if WidthMax WidthMin sub dup TargetAccuracy 64 div lt exch //PrinterEpsilon le or {exit} if } {WidthMax TargetAccuracy 2 div le WidthMax //PrinterEpsilon le or {/WidthMin 0 def exit} if} ifelse % WidthMin //null ne } if % WidthMax //null ne /Width WidthMax //null eq {WidthMin 2 mul} {WidthMin //null eq {WidthMax 2 div} {WidthMin WidthMax add 2 div} ifelse} ifelse def } loop WidthMax MaxResolutionError add WidthMin } {//PrinterEpsilon 0} ifelse end % Non-zero area //DeBugLevel 25 le {(-LineWidthThatCoversPath) OutputToLog} if } bind def % /LineWidthThatCoversPath % CentreX CentreY Radius LineWidthThatCoversCircle WidthMax WidthMin [ X0 Y0 X1 Y1 ... ] % The maximum of, for each point in the specified circle, the distance to the nearest edge of the current path. % WidthMin is known to be less than this distance. WidthMax might be greater. % Returned array is of points that are, approximately, maximally far from the edge. % In a typical case, the most distant point will be on the edge of the circle. So these points are denser. % But if the path is the likes of a large letter 'O', the relevant point could be internal, so there are plenty of these as well. % http://www.ThePortForum.com/viewtopic.php?t=6608&p=55028#p55028 (reason for doing this computation) % http://groups.google.com/g/comp.lang.postscript/c/86b7Sg8v7B0 (non-discussion about how to do it) /LineWidthThatCoversCircle { //DeBugLevel 25 le {(+LineWidthThatCoversCircle) OutputToLog} if 20 dict begin /Radius exch def /CentreY exch def /CentreX exch def % Accuracy is fixed. Points a quarter of a degree round edge, and separated by circumference/360 in interior. Hence know that there is enough stack space. PathBBox /ury exch def /urx exch def /lly exch def /llx exch def urx llx sub //PrinterEpsilon gt ury lly sub //PrinterEpsilon gt and { /Gap Radius //Pi mul 180 div def /NumOnCircleEdge Radius //TwoPi mul 0.24 div 4 div ceiling cvi 4 mul 5760 2 copy gt {exch} if pop def /RadiusSquared Radius dup mul def /PointsMostDistanceFromEdge [ 0 1 NumOnCircleEdge 1 sub {360 mul NumOnCircleEdge div dup cos Radius mul CentreX add exch sin Radius mul CentreY add 2 copy infill {pop pop} if} for Radius Gap div floor cvi -1 1 index neg { /ColNum exch def /X ColNum Gap mul def Radius Gap div floor cvi -1 1 index neg { /RowNum exch def /Y RowNum Gap mul def X dup mul Y dup mul add RadiusSquared lt { X CentreX add Y CentreY add 2 copy infill {pop pop} if } if % inside circle } for % RowNum, Y } for % ColNum, X ] def % /PointsMostDistanceFromEdge % Whilst constructing PointsMostDistanceFromEdge max points on stack is 2*(10325+5760) = 32170. /ExitThreshhold Radius //Pi mul NumOnCircleEdge div def /WidthMin //null def /WidthMax //null def /Width Radius 6 div //PrinterEpsilon 2 copy lt {exch} if pop def { GSave Width setlinewidth strokepath /NewArrayLength 0 def 0 2 PointsMostDistanceFromEdge length 2 sub { dup PointsMostDistanceFromEdge exch get exch 1 add PointsMostDistanceFromEdge exch get 2 copy infill not { PointsMostDistanceFromEdge NewArrayLength 1 add 3 -1 roll put PointsMostDistanceFromEdge NewArrayLength 3 -1 roll put /NewArrayLength NewArrayLength 2 add def } {pop pop} ifelse % infill not } for % PointsMostDistanceFromEdge NewArrayLength 0 gt {/WidthMin Width def /PointsMostDistanceFromEdge PointsMostDistanceFromEdge 0 NewArrayLength getinterval def} {/WidthMax Width def} ifelse GRestore //DeBugLevel 15 le {mark ( LineWidthThatCoversCircle: WidthMin = ) WidthMin (; WidthMax = ) WidthMax (; PointsMostDistanceFromEdge length = ) PointsMostDistanceFromEdge length ConcatenateToMark OutputToLog} if WidthMax //null ne { WidthMin //null ne { WidthMax WidthMin sub dup ExitThreshhold le exch //PrinterEpsilon le or {exit} if } {WidthMax ExitThreshhold le WidthMax //PrinterEpsilon le or {/WidthMin 0 def exit} if} ifelse % WidthMin //null ne } if % WidthMax //null ne /Width WidthMax //null eq {WidthMin 2 mul} {WidthMin //null eq {WidthMax 2 div} {WidthMin WidthMax add 2 div} ifelse} ifelse def } loop WidthMax ExitThreshhold add WidthMin PointsMostDistanceFromEdge } {//PrinterEpsilon 0 []} ifelse end % Non-zero area //DeBugLevel 25 le {(-LineWidthThatCoversCircle) OutputToLog} if } bind def % /LineWidthThatCoversCircle % Immediate dependencies: DeBugLevel; OutputToLog; ConcatenateToMark; ToString; GlyphShow. % A valid parameter is a glyph name, a string, some code, or an array of valid parameters. % ShowRecursive shows the sequences of entities in the natural manner. /ShowRecursive { //DeBugLevel 20 le {(+ShowRecursive) OutputToLog} if 1 dict begin /param exch def 1 { /param load xcheck {[/param load execU] ShowRecursive exit} if % in case the executable puts something on the stack param type dup /integertype eq exch /realtype eq or {/param param ToString store} if % no 'exit'. param type /stringtype eq {param show exit} if param type /nametype eq {param GlyphShow exit} if param type /arraytype eq {param {ShowRecursive} forall exit} if mark (Error: ShowRecursive parameter ) /param load 0 //true ThingToDebugText ( is of type ) /param load type ( rather than executable, string, name or array.) ConcatenateToMark OutputToLog stop } repeat end //DeBugLevel 20 le {(-ShowRecursive) OutputToLog} if } bind def % /ShowRecursive % Immediate dependencies: DeBugLevel; OutputToLog; ConcatenateToMark. /GlyphShowKnownAbsences << >> def /GlyphTestAbsence { //DeBugLevel 4 le {(+GlyphTestAbsence) OutputToLog} if currentfont /CharStrings get GlyphNameThis known not { mark currentfont /FontName get (__MissingGlyph__) GlyphNameThis 256 string cvs ConcatenateToMark //GlyphShowKnownAbsences exch 2 copy known {pop pop} { mark (Error: glyph /) GlyphNameThis ( not present in font /) currentfont /FontName get (. Continuing.) ConcatenateToMark OutputToLog 0 put } ifelse } if % ... GlyphNameThis known not //DeBugLevel 4 le {(-GlyphTestAbsence) OutputToLog} if } bind def % /GlyphTestAbsence currentdict /GlyphShowKnownAbsences undef /GlyphShow { //DeBugLevel 5 le {(+GlyphShow) OutputToLog} if 1 dict begin /GlyphNameThis exch def GlyphTestAbsence GlyphNameThis glyphshow end //DeBugLevel 5 le {(-GlyphShow) OutputToLog} if } bind def % /GlyphShow % Computes the path of a glyph, with the charpath-style boolean flag, destroying the currentpoint. % http://groups.google.com/g/comp.lang.postscript/c/rvAGfbsbLVw /GlyphPath { //DeBugLevel 10 le {(+GlyphPath) OutputToLog} if 2 dict begin /bln exch def /GlyphNameThis exch def GlyphTestAbsence currentfont currentfont length dict begin currentfont {1 index /FID ne {def} {pop pop} ifelse} forall /Encoding [ 256 {/.notdef} repeat ] def Encoding 97 GlyphNameThis put % ASCII a = 97 currentdict end /TemporaryFont exch definefont pop /TemporaryFont 1 selectfont (a) bln charpath setfont /TemporaryFont undefinefont end //DeBugLevel 10 le {(-GlyphPath) OutputToLog} if } bind def % /GlyphPath % Computes the path of a glyph, with the charpath-style boolean flag, moving the currentpoint as if after a show. /GlyphPathMoveto { //DeBugLevel 10 le {(+GlyphPathMoveto) OutputToLog} if 2 dict begin /bln exch def /GlyphNameThis exch def GlyphTestAbsence currentfont currentfont length dict begin currentfont {1 index /FID ne {def} {pop pop} ifelse} forall /Encoding [ 256 {/.notdef} repeat ] def Encoding 97 GlyphNameThis put % ASCII a = 97 currentdict end /TemporaryFont exch definefont pop /TemporaryFont 1 selectfont currentpoint exch (a) stringwidth pop add exch (a) bln charpath % (a) has been redefined moveto setfont /TemporaryFont undefinefont end //DeBugLevel 10 le {(-GlyphPathMoveto) OutputToLog} if } bind def % /GlyphPathMoveto % Is this, or does this contain, an executable? /XcheckRecursive { //DeBugLevel 5 le {(+XcheckRecursive) OutputToLog} if dup xcheck {pop //true} { dup type /arraytype eq {//false exch {XcheckRecursive {pop //true exit} if} forall} {pop //false} ifelse % arraytype } ifelse % xcheck //DeBugLevel 5 le {(-XcheckRecursive) OutputToLog} if } bind def % XcheckRecursive % Assumes path defined, which is used as the clipping region, and also the various CrossHatching... parameters % X Y {FormatStrokeCode} RadialCrossHatching - /RadialCrossHatching { //DeBugLevel 40 le {(+RadialCrossHatching) OutputToLog} if GSave 12 dict begin /FormatStrokeCode exch def /Y exch def /X exch def % /up false upath def PathBBox /ury exch def /urx exch def /lly exch def /llx exch def clip urx llx gt ury lly gt and { newpath X llx sub dup mul X urx sub dup mul 2 copy lt {exch} if pop Y lly sub dup mul Y ury sub dup mul 2 copy lt {exch} if pop add sqrt 0.24 add /Rmax exch def X llx lt {X llx sub dup mul} {X urx gt {X urx sub dup mul} {0} ifelse} ifelse Y lly lt {Y lly sub dup mul} {Y ury gt {Y ury sub dup mul} {0} ifelse} ifelse add sqrt 0.24 sub dup 0 lt {pop 0} if /Rmin exch def % Angles measured from vertical, clockwise, to ensure that the 0 line is vertical. 1 { Y lly lt { /Amin llx X sub X llx lt {ury} {lly} ifelse Y sub atan def /Amax urx X sub X urx gt {ury} {lly} ifelse Y sub atan def exit } if % Y lly lt Y ury gt { /Amin urx X sub X urx lt {ury} {lly} ifelse Y sub atan def /Amax llx X sub X llx gt {ury} {lly} ifelse Y sub atan def exit } if % Y ury gt X llx lt { /Amin llx X sub ury Y sub atan def /Amax llx X sub lly Y sub atan def exit } if % X llx lt X urx gt { /Amin urx X sub lly Y sub atan def /Amax urx X sub ury Y sub atan def exit } if % X llx lt % If X Y inside, choose 'join' so that as few joins as possible are inside /Amax [ ury Y sub Y lly sub urx X sub X llx sub ] def % reusing variable name /Amin 0 def 1 1 3 {dup Amax exch get Amax Amin get lt {/Amin exch def} {pop} ifelse} for % reusing variable name /Amin [ 0 -180 90 -90 ] Amin get def /Amax Amin 360 add def } repeat % 1 Amin Amax gt {/Amin Amin 360 sub def} if 90 180 CrossHatchingNumRadialLines div sub CrossHatchingNumRadialLines mul 360 div dup floor sub 360 mul CrossHatchingNumRadialLines div dup Amin exch sub CrossHatchingNumRadialLines mul 360 div ceiling 360 mul CrossHatchingNumRadialLines div add 360 CrossHatchingNumRadialLines div Amax { dup cos exch sin 2 copy Rmin mul X add exch Rmin mul Y add moveto Rmax mul X add exch Rmax mul Y add lineto % /up load instroke {FormatStrokeCode} {newpath} ifelse } for % angles [Rmax Rmin] {dup mul //Pi mul CrossHatchingCellArea CrossHatchingNumRadialLines mul div} forall ceiling cvi exch 1 exch cvi { % CrossHatchingCellArea = (Rthis^2-Rprev^2)*Pi/CrossHatchingNumRadialLines <== R = Sqrt[ N * CrossHatchingCellArea*CrossHatchingNumRadialLines/Pi ] CrossHatchingNumRadialLines mul CrossHatchingCellArea mul //Pi div sqrt /R exch def X Amax sin R mul add Y Amax cos R mul add moveto X Y R 90 Amax sub 90 Amin sub /m ArcAccurate } for % 'R' 0 setgray 0.12 setlinewidth [] 0 setdash 1 setlinejoin 1 setlinecap FormatStrokeCode newpath } if % non-empty bounding box of clip path end GRestore //DeBugLevel 40 le {(-RadialCrossHatching) OutputToLog} if } bind def % /RadialCrossHatching /ShapesClippedToPath_WarningFlag true def % OuterRegionLlx OuterRegionLly OuterRegionUrx OuterRegionUry SpecialPlace {FillCode} {StrokeCode} DoActuallyClip ShapesClippedToPath - % Everything clipped to current path, which is left unchanged /ShapesClippedToPath { //DeBugLevel 42 le {(+ShapesClippedToPath) OutputToLog} if 20 dict begin GSave GSave flattenpath pathbbox /ury exch def /urx exch def /lly exch def /llx exch def GRestore % pathbbox rather than PathBBox because approximate suffices, and is faster {clip} if % DoActuallyClip /UClipPath //true upath def newpath % Even if not clipping, show only those shapes that intersect this path /StrokeCode exch def /FillCode exch def /SpecialPlace exch def % /Origin /Centre /None /OuterRegionUry exch def /OuterRegionUrx exch def /OuterRegionLly exch def /OuterRegionLlx exch def [ SpecialPlace /Origin eq % If contains (0,0), then 0,0 assumed special; otherwise centre is special { OuterRegionLly ShapesAverageSeparation div floor cvi 1 OuterRegionUry ShapesAverageSeparation div ceiling cvi {/ShapesIntY exch def OuterRegionLlx ShapesAverageSeparation div floor cvi 1 OuterRegionUrx ShapesAverageSeparation div ceiling cvi {/ShapesIntX exch def ShapesIntX 0 ne ShapesIntY 0 ne or { [ ShapesIntX ShapesIntY ShapesIntX ShapesAverageSeparation mul ShapesAverageMaxTweakPlusMinus dup 0 ne {rand //HalfRandMax div 1 sub mul add} {pop} ifelse ShapesIntY ShapesAverageSeparation mul ShapesAverageMaxTweakPlusMinus dup 0 ne {rand //HalfRandMax div 1 sub mul add} {pop} ifelse rand //RandMax div ShapesEnclosingCircleRadiusMax ShapesEnclosingCircleRadiusMin sub mul ShapesEnclosingCircleRadiusMin add ShapesToUse dup length dup 1 le {1 sub} {rand exch mod} ifelse get ] counttomark rand exch mod 1 add 1 roll % The shuffling removes the apparent direction caused by overlapping } if % Not 0,0 } for % /ShapesIntX } for % /ShapesIntY [ 0 0 0 0 ShapesEnclosingCircleRadiusMax ShapesToUse 0 get ] % Last, so on top. }{ % SpecialPlace is /Centre or /None OuterRegionUry OuterRegionLly sub ShapesAverageSeparation div -2 div floor cvi 1 1 index neg {/ShapesIntY exch def OuterRegionUrx OuterRegionLlx sub ShapesAverageSeparation div -2 div floor cvi 1 1 index neg {/ShapesIntX exch def SpecialPlace /None eq ShapesIntX 0 ne or ShapesIntY 0 ne or { [ ShapesIntX ShapesIntY OuterRegionUrx OuterRegionLlx add 2 div ShapesIntX ShapesAverageSeparation mul add ShapesAverageMaxTweakPlusMinus dup 0 ne {rand //HalfRandMax div 1 sub mul add} {pop} ifelse OuterRegionUry OuterRegionLly add 2 div ShapesIntY ShapesAverageSeparation mul add ShapesAverageMaxTweakPlusMinus dup 0 ne {rand //HalfRandMax div 1 sub mul add} {pop} ifelse rand //RandMax div ShapesEnclosingCircleRadiusMax ShapesEnclosingCircleRadiusMin sub mul ShapesEnclosingCircleRadiusMin add ShapesToUse dup length dup 1 le {1 sub} {rand exch mod} ifelse get ] counttomark rand exch mod 1 add 1 roll % The shuffling removes the apparent direction caused by overlapping } if % Not 0,0 } for % /ShapesIntX } for % /ShapesIntY SpecialPlace /None ne {[ 0 0 OuterRegionLlx OuterRegionUrx add 2 div OuterRegionLly OuterRegionUry add 2 div ShapesEnclosingCircleRadiusMax ShapesToUse 0 get ]} if % Last, so on top. It might be out of range, but if so, will be caught by later tests. } ifelse % Contains (0,0) ] % Double-depth array [ ... [ShapesIntX ShapesIntY X Y ThisShapeRadius ThisShape] ... ] { aload pop /ThisShape exch def /ThisShapeRadius exch def /Y exch def /X exch def /ShapesIntY exch def /ShapesIntX exch def /Rand1 rand def /Rand2 rand def % Sometimes, by rounding, a transformed TABO can select differently, which should't desynchronise rand usage; hence rands always done. 0 setgray 0.48 setlinewidth 0 setlinejoin 1 setlinecap [] 0 setdash X 0.8 ThisShapeRadius mul add llx gt X 0.8 ThisShapeRadius mul sub urx lt and % Can't compare to RadiiCirclearrayInsideUsableTAB because might be a PlaceName page. Y 0.8 ThisShapeRadius mul add lly gt and Y 0.8 ThisShapeRadius mul sub ury lt and % The 0.8s reject some of the inelegant cases where only a thin sliver of the shape is painted. X ThisShapeRadius add OuterRegionLlx gt and X ThisShapeRadius sub OuterRegionUrx lt and % These tests might be redundant. Y ThisShapeRadius add OuterRegionLly gt and Y ThisShapeRadius sub OuterRegionUry lt and % These tests might be redundant. { //false /Circle ThisShape eq {X Y ThisShapeRadius 0 360 arc closepath pop //true} if % Nothing ever placed on boundary, so no need for ArcAccurate. /Star ThisShape eq { SpecialPlace /None eq ShapesIntX 0 ne or ShapesIntY 0 ne or {Rand1 //RandMax div 360 mul} {0} ifelse ShapesStarsPointsAndStepsArray dup length Rand1 exch mod get aload pop X Y moveto /Center /Middle ThisShapeRadius /Radius 7 -3 roll //false //false Star pop pop //true } if % /Star /Flower ThisShape eq { ShapesFlowersNumPetalsMin Rand1 ShapesFlowersNumPetalsMax 2 index sub 1 add mod add dup 360 exch div ShapesFlowersAngularWidthMin Rand2 //RandMax div ShapesFlowersAngularWidthMax 2 index sub mul add mul //ArcCosMinusOneThird 2 copy gt {exch} if pop ThisShapeRadius SpecialPlace /None eq ShapesIntX 0 ne or ShapesIntY 0 ne or {Rand1 //RandMax div 360 mul} {0} ifelse Rand2 2 mod 0 eq X Y moveto //true Flower % Always strokeable, because filling works on strokeable but stroke not with just fillable pop //true } if % Flower /Heart ThisShape eq { matrix currentmatrix X Y translate SpecialPlace /None eq ShapesIntX 0 ne or ShapesIntY 0 ne or { Rand1 //RandMax div dup 0.5 le {2 mul sqrt 1} {1 exch sub 2 mul sqrt 1 exch} ifelse sub % Isosceles triangle dist'n: {(-1,0),(0,1),(+1,0)}. //ArcTanFiveEighths mul rotate } if % Rotatable ThisShapeRadius 6 sqrt mul dup scale 0 -0.3846762000998701793217521379 translate 0 0 moveto 0.8 0.5 0.25 1 0 0.65526715987207729968624 CurvetoFourPieces -0.25 1 -0.8 0.5 0 0 CurvetoFourPieces closepath % The 0.655... minimises the path length setmatrix pop //true } if % /Heart { ShapesPrintQuickerDistillSlower {/UClipPath load infill} {//true} ifelse % Insideness assumes path width of zero { /FillCode load {} ne /StrokeCode load {} ne { {GSave FillCode GRestore} if StrokeCode} { {FillCode} {newpath} ifelse} ifelse } {newpath} ifelse }{ ShapesClippedToPath_WarningFlag { mark (Warning: ShapesToUse contains invalid shape ) ThisShape ConcatenateToMark OutputToLog /ShapesClippedToPath_WarningFlag //false store } if % ShapesClippedToPath_WarningFlag } ifelse % ThisShape is valid } if % Some of shape in T|A|B|O's bounding box } forall % 'ShapesInts' GRestore end //DeBugLevel 40 le {(-ShapesClippedToPath) OutputToLog} if } bind def % /ShapesClippedToPath % X Y Filltext FillTextNumSpaces FilltextLineStep Angle NumOutlines InnerMostColor OtherColor RepeatClippedWithin - % On calling RepeatClippedWithin there is a current font, and a current path to be used as a clipping path. % Renders multiple copies of Filltext, outlined in alternate colors, within the clipping region. % Used X Y to determine offset of repeats, so that multiple calls can be aligned. % Some coding help was requested and provided at % http://groups.google.com/g/comp.lang.postscript/c/XegnvWwDAC4 % % As repeated stroke'ing of text makes PDF files heavy and slow to render, % there is an attempt not to paint anything entirely outside the clipping region. % If the clipping region contains a protected font, the test is weaker and the PDF heavier. % This extensive use of infill slows distillation. % % On exit the clipping path is still the current path /RepeatClippedWithin { //DeBugLevel 40 le {(+RepeatClippedWithin) OutputToLog} if 39 dict begin /OtherColor exch def /InnerMostColor exch def /NumOutlines exch def /Angle exch def /FilltextLineStep exch def /FillTextNumSpaces exch def /Filltext exch def /Y exch def /X exch def /Filltext load StringPathBBox /FilltextT exch def /FilltextR exch def /FilltextB exch def /FilltextL exch def FilltextR FilltextL sub //PrinterEpsilon gt { GSave clip matrix currentmatrix /Filltext load GSave //DeSizeRounding dup scale newpath 0 0 moveto //true Angle rotate CharPathRecursive setmatrix PathBBox GRestore [/FilltextTa /FilltextRa /FilltextBa /FilltextLa] {exch //DeSizeRounding div def} forall PathBBox /ury exch def /urx exch def /lly exch def /llx exch def Angle rotate currentpoint /Ya exch def /Xa exch def PathBBox /urya exch def /urxa exch def /llya exch def /llxa exch def /AngleCos Angle cos def /AngleSin Angle sin def /Xa X AngleCos mul Y AngleSin mul sub def /Ya Y AngleCos mul X AngleSin mul add def /WidthPower //GoldenRatio def /FilltextSpacing ( ) stringwidth pop FillTextNumSpaces mul def /Xstep FilltextR FilltextL sub FilltextSpacing add def /TestStandard FillTextPedantry def TestStandard /Quick ne { {//true upath} Stopped {/TestStandard /Quick def} {/CurrentClipUPathA exch def} ifelse} if newpath 1 setlinecap 1 setlinejoin [] 0 setdash % Could do a separate test for each HalfLineWidth. Slows execution by a factor of, almost always, at least three, to prune very few CharPathRecursive's. /GoodStarts [ NumOutlines 0 gt {WidthPower NumOutlines exp 1 sub WidthPower 1 sub div WidthPower sqrt sqrt mul} {pop 0} ifelse FilltextLineStep 12 div dup 1 lt {pop 1} if mul dup setlinewidth 2 div /HalfLineWidth exch def /Xstart Xa {dup dup llxa lt exch urxa lt and {exit} {Xstep sub} ifelse} loop def llya Ya FilltextT add HalfLineWidth add sub FilltextLineStep div ceiling cvi % int * FilltextLineStep + Ya FilltextT add HalfLineWidth add > llya 1 urya Ya FilltextB add HalfLineWidth sub sub FilltextLineStep div floor cvi % int * FilltextLineStep + Ya FilltextB add HalfLineWidth sub < urya { FilltextLineStep mul Ya add /Yfa exch def /Xfa Xstart def { % loop Xfa urxa le Xfa FilltextR FilltextL sub add llxa ge and { Yfa AngleCos mul Xfa AngleSin mul add dup % Yf FilltextTa add HalfLineWidth add lly gt exch FilltextBa add HalfLineWidth sub ury lt and { Xfa AngleCos mul Yfa AngleSin mul sub dup % Xf FilltextRa add HalfLineWidth add llx gt exch FilltextLa add HalfLineWidth sub urx lt and { TestStandard /Quick ne { newpath Xfa Yfa moveto /Filltext load HalfLineWidth 0 le CharPathRecursive /CurrentClipUPathA load HalfLineWidth 0 gt TestStandard /Fussy eq and {instroke} {infill} ifelse } {//true} ifelse % TestStandard {Xfa Yfa} if % TestStandard {...} {//true} ifelse } if % in original x range } if % in original y range } if % Xfa in angle-rotated range /Xfa Xfa Xstep add def Xfa urxa ge {exit} if } loop % Xfa } for % Yfa ] def % /GoodStarts NumOutlines -1 0 { dup 2 mod 0 eq {InnerMostColor} {OtherColor} ifelse dup 0 gt {WidthPower exch exp 1 sub WidthPower 1 sub div WidthPower sqrt sqrt mul} {pop 0} ifelse FilltextLineStep 12 div dup 1 lt {pop 1} if mul dup setlinewidth 2 div /HalfLineWidth exch def 0 2 GoodStarts length 1 sub { dup GoodStarts exch get exch 1 add GoodStarts exch get moveto /Filltext load HalfLineWidth 0 le {//true CharPathRecursive fill} {//false CharPathRecursive stroke} ifelse } for % ... GoodStarts length ... } for % NumOutlines -1 0 GRestore } if % FilltextR FilltextL sub PrinterEpsilon gt end //DeBugLevel 40 le {(-RepeatClippedWithin) OutputToLog} if } bind def % /RepeatClippedWithin % int1 int2 GreatestCommonDivisor int % best if int1 > int2 /GreatestCommonDivisor { //DeBugLevel 3 le {(+GreatestCommonDivisor) OutputToLog} if 3 dict begin /j exch abs def /i exch abs def i type /integertype ne j type /integertype ne or {(GreatestCommonDivisor: non-integer parameter) OutputToLog} if j 0 eq {i} { 0 % answer if fails 93 % Copes with up to 2^64; finite repetition might prevent certain failures { /k i j mod def k 0 eq {pop j exit} if /i j def /j k def } repeat } ifelse % j 0 eq end //DeBugLevel 3 le {(-GreatestCommonDivisor) OutputToLog} if } bind def % /GreatestCommonDivisor % /Left|/Center|/Right /Top|/Middle|/Bottom Size /Radius|/Diameter|/Height|/Width AngleOffset NumPoints NumStep DrawLinesInside AntiClockwise % ... Star dict, the dictionary containing /LeftX, /CenterX, /RightX, /BottomY, /CenterY, /TopY, /Radius, /InnerRadius, /AntiClockwise % Immediate dependencies: DeBugLevel /Star { //DeBugLevel 30 le {(+Star) OutputToLog} if 20 dict begin /AntiClockwise exch def /DrawLinesInside exch def /m exch abs def /n exch abs def /a exch def /ssMeaning exch def /ss exch def /yyMeaning exch def /xxMeaning exch def currentpoint /yy exch def /xx exch def /FromCenterMinX -0.00000001 def % avoids divide-by-zero errors /FromCenterMinY -0.00000001 def /FromCenterMaxX 0.00000001 def /FromCenterMaxY 0.00000001 def 0 1 n 1 sub { 360 mul n div a add dup sin dup FromCenterMaxX gt {/FromCenterMaxX exch def} {dup FromCenterMinX lt {/FromCenterMinX exch def} {pop} ifelse} ifelse cos dup FromCenterMaxY gt {/FromCenterMaxY exch def} {dup FromCenterMinY lt {/FromCenterMinY exch def} {pop} ifelse} ifelse } for ssMeaning /Radius eq {/r ss def} if ssMeaning /Diameter eq {/r ss 2 div def} if ssMeaning /Height eq {/r ss FromCenterMaxY FromCenterMinY sub div def} if ssMeaning /Width eq {/r ss FromCenterMaxX FromCenterMinX sub div def} if /x xx def /y yy def xxMeaning /Left eq {/x xx FromCenterMinX r mul sub def} if xxMeaning /Right eq {/x xx FromCenterMaxX r mul sub def} if yyMeaning /Bottom eq {/y yy FromCenterMinY r mul sub def} if yyMeaning /Top eq {/y yy FromCenterMaxY r mul sub def} if % See http://www.jdawiseman.com/papers/easymath/surds_star_inner_radius.html /InnerRadius m 180 mul n div cos m 1 sub 180 mul n div cos div r mul def DrawLinesInside { 0 1 n m GreatestCommonDivisor 1 sub { /j exch def /i j def { i AntiClockwise {neg} if 360 mul n div a add sin r mul x add i AntiClockwise {neg} if 360 mul n div a add cos r mul y add i j eq {moveto} {lineto} ifelse /i i m add n mod def i j eq {exit} if } loop % i closepath } for % j }{ 0 1 n 2 mul 1 sub % i's meaning different by factor of 2 { /i exch def i 2 mod 0 eq {r} {InnerRadius} ifelse i AntiClockwise {neg} if 180 mul n div a add 2 copy sin mul x add 3 1 roll cos mul y add i 0 eq {moveto} {lineto} ifelse } for % i closepath } ifelse % DrawLinesInside % Left on stack is a dictionary << /LeftX xxMeaning /Left eq {xx} {x FromCenterMinX r mul add} ifelse /CenterX x /RightX xxMeaning /Right eq {xx} {x FromCenterMaxX r mul add} ifelse /BottomY xxMeaning /Bottom eq {yy} {y FromCenterMinY r mul add} ifelse /CenterY y /TopY xxMeaning /Top eq {yy} {y FromCenterMaxY r mul add} ifelse /Radius ssMeaning /Radius eq {ss} {r} ifelse /InnerRadius InnerRadius /AntiClockwise AntiClockwise >> end //DeBugLevel 30 le {(-Star) OutputToLog} if } bind def % /Star % Height CheckMark - /CheckMark { 3 dict begin //Sqrt3 9 mul 2 add div /R exch def currentpoint /Y exch def /X exch def 4 R mul X add 3 R mul Y add moveto R X add //Sqrt3 3 mul 1 add R mul Y add R 030 210 arc R 4 mul X add R Y add R 210 330 arc R 13 mul X add //Sqrt3 9 mul 1 add R mul Y add R -30 150 arc closepath fill R 14 mul X add Y moveto end } bind def % /CheckMark /ThePortForumIconForm % Fits in box with lower-left at (0,0) and unit sides. Calling code to translate and scale and revert. << /FormType 1 /BBox [ -0.0625 dup 1.0625 dup ] /Matrix matrix identmatrix /PaintProc { pop matrix currentmatrix 0.0625 dup scale % White background, one 'pixel' away, including interior spaces % 2 8 moveto 0 7 1 90 180 arc 0 6 1 180 270 arc 1 2 1 180 270 arc 2 1 lineto 3 0 1 180 270 arc 14 0 1 -90 0 arc 15 2 1 -90 0 arc % 16 4 1 -90 0 arc 16 7 1 0 90 arc 15 8 lineto 14 15 1 0 90 arc 13 16 1 0 90 arc 4 16 1 90 180 arc 3 15 1 90 180 arc 1 setgray closepath fill 2 8 moveto -1 8 lineto -1 5 lineto 0 5 lineto 0 1 lineto 2 1 lineto 2 -1 lineto 15 -1 lineto 15 1 lineto 16 1 lineto 16 3 lineto 17 3 lineto 17 8 lineto 15 8 lineto 15 16 lineto 14 16 lineto 14 17 lineto 3 17 lineto 3 16 lineto 2 16 lineto closepath % 3 2 moveto 3 5 lineto 4 5 lineto 4 4 lineto 5 4 lineto 5 3 lineto 7 3 lineto 7 2 lineto closepath % Near T % 10 2 moveto 10 3 lineto 12 3 lineto 12 4 lineto 13 4 lineto 13 2 lineto closepath % Near F % 5 11 moveto 5 14 lineto 6 14 lineto 6 11 lineto closepath % Left of P % 9 11 moveto 9 12 lineto 11 12 lineto 11 14 lineto 12 14 lineto 12 11 lineto closepath % Right of P 1 setgray fill ThePortForumIconColour {0.6 0 0 setrgbcolor} {0 setgray} ifelse % T 0 6 moveto 0 7 lineto 3 7 lineto 3 6 lineto 2 6 lineto 2 2 lineto 1 2 lineto 1 6 lineto closepath fill % P 8 14 moveto 9 14 lineto 9 15 lineto 8 15 lineto closepath 7 11 moveto 7 16 lineto 10 16 lineto 10 13 lineto 8 13 lineto 8 11 lineto closepath fill % F 14 2 moveto 14 7 lineto 16 7 lineto 16 6 lineto 15 6 lineto 15 5 lineto 16 5 lineto 16 4 lineto 15 4 lineto 15 2 lineto closepath fill % Liquid, lying partly under glass in case of sloppy rendering engine ThePortForumIconColour not {0.4 setgray} if 3.8 10 moveto 4 8 lineto 4.8 7.8 lineto 5 6 lineto 5.8 5.8 lineto 6 5 lineto 8.5 4.8 lineto 11 5 lineto 11.2 5.8 lineto 12 6 lineto 12.2 7.8 lineto 13 8 lineto 13.2 10 lineto closepath fill % Glass 3 0 moveto 3 1 lineto 8 1 lineto 8 4 lineto 6 4 lineto 6 5 lineto 5 5 lineto 5 6 lineto 4 6 lineto 4 8 lineto 3 8 lineto 3 15 lineto 4 15 lineto 4 16 lineto 5 16 lineto 5 15 lineto 4 15 lineto 4 8 lineto 5 8 lineto 5 6 lineto 6 6 lineto 6 5 lineto 11 5 lineto 11 6 lineto 12 6 lineto 12 8 lineto 13 8 lineto 13 15 lineto 12 15 lineto 12 16 lineto 13 16 lineto 13 15 lineto 14 15 lineto 14 8 lineto 13 8 lineto 13 6 lineto 12 6 lineto 12 5 lineto 11 5 lineto 11 4 lineto 9 4 lineto 9 1 lineto 14 1 lineto 14 0 lineto closepath 0 setgray fill setmatrix } bind % /PaintProc >> def % /ThePortForumIconForm /IconSizeTN WaterBoxesSizeMax def % ThePortForumIconPlacement PlaceThePortForumIcon - /PlaceThePortForumIcon { //DeBugLevel 6 le {(+PlaceThePortForumIcon) OutputToLog} if 4 dict begin /param exch def /IconForm //ThePortForumIconForm def % Allows easy replacement with something else. /param load xcheck { [param] PlaceThePortForumIcon }{ param type /arraytype eq { param {PlaceThePortForumIcon} forall }{ /IconSize 10 TypeOfPagesBeingRendered /Glasses eq TypeOfPagesBeingRendered /PrePour eq or {pop 1 //SqrtHalf sub Radii SheetNum get mul} if TypeOfPagesBeingRendered /TastingNotes eq {pop NamesFont NamesFontSize selectfont BaseHeight} if def % /IconSize TypeOfPagesBeingRendered /Glasses eq { param /UpperNonWaterBox eq {/param NamesIsLeftHander NameNum get {/UpperRight} {/UpperLeft} ifelse def} if param /UpperWaterBox eq {/param NamesIsLeftHander NameNum get {/UpperLeft} {/UpperRight} ifelse def} if param /LowerNonWaterBox eq {/param NamesIsLeftHander NameNum get {/LowerRight} {/LowerLeft} ifelse def} if param /LowerWaterBox eq {/param NamesIsLeftHander NameNum get {/LowerLeft} {/LowerRight} ifelse def} if } if % ... /Glasses ... TypeOfPagesBeingRendered /TastingNotes eq { /IconSizeTN IconSize store param /UpperNonName eq {/param NamesIsLeftHanderTN NameNum get {/UpperRight} {/UpperLeft} ifelse def} if param /UpperName eq {/param NamesIsLeftHanderTN NameNum get {/UpperLeft} {/UpperRight} ifelse def} if param /LowerNonName eq {/param NamesIsLeftHanderTN NameNum get {/LowerRight} {/LowerLeft} ifelse def} if param /LowerName eq {/param NamesIsLeftHanderTN NameNum get {/LowerLeft} {/LowerRight} ifelse def} if } if % TypeOfPagesBeingRendered /TastingNotes eq //true TypeOfPagesBeingRendered /Glasses eq {PackingDescriptors SheetNum get dup type /arraytype eq { {/SuppressOrnamentsLeft eq {pop //false exit} if} forall} {pop} ifelse} if { param /LowerLeft eq {matrix currentmatrix MgnL MgnB translate IconSize dup scale IconForm execform setmatrix} if param /UpperLeft eq {matrix currentmatrix MgnL PageHeight MgnT sub IconSize sub translate IconSize dup scale IconForm execform setmatrix} if } if % not /SuppressOrnamentsLeft //true TypeOfPagesBeingRendered /Glasses eq {PackingDescriptors SheetNum get dup type /arraytype eq { {/SuppressOrnamentsRight eq {pop //false exit} if} forall} {pop} ifelse} if { param /LowerRight eq {matrix currentmatrix PageWidth MgnR sub IconSize sub MgnB translate IconSize dup scale IconForm execform setmatrix} if param /UpperRight eq {matrix currentmatrix PageWidth MgnR sub IconSize sub PageHeight MgnT sub IconSize sub translate IconSize dup scale IconForm execform setmatrix} if } if % not SuppressOrnamentsRight TypeOfPagesBeingRendered /PrePour eq param /None ne and { % Parameter not an empty array /temp CirclearraysT SheetNum get WithinPage get CirclearraysB SheetNum get WithinPage get sub CirclearraysFontSizes SheetNum get WithinPage get mul IconSize 16 div add def matrix currentmatrix MgnL temp add MgnB temp add translate IconSize dup scale IconForm execform setmatrix matrix currentmatrix PageWidth MgnR sub temp sub IconSize sub MgnB temp add translate IconSize dup scale IconForm execform setmatrix matrix currentmatrix MgnL temp add PageHeight MgnT sub temp sub IconSize sub translate IconSize dup scale IconForm execform setmatrix matrix currentmatrix PageWidth MgnR sub temp sub IconSize sub PageHeight MgnT sub temp sub IconSize sub translate IconSize dup scale IconForm execform setmatrix } if % ... /PrePour ... } ifelse % /arraytype } ifelse % /param load xcheck end //DeBugLevel 6 le {(-PlaceThePortForumIcon) OutputToLog} if } bind def % /PlaceThePortForumIcon % Splits a curveo into four pieces, so that the control points more closely hug the rendered curve. % This can help renderers with clipping. % [currentpoint defined] X1 Y1 X2 Y2 X3 Y3 CurvetoFourPieces - [path extended by four curve pieces] /CurvetoFourPieces { 8 dict begin /Y3 exch def /X3 exch def /Y2 exch def /X2 exch def /Y1 exch def /X1 exch def currentpoint /Y0 exch def /X0 exch def X0 3 mul X1 add 4 div Y0 3 mul Y1 add 4 div X0 9 mul X1 6 mul add X2 add 16 div Y0 9 mul Y1 6 mul add Y2 add 16 div X0 X1 add 27 mul X2 9 mul add X3 add 64 div Y0 Y1 add 27 mul Y2 9 mul add Y3 add 64 div curveto X0 9 mul X1 15 mul add X2 7 mul add X3 add 32 div Y0 9 mul Y1 15 mul add Y2 7 mul add Y3 add 32 div X0 3 mul X1 7 mul add X2 5 mul add X3 add 16 div Y0 3 mul Y1 7 mul add Y2 5 mul add Y3 add 16 div X1 X2 add 3 mul X0 add X3 add 8 div Y1 Y2 add 3 mul Y0 add Y3 add 8 div curveto X0 X1 5 mul add X2 7 mul add X3 3 mul add 16 div Y0 Y1 5 mul add Y2 7 mul add Y3 3 mul add 16 div X0 X1 7 mul add X2 15 mul add X3 9 mul add 32 div Y0 Y1 7 mul add Y2 15 mul add Y3 9 mul add 32 div X0 X1 9 mul add X2 X3 add 27 mul add 64 div Y0 Y1 9 mul add Y2 Y3 add 27 mul add 64 div curveto X1 X2 6 mul add X3 9 mul add 16 div Y1 Y2 6 mul add Y3 9 mul add 16 div X2 X3 3 mul add 4 div Y2 Y3 3 mul add 4 div X3 Y3 curveto end } bind def % /CurvetoFourPieces % Bug! Flower has a bug! % If FlowerNumPetals=8 and FlowerPetalsAngularWidth=125 then need to stroke two pieces of path of each petal % (the two parts around the two maxima of the radius). Hence OK with Cos(FlowerPetalsAngularWidth) >= -1/3. % Sometimes more than once piece required: sometimes many more. % FlowerNumPetals FlowerPetalsAngularWidth FlowerRadius FlowerAngleOffset Clockwise? Strokeable Flower - /Flower { //DeBugLevel 25 le {(+Flower) OutputToLog} if 33 dict begin /Strokeable exch def /Clockwise exch def /AngleOffset exch def /Radius exch def abs /AngularWidth exch def /NumPetals exch def currentpoint /y exch def /x exch def % Require 0 <= AngularWidth < 180. Have already done an abs. {AngularWidth 360 ge {/AngularWidth AngularWidth 360 sub def} {exit} ifelse} loop AngularWidth 180 ge {/AngularWidth 360 AngularWidth sub def} if AngularWidth //ArcCosMinusOneThird le { /r Radius 4 mul 3 div AngularWidth 2 div cos div def }{ Strokeable {(Warning: FlowerPetalsAngularWidth > ArcCos(-1/3) = 109.47122 degrees, and Strokeable) OutputToLog} if /r Radius AngularWidth 2 div sin dup mul mul 2 mul //Sqrt3 mul def } ifelse % mid-point of curve is radius max or local min? AngularWidth NumPetals mul 360 gt { % start by calculating the t value of consecutive petal intersect /x0 0 def /y0 0 def /x3 0 def /y3 0 def /x1 AngularWidth 2 div sin def /y1 AngularWidth 2 div cos def /x2 x1 neg def /y2 y1 def /ax x0 neg x1 3 mul add x2 3 mul sub x3 add def /bx x0 x1 2 mul sub x2 add 3 mul def /cx x1 x0 sub 3 mul def /ay y0 neg y1 3 mul add y2 3 mul sub y3 add def /by y0 y1 2 mul sub y2 add 3 mul def /cy y1 y0 sub 3 mul def % Want t at which angle is 180/NumPetals /AngTarget 180 NumPetals div def /tMin 0.1 def /tMax 0.5 def /tMinAng ax tMin mul bx add tMin mul cx add tMin mul % x0 add ay tMin mul by add tMin mul cy add tMin mul % y0 add atan {dup 90 gt {180 sub} {exit} ifelse} loop def /tMaxAng ax tMax mul bx add tMax mul cx add tMax mul % x0 add ay tMax mul by add tMax mul cy add tMax mul % y0 add atan {dup 90 gt {180 sub} {exit} ifelse} loop def /DoingInterp //true def % For robustness alternate bisection and interpolation /exitcount 30 def { DoingInterp { /tCut tMinAng AngTarget sub tMax mul AngTarget tMaxAng sub tMin mul add tMinAng tMaxAng sub div def /DoingInterp //false def }{ /tCut tMin 0.75 mul tMax 0.25 mul add def /DoingInterp //true def } ifelse % DoingInterp /tCutAng ax tCut mul bx add tCut mul cx add tCut mul % x0 add ay tCut mul by add tCut mul cy add tCut mul % y0 add atan def /exitcount exitcount 1 sub def % mark (tCut=) tCut (; tCutAng=) tCutAng % (; tMin=) tMin (; tMinAng=) tMinAng % (; tMax=) tMax (; tMaxAng=) tMaxAng % (; AngTarget=) AngTarget ConcatenateToMark = exitcount 0 eq {exit} if tCutAng AngTarget sub abs 0.01 lt exitcount 4 gt and {/exitcount 4 def} if % Do extra laps for polishing tCutAng AngTarget gt {tCutAng tMinAng lt {/tMin tCut def /tMinAng tCutAng def} if} {tCutAng tMaxAng gt {/tMax tCut def /tMaxAng tCutAng def} if} ifelse % tCutAng AngTarget lt } loop } if % Petals overlap Clockwise {0 1 NumPetals 1 sub} {NumPetals 1 sub -1 0} ifelse { /i exch def x i NumPetals div 360 mul AngularWidth 2 div add AngleOffset add sin r mul add y i NumPetals div 360 mul AngularWidth 2 div add AngleOffset add cos r mul add x i NumPetals div 360 mul AngularWidth 2 div sub AngleOffset add sin r mul add y i NumPetals div 360 mul AngularWidth 2 div sub AngleOffset add cos r mul add Clockwise {4 2 roll} if /y2 exch def /x2 exch def /y1 exch def /x1 exch def AngularWidth NumPetals mul 360 gt Strokeable and { % Overlapping, strokeable: cut at tCut x y moveto tCut x x1 sub mul x1 add tCut y y1 sub mul y1 add x1 x2 sub 2 mul tCut mul x2 add x x2 add x1 2 mul sub tCut dup mul mul add y1 y2 sub 2 mul tCut mul y2 add y y2 add y1 2 mul sub tCut dup mul mul add 3 tCut mul 3 sub tCut mul 1 add x mul x1 x2 sub tCut mul x2 add tCut mul 1 tCut sub mul 3 mul add 3 tCut mul 3 sub tCut mul 1 add y mul y1 y2 sub tCut mul y2 add tCut mul 1 tCut sub mul 3 mul add CurvetoFourPieces }{ % Not overlapping x y moveto x1 y1 x2 y2 x y CurvetoFourPieces closepath } ifelse % Petals overlap } for % i end //DeBugLevel 25 le {(-Flower) OutputToLog} if } bind def % /Flower % End standard subroutines %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Start code specific to setting out placemats % boolean DefStoreMgns - % true => def; false => store /DefStoreMgns { //DeBugLevel 5 le {(+DefStoreMgns) OutputToLog} if /MgnB MarginB TypeOfPagesBeingRendered /Glasses eq {OuterGlassesMarginB} {OuterMarginB} ifelse add /MgnT MarginT TypeOfPagesBeingRendered /Glasses eq {OuterGlassesMarginT} {OuterMarginT} ifelse add /MgnL MarginL TypeOfPagesBeingRendered /Glasses eq {OuterGlassesMarginL} {OuterMarginL} ifelse add /MgnR MarginR TypeOfPagesBeingRendered /Glasses eq {OuterGlassesMarginR} {OuterMarginR} ifelse add 8 index {def def def def} {store store store store} ifelse TypeOfPagesBeingRendered /Glasses eq TypeOfPagesBeingRendered /TastingNotes eq or SideBySideGlassesTastingNotes and { TypeOfPagesBeingRendered /Glasses eq {/MgnR 1 SideBySideGlassesTastingNotesProportionPageGlasses sub} {/MgnL SideBySideGlassesTastingNotesProportionPageGlasses} ifelse % TypeOfPagesBeingRendered /Glasses eq % The swap for left-handers must be done with a 'translate' PageWidth mul SideBySideGlassesTastingNotesWidthGutter 2 div add 3 -1 roll {def} {store} ifelse } {pop} ifelse % ... SideBySideGlassesTastingNotes ... //DeBugLevel 5 le {(-DefStoreMgns) OutputToLog} if } bind def % /DefStoreMgns /UndefMgns {currentdict dup dup dup /MgnB undef /MgnT undef /MgnL undef /MgnR undef} bind def % r1 r2 RadiiEffectivelyEqual boolean % Passes if within PrinterEpsilon /RadiiEffectivelyEqual {sub abs //PrinterEpsilon le} bind def % a packing type ProcessOnePackingType - /ProcessOnePackingType { //DeBugLevel 50 le {(+ProcessOnePackingType) OutputToLog} if 37 dict begin /PackingDescriptor exch execU def /BaseStyle PackingDescriptor dup type /arraytype eq {0 GetEU} if def /ShoveLeft //false def /ShoveRight //false def /RowsNumMin 1 def /RowsNumMax NG def /GlassesNumMin 1 def /GlassesNumMax 65535 def /CentralGlasses 0 def /OnlyIfSheetNumMin 0 def /OnlyIfSheetNumMax //IntegerMax def /OnlyIfOrientation /Either def /ImprovementPointsMin 0 def /ImprovementProportionMin 0 def /ProhibitVerticalNudging //false def /ProhibitHorizontalNudging //false def /PositionsStart PackingDescriptor length def /PositionsEnd 0 def PackingDescriptor type /arraytype eq { /i 1 def { i PackingDescriptor length ge {exit} if PackingDescriptor i GetEU 1 { dup /ShoveLeft eq {pop /ShoveLeft //true store /i i 1 add store exit} if dup /ShoveRight eq {pop /ShoveRight //true store /i i 1 add store exit} if dup /ProhibitVerticalNudging eq {pop /ProhibitVerticalNudging //true store /i i 1 add store exit} if dup /ProhibitHorizontalNudging eq {pop /ProhibitHorizontalNudging //true store /i i 1 add store exit} if dup /RowsNumMin eq {pop /RowsNumMin PackingDescriptor i 1 add GetEU store /i i 2 add store exit} if dup /RowsNumMax eq {pop /RowsNumMax PackingDescriptor i 1 add GetEU store /i i 2 add store exit} if dup /GlassesNumMin eq {pop /GlassesNumMin PackingDescriptor i 1 add GetEU store /i i 2 add store exit} if dup /GlassesNumMax eq {pop /GlassesNumMax PackingDescriptor i 1 add GetEU store /i i 2 add store exit} if dup /CentralGlasses eq {pop /CentralGlasses PackingDescriptor i 1 add GetEU store /i i 2 add store exit} if dup /OnlyIfSheetNumMin eq {pop /OnlyIfSheetNumMin PackingDescriptor i 1 add GetEU store /i i 2 add store exit} if dup /OnlyIfSheetNumMax eq {pop /OnlyIfSheetNumMax PackingDescriptor i 1 add GetEU store /i i 2 add store exit} if dup /OnlyIfOrientation eq {pop /OnlyIfOrientation PackingDescriptor i 1 add GetEU store /i i 2 add store exit} if dup /ImprovementPointsMin eq {pop /ImprovementPointsMin PackingDescriptor i 1 add GetEU store /i i 2 add store exit} if dup /ImprovementProportionMin eq {pop /ImprovementProportionMin PackingDescriptor i 1 add GetEU store /i i 2 add store exit} if dup /Positions eq {pop /PositionsStart i 1 add store PositionsStart 1 PackingDescriptor length 1 sub {dup PackingDescriptor exch get type /arraytype eq {/PositionsEnd exch store} {pop exit} ifelse} for /i PositionsEnd 1 add store exit} if dup /Mirror eq {pop /i i 1 add store exit} if dup /SuppressOrnamentsLeft eq {pop /i i 1 add store exit} if dup /SuppressOrnamentsRight eq {pop /i i 1 add store exit} if dup /SuppressOrnamentsCentre eq {pop /i i 1 add store exit} if dup /VerticalAlignment eq {pop /i i 2 add store exit} if % Discussion: http://www.theportforum.com/viewtopic.php?t=175&p=79314#p79314 dup /HorizontalAlignment eq {pop /i i 2 add store exit} if dup /RectColsToLeftOrRowsBelow eq {pop /i i 2 add store exit} if dup /PackingNestingColumnMajor eq {pop /i i 2 add store exit} if dup /PackingDirectionTopToBottom eq {pop /i i 2 add store exit} if % Discussion: http://www.theportforum.com/viewtopic.php?t=175&p=73641#p73641 dup /PackingDirectionLeftToRight eq {pop /i i 2 add store exit} if dup /TempleExtraColsToLeftOrRowsBelow eq {pop /i i 2 add store exit} if mark exch (Warning: an item of PackingStyles contains the non-recognised sub-parameter ) exch ToString ConcatenateToMark OutputToLog /i i 1 add store } repeat % 1 } loop } if % PackingDescriptor type /arraytype eq % Ensure RowsNumMin and RowsNumMax are sensible BaseStyle /Bespoke5 eq NG 5 le and {/RowsNumMin 2 store /RowsNumMax 3 store} if % Because if /Bespoke5 also test /Diamonds BaseStyle /Bespoke7 eq NG 7 le and {Orientation /Landscape eq {/RowsNumMin 2 store /RowsNumMax 3 store} {/RowsNumMin 5 store /RowsNumMax 7 store} ifelse} if % Because if /Bespoke7 also test /Diamonds RowsNumMin 1 lt {/RowsNumMin 1 store} if RowsNumMin NG gt {/RowsNumMin NG store} if RowsNumMax RowsNumMin lt {/RowsNumMax RowsNumMin store} if RowsNumMax NG gt {/RowsNumMax NG store} if NG BaseStyle /PostsAndLintel eq {1 add 2 idiv} if dup RowsNumMin lt {dup /RowsNumMin exch store} if dup RowsNumMax lt {/RowsNumMax exch store} {pop} ifelse ShoveLeft ShoveRight and {mark (Error: ProcessOnePackingType, packing with BaseStyle /) BaseStyle ( has both /ShoveLeft and /ShoveRight. Continuing regardless.) ConcatenateToMark OutputToLog} if /PriorBestRadius BestRadius def 1 { % Check meet this PackingDescriptor's requirements OnlyIfOrientation dup /Either eq {pop} {Orientation ne {exit} if} ifelse SheetNum OnlyIfSheetNumMin lt SheetNum OnlyIfSheetNumMax gt or {exit} if NG 0 gt BaseStyle /TopRow ne or {NG GlassesNumMin lt NG GlassesNumMax gt or {exit} if} if % /Diamonds is, uniquely, a fall-back for special cases of some others. /Diamonds BaseStyle eq /RectangularAlternateNudge BaseStyle eq or /Bespoke5 BaseStyle eq NG 5 le and or /Bespoke7 BaseStyle eq NG 7 le and or /Temple BaseStyle eq or { //DeBugLevel 50 le {( ProcessOnePackingType, /Diamonds | /Bespoke5 | /Bespoke7) OutputToLog} if % /Diamonds trivia: fix the number of glasses at eight, and increase the page's usable Height/Width ratio. At which ratios does the number of rows change? % 2 -> 3 0.44444444 4 9 div = 4/9 % 3 -> 4 0.68572971 7 sqrt 1 sub 5 mul 12 div = (Sqrt(7)-1) * 5/12 % 4 -> 3 0.70562062 35 sqrt 15 sqrt add 2 mul 21 sqrt sub 3 sub 17 div = ( (Sqrt(35)+Sqrt(15))*2 - Sqrt(21) - 3 ) / 17 % 3 -> 5 1 1 = 1 % 5 -> 4 1.41719214 35 sqrt 15 sqrt sub 2 mul 21 sqrt add 3 sub 4 div = ( (Sqrt(35)-Sqrt(15))*2 - 3 + Sqrt(21) ) / 4 % 4 -> 5 1.45830052 7 sqrt 1 add 2 mul 5 div = (Sqrt(7)+1) * 2/5 % 5 -> 8 2.25 9 4 div = 9/4 RowsNumMin 1 RowsNumMax { /NR exch def % NumRows NR 3 eq /Temple BaseStyle ne or { /Temple BaseStyle eq {/NC NG 1 sub 3 div ceiling cvi 2 mul 1 add def} {/NC NG 1 eq {1} {NG NR idiv 2 mul NG NR mod dup 0 eq {pop} {NR 1 add 2 idiv gt {2} {1} ifelse add} ifelse} ifelse def} ifelse % /Temple BaseStyle eq /a 1 NC 2 sub NC mul NR 2 sub mul NR mul sub 4 mul def /b NC 1 sub dup mul H mul NR 1 sub dup mul W mul add -4 mul def /c NC 1 sub H mul dup mul NR 1 sub W mul dup mul add def /R [ H NR 1 add div W NC 1 add div [ c b a ] 0 //true //Infinity //true //PrinterEpsilon PolynomialRoots aload pop ] Min def R PriorBestRadius ImprovementPointsMin dup 0 gt {add} {pop} ifelse gt R PriorBestRadius ImprovementProportionMin dup 0 gt {1 add mul} {pop} ifelse gt and R BestRadius gt and { /BestRadius R store BestParamsDict {pop BestParamsDict exch undef} forall BestParamsDict /PackingDescriptor PackingDescriptor put BestParamsDict /BaseStyle /Diamonds put BestParamsDict /NumRows NR put BestParamsDict /NumCols NC put } if % R PriorBestRadius ... gt ... } if % NR 3 eq /Temple BaseStyle ne or } for % NR % No exit as /Diamonds used as a fallback for others } if % /Diamonds /RectangularAlternateNudge /Bespoke5 /Bespoke7 /Temple /Bespoke5 BaseStyle eq NG 5 le and { //DeBugLevel 50 le {( ProcessOnePackingType, /Bespoke5) OutputToLog} if W H 2 copy lt {exch} if /S exch def /L exch def % short side, long side /a 21 S mul 10 L mul sub 2 S mul L sub 6 mul //Sqrt3 mul add S mul def a 0 ge { /R 2 S mul L sub //Sqrt3 mul 5 S mul add L sub a sqrt sub 4 div def R PriorBestRadius ImprovementPointsMin dup 0 gt {add} {pop} ifelse gt R PriorBestRadius ImprovementProportionMin dup 0 gt {1 add mul} {pop} ifelse gt and R S 2 div //PrinterEpsilon add le and % second test should be redundant, but the equations have multiple solutions { /b L S //Sqrt3 mul sub R 2 mul //Sqrt3 1 sub mul add def b 0 ge b R le and % not pushed out of bounds { /BestRadius R store BestParamsDict {pop BestParamsDict exch undef} forall BestParamsDict /PackingDescriptor PackingDescriptor put BestParamsDict /BaseStyle BaseStyle put } if % b 0 ge b R le and } if % R BestRadius gt ... } if % a 0 ge exit % 1 {...} repeat } if % ... /Bespoke5 ... NG 5 le and /Bespoke7 BaseStyle eq NG 7 le and { //DeBugLevel 50 le {( ProcessOnePackingType, /Bespoke7) OutputToLog} if W H 2 copy lt {exch} if /S exch def /L exch def % short side, long side L S div dup 2 //Sqrt3 sub 8 mul lt exch //Sqrt3 1 sub 1.5 mul gt and { /a 4 def /b 7 4 //Sqrt3 mul sub L mul 2 //Sqrt3 sub S mul add -8 mul def /c 7 4 //Sqrt3 mul sub 4 S S mul mul L L mul add mul def [ c b a ] //PrinterEpsilon //true S 2 //Sqrt3 add div L 6 div 2 copy gt {exch} if pop //PrinterEpsilon add //false //PrinterEpsilon PolynomialRoots dup length 1 ge { Min /R exch def R PriorBestRadius ImprovementPointsMin dup 0 gt {add} {pop} ifelse gt R PriorBestRadius ImprovementProportionMin dup 0 gt {1 add mul} {pop} ifelse gt and { /BestRadius R store BestParamsDict {pop BestParamsDict exch undef} forall BestParamsDict /PackingDescriptor PackingDescriptor put BestParamsDict /BaseStyle BaseStyle put } if % R BestRadius gt ... } {pop} ifelse % ... PolynomialRoots ... length 1 ge } if % Usable paper of valid aspect ratio exit % 1 {...} repeat } if % ... /Bespoke7 ... NG 7 le and /Temple BaseStyle eq { //DeBugLevel 50 le {( ProcessOnePackingType, /Temple) OutputToLog} if % http://github.com/jdaw1/placemat/blob/main/Supporting_code/PackingStyles_formulae.nb % The constraint on the aspect ratio might be <= (Sqrt3-1)*5/2 ~= 1.8301 and also >= (27+11*Sqrt3)*(4-SqrtSqrt12)/61 ~= 1.6147 /N NG 1 sub 3 div ceiling cvi dup 2 lt {pop 2} if def 0 1 1 % 0 = Landscape-style, N=NumCols and NumRows~=3; 1 = Portrait-style, N=NumRows and NumCols~=3; { dup /O exch def 0 eq {/L W /S H} {/L H /S W} ifelse def def /MinR L N 1 add 2 mul div S //SqrtSqrt12 2 mul 2 add div 2 copy gt {exch} if pop def /MaxR L N 1 sub //Sqrt3 add 2 mul div S //Sqrt3 2 mul 2 add div 2 copy gt {exch} if pop def [ S S mul dup mul 16 mul dup S L mul dup mul 4 mul sub L L mul dup mul add exch S L mul dup mul 12 mul add L L mul dup mul 9 mul add mul % Coeff 0 512 S mul N 1 add 64 mul L mul add S mul 192 L L mul mul add S mul 112 N mul 32 sub L L L mul mul mul add S mul 112 L L mul dup mul mul add S mul 48 36 N mul sub L L mul dup mul L mul mul add S mul 12 L L L mul mul dup mul mul sub S mul N 18 mul 9 sub L L L mul mul dup mul L mul mul add -8 mul % Coeff 1 64 N mul 128 add N mul 2880 add S mul N 1 add 768 mul L mul add S mul 336 N mul 192 sub N mul 736 add L L mul mul add S mul 896 N mul 256 sub L L L mul mul mul add S mul -180 N mul 480 add N mul 184 add L L mul dup mul mul add S mul -144 N mul 192 add L L mul dup mul L mul mul add S mul N 1 sub 126 mul N mul 9 sub L L L mul mul dup mul mul add 8 mul % Coeff 2 192 N mul 384 add N mul 1472 add S mul 112 N mul 96 sub N mul 736 add N mul 848 add L mul add S mul 672 N mul 384 sub N mul 192 add L L mul mul add S mul -120 N mul 480 add N mul 368 add N mul 304 sub L L L mul mul mul add S mul -180 N mul 480 add N mul 40 sub L L mul dup mul mul add S mul 126 N mul 189 sub N mul 27 sub N mul 75 add L L mul dup mul L mul mul add -32 mul % Coeff 3 112 N mul 128 sub N mul 1472 add N mul 3392 add N mul 1136 sub S mul 1792 N mul 1536 sub N mul 1536 add N mul 3328 add L mul add S mul -360 N mul 1920 add N mul 2208 add N mul 3648 sub N mul 360 add L L mul mul add S mul -960 N mul 3840 add N mul 640 sub N mul 1408 sub L L L mul mul mul add S mul 630 N mul 1260 sub N mul 270 sub N mul 1500 add N mul 239 sub L L mul dup mul mul add 16 mul % Coeff 4 112 N mul 128 sub N mul 192 add N mul 832 add N mul 1392 sub S mul -36 N mul 240 add N mul 368 add N mul 912 sub N mul 180 add N mul 320 add L mul add S mul -180 N mul 960 add N mul 240 sub N mul 1056 sub N mul 308 add L L mul mul add S mul 126 N mul 315 sub N mul 90 sub N mul 750 add N mul 239 sub N mul 176 sub L L L mul mul mul add -128 mul % Coeff 5 -126 N mul 378 add N mul 135 add N mul 1500 sub N mul 717 add N mul 1056 add N mul 416 sub L L mul mul 144 N mul 960 sub N mul 320 add N mul 2112 add N mul 1232 sub N mul L S mul mul 12 N mul 96 sub N mul 184 sub N mul 608 add N mul 180 sub N mul 640 sub N mul 1248 add S S mul mul add add -128 mul % Coeff 6 -18 N mul 63 add N mul 27 add N mul 375 sub N mul 239 add N mul 528 add N mul 416 sub L mul 12 N mul 96 sub N mul 40 add N mul 352 add N mul 308 sub N mul S mul add 512 N mul mul % Coeff 7 9 N mul 36 sub N mul 18 sub N mul 300 add N mul 239 sub N mul 704 sub N mul 832 add 256 N N mul mul mul % Coeff 8 ] MinR //false MaxR //false //PrinterEpsilon PolynomialRoots % On exact boundary, prefer Diamonds or RectangularDislocation dup length 0 gt {Min} {pop MaxR} ifelse /R exch def R PriorBestRadius ImprovementPointsMin dup 0 gt {add} {pop} ifelse gt R PriorBestRadius ImprovementProportionMin dup 0 gt {1 add mul} {pop} ifelse gt and R BestRadius gt and { /BestRadius R store BestParamsDict {pop BestParamsDict exch undef} forall BestParamsDict /PackingDescriptor dup load put BestParamsDict /BaseStyle dup load put BestParamsDict /N N put BestParamsDict /O O put } if % R PriorBestRadius ... gt ... } for % O exit % 1 {...} repeat } if % /Temple BaseStyle dup dup dup /SquareGrid eq exch /TopRow eq or exch /MiddleRow eq or exch /BottomRow eq or { //DeBugLevel 50 le {( ProcessOnePackingType, /SquareGrid | /TopRow | /MiddleRow | /BottomRow) OutputToLog} if BaseStyle /SquareGrid eq {RowsNumMin 1 RowsNumMax} {1 1 1} ifelse { /NR exch def % NumRows /NC NG NR div ceiling cvi def /R H NR 2 ge {NR div} if W NC 2 ge {NC div} if 2 copy gt {exch} if pop 2 div def R PriorBestRadius ImprovementPointsMin dup 0 gt {add} {pop} ifelse gt R PriorBestRadius ImprovementProportionMin dup 0 gt {1 add mul} {pop} ifelse gt and R BestRadius gt and { /BestRadius R store BestParamsDict {pop BestParamsDict exch undef} forall BestParamsDict /PackingDescriptor dup load put BestParamsDict /BaseStyle dup load put BestParamsDict /NumRows NR put BestParamsDict /NumCols NC put } if % R PriorBestRadius ... gt ... } for % NR exit % 1 {...} repeat } if % /SquareGrid /TopRow /MiddleRow /BottomRow /Sides BaseStyle eq { //DeBugLevel 50 le {( ProcessOnePackingType, /Sides) OutputToLog} if NG 1 ge { /NR NG 1 add 2 idiv def /R H NR 2 mul div W 4 div 2 copy gt {exch} if pop def R BestRadius ImprovementPointsMin dup 0 gt {add} {pop} ifelse gt R BestRadius ImprovementProportionMin dup 0 gt {1 add mul} {pop} ifelse gt and { /BestRadius R store BestParamsDict {pop BestParamsDict exch undef} forall BestParamsDict /PackingDescriptor dup load put BestParamsDict /BaseStyle dup load put BestParamsDict /NumRows NR put BestParamsDict /NumCols 2 put } if % R BestRadius ... gt ... } if % NG 1 ge exit % 1 {...} repeat } if % /Sides /LeftSide BaseStyle eq /RightSide BaseStyle eq or { //DeBugLevel 50 le {mark ( ProcessOnePackingType, /) BaseStyle ConcatenateToMark OutputToLog} if NG 1 ge { /R H NG 2 mul div W 2 div 2 copy gt {exch} if pop def R BestRadius ImprovementPointsMin dup 0 gt {add} {pop} ifelse gt R BestRadius ImprovementProportionMin dup 0 gt {1 add mul} {pop} ifelse gt and { /BestRadius R store BestParamsDict {pop BestParamsDict exch undef} forall BestParamsDict /PackingDescriptor dup load put BestParamsDict /BaseStyle dup load put BestParamsDict /NumRows NG put BestParamsDict /NumCols 1 put } if % R BestRadius ... gt ... } if % NG 1 ge exit % 1 {...} repeat } if % /LeftSide ... /RightSide ... /RectangularDislocation BaseStyle eq { //DeBugLevel 50 le {( ProcessOnePackingType, /RectangularDislocation) OutputToLog} if RowsNumMin 1 RowsNumMax { /NR exch def /NC NG NR div ceiling cvi def /R W NC 2 mul div H NR 2 mul div 2 copy gt {exch} if pop def NR NC mul NG gt { % With dislocation. For calculating R it matters not between which rows. /a 4 NC 1 sub NR 1 sub mul 4 mul dup mul add NC 1 sub 4 mul dup mul sub def /b -4 W mul NC 1 sub dup mul NR 1 sub mul 16 mul H mul sub def /c W W mul NC 1 sub 2 mul H mul dup mul add def /R W NC 2 mul div H NR 1 sub 2 mul div 2 copy gt {exch} if pop def [ c b a ] 0 //true R //false //PrinterEpsilon PolynomialRoots dup length [ {pop R} {0 get} {Min} ] exch get exec /R exch def } if % Dislocation R PriorBestRadius ImprovementPointsMin dup 0 gt {add} {pop} ifelse gt R PriorBestRadius ImprovementProportionMin dup 0 gt {1 add mul} {pop} ifelse gt and R BestRadius gt and { /BestRadius R store BestParamsDict {pop BestParamsDict exch undef} forall BestParamsDict /PackingDescriptor dup load put BestParamsDict /BaseStyle dup load put BestParamsDict /NumRows NR put BestParamsDict /NumCols NC put % One fewer column in narrower section } if % R PriorBestRadius ... gt ... } for % NR exit % 1 {...} repeat } if % /RectangularDislocation % Discussion of name: http://www.theportforum.com/viewtopic.php?t=175&p=57297#p57297 /PostsAndLintel BaseStyle eq { //DeBugLevel 50 le {( ProcessOnePackingType, /PostsAndLintel) OutputToLog} if % Recall V is number touching a side, so ignores those touching top CentralGlasses type /integertype ne CentralGlasses 0 lt CentralGlasses 3 gt or or {(Error: ProcessOnePackingType, PostsAndLintel, CentralGlasses should be 0, 1, 2, or 3. Continuing with CentralGlasses=0.) OutputToLog /CentralGlasses 0 def} if /NGaE NG CentralGlasses sub def % Num Glasses at Edge NGaE 1 le { /R W NGaE 2 eq {2 div} if H 2 copy gt {exch} if pop 2 div def /V 0 def }{ RowsNumMin 1 RowsNumMax { /V exch 1 sub def % num glasses touching each vertical side, so 1 less than the number of rows /a V V mul 8 mul NGaE V 4 mul sub NGaE mul add 4 sub def /b H V mul 4 mul NGaE V 2 mul sub W mul add neg def /c W W mul 4 div H H mul add def mark [ c b a ] 0 //true [V 0 gt {H //PrinterEpsilon add V 2 mul div} if NGaE V 2 mul gt {W //PrinterEpsilon add NGaE V 2 mul sub 2 mul div} if] Min //true //PrinterEpsilon PolynomialRoots dup length [ {pop H V 1 add 2 mul div NGaE V 2 mul sub dup 0 gt {2 mul W exch div} {pop //Infinity} ifelse} {0 get} {Min (Warning: ProcessOnePackingType, PostsAndLintel, two seemingly good solutions.) OutputToLog} ] exch get exec W 4 div H 2 div % As above geometry doesn't prevent overlapping of non-adjacent circles CentralGlasses 1 eq {W 6 div H NGaE 2 mod 0 eq {//Sqrt3 2 add} {4} ifelse div} if CentralGlasses 2 eq {W 8 div H NGaE 2 mod 1 eq {//Sqrt3 2 add} {4} ifelse div} if CentralGlasses 3 eq {W 8 div H NGaE 2 mod 1 eq {//Sqrt3 4 add} {//Sqrt3 2 mul 2 add} ifelse div} if MinToMark /R exch def R PriorBestRadius ImprovementPointsMin dup 0 gt {add} {pop} ifelse gt R PriorBestRadius ImprovementProportionMin dup 0 gt {1 add mul} {pop} ifelse gt and R BestRadius gt and { /BestRadius R store BestParamsDict {pop BestParamsDict exch undef} forall BestParamsDict /PackingDescriptor dup load put BestParamsDict /BaseStyle dup load put BestParamsDict /NumRows V 1 add put BestParamsDict /CentralGlasses dup load put W H lt {(Warning: PostsAndLintel packings rarely look good with Orientation equalling /Portrait: consider "... /OnlyIfOrientation /Landscape ...".) OutputToLog} if } if % R PriorBestRadius ... gt ... } for % V } ifelse % NGaE 1 le exit % 1 {...} repeat } if % /PostsAndLintel /Arch BaseStyle eq { % Discussion: http://www.theportforum.com/viewtopic.php?t=175&p=56857#p56857 //DeBugLevel 50 le {( ProcessOnePackingType, /Arch) OutputToLog} if /NGiA NG CentralGlasses sub def % Number Glasses in Arch NGiA 3 ge { % In all other patterns the radius can be computed analytically. Not this. % Outer loop interval bisects R. % Inner attempts to jiggle circles into place. If possible with distance >= 2R, that R good. If not possible, or too hard to tell, fails. % Can be slow and complicated, though many cases fail quickly. 19 dict begin /UpperR mark 90 NGiA 1 sub div NGiA 2 mod 0 eq {dup sin 1 exch div dup 3 -1 roll cos mul} {sin 1 exch div dup} ifelse 2 add H exch div exch 1 add W 2 div exch div 2 copy lt {exch} if pop CentralGlasses 0 eq {W 4 div H 2 div} if CentralGlasses 1 eq {W 6 div H NGiA 2 mod 1 eq {4} {//Sqrt3 2 add} ifelse div} if CentralGlasses 2 eq {W 8 div H NGiA 2 mod 0 eq {4} {//Sqrt3 2 add} ifelse div} if CentralGlasses 3 eq {W 8 div H NGiA 2 mod 0 eq {//Sqrt3 2 mul 2 add} {//Sqrt3 4 add} ifelse div} if MinToMark def % /UpperR /LowerR [ H H mul W W mul 4 div add NGiA 2 mod 0 eq {H 2 mul W add -2 mul 4 NGiA sub NGiA mul 4 add} {H -4 mul W sub 2 NGiA sub NGiA mul 4 add} ifelse ] 0 //true H W lt {H} {W} ifelse 2 div //false //PrinterEpsilon PolynomialRoots dup length 0 eq {pop 0} {Min} ifelse NGiA 4 le {//PrinterEpsilon 2 mul sub} if UpperR //PrinterEpsilon 2 mul sub 2 copy gt {exch} if pop def /R LowerR BestRadius lt {BestRadius //PrinterEpsilon sub} {LowerR UpperR add 2 div} ifelse def % If BestRadius not tiny, try to fail early /LittleN2sub NGiA 1 add 2 idiv 2 sub def /PositionsX LittleN2sub 2 add array def % First element is top-most circle, or right of two top-most. Page X centre at 0, so 0 <= PositionsX <= W/2 - R. /PositionsY LittleN2sub 2 add array def % Page Y bottom at 0, so R <= PositionsY <= H - R. /BestX NGiA 1 add 2 idiv array def /BestY NGiA 1 add 2 idiv array def { % mark (NGiA = ) NGiA 3 string cvs (; LowerR = ) LowerR 15 string cvs (; UpperR = ) UpperR 15 string cvs (; diff = ) UpperR LowerR sub (; R = ) R 15 string cvs ConcatenateToMark = UpperR BestRadius le {exit} if % Continuing purposeless //true BestX {IsNumber not {pop //false exit} if} forall BestY {IsNumber not {pop //false exit} if} forall UpperR LowerR sub //PrinterEpsilon le and {exit} if /RR4 R R mul 4 mul def /EllipseSemiX W 2 div R sub def /EllipseSemiY H R 2 mul sub def PositionsY 0 H R sub put % constant 0 1 LittleN2sub 1 add { /i exch def NGiA 2 mod 0 eq i 0 eq and {/EllipseSemiY H 2 R mul sub 90 NGiA 1 sub div cos div store} if PositionsX i PositionsY i NGiA 1 add 2 mod i 2 mul add 90 mul NGiA 1 sub div dup cos EllipseSemiY mul R add exch sin EllipseSemiX mul 4 1 roll put put } for % i NGiA 2 add dup mul -1 0 { 0 le {/UpperR R def (Error: ProcessOnePackingType, Arch, extremely slow convergence. Please submit an issue to http://github.com/jdaw1/placemat/issues/) OutputToLog exit} if /DistSquaredMax 0 def /DistSquaredMin H W add dup mul def % Test for exit of jiggling of PositionsX & PositionsY NGiA 1 add 2 mod neg 1 LittleN2sub { /i exch def i -1 eq {PositionsX 0 get 2 mul dup mul} {PositionsX i get PositionsX i 1 add get sub dup mul PositionsY i get PositionsY i 1 add get sub dup mul add} ifelse dup dup dup DistSquaredMin lt {/DistSquaredMin exch def} {pop} ifelse DistSquaredMax gt {/DistSquaredMax exch def} {pop} ifelse } for % i DistSquaredMax RR4 lt {/UpperR R def exit} if DistSquaredMin RR4 ge {/LowerR R def BestX 0 PositionsX putinterval BestY 0 PositionsY putinterval exit} if % Done position optimisation? Max-Min Max Max^2 < Min^2 + 2*PrinterEpsilon*Min + small ==> Max^2 - Min^2 < 2 PrinterEpsilon Min ==> (Max^2 - Min^2)^2 < 4 PrinterEpsilon^2 Min^2 DistSquaredMax DistSquaredMin sub dup mul //PrinterEpsilon 2 mul dup mul DistSquaredMin mul le DistSquaredMax DistSquaredMin div //Epsilon 2 mul 1 add lt DistSquaredMax sqrt DistSquaredMin sqrt sub //PrinterEpsilon le or or {/UpperR R def exit} if % Min and Max straddle cutoff, and optimisation done % Not testing extras as embedded into intial value of UpperR % Update PositionsX and PositionsY 0 1 LittleN2sub { /i exch def i 0 eq { NGiA 2 mod 0 eq { PositionsX 0 H R sub PositionsY 1 get sub dup mul 3 mul PositionsX 1 get dup mul 4 mul add sqrt PositionsX 1 get sub 3 div put /EllipseSemiY H R 2 mul sub 1 PositionsX 0 get EllipseSemiX div dup mul sub dup 0 gt {sqrt div} {pop pop //PrinterEpsilon} ifelse store } if % NGiA 2 mod 0 eq }{ /X1 PositionsX i 1 sub get def /X3 PositionsX i 1 add get def /Y1 PositionsY i 1 sub get def /Y3 PositionsY i 1 add get def /X2 [ X1 X1 mul X3 X3 mul sub EllipseSemiY R sub 2 mul Y1 add Y3 add Y1 Y3 sub mul add X1 X1 mul X3 X3 mul sub EllipseSemiY R add 2 mul Y1 sub Y3 sub Y1 Y3 sub mul sub mul EllipseSemiX dup mul mul X1 X1 mul X3 X3 mul sub Y1 Y1 mul add Y3 Y3 mul sub Y3 Y1 sub 2 mul R mul add X1 X3 sub mul EllipseSemiX dup mul mul -4 mul X1 X3 sub EllipseSemiX mul dup mul Y1 Y3 sub EllipseSemiY mul dup mul add 4 mul ] 0 //true W R sub //false //PrinterEpsilon PolynomialRoots dup length 0 eq {(Error: ProcessOnePackingType, Arch, no solutions) OutputToLog stop} if Max R 2 copy lt {exch} if pop def % /X2 PositionsX i X2 put PositionsY i X1 X1 mul X3 X3 mul sub Y1 Y1 mul add Y3 Y3 mul sub X3 X1 sub 2 mul X2 mul add Y1 Y3 sub 2 mul div put } ifelse % i 0 eq } for % i } for % loop count to stop slow convergence, updating PositionsX, PositionsY, EllipseSemiY /R UpperR LowerR add 2 div def } loop % R, UpperR, LowerR [ 0 1 BestX length 1 sub {/i exch def BestX i get IsNumber BestY i get IsNumber and {BestX i get W 2 div LowerR sub div BestY i get LowerR sub H LowerR sub div atan} {//null} ifelse} for ] LowerR end /R exch def R BestRadius ImprovementPointsMin dup 0 gt {add} {pop} ifelse gt R BestRadius ImprovementProportionMin dup 0 gt {1 add mul} {pop} ifelse gt and { /BestRadius R store BestParamsDict {pop BestParamsDict exch undef} forall BestParamsDict /BaseStyle BaseStyle put BestParamsDict /PackingDescriptor PackingDescriptor put BestParamsDict exch /PseudoAngles exch put W H lt {(Warning: Arch packings rarely look good with Orientation equalling /Portrait: consider "... /OnlyIfOrientation /Landscape ...".) OutputToLog} if } {pop} ifelse % LowerR BestRadius gt } if % NGiA 3 ge exit % 1 {...} repeat } if % /Arch /DiamondsPlus BaseStyle eq NG 5 ge and { //DeBugLevel 50 le {( ProcessOnePackingType, /DiamondsPlus) OutputToLog} if W H 2 copy lt {exch} if /S exch def /L exch def % short side, long side RowsNumMin dup 2 mod 0 eq {1 add} if dup 3 lt {pop 3} if 2 RowsNumMax dup 3 gt {pop 3} if % Currently copes only with 3 rows. Should cope with any odd number. Later, perhaps. { /NR exch def % NC refers to the fully filled diamonds section, outside which are NR+1 glasses. /NC NG NR 1 add sub NR div ceiling cvi 2 mul NG NR 1 add sub NR mod 2 mul dup 0 gt exch NR le and {1 sub} if def /NEaT NC 1 add 2 idiv def % Number Extras at Top % This is the quartic that solves for radius with three rows (Landscape), when adjacent items in a row don't touch -- but do touch the circles in the neighbouring row(s). % Valid range will be 0 to its first turning point, which will be the next thing solved. /QuarticCoeffs [ NC dup mul 1 sub S S mul mul dup mul S L mul dup mul 8 mul NC dup mul 1 add mul add L L mul dup mul 16 mul add % Coeff 0 NC dup mul dup 2 sub exch 1 sub mul -8 mul S S S mul mul mul NC dup mul 1 add L S S mul mul mul NC dup mul 2 add L L S mul mul mul add 32 mul sub 128 L L L mul mul mul sub % Coeff 1 NC dup mul dup 3 sub exch 4 add mul -8 mul S S mul mul NC dup mul 2 add 128 mul S L mul mul add NC dup mul 4 sub -96 mul L L mul mul add % Coeff 2 NC dup mul 3 mul 4 sub 128 mul L mul NC dup mul dup 4 sub exch 3 mul 2 add mul 32 mul S mul add % Coeff 3 NC dup mul 3 mul 4 sub dup mul 16 mul % Coeff 4 ] def % /QuarticCoeffs QuarticCoeffs 0 //true S 4 div L NEaT 2 mul div 2 copy gt {exch} if pop //PrinterEpsilon add //false //PrinterEpsilon PolynomialRoots dup length 0 eq {pop //Infinity} {Min} ifelse S 4 div 2 copy gt {exch} if pop /R exch def % If diagonal touching has horizontal overlapping, then instead have horizontal touching and diagonal gaps. 8 R mul S sub S mul dup 0 ge {sqrt 2 div 2 R mul add L exch sub NC div //PrinterEpsilon add R lt} {pop //false} ifelse { % Next equation assumes that circles in the top row touch, so this is effectively /PostsAndLintel with two circles in the lintel. [ 4 L L mul mul S S mul add NC 2 mod 1 eq {NEaT 2 mul 1 add L mul S add -8 mul NEaT 2 mul 1 add dup mul 4 mul} {NEaT 1 add L mul -16 mul S 8 mul sub NEaT 1 add dup mul 16 mul} ifelse ] 0 //true S 2 div //false //PrinterEpsilon PolynomialRoots dup length 0 eq {pop //Infinity} {Min} ifelse % And check that middle row doesn't interfere with end two [ S dup mul dup L dup mul 16 mul add mul L L mul 8 mul S S mul add NC 2 mul 3 add 2 mul L S mul mul add S mul -8 mul 8 L L mul mul NC 2 mul 3 add 4 mul L S mul mul add NC dup 3 add mul S S mul mul add 16 mul NC 4 mul 6 add L mul NC dup 3 add mul 1 sub S mul add -64 mul NC dup 3 add mul 2 mul 1 add 64 mul ] 0 //true L //false //PrinterEpsilon PolynomialRoots dup length 0 eq {pop //Infinity} {Min} ifelse S //Sqrt3 1 add 2 mul div 2 {2 copy gt {exch} if pop} repeat /R exch def /DistHorizontal //true def } {/DistHorizontal //false def} ifelse L NEaT 2 mul 2 add div dup R lt {/R exch def} {pop} ifelse R S 2 div //PrinterEpsilon add lt { R PriorBestRadius ImprovementPointsMin dup 0 gt {add} {pop} ifelse gt R PriorBestRadius ImprovementProportionMin dup 0 gt {1 add mul} {pop} ifelse gt and { mark (DiamondsPlus improves radius by ) R PriorBestRadius sub dup (pt = ) exch 72 div dup (" = ) exch 25.4 mul (mm ) PriorBestRadius 0 gt {(= ) R PriorBestRadius div 1 sub 100 mul (% )} if (to ) R (pt from ) PriorBestRadius (pt on SheetNum=) SheetNum (.) ConcatenateToMark OutputToLog /BestRadius R store BestParamsDict {pop BestParamsDict exch undef} forall BestParamsDict /PackingDescriptor PackingDescriptor put BestParamsDict /BaseStyle BaseStyle put BestParamsDict /NumCols NC put BestParamsDict /DistHorizontal DistHorizontal put } if % R BestRadius gt ... } if % R finite } for % NR exit } if % /DiamondsPlus /DiamondsAndRectangular BaseStyle eq { //DeBugLevel 50 le {( ProcessOnePackingType, /DiamondsAndRectangular) OutputToLog} if RowsNumMin 1 RowsNumMax { /NR exch def /NiLR NG NR div ceiling cvi def % Num in Longer Rows /NC NiLR 2 mul 1 sub def % Always odd /NSR NiLR NR mul NG sub NR 1 sub 2 idiv 2 copy gt {exch} if pop def % Num Short Rows, the upper limit being /Diamonds with an odd number of columns NR 3 ge { % /AboveBelow true [ NSR W mul dup mul 4 mul NC 1 sub H mul dup mul add NR 2 NSR mul sub NC 1 sub dup mul mul -4 mul H mul NSR dup mul 16 mul W mul sub NC 1 sub dup mul NR mul NR NSR 4 mul sub mul NSR dup mul 4 mul add 4 mul ] 0 //false //Infinity //true //PrinterEpsilon PolynomialRoots dup length 0 gt { Min W NiLR 2 mul div 2 copy gt {exch} if pop NR NSR gt {H NR NSR sub 2 mul div 2 copy gt {exch} if pop} if /R exch def R PriorBestRadius ImprovementPointsMin dup 0 gt {add} {pop} ifelse gt R PriorBestRadius ImprovementProportionMin dup 0 gt {1 add mul} {pop} ifelse gt and R BestRadius gt and { /BestRadius R store BestParamsDict {pop BestParamsDict exch undef} forall BestParamsDict /PackingDescriptor dup load put BestParamsDict /BaseStyle dup load put BestParamsDict /AboveBelow //true put BestParamsDict /NumRows NR put BestParamsDict /NumCols NC put BestParamsDict /NumInLongerRows NiLR put BestParamsDict /NumShorterRows NSR put } if % R PriorBestRadius ... gt ... } {pop} ifelse % any solutions to quadratic } if % NR 3 ge % /AboveBelow false % In this section except BestParamsDict, meaning of rows and columns is reversed. Careful! NR 2 mod 1 eq { [ NSR H mul dup mul 4 mul NC 1 sub W mul dup mul add NR 2 NSR mul sub NC 1 sub dup mul mul -4 mul W mul NSR dup mul 16 mul H mul sub NC 1 sub dup mul NR mul NR NSR 4 mul sub mul NSR dup mul 4 mul add 4 mul ] 0 //true H W lt {H} {W} ifelse 2 div //false //PrinterEpsilon PolynomialRoots dup length 0 gt { Min H NiLR 2 mul div 2 copy gt {exch} if pop NR NSR gt {W NR NSR sub 2 mul div 2 copy gt {exch} if pop} if /R exch def R PriorBestRadius ImprovementPointsMin dup 0 gt {add} {pop} ifelse gt R PriorBestRadius ImprovementProportionMin dup 0 gt {1 add mul} {pop} ifelse gt and R BestRadius gt and { /BestRadius R store BestParamsDict {pop BestParamsDict exch undef} forall BestParamsDict /PackingDescriptor dup load put BestParamsDict /BaseStyle dup load put BestParamsDict /AboveBelow //false put BestParamsDict /NumRows NC put BestParamsDict /NumCols NR put BestParamsDict /NumInLongerCols NiLR put BestParamsDict /NumShorterCols NSR put } if % R PriorBestRadius ... gt ... } {pop} ifelse % any solutions to quadratic } if % NR 2 mod 1 eq } for % NR exit } if % /DiamondsAndRectangular /RectangularAlternateSplitNudge BaseStyle eq { //DeBugLevel 50 le {( ProcessOnePackingType, /RectangularAlternateSplitNudge) OutputToLog} if RowsNumMin 1 RowsNumMax { /NR exch def /NC NG NR div ceiling cvi def NR 2 ge NC 2 ge and {[ { /NudgeRows //true def /c 4 H H mul mul NR 1 sub W mul dup mul add def /b NR 1 sub dup mul NC mul W mul 4 H mul add -4 mul def /a NR 1 sub NC mul dup mul NR 2 sub NR mul 4 mul sub 4 mul def } ProhibitHorizontalNudging {pop} if { /NudgeRows //false def /c 4 W W mul mul NC 1 sub H mul dup mul add def /b NC 1 sub dup mul NR mul H mul 4 W mul add -4 mul def /a NC 1 sub NR mul dup mul NC 2 sub NC mul 4 mul sub 4 mul def } ProhibitVerticalNudging {pop} if ]} {[]} ifelse % at least two rows and columns { exec [ c b a ] 0 //true H W lt {H} {W} ifelse 2 div //false //PrinterEpsilon PolynomialRoots { /R exch def NudgeRows {NR 1 add R mul H //PrinterEpsilon add lt NC 2 mul R mul W //PrinterEpsilon add lt NC 1 add 2 mul R mul W //PrinterEpsilon sub gt and and} {NC 1 add R mul W //PrinterEpsilon add lt NR 2 mul R mul H //PrinterEpsilon add lt NR 1 add 2 mul R mul H //PrinterEpsilon sub gt and and} ifelse % NudgeRows { R PriorBestRadius ImprovementPointsMin dup 0 gt {add} {pop} ifelse gt R PriorBestRadius ImprovementProportionMin dup 0 gt {1 add mul} {pop} ifelse gt and R BestRadius gt and { mark (RectangularAlternateSplitNudge improves radius by ) R PriorBestRadius sub dup (pt = ) exch 72 div dup (" = ) exch 25.4 mul (mm ) PriorBestRadius 0 gt {(= ) R PriorBestRadius div 1 sub 100 mul (% )} if (to ) R (pt from ) PriorBestRadius (pt on SheetNum=) SheetNum (.) ConcatenateToMark OutputToLog /BestRadius R store BestParamsDict {pop BestParamsDict exch undef} forall BestParamsDict /PackingDescriptor dup load put BestParamsDict /BaseStyle dup load put BestParamsDict /NumRows NR put BestParamsDict /NumCols NC put BestParamsDict /NudgeRows NudgeRows put } if % R PriorBestRadius ... gt ... } if % valid solution } forall % solutions to PolynomialRoots } forall % Nudge rows or columns } for % NR exit } if % /RectangularAlternateSplitNudge /RectangularAlternateNudge BaseStyle eq { //DeBugLevel 50 le {( ProcessOnePackingType, /RectangularAlternateNudge) OutputToLog} if % Not entirely happy with this code. If there isn't a solution to the quadratic, there should still be something sensible to do. But what? Answers to the author, www.jdawiseman.com/author.html RowsNumMin 1 RowsNumMax { /NR exch def /NC NG NR div ceiling cvi def [ { /NudgeRows //true def H NR 1 sub //Sqrt3 mul 2 add div W NC 2 mul div % R may not exceed lesser of these /a NR 1 sub NC mul dup mul NR 2 sub NR mul sub 4 mul def /b NR 1 sub dup mul NC mul W mul H add -4 mul def /c NR 1 sub W mul dup mul H dup mul add def } ProhibitHorizontalNudging {pop} if { /NudgeRows //false def W NC 1 sub //Sqrt3 mul 2 add div H NR 2 mul div % R may not exceed lesser of these /a NC 1 sub NR mul dup mul NC 2 sub NC mul sub 4 mul def /b NC 1 sub dup mul NR mul H mul W add -4 mul def /c NC 1 sub H mul dup mul W dup mul add def } ProhibitVerticalNudging {pop} if ] { exec [ c b a ] 0 //true H W lt {H} {W} ifelse 2 div //false //PrinterEpsilon PolynomialRoots {2 copy gt {exch} if pop} forall 2 copy gt {exch} if pop /R exch def R PriorBestRadius ImprovementPointsMin dup 0 gt {add} {pop} ifelse gt R PriorBestRadius ImprovementProportionMin dup 0 gt {1 add mul} {pop} ifelse gt and R BestRadius gt and { mark (RectangularAlternateNudge improves radius by ) R PriorBestRadius sub dup (pt = ) exch 72 div dup (" = ) exch 25.4 mul (mm ) PriorBestRadius 0 gt {(= ) R PriorBestRadius div 1 sub 100 mul (% )} if (to ) R (pt from ) PriorBestRadius (pt on SheetNum=) SheetNum (.) ConcatenateToMark OutputToLog /BestRadius R store BestParamsDict {pop BestParamsDict exch undef} forall BestParamsDict /PackingDescriptor dup load put BestParamsDict /BaseStyle dup load put BestParamsDict /NumRows NR put BestParamsDict /NumCols NC put BestParamsDict /NudgeRows NudgeRows put } if % R PriorBestRadius ... gt ... } forall % Nudge rows or columns } for % NR exit } if % /RectangularAlternateNudge /Array BaseStyle eq { //DeBugLevel 50 le {( ProcessOnePackingType, /Array) OutputToLog} if PackingDescriptor length PositionsStart sub NG ge PositionsStart 1 PackingDescriptor length 1 sub {PackingDescriptor exch GetEU dup type /arraytype eq {length 1 le {pop //false exit} if} {pop pop //false exit} ifelse} for { /MinXX //Infinity def /MaxXX //InfinityNeg def /MinYY //Infinity def /MaxYY //InfinityNeg def PositionsStart 1 PackingDescriptor length 1 sub { PackingDescriptor exch GetEU dup 0 GetEU /XX exch def 1 GetEU /YY exch def MinXX XX gt {/MinXX XX def} if MaxXX XX lt {/MaxXX XX def} if MinYY YY gt {/MinYY YY def} if MaxYY YY lt {/MaxYY YY def} if } for % PackingDescriptor /R W H 2 copy gt {exch} if pop 2 div def PositionsStart 1 add 1 PackingDescriptor length 1 sub { /i exch def /XXi PackingDescriptor i GetEU 0 GetEU def /YYi PackingDescriptor i GetEU 1 GetEU def PositionsStart 1 i 1 sub { /j exch def /XXj PackingDescriptor j GetEU 0 GetEU def /YYj PackingDescriptor j GetEU 1 GetEU def XXi XXj eq YYi YYj eq and { mark (Warning: ProcessOnePackingType: PackingStyles contains an array that contains two effectively identical sub-arrays, numbers ) i ( and ) j (. Allowing overlap, which is likely to be messy.) ConcatenateToMark OutputToLog }{ MinXX MaxXX ge { MinYY MaxYY ge {} % PackingDescriptor of zero length, or all the same { YYi YYj sub abs dup 0 eq {pop} {2 div dup R ge {pop} {/R exch def} ifelse} ifelse } ifelse % MinYY MaxYY ge }{ MinYY MaxYY ge { XXi XXj sub abs dup 0 eq {pop} {2 div dup R ge {pop} {/R exch def} ifelse} ifelse }{ /DiffX2 XXi XXj sub MaxXX MinXX sub div dup mul def /DiffY2 YYi YYj sub MaxYY MinYY sub div dup mul def /a DiffX2 DiffY2 add 1 sub 4 mul def /b W DiffX2 mul H DiffY2 mul add -4 mul def /c W W mul DiffX2 mul H H mul DiffY2 mul add def [ c b a ] 0 //true H W lt {H} {W} ifelse 2 div //false //PrinterEpsilon PolynomialRoots dup length [ {pop 0} {0 get} {Min (Warning: ProcessOnePackingType, arraytype, two seemingly good solutions.) OutputToLog} ] exch get exec dup R ge {pop} {/R exch def} ifelse } ifelse % MinYY MaxYY ge } ifelse % MinXX MaxXX ge } ifelse % XXi XXj eq YYi YYj eq and } for % j } for % i R PriorBestRadius ImprovementPointsMin dup 0 gt {add} {pop} ifelse gt R PriorBestRadius ImprovementProportionMin dup 0 gt {1 add mul} {pop} ifelse gt and R BestRadius gt and { /BestRadius R store BestParamsDict {pop BestParamsDict exch undef} forall BestParamsDict /PackingDescriptor dup load put BestParamsDict /BaseStyle /Array put BestParamsDict /PositionsStart dup load put BestParamsDict /PositionsEnd dup load put BestParamsDict /MinXX dup load put BestParamsDict /MaxXX dup load put BestParamsDict /MinYY dup load put BestParamsDict /MaxYY dup load put } if % R PriorBestRadius ... gt ... } if % ... NG ge ... exit % 1 {...} repeat } if % /Array } repeat end //DeBugLevel 50 le {(-ProcessOnePackingType) OutputToLog} if } bind def % /ProcessOnePackingType % LeftX BottomY Width Height NumGlasses MaxRadius Echo CirclePacking [[x1 y1] ...] Radius PackingDescriptor NamePlacementTopX NamePlacementBottomX % This code has grown over the years from 2001, and has a lack of internal consistency. E.g., in some patters RowNum increases from top to bottom; in others from bottom to top. /CirclePacking { //DeBugLevel 100 le {(+CirclePacking) OutputToLog} if 77 dict begin /Echo exch def /MaxRadius exch def /NG exch def /H exch def /W exch def /Y exch def /X exch def /BestRadius 0 def /BestParamsDict 8 dict def NG 0 gt {PackingStyles {ProcessOnePackingType} forall} if % If PackingStyles effectively empty then try some sensible arrangements. BestRadius 0 le { mark (Warning: ProcessOnePackingType re-invoked with standard-ish layouts, because no valid layouts in PackingStyles on SheetNum=) SheetNum (.) ConcatenateToMark OutputToLog NG 1 gt { [ /RectangularDislocation /Diamonds /DiamondsAndRectangular [/Bespoke5 /OnlyIfOrientation /Landscape] [/Bespoke7 /OnlyIfOrientation /Landscape] [/DiamondsPlus /ImprovementPointsMin 2] ] {ProcessOnePackingType} forall } {/TopRow ProcessOnePackingType} ifelse % NG 1 gt } if % BestRadius 0 le /R BestRadius MaxRadius 2 copy gt {exch} if pop def /BaseStyle BestParamsDict 1 index get def /PackingDescriptor BestParamsDict 1 index get def /Mirror //false def /ShoveLeft //false def /ShoveRight //false def /CentralGlasses 0 def /RectColsToLeftOrRowsBelow {BestParamsDict /AboveBelow get {NR NSR} {NC NSC} ifelse 2 mul 1 add sub dup 2 mod 0 eq {2 idiv} {pop 0} ifelse} def % Middle if possible, otherwise 0 /TempleExtraColsToLeftOrRowsBelow {BestParamsDict /N get dup 2 mod 0 eq {2 idiv} {pop 0} ifelse} def % Middle if possible, otherwise 0 /HorizontalAlignment /Centre def % Only in /SquareGrid /VerticalAlignment /Justify def % In /SquareGrid, /Sides, /LeftSide, /RightSide PackingDescriptor type /arraytype eq { /i 1 def { i PackingDescriptor length ge {exit} if PackingDescriptor i GetEU 1 { dup /Mirror eq {pop /Mirror //true store /i i 1 add store exit} if dup /ShoveLeft eq {pop /ShoveLeft //true store /i i 1 add store exit} if dup /ShoveRight eq {pop /ShoveRight //true store /i i 1 add store exit} if dup /CentralGlasses eq {pop /CentralGlasses PackingDescriptor i 1 add GetEU store /i i 2 add store exit} if dup /VerticalAlignment eq {pop /VerticalAlignment PackingDescriptor i 1 add GetEU store /i i 2 add store exit} if % Discussion: http://www.theportforum.com/viewtopic.php?t=175&p=79314#p79314 dup /HorizontalAlignment eq {pop /HorizontalAlignment PackingDescriptor i 1 add GetEU store /i i 2 add store exit} if dup /RectColsToLeftOrRowsBelow eq {pop /RectColsToLeftOrRowsBelow PackingDescriptor i 1 add GetEU store /i i 2 add store exit} if dup /PackingNestingColumnMajor eq {pop /PackingNestingColumnMajor PackingDescriptor i 1 add GetEU def /i i 2 add store exit} if dup /PackingDirectionTopToBottom eq {pop /PackingDirectionTopToBottom PackingDescriptor i 1 add GetEU def /i i 2 add store exit} if % Discussion: http://www.theportforum.com/viewtopic.php?t=175&p=73641#p73641 dup /PackingDirectionLeftToRight eq {pop /PackingDirectionLeftToRight PackingDescriptor i 1 add GetEU def /i i 2 add store exit} if dup /TempleExtraColsToLeftOrRowsBelow eq {pop /TempleExtraColsToLeftOrRowsBelow PackingDescriptor i 1 add GetEU store /i i 2 add store exit} if dup /Positions eq {pop /i PackingDescriptor length store exit} if dup /ProhibitVerticalNudging eq {pop /i i 1 add store exit} if dup /ProhibitHorizontalNudging eq {pop /i i 1 add store exit} if dup /SuppressOrnamentsLeft eq {pop /i i 1 add store exit} if dup /SuppressOrnamentsRight eq {pop /i i 1 add store exit} if dup /SuppressOrnamentsCentre eq {pop /i i 1 add store exit} if dup /RowsNumMin eq {pop /i i 2 add store exit} if dup /RowsNumMax eq {pop /i i 2 add store exit} if dup /GlassesNumMin eq {pop /i i 2 add store exit} if dup /GlassesNumMax eq {pop /i i 2 add store exit} if dup /OnlyIfOrientation eq {pop /i i 2 add store exit} if dup /OnlyIfSheetNumMin eq {pop /i i 2 add store exit} if dup /OnlyIfSheetNumMax eq {pop /i i 2 add store exit} if dup /ImprovementPointsMin eq {pop /i i 2 add store exit} if dup /ImprovementProportionMin eq {pop /i i 2 add store exit} if mark exch (Warning: an item of PackingStyles contains the non-recognised sub-parameter ) exch 256 string cvs ConcatenateToMark OutputToLog /i i 1 add store } repeat % 1 } loop } if % PackingDescriptor type /arraytype eq ShoveLeft ShoveRight and {mark (Error: CirclePacking, chosen BaseStyle /) BaseStyle ( has both /ShoveLeft and /ShoveRight. Continuing regardless.) ConcatenateToMark OutputToLog} if NG 0 eq {/NamePlacementBottomX W 2 div X add dup /NamePlacementTopX exch def def} if /AreaText { ( Of non-margin area ) R dup mul //Pi mul SheetLengths SheetNum get mul PageWidth MgnL MgnR add sub PageHeight MgnB MgnT add sub mul div 100 mul dup exch (\% within circles = ) exch 2 mul //Sqrt3 mul //Pi div (\% of infinite-plane exact-hexagonal maximum.) R 43.2 360 mul 127 div le { (\nWarning! Radius~=) R 1 FormatDecimalPlaces (pt~=) R 127 mul 360 div 1 FormatDecimalPlaces (mm~=) R 72 div 2 FormatDecimalPlaces (" is ) R 36 360 mul 127 div lt { R 30 360 mul 127 div lt {(less than the 30mm~=85pt radius of an INAO/ISO3591 tasting glass.)} {(a tight fit for the 30mm~=85pt radius of an INAO/ISO3591 tasting glass, and too small for the 36mm~=102pt radius of the foot of an IVDP glass.)} ifelse % Radius < 30mm } {(a tight fit for the 36mm~=102pt radius of the foot of an IVDP glass.)} ifelse % Radius < 36mm } if % Radius <= 43.2mm } def % /AreaText % Compute locations of glass centres {1 { % Debugging code for use within CirclePacking, with the array of positions on the top of the stack: % DeBugLevel 50 le {( CirclePacking: positions de-bug:) OutputToLog dup {mark exch aload pop exch exch (\t) exch ConcatenateToMark OutputToLog} forall} if /SquareGrid BaseStyle eq /TopRow BaseStyle eq or /MiddleRow BaseStyle eq or /BottomRow BaseStyle eq or { //DeBugLevel 50 le {( CirclePacking, /SquareGrid | /TopRow BaseStyle | /MiddleRow | /BottomRow) OutputToLog} if /NR BestParamsDict /NumRows get def /NC BestParamsDict /NumCols get def Echo {mark (SheetNum=) SheetNum (, with ) NG ( glasses: best BaseStyle, with radius ) R (, is /) BaseStyle ( with ) NR ( row) NR 1 ne {(s)} if ( and ) NC ( column) NC 1 ne {(s)} if (.) AreaText ConcatenateToMark OutputToLog} if /NamePlacementTopX W 4 div X add def /NamePlacementBottomX NamePlacementTopX def % Relevant if only one column [ PackingNestingColumnMajor {1 NC sub 1 NC 1 sub PackingDirectionLeftToRight not {3 1 roll neg exch} if} {NR 1 sub -2 1 NR sub PackingDirectionTopToBottom not {3 1 roll neg exch} if} ifelse % PackingNestingColumnMajor { PackingNestingColumnMajor {/ColNum exch def NR 1 sub -2 1 NR sub PackingDirectionTopToBottom not {3 1 roll neg exch} if} {/RowNum exch def 1 NC sub 1 NC 1 sub PackingDirectionLeftToRight not {3 1 roll neg exch} if} ifelse % PackingNestingColumnMajor { PackingNestingColumnMajor {/RowNum} {/ColNum} ifelse exch def ColNum NG RowNum NR 1 sub sub -2 div NC mul sub 1 sub 2 mul 1 NC sub add le { 1 { ShoveLeft /Left HorizontalAlignment eq or { NC ColNum add R mul exit} if ShoveRight /Right HorizontalAlignment eq or {W NC ColNum sub R mul sub exit} if HorizontalAlignment /Justify eq {W R 2 mul sub NC 1 le {pop 0} {ColNum mul NC 1 sub 2 mul div} ifelse W 2 div add exit} % Justify {ColNum R mul W 2 div add exit} % /Centre, being the default ifelse % HorizontalAlignment /Justify eq } repeat % 1 X add /XXX exch def 1 { BaseStyle /SquareGrid eq { VerticalAlignment /Top eq {RowNum NR sub R mul H add exit} if VerticalAlignment /Middle eq {RowNum R mul H 2 div add exit} if VerticalAlignment /Bottom eq {RowNum NR add R mul exit} if NR 1 le {H 2 div exit} if VerticalAlignment /Justify eq {H R 2 mul sub NR 1 le {pop 0} {RowNum mul NR 1 sub 2 mul div} ifelse H 2 div add exit} if % Justify, being the default } if % BaseStyle /SquareGrid eq BaseStyle /BottomRow eq {R exit} if BaseStyle /MiddleRow eq {H 2 div exit} if H R sub % /TopRow } repeat % 1 Y add /YYY exch def ColNum NC add 2 mod 1 eq {[XXX YYY]} if % Appropriate modulo 2 ColNum NC 2 mod neg eq {/NamePlacementTopX XXX def /NamePlacementBottomX XXX def} if % ColNum NC 2 mod neg eq } if % Within row, even if shortened } for % NC or NR } for % NR or NC ] exit % 1 {...} repeat } if % /SquareGrid ... /TopRow ... /MiddleRow ... /BottomRow ... /Sides BaseStyle eq /LeftSide BaseStyle eq /RightSide BaseStyle eq or or { //DeBugLevel 50 le {( CirclePacking, /Sides) OutputToLog} if /NR BestParamsDict /NumRows get def /NC BestParamsDict /NumCols get def Echo {mark (SheetNum=) SheetNum (, with ) NG ( glasses: best BaseStyle, with radius ) R (, is /) BaseStyle ( with ) NR ( rows and, of course, ) NC ( column) NC 1 ne {(s)} if (.) AreaText ConcatenateToMark OutputToLog} if [ PackingNestingColumnMajor {0 1 NC 1 sub PackingDirectionLeftToRight not {3 1 roll neg exch} if} {NR 1 sub -1 0 PackingDirectionTopToBottom not {3 1 roll neg exch} if} ifelse % PackingNestingColumnMajor { PackingNestingColumnMajor {/ColNum exch def NR 1 sub -1 0 PackingDirectionTopToBottom not {3 1 roll neg exch} if} {/RowNum exch def 0 1 NC 1 sub PackingDirectionLeftToRight not {3 1 roll neg exch} if} ifelse % PackingNestingColumnMajor { PackingNestingColumnMajor {/RowNum} {/ColNum} ifelse exch def ColNum 0 eq RowNum 0 gt NG 2 mod 0 eq or or {[ /LeftSide BaseStyle eq {X R add} {/RightSide BaseStyle eq {X R sub W add} {ColNum 0 eq {ShoveRight {W R 3 mul sub} {R} ifelse} {ShoveLeft {R 3 mul} {W R sub} ifelse} ifelse X add} ifelse} ifelse 1 { VerticalAlignment /Top eq {H NR RowNum sub 2 mul 1 sub R mul sub exit} if VerticalAlignment /Middle eq {RowNum 2 mul 1 add NR sub R mul H 2 div add exit} if VerticalAlignment /Bottom eq {RowNum 2 mul 1 add R mul exit} if NR 1 le {H 2 div exit} if H R 2 mul sub RowNum mul NR 1 sub div R add exit % Justify, being the default } repeat % 1 Y add ]} if % Within row, even if shortened } for % NC or NR } for % NR or NC ] /LeftSide BaseStyle eq {R //SqrtHalf 1 add mul} {/RightSide BaseStyle eq {W R //SqrtHalf 1 add mul sub} {ShoveLeft {R 2 mul} {ShoveRight {W R 2 mul sub} {W 2 div} ifelse} ifelse} ifelse} ifelse X add dup /NamePlacementTopX exch def /NamePlacementBottomX exch def exit % 1 {...} repeat } if % /Sides ... /LeftSide ... /RightSide ... /RectangularDislocation BaseStyle eq { //DeBugLevel 50 le {( CirclePacking, /RectangularDislocation) OutputToLog} if /NR BestParamsDict /NumRows get def /NC BestParamsDict /NumCols get def Echo {mark (SheetNum=) SheetNum (, with ) NG ( glasses: best BaseStyle, with radius ) R (, is /RectangularDislocation with ) NR ( row) NR 1 ne {(s)} if ( and ) NC ( column) NC 1 ne {(s)} if (.) AreaText ConcatenateToMark OutputToLog} if [ NC NR mul NG eq { /Dist NR 1 gt {H R 2 mul sub NR 1 sub div} {H 2 div R sub} ifelse def /NamePlacementTopX /ColNum NC 1 sub dup 2 mod 0 eq {1 sub} if def ColNum W R sub mul NC 1 sub 2 mul ColNum sub R mul add NC 1 gt {NC 1 sub div} if 2 div X add def /NamePlacementBottomX NamePlacementTopX def ShoveLeft ShoveRight or {/ShoveStepX R def} if }{ /xx W R 2 mul sub NC 1 sub 2 mul div def /yy H R 2 mul sub def /a NR 2 sub dup mul 1 sub def /b -2 NR 2 sub mul yy mul def /c yy dup mul xx dup mul add def [ c b a ] 0 //false H W add //true //PrinterEpsilon PolynomialRoots dup length 0 eq {pop /Dist yy NR 1 sub div def (Warning: CirclePacking, RectangularDislocation: negative determinant.) OutputToLog} {Min /Dist exch def} ifelse ShoveLeft ShoveRight or NR 2 ge and {/ShoveStepX 4 R R mul mul H NR 2 sub Dist mul 2 R mul add sub dup mul sub dup 0 lt {pop 0} {sqrt} ifelse NC 2 ge {dup R lt {pop R} if} if def} if } ifelse % NC NR mul NG eq NC 1 eq {/NamePlacementTopX W 4 div X add def /NamePlacementBottomX NamePlacementTopX def} if PackingNestingColumnMajor {0 1 NC 1 sub 2 mul PackingDirectionLeftToRight not {3 1 roll neg exch} if} {NR 1 sub -1 0 PackingDirectionTopToBottom not {3 1 roll neg exch} if} ifelse % PackingNestingColumnMajor { PackingNestingColumnMajor {/ColNum exch def NR 1 sub -1 0 PackingDirectionTopToBottom not {3 1 roll neg exch} if} {/RowNum exch def 0 1 NC 1 sub 2 mul PackingDirectionLeftToRight not {3 1 roll neg exch} if} ifelse % PackingNestingColumnMajor { PackingNestingColumnMajor {/RowNum} {/ColNum} ifelse exch def /LongerRow Mirror {RowNum NR NG NR mod sub ge} {RowNum NG NR mod lt} ifelse NC NR mul NG eq or def /XX ShoveLeft {ColNum ShoveStepX mul R add} {ShoveRight {W R sub NC 1 sub 2 mul ColNum sub ShoveStepX mul sub} {NC 1 le {W 2 div} {ColNum W R sub mul NC 1 sub 2 mul ColNum sub R mul add NC 1 sub 2 mul div} ifelse} ifelse} ifelse X add def ColNum 2 mod 0 eq LongerRow eq {[ XX Mirror LongerRow ne {Y R add RowNum Dist mul add} {Y H add R sub NR 1 sub RowNum sub Dist mul sub} ifelse ]} { NC 1 sub dup 1 sub ColNum eq exch ColNum eq or { RowNum 0 eq {/NamePlacementBottomX XX def} if RowNum NR 1 sub eq {/NamePlacementTopX XX def} if } if % Middle(ish) } ifelse % ColNum 2 mod 0 eq LongerRow eq } for % ColNum or RowNum } for % RowNum or ColNum ] exit } if % /RectangularDislocation ... /Temple BaseStyle eq { //DeBugLevel 50 le {( CirclePacking, /Temple) OutputToLog} if /O BestParamsDict /O get def /N BestParamsDict /N get def O 0 eq {/L W /S H} {/L H /S W} ifelse def def Echo {mark (SheetNum=) SheetNum (, with ) NG ( glasses: best BaseStyle, with radius ) R (, is /Temple with ) N O 0 eq {( columns.)} {( rows.)} ifelse AreaText ConcatenateToMark OutputToLog} if [ % http://groups.google.com/g/comp.lang.postscript/c/5pJw5Gvf_YI % http://mathematica.stackexchange.com/questions/101954/looking-for-postscriptform-or-forthform-to-print-expressions-as-rpn-code % http://github.com/jdaw1/placemat/blob/main/Supporting_code/PackingStyles_formulae.nb L 8 R mul sub L mul 4 2 R mul 4 S mul add R mul S dup mul sub mul add L mul 16 R mul 2 R mul 4 S mul sub R mul S dup mul add mul add L mul 16 13 R mul 28 S mul sub R mul 23 S dup mul mul add R mul 8 S dup dup mul mul mul sub R mul S dup mul dup mul add mul add 9 L mul 72 R mul sub L mul 12 22 R mul 4 S mul sub R mul S dup mul add mul add L mul 48 R mul 10 R mul 4 S mul sub R mul S dup mul add mul sub L mul 16 37 R mul 44 S mul sub R mul 27 S dup mul mul add R mul 8 S dup dup mul mul mul sub R mul S dup mul dup mul add mul add mul % Coeff 0 -4 L R 2 mul sub mul 9 2 N mul 3 sub mul L mul 108 2 N mul 3 sub mul R mul sub L mul 12 78 N mul 107 sub R mul 4 3 N mul 7 sub mul S mul add R mul 3 N mul 7 sub S dup mul mul sub mul add L mul 96 R mul 18 N mul 17 sub R mul 4 3 N mul 7 sub mul S mul add R mul 3 N mul 7 sub S dup mul mul sub mul sub L mul 16 166 N mul 45 sub R mul 8 27 N add mul S mul sub R mul 6 19 N mul 15 sub mul S dup mul mul add R mul 8 7 N mul 9 sub mul S dup dup mul mul mul sub R mul 7 N mul 9 sub S dup mul dup mul mul add mul add L mul 64 R mul 94 N mul 57 sub R mul 8 19 N mul 15 sub mul S mul sub R mul 6 25 N mul 29 sub mul S dup mul mul add R mul 8 7 N mul 9 sub mul S dup dup mul mul mul sub R mul 7 N mul 9 sub S dup mul dup mul mul add mul sub L mul 64 158 N mul 87 sub R mul 4 95 N mul 51 sub mul S mul sub R mul 3 133 N mul 65 sub mul S dup mul mul add R mul 72 3 N mul 1 sub mul S dup dup mul mul mul sub R mul 67 N mul 9 sub S dup mul dup mul mul add R mul 12 N mul S dup dup mul dup mul mul mul sub R mul N S dup mul dup dup mul mul mul add mul add mul % Coeff 1 2 3 42 N mul 126 sub N mul 85 add mul L mul 36 42 N mul 126 sub N mul 85 add mul R mul sub L mul 4 45 38 R mul 4 S mul add R mul S dup mul sub mul N mul 210 23 R mul 4 S mul add R mul S dup mul sub mul sub N mul 3013 R mul 812 S mul add R mul 203 S dup mul mul sub add mul add L mul 32 R mul 45 10 R mul 4 S mul add R mul S dup mul sub mul N mul 210 5 R mul S sub mul R S add mul sub N mul 463 R mul 812 S mul add R mul 203 S dup mul mul sub add mul sub L mul 16 1146 N mul 1494 sub N mul 743 sub R mul 8 51 N mul 414 sub N mul 533 add mul S mul add R mul 6 39 N mul 6 sub N mul 127 sub mul S dup mul mul add R mul 8 21 N mul 54 sub N mul 19 add mul S dup dup mul mul mul sub R mul 21 N mul 54 sub N mul 19 add S dup mul dup mul mul add mul add L mul 64 R mul 3 118 N mul 106 sub N mul 185 sub mul R mul 8 39 N mul 6 sub N mul 127 sub mul S mul sub R mul 2 207 N mul 438 sub N mul 25 add mul S dup mul mul add R mul 8 21 N mul 54 sub N mul 19 add mul S dup dup mul mul mul sub R mul 21 N mul 54 sub N mul 19 add S dup mul dup mul mul add mul sub L mul 64 346 N mul 402 sub N mul 1021 sub R mul 12 57 N mul 74 sub N mul 209 sub mul S mul sub R mul 699 N mul 1086 sub N mul 2627 sub S dup mul mul add R mul 8 41 N mul 54 sub N mul 221 sub mul S dup dup mul mul mul sub R mul 81 N mul 54 sub N mul 701 sub S dup mul dup mul mul add R mul 12 N dup mul 12 sub mul S dup dup mul dup mul mul mul sub R mul N dup mul 12 sub S dup mul dup dup mul mul mul add mul add mul % Coeff 2 -4 L R 2 mul sub mul 9 2 N mul 3 sub mul 7 N mul 21 sub N mul 11 add mul L mul 72 2 N mul 3 sub mul 7 N mul 21 sub N mul 11 add mul R mul sub L mul 8 3 106 R mul 20 S mul add R mul 5 S dup mul mul sub mul N mul 21 61 R mul 20 S mul add R mul 5 S dup mul mul sub mul sub N mul 1483 R mul 812 S mul add R mul 203 S dup mul mul sub add N mul 99 5 R mul S sub mul R S add mul sub mul add L mul 32 R mul 3 22 R mul 20 S mul add R mul 5 S dup mul mul sub mul N mul 21 7 R mul 20 S mul add R mul 5 S dup mul mul sub mul sub N mul -47 R mul 812 S mul add R mul 203 S dup mul mul sub add N mul 99 R 4 S mul sub R mul S dup mul add mul add mul sub L mul 16 118 N mul 159 sub N mul 555 sub N mul 399 add R mul 8 13 N mul 3 sub N mul 127 sub N mul 75 add mul S mul sub R mul 2 69 N mul 219 sub N mul 25 add N mul 27 add mul S dup mul mul add R mul 8 7 N mul 27 sub N mul 19 add N mul 6 sub mul S dup dup mul mul mul sub R mul 7 N mul 27 sub N mul 19 add N mul 6 sub S dup mul dup mul mul add mul add mul % Coeff 3 630 N mul 3780 sub N mul 7650 add N mul 5940 sub N mul 1393 add L mul 8 630 N mul 3780 sub N mul 7650 add N mul 5940 sub N mul 1393 add mul R mul sub L mul 24 15 38 R mul 4 S mul add R mul S dup mul sub mul N mul 140 23 R mul 4 S mul add R mul S dup mul sub mul sub N mul 2 3013 R mul 812 S mul add R mul 203 S dup mul mul sub mul add N mul 396 11 R mul 4 S mul add R mul S dup mul sub mul sub N mul 1121 R mul 272 S mul add R mul 68 S dup mul mul sub add mul add L mul 32 R mul 45 10 R mul 4 S mul add R mul S dup mul sub mul N mul 420 5 R mul S sub mul R S add mul sub N mul 6 463 R mul 812 S mul add R mul 203 S dup mul mul sub mul add N mul 1188 R 4 S mul add R mul S dup mul sub mul sub N mul 577 R mul 816 S mul add R mul 204 S dup mul mul sub add mul sub L mul 16 382 R mul 136 S mul add R mul 78 S dup mul mul add R mul 56 S dup dup mul mul mul sub R mul 7 S dup mul dup mul mul add N mul 12 83 R mul 184 S mul add R mul 2 S dup mul mul add R mul 24 S dup dup mul mul mul sub R mul 3 S dup mul dup mul mul add mul sub N mul 2 743 R mul 4264 S mul sub R mul 762 S dup mul mul add R mul 152 S dup dup mul mul mul add R mul 19 S dup mul dup mul mul sub mul sub N mul 12 265 R mul 728 S mul sub R mul 150 S dup mul mul add R mul 16 S dup dup mul mul mul add R mul 2 S dup mul dup mul mul sub mul add N mul 2065 R mul 2976 S mul sub R mul 3048 S dup mul mul add R mul 1152 S dup dup mul mul mul sub R mul 144 S dup mul dup mul mul add add mul add % Coeff 4 -4 L R 2 mul sub mul 18 7 L mul 28 R mul sub L mul 2 10 R mul 4 S mul add R mul S dup mul sub mul add mul N mul 105 3 L mul R 2 mul sub S 2 mul sub mul 3 L mul R 10 mul sub S 2 mul add mul sub N mul 2 1275 L mul 5100 R mul sub L mul 4 463 R mul 812 S mul add R mul 203 S dup mul mul sub mul add mul add N mul 594 5 L mul 20 R mul sub L mul 4 R 4 S mul add R mul S dup mul sub mul add mul sub N mul 1393 L mul 5572 R mul sub L mul 4 577 R mul 816 S mul add R mul 204 S dup mul mul sub mul add add N mul 6 31 L mul 124 R mul sub L mul 4 79 R mul 48 S mul sub R mul 12 S dup mul mul add mul add mul sub mul % Coeff 5 2 6 21 L mul 84 R mul sub L mul 2 38 R mul 4 S mul add R mul S dup mul sub mul add mul N mul 42 27 L mul 108 R mul sub L mul 4 23 R mul 4 S mul add R mul S dup mul sub mul add mul sub N mul 3825 L mul 15300 R mul sub L mul 4 3013 R mul 812 S mul add R mul 203 S dup mul mul sub mul add add N mul 396 15 L mul 60 R mul sub L mul 4 11 R mul 4 S mul add R mul S dup mul sub mul add mul sub N mul 3 1393 L mul 5572 R mul sub L mul 4 1121 R mul 272 S mul add R mul 68 S dup mul mul sub mul add mul add N mul 36 31 L mul 124 R mul sub L mul 4 47 R mul 16 S mul sub R mul 4 S dup mul mul add mul add mul sub N mul 72 L R 2 mul sub dup mul mul add mul % Coeff 6 -4 N 3 sub mul N mul 2 N mul 3 sub mul 3 N mul 9 sub N mul 2 add mul 3 N mul 9 sub N mul 4 add mul L R 2 mul sub mul % Coeff 7 N 3 sub dup mul N dup mul mul 3 N mul 9 sub N mul 4 add dup mul mul % Coeff 8 ] R 1.999 mul //PrinterEpsilon sub //false S 2 div R sub dup mul R R mul add sqrt L R 2 mul sub N 1 sub div 2 copy lt {exch} if pop //PrinterEpsilon add //false //PrinterEpsilon PolynomialRoots % In this section (and in other part of ifelse) variable naming and comments as if O=0, so as if L=W dup length 0 gt { Min R 2 mul 2 copy lt {exch} if pop /Dist exch def /Row0X L N 1 sub Dist mul sub 2 div def /Row1Y S R sub Dist dup mul Row0X R sub dup mul sub dup 0 lt {pop 0} if sqrt sub def /Row2Y Row1Y Dist dup mul L 2 div N 2 sub 2 div Dist mul R add sub dup mul sub dup 0 lt {pop 0} if sqrt sub def /Row3X Dist dup mul Row1Y R sub dup mul sub dup 0 lt {pop 0} if sqrt R add def /OcticOK Row2Y R Row1Y add 2 div gt Row3X Row0X //PrinterEpsilon add le and def } {pop /OcticOK //false def} ifelse OcticOK not { {/Row0X mark Dist 2 div R add L 2 div N 1 sub 2 div Dist mul sub MinToMark def} % For exec'ing inside the next ifelse R N 1 add 2 mul mul L le {/Dist L R 2 mul sub N div def exec /Row3X Row0X def /Row1Y S 2 div def /Row2Y Row1Y def} {/Dist L R 2 mul sub N 2 sub //Sqrt3 add div def exec /Row3X R def /Row1Y 4 2 //Sqrt3 mul sub R mul S 2 mul sub R mul S S mul add 2 S mul 4 R mul sub div def /Row2Y Row1Y R add 2 div def} ifelse % R N 1 add 2 mul mul L le } if % OcticOK not [ /CentralCircleCol TempleExtraColsToLeftOrRowsBelow cvi dup 1 lt {pop 1} if dup N 1 sub gt {pop N 1 sub} if def PackingNestingColumnMajor O 0 eq eq {0 1 N O 0 eq {PackingDirectionLeftToRight not} {PackingDirectionTopToBottom} ifelse {3 1 roll neg exch} if} {0 1 3 O 0 eq {PackingDirectionTopToBottom not} {PackingDirectionLeftToRight} ifelse Mirror ne {3 1 roll neg exch} if} ifelse % PackingNestingColumnMajor O 0 eq eq { PackingNestingColumnMajor O 0 eq eq {/ColNum} {/RowNum} ifelse exch def PackingNestingColumnMajor O 0 eq eq {0 1 3 O 0 eq {PackingDirectionTopToBottom not} {PackingDirectionLeftToRight} ifelse Mirror ne {3 1 roll neg exch} if} {0 1 N O 0 eq {PackingDirectionLeftToRight not} {PackingDirectionTopToBottom} ifelse {3 1 roll neg exch} if} ifelse % PackingNestingColumnMajor O 0 eq eq { PackingNestingColumnMajor O 0 eq eq {/RowNum} {/ColNum} ifelse exch def [ ColNum CentralCircleCol eq RowNum 2 eq and {L 2 div N 2 div ColNum sub Dist mul sub Row2Y Mirror {S exch sub} if} if ColNum CentralCircleCol lt { RowNum 0 eq {Dist ColNum mul Row0X add Mirror {R } {S R sub} ifelse} if RowNum 1 eq {Dist ColNum mul R add Mirror {S Row1Y sub} {Row1Y } ifelse} if RowNum 3 eq {Dist ColNum mul Row3X add Mirror {S R sub} {R } ifelse} if } if % ColNum CentralCircleCol lt ColNum CentralCircleCol gt { RowNum 0 eq {L Row0X sub ColNum N sub Dist mul add Mirror {R } {S R sub} ifelse} if RowNum 1 eq {L R sub ColNum N sub Dist mul add Mirror {S Row1Y sub} {Row1Y } ifelse} if RowNum 3 eq {L Row3X sub ColNum N sub Dist mul add Mirror {S R sub} {R } ifelse} if } if % ColNum CentralCircleCol gt dup mark ne {O 0 eq {exch} if X add exch Y add} if ] dup length 0 eq {pop} if } for % RowNum or ColNum } for % ColNum or RowNum L 2 div CentralCircleCol N 2 div sub Dist mul add X add dup /NamePlacementBottomX exch def /NamePlacementTopX exch def ] exit } if % /Temple ... /Diamonds BaseStyle eq { //DeBugLevel 50 le {( CirclePacking, /Diamonds) OutputToLog} if /NR BestParamsDict /NumRows get def /NC BestParamsDict /NumCols get def /Capacity NR NC mul 1 add 2 idiv def /NamePlacementTopX W 4 div X add def /NamePlacementBottomX W 4 div X add def ShoveLeft ShoveRight or {/ShoveStepX NR 1 le {R} {4 R R mul mul H R 2 mul sub NR 1 sub div dup mul sub dup 0 lt {pop 0} {sqrt} ifelse NC 3 ge {dup R lt {pop R} if} if} ifelse def} if Echo { mark (SheetNum=) SheetNum (, with ) NG ( glasses: best BaseStyle, with radius ) R (, is /Diamonds with ) NR ( row) NR 1 ne {(s)} if ( and ) NC ( column) NC 1 ne {(s)} if (; max. capacity of this arrangement being ) Capacity (.) AreaText ConcatenateToMark OutputToLog } if % Echo [ PackingNestingColumnMajor {0 1 NC 1 sub PackingDirectionLeftToRight not {3 1 roll neg exch} if} {NR 1 sub -1 0 PackingDirectionTopToBottom not {3 1 roll neg exch} if} ifelse % PackingNestingColumnMajor { PackingNestingColumnMajor {/ColNum exch def NR 1 sub -1 0 PackingDirectionTopToBottom not {3 1 roll neg exch} if} {/RowNum exch def 0 1 NC 1 sub PackingDirectionLeftToRight not {3 1 roll neg exch} if} ifelse % PackingNestingColumnMajor { PackingNestingColumnMajor {/RowNum} {/ColNum} ifelse exch def /XX ShoveLeft {ColNum ShoveStepX mul R add} {ShoveRight {W R sub NC 1 sub ColNum sub ShoveStepX mul sub} {NC 1 le {W 2 div} {W R 2 mul sub ColNum mul NC 1 sub div R add} ifelse} ifelse} ifelse X add def ColNum RowNum add 2 mod NR NC mul 2 mod 0 eq {0 eq Mirror ne NR 2 eq NC 3 eq and {not} if} {1 eq NG Capacity eq {not} if} ifelse % Same (or opposite if Mirror) modulo as bottom-left corner { ColNum NC 1 sub lt {//true} {RowNum Capacity NC NR mul 2 mod sub NG sub 2 mul ge} ifelse {[ XX NR 1 le {H 2 div} {H R 2 mul sub RowNum mul NR 1 sub div R add} ifelse Y add ]} if % Not off end of row }{ NC 2 idiv dup 1 sub ColNum eq exch ColNum eq or { RowNum 0 eq {/NamePlacementBottomX XX def} if RowNum NR 1 sub eq {/NamePlacementTopX XX def} if } if % Middle(ish) } ifelse % Correct modulo 2 } for % ColNum or RowNum } for % RowNum or ColNum ] exit % 1 {...} repeat } if % /Diamonds ... /PostsAndLintel BaseStyle eq { //DeBugLevel 50 le {( CirclePacking, /PostsAndLintel) OutputToLog} if /NR BestParamsDict /NumRows get def /CentralGlasses BestParamsDict /CentralGlasses get def /NGaE NG CentralGlasses sub def % Num Glasses at Edge Echo { mark NGaE ( glasses: best BaseStyle, with radius ) R (, is /PostsAndLintel with ) NR ( row) NR 1 ne {(s)} if ( and ) CentralGlasses ( extra circle) CentralGlasses 1 ne {(s)} if (.) AreaText ConcatenateToMark OutputToLog } if % Echo NGaE 1 eq { W 4 div X add dup /NamePlacementBottomX exch def /NamePlacementTopX exch def [ [ W 2 div X add Mirror {R} {H R sub} ifelse Y add ] ] exit % 1 {...} repeat } if % NGaE 1 eq % Solve for distance between adjacent centres NR 1 eq { /Dist NGaE 1 gt {W R 2 mul NGaE mul sub NGaE 1 sub div R 2 mul add} {R 2 mul} ifelse def }{ /a NGaE 1 sub dup mul NGaE 1 add NR 1 sub mul 4 mul sub NR 1 sub dup mul 8 mul add def /b 4 H mul 2 NGaE mul R mul add 4 NR 1 sub mul H R sub mul sub NGaE 1 add NR 2 mul sub W mul sub 10 R mul sub 2 mul def /c H R 2 mul sub dup mul 4 mul W R 2 mul sub dup mul add def [ c b a ] 0 //false H W add //true //PrinterEpsilon PolynomialRoots /Dist exch dup length 0 eq {pop 0} {Min} ifelse def } ifelse % NR 1 eq NR 2 sub Dist mul R 2 mul add H gt NGaE NR 2 mul sub 1 add Dist mul R 2 mul add W gt or { /Dist 0 def } if [ CentralGlasses 1 eq { [W 2 div X add Mirror {H R sub} {R} ifelse Y add] } if CentralGlasses 2 ge { [W 2 div R add X add Mirror {H R sub} {R} ifelse Y add] [W 2 div R sub X add Mirror {H R sub} {R} ifelse Y add] PackingDirectionLeftToRight {exch} if} if CentralGlasses 3 ge { [W 2 div X add R //Sqrt3 1 add mul Mirror {H exch sub} if Y add] exch } if Dist 0 eq { /DistV NR 1 gt {H NR 2 mul R mul sub NR 1 sub div 2 R mul add} {W 4 div} ifelse def /HalfDistH NGaE NR 1 sub 2 mul sub dup 1 gt {dup R mul W 2 div exch sub exch 1 sub div R add} {pop W 4 div} ifelse def PackingDirectionLeftToRight { 0 1 NR 2 sub {[ exch DistV mul R add Mirror {H exch sub} if Y add X R add exch]} for % up left side NGaE NR 1 sub 2 mul sub 1 sub neg 2 1 index neg {[ exch HalfDistH mul W 2 div add X add Mirror {R} {H R sub} ifelse Y add ]} for % across top NR 2 sub -1 0 {[ exch DistV mul R add Mirror {H exch sub} if Y add W X add R sub exch]} for % down right side }{ 0 1 NR 2 sub {[ exch DistV mul R add Mirror {H exch sub} if Y add W X add R sub exch]} for % up right side NGaE NR 1 sub 2 mul sub 1 sub -2 1 index neg {[ exch HalfDistH mul W 2 div add X add Mirror {R} {H R sub} ifelse Y add ]} for % across top NR 2 sub -1 0 {[ exch DistV mul R add Mirror {H exch sub} if Y add X R add exch]} for % down left side } ifelse % PackingDirectionLeftToRight }{ PackingDirectionLeftToRight { 0 1 NR 2 sub {Dist mul R add Mirror {H exch sub} if Y add [ exch X R add exch ]} for % up left side NR 2 mul 1 sub NGaE sub 2 1 index neg {[ exch 2 div Dist mul W 2 div add X add Mirror {R} {H R sub} ifelse Y add ]} for % across top NR 2 sub -1 0 {Dist mul R add Mirror {H exch sub} if Y add [ exch W X add R sub exch ]} for % down right side }{ 0 1 NR 2 sub {Dist mul R add Mirror {H exch sub} if Y add [ exch W X add R sub exch ]} for % up right side NGaE 1 NR 1 sub 2 mul add sub -2 1 index neg {[ exch 2 div Dist mul W 2 div add X add Mirror {R} {H R sub} ifelse Y add ]} for % across top NR 2 sub -1 0 {Dist mul R add Mirror {H exch sub} if Y add [ exch X R add exch ]} for % down left side } ifelse % PackingDirectionLeftToRight } ifelse % Dist 0 eq ] /NamePlacementTopX /NamePlacementBottomX Mirror {exch} if [ W 2 div W 4 div R 2 div add W 4 div dup ] CentralGlasses get X add def W 2 div NGaE 2 mod 1 eq {Dist 0 eq {HalfDistH} {Dist 2 div} ifelse sub} if X add def exit % 1 {...} repeat } if % /PostsAndLintel ... /Arch BaseStyle eq { //DeBugLevel 50 le {( CirclePacking, /Arch) OutputToLog} if /PseudoAngles BestParamsDict 1 index get def /NGiA NG CentralGlasses sub def % Number Glasses in Arch 12 dict begin /EllipseSemiX W 2 div R sub def /PositionsX [ PseudoAngles {sin EllipseSemiX mul} forall ] def /EllipseSemiY H R 2 mul sub NGiA 2 mod 0 eq {1 PositionsX 0 get EllipseSemiX div dup mul sub sqrt div} if def /PositionsY [ PseudoAngles {cos EllipseSemiY mul R add} forall ] def NGiA 2 mod 1 eq {PositionsX 0 0 put} if % Extra precision PositionsY 0 H R sub put % Extra precision PositionsX PositionsX length 1 sub W 2 div R sub put % Extra precision PositionsY PositionsY length 1 sub R put % Extra precision NGiA 2 add dup mul -1 0 { 0 le {/UpperR R def (Error: CirclePacking, Arch, extremely slow convergence. Please submit an issue to http://github.com/jdaw1/placemat/issues/) OutputToLog exit} if /DistSquaredMax 0 def /DistSquaredMin H W add dup mul def % Test for exit of jiggling of PositionsX & PositionsY NGiA 1 add 2 mod neg 1 PositionsX length 2 sub { /i exch def i -1 eq {PositionsX 0 get 2 mul dup mul} {PositionsX i get PositionsX i 1 add get sub dup mul PositionsY i get PositionsY i 1 add get sub dup mul add} ifelse dup dup dup DistSquaredMin lt {/DistSquaredMin exch def} {pop} ifelse DistSquaredMax gt {/DistSquaredMax exch def} {pop} ifelse } for % i DistSquaredMax DistSquaredMin sub dup mul //PrinterEpsilon 2 mul dup mul DistSquaredMin mul le DistSquaredMax DistSquaredMin div //Epsilon 2 mul 1 add lt DistSquaredMax sqrt DistSquaredMin sqrt sub //PrinterEpsilon le or or {exit} if % Done position optimisation % Update PositionsX and PositionsY 0 1 PositionsX length 2 sub { /i exch def i 0 eq { NGiA 2 mod 0 eq { H R sub PositionsY 1 get sub dup mul 3 mul PositionsX 1 get dup mul 4 mul add sqrt PositionsX 1 get sub 3 div W 2 div R sub 2 copy gt {exch} if pop PositionsX 0 3 -1 roll put /EllipseSemiY H R 2 mul sub 1 PositionsX 0 get EllipseSemiX div dup mul sub dup 0 gt {sqrt div} {pop pop //PrinterEpsilon} ifelse store } if % NGiA 2 mod 0 eq }{ /X1 PositionsX i 1 sub get def /X3 PositionsX i 1 add get def /Y1 PositionsY i 1 sub get def /Y3 PositionsY i 1 add get def /X2 [ X1 X1 mul X3 X3 mul sub EllipseSemiY R sub 2 mul Y1 add Y3 add Y1 Y3 sub mul add X1 X1 mul X3 X3 mul sub EllipseSemiY R add 2 mul Y1 sub Y3 sub Y1 Y3 sub mul sub mul EllipseSemiX dup mul mul X1 X1 mul X3 X3 mul sub Y1 Y1 mul add Y3 Y3 mul sub Y3 Y1 sub 2 mul R mul add X1 X3 sub mul EllipseSemiX dup mul mul -4 mul X1 X3 sub EllipseSemiX mul dup mul Y1 Y3 sub EllipseSemiY mul dup mul add 4 mul ] 0 //false W R sub //false //PrinterEpsilon PolynomialRoots dup length 0 eq {(Error: ProcessOnePackingType, Arch, no solutions) OutputToLog stop} if Max R 2 copy lt {exch} if pop def % /X2 PositionsX i X2 put PositionsY i X1 X1 mul X3 X3 mul sub Y1 Y1 mul add Y3 Y3 mul sub X3 X1 sub 2 mul X2 mul add Y1 Y3 sub 2 mul div put } ifelse % i 0 eq } for % i } for % loop count to stop slow convergence, updating PositionsX, PositionsY, EllipseSemiY [ CentralGlasses 1 eq { [W 2 div X add Mirror {H R sub} {R} ifelse Y add] } if CentralGlasses 2 ge { [W 2 div R add X add Mirror {H R sub} {R} ifelse Y add] [W 2 div R sub X add Mirror {H R sub} {R} ifelse Y add] PackingDirectionLeftToRight {exch} if} if CentralGlasses 3 ge { [W 2 div X add R //Sqrt3 1 add mul Mirror {H exch sub} if Y add] exch } if PositionsX length 1 sub -1 0 {/i exch def [ W 2 div PositionsX i get PackingDirectionLeftToRight {sub} {add} ifelse X add PositionsY i get Mirror {H exch sub} if Y add ] } for NGiA 2 mod 1 PositionsX length 1 sub {/i exch def [ W 2 div PositionsX i get PackingDirectionLeftToRight {add} {sub} ifelse X add PositionsY i get Mirror {H exch sub} if Y add ] } for ] end /NamePlacementTopX /NamePlacementBottomX Mirror {exch} if [ W 2 div W 4 div R 2 div add W 4 div dup ] CentralGlasses get X add def R X add def exit % 1 {...} repeat } if % /Arch /DiamondsAndRectangular BaseStyle eq { //DeBugLevel 50 le {( CirclePacking, /DiamondsAndRectangular) OutputToLog} if /NR BestParamsDict /NumRows get def /NC BestParamsDict /NumCols get def BestParamsDict /AboveBelow get { /NSR BestParamsDict /NumShorterRows get def /RectRowsBelow RectColsToLeftOrRowsBelow cvi NR NSR 2 mul 1 add sub 2 copy gt {exch} if pop dup 0 lt {pop 0} if def Echo { mark (SheetNum=) SheetNum (, with ) NG ( glasses: best BaseStyle, with radius ) R (, is /DiamondsAndRectangular with ) NC ( column) NC 1 ne {(s)} if (, ) NR NSR sub ( row) 1 index 1 ne {(s)} if ( of ) BestParamsDict /NumInLongerRows get ( glass) 1 index 1 ne {(es)} if (, and ) NSR ( rows with one fewer glass.) AreaText ConcatenateToMark OutputToLog } if % Echo /DistX NC 1 ge {W 2 R mul sub NC 1 sub div} {0} ifelse def [ NC 1 sub H mul W add 2 NC mul R mul sub NR 2 NSR mul sub W 2 R mul sub mul sub NC 1 sub H mul NR 2 NSR mul sub 1 sub W mul add NR NC add 2 sub 2 NSR mul sub 2 mul R mul sub mul NC 1 sub dup mul NSR mul -4 mul H 2 R mul sub mul NC 1 sub dup mul NR 1 sub dup 4 NSR mul sub mul mul neg ] 0 //false H 2 R mul sub //PrinterEpsilon add //false //PrinterEpsilon PolynomialRoots dup length 0 eq {pop H R 2 mul sub NR NSR 2 mul sub 1 sub 2 mul R mul sub NSR dup 1 ge {2 mul div} {pop} ifelse R 2 mul} {Min dup R lt {pop R} if dup NSR 2 mul mul H R 2 mul sub exch sub NR NSR 2 mul sub 1 sub dup 1 ge {div} {pop} ifelse} ifelse /Dist exch def /DistY exch def [ 0 1 NR 1 sub { /RowNum exch def /ThisRowShort //false def RowNum RectRowsBelow gt { RowNum NSR 2 mul RectRowsBelow add le {RectRowsBelow Dist mul RowNum RectRowsBelow sub DistY mul add /ThisRowShort RowNum RectRowsBelow sub 2 mod 1 eq def} {RowNum NSR 2 mul sub Dist mul NSR 2 mul DistY mul add} ifelse % In diamond block } {RowNum Dist mul} ifelse R Y add add /YY exch def ThisRowShort {1} {0} ifelse 2 NC 1 sub {[ exch DistX mul R add X add YY ]} for } for % RowNum ] NC 2 idiv dup 2 mod 0 eq {1 sub} if DistX mul R add X add dup /NamePlacementTopX exch def /NamePlacementBottomX exch def }{ % AboveBelow is false, so rectangular beside diamonds /NSC BestParamsDict /NumShorterCols get def /RectColsToLeft RectColsToLeftOrRowsBelow cvi NC NSC 2 mul 1 add sub 2 copy gt {exch} if pop dup 0 lt {pop 0} if def Echo { mark (SheetNum=) SheetNum (, with ) NG ( glasses: best BaseStyle, with radius ) R (, is /DiamondsAndRectangular with ) NR ( row) NR 1 ne {(s)} if (, ) NC NSC sub ( column) 1 index 1 ne {(s)} if ( of ) BestParamsDict /NumInLongerCols get ( glass) 1 index 1 ne {(es)} if (, and ) NSC ( columns with one fewer glass.) AreaText ConcatenateToMark OutputToLog } if % Echo /DistY NR 1 ge {H 2 R mul sub NR 1 sub div} {0} ifelse def [ NR 1 sub W mul H add 2 NR mul R mul sub NC 2 NSC mul sub H 2 R mul sub mul sub NR 1 sub W mul NC 2 NSC mul sub 1 sub H mul add NC NR add 2 sub 2 NSC mul sub 2 mul R mul sub mul NR 1 sub dup mul NSC mul -4 mul W 2 R mul sub mul NR 1 sub dup mul NC 1 sub dup 4 NSC mul sub mul mul neg ] 0 //true W 2 R mul sub //PrinterEpsilon add //false //PrinterEpsilon PolynomialRoots dup length 0 eq {pop W R 2 mul sub NC NSC 2 mul sub 1 sub 2 mul R mul sub NSC dup 1 ge {2 mul div} {pop} ifelse R 2 mul} {Min dup R lt {pop R} if dup NSC 2 mul mul W R 2 mul sub exch sub NC NSC 2 mul sub 1 sub dup 1 ge {div} {pop} ifelse} ifelse /Dist exch def /DistX exch def /NamePlacementTopX R 2 div def [ 0 1 NC 1 sub { /ColNum exch def /ThisColShort //false def ColNum RectColsToLeft gt { ColNum NSC 2 mul RectColsToLeft add le {RectColsToLeft Dist mul ColNum RectColsToLeft sub DistX mul add /ThisColShort ColNum RectColsToLeft sub 2 mod 1 eq def} {ColNum NSC 2 mul sub Dist mul NSC 2 mul DistX mul add} ifelse % In diamond block } {ColNum Dist mul} ifelse R X add add /XX exch def ThisColShort {1} {0} ifelse 2 NR 1 sub {[ exch XX exch DistY mul R add Y add ]} for ThisColShort {NamePlacementTopX W 2 div X add sub abs XX W 2 div X add sub abs R 24 div add gt {/NamePlacementTopX XX def} if} if % The fraction of R resolves the numerous ties. NSC 0 eq ColNum 0 gt and {NamePlacementTopX W 2 div sub abs XX PrevXX add 2 div W 2 div sub abs R 24 div add gt {/NamePlacementTopX XX PrevXX add 2 div def} if} if /PrevXX XX def } for % ColNum ] /NamePlacementBottomX NamePlacementTopX def } ifelse % /AboveBelow dup { 4 dict begin aload pop /BY exch def /BX exch def aload pop /AY exch def /AX exch def PackingNestingColumnMajor dup {AX BX} {AY BY} ifelse sub abs //PrinterEpsilon le eq {AY BY lt PackingDirectionTopToBottom ne} {AX BX lt PackingDirectionLeftToRight eq} ifelse end } ShellSort exit } if % /DiamondsAndRectangular /RectangularAlternateSplitNudge BaseStyle eq { //DeBugLevel 50 le {( CirclePacking, /RectangularAlternateSplitNudge) OutputToLog} if /NR BestParamsDict /NumRows get def /NC BestParamsDict /NumCols get def /NudgeRows BestParamsDict /NudgeRows get def /dist [ NudgeRows { NR 2 sub NR mul 5 add R R mul mul 4 H R mul mul sub H H mul add 4 mul NR 1 sub dup mul W mul W 4 R mul sub mul add NR 1 sub dup mul NC 1 sub mul 2 mul R 2 mul W sub mul NR 1 sub dup mul NC 1 add mul NC 3 sub mul }{ NC 2 sub NC mul 5 add R R mul mul 4 W R mul mul sub W W mul add 4 mul NC 1 sub dup mul H mul H 4 R mul sub mul add NC 1 sub dup mul NR 1 sub mul 2 mul R 2 mul H sub mul NC 1 sub dup mul NR 1 add mul NR 3 sub mul } ifelse ] R 2 mul //PrinterEpsilon sub //false H W add R 4 mul sub //false //PrinterEpsilon PolynomialRoots dup length [ {pop R 2 mul} {0 get} {Min} ] exch get exec def % /dist /NudgeAmount NudgeRows {W NC} {H NR} ifelse 1 sub dist mul sub 2 div R sub dup R gt {pop R} if def Echo { mark (SheetNum=) SheetNum (, with ) NG ( glasses: best BaseStyle, with radius ) R (, is ) BaseStyle ( with ) NC ( column) NC 1 ne {(s)} if (, ) NR ( row) NR 1 ne {(s)} if (, and alternate ) NudgeRows {(rows nudged, part left and part right)} {(columns nudged, part up and part down)} ifelse (, by ) NudgeAmount (pt.) AreaText ConcatenateToMark OutputToLog } if % Echo /PrevXXb //null def /PrevXXt //null def R 3 div dup /NamePlacementTopX exch def /NamePlacementBottomX exch def [ PackingNestingColumnMajor {PackingDirectionLeftToRight {0 1 NC 1 sub} {NC 1 sub -1 0} ifelse} {PackingDirectionTopToBottom {0 1 NR 1 sub} {NR 1 sub -1 0} ifelse} ifelse % PackingNestingColumnMajor { PackingNestingColumnMajor {/ColNum exch def PackingDirectionTopToBottom {0 1 NR 1 sub} {NR 1 sub -1 0} ifelse} {/RowNum exch def PackingDirectionLeftToRight {0 1 NC 1 sub} {NC 1 sub -1 0} ifelse} ifelse % PackingNestingColumnMajor { PackingNestingColumnMajor {/RowNum} {/ColNum} ifelse exch def % Bottom row or right column nudged split-nudged. NudgeRows { /XX ColNum NC 1 sub 2 div sub dist mul RowNum 2 mod 0 eq Mirror ne {NudgeAmount ColNum NC 2 idiv lt {sub} {add} ifelse} if W 2 div add X add def /YY NR 1 le {R} {H R sub NR 1 sub RowNum sub mul R RowNum mul add NR 1 sub div} ifelse Y add def }{ /YY RowNum NR 1 sub 2 div sub dist mul ColNum 2 mod 0 eq Mirror ne {NudgeAmount RowNum NR 2 idiv lt {sub} {add} ifelse} if H 2 div add Y add def /XX NC 1 le {R} {W R sub NC 1 sub ColNum sub mul R ColNum mul add NC 1 sub div} ifelse X add def } ifelse % NudgeRows [ XX YY ] RowNum 0 eq {PrevXXt IsNumber {NamePlacementTopX W 2 div X add sub abs XX PrevXXt add W sub 2 div X sub abs R 24 div add ge {/NamePlacementTopX XX PrevXXt add 2 div def} if} if /PrevXXt XX def} if RowNum NR 1 sub eq {PrevXXb IsNumber {NamePlacementBottomX W 2 div X add sub abs XX PrevXXb add W sub 2 div X sub abs R 24 div add ge {/NamePlacementBottomX XX PrevXXb add 2 div def} if} if /PrevXXb XX def} if } for % ColNum or RowNum PackingNestingColumnMajor not {/PrevXXb //null def /PrevXXt //null def} if } for % RowNum or ColNum ] exit } if % /RectangularAlternateSplitNudge ... /RectangularAlternateNudge BaseStyle eq { //DeBugLevel 50 le {( CirclePacking, /RectangularAlternateNudge) OutputToLog} if /NR BestParamsDict /NumRows get def /NC BestParamsDict /NumCols get def /NudgeRows BestParamsDict /NudgeRows get def /NudgeAmount NudgeRows { W R 2 mul sub NC 2 mul 1 sub div /a NC 2 sub NC mul NR 1 sub dup mul mul def /b NR 1 sub dup mul 2 mul W R 2 mul sub mul def /c NC 1 sub H mul NR NC sub 2 mul R mul add NR 1 sub W mul sub NC 1 sub H mul NR 1 sub W mul add NR NC add 2 sub 2 mul R mul sub mul def }{ H R 2 mul sub NR 2 mul 1 sub div /a NR 2 sub NR mul NC 1 sub dup mul mul def /b NC 1 sub dup mul 2 mul H R 2 mul sub mul def /c NR 1 sub W mul NC NR sub 2 mul R mul add NC 1 sub H mul sub NR 1 sub W mul NC 1 sub H mul add NC NR add 2 sub 2 mul R mul sub mul def } ifelse % NudgeRows [ c b a ] 0 //false H W add //true //PrinterEpsilon PolynomialRoots {2 copy gt {exch} if pop} forall def % /NudgeAmount % NudgeAmount R //PrinterEpsilon add gt {mark (Warning: CirclePacking, RectangularAlternateNudge: in sheet ) SheetNum ( which has ) NG ( glasses, NudgeAmount = ) NudgeAmount ( > Radius = ) R ConcatenateToMark OutputToLog} if Echo { mark (SheetNum=) SheetNum (, with ) NG ( glasses: best BaseStyle, with radius ) R (, is ) BaseStyle ( with ) NC ( column) NC 1 ne {(s)} if (, ) NR ( row) NR 1 ne {(s)} if (, and alternate ) NudgeRows {(rows)} {(columns)} ifelse ( nudged by ) NudgeAmount (pt.) AreaText ConcatenateToMark OutputToLog } if % Echo [ PackingNestingColumnMajor {PackingDirectionLeftToRight {0 1 NC 1 sub} {NC 1 sub -1 0} ifelse} {PackingDirectionTopToBottom {0 1 NR 1 sub} {NR 1 sub -1 0} ifelse} ifelse % PackingNestingColumnMajor { PackingNestingColumnMajor {/ColNum exch def PackingDirectionTopToBottom {0 1 NR 1 sub} {NR 1 sub -1 0} ifelse} {/RowNum exch def PackingDirectionLeftToRight {0 1 NC 1 sub} {NC 1 sub -1 0} ifelse} ifelse % PackingNestingColumnMajor { PackingNestingColumnMajor {/RowNum} {/ColNum} ifelse exch def % Non-mirrored has spacious bottom-right corner: nudge the last column; or not nudge the last row NudgeRows { /XX NC 1 le {R} {R NC 1 sub ColNum sub mul W R sub NudgeAmount sub ColNum mul add NC 1 sub div} ifelse X add NR RowNum sub 2 mod 1 eq Mirror eq {NudgeAmount add} if def /YY NR 1 le {R} {H R sub NR 1 sub RowNum sub mul R RowNum mul add NR 1 sub div} ifelse Y add def }{ /YY NR 1 le {R} {H R sub NudgeAmount sub NR 1 sub RowNum sub mul R RowNum mul add NR 1 sub div} ifelse Y add NC ColNum sub 2 mod 0 eq Mirror eq {NudgeAmount add} if def /XX NC 1 le {R} {R NC 1 sub ColNum sub mul W R sub ColNum mul add NC 1 sub div} ifelse X add def } ifelse % NudgeRows [ XX YY ] } for % ColNum } for % RowNum ] /NamePlacementTopX NC 1 le {W 4 div} {R NC 1.5 sub mul W R sub NudgeRows {NudgeAmount sub} if 0.5 mul add NC 1 sub div} ifelse X add NudgeRows {NR 2 mod 1 eq Mirror eq {NudgeAmount add} if} if def % /NamePlacementTopX % NamePlacement. If nudging columns, then with the appropriate nudged column, which will be different top and bottom. If nudging rows, then 0.5 cols left of middle. NudgeRows not NudgeAmount NamesFontSize ge and { NC 1 le {W 4 div dup} {W R 2 mul sub NC 1 sub div dup NC 4 idiv 2 mul mul X R add add exch NC 2 sub 4 idiv 2 mul 1 add mul X R add add} ifelse NC 2 mod 0 eq Mirror eq {exch} if /NamePlacementBottomX exch def /NamePlacementTopX exch def }{ NC 1 le {W Mirror {0.25} {0.75} ifelse mul} {R NC 1.5 sub mul W R sub NudgeRows {NudgeAmount sub} if 0.5 mul add NC 1 sub div Mirror NudgeRows and {NudgeAmount add} if} ifelse X add /NamePlacementBottomX exch def NC 1 le {W Mirror NR 2 mod 1 eq eq {0.25} {0.75} ifelse mul} {R NC 1.5 sub mul W R sub NudgeRows {NudgeAmount sub} if 0.5 mul add NC 1 sub div Mirror NR 2 mod 1 eq eq NudgeRows and {NudgeAmount add} if} ifelse X add /NamePlacementTopX exch def } ifelse % NudgeRows not NudgeAmount NamesFontSize ge and exit % 1 {...} repeat } if % /RectangularAlternateNudge ... /Bespoke5 BaseStyle eq { //DeBugLevel 50 le {( CirclePacking, /Bespoke5) OutputToLog} if /NamePlacementTopX W 2 div X add def /NamePlacementBottomX NamePlacementTopX def Echo {mark (SheetNum=) SheetNum (, with ) NG ( glasses: best BaseStyle, with radius ) R (, is /Bespoke5.) AreaText ConcatenateToMark OutputToLog} if /c W H 2 copy lt {exch} if //Sqrt3 mul sub R 2 mul //Sqrt3 1 sub mul add dup 0 le {pop 0} if def /d c //Sqrt3 mul 2 div def [ W H gt { Mirror { [ R c add X add H R sub Y add ] [ W R c add sub X add H R sub Y add ] [ W 2 div X add H 2 div d sub Y add ] [ R X add R Y add ] [ W R sub X add R Y add ] }{ [ R X add H R sub Y add ] [ W R sub X add H R sub Y add ] [ W 2 div X add H 2 div d add Y add ] [ R c add X add R Y add ] [ W R c add sub X add R Y add ] } ifelse % /Mirror }{ Mirror { [ R X add H R c add sub Y add ] [ W R sub X add H R sub Y add ] [ W 2 div d add X add H 2 div Y add ] [ R X add R c add Y add ] [ W R sub X add R Y add ] }{ [ R X add H R sub Y add ] [ W R sub X add H R c add sub Y add ] [ W 2 div d sub X add H 2 div Y add ] [ R X add R Y add ] [ W R sub X add R c add Y add ] } ifelse % /Mirror } ifelse % W H gt PackingDirectionLeftToRight not {exch 5 3 roll exch 5 -3 roll} if PackingDirectionTopToBottom not {5 2 roll 3 1 roll} if PackingNestingColumnMajor {4 2 roll 3 1 roll exch} if ] exit } if % /Bespoke5 /Bespoke7 BaseStyle eq { //DeBugLevel 50 le {( CirclePacking, /Bespoke7) OutputToLog} if W H ge {W 2 div} {W 4 div Mirror not {3 mul} if} ifelse X add dup /NamePlacementTopX exch def /NamePlacementBottomX exch def Echo {mark (SheetNum=) SheetNum (, with ) NG ( glasses: best BaseStyle, with radius ) R (, is /Bespoke7.) AreaText ConcatenateToMark OutputToLog} if W H 2 copy lt {exch} if /S exch def /L exch def % short side, long side /dist 4 S S mul mul 16 S R mul mul sub 20 R R mul mul add 4 R L mul mul sub L L mul add S 2 R mul sub //Sqrt3 2 mul mul L sub 2 R mul add mul 24 S S mul mul 96 S R mul mul sub 88 R R mul mul add 8 R L mul mul add 2 L L mul mul sub dup 0 eq {pop pop 2 R mul} {div} ifelse def % /dist % Construct assuming /Landscape. If not, then reverse. [ [ L 2 div dist 2 div sub R ] [ L 2 div dist 2 div add R ] /Y1 //Sqrt3 2 div dist mul R add def [ L 2 div Y1 ] /Y2 dist dup mul L dist sub 2 div R sub dup mul sub dup 0 gt {sqrt} {pop 0} ifelse def [ R Y2 R add ] [ L R sub Y2 R add ] /X2 dist dup mul S Y1 sub R sub dup mul sub dup 0 gt {sqrt} {pop 0} ifelse def [ L 2 div X2 sub S R sub ] [ L 2 div X2 add S R sub ] ] dup dup Mirror {dup {dup 1 get S exch sub 1 exch put} forall} if {W H lt {dup aload exch X add 0 exch put Y add 1 exch put} {dup aload exch Y add 1 exch put X add 0 exch put} ifelse} forall { 4 dict begin aload pop /BY exch def /BX exch def aload pop /AY exch def /AX exch def PackingNestingColumnMajor dup {AX BX} {AY BY} ifelse sub abs //PrinterEpsilon le eq {AY BY lt PackingDirectionTopToBottom ne} {AX BX lt PackingDirectionLeftToRight eq} ifelse end } ShellSort exit } if % /Bespoke7 /DiamondsPlus BaseStyle eq { //DeBugLevel 50 le {( CirclePacking, /DiamondsPlus) OutputToLog} if /NC BestParamsDict /NumCols get def /DistHorizontal BestParamsDict /DistHorizontal get def Echo { mark (SheetNum=) SheetNum (, with ) NG ( glasses: best BaseStyle, with radius ) R (, is /DiamondsPlus with ) NC 5 ( columns that would be full in the general case, and three rows, the only number of rows yet coded.) AreaText ConcatenateToMark OutputToLog } if % Echo W H 2 copy lt {exch} if /S exch def /L exch def % short side, long side DistHorizontal { [ 4 R mul S sub S mul NC 4 add NC mul 5 add 4 mul R R mul mul sub NC 2 add 8 mul R L mul mul add 4 L L mul mul sub S 2 R mul sub 2 mul 3 ] 2 R mul //PrinterEpsilon sub //false L R 2 mul sub //PrinterEpsilon add //false //PrinterEpsilon PolynomialRoots dup length 0 eq {pop () (Error: CirclePacking, DiamondsPlus, failed to compute dist. Please submit an issue to http://github.com/jdaw1/placemat/issues/) () OutputToLog OutputToLog OutputToLog /dist R 2 mul def} {Min /dist exch def} ifelse /xstep R def }{ /QuarticCoeffs [ NC 1 sub S mul dup mul 4 L L mul mul add NC 1 add S mul dup mul 4 L L mul mul add mul NC dup mul 1 sub dup mul S S S mul mul mul NC dup mul 1 add 4 mul S L mul S L add mul mul add 16 L L L mul mul mul add -8 mul R mul add NC dup mul dup dup mul 3 mul exch 2 mul sub 7 add S S mul mul NC dup mul 1 add 16 mul S L mul mul add NC dup mul 4 mul 52 add L L mul mul add 8 mul R R mul mul add NC dup mul dup 5 add 4 mul L mul exch dup 2 mul exch dup mul add 5 add S mul add -32 mul R R R mul mul mul add NC dup mul dup 6 mul exch dup mul add 25 add 16 mul R R mul dup mul mul add NC dup mul 1 sub S S mul mul 4 L L mul mul sub S mul 4 mul L L mul 2 L S mul mul add 4 mul NC dup mul 1 sub 3 S S mul mul mul sub 8 mul R mul add NC dup mul 3 mul 7 sub S mul 8 L mul sub 16 mul R R mul mul add NC dup mul 5 sub -32 mul R R R mul mul mul add NC dup mul dup dup dup mul 4 mul exch 7 mul sub 1 add -2 mul S S mul mul exch 4 mul 3 add 8 mul L L mul mul sub NC dup mul dup dup dup mul 4 mul exch 7 mul sub 1 add S mul exch 4 mul 3 add 4 mul L mul add 8 mul R mul add NC dup mul dup dup mul 4 mul exch 9 mul add 13 add -8 mul R R mul mul add NC dup mul 4 mul 3 sub dup dup -4 mul S mul exch 8 mul R mul add exch dup mul ] def % /QuarticCoeffs QuarticCoeffs 2 R mul //PrinterEpsilon sub //false S 2 R mul sub dup mul L 2 R mul sub dup mul add sqrt //PrinterEpsilon add //false //PrinterEpsilon PolynomialRoots dup length 0 eq {pop 0} {Min} ifelse /dist exch def /xstep dist dup mul S 2 div R sub dup mul sub dup 0 gt {sqrt} {/xstep 0 def pop 0} ifelse def } ifelse % DistHorizontal /distS dist L NC 1 sub xstep mul sub dup 4 R mul sub mul neg dup 0 lt {pop} {sqrt 2 mul 2 copy lt {exch} if pop} ifelse S 2 R mul sub 2 copy gt {exch} if pop def [ NC 2 mod 2 NC {xstep mul R add dup [exch S R sub] exch [exch R]} for % Top and bottom rows NC 1 add 2 mod 2 NC 1 sub {xstep mul R add [exch S 2 div]} for % central row [L R sub S distS add 2 div] [L R sub S distS sub 2 div] % The two extras ] dup dup Mirror {dup {dup 0 get L exch sub 0 exch put} forall} if {W H lt {dup aload exch X add 0 exch put Y add 1 exch put} {dup aload exch Y add 1 exch put X add 0 exch put} ifelse} forall { 4 dict begin aload pop /BY exch def /BX exch def aload pop /AY exch def /AX exch def PackingNestingColumnMajor dup {AX BX} {AY BY} ifelse sub abs //PrinterEpsilon le eq {AY BY lt PackingDirectionTopToBottom ne} {AX BX lt PackingDirectionLeftToRight eq} ifelse end } ShellSort /MidX W 2 div def /LeftOfMiddle X def /RightOfMiddle W X add def dup { dup 1 get H R Y NamesFontSize //PrinterEpsilon add add add sub ge { 0 get dup dup dup dup dup MidX lt exch LeftOfMiddle gt and {/LeftOfMiddle exch store} {pop} ifelse MidX ge exch RightOfMiddle lt and {/RightOfMiddle exch store} {pop} ifelse } {pop} ifelse % near top } forall /NamePlacementTopX LeftOfMiddle RightOfMiddle add 2 div def /LeftOfMiddle X def /RightOfMiddle W X add def dup { dup 1 get R Y NamesFontSize //PrinterEpsilon add add add le { 0 get dup dup dup dup dup MidX lt exch LeftOfMiddle gt and {/LeftOfMiddle exch store} {pop} ifelse MidX ge exch RightOfMiddle lt and {/RightOfMiddle exch store} {pop} ifelse } {pop} ifelse % near bottom } forall /NamePlacementBottomX LeftOfMiddle RightOfMiddle add 2 div def exit } if % /DiamondsPlus /Array BaseStyle eq { //DeBugLevel 50 le {( CirclePacking, /Array) OutputToLog} if [ /MinXX /MaxXX /MinYY /MaxYY /PositionsStart /PositionsEnd ] {dup BestParamsDict exch get def} forall /RngXX MaxXX MinXX sub def /RngYY MaxYY MinYY sub def Echo {mark (SheetNum=) SheetNum (, with ) NG ( glasses: best BaseStyle, with radius ) R (, is custom array.) AreaText ConcatenateToMark OutputToLog} if RngXX 0 eq { /Coeff1X 0 def /Coeff0X MinXX dup -1 le {pop -1} if dup 1 ge {pop 1} if 1 add 2 div W 2 R mul sub mul X R add add def }{ /Coeff1X W 2 R mul sub RngXX div def /Coeff0X X R add MinXX Coeff1X mul sub def } ifelse % RngXX 0 eq RngYY 0 eq { /Coeff1Y 0 def /Coeff0Y MinYY dup -1 le {pop -1} if dup 1 ge {pop 1} if 1 add 2 div H 2 R mul sub mul Y R add add def }{ /Coeff1Y H 2 R mul sub RngYY div def /Coeff0Y Y R add MinYY Coeff1Y mul sub def } ifelse % RngYY 0 eq % Items of length four [x0 y0 x1 y1]. Radius determined as if at (x0, y0). Canvas and radius then fixed, and circle moved as far as possible to (x1, y1). /IsMoveable NG array def /Answer NG array def //false 0 1 NG 1 sub { /WithinPage exch def Answer WithinPage 2 array put PackingDescriptor PositionsStart WithinPage add GetEU dup length 4 ge {0 4 getinterval aload pop 3 -1 roll ne 3 1 roll ne or} {pop //false} ifelse { pop //true IsMoveable WithinPage //true put }{ IsMoveable WithinPage //false put Answer WithinPage get PackingDescriptor PositionsStart WithinPage add GetEU 2 copy 0 GetEU Coeff1X mul Coeff0X add 0 exch put 1 GetEU Coeff1Y mul Coeff0Y add 1 exch put } ifelse % is moveable? } for % WithinPage, leaving a boolean on the stack { /BPDMsX {BPDM 0 GetEU} bind def /BPDMsY {BPDM 1 GetEU} bind def /BPDMdX {BPDM 2 GetEU BPDM 0 GetEU sub} bind def /BPDMdY {BPDM 3 GetEU BPDM 1 GetEU sub} bind def /BPDBsX {BPDB 0 GetEU} bind def /BPDBsY {BPDB 1 GetEU} bind def /BPDBdX {IsMoveable Blocker get {BPDB 2 GetEU BPDB 0 GetEU sub} {0} ifelse} bind def /BPDBdY {IsMoveable Blocker get {BPDB 3 GetEU BPDB 1 GetEU sub} {0} ifelse} bind def /MsX { BPDMsX Coeff1X mul Coeff0X add } bind def % start /MsY { BPDMsY Coeff1Y mul Coeff0Y add } bind def % start /BsX {IsMoveable Blocker get {BPDBsX Coeff1X mul Coeff0X add} {Answer Blocker get 0 get} ifelse} bind def % start /BsY {IsMoveable Blocker get {BPDBsY Coeff1Y mul Coeff0Y add} {Answer Blocker get 1 get} ifelse} bind def % start /MdX {BPDMdX Coeff1X mul} bind def % direction /MdY {BPDMdY Coeff1Y mul} bind def % direction /BdX {BPDBdX Coeff1X mul} bind def % direction /BdY {BPDBdY Coeff1Y mul} bind def % direction /PopulateCollisionP { /Blocker exch def /BPDB PackingDescriptor PositionsStart Blocker add GetEU def 0 1 NG 1 sub {/Mover exch def IsMoveable Mover get Blocker Mover ne and { /BPDM PackingDescriptor PositionsStart Mover add GetEU def CollisionP Mover get Blocker 1 { % If circles start adjacent, then machine-precision could cause a misleading 'collision' at p=+epsilon. % So multiple tests of whether circles moving away from each other. First test in PackingDescriptor space. BPDMsX BPDBsX ge BPDMdX BPDBdX ge and BPDMsX BPDBsX le BPDMdX BPDBdX le and or BPDMsY BPDBsY ge BPDMdY BPDBdY ge and BPDMsY BPDBsY le BPDMdY BPDBdY le and or and {1 put exit} if % Second, in painting space, but again only if passes in both x and y space MsX BsX ge MdX BdX ge and MsX BsX le MdX BdX le and or MsY BsY ge MdY BdY ge and MsY BsY le MdY BdY le and or and {1 put exit} if % Third, again in painting space, but using sign of dot product MsX BsX sub MdX BdX sub mul MsY BsY sub MdY BdY sub mul add 0 ge {1 put exit} if [ MsX dup mul MsY dup mul add BsX dup mul BsY dup mul add add R R mul 4 mul sub MsX BsX mul MsY BsY mul add 2 mul sub MsX BsX sub MdX mul MsY BsY sub MdY mul add 2 mul IsMoveable Blocker get {BsX MsX sub BdX mul BsY MsY sub BdY mul add 2 mul add} if MdX dup mul MdY dup mul add IsMoveable Blocker get {BdX dup MdX 2 mul sub mul BdY dup MdY 2 mul sub mul add add} if ] 0 //false 1 //true //PrinterEpsilon PolynomialRoots % If there is an adjacent circle, must be moving towards. dup length 0 eq {pop 1 put exit} if dup length 1 eq {0 get dup 0 lt {pop 0} if put exit} if % Two solutions. If a double root, within appropriate precision, ignore. Otherwise lesser. aload pop dup 0 lt {pop 0} if /p1 exch def dup 0 lt {pop 0} if /p0 exch def p1 p0 sub dup mul Coeff1X dup mul Coeff1Y dup mul add mul 16 R //PrinterEpsilon mul mul le {1} {p0 p1 lt {p0} {p1} ifelse} ifelse put } repeat % 1 } if} for % /Mover } bind def % /PopulateCollisionP /MoverMaxP [ % Ensure not going off the page 0 1 NG 1 sub { /Mover exch def /BPDM PackingDescriptor PositionsStart Mover add GetEU def 1 IsMoveable Mover get { MsX MdX add X R add 2 copy //PrinterEpsilon sub lt {MsX dup 3 -1 roll sub 3 1 roll exch sub div 2 copy gt {exch} if pop} {pop pop} ifelse MsX MdX add X W add R sub 2 copy //PrinterEpsilon add gt {MsX dup 3 -1 roll sub 3 1 roll exch sub div 2 copy gt {exch} if pop} {pop pop} ifelse MsY MdY add Y R add 2 copy //PrinterEpsilon sub lt {MsY dup 3 -1 roll sub 3 1 roll exch sub div 2 copy gt {exch} if pop} {pop pop} ifelse MsY MdY add Y H add R sub 2 copy //PrinterEpsilon add gt {MsY dup 3 -1 roll sub 3 1 roll exch sub div 2 copy gt {exch} if pop} {pop pop} ifelse } if % IsMoveable ... } for % /Mover ] def % /MoverMaxP /CollisionP [ NG {[ NG {1} repeat ]} repeat ] def 0 1 NG 1 sub {PopulateCollisionP} for { //true IsMoveable {{pop //false exit} if} forall {exit} if /MinP 1 def 0 1 NG 1 sub {/Mover exch def IsMoveable Mover get { MoverMaxP Mover get dup MinP lt {/MinP exch def} {pop} ifelse 0 1 NG 1 sub {/Blocker exch def Mover Blocker ne { CollisionP Mover get Blocker get dup MinP lt {/MinP exch def} {pop} ifelse } if} for % /Blocker } if} for % /Mover [ 0 1 NG 1 sub {/Mover exch def IsMoveable Mover get { /BPDM PackingDescriptor PositionsStart Mover add GetEU def MinP MoverMaxP Mover get eq { Answer Mover get 0 MdX MinP mul MsX add put Answer Mover get 1 MdY MinP mul MsY add put IsMoveable Mover //false put Mover % left on stack for later PopulateCollisionP'ing } if % MinP MoverMaxP Mover get eq 0 1 NG 1 sub {/Blocker exch def Mover Blocker ne { /BPDB PackingDescriptor PositionsStart Blocker add GetEU def MinP CollisionP Mover get Blocker get eq { Answer Mover get 0 MdX MinP mul MsX add put Answer Mover get 1 MdY MinP mul MsY add put CollisionP Mover get Blocker 1 put IsMoveable Mover //false put Mover % left on stack for later PopulateCollisionP'ing IsMoveable Blocker get { Answer Blocker get 0 BdX MinP mul BsX add put Answer Blocker get 1 BdY MinP mul BsY add put CollisionP Blocker get Mover 1 put IsMoveable Blocker //false put Blocker % left on stack for later PopulateCollisionP'ing } if } if % MinP CollisionP ... eq } if} for % /Blocker } if} for % /Mover ] dup length 0 eq {( Error in CirclePacking's array special: possible infinite loop.) OutputToLog pop exit} {{PopulateCollisionP} forall} ifelse } loop } if % any of IsMoveable % (Answer) = Answer {mark exch aload pop exch exch (\t) exch ConcatenateToMark =} forall () = /MinXX W X add def /MaxXX X def Answer {0 get dup dup MinXX lt {/MinXX exch def} {pop} ifelse dup MaxXX gt {/MaxXX exch def} {pop} ifelse} forall { % For use twice, only a few lines down dup length 0 eq {pop X W 2 div add exit} if dup length 1 eq {0 get dup MinXX MaxXX add 2 div ge {MinXX R sub} {MaxXX R add} ifelse 2 mul add 3 div exit} if dup length 2 gt {dup {lt} ShellSort} if dup 0 get exch 1 get add 2 div } dup /NamePlacementTopX [ Answer {aload pop H Y add R NamesFontSize //PrinterEpsilon add add sub lt {pop} if} forall ] 1 4 -1 roll repeat % 1 def % /NamePlacementTopX /NamePlacementBottomX [ Answer {aload pop Y R NamesFontSize //PrinterEpsilon add add add gt {pop} if} forall ] 1 4 -1 roll repeat % 1 def % /NamePlacementBottomX Answer exit } if % /Array ... mark (Error! With ) NG ( glasses, BestParamsDict /BaseStyle get = ) BestParamsDict /BaseStyle get (, which is an unknown value.) ConcatenateToMark OutputToLog stop } repeat} Stopped {mark (Error: failure in CirclePacking with BaseStyle=) BaseStyle (. Perhaps an overflow error caused by a large page size. Stopping.) ConcatenateToMark OutputToLog stop} if R % second part of answer, = Radius PackingDescriptor NamePlacementTopX NamePlacementBottomX % Final part of answer end //DeBugLevel 100 le {(-CirclePacking) OutputToLog} if } bind def % /CirclePacking /CircletextRecursive { //DeBugLevel 20 le {(+CircletextRecursive) OutputToLog} if /thing exch def /m matrix currentmatrix def 1 { /thing load xcheck { % This is meant to cope with code that does any of several things. % But, of course, different code can do arbitrary things, good or bad. % 1. Change typeface. Requires no help. % 2. Kerning: horizontal rmoveto. This must be handled in the angle calculation, and must not be effected. % 3. Superscript or subscript. No effect on angle calculation; stored in CircleVerticalOffset and the current font. % 4. Leave something to be rendered on the stack. Wrap execution in [] (in case leaves nothing), and call CircletextRecursive. % 5. Render a picture, such as a small dingbat, of course finishing with a moveto to the logical place to continue. % 6. If there is underlining, apply separately to each character or character. GSave 0 0 moveto % NullDevice /UnderlineBegin {/CircletextUnderlining //true store} def /UnderlinePaint {/CircletextUnderlining //false store} def mark /thing load ExecUExceptNotBindedPainting cleartomark currentpoint CircleVerticalOffset add /CircleVerticalOffset exch def /CW exch def GRestore /CA CW R //TwoPi mul div 360 mul def /Angle SentenceAngle CircletextAngleOffsets i get add CharacterAngle add CA 2 div add def Angle neg sin R mul X add Angle neg cos R mul Y add moveto Angle 180 add rotate CW -2 div CircleVerticalOffset rmoveto [ /thing load execU ] currentdict /UnderlineBegin undef currentdict /UnderlinePaint undef m setmatrix /CharacterAngle CharacterAngle CW R //TwoPi mul div 360 mul add def CircletextRecursive exit } if % xcheck thing type /arraytype eq {thing {CircletextRecursive} forall exit} if thing type /nametype eq { /CW thing StringWidthRecursive def /CA CW R //TwoPi mul div 360 mul def /Angle SentenceAngle CircletextAngleOffsets i get add CharacterAngle add CA 2 div add def Angle neg sin R mul X add Angle neg cos R mul Y add moveto Angle 180 add rotate CW -2 div CircleVerticalOffset rmoveto CircletextUnderlining {UnderlineBegin thing GlyphShow UnderlinePaint} {thing GlyphShow} ifelse m setmatrix /CharacterAngle CharacterAngle CA add def exit } if % /nametype thing type dup /integertype eq exch /realtype eq or {/thing thing ToString store} if % no 'exit'. thing type /stringtype eq { 0 1 thing length 1 sub { /C exch thing exch 1 getinterval def /CW C StringWidthRecursive def /CA CW R //TwoPi mul div 360 mul def /Angle SentenceAngle CircletextAngleOffsets i get add CharacterAngle add CA 2 div add def Angle neg sin R mul X add Angle neg cos R mul Y add moveto Angle 180 add rotate CW -2 div CircleVerticalOffset rmoveto CircletextUnderlining {UnderlineBegin C show UnderlinePaint} {C show} ifelse m setmatrix /CharacterAngle CharacterAngle CA add def } for % C exit } if % /stringtype mark (Error: CircletextRecursive parameter ) /thing load 0 //true ThingToDebugText ( is of type ) /thing load type ( rather than executable, string, name, number or array.) ConcatenateToMark OutputToLog stop } repeat //DeBugLevel 20 le {(-CircletextRecursive) OutputToLog} if } bind def % /CircletextRecursive % CircletextArray NumSpaces Radius FontSize NumCopies Circletext -- /Circletext { //DeBugLevel 50 le {(+Circletext) OutputToLog} if 24 dict begin /NumCopies exch def /FontSize exch def /R exch def /NumSpaces exch def /CircletextArray exch def currentpoint /Y exch def /X exch def /CircletextUnderlining //false def GSave CircletextFont FontSize selectfont /CircletextArrayWidths [ CircletextArray {StringWidthRecursive} forall ] def /CircletextArraySumWidths 0 CircletextArrayWidths {add} forall def CircletextArraySumWidths 0 gt NumCopies 1 ge and { /AngleGap 1 NumCopies div CircletextArraySumWidths R //TwoPi mul div sub CircletextArray length div 360 mul def /CircletextAngleOffsets [ CircletextArrayWidths 0 get R //TwoPi mul div 360 mul 2 div neg 1 1 CircletextArray length 1 sub {1 sub CircletextArrayWidths exch get R //TwoPi mul div 360 mul AngleGap add 1 index add} for ] def 0 1 NumCopies 1 sub { CircletextFont FontSize selectfont % Not sure whether needed. Restarts each sentence at same typeface. 360 NumCopies div mul 180 add /SentenceAngle exch def 0 1 CircletextArray length 1 sub { /i exch def /CharacterAngle 0 def /CircleVerticalOffset 0 def X Y R sub moveto % In case first non-array item of CircletextArray is code CircletextArray i get CircletextRecursive } for % i } for % SentenceAngle } if % CircletextArraySumWidths 0 gt NumCopies 1 ge and GRestore end //DeBugLevel 50 le {(-Circletext) OutputToLog} if } bind def % /Circletext /Atan {2 copy abs //PrinterEpsilon lt exch abs //PrinterEpsilon lt and {pop pop /UndefinedAtan} {atan} ifelse} bind def % GlassNum1 GlassNum2 MakePathConnectingGlasses - % For diagonals does a 90 degree curve, horizontally % out of GlassNum1, and vertically into GlassNum2. % Assumes existence of various things. /MakePathConnectingGlasses { //DeBugLevel 50 le {(+MakePathConnectingGlasses) OutputToLog} if /GlassPositions where {pop //true} {//false} ifelse { 7 dict begin GlassPositions SheetNum get exch get aload pop /Y2 exch def /X2 exch def GlassPositions SheetNum get exch get aload pop /Y1 exch def /X1 exch def X1 X2 sub abs Radii SheetNum get le { Y1 Y2 sub abs Radii SheetNum get gt { Y1 Y2 lt {X1 Y1 Radii SheetNum get add moveto X2 Y2 Radii SheetNum get sub lineto} {X1 Y1 Radii SheetNum get sub moveto X2 Y2 Radii SheetNum get add lineto} ifelse % Y1 Y2 lt } if % Y1 Y2 sub abs Radii SheetNum get gt }{ Y1 Y2 sub abs Radii SheetNum get le { X1 X2 lt {X1 Radii SheetNum get add Y1 moveto X2 Radii SheetNum get sub Y2 lineto} {X1 Radii SheetNum get sub Y1 moveto X2 Radii SheetNum get add Y2 lineto} ifelse % Y1 Y2 lt }{ /XX1 X1 Radii SheetNum get X1 X2 lt {add} {sub} ifelse def /YY2 Y2 Radii SheetNum get Y1 Y2 lt {sub} {add} ifelse def /bezierquarter //Sqrt2 1 sub 4 mul 3 div def XX1 Y1 moveto 1 bezierquarter sub XX1 mul bezierquarter X2 mul add Y1 X2 1 bezierquarter sub YY2 mul bezierquarter Y1 mul add X2 YY2 curveto } ifelse % Y1 Y2 sub abs Radii SheetNum get le } ifelse % X1 X2 sub abs Radii SheetNum get le end } {pop pop} ifelse % /GlassPositions where {pop true} {false} ifelse //DeBugLevel 50 le {(-MakePathConnectingGlasses) OutputToLog} if } bind def % /MakePathConnectingGlasses /Mod {dup 0 le {pop pop 0} { {1 index 0 lt {dup 3 1 roll add exch} {mod exit} ifelse} loop} ifelse} bind def % Always returns >= 0 % Circlearray {FontSettingCode} SeparationMinNumSpaces CurrentpointIsTop WidthOfAvailableSpace FillBackground StartItem CirclearrayInStraightLine StartItem NextItem DescenderMin AscenderMax % If StartItem is -1 then computes the StartItem that has the smallest Separation between text pieces; currentpoint is top-left or bottom left of box. /CirclearrayInStraightLine { //DeBugLevel 40 le {(+CirclearrayInStraightLine) OutputToLog} if 24 dict begin /StartItemParam exch def /FillBackground exch def /WidthOfAvailableSpace exch def /CurrentpointIsTop exch def /SeparationMinNumSpaces exch def /FontSettingCode exch def /Circlearray exch def Circlearray length 0 gt { /AscenderMax //InfinityNeg def /DescenderMin //Infinity def /PieceW Circlearray length array def /PieceL Circlearray length array def /PieceR Circlearray length array def 0 1 Circlearray length 1 sub { /i exch def FontSettingCode PieceW i Circlearray i get StringWidthRecursive put Circlearray i get StringPathBBox dup AscenderMax gt {/AscenderMax exch def} {pop} ifelse PieceR exch i exch put dup DescenderMin lt {/DescenderMin exch def} {pop} ifelse PieceL exch i exch put } for % i /SeparationMin FontSettingCode ( ) stringwidth pop SeparationMinNumSpaces mul def /SeparationBest //Infinity def [ StartItemParam 0 ge {StartItemParam} {0 1 Circlearray length 1 sub {} for dup 1 ge { {StartItemBest} } if} ifelse ] % To re-compute Separation using StartItemBest { /StartItem exch exec def % The exec for the {StartItemBest} item of array /ResidualSpace //null def /NumWholes % Swash handling only at start and end. Within use font's widths. WidthOfAvailableSpace SeparationMin add PieceL StartItem get add StartItem 1 sub Circlearray length Mod dup PieceR exch get exch PieceW exch get sub sub 0 PieceW {add} forall Circlearray length SeparationMin mul add div cvi def % /NumWholes 0 1 Circlearray length 1 sub { /NumPieces exch def ResidualSpace % Old, in case next ResidualSpace negative. /ResidualSpace WidthOfAvailableSpace NumWholes 0 gt {0 PieceW {add} forall NumWholes mul sub} if StartItem 1 StartItem 1 sub NumPieces add {Circlearray length Mod PieceW exch get sub} for Circlearray length NumWholes mul NumPieces add 1 sub SeparationMin mul sub PieceL StartItem get add StartItem 1 sub NumPieces add Circlearray length Mod dup PieceR exch get exch PieceW exch get sub sub def % /ResidualSpace ResidualSpace //PrinterEpsilon neg lt % should be false with NumPieces equalling zero {/ResidualSpace exch def /NumPieces NumPieces 1 sub def exit} {pop} ifelse % ResidualSpace PrinterEpsilon neg lt } for % NumPieces /Separation ResidualSpace Circlearray length NumWholes mul NumPieces add 1 sub dup 0 eq {pop pop 0} {div SeparationMin add} ifelse def Separation SeparationBest 0.24 sub lt {/StartItemBest StartItem def /SeparationBest Separation def} if % Should happen at least once, hence no initialisation of StartItem. Embedded 0.24 constant because prefer smaller StartItem. } forall % StartItem FillBackground {currentpoint WidthOfAvailableSpace AscenderMax DescenderMin sub CurrentpointIsTop {neg} if GSave 0.75 setgray rectfill GRestore} if PieceL StartItem get neg CurrentpointIsTop {AscenderMax} {DescenderMin} ifelse neg rmoveto currentpoint /Y exch def pop NumWholes neg 1 0 { /WholeNum exch def 0 1 Circlearray length 1 sub { /PieceNum exch def WholeNum 0 eq {PieceNum NumPieces ge {exit} if} if Circlearray PieceNum StartItem add Circlearray length mod get FontSettingCode ShowRecursive currentpoint pop Separation add Y moveto } for % PieceNum } for % WholeNum StartItem NumPieces StartItem add Circlearray length mod DescenderMin AscenderMax } {StartItemParam dup 0 0} ifelse % Circlearray length 0 gt end //DeBugLevel 40 le {(-CirclearrayInStraightLine) OutputToLog} if } bind def % /CirclearrayInStraightLine % X Y Width Height Circlearray {FontSettingCode} SeparationMinNumSpaces CirclearrayInRectangle DescenderMin AscenderMax /CirclearrayInRectangle { //DeBugLevel 40 le {(+CirclearrayInRectangle) OutputToLog} if 13 dict begin /SeparationMinNumSpaces exch def /FontSettingCode exch def /Circlearray exch def /H exch def /W exch def /Y exch def /X exch def matrix currentmatrix dup X Y H add translate -90 rotate 0 0 moveto % Left Circlearray /FontSettingCode load SeparationMinNumSpaces //false H //false -1 CirclearrayInStraightLine /A exch def /D exch def /NextItem exch def /StartItemV exch def setmatrix % Left /LineH A D sub 0.72 add def X LineH add Y moveto % Bottom Circlearray /FontSettingCode load SeparationMinNumSpaces //false W LineH 2 mul sub //false NextItem CirclearrayInStraightLine pop pop pop /StartItemH exch def % Bottom X W add Y translate 90 rotate 0 0 moveto % Right Circlearray /FontSettingCode load SeparationMinNumSpaces //false H //false StartItemV CirclearrayInStraightLine pop pop pop pop setmatrix % Right X LineH add Y H add moveto % Top Circlearray /FontSettingCode load SeparationMinNumSpaces //true W LineH 2 mul sub //false StartItemH CirclearrayInStraightLine pop pop pop pop % Top D A end //DeBugLevel 40 le {(-CirclearrayInRectangle) OutputToLog} if } bind def % /CirclearrayInRectangle /CirclearrayInSemiRoundedRectangleRec { 6 dict begin /thing exch def 1 { /thing load xcheck { % Mutatis mutandis, include xcheck comment from CircletextRecursive. GSave 0 0 moveto % NullDevice /UnderlineBegin {/CircletextUnderlining //true store} def /UnderlinePaint {/CircletextUnderlining //false store} def mark /thing load ExecUExceptNotBindedPainting cleartomark currentpoint VerticalOffset add /VerticalOffset exch store /CW exch def 1 1 Dists length 1 sub {/PartMiddle exch def DistCurrent CW 2 div add Dists PartMiddle get lt {exit} if} for /Ang DistCurrent CW 2 div add Dists PartMiddle 1 sub get sub Dists PartMiddle get Dists PartMiddle 1 sub get sub div 90 mul def GRestore matrix currentmatrix [ {(Error: CirclearrayInSemiRoundedRectangleRec, impossible PartMiddle. Please submit an issue to http://github.com/jdaw1/placemat/issues/) OutputToLog stop} {X W D add add Y AD DistCurrent add add moveto 90 rotate 0 VerticalOffset rmoveto} {W R sub X add Ang cos R D add mul add H R sub Y add Ang sin R D add mul add moveto 90 Ang add rotate CW -2 div VerticalOffset rmoveto} {X W R DistCurrent Dists 2 get sub add sub add Y H D add add moveto 180 rotate 0 VerticalOffset rmoveto} {X R add Ang sin R D add mul sub H R sub Y add Ang cos R D add mul add moveto 180 Ang add rotate CW -2 div VerticalOffset rmoveto} {X D sub Y H R DistCurrent Dists 4 get sub add sub add moveto -90 rotate 0 VerticalOffset rmoveto} ] PartMiddle get exec [ /thing load execU ] exch setmatrix currentdict /UnderlineBegin undef currentdict /UnderlinePaint undef /DistCurrent dup load CW add store {CirclearrayInSemiRoundedRectangleRec} forall exit } if % xcheck thing type /arraytype eq {thing {CirclearrayInSemiRoundedRectangleRec} forall exit} if thing type dup /integertype eq exch /realtype eq or {/thing thing ToString store} if % no 'exit'. /ThingIsString thing type /stringtype eq def thing type /nametype eq ThingIsString or { ThingIsString {thing length 1 ge} {//true} ifelse { matrix currentmatrix /WidthChar0 thing ThingIsString {0 1 getinterval} if StringWidthRecursive def 1 1 Dists length 1 sub {/PartMiddleChar0 exch def DistCurrent WidthChar0 2 div add Dists PartMiddleChar0 get lt {exit} if} for PartMiddleChar0 2 mod 1 eq % On a straight { ThingIsString { thing length -1 1 { /CharsToShow exch def thing 0 CharsToShow 1 sub getinterval stringwidth pop thing CharsToShow 1 sub 1 getinterval stringwidth pop 2 div add DistCurrent add Dists PartMiddleChar0 get le {exit} if } for % CharsToShow } if % ThingIsString PartMiddleChar0 1 eq {X W D add add Y AD DistCurrent add add moveto 90 rotate 0 VerticalOffset rmoveto} if PartMiddleChar0 3 eq {X W R DistCurrent Dists 2 get sub add sub add Y H D add add moveto 180 rotate 0 VerticalOffset rmoveto} if PartMiddleChar0 5 eq {X D sub Y H R DistCurrent Dists 4 get sub add sub add moveto -90 rotate 0 VerticalOffset rmoveto} if }{ /CharsToShow 1 def /Ang DistCurrent WidthChar0 2 div add Dists PartMiddleChar0 1 sub get sub Dists PartMiddleChar0 get Dists PartMiddleChar0 1 sub get sub div 90 mul def PartMiddleChar0 2 eq {W R sub X add Ang cos R D add mul add H R sub Y add Ang sin R D add mul add moveto 90 Ang add rotate WidthChar0 -2 div VerticalOffset rmoveto} {X R add Ang sin R D add mul sub H R sub Y add Ang cos R D add mul add moveto 180 Ang add rotate WidthChar0 -2 div VerticalOffset rmoveto} ifelse % PartMiddleChar0 2 eq } ifelse % PartMiddleChar0 2 mod 1 eq /DistCurrent dup load thing ThingIsString {0 CharsToShow getinterval dup show} {dup GlyphShow} ifelse StringWidthRecursive add store setmatrix ThingIsString {CharsToShow thing length lt {thing CharsToShow thing length CharsToShow sub getinterval CirclearrayInSemiRoundedRectangleRec} if} if } if % ... thing length 1 ge ... exit } if % ... /nametype ... ThingIsString or } repeat end } bind def % /CirclearrayInSemiRoundedRectangleRec % X Y Width Height Radius Circlearray {FontSettingCode} SeparationMinNumSpaces CirclearrayInSemiRoundedRectangle DescenderMin AscenderMax /CirclearrayInSemiRoundedRectangle { //DeBugLevel 40 le {(+CirclearrayInSemiRoundedRectangle) OutputToLog} if 23 dict begin /SeparationMinNumSpaces exch def /FontSettingCode exch def /Circlearray exch def /R exch def /H exch def /W exch def /Y exch def /X exch def /SeparationMin FontSettingCode ( ) stringwidth pop SeparationMinNumSpaces mul def Circlearray length 0 gt { X Y moveto Circlearray /FontSettingCode load SeparationMinNumSpaces //false W //false -1 CirclearrayInStraightLine /A exch def /D exch def /StartItem exch def dup 0 eq {pop Circlearray length 1 sub} {1 sub} ifelse /EndItem exch def /AD A D sub 0.72 add FontSettingCode ( ) stringwidth pop add def % Embedded constant /R R W 2 div H AD sub 2 {2 copy gt {exch} if pop} repeat AD 2 copy lt {exch} if pop def /Dists [ 0 % Start, start 1st line; H AD R add sub % End 1st line, start 1st arc; dup R D add //HalfPi mul add % End 1st arc, start 2nd line; dup W 2 R mul sub add % End 2nd line, start 2nd arc; dup R D add //HalfPi mul add % End 2nd arc, start 3rd line; dup 4 index add % End 3rd line, end. ] def % /Dists /PieceW Circlearray length array def /PieceL Circlearray length array def /PieceR Circlearray length array def 0 1 Circlearray length 1 sub { /i exch def FontSettingCode PieceW i Circlearray i get StringWidthRecursive put Circlearray i get StringPathBBox pop PieceR exch i exch put pop PieceL exch i exch put } for % i Dists dup length 1 sub get PieceR EndItem get sub PieceL StartItem get add % Swash handling only at start and end. Within use font's widths. [ EndItem StartItem ge {StartItem 1 EndItem 1 sub {} for} {0 1 EndItem 1 sub {} for StartItem 1 Circlearray length 1 sub {} for} ifelse ] {PieceW exch get SeparationMin add sub} forall % EndItem removed in swash handling 0 PieceW {add} forall Circlearray length SeparationMin mul add 2 copy exch SeparationMin add //PrinterEpsilon add exch div floor cvi /NumWholes exch def NumWholes mul sub EndItem StartItem sub dup 0 lt {Circlearray length add} if NumWholes Circlearray length mul add % Want gaps so one less than number text pieces dup 1 lt {pop} {div} ifelse SeparationMin add /Separation exch def /DistCurrent PieceL StartItem get neg def {Circlearray exch get /VerticalOffset 0 def 0 setgray FontSettingCode CirclearrayInSemiRoundedRectangleRec /DistCurrent dup load Separation add store} StartItem 1 Circlearray length 1 sub 3 index for NumWholes StartItem EndItem le {1 sub} if dup 0 lt { pop 0 mark (Error: in CirclearrayInSemiRoundedRectangle a negative value being overidden with zero. Nonetheless proceeding, but neck-tag pages might be faulty. Cause possibly a too long CirclearraysNeckTags ) WithinTitles ( get = ) /Circlearray load ConcatenateToMark OutputToLog } if % ... 0 lt {0 1 Circlearray length 1 sub 3 index for} repeat 0 1 EndItem 4 -1 roll for A D } {0 0} ifelse % Circlearray length 0 gt end //DeBugLevel 40 le {(-CirclearrayInSemiRoundedRectangle) OutputToLog} if } bind def % /CirclearrayInSemiRoundedRectangle /TimeIntervalString { 1 dict begin dup 0 lt {cvr 4294967296.0 add} if % PLRM3 p714 re usertime, p739 table B.1. Note 2^31 ms ~= 24 days + 20 hours + 31 minutes. 1000 div /usertimeInterval exch def mark 1 { ( ~= ) usertimeInterval ( seconds) usertimeInterval 60 div dup 0.5 ge {dup 1 lt {2} {1} ifelse FormatDecimalPlaces 3 index exch ( minutes)} {pop exit} ifelse % There have been some distillation times of multiple minutes. usertimeInterval 3600 div dup 0.5 ge {dup 1 lt {2} {1} ifelse FormatDecimalPlaces 3 index exch ( hours) } {pop exit} ifelse % If time exceeds a few minutes, deactivate FillTitles and FillPlaceNames. usertimeInterval 86400 div dup 0.5 ge {dup 1 lt {2} {1} ifelse FormatDecimalPlaces 3 index exch ( days) } {pop exit} ifelse % As of 01 Jan 2024, JDAW's longest distillation time has been ~=22 minutes. usertimeInterval 2629800 div dup 0.5 ge {dup 1 lt {2} {1} ifelse FormatDecimalPlaces 3 index exch ( months) } {pop exit} ifelse % Julian year of 365.25 days, divided by 12. PostScript's max integer is just bigger than half a month. usertimeInterval 31557600 div dup 0.5 ge {dup 1 lt {2} {1} ifelse FormatDecimalPlaces 3 index exch ( years) } {pop exit} ifelse % Years?! Something is very amiss. } repeat % 1 end ConcatenateToMark } bind def % TimeIntervalString % Do stuff: call the routines % This open curly brace starts code passed to stopped { AnyFillTextingAtAll //DeBugLevel 100 le or {mark ( Main: just before error checking, execution time ) usertime usertimeStart TimeIntervalString ConcatenateToMark OutputToLog} if % Elementary error checking /ErrorFlag //false def 0 1 NumSheets 1 sub { /SheetNum exch def GlassesOnSheets SheetNum GetEU dup type /arraytype eq { { /WithinTitles exch execU def WithinTitles type /integertype ne {(Error: non-integer element of GlassesOnSheets.) OutputToLog /ErrorFlag //true store} if WithinTitles 0 lt {(Error: negative element of GlassesOnSheets.) OutputToLog /ErrorFlag //true store} if WithinTitles Titles length ge { mark (Error: With Titles of length ) Titles length ( no element of GlassesOnSheets should exceed ) Titles length 1 sub (, yet on sheet ) SheetNum ( (starting at zero of course) is a ) WithinTitles ConcatenateToMark OutputToLog /ErrorFlag //true store } if } forall }{ pop (Error: GlassesOnSheets contains a non-array.) OutputToLog /ErrorFlag //true store } ifelse % GlassesOnSheets ... type /arraytype eq } bind for % SheetNum currentdict /WithinTitles undef currentdict /SheetNum undef ErrorFlag {stop} if % If GlassesOnSheets borken, much untestable. % Each sub-array contains names of things that should be the same length /TypeOfPagesBeingRendered /Multiple store [ [ /Circlearrays /Titles /Abovetitles /Overtitles /Belowtitles % Not using GlassesNumCopies as these pages might be computed for sticky-label or pre-pour purposes, then not rendered AnyFillTextingAtAll {/FillTexts} if /FontSizesTitlesEquivalences /FontSizesAbovetitlesEquivalences /FontSizesBelowtitlesEquivalences /FontSizesOvertitlesEquivalences ] {GlassesOnTastingNotePages length 0 gt} MightBeTrue {TastingNotePagesNumCopies 1 ge} MightBeTrue and { [ /CirclearraysTastingNotes /TitlesTastingNotes /SubtitlesTastingNotes ] } if {DecantingNotesNumCopies 1 ge} MightBeTrue { [ /CirclearraysDecantingNotes /TitlesDecantingNotes /SubtitlesDecantingNotes ] } if /VoteRecorders load MightBeTrue { [ /CirclearraysVoteRecorder /TitlesVoteRecorder /SubtitlesVoteRecorder ] } if {CorkDisplayNumCopies 1 ge} MightBeTrue { [ /CirclearraysCorkDisplay /TitlesCorkDisplay /SubtitlesCorkDisplay ] } if {NeckTagsNumCopies 1 ge} MightBeTrue { [ /CirclearraysNeckTags /Titles ] } if {PrePourNumCopies 1 ge} MightBeTrue { [ /CirclearraysPrePour /Titles ] } if {BottleWrapNumCopies 1 ge} MightBeTrue { [ /CirclearraysBottleWrap /Titles ] } if {StickyLabelsNumCopies 1 ge} {StickyLabelsTypes length 0 gt} MightBeTrue exch MightBeTrue and { [ /CirclearraysStickyLabels /Titles ] } if [ /GlassesOnSheets /NamesShowTop /NamesShowBottom /PageOrderingGlasses /MirrorPagesGlasses {DecanterLabelsNumCopies 1 ge} MightBeTrue {/PageOrderingDecanterLabels /MirrorPagesDecanterLabels} if {NeckTagsNumCopies 1 ge} MightBeTrue {/PageOrderingNeckTags /MirrorPagesNeckTags } if {PrePourNumCopies 1 ge} MightBeTrue {/PageOrderingPrePourPages /MirrorPagesPrePour } if {BottleWrapNumCopies 1 ge} MightBeTrue {/PageOrderingPrePourPages /MirrorPagesPrePour } if {StickyLabelsNumCopies 1 ge} {StickyLabelsTypes length 0 gt} MightBeTrue exch MightBeTrue and {/PageOrderingStickyLabels /MirrorPagesStickyLabels} if ShrinkRadii type /arraytype eq {/ShrinkRadii} if {WaterBoxes dup /Glasses eq exch /Both eq or WaterBoxesOverrideShowEverySheet not and} MightBeTrue {/WaterBoxesShowRight /WaterBoxesShowLeft} if {BackgroundTextsGlasses PrePourShowBackgroundTexts or} MightBeTrue {/BackgroundTextsGlassesTexts} if /FlightSeparations load MightBeTrue {/FlightSeparationLines} if ] [ /GlassesOnTastingNotePages /PageOrderingTastingNotePages /MirrorPagesTastingNotePages /BackgroundTextsTastingNotes load MightBeTrue {/BackgroundTextsTNsTexts} if ] [ /TastingNotesColumnHeadings /TastingNotesColumnRelativeWidths ] /PlaceNames load MightBeTrue {[ /NamesPlaceNames /PageOrderingPlaceNames /MirrorPagesPlaceNames ]} if /VoteRecorders load MightBeTrue {[ /GlassesClusteredOnVoteRecorders /VoteRecorderTopTexts /VoteRecorderShowTotalRow /VoteRecorderShowTotalCol /PageOrderingVoteRecorder /MirrorPagesVoteRecorder ]} if {DecantingNotesNumCopies 1 ge} MightBeTrue {[ /GlassesClusteredOnDecantingNotes /PageOrderingDecantingNotes /MirrorPagesDecantingNotes ]} if {AccountsNumCopies 1 ge} MightBeTrue {[ /AccountsColumnGroupHeadings /AccountsSubColumnHeadings ] [ /PageOrderingAccounts /MirrorPagesAccounts ]} if {CorkDisplayNumCopies 1 ge} MightBeTrue {[ /GlassesClusteredOnCorkDisplay /PageOrderingCorkDisplay /MirrorPagesCorkDisplay ]} if {NeckTagsNumCopies 1 ge} MightBeTrue {[ /PageOrderingNeckTags /MirrorPagesNeckTags ]} if /PagesToBeInserted load MightBeTrue {[ /PagesToBeInsertedNumPages /PagesToBeInsertedBeforeInstances /PagesToBeInsertedBeforeTypeOneOf /PagesToBeInsertedDests /PagesToBeInsertedDescriptions ]} if ] { /ArraysWhichShouldBeSameLength exch def 1 1 ArraysWhichShouldBeSameLength length 1 sub { /i exch def /i0 ArraysWhichShouldBeSameLength 0 get load execU dup type dup /arraytype eq {pop length} {/integertype ne {pop //null} if} ifelse def /ii ArraysWhichShouldBeSameLength i get load execU dup type dup /arraytype eq {pop length} {/integertype ne {pop //null} if} ifelse def i0 ii ne i0 //null ne ii //null ne and and { [ (Error: ) ArraysWhichShouldBeSameLength 0 get ToString ( and ) ArraysWhichShouldBeSameLength i get ToString ( should be the same length, but are actually of lengths ) i0 ToString ( and ) ii ToString (.) ] ASCIIfy OutputToLog /ErrorFlag //true store } if % ... 'ne' ... } for % i } bind forall % ArraysWhichShouldBeSameLength /TypeOfPagesBeingRendered /TastingNotes store 0 1 GlassesOnTastingNotePages length 1 sub { /TNSheetNum exch def GlassesOnTastingNotePages TNSheetNum GetEU { /WithinTitles exch execU def WithinTitles type /integertype ne {(Error: non-integer element of GlassesOnTastingNotePages.) OutputToLog /ErrorFlag //true store} if WithinTitles 0 lt {(Error: negative element of GlassesOnTastingNotePages.) OutputToLog /ErrorFlag //true store} if WithinTitles Titles length ge { mark (Error: With Titles of length ) Titles length ( no element of GlassesOnTastingNotePages should exceed ) Titles length 1 sub (, yet on tasting-note sheet ) TNSheetNum ( (starting at zero of course) is a ) WithinTitles ConcatenateToMark OutputToLog /ErrorFlag //true store } if } forall } bind for % TNSheetNum currentdict /WithinTitles undef currentdict /TNSheetNum undef /TastingNotesCirclesBehind load MightBeTrue { /product dup where { 2 dict begin exch get /p exch def /SearchString (Distiller) def //true 0 1 p length SearchString length sub {p exch SearchString length getinterval SearchString eq {pop //false exit} if} for { mark (\n!!! Error, possibly !!!) (\n!!! Ghostscript handles 'settransfer', used when TastingNotesCirclesBehind is true, in a manner ignored by Mac Preview !!!) (\n!!! Check with your preferred PDF reader that the circles on the tasting-note pages are faded rather than original darkness !!!) (\n!!! If not, then "/TastingNotesCirclesBehind false def" would be better !!!) (\n!!! And if printing from a Mac a file containing this warning, try printing from an Adobe product rather than Preview !!!) (\n) ConcatenateToMark OutputToLog } if % Not Distiller end } {pop} ifelse % /product where {TastingNotesCirclesBehindFadingFactorIfAllBlack 1 le} MightBeTrue not {TastingNotesCirclesBehindFadingFactorIfAllBlack 0 gt} MightBeTrue not or {(Error: TastingNotesCirclesBehindFadingFactorIfAllBlack <=0 or >1) OutputToLog /ErrorFlag //true store} if % TastingNotesCirclesBehindFadingFactorIfAllBlack out of range {TastingNotesCirclesBehindFadingFactorIfAnyGrey 1 le} MightBeTrue not {TastingNotesCirclesBehindFadingFactorIfAnyGrey 0 gt} MightBeTrue not or {(Error: TastingNotesCirclesBehindFadingFactorIfAnyGrey <=0 or >1) OutputToLog /ErrorFlag //true store} if % TastingNotesCirclesBehindFadingFactorIfAnyGrey out of range {TastingNotesCirclesBehindTopX 1 le} MightBeTrue not {TastingNotesCirclesBehindTopX 0 ge} MightBeTrue not or {(Error: TastingNotesCirclesBehindTopX <0 or >1) OutputToLog} if % TastingNotesCirclesBehindTopX out of range {TastingNotesCirclesBehindBottomX 1 le} MightBeTrue not {TastingNotesCirclesBehindBottomX 0 ge} MightBeTrue not or {(Error: TastingNotesCirclesBehindBottomX <0 or >1) OutputToLog} if % TastingNotesCirclesBehindBottomX out of range } if % ... TastingNotesCirclesBehind ... TastingNotesStarsNameColsRowsArrangement length 4 mod 0 eq { 0 4 TastingNotesStarsNameColsRowsArrangement length 1 sub { /i exch def {TastingNotesStarsNameColsRowsArrangement i 1 add GetEU type /integertype eq} MightBeTrue not {mark (Error: TastingNotesStarsNameColsRowsArrangement ) i 1 add ( get must be an integer.) ConcatenateToMark OutputToLog /ErrorFlag //true store} if {TastingNotesStarsNameColsRowsArrangement i 2 add GetEU type /integertype eq} MightBeTrue not {mark (Error: TastingNotesStarsNameColsRowsArrangement ) i 2 add ( get must be an integer.) ConcatenateToMark OutputToLog /ErrorFlag //true store} if {TastingNotesStarsNameColsRowsArrangement i 3 add GetEU dup dup /Alternating eq 3 1 roll /Sideways eq 3 1 roll /Upright eq or or} MightBeTrue not {mark (Error: TastingNotesStarsNameColsRowsArrangement ) i 3 add ( get is not one of /Alternating /Sideways /Upright.) ConcatenateToMark OutputToLog /ErrorFlag //true store} if % None of /Alternating /Sideways /Upright } for % i }{ mark (Error: TastingNotesStarsNameColsRowsArrangement of length ) TastingNotesStarsNameColsRowsArrangement length ( which is not a multiple of four.) ConcatenateToMark OutputToLog /ErrorFlag //true store } ifelse % ... length 4 mod 0 eq /TypeOfPagesBeingRendered /Accounts store {AccountsNumCopies 1 ge} MightBeTrue { 0 AccountsSubColumnHeadings {execU length add} forall AccountsColumnRelativeWidths length 2 copy ne { mark (Error: AccountsColumnRelativeWidths length = ) 3 -1 roll (, but lengths of AccountsSubColumnHeadings' sub-arrays total ) counttomark 2 add -1 roll (.) ConcatenateToMark OutputToLog /ErrorFlag //true store } {pop pop} ifelse % ... AccountsSubColumnHeadings ... AccountsColumnRelativeWidths length ne } if % ...AccountsNumCopies 1 ge... % Check that things at least might be a compound string /TypeOfPagesBeingRendered /Multiple store [ /Names /Titles /Abovetitles /Overtitles /Belowtitles % Not using GlassesNumCopies as these pages might be computed for sticky-label or pre-pour purposes, then not rendered {GlassesOnTastingNotePages length 0 gt} {TastingNotePagesNumCopies 1 ge} MightBeTrue exch MightBeTrue and {/NamesTastingNotes /TitlesTastingNotes /SubtitlesTastingNotes} if /VoteRecorders load MightBeTrue {/NamesVoteRecorder /TitlesVoteRecorder /SubtitlesVoteRecorder} if {DecantingNotesNumCopies 1 ge} MightBeTrue {/TitlesDecantingNotes /SubtitlesDecantingNotes} if {CorkDisplayNumCopies 1 ge} MightBeTrue {/TitlesCorkDisplay /SubtitlesCorkDisplay} if {BackgroundTextsGlasses PrePourShowBackgroundTexts BackgroundTextsTastingNotes or or} MightBeTrue {/BackgroundTextsGlassesTexts} if {AccountsNumCopies 1 ge} MightBeTrue {/NamesAccounts} if {StickyLabelsNumCopies 1 ge} MightBeTrue {/NamesStickyLabels} if AnyFillTextingAtAll {/FillTexts} if ] { /thing exch def thing load xcheck not { thing load type /arraytype eq { 0 1 thing load length 1 sub { /i exch def thing load i get MightBeCompoundString not { [ (Error: item ) i ToString ( of ) thing ToString ( should be a compound string, but isn't.) ] ASCIIfy OutputToLog /ErrorFlag //true store } if } for % i }{ [ (Error: ) thing ToString ( should be an array, but isn't.) ] ASCIIfy OutputToLog /ErrorFlag //true store } ifelse % ... MightBeCompoundString not } if % ... xcheck not } bind forall % compound strings at depth 1 [ /Circlearrays {GlassesOnTastingNotePages length 0 gt} {TastingNotePagesNumCopies 1 ge} MightBeTrue exch MightBeTrue and {/CirclearraysTastingNotes} if {VoteRecorders} MightBeTrue {/CirclearraysVoteRecorder} if {DecantingNotesNumCopies 1 ge} MightBeTrue {/CirclearraysDecantingNotes} if {CorkDisplayNumCopies 1 ge} MightBeTrue {/CirclearraysCorkDisplay} if {NeckTagsNumCopies 1 ge} MightBeTrue {/CirclearraysNeckTags} if /PlaceNames load MightBeTrue {/NamesPlaceNames} if ] { /thing exch def thing load xcheck not { thing load type /arraytype eq { 0 1 thing load length 1 sub { /i exch def thing load i get type /arraytype eq { 0 1 thing load i get length 1 sub { /j exch def thing load i get j get MightBeCompoundString not { mark (Error: item ) j ( of item ) i ( of ) thing ( should be a compound string, but isn't.) ConcatenateToMark OutputToLog /ErrorFlag //true store } if } for % j }{ [ (Error: item ) i ToString ( of ) thing ToString ( should be an array, but isn't.) ] ASCIIfy OutputToLog /ErrorFlag //true store } ifelse } for % i }{ [ (Error: ) thing ToString ( should be an array, but isn't.) ] ASCIIfy OutputToLog /ErrorFlag //true store } ifelse % ... MightBeCompoundString not } if % ... xcheck not } bind forall % compound strings at depth 2 currentdict /i undef currentdict /j undef % Check for a lone /quoteright, which might be a failure to compound a string 3 dict begin [ /Names /Titles /Abovetitles /Overtitles /Belowtitles {TastingNotePagesNumCopies 0 gt GlassesOnTastingNotePages length 0 gt and} MightBeTrue {/NamesTastingNotes /TitlesTastingNotes /SubtitlesTastingNotes} if /VoteRecorders load MightBeTrue {/NamesVoteRecorder /TitlesVoteRecorder /SubtitlesVoteRecorder} if {DecantingNotesNumCopies 0 gt} MightBeTrue {/TitlesDecantingNotes /SubtitlesDecantingNotes} if {CorkDisplayNumCopies 1 ge} MightBeTrue {/TitlesCorkDisplay /SubtitlesCorkDisplay} if {AccountsNumCopies 0 gt} MightBeTrue {/NamesAccounts} if {StickyLabelsNumCopies 0 gt} MightBeTrue {/NamesStickyLabels} if ] { /BeingChecked exch def 0 1 BeingChecked load execU length 1 sub { /WithinTitles exch def BeingChecked load execU WithinTitles get /quoteright eq {mark (Warning: in ) BeingChecked (, near item ) WithinTitles (, there might be missing string-compounding square brackets, []. Continuing.) ConcatenateToMark OutputToLog} if } for % WithinTitles } forall % BeingChecked [ /Circlearrays {TastingNotePagesNumCopies 0 gt GlassesOnTastingNotePages length 0 gt and} MightBeTrue {/CirclearraysTastingNotes} if /VoteRecorders load MightBeTrue {/CirclearraysVoteRecorder} if {DecantingNotesNumCopies 0 gt} MightBeTrue {/CirclearraysDecantingNotes} if {CorkDisplayNumCopies 1 ge} MightBeTrue {/CirclearraysCorkDisplay} if {NeckTagsNumCopies 1 ge} MightBeTrue {/CirclearraysNeckTags} if /PlaceNames load MightBeTrue {/NamesPlaceNames} if ] { /BeingChecked exch def 0 1 BeingChecked load execU length 1 sub { /WithinTitles exch def % wrong parameter name for NamesPlaceNames 0 1 BeingChecked load execU WithinTitles GetEU length 1 sub { /i exch def BeingChecked load execU WithinTitles GetEU i get /quoteright eq {mark (Warning: in ) BeingChecked ( ) WithinTitles ( get, near item ) i (, there might be missing string-compounding square brackets, []. Continuing.) ConcatenateToMark OutputToLog} if } for % i } for % WithinTitles } bind forall % BeingChecked end % Check headers and footers [ /HeadersLeft /HeadersCenter /HeadersRight /FootersLeft /FootersRight /FootersCenter ] { /HeaderFooterCheck exch def HeaderFooterCheck load xcheck not { HeaderFooterCheck load length 2 mod 0 ne {mark HeaderFooterCheck ( is not of even length.) OutputToLog /ErrorFlag //true store} if 0 2 HeaderFooterCheck load length 1 sub {/i exch def HeaderFooterCheck load i get IsNumber not {mark (Error: ) HeaderFooterCheck ( ) i ( get should be a number.) ConcatenateToMark OutputToLog /ErrorFlag //true store} if} for 1 2 HeaderFooterCheck load length 1 sub {/i exch def HeaderFooterCheck load i get MightBeCompoundString not {mark (Error: ) HeaderFooterCheck ( ) i ( get should be a compound string.) ConcatenateToMark OutputToLog /ErrorFlag //true store} if} for } if % ... xcheck not } forall % HeaderFooterCheck /TypeOfPagesBeingRendered /Glasses store {FontSizesRatioTitlesMin 1 lt not} MightBeTrue not { mark (Warning: FontSizesRatioTitlesMin = ) FontSizesRatioTitlesMin ( < 1. This is odd. Continuing with execution.) ConcatenateToMark OutputToLog } if % FontSizesRatioTitlesMin 1 lt {FontSizesRatioAboveBelowOverMin 1 lt not} MightBeTrue not { mark (Warning: FontSizesRatioAboveBelowOverMin = ) FontSizesRatioAboveBelowOverMin ( < 1. This is odd. Continuing with execution.) ConcatenateToMark OutputToLog } if % FontSizesRatioAboveBelowOverMin 1 lt {3 FontSizesSetsAboveBelowOver length eq} MightBeTrue not { mark (Error: FontSizesSetsAboveBelowOver has length ) FontSizesSetsAboveBelowOver length (; this should be exactly 3.) ConcatenateToMark OutputToLog /ErrorFlag //true store } if % NumSheets FontSizesSetsGlassesPages length ne {NumSheets FontSizesSetsGlassesPages length ne not} MightBeTrue not { mark (Error: FontSizesSetsGlassesPages has length ) FontSizesSetsGlassesPages length (; GlassesOnSheets has length ) NumSheets ConcatenateToMark OutputToLog /ErrorFlag //true store } if % NumSheets FontSizesSetsGlassesPages length ne {RotationTitlesAboveBelowOverCirclearray abs //ArcTanOneQuarter gt} MightBeTrue {PrePourNumCopies 1 ge} MightBeTrue and { 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def {RotationTitlesAboveBelowOverCirclearray abs //ArcTanOneQuarter gt} MightBeTrue PrePourNumCopies 1 ge and % RotationTitlesAboveBelowOverCirclearray might reference other variables such as MgnB { (Warning: RotationTitlesAboveBelowOverCirclearray non-small => pre-pour sheets can look too different to glasses sheets.) OutputToLog exit } if % pre-pours not quite matching } for % WithinPage, WithinTitles } for % SheetNum } if % might be pre-pours not quite matching currentdict /WithinTitles undef currentdict /WithinPage undef currentdict /SheetNum undef {ExclusionAnnulusProportionInnerRadiusTitlesAboveBelow 1 lt} MightBeTrue not {(Error: ExclusionAnnulusProportionInnerRadiusTitlesAboveBelow >= 1.) OutputToLog /ErrorFlag //true store} if {ExclusionAnnulusProportionInnerRadiusOvertitles 1 lt} MightBeTrue not {(Error: ExclusionAnnulusProportionInnerRadiusOvertitles >= 1.) OutputToLog /ErrorFlag //true store} if {ExclusionAnnulusProportionInnerRadiusTitlesAboveBelow 0 ge} MightBeTrue not {(Warning: ExclusionAnnulusProportionInnerRadiusTitlesAboveBelow < 0.) OutputToLog} if {ExclusionAnnulusProportionInnerRadiusOvertitles 0 ge} MightBeTrue not {(Warning: ExclusionAnnulusProportionInnerRadiusOvertitles < 0.) OutputToLog} if {SideBySideGlassesTastingNotes not} MightBeTrue not { GlassesOnSheets length GlassesOnTastingNotePages length ne {(Warning: SideBySideGlassesTastingNotes is true, but the lengths of GlassesOnSheets and GlassesOnTastingNotePages differ. This is probably an error.) OutputToLog} if Orientation /Landscape ne {(Warning: SideBySideGlassesTastingNotes is true, but Orientation is not /Landscape.) OutputToLog} if TastingNotesCirclesBehind {(Warning: SideBySideGlassesTastingNotes and TastingNotesCirclesBehind are both true, which might be inelegant.) OutputToLog} if } if % ... SideBySideGlassesTastingNotes ... /TypeOfPagesBeingRendered /Multiple store [ /VoteRecorders load MightBeTrue {/GlassesClusteredOnVoteRecorders } if {DecantingNotesNumCopies 0 gt} MightBeTrue {/GlassesClusteredOnDecantingNotes} if {CorkDisplayNumCopies 1 ge} MightBeTrue {/GlassesClusteredOnCorkDisplay } if ]{ 5 dict begin /ClusterCheck exch def /ValueMax -1 1 { /GlassesClusteredOnVoteRecorders ClusterCheck eq {pop TitlesVoteRecorder execU length 1 sub exit} if /GlassesClusteredOnDecantingNotes ClusterCheck eq {pop TitlesDecantingNotes execU length 1 sub exit} if /GlassesClusteredOnCorkDisplay ClusterCheck eq {pop TitlesCorkDisplay execU length 1 sub exit} if } repeat def % /ValueMax ClusterCheck load xcheck not { ClusterCheck load type /arraytype eq { 0 1 ClusterCheck load length 1 sub { /i exch def ClusterCheck load i get xcheck not { ClusterCheck load i get type /arraytype eq { ClusterCheck /GlassesClusteredOnVoteRecorders eq ClusterCheck /GlassesClusteredOnDecantingNotes eq or { /j 0 ClusterCheck load i get {length add} forall def % in next for loop j has a different meaning j 36 gt { j 60 gt {mark (Error re ) ClusterCheck ( ) i ( get, which has sum lengths = ) j (, anything >60 being ludicrous. Nonetheless, continuing.) ConcatenateToMark OutputToLog} {mark (Warning re ) ClusterCheck ( ) i ( get, which has sum lengths = ) j (, anything >36 being tight. Nonetheless, continuing.) ConcatenateToMark OutputToLog} ifelse % j 60 gt } if % j 36 gt } if % ... /GlassesClusteredOnVoteRecorders ... /GlassesClusteredOnDecantingNotes ... or 0 1 ClusterCheck load i get length 1 sub { /j exch def ClusterCheck load i get j get xcheck not { ClusterCheck load i get j get type /arraytype eq { 0 1 ClusterCheck load i get j get length 1 sub { /k exch def ClusterCheck load i get j get k get xcheck not { ClusterCheck load i get j get k get type /integertype eq { ClusterCheck load i get j get k get dup dup 0 lt {mark (Warning: ) ClusterCheck ( ) i ( get ) j ( get ) k ( get = ) counttomark 2 add -1 roll ( is negative; will be blank.) ConcatenateToMark OutputToLog} {pop} ifelse dup ValueMax gt {mark (Error: ) ClusterCheck ( ) i ( get ) j ( get ) k ( get = ) counttomark 2 add -1 roll ( exceeds ) Titles length 1 sub (.) ConcatenateToMark OutputToLog /ErrorFlag //true store} {pop} ifelse } {mark (Error: ) ClusterCheck ( ) i ( get ) j ( get ) k ( get should be an integer, but isn't.) ConcatenateToMark OutputToLog /ErrorFlag //true store} ifelse % ... type /integertype } if % ClusterCheck load i get j get k get dup xcheck not } for % k } {mark (Error: ) ClusterCheck ( ) i ( get ) j ( get should be an array, but isn't.) ConcatenateToMark OutputToLog /ErrorFlag //true store} ifelse % ... type /arraytype } if % ClusterCheck load i get j get dup xcheck not } for % j } {mark (Error: ) ClusterCheck ( ) i ( get should be an array, but isn't.) ConcatenateToMark OutputToLog /ErrorFlag //true store} ifelse % ... type /arraytype } if % ClusterCheck load i get dup xcheck not } for % i } {mark (Error: ) ClusterCheck ( should be an array, but isn't.) ConcatenateToMark OutputToLog /ErrorFlag //true store} ifelse % ... type /arraytype } if % ClusterCheck load xcheck not end } bind forall % GlassesClustered... /TypeOfPagesBeingRendered /Multiple store ExternalLinks length 3 mod 0 eq dup {0 3 ExternalLinks length 1 sub {ExternalLinks exch get type /booleantype ne {pop //false exit} if} for} if dup {1 3 ExternalLinks length 1 sub {ExternalLinks exch get MightBeCompoundString not {pop //false exit} if} for} if dup {2 3 ExternalLinks length 1 sub {ExternalLinks exch get type /stringtype ne {pop //false exit} if} for} if not { (Error: ExternalLinks should be an array of length a multiple of 3, containing: indented-boolean0, Descriptor0, http://URL0, indented-boolean1, Descriptor1, http://URL1, .... The URLs must be strings, not compound strings.) OutputToLog /ErrorFlag //true store } if % Wrong length or contains non-strings ExternalLinks length 0 gt {ExternalLinks 0 GetEU //false ne {mark (Warning: first item of ExternalLinks deemed to be false, even though it is ) ExternalLinks 0 get ConcatenateToMark OutputToLog} if} if {BackgroundTextsGlasses PrePourShowBackgroundTexts BackgroundTextsTastingNotes or or} MightBeTrue { 0 1 NumSheets 1 sub { /SheetNum exch def BackgroundTextsSquooshMin BackgroundTextsSquooshMax gt { mark (Error: ) BackgroundTextsSquooshMin ( = BackgroundTextsSquooshMin > BackgroundTextsSquooshMax = ) BackgroundTextsSquooshMax ConcatenateToMark OutputToLog /ErrorFlag //true store } if % BackgroundTextsSquooshMin BackgroundTextsSquooshMax gt } for % SheetNum currentdict /SheetNum undef } if % /BackgroundTextsGlasses ... 0 1 NumSheets 1 sub { /SheetNum exch def //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns FlightSeparations { 3 dict begin 0 1 FlightSeparationLines SheetNum GetEU length 1 sub { /FlightSeparationLineNum exch def /fsl FlightSeparationLines SheetNum GetEU FlightSeparationLineNum GetEU def 0 1 fsl length 1 sub { /fsl_i exch def fsl fsl_i get dup dup xcheck not { type /arraytype eq { { dup dup type /integertype eq { 0 lt {mark (Error: FlightSeparationLines ) SheetNum ( get ) FlightSeparationLineNum ( get ) fsl_i ( get contains a negative integer.) ConcatenateToMark OutputToLog /ErrorFlag //true store} if GlassesOnSheets SheetNum GetEU length ge { mark (Error: FlightSeparationLines ) SheetNum ( get ) FlightSeparationLineNum ( get ) fsl_i ( get contains an integer exceeding ) GlassesOnSheets SheetNum GetEU length 1 sub (: too large for the number of glasses on the page.) ConcatenateToMark OutputToLog /ErrorFlag //true store } if % Integer too big } {pop pop} ifelse % /integertype } forall } {pop} ifelse % type /arraytype } {pop pop} ifelse % ... xcheck not } for % fsl_i } for % FlightSeparationLineNum end } if % FlightSeparations } for % SheetNum 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def /VoteRecorderSubtitleFontSizeProportionTitles load dup IsNumber {0 le} {pop //false} ifelse { mark (VoteRecorderSubtitleFontSizeProportionTitles=) VoteRecorderSubtitleFontSizeProportionTitles ( with SheetNum=) SheetNum ( WithinPage=) WithinPage ( WithinTitles=) WithinTitles (, but must be strictly positive.) ConcatenateToMark OutputToLog /ErrorFlag //true store } if % ... VoteRecorderSubtitleFontSizeProportionTitles ... /DecantingNotesSubtitleFontSizeProportionTitles load dup IsNumber {0 le} {pop //false} ifelse { mark (DecantingNotesSubtitleFontSizeProportionTitles=) DecantingNotesSubtitleFontSizeProportionTitles ( with SheetNum=) SheetNum ( WithinPage=) WithinPage ( WithinTitles=) WithinTitles (, but must be strictly positive.) ConcatenateToMark OutputToLog /ErrorFlag //true store } if % ... DecantingNotesSubtitleFontSizeProportionTitles ... } for % WithinPage, WithinTitles } for % SheetNum ErrorFlag {stop} if currentdict /ErrorFlag undef % End of elementary error-checking //DeBugLevel 100 le {( Main: some pre-computations) OutputToLog} if /CircleNonEmpty [ SheetLengths {array} forall ] def 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def CircleNonEmpty SheetNum get WithinPage //false [ Circlearrays Titles Overtitles Abovetitles Belowtitles ] {WithinTitles get NonEmptyCompoundObject {pop //true exit} if} forall put } for % WithinPage, WithinTitles } bind for % SheetNum, within which CircleNonEmpty populated //DeBugLevel 100 le {( Main: calling routines to pack circles) OutputToLog} if /PackingDescriptors NumSheets array def /NamePlacementBottomX NumSheets array def /NamePlacementTopX NumSheets array def /Radii NumSheets array def /GlassPositions NumSheets array def % WithinPage0 WithinPage1 HalfDistanceBetweenCentresProportionRadius real /HalfDistanceBetweenCentresProportionRadius { GlassPositions SheetNum get dup 4 -1 roll get aload pop 4 2 roll exch get aload pop 3 -1 roll sub dup mul 3 1 roll sub dup mul add sqrt 2 div Radii SheetNum get div } bind def % /HalfDistanceBetweenCentresProportionRadius /CodeCallCirclePacking { 9 dict begin /Echo exch def /MaxRadius exch def //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns % Call CirclePacking % LeftX BottomY Width Height NumGlasses MaxRadius CirclePacking [[x1 y1] ...] Radius NamePlacementTopX NamePlacementBottomX MgnL MgnB PageWidth MgnL MgnR add sub PageHeight MgnB MgnT add sub SheetLengths SheetNum get /MaxRadius load Echo CirclePacking NamePlacementBottomX SheetNum 3 -1 roll put NamePlacementTopX SheetNum 3 -1 roll put PackingDescriptors SheetNum 3 -1 roll put Radii SheetNum 3 -1 roll put GlassPositions SheetNum 3 -1 roll put % Check GlassPositions. There shouldn't be errors, but there might be uncaught special cases. /GlassPositionsBug //false def 0 1 SheetLengths SheetNum get 1 sub { /WithinPage exch def GlassPositions SheetNum get WithinPage get aload pop 2 copy PageHeight MgnT sub Radii SheetNum get sub //PrinterEpsilon add gt {mark (Error: GlassPositions ) SheetNum ( get ) WithinPage ( get, being above top margin.) ConcatenateToMark OutputToLog /GlassPositionsBug //true def} if PageWidth MgnR sub Radii SheetNum get sub //PrinterEpsilon add gt {mark (Error: GlassPositions ) SheetNum ( get ) WithinPage ( get, being outside right margin.) ConcatenateToMark OutputToLog /GlassPositionsBug //true def} if MgnB Radii SheetNum get add //PrinterEpsilon sub lt {mark (Error: GlassPositions ) SheetNum ( get ) WithinPage ( get, being below bottom margin.) ConcatenateToMark OutputToLog /GlassPositionsBug //true def} if MgnL Radii SheetNum get add //PrinterEpsilon sub lt {mark (Error: GlassPositions ) SheetNum ( get ) WithinPage ( get, being outside left margin.) ConcatenateToMark OutputToLog /GlassPositionsBug //true def} if 0 1 WithinPage 1 sub { /WP exch def GlassPositions SheetNum get dup WithinPage get aload pop 3 -1 roll WP get aload pop 3 -1 roll sub dup mul 3 1 roll sub dup mul add dup Radii SheetNum get //PrinterEpsilon sub dup mul lt { mark (Error: GlassPositions too close by ) counttomark 2 add -1 roll sqrt Radii SheetNum get sub (pt, on SheetNum = ) SheetNum (WithinPage = ) WP ( and ) WithinPage (, ) SheetLengths SheetNum get ( glasses as ) PackingDescriptors SheetNum get ( on ) PaperType (.) ConcatenateToMark OutputToLog /GlassPositionsBug //true def } {pop} ifelse % too close } for % WP } for % WithinPage GlassPositionsBug {mark (Error in the computation of GlassPositions ) SheetNum ( get. Please submit an issue to http://github.com/jdaw1/placemat/issues/ . Execution continuing.) ConcatenateToMark OutputToLog} if UndefMgns end } bind def % CodeCallCirclePacking /TypeOfPagesBeingRendered /Glasses store 0 1 NumSheets 1 sub { /SheetNum exch def /MaxRadius load {GlassesNumCopies 1 ge} MightBeTrue CodeCallCirclePacking % MaxRadius might contain code that refers to SheetNum } for % SheetNum currentdict /SheetNum undef /ShrinkRadiiSquareArray [ 0 1 NumSheets 1 sub { /SheetNum exch def [ 0 1 NumSheets 1 sub { /SN exch def SheetNum SN eq {//true} { ShrinkRadii /ToSmallestSamePageOrdering eq {PageOrderingGlasses SheetNum GetEU PageOrderingGlasses SN GetEU eq} {ShrinkRadii type /arraytype eq {ShrinkRadii SheetNum GetEU ShrinkRadii SN GetEU eq} {ShrinkRadii /ToSmallest eq} ifelse} ifelse % ShrinkRadii /ToSmallestSamePageOrdering eq } ifelse % SheetNum SN eq << /SheetNum SN >> begin {GlassesNumCopies} ValueIfAscertainable end not {1} if 0 gt {GlassesNumCopies} ValueIfAscertainable not {1} if 0 le and {pop //false} if } for % SN ] } bind for % SheetNum ] def % /ShrinkRadiiSquareArray /ExtraLogLineNeedsDoing //true def 0 1 NumSheets 1 sub { /SheetNum exch def /RedoCirclePacking //false def 0 1 NumSheets 1 sub { /SN exch def SheetNum SN ne { ShrinkRadiiSquareArray SN get SheetNum get { ExtraLogLineNeedsDoing {() OutputToLog /ExtraLogLineNeedsDoing //false def} if Radii SheetNum get Radii SN get gt { Radii SheetNum Radii SN get put /RedoCirclePacking //true def } if % Radii SheetNum get Radii SN get gt } if % ShrinkRadiiSquareArray SN get SheetNum get } if % SheetNum SN ne } for % SN RedoCirclePacking {Radii SheetNum get //false CodeCallCirclePacking} if } bind for % SheetNum currentdict /SN undef currentdict /RedoCirclePacking undef currentdict /SheetNum undef currentdict /ExtraLogLineDone undef currentdict /CodeCallCirclePacking undef % Thing0 Thing1 TwoArraysEqual boolean /TwoArraysEqual { 2 dict begin GSave 0 0 moveto /Thing1 exch def 0 0 moveto /Thing0 exch def /Thing0 load type /arraytype eq dup /Thing1 load type /arraytype eq eq { { /Thing0 load length /Thing1 load length eq { //true 0 1 /Thing0 load length 1 sub { dup /Thing0 load exch get exch /Thing1 load exch get TwoArraysEqual not {pop //false exit} if } for } {false} ifelse } {/Thing0 load /Thing1 load eq} ifelse % both or neither array } {pop //false} ifelse GRestore end } bind def % /TwoArraysEqual mark (Radii = ) Radii SizeArrayOutput TrimSpaces ( => diameters ~= ) () [ Radii {mark exch dup 127 mul 180 div 1 FormatDecimalPlaces exch 36 div 2 FormatDecimalPlaces (mm~=) exch (") ConcatenateToMark} forall ] SizeArrayOutput TrimSpaces (.) ConcatenateToMark OutputToLog /GlassesOnSheetsAndTastingNotePagesEqual GlassesOnSheets GlassesOnTastingNotePages TwoArraysEqual def /ByRearrangementArrayString { 11 dict begin /ShowStringBrackets exch def /Suffix exch def /DataArray exch def /RearrangementArray exch def /DescriptionString exch def /NameNum Names length def [ 0 1 RearrangementArray length 1 sub { dup /SheetNum exch def /TNSheetNum exch def [ 0 1 RearrangementArray SheetNum GetEU length 1 sub { /WithinPage exch def /WithinTitles RearrangementArray SheetNum GetEU WithinPage GetEU def DataArray WithinTitles get ASCIIfy Suffix Concatenate } for % WithinPage, WithinTitles ] 0 ShowStringBrackets ThingToDebugText } for ] RearrangementArray length 1 le { DescriptionString ( = [ ) 3 -1 roll aload pop ( ]) }{ DescriptionString ( =\n[) 3 -1 roll {(\n\t) exch} forall (\n]) } ifelse % RearrangementArray length 1 le end } bind def % /ByRearrangementArrayString mark % Matching 'ConcatenateToMark OutputToLog' about 14 lines down (GlassesOnSheets = ) GlassesOnSheets 0 {pop exec} //true TwoArraysFunction 0 //true ThingToDebugText % To help with multi-page tastings, OutputToLog the Titles by page, and like tasks GlassesOnSheets length 0 gt { (\nTitles, ASCIIfied and re-arranged by GlassesOnSheets) GlassesOnSheets Titles () //true ByRearrangementArrayString /GlassesNumCopies load dup 1 eq {pop} {(\nGlassesNumCopies = ) exch 0 //true ThingToDebugText} ifelse } if % GlassesOnSheets length 0 gt {VoteRecorders CorkDisplayNumCopies 0 gt or DecantingNotesNumCopies 0 gt or TastingNotePagesNumCopies 0 gt GlassesOnTastingNotePages length 0 gt and or} MightBeTrue { GlassesOnSheetsAndTastingNotePagesEqual {(\nGlassesOnTastingNotePages = GlassesOnSheets)} {(\nGlassesOnTastingNotePages = ) GlassesOnTastingNotePages 0 {pop exec} //true TwoArraysFunction 0 //true ThingToDebugText} ifelse GlassesOnSheetsAndTastingNotePagesEqual not {(\nTitlesTastingNotes, ASCIIfied and re-arranged by GlassesOnTastingNotePages) GlassesOnTastingNotePages TitlesTastingNotes () //true ByRearrangementArrayString} if /TastingNotePagesNumCopies load dup 1 eq {pop} {(\nTastingNotePagesNumCopies = ) exch 0 //true ThingToDebugText} ifelse } if % {... TastingNotePagesNumCopies 0 gt ...} MightBeTrue ConcatenateToMark OutputToLog % Matching 'mark' about 14 lines up //DeBugLevel 100 le {( Main: computing RadiiCirclearrayBaseline, CirclearraysFontSizes, RadiiCirclearrayInside, CirclearraysN) OutputToLog} if /CirclearraysFontSizes [ SheetLengths {array} forall ] def /CirclearraysN [ SheetLengths {array} forall ] def /CirclearraysUnroundedN [ SheetLengths {array} forall ] def /CircletextsMinCopiesIndividually [ SheetLengths {array} forall ] def /RadiiCirclearrayBaseline NumSheets array def /RadiiCirclearrayInside NumSheets array def /RadiiCirclearrayInsideUsableTAB NumSheets array def /RadiiCirclearrayInsideUsableO NumSheets array def /CircletextMaxFontSizes [ NumSheets {//Infinity} repeat ] def /CirclearraysB [ SheetLengths {array} forall ] def /CirclearraysT [ SheetLengths {array} forall ] def /CirclearraysDescenderMin [ NumSheets {0} repeat ] def 18 dict begin /CirclearraysW [ SheetLengths {array} forall ] def /CirclearraysPaddedW [ SheetLengths {array} forall ] def /CirclearraysBMin [ NumSheets {0} repeat ] def 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def CircletextsMinCopiesIndividually SheetNum get WithinPage CircletextsMinCopies put CircletextFont //DeSizeRounding selectfont 0 Circlearrays WithinTitles get {StringWidthRecursive add} forall //DeSizeRounding div % if an item of the array is a user path then joining the paths would fail dup CirclearraysW SheetNum get exch WithinPage exch put ( ) stringwidth pop CircletextsMinNumSpacesBetween mul Circlearrays WithinTitles get length mul //DeSizeRounding div add CirclearraysPaddedW SheetNum get exch WithinPage exch put CircletextFont //DeSizeRounding selectfont CirclearraysT SheetNum get WithinPage //InfinityNeg put CirclearraysB SheetNum get WithinPage //Infinity put Circlearrays WithinTitles get { StringPathBBox //DeSizeRounding div CirclearraysT SheetNum get WithinPage 3 copy get gt {3 -1 roll put} {pop pop pop} ifelse pop //DeSizeRounding div CirclearraysB SheetNum get WithinPage 3 copy get lt {3 -1 roll put} {pop pop pop} ifelse pop } forall % Circlearrays WithinTitles get CirclearraysB SheetNum get WithinPage get CirclearraysBMin SheetNum 3 copy get lt {3 -1 roll put} {pop pop pop} ifelse } for % WithinPage, WithinTitles } bind for % SheetNum /CirclearraysFontSizesNext [ SheetLengths { [ exch {0} repeat] } forall ] def % - CirclearraysNScore Score % Score = Avg of CirclearraysN * CirclearraysW * CirclearraysFontSizes^2 / (Radii*TwoPi) ~= average area of painted Circlearrays / (Radius*TwoPi) % We maximise this 'area', or ink usage. So if shrinking the font size adds enough to N to increase ink, it is done. % Consider extreme case. Reducing font size by 30% will reduce area per instance by 51%. Going from 1.999 copies to 2 would almost offset that. % But the multiplication by 1/0.7 won't get it above 2.85 instances, so the _maximum_ reduction in font size is less than 30%. Hence optimisation will always terminate. % CirclearraysNScore is not a pure functional function. De facto input is CircletextsMinCopiesIndividually. % Output is by populating CirclearraysFontSizes, CircletextMaxFontSizes, CirclearraysBMin, CirclearraysDescenderMin, RadiiCirclearrayBaseline. /CirclearraysNScore { 6 dict begin % Minima and maxima over all sheets with radii compelled to match 0 1 NumSheets 1 sub {/SN0 exch def 0 1 NumSheets 1 sub {/SN1 exch def ShrinkRadiiSquareArray SN0 get SN1 get { CirclearraysBMin dup SN0 get exch SN1 3 copy get lt {3 -1 roll put} {pop pop pop} ifelse } if} for} for 0 1 NumSheets 1 sub % Font sizes. If CircletextsSameFontSizeIfRadiiShrunkToBeSame then answer final; otherwise preliminary. { /SheetNum exch def CircletextsSameFontSizeIfRadiiShrunkToBeSame { //Infinity 0 1 SheetLengths SheetNum get 1 sub { 4 dict begin WithinPage-WithinTitles-def /CircletextsBasicFS CircletextFontSize def % NumCopies * WidthUnitFont * FontSize = TwoPi * (CirclearraysBMin * FontSize + Radius) % <==> NumCopies = TwoPi * (CirclearraysBMin + Radius/FontSize) / WidthUnitFont % <==> FontSize = TwoPi * Radius / (NumCopies * WidthUnitFont - TwoPi * CirclearraysBMin) /CircletextsBasicNC CircletextsBasicFS 0 gt {Radii SheetNum get CircletextsBasicFS div CirclearraysBMin SheetNum get add //TwoPi mul //PrinterEpsilon sub CirclearraysPaddedW SheetNum get WithinPage get dup 0 gt {div} {pop pop //Infinity} ifelse} {//Infinity} ifelse def CircletextsBasicNC CircletextsMinCopiesIndividually SheetNum get WithinPage get floor lt { //TwoPi Radii SheetNum get mul CircletextsMinCopiesIndividually SheetNum get WithinPage get floor CirclearraysPaddedW SheetNum get WithinPage get mul CirclearraysBMin SheetNum get //TwoPi mul sub div } {CircletextsBasicFS} ifelse % CircletextsBasicNC ... lt CircletextsBasicFS //SqrtSqrt2 mul 2 {2 copy gt {exch} if pop} repeat end % Embedded constant: 'Slightly' is a factor of not more than the fourth root of two. } for % WithinPage, WithinTitles CircletextMaxFontSizes exch SheetNum exch put 0 1 SheetNum 1 sub % Non-standard upper limit { /SN1 exch def ShrinkRadiiSquareArray SheetNum get SN1 get {CircletextMaxFontSizes SN1 get CircletextMaxFontSizes SheetNum 3 copy get lt {3 -1 roll put} {pop pop pop} ifelse} if } for % SN1 RadiiCirclearrayBaseline SheetNum CircletextMaxFontSizes SheetNum get CirclearraysBMin SheetNum get mul Radii SheetNum get add put 0 1 SheetLengths SheetNum get 1 sub {CirclearraysFontSizes SheetNum get exch CircletextMaxFontSizes SheetNum get put} for 0 1 NumSheets 1 sub { /SN1 exch def ShrinkRadiiSquareArray SheetNum get SN1 get {CircletextMaxFontSizes SheetNum get CircletextMaxFontSizes SN1 3 copy get lt { 3 -1 roll put RadiiCirclearrayBaseline SN1 CircletextMaxFontSizes SN1 get CirclearraysBMin SN1 get mul Radii SN1 get add put 0 1 SheetLengths SN1 get 1 sub {CirclearraysFontSizes SN1 get exch CircletextMaxFontSizes SN1 get put} for } {pop pop pop} ifelse} if % ShrinkRadiiSquareArray ... } for % SN1 }{ 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def CirclearraysPaddedW SheetNum get WithinPage get CircletextsMinCopiesIndividually SheetNum get WithinPage get mul //TwoPi div CirclearraysB SheetNum get WithinPage get sub dup 0 gt { Radii SheetNum get exch div CircletextFontSize 2 copy gt {exch} if pop dup CircletextMaxFontSizes SheetNum 3 copy get gt {3 -1 roll put} {pop pop pop} ifelse dup CirclearraysB SheetNum get WithinPage get mul CirclearraysDescenderMin SheetNum 3 copy get lt {3 -1 roll put} {pop pop pop} ifelse } {pop //PrinterEpsilon} ifelse % ... 0 gt CirclearraysFontSizes SheetNum get exch WithinPage exch put } for % WithinPage, WithinTitles } ifelse % CircletextsSameFontSizeIfRadiiShrunkToBeSame } for % SheetNum {CircletextsSameFontSizeIfRadiiShrunkToBeSame not} MightBeTrue { 0 1 NumSheets 1 sub {/SN0 exch def 0 1 NumSheets 1 sub {/SN1 exch def ShrinkRadiiSquareArray SN0 get SN1 get { CirclearraysDescenderMin dup SN0 get exch SN1 3 copy get lt {3 -1 roll put} {pop pop pop} ifelse } if} for} for } if % ... CircletextsSameFontSizeIfRadiiShrunkToBeSame not ... % CircletextsSameFontSizeIfRadiiShrunkToBeSame not => Common inner radii, different font sizes. So use deepest descender. 0 1 NumSheets 1 sub { /SheetNum exch def CircletextsSameFontSizeIfRadiiShrunkToBeSame not { RadiiCirclearrayBaseline SheetNum Radii SheetNum get CirclearraysDescenderMin SheetNum get add put 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def CirclearraysPaddedW SheetNum get WithinPage get CircletextsMinCopiesIndividually SheetNum get WithinPage get mul dup 0 gt { RadiiCirclearrayBaseline SheetNum get //TwoPi mul exch div CircletextFontSize 2 copy gt {exch} if pop } {pop //PrinterEpsilon} ifelse CirclearraysFontSizes SheetNum get exch WithinPage exch put } for % WithinPage, WithinTitles } if % CircletextsSameFontSizeIfRadiiShrunkToBeSame not } for % SheetNum % RadiiCirclearrayInside, RadiiCirclearrayInsideUsableTAB, RadiiCirclearrayInsideUsableO RadiiCirclearrayInside 0 RadiiCirclearrayBaseline putinterval 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { /WithinPage exch def RadiiCirclearrayBaseline SheetNum get CirclearraysT SheetNum get WithinPage get CirclearraysFontSizes SheetNum get WithinPage get mul sub RadiiCirclearrayInside SheetNum 3 copy get lt {3 -1 roll put} {pop pop pop} ifelse } for % WithinPage RadiiCirclearrayInsideUsableTAB SheetNum RadiiCirclearrayInside SheetNum get 1 ExclusionAnnulusProportionInnerRadiusTitlesAboveBelow sub mul put RadiiCirclearrayInsideUsableO SheetNum RadiiCirclearrayInside SheetNum get 1 ExclusionAnnulusProportionInnerRadiusOvertitles sub mul put 0 1 SheetNum 1 sub % Non-standard upper limit { /SN1 exch def ShrinkRadiiSquareArray SheetNum get SN1 get { RadiiCirclearrayBaseline SN1 get RadiiCirclearrayBaseline SheetNum 3 copy get lt {3 -1 roll put} {pop pop pop} ifelse RadiiCirclearrayBaseline SheetNum get RadiiCirclearrayBaseline SN1 3 copy get lt {3 -1 roll put} {pop pop pop} ifelse RadiiCirclearrayInside SN1 get RadiiCirclearrayInside SheetNum 3 copy get lt {3 -1 roll put} {pop pop pop} ifelse RadiiCirclearrayInside SheetNum get RadiiCirclearrayInside SN1 3 copy get lt {3 -1 roll put} {pop pop pop} ifelse } if % ShrinkRadiiSquareArray ... } for % SN1 } for % SheetNum % CirclearraysUnroundedN 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def CirclearraysPaddedW SheetNum get WithinPage get CirclearraysFontSizes SheetNum get WithinPage get mul dup 0 gt { RadiiCirclearrayBaseline SheetNum get //TwoPi mul //PrinterEpsilon add exch div /n exch def n CircletextsMinCopies lt {mark (Error: CirclearraysUnroundedN ) SheetNum ( get ) WithinPage ( get = ) n ( less than CircletextsMinCopies=) CircletextsMinCopies ConcatenateToMark OutputToLog} if } {pop /n 0 def} ifelse % ... 0 gt CirclearraysUnroundedN SheetNum get WithinPage n put } for % WithinPage, WithinTitles } for % SheetNum % CirclearraysN, and Score 0 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { /WithinPage exch def CirclearraysN SheetNum get WithinPage CirclearraysUnroundedN SheetNum get WithinPage get floor cvi CircletextsMaxCopies floor cvi 2 copy gt {exch} if pop % Capped dup 4 1 roll put CirclearraysW SheetNum get WithinPage get mul CirclearraysFontSizes SheetNum get WithinPage get dup mul mul Radii SheetNum get div add } for % WithinPage } for % SheetNum //TwoPi div 0 SheetLengths {add} forall dup 0 le {pop 1} if div end } bind def % /CirclearraysNScore /CirclearraysBestScore CirclearraysNScore def 64 CircletextsTweakSize {-1} {1} ifelse 0 { /CirclearraysAnyImprovement //false def /CirclearraysUnroundedNBest [ CirclearraysUnroundedN {[ exch {} forall ]} forall ] def % Depth-2 copy /CirclearraysProtoBestFontSize 0 def /CirclearraysProtoBestScore //null def /CirclearraysProtoBestSheetNum //null def /CirclearraysProtoBestWithinPage //null def /CirclearraysProtoBestMinCopies //null def 0 eq {(Warning: CirclearraysNScore not converging. Execution continuing, but please submit an issue to http://github.com/jdaw1/placemat/issues/) OutputToLog} if 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def /CircletextsOriginal CircletextsMinCopiesIndividually SheetNum get WithinPage get def CirclearraysUnroundedNBest SheetNum get WithinPage get floor cvi 1 add dup CircletextsMaxCopies cvi le { CircletextsMinCopiesIndividually SheetNum get exch WithinPage exch put /CirclearraysNewScore CirclearraysNScore def CirclearraysNewScore CirclearraysBestScore gt CirclearraysFontSizes SheetNum get WithinPage get CirclearraysProtoBestFontSize gt and % Doing smallest possible steps prevents jumping past best score { /CirclearraysAnyImprovement //true def /CirclearraysProtoBestFontSize CirclearraysFontSizes SheetNum get WithinPage get store /CirclearraysProtoBestScore CirclearraysNewScore store /CirclearraysProtoBestSheetNum SheetNum store /CirclearraysProtoBestWithinPage WithinPage store /CirclearraysProtoBestMinCopies CircletextsMinCopiesIndividually SheetNum get WithinPage get store } if % CirclearraysNewScore CirclearraysBestScore gt CirclearraysFontSizes ... CirclearraysProtoBestFontSize gt and CircletextsMinCopiesIndividually SheetNum get WithinPage CircletextsOriginal put } {pop} ifelse % ... CircletextsMaxCopies ... lt } for % WithinPage, WithinTitles } for % SheetNum CirclearraysAnyImprovement { /CirclearraysBestScore CirclearraysProtoBestScore store CircletextsMinCopiesIndividually CirclearraysProtoBestSheetNum get CirclearraysProtoBestWithinPage CirclearraysProtoBestMinCopies put CirclearraysNScore pop 0 1 NumSheets 1 sub {dup CirclearraysUnroundedN exch get exch CirclearraysUnroundedNBest exch get copy pop} for } {CirclearraysNScore pop exit} ifelse % CirclearraysAnyImprovement } bind for % Effectively forever end {GlassesNumCopies 1 ge PrePourNumCopies 1 ge or NumSheets 1 ge and} MightBeTrue {GlassesOnTastingNotePages length 1 ge TastingNotePagesNumCopies 1 ge TastingNotesCirclesBehind and and} MightBeTrue or { mark (CirclearraysFontSizes = ) CirclearraysFontSizes SizeArrayOutput TrimSpaces (. CirclearraysFontSizes/Radii = ) CirclearraysFontSizes Radii {TwoArraysFunctionDiv} //false TwoArraysFunction SizeArrayOutput TrimSpaces (.\nCirclearraysUnroundedN = ) CirclearraysUnroundedN SizeArrayOutput TrimSpaces (.\nCirclearraysN = ) CirclearraysN SizeArrayOutput TrimSpaces (.) ConcatenateToMark OutputToLog mark (RadiiCirclearrayBaseline = ) RadiiCirclearrayBaseline SizeArrayOutput TrimSpaces (. RadiiCirclearrayInside = ) RadiiCirclearrayInside SizeArrayOutput TrimSpaces (.) ConcatenateToMark OutputToLog } if % ... GlassesNumCopies 1 ge PrePourNumCopies 1 ge or NumSheets 1 ge and ... 5 dict begin % Output the ...Equivalences arrays /EquivalencesEquivalencesToTest [ Titles NonEmptyCompoundObject {/FontSizesTitlesEquivalences dup load AnyMatches not {pop} if} if Abovetitles NonEmptyCompoundObject {/FontSizesAbovetitlesEquivalences dup load AnyMatches not {pop} if} if Belowtitles NonEmptyCompoundObject {/FontSizesBelowtitlesEquivalences dup load AnyMatches not {pop} if} if Overtitles NonEmptyCompoundObject {/FontSizesOvertitlesEquivalences dup load AnyMatches not {pop} if} if ] def % /EquivalencesEquivalencesToTest /EquivalencesEquivalences [ 0 1 EquivalencesEquivalencesToTest length 1 sub {} for ] def 1 1 EquivalencesEquivalencesToTest length 1 sub { /i exch def 0 1 i 1 sub { /j exch def [i j] {EquivalencesEquivalencesToTest exch get load} forall eq {EquivalencesEquivalences dup i exch j get put exit} if } for % j } bind for % i % Different meanings of i and j 0 1 EquivalencesEquivalencesToTest length 1 sub { /i exch def /Count 0 EquivalencesEquivalences {i eq {1 add} if} forall def Count 0 gt { mark 0 1 EquivalencesEquivalencesToTest length 1 sub { /j exch def i EquivalencesEquivalences j get eq { EquivalencesEquivalencesToTest j get 64 string cvs (, ) Count 1 le {exit} if /Count Count 1 sub def } if % i EquivalencesEquivalences j get eq } for (ASCIIfied and re-arranged by GlassesOnSheets) GlassesOnSheets EquivalencesEquivalencesToTest j get load () //false ByRearrangementArrayString ConcatenateToMark OutputToLog } if % Count 0 gt } bind for % i end /TypeOfPagesBeingRendered /Glasses store /NamesFontSizeIndividuallyT [ NumSheets {Names length array} repeat ] def % If NamesShowTop /NamesFontSizeIndividuallyB [ NumSheets {Names length array} repeat ] def % If NamesShowBottom 22 dict begin 0 1 Names length 1 sub { /NameNum exch def 0 1 NumSheets 1 sub { /SheetNum exch def //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns NamesFont 32 selectfont % Inside SheetNum loop as, if only page type is /Glasses, NamesFont could depend on SheetNum. Names NameNum get StringPathBBox 32 div /NameT exch def 32 div /NameR exch def 32 div /NameB exch def 32 div /NameL exch def /DirectionY NameT NameB sub def [ DirectionY 0 gt {NamesShowTop SheetNum GetEU {//true} if NamesShowBottom SheetNum GetEU {//false} if} if ] { /Top exch def /NameFontSizeThis NamesFontSize def /NameY Top {PageHeight MgnT sub} {MgnB} ifelse def /NameX Top {NamePlacementTopX} {NamePlacementBottomX} ifelse SheetNum get def 0 1 SheetLengths SheetNum get 1 sub { /WithinPage exch def GlassPositions SheetNum get WithinPage get aload pop /CircleY exch def /CircleX exch def CircleY NameY Radii SheetNum get DirectionY NameFontSizeThis mul add Top {sub gt} {add lt} ifelse { CircleX NameX sub abs NameR NameL sub 2 div NameFontSizeThis mul Radii SheetNum get add lt CircleNonEmpty SheetNum get WithinPage get and { % On a typical page = instance of SheetNum, with typical settings, will reach here for only 2, 1, or 0 values of WithinPage. /c0 NameX CircleX sub dup mul NameY CircleY sub dup mul add Radii SheetNum get dup mul sub def -0.50 0.02 0.5001 % Fifty-one steps, a number of directions which is excessive but not insanely so. And tests done only for close circles. { NameR NameL sub mul /DirectionX exch def [ c0 NameX CircleX sub DirectionX mul NameY CircleY sub DirectionY mul add 2 mul DirectionX dup mul DirectionY dup mul add ] 0 //false NameFontSizeThis //true //PrinterEpsilon PolynomialRoots dup length 1 ge {Min /NameFontSizeThis exch def} {pop} ifelse } for % DirectionX } if % Circle x-close enough to be worth testing, and CircleNonEmpty } if % Circle y-close enough to be worth testing } for % WithinPage Top {NamesFontSizeIndividuallyT} {NamesFontSizeIndividuallyB} ifelse SheetNum get NameNum NameFontSizeThis put } forall % Top } for % SheetNum % Optionally, here there could be SheetNum^2 loops referring to ShrinkRadiiSquareArray. But, May 2022, such behaviour removed. } bind for % NameNum end //DeBugLevel 100 le {( Main: computing TitleProportionFontSize...) OutputToLog} if /TitlesAnyGrey //false def /TitleProportionFontSizeT /TitleProportionFontSizeB /TitleOffsetsProportionFontSizeVertical /TitleProportionFontSizeL /TitleProportionFontSizeR /TitleOffsetsProportionFontSizeHorizontal 6 {NumSheets array def} repeat 0 1 NumSheets 1 sub { /SheetNum exch def //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns TitleProportionFontSizeT TitleProportionFontSizeB TitleOffsetsProportionFontSizeVertical TitleProportionFontSizeL TitleProportionFontSizeR TitleOffsetsProportionFontSizeHorizontal 6 {SheetNum SheetLengths SheetNum get array put} repeat 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def ColourSchemeTitles /MidGrey eq {/TitlesAnyGrey //true store} if TitlesFont //DeSizeRounding selectfont Titles WithinTitles get StringPathBBox //DeSizeRounding div VerticalMiddlingIncludeBaselineTitles {dup 0 lt {pop 0} if} if TitleProportionFontSizeT SheetNum get WithinPage 3 -1 roll put //DeSizeRounding div TitleProportionFontSizeR SheetNum get WithinPage 3 -1 roll put //DeSizeRounding div VerticalMiddlingIncludeBaselineTitles {dup 0 gt {pop 0} if} if TitleProportionFontSizeB SheetNum get WithinPage 3 -1 roll put //DeSizeRounding div TitleProportionFontSizeL SheetNum get WithinPage 3 -1 roll put TitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage TitleProportionFontSizeR SheetNum get WithinPage get TitleProportionFontSizeL SheetNum get WithinPage get add 2 div neg put } for % WithinPage, WithinTitles currentdict /WithinTitles undef currentdict /WithinPage undef } bind for % SheetNum UndefMgns currentdict /SheetNum undef //DeBugLevel 100 le {( Main: computing TitleOffsetsProportionFontSizeVertical) OutputToLog} if /TitlesFont load XcheckRecursive not /VerticalMiddlingStringTitles load XcheckRecursive not /VerticalMiddlingIncludeBaselineTitles load XcheckRecursive not and and { TitlesFont //DeSizeRounding selectfont VerticalMiddlingStringTitles StringPathBBox //DeSizeRounding div VerticalMiddlingIncludeBaselineTitles {dup 0 lt {pop 0} if} if /VMSTT exch def pop //DeSizeRounding div VerticalMiddlingIncludeBaselineTitles {dup 0 gt {pop 0} if} if /VMSTB exch def pop } {/VMSTT /Null def /VMSTB /Null def} ifelse % ... XcheckRecursive not ... 0 1 NumSheets 1 sub { /SheetNum exch def //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def /MinBottoms TitleProportionFontSizeB SheetNum get WithinPage get def /MaxTops TitleProportionFontSizeT SheetNum get WithinPage get def % /MatchNone /MatchRow /MatchPage /MatchAll /MatchString 1 { /VMT VerticalMiddlingTitles def Titles WithinTitles get VerticalMiddlingTitlesAlwaysMatchNone {1 index TwoArraysEqual {/VMT /MatchNone def exit} if} forall pop VMT /MatchRow eq VMT /MatchPage eq VMT /MatchAll eq or or { VMT /MatchAll eq {0 1 NumSheets 1 sub} {SheetNum 1 SheetNum} ifelse { /SheetNumComparator exch def 0 1 GlassesOnSheets SheetNumComparator GetEU length 1 sub { /WithinPageComparator exch def VMT /MatchRow eq { GlassPositions SheetNum get WithinPage get 1 get GlassPositions SheetNumComparator get WithinPageComparator get 1 get sub abs RadiiCirclearrayInsideUsableTAB SheetNum get 12 div le % embedded constant, and a bit messy as not quite an equivalence relation. Shouldn't matter though. } {//true} ifelse { TitleProportionFontSizeB SheetNumComparator get WithinPageComparator get dup MinBottoms lt {/MinBottoms exch def} {pop} ifelse TitleProportionFontSizeT SheetNumComparator get WithinPageComparator get dup MaxTops gt {/MaxTops exch def} {pop} ifelse } if % vertical postion within a twelth of a radius } for % WithinPageComparator } for % SheetNumComparator exit } if % /MatchRow, or /MatchPage, or /MatchAll VMT /MatchString eq { VMSTT /Null eq VMSTB /Null eq or { TitlesFont //DeSizeRounding selectfont /VerticalMiddlingStringTitles load StringPathBBox //DeSizeRounding div VerticalMiddlingIncludeBaselineTitles {dup 0 lt {pop 0} if} if /MaxTops exch def pop //DeSizeRounding div VerticalMiddlingIncludeBaselineTitles {dup 0 gt {pop 0} if} if /MinBottoms exch def pop }{ /MaxTops VMSTT def /MinBottoms VMSTB def } ifelse % /VMSTT /Null eq ... exit } if % /MatchString } repeat % 1 TitleOffsetsProportionFontSizeVertical SheetNum get WithinPage MinBottoms MaxTops add 2 div neg put } for % WithinPage, WithinTitles currentdict /WithinTitles undef currentdict /WithinPage undef } bind for % SheetNum UndefMgns currentdict /SheetNum undef //DeBugLevel 100 le {( Main: computing TitleFontSizes) OutputToLog} if /TypeOfPagesBeingRendered /Glasses store /TitleFontSizes NumSheets array def /TitleMaxHeightProportionInnerRadiusRelevantNum 0 def /TitleMaxHeightProportionInnerRadiusRelevantSheetNumWithinPage 0 SheetLengths {add} forall 2 mul array def 0 1 NumSheets 1 sub { /SheetNum exch def //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns TitleFontSizes SheetNum SheetLengths SheetNum get array put 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def TitleFontSizes SheetNum get WithinPage PageHeight 5 mul % Initial upper estimate, to be shrunk /TitlesTBsub TitleProportionFontSizeT SheetNum get WithinPage get TitleProportionFontSizeB SheetNum get WithinPage get sub def TitlesTBsub 0 gt { Abovetitles WithinTitles get NonEmptyCompoundObject { 1 TitleMinHeightForAbovetitleProportionInnerRadius sub RadiiCirclearrayInsideUsableTAB SheetNum get mul TitleProportionFontSizeT SheetNum get WithinPage get TitleOffsetsProportionFontSizeVertical SheetNum get WithinPage get add dup 0 gt {div 2 copy gt {exch} if pop} {pop pop} ifelse } if % Belowtitles WithinTitles get NonEmptyCompoundObject Belowtitles WithinTitles get NonEmptyCompoundObject { TitleMinHeightForBelowtitleProportionInnerRadius 1 sub RadiiCirclearrayInsideUsableTAB SheetNum get mul % negative TitleProportionFontSizeB SheetNum get WithinPage get TitleOffsetsProportionFontSizeVertical SheetNum get WithinPage get add dup 0 lt {div 2 copy gt {exch} if pop} {pop pop} ifelse } if % Belowtitles WithinTitles get NonEmptyCompoundObject } if % TitlesTBsub 0 gt /TitlesRLsub TitleProportionFontSizeR SheetNum get WithinPage get TitleProportionFontSizeL SheetNum get WithinPage get sub def % /TitlesRLsub TitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get //DeSizeRounding mul neg TitleOffsetsProportionFontSizeVertical SheetNum get WithinPage get //DeSizeRounding mul neg GSave NullDevice newpath TitlesFont //DeSizeRounding selectfont 0 0 moveto Titles WithinTitles get //true CharPathRecursive 0 0.12 PathBRadiusSquared % sub-1pt tolerance probably much tighter than needed, but underestimation of radius could be bad. GRestore dup 0 gt { sqrt RadiiCirclearrayInsideUsableTAB SheetNum get exch div //DeSizeRounding mul 2 copy gt {exch} if pop } {pop} ifelse % ... PathBRadiusSquared ... 0 gt TitlesTBsub 0 gt { TitleMaxHeightProportionInnerRadius RadiiCirclearrayInsideUsableTAB SheetNum get mul TitlesTBsub div 2 copy gt { exch TitleMaxHeightProportionInnerRadiusRelevantSheetNumWithinPage TitleMaxHeightProportionInnerRadiusRelevantNum 2 mul 2 copy 1 add WithinPage put SheetNum put /TitleMaxHeightProportionInnerRadiusRelevantNum dup load 1 add store } if pop } if % TitlesTBsub 0 gt put % TitleFontSizes SheetNum get WithinPage ... put } for % WithinPage, WithinTitles currentdict /TitlesRLsub undef currentdict /TitlesTBsub undef currentdict /WithinTitles undef currentdict /WithinPage undef } bind for % SheetNum UndefMgns currentdict /SheetNum undef % ArraysStrings ArraysToAlter ArrayMatches SheetMatches FontSizesRatioMin NotSmallerIfTitlesNotLonger Equivalences FewerDifferentFontSizes - /FewerDifferentFontSizes { //DeBugLevel 50 le {(+FewerDifferentFontSizes) OutputToLog} if 20 dict begin /Equivalences exch def /NotSmallerIfTitlesNotLonger exch def /FontSizesRatioMin exch def /SheetMatches exch def /ArrayMatches exch def /ArraysToAlter exch def /ArraysStrings exch def { /NoChanges //true def 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 NumSheets 1 sub { /SheetNum0 exch def SheetMatches SheetNum get SheetMatches SheetNum0 get eq { 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def 0 1 GlassesOnSheets SheetNum0 GetEU length 1 sub { /WithinPage0 exch def SheetNum SheetNum0 ne WithinPage WithinPage0 ne or { /WithinTitles0 << /SheetNum SheetNum0 /WithinPage WithinPage0 >> begin GlassesOnSheets SheetNum GetEU WithinPage GetEU end def NotSmallerIfTitlesNotLonger { Titles WithinTitles get LengthCompoundObject << /SheetNum SheetNum0 /WithinPage WithinPage0 /WithinTitles WithinTitles0 >> begin Titles WithinTitles get LengthCompoundObject end ge { ArraysToAlter {dup SheetNum0 get WithinPage0 get exch SheetNum get WithinPage 3 copy get lt {/NoChanges //false def 3 -1 roll put} {pop pop pop} ifelse} forall } if % Titles WithinTitles get LengthCompoundObject ...0 ... ge } if % NotSmallerIfTitlesNotLonger 0 1 ArraysToAlter length 1 sub { /NumArrayToAlter exch def Equivalences NumArrayToAlter get WithinTitles GetEU << /WithinTitles WithinTitles0 >> begin Equivalences NumArrayToAlter get WithinTitles GetEU end eq { ArraysToAlter NumArrayToAlter get dup dup dup SheetNum0 get WithinPage0 get exch SheetNum get WithinPage 3 copy get lt {/NoChanges //false def 3 -1 roll put} {pop pop pop} ifelse SheetNum get WithinPage get exch SheetNum0 get WithinPage0 3 copy get lt {/NoChanges //false def 3 -1 roll put} {pop pop pop} ifelse } if % Equivalences ... eq } for % NumArrayToAlter } if % Not same } for % WithinPage0 } for % WithinTitles, WithinPage } if % SheetMatches ... SheetMatches ... eq } for % SheetNum0 } for % SheetNum NoChanges {exit} if } loop % until NoChanges /FontSizesSetsDone [ GlassesOnSheets length {[ ArraysToAlter length {//false} repeat ]} repeat ] def 0 1 NumSheets 1 sub { /SheetNum0 exch def 0 1 ArraysToAlter length 1 sub { /NumArrayToAlter0 exch def FontSizesSetsDone SheetNum0 get NumArrayToAlter0 get not { /SortedCircles [ SheetNum0 1 NumSheets 1 sub { /SheetNum exch def SheetMatches SheetNum0 get SheetMatches SheetNum get eq { SheetNum0 SheetNum eq {NumArrayToAlter0} {0} ifelse 1 ArraysToAlter length 1 sub { /NumArrayToAlter exch def ArrayMatches NumArrayToAlter0 get ArrayMatches NumArrayToAlter get eq { 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def ArraysStrings NumArrayToAlter get WithinTitles get NonEmptyCompoundObject { [ ArraysToAlter NumArrayToAlter get SheetNum WithinPage 2 index SheetNum get WithinPage get ] }{ ArraysToAlter NumArrayToAlter get SheetNum get WithinPage //PrinterEpsilon put } ifelse % ... NonEmptyCompoundObject } for % WithinPage, WithinTitles FontSizesSetsDone SheetNum get NumArrayToAlter get {(Error: element of FontSizesSetsDone done twice. Continuing.) OutputToLog} if FontSizesSetsDone SheetNum get NumArrayToAlter //true put } if % ... NumArrayToAlter0 ... NumArrayToAlter ... eq } for % NumArrayToAlter } if % ... SheetNum0 ... SheetNum ... eq } for % SheetNum ] dup {3 get exch 3 get ge} ShellSort def % /SortedCircles % SortedCircles {4 array dup 3 -1 roll 2 copy 1 3 getinterval 1 exch putinterval 0 get dup TitleFontSizes eq {pop (TitleFontSizes)} {dup AbovetitleFontSizes eq {pop (Above...)} % {dup BelowtitleFontSizes eq {pop (Below...)} {OvertitleFontSizes eq {(Over...)} {(Other)} ifelse} ifelse} ifelse} ifelse 0 exch put ==} forall /i -1 def 0 1 SortedCircles length 1 sub {/i exch def SortedCircles i get 3 get //PrinterEpsilon 2 mul gt {exit} if} for { i SortedCircles length 1 sub ge {exit} if i 1 add 1 SortedCircles length 1 sub { /j exch def SortedCircles j get 3 get SortedCircles i get 3 get 2 copy eq {pop pop //false} {FontSizesRatioMin mul lt} ifelse { SortedCircles j get 3 SortedCircles i get 3 get put SortedCircles j get 0 get SortedCircles j get 1 get get SortedCircles j get 2 get SortedCircles i get 3 get put } {exit} ifelse } for % j /i j def } loop % i } if % FontSizesSetsDone SheetNum0 get NumArrayToAlter0 get not } for % NumArrayToAlter0 } for % SheetNum0 end //DeBugLevel 50 le {(-FewerDifferentFontSizes) OutputToLog} if } bind def % /FewerDifferentFontSizes /SoloTitleFontSizes [ TitleFontSizes {[ exch aload pop ]} forall ] def [Titles] [TitleFontSizes] [0] FontSizesSetsGlassesPages /FontSizesRatioTitlesMin load /FontSizesTitlesNotSmallerIfTitlesNotLonger load [FontSizesTitlesEquivalences] FewerDifferentFontSizes mark (Binding constraints on TitleFontSizes as SheetNum,WithinPage,WithinTitles,Title: ) 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def SoloTitleFontSizes SheetNum get WithinPage get TitleFontSizes SheetNum get WithinPage get le {SheetNum (,) WithinPage 1 index WithinTitles 1 index Titles WithinTitles get (; )} if } for % WithinPage, WithinTitles } bind for % SheetNum dup length 2 eq {pop (.)} if ConcatenateToMark OutputToLog currentdict /SoloTitleFontSizes undef //DeBugLevel 100 le {( Main: computing [Above|Below|Over]titleProportionFontSize...) OutputToLog} if /TypeOfPagesBeingRendered /Glasses store /AbovetitleProportionFontSizeT /AbovetitleProportionFontSizeB /AbovetitleProportionFontSizeL /AbovetitleProportionFontSizeR /AbovetitleOffsetsProportionFontSizeHorizontal /BelowtitleProportionFontSizeT /BelowtitleProportionFontSizeB /BelowtitleProportionFontSizeL /BelowtitleProportionFontSizeR /BelowtitleOffsetsProportionFontSizeHorizontal /OvertitleProportionFontSizeT /OvertitleProportionFontSizeB /OvertitleProportionFontSizeL /OvertitleProportionFontSizeR /OvertitleOffsetsProportionFontSizeHorizontal 15 {NumSheets array def} repeat 0 1 NumSheets 1 sub { /SheetNum exch def //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns AbovetitleProportionFontSizeT AbovetitleProportionFontSizeB AbovetitleProportionFontSizeL AbovetitleProportionFontSizeR AbovetitleOffsetsProportionFontSizeHorizontal BelowtitleProportionFontSizeT BelowtitleProportionFontSizeB BelowtitleProportionFontSizeL BelowtitleProportionFontSizeR BelowtitleOffsetsProportionFontSizeHorizontal OvertitleProportionFontSizeT OvertitleProportionFontSizeB OvertitleProportionFontSizeL OvertitleProportionFontSizeR OvertitleOffsetsProportionFontSizeHorizontal 15 {SheetNum SheetLengths SheetNum get array put} repeat 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def AbovetitlesFont //DeSizeRounding selectfont Abovetitles WithinTitles get StringPathBBox 4 {//DeSizeRounding div 4 1 roll} repeat AbovetitleProportionFontSizeT SheetNum get WithinPage 3 -1 roll put AbovetitleProportionFontSizeR SheetNum get WithinPage 3 -1 roll put AbovetitleProportionFontSizeB SheetNum get WithinPage 3 -1 roll put AbovetitleProportionFontSizeL SheetNum get WithinPage 3 -1 roll put AbovetitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage AbovetitleProportionFontSizeL SheetNum get WithinPage get AbovetitleProportionFontSizeR SheetNum get WithinPage get add 2 div neg put BelowtitlesFont //DeSizeRounding selectfont Belowtitles WithinTitles get StringPathBBox 4 {//DeSizeRounding div 4 1 roll} repeat BelowtitleProportionFontSizeT SheetNum get WithinPage 3 -1 roll put BelowtitleProportionFontSizeR SheetNum get WithinPage 3 -1 roll put BelowtitleProportionFontSizeB SheetNum get WithinPage 3 -1 roll put BelowtitleProportionFontSizeL SheetNum get WithinPage 3 -1 roll put BelowtitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage BelowtitleProportionFontSizeL SheetNum get WithinPage get BelowtitleProportionFontSizeR SheetNum get WithinPage get add 2 div neg put OvertitlesFont //DeSizeRounding selectfont Overtitles WithinTitles get StringPathBBox 4 {//DeSizeRounding div 4 1 roll} repeat VerticalMiddlingIncludeBaselineOvertitles {dup 0 lt {pop 0} if} if OvertitleProportionFontSizeT SheetNum get WithinPage 3 -1 roll put OvertitleProportionFontSizeR SheetNum get WithinPage 3 -1 roll put VerticalMiddlingIncludeBaselineOvertitles {dup 0 gt {pop 0} if} if OvertitleProportionFontSizeB SheetNum get WithinPage 3 -1 roll put OvertitleProportionFontSizeL SheetNum get WithinPage 3 -1 roll put OvertitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage OvertitleProportionFontSizeL SheetNum get WithinPage get OvertitleProportionFontSizeR SheetNum get WithinPage get add 2 div neg put } for % WithinPage, WithinTitles currentdict /WithinPage undef currentdict /WithinTitles undef } bind for % SheetNum UndefMgns currentdict /SheetNum undef % For Titles and Overtitles, can compute offset first, and then size. % Abovetitles (and Belowtitles) are more complicated. First compute the bottom (top) of bounding box, storing that, pre tem, in ...titleOffsetsAbsoluteVertical. % From that compute size using PathMaxScalingFitCircle. Apply contraints. Then adjust ...titleOffsetsAbsoluteVertical to point to baseline. //DeBugLevel 100 le {( Main: computing [Above|Below|Over]titleFontSizes, OvertitleOffsetsProportionFontSizeVertical, [Above|Below]titleOffsetsAbsoluteVertical) OutputToLog} if /TypeOfPagesBeingRendered /Glasses store /AbovetitleFontSizes [ 0 1 NumSheets 1 sub {/SheetNum exch def [ SheetLengths SheetNum get {//PrinterEpsilon} repeat ]} for ] def /BelowtitleFontSizes [ 0 1 NumSheets 1 sub {/SheetNum exch def [ SheetLengths SheetNum get {//PrinterEpsilon} repeat ]} for ] def /OvertitleFontSizes [ 0 1 NumSheets 1 sub {/SheetNum exch def [ SheetLengths SheetNum get {//PrinterEpsilon} repeat ]} for ] def /OvertitleOffsetsProportionFontSizeVertical [ 0 1 NumSheets 1 sub {/SheetNum exch def SheetLengths SheetNum get array} for ] def /AbovetitleOffsetsAbsoluteVertical [ 0 1 NumSheets 1 sub {/SheetNum exch def SheetLengths SheetNum get array} for ] def /BelowtitleOffsetsAbsoluteVertical [ 0 1 NumSheets 1 sub {/SheetNum exch def SheetLengths SheetNum get array} for ] def currentdict /SheetNum undef /FirstError //true def 0 1 NumSheets 1 sub { /SheetNum exch def //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def % Over /VMO VerticalMiddlingOvertitles def Titles WithinTitles get ASCIIfy VerticalMiddlingOvertitlesAlwaysMatchNone {1 index TwoArraysEqual {/VMO /MatchNone def exit} if} forall pop /VMO load /MatchString eq /OvertitlesFont load XcheckRecursive not /VerticalMiddlingStringOvertitles load XcheckRecursive not /VerticalMiddlingIncludeBaselineOvertitles load XcheckRecursive not and and and { OvertitlesFont //DeSizeRounding selectfont VerticalMiddlingStringOvertitles StringPathBBox //DeSizeRounding div VerticalMiddlingIncludeBaselineOvertitles {dup 0 lt {pop 0} if} if /VMSST exch def pop //DeSizeRounding div VerticalMiddlingIncludeBaselineOvertitles {dup 0 gt {pop 0} if} if /VMSSB exch def pop } {/VMSST /Null def /VMSSB /Null def} ifelse % ... XcheckRecursive not ... % Calculate offset so as to know the location of the centre of the circle, then compute the size, then call SizeConstraints. /MinBottoms OvertitleProportionFontSizeB SheetNum get WithinPage get def /MaxTops OvertitleProportionFontSizeT SheetNum get WithinPage get def % /MatchNone /MatchRow /MatchPage /MatchAll /MatchString 1 { VMO /MatchRow eq VMO /MatchPage eq VMO /MatchAll eq or or { VMO /MatchAll eq {0 1 NumSheets 1 sub} {SheetNum 1 SheetNum} ifelse { /SheetNumComparator exch def 0 1 GlassesOnSheets SheetNumComparator GetEU length 1 sub { /WithinPageComparator exch def VMO /MatchRow eq { GlassPositions SheetNum get WithinPage get 1 get GlassPositions SheetNumComparator get WithinPageComparator get 1 get sub abs RadiiCirclearrayInsideUsableO SheetNum get 12 div le % embedded constant, and a bit messy as not quite an equivalence relation. Shouldn't matter though. } {//true} ifelse { OvertitleProportionFontSizeB SheetNum get WithinPageComparator get dup MinBottoms lt {/MinBottoms exch def} {pop} ifelse OvertitleProportionFontSizeT SheetNum get WithinPageComparator get dup MaxTops gt {/MaxTops exch def} {pop} ifelse } if % vertical postion within a twelth of a radius } for % WithinPageComparator } for % SheetNumComparator exit } if % /MatchRow, or /MatchPage, or /MatchAll VMO /MatchString eq { VMSST /Null eq VMSSB /Null eq or { OvertitlesFont //DeSizeRounding selectfont /VerticalMiddlingStringOvertitles load StringPathBBox //DeSizeRounding div VerticalMiddlingIncludeBaselineTitles {dup 0 lt {pop 0} if} if /MaxTops exch def pop //DeSizeRounding div VerticalMiddlingIncludeBaselineTitles {dup 0 gt {pop 0} if} if /MinBottoms exch def pop exit }{ /MaxTops VMSST def /MinBottoms VMSSB def } ifelse % /VMSST /Null eq ... exit } if % /MatchAll } repeat % 1 OvertitleOffsetsProportionFontSizeVertical SheetNum get WithinPage MinBottoms MaxTops add 2 div neg put % This holds part of the computation of [Above|Below]titleOffsetsAbsoluteVertical. The remainder follows the computation of [Above|Below]titleFontSizes. /AbovetitlesTBsub AbovetitleProportionFontSizeT SheetNum get WithinPage get AbovetitleProportionFontSizeB SheetNum get WithinPage get sub def /AbovetitlesRLsub AbovetitleProportionFontSizeR SheetNum get WithinPage get AbovetitleProportionFontSizeL SheetNum get WithinPage get sub def % /AbovetitlesRLsub /BelowtitlesTBsub BelowtitleProportionFontSizeT SheetNum get WithinPage get BelowtitleProportionFontSizeB SheetNum get WithinPage get sub def /BelowtitlesRLsub BelowtitleProportionFontSizeR SheetNum get WithinPage get BelowtitleProportionFontSizeL SheetNum get WithinPage get sub def % /BelowtitlesRLsub /OvertitlesTBsub OvertitleProportionFontSizeT SheetNum get WithinPage get OvertitleProportionFontSizeB SheetNum get WithinPage get sub def /OvertitlesRLsub OvertitleProportionFontSizeR SheetNum get WithinPage get OvertitleProportionFontSizeL SheetNum get WithinPage get sub def % /OvertitlesRLsub 0.0625 dup RadiiCirclearrayInside SheetNum get mul exch TitleFontSizes SheetNum get WithinPage get TitleOffsetsProportionFontSizeVertical SheetNum get WithinPage get 4 copy TitleProportionFontSizeT SheetNum get WithinPage get add mul exch 1 exch sub mul add AbovetitleOffsetsAbsoluteVertical SheetNum get exch WithinPage exch put TitleProportionFontSizeB SheetNum get WithinPage get add mul exch 1 exch sub mul sub neg BelowtitleOffsetsAbsoluteVertical SheetNum get exch WithinPage exch put % CentreX CentreY MinMaxRadiusSquared Tolerance PathBRadiusSquared MaxRadiusSquared OvertitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get //DeSizeRounding mul neg OvertitleOffsetsProportionFontSizeVertical SheetNum get WithinPage get //DeSizeRounding mul neg GSave NullDevice newpath OvertitlesFont //DeSizeRounding selectfont 0 0 moveto Overtitles WithinTitles get //true CharPathRecursive 0 0.12 PathBRadiusSquared % sub-1pt tolerance probably much tighter than needed, but underestimation of radius could be bad. GRestore dup 0 gt {sqrt RadiiCirclearrayInsideUsableO SheetNum get exch div //DeSizeRounding mul} {pop //Infinity} ifelse TitleFontSizes SheetNum get WithinPage get dup //PrinterEpsilon le {pop} {OvertitleMaxFontSizeProportionTitles mul 2 copy gt {exch} if pop} ifelse OvertitleFontSizes SheetNum get exch WithinPage exch put GSave NullDevice newpath AbovetitlesFont //DeSizeRounding selectfont GlassPositions SheetNum get WithinPage get aload pop % circle centre 2 copy AbovetitleOffsetsAbsoluteVertical SheetNum get WithinPage get add % Expansion centre 2 copy exch AbovetitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get //DeSizeRounding mul add exch AbovetitleProportionFontSizeB SheetNum get WithinPage get //DeSizeRounding mul sub moveto Abovetitles WithinTitles get //true CharPathRecursive 4 2 roll RadiiCirclearrayInsideUsableTAB SheetNum get PathMaxScalingFitCircle //DeSizeRounding mul GRestore TitleFontSizes SheetNum get WithinPage get dup //PrinterEpsilon le {pop} {AbovetitleMaxFontSizeProportionTitles mul 2 copy gt {exch} if pop} ifelse AbovetitleFontSizes SheetNum get exch WithinPage exch put GSave NullDevice newpath BelowtitlesFont //DeSizeRounding selectfont GlassPositions SheetNum get WithinPage get aload pop % circle centre 2 copy BelowtitleOffsetsAbsoluteVertical SheetNum get WithinPage get add % Expansion centre 2 copy exch BelowtitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get //DeSizeRounding mul add exch BelowtitleProportionFontSizeT SheetNum get WithinPage get //DeSizeRounding mul sub moveto Belowtitles WithinTitles get //true CharPathRecursive 4 2 roll RadiiCirclearrayInsideUsableTAB SheetNum get PathMaxScalingFitCircle //DeSizeRounding mul GRestore TitleFontSizes SheetNum get WithinPage get dup //PrinterEpsilon le {pop} {BelowtitleMaxFontSizeProportionTitles mul 2 copy gt {exch} if pop} ifelse BelowtitleFontSizes SheetNum get exch WithinPage exch put /a AbovetitleFontSizes SheetNum get WithinPage get //PrinterEpsilon le {Abovetitles WithinTitles get NonEmptyCompoundObject} {//false} ifelse def /b BelowtitleFontSizes SheetNum get WithinPage get //PrinterEpsilon le {Belowtitles WithinTitles get NonEmptyCompoundObject} {//false} ifelse def a b or { mark FirstError {(\n)} if (Error. With SheetNum=) SheetNum (, WithinPage=) WithinPage (, WithinTitles=) WithinTitles (, title=) Titles WithinTitles get ASCIIfy (: ) /FirstError //false def a {(insufficient room for Abovetitles, which is weird. Please submit an issue to http://github.com/jdaw1/placemat/issues/ ) (; )} if b {(insufficient room for Belowtitles, which is weird. Please submit an issue to http://github.com/jdaw1/placemat/issues/ ) (; )} if pop (.) ConcatenateToMark OutputToLog } if % a b or } for % WithinPage, WithinTitles currentdict /WithinTitles undef currentdict /WithinPage undef } bind for % SheetNum FirstError not {(\n) OutputToLog} if UndefMgns [ /FirstError /a /b ] {currentdict exch undef} forall [Abovetitles Belowtitles Overtitles] [AbovetitleFontSizes BelowtitleFontSizes OvertitleFontSizes] FontSizesSetsAboveBelowOver FontSizesSetsGlassesPages /FontSizesRatioAboveBelowOverMin load /FontSizesAboveBelowOverNotSmallerIfTitlesNotLonger load [FontSizesAbovetitlesEquivalences FontSizesBelowtitlesEquivalences FontSizesOvertitlesEquivalences] FewerDifferentFontSizes % Above here BelowtitleOffsetsAbsoluteVertical is the offset to the top of the Belowtitles % (and AbovetitleOffsetsAbsoluteVertical to the bottom). Now adjust to point to baseline. //DeBugLevel 100 le {( Main: further computation of BelowtitleOffsetsAbsoluteVertical and AbovetitleOffsetsAbsoluteVertical) OutputToLog} if 0 1 NumSheets 1 sub { /SheetNum exch def //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def % AbovetitleOffsetsAbsoluteVertical needs adjusting, to point to baseline rather than bottom AbovetitleOffsetsAbsoluteVertical SheetNum get WithinPage 2 copy get dup IsNumber { AbovetitleProportionFontSizeB SheetNum get WithinPage get AbovetitleFontSizes SheetNum get WithinPage get mul dup 0 gt {pop 0} if sub put }{ pop pop pop Abovetitles WithinTitles get NonEmptyCompoundObject {mark (Error: non-numeric AbovetitleOffsetsAbsoluteVertical ) SheetNum ( get ) WithinPage ( get) ConcatenateToMark OutputToLog} if % Abovetitles WithinTitles get NonEmptyCompoundObject } ifelse % AbovetitleOffsetsAbsoluteVertical ... IsNumber % BelowtitleOffsetsAbsoluteVertical needs adjusting, to point to baseline rather than top BelowtitleOffsetsAbsoluteVertical SheetNum get WithinPage 2 copy get dup IsNumber { BelowtitleProportionFontSizeT SheetNum get WithinPage get BelowtitleFontSizes SheetNum get WithinPage get mul dup 0 lt {pop 0} if sub put }{ pop pop pop Belowtitles WithinTitles get NonEmptyCompoundObject {mark (Error: non-numeric BelowtitleOffsetsAbsoluteVertical ) SheetNum ( get ) WithinPage ( get) ConcatenateToMark OutputToLog} if % Abovetitles WithinTitles get NonEmptyCompoundObject } ifelse % BelowtitleOffsetsAbsoluteVertical ... IsNumber } for % WithinPage, WithinTitles currentdict /WithinTitles undef currentdict /WithinPage undef } bind for % SheetNum UndefMgns currentdict /SheetNum undef /TypeOfPagesBeingRendered /Glasses store % Font size information mark () {GlassesNumCopies 1 ge} MightBeTrue { Titles NonEmptyCompoundObject { 4 dict begin (TitleFontSizes = ) TitleFontSizes 1 {TwoArraysFunctionDiv} //false TwoArraysFunction SizeArrayOutput TrimSpaces (.) (\n) /TitleFontSizesUnique [ TitleFontSizes { {counttomark 1 sub -1 1 {index 1 index sub abs //PrinterEpsilon le {pop exit} if} for} forall} forall ] dup {le} ShellSort def % Unique font sizes TitleFontSizesUnique length 1 gt { (TitleFontSizes, equality classes: ) [ TitleFontSizes { [ exch {0 1 TitleFontSizesUnique length 1 sub {2 copy TitleFontSizesUnique exch get sub abs //PrinterEpsilon le {exch pop exit} {pop} ifelse} for} forall ] } forall ] (; ) /TitleFontSizesFrequencies [ TitleFontSizesUnique length {0} repeat ] def TitleFontSizes {{/TFS exch def 0 1 TitleFontSizesUnique length 1 sub {/i exch def TitleFontSizesUnique i get TFS sub abs //PrinterEpsilon le {TitleFontSizesFrequencies i 2 copy get 1 add put exit} if} for} forall} forall (frequencies=) TitleFontSizesFrequencies (; ) 1 1 TitleFontSizesUnique length 1 sub { dup 1 sub 2 copy (#) 5 1 roll (/#) 4 1 roll (=) 3 1 roll TitleFontSizesUnique exch get exch TitleFontSizesUnique exch get exch dup //PrinterEpsilon gt {div (, )} {pop pop pop pop pop pop pop} ifelse } for pop (.) (\n) } if % At least two different values in TitleFontSizes end TitleMaxHeightProportionInnerRadiusRelevantNum 0 gt { (TitleMaxHeightProportionInnerRadius directly relevant for these WithinTitles and Titles: ) 0 2 TitleMaxHeightProportionInnerRadiusRelevantNum 2 mul 1 sub { TitleMaxHeightProportionInnerRadiusRelevantSheetNumWithinPage exch 2 copy get /SheetNum exch def 1 add get WithinPage-WithinTitles-def WithinTitles ( = ) Titles WithinTitles get ASCIIfy dup length 0 eq {pop pop} if (; ) } for pop (.) (\n) } if % TitleMaxHeightProportionInnerRadiusRelevantNum 0 gt (Title heights / RadiiCirclearrayInsideUsableTAB = ) TitleProportionFontSizeT TitleProportionFontSizeB {sub} //false TwoArraysFunction TitleFontSizes {mul} //false TwoArraysFunction RadiiCirclearrayInsideUsableTAB {TwoArraysFunctionDiv} //false TwoArraysFunction SizeArrayOutput TrimSpaces (.) (\n) } if % Titles NonEmptyCompoundObject Abovetitles NonEmptyCompoundObject {(AbovetitleFontSizes = ) AbovetitleFontSizes 1 {TwoArraysFunctionDiv} //false TwoArraysFunction SizeArrayOutput TrimSpaces (.) (\n)} if Belowtitles NonEmptyCompoundObject {(BelowtitleFontSizes = ) BelowtitleFontSizes 1 {TwoArraysFunctionDiv} //false TwoArraysFunction SizeArrayOutput TrimSpaces (.) (\n)} if Overtitles NonEmptyCompoundObject {(OvertitleFontSizes = ) OvertitleFontSizes 1 {TwoArraysFunctionDiv} //false TwoArraysFunction SizeArrayOutput TrimSpaces (.) (\n)} if } if % ... GlassesNumCopies 1 ge ... /TitleFontSizesMaxByPage [ TitleFontSizes {0 exch {2 copy lt {exch} if pop} forall} forall ] def /AbovetitleFontSizesMaxByPage [ AbovetitleFontSizes {0 exch {2 copy lt {exch} if pop} forall} forall ] def /BelowtitleFontSizesMaxByPage [ BelowtitleFontSizes {0 exch {2 copy lt {exch} if pop} forall} forall ] def /OvertitleFontSizesMaxByPage [ OvertitleFontSizes {0 exch {2 copy lt {exch} if pop} forall} forall ] def /TitleAboveBelowOverL [ SheetLengths {[ exch {0} repeat ]} forall ] def /TitleAboveBelowOverR [ SheetLengths {[ exch {0} repeat ]} forall ] def /TitleAboveBelowOverB [ SheetLengths {[ exch {0} repeat ]} forall ] def /TitleAboveBelowOverT [ SheetLengths {[ exch {0} repeat ]} forall ] def //DeBugLevel 100 le {( Main: Computation of TitleAboveBelowOverL, ...R, ...B, ...T.) OutputToLog} if 9 dict begin /TABO_MaxT //InfinityNeg def /TABO_MaxT_SheetNum -1 def /TABO_MaxT_WithinPage -1 def /TABO_MinB //Infinity def /TABO_MinB_SheetNum -1 def /TABO_MinB_WithinPage -1 def 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def TitleAboveBelowOverB SheetNum get WithinPage 2 copy get Titles WithinTitles get NonEmptyCompoundObject { TitleProportionFontSizeB SheetNum get WithinPage get TitleOffsetsProportionFontSizeVertical SheetNum get WithinPage get add TitleFontSizes SheetNum get WithinPage get mul 2 copy gt {exch} if pop } if % ... NonEmptyCompoundObject Abovetitles WithinTitles get NonEmptyCompoundObject { AbovetitleProportionFontSizeB SheetNum get WithinPage get AbovetitleFontSizes SheetNum get WithinPage get mul AbovetitleOffsetsAbsoluteVertical SheetNum get WithinPage get add 2 copy gt {exch} if pop } if % ... NonEmptyCompoundObject Belowtitles WithinTitles get NonEmptyCompoundObject { BelowtitleProportionFontSizeB SheetNum get WithinPage get BelowtitleFontSizes SheetNum get WithinPage get mul BelowtitleOffsetsAbsoluteVertical SheetNum get WithinPage get add 2 copy gt {exch} if pop } if % ... NonEmptyCompoundObject Overtitles WithinTitles get NonEmptyCompoundObject { OvertitleProportionFontSizeB SheetNum get WithinPage get OvertitleOffsetsProportionFontSizeVertical SheetNum get WithinPage get add OvertitleFontSizes SheetNum get WithinPage get mul 2 copy gt {exch} if pop } if % ... NonEmptyCompoundObject put % TitleAboveBelowOverB ... TitleAboveBelowOverT SheetNum get WithinPage 2 copy get Titles WithinTitles get NonEmptyCompoundObject { TitleProportionFontSizeT SheetNum get WithinPage get TitleOffsetsProportionFontSizeVertical SheetNum get WithinPage get add TitleFontSizes SheetNum get WithinPage get mul 2 copy lt {exch} if pop } if % ... NonEmptyCompoundObject Abovetitles WithinTitles get NonEmptyCompoundObject { AbovetitleProportionFontSizeT SheetNum get WithinPage get AbovetitleFontSizes SheetNum get WithinPage get mul AbovetitleOffsetsAbsoluteVertical SheetNum get WithinPage get add 2 copy lt {exch} if pop } if % ... NonEmptyCompoundObject Belowtitles WithinTitles get NonEmptyCompoundObject { BelowtitleProportionFontSizeT SheetNum get WithinPage get BelowtitleFontSizes SheetNum get WithinPage get mul BelowtitleOffsetsAbsoluteVertical SheetNum get WithinPage get add 2 copy lt {exch} if pop } if % ... NonEmptyCompoundObject Overtitles WithinTitles get NonEmptyCompoundObject { OvertitleProportionFontSizeT SheetNum get WithinPage get OvertitleOffsetsProportionFontSizeVertical SheetNum get WithinPage get add OvertitleFontSizes SheetNum get WithinPage get mul 2 copy lt {exch} if pop } if % ... NonEmptyCompoundObject put % TitleAboveBelowOverT ... TitleAboveBelowOverL SheetNum get WithinPage 2 copy get Titles WithinTitles get NonEmptyCompoundObject { TitleProportionFontSizeL SheetNum get WithinPage get TitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get add TitleFontSizes SheetNum get WithinPage get mul 2 copy gt {exch} if pop } if % ... NonEmptyCompoundObject Abovetitles WithinTitles get NonEmptyCompoundObject { AbovetitleProportionFontSizeL SheetNum get WithinPage get AbovetitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get add AbovetitleFontSizes SheetNum get WithinPage get mul 2 copy gt {exch} if pop } if % ... NonEmptyCompoundObject Belowtitles WithinTitles get NonEmptyCompoundObject { BelowtitleProportionFontSizeL SheetNum get WithinPage get BelowtitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get add BelowtitleFontSizes SheetNum get WithinPage get mul 2 copy gt {exch} if pop } if % ... NonEmptyCompoundObject Overtitles WithinTitles get NonEmptyCompoundObject { OvertitleProportionFontSizeL SheetNum get WithinPage get OvertitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get add OvertitleFontSizes SheetNum get WithinPage get mul 2 copy gt {exch} if pop } if % ... NonEmptyCompoundObject put % TitleAboveBelowOverL ... TitleAboveBelowOverR SheetNum get WithinPage 2 copy get Titles WithinTitles get NonEmptyCompoundObject { TitleProportionFontSizeR SheetNum get WithinPage get TitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get add TitleFontSizes SheetNum get WithinPage get mul 2 copy lt {exch} if pop } if % ... NonEmptyCompoundObject Abovetitles WithinTitles get NonEmptyCompoundObject { AbovetitleProportionFontSizeR SheetNum get WithinPage get AbovetitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get add AbovetitleFontSizes SheetNum get WithinPage get mul 2 copy lt {exch} if pop } if % ... NonEmptyCompoundObject Belowtitles WithinTitles get NonEmptyCompoundObject { BelowtitleProportionFontSizeR SheetNum get WithinPage get BelowtitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get add BelowtitleFontSizes SheetNum get WithinPage get mul 2 copy lt {exch} if pop } if % ... NonEmptyCompoundObject Overtitles WithinTitles get NonEmptyCompoundObject { OvertitleProportionFontSizeR SheetNum get WithinPage get OvertitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get add OvertitleFontSizes SheetNum get WithinPage get mul 2 copy lt {exch} if pop } if % ... NonEmptyCompoundObject put % TitleAboveBelowOverR ... TitleAboveBelowOverT SheetNum get WithinPage get dup TABO_MaxT gt {/TABO_MaxT exch def /TABO_MaxT_SheetNum SheetNum def /TABO_MaxT_WithinPage WithinPage def} {pop} ifelse TitleAboveBelowOverB SheetNum get WithinPage get dup TABO_MinB lt {/TABO_MinB exch def /TABO_MinB_SheetNum SheetNum def /TABO_MinB_WithinPage WithinPage def} {pop} ifelse } for % WithinPage, WithinTitles } bind for % SheetNum {GlassesNumCopies 1 ge DecanterLabelsNumCopies 1 ge PrePourNumCopies 1 ge BottleWrapNumCopies 1 ge StickyLabelsNumCopies 1 ge or or or or} MightBeTrue { () Abovetitles NonEmptyCompoundObject {(AbovetitleFontSizes/TitleFontSizes = ) AbovetitleFontSizes TitleFontSizes {TwoArraysFunctionDiv} //false TwoArraysFunction SizeArrayOutput TrimSpaces (.) (\n)} if Belowtitles NonEmptyCompoundObject {(BelowtitleFontSizes/TitleFontSizes = ) BelowtitleFontSizes TitleFontSizes {TwoArraysFunctionDiv} //false TwoArraysFunction SizeArrayOutput TrimSpaces (.) (\n)} if Overtitles NonEmptyCompoundObject {(OvertitleFontSizes/TitleFontSizes = ) OvertitleFontSizes TitleFontSizes {TwoArraysFunctionDiv} //false TwoArraysFunction SizeArrayOutput TrimSpaces (.) (\n)} if TABO_MaxT_WithinPage 0 ge TABO_MinB_WithinPage 0 le or { TABO_MaxT_SheetNum (,) TABO_MaxT_WithinPage (,) GlassesOnSheets TABO_MaxT_SheetNum get TABO_MaxT_WithinPage get (,) Titles 2 index get ASCIIfy ( has max TitleAboveBelowOverT ~= ) TitleAboveBelowOverT TABO_MinB_SheetNum get TABO_MinB_WithinPage get (; ) TABO_MinB_SheetNum (,) TABO_MinB_WithinPage (,) GlassesOnSheets TABO_MinB_SheetNum get TABO_MinB_WithinPage get (,) Titles 2 index get ASCIIfy ( has min TitleAboveBelowOverB ~= ) TitleAboveBelowOverB TABO_MinB_SheetNum get TABO_MinB_WithinPage get (.) } {pop} ifelse % ... 0 ge ... 0 le or } if % ... GlassesNumCopies 1 ge ... StickyLabelsNumCopies 1 ge ... ConcatenateToMark OutputToLog end {PrePourNumCopies 1 ge} MightBeTrue { //DeBugLevel 100 le {( Main: PrePourScalingFactors) OutputToLog} if /TypeOfPagesBeingRendered /PrePour store /PrePourScalingFactors [ NumSheets {//Infinity} repeat ] def 12 dict begin 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def {PrePourNumCopies 1 ge} MightBeTrue { //false //false //false //false PrePourPaperType PrePourOrientation SetPaperSize //true DefStoreMgns CircletextFont CirclearraysFontSizes SheetNum get WithinPage get selectfont CirclearraysPrePour WithinTitles get StringPathBBox exch pop exch sub /AD exch def pop PageHeight MgnB MgnT add sub 2 div AD sub dup PageWidth MgnL MgnR add sub 2 div AD sub dup [ TitleAboveBelowOverL TitleAboveBelowOverR TitleAboveBelowOverB TitleAboveBelowOverT ] {SheetNum get WithinPage get abs 0.48 add div 4 1 roll} forall % Half maximum linewidth of /MidGrey edging 3 {2 copy gt {exch} if pop} repeat PrePourScalingFactors SheetNum 3 copy get lt {3 -1 roll put} {pop pop pop} ifelse } if % ... PrePourNumCopies 1 ge ... } for % WithinPage, WithinTitles } bind for % SheetNum 0 1 NumSheets 1 sub {/SN0 exch def 0 1 NumSheets 1 sub {/SN1 exch def ShrinkRadiiSquareArray SN0 get SN1 get { PrePourScalingFactors dup SN0 get exch SN1 3 copy get lt {3 -1 roll put} {pop pop pop} ifelse } if} for} bind for end } if % ... PrePourNumCopies 1 ge ... {PlaceNames} MightBeTrue {/PlaceNamesFontSizes [ NamesPlaceNames {execU length array} forall ] def} if % WithinTitles FindWithinGlassesOnSheets SheetNum WithinPage true | false /FindWithinGlassesOnSheets { 6 dict begin /param exch def /AnsFound //false def 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def WithinTitles param eq {/AnsFound //true def exit} if } for % WithinPage, WithinTitles AnsFound {exit} if } for % SheetNum AnsFound {SheetNum WithinPage //true} {//false} ifelse end } bind def % /FindWithinGlassesOnSheets % FlightSeparationPath takes a single array parameter and appends a segment to the current path. % The range of permitted parameters is described at http://github.com/jdaw1/placemat/blob/main/Documentation/page_level.md#separating-flights-within-a-page /FlightSeparationDone [ NumSheets {//false} repeat ] def /FlightSeparationInterestingsTB [ SheetLengths {4 mul array} forall ] def /FlightSeparationInterestingsLR [ SheetLengths {4 mul array} forall ] def /FlightSeparationPath { //DeBugLevel 50 le {(+FlightSeparationPath) OutputToLog} if 42 dict begin /fsl exch execU def % Flight Separation Line /Connections_fsl fsl length array def /Connections_X fsl length array def /Connections_Y fsl length array def /Connections_dX [ fsl length {0} repeat ] def /Connections_dY [ fsl length {0} repeat ] def /Connections_dLength2 [ fsl length {0} repeat ] def /Connections_Type [ fsl length {/Straight} repeat ] def % /Point, /Straight, /Arc. Note that /Straight /Arc are from previous. /Connections_linetoXY [ fsl length {//true} repeat ] def % Is a line to or from _X,_Y permitted? /Connections_num 0 def /Connections_Done_First //false def /FSNumDoneTB 0 def /FSNumDoneLR 0 def % ArrayInterestingPoints FlightSeparationReportablePointsAppend -- /FlightSeparationReportablePointsAppend { { aload pop /YY exch def /XX exch def GlassPositions SheetNum get { aload pop /Y exch def /X exch def Y MgnB Radii SheetNum get 2 mul add le Y PageHeight MgnT sub Radii SheetNum get 2 mul sub ge or { XX X sub Radii SheetNum get div dup abs 2 le { //true FlightSeparationInterestingsTB SheetNum get 0 FSNumDoneTB getinterval {2 index sub abs //Epsilon le {pop pop //false exit} if} forall {FlightSeparationInterestingsTB SheetNum get exch FSNumDoneTB exch put /FSNumDoneTB FSNumDoneTB 1 add store} if } {pop} ifelse % within 2 radii } if % Circle near top or bottom X MgnL Radii SheetNum get 2 mul add le X PageWidth MgnR sub Radii SheetNum get 2 mul sub ge or { YY Y sub Radii SheetNum get div dup abs 2 le { //true FlightSeparationInterestingsLR SheetNum get 0 FSNumDoneLR getinterval {2 index sub abs //Epsilon le {pop pop //false exit} if} forall {FlightSeparationInterestingsLR SheetNum get exch FSNumDoneLR exch put /FSNumDoneLR FSNumDoneLR 1 add store} if } {pop} ifelse % within 2 radii } if % Circle near left or right } forall % GlassPositions SheetNum get } forall % 'ArrayInterestingPoints' } def % /FlightSeparationReportablePointsAppend //DeBugLevel 49 le {( FlightSeparationPath: Connections_ arrays) OutputToLog} if 0 1 fsl length 1 sub { /fsl_i exch def /ThisFSPiece fsl fsl_i GetEU def ThisFSPiece /Arc eq {Connections_Type Connections_num ThisFSPiece put Connections_fsl Connections_num ThisFSPiece put} if ThisFSPiece type /arraytype eq {ThisFSPiece length 0 gt} {//false} ifelse { ThisFSPiece length 2 eq dup {ThisFSPiece {execU dup type /integertype eq {pop} {dup type /arraytype eq {length 2 eq and} {pop pop //false} ifelse} ifelse} forall} if { % So [i j] or [[xi, yi], j] or [i, [xj, yj]] or [[xi, yi], [xj, yj]] ThisFSPiece {execU dup type /integertype eq {GlassPositions SheetNum get exch get} if {execU} forall} forall 4 copy 3 -1 roll add 2 div Connections_Y exch Connections_num exch put add 2 div Connections_X exch Connections_num exch put 3 -1 roll sub Connections_dX exch Connections_num exch put sub Connections_dY exch Connections_num exch put % Y-positions switched which does negation of dX Connections_dLength2 Connections_num Connections_dX Connections_num get dup mul Connections_dY Connections_num get dup mul add put Connections_dLength2 Connections_num get Radii SheetNum get dup mul 12 mul gt Radii SheetNum get MaxRadius lt and { mark (Warning in FlightSeparationPath: with SheetNum = ) SheetNum (, position ) fsl_i ( in the parameter to FlightSeparationPath, references two circles, ) ThisFSPiece 0 GetEU ( and ) ThisFSPiece 1 GetEU (, that are apart by more than Radii SheetNum get 2 mul Sqrt3 mul.) ConcatenateToMark OutputToLog } if % More than Radii SheetNum get*2*Sqrt[3] apart /Connections_num Connections_num 1 add def }{ % So not [i j] nor [[xi, yi], j] nor [i, [xj, yj]] nor [[xi, yi], [xj, yj]] Connections_fsl Connections_num ThisFSPiece 0 get put 1 { //false [/Left /Right] {ThisFSPiece 0 get eq {pop //true exit} if} forall { /SumReals 0 def /SumPointeds 0 def /CountPointeds 0 def 1 1 ThisFSPiece length 1 sub { ThisFSPiece exch GetEU /SubPiece exch def SubPiece /Bottom eq {/SumPointeds MgnB SumPointeds add def /CountPointeds CountPointeds 1 add def} if SubPiece /Top eq {/SumPointeds PageHeight MgnT sub SumPointeds add def /CountPointeds CountPointeds 1 add def} if SubPiece type /integertype eq {/SumPointeds GlassPositions SheetNum get SubPiece get 1 get SumPointeds add def /CountPointeds CountPointeds 1 add def} if SubPiece type /realtype eq {/SumReals SubPiece SumReals add def} if } for % ThisFSPiece Connections_X Connections_num ThisFSPiece 0 get /Right eq {PageWidth MgnR sub} {MgnL} ifelse put CountPointeds 0 gt { Connections_Y Connections_num SumReals Radii SheetNum get mul SumPointeds CountPointeds div add put Connections_dX Connections_num 1 put Connections_dY Connections_num 0 put }{ Connections_linetoXY Connections_num //false put Connections_Y Connections_num PageHeight MgnT MgnB sub add 2 div put Connections_dX Connections_num 0 put Connections_dY Connections_num 1 put } ifelse % CountPointeds 0 gt Connections_dLength2 Connections_num Connections_dX Connections_num get dup mul Connections_dY Connections_num get dup mul add put currentdict /CountPointeds undef currentdict /SumPointeds undef currentdict /SumReals undef /Connections_num Connections_num 1 add def exit } if % /Left or /Right or /Horizontal... //false [/Bottom /Top] {ThisFSPiece 0 get eq {pop //true exit} if} forall { /SumReals 0 def /SumPointeds 0 def /CountPointeds 0 def 1 1 ThisFSPiece length 1 sub { ThisFSPiece exch GetEU /SubPiece exch def SubPiece /Left eq {/SumPointeds MgnL SumPointeds add def /CountPointeds CountPointeds 1 add def} if SubPiece /Right eq {/SumPointeds PageWidth MgnR sub SumPointeds add def /CountPointeds CountPointeds 1 add def} if SubPiece type /integertype eq {/SumPointeds GlassPositions SheetNum get SubPiece get 0 get SumPointeds add def /CountPointeds CountPointeds 1 add def} if SubPiece type /realtype eq {/SumReals SubPiece SumReals add def} if } for % ThisFSPiece Connections_Y Connections_num ThisFSPiece 0 get /Top eq {PageHeight MgnT sub} {MgnB} ifelse put % /VerticalUp has Y at bottom CountPointeds 0 gt { Connections_X Connections_num SumReals Radii SheetNum get mul SumPointeds CountPointeds div add put Connections_dX Connections_num 0 put Connections_dY Connections_num 1 put }{ Connections_linetoXY Connections_num //false put Connections_X Connections_num PageWidth MgnR MgnL sub add 2 div put Connections_dX Connections_num 1 put Connections_dY Connections_num 0 put } ifelse % CountPointeds 0 gt Connections_dLength2 Connections_num Connections_dX Connections_num get dup mul Connections_dY Connections_num get dup mul add put currentdict /CountPointeds undef currentdict /SumPointeds undef currentdict /SumReals undef /Connections_num Connections_num 1 add def exit } if % /Top or /Bottom (Error in FlightSeparationPath: invalid item ) ThisFSPiece 0 //true ThingToDebugText Concatenate OutputToLog } repeat % 1 } ifelse % tangent? } if % ThisFSPiece type /arraytype eq } for % fsl_i, ThisFSPiece fsl length 0 gt {fsl 0 get /Closed eq Connections_Done_First and} {//false} ifelse { //DeBugLevel 49 le {( FlightSeparationPath: Connections_ arrays since /Closed) OutputToLog} if Connections_fsl Connections_num Connections_fsl 0 get put Connections_X Connections_num Connections_X 0 get put Connections_Y Connections_num Connections_Y 0 get put Connections_dX Connections_num Connections_dX 0 get neg put Connections_dY Connections_num Connections_dY 0 get neg put Connections_dLength2 Connections_num Connections_dLength2 0 get put Connections_Type 0 get dup /Arc eq {Connections_Type exch Connections_num exch put} {pop} ifelse /Connections_num Connections_num 1 add def } if % ... /Closed ... Connections_Done_First and //DeBugLevel 49 le {( FlightSeparationPath: path construction) OutputToLog} if 0 1 Connections_num 1 sub { /Connections0 exch def /X0 Connections_X Connections0 get def /Y0 Connections_Y Connections0 get def Connections_Type Connections0 get /Point eq Connections0 0 le or { Connections_X Connections0 get Connections_Y Connections0 get moveto }{ /Connections1 Connections0 1 sub def /dX0 Connections_dX Connections0 get def /dY0 Connections_dY Connections0 get def /dL0 Connections_dLength2 Connections0 get def /X1 Connections_X Connections1 get def /Y1 Connections_Y Connections1 get def /dX1 Connections_dX Connections1 get def /dY1 Connections_dY Connections1 get def /dL1 Connections_dLength2 Connections1 get def /DirectionsBothNonZero dL0 1E-8 ge dL1 1E-8 ge and def /DirectionsParallel dX0 dX1 mul dY0 dY1 mul add dup mul dL0 dL1 mul 0.999 mul gt def % Cos()^2 = 0.999 implies angle of about 1.812 degrees % GSave newpath Connections_X Connections0 get Connections_Y Connections0 get 2 copy 10 0 360 arc Connections0 23 mul Connections_num mod Connections_num div 1 0.75 sethsbcolor stroke 5 sub moveto /Times-Bold 24 selectfont Connections0 show GRestore DirectionsParallel not DirectionsBothNonZero and { X0 X1 sub dY0 mul Y1 Y0 sub dX0 mul add dX1 dY0 mul dX0 dY1 mul sub div dup dX1 mul X1 add /Xj exch def dY1 mul Y1 add /Yj exch def Xj MgnL 1.0 sub lt Xj PageWidth MgnR sub 1.0 add gt or Yj MgnB 1.0 sub lt Yj PageHeight MgnT sub 1.0 add gt or or {/DirectionsParallel //true def} if } if % DirectionsParallel not DirectionsBothNonZero and dL0 //PrinterEpsilonSquared gt {X1 X0 sub dX0 mul Y1 Y0 sub dY0 mul add dX0 dup mul dY0 dup mul add div 2 div} {0} ifelse dup dX0 mul X0 add /Xh0 exch def dY0 mul Y0 add /Yh0 exch def dL1 //PrinterEpsilonSquared gt {X0 X1 sub dX1 mul Y0 Y1 sub dY1 mul add dX1 dup mul dY1 dup mul add div 2 div} {0} ifelse dup dX1 mul X1 add /Xh1 exch def dY1 mul Y1 add /Yh1 exch def Connections_Type Connections0 get /Arc eq { DirectionsParallel not DirectionsBothNonZero and Connections_linetoXY Connections0 get { {Xj Yj} {Xh1 Xh0 add 2 div Yh1 Yh0 add 2 div} ifelse dup Y0 ne 2 index X0 ne or {X0 Y0 2 copy 6 2 roll Radii SheetNum get FlightSeparationsArcProportionRadius mul arct lineto} {pop pop} ifelse % Identical points produces /undefinedresult } {{Xj Yj lineto} if} ifelse % Connections_linetoXY Connections0 get } if % /Arc Connections_Type Connections0 get /Straight eq { DirectionsParallel not DirectionsBothNonZero and {Xj Yj lineto} if Connections_linetoXY Connections0 get {X0 Y0 lineto} if } if % ... /Straight ... } ifelse % ... /Point ... } for % Connections0 fsl length 1 ge {fsl 0 get /Closed eq {closepath} if} if 3 PathDistinctiveXY FlightSeparationReportablePointsAppend FlightSeparationDone SheetNum get not { mark FSNumDoneTB 0 gt { mark (FlightSeparations, SheetNum=) SheetNum (, /Top or /Bottom: possible elegant offsets from a centre: ) () /prev //Infinity def FlightSeparationInterestingsTB SheetNum get 0 FSNumDoneTB getinterval dup {lt} ShellSort {dup prev sub abs //Epsilon ge {dup /prev exch store (; )} {pop} ifelse} forall pop ConcatenateToMark } if % FSNumDoneTB 0 gt FSNumDoneLR 0 gt { mark (FlightSeparations, SheetNum=) SheetNum (, /Left or /Right: possible elegant offsets from a centre: ) () /prev //Infinity def FlightSeparationInterestingsLR SheetNum get 0 FSNumDoneLR getinterval dup {lt} ShellSort {dup prev sub abs //Epsilon ge {dup /prev exch store (; )} {pop} ifelse} forall pop ConcatenateToMark } if % FSNumDoneLR 0 gt counttomark dup 0 gt {-1 2 {(\n) exch 1 roll} for ConcatenateToMark OutputToLog} {pop pop} ifelse FlightSeparationDone SheetNum //true put } if % FlightSeparationDone SheetNum get not end //DeBugLevel 50 le {(-FlightSeparationPath) OutputToLog} if } bind def % /FlightSeparationPath % Make forms {BackgroundTextsGlasses PrePourShowBackgroundTexts BackgroundTextsTastingNotes or or} MightBeTrue { /BackgroundTextsTNsRotated GlassesOnTastingNotePages length array def /BackgroundTextsGlassesRotated NumSheets array def /BackgroundTextsTNsFontSizeX GlassesOnTastingNotePages length array def /BackgroundTextsGlassesFontSizeX NumSheets array def /BackgroundTextsTNsFontSizeY GlassesOnTastingNotePages length array def /BackgroundTextsGlassesFontSizeY NumSheets array def /BackgroundTextsTNsL GlassesOnTastingNotePages length array def /BackgroundTextsGlassesL NumSheets array def /BackgroundTextsTNsR GlassesOnTastingNotePages length array def /BackgroundTextsGlassesR NumSheets array def /BackgroundTextsTNsB GlassesOnTastingNotePages length array def /BackgroundTextsGlassesB NumSheets array def /BackgroundTextsTNsT GlassesOnTastingNotePages length array def /BackgroundTextsGlassesT NumSheets array def /BackgroundTextsTNsMinB GlassesOnTastingNotePages length array def /BackgroundTextsGlassesMinB NumSheets array def /BackgroundTextsTNsMaxT GlassesOnTastingNotePages length array def /BackgroundTextsGlassesMaxT NumSheets array def /BackgroundTextsTNsOffsetY GlassesOnTastingNotePages length array def /BackgroundTextsGlassesOffsetY NumSheets array def /BackgroundUsedFontSizesX NumSheets GlassesOnTastingNotePages length add Titles length add array def % Way too many should be enough [ /BackgroundUsedFontSizesY /BackgroundUsedFontSizesOrigX /BackgroundUsedFontSizesOrigY ] {BackgroundUsedFontSizesX length array def} forall /BackgroundUsedFontSizesNum 0 def 21 dict begin 0 1 1 { /PageType exch def /TypeOfPagesBeingRendered PageType 0 eq {/Glasses} {/TastingNotes} ifelse store 0 1 PageType 0 eq {NumSheets} {GlassesOnTastingNotePages length} ifelse 1 sub { PageType 0 eq {/SheetNum} {/TNSheetNum} ifelse exch def /BackgroundTextThis PageType 0 eq {BackgroundTextsGlassesTexts SheetNum} {BackgroundTextsTNsTexts TNSheetNum} ifelse get def /BackgroundTextThis load length 0 gt { //false //false //false //false PageType 0 eq {PaperType Orientation} {TastingNotesPaperType TastingNotesOrientation} ifelse SetPaperSize //true DefStoreMgns PageType 0 eq {BackgroundTextsGlassesRotated SheetNum} {BackgroundTextsTNsRotated TNSheetNum} ifelse BackgroundTextsOrientation dup /Rotated eq exch PageType 0 eq {Orientation} {TastingNotesOrientation} ifelse 2 copy /Landscape eq exch /Portrait eq and 3 1 roll /Portrait eq exch /Landscape eq and or or put BackgroundTextsFont //DeSizeRounding selectfont /BackgroundTextThis load StringPathBBox [ /BgT /BgR /BgB /BgL ] {exch //DeSizeRounding div def} forall TypeOfPagesBeingRendered /Glasses eq {PackingDescriptors SheetNum get dup dup type /arraytype eq { //false exch {/SuppressOrnamentsLeft eq {pop //true exit} if} forall {mark (Warning: SheetNum=) SheetNum ( has BackgroundText, but its PackingStyle contains /SuppressOrnamentsLeft.) ConcatenateToMark OutputToLog} if //false exch {/SuppressOrnamentsRight eq {pop //true exit} if} forall {mark (Warning: SheetNum=) SheetNum ( has BackgroundText, but its PackingStyle contains /SuppressOrnamentsRight.) ConcatenateToMark OutputToLog} if //false exch {/SuppressOrnamentsCentre eq {pop //true exit} if} forall {mark (Warning: SheetNum=) SheetNum ( has BackgroundText, but its PackingStyle contains /SuppressOrnamentsCentre.) ConcatenateToMark OutputToLog} if } {pop pop} ifelse} if % /arraytype, /Glasses } {/BgT 0 def /BgR 0 def /BgB 0 def /BgL 0 def} ifelse % /BackgroundTextThis load length 0 gt PageType 0 eq {BackgroundTextsGlassesL SheetNum BackgroundTextsGlassesR BackgroundTextsGlassesB BackgroundTextsGlassesT BackgroundTextsGlassesMinB BackgroundTextsGlassesMaxT} {BackgroundTextsTNsL TNSheetNum BackgroundTextsTNsR BackgroundTextsTNsB BackgroundTextsTNsT BackgroundTextsTNsMinB BackgroundTextsTNsMaxT} ifelse 5 index BgT put 4 index BgB put 3 index BgT put 2 index BgB put 1 index BgR put BgL put } for % SheetNum|TNSheetNum //true BackgroundTextsGlassesSameSizeIfAllOf {dup //false eq exch /False eq or {pop //false exit} if} forall { 0 1 PageType 0 eq {NumSheets} {GlassesOnTastingNotePages length} ifelse 1 sub { /SNum0 exch def 0 1 SNum0 1 sub { /SNum1 exch def //true BackgroundTextsGlassesSameSizeIfAllOf PageType 0 eq { { dup /SamePageOrdering eq {PageOrderingGlasses dup SNum0 GetEU exch SNum1 GetEU ne {pop pop //false exit} if} if dup /OnSheetWithSameNumberGlasses eq {GlassesOnSheets SNum0 GetEU length GlassesOnSheets SNum1 GetEU length ne {pop pop //false exit} if} if dup /OnSheetWithSameRadius eq {Radii SNum0 GetEU Radii SNum1 GetEU RadiiEffectivelyEqual not {pop pop //false exit} if} if dup /SamePaperSize eq {PaperTypes SNum0 GetEU PaperTypes SNum1 GetEU ne {pop pop //false exit} if} if dup /TextSameLength eq {BackgroundTextsGlassesTexts SNum0 get LengthCompoundObject BackgroundTextsGlassesTexts SNum1 get LengthCompoundObject ne {pop pop //false exit} if} if dup /RadiiShrunkToBeSame eq {ShrinkRadiiSquareArray SNum0 GetEU SNum1 GetEU not {pop pop //false exit} if} if pop } } { { dup /SamePageOrdering eq {PageOrderingTastingNotePages dup SNum0 GetEU exch SNum1 GetEU ne {pop pop //false exit} if} if dup /OnSheetWithSameNumberGlasses eq {GlassesOnTastingNotePages SNum0 GetEU length GlassesOnTastingNotePages SNum1 GetEU length ne {pop pop //false exit} if} if dup /SamePaperSize eq {<< /TNSheetNum SNum0 /SheetNum SNum0 >> begin TastingNotesPaperType end << /TNSheetNum SNum1 /SheetNum SNum1 >> begin TastingNotesPaperType end ne {pop pop //false exit} if} if dup /TextSameLength eq {BackgroundTextsTNsTexts SNum0 get LengthCompoundObject BackgroundTextsTNsTexts SNum1 get LengthCompoundObject ne {pop pop //false exit} if} if pop } } ifelse forall % BackgroundTextsGlassesSameSizeIfAllOf { PageType 0 eq {BackgroundTextsGlassesMinB dup BackgroundTextsGlassesMaxT dup} {BackgroundTextsTNsMinB dup BackgroundTextsTNsMaxT dup} ifelse SNum1 2 copy get 2 index SNum0 get dup 3 1 roll lt {put} {pop pop pop} ifelse SNum0 2 copy get 2 index SNum1 get dup 3 1 roll lt {put} {pop pop pop} ifelse SNum1 2 copy get 2 index SNum0 get dup 3 1 roll gt {put} {pop pop pop} ifelse SNum0 2 copy get 2 index SNum1 get dup 3 1 roll gt {put} {pop pop pop} ifelse } if % passes all possible tests } for % SNum1 } for % SNum0 } if % not /False 0 1 PageType 0 eq {NumSheets} {GlassesOnTastingNotePages length} ifelse 1 sub { dup /SheetNum exch def /TNSheetNum exch def % In case BackgroundTextsSquooshMin/...Max depend on SheetNum|TastingNotes PageType 0 eq {BackgroundTextsGlassesL BackgroundTextsGlassesR BackgroundTextsGlassesMinB BackgroundTextsGlassesMaxT} {BackgroundTextsTNsL BackgroundTextsTNsR BackgroundTextsTNsMinB BackgroundTextsTNsMaxT} ifelse % Note MinB, MaxT 4 {SheetNum get 4 1 roll} repeat /BgT exch def /BgB exch def /BgR exch def /BgL exch def BgR BgL gt BgT BgB gt and { //false //false //false //false PageType 0 eq {PaperType Orientation} {TastingNotesPaperType TastingNotesOrientation} ifelse SetPaperSize //true DefStoreMgns PageHeight MgnB MgnT add sub PageWidth MgnL MgnR add sub PageType 0 eq {BackgroundTextsGlassesRotated} {BackgroundTextsTNsRotated} ifelse SheetNum get {exch} if /FontSizeOrigX exch BgR BgL sub dup //Epsilon le {pop pop 1} {div} ifelse def /FontSizeOrigY exch BgT BgB sub dup //Epsilon le {pop pop 1} {div} ifelse def /FontSizeX FontSizeOrigX FontSizeOrigY BackgroundTextsSquooshMin div gt {FontSizeOrigY BackgroundTextsSquooshMin div} {FontSizeOrigX} ifelse BackgroundTextsFontSizeMax 2 copy gt {exch} if pop def /FontSizeY FontSizeOrigY FontSizeOrigX BackgroundTextsSquooshMax mul gt {FontSizeOrigX BackgroundTextsSquooshMax mul} {FontSizeOrigY} ifelse BackgroundTextsFontSizeMax 2 copy gt {exch} if pop def PageType 0 eq {BackgroundTextsGlassesFontSizeX} {BackgroundTextsTNsFontSizeX} ifelse SheetNum FontSizeX put PageType 0 eq {BackgroundTextsGlassesFontSizeY} {BackgroundTextsTNsFontSizeY} ifelse SheetNum FontSizeY put //true 0 1 BackgroundUsedFontSizesNum 1 sub { /i exch def BackgroundUsedFontSizesOrigX i get FontSizeOrigX sub abs //PrinterEpsilon le BackgroundUsedFontSizesOrigY i get FontSizeOrigY sub abs //PrinterEpsilon le and BackgroundUsedFontSizesX i get FontSizeX sub abs //PrinterEpsilon le and BackgroundUsedFontSizesY i get FontSizeY sub abs //PrinterEpsilon le and {pop //false exit} if } for % ... BackgroundUsedFontSizesNum ... { BackgroundUsedFontSizesOrigX BackgroundUsedFontSizesNum FontSizeOrigX put BackgroundUsedFontSizesOrigY BackgroundUsedFontSizesNum FontSizeOrigY put BackgroundUsedFontSizesX BackgroundUsedFontSizesNum FontSizeX put BackgroundUsedFontSizesY BackgroundUsedFontSizesNum FontSizeY put /BackgroundUsedFontSizesNum dup load 1 add store mark (BackgroundTexts: FontSizeX=) FontSizeX (; FontSizeY=) FontSizeY (, on ) TypeOfPagesBeingRendered TypeOfPagesBeingRendered /TastingNotes eq {( TNSheetNum=) TNSheetNum} {( SheetNum=) SheetNum} ifelse ( and perhaps others) PageType 0 eq {BackgroundTextsGlassesTexts SheetNum} {BackgroundTextsTNsTexts TNSheetNum} ifelse get LengthCompoundObject 2 ge { PageWidth MgnL MgnR add sub PageHeight MgnB MgnT add sub PageType 0 eq {BackgroundTextsGlassesRotated SheetNum} {BackgroundTextsTNsRotated TNSheetNum} ifelse get {exch} if div BgT BgB sub mul BgR BgL sub sub dup abs 0.0001 ge {( \(for snug fit insert "{) exch dup 0 gt {(+) exch} if ( Kern}"\))} {pop ( \(which fits snugly\))} ifelse % If so small that would be shown in scientific notation, don't show. And on A3 1E-4 ~= 0.1pt } if % at least two characters (.) ConcatenateToMark OutputToLog } if % Not previous logged } if % Non-zero bounding box } for % SheetNum|TNSheetNum } bind for % PageType end /BackgroundTextsPaint { //DeBugLevel 50 le {(+BackgroundTextsPaint) OutputToLog} if 9 dict begin /BackgroundTextThis TypeOfPagesBeingRendered /Glasses eq {BackgroundTextsGlassesTexts SheetNum} {BackgroundTextsTNsTexts TNSheetNum} ifelse get def /BackgroundTextThis load length 0 gt { /BTAH BackgroundTextsAlignmentHorizontal dup /Left eq {pop 0} if dup /Centre eq {pop 0.5} if dup /Right eq {pop 1} if def /BTAV BackgroundTextsAlignmentVertical dup /Bottom eq {pop 0} if dup /Middle eq {pop 0.5} if dup /Top eq {pop 1} if def matrix currentmatrix TypeOfPagesBeingRendered /Glasses eq {BackgroundTextsGlassesRotated SheetNum} {BackgroundTextsTNsRotated TNSheetNum} ifelse get { PageWidth 0 translate 90 rotate /MgnL MgnB /MgnB MgnR /MgnR MgnT /MgnT MgnL /PageHeight PageWidth /PageWidth PageHeight 6 {def} repeat } if % rotated PageWidth MgnL MgnR add sub BTAH mul MgnL add PageHeight MgnB MgnT add sub BTAV mul MgnB add moveto TypeOfPagesBeingRendered /Glasses eq { matrix currentmatrix BackgroundTextsGlassesFontSizeX SheetNum get BackgroundTextsGlassesFontSizeY SheetNum get scale BackgroundTextsGlassesL SheetNum get neg 1 BTAH sub mul BackgroundTextsGlassesR SheetNum get neg BTAH mul add BackgroundTextsGlassesB SheetNum get neg 1 BTAV sub mul BackgroundTextsGlassesT SheetNum get neg BTAV mul add rmoveto }{ matrix currentmatrix BackgroundTextsTNsFontSizeX TNSheetNum get BackgroundTextsTNsFontSizeY TNSheetNum get scale BackgroundTextsTNsL TNSheetNum get neg 1 BTAH sub mul BackgroundTextsTNsR TNSheetNum get neg BTAH mul add BackgroundTextsTNsB TNSheetNum get neg 1 BTAV sub mul BackgroundTextsTNsT TNSheetNum get neg BTAV mul add rmoveto } ifelse % ... /Glasses BackgroundTextsFont 1 selectfont /BackgroundTextThis load //true CharPathRecursive setmatrix 0.9375 setgray 4.32 setlinewidth 1 setlinecap 1 setlinejoin [] 0 setdash ClipSave BackgroundTextsGlassesPaintCode ClipRestore setmatrix } if % /BackgroundTextThis load length 0 gt end //DeBugLevel 50 le {(-BackgroundTextsPaint) OutputToLog} if } bind def % /BackgroundTextsPaint {BackgroundTextsGlasses PrePourShowBackgroundTexts or} MightBeTrue { //DeBugLevel 100 le {( Main: BackgroundTextsGlassesForms) OutputToLog} if /BackgroundTextsGlassesForms [ GlassesOnSheets length {5 dict} repeat ] def 0 1 NumSheets 1 sub { /SheetNum exch def //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns BackgroundTextsGlassesForms SheetNum get begin /SheetNum SheetNum def /FormType 1 def /BBox [ MgnL 0.6 mul 1 sub MgnB 0.6 mul 1 sub PageWidth MgnR 0.6 mul 1 sub sub PageHeight MgnB 0.6 mul 1 sub sub ] def /Matrix matrix identmatrix def /PaintProc { //DeBugLevel 100 le {(+BackgroundTextsGlassesForms: PaintProc) OutputToLog} if pop BackgroundTextsPaint //DeBugLevel 100 le {(-BackgroundTextsGlassesForms: PaintProc) OutputToLog} if } def % /PaintProc end % BackgroundTextsGlassesForms SheetNum get } bind for % SheetNum UndefMgns currentdict /SheetNum undef } if % ... BackgroundTextsGlasses ... /BackgroundTextsTastingNotes load MightBeTrue { //DeBugLevel 100 le {( Main: BackgroundTextsTNsForms) OutputToLog} if /BackgroundTextsTNsForms [ GlassesOnTastingNotePages length {5 dict} repeat ] def 0 1 GlassesOnTastingNotePages length 1 sub { /TNSheetNum exch def //false //false //false //false TastingNotesPaperType TastingNotesOrientation SetPaperSize //true DefStoreMgns BackgroundTextsTNsForms TNSheetNum get begin /TNSheetNum TNSheetNum def /FormType 1 def /BBox [ MgnL 0.6 mul 1 sub MgnB 0.6 mul 1 sub PageWidth MgnR 0.6 mul 1 sub sub PageHeight MgnB 0.6 mul 1 sub sub ] def /Matrix matrix identmatrix def /PaintProc { //DeBugLevel 100 le {(+BackgroundTextsTNsForms: PaintProc) OutputToLog} if pop << /SheetNum TNSheetNum >> begin BackgroundTextsPaint end //DeBugLevel 100 le {(-BackgroundTextsTNsForms: PaintProc) OutputToLog} if } def % /PaintProc end % BackgroundTextsTNsForms TNSheetNum get } bind for % TNSheetNum UndefMgns currentdict /TNSheetNum undef } if % ... BackgroundTextsTastingNotes ... } if % ... BackgroundTextsGlasses ... % NameHorizontalLeft NameHorizontalRight ShowRight ShowLeft FillWhite WaterBoxesPaintProc - /WaterBoxesPaintProc { //DeBugLevel 100 le {(+WaterBoxesPaintProc) OutputToLog} if 20 dict begin /FillWhite exch def /ShowLeft exch def /ShowRight exch def /NameHorizontalRight exch def /NameHorizontalLeft exch def % This converts the new parameterisation into the old. /R Radii SheetNum get def /WaterBoxesNumSideTriangle WaterBoxesNum 8 mul 1 add sqrt 1.00001 sub 2 div ceiling cvi def /i WaterBoxesNumSideTriangle cvi 1 add 2 idiv def /WaterBoxesSize [ R R mul WaterBoxesGapProportionSize 1 add WaterBoxesNumSideTriangle cvi mul 1 add R mul -2 mul WaterBoxesGapProportionSize 1 add dup WaterBoxesNumSideTriangle cvi mul 1 add dup mul exch dup mul i mul i 1 WaterBoxesNumSideTriangle cvi add sub 2 mul mul add ] 0 //true R //true //PrinterEpsilon PolynomialRoots Min WaterBoxesSizeMax 2 copy gt {exch} if pop def % /WaterBoxesSize /WaterBoxesGap WaterBoxesSize WaterBoxesGapProportionSize mul def /WaterBoxesMaxRowLengths [ WaterBoxesNumSideTriangle cvi -1 0 {0 counttomark 1 sub -1 1 {index add} for WaterBoxesNum 2 copy ge {sub sub exit} {pop pop} ifelse} for ] def newpath [ ShowLeft {//false TypeOfPagesBeingRendered /Glasses eq {PackingDescriptors SheetNum get dup type /arraytype eq { {/SuppressOrnamentsLeft eq {pop exit} if} forall} {pop} ifelse} if} if ShowRight {//true TypeOfPagesBeingRendered /Glasses eq {PackingDescriptors SheetNum get dup type /arraytype eq { {/SuppressOrnamentsRight eq {pop exit} if} forall} {pop} ifelse} if} if ]{ /IsRight exch def /WBtoPaint 0 def /WBb MgnB def /WaterBoxPositions [ 0 1 WaterBoxesNum 1 sub % rows { /WaterBoxRow exch def /WBb WaterBoxesSize WaterBoxesGap add WaterBoxRow mul MgnB add def /WBt WBb WaterBoxesSize add def WBt PageHeight MgnT sub gt {exit} if 0 1 WaterBoxesNum 1 sub % columns { /WaterBoxCol exch def IsRight {/WBr PageWidth MgnR sub WaterBoxesSize WaterBoxesGap add WaterBoxCol mul sub def /WBl WBr WaterBoxesSize sub def} {/WBl MgnL WaterBoxesSize WaterBoxesGap add WaterBoxCol mul add def /WBr WBl WaterBoxesSize add def} ifelse % IsRight SideBySideGlassesTastingNotes not {IsRight {WBl NameHorizontalRight WaterBoxesGap add lt} {WBr NameHorizontalLeft WaterBoxesGap sub gt} ifelse {/WBok //false def exit} if} if WaterBoxesMaxRowLengths length dup 0 gt {1 sub WaterBoxRow 2 copy gt {exch} if pop WaterBoxesMaxRowLengths exch GetEU WaterBoxCol le {/WBok //false def exit} if} {pop} ifelse /WBok //true def 0 1 SheetLengths SheetNum get 1 sub { /WithinPage exch def CircleNonEmpty SheetNum get WithinPage get { R WaterBoxesGap add //PrinterEpsilon sub dup mul GlassPositions SheetNum get WithinPage get aload pop 3 copy 6 copy WBb sub dup mul exch WBl sub dup mul add gt 10 1 roll WBb sub dup mul exch WBr sub dup mul add gt 7 1 roll WBt sub dup mul exch WBl sub dup mul add gt 4 1 roll WBt sub dup mul exch WBr sub dup mul add gt or or or {/WBok //false def exit} if } if % CircleNonEmpty ... } for % WithinPage currentdict /WithinPage undef WBok {WBl WBb /WBtoPaint WBtoPaint 1 add def} {exit} ifelse } for % WaterBoxCol WaterBoxCol 0 eq WBok not and currentdict /WaterBoxCol undef {exit} if % blank row WBtoPaint WaterBoxesNum ge {exit} if } for % WaterBoxRow currentdict /WaterBoxRow undef ] def % /WaterBoxPositions 0 2 WaterBoxPositions length 1 sub { WaterBoxPositions exch 2 getinterval aload pop /WBb exch def /WBl exch def WBl WBb WaterBoxesSize add moveto WBl WBb lineto WBl WaterBoxesSize add dup WBb lineto WBb WaterBoxesSize add lineto } for FillWhite {GSave 1 setgray fill GRestore} if 0 setgray 0.24 setlinewidth 0 setlinecap 1 setlinejoin [] 0 setdash WaterBoxesFormatStroke newpath } forall % sides end //DeBugLevel 100 le {(-WaterBoxesPaintProc) OutputToLog} if } bind def % /WaterBoxesPaintProc /DropletLocalField % For speed takes no parameters; output put dictionary of calling routine. Assumes existence of X, Y, ChargesData { 11 dict begin % Local variables: i, XX, YY, Ch, Sp, DistSqrd /i ChargesData length 4 idiv def /P00_array i array def % Num derivatives of P wrt X; num derivs wrt Y /P10_array i array def % dP/dX /P01_array i array def % dP/dY /P20_array i array def % d2P/dX2 /P02_array i array def % d2P/dY2 /P11_array i array def % d2P/dXdY 0 4 ChargesData length 4 sub { /i exch def /XX ChargesData i get X sub def /YY ChargesData i 1 add get Y sub def /Ch ChargesData i 2 add get def /Sp ChargesData i 3 add get 2 mul def % At a distance of Sp, the angle is 45 degrees. /DistSqrd XX dup mul YY dup mul add def /i i 4 idiv def DistSqrd 0.01 gt % I.e., at least 0.1pt { P00_array i Ch DistSqrd div put P10_array i XX -2 mul Sp YY mul DistSqrd sqrt div add Ch mul DistSqrd dup mul div put P01_array i YY -2 mul Sp XX mul DistSqrd sqrt div sub Ch mul DistSqrd dup mul div put P20_array i XX dup mul 6 mul YY dup mul 2 mul sub Sp 5 mul XX mul YY mul DistSqrd sqrt div sub Ch mul DistSqrd dup dup mul mul div put P02_array i YY dup mul 6 mul XX dup mul 2 mul sub Sp 5 mul XX mul YY mul DistSqrd sqrt div add Ch mul DistSqrd dup dup mul mul div put P11_array i XX YY mul 8 mul Sp 2.5 mul XX YY sub XX YY add mul mul DistSqrd sqrt div add Ch mul DistSqrd dup dup mul mul div put }{ P00_array i Ch 0 ne {1e+19 Ch 0 lt {neg} if} {0} ifelse put P10_array i 0 put P01_array i 0 put P20_array i 0 put P02_array i 0 put P11_array i 0 put } ifelse % DistSqrd 0.01 gt. Constant 'Infinity' is a distance, hence this manual infinity. } for % i /P00 P00_array /P10 P10_array /P01 P01_array /P20 P20_array /P02 P02_array /P11 P11_array end 6 {//KleinSum exec def} repeat } bind def % /DropletLocalField % [ X0 Y0 Charge0 X1 Y1 Charge1 ... ] StartX StartY PathDistance StepSizeMax DropletPath [ X0 Y0 0 Pot0 X1 Y1 Dist1 Pot1 X2 Y2 Dist2 Pot2 ... ] /DropletPath { //DeBugLevel 25 le {(+DropletPath) OutputToLog} if 22 dict begin /StepSizeMax exch def /PathDistance exch def /Y exch def /X exch def /ChrgData exch def % mark (P00) (\t) (P10) 1 index (P01) 1 index (P20) 1 index (P02) 1 index (P11) ConcatenateToMark = /DistanceTraversed 0 def [ % Start this one droplet { % loop until have travelled enough distance //false 0 3 ChrgData length 3 sub {/i exch def ChrgData i get X sub dup mul ChrgData i 1 add get Y sub dup mul add StepSizeMax dup mul le {pop //true exit} if} for {counttomark {pop} repeat exit} if % Close to any of the charges DropletLocalField % mark P00 (\t) P10 1 index P01 1 index P20 1 index P02 1 index P11 ConcatenateToMark = X Y DistanceTraversed P00 % Output (P00 is 'new'; others are old). PathDistance DistanceTraversed sub //PrinterEpsilon le {exit} if /SpeedSqrd P10 dup mul P01 dup mul add def SpeedSqrd 0 gt { /ThisStep PathDistance DistanceTraversed sub dup StepSizeMax div ceiling dup 1 gt {div} {pop} ifelse abs 0.03 2 copy lt {exch} if pop % So that always move a non-trivial distance def % /ThisStep ThisStep SpeedSqrd sqrt div neg dup P10 mul X add /X exch def P01 mul Y add /Y exch def /DistanceTraversed DistanceTraversed ThisStep add def } {counttomark {pop} repeat exit} ifelse % SpeedSqrd 0 gt } loop % Until PathDistance DistanceTraversed sub //PrinterEpsilon le, or some bad conditions ] % End this one droplet end //DeBugLevel 25 le {(-DropletPath) OutputToLog} if } bind def % /DropletPath % Discussion: http://www.theportforum.com/viewtopic.php?t=175&p=112214#p112214 {Droplets} MightBeTrue { //DeBugLevel 50 le {(+DropletPaths computation) OutputToLog} if /DropletsWhichReversed NumSheets array def % Can be used in mischievous PaintBackgroundCode to highlight reversed droplets. /DropletsChargesText [ NumSheets {()} repeat ] def /DropletPaths [ % DropletPaths has one array element for each SheetNum. Within which, one per droplet, each of which is an array. % Most of these droplets are of length a multiple of four, being: X; Y; DistanceTravelled; Potential. % A small number of droplets are of length precisely five, the fifth being an array [x' y'], an eigenvector of the Hessian. 46 dict begin 0 1 NumSheets 1 sub { /SheetNum exch def //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns /DrpMgnL Droplets_SideBySide_UnderTNs {MarginL} {MgnL} ifelse def /DrpMgnR Droplets_SideBySide_UnderTNs {MarginR} {MgnR} ifelse def /DrpMgnB Droplets_SideBySide_UnderTNs {MarginB} {MgnB} ifelse def /DrpMgnT Droplets_SideBySide_UnderTNs {MarginT} {MgnT} ifelse def /ChargesData % length a multiple of 4: X0 Y0 Charge0 Spin0 X1 Y1 Charge1 Spin1 ... [ DropletsCharges length 4 mod 0 eq { % The parameter has length a multiple of 4: SheetNum (/All ==> all); position being either a WithinPage integer, or array [x y] of reals, or array [i j k ...] of WithinPages to be averaged; charge being numeric; spin being numeric. 0 4 DropletsCharges length 4 sub { /ChargeNum exch def /This DropletsCharges ChargeNum GetEU def This /All eq This type /integertype eq or { This /All eq This SheetNum eq or { /This DropletsCharges ChargeNum 1 add GetEU def /ThisGood //false def This type dup /arraytype eq exch /integertype eq or { This type /arraytype eq { This length 2 eq ThisGood not and {//true This {type /realtype ne {pop //false exit} if} forall} {//false} ifelse { /ThisGood //true def This aload pop } if % [x y] This length 1 ge ThisGood not and {//true This {type /integertype ne {pop //false exit} if} forall} {//false} ifelse { //true This {dup 0 lt exch SheetLengths SheetNum get ge or {pop //false exit} if} forall { /ThisGood //true def 0 This {GlassPositions SheetNum get exch get 0 get add} forall This length div 0 This {GlassPositions SheetNum get exch get 1 get add} forall This length div } {mark (Error: DropletsCharges ) ChargeNum 1 add ( = ) This ToString ( is an array of integers, more than none of which are out of bounds.) ConcatenateToMark OutputToLog} ifelse % In range } if % [WithinPage0 WithinPage1 ... ] ThisGood not {mark (Error: DropletsCharges ) ChargeNum 1 add ( get is validly an array, but should be either two reals, or >=1 in-range integers. Ignoring and continuing.) ConcatenateToMark OutputToLog} if }{ This type /integertype eq {This 0 ge This SheetLengths SheetNum get lt and} {//false} ifelse { /ThisGood //true def GlassPositions SheetNum get This get aload pop } {mark (Error: DropletsCharges ) ChargeNum 1 add (neither array, nor in-bounds integer. Ignoring and continuing.) ConcatenateToMark OutputToLog} ifelse } ifelse % ... /arraytype ... } {mark (Error: DropletsCharges ) ChargeNum 1 add ( get neither an integer \(WithinPage\) nor an array \([x y]\) nor an array \([WithinPage0 ...]\).) ConcatenateToMark OutputToLog} ifelse ThisGood { DropletsCharges ChargeNum 2 add GetEU DropletsCharges ChargeNum 3 add GetEU 2 copy IsNumber exch IsNumber and {1 index 0 eq {pop pop pop pop} if} {pop pop pop pop mark (Error: DropletsCharges ) ChargeNum 2 add ( or ) ChargeNum 3 add ( non-numeric. Ignoring and continuing.) ConcatenateToMark OutputToLog} ifelse % ... IsNumber ... IsNumber and } if % ThisGood } if % If charge used on this SheetNum } {mark (Error: DropletsCharges ) ChargeNum ( get neither an integer \(for a specific SheetNum\) nor /All.) ConcatenateToMark OutputToLog stop} ifelse } for % ChargeNum } {mark (Error: DropletsCharges length = ) DropletsCharges length ( which is not a multiple of 4.) ConcatenateToMark OutputToLog stop} ifelse ] def % /ChargesData DropletsChargesText SheetNum mark 0 4 ChargesData length 4 sub { /ChargeNum exch def (\n) SheetNum 5 string cvs dup length 5 exch sub {( ) exch} repeat ( [) ChargesData ChargeNum get cvr 10 string cvs dup length 10 exch sub {( ) exch} repeat ( ) ChargesData ChargeNum 1 add get cvr 10 string cvs dup length 10 exch sub {( ) exch} repeat (] ) ChargesData ChargeNum 2 add get 10 string cvs dup length 10 exch sub {( ) exch} repeat ChargesData ChargeNum 3 add get 10 string cvs dup length 10 exch sub {( ) exch} repeat } for ConcatenateToMark put % DropletsChargesText rrand srand /DropMinProximitySqd 0 0 1 15 % This a kludge. Copes if width dependent on DropletNum mod something modest. { << exch /DropletNum exch >> begin [ DropletsInnerWidthStart DropletsInnerWidthEnd DropletsInnerGrayStart DropletsInnerGrayEnd DropletsOuterWidthStart DropletsOuterWidthEnd DropletsOuterGrayStart DropletsOuterGrayEnd ] end {1.2 mul 2 copy lt {exch} if pop} forall % the various widths } for % various kludged modulos dup mul def % /DropMinProximitySqd [ Droplets { PageHeight DrpMgnB DrpMgnT add sub PageWidth DrpMgnL DrpMgnR add sub add //SqrtSixth mul DropletsAverageMaxTweakPlusMinus abs add DropletsAverageSeparation abs div floor cvi neg 1 1 index abs { /Dim1 exch def PageHeight DrpMgnB DrpMgnT add sub 3 //Sqrt3 add mul PageWidth DrpMgnL DrpMgnR add sub 3 //Sqrt3 sub mul add 6 div //SqrtHalf mul DropletsAverageMaxTweakPlusMinus abs add DropletsAverageSeparation abs div floor cvi neg 1 1 index abs { /Dim2 exch def /RandAng rand 360 mod def /RandRadii DropletsAverageMaxTweakPlusMinus rand mul RandMax div def /X PageWidth DrpMgnL DrpMgnR sub add 2 div Dim2 //SqrtHalf mul Dim1 //Cos15 mul add DropletsAverageSeparation mul add RandAng sin RandRadii mul add def /Y PageHeight DrpMgnB DrpMgnT sub add 2 div Dim2 //SqrtHalf mul Dim1 //Sin15 mul sub DropletsAverageSeparation mul add RandAng cos RandRadii mul add def X DrpMgnL DropletsPathLength sub gt X PageWidth DrpMgnR sub DropletsPathLength add lt and Y DrpMgnB DropletsPathLength sub gt Y PageHeight DrpMgnT sub DropletsPathLength add lt and and { /Drplt ChargesData X Y DropletsPathLength 0.36 DropletPath def % Embedded constant. Drplt length 8 ge { /OnPageStart //Infinity def /OnPageEnd //InfinityNeg def 0 4 Drplt length 4 sub % Is any part of droplet inside paintable page? { /i exch def Drplt dup i get /X exch def i 1 add get /Y exch def X DrpMgnL ge X PageWidth DrpMgnR sub le and Y DrpMgnB ge Y PageHeight DrpMgnT sub le and and { Drplt i 2 add get dup dup dup OnPageStart lt {/OnPageStart exch def} {pop} ifelse OnPageEnd gt {/OnPageEnd exch def} {pop} ifelse } if % inside paintable page } for % length of this droplet OnPageEnd OnPageStart sub DropletsPathLength //GoldenRatio div gt % Next loop might pop false. 0 4 Drplt length 4 sub % Is any part of droplet too near a charge, or too near a stationary point? { dup 1 add Drplt exch get /Y exch def Drplt exch get /X exch def dup //false eq {exit} if 0 4 ChargesData length 4 sub { /i exch def ChargesData i get X sub dup mul ChargesData i 1 add get Y sub dup mul add DropMinProximitySqd dup ChargesData i 3 add get dup mul 4 div lt {4 div} if % Allow closer for faster spins lt {pop //false exit} if % Too close to a charge } for % i } for % length of this droplet { % There's a max step size = 0.36, giving a min number of points, spread evenly. % Then prunes to remove redundant points. Consider point Previous, and much later point This. If all points Between have offset from % Previous-This line of no more than 0.18 points, and an angle of less than 3 degrees, bin Between. Keep last this of which this so. [ /IP 0 def % Herein P=Previous; T=This; B=Between Drplt IP 4 getinterval aload pop { /XP Drplt IP get def /YP Drplt IP 1 add get def Drplt length dup 4 mod sub 4 sub -4 IP 4 add % Going backwards finds good long stretches quicker { /IT exch def /XT Drplt IT get def /YT Drplt IT 1 add get def //true % Prev and This good, in that no Between yet fails tests IP 4 add 4 IT 4 sub { /IB exch def /XB Drplt IB get def /YB Drplt IB 1 add get def XB XP sub dup mul YB YP sub dup mul add XT XB sub dup mul YT YB sub dup mul add mul dup abs 1E-16 gt % Units of pt^4 { XB XP sub XT XB sub mul % Equal-deepest indentation of code in whole program. YB YP sub YT YB sub mul add dup mul exch div //Cos01Sqd lt {pop //false exit} if } {pop} ifelse % ... abs 1E-16 gt YT YP sub dup mul XT XP sub dup mul add dup abs 1E-08 gt % Units of pt^2 { % http://en.wikipedia.org/wiki/Distance_from_a_point_to_a_line#Line_defined_by_two_points YT YP sub XB mul XT XP sub YB mul sub XT YP mul add XP YT mul sub dup mul exch div 0.0324 ge {pop //false exit} if % dist^2 >= 0.18pt^2 } {pop} ifelse % ... abs 1E-08 gt } //ForReverseBinary exec % IB. 'shuffled' order finds failures quicker. { Drplt IT 4 getinterval aload pop /IP IT def exit } if % This is good } for % IT IP Drplt length 4 sub ge {exit} if } loop % effectively over IP ] % droplet re-construction; removal of redundant points } if % Droplet on page and not too close to something } if % Drplt length 8 ge } if % Start not far from paintable part of page } for % Dim2 } for % Dim1 } if % Droplets (so if not, empty array) ] dup {dup length dup 4 mod sub 1 sub get exch dup length dup 4 mod sub 1 sub get lt} ShellSort % First paint those ending nearest charges, so that heads overlay tails. dup length DropletsProportionBackwards dup 0 gt {dup 1 gt {pop} {mul ceiling cvi} ifelse} {pop pop 0} ifelse array DropletsWhichReversed exch SheetNum exch put DropletsProportionBackwards 0 gt { /protoThisSheet exch def /DrpltReversedCount 0 def /DrpltNonShortCount 0 def [ 0 1 protoThisSheet length 1 sub { /DrpltNum exch def protoThisSheet DrpltNum get length 8 ge {/DrpltNonShortCount DrpltNonShortCount 1 add store} if DropletsProportionBackwards DrpltNonShortCount mul DrpltReversedCount 0.5 add gt protoThisSheet DrpltNum get length 8 ge and { DropletsWhichReversed SheetNum get DrpltReversedCount DrpltNum put /DrpltReversedCount DrpltReversedCount 1 add store [ protoThisSheet DrpltNum get length dup 4 mod sub 4 sub -4 0 { /IT exch def protoThisSheet DrpltNum get IT get % X protoThisSheet DrpltNum get IT 1 add get % Y protoThisSheet DrpltNum get IT 2 add get protoThisSheet DrpltNum get dup length 2 sub get exch sub dup 0 lt {pop 0} if % distance along protoThisSheet DrpltNum get IT 3 add get % Potential } for % IT ] } {protoThisSheet DrpltNum get} ifelse % Reversing readonly } for % /DrpltNum ] readonly % all droplets for this SheetNum } {dup {readonly pop} forall readonly} ifelse % DropletsProportionBackwards 0 gt } bind for % SheetNum end ] readonly def % /DropletPaths //DeBugLevel 50 le {(-DropletPaths computation) OutputToLog} if //DeBugLevel 50 le {(+DropletPaths logging) OutputToLog} if mark { (Droplets will cover approximately ) % Calculations in file .../Port_PS/Old/Old_2019/20191019_area_droplets.nb 2 //Sqrt3 div DropletsAverageSeparation dup mul div 0.0625 1 DropletsPathLength dup mul div neg DropletsOuterWidthEnd mul 2 DropletsOuterWidthStart mul DropletsPathLength dup mul div add DropletsOuterWidthEnd mul DropletsOuterWidthStart DropletsPathLength 2 mul sub DropletsPathLength dup mul div DropletsOuterWidthStart DropletsPathLength 2 mul add mul sub sqrt mul DropletsPathLength div DropletsOuterWidthEnd mul 0.0625 DropletsPathLength div 1 DropletsPathLength dup mul div neg DropletsOuterWidthEnd mul 2 DropletsOuterWidthStart mul DropletsPathLength dup mul div add DropletsOuterWidthEnd mul DropletsOuterWidthStart DropletsPathLength 2 mul sub DropletsPathLength dup mul div DropletsOuterWidthStart DropletsPathLength 2 mul add mul sub sqrt neg DropletsOuterWidthStart mul 2 DropletsPathLength mul 2 DropletsOuterWidthEnd DropletsOuterWidthStart sub DropletsOuterWidthEnd neg 2 DropletsOuterWidthStart mul add DropletsOuterWidthEnd mul DropletsOuterWidthStart DropletsPathLength 2 mul sub DropletsOuterWidthStart DropletsPathLength 2 mul add mul sub sqrt atan //DegreeInRadians mul mul //Pi add mul add mul add DropletsOuterWidthEnd mul 0.0625 DropletsPathLength dup mul div DropletsOuterWidthEnd neg 2 DropletsOuterWidthStart mul add DropletsOuterWidthEnd mul DropletsOuterWidthStart DropletsPathLength 2 mul sub DropletsOuterWidthStart DropletsPathLength 2 mul add mul sub dup sqrt mul mul add DropletsOuterWidthEnd mul 0.0625 DropletsOuterWidthStart mul DropletsPathLength dup mul div DropletsOuterWidthEnd neg 2 DropletsOuterWidthStart mul add DropletsOuterWidthEnd mul DropletsOuterWidthStart DropletsPathLength 2 mul sub DropletsOuterWidthStart DropletsPathLength 2 mul add mul sub dup sqrt mul mul add mul 100 mul dup 1 gt {1} {dup 0.2 gt {2} {4} ifelse} ifelse FormatDecimalPlaces (% of non-margin bare page \(ignoring overlaps and hollow inners, assuming no sharp turns, etc\).\n) } Stopped pop % Stopped in case any of these parameters are code referring to something presently undefined. (DropletsCharges is equivalent to [) DropletsChargesText aload pop ( ] % Reminder: SheetNum [X Y] Charge Spin ...\n) (DropletsProportionBackwards = ) /DropletsProportionBackwards load DropletsProportionBackwards dup 0.0001 gt exch 0.5 lt and {( ~= 1/) 1 DropletsProportionBackwards div} if (.) (\nDropletPaths, number on each SheetNum = ) [ DropletPaths {length} forall ] ToString TrimSpaces (. Frequencies of the number of points in individual droplets: ) 11 dict begin /FrequencyDict << >> def /LengthsNum 0 def /LengthsSum 0 def DropletPaths { { length dup 4 mod sub 4 idiv dup LengthsSum add /LengthsSum exch def /LengthsNum LengthsNum 1 add def dup FrequencyDict exch known {dup FrequencyDict exch get 1 add} {1} ifelse FrequencyDict 3 1 roll put } forall} forall LengthsNum 0 gt { [ FrequencyDict { [ 3 1 roll ] } forall ] dup {0 get exch 0 get gt} ShellSort dup dup length 1 sub get 0 get /LengthsMax exch def {aload pop (*) exch dup 2 gt {dup 100 mul LengthsNum div dup 0.15 gt {dup 1 FormatDecimalPlaces dup cvr 3 -1 roll sub abs 0.001 le {(=)} {(~=)} ifelse exch (%)} {pop} ifelse} if (; )} forall pop (. Total = ) LengthsSum (; avg length ) LengthsSum LengthsNum div dup 2 FormatDecimalPlaces dup cvr 3 -1 roll sub abs 0.00001 le {(= )} {(~= )} ifelse exch (.) } if % LengthsNum 0 gt ConcatenateToMark OutputToLog end //DeBugLevel 50 le {(-DropletPaths logging) OutputToLog} if % SheetNum Llx Lly Urx Ury WithinPage LengthsDistance DropletsPaint - /DropletsPaint { //DeBugLevel 75 le {(+DropletsPaint) OutputToLog} if 32 dict begin /LengthsDistance exch def /WithinPage exch def /Ury exch def /Urx exch def /Lly exch def /Llx exch def /SheetNum exch def newpath 1 setlinecap [] 0 setdash 0 1 1 { 1 eq /DropletShowReversed exch def 0 1 DropletPaths SheetNum get length 1 sub { /DropletNum exch def DropletShowReversed //false DropletsWhichReversed SheetNum get {DropletNum eq {pop //true exit} if} forall eq % Is this reversed, and does that match DropletShowReversed { /ThisDroplet DropletPaths SheetNum get DropletNum get def ThisDroplet length dup 5 eq exch dup 4 ge exch 4 mod 0 eq and or { ThisDroplet length 8 ge { /DistStart ThisDroplet 2 get def /DistTotal ThisDroplet dup length 2 sub get DistStart sub def DistTotal //PrinterEpsilon gt % I.e., can draw a line. { 0 1 1 { 1 eq /IsInner exch def IsInner { /DpWS DropletsInnerWidthStart def % These might be code doing randomisation. Even if so, fixed per droplet, so independent of i. /DpWE DropletsInnerWidthEnd def /DpGS DropletsInnerGrayStart def /DpGE DropletsInnerGrayEnd def }{ /DpWS DropletsOuterWidthStart def % These might be code doing randomisation. Even if so, fixed per droplet, so independent of i. /DpWE DropletsOuterWidthEnd def /DpGS DropletsOuterGrayStart def /DpGE DropletsOuterGrayEnd def } ifelse % IsInner DpWS 0 gt DpWE 0 gt or { % Testing whether droplet is paintable. Testing it in this inner loop after assignment of (the likes of) DpGS, in case (ditto) DropletsInnerGrayStart invoke rand. 4 4 ThisDroplet length 1 sub % The third of these for parameters replaced by sensible value if any line crosses the inside. Used 38 lines below; perhaps modified before. //true % All points outside box 4 copy pop { /i exch def /X0 ThisDroplet i 4 sub get def /Y0 ThisDroplet i 3 sub get def /X1 ThisDroplet i get def /Y1 ThisDroplet i 1 add get def X0 Llx gt X1 Urx lt and X1 Llx gt X0 Urx lt and or Y0 Lly gt Y1 Ury lt and Y1 Lly gt Y0 Ury lt and or and {pop //false exit} if } for % i, to determine whether doing next i loop {pop -1} if % If all points outside box dup 4 ge WithinPage 0 ge and % If already not this droplet, then not this droplet; if WithinPage negative, ignored. { //true % Further from circle WithinPage than from all others 0 4 ThisDroplet length 1 sub { /i exch def //true % Point i closest to WithinPage 0 1 GlassPositions SheetNum get length 1 sub { /WP exch def WithinPage WP ne { % Double test on points: at most Radius+DropletsPathLength * LengthsDistance from centre; closer to WithinPage than WP. GlassPositions SheetNum get WithinPage get aload pop ThisDroplet i 1 add get sub dup mul exch ThisDroplet i get sub dup mul add dup Radii SheetNum get DropletsPathLength LengthsDistance mul add dup mul gt exch GlassPositions SheetNum get WP get aload pop ThisDroplet i 1 add get sub dup mul exch ThisDroplet i get sub dup mul add gt or {pop //false exit} if % Point i further from WithinPage than from WP } if % WithinPage WP ne } for % WP {pop //false exit} if % Not further from WithinPage than all others } for % i {pop -1} if % Further from circle WithinPage than from all others } if % dup 4 ge WithinPage 0 ge and % Three integer loop parameters from 38 lines above, perhaps modified since { % Some effort not to add to size of PDF. E.g.: don't setgray to currentgray; don't setlinewidth to currentlinewidth. /i exch def /X0 ThisDroplet i 4 sub get def /Y0 ThisDroplet i 3 sub get def /F0 ThisDroplet i 2 sub get DistStart sub DistTotal div def /X1 ThisDroplet i get def /Y1 ThisDroplet i 1 add get def /F1 ThisDroplet i 2 add get DistStart sub DistTotal div def /LW0 1 F0 sub DpWS mul F0 DpWE mul add def % /LW0 /LW1 1 F1 sub DpWS mul F1 DpWE mul add def % /LW1 LW0 LW1 mul 0 le { F0 LW1 mul F1 LW0 mul sub LW1 LW0 sub div X0 LW1 mul X1 LW0 mul sub LW1 LW0 sub div Y0 LW1 mul Y1 LW0 mul sub LW1 LW0 sub div LW0 0 le {/Y0 exch def /X0 exch def /F0 exch def /LW0 0 def /EndAtStart //true def} {/Y1 exch def /X1 exch def /F1 exch def /LW1 0 def /EndAtStart //false def} ifelse % LW0 0 lt } {/EndAtStart //false def} ifelse % Different sides of zero LW0 0 gt LW1 0 ge and LW1 0 gt LW0 0 ge and or { /Gr0 1 F0 sub DpGS mul F0 DpGE mul add def % /Gr0 /Gr1 1 F1 sub DpGS mul F1 DpGE mul add def % /Gr1 /Dist X0 X1 sub dup mul Y0 Y1 sub dup mul add sqrt def LW1 LW0 sub abs //PrinterEpsilon le Gr1 Gr0 sub abs 0.017 lt and % The 0.017 is a judgement. Too large and there can be apparent jumps in grey level. Too small overburdens PDF and printer with many shfill's. { /DeviceGray currentcolorspace 0 get ne Gr1 currentgray sub abs 0.017 ge or {Gr1 setgray} if LW1 currentlinewidth sub abs //PrinterEpsilon gt {LW1 setlinewidth} if 1 setlinecap X0 Y0 moveto X1 Y1 lineto stroke }{ 1 { /AngMain Y1 Y0 sub X1 X0 sub atan def % /AngMain /AngSub LW1 LW0 sub abs //PrinterEpsilon gt { LW1 2 div Dist LW1 mul LW1 LW0 sub div dup mul LW1 2 div dup mul sub dup 0 lt {mark (Error in DropletsPaint) 0 4 ThisDroplet length 1 sub {(\n) exch ThisDroplet exch 4 getinterval {(\t)} forall} for ConcatenateToMark OutputToLog pop pop pop exit} if 2 copy 0 ne exch 0 ne or {sqrt atan} {pop pop 0} ifelse LW1 LW0 lt {neg} if } {0} ifelse def % /AngSub LW0 2 div AngMain 90 AngSub add sub 2 copy cos mul X0 add 3 1 roll sin mul Y0 add moveto X1 Y1 LW1 2 div AngMain -90 AngSub sub add AngMain 90 AngSub add add arc EndAtStart {closepath} {LW0 2 div AngMain 90 AngSub add add 2 copy cos mul X0 add 3 1 roll sin mul Y0 add lineto} ifelse % closepath done implicitly by fill; but fewer PDF bytes than lineto Gr1 Gr0 sub abs 0.017 lt { % i IsInner {2 mod 0.75 mul setgray} {3 mod 3 div 1 1 sethsbcolor} ifelse 0.017 setlinewidth stroke % X1 Y1 0.12 IsInner {2 div} if 0 360 arc fill /DeviceGray currentcolorspace 0 get ne Gr1 currentgray sub abs 0.017 ge or {Gr1 setgray} if fill }{ clipsave clip << /ShadingType 2 % Axial shading /ColorSpace /DeviceGray /Coords [ X0 Y0 X1 Y1 ] /Domain [ 0 1 ] /Function << /FunctionType 2 % C0 + t ** N * (C1 - C0) /Domain [ 0 1 ] /C0 Gr0 /C1 Gr1 /N 1 >> % /Function /Extend [ //true //true ] >> shfill cliprestore newpath } ifelse % Greys close } repeat % 1 } ifelse % Greys close and widths the same } if % Widths non-negative and at least 1 positive } for % i, loop not happening unless any point of droplet inside Llx Lly Urx Ury /DropletsPaintAtEnd load dup length 0 gt { DropletsPaintAtEndRotate { matrix currentmatrix exch X1 Y1 translate 0 0 moveto X1 X0 sub Y1 Y0 sub 2 copy dup mul exch dup mul add //PrinterEpsilonSquared gt {atan neg rotate} {pop pop} ifelse exec setmatrix } {X1 Y1 moveto exec} ifelse % DropletsPaintAtEndRotate } {pop} ifelse % DropletsPaintAtEnd } if % DpWS 0 gt DpWE 0 gt or } for % IsInner } if % DistTotal //PrinterEpsilon gt }{ /X0 ThisDroplet 0 get def /Y0 ThisDroplet 1 get def X0 Llx ge X0 Urx le and Y0 Lly ge and Y0 Ury le and { ThisDroplet length 5 eq % So 5th element is one of the two eigenvectors of the Hessian { DropletsOuterWidthEnd dup 0 gt { dup DropletsInnerWidthEnd dup 0 gt {sub} {pop} ifelse 2 div dup currentlinewidth sub //PrinterEpsilon gt {setlinewidth} {pop} ifelse dup ThisDroplet 4 get aload pop 3 1 roll mul 3 1 roll mul 2 copy 2 copy exch neg 2 copy 2 {Y0 add exch X0 add exch moveto Y0 exch sub exch X0 exch sub exch lineto} repeat 1 setlinecap DropletsOuterGrayEnd dup /DeviceGray currentcolorspace 0 get ne exch currentgray sub abs 0.017 ge or {setgray} {pop} ifelse stroke } {pop} ifelse % DropletsOuterWidthEnd ... 0 gt } if % ThisDroplet length 5 eq DropletsOuterWidthEnd 0 gt { DropletsOuterGrayEnd dup /DeviceGray currentcolorspace 0 get ne exch currentgray sub abs 0.017 ge or {setgray} {pop} ifelse X0 Y0 DropletsOuterWidthEnd 2 div 0 360 arc fill } if % DropletsOuterWidthEnd 0 gt DropletsInnerWidthEnd 0 gt { DropletsInnerGrayEnd dup /DeviceGray currentcolorspace 0 get ne exch currentgray sub abs 0.017 ge or {setgray} {pop} ifelse X0 Y0 DropletsInnerWidthEnd 2 div 0 360 arc fill } if % DropletsInnerWidthEnd 0 gt } if % On page } ifelse % ThisDroplet length 8 ge } if % ThisDroplet length dup 5 eq exch dup 4 ge exch 4 mod 0 eq and or } if % matches DropletShowReversed } for % DropletNum, ThisDroplet } for % DropletShowReversed end //DeBugLevel 75 le {(-DropletsPaint) OutputToLog} if } bind def % /DropletsPaint //DeBugLevel 100 le {( Main: DropletsForms) OutputToLog} if /DropletsForms [ NumSheets {5 dict} repeat ] def 0 1 NumSheets 1 sub { /SheetNum exch def //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns DropletsForms SheetNum get begin /SheetNum SheetNum def /FormType 1 def /BBox [ Droplets_SideBySide_UnderTNs {MarginL} {MgnL} ifelse 0.5 sub Droplets_SideBySide_UnderTNs {MarginB} {MgnB} ifelse 0.5 sub PageWidth Droplets_SideBySide_UnderTNs {MarginR} {MgnR} ifelse 0.5 sub sub PageHeight Droplets_SideBySide_UnderTNs {MarginB} {MgnB} ifelse 0.5 sub sub ] def % /BBox /Matrix matrix identmatrix def /PaintProc { //DeBugLevel 100 le {(+DropletsForms: PaintProc) OutputToLog} if 11 dict begin /SheetNum get /SheetNum exch def /DrpMgnL Droplets_SideBySide_UnderTNs {MarginL} {MgnL} ifelse def /DrpMgnR Droplets_SideBySide_UnderTNs {MarginR} {MgnR} ifelse def /DrpMgnB Droplets_SideBySide_UnderTNs {MarginB} {MgnB} ifelse def /DrpMgnT Droplets_SideBySide_UnderTNs {MarginT} {MgnT} ifelse def newpath 1 setlinecap [] 0 setdash //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns ClipSave DrpMgnL DrpMgnB PageWidth DrpMgnL DrpMgnR add sub PageHeight DrpMgnB DrpMgnT add sub rectclip SheetNum DrpMgnL DrpMgnB PageWidth DrpMgnR sub PageHeight DrpMgnT sub -1 //null DropletsPaint ClipRestore end //DeBugLevel 100 le {(-DropletsForms: PaintProc) OutputToLog} if } def % /PaintProc end % DropletsForms SheetNum get } bind for % SheetNum /DropletsReversedForms [ NumSheets {5 dict} repeat ] def 0 1 NumSheets 1 sub { /SheetNum exch def //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns DropletsReversedForms SheetNum get begin /SheetNum SheetNum def /FormType 1 def /BBox [ Droplets_SideBySide_UnderTNs {MarginL} {MgnL} ifelse 0.5 sub Droplets_SideBySide_UnderTNs {MarginB} {MgnB} ifelse 0.5 sub PageWidth Droplets_SideBySide_UnderTNs {MarginR} {MgnR} ifelse 0.5 sub sub PageHeight Droplets_SideBySide_UnderTNs {MarginB} {MgnB} ifelse 0.5 sub sub ] def % /BBox /Matrix matrix identmatrix def /PaintProc { //DeBugLevel 100 le {(+DropletsReversedForms: PaintProc) OutputToLog} if 13 dict begin /DrpMgnL Droplets_SideBySide_UnderTNs {MarginL} {MgnL} ifelse def /DrpMgnR Droplets_SideBySide_UnderTNs {MarginR} {MgnR} ifelse def /DrpMgnB Droplets_SideBySide_UnderTNs {MarginB} {MgnB} ifelse def /DrpMgnT Droplets_SideBySide_UnderTNs {MarginT} {MgnT} ifelse def /SheetNum get /SheetNum exch def % () = (DropletsWhichReversed = [) = DropletsWhichReversed {==} forall (]) = () = //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns ClipSave DrpMgnL DrpMgnB PageWidth DrpMgnL DrpMgnR add sub PageHeight DrpMgnB DrpMgnT add sub rectclip 1 setlinecap 1 setlinejoin [] 0 setdash DropletsWhichReversed SheetNum get { dup type /integertype eq { DropletPaths SheetNum get exch get /ThisDroplet exch def 0 4 ThisDroplet length 1 sub {ThisDroplet 1 index 2 getinterval aload pop 3 -1 roll 0 eq {moveto} {lineto} ifelse} for mark DropletsOuterWidthEnd DropletsOuterWidthStart 0.96 MaxToMark dup 2.5 mul setlinewidth 1 0 0 setrgbcolor GSave stroke GRestore 1.75 mul setlinewidth 1 setgray stroke } {pop exit} ifelse % /integertype } forall % DropletsWhichReversed ... ClipRestore end //DeBugLevel 100 le {(-DropletsReversedForms: PaintProc) OutputToLog} if } def % /PaintProc end % DropletsReversedForms SheetNum get } bind for % SheetNum UndefMgns currentdict /SheetNum undef } if % ...Droplets... /FlightSeparations load MightBeTrue { //DeBugLevel 100 le {( Main: FlightSeparationForms) OutputToLog} if /TypeOfPagesBeingRendered /Glasses store /FlightSeparationForms [ GlassesOnSheets length {6 dict} repeat ] def 0 1 NumSheets 1 sub { /SheetNum exch def //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns FlightSeparationForms SheetNum get begin /SheetNum SheetNum def /FormType 1 def /BBox [ MgnL 2 div MgnB 2 div PageWidth MgnR 2 div sub PageHeight MgnT 2 div sub ] def /Matrix matrix identmatrix def /PaintProc % Paints flight separation lines { pop //DeBugLevel 100 le {(+FlightSeparationForms: PaintProc) OutputToLog} if 6 dict begin FlightSeparations {FlightSeparationLines SheetNum GetEU length 0 gt} {//false} ifelse { /MinCentreSeparation2 PageHeight MgnB MgnT add sub Radii SheetNum get 2 mul sub dup mul PageWidth MgnL MgnR add sub Radii SheetNum get 2 mul sub dup mul add def 1 1 SheetLengths SheetNum get 1 sub { /WithinPageA exch def /WithinTitlesA GlassesOnSheets SheetNum GetEU WithinPageA GetEU def //false 1 { Titles WithinTitlesA get NonEmptyCompoundObject {pop //true exit} if Abovetitles WithinTitlesA get NonEmptyCompoundObject {pop //true exit} if Belowtitles WithinTitlesA get NonEmptyCompoundObject {pop //true exit} if Overtitles WithinTitlesA get NonEmptyCompoundObject {pop //true exit} if Circlearrays WithinTitlesA get NonEmptyCompoundObject {pop //true exit} if } repeat % 1 { 0 1 WithinPageA 1 sub { /WithinPageB exch def /WithinTitlesB GlassesOnSheets SheetNum GetEU WithinPageB GetEU def //false 1 { Titles WithinTitlesB get NonEmptyCompoundObject {pop //true exit} if Abovetitles WithinTitlesB get NonEmptyCompoundObject {pop //true exit} if Belowtitles WithinTitlesB get NonEmptyCompoundObject {pop //true exit} if Overtitles WithinTitlesB get NonEmptyCompoundObject {pop //true exit} if Circlearrays WithinTitlesB get NonEmptyCompoundObject {pop //true exit} if } repeat % 1 { GlassPositions SheetNum get WithinPageA get aload pop GlassPositions SheetNum get WithinPageB get aload pop 3 -1 roll sub dup mul 3 1 roll sub dup mul add dup MinCentreSeparation2 lt {/MinCentreSeparation2 exch def} {pop} ifelse } if % B non-empty } for % WithinPageB, WithinTitlesB } if % A non-empty } for % WithinPageA, WithinTitlesA currentdict /WithinPageB undef currentdict /WithinTitlesB undef currentdict /WithinPageA undef currentdict /WithinTitlesA undef /MaxPossibleArcRadius MinCentreSeparation2 sqrt 2 div Radii SheetNum get 2 copy lt {exch} if pop def % Precision errors in sqrt currentdict /MinCentreSeparation2 undef GSave newpath 0 1 FlightSeparationLines SheetNum GetEU length 1 sub { /FlightSeparationLineNum exch def FlightSeparationLines SheetNum GetEU FlightSeparationLineNum GetEU FlightSeparationPath [] 0 setdash 1 setlinejoin 0 setlinecap 0.96 setlinewidth 0.75 setgray % sensible defaults FlightSeparationPaintSeparately {/FlightSeparationPaintCode load execU} if } for % FlightSeparationLineNum currentdict /FlightSeparationLineNum undef [] 0 setdash 1 setlinejoin 0 setlinecap 0.96 setlinewidth 0.75 setgray % sensible defaults FlightSeparationPaintSeparately not {/FlightSeparationPaintCode load execU} if GRestore } if % FlightSeparations ... FlightSeparationLines SheetNum GetEU length 0 gt ... end //DeBugLevel 100 le {(-FlightSeparationForms: PaintProc) OutputToLog} if } bind def % /PaintProc end % FlightSeparationForms } bind for % SheetNum UndefMgns currentdict /SheetNum undef } if % ... FlightSeparations ... /CHCX_CHCY { NamesShowTop SheetNum get {NamePlacementTopX} {NamePlacementBottomX} ifelse SheetNum get % default CentreX for CrossHatching CrossHatchingCentreX IsNumber {pop CrossHatchingCentreX} if /Left CrossHatchingCentreX eq {pop OuterGlassesMarginL} if /Center CrossHatchingCentreX eq {pop PageWidth MgnL MgnR sub add 2 div OuterGlassesMarginL add} if /Right CrossHatchingCentreX eq {pop PageWidth OuterGlassesMarginR sub} if /CenterSheetsSamePageOrdering CrossHatchingCentreX eq SideBySideGlassesTastingNotes not and { pop OuterGlassesMarginL 0 1 GlassesOnSheets length 1 sub { /SheetNum0 exch def PageOrderingGlasses dup SheetNum0 GetEU exch SheetNum GetEU eq { //false //false //false //false << /SheetNum SheetNum0 >> begin PaperType Orientation end SetPaperSize PageWidth OuterGlassesMarginL OuterGlassesMarginR add sub SheetNum0 SheetNum lt {sub} {add} ifelse } if % PageOrderingGlasses ... eq } for % SheetNum0 2 div currentdict /SheetNum0 undef //false //false //false //false PaperType Orientation SetPaperSize } if % /CrossHatchingCentreX /CenterSheetsSamePageOrdering eq SideBySideGlassesTastingNotes not and << /TypeOfPagesBeingRendered /Glasses /SheetNum 0 >> begin NamesFont NamesFontSize end selectfont (W) StringPathBBox 4 1 roll pop exch pop % Y_T, Y_B NamesShowTop SheetNum get {PageHeight MgnT sub 3 1 roll pop 2 div sub} {MgnB exch sub exch 2 div add} ifelse % cross hatching centre y CrossHatchingCentreY IsNumber {pop CrossHatchingCentreY} if /Bottom CrossHatchingCentreY eq {pop OuterGlassesMarginB} if /Middle CrossHatchingCentreY eq {pop PageHeight MgnB MgnT sub add 2 div OuterGlassesMarginB add} if /Top CrossHatchingCentreY eq {pop PageHeight OuterGlassesMarginT sub} if } bind def % /CHCX_CHCY //DeBugLevel 100 le {( Main: TitleAboveBelowOverForms) OutputToLog} if /TypeOfPagesBeingRendered /Glasses store /TitleAboveBelowOverForms [ GlassesOnSheets {[ exch execU length {6 dict} repeat ]} forall ] def /TitleAboveBelowOverRandomSeeds [ Titles length {//null} repeat ] def /TitlesAboveBelowOverFillTextsInnerColour dup where {pop pop} {{ColourSchemeCurrent /MidGrey eq {0.6} {0} ifelse setgray} bind def} ifelse /TitlesAboveBelowOverFillTextsOuterColour dup where {pop pop} {{1 setgray} bind def} ifelse /TitlesStrokeCode dup where {pop pop} {{1.44 setlinewidth ColourSchemeCurrent /MidGrey eq {0.25 setgray stroke} {FillTextsCurrent {0 setgray stroke} if} ifelse} bind def} ifelse /AbovetitlesStrokeCode dup where {pop pop} {{0.72 setlinewidth ColourSchemeCurrent /MidGrey eq {0.25 setgray stroke} {FillTextsCurrent {0 setgray stroke} if} ifelse} bind def} ifelse /BelowtitlesStrokeCode dup where {pop pop} {{0.72 setlinewidth ColourSchemeCurrent /MidGrey eq {0.25 setgray stroke} {FillTextsCurrent {0 setgray stroke} if} ifelse} bind def} ifelse /OvertitlesStrokeCode { 0.96 setlinewidth ColourSchemeCurrent /MidGrey eq { ColourSchemeTitles /MidGrey eq {0} {0.25} ifelse setgray stroke }{ ColourSchemeTitles /MidGrey eq {FillTitles {0.25 setgray stroke} {newpath} ifelse} {FillTitles not {1 setgray} if stroke} ifelse % ColourSchemeTitles /MidGrey eq } ifelse % ColourSchemeCurrent /MidGrey eq } bind def % /OvertitlesStrokeCode /TitlesAboveBelowOverFillCode {ColourSchemeCurrent /MidGrey eq {0.75} {0} ifelse setgray fill} bind def /TitlesAboveBelowOverInlinePaleStrokeCode {1 setlinejoin 1 setgray stroke} bind def /TitlesAboveBelowOverInlineDarkStrokeCode {1 setlinejoin ColourSchemeCurrent /MidGrey eq {0.4} {0} ifelse setgray stroke} bind def % Discussion: http://www.theportforum.com/viewtopic.php?t=175&p=90575#p90575 /AnnotateGlass { 3 dict begin /AnnotationCount 0 def 0 2 GlassesAnnotations length 2 sub dup 0 ge {//false PageSuppressed {pop -1} if} if { dup GlassesAnnotations exch GetEU WithinTitles eq { [ TitleAboveBelowOverR SheetNum get WithinPage get TitleAboveBelowOverL SheetNum get WithinPage get 2 copy add 2 div ] AnnotationCount 3 idiv get [ TitleProportionFontSizeT SheetNum get WithinPage get TitleProportionFontSizeB SheetNum get WithinPage get 2 copy add 2 div exch ] AnnotationCount 3 mod get TitleOffsetsProportionFontSizeVertical SheetNum get WithinPage get add TitleFontSizes SheetNum get WithinPage get mul moveto matrix currentmatrix exch InitialMatrix setmatrix currentpoint newpath /Y exch def /X exch def mark exch 1 add GlassesAnnotations exch GetEU PDFDocEncodingify /Contents exch /Title [Titles WithinTitles get (: annotation)] PDFDocEncodingify /Rect [ X Y 2 copy ] % pdfmark Reference, June 2008, says this is in user space. But Adobe XI has it in device space. Bug. Avoiding bug and its subsequent repair by working in device space. /Subtype /Text /Open //true /F 64 128 add % ReadOnly + Locked. PDFReference16.pdf page 574 /ANN pdfmark setmatrix /AnnotationCount AnnotationCount 1 add store AnnotationCount 9 ge {exit} if } {pop} ifelse % ... WithinTitles eq } for % 'GlassesAnnotations' end } bind def % AnnotateGlass /InlineTitlesNumberContours [ SheetLengths {array} forall ] def /InlineAbovetitlesNumberContours [ SheetLengths {array} forall ] def /InlineBelowtitlesNumberContours [ SheetLengths {array} forall ] def /InlineOvertitlesNumberContours [ SheetLengths {array} forall ] def 0 1 NumSheets 1 sub { /SheetNum exch def //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns 0 1 SheetLengths SheetNum get 1 sub { dup TitleAboveBelowOverForms SheetNum get exch get begin WithinPage-WithinTitles-def /FormType 1 def /BBox [ RadiiCirclearrayInside SheetNum get 1.2 add dup dup neg dup 4 2 roll ] def % Slightly outside minimal box /Matrix matrix identmatrix def /PaintProc % Paints Title and Abovetitle and Belowtitle and Overtitle { //DeBugLevel 100 le {(+TitleAboveBelowOverForms: PaintProc) OutputToLog} if dup % dictionary parameter of execform containing WithinTitles and WithinPage /TypeOfPagesBeingRendered /Glasses store /WithinTitles get /WithinTitles exch def /WithinPage get /WithinPage exch def TitleAboveBelowOverRandomSeeds WithinTitles 2 copy get type /integertype ne { RandomisationSeed SheetNum 17 mul add WithinPage 257 mul add WithinTitles 4099 mul add % Three primes dup srand put } {get srand} ifelse % ... /integertype ne /NextRand rrand def 0 0 moveto FillTitles FillAbovetitles FillBelowtitles FillOvertitles or or or { /ThisFillTextAngle FillTextAngle IsNumber {FillTextAngle} { FillTextAngle /Name eq { NamesShowTop SheetNum get {PageHeight MgnT sub} {MgnB} ifelse GlassPositions SheetNum get WithinPage get 1 get sub NamesShowTop SheetNum get {NamePlacementTopX} {NamePlacementBottomX} ifelse SheetNum get GlassPositions SheetNum get WithinPage get 0 get sub Atan } {-90} ifelse % /Name FillTextAngle dup dup /LowerLeft eq exch /LowerCenter eq or exch /LowerRight eq or {pop GlassPositions SheetNum get WithinPage get 1 get neg} if FillTextAngle dup dup /MiddleLeft eq exch /MiddleCenter eq or exch /MiddleRight eq or {pop PageHeight 2 div GlassPositions SheetNum get WithinPage get 1 get sub} if FillTextAngle dup dup /UpperLeft eq exch /UpperCenter eq or exch /UpperRight eq or {pop PageHeight GlassPositions SheetNum get WithinPage get 1 get sub} if FillTextAngle dup dup /LowerLeft eq exch /MiddleLeft eq or exch /UpperLeft eq or { GlassPositions SheetNum get WithinPage get 0 get neg Atan} if FillTextAngle dup dup /LowerCenter eq exch /MiddleCenter eq or exch /UpperCenter eq or {PageWidth 2 div GlassPositions SheetNum get WithinPage get 0 get sub Atan} if FillTextAngle dup dup /LowerRight eq exch /MiddleRight eq or exch /UpperRight eq or {PageWidth GlassPositions SheetNum get WithinPage get 0 get sub Atan} if dup /UndefinedAtan eq {pop 0} {90 add} ifelse {dup 90 gt {180 sub} {exit} ifelse} loop {dup -90 lt {180 add} {exit} ifelse} loop dup abs 89.9 gt { FillTextAngle /MiddleLeft eq {pop -90} if FillTextAngle /MiddleCenter eq {pop GlassPositions SheetNum get WithinPage get 0 get PageWidth 2 div 1 add gt {-90} {GlassPositions SheetNum get WithinPage get 0 get PageWidth 2 div 1 sub lt {90} {0} ifelse} ifelse} if FillTextAngle /MiddleRight eq {pop 90} if } if % abs 89.9 gt } ifelse % FillTextAngle IsNumber RotationTitlesAboveBelowOverCirclearray sub def % /ThisFillTextAngle /ThisFillFontSize FillTextMinFontSizeAbsolute FillTitles Titles WithinTitles get NonEmptyCompoundObject and {TitleFontSizes SheetNum get WithinPage get FillTextMinFontSizeProportionLargestTitleAboveBelowOver mul} {0} ifelse FillAbovetitles Abovetitles WithinTitles get NonEmptyCompoundObject and {AbovetitleFontSizes SheetNum get WithinPage get FillTextMinFontSizeProportionLargestTitleAboveBelowOver mul} {0} ifelse FillBelowtitles Belowtitles WithinTitles get NonEmptyCompoundObject and {BelowtitleFontSizes SheetNum get WithinPage get FillTextMinFontSizeProportionLargestTitleAboveBelowOver mul} {0} ifelse FillOvertitles Overtitles WithinTitles get NonEmptyCompoundObject and { OvertitleFontSizes SheetNum get WithinPage get FillTextMinFontSizeProportionLargestTitleAboveBelowOver mul} {0} ifelse 4 {2 copy lt {exch} if pop} repeat def % /ThisFillFontSize } if % FillTitles FillAbovetitles FillBelowtitles FillOvertitles or or or CrossHatchingTitles CrossHatchingAbovetitles CrossHatchingBelowtitles CrossHatchingOvertitles or or or { matrix currentmatrix CHCX_CHCY RotationTitlesAboveBelowOverCirclearray dup 0 ne {neg rotate} {pop} ifelse GlassPositions SheetNum get WithinPage get aload pop neg exch neg exch translate moveto setmatrix currentpoint newpath /CHCY exch def /CHCX exch def } if % CrossHatchingTitles CrossHatchingAbovetitles CrossHatchingBelowtitles CrossHatchingOvertitles or or or TitleFontSizes SheetNum get WithinPage get 0 gt { 6 dict begin TitleAboveBelowOverRandomSeeds WithinTitles get srand /ColourSchemeCurrent ColourSchemeTitles def /FillTextsCurrent FillTitles def TitleFontSizesMaxByPage SheetNum get ColourSchemeCurrent /MidGrey eq {60 div 0.96} {120 div 0.48} ifelse % Embedded constants 2 copy gt {exch} if pop FillTextsCurrent {1.25 mul} if setlinewidth 1 setlinecap 1 setlinejoin [] 0 setdash InlineTitles { /InlinePath % http://groups.google.com/g/comp.lang.postscript/c/ewwOV_qN4JQ http://acrobat.uservoice.com/forums/590923-acrobat-for-windows-and-mac/suggestions/19193479-distiller-charpath-clip-stroke-does-not-honou { TitlesFont TitleFontSizes SheetNum get WithinPage get selectfont TitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get TitleFontSizes SheetNum get WithinPage get mul TitleOffsetsProportionFontSizeVertical SheetNum get WithinPage get TitleFontSizes SheetNum get WithinPage get mul moveto Titles WithinTitles get //true CharPathRecursive } def % /InlinePath InlinePath GSave clip InlineTitlesPrefillWhite {1 setgray fill} {newpath} ifelse newpath InlinePath % http://groups.google.com/g/comp.lang.postscript/c/ewwOV_qN4JQ /InlineBlackPlusWhite InlineTitlesBlackWidth InlineTitlesWhiteWidth add abs 2 mul def % 2 mul because half of the linewidth clip'ped away InlineTitlesAttemptMinimiseNumContours { InlineTitlesNumberContours SheetNum get WithinPage 2 copy get IsNumber {get} {InlineBlackPlusWhite LineWidthThatCoversPath pop InlineBlackPlusWhite div ceiling cvi dup 4 1 roll put} ifelse % ... IsNumber } {//IntegerMax} ifelse % InlineTitlesAttemptMinimiseNumContours /InlineFirst //true def TitleFontSizes SheetNum get WithinPage get InlineBlackPlusWhite div ceiling cvi InlineTitlesMaxNumberContours 2 {2 copy gt {exch} if pop} repeat -1 1 { /i exch def InlineFirst {/InlineFirst //false store} {InlineBlackPlusWhite i mul GSave setlinewidth TitlesAboveBelowOverInlinePaleStrokeCode GRestore} ifelse % InlineFirst i 1 gt {InlineTitlesBlackWidth i mul InlineTitlesWhiteWidth i 1 sub mul add 2 mul GSave setlinewidth TitlesAboveBelowOverInlineDarkStrokeCode GRestore} if } for % i GRestore } if % InlineTitles FillTextsCurrent { TitlesFont TitleFontSizes SheetNum get WithinPage get selectfont TitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get TitleFontSizes SheetNum get WithinPage get mul TitleOffsetsProportionFontSizeVertical SheetNum get WithinPage get TitleFontSizes SheetNum get WithinPage get mul moveto Titles WithinTitles get //true CharPathRecursive GSave FillTextNumOutlines 2 mod 0 eq {TitlesAboveBelowOverFillTextsOuterColour} {TitlesAboveBelowOverFillTextsInnerColour} ifelse fill GRestore GSave FillTextFont ThisFillFontSize selectfont % X Y Filltitle FillTextNumSpaces FilltitleLineStep Angle NumOutlines InnerMostColor OtherColor RepeatClippedWithin - 0 0 FillTexts WithinTitles get FillTextNumSpaces ThisFillFontSize 1.125 mul ThisFillTextAngle FillTextNumOutlines /TitlesAboveBelowOverFillTextsInnerColour load /TitlesAboveBelowOverFillTextsOuterColour load 1 dict begin FillPrioritiseSmallFileSizeOverPortability {/DeFontPath {} def} if RepeatClippedWithin end GRestore 1 setlinecap 1 setlinejoin [] 0 setdash GSave TitlesStrokeCode GRestore } if % FillTextsCurrent FillTextsCurrent not InlineTitles not and { TitlesFont TitleFontSizes SheetNum get WithinPage get selectfont TitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get TitleFontSizes SheetNum get WithinPage get mul TitleOffsetsProportionFontSizeVertical SheetNum get WithinPage get TitleFontSizes SheetNum get WithinPage get mul moveto 0 setgray 1 setlinecap 1 setlinejoin [] 0 setdash Titles WithinTitles get //false CharPathRecursive GSave TitlesStrokeCode GRestore GSave TitlesAboveBelowOverFillCode GRestore } if % FillTextsCurrent not InlineTitles not and CrossHatchingTitles { 0.5 setgray 0 setlinecap 1 setlinejoin [] 0 setdash CHCX CHCY /CrossHatchingTitlesStrokeCode load RadialCrossHatching } if % CrossHatchingTitles ShapesInTitles { 0.5 setgray 0 setlinecap 0 setlinejoin [] 0 setdash 0.36 TypeOfPagesBeingRendered /PlaceName eq {PlaceNamesDetailsScalingFactor mul} if setlinewidth RadiiCirclearrayInsideUsableTAB SheetNum get dup dup neg dup 4 2 roll /Origin /ShapesTitlesFill load /ShapesTitlesStroke load ShapesTitlesClip ShapesClippedToPath } if % ShapesInTitles InlineTitles % Doing the terminal '1' from the loop 50ish lines above here { GSave newpath InlinePath clip newpath InlinePath % http://groups.google.com/g/comp.lang.postscript/c/ewwOV_qN4JQ InlineTitlesBlackWidth 2 mul setlinewidth TitlesAboveBelowOverInlineDarkStrokeCode GRestore } if % InlineTitles newpath end TitleAboveBelowOverRandomSeeds WithinTitles get rrand ne {/NextRand rrand def} if } if % TitleFontSizes of non-zero size OvertitleFontSizes SheetNum get WithinPage get //PrinterEpsilon gt { 4 dict begin TitleAboveBelowOverRandomSeeds WithinTitles get srand /ColourSchemeCurrent ColourSchemeOvertitles def /FillTextsCurrent FillOvertitles def 0 setgray OvertitleFontSizesMaxByPage SheetNum get ColourSchemeCurrent /MidGrey eq {60 div 0.96} {120 div 0.48} ifelse 2 copy gt {exch} if pop FillOvertitles {1.25 mul} if setlinewidth InlineOvertitles { /InlinePath % http://groups.google.com/g/comp.lang.postscript/c/ewwOV_qN4JQ http://acrobat.uservoice.com/forums/590923-acrobat-for-windows-and-mac/suggestions/19193479-distiller-charpath-clip-stroke-does-not-honou { OvertitlesFont OvertitleFontSizes SheetNum get WithinPage get selectfont OvertitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get OvertitleFontSizes SheetNum get WithinPage get mul OvertitleOffsetsProportionFontSizeVertical SheetNum get WithinPage get OvertitleFontSizes SheetNum get WithinPage get mul moveto Overtitles WithinTitles get //true CharPathRecursive } def % InlinePath InlinePath GSave clip InlineOvertitlesPrefillWhite {1 setgray fill} {newpath} ifelse newpath InlinePath % http://groups.google.com/g/comp.lang.postscript/c/ewwOV_qN4JQ /InlineBlackPlusWhite InlineOvertitlesBlackWidth InlineOvertitlesWhiteWidth add abs 2 mul def % 2 mul because half of the linewidth clip'ped away InlineAboveBelowOverAttemptMinimiseNumContours { InlineOvertitlesNumberContours SheetNum get WithinPage 2 copy get IsNumber {get} {InlineBlackPlusWhite LineWidthThatCoversPath pop InlineBlackPlusWhite div ceiling cvi dup 4 1 roll put} ifelse % ... IsNumber } {//IntegerMax} ifelse % InlineAboveBelowOverAttemptMinimiseNumContours /InlineFirst //true def OvertitleFontSizes SheetNum get WithinPage get InlineBlackPlusWhite div ceiling cvi InlineOvertitlesMaxNumberContours 2 {2 copy gt {exch} if pop} repeat -1 2 % Down to 2, as '1' is handled after ShapesInOvertitles etc { /i exch def InlineFirst {/InlineFirst //false store} {InlineBlackPlusWhite i mul GSave setlinewidth TitlesAboveBelowOverInlinePaleStrokeCode GRestore} ifelse % InlineFirst i 1 gt {InlineOvertitlesBlackWidth i mul InlineOvertitlesWhiteWidth i 1 sub mul add 2 mul GSave setlinewidth TitlesAboveBelowOverInlineDarkStrokeCode GRestore} if } for % i GRestore } if % InlineOvertitles FillTextsCurrent { OvertitlesFont OvertitleFontSizes SheetNum get WithinPage get selectfont OvertitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get OvertitleFontSizes SheetNum get WithinPage get mul OvertitleOffsetsProportionFontSizeVertical SheetNum get WithinPage get OvertitleFontSizes SheetNum get WithinPage get mul moveto Overtitles WithinTitles get //true CharPathRecursive GSave FillTextNumOutlines 2 mod 0 eq {TitlesAboveBelowOverFillTextsOuterColour} {TitlesAboveBelowOverFillTextsInnerColour} ifelse fill GRestore GSave FillTextFont ThisFillFontSize selectfont % X Y Fulltitle FillTextNumSpaces FulltitleLineStep Angle NumOutlines InnerMostColor OtherColor RepeatClippedWithin - 0 0 FillTexts WithinTitles get FillTextNumSpaces ThisFillFontSize 1.125 mul ThisFillTextAngle FillTextNumOutlines /TitlesAboveBelowOverFillTextsInnerColour load /TitlesAboveBelowOverFillTextsOuterColour load 1 dict begin FillPrioritiseSmallFileSizeOverPortability {/DeFontPath {} def} if RepeatClippedWithin end GRestore 1 setlinecap 1 setlinejoin [] 0 setdash GSave OvertitlesStrokeCode GRestore } if % FillOvertitles FillTextsCurrent not InlineOvertitles not and { OvertitlesFont OvertitleFontSizes SheetNum get WithinPage get selectfont OvertitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get OvertitleFontSizes SheetNum get WithinPage get mul OvertitleOffsetsProportionFontSizeVertical SheetNum get WithinPage get OvertitleFontSizes SheetNum get WithinPage get mul moveto Overtitles WithinTitles get //true CharPathRecursive GSave OvertitlesStrokeCode GRestore GSave TitlesAboveBelowOverFillCode GRestore } if % FillOvertitles not InlineOvertitles not and CrossHatchingOvertitles { 0.5 setgray 0 setlinecap 1 setlinejoin [] 0 setdash CHCX CHCY /CrossHatchingOvertitlesStrokeCode load RadialCrossHatching } if % CrossHatchingOvertitles ShapesInOvertitles { 0.5 setgray 0 setlinecap 0 setlinejoin [] 0 setdash 0.36 TypeOfPagesBeingRendered /PlaceName eq {PlaceNamesDetailsScalingFactor mul} if setlinewidth RadiiCirclearrayInsideUsableO SheetNum get dup dup neg dup 4 2 roll /Origin /ShapesOvertitlesFill load /ShapesOvertitlesStroke load ShapesOvertitlesClip ShapesClippedToPath } if % ShapesInOvertitles InlineOvertitles % Doing the terminal '1' from the loop 47ish lines above here { GSave newpath InlinePath clip newpath InlinePath % http://groups.google.com/g/comp.lang.postscript/c/ewwOV_qN4JQ InlineOvertitlesBlackWidth 2 mul setlinewidth TitlesAboveBelowOverInlineDarkStrokeCode GRestore } if % InlineOvertitles newpath end TitleAboveBelowOverRandomSeeds WithinTitles get rrand ne {/NextRand rrand def} if } if % OvertitleFontSizes of non-zero size BelowtitleFontSizes SheetNum get WithinPage get //PrinterEpsilon gt { 4 dict begin TitleAboveBelowOverRandomSeeds WithinTitles get srand /ColourSchemeCurrent ColourSchemeBelowtitles def /FillTextsCurrent FillBelowtitles def 0 setgray BelowtitleFontSizesMaxByPage SheetNum get ColourSchemeCurrent /MidGrey eq {60 div 0.96} {120 div 0.48} ifelse 2 copy gt {exch} if pop FillBelowtitles {1.25 mul} if setlinewidth InlineBelowtitles { /InlinePath % http://groups.google.com/g/comp.lang.postscript/c/ewwOV_qN4JQ http://acrobat.uservoice.com/forums/590923-acrobat-for-windows-and-mac/suggestions/19193479-distiller-charpath-clip-stroke-does-not-honou { BelowtitlesFont BelowtitleFontSizes SheetNum get WithinPage get selectfont BelowtitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get BelowtitleFontSizes SheetNum get WithinPage get mul BelowtitleOffsetsAbsoluteVertical SheetNum get WithinPage get moveto Belowtitles WithinTitles get //true CharPathRecursive } def % InlinePath InlinePath GSave clip InlineBelowtitlesPrefillWhite {1 setgray fill} {newpath} ifelse newpath InlinePath % http://groups.google.com/g/comp.lang.postscript/c/ewwOV_qN4JQ /InlineBlackPlusWhite InlineBelowtitlesBlackWidth InlineBelowtitlesWhiteWidth add abs 2 mul def % 2 mul because half of the linewidth clip'ped away InlineAboveBelowOverAttemptMinimiseNumContours { InlineBelowtitlesNumberContours SheetNum get WithinPage 2 copy get IsNumber {get} {InlineBlackPlusWhite LineWidthThatCoversPath pop InlineBlackPlusWhite div ceiling cvi dup 4 1 roll put} ifelse % ... IsNumber } {//IntegerMax} ifelse % InlineAboveBelowOverAttemptMinimiseNumContours /InlineFirst //true def BelowtitleFontSizes SheetNum get WithinPage get InlineBlackPlusWhite div ceiling cvi InlineBelowtitlesMaxNumberContours 2 {2 copy gt {exch} if pop} repeat -1 2 % Down to 2, as '1' is handled after ShapesInBelowtitles etc { /i exch def InlineFirst {/InlineFirst //false store} {InlineBlackPlusWhite i mul GSave setlinewidth TitlesAboveBelowOverInlinePaleStrokeCode GRestore} ifelse % InlineFirst i 1 gt {InlineBelowtitlesBlackWidth i mul InlineBelowtitlesWhiteWidth i 1 sub mul add 2 mul GSave setlinewidth TitlesAboveBelowOverInlineDarkStrokeCode GRestore} if } for % i GRestore } if % InlineBelowtitles FillTextsCurrent { BelowtitlesFont BelowtitleFontSizes SheetNum get WithinPage get selectfont BelowtitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get BelowtitleFontSizes SheetNum get WithinPage get mul BelowtitleOffsetsAbsoluteVertical SheetNum get WithinPage get moveto Belowtitles WithinTitles get //true CharPathRecursive GSave FillTextNumOutlines 2 mod 0 eq {TitlesAboveBelowOverFillTextsOuterColour} {TitlesAboveBelowOverFillTextsInnerColour} ifelse fill GRestore GSave FillTextFont ThisFillFontSize selectfont % X Y Fulltitle FillTextNumSpaces FulltitleLineStep Angle NumOutlines InnerMostColor OtherColor RepeatClippedWithin - 0 0 FillTexts WithinTitles get FillTextNumSpaces ThisFillFontSize 1.125 mul ThisFillTextAngle FillTextNumOutlines /TitlesAboveBelowOverFillTextsInnerColour load /TitlesAboveBelowOverFillTextsOuterColour load 1 dict begin FillPrioritiseSmallFileSizeOverPortability {/DeFontPath {} def} if RepeatClippedWithin end GRestore 1 setlinecap 1 setlinejoin [] 0 setdash GSave BelowtitlesStrokeCode GRestore } if % FillBelowtitles FillTextsCurrent not InlineBelowtitles not and { BelowtitlesFont BelowtitleFontSizes SheetNum get WithinPage get selectfont BelowtitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get BelowtitleFontSizes SheetNum get WithinPage get mul BelowtitleOffsetsAbsoluteVertical SheetNum get WithinPage get moveto Belowtitles WithinTitles get //true CharPathRecursive GSave BelowtitlesStrokeCode GRestore GSave TitlesAboveBelowOverFillCode GRestore } if % FillBelowtitles not InlineBelowtitles not and CrossHatchingBelowtitles { 0.5 setgray 0 setlinecap 1 setlinejoin [] 0 setdash CHCX CHCY /CrossHatchingBelowtitlesStrokeCode load RadialCrossHatching } if % CrossHatchingBelowtitles ShapesInBelowtitles { 0.5 setgray 0 setlinecap 0 setlinejoin [] 0 setdash 0.36 TypeOfPagesBeingRendered /PlaceName eq {PlaceNamesDetailsScalingFactor mul} if setlinewidth RadiiCirclearrayInsideUsableTAB SheetNum get dup dup neg dup 4 2 roll /Origin /ShapesBelowtitlesFill load /ShapesBelowtitlesStroke load ShapesBelowtitlesClip ShapesClippedToPath } if % ShapesInBelowtitles InlineBelowtitles % Doing the terminal '1' from the loop 47ish lines above here { GSave newpath InlinePath clip newpath InlinePath % http://groups.google.com/g/comp.lang.postscript/c/ewwOV_qN4JQ InlineBelowtitlesBlackWidth 2 mul setlinewidth TitlesAboveBelowOverInlineDarkStrokeCode GRestore } if % InlineBelowtitles newpath end TitleAboveBelowOverRandomSeeds WithinTitles get rrand ne {/NextRand rrand def} if } if % BelowtitleFontSizes of non-zero size AbovetitleFontSizes SheetNum get WithinPage get //PrinterEpsilon gt { 4 dict begin TitleAboveBelowOverRandomSeeds WithinTitles get srand /ColourSchemeCurrent ColourSchemeAbovetitles def /FillTextsCurrent FillAbovetitles def 0 setgray AbovetitleFontSizesMaxByPage SheetNum get ColourSchemeCurrent /MidGrey eq {60 div 0.96} {120 div 0.48} ifelse 2 copy gt {exch} if pop FillAbovetitles {1.25 mul} if setlinewidth InlineAbovetitles { /InlinePath % http://groups.google.com/g/comp.lang.postscript/c/ewwOV_qN4JQ http://acrobat.uservoice.com/forums/590923-acrobat-for-windows-and-mac/suggestions/19193479-distiller-charpath-clip-stroke-does-not-honou { AbovetitlesFont AbovetitleFontSizes SheetNum get WithinPage get selectfont AbovetitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get AbovetitleFontSizes SheetNum get WithinPage get mul AbovetitleOffsetsAbsoluteVertical SheetNum get WithinPage get moveto Abovetitles WithinTitles get //true CharPathRecursive } def % InlinePath InlinePath GSave clip InlineAbovetitlesPrefillWhite {1 setgray fill} {newpath} ifelse newpath InlinePath % http://groups.google.com/g/comp.lang.postscript/c/ewwOV_qN4JQ /InlineBlackPlusWhite InlineAbovetitlesBlackWidth InlineAbovetitlesWhiteWidth add abs 2 mul def % 2 mul because half of the linewidth clip'ped away InlineAboveBelowOverAttemptMinimiseNumContours { InlineAbovetitlesNumberContours SheetNum get WithinPage 2 copy get IsNumber {get} {InlineBlackPlusWhite LineWidthThatCoversPath pop InlineBlackPlusWhite div ceiling cvi dup 4 1 roll put} ifelse % ... IsNumber } {//IntegerMax} ifelse % InlineAboveBelowOverAttemptMinimiseNumContours /InlineFirst //true def AbovetitleFontSizes SheetNum get WithinPage get InlineBlackPlusWhite div ceiling cvi InlineAbovetitlesMaxNumberContours 2 {2 copy gt {exch} if pop} repeat -1 2 % Down to 2, as '1' is handled after ShapesInAbovetitles etc { /i exch def InlineFirst {/InlineFirst //false store} {InlineBlackPlusWhite i mul GSave setlinewidth TitlesAboveBelowOverInlinePaleStrokeCode GRestore} ifelse % InlineFirst i 1 gt {InlineAbovetitlesBlackWidth i mul InlineAbovetitlesWhiteWidth i 1 sub mul add 2 mul GSave setlinewidth TitlesAboveBelowOverInlineDarkStrokeCode GRestore} if } for % i GRestore } if % InlineAbovetitles FillTextsCurrent { AbovetitlesFont AbovetitleFontSizes SheetNum get WithinPage get selectfont AbovetitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get AbovetitleFontSizes SheetNum get WithinPage get mul AbovetitleOffsetsAbsoluteVertical SheetNum get WithinPage get moveto Abovetitles WithinTitles get //true CharPathRecursive GSave FillTextNumOutlines 2 mod 0 eq {TitlesAboveBelowOverFillTextsOuterColour} {TitlesAboveBelowOverFillTextsInnerColour} ifelse fill GRestore GSave FillTextFont ThisFillFontSize selectfont % X Y Fulltitle FillTextNumSpaces FulltitleLineStep Angle NumOutlines InnerMostColor OtherColor RepeatClippedWithin - 0 0 FillTexts WithinTitles get FillTextNumSpaces ThisFillFontSize 1.125 mul ThisFillTextAngle FillTextNumOutlines /TitlesAboveBelowOverFillTextsInnerColour load /TitlesAboveBelowOverFillTextsOuterColour load 1 dict begin FillPrioritiseSmallFileSizeOverPortability {/DeFontPath {} def} if RepeatClippedWithin end GRestore 1 setlinecap 1 setlinejoin [] 0 setdash GSave AbovetitlesStrokeCode GRestore } if % FillAbovetitles FillTextsCurrent not InlineAbovetitles not and { AbovetitlesFont AbovetitleFontSizes SheetNum get WithinPage get selectfont AbovetitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get AbovetitleFontSizes SheetNum get WithinPage get mul AbovetitleOffsetsAbsoluteVertical SheetNum get WithinPage get moveto Abovetitles WithinTitles get //true CharPathRecursive GSave AbovetitlesStrokeCode GRestore GSave TitlesAboveBelowOverFillCode GRestore } if % FillAbovetitles not InlineAbovetitles not and CrossHatchingAbovetitles { 0.5 setgray 0 setlinecap 1 setlinejoin [] 0 setdash CHCX CHCY /CrossHatchingAbovetitlesStrokeCode load RadialCrossHatching } if % CrossHatchingAbovetitles ShapesInAbovetitles { 0.5 setgray 0 setlinecap 0 setlinejoin [] 0 setdash 0.36 TypeOfPagesBeingRendered /PlaceName eq {PlaceNamesDetailsScalingFactor mul} if setlinewidth RadiiCirclearrayInsideUsableTAB SheetNum get dup dup neg dup 4 2 roll /Origin /ShapesAbovetitlesFill load /ShapesAbovetitlesStroke load ShapesAbovetitlesClip ShapesClippedToPath } if % ShapesInAbovetitles InlineAbovetitles % Doing the terminal '1' from the loop 47ish lines above here { GSave newpath InlinePath clip newpath InlinePath % http://groups.google.com/g/comp.lang.postscript/c/ewwOV_qN4JQ InlineAbovetitlesBlackWidth 2 mul setlinewidth TitlesAboveBelowOverInlineDarkStrokeCode GRestore } if % InlineAbovetitles newpath end TitleAboveBelowOverRandomSeeds WithinTitles get rrand ne {/NextRand rrand def} if } if % AbovetitleFontSizes of non-zero size NextRand srand //DeBugLevel 100 le {(-TitleAboveBelowOverForms: PaintProc) OutputToLog} if } bind def % /PaintProc end % dictionary TitleAboveBelowOverForms } for % WithinPage, WithinTitles currentdict /WithinPage undef currentdict /WithinTitles undef } bind for % SheetNum UndefMgns currentdict /SheetNum undef //DeBugLevel 100 le {( Main: define PaintPlaceName) OutputToLog} if /PaintPlaceName { //DeBugLevel 100 le {(+PaintPlaceName) OutputToLog} if 17 dict begin /SheetNum 0 def /WithinPage 0 def /WithinTitles 0 def % If formatting settings of Titles uses these, then formatting of PlaceNames will attempt to use them. Of course, the formatting _should_ check TypeOfPagesBeingRendered, but, you know. /TypeOfPagesBeingRendered /PlaceName def /FooterExtraOffset PlaceNamesFirstAndThirdFoldsFromEdge FooterFontSize 2 mul add MgnB sub dup 0 lt {pop 0} if def /X PageWidth MgnL MgnR sub add 2 div def /Y PageHeight 4 div MgnB FooterExtraOffset add MgnT sub 2 div add def newpath PlaceNamesFont //DeSizeRounding selectfont /ThisName load StringPathBBox /URY exch def /URX exch def /LLY exch def /LLX exch def URY LLY sub dup 0 gt {PageHeight 2 div MgnB MgnT add sub 2.4 sub FooterExtraOffset sub exch div //DeSizeRounding mul} {pop PageHeight 2 div} ifelse % embedded constant URX LLX sub dup 0 gt {PageWidth MgnL MgnR add sub 4.8 sub exch div //DeSizeRounding mul} {pop PageHeight 2 div} ifelse % embedded constant PlaceNamesMaxFontSizeAbsolute 2 {2 copy gt {exch} if pop} repeat /PlaceNamesFontSize exch store PlaceNamesFont PlaceNamesFontSize selectfont % http://groups.google.com/g/comp.lang.postscript/c/b6f1e9ec3da9cc87/ /XX X URX LLX add //DeSizeRounding div PlaceNamesFontSize mul 2 div sub def /YY Y URY LLY add //DeSizeRounding div PlaceNamesFontSize mul 2 div sub def PlaceNamesFontSize 0 gt { /ColourSchemeCurrent ColourSchemePlaceNames def /FillTextsCurrent FillPlaceNames def FillTextsCurrent { /ThisFillTextAngle /FillTextAnglePlaceNames load def /ThisFillFontSize FillTextMinFontSizeAbsolute /ThisName load NonEmptyCompoundObject {PlaceNamesFontSize FillTextMinFontSizeProportionLargestTitleAboveBelowOver mul} {0} ifelse 2 copy lt {exch} if pop def % /ThisFillFontSize } if % FillTextsCurrent CrossHatchingPlaceNames { /CHCX X def % Cross Hatching Center X CrossHatchingCentreX /Left eq {/CHCX 0 def} if CrossHatchingCentreX /Right eq {/CHCX PageWidth def} if /CHCY 0 def % Cross Hatching Center Y CrossHatchingCentreY /Middle eq {/CHCY Y def} if CrossHatchingCentreY /Top eq {/CHCY PageHeight 2 div def} if } if % CrossHatchingPlaceNames PlaceNamesFontSize ColourSchemeCurrent /MidGrey eq {60 div 0.96} {120 div 0.48} ifelse 2 copy gt {exch} if pop FillTextsCurrent {1.25 mul} if PlaceNamesDetailsScalingFactor mul setlinewidth 1 setlinecap 1 setlinejoin [] 0 setdash InlinePlaceNames { { PlaceNamesFont PlaceNamesFontSize selectfont XX YY moveto /ThisName load //true CharPathRecursive } dup exec ClipSave clip newpath exec % http://groups.google.com/g/comp.lang.postscript/c/ewwOV_qN4JQ /InlineBlackPlusWhite InlineTitlesBlackWidth InlineTitlesWhiteWidth add abs 2 mul def % 2 mul because half of the linewidth clip'ped away % Discussion: http://www.theportforum.com/viewtopic.php?t=175&start=913 InlinePlaceNamesAttemptMinimiseNumContours {InlineBlackPlusWhite LineWidthThatCoversPath pop InlineBlackPlusWhite div ceiling cvi} {//IntegerMax} ifelse PlaceNamesFontSize InlineBlackPlusWhite div PlaceNamesDetailsScalingFactor div ceiling cvi InlineTitlesMaxNumberContours 2 {2 copy gt {exch} if pop} repeat -1 1 { /i exch def GSave i InlineBlackPlusWhite mul setlinewidth TitlesAboveBelowOverInlinePaleStrokeCode GRestore i 1 gt {GSave i InlineBlackPlusWhite mul InlineTitlesWhiteWidth 2 mul sub setlinewidth TitlesAboveBelowOverInlineDarkStrokeCode GRestore} if } for % i ClipRestore } if % InlinePlaceNames FillTextsCurrent { PlaceNamesFont PlaceNamesFontSize selectfont XX YY moveto /ThisName load //true CharPathRecursive GSave FillTextNumOutlines 2 mod 0 eq {TitlesAboveBelowOverFillTextsOuterColour} {TitlesAboveBelowOverFillTextsInnerColour} ifelse fill GRestore GSave FillTextFont ThisFillFontSize selectfont % X Y Filltitle FillTextNumSpaces FilltitleLineStep Angle NumOutlines InnerMostColor OtherColor RepeatClippedWithin - X Y {FillTextPlaceNames} FillTextNumSpaces ThisFillFontSize 1.125 mul ThisFillTextAngle FillTextNumOutlines /TitlesAboveBelowOverFillTextsInnerColour load /TitlesAboveBelowOverFillTextsOuterColour load 1 dict begin FillPrioritiseSmallFileSizeOverPortability {/DeFontPath {} def} if RepeatClippedWithin end GRestore 1 setlinecap 1 setlinejoin [] 0 setdash GSave TitlesStrokeCode GRestore } if % FillTextsCurrent FillTextsCurrent not InlinePlaceNames not and { PlaceNamesFont PlaceNamesFontSize selectfont XX YY moveto 0 setgray 1 setlinecap 1 setlinejoin [] 0 setdash /ThisName load //false CharPathRecursive GSave TitlesStrokeCode GRestore GSave TitlesAboveBelowOverFillCode GRestore } if % FillTextsCurrent not InlinePlaceNames not and CrossHatchingPlaceNames { 0.5 setgray 0 setlinecap 1 setlinejoin [] 0 setdash CHCX CHCY /CrossHatchingTitlesStrokeCode load RadialCrossHatching } if % CrossHatchingPlaceNames ShapesInPlaceNames { 0.5 setgray 0 setlinecap 0 setlinejoin [] 0 setdash 0.36 TypeOfPagesBeingRendered /PlaceName eq {PlaceNamesDetailsScalingFactor mul} if setlinewidth MgnL MgnB PageWidth MgnR sub PageHeight 2 div MgnT sub /Centre /ShapesTitlesFill load /ShapesTitlesStroke load ShapesPlaceNamesClip ShapesClippedToPath } if % ShapesInPlaceNames InlinePlaceNames { { PlaceNamesFont PlaceNamesFontSize selectfont XX YY moveto /ThisName load //true CharPathRecursive } dup exec ClipSave clip newpath exec % http://groups.google.com/g/comp.lang.postscript/c/ewwOV_qN4JQ GSave InlineTitlesBlackWidth 2 mul setlinewidth TitlesAboveBelowOverInlineDarkStrokeCode GRestore % 2 mul because half of the linewidth clip'ped away ClipRestore } if % InlinePlaceNames newpath } if % PlaceNamesFontSize 0 gt end //DeBugLevel 100 le {(-PaintPlaceName) OutputToLog} if } bind def % /PaintPlaceName {PrePourNumCopies 1 ge} MightBeTrue { //DeBugLevel 100 le {( Main: PrePourForms) OutputToLog} if /TypeOfPagesBeingRendered /PrePour store /PrePourForms [ GlassesOnSheets {[ exch execU length {12 dict} repeat]} forall ] def 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { dup PrePourForms SheetNum get exch get begin WithinPage-WithinTitles-def //false //false //false //false PrePourPaperType PrePourOrientation SetPaperSize //true DefStoreMgns /FormType 1 def /BBox [ MgnL 1.92 sub MgnB 1.92 sub PageWidth MgnR sub 1.92 add PageHeight MgnT sub 1.92 add ] def % embedded constant, should be positive /Matrix matrix identmatrix def /PaintProc % Paints Title and Subtitle very big, and CirclearraysPrePour in a box { //DeBugLevel 100 le {(+PrePourForms: PaintProc) OutputToLog} if pop 22 dict begin % dictionary parameter of execform containing WithinTitles and WithinPage /TypeOfPagesBeingRendered /PrePour store /MatrixPrePour matrix currentmatrix def PageWidth MgnL MgnR sub add 2 div PageHeight MgnB MgnT sub add 2 div translate PrePourScalingFactors SheetNum get dup scale /MatrixGlasses matrix currentmatrix def % Show Circlearrays only if centre-to-corner >= scaled[ Radii + Radii-RadiiCirclearrayInside ] /PPShowCirclearrays PageWidth MgnL MgnR add sub dup mul PageHeight MgnB MgnT add sub dup mul add sqrt 2 div Radii SheetNum get 2 mul RadiiCirclearrayInside SheetNum get sub PrePourScalingFactors SheetNum get mul ge def /PPCirclearraysV CircletextFont CirclearraysFontSizes SheetNum get WithinPage get selectfont CirclearraysPrePour WithinTitles get StringHeight def PrePourShowBackgroundTexts Droplets {PrePourShowDroplets or} if { MatrixPrePour setmatrix //false //false //false //false PrePourPaperType PrePourOrientation SetPaperSize //true DefStoreMgns ClipSave newpath MgnL MgnB PageWidth MgnL MgnR add sub PageHeight MgnB MgnT add sub rectclip newpath % Perhaps two clips here, first to margins PPShowCirclearrays { /PPCaVPE PPCirclearraysV 0.48 add def % PPCirclearraysV Plus Extra MgnL PPCaVPE add MgnB PPCaVPE add moveto PageWidth MgnR PPCaVPE add sub dup MgnB PPCaVPE add lineto PageHeight MgnT PPCaVPE add sub lineto MgnL PPCaVPE add PageHeight MgnT PPCaVPE add sub lineto closepath MatrixGlasses setmatrix 0 0 Radii SheetNum get 0 360 /m ArcAccurate closepath clip newpath % Second clip to union of rectangle inside Circlearrays and circle of radius Radii... } if % PPShowCirclearrays /TypeOfPagesBeingRendered /Glasses store //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns MatrixGlasses setmatrix RotationTitlesAboveBelowOverCirclearray dup 0 ne {neg rotate} {pop} ifelse GlassPositions SheetNum get WithinPage get {neg} forall translate BackgroundTextsGlasses PrePourShowBackgroundTexts and {BackgroundTextsGlassesForms SheetNum get execform} if Droplets PrePourShowDroplets and { //false //false //false //false PrePourPaperType PrePourOrientation SetPaperSize //true DefStoreMgns SheetNum RotationTitlesAboveBelowOverCirclearray 0 eq { GSave MatrixPrePour setmatrix newpath MgnL MgnB moveto PageWidth MgnR sub MgnB lineto PageWidth MgnR sub PageHeight MgnT sub lineto MgnL PageHeight MgnT sub lineto MatrixGlasses setmatrix GlassPositions SheetNum get WithinPage get {neg} forall translate pathbbox GRestore } {//InfinityNeg //InfinityNeg //Infinity //Infinity} ifelse % RotationTitlesAboveBelowOverCirclearray 0 eq WithinPage 1.0 DropletsPaint % If rotating too complicated to rotate box; the WithinPage must suffice. } if % Droplets PrePourShowDroplets and ClipRestore /TypeOfPagesBeingRendered /PrePour store //false //false //false //false PrePourPaperType PrePourOrientation SetPaperSize //true DefStoreMgns } if % PrePourShowBackgroundTexts ... Droplets ...PrePourShowDroplets or MatrixGlasses setmatrix OutlineTitles CrossHatchingInside Spirals or or CircleNonEmpty SheetNum get WithinPage get and { MatrixPrePour setmatrix //false //false //false //false PrePourPaperType PrePourOrientation SetPaperSize //true DefStoreMgns MgnL PPCirclearraysV 0.12 add add MgnB PPCirclearraysV 0.12 add add PageWidth MgnL MgnR add 0.24 add PPCirclearraysV 2 mul add sub PageHeight MgnB MgnT add 0.24 add PPCirclearraysV 2 mul add sub 4 copy ClipSave newpath rectclip newpath MatrixGlasses setmatrix //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns % Perhaps accessed by CrossHatchingInside OutlineTitles { OutlineForms SheetNum get WithinPage get execform} if Spirals {SpiralForms SheetNum get WithinPage get execform} if CrossHatchingInside {CrossHatchingInsideForms SheetNum get WithinPage get execform} if ClipRestore MatrixPrePour setmatrix 1 setgray 0.24 setlinewidth [] 0 setdash 0 setlinejoin rectstroke % Erase black leakage } if % OutlineTitles CrossHatchingInside Spirals or or CircleNonEmpty ... and MatrixGlasses setmatrix //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns /PaintBackgroundInsideGlassCircles load dup length 0 gt {/TypeOfPagesBeingRendered /PrePour store GSave newpath 0 0 Radii SheetNum get 0 360 /m ArcAccurate closepath clip newpath execU GRestore /TypeOfPagesBeingRendered /Glasses store} {pop} ifelse % PaintBackgroundInsideGlassCircles ... length 0 gt TitleAboveBelowOverForms SheetNum get WithinPage get execform AnnotateGlass MatrixPrePour setmatrix /TypeOfPagesBeingRendered /PrePour store //false //false //false //false PrePourPaperType PrePourOrientation SetPaperSize //true DefStoreMgns PPShowCirclearrays { /PPCaHB PPCirclearraysV 0.72 add def % embedded constant /PPCaHG PPCaHB 0.12 add def % This grey, other black. Slight overlap to prevent white showing between. IsDistiller { MatrixPrePour setmatrix //false //false //false //false PrePourPaperType PrePourOrientation SetPaperSize //true DefStoreMgns GSave newpath % GSave saving currenttransfer and clippath MgnL PPCaHG add MgnB PPCaHG add moveto MgnL PPCaHG add PageHeight MgnT PPCaHG add sub lineto PageWidth MgnR PPCaHG add sub PageHeight MgnT PPCaHG add sub lineto PageWidth MgnR PPCaHG add sub MgnB PPCaHG add lineto closepath MgnL MgnB moveto PageWidth MgnR sub MgnB lineto PageWidth MgnR sub PageHeight MgnT sub lineto MgnL PageHeight MgnT sub lineto closepath clip newpath [ currenttransfer /exec cvx 1 /exch cvx /sub cvx 0.25 /mul cvx 1 /exch cvx /sub cvx ] cvx bind settransfer % embedded constant MatrixGlasses setmatrix //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns CirclearrayForms SheetNum get WithinPage get execform GRestore } if % IsDistiller ClipSave MatrixPrePour setmatrix //false //false //false //false PrePourPaperType PrePourOrientation SetPaperSize //true DefStoreMgns MgnL PPCaHB add MgnB PPCaHB add PageWidth MgnL MgnR add PPCaHB 2 mul add sub PageHeight MgnB MgnT add PPCaHB 2 mul add sub rectclip newpath MatrixGlasses setmatrix //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns CirclearrayForms SheetNum get WithinPage get execform ClipRestore } if % PPShowCirclearrays MatrixPrePour setmatrix //false //false //false //false PrePourPaperType PrePourOrientation SetPaperSize //true DefStoreMgns ThePortForumIconPlacement /None ne {/All PlaceThePortForumIcon} if matrix currentmatrix RotationTitlesAboveBelowOverCirclearray {dup -45 ge {exit} if 360 add} loop {dup 315 lt {exit} if 360 sub} loop 1 { dup 225 ge {pop PageWidth 0 translate 90 rotate MgnB MgnR PageHeight MgnB MgnT add sub PageWidth MgnL MgnR add sub exit} if dup 135 gt {pop PageWidth PageHeight translate 180 rotate MgnR MgnT PageWidth MgnL MgnR add sub PageHeight MgnB MgnT add sub exit} if 45 gt { 0 PageHeight translate -90 rotate MgnT MgnL PageHeight MgnB MgnT add sub PageWidth MgnL MgnR add sub exit} if MgnL MgnB PageWidth MgnL MgnR add sub PageHeight MgnB MgnT add sub } repeat % 1 CirclearraysPrePour WithinTitles get {0 setgray CircletextFont CirclearraysFontSizes SheetNum get WithinPage get selectfont} CircletextsMinNumSpacesBetween CirclearrayInRectangle pop pop setmatrix /RotationTitlesAboveBelowOverCirclearray load 0 ne { RotationTitlesAboveBelowOverCirclearray dup sin /dX exch def cos /dY exch def /ArrowScaling 2.88 def % embedded constant {0 0 moveto 3 -3 lineto 1 -3 lineto 1 -6 lineto -1 -6 lineto -1 -3 lineto -3 -3 lineto closepath} % Arrow in 6x6 box, tip of arrow at 0,0 CirclearraysT SheetNum get WithinPage get CirclearraysB SheetNum get WithinPage get sub CirclearraysFontSizes SheetNum get WithinPage get mul 0.83 ArrowScaling mul add dup % embedded constant, approximately correct dY 0 eq {pop //Infinity} {PageHeight MgnB MgnT add sub 2 div exch sub dY div abs exch} ifelse dX 0 eq {pop //Infinity} {PageWidth MgnL MgnR add sub 2 div exch sub dX div abs} ifelse 2 copy gt {exch} if pop 0 exch RotationTitlesAboveBelowOverCirclearray neg PageWidth MgnL MgnR sub add 2 div PageHeight MgnB MgnT sub add 2 div 6 copy translate rotate translate ArrowScaling dup scale exec MatrixPrePour setmatrix translate rotate neg translate ArrowScaling dup scale 0 6 translate exec MatrixPrePour setmatrix GSave 0.8 setgray fill GRestore 0 setgray ClipSave clip 1.92 setlinewidth 0 setlinejoin stroke ClipRestore } if % Angle perhaps non-zero for any glasses end //DeBugLevel 100 le {(-PrePourForms: PaintProc) OutputToLog} if } bind def % /PaintProc end % dictionary PrePourForms } for % WithinPage, WithinTitles currentdict /WithinPage undef currentdict /WithinTitles undef } bind for % SheetNum UndefMgns currentdict /SheetNum undef } if % ... PrePourNumCopies 1 ge ... {BottleWrapNumCopies 1 ge} MightBeTrue { //DeBugLevel 100 le {( Main: BottleWrapForms) OutputToLog} if /TypeOfPagesBeingRendered /BottleWrap store /BottleWrapScalingFactors Titles length array def /BottleWrapForms [ GlassesOnSheets {[ exch execU length {12 dict} repeat]} forall ] def 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { dup BottleWrapForms SheetNum get exch get begin WithinPage-WithinTitles-def //false //false //false //false BottleWrapPaperType BottleWrapOrientation SetPaperSize //true DefStoreMgns /FormType 1 def /BBox [ MgnL 1.92 sub MgnB 1.92 sub PageWidth MgnR sub PageHeight MgnT sub 1.92 add ] def % Needs the hard clipping on right. Embedded constant, should be positive. /Matrix matrix identmatrix def /PaintProc % Paints repeated copies of a TitleAboveBelowOverForms, and repeated copies of an item of CirclearraysBottleWrap { //DeBugLevel 100 le {(+BottleWrapForms: PaintProc) OutputToLog} if pop 31 dict begin % dictionary parameter of execform containing WithinTitles and WithinPage /TypeOfPagesBeingRendered /BottleWrap store //false //false //false //false BottleWrapPaperType BottleWrapOrientation SetPaperSize //true DefStoreMgns CircletextFont CirclearraysFontSizes SheetNum get WithinPage get selectfont CirclearraysBottleWrap WithinTitles get StringPathBBox exch pop exch sub /AD exch def pop /BottleWrapNumRows PageHeight MgnB MgnT add sub AD sub TitleAboveBelowOverT SheetNum get WithinPage get TitleAboveBelowOverB SheetNum get WithinPage get sub BottleWrapScalingMin mul AD add BottleWrapPadding 2 mul add dup //PrinterEpsilon gt {div} {pop pop AD //PrinterEpsilon gt {PageHeight MgnB MgnT add sub AD div 2 div} {12} ifelse} ifelse dup 48 gt {pop 48} {dup 1 le {pop 1} {floor cvi} ifelse} ifelse def % /BottleWrapNumRows /BottleWrapScalingFactor PageHeight MarginB MarginT add sub BottleWrapNumRows 1 add AD mul sub BottleWrapNumRows div BottleWrapPadding 2 mul sub TitleAboveBelowOverT SheetNum get WithinPage get TitleAboveBelowOverB SheetNum get WithinPage get sub div def % /BottleWrapScalingFactor BottleWrapScalingFactors WithinTitles BottleWrapScalingFactor put CircletextFont CirclearraysFontSizes SheetNum get WithinPage get selectfont CirclearraysBottleWrap WithinTitles get StringPathBBox /BW_T exch def pop /BW_B exch def pop /BW_H BW_T BW_B sub def /BW_X_first BW_H MarginL add TitleAboveBelowOverL SheetNum get WithinPage get BottleWrapScalingFactor mul sub BottleWrapPadding add def % /BW_X_first /BW_X_step BW_H TitleAboveBelowOverR SheetNum get WithinPage get TitleAboveBelowOverL SheetNum get WithinPage get sub BottleWrapScalingFactor mul add BottleWrapPadding 2 mul add def % /BW_X_step /BW_Y_first PageHeight BW_H MarginT add sub TitleAboveBelowOverT SheetNum get WithinPage get BottleWrapScalingFactor mul sub BottleWrapPadding sub def % /BW_Y_first /BW_Y_step BW_H TitleAboveBelowOverT SheetNum get WithinPage get TitleAboveBelowOverB SheetNum get WithinPage get sub BottleWrapScalingFactor mul add BottleWrapPadding 2 mul add neg def % /BW_Y_step BW_X_first BW_X_step PageWidth MgnR sub BW_X_step 2 div add { /BW_X exch def 0 1 BottleWrapNumRows 1 sub { BW_Y_step mul BW_Y_first add /BW_Y exch def matrix currentmatrix BW_X BW_Y translate CrossHatchingInside BottleWrapShowCrossHatchingInside and OutlineTitles BottleWrapShowOutlineTitles and or /PaintBackgroundInsideGlassCircles load length 0 gt or { ClipSave BW_X_step BW_H sub 0.24 sub dup -2 div exch BW_Y_step 0.24 add 2 div BW_H sub exch BW_Y_step 0.24 add neg BW_H sub rectclip BottleWrapScalingFactor dup scale /PaintBackgroundInsideGlassCircles load dup length 0 gt {/TypeOfPagesBeingRendered /BottleWrap store GSave newpath 0 0 Radii SheetNum get 0 360 /m ArcAccurate closepath clip newpath execU GRestore} {pop} ifelse % PaintBackgroundInsideGlassCircles ... length 0 gt /TypeOfPagesBeingRendered /Glasses store OutlineTitles BottleWrapShowOutlineTitles and {OutlineForms SheetNum get WithinPage get execform} if Spirals {SpiralForms SheetNum get WithinPage get execform} if CrossHatchingInside BottleWrapShowCrossHatchingInside and {CrossHatchingInsideForms SheetNum get WithinPage get execform} if ClipRestore } {BottleWrapScalingFactor dup scale} ifelse % CrossHatchingInside ... OutlineTitles ... or ... PaintBackgroundInsideGlassCircles ... or TitleAboveBelowOverForms SheetNum get WithinPage get execform AnnotateGlass setmatrix /TypeOfPagesBeingRendered /BottleWrap store } for % BW_Y } for % BW_X /N CirclearraysBottleWrap WithinTitles get length def N 0 gt { CircletextFont CirclearraysFontSizes SheetNum get WithinPage get selectfont 0 1 1000 % X counter { /BW_XX exch def /BW_X BW_XX BW_X_step mul MgnL add def BW_X PageWidth MgnR sub ge {exit} if % Text running vertically /ItemCBW BW_XX N mod 1 { N 3 le {exit} if N 4 eq {[0 2 1 3] exch get exit} if N 5 eq {2 mul N mod exit} if % In the wild, items of Circlearrays of length <=5 N 6 eq {[0 2 4 1 5 3] exch get exit} if N 7 eq {[0 3 5 1 6 2 4] exch get exit} if N 8 eq {[0 4 2 6 1 5 7 3] exch get exit} if % slightly excessive. } repeat def % /ItemCBW matrix currentmatrix BW_X 0 translate 90 rotate MgnB 0 moveto CirclearraysBottleWrap WithinTitles get {CircletextFont CirclearraysFontSizes SheetNum get WithinPage get selectfont} CircletextsMinNumSpacesBetween //true % CurrentpointIsTop PageHeight MgnB MgnT add sub //false % FillBackground ItemCBW CirclearrayInStraightLine pop pop pop pop setmatrix % Horizontal text, in many short stretches 0 1 BottleWrapNumRows % Not 1 sub, as one more row of CirclearraysBottleWrap than of Titles { /BW_YY exch def /BW_Y BW_Y_step BW_YY mul PageHeight MgnT sub add def BW_X BW_H add BW_Y moveto CirclearraysBottleWrap WithinTitles get {CircletextFont CirclearraysFontSizes SheetNum get WithinPage get selectfont} CircletextsMinNumSpacesBetween //true % CurrentpointIsTop BottleWrapPadding 2 mul TitleAboveBelowOverR SheetNum get WithinPage get TitleAboveBelowOverL SheetNum get WithinPage get sub BottleWrapScalingFactor mul add //false % FillBackground BW_XX BW_YY add 2 mod 0 eq {-1} {ItemCBW} ifelse CirclearrayInStraightLine pop pop pop pop } for % Y } for % X } if % N 0 gt end //DeBugLevel 100 le {(-BottleWrapForms: PaintProc) OutputToLog} if } bind def % /PaintProc end % dictionary BottleWrapForms } for % WithinPage, WithinTitles currentdict /WithinPage undef currentdict /WithinTitles undef } bind for % SheetNum UndefMgns currentdict /SheetNum undef } if % ... BottleWrapNumCopies 1 ge ... /VoteRecorders load MightBeTrue { //DeBugLevel 100 le {( Main: VoteRecorderForms) OutputToLog} if /VoteRecorderNamesWidthsLogged //false def /TypeOfPagesBeingRendered /VoteRecorder store /VoteRecorderForms [ GlassesClusteredOnVoteRecorders length {6 dict} repeat ] def 0 1 GlassesClusteredOnVoteRecorders length 1 sub { /VoteRecorderSheetNum exch def //false //false //false //false VoteRecorderPaperType VoteRecorderOrientation SetPaperSize //true DefStoreMgns VoteRecorderForms VoteRecorderSheetNum get begin /FormType 1 def /BBox [ MgnL 2 div MgnB 2 div PageWidth MgnR 2 div sub PageHeight MgnT 2 div sub ] def /Matrix matrix identmatrix def /PaintProc { //DeBugLevel 100 le {(+VoteRecorderForms: PaintProc) OutputToLog} if pop % dictionary parameter of execform 52 dict begin /VoteRecorderSheetNum VoteRecorderSheetNum def /TypeOfPagesBeingRendered /VoteRecorder store /TypeOfPagesBeingRendered /TastingNotes store % only those elements of names with non-zero TN pages /VoteRecorderNames [ NamesVoteRecorder aload pop VoteRecorderShowTotalRow VoteRecorderSheetNum GetEU VoteRecorderMonkeyWhenShowTotalRow and {/VoteRecorderMonkeyName load} if /VoteRecorderNumNames counttomark def VoteRecorderShowTotalCol VoteRecorderSheetNum GetEU {/VoteRecorderTotalColTitle load} if ] def % /VoteRecorderNames /TypeOfPagesBeingRendered /VoteRecorder store HeadersAndFooters PaintHeadersFooters % Columns: % First column names the wines. % Subsequent columns headed with elements of VoteRecorderNames. % Last column might hold Totals. % Thick line separate sections; thin lines within sections. % Rows: % First row is potentially higher, and contains VoteRecorderNames. % Subsequent rows contain wines. /VoteRecorderTitlesFontSize PageHeight MgnB MgnT add sub VoteRecorderThisSheetLength 6 add div 1.8 div % embedded constant VoteRecorderTitlesFontSizeMax 2 copy gt {exch} if pop //PrinterEpsilon 2 copy lt {exch} if pop def % /VoteRecorderTitlesFontSize VoteRecorderTitlesFontSize 8 lt { mark VoteRecorderTitlesFontSize 5 lt { (Error: VoteRecorderTitlesFontSize \(with VoteRecorderSheetNum=) VoteRecorderSheetNum (\) computed to be ) VoteRecorderTitlesFontSize ( which is <) 5 (, so tiny)} {(Warning: VoteRecorderTitlesFontSize \(with VoteRecorderSheetNum=) VoteRecorderSheetNum (\) computed to be ) VoteRecorderTitlesFontSize ( which is <) 8 (, so small)} ifelse (. Continuing, but consider changing GlassesClusteredOnVoteRecorders.) ConcatenateToMark OutputToLog } if % VoteRecorderTitlesFontSize 6 lt /VoteRecorderNamesFontSize PageWidth MgnL MgnR add sub VoteRecorderNumNames 6 add div 1.25 div NamesFontSize 2 copy gt {exch} if pop //PrinterEpsilon 2 copy lt {exch} if pop def % /VoteRecorderNamesFontSize VoteRecorderNamesFontSize 8 lt { mark VoteRecorderNamesFontSize 5 lt { (Error: VoteRecorderNamesFontSize \(with VoteRecorderSheetNum=) VoteRecorderSheetNum (\) computed to be ) VoteRecorderNamesFontSize ( which is <) 5 (, so tiny)} {(Warning: VoteRecorderNamesFontSize \(with VoteRecorderSheetNum=) VoteRecorderSheetNum (\) computed to be ) VoteRecorderNamesFontSize ( which is <) 8 (, so small)} ifelse (. Continuing, but consider changing NamesVoteRecorder or GlassesClusteredOnVoteRecorders.) ConcatenateToMark OutputToLog } if % VoteRecorderTitlesFontSize 6 lt /VoteRecorderTitleWidths VoteRecorderThisSheetLength array def /VoteRecorderSubtitleWidths VoteRecorderThisSheetLength array def /VoteRecorderSubtitleFSPT [ VoteRecorderThisSheetLength {/VoteRecorderSubtitleFontSizeProportionTitles load} repeat VoteRecorderShowTotalRow VoteRecorderSheetNum GetEU {pop //Epsilon} if ] def /VoteRecorderTitleWidthsMax 0 def /VoteRecorderSubtitleWidthsMax 0 def /WithinPage 0 def 0 1 VoteRecorderThisSheet length 1 sub { /ClusterNum exch def 0 1 VoteRecorderThisSheet ClusterNum GetEU length 1 sub VoteRecorderShowTotalRow VoteRecorderSheetNum GetEU ClusterNum VoteRecorderThisSheet length 1 sub eq and {1 add} if { /WithinCluster exch def /ThisRowTotalRow VoteRecorderShowTotalRow VoteRecorderSheetNum GetEU WithinPage VoteRecorderThisSheetLength 1 sub eq and def /WithinTitles ThisRowTotalRow {//null} {VoteRecorderThisSheet ClusterNum GetEU WithinCluster GetEU} ifelse def WithinTitles dup type /integertype eq {0 ge} {pop //false} ifelse { /ThisVoteRecorderTitle ThisRowTotalRow {()} {TitlesVoteRecorder WithinTitles get} ifelse def /ThisVoteRecorderSubtitle ThisRowTotalRow {()} {SubtitlesVoteRecorder WithinTitles get} ifelse def TitlesFont VoteRecorderTitlesFontSize selectfont VoteRecorderTitleWidths WithinPage /ThisVoteRecorderTitle load StringPathBBox pop exch pop exch sub /VoteRecorderTitleWidthsMax dup load 2 index lt {1 index store} {pop} ifelse put SubtitlesFont VoteRecorderTitlesFontSize selectfont VoteRecorderSubtitleWidths WithinPage /ThisVoteRecorderSubtitle load StringPathBBox pop exch pop exch sub /VoteRecorderSubtitleWidthsMax dup load 2 index lt {1 index store} {pop} ifelse put } if % WithinTitles ...0 ge /WithinPage WithinPage 1 add def } for % WithinCluster, WithinTitles } for % ClusterNum /WithinPage 0 def /VoteRecorderProportionToBeLogged //true def /VoteRecorderSubtitleWidthsMax 0 def 0 1 VoteRecorderThisSheet length 1 sub { /ClusterNum exch def 0 1 VoteRecorderThisSheet ClusterNum GetEU length 1 sub % Non-standard upper bound { /WithinCluster exch def /WithinTitles VoteRecorderThisSheet ClusterNum GetEU WithinCluster GetEU def WithinTitles 0 ge { VoteRecorderSubtitleWidths WithinPage 2 copy get VoteRecorderSubtitleFontSizeProportionTitles dup IsNumber not { pop VoteRecorderTitleWidthsMax VoteRecorderSubtitleWidthsMax dup 0 gt {div} {pop pop 0.5} ifelse 0.5 2 copy gt {exch} if pop % embedded constant 5 VoteRecorderTitlesFontSize div 2 copy lt {exch} if pop % embedded constant //Epsilon 2 copy lt {exch} if pop //SqrtHalf 2 copy gt {exch} if pop % embedded constant VoteRecorderProportionToBeLogged VoteRecorderSubtitleWidthsMax 0 gt and { dup mark exch (VoteRecorderSheetNum=) exch VoteRecorderSheetNum exch (: VoteRecorderSubtitleFontSizeProportionTitles at least once replaced with ) exch (, a font size of ) 1 index VoteRecorderTitlesFontSize mul (pt.) ConcatenateToMark OutputToLog /VoteRecorderProportionToBeLogged //false store } if % VoteRecorderProportionToBeLogged VoteRecorderSubtitleWidthsMax 0 gt and dup VoteRecorderSubtitleFSPT exch WithinPage exch put } if % VoteRecorderSubtitleFontSizeProportionTitles dup IsNumber not mul put } if % WithinTitles 0 ge /WithinPage WithinPage 1 add def } for % WithinCluster, WithinTitles /VoteRecorderSubtitleWidthsMax dup load 0 1 VoteRecorderThisSheet ClusterNum GetEU length 1 sub { dup VoteRecorderSubtitleWidths exch get dup IsNumber {exch VoteRecorderSubtitleFSPT exch GetEU mul 2 copy lt {exch} if} {pop} ifelse pop } for store } for % ClusterNum currentdict /WithinTitles undef currentdict /WithinCluster undef currentdict /ClusterNum undef /VoteRecorderNamesMaxT 0 def /VoteRecorderNamesMinB 0 def /VoteRecorderNameL VoteRecorderNumNames array def /VoteRecorderNameB VoteRecorderNumNames array def /VoteRecorderNameR VoteRecorderNumNames array def 0 1 VoteRecorderNumNames 1 sub { /NameNum exch def /ThisName VoteRecorderNames NameNum get def % Non-standard line NamesFont VoteRecorderNamesFontSize selectfont /ThisName load StringPathBBox dup VoteRecorderNamesMaxT gt {/VoteRecorderNamesMaxT exch def} {pop} ifelse exch dup dup VoteRecorderNamesMinB lt {/VoteRecorderNamesMinB exch def} {pop} ifelse VoteRecorderNameB exch NameNum exch put VoteRecorderNameR exch NameNum exch put VoteRecorderNameL exch NameNum exch put } for % NameNum currentdict /NameNum undef VoteRecorderNamesWidthsLogged not NamesVoteRecorder length 4 ge and { /NamesVoteRecorderWidths VoteRecorderNameR VoteRecorderNameL {sub} //false TwoArraysFunction 0 NamesVoteRecorder length getinterval def NamesVoteRecorderWidths //false exch {0 ne {pop //true exit} if} forall { /SortIncreasingVR 0 NamesVoteRecorderWidths NamesVoteRecorder length 2 idiv 1 sub dup NamesVoteRecorder length 1 sub exch sub exch getinterval {add} forall 0 NamesVoteRecorderWidths 1 NamesVoteRecorder length 2 idiv 1 sub getinterval {add} forall ge def % /SortIncreasingVR % VoteRecorder slightly neater if names sorted by length. Usual practice to begin with honoured guest, then organiser, then the others sorted by length. These logs help sorting. mark () (NamesVoteRecorder, sorted ) (longer) (shorter) SortIncreasingVR {exch} if (-to-) exch (: ) [ 0 1 NamesVoteRecorder length 1 sub {[exch dup NamesVoteRecorder exch get ASCIIfy exch NamesVoteRecorderWidths exch get] dup 1 get 0 eq {pop} if} for ] dup {1 get exch 1 get SortIncreasingVR {gt} {lt} ifelse} ShellSort {0 get (; )} forall pop dup (; ) eq {pop TerminatingFullStopAppend} if % pop until string that is neither () nor (; ) ( Names with lengths locally non-monotonic: ) 1 1 NamesVoteRecorderWidths length 2 sub { /NameNum exch def //true -1 1 1 {NameNum add NamesVoteRecorderWidths exch get 0 le {pop //false exit} if} for { -1 1 1 {NameNum add NamesVoteRecorderWidths exch get} for 1 index sub 3 1 roll sub 2 copy abs 0.06 ge exch abs 0.06 ge and 3 1 roll mul 0 gt and % Embedded constant, being 1px at 1200d.p.i. { NamesVoteRecorder NameNum get ASCIIfy (; ) } if % Non-montonic } if % ... 0 gt } for % i (; ) eq {TerminatingFullStopAppend} if ConcatenateToMark OutputToLog /VoteRecorderNamesWidthsLogged //true store } if % any non-0 widths currentdict /NamesVoteRecorderWidths undef } if % VoteRecorderNamesWidthsLogged not NamesVoteRecorder length 4 ge and /VoteRecorderHeightFirstRow 0 0 1 VoteRecorderNumNames 1 sub {dup VoteRecorderNameR exch get exch VoteRecorderNameL exch get sub 2 copy lt {exch} if pop} for PageHeight MgnB MgnT add VoteRecorderTopTextHeight add sub dup 8 div exch 3 mul VoteRecorderThisSheetLength 3 add div 2 {2 copy gt {exch} if pop} repeat % Not to exceed 1/8 space of rows, nor 3 times other rows def % /VoteRecorderHeightFirstRow 2 { % VoteRecorderRowHeight needs VoteRecorderHeightFirstRow needs VoteRecorderColWidth needs VoteRecorderWideLineWidth needs VoteRecorderCircletextFontSize needs VoteRecorderRowHeight /VoteRecorderRowHeight PageHeight MgnB MgnT add sub VoteRecorderTopTextHeight sub VoteRecorderHeightFirstRow sub VoteRecorderThisSheetLength dup 0 eq {pop pop //PrinterEpsilon} {div} ifelse def /VoteRecorderCircletextFontSize VoteRecorderRowHeight 6 div dup 5 gt {pop 5} if def % embedded constant /VoteRecorderWideLineWidth << /SheetNum 0 /WithinPage 0 /WithinTitles 0 >> begin CircletextFont end VoteRecorderCircletextFontSize selectfont BaseHeight def /VoteRecorderNarrowLineWidth 0.72 VoteRecorderWideLineWidth 3 div 2 copy gt {exch} if pop def /VoteRecorderMiddleLineWidth VoteRecorderWideLineWidth VoteRecorderNarrowLineWidth add 2 div def /VoteRecorderWidthColFirst VoteRecorderTitleWidthsMax VoteRecorderSubtitleWidthsMax 2 copy lt {exch} if pop VoteRecorderWideLineWidth 2 div add PageWidth MgnL MgnR add sub 6 mul VoteRecorderNumNames 7 add div 2 copy gt {exch} if pop % Max is 6 times other cols def % /VoteRecorderWidthColFirst /VoteRecorderColWidth PageWidth MgnL MgnR add sub VoteRecorderWidthColFirst sub VoteRecorderNumNames div def % Discussion: http://www.theportforum.com/viewtopic.php?t=175&p=80997#p80997 VoteRecorderNamesOrientation dup /Horizontal eq exch /Vertical ne VoteRecorderColWidth VoteRecorderHeightFirstRow 0.9375 mul ge and or { % Might as well show VoteRecorderNames horizontally. So can shrink VoteRecorderHeightFirstRow. /VoteRecorderHeightFirstRow VoteRecorderNamesMaxT VoteRecorderNamesMinB sub 1.0625 mul def } if % VoteRecorderColWidth VoteRecorderHeightFirstRow 0.875 mul gt } repeat % 2 0.75 setgray 0 setlinecap 1 setlinejoin [] 0 setdash 0 1 VoteRecorderNumNames 1 sub { /NameNum exch def /x PageWidth MgnL MgnR add sub VoteRecorderWidthColFirst sub NameNum mul VoteRecorderNumNames div MgnL add VoteRecorderWidthColFirst add def x MgnB moveto x PageHeight MgnT sub VoteRecorderTopTextHeight sub lineto VoteRecorderShowTotalCol VoteRecorderSheetNum GetEU NameNum VoteRecorderNumNames 1 sub eq and NameNum 0 eq or {VoteRecorderWideLineWidth} {VoteRecorderNumNames 7 ge VoteRecorderNumNames 3 mod 0 eq {0} {2} ifelse NameNum 3 mod eq and {VoteRecorderMiddleLineWidth} {VoteRecorderNarrowLineWidth} ifelse} ifelse setlinewidth stroke } for % NameNum currentdict /NameNum undef /WithinPage 0 def 0 1 VoteRecorderThisSheet length 1 sub { /ClusterNum exch def 0 1 VoteRecorderThisSheet ClusterNum GetEU length 1 sub VoteRecorderShowTotalRow VoteRecorderSheetNum GetEU ClusterNum VoteRecorderThisSheet length 1 sub eq and {1 add} if { /WithinCluster exch def /ThisRowTotalRow VoteRecorderShowTotalRow VoteRecorderSheetNum GetEU WithinPage VoteRecorderThisSheetLength 1 sub eq and def /WithinTitles ThisRowTotalRow {//null} {VoteRecorderThisSheet ClusterNum GetEU WithinCluster GetEU} ifelse def WithinTitles //null eq {//true} {WithinTitles 0 ge} ifelse { /ThisVoteRecorderTitle ThisRowTotalRow {/VoteRecorderTotalRowTitle load} {TitlesVoteRecorder WithinTitles get} ifelse def /ThisVoteRecorderSubtitle ThisRowTotalRow {()} {SubtitlesVoteRecorder WithinTitles get} ifelse def /CurrentTop VoteRecorderRowHeight VoteRecorderThisSheetLength WithinPage sub mul MgnB add def TitlesFont VoteRecorderTitlesFontSize selectfont /ThisVoteRecorderTitle load StringPathBBox /VoteRecorderTitleT exch def /VoteRecorderTitleR exch def /VoteRecorderTitleB exch def /VoteRecorderTitleL exch def SubtitlesFont VoteRecorderTitlesFontSize VoteRecorderSubtitleFSPT WithinPage GetEU mul selectfont /ThisVoteRecorderSubtitle load StringPathBBox /VoteRecorderSubtitleT exch def pop /VoteRecorderSubtitleB exch def pop /VoteRecorderTitleSubtitleGap VoteRecorderTitleT VoteRecorderTitleB sub VoteRecorderSubtitleT VoteRecorderSubtitleB sub 2 copy gt {exch} if pop 0.25 mul def % embedded constant 0.25 ThisRowTotalRow { 0.75 setgray MgnL CurrentTop PageWidth MgnL MgnR add sub VoteRecorderWideLineWidth neg rectfill 0 setgray TitlesFont VoteRecorderTitlesFontSize selectfont VoteRecorderTitleT VoteRecorderTitleB sub //PrinterEpsilon gt VoteRecorderTitleR VoteRecorderTitleL sub //PrinterEpsilon gt and { % http://www.theportforum.com/viewtopic.php?t=175&start=852 matrix currentmatrix % Size factor if rotated VoteRecorderWidthColFirst VoteRecorderWideLineWidth 2 div sub VoteRecorderTitleT VoteRecorderTitleB sub div VoteRecorderRowHeight VoteRecorderWideLineWidth sub VoteRecorderTitleR VoteRecorderTitleL sub div 1 2 {2 copy gt {exch} if pop} repeat % Size factor if not rotated VoteRecorderWidthColFirst VoteRecorderWideLineWidth 2 div sub VoteRecorderTitleR VoteRecorderTitleL sub div VoteRecorderRowHeight VoteRecorderWideLineWidth sub VoteRecorderTitleT VoteRecorderTitleB sub div 1 2 {2 copy gt {exch} if pop} repeat 2 copy gt { MgnL VoteRecorderRowHeight VoteRecorderThisSheetLength WithinPage sub 1 sub mul MgnB add translate pop 90 rotate dup 1 ne {dup scale} {pop} ifelse VoteRecorderTitleL neg VoteRecorderTitleT neg moveto }{ MgnL CurrentTop VoteRecorderRowHeight sub VoteRecorderTitleB sub VoteRecorderRowHeight 32 div add moveto dup 1 ne {1 scale} {pop} ifelse pop } ifelse % rotate /ThisVoteRecorderTitle load ShowRecursive setmatrix } if % Non-zero size }{ MgnL CurrentTop moveto CirclearraysVoteRecorder WithinTitles get {0 setgray CircletextFont VoteRecorderCircletextFontSize selectfont} CircletextsMinNumSpacesBetween //true PageWidth MgnL MgnR add sub WithinCluster 0 eq -1 CirclearrayInStraightLine /CirclearraysVoteRecorderT exch def /CirclearraysVoteRecorderB exch def pop pop /CurrentTop CurrentTop CirclearraysVoteRecorderT CirclearraysVoteRecorderB sub sub def 1 dict begin /AnnotationCount 0 def 0 2 GlassesAnnotations length 2 sub dup 0 ge {//false PageSuppressed {pop -1} if} if { dup GlassesAnnotations exch GetEU WithinTitles eq { mark exch 1 add GlassesAnnotations exch GetEU PDFDocEncodingify /Contents exch /Title [Titles WithinTitles get (: annotation)] PDFDocEncodingify /Rect [ MgnL VoteRecorderWidthColFirst add 8 AnnotationCount sub 8 div mul PageWidth MgnR sub AnnotationCount 8 div mul add CurrentTop 2 copy ] /Subtype /Text /Open //true /F 64 128 add % ReadOnly + Locked. PDFReference16.pdf page 574 /ANN pdfmark /AnnotationCount AnnotationCount 1 add store AnnotationCount 9 ge {exit} if } {pop} ifelse % ... WithinTitles eq } for end % 'GlassesAnnotations' newpath 1 setlinecap 1 setlinejoin [] 0 setdash /VoteRecorderCrossLineWidth 2.88 VoteRecorderColWidth 12 div VoteRecorderRowHeight CirclearraysVoteRecorderT CirclearraysVoteRecorderB sub sub 12 div 2 {2 copy gt {exch} if pop} repeat def % VoteRecorderCrossLineWidth 0 1 VoteRecorderNumNames 1 sub % Different upper bound { /NameNum exch def % Different variable /ThisName VoteRecorderNames NameNum get def //DeBugLevel 100 le {( VoteRecorderForms: PaintProc, +VoteRecorderCrossedBox) OutputToLog} if /x PageWidth MgnL MgnR add sub VoteRecorderWidthColFirst sub NameNum 0.5 add mul VoteRecorderNumNames div MgnL add VoteRecorderWidthColFirst add def /VoteRecorderRowHeight2 VoteRecorderRowHeight CirclearraysVoteRecorderT CirclearraysVoteRecorderB sub sub 2 div def /y CurrentTop VoteRecorderRowHeight2 sub def VoteRecorderCrossedBox { //DeBugLevel 100 le {mark ( VoteRecorderForms: PaintProc, VoteRecorderCrossedBox=true, NameNum=) NameNum (; WithinTitles=) WithinTitles ConcatenateToMark OutputToLog} if x VoteRecorderColWidth 2 div sub VoteRecorderCrossLineWidth 2 mul add y VoteRecorderRowHeight2 add VoteRecorderCrossLineWidth 2 mul sub 2 copy moveto x VoteRecorderColWidth 2 div add VoteRecorderCrossLineWidth 2 mul sub y VoteRecorderRowHeight2 sub VoteRecorderCrossLineWidth 2 mul add 2 copy lineto 3 1 roll exch moveto lineto 0 setgray VoteRecorderCrossLineWidth dup setlinewidth 2.16 ge {GSave stroke GRestore 1 setgray VoteRecorderCrossLineWidth 3 div setlinewidth stroke} {stroke} ifelse } if % VoteRecorderCrossedBox NameNum VoteRecorderNumNames VoteRecorderShowTotalCol VoteRecorderSheetNum GetEU {2} {1} ifelse sub eq ThisName VoteRecorderMonkeyName eq and /VoteRecorderMonkeyVote load NonEmptyCompoundObject and { 5 dict begin TitlesFont 1 selectfont VoteRecorderMonkeyVote StringPathBBox /T exch def /R exch def /B exch def /L exch def T B 0.01 add gt R L 0.01 add gt and { /FS VoteRecorderColWidth 0.8 mul R L sub div VoteRecorderRowHeight2 1.6 mul T B sub div 2 copy gt {exch} if pop def % Filling <=80% of width and height x R L add FS mul 2 div sub y T B add FS mul 2 div sub moveto TitlesFont FS selectfont 0.6 setgray VoteRecorderMonkeyVote ShowRecursive % Not quite black } if % Non-zero size end } if % Monkey //DeBugLevel 100 le {( VoteRecorderForms: PaintProc, -VoteRecorderCrossedBox) OutputToLog} if } for % NameNum currentdict /NameNum undef currentdict /ThisName undef /CurrentTop CurrentTop TastingNotesLineGap sub def 0 setgray TitlesFont VoteRecorderTitlesFontSize selectfont MgnL CurrentTop VoteRecorderTitleT sub VoteRecorderRowHeight 32 div sub moveto VoteRecorderWidthColFirst VoteRecorderTitleWidths WithinPage get 2 copy lt {div matrix currentmatrix exch 1 scale /ThisVoteRecorderTitle load ShowRecursive setmatrix} {pop pop /ThisVoteRecorderTitle load ShowRecursive} ifelse /CurrentTop CurrentTop VoteRecorderTitleT VoteRecorderTitleB sub sub VoteRecorderRowHeight 32 div sub def SubtitlesFont VoteRecorderTitlesFontSize VoteRecorderSubtitleFSPT WithinPage GetEU mul selectfont MgnL CurrentTop VoteRecorderTitleSubtitleGap sub VoteRecorderSubtitleT sub moveto VoteRecorderWidthColFirst VoteRecorderSubtitleWidths WithinPage get 2 copy lt {div matrix currentmatrix exch 1 scale /ThisVoteRecorderSubtitle load ShowRecursive setmatrix} {pop pop /ThisVoteRecorderSubtitle load ShowRecursive} ifelse } ifelse % ThisRowTotalRow } if % WithinTitles //null eq {//true} {WithinTitles 0 ge} ifelse /WithinPage WithinPage 1 add def } for % WithinCluster, WithinTitles } for % ClusterNum /WithinPage 0 def 0 1 VoteRecorderNumNames 1 sub { /NameNum exch def /ThisName VoteRecorderNames NameNum get def % Non-standard line /CurrentCentre MgnL VoteRecorderWidthColFirst add VoteRecorderColWidth NameNum 0.5 add mul add def NamesFont VoteRecorderNamesFontSize selectfont 0 setgray % Discussion: http://www.theportforum.com/viewtopic.php?t=175&p=80997#p80997 VoteRecorderNamesOrientation dup /Horizontal eq exch /Vertical ne VoteRecorderColWidth VoteRecorderHeightFirstRow ge and or { % Horizontal PageHeight MgnT sub VoteRecorderTopTextHeight sub VoteRecorderHeightFirstRow VoteRecorderNamesMaxT VoteRecorderNamesMinB add add 2 div sub VoteRecorderColWidth VoteRecorderNarrowLineWidth NameNum VoteRecorderNumNames ge {2 div} if sub % The VoteRecorderNarrowLineWidth is so that adjacent columns don't quite touch VoteRecorderNameR NameNum get VoteRecorderNameL NameNum get sub 2 copy lt { //DeBugLevel 9 le {( VoteRecorder: Horizontal, scaled) OutputToLog} if CurrentCentre VoteRecorderColWidth VoteRecorderNarrowLineWidth sub 2 div sub 4 -1 roll moveto div matrix currentmatrix exch 1 scale VoteRecorderNameL NameNum get neg 0 rmoveto /ThisName load ShowRecursive setmatrix }{ //DeBugLevel 9 le {( VoteRecorder: Horizontal) OutputToLog} if NameNum VoteRecorderNumNames ge {pop pop PageWidth MgnR sub VoteRecorderNameR NameNum get sub} {pop pop CurrentCentre VoteRecorderNameL NameNum get VoteRecorderNameR NameNum get add 2 div sub} ifelse exch moveto /ThisName load ShowRecursive } ifelse % VoteRecorderColWidth ... VoteRecorderNameR ... VoteRecorderNameL sub ... lt }{ % Vertical matrix currentmatrix NameNum VoteRecorderNumNames ge % "Total" {PageWidth MgnR sub VoteRecorderNameB NameNum get add} {CurrentCentre VoteRecorderNamesMaxT VoteRecorderNamesMinB add 2 div add} ifelse % Total column VoteRecorderHeightFirstRow VoteRecorderNameR NameNum get VoteRecorderNameL NameNum get sub 2 copy lt { //DeBugLevel 9 le {( VoteRecorder: Vertical, scaled) OutputToLog} if 3 -1 roll PageHeight MgnT sub VoteRecorderTopTextHeight sub VoteRecorderHeightFirstRow sub VoteRecorderNameL NameNum get sub moveto div 90 rotate 1 scale /ThisName load ShowRecursive }{ //DeBugLevel 9 le {( VoteRecorder: Vertical) OutputToLog} if pop pop PageHeight MgnT sub VoteRecorderTopTextHeight sub VoteRecorderHeightFirstRow sub VoteRecorderNameL NameNum get sub 1.20 VoteRecorderHeightFirstRow VoteRecorderNameR NameNum get sub VoteRecorderNameL NameNum get add 2 copy gt {exch} if pop add moveto % Embedded constant 90 rotate /ThisName load ShowRecursive } ifelse % VoteRecorderHeightFirstRow ... VoteRecorderNameR ... VoteRecorderNameL ... sub ... lt setmatrix } ifelse % VoteRecorderColWidth VoteRecorderHeightFirstRow gt } for % NameNum currentdict /NameNum undef matrix currentmatrix << /WithinTitles 0 >> begin HeaderFont VoteRecorderCircletextFontSize selectfont end VoteRecorderInstruction StringPathBBox /VRTTT exch def /VRTTR exch def /VRTTB exch def /VRTTL exch def VoteRecorderWidthColFirst VoteRecorderHeightFirstRow 0.875 mul ge { MgnL PageHeight MgnT sub VoteRecorderTopTextHeight sub VoteRecorderHeightFirstRow 2 div sub VRTTT VRTTB add 2 div sub moveto VoteRecorderWidthColFirst VoteRecorderWideLineWidth 2 div sub VRTTR VRTTL sub dup //PrinterEpsilon gt {div dup 1 lt {1 scale} {pop} ifelse} {pop pop} ifelse }{ MgnL VoteRecorderWidthColFirst 2 div add VRTTT VRTTB sub 2 div add PageHeight MgnT sub VoteRecorderTopTextHeight sub VoteRecorderHeightFirstRow sub translate 90 rotate 0 0 moveto VRTTR VRTTL sub VoteRecorderHeightFirstRow gt {VoteRecorderHeightFirstRow VRTTR VRTTL sub div 1 scale} {VoteRecorderHeightFirstRow VRTTR VRTTL sub sub 2 div 0 rmoveto} ifelse } ifelse VoteRecorderInstruction ShowRecursive setmatrix % Show horizontally end //DeBugLevel 100 le {(-VoteRecorderForms: PaintProc) OutputToLog} if } bind def % /PaintProc end % dictionary VoteRecorderForms } bind for % VoteRecorderSheetNum UndefMgns currentdict /VoteRecorderSheetNum undef } if % ... VoteRecorders ... % Discussion: http://www.theportforum.com/viewtopic.php?t=175&p=42615#p42615 {DecantingNotesNumCopies 1 ge} MightBeTrue { //DeBugLevel 100 le {( Main: DecantingNotesForms) OutputToLog} if /TypeOfPagesBeingRendered /DecantingNotes store /ThisName (Decanting notes) def /DecantingNotesForms [ GlassesClusteredOnDecantingNotes length {6 dict} repeat ] def 0 1 GlassesClusteredOnDecantingNotes length 1 sub { /DecantingNotesSheetNum exch def //false //false //false //false DecantingNotesPaperType DecantingNotesOrientation SetPaperSize //true DefStoreMgns DecantingNotesForms DecantingNotesSheetNum get begin /FormType 1 def /BBox [ MgnL 2 div MgnB 2 div PageWidth MgnR 2 div sub PageHeight MgnT 2 div sub ] def /Matrix matrix identmatrix def /PaintProc { //DeBugLevel 100 le {(+DecantingNotesForms: PaintProc) OutputToLog} if pop % dictionary parameter of execform 32 dict begin /DecantingNotesSheetNum DecantingNotesSheetNum def /TypeOfPagesBeingRendered /DecantingNotes store /ThisName (Decanting notes) def HeadersAndFooters PaintHeadersFooters /DecantingNotesLineWidth 1.32 def /DecantingNotesNumGlasses 0 GlassesClusteredOnDecantingNotes DecantingNotesSheetNum GetEU {execU length add} forall def /DecantingNotesTitlesFontSize PageHeight MgnB MgnT add sub 8 DecantingNotesNumGlasses 2 copy lt {exch} if pop 1 add div % embedded constant 1.8 div % embedded constant DecantingNotesTitlesFontSizeMax 2 copy gt {exch} if pop def % /DecantingNotesTitlesFontSize DecantingNotesTitlesFontSize 8 lt { mark DecantingNotesTitlesFontSize 5 lt { (Error: DecantingNotesTitlesFontSize \(with DecantingNotesSheetNum=) DecantingNotesSheetNum (\) computed to be ) DecantingNotesTitlesFontSize ( which is <) 5 (, so tiny)} {(Warning: DecantingNotesTitlesFontSize \(with DecantingNotesSheetNum=) DecantingNotesSheetNum (\) computed to be ) DecantingNotesTitlesFontSize ( which is <) 8 (, so small)} ifelse (. Continuing, but consider changing GlassesClusteredOnDecantingNotes.) ConcatenateToMark OutputToLog } if % VoteRecorderTitlesFontSize 6 lt /DecantingNotesTitleWidths DecantingNotesThisSheetLength array def /DecantingNotesSubtitleWidths DecantingNotesThisSheetLength array def /DecantingNotesSubtitleFSPT [ DecantingNotesThisSheetLength {0} repeat ] def /DecantingNotesTitleWidthsMax 0 def /DecantingNotesSubtitleWidthsMax 0 def /WithinPage 0 def 0 1 DecantingNotesThisSheet length 1 sub { /ClusterNum exch def 0 1 DecantingNotesThisSheet ClusterNum GetEU length 1 sub { /WithinCluster exch def /WithinTitles DecantingNotesThisSheet ClusterNum GetEU WithinCluster GetEU def WithinTitles 0 ge { TitlesFont DecantingNotesTitlesFontSize selectfont DecantingNotesTitleWidths WithinPage TitlesDecantingNotes WithinTitles get StringPathBBox pop exch pop exch sub /DecantingNotesTitleWidthsMax dup load 2 index lt {1 index store} {pop} ifelse put SubtitlesFont DecantingNotesTitlesFontSize selectfont DecantingNotesSubtitleWidths WithinPage SubtitlesDecantingNotes WithinTitles get StringPathBBox pop exch pop exch sub /DecantingNotesSubtitleWidthsMax dup load 2 index lt {1 index store} {pop} ifelse put } if % WithinTitles 0 ge /WithinPage WithinPage 1 add def } for % WithinCluster, WithinTitles } for % ClusterNum /WithinPage 0 def /DecantingNotesProportionToBeLogged //true def 0 1 DecantingNotesThisSheet length 1 sub { /ClusterNum exch def 0 1 DecantingNotesThisSheet ClusterNum GetEU length 1 sub { /WithinCluster exch def /WithinTitles DecantingNotesThisSheet ClusterNum GetEU WithinCluster GetEU def WithinTitles 0 ge { DecantingNotesSubtitleWidths WithinPage 2 copy get DecantingNotesSubtitleFontSizeProportionTitles dup IsNumber not { pop DecantingNotesTitleWidthsMax DecantingNotesSubtitleWidthsMax dup 0 gt {div} {pop pop 0.5} ifelse 0.5 2 copy gt {exch} if pop % embedded constant 5 DecantingNotesTitlesFontSize div 2 copy lt {exch} if pop % embedded constant //SqrtHalf 2 copy gt {exch} if pop % embedded constant DecantingNotesProportionToBeLogged DecantingNotesSubtitleWidthsMax 0 gt and { dup mark exch (DecantingNotesSheetNum=) exch DecantingNotesSheetNum exch (: DecantingNotesSubtitleFontSizeProportionTitles at least once replaced with ) exch (, a font size of ) 1 index DecantingNotesTitlesFontSize mul (pt.) ConcatenateToMark OutputToLog /DecantingNotesProportionToBeLogged //false store } if % DecantingNotesProportionToBeLogged DecantingNotesSubtitleWidthsMax 0 gt and dup DecantingNotesSubtitleFSPT exch WithinPage exch put } if % DecantingNotesSubtitleFontSizeProportionTitles dup IsNumber not mul put } if % WithinTitles 0 ge /WithinPage WithinPage 1 add def } for % WithinCluster, WithinTitles } for % ClusterNum /DecantingNotesSubtitleWidthsMax 0 0 1 DecantingNotesThisSheetLength 1 sub { dup DecantingNotesSubtitleWidths exch get dup IsNumber {exch DecantingNotesSubtitleFSPT exch get mul 2 copy lt {exch} if} {pop} ifelse pop } for store currentdict /WithinTitles undef currentdict /WithinCluster undef currentdict /ClusterNum undef HeaderFont DecantingNotesTopTextHeight selectfont DecantingNotesTopText StringPathBBox /DecantingNotesTopTextT exch def /DecantingNotesTopTextR exch def /DecantingNotesTopTextB exch def pop /DecantingNotesTopTextFontSize DecantingNotesTopTextHeight dup mul DecantingNotesTopTextT DecantingNotesTopTextB sub div //PrinterEpsilon 2 copy lt {exch} if pop def /DecantingNotesHeadingsFontSize DecantingNotesTopTextFontSize //GoldenRatio div def /DecantingNotesWidthColFirst DecantingNotesTitleWidthsMax DecantingNotesSubtitleWidthsMax 2 copy lt {exch} if pop DecantingNotesLineWidth 2 div add PageWidth MgnL MgnR add sub 6 div 2 copy gt {exch} if pop % Max is 6 times other cols def % /DecantingNotesWidthColFirst /DecantingNotesWidthColTimes 72 DecantingNotesHeadingsFontSize 3 mul 2 copy lt {exch} if pop % embedded constants PageWidth MgnL MgnR add sub DecantingNotesWidthColFirst sub 2 div 2 copy gt {exch} if pop def HeaderFont DecantingNotesHeadingsFontSize selectfont [DecantingNotesColumnHeadingTimes DecantingNotesColumnHeadingNotes] StringPathBBox exch pop 2 copy exch sub 2 add /DecantingNotesHeightFirstRow exch def % embedded constant add neg DecantingNotesHeightFirstRow add 2 div /DecantingNotesVerticalOffsetFirstRow exch def pop /DecantingNotesLargerTopTwoThings DecantingNotesTopTextHeight DecantingNotesHeightFirstRow 2 copy lt {exch} if pop def 0.75 setgray DecantingNotesLineWidth setlinewidth 0 setlinecap 1 setlinejoin [] 0 setdash PageHeight MgnT sub DecantingNotesTopTextHeight sub DecantingNotesHeightFirstRow add dup MgnL DecantingNotesWidthColFirst add dup MgnB moveto exch lineto stroke MgnL DecantingNotesWidthColFirst add DecantingNotesWidthColTimes add dup MgnB moveto exch lineto stroke /DecantingNotesRowHeight PageHeight MgnB MgnT add sub DecantingNotesLargerTopTwoThings sub DecantingNotesNumGlasses dup 0 eq {pop pop 0} {div} ifelse def /DecantingNotesCircletextFontSize DecantingNotesRowHeight 6 div dup 5 gt {pop 5} if def % embedded constant DecantingNotesTopTextHeight 0 gt { HeaderFont DecantingNotesTopTextFontSize selectfont /DecantingNotesFirstRowBaseline PageHeight MgnT sub DecantingNotesTopTextHeight DecantingNotesTopTextT DecantingNotesTopTextB sub div DecantingNotesTopTextT mul sub def PageWidth MgnR sub DecantingNotesTopTextR DecantingNotesTopTextHeight mul DecantingNotesTopTextT DecantingNotesTopTextB sub div sub DecantingNotesFirstRowBaseline moveto 0.5 setgray DecantingNotesTopText ShowRecursive currentdict /DecantingNotesTopTextB undef currentdict /DecantingNotesTopTextR undef currentdict /DecantingNotesTopTextT undef 0 setgray HeaderFont DecantingNotesHeadingsFontSize selectfont DecantingNotesFirstRowBaseline dup /DecantingNotesColumnHeadingTimesStringWidth DecantingNotesColumnHeadingTimes StringWidthRecursive def DecantingNotesWidthColTimes DecantingNotesColumnHeadingTimesStringWidth lt {matrix currentmatrix exch MgnL DecantingNotesWidthColFirst add exch moveto DecantingNotesWidthColTimes DecantingNotesColumnHeadingTimesStringWidth div 1 scale DecantingNotesColumnHeadingTimes ShowRecursive setmatrix} {MgnL DecantingNotesWidthColFirst add DecantingNotesWidthColTimes DecantingNotesColumnHeadingTimesStringWidth sub 2 div add exch moveto DecantingNotesColumnHeadingTimes ShowRecursive} ifelse % DecantingNotesColumnHeadingTimes too large DecantingNotesWidthColTimes DecantingNotesColumnHeadingTimesStringWidth lt {PageWidth MgnL MgnR add sub 128 div} {DecantingNotesWidthColTimes DecantingNotesColumnHeadingTimesStringWidth sub 2 div} ifelse MgnL add DecantingNotesWidthColFirst add DecantingNotesWidthColTimes add exch moveto DecantingNotesColumnHeadingNotes ShowRecursive } if % DecantingNotesTopTextHeight 0 gt /WithinPage 0 def 0 1 DecantingNotesThisSheet length 1 sub { /ClusterNum exch def 0 1 DecantingNotesThisSheet ClusterNum GetEU length 1 sub { /WithinCluster exch def /WithinTitles DecantingNotesThisSheet ClusterNum GetEU WithinCluster GetEU def WithinTitles 0 ge { /CurrentTop DecantingNotesRowHeight DecantingNotesThisSheetLength WithinPage sub mul MgnB add def MgnL CurrentTop moveto CirclearraysDecantingNotes WithinTitles get {0 setgray CircletextFont DecantingNotesCircletextFontSize selectfont} CircletextsMinNumSpacesBetween //true PageWidth MgnL MgnR add sub WithinCluster 0 eq -1 CirclearrayInStraightLine sub 2 div CurrentTop add /CurrentTop exch def pop pop 1 dict begin /AnnotationCount 0 def 0 2 GlassesAnnotations length 2 sub dup 0 ge {//false PageSuppressed {pop -1} if} if { dup GlassesAnnotations exch GetEU WithinTitles eq { mark exch 1 add GlassesAnnotations exch GetEU PDFDocEncodingify /Contents exch /Title [Titles WithinTitles get (: annotation)] PDFDocEncodingify /Rect [ MgnL DecantingNotesWidthColFirst add 8 AnnotationCount sub 8 div mul PageWidth MgnR sub AnnotationCount 8 div mul add CurrentTop 2 copy ] /Subtype /Text /Open //true /F 64 128 add % ReadOnly + Locked. PDFReference16.pdf page 574 /ANN pdfmark /AnnotationCount AnnotationCount 1 add store AnnotationCount 9 ge {exit} if } {pop} ifelse % ... WithinTitles eq } for end % 'GlassesAnnotations' TitlesFont DecantingNotesTitlesFontSize selectfont TitlesDecantingNotes WithinTitles get StringPathBBox /DecantingNotesTitleT exch def pop /DecantingNotesTitleB exch def pop SubtitlesFont DecantingNotesTitlesFontSize DecantingNotesSubtitleFSPT WithinPage get mul selectfont SubtitlesDecantingNotes WithinTitles get StringPathBBox /DecantingNotesSubtitleT exch def pop /DecantingNotesSubtitleB exch def pop /DecantingNotesTitleSubtitleGap DecantingNotesTitleT DecantingNotesTitleB sub DecantingNotesSubtitleT DecantingNotesSubtitleB sub 2 copy gt {exch} if pop 0.25 mul def % embedded constant 0.25 MgnL CurrentTop DecantingNotesRowHeight 2 div sub 2 copy DecantingNotesSubtitleT DecantingNotesSubtitleB sub DecantingNotesTitleT DecantingNotesTitleB add sub DecantingNotesTitleSubtitleGap add 2 div add TitlesFont DecantingNotesTitlesFontSize selectfont moveto DecantingNotesWidthColFirst DecantingNotesTitleWidths WithinPage get 2 copy lt {div matrix currentmatrix exch 1 scale TitlesDecantingNotes WithinTitles get ShowRecursive setmatrix} {pop pop TitlesDecantingNotes WithinTitles get ShowRecursive} ifelse DecantingNotesSubtitleT DecantingNotesSubtitleB add DecantingNotesTitleT DecantingNotesTitleB sub add DecantingNotesTitleSubtitleGap add 2 div sub SubtitlesFont DecantingNotesTitlesFontSize DecantingNotesSubtitleFSPT WithinPage get mul selectfont moveto DecantingNotesWidthColFirst DecantingNotesSubtitleWidths WithinPage get 2 copy lt {div matrix currentmatrix exch 1 scale SubtitlesDecantingNotes WithinTitles get ShowRecursive setmatrix} {pop pop SubtitlesDecantingNotes WithinTitles get ShowRecursive} ifelse } if % WithinTitles 0 ge /WithinPage WithinPage 1 add def } for % WithinCluster, WithinTitles } for % ClusterNum end //DeBugLevel 100 le {(-DecantingNotesForms: PaintProc) OutputToLog} if } bind def % /PaintProc end % dictionary DecantingNotesForms } bind for % DecantingNotesSheetNum UndefMgns currentdict /DecantingNotesSheetNum undef } if % ... DecantingNotesNumCopies 1 ge ... /CrossHatchingOutside load MightBeTrue { //DeBugLevel 100 le {( Main: CrossHatchingOutsideForms) OutputToLog} if /TypeOfPagesBeingRendered /Glasses store /CrossHatchingOutsideForms [ NumSheets {4 dict} repeat ] def 0 1 NumSheets 1 sub { /SheetNum exch def //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns CrossHatchingOutsideForms SheetNum get begin /FormType 1 def /Matrix matrix identmatrix def /BBox [ CrossHatchingOutsideToPaperEdge {0 0 PageWidth PageHeight} {MgnL MgnB PageWidth MgnR sub PageHeight MgnT sub} ifelse ] def /PaintProc % Paints CrossHatchingOutsideForm { //DeBugLevel 100 le {(+CrossHatchingOutsideForms: PaintProc) OutputToLog} if pop 3 dict begin CHCX_CHCY /CHCY exch def /CHCX exch def % If two circles have a machine-precision overlap, it will look just as if they had a machine-precision underlap. No problem. % But circles overlapping page edge can look wrong, as eye will see fragments outside margin. And a preliminary rectclip will also speed rasterisation. ClipSave CrossHatchingOutsideToPaperEdge {0 0 PageWidth PageHeight} {MgnL MgnB PageWidth MgnL MgnR add sub PageHeight MgnB MgnT add sub} ifelse rectclip newpath % This path passed to RadialCrossHatching CrossHatchingOutsideToPaperEdge {PageWidth 0 1 index PageHeight 0 1 index 0 0} {PageWidth MgnR sub MgnB 1 index PageHeight MgnT sub MgnL 1 index MgnL MgnB} ifelse moveto lineto lineto lineto closepath 0 1 SheetLengths SheetNum get 1 sub { /WithinPage exch def CircleNonEmpty SheetNum get WithinPage get {GlassPositions SheetNum get WithinPage get aload pop Radii SheetNum get 0 360 /m ArcAccurate closepath} if } for % WithinPage CHCX CHCY /CrossHatchingOutsideStrokeCode load RadialCrossHatching newpath ClipRestore end //DeBugLevel 100 le {(-CrossHatchingOutsideForms: PaintProc) OutputToLog} if } bind def % /PaintProc end % CrossHatchingOutsideForms } bind for % SheetNum currentdict /SheetNum undef } if % ... CrossHatchingOutside ... /CrossHatchingInside load MightBeTrue { //DeBugLevel 100 le {( Main: CrossHatchingInsideForms) OutputToLog} if /TypeOfPagesBeingRendered /Glasses store /CrossHatchingInsideForms [ SheetLengths {[ exch {6 dict} repeat]} forall ] def 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { dup CrossHatchingInsideForms SheetNum get exch get begin WithinPage-WithinTitles-def /FormType 1 def /BBox [ Radii SheetNum get dup dup neg dup 4 2 roll ] def /Matrix matrix identmatrix def /PaintProc % Paints CrossHatchingInsideForm { //DeBugLevel 100 le {(+CrossHatchingInsideForms: PaintProc) OutputToLog} if dup % dictionary parameter of execform containing WithinTitles and WithinPage /TypeOfPagesBeingRendered /Glasses store /WithinTitles get /WithinTitles exch def /WithinPage get /WithinPage exch def CrossHatchingInside { matrix currentmatrix CHCX_CHCY RotationTitlesAboveBelowOverCirclearray dup 0 ne {neg rotate} {pop} ifelse GlassPositions SheetNum get WithinPage get aload pop neg exch neg exch translate moveto setmatrix currentpoint newpath /CHCY exch def /CHCX exch def 0 0 RadiiCirclearrayInside SheetNum get 0 360 /m ArcAccurate CHCX CHCY /CrossHatchingInsideStrokeCode load RadialCrossHatching newpath } if % CrossHatchingInside //DeBugLevel 100 le {(-CrossHatchingInsideForms: PaintProc) OutputToLog} if } bind def % /PaintProc end % CrossHatchingInsideForms } for % WithinPage, WithinTitles currentdict /WithinPage undef currentdict /WithinTitles undef } bind for % SheetNum currentdict /SheetNum undef } if % ... CrossHatchingInside ... /OutlineTitles load MightBeTrue { //DeBugLevel 100 le {( Main: OutlineForms) OutputToLog} if /OutlineTitlesNumberContours [ SheetLengths {array} forall ] def /TypeOfPagesBeingRendered /Glasses store /OutlineForms [ GlassesOnSheets {[ exch execU length {6 dict} repeat]} forall ] def 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { dup OutlineForms SheetNum get exch get begin WithinPage-WithinTitles-def /FormType 1 def /BBox [ Radii SheetNum get 1.02 mul dup dup neg dup 4 2 roll ] def /Matrix matrix identmatrix def /PaintProc % Paints OutlineForm { //DeBugLevel 100 le {(+OutlineForms: PaintProc) OutputToLog} if dup % dictionary parameter of execform containing WithinTitles and WithinPage /WithinTitles get /WithinTitles exch def /WithinPage get /WithinPage exch def RadiiCirclearrayInside SheetNum get 0 gt OutlineTitles and { 0 setgray 1 setlinejoin 1 setlinecap [] 0 setdash newpath 0 0 RadiiCirclearrayInside SheetNum get 0 360 /m ArcAccurate GSave clip newpath % on GRestore will be able to stroke clipping circle TitlesFont TitleFontSizes SheetNum get WithinPage get selectfont TitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get TitleFontSizes SheetNum get WithinPage get mul TitleOffsetsProportionFontSizeVertical SheetNum get WithinPage get TitleFontSizes SheetNum get WithinPage get mul moveto Titles WithinTitles get //true CharPathRecursive OutlineTitlesAlsoOvertitles { OvertitlesFont OvertitleFontSizes SheetNum get WithinPage get selectfont OvertitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get OvertitleFontSizes SheetNum get WithinPage get mul OvertitleOffsetsProportionFontSizeVertical SheetNum get WithinPage get OvertitleFontSizes SheetNum get WithinPage get mul moveto Overtitles WithinTitles get //true CharPathRecursive } if % OutlineTitlesAlsoOvertitles OutlineTitlesAlsoBelowtitles { BelowtitlesFont BelowtitleFontSizes SheetNum get WithinPage get selectfont BelowtitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get BelowtitleFontSizes SheetNum get WithinPage get mul BelowtitleOffsetsAbsoluteVertical SheetNum get WithinPage get moveto Belowtitles WithinTitles get //true CharPathRecursive } if % OutlineTitlesAlsoBelowtitles OutlineTitlesAlsoAbovetitles { AbovetitlesFont AbovetitleFontSizes SheetNum get WithinPage get selectfont AbovetitleOffsetsProportionFontSizeHorizontal SheetNum get WithinPage get AbovetitleFontSizes SheetNum get WithinPage get mul AbovetitleOffsetsAbsoluteVertical SheetNum get WithinPage get moveto Abovetitles WithinTitles get //true CharPathRecursive } if % OutlineTitlesAlsoAbovetitles OutlineTitlesNumberContours SheetNum get WithinPage 2 copy get IsNumber { get /m exch def }{ /OutlineTitlesTargetTotalDistance 0 0 RadiiCirclearrayInside SheetNum get LineWidthThatCoversCircle pop pop 2 div def /m 0 def 1 1 OutlineTitlesMaxNum % Upper bound determines maximum number of laps { /m exch def OutlineTitlesMultiplierWhite 1 eq {m } {OutlineTitlesMultiplierWhite m exp 1 sub OutlineTitlesMultiplierWhite 1 sub div} ifelse OutlineTitlesInnerWidthWhite mul OutlineTitlesMultiplierBlack 1 eq {m 1 sub} {OutlineTitlesMultiplierBlack m 1 sub exp 1 sub OutlineTitlesMultiplierBlack 1 sub div} ifelse OutlineTitlesInnerWidthBlack mul add OutlineTitlesTargetTotalDistance gt {/m m 1 sub def exit} if % Larger than radius needed if title is "J" or "L". OutlineTitlesMultiplierBlack m 1 sub exp dup OutlineTitlesInnerWidthBlack mul 0.03 lt exch 0.25 lt and {exit} if % Less than half a pixel at 1200 dpi } for % m m put } ifelse % OutlineTitlesNumberContours ... IsNumber m -1 1 { GSave /m exch def OutlineTitlesMultiplierWhite 1 eq {m } {OutlineTitlesMultiplierWhite m exp 1 sub OutlineTitlesMultiplierWhite 1 sub div} ifelse OutlineTitlesInnerWidthWhite mul dup OutlineTitlesMultiplierBlack 1 eq {m } {OutlineTitlesMultiplierBlack m exp 1 sub OutlineTitlesMultiplierBlack 1 sub div} ifelse OutlineTitlesInnerWidthBlack mul add 2 mul setlinewidth GSave 0 setgray stroke GRestore OutlineTitlesMultiplierBlack 1 eq {m 1 sub} {OutlineTitlesMultiplierBlack m 1 sub exp 1 sub OutlineTitlesMultiplierBlack 1 sub div} ifelse OutlineTitlesInnerWidthBlack mul add 2 mul setlinewidth 1 setgray stroke GRestore } for % m -1 1 GRestore % end of clipping, but about to reuse clipping path 1.0625 setlinewidth 1 setgray stroke % an edge more than a point } if % RadiiCirclearrayInside SheetNum get 0 gt OutlineTitles and //DeBugLevel 100 le {(-OutlineForms: PaintProc) OutputToLog} if } def % /PaintProc end % OutlineForm } for % WithinPage, WithinTitles currentdict /WithinPage undef currentdict /WithinTitles undef } bind for % SheetNum currentdict /SheetNum undef } if % ...OutlineTitles ... /Spirals load MightBeTrue { //DeBugLevel 100 le {( Main: SpiralForms) OutputToLog} if /SpiralForms [ GlassesOnSheets {[ exch execU length {6 dict} repeat]} forall ] def 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { dup SpiralForms SheetNum get exch get begin WithinPage-WithinTitles-def /FormType 1 def /BBox [ RadiiCirclearrayInside SheetNum get 2 add dup dup neg dup 4 2 roll ] def /Matrix matrix identmatrix def /PaintProc % Paints Spirals { //DeBugLevel 100 le {(+SpiralForms: PaintProc) OutputToLog} if dup % dictionary parameter of execform containing WithinTitles and WithinPage /WithinTitles get /WithinTitles exch def /WithinPage get /WithinPage exch def RadiiCirclearrayInside SheetNum get 0 gt Spirals and { ClipSave newpath 0 0 RadiiCirclearrayInside SheetNum get 0 360 /m ArcAccurate clip newpath SpiralRadiusBetweenArms abs //Infinity ge { 0 1 SpiralNumArms 1 sub { RadiiCirclearrayInside SheetNum get SpiralCentreFromCentreProportionRadiiInside mul SpiralCentreFromCentreAngle 2 copy sin mul 3 1 roll cos mul moveto % 'centre' 360 mul SpiralNumArms div SpiralAngleOffset add SpiralRadiusBetweenArms 0 lt {180 add} if SpiralCentreFromCentreProportionRadiiInside abs 1 add RadiiCirclearrayInside SheetNum get mul exch 2 copy sin mul 3 1 roll cos mul rlineto % extremity of arm } for % arm number }{ RadiiCirclearrayInside SheetNum get SpiralCentreFromCentreProportionRadiiInside mul dup dup SpiralCentreFromCentreAngle sin mul exch SpiralCentreFromCentreAngle cos mul 3 -1 roll abs RadiiCirclearrayInside SheetNum get add 2 add % Embedded constant. Will be enough if linewidth <= 4. SpiralNumArms SpiralRadiusBetweenArms SpiralAngleOffset SpiralClockwise //true /m ArchimedeanSpiralPath } ifelse % SpiralRadiusBetweenArms abs //Infinity ge 0.24 setlinewidth 0 setgray 1 setlinejoin 1 setlinecap [] 0 setdash SpiralStrokeCode % Too thin was 0.12 setlinewidth as used http://www.jdawiseman.com/2022/20220120_blind.pdf ClipRestore } if % RadiiCirclearrayInside SheetNum get 0 gt Spirals and //DeBugLevel 100 le {(-SpiralForms: PaintProc) OutputToLog} if } def % /PaintProc end % SpiralForm } for % WithinPage, WithinTitles currentdict /WithinPage undef currentdict /WithinTitles undef } bind for % SheetNum currentdict /SheetNum undef } if % ...Spirals ... //DeBugLevel 100 le {( Main: CirclearrayForms) OutputToLog} if /TypeOfPagesBeingRendered /Glasses store /CirclearrayForms [ GlassesOnSheets {[ exch execU length {6 dict} repeat]} forall ] def 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { dup CirclearrayForms SheetNum get exch get begin WithinPage-WithinTitles-def /FormType 1 def /BBox [ Radii SheetNum get 1.05 mul dup dup neg dup 4 2 roll ] def /Matrix matrix identmatrix def /PaintProc % Paints Circletext { //DeBugLevel 100 le {(+CirclearrayForms: PaintProc) OutputToLog} if dup % dictionary parameter of execform containing WithinTitles and WithinPage /WithinTitles get /WithinTitles exch def /WithinPage get /WithinPage exch def 0 setgray 0.24 setlinewidth 0 0 moveto Circlearrays WithinTitles GetEU CircletextsMinNumSpacesBetween RadiiCirclearrayBaseline SheetNum get CirclearraysFontSizes SheetNum get WithinPage get CirclearraysN SheetNum get WithinPage get Circletext //DeBugLevel 100 le {(-CirclearrayForms: PaintProc) OutputToLog} if } bind def % /PaintProc end } for % WithinPage currentdict /WithinPage undef currentdict /WithinTitles undef } bind for % SheetNum currentdict /SheetNum undef % - HeadersAndFooters HeaderLeft HeaderCenter HeaderRight FooterLeft FooterCenter FooterRight /HeadersAndFooters { //DeBugLevel 75 le {(+HeadersAndFooters) OutputToLog} if 2 dict begin % ii is the best i /ii -1 def 0 2 HeadersLeft length 2 sub {/i exch def HeadersLeft i GetEU dup ThisPageOrdering le {ii -1 eq {pop //true} {HeadersLeft ii GetEU gt} ifelse {/ii i def} if} {pop} ifelse} for ii -1 eq {()} {HeadersLeft ii 1 add get} ifelse /ii -1 def 0 2 HeadersCenter length 2 sub {/i exch def HeadersCenter i GetEU dup ThisPageOrdering le {ii -1 eq {pop //true} {HeadersCenter ii GetEU gt} ifelse {/ii i def} if} {pop} ifelse} for ii -1 eq {()} {HeadersCenter ii 1 add get} ifelse /ii -1 def 0 2 HeadersRight length 2 sub {/i exch def HeadersRight i GetEU dup ThisPageOrdering le {ii -1 eq {pop //true} {HeadersRight ii GetEU gt} ifelse {/ii i def} if} {pop} ifelse} for ii -1 eq {()} {HeadersRight ii 1 add get} ifelse /ii -1 def 0 2 FootersLeft length 2 sub {/i exch def FootersLeft i GetEU dup ThisPageOrdering le {ii -1 eq {pop //true} {FootersLeft ii GetEU gt} ifelse {/ii i def} if} {pop} ifelse} for ii -1 eq {()} {FootersLeft ii 1 add get} ifelse /ii -1 def 0 2 FootersCenter length 2 sub {/i exch def FootersCenter i GetEU dup ThisPageOrdering le {ii -1 eq {pop //true} {FootersCenter ii GetEU gt} ifelse {/ii i def} if} {pop} ifelse} for ii -1 eq {()} {FootersCenter ii 1 add get} ifelse /ii -1 def 0 2 FootersRight length 2 sub {/i exch def FootersRight i GetEU dup ThisPageOrdering le {ii -1 eq {pop //true} {FootersRight ii GetEU gt} ifelse {/ii i def} if} {pop} ifelse} for ii -1 eq {()} {FootersRight ii 1 add get} ifelse end //DeBugLevel 75 le {(-HeadersAndFooters) OutputToLog} if } bind def % /HeadersAndFooters % HeaderLeft HeaderCenter HeaderRight FooterLeft FooterCenter FooterRight PaintHeadersFooters - /PaintHeadersFooters { //DeBugLevel 75 le {(+PaintHeadersFooters) OutputToLog} if 10 dict begin /FooterRight exch def /FooterCenter exch def /FooterLeft exch def /HeaderRight exch def /HeaderCenter exch def /HeaderLeft exch def /ShowLeft //true def /ShowCentre //true def /ShowRight //true def TypeOfPagesBeingRendered /Glasses eq {PackingDescriptors SheetNum get type /arraytype eq} {//false} ifelse { PackingDescriptors SheetNum get % Usually of length 3 to 9, so not worth being complicatedly efficient. { execU dup dup /SuppressOrnamentsLeft eq {/ShowLeft //false def} if /SuppressOrnamentsCentre eq {/ShowCentre //false def} if /SuppressOrnamentsRight eq {/ShowRight //false def} if } forall % 'PackingDescriptor' } if % /Glasses, etc % Show Left then Centre then Right, so that copy-paste works naturally. /Y PageHeight TypeOfPagesBeingRendered /PlaceName eq {2 div} if HeaderBaselineFromPageTop sub def {HeaderFont HeaderFontSize selectfont 0 setgray} dup dup ShowLeft {exec MgnL Y moveto /HeaderLeft load ShowRecursive} {pop} ifelse ShowCentre { exec TypeOfPagesBeingRendered /Glasses eq {HeaderFooterCenterX} {PageWidth MgnL MgnR sub add 2 div} ifelse Y moveto /HeaderCenter load dup StringWidthRecursive 2 div neg 0 rmoveto ShowRecursive } {pop} ifelse % ShowCentre ShowRight {exec PageWidth MgnR sub Y moveto /HeaderRight load dup StringWidthRecursive neg 0 rmoveto ShowRecursive} {pop} ifelse /Y FooterTopFromPageBottom BaseHeight sub TypeOfPagesBeingRendered /PlaceName eq {PlaceNamesFirstAndThirdFoldsFromEdge FooterFontSize 2 mul add MgnB sub dup 0 gt {add} {pop} ifelse} if def {FooterFont FooterFontSize selectfont 0 setgray} dup dup ShowLeft {exec MgnL Y moveto /FooterLeft load ShowRecursive} {pop} ifelse ShowCentre { exec TypeOfPagesBeingRendered /Glasses eq {HeaderFooterCenterX} {PageWidth MgnL MgnR sub add 2 div} ifelse Y moveto /FooterCenter load dup StringWidthRecursive 2 div neg 0 rmoveto ShowRecursive } {pop} ifelse % ShowCentre ShowRight {exec PageWidth MgnR sub Y moveto /FooterRight load dup StringWidthRecursive neg 0 rmoveto ShowRecursive} {pop} ifelse end //DeBugLevel 75 le {(-PaintHeadersFooters) OutputToLog} if } bind def % /PaintHeadersFooters //DeBugLevel 100 le {( Main: TastingNoteForms) OutputToLog} if /TypeOfPagesBeingRendered /TastingNotes store /RightBoundaryNameTastingNotes GlassesOnTastingNotePages length array def % values will be put into this /TastingNoteForms [ GlassesOnTastingNotePages length {6 dict} repeat ] def /TastingNotesStarTops GlassesOnTastingNotePages length array def 0 1 GlassesOnTastingNotePages length 1 sub { /TNSheetNum exch def //false //false //false //false SideBySideGlassesTastingNotes { << /SheetNum TNSheetNum >> begin PaperType Orientation end} {TastingNotesPaperType TastingNotesOrientation} ifelse SetPaperSize //true DefStoreMgns TastingNoteForms TNSheetNum get begin /TNSheetNum TNSheetNum def /FormType 1 def /BBox [ 0 0 PageWidth PageHeight ] def /Matrix matrix identmatrix def /PaintProc { //DeBugLevel 100 le {(+TastingNoteForms: PaintProc) OutputToLog} if pop 33 dict begin /TypeOfPagesBeingRendered /TastingNotes store /TastingNotesPageCircletextFontSize 4 def % embedded constant /N GlassesOnTastingNotePages TNSheetNum GetEU length def /TNColumnMultiplier 0 TastingNotesColumnRelativeWidths {execU add} forall dup 0 eq {pop 1} {PageWidth MgnL MgnR add sub exch div} ifelse def TastingNotesColumnHeadings length 0 gt TastingNotes_NumVerticalSections 1 eq and { HeaderFont TastingNotesColumnHeadingsFontSize selectfont TastingNotesColumnHeadings StringPathBBox /TastingNotesColumnHeadingsT exch def pop /TastingNotesColumnHeadingsB exch def pop /TNtop PageHeight MgnT sub TastingNotesColumnHeadingsT sub TastingNotesColumnHeadingsB -0.48 2 copy gt {exch} if pop add def } {/TNtop PageHeight MgnT sub def} ifelse % TastingNotesColumnHeadings length 0 gt /TastingNotesCirclesBehind load MightBeTrue TastingNotes_NumVerticalSections 1 eq and { /H TNtop MgnB sub def /W PageWidth MgnL MgnR add sub def /TNCirclesBehindR N 2 ge { TastingNotesCirclesBehindFitAndCentreInRow {H N 2 mul div} { [ TastingNotesCirclesBehindTopX TastingNotesCirclesBehindBottomX sub dup mul dup 2 N sub N mul add 4 mul exch W mul dup H add -4 mul exch W mul H H mul add 3 1 roll exch ] 0 //true //Infinity //true //PrinterEpsilon PolynomialRoots Min } ifelse % TastingNotesCirclesBehindFitAndCentreInRow } {//Infinity} ifelse % N 2 ge W H lt {W} {H} ifelse 2 div 2 copy gt {exch} if pop def % /TNCirclesBehindR 0 1 N 1 sub { /WithinPage exch def /WithinTitles GlassesOnTastingNotePages TNSheetNum GetEU WithinPage GetEU def TastingNotesCirclesBehind { /t N 1 le {0.5} {WithinPage N 1 sub div} ifelse def /y TastingNotesCirclesBehindFitAndCentreInRow {N WithinPage sub 0.5 sub N div TNtop MgnB sub mul MgnB add} {1 t sub TNtop TNCirclesBehindR sub mul t MgnB TNCirclesBehindR add mul add} ifelse def % TastingNotesCirclesBehindFitAndCentreInRow, /y /x 1 t sub TastingNotesCirclesBehindTopX mul t TastingNotesCirclesBehindBottomX mul add PageWidth MgnR sub TNCirclesBehindR sub mul 1 t sub 1 TastingNotesCirclesBehindTopX sub mul t 1 TastingNotesCirclesBehindBottomX sub mul add MgnL TNCirclesBehindR add mul add def % /x /FoundOnGlassSheet //false def 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { /WithinPage exch def WithinTitles GlassesOnSheets SheetNum GetEU WithinPage GetEU eq {/FoundOnGlassSheet //true def exit} if } for % WithinPage, WithinTitles FoundOnGlassSheet {exit} if } for % SheetNum FoundOnGlassSheet { GSave % saving currenttransfer and currentmatrix /TypeOfPagesBeingRendered /Glasses store //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns [ currenttransfer /exec cvx 1 /exch cvx /sub cvx TitlesAnyGrey {TastingNotesCirclesBehindFadingFactorIfAnyGrey} {TastingNotesCirclesBehindFadingFactorIfAllBlack} ifelse /mul cvx 1 /exch cvx /sub cvx ] cvx bind settransfer x y translate TNCirclesBehindR Radii SheetNum get div dup scale RotationTitlesAboveBelowOverCirclearray dup 0 ne {rotate} {pop} ifelse OutlineTitles { OutlineForms SheetNum get WithinPage get execform } if % OutlineTitles ... CircleNonEmpty SheetNum get WithinPage get { Spirals {SpiralForms SheetNum get WithinPage get execform} if CrossHatchingInside {CrossHatchingInsideForms SheetNum get WithinPage get execform} if } if % CircleNonEmpty ... /PaintBackgroundInsideGlassCircles load dup length 0 gt {/TypeOfPagesBeingRendered /TastingNotes store GSave newpath 0 0 Radii SheetNum get 0 360 /m ArcAccurate closepath clip newpath execU GRestore /TypeOfPagesBeingRendered /Glasses store} {pop} ifelse % PaintBackgroundInsideGlassCircles ... length 0 gt TitleAboveBelowOverForms SheetNum get WithinPage get execform AnnotateGlass CirclearrayForms SheetNum get WithinPage get execform /TypeOfPagesBeingRendered /TastingNotes store //false //false //false //false TastingNotesPaperType TastingNotesOrientation SetPaperSize //true DefStoreMgns GRestore } if % FoundOnGlassSheet } if % TastingNotesCirclesBehind } for % WithinPage, WithinTitles currentdict /SheetNum undef currentdict /WithinPage undef currentdict /WithinTitles undef } if % ... TastingNotesCirclesBehind ... TastingNotes_NumVerticalSections 1 eq and 0 1 TastingNotesColumnHeadings length 2 sub TastingNotes_NumVerticalSections 1 ne {pop -1} if { 0 exch -1 0 {TastingNotesColumnRelativeWidths exch GetEU add} for TNColumnMultiplier mul MgnL add dup PageHeight MgnT sub moveto MgnB lineto TastingNotesColumnStrokeCode newpath } for % 0 1 TastingNotesColumnHeadings length 2 sub TastingNotesColumnHeadings length 0 gt TastingNotes_NumVerticalSections 1 eq and { 0 setgray 0.24 setlinewidth 1 setlinecap 1 setlinejoin [] 0 setdash HeaderFont TastingNotesColumnHeadingsFontSize selectfont RightBoundaryNameTastingNotes TNSheetNum PageWidth MgnR sub put TastingNotesColumnHeadings length 1 sub -1 0 % goes down to allow population of RightBoundaryNameTastingNotes { /i exch def TastingNotesColumnHeadings i get NonEmptyCompoundObject { GSave /ColStart 0 0 1 i 1 sub {TastingNotesColumnRelativeWidths exch GetEU add} for TNColumnMultiplier mul MgnL add def ColStart PageHeight MgnT sub TastingNotesColumnHeadingsT sub moveto TastingNotesColumnHeadings i get StringWidthRecursive dup TastingNotesColumnRelativeWidths i GetEU TNColumnMultiplier mul gt { TastingNotesColumnRelativeWidths i GetEU 0 gt { TastingNotesColumnRelativeWidths i GetEU TNColumnMultiplier mul exch div 1 scale RightBoundaryNameTastingNotes TNSheetNum ColStart put } {pop} ifelse % TastingNotesColumnRelativeWidths i GetEU 0 gt }{ neg TastingNotesColumnRelativeWidths i GetEU TNColumnMultiplier mul add 2 div 0 rmoveto RightBoundaryNameTastingNotes TNSheetNum currentpoint pop put } ifelse % text wider than column CurrentFontSize 60 div setlinewidth TastingNotesColumnRelativeWidths i GetEU 0 gt {TastingNotesColumnHeadings i get ShowRecursive} if GRestore } if % TastingNotesColumnHeadings i get NonEmptyCompoundObject } for % TastingNotesColumnHeadings length 1 sub -1 0 } if % TastingNotesColumnHeadings length 0 gt TastingNotes_NumVerticalSections 1 eq and /TN_NumPerCol N TastingNotes_NumVerticalSections dup 1 gt {div ceiling cvi} {pop} ifelse def /TNRowHeight N 0 eq {0} {TNtop MgnB sub TN_NumPerCol div} ifelse def 0 1 N 1 sub { /WithinPage exch def /WithinTitles GlassesOnTastingNotePages TNSheetNum GetEU WithinPage GetEU def /CurrentTop TN_NumPerCol dup WithinPage exch mod sub TNRowHeight mul MgnB add def /TastingNotes_FoldSectionsGap 18 def % Embedded constant, perhaps promotable to being a parameter. /ThisW PageWidth MgnL MgnR add sub TastingNotes_NumVerticalSections 2 ge {TastingNotes_NumVerticalSections 1 sub TastingNotes_FoldSectionsGap mul sub TastingNotes_NumVerticalSections div} if def /ThisL TastingNotes_NumVerticalSections 2 lt {MgnL} {WithinPage TN_NumPerCol div //Epsilon add floor cvi ThisW TastingNotes_FoldSectionsGap add mul MgnL add} ifelse def ThisL CurrentTop moveto CirclearraysTastingNotes WithinTitles get {0 setgray CircletextFont TastingNotesPageCircletextFontSize selectfont} CircletextsMinNumSpacesBetween //true ThisW //false -1 CirclearrayInStraightLine sub CurrentTop add TastingNotesLineGap sub /CurrentTop exch def pop pop TastingNotesStarTops TNSheetNum 2 copy get //null eq {GlassesOnTastingNotePages TNSheetNum GetEU length array put} {pop pop} ifelse TastingNotesStarTops TNSheetNum get WithinPage 2 copy get IsNumber {pop pop} {CurrentTop put} ifelse 0 setgray 0.24 setlinewidth TNRowHeight 2 div TastingNotesSubtitleFontSizeProportionTitles 1 add div TastingNotesTitlesFontSizeMax 2 copy gt {exch} if pop dup TitlesFont exch 2 copy % embedded constant in "2 div" selectfont TitlesTastingNotes WithinTitles get StringPathBBox /urY exch def pop /llY exch def pop selectfont ThisL CurrentTop urY sub moveto TitlesTastingNotes WithinTitles get ShowRecursive /CurrentTop CurrentTop TastingNotesLineGap urY llY sub add sub def 0 setgray 0.24 setlinewidth TastingNotesSubtitleFontSizeProportionTitles mul SubtitlesFont exch 2 copy selectfont SubtitlesTastingNotes WithinTitles get StringPathBBox /urY exch def pop pop pop selectfont ThisL CurrentTop urY sub moveto SubtitlesTastingNotes WithinTitles get ShowRecursive } for % WithinPage, WithinTitles end //DeBugLevel 100 le {(-TastingNoteForms: PaintProc) OutputToLog} if } def % /PaintProc end } bind for % TNSheetNum UndefMgns currentdict /TNSheetNum undef % GlassesPageInnerLoop and TastingNotesInnerLoop are really 'inline code'. % They exist to allow later determination the ordering of the % outer loops, without repeating any of this code. Messy, but functional. //DeBugLevel 100 le {( Main: Defining inner loops) OutputToLog} if /GlassesPageInnerLoop { //DeBugLevel 100 le {(+GlassesPageInnerLoop) OutputToLog} if 13 dict begin /TypeOfPagesBeingRendered /Glasses store 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def GlassesPageWhiteCirclesBehind CircleNonEmpty SheetNum get WithinPage get and {newpath GlassPositions SheetNum get WithinPage get aload pop Radii SheetNum get 0 360 /m ArcAccurate 1 setgray fill} if } for % WithinPage, WithinTitles 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def % Discussion: http://www.theportforum.com/viewtopic.php?t=175&p=94014#p94014 GlassesCirclesFadingFactor dup //Epsilon ge CirclearraysFillBehind and { newpath GSave dup 1 //Epsilon sub lt {[currenttransfer /exec cvx 1 /exch cvx /sub cvx 7 -1 roll /mul cvx 1 /exch cvx /sub cvx] cvx bind settransfer} {pop} ifelse GlassPositions SheetNum get WithinPage get aload pop 2 copy Radii SheetNum get 0 360 /m ArcAccurate closepath RadiiCirclearrayInside SheetNum get 360 0 /m ArcAccurateN closepath /CirclearraysFillBehindCode load execU GRestore } {pop} ifelse % GlassesCirclesFadingFactor dup //Epsilon ge CirclearraysFillBehind and } for % WithinPage, WithinTitles BackgroundTextsGlasses { //DeBugLevel 75 le {( GlassesPageInnerLoop: BackgroundTexts) OutputToLog} if BackgroundTextsGlassesForms SheetNum get execform } if % BackgroundTextsGlasses Droplets { //DeBugLevel 75 le {( GlassesPageInnerLoop: Droplets) OutputToLog} if DropletsReversedHighlight {DropletsReversedForms SheetNum get execform} if % Only pn Glasses, so that DropletsReversedHighlight can be a NameNum test. DropletsForms SheetNum get execform } if % Droplets % CrossHatchingOutside /CrossHatchingOutside load MightBeTrue { //DeBugLevel 75 le {( GlassesPageInnerLoop: CrossHatchingOutside) OutputToLog} if CrossHatchingOutsideForms SheetNum get execform } if % ... CrossHatchingOutside ... % FlightSeparationForms FlightSeparations { //DeBugLevel 75 le {( GlassesPageInnerLoop: FlightSeparations) OutputToLog} if FlightSeparationForms SheetNum get execform } if % FlightSeparations % WaterBoxes WaterBoxes dup /Glasses eq exch /Both eq or WaterBoxesNum 1 ge and { //DeBugLevel 75 le {( GlassesPageInnerLoop: WaterBoxes) OutputToLog} if % NameHorizontalLeft NameHorizontalRight ShowRight ShowLeft FillWhite WaterBoxesPaintProc - NamesFontSizeIndividuallyB SheetNum get NameNum get dup IsNumber NamesShowBottom SheetNum get and { NamesFont exch selectfont /ThisName load StringPathBBox pop /ThisNameR exch def pop /ThisNameL exch def NamePlacementBottomX SheetNum get ThisNameR ThisNameL sub 2 div 2 copy sub 3 1 roll add } {pop //Infinity //InfinityNeg} ifelse % NamesShowBottom ... NamesIsLeftHander NameNum get not WaterBoxesOverrideShowEverySheet not {WaterBoxesShowRight SheetNum get execU and} if NamesIsLeftHander NameNum get WaterBoxesOverrideShowEverySheet not {WaterBoxesShowLeft SheetNum get execU and} if /PaintBackgroundCode load length 0 gt /Droplets load MightBeTrue or CrossHatchingOutside or /FlightSeparations load MightBeTrue {FlightSeparationLines SheetNum get length 0 gt or} if WaterBoxesPaintProc % Ignoring BackgroundTextsGlasses. } if % WaterBoxes dup /Glasses eq exch /Both eq or WaterBoxesNumSideTriangle 1 ge and % Outlined titles, and CrossHatchingInside after outlining as that spreads much white paint //DeBugLevel 75 le {( GlassesPageInnerLoop: OutlineTitles and CrossHatchingInside) OutputToLog} if 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def CircleNonEmpty SheetNum get WithinPage get { GlassesCirclesFadingFactor dup //Epsilon ge { GSave dup 1 //Epsilon sub lt {[currenttransfer /exec cvx 1 /exch cvx /sub cvx 7 -1 roll /mul cvx 1 /exch cvx /sub cvx] cvx bind settransfer} {pop} ifelse GlassPositions SheetNum get WithinPage get aload pop translate RotationTitlesAboveBelowOverCirclearray dup 0 ne {rotate} {pop} ifelse CrossHatchingInside { CrossHatchingInsideForms SheetNum get WithinPage get execform } if % CrossHatchingInside OutlineTitles { OutlineForms SheetNum get WithinPage get execform } if % OutlineTitles Spirals {SpiralForms SheetNum get WithinPage get execform} if GRestore } {pop} ifelse % GlassesCirclesFadingFactor ... 0 gt } if % CircleNonEmpty ... } for % WithinPage, WithinTitles currentdict /WithinPage undef currentdict /WithinTitles undef ThePortForumIconPlacement PlaceThePortForumIcon % TitleAboveBelowOverForms //DeBugLevel 75 le {( GlassesPageInnerLoop: TitleAboveBelowOverForms) OutputToLog} if /usertimeStartLocal usertime def 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def GlassesCirclesFadingFactor dup //Epsilon ge { matrix currentmatrix exch GlassPositions SheetNum get WithinPage get aload pop translate GSave dup 1 //Epsilon sub lt {[currenttransfer /exec cvx 1 /exch cvx /sub cvx 7 -1 roll /mul cvx 1 /exch cvx /sub cvx] cvx bind settransfer} {pop} ifelse RotationTitlesAboveBelowOverCirclearray dup 0 ne {rotate} {pop} ifelse /PaintBackgroundInsideGlassCircles load dup length 0 gt {GSave newpath 0 0 Radii SheetNum get 0 360 /m ArcAccurate closepath clip newpath execU GRestore} {pop} ifelse % PaintBackgroundInsideGlassCircles ... length 0 gt TitleAboveBelowOverForms SheetNum get WithinPage get execform AnnotateGlass GRestore % Discussion: http://www.theportforum.com/viewtopic.php?t=175&p=94014#p94014 GlassesCrossedOut { 2 dict begin /CrossedOutLineWidth Radii SheetNum get 15 div def /CrossedOutOffset Radii SheetNum get CrossedOutLineWidth 2 div sub //SqrtHalf mul def CrossedOutOffset neg dup moveto CrossedOutOffset dup lineto CrossedOutOffset neg dup neg moveto CrossedOutOffset dup neg lineto GSave 0.875 setgray CrossedOutLineWidth setlinewidth 1 setlinecap stroke GRestore 1 setgray CrossedOutLineWidth 3 div setlinewidth 1 setlinecap stroke end } if % GlassesCrossedOut setmatrix } {pop} ifelse % GlassesCirclesFadingFactor ...Epsilon gt } for % WithinPage, WithinTitles currentdict /WithinPage undef currentdict /WithinTitles undef usertime usertimeStartLocal sub 1000 gt { mark ( GlassesPageInnerLoop, TitleAboveBelowOverForms: NameNum=) NameNum (; SheetNum=) SheetNum (; execution time) usertime usertimeStart sub TimeIntervalString ConcatenateToMark OutputToLog } if % usertime usertimeStartLocal sub 1000 gt % Names SideBySideGlassesTastingNotes not { //DeBugLevel 75 le {( GlassesPageInnerLoop: Names) OutputToLog} if 4.8 setlinewidth 1 setlinejoin [] 0 setdash % Embedded constant 3 dict begin NamesFontSizeIndividuallyT SheetNum get NameNum get dup IsNumber NamesShowTop SheetNum get and { NamesFont exch selectfont /ThisName load StringPathBBox /ThisNameT exch def /ThisNameR exch def pop /ThisNameL exch def NamePlacementTopX SheetNum get ThisNameL ThisNameR add 2 div sub PageWidth MgnR ThisNameR add sub 2 copy gt {exch} if pop MgnL ThisNameL sub 2 copy lt {exch} if pop PageHeight MgnT ThisNameT add sub moveto /ThisName load //true CharPathRecursive 1 setgray GSave stroke GRestore 0 setgray fill } {pop} ifelse % NamesShowTop ... NamesFontSizeIndividuallyB SheetNum get NameNum get dup IsNumber NamesShowBottom SheetNum get and { NamesFont exch selectfont /ThisName load StringPathBBox pop /ThisNameR exch def /ThisNameB exch def /ThisNameL exch def NamePlacementBottomX SheetNum get ThisNameL ThisNameR add 2 div sub PageWidth MgnR ThisNameR add sub 2 copy gt {exch} if pop MgnL ThisNameL sub 2 copy lt {exch} if pop MgnB ThisNameB sub moveto /ThisName load //true CharPathRecursive 1 setgray GSave stroke GRestore 0 setgray fill } {pop} ifelse % NamesShowBottom ... end } if % SideBySideGlassesTastingNotes not ShowHeadersAndFooters { //DeBugLevel 75 le {( GlassesPageInnerLoop: headers and footers) OutputToLog} if << /SideBySideGlassesTastingNotes //false >> begin //false DefStoreMgns dup matrix currentmatrix exch setmatrix HeadersAndFooters PaintHeadersFooters setmatrix end //false DefStoreMgns } if % ShowHeadersAndFooters % Circletext over everything //DeBugLevel 75 le {( GlassesPageInnerLoop: CirclearrayForms) OutputToLog} if 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def GlassesCirclesFadingFactor dup //Epsilon ge { GSave GlassPositions SheetNum get WithinPage get aload pop translate dup 1 //Epsilon sub lt {[currenttransfer /exec cvx 1 /exch cvx /sub cvx 7 -1 roll /mul cvx 1 /exch cvx /sub cvx] cvx bind settransfer} {pop} ifelse RotationTitlesAboveBelowOverCirclearray dup 0 ne {rotate} {pop} ifelse CirclearrayForms SheetNum get WithinPage get execform GRestore } {pop} ifelse % GlassesCirclesFadingFactor ...Epsilon gt } for % WithinPage, WithinTitles currentdict /WithinPage undef currentdict /WithinTitles undef end //DeBugLevel 100 le {(-GlassesPageInnerLoop) OutputToLog} if } bind def % /GlassesPageInnerLoop /TastingNotesInnerLoop { //DeBugLevel 100 le {(+TastingNotesInnerLoop) OutputToLog} if 20 dict begin /usertimeStartLocal usertime def TastingNotesReplaceNameWithPageNum {/ThisName TastingNotesPageNumCompoundString def} if BackgroundTextsTastingNotes /SideBySideGlassesTastingNotes load MightBeTrue not and {BackgroundTextsTNsForms TNSheetNum get execform} if SideBySideGlassesTastingNotes not {ThePortForumIconTastingNotePlacement PlaceThePortForumIcon} if ShowHeadersAndFooters { //DeBugLevel 75 le {( TastingNotesInnerLoop: headers and footers) OutputToLog} if << /SideBySideGlassesTastingNotes //false >> begin dup matrix currentmatrix exch setmatrix //false DefStoreMgns HeadersAndFooters PaintHeadersFooters setmatrix end //false DefStoreMgns } if % ShowHeadersAndFooters /ThisNameASCII /ThisName load ASCIIfy def //DeBugLevel 75 le {( TastingNotesInnerLoop: TastingNoteForms) OutputToLog} if TastingNoteForms TNSheetNum get execform currentdict /WithinPage undef currentdict /WithinTitles undef 12 dict begin 0 1 GlassesOnTastingNotePages TNSheetNum GetEU length 1 sub { /WithinPage exch def /WithinTitles GlassesOnTastingNotePages TNSheetNum GetEU WithinPage GetEU def 0 4 TastingNotesStarsNameColsRowsArrangement length 4 sub { /i exch def % Discussion: http://www.theportforum.com/viewtopic.php?t=175&p=69275#p69275 ThisNameASCII TastingNotesStarsNameColsRowsArrangement i get ASCIIfy eq { /TNcols TastingNotesStarsNameColsRowsArrangement i 1 add GetEU def /TNrows TastingNotesStarsNameColsRowsArrangement i 2 add GetEU def /TNtype TastingNotesStarsNameColsRowsArrangement i 3 add GetEU def % 1.577193 = 5 5 sqrt sub 10 div sqrt 3 mul; 1.459220 = 39 5 sqrt 7 mul sub 16 div; 1.979367 = 5 sqrt dup 5 add 2 mul sqrt 8 mul add 1 sub 16 div 1 { TNtype /Alternating eq {/xStepFactor 1.577193 def /yStepFactor 1.459220 def /Angle {ColNum TNcols add 1 add 2 mod 36 mul} bind def exit} if TNtype /Sideways eq {/xStepFactor 1.459220 def /yStepFactor 1.577193 def /Angle {RowNum 2 mod 0 eq {18} {-18} ifelse } bind def exit} if TNtype /Upright eq {/xStepFactor 1.979367 def /yStepFactor 1.459220 def /Angle 0 def exit} if mark (Error: unknown star arrangement in item ) i (+3 = ) i 3 add ( of TastingNotesStarsNameColsRowsArrangement: neither /Alternating nor /Sideways nor /Upright.) ConcatenateToMark OutputToLog stop } repeat % 1 /StarRadius mark 10 TitlesFont TastingNotesTitlesFontSizeMax selectfont (DFGKNOSTVW) StringHeight 1 //Sqrt5 5 div sub mul % Embedded constant string TastingNotesStarTops TNSheetNum get dup length 1 sub get MgnB sub TNrows dup 0 le {pop} {1 sub yStepFactor mul 2 add div} ifelse 2 div % Approx, because stars packed tighter than circles. Final "2 div" to take not more than half space. PageWidth MgnL MgnR add sub 0.25 mul TNcols dup 0 eq {pop} {1 sub xStepFactor mul 2 add div} ifelse % Approx, because stars packed tighter than circles MinToMark def % /StarRadius 0 1 TNcols 1 sub { /ColNum exch def 0 1 TNrows 1 sub { /RowNum exch def PageWidth MgnR ColNum StarRadius xStepFactor mul mul add sub TastingNotesStarTops TNSheetNum get WithinPage get RowNum StarRadius yStepFactor mul mul sub moveto /Right /Top StarRadius /Radius Angle 5 2 //false //false Star 0 setgray fill begin CenterX CenterY moveto /Center /Middle Radius 0.75 mul /Radius Angle 5 2 //false //true end Star pop 1 setgray fill } for % /RowNum } for % /ColNum exit } if % Names ... eq } for % i } for % WithinPage, WithinTitles end % Discussion: http://www.theportforum.com/viewtopic.php?t=175&start=929 WaterBoxes dup /TastingNotes eq exch /Both eq or WaterBoxesNum 0 gt and WaterBoxesShowTN TNSheetNum get WaterBoxesOverrideShowEverySheet or and { //DeBugLevel 75 le {( TastingNotesInnerLoop: Water) OutputToLog} if /WaterBoxesSizeTN IconSizeTN WaterBoxesSizeMax 2 copy gt {exch} if pop def NamesIsLeftHanderTN NameNum get ThePortForumIconTastingNotePlacement /LowerNonName eq {WaterBoxesSizeTN WaterBoxesGapProportionSize mul IconSizeTN add exch {WaterBoxesSizeTN add MgnR add PageWidth exch sub} {MgnL add} ifelse} { {PageWidth MgnR WaterBoxesSizeTN add sub} {MgnL} ifelse} ifelse /X exch def % two booleans 0 1 WaterBoxesNum 1 sub { WaterBoxesSizeTN WaterBoxesGapProportionSize 1 add mul mul NamesIsLeftHanderTN NameNum get {X exch sub} {X add} ifelse MgnB WaterBoxesSizeTN add moveto WaterBoxesSizeTN dup dup neg 0 exch rlineto 0 rlineto 0 exch rlineto 0.24 setlinewidth 0 setgray 0 setlinecap 1 setlinejoin [] 0 setdash WaterBoxesFormatStroke newpath } for } if % WaterBoxes dup /TastingNotes ... WaterBoxesNum ... WaterBoxesShowTN ... WaterBoxesOverrideShowEverySheet ... //DeBugLevel 75 le {( TastingNotesInnerLoop: Names) OutputToLog} if 0 setgray NamesFont NamesFontSize TastingNotesReplaceNameWithPageNum {TastingNotesPageNumFontSizeFactor mul} if selectfont /ThisName load StringPathBBox pop /ThisNameR exch def /ThisNameB exch def /ThisNameL exch def NamesIsLeftHanderTN NameNum get {MgnL ThisNameL sub} {PageWidth MgnR sub ThisNameR sub} ifelse MgnB ThisNameB sub moveto /ThisName load ShowRecursive usertime usertimeStartLocal sub 1000 gt { mark ( TastingNotesInnerLoop, TastingNoteForms: NameNum= ) NameNum (; name=") ThisNameASCII ("; TNSheetNum=) TNSheetNum (; execution time) usertime usertimeStart sub TimeIntervalString ConcatenateToMark OutputToLog } if % usertime usertimeStartLocal sub 1000 gt end //DeBugLevel 100 le {(-TastingNotesInnerLoop) OutputToLog} if } bind def % /TastingNotesInnerLoop % Paint the pages 0 setgray 1 setlinecap 1 setlinejoin [] 0 setdash PrologueCode 0 setgray 1 setlinecap 1 setlinejoin [] 0 setdash /PlaceNamesRandomSeeds [ NamesPlaceNames { [ exch length {//null} repeat ] } forall ] def /PlaceNamesInnerLoop { //DeBugLevel 100 le {(+PlaceNamesInnerLoop) OutputToLog} if 9 dict begin PlaceNamesFirstAndThirdFoldsFromEdge 0 ne { //DeBugLevel 75 le {( PlaceNamesInnerLoop: PlaceNamesFirstAndThirdFoldsFromEdge) OutputToLog} if newpath 0 1 1 { 2 mod 0 eq {PlaceNamesFirstAndThirdFoldsFromEdge} {PageHeight PlaceNamesFirstAndThirdFoldsFromEdge sub} ifelse MgnL exch moveto PageWidth MgnL MgnR add sub 0 rlineto 0.5 setgray 0.48 setlinewidth [2.4 dup 12 mul] 0 setdash 0 setlinecap 0 setlinejoin stroke % embedded constants } for % SideFacingNamedPerson PlaceNamesFirstAndThirdFoldsFromEdge MgnB sub 5 gt { GSave 0 setgray FooterFont PlaceNamesFirstAndThirdFoldsFromEdge MgnB sub dup 12 gt {pop 12} if 0.6 mul selectfont % embedded constant MgnL MgnB CurrentFontSize 0.15 mul add moveto % descenders away from MgnB (Fold sheet in half, then along dashed lines. Press hard on folds.) HeadersAndFooters [ 4 1 roll ] NonEmptyCompoundObject [ 5 2 roll ] NonEmptyCompoundObject { {( Side with header or footer to face named person; side without to face away.) Concatenate} {( Side with header to face named person; side without to face away.) Concatenate} ifelse } { {( Side with footer to face named person; side without to face away.) Concatenate} if } ifelse dup StringWidthRecursive PageWidth MgnL MgnR add sub 2 div exch div dup 1 lt {GSave 1 scale ShowRecursive GRestore} {pop ShowRecursive} ifelse % Folding string too long WaterBoxes dup /Glasses eq exch /Both eq or {NamesIsLeftHanderPN PlaceNameSetNum get NameNum get} {//false} ifelse { [( ) /bullet dup dup ( Believed left-handed. To prevent elbow-clash lefties should be stacked from the clockwise end of a table edge. ) 1 index dup dup] dup StringWidthRecursive dup PageWidth MgnL MgnR add sub 2 div exch div dup 1 lt { GSave PageWidth MgnL MgnR sub add 2 div MgnB CurrentFontSize 0.15 mul add moveto 1 scale pop ShowRecursive GRestore }{ PageWidth MgnR sub MgnB CurrentFontSize 0.15 mul add moveto pop neg 0 rmoveto ShowRecursive } ifelse % Leftie string too long } if % WaterBoxes and left-handed GRestore } if % room above MgnB but below line } if % PlaceNamesFirstAndThirdFoldsFromEdge 0 ne ShowHeadersAndFooters { //DeBugLevel 75 le {( PlaceNamesInnerLoop: headers and footers) OutputToLog} if HeadersAndFooters PlaceNamesShowNameAsFooter PlaceNameSetNum GetEU NameNum Names length lt and {exch pop Names NameNum get exch} if PaintHeadersFooters } if % ShowHeadersAndFooters //DeBugLevel 75 le {( PlaceNamesInnerLoop: call PaintPlaceName) OutputToLog} if PlaceNamesRandomSeeds PlaceNameSetNum get NameNum 2 copy get type /integertype ne { RandomisationSeed PlaceNameSetNum 61 mul add NameNum 1 add 4093 mul add put % Two primes } {pop pop} ifelse % ... /integertype ne 0 1 1 { /SideFacingNamedPerson exch 2 mod 0 eq def SideFacingNamedPerson not { matrix currentmatrix [-1 0 0 -1 PageWidth PageHeight] concat << /MgnL MgnR /MgnR MgnL /MgnB MgnT /MgnT MgnB >> begin } if % SideFacingNamedPerson not /PlaceNamesFontSize /Null def PlaceNamesRandomSeeds PlaceNameSetNum get NameNum get srand PaintPlaceName PlaceNamesFontSizes PlaceNameSetNum get NameNum PlaceNamesFontSize put PlaceNamesShowNameAsFooter PlaceNameSetNum GetEU SideFacingNamedPerson not NameNum Names length lt and and {5 {()} repeat Names NameNum get exch PaintHeadersFooters} if SideFacingNamedPerson not {end setmatrix} if } for % SideFacingNamedPerson end //DeBugLevel 100 le {(-PlaceNamesInnerLoop) OutputToLog} if } bind def % /PlaceNamesInnerLoop /PrePourInnerLoop { //DeBugLevel 100 le {(+PrePourInnerLoop) OutputToLog} if /usertimeStartLocal usertime def CircleNonEmpty SheetNum get WithinPage get {PrePourForms SheetNum get WithinPage get execform} if ShowHeadersAndFooters { //DeBugLevel 75 le {( PrePourInnerLoop: headers and footers) OutputToLog} if HeadersAndFooters PaintHeadersFooters } if % ShowHeadersAndFooters usertime usertimeStartLocal sub 1000 gt { mark ( PrePourInnerLoop, PrePourForms: SheetNum=) SheetNum (; WithinPage=) WithinPage (; WithinTitles=) WithinTitles (; title~=") Titles WithinTitles get ASCIIfy ("; execution time) usertime usertimeStart sub TimeIntervalString ConcatenateToMark OutputToLog } if % usertime usertimeStartLocal sub 1000 gt //DeBugLevel 100 le {(-PrePourInnerLoop) OutputToLog} if } bind def % /PrePourInnerLoop /BottleWrapInnerLoop { //DeBugLevel 100 le {(+BottleWrapInnerLoop) OutputToLog} if CircleNonEmpty SheetNum get WithinPage get {BottleWrapForms SheetNum get WithinPage get execform} if ShowHeadersAndFooters { //DeBugLevel 75 le {( BottleWrapInnerLoop: headers and footers) OutputToLog} if HeadersAndFooters PaintHeadersFooters } if % ShowHeadersAndFooters //DeBugLevel 100 le {(-BottleWrapInnerLoop) OutputToLog} if } bind def % /BottleWrapInnerLoop () OutputToLog % Render the pages, starting with the possible (only) empty page EmptyGlassesPageAtStart % /Empty { /TypeOfPagesBeingRendered /Glasses store 10 dict begin << /SheetNum 0 /TNSheetNum 0 /WithinPage 0 /WithinTitles 0 >> begin HeaderFont dup dup TastingNotesPaperType end EmptyGlassesPageOrientation //false //false //false //true 6 4 roll SetPaperSize //true DefStoreMgns /PageLesser PageWidth MgnL MgnR add sub PageHeight MgnB MgnT add sub 2 copy gt {exch} if pop def PageHeight MgnT MgnB sub add 2 div PageWidth MgnR MgnL sub add 2 div 2 copy 4 copy PageLesser 6 div add exch PageLesser 6 div sub moveto PageLesser 6 div sub exch PageLesser 6 div add lineto PageLesser 6 div sub exch PageLesser 6 div sub moveto PageLesser 6 div add exch PageLesser 6 div add lineto 0.75 setgray PageLesser 40 div setlinewidth [] 0 setdash 1 setlinecap stroke 0 setgray % Embedded constant //DeSizeRounding selectfont EmptyPageString StringPathBBox //DeSizeRounding div [/ury /urx /lly /llx ] {exch //DeSizeRounding div def} forall urx llx sub //PrinterEpsilon gt ury lly sub //PrinterEpsilon gt and { /FontSize 32 PageWidth MgnL MgnR add sub urx llx sub div PageHeight MgnT MgnB add sub 6 div ury lly sub div 2 {2 copy gt {exch} if pop} repeat def % Embedded constants PageWidth urx llx add FontSize mul sub 2 div PageHeight MgnT sub ury FontSize mul sub moveto FontSize selectfont EmptyPageString ShowRecursive PageWidth urx llx add FontSize mul sub 2 div MgnB lly FontSize mul sub moveto FontSize selectfont EmptyPageString ShowRecursive } {pop pop} ifelse % EmptyPageString non-empty /TypeOfPagesBeingRendered /Empty store ShowPage end } if % EmptyGlassesPageAtStart AnyFillTextingAtAll //DeBugLevel 100 le or {mark ( Main: starting outermost page-rendering loop: execution time ) usertime usertimeStart sub TimeIntervalString ConcatenateToMark OutputToLog} if /ShowHeadersAndFooters //true def UsedPageOrderings { /ThisPageOrdering exch def % Doesn't use a PageType, so outside UsedPaperTypes loop. {OneCircles} MightBeTrue PageOrderingOneCircle ThisPageOrdering eq and { /TypeOfPagesBeingRendered /OneCircle store 15 dict begin /MgnL 0 def /MgnR 0 def /MgnB 0 def /MgnT 0 def 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def OneCircles //false PageSuppressed not and CircleNonEmpty SheetNum get WithinPage get and { //false //false MirrorPagesOneCircle //true [Radii SheetNum get 2 mul dup] /Portrait SetPaperSize % MirrorPagesOneCircle could vary by WithinTitles. //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns % Defs PageHeight etc. matrix currentmatrix Radii SheetNum get dup translate newpath /MatrixGlasses matrix currentmatrix def ClipSave 0 0 Radii SheetNum get 0 360 /m ArcAccurate clip 1 setgray fill PrePourShowBackgroundTexts Droplets {PrePourShowDroplets or} if { /TypeOfPagesBeingRendered /Glasses store GlassPositions SheetNum get WithinPage get {neg} forall translate /MatrixGlassesPage matrix currentmatrix def BackgroundTextsGlasses PrePourShowBackgroundTexts and {BackgroundTextsGlassesForms SheetNum get execform} if Droplets PrePourShowDroplets and { SheetNum % passed to DropletsPaint MatrixGlasses setmatrix Radii SheetNum get dup dup dup neg dup dup dup 4 index moveto lineto lineto lineto MatrixGlassesPage setmatrix pathbbox WithinPage 0.0 DropletsPaint } if % Droplets PrePourShowDroplets and } if % PrePourShowBackgroundTexts ...PrePourShowDroplets or MatrixGlasses setmatrix /TypeOfPagesBeingRendered /Glasses store [ OutlineTitles {OutlineForms} if Spirals {SpiralForms} if CrossHatchingInside {CrossHatchingInsideForms} if ] {SheetNum get WithinPage get execform} forall /PaintBackgroundInsideGlassCircles load dup length 0 gt {execU} {pop} ifelse ClipRestore % from 20 lines above TitleAboveBelowOverForms SheetNum get WithinPage get execform AnnotateGlass CirclearrayForms SheetNum get WithinPage get execform /TypeOfPagesBeingRendered /OneCircle store mark /Rect [ PageWidth -2 div PageHeight 2 div 2 copy ] /Subtype /Text /Contents mark (One circle, intended for the generation of bitmap images, perhaps a GIF animation of all the circles.\r\n\r\n) () [ Titles Belowtitles Abovetitles Overtitles FillTitles {FillTexts} if ] {WithinTitles get PDFDocEncodingify TrimSpaces dup length 0 gt {(; )} {pop} ifelse} forall () Circlearrays WithinTitles get {PDFDocEncodingify TrimSpaces dup length 0 gt {CircletextsMinNumSpacesBetween ceiling cvi dup 2 lt {pop 2} if {( )} repeat} {pop} ifelse} forall pop HeadersAndFooters 6 3 roll 3 copy [ 4 1 roll ] NonEmptyCompoundObject {[(\r\n\r\nHeader: ) 5 2 roll ( ) 3 1 roll 2 index exch] PDFDocEncodingify 4 1 roll} {pop pop pop} ifelse 3 copy [ 4 1 roll ] NonEmptyCompoundObject {[(\r\n\r\nFooter: ) 5 2 roll ( ) 3 1 roll 2 index exch] PDFDocEncodingify } {pop pop pop} ifelse ConcatenateToMark /Open //false /Title [ (One circle: ) Titles WithinTitles get ] PDFDocEncodingify /ModDate ParametersVersionDateTimeAdobeFormat /F 64 128 add % ReadOnly + Locked. PDFReference16.pdf page 574 /ANN pdfmark setmatrix ShowPage } if % OneCircles ... PageSuppressed not ... CircleNonEmpty ... } for % WithinPage, WithinTitles } bind for % SheetNum end /TypeOfPagesBeingRendered /Multiple store } if % OneCircles UsedPaperTypes % Simplifies printing if pages with same paper type are gathered together { /ThisPaperType exch def 0 1 Names length 1 sub { /NameNum exch def SideBySideGlassesTastingNotes { % SideBySideGlassesTastingNotes is true /ThisName Names NameNum get def 0 1 NumSheets GlassesOnTastingNotePages length 2 copy lt {exch} if pop 1 sub { /SheetNum exch def NameNum Names length lt { /TNSheetNum SheetNum def NameNum Names length lt {PageOrderingGlasses} {PageOrderingDecanterLabels} ifelse SheetNum GetEU ThisPageOrdering eq ThisPaperType PaperType ne {PaperType type /arraytype eq ThisPaperType type /arraytype eq and {0 1 1 {dup PaperType exch GetEU exch ThisPaperType exch GetEU sub abs //PrinterEpsilon lt} for and and} {pop //false} ifelse} if { 0 1 GlassesNumCopies 1 sub { //false PageSuppressed {pop exit} if /GlassesCopyNum exch def OuterGlassesCropMarks Rotate180AlternateNames {NameNum dup Names length ge {Names length sub} if 2 mod 1 eq} {//false} ifelse MirrorPagesGlasses SheetNum GetEU //true ThisPaperType Orientation SetPaperSize SheetNum NumSheets lt { /TypeOfPagesBeingRendered /Glasses store //true DefStoreMgns /ShowHeadersAndFooters //true store matrix currentmatrix NamesIsLeftHander NameNum get { 1 SideBySideGlassesTastingNotesProportionPageGlasses sub PageWidth mul SideBySideGlassesTastingNotesWidthGutter 2 div add MgnL sub 0 translate } if % NamesIsLeftHander ... //DeBugLevel 40 le {(+PaintBackgroundCode) OutputToLog} if GSave newpath /PaintBackgroundCode load execU GRestore //DeBugLevel 40 le {(-PaintBackgroundCode) OutputToLog} if GlassesPageInnerLoop //DeBugLevel 40 le {(+PaintForegroundCode) OutputToLog} if GSave newpath /PaintForegroundCode load execU GRestore //DeBugLevel 40 le {(-PaintForegroundCode) OutputToLog} if setmatrix } if % SheetNum NumSheets lt TNSheetNum GlassesOnTastingNotePages length lt { /TypeOfPagesBeingRendered /TastingNotes store //true DefStoreMgns /ShowHeadersAndFooters //false store matrix currentmatrix NamesIsLeftHander NameNum get { MarginL MgnL sub 0 translate } if % NamesIsLeftHander ... //DeBugLevel 40 le {(+PaintBackgroundCode) OutputToLog} if GSave newpath /PaintBackgroundCode load execU GRestore //DeBugLevel 40 le {(-PaintBackgroundCode) OutputToLog} if TastingNotesInnerLoop //DeBugLevel 40 le {(+PaintForegroundCode) OutputToLog} if GSave newpath /PaintForegroundCode load execU GRestore //DeBugLevel 40 le {(-PaintForegroundCode) OutputToLog} if setmatrix } if % TNSheetNum GlassesOnTastingNotePages length lt ... ShowPage currentdict /SheetNum undef currentdict /TNSheetNum undef } for % GlassesCopyNum /ShowHeadersAndFooters //true store } if % ThisPaperType ... eq } if % NameNum Names length lt } for % SheetNum, TNSheetNum }{ % SideBySideGlassesTastingNotes is false /TypeOfPagesBeingRendered /Glasses store 0 1 NumSheets 1 sub {GlassesNumCopies 1 ge} MightBeTrue not {pop -1} if { /SheetNum exch def NameNum Names length lt { /ThisName Names NameNum get def NameNum Names length lt {PageOrderingGlasses} {PageOrderingDecanterLabels} ifelse SheetNum GetEU ThisPageOrdering eq ThisPaperType PaperType ne {PaperType type /arraytype eq ThisPaperType type /arraytype eq and {0 1 1 {dup PaperType exch GetEU exch ThisPaperType exch GetEU sub abs //PrinterEpsilon lt} for and and} {pop //false} ifelse} if { 0 1 GlassesNumCopies 1 sub { //false PageSuppressed {pop exit} if /GlassesCopyNum exch def OuterGlassesCropMarks Rotate180AlternateNames {NameNum dup Names length ge {Names length sub} if 2 mod 1 eq} {//false} ifelse MirrorPagesGlasses SheetNum GetEU //true ThisPaperType Orientation SetPaperSize //true DefStoreMgns matrix currentmatrix //DeBugLevel 40 le {(+PaintBackgroundCode) OutputToLog} if GSave newpath /PaintBackgroundCode load execU GRestore //DeBugLevel 40 le {(-PaintBackgroundCode) OutputToLog} if GlassesPageInnerLoop //DeBugLevel 40 le {(+PaintForegroundCode) OutputToLog} if GSave newpath /PaintForegroundCode load execU GRestore //DeBugLevel 40 le {(-PaintForegroundCode) OutputToLog} if setmatrix ShowPage } for % GlassesCopyNum } if % ... ThisPageOrdering eq ... ThisPaperType eq and } if % NameNum Names length lt } for % SheetNum UndefMgns currentdict /SheetNum undef % Tasting note pages /TypeOfPagesBeingRendered /TastingNotes store 0 1 GlassesOnTastingNotePages length 1 sub {TastingNotePagesNumCopies 1 ge} MightBeTrue not {pop -1} if { /TNSheetNum exch def /TypeOfPagesBeingRendered /TastingNotes store TastingNotesPaperType ThisPaperType eq PageOrderingTastingNotePages TNSheetNum GetEU ThisPageOrdering eq and { NameNum NamesTastingNotes length lt { /ThisName NamesTastingNotes NameNum get def TastingNotePagesNumCopies { //false PageSuppressed {exit} if /TypeOfPagesBeingRendered /TastingNotes store //false % Crop marks Rotate180AlternateNames {NameNum dup Names length ge {Names length sub} if 2 mod 1 eq} {//false} ifelse MirrorPagesTastingNotePages TNSheetNum GetEU //true TastingNotesPaperType TastingNotesOrientation SetPaperSize //true DefStoreMgns matrix currentmatrix //DeBugLevel 40 le {(+PaintBackgroundCode) OutputToLog} if GSave newpath /PaintBackgroundCode load execU GRestore //DeBugLevel 40 le {(-PaintBackgroundCode) OutputToLog} if TastingNotesInnerLoop //DeBugLevel 40 le {(+PaintForegroundCode) OutputToLog} if GSave newpath /PaintForegroundCode load execU GRestore //DeBugLevel 40 le {(-PaintForegroundCode) OutputToLog} if setmatrix ShowPage } repeat % TastingNotePagesNumCopies ... } if % NameNum NamesTastingNotes length lt } if % ... ThisPaperType ... ThisPageOrdering ... and } for % TNSheetNum UndefMgns currentdict /TNSheetNum undef } ifelse % SideBySideGlassesTastingNotes /TypeOfPagesBeingRendered /PlaceName store 0 1 NamesPlaceNames length 1 sub {PlaceNames} MightBeTrue not {pop -1} if { //false PageSuppressed {pop exit} if /PlaceNameSetNum exch def NameNum NamesPlaceNames PlaceNameSetNum GetEU length lt { PlaceNamesPaperType ThisPaperType eq PageOrderingPlaceNames PlaceNameSetNum GetEU ThisPageOrdering eq and { /ThisName NamesPlaceNames PlaceNameSetNum GetEU NameNum get def /usertimeStartLocal usertime def matrix currentmatrix /TypeOfPagesBeingRendered /PlaceName store //false //false MirrorPagesPlaceNames PlaceNameSetNum GetEU //true PlaceNamesPaperType PlaceNamesOrientation SetPaperSize //true DefStoreMgns //DeBugLevel 40 le {(+PaintBackgroundCode) OutputToLog} if GSave newpath /PaintBackgroundCode load execU GRestore //DeBugLevel 40 le {(-PaintBackgroundCode) OutputToLog} if PlaceNamesInnerLoop //DeBugLevel 40 le {(+PaintForegroundCode) OutputToLog} if GSave newpath /PaintForegroundCode load execU GRestore //DeBugLevel 40 le {(-PaintForegroundCode) OutputToLog} if setmatrix ShowPage usertime usertimeStartLocal sub 1000 gt { mark ( Main: -PlaceName: NameNum=) NameNum (; PlaceNameSetNum=) PlaceNameSetNum (; execution time) usertime usertimeStart sub TimeIntervalString ConcatenateToMark OutputToLog } if % usertime usertimeStartLocal sub 1000 gt } if % ... ThisPaperType ... ThisPageOrdering ... and } if % NameNum NamesPlaceNames PlaceNameSetNum GetEU length lt } for % /PlaceNameSetNum /TypeOfPagesBeingRendered /Multiple store UndefMgns currentdict /PlaceNameSetNum undef } for % NameNum currentdict /ThisName undef currentdict /NameNum undef % See http://www.theportforum.com/viewtopic.php?t=175&start=166 /VoteRecorders load MightBeTrue { 17 dict begin //DeBugLevel 100 le {(+VoteRecorder) OutputToLog} if /TypeOfPagesBeingRendered /VoteRecorder store /ThisName (Vote recorder) def 0 1 GlassesClusteredOnVoteRecorders length 1 sub { /VoteRecorderSheetNum exch def /VoteRecorderThisSheet GlassesClusteredOnVoteRecorders VoteRecorderSheetNum GetEU def /VoteRecorderThisSheetLength 0 VoteRecorderThisSheet {execU length add} forall VoteRecorderShowTotalRow VoteRecorderSheetNum GetEU {1 add} if def VoteRecorderPaperType ThisPaperType eq PageOrderingVoteRecorder VoteRecorderSheetNum get ThisPageOrdering eq and { 0 1 VoteRecorderTopTexts VoteRecorderSheetNum get length 1 sub { //false PageSuppressed {pop exit} if /VoteRecorderTopTextNum exch def /VoteRecorderThisSheetLength 0 VoteRecorderThisSheet {execU length add} forall VoteRecorderShowTotalRow VoteRecorderSheetNum GetEU {1 add} if def /TypeOfPagesBeingRendered /VoteRecorder store //false //false MirrorPagesVoteRecorder VoteRecorderSheetNum GetEU //true VoteRecorderPaperType VoteRecorderOrientation SetPaperSize //true DefStoreMgns //DeBugLevel 40 le {(+PaintBackgroundCode) OutputToLog} if GSave newpath /PaintBackgroundCode load execU GRestore //DeBugLevel 40 le {(-PaintBackgroundCode) OutputToLog} if /VoteRecorderTopTextHeight PageHeight MgnB MgnT add sub 50 div def % Embedded constant. Discussion: http://www.theportforum.com/viewtopic.php?t=175&p=56967#p56967 VoteRecorderTopTextHeight 0 gt { HeaderFont VoteRecorderTopTextHeight selectfont VoteRecorderTopTexts VoteRecorderSheetNum get VoteRecorderTopTextNum get StringPathBBox /VoteRecorderTopTextT exch def pop /VoteRecorderTopTextB exch def pop HeaderFont VoteRecorderTopTextHeight dup mul VoteRecorderTopTextT VoteRecorderTopTextB sub dup 0 ne { div selectfont MgnL PageHeight MgnT sub VoteRecorderTopTextHeight VoteRecorderTopTextT VoteRecorderTopTextB sub div VoteRecorderTopTextT mul sub moveto 0 setgray VoteRecorderTopTexts VoteRecorderSheetNum get VoteRecorderTopTextNum get ShowRecursive } {pop pop pop} ifelse % Non-zero height } if % VoteRecorderTopTextHeight 0 gt VoteRecorderForms VoteRecorderSheetNum get execform //DeBugLevel 40 le {(+PaintForegroundCode) OutputToLog} if GSave newpath /PaintForegroundCode load execU GRestore //DeBugLevel 40 le {(-PaintForegroundCode) OutputToLog} if ShowPage } for % VoteRecorderTopTextNum } if % VoteRecorderPaperType ... PageOrderingVoteRecorder ... and } for % VoteRecorderSheetNum end //DeBugLevel 100 le {(-VoteRecorder) OutputToLog} if } if % ... VoteRecorders ... {DecantingNotesNumCopies 1 ge} MightBeTrue { //DeBugLevel 100 le {(+DecantingNotes) OutputToLog} if /TypeOfPagesBeingRendered /DecantingNotes store /ThisName (Decanter labels) def 0 1 GlassesClusteredOnDecantingNotes length 1 sub { /DecantingNotesSheetNum exch def 0 1 DecantingNotesNumCopies 1 sub { //false PageSuppressed {pop exit} if /DecantingNotesCopyNum exch def /DecantingNotesThisSheet GlassesClusteredOnDecantingNotes DecantingNotesSheetNum GetEU def DecantingNotesPaperType ThisPaperType eq PageOrderingDecantingNotes DecantingNotesSheetNum get ThisPageOrdering eq and { /DecantingNotesThisSheetLength 0 DecantingNotesThisSheet {execU length add} forall def /TypeOfPagesBeingRendered /DecantingNotes store //false //false MirrorPagesDecantingNotes DecantingNotesSheetNum GetEU //true DecantingNotesPaperType DecantingNotesOrientation SetPaperSize //true DefStoreMgns //DeBugLevel 40 le {(+PaintBackgroundCode) OutputToLog} if GSave newpath /PaintBackgroundCode load execU GRestore //DeBugLevel 40 le {(-PaintBackgroundCode) OutputToLog} if /DecantingNotesTopTextHeight PageHeight MgnB MgnT add sub 50 div def % embedded constant DecantingNotesForms DecantingNotesSheetNum get execform //DeBugLevel 40 le {(+PaintForegroundCode) OutputToLog} if GSave newpath /PaintForegroundCode load execU GRestore //DeBugLevel 40 le {(-PaintForegroundCode) OutputToLog} if ShowPage } if % DecantingNotesPaperType ... PageOrderingDecantingNotes ... and } for % DecantingNotesCopyNum } for % DecantingNotesSheetNum //DeBugLevel 100 le {(-DecantingNotes) OutputToLog} if } if % ... DecantingNotesNumCopies 1 ge ... % Discussion: http://www.theportforum.com/viewtopic.php?t=175&p=96950#p96950 AccountsNumCopies 1 ge { 35 dict begin /TypeOfPagesBeingRendered /Accounts store /ThisName (Accounts) def //false AccountsPaperType ThisPaperType eq {PageOrderingAccounts {execU ThisPageOrdering eq {pop //true exit} if} forall} if { AccountsNumCopies { //DeBugLevel 100 le {(+Accounts) OutputToLog} if //false //false MirrorPagesAccounts 0 1 PageOrderingAccounts length 1 sub {dup PageOrderingAccounts exch GetEU ThisPageOrdering eq {exit} {pop} ifelse} for GetEU //true AccountsPaperType AccountsOrientation SetPaperSize //true DefStoreMgns //DeBugLevel 40 le {(+PaintBackgroundCode) OutputToLog} if GSave newpath /PaintBackgroundCode load execU GRestore //DeBugLevel 40 le {(-PaintBackgroundCode) OutputToLog} if HeadersAndFooters PaintHeadersFooters /AccTopTextFontSize 16 def % embedded constant HeaderFont AccTopTextFontSize selectfont AccountsTopText StringPathBBox /AccTopTextT exch def /AccTopTextR exch def /AccTopTextB exch def /AccTopTextL exch def /AccTopTextHeight AccTopTextT AccTopTextB sub def AccTopTextHeight 0 gt {HeaderFont AccTopTextFontSize selectfont PageWidth MgnL MgnR sub AccTopTextL AccTopTextR add sub add 2 div PageHeight MgnT AccTopTextT add sub moveto 0 setgray AccountsTopText ShowRecursive} if /AccRowNames [ NamesAccounts aload pop AccountsExtraRows aload pop ] def /AccRowNamesFontSize NamesFontSize PageHeight MgnB MgnT add AccTopTextHeight add 1.92 add sub AccRowNames length dup 0 gt {div} {pop} ifelse 0.6 mul 2 copy gt {exch} if pop def % Embedded constant {/AccRowNameWidths [ AccRowNames {NamesFont AccRowNamesFontSize selectfont StringWidthRecursive} forall ] def /AccRowNameWidthsMax AccRowNameWidths Max def} dup exec AccRowNameWidthsMax PageWidth MgnL MgnR add sub 6 div 2 copy gt {exch div AccRowNamesFontSize mul /AccRowNamesFontSize exch def exec} {pop pop pop} ifelse % Embdedded constant /AccWideLineWidth 2.88 def /AccNarrowLineWidth 0.72 def /AccMiddleLineWidth AccWideLineWidth AccNarrowLineWidth add 2 div def /AccColumnRelativeWidthsSum 0 AccountsColumnRelativeWidths {execU add} forall def /AccColLeftX [ AccRowNameWidthsMax AccWideLineWidth 2 div MgnL add add /AccColWidthPer PageWidth MgnR sub 2 index sub AccColumnRelativeWidthsSum dup 0 gt {div} {pop} ifelse def AccountsColumnRelativeWidths {AccColWidthPer mul 1 index add} forall ] def % /AccColLeftX /AccColGrpHeadingsT 0 def /AccColGrpHeadingsB 0 def /AccColSubHeadingsT 0 def /AccColSubHeadingsB 0 def 0 1 AccountsColumnGroupHeadings length 1 sub { /i exch def HeaderFont AccountsColumnHeadingsFontSize selectfont AccountsColumnGroupHeadings i get StringPathBBox dup AccColGrpHeadingsT gt {/AccColGrpHeadingsT exch def} {pop} ifelse pop dup AccColGrpHeadingsB lt {/AccColGrpHeadingsB exch def} {pop} ifelse pop 0 1 AccountsSubColumnHeadings i get length 1 sub { /j exch def HeaderFont AccountsColumnHeadingsFontSize selectfont AccountsSubColumnHeadings i get j get StringPathBBox dup AccColSubHeadingsT gt {/AccColSubHeadingsT exch def} {pop} ifelse pop dup AccColSubHeadingsB lt {/AccColSubHeadingsB exch def} {pop} ifelse pop } for % j } for % i /jTotal 0 def 0.8 setgray 0 setlinecap [] 0 setdash 0 1 AccountsColumnGroupHeadings length 1 sub { /i exch def /jTotalGrpStart jTotal def i 0 eq {AccWideLineWidth} {AccMiddleLineWidth} ifelse setlinewidth AccColLeftX jTotalGrpStart get MgnB 1 index PageHeight MgnT AccTopTextT AccTopTextB sub 0.48 add add sub moveto lineto stroke 0 1 AccountsSubColumnHeadings i get length 1 sub { /j exch def j 1 ge {AccNarrowLineWidth setlinewidth AccColLeftX jTotal get MgnB 1 index PageHeight MgnT AccTopTextT AccTopTextB sub AccColGrpHeadingsT AccColGrpHeadingsB sub 1.44 add add add sub moveto lineto stroke} if /jTotal jTotal 1 add store } for % j } for % i AccNarrowLineWidth setlinewidth AccColLeftX jTotal get MgnB 1 index PageHeight MgnT AccTopTextT AccTopTextB sub 0.48 add add sub moveto lineto stroke /jTotal 0 def 0 1 AccountsColumnGroupHeadings length 1 sub { /i exch def /jTotalGrpStart jTotal def 0 1 AccountsSubColumnHeadings i get length 1 sub { /j exch def HeaderFont AccountsColumnHeadingsFontSize selectfont 0 setgray PageHeight MgnT AccTopTextT AccTopTextB sub AccColGrpHeadingsT AccColGrpHeadingsB sub AccColSubHeadingsT 1.92 add add add add sub AccountsSubColumnHeadings i get j get dup StringWidthRecursive AccColLeftX jTotal get AccNarrowLineWidth 2 div add AccColLeftX jTotal 1 add get AccNarrowLineWidth 2 div sub 2 copy //PrinterEpsilon sub le { 3 copy exch sub le {add exch sub 2 div 3 -1 roll moveto ShowRecursive} {1 index 6 -1 roll moveto matrix currentmatrix 5 1 roll exch sub exch div 1 scale ShowRecursive setmatrix} ifelse % String narrower than space } {pop pop pop pop pop} ifelse % Non-zero space /jTotal jTotal 1 add store } for % j HeaderFont AccountsColumnHeadingsFontSize selectfont 0 setgray PageHeight MgnT AccTopTextT AccTopTextB sub AccColGrpHeadingsT 0.96 add add add sub AccountsColumnGroupHeadings i get dup StringWidthRecursive AccColLeftX jTotalGrpStart get AccMiddleLineWidth 2 div add AccColLeftX jTotal get AccMiddleLineWidth 2 div sub 2 copy //PrinterEpsilon sub le { 3 copy exch sub le {add exch sub 2 div 3 -1 roll moveto ShowRecursive} {1 index 6 -1 roll moveto matrix currentmatrix 5 1 roll exch sub exch div 1 scale ShowRecursive setmatrix} ifelse % String narrower than space } {pop pop pop pop pop} ifelse % Non-zero space } for % i 0 1 AccRowNames length 1 sub { /NameNum exch def NamesFont AccRowNamesFontSize selectfont /ThisLineWidth 1 {AccNarrowLineWidth NameNum NamesAccounts length gt {exit} if NameNum 0 eq NameNum NamesAccounts length eq or {pop AccWideLineWidth exit} if NamesAccounts length 6 ge NamesAccounts length 3 mod 0 eq {0} {2} ifelse NameNum 3 mod eq and {pop AccMiddleLineWidth exit} if } repeat def % /ThisLineWidth /Y PageHeight MgnB MgnT add AccTopTextHeight add AccColGrpHeadingsT AccColGrpHeadingsB sub add AccColSubHeadingsT AccColSubHeadingsB sub add 2.4 add sub AccRowNames length div AccRowNames length NameNum sub mul MgnB add def MgnL Y ThisLineWidth 2 div sub moveto PageWidth MgnL MgnR add sub 0 rlineto ThisLineWidth setlinewidth 0.8 setgray 0 setlinecap [] 0 setdash stroke 0 setgray MgnL Y ThisLineWidth 0.48 add sub moveto AccRowNames NameNum get dup StringPathBBox 0 exch neg rmoveto pop pop pop ShowRecursive } for % NameNum //DeBugLevel 40 le {(+PaintForegroundCode) OutputToLog} if GSave newpath /PaintForegroundCode load execU GRestore //DeBugLevel 40 le {(-PaintForegroundCode) OutputToLog} if ShowPage //DeBugLevel 100 le {(-Accounts) OutputToLog} if } repeat % AccountsNumCopies } if % ... AccountsPaperType ... PageOrderingAccounts ... end } if % AccountsNumCopies 1 ge % Discussion: http://www.theportforum.com/viewtopic.php?t=175&p=45400#p45400 {CorkDisplayNumCopies 1 ge} MightBeTrue { //DeBugLevel 100 le {(+CorkDisplay) OutputToLog} if 56 dict begin /TypeOfPagesBeingRendered /CorkDisplay store /ThisName (Cork display) def 0 1 GlassesClusteredOnCorkDisplay length 1 sub { /CorkDisplaySetNum exch def //false //false //false //false CorkDisplayPaperType /Portrait SetPaperSize //true DefStoreMgns /CDTopTextFontSize 14 def % embedded constant HeaderFont CDTopTextFontSize selectfont CorkDisplayTopText StringPathBBox /CDTopTextT exch def /CDTopTextR exch def /CDTopTextB exch def /CDTopTextL exch def /CorkDisplayTopTextHeight CDTopTextT CDTopTextB sub def CorkDisplayPaperType ThisPaperType eq PageOrderingCorkDisplay CorkDisplaySetNum GetEU ThisPageOrdering eq and {CorkDisplayNumCopies 1 ge} MightBeTrue and dup {//false PageSuppressed {pop //false} if} if { /CDNumGlasses 0 GlassesClusteredOnCorkDisplay CorkDisplaySetNum GetEU {execU {/WithinTitles exch def CorkDisplayNumCopies add} forall} forall def /CDGapBetween 6 def % embedded constant /CDBestMeetsCriteria //false def /CDBestFailureAmount //Infinity def /CDBestOrientation /Portrait def /CDBestNumPages CDNumGlasses 1 add def /CDBestSizeScore //InfinityNeg def /CDBestWidthOneCork 0 def /CDBestHeightOneCork 0 def /CDBestNumRows //null def /CDBestNumCols //null def [ /Portrait /Landscape ] { /CDOrientation exch def //false //false //false //false CorkDisplayPaperType CDOrientation SetPaperSize //true DefStoreMgns /CDSpaceH PageWidth MgnL MgnR add sub def /CDSpaceV PageHeight MgnB MgnT add CorkDisplayTopTextHeight add sub def 1 1 CDNumGlasses { /CDNumCols exch def /CDWidthPer CDSpaceH CDNumCols 1 sub CDGapBetween mul sub CDNumCols div def 1 1 CDNumGlasses { /CDNumRows exch def /CDHeightPer CDSpaceV 0.48 sub CDNumRows 1 sub CDGapBetween mul sub CDNumRows div def % Embedded constant = small space below CorkDisplayTopText /CDNumPages CDNumGlasses CDNumCols CDNumRows mul div ceiling cvi def /CDFailureAmount CorkDisplayMinWidth CDWidthPer sub dup 0 le {pop 0} if CorkDisplayMinHeight CDHeightPer sub dup 0 le {pop} {add} ifelse def % /CDFailureAmount /CDSizeScore % www.ThePortForum.com/viewtopic.php?t=175&start=205 CDHeightPer CDWidthPer mul CorkDisplayMinWidth 0 gt CorkDisplayMinHeight 0 gt and { CorkDisplayMinWidth CDHeightPer mul CorkDisplayMinHeight CDWidthPer mul add dup 0 gt {div} {pop pop -1} ifelse } if % positive minima def % /CDSizeScore //false 1 { CDFailureAmount 0 le CDBestMeetsCriteria not and {pop //true exit} if CDHeightPer 0 le CDWidthPer 0 le or {exit} if CDFailureAmount 0 gt { CDBestMeetsCriteria {exit} if CDFailureAmount CDBestFailureAmount lt {pop //true exit} if CDFailureAmount CDBestFailureAmount gt {exit} if } if % this failing criteria CDNumPages CDBestNumPages lt {pop //true exit} if CDNumPages CDBestNumPages gt {exit} if CDSizeScore CDBestSizeScore gt {pop //true exit} if } repeat % 1 { /CDBestMeetsCriteria CDFailureAmount 0 le def /CDBestFailureAmount CDFailureAmount def /CDBestOrientation CDOrientation def /CDBestNumPages CDNumPages def /CDBestSizeScore CDSizeScore def /CDBestWidthOneCork CDWidthPer def /CDBestHeightOneCork CDHeightPer def /CDBestNumRows CDNumRows def /CDBestNumCols CDNumCols def } if % lots of things CorkDisplayMinHeight CDHeightPer gt {exit} if } for % CDNumRows CorkDisplayMinWidth CDWidthPer gt {exit} if } for % CDNumCols } forall % CDOrientation /CDCircletextFontSize [ 6 CDBestWidthOneCork 36 div CDBestHeightOneCork 36 div ] Min def % embedded constants /CDUsableWidth CDBestWidthOneCork CDCircletextFontSize 2.5 mul sub def % 2.5 approximate /CDTitleFontSize mark CorkDisplayTitleFontSizeMax CDTopTextFontSize dup 7 lt {pop} if % Test should be redundant. CDBestHeightOneCork 6 div dup CDCircletextFontSize 2.5 mul sub dup 0 le {pop} if % 2.5 approximate: should use a MaxT-MinB, but precision not important. CDUsableWidth //PrinterEpsilon gt { GlassesClusteredOnCorkDisplay CorkDisplaySetNum GetEU {execU { /WithinTitles exch execU def TitlesFont 1 selectfont TitlesCorkDisplay WithinTitles get StringWidthRecursive dup 0 gt {CDUsableWidth exch div} {pop} ifelse } forall} forall } if % CDUsableWidth //PrinterEpsilon gt MinToMark def % /CDTitleFontSize /CDSubtitleFontSize mark CDTitleFontSize CorkDisplayTitleFontSizeMax VoteRecorderSubtitleFontSizeProportionTitles dup IsNumber not {pop 0.5} if mul CDUsableWidth //PrinterEpsilon gt { GlassesClusteredOnCorkDisplay CorkDisplaySetNum GetEU {execU { /WithinTitles exch execU def SubtitlesFont 1 selectfont SubtitlesCorkDisplay WithinTitles get StringWidthRecursive dup 0 gt {CDUsableWidth exch div} {pop} ifelse } forall} forall } if % CDUsableWidth //PrinterEpsilon gt MinToMark def % /CDSubtitleFontSize /CDSpareHoles CDNumGlasses 0 gt {CDBestNumCols CDBestNumRows mul CDBestNumPages mul CDNumGlasses sub} {0} ifelse def /WithinPage 0 def /CorkDisplayThisPageTitles () def GlassesClusteredOnCorkDisplay CorkDisplaySetNum GetEU dup //true exch {length 0 gt {pop //false exit} if} forall {pop [ [ -1 ] ]} if { execU { /WithinTitles exch execU def WithinTitles type /integertype eq {CorkDisplayNumCopies} {1} ifelse % Should be redundant following change in code on 11 March 2018. { WithinPage 0 eq { //false //false MirrorPagesCorkDisplay CorkDisplaySetNum GetEU //true CorkDisplayPaperType CDBestOrientation SetPaperSize //true DefStoreMgns //DeBugLevel 40 le {(+PaintBackgroundCode) OutputToLog} if GSave newpath /PaintBackgroundCode load execU GRestore //DeBugLevel 40 le {(-PaintBackgroundCode) OutputToLog} if HeadersAndFooters PaintHeadersFooters CorkDisplayTopTextHeight 0 gt { PageWidth MgnL MgnR sub CDTopTextL CDTopTextR add sub add 2 div PageHeight MgnT CDTopTextT add sub moveto HeaderFont CDTopTextFontSize selectfont 0 setgray CorkDisplayTopText ShowRecursive } if % CorkDisplayTopTextHeight 0 gt } if % WithinPage 0 eq WithinTitles type /integertype eq {WithinTitles 0 ge} {//false} ifelse % First clause should be redundant following change in code on 11 March 2018. { /CDColNum WithinPage << /SheetNum 0 >> begin PackingNestingColumnMajor end {CDBestNumRows idiv} {CDBestNumCols mod } ifelse def /CDRowNum WithinPage << /SheetNum 0 >> begin PackingNestingColumnMajor end {CDBestNumRows mod } {CDBestNumCols idiv} ifelse def /CDLeft CDGapBetween CDBestWidthOneCork add CDColNum mul MgnL add def /CDBottom CDGapBetween CDBestHeightOneCork add CDBestNumRows CDRowNum sub 1 sub mul MgnB add def CDLeft CDBottom CDBestWidthOneCork CDBestHeightOneCork CirclearraysCorkDisplay WithinTitles get {CircletextFont CDCircletextFontSize selectfont} CircletextsMinNumSpacesBetween CirclearrayInRectangle sub neg /AD exch def 1 dict begin /AnnotationCount 0 def 0 2 GlassesAnnotations length 2 sub dup 0 ge {//false PageSuppressed {pop -1} if} if { dup GlassesAnnotations exch GetEU WithinTitles eq { mark exch 1 add GlassesAnnotations exch GetEU PDFDocEncodingify /Contents exch /Title [Titles WithinTitles get (: annotation)] PDFDocEncodingify /Rect [ CDLeft AD add CDBestWidthOneCork AD 2 mul sub 20 sub AnnotationCount 8 div mul add % Embedded constant, width of annotation icon in Preview 7.0 (826.4) CDBottom AD add CDBestHeightOneCork AD 2 mul sub 24 sub 8 AnnotationCount sub 8 div mul 24 add add 2 copy ] % Embedded constant, height of annotation icon in Preview 7.0 (826.4) /Subtype /Text /Open //true /F 64 128 add % ReadOnly + Locked. PDFReference16.pdf page 574 /ANN pdfmark /AnnotationCount AnnotationCount 1 add store AnnotationCount 9 ge {exit} if } {pop} ifelse % ... WithinTitles eq } for end % 'GlassesAnnotations' /CDLeft CDLeft AD add 1.92 add def % Embedded constant /CDBottom CDBottom AD add 1.92 add def % Embedded constant SubtitlesFont CDSubtitleFontSize selectfont 0 setgray SubtitlesCorkDisplay WithinTitles get StringPathBBox /CDSubtitlesT exch def /CDSubtitlesR exch def /CDSubtitlesB exch def /CDSubtitlesL exch def CDSubtitlesT CDSubtitlesB gt CDSubtitlesR CDSubtitlesL gt and { CDLeft CDBottom CDSubtitlesB sub moveto SubtitlesCorkDisplay WithinTitles get ShowRecursive /CDBottom CDBottom CDSubtitlesB sub CDSubtitlesT add 0.96 add def % Embedded constant } if % non-empty TitlesFont CDTitleFontSize selectfont 0 setgray TitlesCorkDisplay WithinTitles get StringPathBBox /CDTitlesT exch def /CDTitlesR exch def /CDTitlesB exch def /CDTitlesL exch def CDTitlesT CDTitlesB gt CDTitlesR CDTitlesL gt and { CDLeft CDBottom CDTitlesB sub moveto TitlesCorkDisplay WithinTitles get ShowRecursive } if % non-empty } if % WithinTitles type /integertype eq ... WithinTitles 0 ge ... WithinTitles 0 ge {/CorkDisplayThisPageTitles dup load dup length 0 gt {(; ) Concatenate} if Titles WithinTitles get PDFDocEncodingify Concatenate def} if % Deliberately Titles rather than TitlesCorkDisplay /WithinPage WithinPage 1 add def WithinPage CDBestNumRows CDBestNumCols mul ge { //DeBugLevel 40 le {(+PaintForegroundCode) OutputToLog} if GSave newpath /PaintForegroundCode load execU GRestore //DeBugLevel 40 le {(-PaintForegroundCode) OutputToLog} if ShowPage /WithinPage 0 def /CorkDisplayThisPageTitles () def } if % Page finished } repeat % ... CorkDisplayNumCopies ... } forall WithinPage 0 gt {CDSpareHoles CDBestNumCols CDBestNumRows mul WithinPage sub 2 copy ge {sub /CDSpareHoles exch def ShowPage /WithinPage 0 def /CorkDisplayThisPageTitles () def} {pop pop} ifelse} if } forall WithinPage 0 gt { //DeBugLevel 40 le {(+PaintForegroundCode) OutputToLog} if GSave newpath /PaintForegroundCode load execU GRestore //DeBugLevel 40 le {(-PaintForegroundCode) OutputToLog} if ShowPage } if } if % CorkDisplayPaperType ... PageOrderingCorkDisplay ... and ... CorkDisplayNumCopies 1 ge } for % CorkDisplaySetNum end //DeBugLevel 100 le {(-CorkDisplay) OutputToLog} if } if % ... CorkDisplayNumCopies 1 ge ... //false {NeckTagsNumCopies 1 ge} MightBeTrue {PageOrderingNeckTags {execU ThisPageOrdering eq {pop //true exit} if} forall} if { //DeBugLevel 100 le {(+NeckTags) OutputToLog} if 51 dict begin /TypeOfPagesBeingRendered /NeckTags store /NTGapBetweenMin 6 def /NTGapInside 0.24 def % embedded constants /ThisName (Neck tags) def //false //false MirrorPagesNeckTags //true NeckTagsPaperType /Portrait SetPaperSize //true DefStoreMgns /NTSpaceH PageWidth MgnL MgnR add sub def /NTSpaceV PageHeight MgnB MgnT add sub def /NTNumGlasses 0 def /NTTitleAboveBelowOverPropRMinL 0 def /NTTitleAboveBelowOverPropRMaxR 0 def /NTTitleAboveBelowOverPropRMinB 0 def /NTTitleAboveBelowOverPropRMaxT 0 def 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def NeckTagsPaperType ThisPaperType eq PageOrderingNeckTags SheetNum GetEU ThisPageOrdering eq and NeckTagsNumCopies 1 ge and { /NTNumGlasses dup load NeckTagsNumCopies add store /NTTitleAboveBelowOverPropRMinL TitleAboveBelowOverL SheetNum get WithinPage get RadiiCirclearrayInside SheetNum get div dup 2 index load lt {store} {pop pop} ifelse /NTTitleAboveBelowOverPropRMaxR TitleAboveBelowOverR SheetNum get WithinPage get RadiiCirclearrayInside SheetNum get div dup 2 index load gt {store} {pop pop} ifelse /NTTitleAboveBelowOverPropRMinB TitleAboveBelowOverB SheetNum get WithinPage get RadiiCirclearrayInside SheetNum get div dup 2 index load lt {store} {pop pop} ifelse /NTTitleAboveBelowOverPropRMaxT TitleAboveBelowOverT SheetNum get WithinPage get RadiiCirclearrayInside SheetNum get div dup 2 index load gt {store} {pop pop} ifelse } if % NeckTagsPaperType ... PageOrderingNeckTags ... and ... NeckTagsNumCopies ... } for % WithinPage, WithinTitles } for % SheetNum NTNumGlasses 1 ge NTTitleAboveBelowOverPropRMaxR NTTitleAboveBelowOverPropRMinL sub //Epsilon gt NTTitleAboveBelowOverPropRMaxT NTTitleAboveBelowOverPropRMinB sub //Epsilon gt and and { /NTBestScalingFactor //Epsilon def /NTBestNumPages //Infinity def [ /NTBestRotatedness /NTBestNumRows /NTBestNumCols /NTBestRadius /NTBestWidthPer /NTBestHeightPer ] {//null def} forall 21 dict begin 0 1 1 { 1 eq /NTRotated exch def 1 1 NTNumGlasses NTSpaceH NTGapBetweenMin add NTRotated {NeckTagsMinHeight} {NeckTagsMinWidth} ifelse NTGapBetweenMin add div cvi dup 1 lt {pop 1} if 2 copy gt {exch} if pop { /NTNumCols exch def 1 1 NTNumGlasses NTNumCols div ceiling cvi NTSpaceV NTGapBetweenMin add NTRotated {NeckTagsMinWidth} {NeckTagsMinHeight} ifelse NTGapBetweenMin add div cvi dup 1 lt {pop 1} if 2 copy gt {exch} if pop { /NTNumRows exch def /NTNumPages NTNumGlasses NTNumCols NTNumRows mul div ceiling cvi def /NTScalingFactorThis //Infinity def /NTWidthPerThis //PrinterEpsilon def /NTHeightPerThis //PrinterEpsilon def /NTRadiusThis //Infinity def 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def /NTRadiiDiffPlusGap Radii SheetNum get RadiiCirclearrayInside SheetNum get sub NTGapInside add def /NTHeightPer /NTWidthPer NTRotated {exch} if NTSpaceH NTNumCols 1 sub NTGapBetweenMin mul sub NTNumCols div NTRotated {NeckTagsMaxHeight} {NeckTagsMaxWidth} ifelse 2 copy gt {exch} if pop def NTSpaceV NTNumRows 1 sub NTGapBetweenMin mul sub NTNumRows div NTRotated {NeckTagsMaxWidth} {NeckTagsMaxHeight} ifelse 2 copy gt {exch} if pop def % Want large Titles etc. But don't want wasted space. Hence resetting of NTHeightPer|NTWidthPer for no wasted space. /NTUsedV NeckTagsHoleRadius 2 mul NeckTagsSpaceAboveTitlesEtc NeckTagsSpaceBelowTitlesEtc add add NeckTagsSpaceAboveHole add NTRadiiDiffPlusGap add def /NTUsableV NTHeightPer NTUsedV sub def /NTUsedH NTRadiiDiffPlusGap 2 mul def /NTUsableH NTWidthPer NTUsedH sub def /NTTABOPRV NTTitleAboveBelowOverPropRMaxT NTTitleAboveBelowOverPropRMinB sub def /NTTABOPRH NTTitleAboveBelowOverPropRMaxR NTTitleAboveBelowOverPropRMinL sub def NTUsableV NTTABOPRH mul NTUsableH NTTABOPRV mul gt {/NTScalingFactor NTUsableH NTTABOPRH dup 0 gt {div} {pop pop 0} ifelse def /NTHeightPer NTTABOPRV NTScalingFactor mul NTUsedV add NeckTagsMinHeight 2 copy lt {exch} if pop def} {/NTScalingFactor NTUsableV NTTABOPRV dup 0 gt {div} {pop pop 0} ifelse def /NTWidthPer NTTABOPRH NTScalingFactor mul NTUsedH add NeckTagsMinWidth 2 copy lt {exch} if pop def} ifelse % Horizontal or vertical direction the binding constraint NTScalingFactor NTScalingFactorThis lt {/NTScalingFactorThis NTScalingFactor store} if NTWidthPer NTWidthPerThis gt {/NTWidthPerThis NTWidthPer store} if NTHeightPer NTHeightPerThis gt {/NTHeightPerThis NTHeightPer store} if /NTRadiusThis NeckTagsSpaceAboveHole 2 div NeckTagsHoleRadius add dup 2 index load lt {store} {pop pop} ifelse } for % WithinPage, WithinTitles } for % SheetNum NTNumPages NTBestNumPages lt NTNumPages NTBestNumPages eq NTScalingFactor NTBestScalingFactor gt and or { /NTBestRotatedness NTRotated /NTBestScalingFactor NTScalingFactorThis /NTBestNumPages NTNumPages /NTBestNumRows NTNumRows /NTBestNumCols NTNumCols /NTBestWidthPer NTWidthPerThis /NTBestHeightPer NTHeightPerThis /NTBestRadius NTRadiusThis 8 {store} repeat } if % new best } for % NTNumRows } for % NTNumCols } for % NTRotated end /StringAnnotationPDF mark (Neck tags: cut around text; cut circle perhaps after gently folding that part of tag; put over otherwise-unlabelled bottle.) << /SheetNum 0 /TNSheetNum 0 >> begin % in case headers reference same HeadersAndFooters 6 3 roll 3 copy [ 4 1 roll ] NonEmptyCompoundObject {[(\r\n\r\nHeader: ) 5 2 roll ( ) 3 1 roll 2 index exch] PDFDocEncodingify 4 1 roll} {pop pop pop} ifelse 3 copy [ 4 1 roll ] NonEmptyCompoundObject {[(\r\n\r\nFooter: ) 5 2 roll ( ) 3 1 roll 2 index exch] PDFDocEncodingify } {pop pop pop} ifelse ConcatenateToMark end % << /SheetNum 0 /TNSheetNum 0 >> def % /StringAnnotationPDF /AnnotatePDF { //false PageSuppressed not { mark /Rect [ 0 PageHeight 2 copy ] /Subtype /Text /Contents StringAnnotationPDF /Open //false /Title (Neck tags) /ModDate ParametersVersionDateTimeAdobeFormat /F 64 128 add % ReadOnly + Locked. PDFReference16.pdf page 574 /ANN pdfmark } if % PageSuppressed not } bind def % /AnnotatePDF NTBestRotatedness //null ne { DeBugLevel 100 le { mark (Neck tags: scaling factors = ) NTBestScalingFactor RadiiCirclearrayInside {div} //false TwoArraysFunction (\(with ThisPageOrdering = ) ThisPageOrdering (\), and scaled TitleFontSizes = ) TitleFontSizes RadiiCirclearrayInside {div} //false TwoArraysFunction NTBestScalingFactor {mul} //false TwoArraysFunction SizeArrayOutput (.) ConcatenateToMark OutputToLog } if % DeBugLevel 100 le /MatrixPaper matrix currentmatrix def /NeckTagsThisPageTitles () def /NTGapBetweenH PageWidth NTBestRotatedness {NTBestHeightPer} {NTBestWidthPer} ifelse NTBestNumCols mul sub dup NTBestNumCols 1 add div dup 2 mul MgnL MgnR add ge {exch pop} {pop MgnL MgnR add sub NTBestNumCols 1 sub dup 1 lt {pop pop 0} {div} ifelse} ifelse def % /NTGapBetweenH /NTGapBetweenV PageHeight NTBestRotatedness {NTBestWidthPer} {NTBestHeightPer} ifelse NTBestNumRows mul sub dup NTBestNumRows 1 add div dup 2 mul MgnB MgnT add ge {exch pop} {pop MgnB MgnT add sub NTBestNumRows 1 sub dup 1 lt {pop pop 0} {div} ifelse} ifelse def % /NTGapBetweenV /NTNumPaintedThisPage 0 def 0 1 NumSheets 1 sub { /SheetNum exch def 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def /NTRadiiDiffPlusGap Radii SheetNum get RadiiCirclearrayInside SheetNum get sub NTGapInside add def NeckTagsMaxHeight NeckTagsHoleRadius 2 mul NeckTagsSpaceAboveTitlesEtc NeckTagsSpaceBelowTitlesEtc add add NeckTagsSpaceAboveHole add NTRadiiDiffPlusGap add 6 add gt % Embedded constant { NeckTagsPaperType ThisPaperType eq PageOrderingNeckTags SheetNum GetEU ThisPageOrdering eq and CircleNonEmpty SheetNum get WithinPage get and { 0 1 NTBestScalingFactor //Epsilon le {-1} {NeckTagsNumCopies 1 sub} ifelse { //false PageSuppressed {pop exit} if /NeckTagsCopyNum exch def NTBestRotatedness {/NTColNum NTNumPaintedThisPage NTBestNumRows idiv def /NTRowNum NTBestNumRows NTNumPaintedThisPage NTBestNumRows mod sub 1 sub def} {/NTRowNum NTNumPaintedThisPage NTBestNumCols idiv def /NTColNum NTNumPaintedThisPage NTBestNumCols mod def} ifelse /NTCentreX PageWidth MgnR MgnL sub add 2 div NTBestNumCols 1 sub 2 div NTColNum sub NTBestRotatedness {NTBestHeightPer} {NTBestWidthPer} ifelse NTGapBetweenH add mul sub def /NTCentreY PageHeight MgnT MgnB sub add 2 div NTBestNumRows 1 sub 2 div NTRowNum sub NTBestRotatedness {NTBestWidthPer} {NTBestHeightPer} ifelse NTGapBetweenV add mul add def /MatrixNT NTBestRotatedness {NTBestNumCols 1 gt NTColNum 0 eq and {-90} {90} ifelse matrix rotate} {NTBestNumRows 1 gt NTRowNum 0 eq and {180 matrix rotate} if} ifelse NTCentreX NTCentreY matrix translate MatrixPaper {1 index type /arraytype eq {matrix concatmatrix} {exit} ifelse} loop def % /MatrixNT /MatrixTitlesEtc 0 NTTitleAboveBelowOverPropRMaxT NTTitleAboveBelowOverPropRMinB add RadiiCirclearrayInside SheetNum get mul -2 div matrix translate NTBestScalingFactor RadiiCirclearrayInside SheetNum get div dup matrix scale 0 NeckTagsSpaceAboveHole NTRadiiDiffPlusGap sub NeckTagsSpaceAboveTitlesEtc NeckTagsSpaceBelowTitlesEtc sub add 2 div NeckTagsHoleRadius add neg matrix translate MatrixNT {1 index type /arraytype eq {matrix concatmatrix} {exit} ifelse} loop def % /MatrixTitlesEtc /MatrixGlasses GlassPositions SheetNum get WithinPage get {neg} forall matrix translate MatrixTitlesEtc {1 index type /arraytype eq {matrix concatmatrix} {exit} ifelse} loop def MatrixNT setmatrix ClipSave NTBestWidthPer NTGapBetweenMin 0.8 mul add dup -2 div exch NTBestHeightPer NTGapBetweenMin 0.8 mul add dup -2 div 3 1 roll rectclip % Non-overlapping rectclips help RIP engines /TypeOfPagesBeingRendered /Glasses store //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns BackgroundTextsGlasses {NeckTagsShowBackgroundTexts} {//false} ifelse Droplets {NeckTagsShowDroplets or} if { ClipSave MatrixNT setmatrix NTBestWidthPer -2 div NTRadiiDiffPlusGap add NTBestHeightPer -2 div NTRadiiDiffPlusGap add moveto NTBestWidthPer NTRadiiDiffPlusGap 2 mul sub 0 rlineto NTBestWidthPer 2 div NTBestRadius sub NTBestHeightPer 2 div NTBestRadius sub NTBestRadius NTRadiiDiffPlusGap sub 0 90 /l ArcAccurate NTBestWidthPer -2 div NTBestRadius add NTBestHeightPer 2 div NTBestRadius sub NTBestRadius NTRadiiDiffPlusGap sub 90 180 /l ArcAccurate closepath clip newpath RotationTitlesAboveBelowOverCirclearray dup 0 ne { MatrixTitlesEtc setmatrix neg rotate GlassPositions SheetNum get WithinPage get {neg} forall translate } {pop MatrixGlasses setmatrix} ifelse % RotationTitlesAboveBelowOverCirclearray 0 ne BackgroundTextsGlasses NeckTagsShowBackgroundTexts and {BackgroundTextsGlassesForms SheetNum get execform} if Droplets NeckTagsShowDroplets and { SheetNum RotationTitlesAboveBelowOverCirclearray 0 eq { GSave MatrixNT setmatrix newpath NTBestWidthPer -2 div NTBestHeightPer -2 div moveto NTBestWidthPer 2 div NTBestHeightPer -2 div lineto NTBestWidthPer 2 div NTBestHeightPer 2 div lineto NTBestWidthPer -2 div NTBestHeightPer 2 div lineto MatrixTitlesEtc setmatrix GlassPositions SheetNum get WithinPage get {neg} forall translate pathbbox GRestore } {//InfinityNeg //InfinityNeg //Infinity //Infinity} ifelse % RotationTitlesAboveBelowOverCirclearray 0 eq WithinPage 1.0 DropletsPaint % If rotating too complicated to rotate box; the WithinPage must suffice. } if % Droplets NeckTagsShowDroplets and ClipRestore } if % BackgroundTextsGlasses ... NeckTagsShowBackgroundTexts ... Droplets ...NeckTagsShowDroplets or /PaintBackgroundInsideGlassCircles load length 0 gt OutlineTitles NeckTagsShowOutlineTitles and or Spirals or CrossHatchingInside NeckTagsShowCrossHatchingInside and or { GSave MatrixNT setmatrix NTBestWidthPer -2 div NTRadiiDiffPlusGap add NTBestHeightPer -2 div NTRadiiDiffPlusGap add moveto NTBestWidthPer NTRadiiDiffPlusGap 2 mul sub 0 rlineto NTBestWidthPer 2 div NTRadiiDiffPlusGap sub NeckTagsHoleRadius NeckTagsSpaceAboveHole add sub NTBestHeightPer 2 div NeckTagsHoleRadius NeckTagsSpaceAboveHole add NTRadiiDiffPlusGap add sub NeckTagsHoleRadius NeckTagsSpaceAboveHole add 0 90 /l ArcAccurate NTBestWidthPer -2 div NTRadiiDiffPlusGap add NeckTagsHoleRadius NeckTagsSpaceAboveHole add add NTBestHeightPer 2 div NeckTagsHoleRadius NeckTagsSpaceAboveHole add NTRadiiDiffPlusGap add sub NeckTagsHoleRadius NeckTagsSpaceAboveHole add 90 180 /l ArcAccurate closepath clip newpath MatrixTitlesEtc setmatrix 0 0 Radii SheetNum get 0 360 /m ArcAccurate closepath clip newpath /PaintBackgroundInsideGlassCircles load length 0 gt {/TypeOfPagesBeingRendered /NeckTags store /PaintBackgroundInsideGlassCircles load execU} if OutlineTitles NeckTagsShowOutlineTitles and {OutlineForms SheetNum get WithinPage get execform} if Spirals {SpiralForms SheetNum get WithinPage get execform} if CrossHatchingInside NeckTagsShowCrossHatchingInside and {CrossHatchingInsideForms SheetNum get WithinPage get execform} if GRestore } if % any of many /TypeOfPagesBeingRendered /NeckTags store //false //false //false //false NeckTagsPaperType /Portrait SetPaperSize //true DefStoreMgns MatrixNT setmatrix NTBestWidthPer -2 div NTBestHeightPer -2 div NTBestWidthPer NTBestHeightPer NTBestRadius CirclearraysNeckTags WithinTitles get {CircletextFont CirclearraysFontSizes SheetNum get WithinPage get selectfont 0 setgray} CircletextsMinNumSpacesBetween CirclearrayInSemiRoundedRectangle pop pop /TypeOfPagesBeingRendered /Glasses store MatrixTitlesEtc setmatrix TitleAboveBelowOverForms SheetNum get WithinPage get execform AnnotateGlass /TypeOfPagesBeingRendered /NeckTags store //false //false //false //false NeckTagsPaperType /Portrait SetPaperSize //true DefStoreMgns /N NeckTagsHoleRadius //TwoPi mul 18 div 4 div ceiling cvi 4 mul dup 4 lt {pop 4} if def % Pieces of just under 18 pt; one third being be painted black MatrixNT setmatrix 0 NTBestHeightPer 2 div NeckTagsHoleRadius NeckTagsSpaceAboveHole add sub NeckTagsHoleRadius newpath [] 0 setdash 1 setlinejoin 0 1 N 1 sub { /i exch def 3 copy 6 copy i 2 mod 0 eq {-36 -60 +12 -12 +60 +36} {-27 -60 +3 -3 +60 +27} ifelse 12 2 roll 7 2 roll % Three even pieces, or long-short-long of same average length 3 {i 360 mul add N div exch i 360 mul add N div 5 copy pop 2 copy sin mul 3 1 roll cos mul 4 -1 roll add 3 1 roll add moveto arc} repeat % moveto start of arc, then arc } for pop pop pop MatrixPaper setmatrix GSave 1 setgray NeckTagsHoleLineWidth 1.44 add setlinewidth 1 setlinecap stroke GRestore 0 setgray NeckTagsHoleLineWidth setlinewidth 0 setlinecap stroke ClipRestore /NTNumPaintedThisPage dup load 1 add store /NeckTagsThisPageTitles dup load [ exch dup length 0 gt {(; )} if Titles WithinTitles get ] PDFDocEncodingify def NTNumPaintedThisPage NTBestNumRows NTBestNumCols mul ge {AnnotatePDF ShowPage /NTNumPaintedThisPage 0 store /NeckTagsThisPageTitles () store} if } for % NeckTagsCopyNum } if % NeckTagsPaperType ... PageOrderingNeckTags ... and ... NeckTags ... CircleNonEmpty ... }{ mark (Error in neck tags with SheetNum=) SheetNum ( WithinPage=) WithinPage ( WithinTitles=) WithinTitles (. NeckTagsMaxHeight, which is ) NeckTagsMaxHeight (, must materially exceed 2*NeckTagsHoleRadius + NeckTagsSpaceAboveTitlesEtc + NeckTagsSpaceBelowTitlesEtc + NeckTagsSpaceAboveHole + space for CirclearraysNeckTags at bottom of tag = 2*) NeckTagsHoleRadius ( + ) NeckTagsSpaceAboveTitlesEtc ( + ) NeckTagsSpaceBelowTitlesEtc ( + ) NeckTagsSpaceAboveHole ( + ) NTRadiiDiffPlusGap ( = ) NeckTagsHoleRadius 2 mul NeckTagsSpaceAboveTitlesEtc NeckTagsSpaceBelowTitlesEtc add add NeckTagsSpaceAboveHole add NTRadiiDiffPlusGap add (. Omitting this neck tag; otherwise continuing.) ConcatenateToMark OutputToLog } ifelse % NeckTagsMaxHeight big enough } for % WithinPage, WithinTitles } for % SheetNum NTNumPaintedThisPage 0 gt {AnnotatePDF ShowPage} if } {(Error: NeckTags, NTBestRotatedness is null. No neck tags pages; otherwise continuing. Please submit an issue to http://github.com/jdaw1/placemat/issues/) OutputToLog} ifelse % NTBestRotatedness //null ne } if % NTNumGlasses 1 ge ... end //DeBugLevel 100 le {(-NeckTags) OutputToLog} if } if % ...NeckTagsNumCopies 1 ge ... PageOrderingNeckTags ... ThisPageOrdering eq {PrePourNumCopies 0 gt} MightBeTrue { /TypeOfPagesBeingRendered /PrePour store 17 dict begin /NameNum 0 def /ThisName (Pre-pour) def /PrePourSheetNumWithinPageWithinTitles [ NumSheets 1 sub PrePourReverseOrder {-1 0} {0 exch 1 exch} ifelse { /SheetNum exch def PrePourPaperType ThisPaperType eq PageOrderingPrePourPages SheetNum GetEU ThisPageOrdering eq and % Note SheetNum not PrePourSheetNum { SheetLengths SheetNum get 1 sub PrePourReverseOrder {-1 0} {0 exch 1 exch} ifelse { WithinPage-WithinTitles-def //true PrePourRemoveDuplicatesByWithinTitles {counttomark 1 sub 1 exch 1 exch {index 2 get WithinTitles eq {pop //false exit} if} for} if { [ SheetNum WithinPage WithinTitles ] } if } for % WithinPage, WithinTitles } if % ... ThisPaperType ... ThisPageOrdering ... and } for % SheetNum ] def % /PrePourSheetNumWithinPageWithinTitles PrePourSheetNumWithinPageWithinTitles length 1 ge { PrePourSortByWithinTitles {PrePourSheetNumWithinPageWithinTitles {2 get exch 2 get ge} {2 get exch 2 get le} PrePourReverseOrder {exch} if pop ShellSort} if PrePourCollate {/PrePourSheetNum 0 def} if { /Finished //true def AnyFillTextingAtAll //DeBugLevel 100 le or {mark ( Main: +PrePour: execution time ~= ) usertime usertimeStart sub 1000 div (s) ConcatenateToMark OutputToLog} if PrePourSheetNumWithinPageWithinTitles { aload pop /WithinTitles exch def /WithinPage exch def /SheetNum exch def 0 1 PrePourCollate {PrePourSheetNum PrePourNumCopies lt {0} {-1} ifelse} {PrePourNumCopies 1 sub} ifelse { //false PageSuppressed {pop exit} if PrePourCollate {pop} {/PrePourSheetNum exch def} ifelse matrix currentmatrix /TypeOfPagesBeingRendered /PrePour store /Finished //false def //false //false MirrorPagesPrePour SheetNum GetEU //true PrePourPaperType PrePourOrientation SetPaperSize //true DefStoreMgns //DeBugLevel 40 le {(+PaintBackgroundCode) OutputToLog} if GSave newpath /PaintBackgroundCode load execU GRestore //DeBugLevel 40 le {(-PaintBackgroundCode) OutputToLog} if PrePourInnerLoop //DeBugLevel 40 le {(+PaintForegroundCode) OutputToLog} if GSave newpath /PaintForegroundCode load execU GRestore //DeBugLevel 40 le {(-PaintForegroundCode) OutputToLog} if setmatrix ShowPage } for % PrePourSheetNum, if not collating } forall % PrePourSheetNumWithinPageWithinTitles AnyFillTextingAtAll //DeBugLevel 100 le or {mark ( Main: -PrePour: execution time ~= ) usertime usertimeStart sub 1000 div (s) ConcatenateToMark OutputToLog} if Finished PrePourCollate not or {exit} if /PrePourSheetNum PrePourSheetNum 1 add def } loop % PrePourSheetNum, if collating } if % PrePourSheetNumWithinPageWithinTitles length 1 ge end } if % ...PrePourNumCopies 0 gt... {BottleWrapNumCopies 0 gt} MightBeTrue { /TypeOfPagesBeingRendered /BottleWrap store 17 dict begin /NameNum 0 def /ThisName (Bottle-wrap) def /BottleWrapSheetNumWithinPageWithinTitles [ NumSheets 1 sub BottleWrapReverseOrder {-1 0} {0 exch 1 exch} ifelse { /SheetNum exch def BottleWrapPaperType ThisPaperType eq PageOrderingBottleWrap SheetNum GetEU ThisPageOrdering eq and % Note SheetNum not BottleWrapSheetNum { SheetLengths SheetNum get 1 sub BottleWrapReverseOrder {-1 0} {0 exch 1 exch} ifelse { WithinPage-WithinTitles-def //true BottleWrapRemoveDuplicatesByWithinTitles {counttomark 1 sub 1 exch 1 exch {index 2 get WithinTitles eq {pop //false exit} if} for} if { [ SheetNum WithinPage WithinTitles ] } if } for % WithinPage, WithinTitles } if % ... ThisPaperType ... ThisPageOrdering ... and } for % SheetNum ] def % /BottleWrapSheetNumWithinPageWithinTitles BottleWrapSheetNumWithinPageWithinTitles length 1 ge { BottleWrapSortByWithinTitles {BottleWrapSheetNumWithinPageWithinTitles {2 get exch 2 get ge} {2 get exch 2 get le} BottleWrapReverseOrder {exch} if pop ShellSort} if BottleWrapCollate {/BottleWrapSheetNum 0 def} if { /Finished //true def AnyFillTextingAtAll //DeBugLevel 100 le or {mark ( Main: +BottleWrap: execution time ~= ) usertime usertimeStart sub 1000 div (s) ConcatenateToMark OutputToLog} if BottleWrapSheetNumWithinPageWithinTitles { aload pop /WithinTitles exch def /WithinPage exch def /SheetNum exch def 0 1 BottleWrapCollate {BottleWrapSheetNum BottleWrapNumCopies lt {0} {-1} ifelse} {BottleWrapNumCopies 1 sub} ifelse { //false PageSuppressed {pop exit} if BottleWrapCollate {pop} {/BottleWrapSheetNum exch def} ifelse matrix currentmatrix /TypeOfPagesBeingRendered /BottleWrap store /Finished //false def //false //false MirrorPagesBottleWrap SheetNum GetEU //true BottleWrapPaperType BottleWrapOrientation SetPaperSize //true DefStoreMgns //DeBugLevel 40 le {(+PaintBackgroundCode) OutputToLog} if GSave newpath /PaintBackgroundCode load execU GRestore //DeBugLevel 40 le {(-PaintBackgroundCode) OutputToLog} if BottleWrapInnerLoop //DeBugLevel 40 le {(+PaintForegroundCode) OutputToLog} if GSave newpath /PaintForegroundCode load execU GRestore //DeBugLevel 40 le {(-PaintForegroundCode) OutputToLog} if setmatrix ShowPage } for % BottleWrapSheetNum, if not collating } forall % BottleWrapSheetNumWithinPageWithinTitles AnyFillTextingAtAll //DeBugLevel 100 le or {mark ( Main: -BottleWrap: execution time ~= ) usertime usertimeStart sub 1000 div (s) ConcatenateToMark OutputToLog} if Finished BottleWrapCollate not or {exit} if /BottleWrapSheetNum BottleWrapSheetNum 1 add def } loop % BottleWrapSheetNum, if collating } if % BottleWrapSheetNumWithinPageWithinTitles length 1 ge end } if % ...BottleWrapNumCopies 0 gt... % Decanter labels. Because there is, in inner loops, testing of DecanterLabelsPaperType and PageOrderingDecanterLabels, this is not in an ...InnerLoop code. {DecanterLabelsNumCopies 1 ge} MightBeTrue { /DLRotations dup where {pop pop} {[ SheetLengths {array} forall ] def} ifelse 45 dict begin //false 0 1 NumSheets 1 sub { /SheetNum exch def DecanterLabelsPaperType ThisPaperType eq PageOrderingDecanterLabels SheetNum get ThisPageOrdering eq and {pop //true exit} if } for % /SheetNum { AnyFillTextingAtAll //DeBugLevel 100 le or {mark (+DecanterLabels: execution time ~= ) usertime usertimeStart sub 1000 div (s) ConcatenateToMark OutputToLog} if /TypeOfPagesBeingRendered /DecanterLabels store //false //false //false //false DecanterLabelsPaperType /Portrait SetPaperSize //true DefStoreMgns /ThisName (Decanter labels) def /DecanterLabelsGap 8 def % embedded constant /DecanterLabelsTopTextFontSize 6 def HeaderFont DecanterLabelsTopTextFontSize selectfont % Embedded constant /DecanterLabelsTopText load StringWidthRecursive PageWidth MgnL MgnR add sub 2 copy gt {exch div /DecanterLabelsTopTextFontSize dup load 3 -1 roll mul def} {pop pop} ifelse HeaderFont DecanterLabelsTopTextFontSize selectfont /DecanterLabelsTopText load StringPathBBox /DecanterLabelsTopTextT exch def /DecanterLabelsTopTextR exch def /DecanterLabelsTopTextB exch def /DecanterLabelsTopTextL exch def /DLBestNumOnPage -1 def % Boolean orientations: portrait = true /DLBackgroundOrFooters BackgroundTextsDecanterLabels {//true} {[HeadersAndFooters 6 3 roll pop pop pop] NonEmptyCompoundObject} ifelse def //null //null 0 0 % DLOrientation DLEachOrientation DLNumRows DLNumCols 0 1 1 { 0 eq /DLOrientation exch def % page 1 -1 0 { 0 eq /DLEachOrientation exch def % labels. Portrait => DLEachOrientation is true /DLNumRows DLOrientation {PageHeight} {PageWidth} ifelse MgnB MgnT add DecanterLabelsTopTextT DecanterLabelsTopTextB sub add DLBackgroundOrFooters {DecanterLabelsGap add} if sub DLEachOrientation {DecanterLabelsMaxLargerDimension} {DecanterLabelsMaxSmallerDimension} ifelse DecanterLabelsGap add div floor cvi def /DLNumCols DLOrientation {PageWidth} {PageHeight} ifelse MgnL MgnR add DecanterLabelsGap sub sub DLEachOrientation {DecanterLabelsMaxSmallerDimension} {DecanterLabelsMaxLargerDimension} ifelse DecanterLabelsGap add div floor cvi def DLNumRows DLNumCols mul dup DLBestNumOnPage gt {/DLBestNumOnPage exch def pop pop pop pop DLOrientation DLEachOrientation DLNumRows DLNumCols} {pop} ifelse } for % DLEachOrientation } for % DLOrientation /DLNumCols exch def /DLNumRows exch def /DLEachOrientation exch def /DLOrientation exch def /DLTotalNumCopies 0 def /DecanterLabelsThisPageTitles () def DLBestNumOnPage 1 lt { (Error, Decanter labels: the page is too small for DecanterLabelsMaxSmallerDimension and DecanterLabelsMaxLargerDimension: no DLs.) OutputToLog }{ /TypeOfPagesBeingRendered /DecanterLabels store //false //false MirrorPagesDecanterLabels SheetNum get //true DecanterLabelsPaperType DLOrientation {/Portrait} {/Landscape} ifelse SetPaperSize //true DefStoreMgns /MatrixDL matrix currentmatrix def /DLScalingFactor //Infinity def 0 1 NumSheets 1 sub { /SheetNum exch def DecanterLabelsPaperType ThisPaperType eq PageOrderingDecanterLabels SheetNum get ThisPageOrdering eq and { 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def /DLTotalNumCopies dup load DecanterLabelsNumCopies add def /DLScalingP DecanterLabelsMaxLargerDimension TitleAboveBelowOverT SheetNum get WithinPage get TitleAboveBelowOverB SheetNum get WithinPage get sub //PrinterEpsilon 2 copy lt {exch} if pop div DecanterLabelsMaxSmallerDimension TitleAboveBelowOverR SheetNum get WithinPage get TitleAboveBelowOverL SheetNum get WithinPage get sub //PrinterEpsilon 2 copy lt {exch} if pop div 2 copy gt {exch} if pop def % /DLScalingP /DLScalingL DecanterLabelsMaxSmallerDimension TitleAboveBelowOverT SheetNum get WithinPage get TitleAboveBelowOverB SheetNum get WithinPage get sub //PrinterEpsilon 2 copy lt {exch} if pop div DecanterLabelsMaxLargerDimension TitleAboveBelowOverR SheetNum get WithinPage get TitleAboveBelowOverL SheetNum get WithinPage get sub //PrinterEpsilon 2 copy lt {exch} if pop div 2 copy gt {exch} if pop def % /DLScalingL DLRotations SheetNum get WithinPage 1 { DecanterLabelsOrientation /Automatic eq {DLScalingP DLScalingL ge DLEachOrientation ne put DLScalingP DLScalingL 2 copy lt {exch} if pop exit} if DecanterLabelsOrientation /Landscape eq {DLEachOrientation put DLScalingL exit} if DLEachOrientation not put DLScalingP exit % Portrait } repeat % 1 dup DLScalingFactor lt {/DLScalingFactor exch store} {pop} ifelse } for % WithinPage, WithinTitles } if % ... ThisPaperType ... ThisPageOrdering ... and } for % /SheetNum DLTotalNumCopies 0 gt { DLNumCols DLTotalNumCopies gt {/DLNumCols DLTotalNumCopies def} if /DLNumRows DLTotalNumCopies DLNumCols div ceiling cvi dup DLNumRows div ceiling cvi div ceiling cvi def /DLNumOnPage 0 def /FirstX DLEachOrientation {DecanterLabelsMaxSmallerDimension} {DecanterLabelsMaxLargerDimension} ifelse 2 div MgnL add def /StepX DLNumCols 1 gt {PageWidth DLEachOrientation {DecanterLabelsMaxSmallerDimension} {DecanterLabelsMaxLargerDimension} ifelse MgnL MgnR add add sub DLNumCols 1 sub div} {0} ifelse def /StepY PageHeight MgnB MgnT add DecanterLabelsTopTextT DecanterLabelsTopTextB sub add DLBackgroundOrFooters {DLEachOrientation {DecanterLabelsMaxLargerDimension} {DecanterLabelsMaxSmallerDimension} ifelse dup 4 1 roll DLNumRows mul add sub DLNumRows 1 add div add} {sub DLNumRows div} ifelse neg def % DLBackgroundOrFooters, /StepY /FirstY PageHeight MgnT DecanterLabelsTopTextT DecanterLabelsTopTextB sub add StepY sub DLEachOrientation {DecanterLabelsMaxLargerDimension} {DecanterLabelsMaxSmallerDimension} ifelse 2 div sub sub def 0 1 NumSheets 1 sub { /SheetNum exch def DecanterLabelsPaperType ThisPaperType eq PageOrderingDecanterLabels SheetNum get ThisPageOrdering eq and { 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def /DLRSW DLRotations SheetNum get WithinPage get def 0 1 DecanterLabelsNumCopies 1 sub CircleNonEmpty SheetNum get WithinPage get not {pop -1} if { //false PageSuppressed {pop exit} if 0 eq { /DecanterLabelsThisPageTitles dup load [ exch dup length 0 gt {(; )} if Titles WithinTitles get ] PDFDocEncodingify def DecanterLabelsGuillotineMarks DLNumCols 1 ge DLNumRows 1 ge and and { 0 1 DLNumCols 1 sub { StepX mul FirstX add DLEachOrientation {DecanterLabelsMaxSmallerDimension} {DecanterLabelsMaxLargerDimension} ifelse 2 div 2 copy add 3 1 roll sub 2 copy 3 -1 roll 2 {MgnB moveto 0 4 rlineto PageHeight MgnT sub moveto 0 DecanterLabelsTopTextB DecanterLabelsTopTextT sub -2 add -4 2 copy gt {exch} if pop rlineto} repeat % Embedded constants } for % columns 0 1 DLNumRows 1 sub { StepY mul FirstY add DLEachOrientation {DecanterLabelsMaxLargerDimension} {DecanterLabelsMaxSmallerDimension} ifelse 2 div 2 copy add 3 1 roll sub 2 copy 3 -1 roll 2 {MgnL exch moveto 4 0 rlineto PageWidth MgnR sub exch moveto -4 0 rlineto} repeat % Embedded constants } for % rows 0.6 setgray 0.24 setlinewidth [] 0 setdash 0 setlinecap stroke % Embedded constants } if % DLNumOnPage 0 eq DecanterLabelsGuillotineMarks ... and } if % 0 eq /DLX DLNumCols 1 gt {DLNumOnPage DLNumCols mod StepX mul FirstX add} {PageWidth MgnL MgnR sub add 2 div} ifelse def /DLY DLNumRows 1 gt {DLNumOnPage DLNumCols idiv StepY mul FirstY add} {PageHeight MgnB MgnT sub add 2 div} ifelse def /DLDashInk DecanterLabelsMaxSmallerDimension DecanterLabelsMaxLargerDimension add dup 12 div ceiling cvi div 3 div def mark /Rect [ DLX DLEachOrientation {DecanterLabelsMaxSmallerDimension} {DecanterLabelsMaxLargerDimension} ifelse 2 div 2 copy sub 3 1 roll add DLY DLEachOrientation {DecanterLabelsMaxLargerDimension} {DecanterLabelsMaxSmallerDimension} ifelse 2 div 2 copy sub 4 1 roll add ] /Vertices [ 2 index aload pop 4 copy 6 -2 roll 5 -2 roll exch DLRSW {2 copy 0.5 //PrinterEpsilon add add} {8 -2 roll 2 copy exch 0.5 //PrinterEpsilon add add exch} ifelse 10 4 roll ] % +width/2 to bring into corner /Subtype /PolyLine /BS << /Type /Border /W 1 /S /D /D [DLDashInk dup 2 mul] >> /Title [ Titles WithinTitles get (: left top right of decanter label) ] PDFDocEncodingify /ModDate ParametersVersionDateTimeAdobeFormat /F 64 128 add % ReadOnly + Locked. PDFReference16.pdf page 574 /Color [ 1 0.8 0.4 ] /ANN pdfmark mark /Rect [ DLX DLEachOrientation {DecanterLabelsMaxSmallerDimension} {DecanterLabelsMaxLargerDimension} ifelse 2 div DLRSW {add dup DLY DLEachOrientation {DecanterLabelsMaxLargerDimension} {DecanterLabelsMaxSmallerDimension} ifelse 2 div 2 copy sub 4 1 roll add} {2 copy sub 3 1 roll add DLY DLEachOrientation {DecanterLabelsMaxLargerDimension} {DecanterLabelsMaxSmallerDimension} ifelse 2 div sub dup 3 1 roll} ifelse % DLRotations ] /Vertices [ 2 index aload pop DLRSW {3 -1 roll DLDashInk 2 mul 0.5 add add 3 1 roll} {4 -1 roll DLDashInk 2 mul 0.5 add add 4 1 roll} ifelse % Simulating dash phase, needing a half width of previous ANN 2 copy DLRSW {exch //PrinterEpsilon 0.75 add sub exch} {//PrinterEpsilon 0.75 add add} ifelse % Corner a mite larger than half line width, so that the pieces seem properly joined ] /Subtype /PolyLine /BS << /Type /Border /W 1.5 /S /D /D [DLDashInk dup 2 mul] >> % PDF 32000-1:2008, p387: "The dash phase is not specified and shall be assumed to be 0." /Title [ Titles WithinTitles get (: bottom of decanter label) ] PDFDocEncodingify /ModDate ParametersVersionDateTimeAdobeFormat /F 64 128 add % ReadOnly + Locked. PDFReference16.pdf page 574 /Color [ 1 0.2 0.1 ] /ANN pdfmark DLX DLY translate DLScalingFactor dup scale DLRSW {90 rotate} if /MatrixGlasses matrix currentmatrix def /TypeOfPagesBeingRendered /Glasses store /TypeOfPagesBeingRendered /Glasses store //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns MatrixGlasses setmatrix newpath TitleAboveBelowOverR SheetNum get WithinPage get TitleAboveBelowOverL SheetNum get WithinPage get add -2 div TitleAboveBelowOverT SheetNum get WithinPage get TitleAboveBelowOverB SheetNum get WithinPage get add -2 div translate BackgroundTextsDecanterLabels { ClipSave matrix currentmatrix dup /TypeOfPagesBeingRendered /DecanterLabels store //false //false //false //false DecanterLabelsPaperType /Portrait SetPaperSize //true DefStoreMgns MatrixDL setmatrix newpath DLNumOnPage DLNumCols mod 0 eq {MgnL} {DLX StepX 2 div sub} ifelse DLNumOnPage DLNumCols idiv DLNumRows 1 sub eq {MgnB} {DLY StepY 2 div add} ifelse DLNumOnPage 1 add DLNumCols mod 0 eq {PageWidth MgnR sub} {DLX StepX 2 div add} ifelse 2 index sub DLNumOnPage DLNumCols idiv 0 eq {PageHeight MgnT sub} {DLY StepY 2 div sub} ifelse 2 index sub rectclip newpath setmatrix /TypeOfPagesBeingRendered /Glasses store //false //false //false //false PaperType Orientation SetPaperSize //true DefStoreMgns newpath RotationTitlesAboveBelowOverCirclearray dup 0 ne {neg rotate} {pop} ifelse GlassPositions SheetNum get WithinPage get {neg} forall translate BackgroundTextsGlassesForms SheetNum get execform setmatrix ClipRestore } if % BackgroundTextsDecanterLabels CrossHatchingInside DecanterLabelsShowCrossHatchingInside and OutlineTitles DecanterLabelsShowOutlineTitles and or /PaintBackgroundInsideGlassCircles load length 0 gt or { matrix currentmatrix ClipSave MatrixDL setmatrix DecanterLabelsMaxLargerDimension DecanterLabelsMaxSmallerDimension DLEachOrientation {exch} if DLX 2 index 2 div sub DLY 2 index 2 div sub 4 2 roll rectclip newpath dup setmatrix /PaintBackgroundInsideGlassCircles load dup length 0 gt {/TypeOfPagesBeingRendered /DecanterLabels store GSave newpath 0 0 Radii SheetNum get 0 360 /m ArcAccurate closepath clip newpath execU GRestore} {pop} ifelse % PaintBackgroundInsideGlassCircles ... length 0 gt /TypeOfPagesBeingRendered /Glasses store OutlineTitles DecanterLabelsShowOutlineTitles and {OutlineForms SheetNum get WithinPage get execform} if Spirals {SpiralForms SheetNum get WithinPage get execform} if CrossHatchingInside DecanterLabelsShowCrossHatchingInside and {CrossHatchingInsideForms SheetNum get WithinPage get execform} if setmatrix ClipRestore } if % CrossHatchingInside ... OutlineTitles ... or ... PaintBackgroundInsideGlassCircles ... or TitleAboveBelowOverForms SheetNum get WithinPage get execform AnnotateGlass /TypeOfPagesBeingRendered /DecanterLabels store //false //false //false //false DecanterLabelsPaperType DLOrientation {/Portrait} {/Landscape} ifelse SetPaperSize //true DefStoreMgns MatrixDL setmatrix DLNumOnPage 0 eq {HeadersAndFooters PaintHeadersFooters MgnL PageHeight MgnT DecanterLabelsTopTextT add sub moveto HeaderFont DecanterLabelsTopTextFontSize selectfont DecanterLabelsTopText ShowRecursive} if /DLNumOnPage dup load 1 add def DLNumOnPage DLNumRows DLNumCols mul ge {ShowPage /DLNumOnPage 0 store /DecanterLabelsThisPageTitles () store} if } for % DecanterLabelsNumCopies, if CircleNonEmpty } for % WithinPage, WithinTitles } if % ... ThisPaperType ... ThisPageOrdering ... and } for % /SheetNum DLNumOnPage 0 gt {ShowPage} if } if % DLTotalNumCopies 1 gt } ifelse % DLBestNumOnPage 1 lt AnyFillTextingAtAll //DeBugLevel 100 le or {mark (-DecanterLabels: execution time ~= ) usertime usertimeStart sub 1000 div (s) ConcatenateToMark OutputToLog} if } if % ... ThisPaperType ... ThisPageOrdering ... and end } if % ... DecanterLabelsNumCopies 1 ge ... % Sticky labels, usually for bottles, sometimes for glasses. % Because there is, in inner loops, testing of StickyLabelsPaperType and PageOrderingStickyLabels, this is not in an ...InnerLoop code. StickyLabelsTypes { 60 dict begin /StickyLabelsTypeThis exch def {StickyLabelsNumCopies 1 ge} MightBeTrue { AnyFillTextingAtAll //DeBugLevel 100 le or {mark (+StickyLabels: execution time ~= ) usertime usertimeStart sub 1000 div (s) ConcatenateToMark OutputToLog} if /TypeOfPagesBeingRendered /StickyLabels store //false //false //false //false StickyLabelsPaperType /Portrait SetPaperSize //true DefStoreMgns /StickyLabelsWithPagePortraitHeight PageHeight StickyLabelsWithPagePortraitGapT StickyLabelsWithPagePortraitGapB add sub StickyLabelsWithPagePortraitGapBetweenRows StickyLabelsWithPagePortraitNumRows 1 sub mul sub StickyLabelsWithPagePortraitNumRows div def /StickyLabelsWithPagePortraitWidth PageWidth StickyLabelsWithPagePortraitGapL StickyLabelsWithPagePortraitGapR add sub StickyLabelsWithPagePortraitGapBetweenCols StickyLabelsWithPagePortraitNumCols 1 sub mul sub StickyLabelsWithPagePortraitNumCols div def //DeBugLevel 10 le {( StickyLabels: StringAnnotationPDF computation) OutputToLog} if /StringAnnotationPDF mark (For ) StickyLabelsPaperType execU ( page of labels. When held portrait there are ) StickyLabelsWithPagePortraitNumCols ( columns separated by gaps of ) StickyLabelsWithPagePortraitGapBetweenCols (pt; and ) StickyLabelsWithPagePortraitNumRows ( rows separated by gaps of ) StickyLabelsWithPagePortraitGapBetweenRows (pt. Margins: top ) StickyLabelsWithPagePortraitGapT (pt; bottom ) StickyLabelsWithPagePortraitGapB (pt; left ) StickyLabelsWithPagePortraitGapL (pt; right ) StickyLabelsWithPagePortraitGapR (pt.\r\n\r\nIn some PDF viewers pale lines are visible. These make more obvious the assumed label size and paddings, but do not print.) << /SheetNum 0 /TNSheetNum 0 >> begin % in case headers reference same HeadersAndFooters 6 3 roll 3 copy [ 4 1 roll ] NonEmptyCompoundObject {[(\r\n\r\nHeader: ) 5 2 roll ( ) 3 1 roll 2 index exch] PDFDocEncodingify 4 1 roll} {pop pop pop} ifelse 3 copy [ 4 1 roll ] NonEmptyCompoundObject {[(\r\n\r\nFooter: ) 5 2 roll ( ) 3 1 roll 2 index exch] PDFDocEncodingify } {pop pop pop} ifelse ConcatenateToMark end % << /SheetNum 0 /TNSheetNum 0 >> def % /StringAnnotationPDF /AnnotatePDF { //false PageSuppressed not { mark /Rect [ 0 PageHeight 2 div 2 copy ] /Subtype /Text /Contents StringAnnotationPDF /Open //false /Title (The labels) /ModDate ParametersVersionDateTimeAdobeFormat /F 64 128 add % ReadOnly + Locked. PDFReference16.pdf page 574 /ANN pdfmark } if % PageSuppressed not } bind def % /AnnotatePDF //DeBugLevel 10 le {( StickyLabels: compute StickyLabelsSheetNumWithinPageWithinTitles) OutputToLog} if /StickyLabelsSheetNumWithinPageWithinTitles [ NumSheets 1 sub StickyLabelsReverseOrder {-1 0} {0 exch 1 exch} ifelse { /SheetNum exch def StickyLabelsPaperType ThisPaperType eq PageOrderingStickyLabels SheetNum GetEU ThisPageOrdering eq and % Note SheetNum not StickyLabelsSheetNum { SheetLengths SheetNum get 1 sub StickyLabelsReverseOrder {-1 0} {0 exch 1 exch} ifelse { WithinPage-WithinTitles-def //true StickyLabelsRemoveDuplicatesByWithinTitles {counttomark 1 sub 1 exch 1 exch {index 2 get WithinTitles eq {pop //false exit} if} for} if { [ SheetNum WithinPage WithinTitles ] } if } for % WithinPage, WithinTitles } if % ... ThisPaperType ... ThisPageOrdering ... and } for % SheetNum ] def % /StickyLabelsSheetNumWithinPageWithinTitles StickyLabelsSortByWithinTitles {StickyLabelsSheetNumWithinPageWithinTitles {2 get exch 2 get ge} {2 get exch 2 get le} StickyLabelsReverseOrder {exch} if pop ShellSort} if //DeBugLevel 10 le {( StickyLabels: painting) OutputToLog} if /StickyLabelsNumPaintedOnCurrentPage 0 def /StickyLabelsPositionOnPage where {pop} {/StickyLabelsPositionOnPage StickyLabelsFirstPageStartPosition StickyLabelsWithPagePortraitNumRows StickyLabelsWithPagePortraitNumCols mul mod def} ifelse /StickyLabelsPaperSizeSet //false def matrix currentmatrix /StickyLabelsThisPageTitlesNames () def 0 1 StickyLabelsByNameWhichReplaceCirclearrays StickyLabelsNamesChangeFaster not and {NamesStickyLabels length 1 sub} {0} ifelse { StickyLabelsByNameWhichReplaceCirclearrays StickyLabelsNamesChangeFaster not and { /NameNum exch def /ThisName NamesStickyLabels NameNum get def /StickyLabelsThisPageTitlesNamesDoThis //true def }{ pop /NameNum 0 def /ThisName (Sticky lLabels) def } ifelse % StickyLabelsByNameWhichReplaceCirclearrays 0 1 StickyLabelsSheetNumWithinPageWithinTitles length 1 sub { /StickieNum exch def 0 1 StickyLabelsByNameWhichReplaceCirclearrays StickyLabelsNamesChangeFaster and {NamesStickyLabels length 1 sub} {0} ifelse { StickyLabelsByNameWhichReplaceCirclearrays StickyLabelsNamesChangeFaster and { /NameNum exch def /ThisName NamesStickyLabels NameNum get def }{ pop /NameNum 0 def } ifelse % StickyLabelsByNameWhichReplaceCirclearrays StickyLabelsSheetNumWithinPageWithinTitles StickieNum get aload pop dup WithinTitles ne StickyLabelsByNameWhichReplaceCirclearrays not StickyLabelsNamesChangeFaster or and {/StickyLabelsThisPageTitlesNamesDoThis //true def} if /WithinTitles exch def /WithinPage exch def /SheetNum exch def //true DefStoreMgns StickyLabelsPaperType ThisPaperType eq PageOrderingStickyLabels SheetNum GetEU ThisPageOrdering eq and % Note SheetNum. Also note that 'PageOrderingStickyLabels SheetNum get' could be code. { StickyLabelsPaperSizeSet not {//false //false MirrorPagesStickyLabels SheetNum GetEU //true StickyLabelsPaperType /Portrait SetPaperSize /StickyLabelsPaperSizeSet //true def} if /StickyLabelsCirclearraysMaxFontSize 7 def % Embedded constant: max 7pt 0 1 StickyLabelsNumCopies 1 sub % StickyLabelsNumCopies might be code referencing WithinPage or WithinTitles or NameNum { //false PageSuppressed {pop exit} if /StickyLabelCopyNum exch def StickyLabelsPositionOnPage StickyLabelsWithPagePortraitNumRows StickyLabelsWithPagePortraitNumCols mul ge { AnnotatePDF ShowPage /StickyLabelsNumPaintedOnCurrentPage 0 store /StickyLabelsPositionOnPage 0 store /StickyLabelsThisPageTitlesNames () def /StickyLabelsThisPageTitlesNamesDoThis //true def } if % page full StickyLabelsThisPageTitlesNamesDoThis { /StickyLabelsThisPageTitlesNames dup load [ exch dup length 0 ne {(, )} {pop} ifelse StickyLabelsByNameWhichReplaceCirclearrays StickyLabelsNamesChangeFaster not and {ThisName} {Titles WithinTitles get} ifelse ] PDFDocEncodingify def % /StickyLabelsThisPageTitlesNames /StickyLabelsThisPageTitlesNamesDoThis //false def } if StickyLabelsWithPagePortraitHeight StickyLabelsPaddingWithPagePortraitTB 2 mul le {(Error: StickyLabelsWithPagePortraitHeight = ) StickyLabelsWithPagePortraitHeight ToString Concatenate ( < 2*StickyLabelsPaddingWithPagePortraitTB) Concatenate OutputToLog stop} if StickyLabelsWithPagePortraitWidth StickyLabelsPaddingWithPagePortraitRL 2 mul le {(Error: StickyLabelsWithPagePortraitWidth = ) StickyLabelsWithPagePortraitWidth ToString Concatenate ( < 2*StickyLabelsPaddingWithPagePortraitRL) Concatenate OutputToLog stop} if /StickyLabelX StickyLabelsPositionOnPage StickyLabelsColumnsChangeFaster {StickyLabelsWithPagePortraitNumCols mod} {StickyLabelsWithPagePortraitNumRows idiv} ifelse StickyLabelsWithPagePortraitGapBetweenCols StickyLabelsWithPagePortraitWidth add mul StickyLabelsWithPagePortraitGapL StickyLabelsWithPagePortraitWidth 2 div add add def % /StickyLabelX /StickyLabelY StickyLabelsWithPagePortraitNumRows 1 sub StickyLabelsPositionOnPage StickyLabelsColumnsChangeFaster {StickyLabelsWithPagePortraitNumCols idiv} {StickyLabelsWithPagePortraitNumRows mod} ifelse sub StickyLabelsWithPagePortraitGapBetweenRows StickyLabelsWithPagePortraitHeight add mul StickyLabelsWithPagePortraitGapB StickyLabelsWithPagePortraitHeight 2 div add add def % /StickyLabelY mark /Rect [ StickyLabelX StickyLabelsWithPagePortraitWidth 2 div sub StickyLabelY StickyLabelsWithPagePortraitHeight 2 div sub StickyLabelX StickyLabelsWithPagePortraitWidth 2 div add StickyLabelY StickyLabelsWithPagePortraitHeight 2 div add ] /Subtype /Polygon /BS << /Type /Border /W 1 /S /S >> /ModDate ParametersVersionDateTimeAdobeFormat /F 64 128 add % ReadOnly + Locked. PDFReference16.pdf page 574 counttomark 1 add copy /Title [ Titles WithinTitles get (: edge of sticky label) ] PDFDocEncodingify /Vertices [ StickyLabelX StickyLabelsWithPagePortraitWidth 2 div sub StickyLabelY StickyLabelsWithPagePortraitHeight 2 div sub 2 copy StickyLabelsPaddingWithPagePortraitTB add 4 2 roll exch StickyLabelsPaddingWithPagePortraitRL add exch StickyLabelX StickyLabelsWithPagePortraitWidth 2 div add StickyLabelY StickyLabelsWithPagePortraitHeight 2 div sub 2 copy exch StickyLabelsPaddingWithPagePortraitRL sub exch 4 2 roll StickyLabelsPaddingWithPagePortraitTB add StickyLabelX StickyLabelsWithPagePortraitWidth 2 div add StickyLabelY StickyLabelsWithPagePortraitHeight 2 div add 2 copy StickyLabelsPaddingWithPagePortraitTB sub 4 2 roll exch StickyLabelsPaddingWithPagePortraitRL sub exch StickyLabelX StickyLabelsWithPagePortraitWidth 2 div sub StickyLabelY StickyLabelsWithPagePortraitHeight 2 div add 2 copy exch StickyLabelsPaddingWithPagePortraitRL add exch 4 2 roll StickyLabelsPaddingWithPagePortraitTB sub ] /Color [ 0.6 0.6 1.0 ] /ANN pdfmark /Title [ Titles WithinTitles get (: printable rectangle within sticky label) ] PDFDocEncodingify /Vertices [ StickyLabelX StickyLabelsWithPagePortraitWidth 2 div sub StickyLabelsPaddingWithPagePortraitRL add StickyLabelY StickyLabelsWithPagePortraitHeight 2 div sub StickyLabelsPaddingWithPagePortraitTB add StickyLabelX StickyLabelsWithPagePortraitWidth 2 div add StickyLabelsPaddingWithPagePortraitRL sub StickyLabelY StickyLabelsWithPagePortraitHeight 2 div sub StickyLabelsPaddingWithPagePortraitTB add StickyLabelX StickyLabelsWithPagePortraitWidth 2 div add StickyLabelsPaddingWithPagePortraitRL sub StickyLabelY StickyLabelsWithPagePortraitHeight 2 div add StickyLabelsPaddingWithPagePortraitTB sub StickyLabelX StickyLabelsWithPagePortraitWidth 2 div sub StickyLabelsPaddingWithPagePortraitRL add StickyLabelY StickyLabelsWithPagePortraitHeight 2 div add StickyLabelsPaddingWithPagePortraitTB sub ] /Color [ 0.8 1.0 0.8 ] /ANN pdfmark /StickyTextUnscaledHeight TitleAboveBelowOverT SheetNum get WithinPage get TitleAboveBelowOverB SheetNum get WithinPage get sub def StickyTextUnscaledHeight 0 lt {(Error: StickyTextUnscaledHeight = ) StickyTextUnscaledHeight ToString Concatenate OutputToLog stop} if /StickyTextUnscaledWidth TitleAboveBelowOverR SheetNum get WithinPage get TitleAboveBelowOverL SheetNum get WithinPage get sub def StickyTextUnscaledWidth 0 lt {(Error: StickyTextUnscaledWidth = ) StickyTextUnscaledHeight ToString Concatenate OutputToLog stop} if /StickyLabelsRotate StickyLabelsWithPagePortraitWidth StickyLabelsPaddingWithPagePortraitRL 2 mul sub StickyLabelsWithPagePortraitHeight StickyLabelsPaddingWithPagePortraitTB 2 mul sub StickyLabelsOrientation /Automatic ne {2 copy} if StickyTextUnscaledWidth //PrinterEpsilon add StickyTextUnscaledHeight //PrinterEpsilon add 4 copy 3 -1 roll StickyLabelsCirclearraysMaxFontSize 2 mul sub exch div 3 1 roll div 2 copy gt {exch} if pop dup 1 gt {pop 1} if /ScalingFactorNotRotated exch def 4 -1 roll StickyLabelsCirclearraysMaxFontSize 2 mul sub exch div 3 1 roll div 2 copy gt {exch} if pop dup 1 gt {pop 1} if /ScalingFactorRotated exch def StickyLabelsOrientation /Automatic eq { % Prefer landscape to give extras space for CirclearraysStickyLabels. Use Portrait only if improves ScalingFactor by a factor of at least 1 (previous code had SqrtSqrt2). ScalingFactorRotated ScalingFactorNotRotated 1 StickyLabelsWithPagePortraitHeight StickyLabelsWithPagePortraitWidth gt {div} {mul} ifelse gt }{ StickyLabelsOrientation /Landscape eq {lt} {gt} ifelse } ifelse def % /StickyLabelsRotate, StickyLabelsRotate StickyLabelsWithPagePortraitHeight StickyLabelsWithPagePortraitWidth StickyLabelsRotate {exch} if /StickyLabelsWidth exch def /StickyLabelsHeight exch def StickyLabelsPaddingWithPagePortraitTB StickyLabelsPaddingWithPagePortraitRL StickyLabelsRotate {exch} if /StickyLabelsPaddingRL exch def /StickyLabelsPaddingTB exch def /ScalingFactor StickyLabelsRotate {ScalingFactorRotated} {ScalingFactorNotRotated} ifelse def matrix currentmatrix StickyLabelX StickyLabelY translate StickyLabelsRotate {90 rotate} if ScalingFactor dup scale 0 TitleAboveBelowOverT SheetNum get WithinPage get TitleAboveBelowOverB SheetNum get WithinPage get add 2 div neg translate /StickyLabelsGlassesMatrix matrix currentmatrix def setmatrix BackgroundTextsGlasses {StickyLabelsShowBackgroundTexts} {//false} ifelse Droplets {StickyLabelsShowDroplets or} if { /TypeOfPagesBeingRendered /Glasses store //false //false //false //false PaperType Orientation SetPaperSize //false DefStoreMgns ClipSave matrix currentmatrix StickyLabelX StickyLabelsWithPagePortraitWidth 2 div sub StickyLabelsPaddingWithPagePortraitRL add StickyLabelY StickyLabelsWithPagePortraitHeight 2 div sub StickyLabelsPaddingWithPagePortraitTB add StickyLabelsWithPagePortraitWidth StickyLabelsPaddingWithPagePortraitRL 2 mul sub StickyLabelsWithPagePortraitHeight StickyLabelsPaddingWithPagePortraitTB 2 mul sub rectclip newpath StickyLabelsGlassesMatrix setmatrix RotationTitlesAboveBelowOverCirclearray dup 0 ne {neg rotate} {pop} ifelse GlassPositions SheetNum get WithinPage get {neg} forall translate BackgroundTextsGlasses StickyLabelsShowBackgroundTexts and {BackgroundTextsGlassesForms SheetNum get execform} if Droplets StickyLabelsShowDroplets and { SheetNum RotationTitlesAboveBelowOverCirclearray 0 eq { GSave 1 index setmatrix newpath StickyLabelX StickyLabelsWithPagePortraitWidth 2 div sub StickyLabelY StickyLabelsWithPagePortraitHeight 2 div sub moveto StickyLabelX StickyLabelsWithPagePortraitWidth 2 div sub StickyLabelY StickyLabelsWithPagePortraitHeight 2 div add lineto StickyLabelX StickyLabelsWithPagePortraitWidth 2 div add StickyLabelY StickyLabelsWithPagePortraitHeight 2 div add lineto StickyLabelX StickyLabelsWithPagePortraitWidth 2 div add StickyLabelY StickyLabelsWithPagePortraitHeight 2 div sub lineto StickyLabelsGlassesMatrix setmatrix GlassPositions SheetNum get WithinPage get {neg} forall translate pathbbox GRestore } {//InfinityNeg //InfinityNeg //Infinity //Infinity} ifelse % RotationTitlesAboveBelowOverCirclearray 0 eq WithinPage 1.0 DropletsPaint } if % Droplets StickyLabelsShowDroplets and setmatrix ClipRestore /TypeOfPagesBeingRendered /StickyLabels store //false //false //false //false StickyLabelsPaperType /Portrait SetPaperSize //false DefStoreMgns } if % BackgroundTextsGlasses ... StickyLabelsShowBackgroundTexts ... Droplets ...StickyLabelsShowDroplets or StickyLabelsRotate { matrix currentmatrix StickyLabelX StickyLabelY translate 90 rotate StickyLabelX neg StickyLabelY neg translate } if % StickyLabelsRotate 0 1 1 { /Top0Bottom1 exch def % Discussion: http://www.theportforum.com/viewtopic.php?t=175&p=91779#p91779 StickyLabelsByNameWhichReplaceCirclearrays Top0Bottom1 1 eq and {/ThisFont NamesFont def /ThisCirclearray [/ThisName load] def} {/ThisFont CircletextFont def /ThisCirclearray CirclearraysStickyLabels WithinTitles get def} ifelse /ThisCirclearray load NonEmptyCompoundObject { /StickyLabelsCircletextFontSize % Embedded constant: max 0.25 * TitleFontSize StickyLabelsCirclearraysMaxFontSize NamesFontSize 2 copy gt {exch} if pop Titles WithinTitles get NonEmptyCompoundObject {TitleFontSizes SheetNum get WithinPage get 4 div 2 copy gt {exch} if pop} if Abovetitles WithinTitles get NonEmptyCompoundObject {AbovetitleFontSizes SheetNum get WithinPage get 4 div 2 copy gt {exch} if pop} if Belowtitles WithinTitles get NonEmptyCompoundObject {BelowtitleFontSizes SheetNum get WithinPage get 4 div 2 copy gt {exch} if pop} if Overtitles WithinTitles get NonEmptyCompoundObject {OvertitleFontSizes SheetNum get WithinPage get 4 div 2 copy gt {exch} if pop} if def % /StickyLabelsCircletextFontSize ThisFont StickyLabelsCircletextFontSize selectfont newpath /ThisCirclearray load StringPathBBox /CirclearrayT exch def /CirclearrayR exch def /CirclearrayB exch def /CirclearrayL exch def /StickyLabelCirclearrayBaseline Top0Bottom1 0 eq { StickyLabelY TitleAboveBelowOverT SheetNum get WithinPage get TitleAboveBelowOverB SheetNum get WithinPage get sub 2 div ScalingFactor mul add StickyLabelY StickyLabelsHeight 2 div StickyLabelsPaddingTB sub add add CirclearrayT CirclearrayB add sub 2 div StickyLabelY StickyLabelsHeight 2 div StickyLabelsPaddingTB sub add CirclearrayT sub 2 copy gt {exch} if pop dup CirclearrayB add 0.24 sub /BBYT exch def % embedded constant }{ StickyLabelY TitleAboveBelowOverT SheetNum get WithinPage get TitleAboveBelowOverB SheetNum get WithinPage get sub 2 div ScalingFactor mul sub StickyLabelY StickyLabelsHeight 2 div StickyLabelsPaddingTB sub sub add CirclearrayT CirclearrayB add sub 2 div StickyLabelY StickyLabelsHeight 2 div StickyLabelsPaddingTB sub sub CirclearrayB sub 2 copy lt {exch} if pop dup CirclearrayT add 0.24 add /BBYB exch def % embedded constant } ifelse def % Top0Bottom1 0 eq, /StickyLabelCirclearrayBaseline ThisFont StickyLabelsCircletextFontSize selectfont /CirclearraySpacesWidth ( ) stringwidth pop CircletextsMinNumSpacesBetween mul def /CirclearrayWidth CirclearrayR CirclearrayL sub CirclearraySpacesWidth /ThisCirclearray load execU length 1 sub mul add def % /CirclearrayWidth StickyLabelsWidth StickyLabelsPaddingRL 2 mul sub CirclearrayWidth //PrinterEpsilon add div dup 1 ge {pop} { dup dup dup dup dup CirclearrayT mul /CirclearrayT exch def CirclearrayR mul /CirclearrayR exch def CirclearrayB mul /CirclearrayB exch def CirclearrayL mul /CirclearrayL exch def CirclearraySpacesWidth mul /CirclearraySpacesWidth exch def StickyLabelsCircletextFontSize mul /StickyLabelsCircletextFontSize exch def ThisFont StickyLabelsCircletextFontSize selectfont /CirclearrayWidth StickyLabelsWidth StickyLabelsPaddingRL 2 mul sub //PrinterEpsilon sub def } ifelse % ... 1 ge StickyLabelsWidth StickyLabelsPaddingRL 2 mul sub CirclearrayWidth //PrinterEpsilon add div dup 1 lt { dup CirclearrayT mul /CirclearrayT exch def dup CirclearrayR mul /CirclearrayR exch def dup CirclearrayB mul /CirclearrayB exch def dup CirclearrayL mul /CirclearrayL exch def dup StickyLabelsCircletextFontSize mul /StickyLabelsCircletextFontSize exch def dup CirclearrayWidth mul /CirclearrayWidth exch def CirclearraySpacesWidth mul /CirclearraySpacesWidth exch def ThisFont StickyLabelsCircletextFontSize selectfont } {pop} ifelse /CirclearrayN StickyLabelsWidth StickyLabelsPaddingRL 2 mul sub CirclearraySpacesWidth add CirclearrayWidth CirclearraySpacesWidth add dup 0 gt {div} {pop pop 1} ifelse dup 4 gt {4 sub 0.75 mul 4 add} if % Embedded constant cvi dup 1 lt {pop 1} if def % /CirclearrayN StickyLabelX CirclearrayWidth CirclearrayN mul CirclearraySpacesWidth CirclearrayN 1 sub mul add 2 div sub StickyLabelCirclearrayBaseline moveto CirclearrayN { /ThisCirclearray load execU { ThisFont StickyLabelsCircletextFontSize selectfont 0 setgray ShowRecursive CirclearraySpacesWidth 0 rmoveto } forall % /ThisCirclearray load execU } repeat % CirclearrayN } if % /ThisCirclearray load NonEmptyCompoundObject } for % Top0Bottom1 StickyLabelsShowCirclearraysInCircle /PaintBackgroundInsideGlassCircles load length 0 gt or { /TypeOfPagesBeingRendered /Glasses store //false //false //false //false PaperType Orientation SetPaperSize //false DefStoreMgns matrix currentmatrix ClipSave StickyLabelsRotate { StickyLabelX StickyLabelsWithPagePortraitHeight 2 div sub StickyLabelsPaddingWithPagePortraitTB add StickyLabelsWithPagePortraitHeight StickyLabelsPaddingWithPagePortraitTB 2 mul sub }{ StickyLabelX StickyLabelsWithPagePortraitWidth 2 div sub StickyLabelsPaddingWithPagePortraitRL add StickyLabelsWithPagePortraitWidth StickyLabelsPaddingWithPagePortraitRL 2 mul sub } ifelse % StickyLabelsRotate BBYB exch BBYT BBYB sub rectclip newpath /PaintBackgroundInsideGlassCircles load dup length 0 gt {/TypeOfPagesBeingRendered /StickyLabels store StickyLabelsGlassesMatrix setmatrix GSave newpath 0 0 Radii SheetNum get 0 360 /m ArcAccurate closepath clip newpath execU GRestore} {pop} ifelse % PaintBackgroundInsideGlassCircles ... length 0 gt /TypeOfPagesBeingRendered /Glasses store StickyLabelsShowCirclearraysInCircle {StickyLabelsGlassesMatrix setmatrix CirclearrayForms SheetNum get WithinPage get dup /PaintProc get exec} if ClipRestore setmatrix } if % StickyLabelsShowCirclearraysInCircle /PaintBackgroundInsideGlassCircles load length 0 gt or % Problem here: vertical position is slightly wrong. Perhaps TitleOffsetsProportionFontSizeVertical somehow needs to be used? matrix currentmatrix StickyLabelX StickyLabelY translate ScalingFactor dup scale 0 TitleAboveBelowOverT SheetNum get WithinPage get TitleAboveBelowOverB SheetNum get WithinPage get add 2 div neg translate TitleAboveBelowOverForms SheetNum get WithinPage get execform AnnotateGlass /TypeOfPagesBeingRendered /StickyLabels store //false //false //false //false StickyLabelsPaperType /Portrait SetPaperSize //false DefStoreMgns setmatrix StickyLabelsRotate {setmatrix} if /StickyLabelsNumPaintedOnCurrentPage dup load 1 add store /StickyLabelsPositionOnPage dup load 1 add store } for % StickyLabelCopyNum } if % ... ThisPaperType ... ThisPageOrdering ... and } for % NameNum, or not loop } for % StickieNum StickyLabelsByNameWhichReplaceCirclearrays StickyLabelsNamesChangeFaster not and { StickyLabelsAvoidAcrossColumnsOrRows { /RowOrColLength StickyLabelsColumnsChangeFaster {StickyLabelsWithPagePortraitNumCols} {StickyLabelsWithPagePortraitNumRows} ifelse def StickyLabelsSheetNumWithinPageWithinTitles length StickyLabelsPositionOnPage RowOrColLength mod add RowOrColLength gt { StickyLabelsPositionOnPage RowOrColLength mod dup 0 gt {RowOrColLength exch sub StickyLabelsPositionOnPage add /StickyLabelsPositionOnPage exch store} {pop} ifelse } if % ... RowOrColLength gt } if % StickyLabelsAvoidAcrossColumnsOrRows StickyLabelsAvoidAcrossPages StickyLabelsPositionOnPage 0 gt and StickyLabelsSheetNumWithinPageWithinTitles length StickyLabelsPositionOnPage add StickyLabelsWithPagePortraitNumRows StickyLabelsWithPagePortraitNumCols mul gt and {/StickyLabelsPositionOnPage //IntegerMax store} if % StickyLabelsAvoidAcrossPages ... } if % StickyLabelsByNameWhichReplaceCirclearrays StickyLabelsNamesChangeFaster not and } for % NameNum, or not loop StickyLabelsNumPaintedOnCurrentPage 0 gt {AnnotatePDF ShowPage /StickyLabelsNumPaintedOnCurrentPage 0 def} if setmatrix AnyFillTextingAtAll //DeBugLevel 100 le or {mark (-StickyLabels: execution time ~= ) usertime usertimeStart sub 1000 div (s) ConcatenateToMark OutputToLog} if } if % ... StickyLabelsNumCopies 1 ge ... end } forall % StickyLabelsTypeThis drawn from StickyLabelsTypes } forall % UsedPaperTypes } bind forall % ThisPageOrdering currentdict /ThisPaperType undef currentdict /ThisPageOrdering undef mark /OutlineTitles load MightBeTrue {(Computed bound on OutlineTitlesNumberContours = ) OutlineTitlesNumberContours 0 //false ThingToDebugText} if /InlineTitles load MightBeTrue { {Titles NonEmptyCompoundObject} MightBeTrue //false InlineTitlesNumberContours {{IsNumber {pop //true exit} if} forall} forall and} {//false} ifelse { dup mark ne {(\n)} if (Computed bound on InlineTitlesNumberContours = ) InlineTitlesNumberContours 0 //false ThingToDebugText } if /InlineAbovetitles load MightBeTrue {{Abovetitles NonEmptyCompoundObject} MightBeTrue //false InlineAbovetitlesNumberContours {{IsNumber {pop //true exit} if} forall} forall and} {//false} ifelse { dup mark ne {(\n)} if (Computed bound on InlineAbovetitlesNumberContours = ) InlineAbovetitlesNumberContours 0 //false ThingToDebugText } if /InlineBelowtitles load MightBeTrue {{Belowtitles NonEmptyCompoundObject} MightBeTrue //false InlineBelowtitlesNumberContours {{IsNumber {pop //true exit} if} forall} forall and} {//false} ifelse { dup mark ne {(\n)} if (Computed bound on InlineBelowtitlesNumberContours = ) InlineBelowtitlesNumberContours 0 //false ThingToDebugText } if /InlineOvertitles load MightBeTrue {{Overtitles NonEmptyCompoundObject} MightBeTrue //false InlineOvertitlesNumberContours {{IsNumber {pop //true exit} if} forall} forall and} {//false} ifelse { dup mark ne {(\n)} if (Computed bound on InlineOvertitlesNumberContours = ) InlineOvertitlesNumberContours 0 //false ThingToDebugText } if dup mark ne {ConcatenateToMark OutputToLog} {pop} ifelse /PlaceNames load MightBeTrue { () OutputToLog mark /PlaceNamesFirstAndThirdFoldsFromEdge load xcheck not { PlaceNamesFirstAndThirdFoldsFromEdge 0 gt {(Foldable paper)} {(Stiff card)} ifelse ( should be used for PlaceNames, as PlaceNamesFirstAndThirdFoldsFromEdge = ) PlaceNamesFirstAndThirdFoldsFromEdge (.\n) } if % /PlaceNamesFirstAndThirdFoldsFromEdge load xcheck not (PlaceNamesFontSizes = ) PlaceNamesFontSizes SizeArrayOutput (\nMinimum of PlaceNamesFontSizes = ) //Infinity PlaceNamesFontSizes {{dup IsNumber {2 copy gt {exch} if} if pop} forall} forall dup //Infinity lt {ConcatenateToMark OutputToLog} {cleartomark} ifelse } if % ...PlaceNames ... {BottleWrapNumCopies 1 ge} MightBeTrue { mark (BottleWrapScalingFactors: ) 0 1 Titles length 1 sub { /WithinTitles exch def BottleWrapScalingFactors WithinTitles get type /realtype eq { Titles WithinTitles get ASCIIfy ( = ) BottleWrapScalingFactors WithinTitles get (; ) } if % /realtype } for % WithinTitles pop (.) ConcatenateToMark OutputToLog } if % {BottleWrapNumCopies 1 ge} MightBeTrue /TypeOfPagesBeingRendered /Multiple store mark mark (URL # tags: ) [ [ DestEmpty DestPrefixEmpty ] [ DestOneCircle DestPrefixOneCircle ] [ DestGlasses DestPrefixGlasses ] [ DestTastingNotes DestPrefixTastingNotes ] [ DestVoteRecorder DestPrefixVoteRecorders ] [ DestDecantingNotes DestPrefixDecantingNotes ] [ DestAccounts DestPrefixAccounts ] [ DestCorkDisplay DestPrefixCorkDisplay ] [ DestNeckTags DestPrefixNeckTags ] [ DestPrePour DestPrefixPrePour ] [ DestBottleWrap DestPrefixBottleWrap ] [ DestPlaceName DestPrefixPlaceName ] [ DestDecanterLabels DestPrefixDecanterLabels ] [ DestStickyLabels DestPrefixStickyLabels ] [ DestOther DestPrefixOther ] ]{ 2 dict begin aload pop /Prefix exch def /NumThisType exch def NumThisType 0 gt {Prefix (0) NumThisType 2 ge {NumThisType 2 eq {(, )} {( ... )} ifelse Prefix NumThisType 1 sub} if (; )} if end } forall pop ConcatenateToMark OutputLogToPage OneCircleSuppressOtherPageTypes not and BottleWrapSuppressOtherPageTypes not and {dup length 0 gt {(; )} if (DistillationLog)} if % Log pages likely to exist ShownGlassesCircles 0 gt { 1 index mark ne {(; )} if (and also ) ShownGlassesCircles /GlassesNumCopies load type /integertype eq {dup 0 SheetLengths {add} forall Names length mul GlassesNumCopies mul eq NumSheets 1 ge and { (=) Names length (*) //true 1 1 NumSheets 1 sub {dup 1 sub SheetLengths exch get exch SheetLengths exch get eq and} for {NumSheets (*) SheetLengths 0 get} {(\() SheetLengths {(+)} forall pop (\))} ifelse GlassesNumCopies dup 1 gt {(*) exch} {pop} ifelse } if} if % Sensible to express as a multiplication ( glass-circle zooms of form Circle_#NameNum_#SheetNum_#WithinPage) {GlassesNumCopies 2 ge} MightBeTrue {([_#GlassesCopyNum])} if (, from ) ShownGlassesCirclesData 0 get /GlassesCircleDestName get ( to ) ShownGlassesCirclesData ShownGlassesCircles 1 sub get /GlassesCircleDestName get (.) IsDistiller not {( \(But distillation might not be in Distiller, so these # tags might be missing.\))} if } {(.)} ifelse 1 index mark ne {ConcatenateToMark () OutputToLog OutputToLog} {cleartomark} ifelse //DeBugLevel 50 le {( Main: pdfmark's, DOCVIEW, DOCINFO, {Catalog}...PUT) OutputToLog} if mark /Page 1 /View [/Fit] /PageMode ShownPages 9 gt {/UseOutlines} {/UseThumbs} ifelse /DOCVIEW pdfmark mark /CreationDate ParametersVersionDateTimeAdobeFormat /Title PDF_title ASCIIfy /Author (Julian D. A. Wiseman) /Creator (www.jdawiseman.com/author.html) /Subject mark (PostScript code by Julian D. A. Wiseman; software version ) SoftwareVersionDateTimeAdobeFormat dup length 2 sub 2 exch getinterval (; parameters as of ) ParametersVersionDateTimeAdobeFormat dup length 2 sub 2 exch getinterval /WizardVersionDateTimeAdobeFormat where {pop /WizardLongName where {pop ( \(made by ) WizardLongName (, version = ) WizardVersionDateTimeAdobeFormat dup length 2 sub 2 exch getinterval (\)) } if} if (.) ConcatenateToMark /Keywords (placemat, tasting, glasses, Port, wine, Madeira, whisky) /DOCINFO pdfmark mark {Catalog} << /PageLayout /TwoPageLeft >> /PUT pdfmark % https://groups.google.com/g/comp.text.pdf/c/kh5-xfVOK_g /TypeOfPagesBeingRendered /Multiple store mark /Action << >> /Color [0.4 0.4 0.4] /F 1 /Title (\200 ) ParametersVersionDateTimeAdobeFormat AdobeFormatDateToString Concatenate /OUT pdfmark //DeBugLevel 50 le {( Main: pdfmark's, OUT, in print order) OutputToLog} if mark /Action << >> /Color [0 0 0] /F 2 /Title (\247 In Print Order) ShownPages 0 gt ShownPagesData 0 ShownPages getinterval {/ThisPaperType get dup //null eq {pop pop //false exit} if ShownPagesData 0 get /ThisPaperType get ne {pop //false exit} if} forall {mark exch ( \() ShownPagesData 0 get begin PaperTypeStringShortPDF end (\)) ConcatenateToMark} if /OUT pdfmark /PrevPageOrdering -2147483648 def % PLRM3, p739, "Smallest integer value" /ShownPageThis 0 def { ShownPageThis ShownPages ge {exit} if ShownPagesData ShownPageThis get begin 12 dict begin 1 { ThisPageOrdering PrevPageOrdering ne { 0 2 PageOrderingSections length 2 sub { /i exch def PageOrderingSections i GetEU dup PrevPageOrdering gt exch ThisPageOrdering le and { mark /Action //false i 2 PageOrderingSections length 2 sub {/j exch def ThisPageOrdering PageOrderingSections j get eq PageOrderingSections j 1 add get NonEmptyCompoundObject not and {pop //true exit} if} for {<< >>} {/GoTo /Dest PageDestName} ifelse /Color [0 0 0] /F 1 /Title PageOrderingSections i 1 add get PDFDocEncodingify /OUT pdfmark } if % ... PrevPageOrdering ... ThisPageOrdering ... } for % i /PrevPageOrdering ThisPageOrdering store } if % PrevPageOrdering ThisPageOrdering ne PagesToBeInsertedData { begin PagesToBeInsertedDest type /nametype eq {mark /Action /GoTo /Dest PagesToBeInsertedDest /Title [PagesToBeInsertedDescription ( \(p) PagesToBeInsertedPageNum 1 add (\))] PDFDocEncodingify /Count 0 /F 0 /OUT pdfmark} if /PagesToBeInsertedWarning dup load mark exch ( ") PagesToBeInsertedDescription ASCIIfy (", p) PagesToBeInsertedPageNum 1 add PagesToBeInsertedDest type /nametype eq {(, containing 'Dest' ") PagesToBeInsertedDest (")} if (;) ConcatenateToMark store end } forall % PagesToBeInsertedData TypeOfPagesBeingRendered dup dup /Glasses eq exch /TastingNotes eq or exch /PlaceName eq or { //DeBugLevel 25 le {( Main: pdfmark's, OUT, in print order, Glasses and TastingNotes and PlaceName) OutputToLog} if /NumPagesThisType 1 def /PagesCountGlasses /PagesCountTNs /PagesCountPlaceName TypeOfPagesBeingRendered /Glasses eq {3 -1 roll} if TypeOfPagesBeingRendered /TastingNotes eq {exch} if 1 def 0 def 0 def /NewNamePages [ ShownPageThis { ShownPageThis NumPagesThisType add ShownPages ge {exit} if ThisPageOrdering ThisPaperType ShownPagesData ShownPageThis NumPagesThisType add get begin ThisPaperType ne exch ThisPageOrdering ne or {end exit} if TypeOfPagesBeingRendered dup dup /Glasses ne exch /TastingNotes ne and exch /PlaceName ne and {end exit} if /PlaceName TypeOfPagesBeingRendered eq {/PagesCountPlaceName dup load 1 add store} { /Glasses TypeOfPagesBeingRendered eq SideBySideGlassesTastingNotes or {/PagesCountGlasses dup load 1 add store} if /TastingNotes TypeOfPagesBeingRendered eq SideBySideGlassesTastingNotes or {/PagesCountTNs dup load 1 add store} if } ifelse % /PlaceName ... end ShownPagesData ShownPageThis NumPagesThisType add get /NameNum get ShownPagesData ShownPageThis NumPagesThisType add 1 sub get /NameNum get ne {ShownPageThis NumPagesThisType add} if /NumPagesThisType NumPagesThisType 1 add store } loop ShownPageThis NumPagesThisType add ] def % NewNamePages mark /Action /GoTo /Dest PageDestName /Title mark PagesCountGlasses 0 gt PagesCountTNs 0 gt PagesCountPlaceName 0 gt { { {(Glasses + TNs + Seating)} {(Tasting notes + Seating)} } { {(Glasses + Seating)} {(Seating) } } } { { {(Glasses + TNs) } {(Tasting notes) } } { {(Glasses) } {(\241Error!) } } } ifelse ifelse ifelse ( \() NumPagesThisType 1 eq {(p) PageNum 1 add} {(pp) PageNum 1 add (\205) PageNum NumPagesThisType add} ifelse (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark /Count NewNamePages length 1 sub neg /F 0 /OUT pdfmark 0 1 NewNamePages length 2 sub { /i exch def /ThisNamePagesCountGlasses 0 def /ThisNamePagesCountTNs 0 def /ThisNamePagesCountPlaceName 0 def ShownPagesData NewNamePages i get NewNamePages i 1 add get 1 index sub getinterval { /TypeOfPagesBeingRendered get dup dup /Glasses eq {/ThisNamePagesCountGlasses dup load 1 add store} if /TastingNotes eq {/ThisNamePagesCountTNs dup load 1 add store} if /PlaceName eq {/ThisNamePagesCountPlaceName dup load 1 add store} if } forall % ShownPagesData ... getinterval /ThisNameNumTypes 0 [ ThisNamePagesCountGlasses ThisNamePagesCountTNs ThisNamePagesCountPlaceName ] {1 ge {1 add} if} forall def /ThisNameCount ThisNamePagesCountGlasses ThisNamePagesCountTNs ThisNamePagesCountPlaceName add add dup 2 lt {pop 0} if def ShownPagesData NewNamePages i get get begin mark /Action /GoTo /Dest PageDestName /Title mark /ThisName load PDFDocEncodingify TrimSpaces dup length 0 le {pop UnnamedAttendee PDFDocEncodingify} if NewNamePages i 1 add get NewNamePages i get sub 1 le {( \(p) NewNamePages i get 1 add} {( \(pp) NewNamePages i get 1 add (\205) NewNamePages i 1 add get} ifelse (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark TruncateTo255 /F 0 /Count ThisNameCount neg /OUT pdfmark end ThisNameCount 0 gt { ShownPagesData NewNamePages i get NewNamePages i 1 add get 1 index sub getinterval { begin TypeOfPagesBeingRendered dup dup /Glasses eq exch /TastingNotes eq or exch /PlaceName eq or { 2 dict begin mark /Action /GoTo /Dest PageDestName /Title mark /Glasses TypeOfPagesBeingRendered eq { ThisNameNumTypes 2 ge {(G\220s: )} {()} ifelse mark () 0 1 SheetLengths SheetNum get 1 sub { WithinPage-WithinTitles-def Titles WithinTitles get PDFDocEncodingify TrimSpaces dup length 0 gt {(; )} if } for % WithinPage pop ConcatenateToMark dup length 0 le {pop (SheetNum = ) SheetNum} if ( \(p) PageNum 1 add (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark TruncateTo255 } if % /Glasses ... /TastingNotes TypeOfPagesBeingRendered eq { ThisNameNumTypes 2 ge {(TNs: )} {()} ifelse mark () 0 1 GlassesOnTastingNotePages TNSheetNum GetEU length 1 sub { /WithinPage exch def /WithinTitles GlassesOnTastingNotePages TNSheetNum GetEU WithinPage GetEU def Titles WithinTitles get PDFDocEncodingify TrimSpaces dup length 0 gt {(; )} if % Deliberately not using TitlesTastingNotes } for % WithinPage pop ConcatenateToMark dup length 0 le {pop (TNSheetNum = ) TNSheetNum} if ( \(p) PageNum 1 add (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark TruncateTo255 } if % /TastingNotes ... /PlaceName TypeOfPagesBeingRendered eq { /ThisName load PDFDocEncodingify TrimSpaces dup length 0 le {pop UnnamedAttendee PDFDocEncodingify} if ( \(p) PageNum 1 add (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark TruncateTo255 } if % /PlaceName ... /F 0 /Count 0 /OUT pdfmark end } if % ... /Glasses ... /TastingNotes ... /PlaceName ... end } forall % ShownPagesData ... getinterval } if % ThisNameCount 0 gt } for % i, non-last element of NewNamePages /ShownPageThis ShownPageThis NumPagesThisType 1 sub add store } if % ... /Glasses ... /TastingNotes ... /PlaceName /NumPagesThisType 1 def { ShownPageThis NumPagesThisType add ShownPages ge {exit} if ThisPageOrdering TypeOfPagesBeingRendered ShownPagesData ShownPageThis NumPagesThisType add get begin TypeOfPagesBeingRendered ne exch ThisPageOrdering ne or end {exit} if /StickyLabels TypeOfPagesBeingRendered eq { StickyLabelsWithPagePortraitNumRows ShownPagesData ShownPageThis NumPagesThisType add get begin StickyLabelsWithPagePortraitNumRows end ne {exit} if StickyLabelsWithPagePortraitNumCols ShownPagesData ShownPageThis NumPagesThisType add get begin StickyLabelsWithPagePortraitNumCols end ne {exit} if } if % /StickyLabels ... /NumPagesThisType dup load 1 add store } loop % /NumPagesThisType /OneCircle TypeOfPagesBeingRendered eq { //DeBugLevel 25 le {( Main: pdfmark's, OUT, in print order, OneCircle) OutputToLog} if mark /Action /GoTo /Dest PageDestName /Title mark (One-circle extract) NumPagesThisType 1 eq {( \(p) PageNum 1 add} {(s \(pp) PageNum 1 add (\205) PageNum NumPagesThisType add (\))} ifelse ConcatenateToMark /Count NumPagesThisType neg /F 0 /OUT pdfmark ShownPageThis 1 ShownPageThis NumPagesThisType 1 sub add { /ShownPageThis exch store ShownPagesData ShownPageThis get begin mark /Action /GoTo /Dest PageDestName /F 0 /Title mark () [ Titles Belowtitles Abovetitles Overtitles FillTitles {FillTexts} if ] {WithinTitles get PDFDocEncodingify TrimSpaces dup length 0 gt {(, )} {pop} ifelse} forall pop (, \(p) PageNum 1 add (, sides) Radii SheetNum get 2 mul dup 1 FormatDecimalPlaces dup cvr 3 -1 roll eq {(=)} {(~=)} ifelse exch (pt\)) ConcatenateToMark TruncateTo255 dup length 0 eq {pop mark WithinTitles (=WithinTitles) ConcatenateToMark} if /OUT pdfmark end % ShownPagesData ShownPageThis get } for % ShownPageThis exit } if % /OneCircle ... /VoteRecorder TypeOfPagesBeingRendered eq { //DeBugLevel 25 le {( Main: pdfmark's, OUT, in print order, VoteRecorder) OutputToLog} if mark /Action /GoTo /Dest PageDestName /Title mark (Vote recorder) NumPagesThisType 1 eq {( \(p) PageNum 1 add} {(s \(pp) PageNum 1 add (\205) PageNum NumPagesThisType add} ifelse (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark /Count NumPagesThisType neg /F 0 /OUT pdfmark ShownPageThis 1 ShownPageThis NumPagesThisType 1 sub add { /ShownPageThis exch store ShownPagesData ShownPageThis get begin mark /Action /GoTo /Dest PageDestName /F 0 /Title mark VoteRecorderTopTexts VoteRecorderSheetNum get VoteRecorderTopTextNum get PDFDocEncodingify TrimSpaces dup length 0 le {pop (Vote recorder)} if ( \(p) PageNum 1 add (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark TruncateTo255 /OUT pdfmark end % ShownPagesData ShownPageThis get } for % ShownPageThis exit } if % /VoteRecorder ... /DecantingNotes TypeOfPagesBeingRendered eq { //DeBugLevel 25 le {( Main: pdfmark's, OUT, in print order, DecantingNotes) OutputToLog} if mark /Action /GoTo /Dest PageDestName /Title mark (Decanting notes) ( \() NumPagesThisType 1 eq {(p) PageNum 1 add} {(pp) PageNum 1 add (\205) PageNum NumPagesThisType add} ifelse (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark /Count NumPagesThisType neg /F 0 /OUT pdfmark ShownPageThis 1 ShownPageThis NumPagesThisType 1 sub add { /ShownPageThis exch store ShownPagesData ShownPageThis get begin mark /Action /GoTo /Dest PageDestName /F 0 /Title mark mark () 3 dict begin 0 1 GlassesClusteredOnDecantingNotes DecantingNotesSheetNum get length 1 sub { /ClusterNum exch def 0 1 GlassesClusteredOnDecantingNotes DecantingNotesSheetNum get ClusterNum GetEU length 1 sub { /WithinCluster exch def /WithinTitles GlassesClusteredOnDecantingNotes DecantingNotesSheetNum GetEU ClusterNum GetEU WithinCluster GetEU def WithinTitles 0 ge {TitlesDecantingNotes WithinTitles get PDFDocEncodingify TrimSpaces dup length 0 gt {(; )} if} if } for % WithinCluster, WithinTitles } for % ClusterNum end pop ConcatenateToMark dup length 0 le {pop (Decanting notes)} if ( \(p) PageNum 1 add (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark TruncateTo255 /OUT pdfmark end % ShownPagesData ShownPageThis get } for % ShownPageThis exit } if % /DecantingNotes ... /Accounts TypeOfPagesBeingRendered eq { //DeBugLevel 25 le {( Main: pdfmark's, OUT, in print order, Accounts) OutputToLog} if mark /Action /GoTo /Dest PageDestName /Title mark (Accounts) ( \() NumPagesThisType 1 eq {(p) PageNum 1 add} {(pp) PageNum 1 add (\205) PageNum NumPagesThisType add} ifelse (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark /Count NumPagesThisType dup 1 gt {neg} {pop 0} ifelse /F 0 /OUT pdfmark ShownPageThis 1 ShownPageThis NumPagesThisType 1 sub add NumPagesThisType 1 le {pop 1 index 1 sub} if { /ShownPageThis exch store ShownPagesData ShownPageThis get begin mark /Action /GoTo /Dest PageDestName /F 0 /Title mark (Accounts \(p) PageNum 1 add (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark TruncateTo255 /OUT pdfmark end % ShownPagesData ShownPageThis get } for % ShownPageThis exit } if % /Accounts ... /CorkDisplay TypeOfPagesBeingRendered eq { //DeBugLevel 25 le {( Main: pdfmark's, OUT, in print order, CorkDisplay) OutputToLog} if mark /Action /GoTo /Dest PageDestName /Count NumPagesThisType neg /F 0 /Title mark (Cork display \() NumPagesThisType 1 eq {(p) PageNum 1 add} {(pp) PageNum 1 add (\205) PageNum NumPagesThisType add} ifelse (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark /OUT pdfmark ShownPageThis 1 ShownPageThis NumPagesThisType 1 sub add { /ShownPageThis exch store ShownPagesData ShownPageThis get begin mark /Action /GoTo /Dest PageDestName /F 0 /Title mark CorkDisplayThisPageTitles PDFDocEncodingify TrimSpaces dup length 0 le {pop (Cork display)} if ( \(p) PageNum 1 add (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark TruncateTo255 /OUT pdfmark end } for % ShownPageThis exit } if % /CorkDisplay ... /NeckTags TypeOfPagesBeingRendered eq { //DeBugLevel 25 le {( Main: pdfmark's, OUT, in print order, NeckTags) OutputToLog} if mark /Action /GoTo /Dest PageDestName /Count NumPagesThisType neg /F 0 /Title mark (Neck tags \() NumPagesThisType 1 eq {(p) PageNum 1 add} {(pp) PageNum 1 add (\205) PageNum NumPagesThisType add} ifelse (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark /OUT pdfmark ShownPageThis 1 ShownPageThis NumPagesThisType 1 sub add { /ShownPageThis exch store ShownPagesData ShownPageThis get begin mark /Action /GoTo /Dest PageDestName /F 0 /Title mark NeckTagsThisPageTitles PDFDocEncodingify TrimSpaces dup length 0 le {pop (Neck tags)} if ( \(p) PageNum 1 add (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark TruncateTo255 /OUT pdfmark end } for % ShownPageThis exit } if % /NeckTags ... /PrePour TypeOfPagesBeingRendered eq { //DeBugLevel 25 le {( Main: pdfmark's, OUT, in print order, PrePour) OutputToLog} if mark /Action /GoTo /Dest PageDestName /Count NumPagesThisType neg /F 0 /Title mark (Pre-pour) NumPagesThisType 1 eq {( \(p) PageNum 1 add} {(s \(pp) PageNum 1 add (\205) PageNum NumPagesThisType add} ifelse (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark /OUT pdfmark ShownPageThis 1 ShownPageThis NumPagesThisType 1 sub add { /ShownPageThis exch store ShownPagesData ShownPageThis get begin 2 dict begin mark /Action /GoTo /Dest PageDestName /PrePourTitlingPieces [ Titles WithinTitles get PDFDocEncodingify TrimSpaces [ Abovetitles Belowtitles Overtitles ] {WithinTitles get PDFDocEncodingify TrimSpaces dup length 0 eq {pop} if} forall ] def /PrePourTitlingPieces [ 0 1 PrePourTitlingPieces length 1 sub {/i exch def PrePourTitlingPieces i get 0 1 i 1 sub {PrePourTitlingPieces exch get 1 index eq {pop exit} if} for} for ] def /Title mark mark PrePourTitlingPieces {(, )} forall pop ConcatenateToMark dup length 0 le {pop (Pre-pour)} if ( \(p) PageNum 1 add (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark TruncateTo255 /F 0 /OUT pdfmark end end } for % ShownPageThis exit } if % /PrePour ... /BottleWrap TypeOfPagesBeingRendered eq { //DeBugLevel 25 le {( Main: pdfmark's, OUT, in print order, BottleWrap) OutputToLog} if mark /Action /GoTo /Dest PageDestName /Count NumPagesThisType neg /F 0 /Title mark (Bottle-wrap) NumPagesThisType 1 eq {( \(p) PageNum 1 add} {(s \(pp) PageNum 1 add (\205) PageNum NumPagesThisType add} ifelse (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark /OUT pdfmark ShownPageThis 1 ShownPageThis NumPagesThisType 1 sub add { /ShownPageThis exch store ShownPagesData ShownPageThis get begin 2 dict begin mark /Action /GoTo /Dest PageDestName /BottleWrapTitlingPieces [ Titles WithinTitles get PDFDocEncodingify TrimSpaces [ Abovetitles Belowtitles Overtitles ] {WithinTitles get PDFDocEncodingify TrimSpaces dup length 0 eq {pop} if} forall ] def /BottleWrapTitlingPieces [ 0 1 BottleWrapTitlingPieces length 1 sub {/i exch def BottleWrapTitlingPieces i get 0 1 i 1 sub {BottleWrapTitlingPieces exch get 1 index eq {pop exit} if} for} for ] def /Title mark mark BottleWrapTitlingPieces {(, )} forall pop ConcatenateToMark dup length 0 le {pop (Bottle-wrap)} if ( \(p) PageNum 1 add (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark TruncateTo255 /F 0 /OUT pdfmark end end } for % ShownPageThis exit } if % /BottleWrap ... /DecanterLabels TypeOfPagesBeingRendered eq { //DeBugLevel 25 le {( Main: pdfmark's, OUT, in print order, DecanterLabels) OutputToLog} if mark /Action /GoTo /Dest PageDestName /Title mark (Decanter labels) ( \() NumPagesThisType 1 eq {(p) PageNum 1 add} {(pp) PageNum 1 add (\205) PageNum NumPagesThisType add} ifelse (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark /Count NumPagesThisType neg /F 0 /OUT pdfmark ShownPageThis 1 ShownPageThis NumPagesThisType 1 sub add { /ShownPageThis exch store ShownPagesData ShownPageThis get begin mark /Action /GoTo /Dest PageDestName /F 0 /Title mark DecanterLabelsThisPageTitles PDFDocEncodingify TrimSpaces dup length 0 le {pop (Decanter labels)} if ( \(p) PageNum 1 add (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark TruncateTo255 /OUT pdfmark end % ShownPagesData ShownPageThis get } for % ShownPageThis } if % /DecanterLabels /StickyLabels TypeOfPagesBeingRendered eq { //DeBugLevel 25 le {( Main: pdfmark's, OUT, in print order, StickyLabels) OutputToLog} if mark /Action /GoTo /Dest PageDestName /Count NumPagesThisType dup 1 eq {pop 0} {neg} ifelse /F 0 /Title mark (Sticky labels, ) StickyLabelsWithPagePortraitNumCols (\327) StickyLabelsWithPagePortraitNumRows NumPagesThisType 1 eq {( \(p) PageNum 1 add} {( \(pp) PageNum 1 add (\205) PageNum NumPagesThisType add} ifelse (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark TruncateTo255 /OUT pdfmark ShownPageThis 1 ShownPageThis 1 sub NumPagesThisType 1 ne {NumPagesThisType add} if % So don't do if NumPagesThisType is 1 { /ShownPageThis exch store ShownPagesData ShownPageThis get begin mark /Action /GoTo /Dest PageDestName /F 0 /Title mark StickyLabelsThisPageTitlesNames PDFDocEncodingify TrimSpaces dup length 0 le {pop (Sticky labels)} if ( \(p) PageNum 1 add (, ) PaperTypeStringShortPDF (\)) ConcatenateToMark TruncateTo255 /OUT pdfmark end % ShownPagesData ShownPageThis get } for % ShownPageThis exit } if % /StickyLabels ... /Empty TypeOfPagesBeingRendered eq { //DeBugLevel 25 le {( Main: pdfmark's, OUT, in print order, Empty) OutputToLog} if mark /Action /GoTo /Dest PageDestName /Title [(Empty: ) EmptyPageString ( \(p) PageNum 1 add (\))] PDFDocEncodingify TrimSpaces TruncateTo255 /F 0 /OUT pdfmark exit } if % /Empty ... } repeat % 1 end end /ShownPageThis ShownPageThis 1 add def } bind loop % ShownPageThis //DeBugLevel 50 le {( Main: pdfmark's, OUT, re-arranged) OutputToLog} if /TypeOfPagesBeingRendered /DistillerLog def OutputLogToPage {false PageSuppressed not} {false} ifelse { 0 2 PageOrderingSections length 2 sub { /i exch def PageOrderingSections i GetEU PrevPageOrdering gt {mark /Action << >> /Color [0 0 0] /F 1 /Title PageOrderingSections i 1 add get PDFDocEncodingify /OUT pdfmark} if } for % i /DistillationLogPaperType /TastingNotesPaperType dup where {exch get dup /USL ne {pop /A4} if} {pop /A4} ifelse def mark /Action /GoTo /Dest /DistillationLog /Title mark (Distillation log \() OutputtedToLog 2 mul ExternalLinks length 3 idiv add 120 gt {(from )} if (p) ShownPageThis 0 gt {ShownPagesData ShownPageThis 1 sub get /PageNum get 2 add} {0} ifelse (, ) << /ThisPaperType DistillationLogPaperType >> begin PaperTypeStringShortPDF end (\)) ConcatenateToMark TruncateTo255 /F 0 /OUT pdfmark % Log page lacks ShownPagesData, so using one more than previous; and "from" if likely to be more than one page. } if % OutputLogToPage ... [ 0 1 NumSheets 1 sub {/SheetNum exch def {GlassesNumCopies 1 ge} MightBeTrue {PageOrderingGlasses SheetNum GetEU} if} for 0 1 GlassesOnTastingNotePages length 1 sub {/TNSheetNum exch def {TastingNotePagesNumCopies 1 ge} MightBeTrue {PageOrderingTastingNotePages TNSheetNum GetEU} if} for ] dup {le} ShellSort /RelevantPageOrderings exch def //false 1 1 RelevantPageOrderings length 1 sub {RelevantPageOrderings exch 2 copy 1 sub get 3 1 roll get eq {pop //true exit} if} for currentdict /RelevantPageOrderings undef { /ShownPagesBySheetNum [ NumSheets {0} repeat ] def /ShownPagesByTastingSheetNum [ GlassesOnTastingNotePages length {0} repeat ] def /ShownPagesSideBySideByNum [ NumSheets GlassesOnTastingNotePages length 2 copy lt {exch} if pop {0} repeat ] def ShownPagesData 0 ShownPages getinterval { begin SideBySideGlassesTastingNotes { ShownPagesSideBySideByNum /SheetNum dup where {exch get} {pop /TNSheetNum dup where {exch get} {pop //null} ifelse} ifelse dup type /integertype ne {pop pop} {2 copy get 1 add put} ifelse }{ /Glasses TypeOfPagesBeingRendered eq {ShownPagesBySheetNum SheetNum 2 copy get 1 add put} if /TastingNotes TypeOfPagesBeingRendered eq {ShownPagesByTastingSheetNum TNSheetNum 2 copy get 1 add put} if } ifelse % SideBySideGlassesTastingNotes end } forall % ShownPagesData ... //false ShownPagesBySheetNum {0 gt {pop //true exit} if} forall ShownPagesByTastingSheetNum {0 gt {pop //true exit} if} forall { % http://groups.google.com/g/comp.lang.postscript/c/dcOto3ySuYE mark /Action << >> /Color [0 0 0] /F 0 /Title () /OUT pdfmark mark /Action << >> /Color [0 0 0] /F 2 /Title (\247 Re-ordered) /OUT pdfmark % Not bothering to show side-by-sides. In practice, documents with s-b-s are so small that navigation irrelevant. //false ShownPagesBySheetNum {0 gt {pop //true exit} if} forall { /PdfmarkShownHeaderLevel0 //false def 0 1 NumSheets 1 sub { /SheetNum exch def ShownPagesBySheetNum SheetNum get 0 gt { /PdfmarkShownHeaderLevel1 //false def ShownPagesData 0 ShownPages getinterval { SheetNum exch begin /Glasses TypeOfPagesBeingRendered eq {SheetNum eq} {pop //false} ifelse SideBySideGlassesTastingNotes not and { PdfmarkShownHeaderLevel0 not { mark /Action /GoTo /Dest PageDestName /Title (Glasses) //true PaperTypes length 1 ge {1 1 PaperTypes length 1 sub {PaperTypes exch get PaperTypes 0 get ne {pop //false exit} if} for % Duplicates not already removed {mark exch ( \() << /ThisPaperType PaperTypes 0 get >> begin PaperTypeStringShortPDF end (\)) ConcatenateToMark} if} if % Only one PaperType /F 0 /Color [0.4 0.4 0.4] /Count 0 ShownPagesBySheetNum {0 gt {1 sub} if} forall /OUT pdfmark /PdfmarkShownHeaderLevel0 //true store } if % PdfmarkShownHeaderLevel0 not PdfmarkShownHeaderLevel1 not { mark /Action /GoTo /Dest PageDestName /Color [0 0 1] /F 0 /Count ShownPagesBySheetNum SheetNum get neg /Title mark mark () 0 1 SheetLengths SheetNum get 1 sub { 2 dict begin WithinPage-WithinTitles-def Titles WithinTitles get PDFDocEncodingify TrimSpaces dup length 0 gt {(; )} if end } for % WithinPage pop ConcatenateToMark TruncateTo255 dup length 0 le {pop (SheetNum = ) SheetNum} if ( \() << /ThisPaperType PaperType >> begin PaperTypeStringShortPDF end (\)) ConcatenateToMark /OUT pdfmark /PdfmarkShownHeaderLevel1 //true store } if % PdfmarkShownHeaderLevel1 not mark /Action /GoTo /Dest PageDestName /F 0 /Title [Names NameNum get dup length 0 le {pop UnnamedAttendee} if ( \(p) PageNum 1 add (, ) PaperTypeStringShortPDF (\))] PDFDocEncodingify TrimSpaces TruncateTo255 /OUT pdfmark } if end } forall % ShownPagesData ... } if % ShownPagesBySheetNum SheetNum get 0 gt } bind for % SheetNum } if % Any glasses sheets //false ShownPagesByTastingSheetNum {0 gt {pop //true exit} if} forall { /PdfmarkShownHeaderLevel0 //false def 0 1 GlassesOnTastingNotePages length 1 sub { /TNSheetNum exch def ShownPagesByTastingSheetNum TNSheetNum get 0 gt { /PdfmarkShownHeaderLevel1 //false def ShownPagesData 0 ShownPages getinterval { TNSheetNum exch begin /TastingNotes TypeOfPagesBeingRendered eq {TNSheetNum eq} {pop //false} ifelse SideBySideGlassesTastingNotes not and { PdfmarkShownHeaderLevel0 not { mark /Action /GoTo /Dest PageDestName /Title (Tasting notes) TastingNotesPaperTypes length 1 eq {mark exch ( \() << /ThisPaperType TastingNotesPaperTypes 0 get >> begin PaperTypeStringShortPDF end (\)) ConcatenateToMark} if % Duplicates already removed /F 0 /Color [0.4 0.4 0.4] /Count 0 ShownPagesByTastingSheetNum {0 gt {1 sub} if} forall /OUT pdfmark /PdfmarkShownHeaderLevel0 //true store } if % PdfmarkShownHeaderLevel0 not PdfmarkShownHeaderLevel1 not { mark /Action /GoTo /Dest PageDestName /Color [0.4 0.4 0.4] /F 0 /Count ShownPagesByTastingSheetNum TNSheetNum get neg /Title mark mark () 0 1 GlassesOnTastingNotePages TNSheetNum GetEU length 1 sub { 2 dict begin /WithinPage exch def /WithinTitles GlassesOnTastingNotePages TNSheetNum GetEU WithinPage GetEU def Titles WithinTitles get PDFDocEncodingify TrimSpaces dup length 0 gt {(; )} if % Deliberately not using TitlesTastingNotes end } for % WithinPage pop ConcatenateToMark TruncateTo255 dup length 0 le {pop (TNSheetNum = ) TNSheetNum} if ( \() << /ThisPaperType TastingNotesPaperType >> begin PaperTypeStringShortPDF end (\)) ConcatenateToMark /OUT pdfmark /PdfmarkShownHeaderLevel1 //true store } if % PdfmarkShownHeaderLevel1 not mark /Action /GoTo /Dest PageDestName /F 0 /Title [NamesTastingNotes NameNum get dup length 0 le {pop UnnamedAttendee} if ( \(p) PageNum 1 add (, ) PaperTypeStringShortPDF (\))] PDFDocEncodingify TrimSpaces TruncateTo255 /OUT pdfmark } if end } forall % ShownPagesData ... } if % ShownPagesByTastingSheetNum TNSheetNum get 0 gt } bind for % TNSheetNum } if % Any TN sheets } if % Any relevant sheets } if % There are glasses or TN sheets with the same page ordering 4 dict begin /FirstGlasses % Despite appearances, functionally linear in n. Even in multi-session tastings, if a glass is a repeat then it appears nearby. [ 0 1 ShownGlassesCircles 1 sub { dup /i exch def i 1 sub -1 0 % Faster if j loop starts near i, as in multi-session tastings will find match quicker. { /j exch def ShownGlassesCirclesData i get begin SheetNum WithinPage WithinTitles end ShownGlassesCirclesData j get begin WithinTitles WithinPage SheetNum end 6 -1 roll eq 4 2 roll eq and 3 1 roll eq and {pop exit} if } for % j } bind for % i ] def % /FirstGlasses FirstGlasses length 0 gt NumSheets 0 gt and { FirstGlasses { /ShownGlassesNum exch def ShownGlassesCirclesData ShownGlassesNum get begin 2 dict begin /ShownGlassesCount 1 def ShownGlassesNum 1 add 1 ShownGlassesCircles 1 sub { /i exch def ShownGlassesCirclesData i get begin SheetNum WithinPage WithinTitles end WithinTitles eq exch WithinPage eq and exch SheetNum eq and {/ShownGlassesCount dup load 1 add store} if } for FirstGlasses 0 get ShownGlassesNum eq { mark /Action /GoTo /Dest GlassesCircleDestName /Color [0 0 0] /F 0 /Count FirstGlasses length 1 add neg % 1 add because of links to bug report /Title mark (Zooms of ) /GlassesNumCopies load type /integertype eq Names length 0 gt and {0 SheetLengths {add} forall Names length mul GlassesNumCopies mul ShownGlassesCircles eq { ShownGlassesCircles (=) Names length (\327) 0 SheetLengths {add} forall GlassesNumCopies dup 1 gt {(\327) exch} {pop} ifelse ( ) } if} if (glass circles) ConcatenateToMark /OUT pdfmark } if % First circle. Code must be here because GlassesCircleDestName needed. mark /Action /GoTo /Dest GlassesCircleDestName /Color [0.4 0.4 0.4] /F 0 /Count ShownGlassesCount dup 1 gt {neg} {pop 0} ifelse /Title mark mark Titles WithinTitles get PDFDocEncodingify [ Abovetitles Belowtitles Overtitles ] {WithinTitles get PDFDocEncodingify TrimSpaces dup length 0 gt {(, ) exch} {pop} ifelse} forall ConcatenateToMark dup length 0 le {pop (SheetNum=) SheetNum (, WithinPage=) WithinPage} if ( \() ShownGlassesCount 1 eq {(p) PageNum 1 add (, )} if << /ThisPaperType PaperType >> begin PaperTypeStringShortPDF end (\)) ConcatenateToMark TruncateTo255 /OUT pdfmark ShownGlassesCount 1 gt { ShownGlassesNum 1 ShownGlassesCircles 1 sub % Starts 1 earlier than before { /i exch def ShownGlassesCirclesData i get begin SheetNum WithinPage WithinTitles end WithinTitles eq exch WithinPage eq and exch SheetNum eq and { ShownGlassesCirclesData i get begin mark /Action /GoTo /Dest GlassesCircleDestName /Color [0 0 0] /F 0 /Count 0 /Title mark Names NameNum get PDFDocEncodingify TrimSpaces dup length 0 le {pop UnnamedAttendee PDFDocEncodingify} if ( \(p) PageNum 1 add (, ) << /ThisPaperType PaperType >> begin PaperTypeStringShortPDF end (\)) ConcatenateToMark TruncateTo255 /OUT pdfmark end } if } for % i } if % ShownGlassesCount 1 gt end end } bind forall % /ShownGlassesNum mark /Title (\(Mac Preview: zoom-in fails\)) /Color [0.4 0.4 0.4] /Action << /Subtype /URI /URI (http://discussions.apple.com/thread/7234631) >> /Count 0 /F 0 /OUT pdfmark } if % FirstGlasses length 0 gt NumSheets 0 gt and end ExternalLinks length 3 ge { mark /Action << >> /Color [0 0 0] /Title () /F 0 /OUT pdfmark mark /Action << >> /Color [0 0 0] /Title ExternalLinks length 3 gt {(\247 External Links)} {(\247 External Link)} ifelse /F 2 /OUT pdfmark /NextF 0 def 0 3 ExternalLinks length 3 sub { /i exch def /IndentationCount 0 ExternalLinks i GetEU not {i 3 add 3 ExternalLinks length 3 sub {ExternalLinks exch GetEU {1 add} {exit} ifelse} for} if def mark ExternalLinks i 2 add GetEU length 0 gt {/Color [0 0 0 ] /Action << /Subtype /URI /URI ExternalLinks i 2 add GetEU >>} {/Color [0 0 0.6] /Action << >>} ifelse /Title ExternalLinks i 1 add get PDFDocEncodingify /Count IndentationCount neg /F NextF 0 eq {ExternalLinks i 2 add GetEU length 0 gt {0} {1} ifelse} {NextF} ifelse /OUT pdfmark /NextF ExternalLinks i 1 add GetEU length 0 gt {0} {2} ifelse store } for % i } if % ExternalLinks length 3 ge mark /Action << >> /Color [0 0 0] /Title () /F 0 /OUT pdfmark mark /Action << /Subtype /URI /URI (http://github.com/jdaw1/placemat/) >> /Color [0 0 0] /Title (\247 Placemat software) /F 2 /OUT pdfmark mark /Action << >> /Color [0.4 0.4 0.4] /Title mark (\(ver: ) SoftwareVersionDateTimeAdobeFormat (\)) ConcatenateToMark /F 1 /OUT pdfmark 0 3 ExternalLinksExtras length 3 sub { /i exch def /IndentationCount 0 ExternalLinksExtras i GetEU not {i 3 add 3 ExternalLinksExtras length 3 sub {ExternalLinksExtras exch GetEU {1 add} {exit} ifelse} for} if def mark /Action ExternalLinksExtras i 2 add GetEU length 0 gt {<< /Subtype /URI /URI ExternalLinksExtras i 2 add GetEU >> /Color [0 0 0]} {<< >> /Color [0 0 1]} ifelse /Title ExternalLinksExtras i 1 add get PDFDocEncodingify /Count IndentationCount neg /F 0 /OUT pdfmark } for % i //DeBugLevel 50 le {(-Outline construction, and other pdfmark's) OutputToLog} if OuterMarginLogsNum 0 gt {mark OuterMarginLogs 0 OuterMarginLogsNum getinterval {(\n)} forall pop ConcatenateToMark OutputToLog} if PagesToBeInserted {PagesToBeInsertedWarning OutputToLog} if EpilogueCode mark (Execution time) usertime usertimeStart sub TimeIntervalString (, excluding time for parameter assignments and log page(s).) ConcatenateToMark OutputToLog /EndError //false def count mark exch dup 0 eq {(:-\) )} {/EndError //true store (Error! )} ifelse exch ( = count: should = 0\n) dup 3 -1 roll 5 string cvs dup length 5 exch sub exch putinterval vmstatus pop pop dup dup 1 eq exch 2 eq or {(:-\) )} {/EndError //true store (Error! )} ifelse exch ( = vmstatus pop pop: should = 1|2\n) dup 3 -1 roll 5 string cvs dup length 5 exch sub exch putinterval CountClipStack dup 0 eq {(:-\) )} {/EndError //true store (Error! )} ifelse exch ( = CountClipStack: should = 0\n) dup 3 -1 roll 5 string cvs dup length 5 exch sub exch putinterval CountGraphicsStack dup 0 eq {(:-\) )} {/EndError //true store (Error! )} ifelse exch ( = CountGraphicsStack: should = 0\n) dup 3 -1 roll 5 string cvs dup length 5 exch sub exch putinterval countdictstack dup 3 eq {(:-\) )} {/EndError //true store (Error! )} ifelse exch ( = countdictstack: should = 3\n) dup 3 -1 roll 5 string cvs dup length 5 exch sub exch putinterval ConcatenateToMark OutputToLog EndError {(!!! Error !!! Error !!! Error !!! !!! Error !!! Error !!! Error !!! !!! Error !!! Error !!! Error !!!) OutputToLog} {OutputLog 0 (:-\) :-\) Happily, execution successfully completed. :-\) :-\)) put} ifelse % EndError count 0 ne {(+pstack) = pstack (-pstack) =} if } stopped % From about 7.9k lines above. { /ErrorFlag where {/ErrorFlag get} {//false} ifelse % Error in parameter(s) { (Error: execution stopped, probably because of a parameter error or inconsistency.) OutputToLog }{ (An error has occured. Items of $error:) OutputToLog ($error /errorname = ) $error /errorname get 0 //true ThingToDebugText Concatenate OutputToLog ($error /command = ) $error /command get 0 //true ThingToDebugText Concatenate OutputToLog mark ($error /ostack = [) (\n) $error /ostack get {(\t) exch 0 //true ThingToDebugText (\n) dup} forall pop (]) ConcatenateToMark OutputToLog ($error countdictstack = ) countdictstack 5 string cvs Concatenate OutputToLog mark ($error top instance of TypeOfPagesBeingRendered = ) TypeOfPagesBeingRendered ConcatenateToMark OutputToLog mark ($error userdict->TypeOfPagesBeingRendered = ) userdict /TypeOfPagesBeingRendered get ConcatenateToMark OutputToLog $error /newerror //false put $error /errorinfo //null put } ifelse % ErrorFlag } if % stopped OutputLogToAnnotation ShownPages 0 gt and { mark /Subtype /Text /SrcPg ShownPages /Rect [ ShownPagesData ShownPages 1 sub get begin PageWidth MgnR sub MgnB end 2 copy ] /Title (Distillation log) /Subject (The log output from the progam that converted the PostScript to PDF. Mostly human-readable.) /Contents mark (Placemat software:\nhttp://github.com/jdaw1/placemat/) OutputLog {dup type /stringtype eq {(\n\n) exch} {pop exit} ifelse} forall ConcatenateToMark /NM (DistillationLog) /M ParametersVersionDateTimeAdobeFormat /CreationDate 1 index /F 64 128 add % ReadOnly + Locked. PDFReference16.pdf page 574 /C [0.4] /Q 0 % = left-justfied, but a parameter of a FreeText annotation. /DS (font-family: monospace;) % Default Style, but a parameter of a FreeText annotation. /Open false /ANN pdfmark } if % OutputLogToAnnotation ... /TypeOfPagesBeingRendered /DistillerLog def OutputLogToPage {false PageSuppressed not} {false} ifelse {{ 35 dict begin /TypeOfPagesBeingRendered /DistillerLog def % def rather than store in case top-most instance of TypeOfPagesBeingRendered is in a readonly dictionary /OuterMarginL 0 def /OuterMarginR 0 def /OuterMarginT 0 def /OuterMarginB 0 def % Fixed page size based on type of first page. Also will use 27 margins all round. Page not really for high-quality printing. /SPS {//false //false //false //true TastingNotesPaperType NorthAmericanPaperSize {/USL} {/A4} ifelse /Portrait SetPaperSize} bind def SPS mark /Dest /DistillationLog /View [/FitH PageHeight] /DEST pdfmark mark /Label (Distillation log) /PAGELABEL pdfmark /FontSize 6.25 def /Courier FontSize selectfont /WidthW (W) stringwidth pop def % Large initial FontSize, constrained by >=132 char limit, on A4 is FontSize ~=6.833; 6.25 leads to 6.22043. /FontSize PageWidth 54 sub //PrinterEpsilon sub dup WidthW div ceiling 132 2 copy lt {exch} if pop WidthW mul div FontSize mul def % /FontSize WatchExpression /YlineStep FontSize 1.125 mul def /YparaExtra FontSize 0.75 mul def /YblankLine 0 def /Y PageHeight 27 sub YlineStep sub def /ForcedLineBreak //false def /Courier-Bold FontSize selectfont 27 Y moveto 0 0 0.9333333 setrgbcolor % #0000EE http://www.w3.org/TR/html5/rendering.html http://stackoverflow.com/questions/4774022/ /LogHeaders [ (http://github.com/jdaw1/placemat/) (http://github.com/jdaw1/placemat/blob/main/PostScript/placemat.ps) ] def /LogHeaderGap PageWidth 54 sub LogHeaders {stringwidth pop sub} forall LogHeaders length dup 3 ge {1 sub div} {pop} ifelse def LogHeaders {show LogHeaderGap 0 rmoveto /AnythingOnPage //true def} forall /Y Y YlineStep sub YparaExtra sub def /Courier FontSize selectfont /WidthW (W) stringwidth pop def 0 setgray OutputLog 0 OutputtedToLog getinterval { //false PageSuppressed {pop exit} if dup length 16384 gt {0 16384 getinterval dup 16381 (...) putinterval (Warning: OutputLogToPage, string of length exceeding 16384 in OutputLog. Paragraph trimmed.) =} if /TextToPaint exch def TextToPaint type /stringtype ne {/TextToPaint TextToPaint ToString def (Warning: OutputLogToPage, non-string in OutputLog.) =} if /CharsPainted 0 def % what has been painted from within TextToPaint { /NumCharsPerLine PageWidth 54 sub WidthW div cvi dup 1 lt {pop 1} if def % within loop allows re-definition for Copyright special case TextToPaint length 0 eq {/Y Y YblankLine sub def exit} if % Newlines { CharsPainted TextToPaint length ge {exit} if TextToPaint CharsPainted get //AsciiNewline eq {/CharsPainted CharsPainted 1 add def /Y Y YlineStep sub def} {exit} ifelse } loop Y 27 lt { //true PageSuppressed not {showpage /ShownPages dup load 1 add store} {erasepage initgraphics} ifelse /AnythingOnPage //false def SPS /Y PageHeight 27 sub YlineStep sub def //false PageSuppressed {exit} if } if % Y 27 lt 27 Y moveto CharsPainted 0 eq TextToPaint length 10 ge and {TextToPaint 0 10 getinterval (Copyright ) eq} {false} ifelse { /copyright glyphshow ( ) show /NumCharsPerLine NumCharsPerLine 2 sub dup 0 lt {pop 0} if def } if % Copyright at start of line % Tabs { CharsPainted TextToPaint length ge {exit} if TextToPaint CharsPainted get //AsciiTab ne {exit} if /CharsPainted CharsPainted 1 add def WidthW 4 mul 0 rmoveto /NumCharsPerLine NumCharsPerLine 3 sub dup 0 lt {pop 0} if def } loop % If not at start of string or forced line break, go to next non-space CharsPainted 0 gt ForcedLineBreak not and { { CharsPainted TextToPaint length ge {exit} if TextToPaint CharsPainted get //AsciiSpace eq {/CharsPainted CharsPainted 1 add def} {exit} ifelse } loop } if % CharsPainted 0 gt ForcedLineBreak not and CharsPainted TextToPaint length ge {/Y Y YparaExtra sub def exit} if % So CharsPainted points to a non-space. Where does this line break? /EndThisLine TextToPaint length 1 sub def CharsPainted 1 EndThisLine {dup TextToPaint exch get //AsciiNewline eq {/EndThisLine exch def /ForcedLineBreak //true def exit} {pop /ForcedLineBreak //false def} ifelse} for % to next newline EndThisLine CharsPainted sub NumCharsPerLine gt { CharsPainted NumCharsPerLine add 1 sub -1 CharsPainted NumCharsPerLine 2 div ceiling cvi add { /EndThisLine exch def TextToPaint EndThisLine get //AsciiSpace eq {exit} if } for } if TextToPaint CharsPainted EndThisLine CharsPainted sub TextToPaint EndThisLine get //AsciiNewline ne {1 add} if getinterval /TextToShow exch def /j 0 def { /i j def i TextToShow length ge {exit} if i 1 TextToShow length 1 sub {/j exch def TextToShow j get //AsciiTab eq {/j j 1 sub def exit} if} for /j j 1 add def j i gt { /ThisLineToShow TextToShow i j i sub getinterval def {TextToShow dup length dup 0 eq {pop pop exit} if 1 sub 2 copy get dup //AsciiTab eq exch //AsciiSpace eq or {0 exch getinterval /TextToShow exch def} {pop pop exit} ifelse} loop % Trim tabs and spaces from end 1 { //false 0 1 ThisLineToShow length 5 sub {ThisLineToShow exch 5 getinterval (Error) eq {pop //true} if dup {exit} if} for 0 1 ThisLineToShow length 3 sub {ThisLineToShow exch 3 getinterval (!!!) eq {pop //true} if dup {exit} if} for 0 1 ThisLineToShow length 7 sub {ThisLineToShow exch 7 getinterval (Warning) eq {pop //true} if dup {exit} if} for {ThisLineToShow 0.8 0 0 setrgbcolor show exit} if /k 0 def {k ThisLineToShow length 8 sub gt {/k ThisLineToShow length def exit} if ThisLineToShow k 4 getinterval (http) eq {exit} if /k k 1 add def} loop k ThisLineToShow length ge {ThisLineToShow show exit} if k 0 gt {ThisLineToShow 0 k getinterval show} if /l k def {l ThisLineToShow length ge {exit} if ThisLineToShow l get //AsciiSpace eq {exit} if /l l 1 add def} loop ThisLineToShow k l k sub getinterval 0 0 0.9333333 setrgbcolor show 0 setgray % #0000EE http://www.w3.org/TR/html5/rendering.html http://stackoverflow.com/questions/4774022/ l ThisLineToShow length lt {ThisLineToShow l dup 2 index length sub neg getinterval show} if } repeat % 1 /AnythingOnPage //true def } if % j i gt j 1 TextToShow length 1 sub { /j exch def TextToShow j get //AsciiTab eq { gsave /Symbol dup 1 selectfont WidthW 1.6 mul /arrowdblright StringWidthRecursive div selectfont WidthW 0.2 mul 0 rmoveto 0 0.6 0 setrgbcolor /arrowdblright glyphshow grestore WidthW 2 mul 0 rmoveto /NumCharsPerLine NumCharsPerLine 1 sub dup 0 lt {pop 0} if def } {exit} ifelse % ... AsciiTab } for % j } loop % i and j /Y Y YlineStep sub def /CharsPainted EndThisLine 1 add def CharsPainted TextToPaint length ge {/Y Y YparaExtra sub def exit} if } loop % CharsPainted 0 setgray } bind forall % OutputLog //true PageSuppressed not {showpage /ShownPages dup load 1 add store} {erasepage initgraphics} ifelse /AnythingOnPage //false def end } bind exec} if % OutputLogToPage ... PageSuppressed not ... OutputLogToLog {{ % In case messed by the outputting to log countdictstack dup 3 eq {pop} {5 string cvs ( = countdictstack, which should be 3) dup 0 4 -1 roll putinterval =} ifelse count 0 ne {(+pstack in OutputLogToLog) = pstack (-pstack in OutputLogToLog) =} if } bind exec} if % OutputLogToLog % Final debugging {countdictstack 3 gt {8 {() =} repeat currentdict {exch == =} forall end} {exit} ifelse} bind loop