%! %!PS-Adobe-3.0 %%Title: (Chimes of the Clock of the Long Now) %%Version: 1.0 1 %%Creator: Sean M. Burke sburke@cpan.org %%CreationDate: 02006-06-16 00:00 %%Pages: (atend) %%PageOrder: Ascend %%Orientation: Portrait %%DocumentNeededFonts: Times-Bold Times-Italic Times-Roman %%DocumentNeededResources: %%+ font Times-Bold %%+ font Times-Italic %%+ font Times-Roman %%DocumentSuppliedResources: procset LongNowChimesGen 1.0 1 %%+ encoding ISOLatin1Encoding %%EndComments %%BeginProlog %%BeginProcSet: LongNowChimesGen 1.0 1 % % No user-serviceable parts inside, folks! - sburke@cpan.org % % We start with Sean's general PS utility routines true setpacking % I.e., we promise not to try mutating {...} objects. /AppDebugLevel 0 def /StaveSpacing 62 def /TopStave 737 def /PageTop 790 def /PageBot 30 def /! { bind def } def /alias { load dup type /arraytype eq {bind} if def }! /last /exit alias /break /exit alias /halt /stop alias /q { quit } ! /Q { quit } ! /? { pstack } def /?? { (Stack: \253\n) print pstack (\273\n) print } def /typeof /type alias /sub1 { 1 sub }! /add1 { 1 add }! /println { print (\n) print }! /trace { AppDebugLevel le { (~ ) print println } { pop } ifelse }! /num2string { 40 string cvs }! % TODO: redo to make more efficient! /newseq { % array-or-str 5 newseq >> array-or-str newobjOfSize5 % Note that it does not consume the array-or-str, but does consume the length 1 index type /arraytype eq { array } { string } ifelse }! /@ { %% string1 string2 @ >> string ("@" because it ATpends strings/arrays) %% array1 array2 @ >> array 2 copy length exch length add % - seq1 seq2 newsize newseq % - seq1 seq2 newseq dup 4 2 roll 2 index 0 3 index putinterval exch length exch putinterval } bind def % The assertion system: /++ { dup load add1 store }! % increments the symbol's value. /-- { dup load sub1 store }! % decrements the symbol's value. /assert_count 0 def /assert_verbosity 10 def /assertnote { (t: ) exch @ assert_verbosity trace } def /stackempty? { count 0 eq } ! /stack-empty? /stackempty? alias /stack-empty /stackempty? alias /stackempty /stackempty? alias /printem { % stacktop be MUST a (array of)* strings! dup typeof /arraytype eq { { printem } forall } { print } ifelse }! /die { printem (Aborting.\n\n) print % TODO: use a 'signalerror' instead? is signalerror real % PostScript, or just GhostScript? stop }! /_assert_failure_common { % prefaceMsg >> -- (!!!!!!!!!!!!!!! ) print print (Assertion ) print assert_count num2string print ( failed !! !!!!!!!!!!!!!!!\n Assertion code: ) print /assertBlock load == }! /assert { % Yay, test driven development... in PostScript! /assertBlock exch ! /assert_count ++ count 0 eq not { (Precondition for ) _assert_failure_common (Stack is not empty from preceding code! ) print ?? () die } if assertBlock count 1 eq not { (Postcondition for ) _assert_failure_common (Stack is not empty after assertion code! ) print ?? () die } if not { () _assert_failure_common () die } if assert_verbosity AppDebugLevel le {(t) assert_count num2string ( okay) @ @ 0 trace} if }def /assert_T /assert alias (Checking assertions for Long Now Chimes under ) product ( ...) @ @ assertnote { 1 1 eq } assert { 1 2 ne } assert /delayed_assertions 100 array def /delayed_assertions_index 0 def /assert_later { delayed_assertions delayed_assertions_index 3 -1 roll put /delayed_assertions_index ++ }! /run_delayed_assertions { 0 1 delayed_assertions_index 1 sub { delayed_assertions exch get assert } for /delayed_assertions 0 store } def { 1 1 eq } assert_later { 1 2 ne } assert_later /aeq { % array1 array2 >> bool % Returns true iff the two arrays are equal (to one level of comparison) { % Asserting that both are arrays: dup type /arraytype ne { pop pop false last } if 1 index type /arraytype ne { pop pop false last } if % Catch case of them being the actually same array obj 2 copy eq { pop pop true last } if % Asserting that both are same length: 2 copy length exch length ne { pop pop false last } if true 3 1 roll dup length 1 sub 0 1 3 -1 roll % okay-so-far-bool a1 a2 0 1 lastindex { 3 copy get 3 1 roll exch get ne { % Unequal! so change flag to false and break out 3 -1 roll pop false 3 1 roll last } if } for pop pop last % Returning just the okay-so-far flag } loop }! { [] 0 aeq not } assert { [] [] aeq } assert { [] [2] aeq not } assert { [101] [101] aeq } assert { [101] dup aeq } assert { [101] [102] aeq not } assert { [(abc)] [(abc)] aeq } assert { [(abc)] [(Abc)] aeq not } assert { [(abc)] [123] aeq not } assert %--------------------------------------------------------------------------- /reversed { % Returns a copy of the given array, reversed dup length dup 1 sub exch array 3 1 roll % new old lastindex - 0 1 2 index { 4 copy sub get 3 -1 roll exch put } for pop pop % >> new % (yup, even works for empty or 1-element arrays.) }! { [] [] reversed aeq } assert { [101] [101] reversed aeq } assert { [101 102 ] [102 101] reversed aeq } assert { [101 102 103] [103 102 101] reversed aeq } assert { [101 102 103 104][104 103 102 101] reversed aeq } assert %--------------------------------------------------------------------------- /range { % A B >> [A, A+1,... B] % Assumes exch is less than y [ 3 1 roll 1 exch { } for ] %sic! }! { 5 6 range [5 6 ] aeq } assert { 5 7 range [5 6 7 ] aeq } assert { 5 8 range [5 6 7 8] aeq } assert % End of general-purpose stuff %-------------------------------------------------------------------------- % Now the proper Long Now Chimes stuff: ( Testing basic chimes-support routines ) assertnote /bells 10 def /_factorials [ % We actually precompute the factorials [0..bells-1] 1 dup dup 1 bells 1 sub { mul dup } for pop ] store /factorial { cvi _factorials exch get }! { 0 factorial 1 eq } assert { 1 factorial 1 eq } assert { 2 factorial 2 eq } assert { 9 factorial 362880 eq } assert %--------------------------------------------------------------------------- /funnydigit { % n i >> newint dup 3 1 roll sub1 factorial div cvi exch mod cvi }! {123456 10 funnydigit 0 eq } assert {123456 9 funnydigit 3 eq } assert {123456 8 funnydigit 0 eq } assert {123456 7 funnydigit 3 eq } assert {123456 6 funnydigit 2 eq } assert {123456 5 funnydigit 4 eq } assert {123456 4 funnydigit 0 eq } assert {123456 3 funnydigit 0 eq } assert {123456 2 funnydigit 0 eq } assert {123456 1 funnydigit 0 eq } assert %--------------------------------------------------------------------------- /graft-in { % inarray index item >> newarray 2 index length add1 array 4 1 roll 3 index 2 index 3 -1 roll put % outarray inarray atindex - 3 copy 0 exch getinterval 0 exch putinterval % outarray inarray atindex - dup dup add1 4 index exch 5 2 roll 2 index length exch sub getinterval % outarray outarray atindex-plus-one afterward putinterval }! { [] 0 456 graft-in [456] aeq } assert { [101] 0 456 graft-in [456 101] aeq } assert { [101] 1 456 graft-in [101 456] aeq } assert { [101 102 103 104 105] 0 456 graft-in [456 101 102 103 104 105] aeq } assert { [101 102 103 104 105] 1 456 graft-in [101 456 102 103 104 105] aeq } assert { [101 102 103 104 105] 2 456 graft-in [101 102 456 103 104 105] aeq } assert { [101 102 103 104 105] 3 456 graft-in [101 102 103 456 104 105] aeq } assert { [101 102 103 104 105] 4 456 graft-in [101 102 103 104 456 105] aeq } assert { [101 102 103 104 105] 5 456 graft-in [101 102 103 104 105 456] aeq } assert %--------------------------------------------------------------------------- /makeperm { % shifties-array bellnumbers-array >> permutation-array /e exch def /f exch def 0 array % the beginnings of our output array f length sub1 -1 0 { dup f exch get exch e exch get graft-in } for }! /makepermutation { % array bells >> permutation-array 0 exch range reversed exch reversed exch makeperm }! /nth-perm { % n bells >> permutation-array dup array 0 1 3 index sub1 { dup add1 4 index exch funnydigit 2 index 3 1 roll put } for % n bells intermediate-array - 3 -1 roll pop exch % intermediate-array bells - makepermutation reversed }! %--------------------------------------------------------------------------- % Our little bits of date-handling code: /isleap { % intYear >> boolean dup dup 4 mod 0 eq exch 100 mod 0 ne and exch 400 mod 0 eq or }! (Leap-year logic) assertnote { 1899 isleap not } assert { 1900 isleap not } assert { 1901 isleap not } assert { 1902 isleap not } assert { 1903 isleap not } assert { 1904 isleap } assert { 1905 isleap not } assert { 1999 isleap not } assert { 2000 isleap } assert { 2001 isleap not } assert { 2002 isleap not } assert { 2003 isleap not } assert { 2004 isleap } assert { 2005 isleap not } assert /daysinyear { isleap {366} {365} ifelse }! % intYear >> intDayscount { 2000 daysinyear 366 eq } assert { 2001 daysinyear 365 eq } assert % Days in each month in normal and leap years. Note 1-indexed /_normyear [0 31 28 31 30 31 30 31 31 30 31 30 31] def /_leapyear [0 31 29 31 30 31 30 31 31 30 31 30 31] def /monthdays-year { isleap {_leapyear} {_normyear} ifelse }! % intYear >> array /MINYEAR 2000 def /daynumber { % Y M D >> daynum 2 index 2000 lt { pop pop pop 0 } { % Main stuff: sub1 % y m running-total 2 index monthdays-year 0 3 index getinterval { add } forall exch pop exch % running-total year - sub1 2000 1 3 -1 roll { daysinyear add } for } ifelse }! % TODO: speed this up with a per-century cache or something? %--------------------------------------------------------------------------- /ymd-to-perm { daynumber 10 nth-perm }! % y m d >> permlist /ym-to-perms { % y m >> list-of-perms 2 copy exch monthdays-year exch get dup array exch 4 2 roll 1 daynumber % outarray maxday bigdaynum (e.g., [...] 31 1827308) 0 1 4 -1 roll 1 sub { % outarray bigdaynum dayoffset 2 copy add 10 nth-perm 3 index 3 1 roll put } for pop }! %--------------------------------------------------------------------------- (Running the Hillis test data) assertnote { 0 3 nth-perm [1 2 3] aeq } assert { 1 3 nth-perm [2 1 3] aeq } assert { 2 3 nth-perm [1 3 2] aeq } assert { 3 3 nth-perm [2 3 1] aeq } assert { 4 3 nth-perm [3 1 2] aeq } assert { 5 3 nth-perm [3 2 1] aeq } assert { 1567806 10 nth-perm [7 5 9 3 10 4 6 2 1 8] reversed aeq } assert { 1567807 10 nth-perm [7 5 9 3 10 4 6 1 2 8] reversed aeq } assert { 1567808 10 nth-perm [7 5 9 2 10 4 6 3 1 8] reversed aeq } assert { 1567809 10 nth-perm [7 5 9 1 10 4 6 3 2 8] reversed aeq } assert { 1567810 10 nth-perm [7 5 9 2 10 4 6 1 3 8] reversed aeq } assert { 1567811 10 nth-perm [7 5 9 1 10 4 6 2 3 8] reversed aeq } assert { 1567812 10 nth-perm [7 5 9 3 10 2 6 4 1 8] reversed aeq } assert { 1567813 10 nth-perm [7 5 9 3 10 1 6 4 2 8] reversed aeq } assert { 1567814 10 nth-perm [7 5 9 2 10 3 6 4 1 8] reversed aeq } assert { 1567815 10 nth-perm [7 5 9 1 10 3 6 4 2 8] reversed aeq } assert { 1567816 10 nth-perm [7 5 9 2 10 1 6 4 3 8] reversed aeq } assert /test-month-startday 1827308 def /test-month-startdate (07003-01-01) def /test-month-data [ % test data from Hillis's .nb file [9 2 3 8 5 10 7 1 4 6] [9 1 3 8 5 10 7 2 4 6] [9 2 1 8 5 10 7 3 4 6] [9 1 2 8 5 10 7 3 4 6] [9 4 3 8 2 10 7 5 1 6] [9 4 3 8 1 10 7 5 2 6] [9 4 2 8 3 10 7 5 1 6] [9 4 1 8 3 10 7 5 2 6] [9 4 2 8 1 10 7 5 3 6] [9 4 1 8 2 10 7 5 3 6] [9 3 4 8 2 10 7 5 1 6] [9 3 4 8 1 10 7 5 2 6] [9 2 4 8 3 10 7 5 1 6] [9 1 4 8 3 10 7 5 2 6] [9 2 4 8 1 10 7 5 3 6] [9 1 4 8 2 10 7 5 3 6] [9 3 2 8 4 10 7 5 1 6] [9 3 1 8 4 10 7 5 2 6] [9 2 3 8 4 10 7 5 1 6] [9 1 3 8 4 10 7 5 2 6] [9 2 1 8 4 10 7 5 3 6] [9 1 2 8 4 10 7 5 3 6] [9 3 2 8 1 10 7 5 4 6] [9 3 1 8 2 10 7 5 4 6] [9 2 3 8 1 10 7 5 4 6] [9 1 3 8 2 10 7 5 4 6] [9 2 1 8 3 10 7 5 4 6] [9 1 2 8 3 10 7 5 4 6] [9 4 3 8 2 10 7 1 5 6] [9 4 3 8 1 10 7 2 5 6] [9 4 2 8 3 10 7 1 5 6] [9 4 1 8 3 10 7 2 5 6] ]def 0 1 test-month-data length sub1 { dup test-month-startday add 10 nth-perm /test-day-data-is exch def test-month-data exch get reversed /test-day-data-should exch def { test-day-data-is test-day-data-should aeq } assert } for {7003 1 1 ymd-to-perm [9 2 3 8 5 10 7 1 4 6] reversed aeq } assert {7003 1 2 ymd-to-perm [9 1 3 8 5 10 7 2 4 6] reversed aeq } assert {7003 1 3 ymd-to-perm [9 2 1 8 5 10 7 3 4 6] reversed aeq } assert {7003 1 4 ymd-to-perm [9 1 2 8 5 10 7 3 4 6] reversed aeq } assert {7003 1 5 ymd-to-perm [9 4 3 8 2 10 7 5 1 6] reversed aeq } assert {7003 1 6 ymd-to-perm [9 4 3 8 1 10 7 5 2 6] reversed aeq } assert {7003 1 7 ymd-to-perm [9 4 2 8 3 10 7 5 1 6] reversed aeq } assert {7003 1 8 ymd-to-perm [9 4 1 8 3 10 7 5 2 6] reversed aeq } assert {7003 1 9 ymd-to-perm [9 4 2 8 1 10 7 5 3 6] reversed aeq } assert {7003 1 10 ymd-to-perm [9 4 1 8 2 10 7 5 3 6] reversed aeq } assert {7003 1 11 ymd-to-perm [9 3 4 8 2 10 7 5 1 6] reversed aeq } assert {7003 1 12 ymd-to-perm [9 3 4 8 1 10 7 5 2 6] reversed aeq } assert {7003 1 13 ymd-to-perm [9 2 4 8 3 10 7 5 1 6] reversed aeq } assert {7003 1 14 ymd-to-perm [9 1 4 8 3 10 7 5 2 6] reversed aeq } assert {7003 1 15 ymd-to-perm [9 2 4 8 1 10 7 5 3 6] reversed aeq } assert {7003 1 16 ymd-to-perm [9 1 4 8 2 10 7 5 3 6] reversed aeq } assert {7003 1 17 ymd-to-perm [9 3 2 8 4 10 7 5 1 6] reversed aeq } assert {7003 1 18 ymd-to-perm [9 3 1 8 4 10 7 5 2 6] reversed aeq } assert {7003 1 19 ymd-to-perm [9 2 3 8 4 10 7 5 1 6] reversed aeq } assert {7003 1 20 ymd-to-perm [9 1 3 8 4 10 7 5 2 6] reversed aeq } assert {7003 1 21 ymd-to-perm [9 2 1 8 4 10 7 5 3 6] reversed aeq } assert {7003 1 22 ymd-to-perm [9 1 2 8 4 10 7 5 3 6] reversed aeq } assert {7003 1 23 ymd-to-perm [9 3 2 8 1 10 7 5 4 6] reversed aeq } assert {7003 1 24 ymd-to-perm [9 3 1 8 2 10 7 5 4 6] reversed aeq } assert {7003 1 25 ymd-to-perm [9 2 3 8 1 10 7 5 4 6] reversed aeq } assert {7003 1 26 ymd-to-perm [9 1 3 8 2 10 7 5 4 6] reversed aeq } assert {7003 1 27 ymd-to-perm [9 2 1 8 3 10 7 5 4 6] reversed aeq } assert {7003 1 28 ymd-to-perm [9 1 2 8 3 10 7 5 4 6] reversed aeq } assert {7003 1 29 ymd-to-perm [9 4 3 8 2 10 7 1 5 6] reversed aeq } assert {7003 1 30 ymd-to-perm [9 4 3 8 1 10 7 2 5 6] reversed aeq } assert {7003 1 31 ymd-to-perm [9 4 2 8 3 10 7 1 5 6] reversed aeq } assert {7003 2 1 ymd-to-perm [9 4 1 8 3 10 7 2 5 6] reversed aeq } assert {7003 2 1 ymd-to-perm [9 4 1 8 3 10 7 2 5 6] reversed aeq } assert {2000 1 1 ymd-to-perm [1 2 3 4 5 6 7 8 9 10] aeq } assert {2000 1 2 ymd-to-perm [2 1 3 4 5 6 7 8 9 10] aeq } assert {2000 1 3 ymd-to-perm [1 3 2 4 5 6 7 8 9 10] aeq } assert {2000 1 4 ymd-to-perm [2 3 1 4 5 6 7 8 9 10] aeq } assert {3000 1 1 ymd-to-perm [3 5 2 7 4 6 1 8 10 9] aeq } assert {3000 12 10 ymd-to-perm [4 6 1 7 5 2 3 8 10 9] aeq } assert {11000 1 1 ymd-to-perm [10 4 3 6 8 2 1 7 5 9] aeq } assert {11900 1 1 ymd-to-perm [10 9 2 4 8 5 7 1 3 6] aeq } assert {11935 4 24 ymd-to-perm [10 9 8 7 6 5 4 2 3 1] aeq } assert {11935 4 25 ymd-to-perm [10 9 8 7 6 5 4 3 1 2] aeq } assert {11935 4 26 ymd-to-perm [10 9 8 7 6 5 4 3 2 1] aeq } assert {11935 4 27 ymd-to-perm [1 2 3 4 5 6 7 8 9 10] aeq } assert {11935 4 28 ymd-to-perm [2 1 3 4 5 6 7 8 9 10] aeq } assert {11935 4 29 ymd-to-perm [1 3 2 4 5 6 7 8 9 10] aeq } assert {11935 4 30 ymd-to-perm [2 3 1 4 5 6 7 8 9 10] aeq } assert {11935 5 1 ymd-to-perm [3 1 2 4 5 6 7 8 9 10] aeq } assert {7003 1 ym-to-perms length 31 eq } assert {7003 1 ym-to-perms 0 get [9 2 3 8 5 10 7 1 4 6] reversed aeq } assert {7003 1 ym-to-perms 30 get [9 4 2 8 3 10 7 1 5 6] reversed aeq } assert %# That's it. % %--------------------------------------------------------------------------- run_delayed_assertions (Done checking assertions.) assertnote %--------------------------------------------------------------------------- % % Here starts the muscript stuff: % /blackblob { % usage: x y staveheight blackblob /staveheight exch def /y exch def /x exch def gsave x y translate staveheight 0.17 mul staveheight 0.113 mul scale newpath 0 0 1 0 360 arc fill grestore } bind def /stave { % usage: y_topline staveheight x_left x_right stave /x_right exch def /x_left exch def /staveheight exch def /first exch def /second first staveheight 0.25 mul sub def /third first staveheight 0.5 mul sub def /fourth first staveheight 0.75 mul sub def /fifth first staveheight sub def .015 staveheight mul setlinewidth newpath x_left first moveto x_right first lineto x_left second moveto x_right second lineto x_left third moveto x_right third lineto x_left fourth moveto x_right fourth lineto x_left fifth moveto x_right fifth lineto stroke } bind def /ledger { % usage: x y staveheight ledger /staveheight exch def /y exch def /x exch def /x_left x staveheight 0.28 mul sub def /x_right x staveheight 0.28 mul add def .015 staveheight mul setlinewidth newpath x_left y moveto x_right y lineto stroke % grestore } bind def /barline { % usage: x y_top y_bot barline /y_bot exch def /y_top exch def /x exch def 0.6 setlinewidth newpath x y_bot moveto x y_top lineto stroke } bind def /notestem { % usage: x y_top y_bot notestem /y_bot exch def /y_top exch def /x exch def 0.4 setlinewidth newpath x y_bot moveto x y_top lineto stroke } bind def /bracket { % usage: x y_top y_bot bracket /y_bot exch def /y_top exch def /x exch def 2.5 setlinewidth newpath x y_top moveto x y_bot lineto stroke 0.6 setlinewidth newpath x y_top 5.0 add 5.0 270 350 arc stroke newpath x y_bot 5.0 sub 5.0 10 90 arc stroke } bind def /treble8vaclef { % usage: x y_top staveheight treble8vaclef % NOTE: I think this actually has just arity 3! /staveheight exch def /y_top exch def /x exch def /Times-Italic findfont staveheight 0.58 mul scalefont setfont x staveheight 0.15 mul add y_top staveheight 0.3 mul add moveto (8) show /y_g y_top staveheight 0.75 mul sub def x y_g staveheight g_clef } bind def /g_clef { % usage: x y_g staveheight g_clef gsave x y_g translate staveheight staveheight scale % start at bottom left blob ... newpath -.17 -.479 .086 0 360 arc fill newpath -.256 -.479 moveto -.256 -.58 -.17 -.643 -.12 -.643 curveto -.12 -.617 lineto -.21 -.622 -.13 -.58 -.21 -.479 curveto closepath fill newpath .026 setlinewidth -.12 -.63 moveto .07 -.63 .11 -.48 .10 -.4 curveto -.05 .75 lineto stroke newpath % from left of top loop -.062 .751 moveto -.1 1.1 .06 1.18 .10 1.19 curveto % top .125 1.12 lineto .06 1.09 -.084 1.05 -.038 .749 curveto closepath fill newpath % start at top .10 1.19 moveto .36 .55 -.27 .45 -.27 .10 curveto % inside of left extreme -.3 .16 lineto -.3 .6 .25 .65 .125 1.12 curveto closepath fill newpath % start at left -.3 .16 moveto -.3 -.15 -.15 -.23 .02 -.23 curveto .02 -.21 lineto -.15 -.21 -.27 -.15 -.27 .10 curveto closepath fill newpath % start at bottom .02 -.23 moveto .2 -.23 .30 -.12 .30 .04 curveto % right extreme .265 .04 lineto .27 -.11 .2 -.21 .02 -.21 curveto closepath fill newpath .30 .04 moveto .30 .16 .17 .28 .07 .28 curveto % top of body .07 .19 lineto .17 .19 .26 .16 .265 .04 curveto closepath fill newpath % start at top of body .07 .28 moveto -.15 .28 -.15 .05 -.05 -.05 curveto % end -.10 .05 -.08 .19 .07 .19 curveto closepath fill grestore } bind def /timesig { % usage (eg. for 6/8): x y_top staveheight (6) (8) timesig /botnum exch def /topnum exch def /staveheight exch def /y_top exch def /x exch def gsave /Times-Bold findfont staveheight 0.6 mul scalefont setfont x topnum stringwidth pop 0.5 mul sub y_top staveheight 0.45 mul sub moveto topnum show x botnum stringwidth pop 0.5 mul sub y_top staveheight 0.95 mul sub moveto botnum show grestore } bind def /flat { % usage: x y staveheight flat /staveheight exch def /y exch def /x exch def gsave x y translate staveheight staveheight scale newpath 0.03 setlinewidth -0.07 0.45 moveto -0.07 -0.15 lineto stroke newpath 0.05 setlinewidth -0.07 -0.15 moveto 0.15 0 0.3 0.2 -0.07 0.08 curveto stroke grestore } bind def /minimrest { % usage: x y staveheight minimrest /staveheight exch def /y exch def /x exch def gsave x y translate staveheight staveheight scale newpath 0.07 setlinewidth -0.1 0.035 moveto 0.1 0.035 lineto stroke grestore } bind def /rightshow { % usage: x y font fontsize (string) rightshow /s exch def /fontsize exch def /font exch def /y exch def /x exch def gsave font findfont fontsize scalefont setfont x s stringwidth pop sub y moveto s show grestore } bind def /leftshow { % usage: x y font fontsize (string) leftshow /s exch def /fontsize exch def /font exch def /y exch def /x exch def gsave font findfont fontsize scalefont setfont x y moveto s show grestore } bind def /centreshow { % usage: x y font fontsize (string) centreshow /s exch def /fontsize exch def /font exch def gsave moveto font findfont fontsize scalefont setfont gsave s false charpath flattenpath pathbbox grestore exch 4 -1 roll exch sub 0.5 mul 3 1 roll sub 0.5 mul rmoveto s show grestore } bind def /fermata { % usage: x y staveheight fermata gsave 3 1 roll translate dup scale 0 -0.11 translate newpath 0 0 .07 0 360 arc fill newpath -.33 -.06 moveto -.33 .41 .33 .41 .33 -.06 curveto .31 -.06 lineto .31 .31 -.31 .31 -.31 -.06 curveto -.33 -.06 lineto fill grestore } bind def %-------------------------------------------------------------------------- % % And now Sean's muscript-wrapping, including some stack-management stuff %/? {(Stack: [\n) print pstack (]%#\n) print } bind def /? /===onlyq where { pop { ([ % Stack:\n) print 0 1 count 3 sub { ( ) print dup 1 add index ===only ( %i) print 3 string cvs print (\n) print } for (]\n) print } } { { ([ % Stack:\n) print 0 1 count 3 sub { ( ) print index === } for (]\n) print } } ifelse bind def /arity { 2 add mark exch 2 roll } bind def /tidy-quiet { cleartomark pop } bind def /tidy-verbose { ] dup length 0 eq { % no leak. Nix array and token pop pop } { exch dup length string cvs print ( leaks: ) print === } ifelse } bind def /tidy /tidy-verbose load def /Sig { %(Sig at ) print dup === /Sig 1 arity 68 exch 20 (12) (4) timesig tidy } bind def /Clef { /Clef 1 arity 48 exch 20 treble8vaclef pop pop pop tidy } bind def /Staff { /Staff 1 arity 20 40 565 stave tidy } bind def /Ferm { /Ferm 2 arity %? -20 fermata tidy } bind def /Blob { 20 blackblob } bind def /Rest { /Rest 2 arity 20 minimrest tidy } bind def /Flat { /Flat 1 arity 58 exch 20 flat tidy } bind def /NewMeasure { /_yat exch def } bind def % ycoord >> - /Leading { /_Leading exch def } bind def % leading >> - /Then { /_yat _yat _Leading add store } bind def /CLeft { /CLeft 0 arity /_LineX _LineX StaveSpacing sub def _LineX dup 10 sub Flat dup Sig %(Hey: ) print pstack (!\n\n) print dup Clef dup Staff dup dup 20 sub 40 3 1 roll barline dup dup 20 sub 35.5 3 1 roll bracket dup Barlines pop tidy } bind def /RestFerm { /RestFerm 2 arity 2 copy Rest 17.6 sub Ferm tidy } bind def /_Barlines_at [ 227.167 226.667 224.167 396.833 396.333 393.833 566.5 566 563.5 ] def /Barlines { /Barlines 1 arity _Barlines_at { 1 index dup 20 sub barline } forall pop tidy } bind def /pnote { % x y >> - _yat exch 2 copy Blob exch 3.52 sub exch dup 17 sub notestem %pop pop } bind def /dnote { % x y >> - _yat exch 2 copy Blob exch 3.52 add exch 17 add dup 17 sub notestem } bind def % Leadings: 10.119 11.111 11.111 /StartPage { 4 0 translate 1.0 0.95 scale /_LineX TopStave StaveSpacing add def /_MeasureCount 0 def } bind def /MLeft { /MLeft 0 arity %? CLeft 10.119 Leading 94.119 NewMeasure tidy } bind def /MMid { /MMid 0 arity %? 11.111 Leading 250.879 NewMeasure tidy } bind def /MRight { /MRight 0 arity %? 11.111 Leading 420.545 NewMeasure tidy } bind def /EndPage { 302.5 PageTop /Times-Bold-ISO 17.5 5 -1 roll centreshow 40 PageTop /Times-Italic-ISO 9 (con moto) leftshow 565 PageTop /Times-Italic-ISO 9 (Brian Eno & Danny Hillis) rightshow 40 PageBot /Times-Italic-ISO 9 (PostScript programming by Sean Burke, with graphics routines from Peter Billam's muscript) leftshow } bind def /EndMeasure { Then _yat _LineX 10 sub RestFerm } bind def /_Mvector [/MLeft load /MMid load /MRight load] def /StartMeasure { _Mvector _MeasureCount 3 mod get exec % (Measure: ) print _MeasureCount === /_MeasureCount _MeasureCount 1 add def } bind def /ChimesRoutines [ null { _LineX 2.7 add pnote Then } bind { _LineX pnote Then } bind { _LineX 2.5 sub pnote Then } bind { _LineX 5 sub pnote Then } bind { _LineX 7.5 sub pnote Then } bind { _LineX 10 sub pnote Then } bind { _LineX 12.5 sub dnote Then } bind { _LineX 15 sub dnote Then } bind { _LineX 17.5 sub dnote Then } bind { _LineX 25 sub dup dnote _yat exch 20 ledger Then } bind ] def /MonthNames [ (NIL) (January) (February) (March) (April) (May) (June) (July) (August) (September) (October) (November) (December) ] def /Yearnum2str { % ynum >> str cvi dup 10000 lt { (0) exch 4 string cvs @ } { 5 string cvs } ifelse } bind def % And finally: /P { % y m >> - 2 AppDebugLevel le { 2 copy 7 string cvs exch 7 string cvs (Typesetting for ) print print (-) print print ( ...\n) print } if /pgsave save def gsave StartPage 2 copy ym-to-perms { %dup === StartMeasure { ChimesRoutines exch get exec } forall EndMeasure } forall %pstack MonthNames exch get ( ) @ exch Yearnum2str @ EndPage showpage pgsave restore grestore } bind def %~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ /Times-Bold findfont dup length dict begin { 1 index /FID ne { def } { pop pop } ifelse } forall /Encoding ISOLatin1Encoding def currentdict end /Times-Bold-ISO exch definefont pop /Times-Italic findfont dup length dict begin { 1 index /FID ne { def } { pop pop } ifelse } forall /Encoding ISOLatin1Encoding def currentdict end /Times-Italic-ISO exch definefont pop %--------------------------------------------------------------------------- %%EndProcSet %%EndProlog 2000 1 12999 { 1 1 12 { 1 index exch P } for } for %%Trailer %%Pages: 132000 %%EOF