{************************************************
                 Hugo Eti‚vant
     http://www.multimania.com/cyberzoide/
      e-mail : cyberzoide@multimania.com
      (pour une aide en Turbo Pascal 7.0)
*************************************************}
unit graphics;

INTERFACE
uses graph;
{ ligne du point (X1,Y1) au point (X2,Y2) }
procedure ligne(x1,y1,x2,y2,c:integer);
{ Segment de Bresenham avec antialiasing. Attention aux figures de Moir‚ }
procedure ligne2(x1,y1,x2,y2,c:integer);
{ cercle de centre (X,Y) de rayon R et de couleur C }
procedure cercle(x,y,r,c:integer);
{ cercle de centre (X,Y) de rayon R et de couleur C avec sin et cos}
procedure cercle2(x,y,r,c:integer);
{ disque de centre (X,Y) de rayon R et de couleur C }
procedure disque(x,y,r,c:integer);
{ disque de centre (X,Y) de rayon R et de couleur C avec sin et cos}
procedure disque2(x,y,r,c:integer);
{ remplissage d'une surface d‚limit‚ par un contour ferm‚ de couleur B
  … partir du point (X,Y) et avec la couleur C }
procedure foodfill(x,y,c,b:integer);
{ remplissage d'une surface d‚limit‚ par un contour ferm‚
  … partir du point (X,Y) et avec la couleur C tant que les points
  rencontr‚s sont de couleur B (couleur de fond) }
procedure foodfill2(x,y,c,b:integer);
{ rectangle remplit de couleur C dont les coins extrˆmes sont
  haut/gauche (X1,Y1) et bas/droite (X2,Y2) }
procedure rect(x1,y1,x2,y2,c:integer);
{ cercle avec effet de vagues}
procedure rectP(x1,y1,x2,y2,c:integer);
{ rectangle de couleur C dont les coins extrˆmes sont
  haut/gauche (X1,Y1) et bas/droite (X2,Y2) }
procedure cercleWaves(x,y,r,c:integer);
{ disque avec effet de vagues }
procedure disqueWaves(x,y,r,c:integer);
{ rectangle remplit avec effet de vagues}
procedure rectPWaves(x1,y1,x2,y2,c:integer);


IMPLEMENTATION

{ ligne du point (X1,Y1) au point (X2,Y2) }
procedure ligne(x1,y1,x2,y2,c:integer);
var m,y0,y:real;
    x:integer;
begin
setcolor(c);
m:=abs((y2-y1)/(x2-x1+0.1));
          { y0:=y1-x1*m; }
y:=y1; { <=> y:=y0+m*x1; }
moveto(x1,round(y));
for x:=x1 to x2 do
    begin
    putpixel(x,round(y),c);
    y:=y+m;
    end;
end;

{ cercle de centre (X,Y) de rayon R et de couleur C }
procedure cercle(x,y,r,c:integer);
var d,cx,cy : integer;
begin
     d := 3-(r+r);
     cx := 0;
     cy := r;
     while cx <= cy do begin
           putpixel(x+cx,y+cy,c);
           putpixel(x+cx,y-cy,c);
           putpixel(x-cx,y+cy,c);
           putpixel(x-cx,y-cy,c);
           putpixel(x+cy,y+cx,c);
           putpixel(x+cy,y-cx,c);
           putpixel(x-cy,y+cx,c);
           putpixel(x-cy,y-cx,c);
           inc(cx);
           if d < 0 then begin
              d := d+cx shl 2+6;
           end
           else begin
              d := d+(cx-cy) shl 2+10;
              dec(cy);
           end;
     end;
end;

end;

{ cercle de centre (X,Y) de rayon R et de couleur C }
procedure cercle2(x,y,r,c:integer);
var a:real;
begin
a:=0;
repeat
putpixel(round(x+r*cos(a)),round(y+r*sin(a)),c);
putpixel(round(x+r*cos(a)),round(y-r*sin(a)),c);
putpixel(round(x-r*cos(a)),round(y+r*sin(a)),c);
putpixel(round(x-r*cos(a)),round(y-r*sin(a)),c);
a:=a+Pi/(4*r);
until a>=Pi/2;
end;

{ disque de centre (X,Y) de rayon R et de couleur C }
procedure disque(x,y,r,c:integer);
var a,b:real;
begin
setcolor(c);
b:=0;
repeat
a:=sqrt(abs(sqr(r)-sqr(b)));
putpixel(round(x+b),round(y+a),c);
putpixel(round(x+b),round(y-a),c);
putpixel(round(x-b),round(y+a),c);
putpixel(round(x-b),round(y-a),c);
{ remplissage : }
ligne(round(x-b),round(y-a),round(x+b),round(y-a),c);
ligne(round(x-b),round(y+a),round(x+b),round(y+a),c);
{ fin }
b:=b+Pi/(2*r);
until b>r;
end;

