program vektorfont;
{Bei Ausf�hrung nach Zahlenausgabe ENTER dr�cken
Dreht Wort in verschiedenen Achsen (vorgegeben Zeile 154, Zeile 152
Beachte Graphikverzeichnis in Zeile 133, Schriftverzeichnis Zeile 102}
uses crt, graph;

type array50 = array [1..50] of byte;

var f  : file of char;
    st : string;
    sterst : array50;
    i, j, ende, len, len25 : byte;
    durch : word;
    durch2: integer;
    ch, ch2 : char;
    gd, gm : integer;
    endeb     : boolean;
    buchstaben : array [1..255] of record
                                     line: array[1..50] of byte;
                                     len : byte;
                                    end;

procedure paintchar(sterst: array50; len, fak, a: byte; winkel: integer);

  var i, j, act : byte;
      xr, yr, xz, yz, xv1, yv1, xv2, yv2 : integer;
      winkelreal, sinus, cosin, sin45, cos45, x, y, z : real;

  begin
    xz:=getx; yz:=gety;
    winkel:=winkel mod 360;
    if winkel<0 then winkel:=360+winkel;
    winkelreal:=winkel* Pi / 180;
    sinus:=sin(winkelreal); cosin:=cos(winkelreal);
    sin45:=sin(45*Pi/180);
    cos45:=cos(45*Pi/180);
    for i:=1 to (len-2) div 2 do
      begin
        j:=(i-1)*2;
        x:=sterst[j+1] and 127;
        y:=sterst[j+2] and 127;
        if x>=64 then x:=x-128;
        if y>=64 then y:=y-128;
        x:=x*fak;
        y:=y*fak;
        if (a=0) then
          begin
            xr:=round(x*cosin-y*sinus);
            yr:=round(y*cosin+x*sinus);
          end;
        if (a=1) or (a=3) then
          begin
            xr:=round(x);      {Rotationsachse waagerecht}
            x:=round(x*cosin-y*sinus);
            yr:=round(y*cosin+x*sinus);
          end;
        if (a=2) or (a=3) then
          begin
            yr:=round(y);      {Rotationsachse senkrecht}
            y:=round(y*cosin+x*sinus);
            xr:=round(x*cosin-y*sinus);
          end;
        if (a=4) then
          begin
            z:=(sinus)*y;
            y:=(cosin)*y;
            yr:=round(y-(z*sin45));
            xr:=round(x+(z*cos45));
          end;
        if (a=5) then
          begin
            z:=(-sinus)*x;
            x:=(cosin)*x;
            xr:=round(x+(z*cos45));
            yr:=round(y-(z*sin45));
          end;
        if sterst[j+1]>=128 then act:=2
                            else act:=0;
        if sterst[j+2]>=128 then act:=act+1;
        if act=2 then moveto(xz+xr, yz-yr);
        if act=3 then lineto(xz+xr, yz-yr);
      end{ of for};
  end;{ of procedure}

procedure textausgabe(x, y, winkel: integer; faktor, act: byte; text: string);

  var i, j, len, zeichen : byte;

  begin
    moveto(x, y);
    for i:=1 to length(text) do
      begin
        zeichen:=ord(text[i]);
        for j:=1 to 50 do sterst[j]:=buchstaben[zeichen].line[j];
        len:=buchstaben[zeichen].len;
        paintchar(sterst, len, faktor, act, winkel);
      end;
  end;

begin
  clrscr;
  assign(f, 'd:\tp\bgi\litt.chr');
  reset(f);
  durch:=0;
  for j:=1 to 255 do
    begin
      for i:=1 to 50 do buchstaben[j].line[i]:=0;
      writeln(j);
    end;
  repeat
    for i:=1 to 255 do st[i]:=' ';
    i:=0;
    ende:=0;
    repeat
      i:=i+1;
      read(f, ch);
      st[i]:=ch;
      if ch=chr(0) then ende:=ende+1
                        else ende:=0;
    until ende=3;
    len:=i;
    writeln(durch, ' ', len);
    durch2:=durch+21;
    if durch2>32 then buchstaben[durch2].len:=len;
    if (len< 51) and (durch2>32) then
      for i:=1 to len do buchstaben[durch2].line[i]:=ord(st[i]);
    if keypressed then ch:=readkey;
    durch:=durch+1;
  until (ord(ch)=27) or (eof(f));
  close(f);
  readln;
  gd:=9; gm:=2;
  initgraph(gd, gm, 'd:\tp\bgi');
  {for durch:=33 to 255 do
    begin
      delay(500);
      cleardevice;
      moveto(300, 300);
      if keypressed then ch:=readkey;
      if ord(ch)=27 then durch:= 255;
      for i:=1 to 50 do sterst[i]:=buchstaben[durch].line[i];
      len:=buchstaben[durch].len;
      paintchar(sterst, len);
    end;}
  repeat
  ch:=chr(0); endeb:=false;
  for durch2:=0 to 5 do
    begin
      for durch:=1 to 180 do
        begin
          setcolor(0);
          textausgabe(320, 240, (durch-1)*2, 6, durch2, 'Text');
          setcolor(2);
          textausgabe(320, 240, durch*2, 6, durch2, 'Text');
          delay(50);
          if keypressed then ch:=readkey;
          if ord(ch)=27 then durch:= 180;
          if ord(ch)=27 then durch2:= 5
            else if ord(ch) > 0 then readln;
          if ord(ch) <> 27 then ch := chr(0);
        end;
      delay(50);
      if ord(ch)=27 then endeb:=true;
    end;
  until endeb;
  delay(500);
  closegraph;
end.