{****************************************************************************}
{Modul VENOMPOL.INC - it is a part of the VenomGFX unit which implements     }
{algorithm for polygone drawing                                              }
{published in book Pocitacova grafika - principy a akgoritmy by Jiri Jara    }
{    routine adjusted by Laaca                                               }
{****************************************************************************}

type
       Tpoly_hrana = record
                 y_horni    : longint;   { vetsi souradnice y hrany }
                 prusecik_x : real;      { x, ktere patri k y_horni }
                 delta_y    : longint;   { rozdil mezi souradnicemi y }
                 zmena_x_na_radek : real { zmena x pri zmene y o 1 pixel }
               end;

       TPoly_hranice = array[1..MAX_POLY] of Tpoly_hrana;
       PPoly_hranice = ^TPoly_hranice;

  var
       poly_hranice : PPoly_hranice;
       poly_tg:PVirtualwindow;
       poly_barva:word;

procedure Uvodni_zpracovani_hranice (p:polytype;var pocet_hran, nejnizsi_y : longint);
     var k, x1, y1 : longint;

     function Najdi_dalsi_y (k : longint) : longint;
       var i:longint;
           hotovo : boolean;
          begin
               {nalezne v seznamu vrcholu dalsi vrchol,
               jehoz souradnice y neni rovna y[k]}
              i:=k;
              hotovo := false;
              while not (hotovo)
                do if p.point^[i].y<>p.point^[k].y then hotovo := true
                  else begin
                         inc(i);
                         if i>p.num then i:=1;
                       end;
              najdi_dalsi_y := p.point^[i].y;
          end; {Najdi_dalsi_y}

    procedure Vloz_do_seznamu_hran (polozka, x1, y1, x2, y2, dalsi_y : longint);
         var  max_y : longint;
              x2_prac, zmena_x_prac : real;
              zarazeno : boolean;
         begin
              {uprava souradnic vrcholu pri kraceni hrany}
              zmena_x_prac := (x2 - x1) / (y2 - y1);
              x2_prac := x2;
              if (y2 > y1) and (y2 < dalsi_y) then
                   begin
                        y2 := y2 - 1;
                        x2_prac := x2_prac - zmena_x_prac
                   end
              else
              if (y2 < y1) and (y2 > dalsi_y) then
                   begin
                        y2 := y2 + 1;
                        x2_prac := x2_prac + zmena_x_prac
                   end;
              {zatrideni do seznamu hran podle max_y dane hrany}
              if y1 > y2 then max_y := y1 else max_y := y2;
              zarazeno := false;
              while not(zarazeno) and (polozka > 1) do
                     if (max_y <= poly_hranice^[polozka - 1].y_horni)
                       then zarazeno := true
                       else
                       begin
                        poly_hranice^[polozka] := poly_hranice^[polozka-1];
                        polozka := polozka - 1
                   end; {while}
              with poly_hranice^[polozka] do
                   begin
                        y_horni := max_y;
                        delta_y := abs(y2 - y1) + 1;
                        if y1 > y2 then prusecik_x := x1
                                   else prusecik_x := x2_prac;
                        zmena_x_na_radek := zmena_x_prac
                   end; {with}
         end; {Vloz_do_seznamu_hran}

begin {Uvodni_zpracovani_hranice }
pocet_hran := 0;
GetMem(poly_hranice,p.num*SizeOf(Tpoly_hrana));
y1:=p.point^[p.num].y; x1:=p.point^[p.num].x; {inicializace}
nejnizsi_y := y1;
for k:=1 to p.num do
    begin
    if y1 = p.point^[k].y then        { vodorovna hrana je hned vykreslena }
       LineHorz(poly_tg^,x1,p.point^[k].x,y1,poly_barva)
       else begin               { umisteni nevodorovne hrany do seznamu }
       pocet_hran := pocet_hran + 1;
       Vloz_do_seznamu_hran(pocet_hran,x1,y1,p.point^[k].x,p.point^[k].y,
                            Najdi_dalsi_y(k))
       end;
    y1 := p.point^[k].y; x1 := p.point^[k].x;    {priprava pro dalsi hranu}
    if y1 < nejnizsi_y then nejnizsi_y := y1;
    end; {for k}
