home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 11 / grafik8 / cpline3d.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-09-04  |  3.1 KB  |  103 lines
  1. (*-------------------------------------------------------------*)
  2. (*                       CPLINE3D.PAS                          *)
  3. (*   Clipping einer dreidimensionale Linie im Blickvolumem.    *)
  4.  
  5. PROCEDURE Clip3DLine(VAR P1, P2 : tVektor; MinDist : REAL;
  6.                      VAR Zeichnen : BOOLEAN (* Linie zeichnen ? *) );
  7.  
  8. LABEL 9999;
  9.  
  10. TYPE direction = SET OF (left,right,top,bottom,front,back);
  11.  
  12. VAR P : tVektor;
  13.     VAR t : REAL;    (* Faktor fuer Liniensegment *)
  14.     dir, dir1, dir2 : direction;
  15.  
  16.   PROCEDURE Region(P : tVektor;
  17.                    VAR Endpunkt : direction);
  18.   BEGIN
  19.     Endpunkt := [];
  20.     IF P[1] < -P[3] THEN Endpunkt := [left]
  21.     ELSE IF P[1] > P[3] THEN Endpunkt := [right];
  22.     IF P[2] < -P[3] THEN Endpunkt := Endpunkt + [bottom]
  23.     ELSE IF P[2] > P[3] THEN Endpunkt := Endpunkt + [top];
  24.     IF P[3] < MinDist THEN Endpunkt := Endpunkt + [front]
  25.     ELSE IF P[3] > 1 THEN Endpunkt := Endpunkt + [back];
  26.   END; (* Region *)
  27.  
  28.   PROCEDURE NewPoint(VAR P : tVektor);
  29.   BEGIN
  30.     P[1] := (P2[1] - P1[1])*t + P1[1];
  31.     P[2] := (P2[2] - P1[2])*t + P1[2];
  32.     P[3] := (P2[3] - P1[3])*t + P1[3];
  33.   END;
  34.  
  35.   PROCEDURE clip_left(VAR P : tVektor); (* Links abschneiden *)
  36.   BEGIN
  37.     t := -(P1[3] - P1[1]) / ((P2[1] - P1[1]) - (P2[3] - P1[3]));
  38.     NewPoint(P);
  39.   END;
  40.  
  41.   PROCEDURE clip_right(VAR P : tVektor); (* Rechts abschneiden *)
  42.   BEGIN
  43.     t := (P1[3] - P1[1]) / ((P2[1] - P1[1]) - (P2[3] - P1[3]));
  44.     NewPoint(P);
  45.   END;
  46.  
  47.   PROCEDURE clip_top(VAR P : tVektor);   (* Oben abschneiden *)
  48.   BEGIN
  49.     t := (P1[3] - P1[2]) / ((P2[2] - P1[2]) - (P2[3] - P1[3]));
  50.     NewPoint(P);
  51.   END;
  52.  
  53.   PROCEDURE clip_bottom(VAR P : tVektor); (* Unten abschneiden *)
  54.   BEGIN
  55.     t := -(P1[3] - P1[2]) / ((P2[2] - P1[2]) - (P2[3] - P1[3]));
  56.     NewPoint(P);
  57.   END;
  58.  
  59.   PROCEDURE clip_front(VAR P : tVektor); (* Vorne abschneiden *)
  60.   BEGIN
  61.     t := (MinDist - P1[3]) / (P2[3] - P1[3]);
  62.     NewPoint(P);
  63.   END;
  64.  
  65.   PROCEDURE clip_back(VAR P : tVektor); (* Hinten abschneiden *)
  66.   BEGIN
  67.     t := (1 - P1[3]) / (P2[3] - P1[3]);
  68.     NewPoint(P);
  69.   END;
  70.  
  71. BEGIN (* Line-Draw mit Clipping *)
  72.   Zeichnen := TRUE;
  73.   Region(P1,dir1); (* Endpunkts-Bereich bestimmen *)
  74.   Region(P2,dir2);
  75.   WHILE (dir1 <> []) OR (dir2 <> []) DO BEGIN
  76.     IF dir1*dir2 <> [] THEN BEGIN (* Linie ausserhalb Volumen *)
  77.       Zeichnen := FALSE;
  78.       GOTO 9999; (* ---> Ausgang *)
  79.     END;
  80.     IF dir1 = [] THEN BEGIN (* P1 innerhalb Volumen, P2 clippen *)
  81.       dir := dir2;  P := P2;
  82.     END
  83.     ELSE BEGIN
  84.       dir := dir1;  P := P1;   (* P1 clippen *)
  85.     END;
  86.     IF left IN dir THEN clip_left(P)
  87.     ELSE IF right IN dir THEN clip_right(P)
  88.     ELSE IF bottom IN dir THEN clip_bottom(P)
  89.     ELSE IF top IN dir THEN clip_top(P)
  90.     ELSE IF front IN dir THEN clip_front(P)
  91.     ELSE IF back IN dir THEN clip_back(P);
  92.     IF dir = dir1 THEN BEGIN
  93.       P1 := P;  Region(P1,dir1)
  94.     END
  95.     ELSE BEGIN
  96.       P2 := P;  Region(P2,dir2)
  97.     END
  98.   END;
  99.   9999:;  (* Ausgangslabel *)
  100. END;
  101. (*-------------------------------------------------------------*)
  102. (*                  Ende CLIPLINE.PAS                          *)
  103.