screenge.mod

IMPLEMENTATION MODULE ScreenGeometry;

	(********************************************************)
	(*							*)
	(*	    Support module for screen graphics		*)
	(*							*)
	(*  Programmer:		P. Moylan			*)
	(*  Last edited:	10 October 1993			*)
	(*  Status:		Working				*)
	(*							*)
	(*	Might be worth looking for a better algorithm	*)
	(*	for SolveForX and SolveForY - see module	*)
	(*	RawGraphics, where I think I've done it better.	*)
	(*							*)
	(********************************************************)

(************************************************************************)

PROCEDURE Inside (x, y: INTEGER;  R: Rectangle): BOOLEAN;

    (* Returns TRUE iff point (x,y) is in (or on the border of) R.	*)

    BEGIN
	WITH R DO
	    RETURN (x >= left) AND (x <= right)
				AND (y >= bottom) AND (y <= top);
	END (*WITH*);
    END Inside;

(************************************************************************)

PROCEDURE Adjacent (R1, R2: Rectangle;
				VAR (*OUT*) union: Rectangle): BOOLEAN;

    (* If the union of R1 and R2 is itself a rectangle, returns TRUE	*)
    (* and sets "union" to be the combined rectangle.  Otherwise	*)
    (* returns FALSE, and the "union" result is meaningless.		*)

    BEGIN
	union := R1;
	IF R1.top = R2.top THEN
	    (* Possible left/right adjacency *)
	    IF R1.bottom = R2.bottom THEN
		IF R2.left = R1.right + 1 THEN
		    union.right := R2.right;
		    RETURN TRUE;
		ELSIF R1.left = R2.right + 1 THEN
		    union.left := R2.left;
		    RETURN TRUE;
		ELSE
		    RETURN FALSE;
		END (*IF*);
	    ELSE
		RETURN FALSE;
	    END (*IF*);
	ELSIF R1.left = R2.left THEN
	    (* Possible above/below adjacency *)
	    IF R1.right = R2.right THEN
		IF R2.bottom = R1.top + 1 THEN
		    union.top := R2.top;
		    RETURN TRUE;
		ELSIF R1.bottom = R2.top + 1 THEN
		    union.bottom := R2.bottom;
		    RETURN TRUE;
		ELSE
		    RETURN FALSE;
		END (*IF*);
	    ELSE
		RETURN FALSE;
	    END (*IF*);
	ELSE
	    RETURN FALSE;
	END (*IF*);
    END Adjacent;

(************************************************************************)

PROCEDURE SolveForX (end1, end2: Point;  y: INTEGER): INTEGER;

    (* Returns the x value for which the line with endpoints end1 and	*)
    (* end2 passes through the point (x,y).				*)

    VAR x1, x2, y1, y2, temp: LONGINT;

    BEGIN
	x1 := LONGINT(end1.x);  y1 := LONGINT(end1.y);
	x2 := LONGINT(end2.x);  y2 := LONGINT(end2.y);
	IF y1 > y2 THEN
	    temp := x1;  x1 := x2;  x2 := temp;
	    temp := y1;  y1 := y2;  y2 := temp;
	END (*IF*);
	RETURN INTEGER ((LONGINT(y)*(x2-x1)
			 - x2*y1 + x1*y2 + (y2-y1) DIV 2 + 1)
						DIV (y2-y1));
    END SolveForX;

(************************************************************************)

PROCEDURE SolveForY (end1, end2: Point;  x: INTEGER): INTEGER;

    (* Returns the y value for which the line with endpoints end1 and	*)
    (* end2 passes through the point (x,y).				*)

    VAR x1, x2, y1, y2, temp: LONGINT;

    BEGIN
	x1 := LONGINT(end1.x);  y1 := LONGINT(end1.y);
	x2 := LONGINT(end2.x);  y2 := LONGINT(end2.y);
	IF x1 > x2 THEN
	    temp := x1;  x1 := x2;  x2 := temp;
	    temp := y1;  y1 := y2;  y2 := temp;
	END (*IF*);
	RETURN INTEGER ((LONGINT(x)*(y2-y1) - y2*x1
				 + y1*x2 + (x2-x1) DIV 2 + 1)
							DIV (x2-x1));
    END SolveForY;

(************************************************************************)

PROCEDURE TrimLine (VAR (*INOUT*) end1, end2: Point;  R: Rectangle): BOOLEAN;

    (* Modifies end1 and end2, if necessary, to cut off the ends of	*)
    (* the line from end1 to end2 which do not fit in R.		*)
    (* Returns FALSE if none of the line passes through the rectangle.	*)

    VAR temp: Point;  result: INTEGER;

    BEGIN

	(* Check the bottom and top of the rectangle.	*)

	IF end1.y > end2.y THEN
	    temp := end1;  end1 := end2;  end2 := temp;
	END (*IF*);

	(* Exclude some special cases, to avoid overflow problems.	*)

	IF (end2.y < R.bottom) OR (end1.y > R.top) THEN
	    RETURN FALSE;
	END (*IF*);

	IF end1.y < R.bottom THEN
	    result := SolveForX (end1, end2, R.bottom);
	    IF (result < R.left) OR (result > R.right) THEN
		RETURN FALSE;
	    END (*IF*);
	    end1.x := result;
	    end1.y := R.bottom;
	END (*IF*);
	IF end2.y > R.top THEN
	    result := SolveForX (end1, end2, R.top);
	    IF (result < R.left) OR (result > R.right) THEN
		RETURN FALSE;
	    END (*IF*);
	    end2.x := result;
	    end2.y := R.top;
	END (*IF*);

	(* Check the left and right of the rectangle.	*)

	IF end1.x > end2.x THEN
	    temp := end1;  end1 := end2;  end2 := temp;
	END (*IF*);

	(* Exclude some special cases, to avoid overflow problems.	*)

	IF (end2.x < R.left) OR (end1.x > R.right) THEN
	    RETURN FALSE;
	END (*IF*);

	IF end1.x < R.left THEN
	    result := SolveForY (end1, end2, R.left);
	    IF (result < R.bottom) OR (result > R.top) THEN
		RETURN FALSE;
	    END (*IF*);
	    end1.y := result;
	    end1.x := R.left;
	END (*IF*);
	IF end2.x > R.right THEN
	    result := SolveForY (end1, end2, R.right);
	    IF (result < R.bottom) OR (result > R.top) THEN
		RETURN FALSE;
	    END (*IF*);
	    end2.y := result;
	    end2.x := R.right;
	END (*IF*);

	RETURN TRUE;

    END TrimLine;

END ScreenGeometry.