home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 02 / appl_grf / floodfil.pas next >
Encoding:
Pascal/Delphi Source File  |  1987-12-04  |  2.9 KB  |  105 lines

  1. (*-----------------------------------------------------------------*)
  2. (*                       FLOODFIL.PAS                              *)
  3. (*   Rekursives Flaechenfuellen aus PASCAL 5/87 mit Apple-Grafik   *)
  4.  
  5. (*$A-*) (* Rekursiven Code auf CP/M-Rechnern erlauben *)
  6. PROGRAM FillDemo;
  7.  
  8. TYPE x_Koord_Sys = INTEGER;
  9.      y_Koord_Sys = INTEGER;
  10.  
  11. (*$I IGrafik  *)
  12. (*$I IMemDisk *)
  13.  
  14. VAR i: INTEGER;
  15.  
  16. FUNCTION Adressenvergleich(k, g: INTEGER): BOOLEAN;
  17. BEGIN
  18.  IF ((k >= 0) AND (g >= 0)) OR ((k <= 0) AND (g <= 0)) THEN
  19.    Adressenvergleich := k < g
  20.  ELSE
  21.    Adressenvergleich := (k >= 0) AND (g < 0)
  22. END;
  23.  
  24. PROCEDURE Fill(x: x_Koord_Sys; y: y_Koord_Sys);
  25. BEGIN
  26.  (* Rekursionstiefe mit Heapueberpruefung beschraenken *)
  27.  IF Adressenvergleich(HeapPtr + 50,RecurPtr) THEN BEGIN
  28.    IF NOT Screenbit(x, y) THEN BEGIN
  29.      Point_System(x, y);
  30.      IF Succ(x) <= ScreenXmax_Sys THEN Fill(Succ(x),y);
  31.      IF Pred(x) >= ScreenXmin_Sys THEN Fill(Pred(x),y);
  32.      IF Succ(y) <= ScreenYmax_Sys THEN Fill(x,      Succ(y));
  33.      IF Pred(y) >= ScreenYmin_Sys THEN Fill(x,      Pred(y));
  34.     END
  35.   END
  36.   ELSE BEGIN
  37.     SystemZurueckbringen;
  38.     WriteLn(HeapPtr, RecurPtr, StackPtr);
  39.     Halt
  40.   END;
  41. END;
  42.  
  43.  
  44. PROCEDURE Fill2(x: x_Koord_Sys; y: y_Koord_Sys);
  45.  
  46. CONST Stacksize = 5;
  47.  
  48. VAR Stack: ARRAY(.1..Stacksize.) OF RECORD
  49.                                       x, y:INTEGER;
  50.                                     END;
  51.     StackPointer: BYTE;
  52.     oben_frei, unten_frei: BOOLEAN;
  53.     xAnfang: x_Koord_Sys;
  54.  
  55.   PROCEDURE StackZuweisung(y: y_Koord_Sys; VAR Zustand: BOOLEAN);
  56.  
  57.   VAR vorher: BOOLEAN;
  58.  
  59.   BEGIN
  60.     vorher := Zustand;
  61.     Zustand := NOT Screenbit(x, y);
  62.     IF NOT vorher AND Zustand
  63.     AND (StackPointer <= Stacksize) THEN BEGIN
  64.       Stack(.StackPointer.).x := x;
  65.       Stack(.StackPointer.).y := y;
  66.       StackPointer := Succ(StackPointer);
  67.     END;
  68.   END;
  69.  
  70. BEGIN
  71.   StackPointer := 1;
  72.   REPEAT
  73.     WHILE NOT Screenbit(x, y) AND (x > 0) DO x := Pred(x);
  74.     x       := Succ(x);
  75.     xAnfang := x;
  76.     oben_frei := FALSE; unten_frei := FALSE;
  77.     WHILE NOT Screenbit(x, y) AND (x < ScreenXmax_Sys) DO BEGIN
  78.       IF (y > 0)              THEN StackZuweisung(Pred(y), oben_frei);
  79.       IF (y < ScreenXmax_Sys) THEN StackZuweisung(Succ(y), unten_frei);
  80.       x := Succ(x);
  81.     END;
  82.     Point_System(xAnfang, y);
  83.     PlotLine(Pred(x), y);
  84.     StackPointer := Pred(StackPointer);
  85.     IF StackPointer > 0 THEN BEGIN
  86.       x := Stack(.StackPointer.).x;
  87.       y := Stack(.StackPointer.).y;
  88.     END;
  89.   UNTIL StackPointer < 1;
  90. END;
  91.  
  92. BEGIN
  93.  HeapzeigerSetzen;
  94.  ClrScr; GotoXY(10,10);
  95.  WriteLn('Es wird im Vordergrund gezeichnet!');
  96.  SystemSicherstellen;
  97.  GrafikEin;
  98.  Position(80, 89); PlotLine(130, 89); PlotLine(130, 20);
  99.                    PlotLine( 80, 20); PlotLine( 80, 89);
  100.  Position(99, 89); PlotLine( 99, 20);
  101.  Fill(90, 60);
  102.  Fill2(110,60);
  103.  SystemZurueckbringen;
  104. END.
  105.