program bilddrehen3;
{$M 40000, 0, 655360}
{F�r jeden Punkt der Ergebnisfl�che wird die entsprechende Ausgangsfarbe
gesucht; Bitmap-Format in bmpdreh.pas}
uses crt, graph;

type bfeld = array[1..12000] of byte;
type arccoordstype = record
                        x, y, xstart, ystart, xend, yend : longint;
                      end;
var gd, gm : integer;
    punkte : arccoordstype;
    fehler : byte;

procedure ausgangstext(x, y: integer);
{linke obere Ecke f�r Textausgabe}

  var i, j : byte;

  begin
    {for i:=1 to 48 do
      begin
        setcolor(i);
        for j:=1 to 10 do line(0, i*10+j, 120, i*10+j);
      end;}
    settextstyle(1, 0, 4);
    outtextxy(x, y, 'Stefan Ziegler');
  end;

procedure fillcoords(xs, ys, xe, ye, xm, ym : integer; var arcvar: arccoordstype);
  begin         {punkte in arcvar eintragen}
    with arcvar do
      begin
        Xstart:=xs; Ystart:=ys;
        Xend:=xe; Yend:=ye;
        X:=xm; Y:=ym;
      end;
  end;

function lesen(x, y: integer; xd: byte; bildp: bfeld): byte;
   {liest Farbe vom Punkt x,y(0, 0 ist 1.Punkt in Bitmap) aus Bitmap bfeld}
  var f1, f2, f3, f4 : byte;
      stelle         : integer;
      j, av, k, fl   : byte;

  begin
    stelle:=4 + xd*4*(y-1) + (x div 8);
    f1:=bildp[stelle];
    f2:=bildp[stelle+xd];
    f3:=bildp[stelle+xd*2];
    f4:=bildp[stelle+xd*3];
    k:=x mod 8;
    av:=128;
    if k>=2 then
      for j:=1 to k-1 do
        av:=av div 2;
    if (av<>0) then
      fl:=((f1 and av) div av) * 8 + ((f2 and av) div av) * 4;
    if (av<>0) then
    fl:=fl + ((f3 and av) div av) * 2 + ((f4 and av) div av) * 1;
    lesen:=fl;
  end;

procedure bmpdrehen(punkte: arccoordstype; winkel:integer; var fehler:byte);
{Punkte: Xstart, Ystart: linke obere Koordinate;
         Xend,   Yend  : rechte untere Koordinate;
         X, Y          : Drehmittelpunkt;
 winkel: Drehwinkel in Grad;
 Fehler 1: Bildfl�che zu gro�;
 Fehler 2: Bildrand �berschritten (kein Abbruch)}

  var winkr, radr, winkd  : real;
      bildp        : bfeld;
      xi, yi, xp, yp : longint;
      xd, farbe    : byte;
      xpstr, ypstr, xistr, yistr, winstr : string[5];

  begin
    fehler:=0;
    winkd:=winkel*Pi/180;
    with punkte do
      begin
        getimage(Xstart, Ystart, Xend, Yend, bildp);
        xd:=((Xend-Xstart) div 8) + 1; {siehe Aufbau bmp, wie lang Zahlenkolonne ?}
        settextstyle(0, 0, 3);
        for yi:=0 to Yend-Ystart do
          for xi:=0 to Xend-Xstart do
            begin
              radr:=sqrt(abs((yi+ystart-y)*(yi+ystart-y))+
                         abs((xi+xstart-x)*(xi+xstart-x)));
              if (xi+xstart-x)<>0
                 then winkr:=winkd+arctan((yi+ystart-y)/(xi+xstart-x))
                 else winkr:=winkd;
              if x>xi then winkr:=winkr+Pi;
              xp:=round(x+cos(2*Pi-winkr)*radr);
              yp:=round(y-sin(2*Pi-winkr)*radr);
              {str(xp, xpstr); str(yp, ypstr); str(yi, yistr); str(xi, xistr);
              str((winkd*180/Pi):5:2, winstr);
              setcolor(0);
              outtextxy(200, 0, '����������������������������������');
              setcolor(15);
              outtextxy(200, 0, xpstr+' '+ypstr+' '+xistr+' '+yistr+' '+winstr);}
              if (xp>=0) and (yp>=0) and (xp<Xend) and (yp<Yend)
                then farbe:=lesen(xp+1, yp+1, xd, bildp)
                else farbe:=0;
              {farbe:=3;}
              putpixel(Xstart+xi, Ystart+yi, farbe);
            end;{of for x}
      end;{of with punkte}
  end;{of procedure bmpdrehen}

begin
  gd:=9; gm:=2;
  initgraph(gd, gm, 'd:\tp\bgi');
  cleardevice;
  ausgangstext(50, 0);
  fillcoords(50, 0, 300, 60, 400, 32, punkte);
  bmpdrehen(punkte, 5, fehler);
  ausgangstext(50, 100);
  repeat until keypressed;
  closegraph;
end.