Turbo Toolbox/Turbo_Toolbox.iso/sonderh1/polyfilp.pas

Pascal/Delphi Source File | 1987-04-15 | 12KB | 286 lines

(*-------------------------------------------------------------------------*)
(*                          POLYFILP.PAS                                   *)
(*         Aenderungen die an POLYFILL vorgenommen werden muessen,         *)
(*               um den PatternFill zu erhalten.                           *)

(***       Neuer Prozedurkopf mit zusaetzlichem Parameter 'Muster':      ***)
PROCEDURE PolyFill (Punkte: Polygon;
                    AnzahlEcken: PolyIndex;
                    Muster: Pattern_);


TYPE Zeiger = ^EckenInfo;
     EckenInfo = RECORD
                   YTop : INTEGER;          (* Max. y-Wert der Kante       *)
                   XMin,                    (* Min. x-Wert der Kante       *)
                   m_inverse : REAL;        (* reziproke Steig. der Kante  *)
                   next : Zeiger            (* Naechste Kante              *)
                 END;

VAR
       (* Es ist guenstiger, die Punkte intern bei 0 beginnend zu zaehlen, *)
       (* siehe Anwendungen der Modulafunktion im Algorithmus. Daher :     *)
    PunktIntern: ARRAY [0..PolyMax] OF PolyPunkt;
    EckenTabelle : ARRAY [0..ScreenYmax] OF Zeiger;
    ScanLine : Zeiger;            (* Schnittpunktliste fuer aktuelle Zeile *)
    i : INTEGER;

