Text am Pfad ausrichten


%!PS-Adobe-1.0
%%Creator: Holger Gehringer
%%Title: Beispiel fuer Text am Pfad ausrichten
%%CreationDate: Mo, 23.11.1998
%%DocumentMedia: A4 595 842 0 () ()
%%Orientation: Portrait
%%Pages: (atend)
%%DocumentFonts: Times-Roman Helvetica
%%EndComments

% Dieses Programm definiert eine allgemeine Prozedur Pathtext, mit der es moeg-
% lich ist, einen Text entlang eines beliebigen Pfades auszugeben.

/PathtextDict 26 dict def        % Lokaler Speicher fuer Pathtext

/Pathtext                        % Pathtext erwartet den auszugebenden String
                                 % und einen Offset vom Pfadanfang als Argumente
                                 % auf dem Stack. Es wird vorausgesetzt, dass
                                 % der Pfad bereits existiert und dass der ak-
                                 % tuelle Font gesetzt ist. Pathtext plaziert
                                 % die einzelnen Zeichen des Strings entlang des
                                 % Pfades, beginnend bei der Distanz 0ffset nach
                                 % dem Pfadanfang, bis der String leer oder der
                                 % Pfad zu Ende ist.
{ PathtextDict begin
    /Offset exch def
    /Str exch def
    /Pathdist 0 def              % Zurueckgelegte Distanz entlang des Pfades
    /Setdist Offset def          % Laenge des bisher ausgegebenen Textes
    /Charcount 0 def             % Anzahl der ausgegebenen Zeichen
    gsave
    flattenpath                  % Pfad glaetten
    {MovetoProc}
    {LinetoProc}                 % Zeichen werden von LinetoProc ausgegeben
    {CurvetoProc}
    {ClosepathProc}
    pathforall
    grestore
    newpath                      % Nach Aufruf von Pathtext ist aktueller Pfad
                                 % geloescht
  end
} def

PathtextDict begin
  /MovetoProc                    % wird aufgerufen, wenn im Pfad ein moveto-
                                 % Segment angetroffen wird.
  { /NewY exch def
    /NewX exch def
    /FirstY NewY def             % Position des Pfadanfangs; wird spaeter fuer
    /FirstX NewX def             % closepath gebraucht.
    /Ovr 0 def
  } def
  
  /LinetoProc                    % wird aufgerufen, wenn im Pfad ein lineto-Seg-
                                 % ment angetroffen wird
  { /OldY NewY def               % Letzten Punkt merken
    /OldX NewX def
    /NewY exch def               % Neuen Punkt holen
    /NewX exch def
    /DX NewX OldX sub def        % Entfernung zwischen altem und neuem Punkt
    /DY NewY OldY sub def        % ausrechnen. (Pythagoras)
    /Dist DX dup mul
    DY dup mul add sqrt def
    Dist 0 ne                    % Falls Entfernung 0, dann garnichts machen.
    { /DSX DX Dist div           % Die Variable Ovr gibt an, um welchen Betrag
      Ovr mul def                % der letzte Buchstaben ueber das vorhergehende
      /DSY DY Dist div           % Pfadsegment hinausragt. Dieses Stueck wird
      Ovr mul def                % beim neuen Segment beruecksichtigt.
      OldX DSX add
      OldY DSY add
      transform                  % aktuelle Position in absoluten (Geraete-)
      /CPY exch def              % Koordinaten gemerkt.
      /CPX exch def
      /Pathdist                  % bisher zurueckgelegte Entfernung wird um die
      Pathdist Dist add def      % Laenge des aktuellen Segmentes erhoeht.
      { Setdist Pathdist le      % Solange das neue Segment nicht gefuellt ist,
                                 % werden weitere Zeichen ausgegeben.
        { Charcount
     Str length lt               % Enthaelt der String noch Zeichen?
     { Setchar }                 % Ja, dann ausgeben
     { exit } ifelse             % Nein, dann Schluss
   }
   { /Ovr Setdist                % um wieviel ueber den Pfad hinausgegangen?
     Pathdist sub def
     exit
   } ifelse
      } loop
    } if
  } def
  
  /Curvetoproc                   % wird nicht gebraucht, da der Pfad nach flat-
  { } def                        % tenpath keine curveto-Segmente mehr enthaelt.
  
  /ClosepathProc                 % wird aufgerufen, wenn im Pfad ein closepath-
                                 % Segment angetroffen wird.
  { FirstX FirstY LinetoProc     % Der closepath-Operator wird durch ein lineto
    FirstX FirstY MovetoProc     % zum Ausgangspunkt mit folgendem moveto simu-
  } def                          % liert
  
  /Setchar                       % setzt das naechste Zeichen des Strings
  { /Char Str Charcount 1        % naechstes Zeichen holen
    getinterval def
    /Charcount Charcount 1       % Anzahl der Zeichen erhoehen
    add def
    /Charwidth Char              % Dickte des Zeichens
    stringwidth pop def
    gsave
    CPX CPY itransform           % Koordinatensystem an die letzte Position ver-
    translate                    % schieben und entlang des Pfades ausrichten.
    DY DX atan rotate
    0 0 moveto Char show         % Zeichen ausgeben
    currentpoint transform       % Aktuelle Position in Geraetekoordinaten
    /CPY exch def                % transformieren und merken
    /CPX exch def
    grestore
    /Setdist Setdist             % Laenge des ausgegebenen Textes aktualisieren
    Charwidth add def
  } def
end

%%EndProlog

%%Page: 1 1
/Helvetica findfont              % Aktuellen Font auswaehlen
16 scalefont setfont

% 1.5 1.5 scale

newpath                          % Konstruktion eines Pfades fuer Pathtext
200 500 70 0 270 arc
200 110 add 500 70 270 180 arc

(If my film makes one \
more person feel miserable \
I'll feel I've done my job. \
-- WOODY ALLEN) 55 Pathtext      % Die Textausgabe soll erst beginnen, wenn 55
                                 % Einheiten auf dem Pfad zurueckgelegt sind.
newpath
150 310 moveto 360 310 lineto
360 400 lineto 150 400 lineto
closepath
360 347 moveto 410 330 lineto
410 380 lineto 360 363 lineto
2 setlinewidth stroke

showpage

%%Trailer
%%Pages: 1


Vorschau:

Download PostScript-File

© Holger Gehringer, Dezember 1998