home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 09 / grafik6 / clipping.pas next >
Encoding:
Pascal/Delphi Source File  |  1987-08-09  |  3.1 KB  |  121 lines
  1. (*-------------------------------------------------------------------------*)
  2. (*                            CLIPPING.PAS                                 *)
  3. (*          Setzen eines Punktes mit Clipping in Fenstergrenzen            *)
  4.  
  5. PROCEDURE ClipPoint( x, y : REAL);
  6.  
  7. BEGIN
  8.   WITH Window[AktWin]^ DO
  9.     IF (x >= xmin) AND (x <= xmax) AND (y >= ymin) AND (y <= ymax) THEN
  10.       pointw(x,y)
  11. END;
  12.  
  13. (*-------------------------------------------------------------------------*)
  14. (*            Zeichnen einer Linie mit Clipping auf Fenstergrenzen.        *)
  15.  
  16. PROCEDURE ClipLine(x1, y1, x2, y2 : REAL);
  17.  
  18. TYPE direction = SET OF (left,right,top,bottom);
  19.  
  20. VAR m, m_inverse : REAL;      (* Steigung und reziproke Steigung *)
  21.     x, y : REAL;              (* Schnittpunkt mit Windowgrenzen  *)
  22.     dir, dir1, dir2 : direction;
  23.  
  24.   PROCEDURE region(x, y : REAL; VAR Endpunkt : direction); (* Wo liegt's ? *)
  25.  
  26.   BEGIN
  27.     Endpunkt := [];
  28.     IF x < Window[AktWin]^.xmin THEN
  29.       Endpunkt := [left]
  30.     ELSE
  31.       IF x > Window[AktWin]^.xmax THEN
  32.         Endpunkt := [right];
  33.     IF y < Window[AktWin]^.ymin THEN
  34.       Endpunkt := Endpunkt + [bottom]
  35.     ELSE
  36.       IF y > Window[AktWin]^.ymax THEN
  37.         Endpunkt := Endpunkt + [top]
  38.   END; (* region *)
  39.  
  40.  
  41.   PROCEDURE clip_left(VAR x, y : REAL); (* Links abschneiden *)
  42.  
  43.   BEGIN
  44.     y := m*(Window[AktWin]^.xmin - x1) + y1;
  45.     x := Window[AktWin]^.xmin
  46.   END;
  47.  
  48.  
  49.   PROCEDURE clip_right(VAR x, y : REAL); (* Rechts abschneiden *)
  50.  
  51.   BEGIN
  52.     y := m*(Window[AktWin]^.xmax - x1) + y1;
  53.     x := Window[AktWin]^.xmax
  54.   END;
  55.  
  56.  
  57.   PROCEDURE clip_top(VAR x, y : REAL);   (* Oben abschneiden *)
  58.  
  59.   BEGIN
  60.     x := m_inverse*(Window[AktWin]^.ymax - y1) + x1;
  61.     y := Window[AktWin]^.ymax
  62.   END;
  63.  
  64.  
  65.   PROCEDURE clip_bottom(VAR x, y : REAL); (* Unten abschneiden *)
  66.  
  67.   BEGIN
  68.     x := m_inverse*(Window[AktWin]^.ymin - y1) + x1;
  69.     y := Window[AktWin]^.ymin
  70.   END;
  71.  
  72.  
  73. BEGIN (* Line-Draw mit Clipping *)
  74.   region(x1,y1,dir1); (* In welchen Bereich liegen die Linienendpunkte ? *)
  75.   region(x2,y2,dir2);
  76.   IF x1 <> x2 THEN
  77.     m := (y2 - y1)/(x2 - x1);
  78.   IF y1 <> y2 THEN
  79.     m_inverse :=  (x2-x1)/(y2-y1);
  80.   WHILE (dir1 <> []) OR (dir2 <> []) DO BEGIN
  81.     IF dir1*dir2 <> [] THEN  (* Linie ausserhalb des Windows *)
  82.       Exit;
  83.     IF dir1 = [] THEN BEGIN (* P1 innerhalb des Windows, P2 clippen *)
  84.       dir := dir2;
  85.       x := x2;
  86.       y := y2
  87.     END
  88.     ELSE BEGIN
  89.       dir := dir1;         (* P1 clippen *)
  90.       x := x1;
  91.       y := y1
  92.     END;
  93.     IF left IN dir THEN
  94.       clip_left(x,y)
  95.     ELSE
  96.     IF right IN dir THEN
  97.       clip_right(x,y)
  98.     ELSE
  99.     IF bottom IN dir THEN
  100.       clip_bottom(x,y)
  101.     ELSE
  102.     IF top IN dir THEN
  103.       clip_top(x,y);
  104.     IF dir = dir1 THEN BEGIN
  105.       x1 := x;
  106.       y1 := y;
  107.       region(x1,y1,dir1)
  108.     END
  109.     ELSE BEGIN
  110.       x2 := x;
  111.       y2 := y;
  112.       region(x2,y2,dir2)
  113.     END
  114.   END;
  115.  
  116.   linew(x1,y1,x2,y2)
  117. END;
  118.  
  119. (*-------------------------------------------------------------------------*)
  120. (*                        Ende CLIPPING.PAS                                *)
  121.