home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / pmos2002.zip / SRC / SCREENGE.MOD < prev    next >
Text File  |  1996-11-05  |  7KB  |  190 lines
  1. IMPLEMENTATION MODULE ScreenGeometry;
  2.  
  3.         (********************************************************)
  4.         (*                                                      *)
  5.         (*          Support module for screen graphics          *)
  6.         (*                                                      *)
  7.         (*  Programmer:         P. Moylan                       *)
  8.         (*  Last edited:        5 November 1996                 *)
  9.         (*  Status:             Working                         *)
  10.         (*                                                      *)
  11.         (*      Might be worth looking for a better algorithm   *)
  12.         (*      for SolveForX and SolveForY - see module        *)
  13.         (*      RawGraphics, where I think I've done it better. *)
  14.         (*                                                      *)
  15.         (********************************************************)
  16.  
  17. (************************************************************************)
  18.  
  19. PROCEDURE Inside (x, y: INTEGER;  R: Rectangle): BOOLEAN;
  20.  
  21.     (* Returns TRUE iff point (x,y) is in (or on the border of) R.      *)
  22.  
  23.     BEGIN
  24.         WITH R DO
  25.             RETURN (x >= left) AND (x <= right)
  26.                                 AND (y >= bottom) AND (y <= top);
  27.         END (*WITH*);
  28.     END Inside;
  29.  
  30. (************************************************************************)
  31.  
  32. PROCEDURE Adjacent (R1, R2: Rectangle;
  33.                                 VAR (*OUT*) union: Rectangle): BOOLEAN;
  34.  
  35.     (* If the union of R1 and R2 is itself a rectangle, returns TRUE    *)
  36.     (* and sets "union" to be the combined rectangle.  Otherwise        *)
  37.     (* returns FALSE, and the "union" result is meaningless.            *)
  38.  
  39.     BEGIN
  40.         union := R1;
  41.         IF R1.top = R2.top THEN
  42.             (* Possible left/right adjacency *)
  43.             IF R1.bottom = R2.bottom THEN
  44.                 IF R2.left = R1.right + 1 THEN
  45.                     union.right := R2.right;
  46.                     RETURN TRUE;
  47.                 ELSIF R1.left = R2.right + 1 THEN
  48.                     union.left := R2.left;
  49.                     RETURN TRUE;
  50.                 ELSE
  51.                     RETURN FALSE;
  52.                 END (*IF*);
  53.             ELSE
  54.                 RETURN FALSE;
  55.             END (*IF*);
  56.         ELSIF R1.left = R2.left THEN
  57.             (* Possible above/below adjacency *)
  58.             IF R1.right = R2.right THEN
  59.                 IF R2.bottom = R1.top + 1 THEN
  60.                     union.top := R2.top;
  61.                     RETURN TRUE;
  62.                 ELSIF R1.bottom = R2.top + 1 THEN
  63.                     union.bottom := R2.bottom;
  64.                     RETURN TRUE;
  65.                 ELSE
  66.                     RETURN FALSE;
  67.                 END (*IF*);
  68.             ELSE
  69.                 RETURN FALSE;
  70.             END (*IF*);
  71.         ELSE
  72.             RETURN FALSE;
  73.         END (*IF*);
  74.     END Adjacent;
  75.  
  76. (************************************************************************)
  77.  
  78. PROCEDURE SolveForX (end1, end2: Point;  y: INTEGER): INTEGER;
  79.  
  80.     (* Returns the x value for which the line with endpoints end1 and   *)
  81.     (* end2 passes through the point (x,y).                             *)
  82.  
  83.     VAR x1, x2, y1, y2, temp: INTEGER;
  84.  
  85.     BEGIN
  86.         x1 := end1.x;  y1 := end1.y;
  87.         x2 := end2.x;  y2 := end2.y;
  88.         IF y1 > y2 THEN
  89.             temp := x1;  x1 := x2;  x2 := temp;
  90.             temp := y1;  y1 := y2;  y2 := temp;
  91.         END (*IF*);
  92.         RETURN (y*(x2-x1) - x2*y1 + x1*y2 + (y2-y1) DIV 2 + 1) DIV (y2-y1);
  93.     END SolveForX;
  94.  
  95. (************************************************************************)
  96.  
  97. PROCEDURE SolveForY (end1, end2: Point;  x: INTEGER): INTEGER;
  98.  
  99.     (* Returns the y value for which the line with endpoints end1 and   *)
  100.     (* end2 passes through the point (x,y).                             *)
  101.  
  102.     VAR x1, x2, y1, y2, temp: INTEGER;
  103.  
  104.     BEGIN
  105.         x1 := end1.x;  y1 := end1.y;
  106.         x2 := end2.x;  y2 := end2.y;
  107.         IF x1 > x2 THEN
  108.             temp := x1;  x1 := x2;  x2 := temp;
  109.             temp := y1;  y1 := y2;  y2 := temp;
  110.         END (*IF*);
  111.         RETURN (x*(y2-y1) - y2*x1 + y1*x2 + (x2-x1) DIV 2 + 1) DIV (x2-x1);
  112.     END SolveForY;
  113.  
  114. (************************************************************************)
  115.  
  116. PROCEDURE TrimLine (VAR (*INOUT*) end1, end2: Point;  R: Rectangle): BOOLEAN;
  117.  
  118.     (* Modifies end1 and end2, if necessary, to cut off the ends of     *)
  119.     (* the line from end1 to end2 which do not fit in R.                *)
  120.     (* Returns FALSE if none of the line passes through the rectangle.  *)
  121.  
  122.     VAR temp: Point;  result: INTEGER;
  123.  
  124.     BEGIN
  125.  
  126.         (* Check the bottom and top of the rectangle.   *)
  127.  
  128.         IF end1.y > end2.y THEN
  129.             temp := end1;  end1 := end2;  end2 := temp;
  130.         END (*IF*);
  131.  
  132.         (* Exclude some special cases, to avoid overflow problems.      *)
  133.  
  134.         IF (end2.y < R.bottom) OR (end1.y > R.top) THEN
  135.             RETURN FALSE;
  136.         END (*IF*);
  137.  
  138.         IF end1.y < R.bottom THEN
  139.             result := SolveForX (end1, end2, R.bottom);
  140.             IF (result < R.left) OR (result > R.right) THEN
  141.                 RETURN FALSE;
  142.             END (*IF*);
  143.             end1.x := result;
  144.             end1.y := R.bottom;
  145.         END (*IF*);
  146.         IF end2.y > R.top THEN
  147.             result := SolveForX (end1, end2, R.top);
  148.             IF (result < R.left) OR (result > R.right) THEN
  149.                 RETURN FALSE;
  150.             END (*IF*);
  151.             end2.x := result;
  152.             end2.y := R.top;
  153.         END (*IF*);
  154.  
  155.         (* Check the left and right of the rectangle.   *)
  156.  
  157.         IF end1.x > end2.x THEN
  158.             temp := end1;  end1 := end2;  end2 := temp;
  159.         END (*IF*);
  160.  
  161.         (* Exclude some special cases, to avoid overflow problems.      *)
  162.  
  163.         IF (end2.x < R.left) OR (end1.x > R.right) THEN
  164.             RETURN FALSE;
  165.         END (*IF*);
  166.  
  167.         IF end1.x < R.left THEN
  168.             result := SolveForY (end1, end2, R.left);
  169.             IF (result < R.bottom) OR (result > R.top) THEN
  170.                 RETURN FALSE;
  171.             END (*IF*);
  172.             end1.y := result;
  173.             end1.x := R.left;
  174.         END (*IF*);
  175.         IF end2.x > R.right THEN
  176.             result := SolveForY (end1, end2, R.right);
  177.             IF (result < R.bottom) OR (result > R.top) THEN
  178.                 RETURN FALSE;
  179.             END (*IF*);
  180.             end2.y := result;
  181.             end2.x := R.right;
  182.         END (*IF*);
  183.  
  184.         RETURN TRUE;
  185.  
  186.     END TrimLine;
  187.  
  188. END ScreenGeometry.
  189. 
  190.