WMRectangles.Mod 3.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108
  1. MODULE WMRectangles; (** AUTHOR "TF"; PURPOSE "Basic rectangles that are used by the WM and visual components"; *)
  2. TYPE
  3. Rectangle* = RECORD l*, t*, r*, b*: LONGINT END;
  4. (* It is important to understand and respect that the point (r,b) is not included in the rectangle !
  5. This is to ensure consistency between the continuous and discrete case
  6. *)
  7. (** move the rectangle by deltaX, deltaY *)
  8. PROCEDURE MoveRel*(VAR x:Rectangle; deltaX, deltaY:LONGINT);
  9. BEGIN
  10. x.l:=x.l+deltaX; x.t:=x.t+deltaY; x.r:=x.r+deltaX; x.b:=x.b+deltaY
  11. END MoveRel;
  12. PROCEDURE Bound(VAR x:LONGINT; min, max:LONGINT);
  13. BEGIN
  14. IF x<min THEN x:=min ELSE IF x>max THEN x:=max END END
  15. END Bound;
  16. (** Clip rectangle rect at the boundary bounds *)
  17. PROCEDURE ClipRect*(VAR rect, bounds : Rectangle);
  18. BEGIN
  19. Bound(rect.l, bounds.l, bounds.r);Bound(rect.r, bounds.l, bounds.r);
  20. Bound(rect.t, bounds.t, bounds.b);Bound(rect.b, bounds.t, bounds.b)
  21. END ClipRect;
  22. (** return true if rectangle x is empty *)
  23. PROCEDURE RectEmpty*(x : Rectangle) : BOOLEAN;
  24. BEGIN
  25. RETURN (x.t >= x.b) OR (x.l >= x.r)
  26. END RectEmpty;
  27. (** return true if x and y are inside rect *)
  28. PROCEDURE PointInRect*(x, y : LONGINT; rect : Rectangle) : BOOLEAN;
  29. BEGIN
  30. RETURN (x >= rect.l) & (x < rect.r) & (y >= rect.t) & (y < rect.b)
  31. END PointInRect;
  32. (** return true if the inner rectangle is completely inside the outer *)
  33. PROCEDURE IsContained*(VAR outer, inner : Rectangle) : BOOLEAN;
  34. BEGIN
  35. RETURN (outer.l <= inner.l) & (outer.r >= inner.r) &
  36. (outer.t <= inner.t) & (outer.b >= inner.b)
  37. END IsContained;
  38. PROCEDURE IsEqual*(CONST a, b : Rectangle) : BOOLEAN;
  39. BEGIN
  40. RETURN (a.l = b.l) & (a.r = b.r) & (a.t = b.t) & (a.b = b.b)
  41. END IsEqual;
  42. (** return whether a and be intersect and not only touche *)
  43. PROCEDURE Intersect*(VAR a, b : Rectangle) : BOOLEAN;
  44. BEGIN
  45. RETURN (a.l < b.r) & (a.r > b.l) & (a.t < b.b) & (a.b > b.t)
  46. END Intersect;
  47. (** Set rect to (l, t, r, b) *)
  48. PROCEDURE SetRect*(VAR rect : Rectangle; l, t, r, b : LONGINT);
  49. BEGIN
  50. rect.l := l; rect.t := t; rect.r := r; rect.b := b
  51. END SetRect;
  52. (** return the area of r. Overflow if r w * h > MAX(LONGINT) *)
  53. PROCEDURE Area*(VAR r : Rectangle) : LONGINT;
  54. BEGIN
  55. RETURN (r.r - r.l) * (r.b - r.t)
  56. END Area;
  57. (** Extend old to contain addition *)
  58. PROCEDURE ExtendRect*(VAR old, addition : Rectangle);
  59. BEGIN
  60. old.l := MIN(old.l, addition.l); old.r := MAX(old.r,addition.r);
  61. old.t := MIN(old.t, addition.t); old.b := MAX(old.b, addition.b)
  62. END ExtendRect;
  63. (** return the Rectangle (l, t, r, b) *)
  64. PROCEDURE MakeRect*(l, t, r, b: LONGINT) : Rectangle;
  65. VAR result : Rectangle;
  66. BEGIN
  67. result.l := l; result.t := t; result.r := r; result.b := b; RETURN result
  68. END MakeRect;
  69. (** extend the rectangle by units in each direction *)
  70. PROCEDURE ResizeRect*(x : Rectangle; units : LONGINT) : Rectangle;
  71. VAR t : Rectangle;
  72. BEGIN
  73. t.l := x.l - units; t.t := x.t - units; t.r := x.r + units; t.b := x.b + units;
  74. RETURN t
  75. END ResizeRect;
  76. PROCEDURE Normalize*(VAR rect: Rectangle);
  77. VAR
  78. temp: LONGINT;
  79. BEGIN
  80. IF rect.l > rect.r THEN
  81. temp := rect.l;
  82. rect.l := rect.r;
  83. rect.r := temp;
  84. END;
  85. IF rect.t > rect.b THEN
  86. temp := rect.t;
  87. rect.t := rect.b;
  88. rect.b := temp;
  89. END;
  90. END Normalize;
  91. END WMRectangles.