end; { Uvodni_zpracovani_hranice }

procedure Aktualizuj_seznam_hran (pocet_hran, radek : longint;
                      var prvni_hrana, posledni_hrana : longint);
     var konec_cyklu : boolean;
     begin
          konec_cyklu := (posledni_hrana = pocet_hran);
          while not konec_cyklu do
               if (poly_hranice^[posledni_hrana + 1].y_horni >= radek)
               then begin
                         posledni_hrana := posledni_hrana + 1;
                         konec_cyklu := (posledni_hrana = pocet_hran);
                    end
               else konec_cyklu := true;
          while poly_hranice^[prvni_hrana].delta_y = 0 do
               prvni_hrana := prvni_hrana + 1
     end; { Aktualizuj_seznam_hran }

procedure Nalezni_pruseciky_x (radek : longint;
               var pocet_pruseciku : longint;
               prvni_hrana, posledni_hrana : longint);
  var k:longint;

     procedure Zarad_podle_x (dana_hrana, prvni_hrana: longint);
       var zarazeno : boolean;
           na_zamenu : Tpoly_hrana;
       begin
         zarazeno := false;
         while not (zarazeno) and (dana_hrana > prvni_hrana)  do
           if (poly_hranice^[dana_hrana].prusecik_x >=
               poly_hranice^[dana_hrana - 1].prusecik_x)
                 then zarazeno := true
                 else          {zamena dvou zaznamu v tabulce hran }
                   begin
                     na_zamenu := poly_hranice^[dana_hrana];
                     poly_hranice^[dana_hrana] := poly_hranice^[dana_hrana - 1];
                     poly_hranice^[dana_hrana - 1] := na_zamenu;
                     dana_hrana := dana_hrana - 1
                   end
     end; {Zarad_podle_x}

     begin {Nalezni_pruseciky_x}
          pocet_pruseciku := 0;
          for k := prvni_hrana to posledni_hrana do
               begin
                    if poly_hranice^[k].delta_y > 0 then
                         pocet_pruseciku := pocet_pruseciku + 1;
                    Zarad_podle_x (k, prvni_hrana)
               end
     end; {Nalezni_pruseciky_x}

procedure Kresli_useky (radek, pocet_pruseciku, index_hrany : longint);
     var k, x1, x2 : longint;
     begin
          for k := 1 to pocet_pruseciku div 2 do
               begin
                    while poly_hranice^[index_hrany].delta_y = 0
                         do index_hrany:=index_hrany + 1;
                    x1 := round (poly_hranice^[index_hrany].prusecik_x);
                    index_hrany := index_hrany + 1;
                    while poly_hranice^[index_hrany].delta_y = 0
                         do index_hrany:=index_hrany + 1;
                    x2 := round (poly_hranice^[index_hrany].prusecik_x);
                    LineHorz(poly_tg^,x1,x2,radek,poly_barva);
                    index_hrany:=index_hrany + 1
               end {for k}
     end; {Kresli_useky}

procedure Uprav_seznam_hran (prvni_hrana, posledni_hrana: longint);
  var k : longint;
  begin
    for k := prvni_hrana to posledni_hrana do
      with poly_hranice^[k] do
        if delta_y > 0 then   {urceni dalsiho prusecik_x, snizeni delta_y}
          begin
            delta_y := delta_y - 1;
            prusecik_x := prusecik_x - zmena_x_na_radek
          end
  end; {Uprav_seznam_hran}

Procedure Zrus_seznam_hran(p:polytype);
begin
FreeMem(poly_hranice,p.num*SizeOf(Tpoly_hrana));
end;