Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/eXene/lib/basics/geom.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/lib/basics/geom.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (view) (download)

1 : monnier 2 (* geom.sml
2 :     *
3 :     * COPYRIGHT (c) 1990,1991 by John H. Reppy. See COPYRIGHT file for details.
4 :     *
5 :     * The basic geometric types and operations.
6 :     *)
7 :    
8 :     structure Geometry =
9 :     struct
10 :    
11 :     local
12 :     open XValid
13 :    
14 :     fun min (x : int, y) = if x < y then x else y
15 :     fun max (x : int, y) = if x > y then x else y
16 :     in
17 :    
18 :     (* geometric types (from Xlib.h) *)
19 :     datatype point = PT of {x : int, y : int}
20 :     datatype line = LINE of point * point
21 :     datatype size = SIZE of {wid : int, ht : int}
22 :     datatype rect = RECT of {x : int, y : int, wid : int, ht : int}
23 :     datatype arc = ARC of {
24 :     x : int, y : int,
25 :     wid : int, ht : int,
26 :     angle1 : int, angle2 : int
27 :     }
28 :    
29 :     (* The geometry of a window w.r.t. its parent. *)
30 :     datatype win_geom = WGEOM of {
31 :     pos : point,
32 :     sz : size,
33 :     border : int
34 :     }
35 :    
36 :     (* points *)
37 :     val originPt = PT{x=0, y=0}
38 :     fun xCoordOfPt (PT{x, ...}) = x
39 :     fun yCoordOfPt (PT{y, ...}) = y
40 :     fun addPt (PT{x=x1, y=y1}, PT{x=x2, y=y2}) = PT{x=(x1+x2), y=(y1+y2)}
41 :     fun subPt (PT{x=x1, y=y1}, PT{x=x2, y=y2}) = PT{x=(x1-x2), y=(y1-y2)}
42 :     fun scalePt (s, PT{x, y}) = PT{x=s*x, y=s*y}
43 :     fun lessThanPt (PT{x=x1, y=y1}, PT{x=x2, y=y2}) = (x1 < x2) andalso (y1 < y2)
44 :     fun lessEqPt (PT{x=x1, y=y1}, PT{x=x2, y=y2}) = (x1 <= x2) andalso (y1 <= y2)
45 :    
46 :     (* size operations *)
47 :     fun addSz (SIZE{wid=w1, ht=h1}, SIZE{wid=w2, ht=h2}) = SIZE{wid=(w1+w2), ht=(h1+h2)}
48 :     fun subSz (SIZE{wid=w1, ht=h1}, SIZE{wid=w2, ht=h2}) = SIZE{wid=(w1-w2), ht=(h1-h2)}
49 :     fun scaleSz (s, SIZE{wid, ht}) = SIZE{wid=s*wid, ht=s*ht}
50 :     fun addSzToPt (PT{x, y}, SIZE{wid, ht}) = PT{x=x+wid, y=y+ht}
51 :     fun limitPt (SIZE{wid, ht}, PT{x, y}) =
52 :     PT{
53 :     x = if (x <= 0) then 0 else if (x < wid) then x else (wid-1),
54 :     y = if (y <= 0) then 0 else if (y < ht) then y else (ht-1)
55 :     }
56 :    
57 :     (* rectangles *)
58 :     fun mkRect (PT{x, y}, SIZE{wid, ht}) = RECT{x=x, y=y, wid=wid, ht=ht}
59 :     fun originOfRect (RECT{x, y, ...}) = PT{x=x, y=y}
60 :     fun sizeOfRect (RECT{wid, ht, ...}) = SIZE{wid=wid, ht=ht}
61 :     fun originAndSzOfRect (RECT{x, y, wid, ht}) = (PT{x=x, y=y}, SIZE{wid=wid, ht=ht})
62 :     fun cornerOfRect r = addSzToPt(originAndSzOfRect r)
63 :     fun clipPt (RECT{x=minX, y=minY, wid, ht}, PT{x, y}) =
64 :     PT{
65 :     x = if (x <= minX) then minX else if (x < minX+wid) then x else (minX+wid-1),
66 :     y = if (y <= minY) then minY else if (y < minY+ht) then y else (minY+ht-1)
67 :     }
68 :     fun translate (RECT{x, y, wid, ht}, PT{x=px, y=py}) =
69 :     RECT{x=x+px, y=y+py, wid=wid, ht=ht}
70 :     fun rtranslate (RECT{x, y, wid, ht}, PT{x=px, y=py}) =
71 :     RECT{x=x-px, y=y-py, wid=wid, ht=ht}
72 :     fun intersect (RECT{x=x1, y=y1, wid=w1, ht=h1},
73 :     RECT{x=x2, y=y2, wid=w2, ht=h2}) =
74 :     ((x1 < (x2+w2)) andalso (y1 < (y2+h2))
75 :     andalso (x2 < (x1+w1)) andalso (y2 < (y1+h1)))
76 :     exception Intersection
77 :     fun intersection (RECT{x=x1, y=y1, wid=w1, ht=h1},
78 :     RECT{x=x2, y=y2, wid=w2, ht=h2}) = let
79 :     val x = max(x1, x2) and y = max(y1, y2)
80 :     val cx = min(x1+w1, x2+w2) and cy = min(y1+h1, y2+h2)
81 :     in
82 :     if ((x < cx) andalso (y < cy))
83 :     then RECT{x=x, y=y, wid=(cx-x), ht=(cy-y)}
84 :     else raise Intersection
85 :     end
86 :     fun union (
87 :     r1 as RECT{x=x1, y=y1, wid=w1, ht=h1},
88 :     r2 as RECT{x=x2, y=y2, wid=w2, ht=h2}
89 :     ) = if ((w1 = 0) orelse (h1 = 0))
90 :     then r2
91 :     else if ((w2 = 0) orelse (h2 = 0))
92 :     then r1
93 :     else let
94 :     val x = min(x1, x2) and y = min(y1, y2)
95 :     val cx = max(x1+w1, x2+w2) and cy = max(y1+h1, y2+h2)
96 :     in
97 :     RECT{x=x, y=y, wid=(cx-x), ht=(cy-y)}
98 :     end
99 :     fun within (PT{x=px, y=py}, RECT{x, y, wid, ht}) =
100 :     ((x <= px) andalso (y <= py)
101 :     andalso (px < (x+wid)) andalso (py < (y+ht)))
102 :     fun inside (RECT{x=x1, y=y1, wid=w1, ht=h1}, RECT{x=x2, y=y2, wid=w2, ht=h2}) =
103 :     ((x2 <= x1) andalso (y2 <= y1)
104 :     andalso ((x1+w1) <= (x2+w2))
105 :     andalso ((y1+h1) <= (y2+h2)))
106 :     fun boundBox [] = RECT{x=0, y=0, wid=0, ht=0}
107 :     | boundBox ((PT{x, y}) :: pts) = let
108 :     fun bb (minx, miny, maxx, maxy, []) =
109 :     RECT{x = minx, y = miny, wid = maxx-minx+1, ht = maxy-miny+1}
110 :     | bb (minx, miny, maxx, maxy, (PT{x, y}) :: pts) =
111 :     bb (min(minx, x), min(miny, y), max(maxx, x), max(maxy, y), pts)
112 :     in
113 :     bb (x, y, x, y, pts)
114 :     end
115 :    
116 :     (* Validation routines *)
117 :     fun validPt (PT{x, y}) = (validSigned16 x) andalso (validSigned16 y)
118 :     fun validLine (LINE(p1, p2)) = (validPt p1) andalso (validPt p2)
119 :     fun validSize (SIZE{wid, ht}) = (valid16 wid) andalso (valid16 ht)
120 :     fun validRect (RECT{x, y, wid, ht}) =
121 :     (validSigned16 x) andalso (validSigned16 y) andalso
122 :     (valid16 wid) andalso (valid16 ht)
123 :    
124 :     fun validArc (ARC{x, y, wid, ht, angle1, angle2}) =
125 :     (validSigned16 x) andalso (validSigned16 y) andalso
126 :     (valid16 wid) andalso (valid16 ht) andalso
127 :     (validSigned16 angle1) andalso (validSigned16 angle2)
128 :    
129 :     fun validGeom (WGEOM{pos, sz, border}) =
130 :     (validPt pos) andalso (validSize sz) andalso (valid16 border)
131 :    
132 :     end (* local *)
133 :     end (* Geometry *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0