Рисование раскрашенного треугольника

PROGRAM ColorTriangle;

CONST
    canvas_width  = 500;
    canvas_height = 500;

TYPE
    Integer = int32;
    TCanvas = array[0..canvas_width, 0..canvas_height] of Integer;



{ меняет местами x и y }
PROCEDURE Swap(var x, y : Integer);
BEGIN
x := x + y;
y := x - y;
x := x - y;
END;



{ работа с R, G, B компонентами }
FUNCTION cR(x : Integer) : Integer; BEGIN cR := x shr 16; END;
FUNCTION cG(x : Integer) : Integer; BEGIN cG := x shr 8 and 255; END;
FUNCTION cB(x : Integer) : Integer; BEGIN cB := x and 255; END;
FUNCTION RGB (r, g, b : Integer) : Integer;
BEGIN
RGB := r and 255 shl 16 + g and 255 shl 8 + b and 255;
END;



{ линейная интерполяция (x1, y1) - (x, ? ) - (x2, y2) }
FUNCTION LinearInterpolate(x1, y1, x, x2, y2 : Integer) : Integer;
BEGIN
LinearInterpolate := y1 + (y2 - y1) * (x - x1) div (x2 - x1);
END;



{ рисование градиентной горизонтальной линии }
PROCEDURE DrawLine(var canvas : TCanvas; x1, color1, x2, color2, y : Integer);

VAR
    x : Integer;

BEGIN

{ если x1 = x2 - вырожденный случай }
if x1 = x2 then begin
    canvas[x1, y] := (color1 + color2) shr 1;
    exit;
    end;

{ сортируем вершины так, чтобы выполнялось x1 <= x2 }
if x1 > x2 then begin
    Swap(    x1,     x2);
    Swap(color1, color2);
    end;

for x := x1 to x2 do
    if (x >= 0) and (x <= canvas_width) and (y >= 0) and (y <= canvas_height) then
        canvas[x, y] := RGB(
                        LinearInterpolate(x1, cR(color1), x, x2, cR(color2)),
                        LinearInterpolate(x1, cG(color1), x, x2, cG(color2)),
                        LinearInterpolate(x1, cB(color1), x, x2, cB(color2))
                        );

END;




{ рисование закрашенного треугольника }
PROCEDURE DrawTriangle(var canvas : TCanvas;  x1, y1, color1,  x2, y2, color2,  x3, y3, color3 : Integer);

VAR
    y                      : Integer;
    x_line_A, color_line_A,
    x_line_B, color_line_B : Integer;

BEGIN

{ сортируем вершины так, чтобы выполнялось y1 <= y2 <= y3 }
if (y1 > y2) or (y1 = y2) and (x1 > x2) then begin
    Swap(    x1,     x2);
    Swap(    y1,     y2);
    Swap(color1, color2);
    end;
if (y2 > y3) or (y2 = y3) and (x2 > x3) then begin
    Swap(    x2,     x3);
    Swap(    y2,     y3);
    Swap(color2, color3);
    end;
if (y1 > y2) or (y1 = y2) and (x1 > x2) then begin
    Swap(    x1,     x2);
    Swap(    y1,     y2);
    Swap(color1, color2);
    end;

{ если y1 = y3 - вырожденный случай }
if y1 = y3 then begin
    DrawLine(canvas, x1, color1, x3, color3, y1);
    exit;
    end;

{ закрашиваем горизонтальными полосками часть треугольника от y1 до y2 }
if y1 <> y2 then
    for y := y1 to y2 do begin

        { считаем начало и конец горизонтальной полоски }
        x_line_A     := LinearInterpolate(y1, x1, y, y2, x2);
        color_line_A := RGB(
                        LinearInterpolate(y1, cR(color1), y, y2, cR(color2)),
                        LinearInterpolate(y1, cG(color1), y, y2, cG(color2)),
                        LinearInterpolate(y1, cB(color1), y, y2, cB(color2))
                        );
        x_line_B     := LinearInterpolate(y1, x1, y, y3, x3);
        color_line_B := RGB(
                        LinearInterpolate(y1, cR(color1), y, y3, cR(color3)),
                        LinearInterpolate(y1, cG(color1), y, y3, cG(color3)),
                        LinearInterpolate(y1, cB(color1), y, y3, cB(color3))
                        );

        { рисуем полоску }
        DrawLine(canvas, x_line_A, color_line_A, x_line_B, color_line_B, y);
        end;

{ закрашиваем горизонтальными полосками часть треугольника от y2 до y3 }
if y2 <> y3 then
    for y := y2 to y3 do begin

        { считаем начало и конец горизонтальной полоски }
        x_line_A     := LinearInterpolate(y2, x2, y, y3, x3);
        color_line_A := RGB(
                        LinearInterpolate(y2, cR(color2), y, y3, cR(color3)),
                        LinearInterpolate(y2, cG(color2), y, y3, cG(color3)),
                        LinearInterpolate(y2, cB(color2), y, y3, cB(color3))
                        );
        x_line_B     := LinearInterpolate(y1, x1, y, y3, x3);
        color_line_B := RGB(
                        LinearInterpolate(y1, cR(color1), y, y3, cR(color3)),
                        LinearInterpolate(y1, cG(color1), y, y3, cG(color3)),
                        LinearInterpolate(y1, cB(color1), y, y3, cB(color3))
                        );

        { рисуем полоску }
        DrawLine(canvas, x_line_A, color_line_A, x_line_B, color_line_B, y);
        end;

END;


VAR
    { картинная плоскость }
    canvas : TCanvas;

    x, y  : integer;

    { вершины треугольника и их цвета }
    x1, y1, color1,
    x2, y2, color2,
    x3, y3, color3 : integer;

    { для сохранения картинки в файл }
    F :Text;


BEGIN

{ инициализируем катринную плоскость черным цеветом }
for x := 0 to canvas_width do
    for y := 0 to canvas_height do
        canvas[x, y] := 0;


{ задаём вершины треугольника и их цвета }
x1 :=  10; y1 :=  10; color1 := RGB(255, 0, 0);
x2 := 300; y2 := 490; color2 := RGB(0, 255, 0);
x3 := 490; y3 := 100; color3 := RGB(0, 0, 255);


{ рисуем треугольник }
DrawTriangle(canvas, x1, y1, color1,  x2, y2, color2,  x3, y3, color3);


{ сбрасываем картинную плоскость в файл .ppm }
Assign(F, 'result.ppm');
Rewrite(F);

WriteLn(F, 'P3');
WriteLn(F, canvas_width+1, ' ', canvas_height+1);
WriteLn(F, 255);

for y := 0 to canvas_height do begin
    for x := 0 to canvas_width do
        Write(F, cR(canvas[x, y]), ' ', cG(canvas[x, y]), ' ', cB(canvas[x, y]), ' ');
    WriteLn(F, '');
    end;


Close(F);

END.