1 %
2 % Stuff used to draw or set text along a baseline specified by parametric equations
3 % for x and y.
4 %
5 
6 /left -1 def
7 /center 0 def
8 /right 1 def
9 
10 /baselinedict 50 dict def
11 
12 /newbaseline {
13 	baselinedict begin
14 		/g' exch bind def
15 		/f' exch bind def
16 		/g  exch bind def
17 		/f  exch bind def
18 
19 		counttomark 2 eq {/hoffset exch def} if
20 		/res exch def
21 
22 		/t 0 def
23 		/s 0 def
24 		/voffset false def
25 		cleartomark
26 	end
27 } bind def
28 
29 /drawfunnytext {
30 	baselinedict begin
31 		/t exch def
32 		/mode exch def
33 		/str exch def
34 
35 		mode left eq {
36 			/leftstring emptystring def
37 			/rightstring str def
38 		} if
39 
40 		mode right eq {
41 			/leftstring str reversestring def
42 			/rightstring emptystring def
43 		} if
44 
45 		mode center eq {
46 			str splitstring
47 			/rightstring exch def
48 			/leftstring exch reversestring def
49 		} if
50 
51 		gsave currentpoint translate leftstring left t baselineshow grestore
52 		gsave currentpoint translate rightstring right t baselineshow grestore
53 
54 		/t 0 def
55 		/s 0 def
56 		/voffset false def
57 		cleartomark
58 	end
59 } bind def
60 
61 /setfunnytext {
62 	baselinedict begin
63 		/vpos exch def
64 		/hpos exch def
65 		/str  exch def
66 
67 		voffset vpos ne {
68 			/voffset vpos def
69 			/t 0 def
70 			/s hoffset def
71 		} if
72 
73 		gsave
74 			hoffset voffset translate
75 			0 0 moveto
76 			/ds hpos s sub def
77 			/dt ds t f' dup mul t g' dup mul add sqrt res mul div def
78 			/s s ds add def
79 			/t t dt add def
80 			str right t baselineshow
81 		grestore
82 	end
83 } bind def
84 
85 baselinedict begin
86 
87 /f  {} bind def
88 /g  {pop 0} bind def
89 /f' {pop 1} bind def
90 /g' {pop 0} bind def
91 
92 /s 0 def
93 /t 0 def
94 /res 72 def
95 
96 /onecharstring ( ) def
97 /emptystring () def
98 
99 /baselineshow {
100 	/t exch def
101 	/mode exch def
102 	/str exch def
103 
104 	gsave
105 		t f res mul t g res mul translate
106 		0 0 moveto
107 		t g' t f' atan rotate
108 		{
109 			mode right eq {pop} if
110 			grestore gsave
111 			onecharstring 0 3 -1 roll put onecharstring stringwidth pop
112 			/ds exch mode mul def
113 			/dt ds t f' dup mul t g' dup mul add sqrt res mul div def
114 			/t t dt add def
115 			/s s ds add def
116 			t f res mul t g res mul translate
117 			0 0 moveto
118 			t g' t f' atan rotate
119 			mode left eq {pop} if
120 		} str kshow
121 	grestore
122 } bind def
123 
124 /reversestring {
125 	/str1 exch def
126 
127 	/str2 str1 length string def
128 	/i 0 def
129 	/n str1 length 1 sub def
130 
131 	{
132 		str1 n get str2 exch i exch put
133 		/i i 1 add def
134 		/n n 1 sub def
135 		n 0 lt {exit} if
136 	} loop
137 	str2
138 } bind def
139 
140 /splitstring {
141 	/str1 exch def
142 
143 	/len str1 stringwidth pop def
144 	/s 0 def
145 	/n 0 def
146 	str1 length {
147 		str1 n get onecharstring exch 0 exch put
148 		/s onecharstring stringwidth pop s add def
149 		s len 2 div ge {exit} if
150 		/n n 1 add def
151 	} repeat
152 	str1 0 n 1 add getinterval
153 	str1 n str1 length n sub getinterval
154 } bind def
155 
156 end