{ disque de centre (X,Y) de rayon R et de couleur C }
procedure disque2(x,y,r,c:integer);                                           
var a:real;                                                                   
begin                                                                         
a:=0;                                                                         
repeat                                                                        
line(round(x-r*cos(a)),round(y-r*sin(a)),round(x+r*cos(a)),round(y-r*sin(a)));
line(round(x-r*cos(a)),round(y+r*sin(a)),round(x+r*cos(a)),round(y+r*sin(a)));
a:=a+Pi/(4*r);                                                                
until a>Pi/2;                                                                 
end;                                                                          

{ remplissage d'une surface d‚limit‚ par un contour de couleur B
  … partir du point (X,Y) et avec la couleur C }
procedure foodfill(x,y,c,b:integer);
var f:longint;
begin
if (getpixel(x,y)<>c) and (getpixel(x,y)<>b)
   then
   begin
   putpixel(x,y,c);
   foodfill(x-1,y,c,b);
   foodfill(x+1,y,c,b);
   foodfill(x,y-1,c,b);
   foodfill(x,y+1,c,b);
   end;
end;

{ remplissage d'une surface d‚limit‚ par un contour ferm‚
  … partir du point (X,Y) et avec la couleur C tant que les points
  rencontr‚s sont de couleur B (couleur de fond) }
procedure foodfill2(x,y,c,b:integer);
var f:longint;
begin
if (getpixel(x,y)<>c) and (getpixel(x,y)=b)
   then
   begin
   putpixel(x,y,c);
   foodfill(x-1,y,c,b);
   foodfill(x+1,y,c,b);
   foodfill(x,y-1,c,b);
   foodfill(x,y+1,c,b);
   end;
end;

{ rectangle remplit de couleur C dont les coins extrˆmes sont
  haut/gauche (X1,Y1) et bas/droite (X2,Y2) }
procedure rectP(x1,y1,x2,y2,c:integer);
var x,y:integer;
begin
setcolor(c);
y:=y1;
for x:=x1 to x2 do
    begin
    line(x,y1,x,y2);
    y:=y+1;
    end;
end;

{ rectangle de couleur C dont les coins extrˆmes sont
  haut/gauche (X1,Y1) et bas/droite (X2,Y2) }
procedure rect(x1,y1,x2,y2,c:integer);
begin
setcolor(c);
line(x1,y1,x2,y1);   {haut}
line(x1,y2,x2,y2);   {bas}
line(x1,y1,x1,y2);   {gauche}
line(x2,y1,x2,y2);  {droite}
end;

{ cercle avec effet de vagues}
procedure cercleWaves(x,y,r,c:integer);
var a,b,z:integer;
begin
for b:=y-r to y+r do
    begin
    z:=round(sqrt(abs(sqr(r)-sqr(b-y))));
    putpixel(x-z,b+round(sin(z)),c);
    putpixel(x+z+round(sin(z)),b,c);
    end;
end;

{ disque avec effet de vagues }
procedure disqueWaves(x,y,r,c:integer);
var a,b,z:integer;
begin
for b:=y-r to y+r do
    begin
    z:=round(sqrt(abs(sqr(r)-sqr(b-y))));
    for a:=x to x+z do
        begin
        putpixel(a+round(sin(z)),b,c);        { sym‚trie }
        putpixel(a-z+round(sin(z)),b,c);
        end;
    end;
end;

{ rectangle remplit avec effet de vagues}
procedure rectPWaves(x1,y1,x2,y2,c:integer);
var x,y:integer;
begin
for x:=x1 to x2 do
    for y:=y1+10 to y2-10 do putpixel(x+round(5*sin(y/3)),y,c);
for y:=y1 to y1+15 do
    for x:=x1+10 to x2-10 do
        begin
        putpixel(x,y+round(5*sin(x/3)),c);
        putpixel(x,y+abs(y2-y1)-15+round(5*sin(x/3)),c);
        end;
end;

{ Segment de Bresenham avec antialiasing
  Attention aux figures de moir‚ }
procedure ligne2(x1,y1,x2,y2,c:integer);
var x,y:integer;
    e,m:real;
begin
y:=y1;
m:=(y2-y1)/(x2-x1+1e-5);
e:=0;         { e = intensit‚ de couleur varie entre 0 et 1 }
for x:=x1 to x2 do
    begin
    e:=e+m;
    if e>=1 then
       begin
       e:=e-1;
       y:=y+1;
       end;
    putpixel(x,y+1,round(e*(c-1)));
    putpixel(x,y,round(c-1-e*(c-1)));
    end;
end;

BEGIN
END.