(*-------------------------------------------------------------------------*)
(*                  Prozeduren zur Listenbearbeitung:                      *)

  (*-----------------------------------------------------------------------*)
  (*              reziproke Steigung einer Kante berechnen:                *)
  FUNCTION Inverse (i: INTEGER): REAL;

  BEGIN
    IF PunktIntern[i].y = PunktIntern[Succ(i) MOD AnzahlEcken].y THEN
      Inverse := 0                                    (* horizontale Kante *)
    ELSE
      Inverse := (PunktIntern[i].x-PunktIntern[Succ(i) MOD AnzahlEcken].x)
                  /(PunktIntern[i].y-PunktIntern[Succ(i) MOD AnzahlEcken].y)
  END;

  (*-----------------------------------------------------------------------*)

  PROCEDURE Einfuegen (Ecke: Zeiger; VAR Liste: Zeiger);

  VAR
    Akt,
    Vor : Zeiger;

  BEGIN
    IF Liste = NIL THEN                             (* Liste ist noch leer *)
      Liste := Ecke
    ELSE                                        (* Ecke in Liste einfuegen *)
      IF Ecke^.XMin <= Liste^.XMin THEN
        BEGIN                     (* Ecke muss als erste eingefuegt werden *)
          Ecke^.next := Liste;
          Liste := Ecke
        END
      ELSE
        BEGIN                                           (* Position suchen *)
          Akt := Liste;
          WHILE (Akt^.next <> NIL) AND (Akt^.XMin < Ecke^.XMin) DO
          BEGIN
            Vor := Akt;                      (* Vorherige Position sichern *)
            Akt := Akt^.next                 (* und zur naechsten ....     *)
          END;
          IF (Akt^.next = NIL) AND (Akt^.XMin < Ecke^.XMin) THEN
                                       (* Ecke gehoert an's Ende der Liste *)
            Akt^.next := Ecke
          ELSE
            BEGIN                               (* Ecke in Liste einketten *)
              Ecke^.next := Akt;
              Vor^.next := Ecke
            END
        END
  END;

  (*-----------------------------------------------------------------------*)

  PROCEDURE ErstelleTabelle (AnzahlEcken: INTEGER);

  VAR ScanLine,                               (* Abtastlinie               *)
      k           : INTEGER;                  (* Ecken-Laufindex           *)
      Eckenliste  : Zeiger;

  BEGIN
    FOR ScanLine := 0 TO ScreenYmax DO
      EckenTabelle[ScanLine] := NIL;
                       (* Eckeninformationen in die Eckentabelle einfuegen *)
    FOR k := 0 TO Pred(AnzahlEcken) DO
    BEGIN
      New(Eckenliste);
      Eckenliste^.m_inverse := Inverse(k);
      Eckenliste^.next := NIL;

      (* Falls PunktIntern[k].y weiter oben ist als PunktIntern[k+1], dann *)
      (* YTop auf diesen Wert setzen.                                      *)
      IF PunktIntern[k].y > PunktIntern[Succ(k) MOD AnzahlEcken].y THEN
        BEGIN
          Eckenliste^.YTop := PunktIntern[k].y;
                        (* Falls am PunktIntern[k+1] ein Minimum vorliegt, *)
                        (* die Kante NICHT verkuerzen.                     *)
          IF PunktIntern[Succ(k) MOD AnzahlEcken].y <
             PunktIntern[(k + 2) MOD AnzahlEcken].y THEN
            BEGIN
              Eckenliste^.XMin := PunktIntern[Succ(k) MOD AnzahlEcken].x;
              Einfuegen(Eckenliste,
                        EckenTabelle[PunktIntern[Succ(k) MOD AnzahlEcken].y])
            END
          ELSE                      (* Falls Ecke[k + 1] KEIN Extrema ist, *)
            BEGIN                   (* das niedrigere Ende kuerzen         *)
              Eckenliste^.XMin := PunktIntern[Succ(k) MOD AnzahlEcken].x
                                  + Eckenliste^.m_inverse;
              Einfuegen(Eckenliste,
                        EckenTabelle[Succ(PunktIntern[Succ(k) MOD
                                                         AnzahlEcken].y)])
          END
        END
      ELSE
                (* Falls PunktIntern[k + 1] hoeher ist als PunktIntern[k], *)
                (* YTop entsprechend setzen. Darf NICHT bei einer waage-   *)
                (* rechten Kante gemacht werden !                          *)
        IF PunktIntern[k].y < PunktIntern[Succ(k) MOD AnzahlEcken].y THEN
        BEGIN
          Eckenliste^.YTop := PunktIntern[Succ(k) MOD AnzahlEcken].y;
                                (* Falls kein Minimum, Kante NICHT kuerzen *)
          IF (PunktIntern[k].y <
              PunktIntern[Pred(k + AnzahlEcken) MOD AnzahlEcken].y) THEN
            BEGIN
              Eckenliste^.XMin := PunktIntern[k].x;
              Einfuegen(Eckenliste,EckenTabelle[PunktIntern[k].y])
            END
          ELSE
            BEGIN               (* Ecke ist kein Extrema ==> Kante kuerzen *)
              Eckenliste^.XMin := PunktIntern[k].x + Eckenliste^.m_inverse;
              Einfuegen(Eckenliste,EckenTabelle[Succ(PunktIntern[k].y)])
            END
        END
    END (* FOR *)
  END;

  (*-----------------------------------------------------------------------*)
  (* NeueListe ist die Liste aus der Eckentabelle, AlteListe wird fuer die
     Scanline aufgebaut.                                                   *)

  PROCEDURE Mischen (NeueListe: Zeiger; VAR AlteListe: Zeiger);

  VAR Temp, Neu: Zeiger;

  BEGIN
    IF AlteListe = NIL THEN                              (* Leere Scanline *)
      AlteListe := NeueListe
    ELSE
      BEGIN                                                     (* Mischen *)
        Neu := NeueListe;
        WHILE Neu <> NIL DO
        BEGIN                          (* Ecke in ScanLine-Liste einfuegen *)
          Temp := Neu^.next;
          Neu^.next := NIL;
          Einfuegen(Neu, AlteListe);
          Neu := Temp                               (* Zur naechsten Kante *)
        END
      END
  END;

  (*-----------------------------------------------------------------------*)
  (* Entfernt aus der ScanLine-Liste solche Kanten, die an der aktuellen
     ScanLine enden.                                                       *)

  PROCEDURE Entferne (VAR ScanLine: Zeiger; YZeile: INTEGER);

  VAR Akt, Letzte : Zeiger;

  BEGIN
    Akt := ScanLine;
    WHILE Akt <> NIL DO
    BEGIN
      IF Akt = ScanLine THEN                          (* erste entfernen ? *)
        IF Akt^.YTop = YZeile THEN
          BEGIN                                             (* entfernen ! *)
            ScanLine := ScanLine^.next;
            Akt := ScanLine;
            Letzte := Akt
          END
        ELSE
          BEGIN                             (* erste Kante NICHT entfernen *)
            Letzte := Akt;                  (* weiter...                   *)
            Akt := Akt^.next
          END
      ELSE
        BEGIN                                    (* andere Ecken behandeln *)
          IF Akt^.YTop = YZeile THEN                    (* Ecke entfernen? *)
            Letzte^.next := Akt^.next                   (* ja...           *)
          ELSE
            Letzte := Akt;
          Akt := Akt^.next                 (* und weiter in beiden Faellen *)
        END
    END
  END;

  (*-----------------------------------------------------------------------*)
  (* Inkrementiert die XMin-Werte der ScanLine-Liste um m_inverse und      *)
  (* sortiert die ScanLine-Liste aufgrund der XMin-Werte neu.              *)

  PROCEDURE NeuSortieren (VAR ScanLine: Zeiger);

  VAR SortZeiger, SortNext: Zeiger;

  BEGIN
    IF ScanLine <> NIL THEN
    BEGIN                                          (* Erste Ecke behandeln *)
      ScanLine^.XMin := ScanLine^.XMin + ScanLine^.m_inverse;
      SortZeiger := ScanLine^.next;
      ScanLine^.next := NIL;
                             (* Damit hat ScanLine nur noch die erste Ecke *)
                             (* Restlichen Ecken behandeln...              *)
      WHILE SortZeiger <> NIL DO
      BEGIN                                         (* XMin inkrementieren *)
        SortZeiger^.XMin := SortZeiger^.XMin + SortZeiger^.m_inverse;
        SortNext := SortZeiger^.next;

        SortZeiger^.next := NIL;     (* Fuer Einfuegen EINE Ecke isolieren *)
        Einfuegen(SortZeiger, ScanLine);
        SortZeiger := SortNext
      END
    END
  END;

  (*-----------------------------------------------------------------------*)
  (* diese modifizierte Prozedur 'Fuelle_ScanLine' gegen die alte ersetzen!*)

  PROCEDURE Fuelle_ScanLine (ScanLine: Zeiger; y: INTEGER);

  VAR k: INTEGER;      (* k = gerade ==> zeichnen, k = ungerade ==> move'n *)
      Akt: Zeiger;
      AktX,                                   (* X-Wert Pixel auf ScanLine *)
      xi, yi: INTEGER;                                    (* Pattern Index *)

  BEGIN
    k := 0;
    IF ScanLine <> NIL THEN
    BEGIN                                        (* Es gibt was zu fuellen *)
      Akt := ScanLine;
      WHILE Akt <> NIL DO
      BEGIN                                                    (* Zeichnen *)
        k := Succ(k);
        IF k MOD 2 = 1 THEN
          movea(Round(Akt^.XMin),y)
        ELSE
          BEGIN
            yi := y MOD Succ(PatternSize);
            FOR AktX := Pen_xPos TO Round(Akt^.XMin) DO
            BEGIN
              xi := AktX MOD Succ(PatternSize);
              IF Muster[yi,xi] THEN
                point(AktX,y)
            END
          END;
        Akt := Akt^.next
      END
    END
  END;

  (*-----------------------------------------------------------------------*)

BEGIN (* PolyFill *)
  FOR i := 1 TO AnzahlEcken DO        (* Punkte in PunktIntern umsortieren *)
    PunktIntern[Pred(i)] := Punkte[i];
  PolyLine(Punkte, AnzahlEcken);
                                                     (* Polygon schliessen *)
  Line(Punkte[1].x,Punkte[1].y,Punkte[AnzahlEcken].x,Punkte[AnzahlEcken].y);
  ErstelleTabelle(AnzahlEcken);
  ScanLine := NIL;
  FOR i := 0 TO ScreenYmax DO
  BEGIN
    IF EckenTabelle[i] <> NIL THEN
      Mischen(EckenTabelle[i], ScanLine);
    Fuelle_ScanLine(ScanLine, i);
    Entferne(ScanLine, i);
    NeuSortieren(ScanLine);
  END
END;

(*-------------------------------------------------------------------------*)
(*                             Ende POLYFILP.PAS                           *)