home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sonderh1 / polyfill.pas < prev    next >
Pascal/Delphi Source File  |  1987-04-15  |  11KB  |  271 lines
  1. (*-------------------------------------------------------------------------*)
  2. (*                        POLYFILL.PAS                                     *)
  3. (*          Polygonfill mit Kantentabellen (siehe Begleittext)             *)
  4.  
  5. PROCEDURE PolyFill (Punkte: Polygon; AnzahlEcken: PolyIndex);
  6.  
  7. TYPE Zeiger = ^EckenInfo;
  8.      EckenInfo = RECORD
  9.                    YTop : INTEGER;          (* Max. y-Wert der Kante       *)
  10.                    XMin,                    (* Min. x-Wert der Kante       *)
  11.                    m_inverse : REAL;        (* reziproke Steig. der Kante  *)
  12.                    next : Zeiger            (* Naechste Kante              *)
  13.                  END;
  14.  
  15. VAR
  16.        (* Es ist guenstiger, die Punkte intern bei 0 beginnend zu zaehlen, *)
  17.        (* siehe Anwendungen der Modulafunktion im Algorithmus. Daher :     *)
  18.     PunktIntern: ARRAY [0..PolyMax] OF PolyPunkt;
  19.     EckenTabelle : ARRAY [0..ScreenYmax] OF Zeiger;
  20.     ScanLine : Zeiger;            (* Schnittpunktliste fuer aktuelle Zeile *)
  21.     i : INTEGER;
  22.  
  23. (*-------------------------------------------------------------------------*)
  24. (*                  Prozeduren zur Listenbearbeitung:                      *)
  25.  
  26.   (*-----------------------------------------------------------------------*)
  27.   (*              reziproke Steigung einer Kante berechnen:                *)
  28.   FUNCTION Inverse (i: INTEGER): REAL;
  29.  
  30.   BEGIN
  31.     IF PunktIntern[i].y = PunktIntern[Succ(i) MOD AnzahlEcken].y THEN
  32.       Inverse := 0                                    (* horizontale Kante *)
  33.     ELSE
  34.       Inverse := (PunktIntern[i].x-PunktIntern[Succ(i) MOD AnzahlEcken].x)
  35.                   /(PunktIntern[i].y-PunktIntern[Succ(i) MOD AnzahlEcken].y)
  36.   END;
  37.  
  38.   (*-----------------------------------------------------------------------*)
  39.  
  40.   PROCEDURE Einfuegen (Ecke: Zeiger; VAR Liste: Zeiger);
  41.  
  42.   VAR
  43.     Akt,
  44.     Vor : Zeiger;
  45.  
  46.   BEGIN
  47.     IF Liste = NIL THEN                             (* Liste ist noch leer *)
  48.       Liste := Ecke
  49.     ELSE                                        (* Ecke in Liste einfuegen *)
  50.       IF Ecke^.XMin <= Liste^.XMin THEN
  51.         BEGIN                     (* Ecke muss als erste eingefuegt werden *)
  52.           Ecke^.next := Liste;
  53.           Liste := Ecke
  54.         END
  55.       ELSE
  56.         BEGIN                                           (* Position suchen *)
  57.           Akt := Liste;
  58.           WHILE (Akt^.next <> NIL) AND (Akt^.XMin < Ecke^.XMin) DO
  59.           BEGIN
  60.             Vor := Akt;                      (* Vorherige Position sichern *)
  61.             Akt := Akt^.next                 (* und zur naechsten ....     *)
  62.           END;
  63.           IF (Akt^.next = NIL) AND (Akt^.XMin < Ecke^.XMin) THEN
  64.                                        (* Ecke gehoert an's Ende der Liste *)
  65.             Akt^.next := Ecke
  66.           ELSE
  67.             BEGIN                               (* Ecke in Liste einketten *)
  68.               Ecke^.next := Akt;
  69.               Vor^.next := Ecke
  70.             END
  71.         END
  72.   END;
  73.  
  74.   (*-----------------------------------------------------------------------*)
  75.  
  76.   PROCEDURE ErstelleTabelle (AnzahlEcken: INTEGER);
  77.  
  78.   VAR ScanLine,                               (* Abtastlinie               *)
  79.       k           : INTEGER;                  (* Ecken-Laufindex           *)
  80.       Eckenliste  : Zeiger;
  81.  
  82.   BEGIN
  83.     FOR ScanLine := 0 TO ScreenYmax DO
  84.       EckenTabelle[ScanLine] := NIL;
  85.                        (* Eckeninformationen in die Eckentabelle einfuegen *)
  86.     FOR k := 0 TO Pred(AnzahlEcken) DO
  87.     BEGIN
  88.       New(Eckenliste);
  89.       Eckenliste^.m_inverse := Inverse(k);
  90.       Eckenliste^.next := NIL;
  91.  
  92.       (* Falls PunktIntern[k].y weiter oben ist als PunktIntern[k+1], dann *)
  93.       (* YTop auf diesen Wert setzen.                                      *)
  94.       IF PunktIntern[k].y > PunktIntern[Succ(k) MOD AnzahlEcken].y THEN
  95.         BEGIN
  96.           Eckenliste^.YTop := PunktIntern[k].y;
  97.                         (* Falls am PunktIntern[k+1] ein Minimum vorliegt, *)
  98.                         (* die Kante NICHT verkuerzen.                     *)
  99.           IF PunktIntern[Succ(k) MOD AnzahlEcken].y <
  100.              PunktIntern[(k + 2) MOD AnzahlEcken].y THEN
  101.             BEGIN
  102.               Eckenliste^.XMin := PunktIntern[Succ(k) MOD AnzahlEcken].x;
  103.               Einfuegen(Eckenliste,
  104.                         EckenTabelle[PunktIntern[Succ(k) MOD AnzahlEcken].y])
  105.             END
  106.           ELSE                      (* Falls Ecke[k + 1] KEIN Extrema ist, *)
  107.             BEGIN                   (* das niedrigere Ende kuerzen         *)
  108.               Eckenliste^.XMin := PunktIntern[Succ(k) MOD AnzahlEcken].x
  109.                                   + Eckenliste^.m_inverse;
  110.               Einfuegen(Eckenliste,
  111.                         EckenTabelle[Succ(PunktIntern[Succ(k) MOD
  112.                                                          AnzahlEcken].y)])
  113.           END
  114.         END
  115.       ELSE
  116.                 (* Falls PunktIntern[k + 1] hoeher ist als PunktIntern[k], *)
  117.                 (* YTop entsprechend setzen. Darf NICHT bei einer waage-   *)
  118.                 (* rechten Kante gemacht werden !                          *)
  119.         IF PunktIntern[k].y < PunktIntern[Succ(k) MOD AnzahlEcken].y THEN
  120.         BEGIN
  121.           Eckenliste^.YTop := PunktIntern[Succ(k) MOD AnzahlEcken].y;
  122.                                 (* Falls kein Minimum, Kante NICHT kuerzen *)
  123.           IF (PunktIntern[k].y <
  124.               PunktIntern[Pred(k + AnzahlEcken) MOD AnzahlEcken].y) THEN
  125.             BEGIN
  126.               Eckenliste^.XMin := PunktIntern[k].x;
  127.               Einfuegen(Eckenliste,EckenTabelle[PunktIntern[k].y])
  128.             END
  129.           ELSE
  130.             BEGIN               (* Ecke ist kein Extrema ==> Kante kuerzen *)
  131.               Eckenliste^.XMin := PunktIntern[k].x + Eckenliste^.m_inverse;
  132.               Einfuegen(Eckenliste,EckenTabelle[Succ(PunktIntern[k].y)])
  133.             END
  134.         END
  135.     END (* FOR *)
  136.   END;
  137.  
  138.   (*-----------------------------------------------------------------------*)
  139.   (* NeueListe ist die Liste aus der Eckentabelle, AlteListe wird fuer die
  140.      Scanline aufgebaut.                                                   *)
  141.  
  142.   PROCEDURE Mischen (NeueListe: Zeiger; VAR AlteListe: Zeiger);
  143.  
  144.   VAR Temp, Neu: Zeiger;
  145.  
  146.   BEGIN
  147.     IF AlteListe = NIL THEN                              (* Leere Scanline *)
  148.       AlteListe := NeueListe
  149.     ELSE
  150.       BEGIN                                                     (* Mischen *)
  151.         Neu := NeueListe;
  152.         WHILE Neu <> NIL DO
  153.         BEGIN                          (* Ecke in ScanLine-Liste einfuegen *)
  154.           Temp := Neu^.next;
  155.           Neu^.next := NIL;
  156.           Einfuegen(Neu, AlteListe);
  157.           Neu := Temp                               (* Zur naechsten Kante *)
  158.         END
  159.       END
  160.   END;
  161.  
  162.   (*-----------------------------------------------------------------------*)
  163.   (* Entfernt aus der ScanLine-Liste solche Kanten, die an der aktuellen
  164.      ScanLine enden.                                                       *)
  165.  
  166.   PROCEDURE Entferne (VAR ScanLine: Zeiger; YZeile: INTEGER);
  167.  
  168.   VAR Akt, Letzte : Zeiger;
  169.  
  170.   BEGIN
  171.     Akt := ScanLine;
  172.     WHILE Akt <> NIL DO
  173.     BEGIN
  174.       IF Akt = ScanLine THEN                          (* erste entfernen ? *)
  175.         IF Akt^.YTop = YZeile THEN
  176.           BEGIN                                             (* entfernen ! *)
  177.             ScanLine := ScanLine^.next;
  178.             Akt := ScanLine;
  179.             Letzte := Akt
  180.           END
  181.         ELSE
  182.           BEGIN                             (* erste Kante NICHT entfernen *)
  183.             Letzte := Akt;                  (* weiter...                   *)
  184.             Akt := Akt^.next
  185.           END
  186.       ELSE
  187.         BEGIN                                    (* andere Ecken behandeln *)
  188.           IF Akt^.YTop = YZeile THEN                    (* Ecke entfernen? *)
  189.             Letzte^.next := Akt^.next                   (* ja...           *)
  190.           ELSE
  191.             Letzte := Akt;
  192.           Akt := Akt^.next                 (* und weiter in beiden Faellen *)
  193.         END
  194.     END
  195.   END;
  196.  
  197.   (*-----------------------------------------------------------------------*)
  198.   (* Inkrementiert die XMin-Werte der ScanLine-Liste um m_inverse und      *)
  199.   (* sortiert die ScanLine-Liste aufgrund der XMin-Werte neu.              *)
  200.  
  201.   PROCEDURE NeuSortieren (VAR ScanLine: Zeiger);
  202.  
  203.   VAR SortZeiger, SortNext: Zeiger;
  204.  
  205.   BEGIN
  206.     IF ScanLine <> NIL THEN
  207.     BEGIN                                          (* Erste Ecke behandeln *)
  208.       ScanLine^.XMin := ScanLine^.XMin + ScanLine^.m_inverse;
  209.       SortZeiger := ScanLine^.next;
  210.       ScanLine^.next := NIL;
  211.                              (* Damit hat ScanLine nur noch die erste Ecke *)
  212.                              (* Restlichen Ecken behandeln...              *)
  213.       WHILE SortZeiger <> NIL DO
  214.       BEGIN                                         (* XMin inkrementieren *)
  215.         SortZeiger^.XMin := SortZeiger^.XMin + SortZeiger^.m_inverse;
  216.         SortNext := SortZeiger^.next;
  217.  
  218.         SortZeiger^.next := NIL;     (* Fuer Einfuegen EINE Ecke isolieren *)
  219.         Einfuegen(SortZeiger, ScanLine);
  220.         SortZeiger := SortNext
  221.       END
  222.     END
  223.   END;
  224.  
  225.   (*-----------------------------------------------------------------------*)
  226.   (*               Liniensegmente auf der ScanLine zeichnen:               *)
  227.  
  228.   PROCEDURE Fuelle_ScanLine (ScanLine: Zeiger; y: INTEGER);
  229.  
  230.   VAR k: INTEGER;      (* k = gerade ==> zeichnen, k = ungerade ==> move'n *)
  231.       Akt: Zeiger;
  232.  
  233.   BEGIN
  234.     k := 0;
  235.     IF ScanLine <> NIL THEN
  236.     BEGIN                                        (* Es gibt was zu fuellen *)
  237.       Akt := ScanLine;
  238.       WHILE Akt <> NIL DO
  239.       BEGIN                                                    (* Zeichnen *)
  240.         k := Succ(k);
  241.         IF k MOD 2 = 1 THEN
  242.           movea(Round(Akt^.XMin), y)
  243.         ELSE
  244.           linea(Round(Akt^.XMin), y);
  245.         Akt := Akt^.next
  246.       END
  247.     END
  248.   END;
  249.  
  250.   (*-----------------------------------------------------------------------*)
  251.  
  252. BEGIN (* PolyFill *)
  253.   FOR i := 1 TO AnzahlEcken DO        (* Punkte in PunktIntern umsortieren *)
  254.     PunktIntern[Pred(i)] := Punkte[i];
  255.   PolyLine(Punkte, AnzahlEcken);
  256.                                                      (* Polygon schliessen *)
  257.   Line(Punkte[1].x,Punkte[1].y,Punkte[AnzahlEcken].x,Punkte[AnzahlEcken].y);
  258.   ErstelleTabelle(AnzahlEcken);
  259.   ScanLine := NIL;
  260.   FOR i := 0 TO ScreenYmax DO
  261.   BEGIN
  262.     IF EckenTabelle[i] <> NIL THEN
  263.       Mischen(EckenTabelle[i], ScanLine);
  264.     Fuelle_ScanLine(ScanLine, i);
  265.     Entferne(ScanLine, i);
  266.     NeuSortieren(ScanLine);
  267.   END
  268. END;
  269.  
  270. (*-------------------------------------------------------------------------*)
  271. (*                             Ende POLYFILL.PAS                           *)