🚀 go-pugleaf

The PostScript file in the attachement shows
german texts placed along spirals using the
procedure pathtext (PostScript Language
Tutorial and Cookbook p.167 ISBN 0-201-10179-3
or 0-201-10189-0).

Because of german text the Adobe standard
encoding of the text font is replaced by the
ISO Latin-1 encoding (PostScript Language
Reference Manual p.275 ISBN 0-201-18127-4 ).

I want to substitute the text sequences "--"
by ZapfDingbats "flowers" or "hearts"
and/or Symbol card symbols.

Is it possible to add such symbols to free
positions of the text font in such a manner
that the new font is usable with pathtext
(gsview32 + Windows Me) ?
If yes, how can I do that ?

Composite fonts (like H.McGilton/M.Campione,
PostScript by Example, p.419 ISBN 0-201-63228-4)
are not accepted by the routine pathtext.

With best regards
Ch.Opitz
========================================
%!PS
%/u/opitz/ps/spiralen12.ps
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/pathtextdict 26 dict def
/pathtext
{ pathtextdict begin
  /offset exch def
  /str exch def

/pathdist 0 def

/setdist offset def
  /charcount 0 def
  gsave
   flattenpath
   {movetoproc}{linetoproc}
    {curvetoproc}{closepathproc}
    pathforall
   grestore
   newpath
   end
 } def

pathtextdict begin
/movetoproc
 { /newy exch def /newx exch def
   /firstx newx def /firsty newy def
   /ovr 0 def
   newx newy transform
   /cpy exch def /cpx exch def
 } def

/linetoproc

{ /oldx newx def /oldy newy def
   /newy exch def /newx exch def
   /dx newx oldx sub def
   /dy newy oldy sub def
   /dist dx dup mul dy dup mul add sqrt def
   dist 0 ne
    { /dsx dx dist div ovr mul def
      /dsy dy dist div ovr mul def

oldx dsx add oldy dsy add transform
      /cpy exch def /cpx exch def
      /pathdist pathdist dist add def
       { setdist pathdist le

{ charcount str length lt
           {setchar} {exit} ifelse }
        { /ovr setdist pathdist sub def
          exit }
        ifelse
     } loop
   } if
 } def

/curvetoproc
 { (ERROR: No curveto's after flattenpath!) print
 } def

/closepathproc
 { firstx firsty linetoproc
   firstx firsty movetoproc
 } def

/setchar
 { /char str charcount 1 getinterval def

/charcount charcount 1 add def
   /charwidth char stringwidth pop def
   gsave
    cpx cpy itransform translate
    dy dx atan rotate
    0 0 moveto char show
    currentpoint transform
    /cpy exch def /cpx exch def
   grestore
   /setdist setdist charwidth add def
 } def
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/Text1
%Text1 von aussen nach innen
(Viele Dinge sind sch�n rund -- Hollahi-Hollaho -- Kreise,\
 Nullen und der Mund. -- Hollahijaho -- Rund sind B�uche, Busen,\
 Spund. -- Hollahi-Hollaho -- Drum geht dieses Lied auch\
 rund. -- Hollahijaho -- Sieh den rechten Nachbarn\
 an! -- Hollahi-Hollaho -- Wie der emsig drehen\
 kann. -- Hollahijaho -- Auch der linke ist am\
 Dreh'n. -- Hollahi-Hollaho -- Das ist komisch\
 anzusehn. -- Hollahijaho -- Scheint ein Unsinn, solch ein\
 Dreh'n -- Hollahi-Hollaho -- Es ist aber\
 einzusehn, -- Hollahijaho -- da� sich's heut um etwas\
 dreht -- Hollahi-Hollaho -- und man dieses Dreh'n\
 versteht. -- Hollahijaho -- )
def

/Text2
%Text2 von innen nach aussen
(Um was aber dreht sich's heut? -- Hollahi-Hollaho -- Liebe\
 Freunde, liebe Leut, -- Hollahijaho -- der Grund, der ist\
 uns allen klar. -- Hollahi-Hollaho -- Wir haben heut ein\
 Geburtstagskind. -- Hollahijaho -- Dieses Mal da feiern\
 wir -- Hollahi-Hollaho -- mit der(dem) flotten . . . . . . . . .\
 hier. -- Hollahijaho -- Braten gibt's, Salat und\
 Wein. -- Hollahi-Hollaho -- Darum la�t uns fr�hlich\
 sein. -- Hollahijaho -- Ja, man dreht und singt und\
 lacht -- Hollahi-Hollaho -- bis es einen schwindlig\
 macht. -- Hollahijaho -- Das ist aber jetzt der\
 Rest. -- Hollahi-Hollaho -- PROST auf dieses sch�ne\
 Fest! -- Hollahijaho --)
def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% WINKEL F�R COS UND SIN IN GRAD (!), SONST ABER IN BOGENMASS %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/um 0.0174533 def % Faktor * Grad --> Radian
/a 5.0 def % Parameter der Archim. Spirale
/p 0.25 def % prozent. Verschiebung
/pab 6.283 a p mul mul def % Wert der Verschiebung
/phia 10 def % Anfangswinkel (innen)
/phie 3400 def % Endwinkel (aussen)
/ds 2 def % Bogenlaenge eines Intervalls

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Definition des 1. Punktes der Arch. Spirale
/xa {phia dup cos mul a mul um mul} def
/ya {phia dup sin mul a mul um mul} def

% Definition des 1. Punktes der versch. Kurve
/xb {phie dup a mul um mul pab add exch cos mul} def
/yb {phie dup a mul um mul pab add exch sin mul} def

/punkt % stellt naechsten Punkt der Spirale
 { dup dup cos mul a mul um mul % als x,y in Stack bereit,
  exch dup sin mul a mul um mul % Eingabe: phi[�]
 } def

/punkt1 % naechster Punkt der versch. Kurve
 {dup dup a mul um mul pab add % a*phi+pab,
  dup 3 -1 roll cos mul % Ausgabe: xi_b yi_b
  3 1 roll exch sin mul} def % Eingabe: phi[�]

% neuer Winkel Phi[Grad]=Phialt+dphi aus altem Winkel[Grad]
/phineuadd
{um mul dup dup mul 1 add sqrt a mul ds exch div add um div
} def

% neuer Winkel Phi[Grad]=Phialt-dphi aus altem Winkel[Grad]
/phineusub
{um mul dup dup mul 1 add sqrt a mul ds exch div sub um div
} def
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/Helvetica findfont
dup length dict begin
   {1 index /FID ne {def} {pop pop} ifelse} forall
   /Encoding ISOLatin1Encoding def
   currentdict
end
/Helvetica-ISOLatin1 exch definefont pop

/Helvetica-ISOLatin1 findfont
13.60 scalefont setfont
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/scal 1.45 def

298 421 translate
scal scal scale
-210 rotate
-15 80 translate
0 -50 translate

newpath
xa ya moveto % Spiralenanfang
phia phineuadd dup punkt lineto
{phineuadd dup dup phie le
  {punkt lineto}
  {exit} ifelse
} loop
Text2 120 pathtext

newpath
xb yb moveto % Anfang der versch. Kurve
phie phineusub dup punkt1 lineto
{phineusub dup dup phia ge
  {punkt1 lineto}
  {exit} ifelse
} loop
Text1 5555 pathtext

210 rotate
0 50 translate

newpath
 -180 200 moveto
(Nach der Melodie: "Horch, was kommt von drau�en rein . . .")
show

newpath
 -55 220 moveto
/Times-Roman findfont 20.60 scalefont setfont
(Rundgesang) show

showpage