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 /eXene/releases/release-110.74/graph-util/band.sml
ViewVC logotype

Annotation of /eXene/releases/release-110.74/graph-util/band.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3683 - (view) (download)

1 : monnier 2 (* band.sml
2 :     *
3 :     * COPYRIGHT (c) 1994 by AT&T Bell Laboratories
4 :     *
5 :     * Code for band data structure.
6 :     *
7 :     * A band is a list non-continguous rectangles listed from left
8 :     * to right (increasing x) that all have the same upper and lower
9 :     * y coordinates. Regions (see region-sig.sml and region.sml)
10 :     * are essentially ordered lists of bands.
11 :     *
12 :     *
13 :     *)
14 :     signature BAND =
15 :     sig
16 :     structure G : GEOMETRY
17 :    
18 :     datatype rect_overlap = RectangleOut | RectangleIn | RectanglePart
19 :    
20 :     datatype band = BAND of {
21 :     y1 : int, (* top y value *)
22 :     y2 : int, (* bottom y value *)
23 :     xs : (int * int) list (* list of (left,right) values *)
24 :     }
25 :    
26 :     (* Return y1(y2) of band *)
27 :     val y1Of : band -> int
28 :     val y2Of : band -> int
29 :    
30 :     (* Return number of intervals. Always > 0 *)
31 :     val sizeOf : band -> int
32 :    
33 :     (* concat list of rectangles of band on accumlator list
34 :     * The leftmost rectangle in the band will be the head of
35 :     * the resulting list.
36 :     *)
37 :     val rectsOfBand : band * G.rect list -> G.rect list
38 :    
39 :     (* True if point is in band *)
40 :     val inBand : band * G.point -> bool
41 :    
42 :     (* Return left and right extent of band *)
43 :     val bandExtent : band -> (int * int)
44 :    
45 :     (* Compares argument interval with x intervals of band *)
46 :     val rectInBand : band * int * int -> rect_overlap
47 :    
48 :     (* Returns true if any two x intervals of the bands intersect *)
49 :     val overlap : band * band -> bool
50 :    
51 :     (* Translate band by given vector *)
52 :     val offsetBand : G.point -> band -> band
53 :    
54 :     (* Translate band horizontally(vertically) *)
55 :     val xOffsetBand : int -> band -> band
56 :     val yOffsetBand : int -> band -> band
57 :    
58 :     (* Coalesce lower band below upper band.
59 :     * Return SOME of new band if successful.
60 :     * Assumes y values are compatible.
61 :     *)
62 :     val coalesce : {lower : band, upper : band} -> band option
63 :    
64 :     (* Create a new band that is the union(intersection,difference)
65 :     * of the two argument bands. The integer return value is
66 :     * the number of intervals in the band.
67 :     * The integer arguments provide the upper
68 :     * and lower y coordinates for the resulting band. The operation
69 :     * only involves the x intervals; it is assumed that y overlap
70 :     * has already been checked.
71 :     *)
72 :     val union : band * band * int * int -> (band * int)
73 :     val intersect : band * band * int * int -> (band * int)
74 :     val subtract : band * band * int * int -> (band * int)
75 :    
76 :     (* Return a new band that has the same x intervals as the
77 :     * argument band, but with the new upper and lower y values.
78 :     *)
79 :     val squeeze : band * int * int -> (band * int)
80 :     end
81 :    
82 :     structure Band : BAND =
83 :     struct
84 :     structure G = Geometry
85 :    
86 :     datatype rect_overlap = RectangleOut | RectangleIn | RectanglePart
87 :    
88 :     (* It might be worthwhile to maintain the length of xs in the band *)
89 :     datatype band = BAND of {
90 :     y1 : int,
91 :     y2 : int,
92 :     xs : (int * int) list
93 :     }
94 :    
95 :     fun isIn (x : int) (x1,x2) = x1 <= x andalso x < x2
96 :     fun xoff (x : int) (x1,x2) = (x1+x,x2+x)
97 :     fun ontop ([],l,n) = (l,n)
98 :     | ontop (a::t,l,n) = ontop(t,a::l,n+1)
99 :     fun mkr (y1,y2) = let
100 :     val ht = y2 - y1
101 :     in fn ((x1,x2),l) => ((G.RECT{x=x1,y=y1,wid=x2 - x1,ht = ht})::l) end
102 :    
103 :     fun rectsOfBand (BAND{xs,y1,y2},l) = foldr (mkr (y1,y2)) l xs
104 :     fun squeeze (BAND{xs,...},top,bot) = (BAND{xs=xs,y1=top,y2=bot},length xs)
105 :    
106 :     fun y1Of (BAND{y1,...}) = y1
107 :     fun y2Of (BAND{y2,...}) = y2
108 :     fun sizeOf (BAND{xs,...}) = length xs
109 :    
110 :     fun inBand (BAND{y1,y2,xs},G.PT{x=px,y=py}) =
111 :     y1 <= py andalso py < y2 andalso List.exists (isIn px) xs
112 :    
113 :     fun bandExtent (BAND{xs = xs as ((x1,_)::_),...}) = let
114 :     fun right ([(l,r)]) = r
115 :     | right (_::t) = right t
116 :     | right _ = raise LibBase.Impossible "Band.bandExtent.right"
117 :     in (x1,right xs) end
118 :     | bandExtent _ = raise LibBase.Impossible "Band.bandExtent"
119 :    
120 :     fun rectInBand (BAND{y1,y2,xs},x1,x2) = let
121 :     fun rib [] = RectangleOut
122 :     | rib ((l,r)::rest) =
123 :     if r <= x1 then rib rest
124 :     else if x2 <= l then RectangleOut
125 :     else if l <= x1 andalso x2 <= r then RectangleIn
126 :     else RectanglePart
127 :     in rib xs end
128 :    
129 :     (* Only check overlap of x intervals *)
130 :     fun overlap (BAND{xs,...},BAND{xs=xs',...}) = let
131 :     fun loop([],_) = false
132 :     | loop(_,[]) = false
133 :     | loop(x as ((x1,x2)::xs),x' as ((x1',x2')::xs')) =
134 :     if x2 <= x1' then loop(xs,x')
135 :     else if x2' <= x1 then loop(x,xs')
136 :     else true
137 :     in loop (xs,xs') end
138 :    
139 :     fun xOffsetBand dx (BAND{y1,y2,xs}) = BAND{y1=y1,y2=y2, xs = map (xoff dx) xs}
140 :    
141 :     fun yOffsetBand dy (BAND{y1,y2,xs}) = BAND{y1=y1+dy,y2=y2+dy, xs = xs}
142 :    
143 :     fun offsetBand (G.PT{x=dx,y=dy}) (BAND{y1,y2,xs}) =
144 :     BAND{y1=y1+dy,y2=y2+dy, xs = map (xoff dx) xs}
145 :    
146 :     (* coalesces two bands into one, if possible.
147 :     * assume y1 of lower band = y2 of upper band
148 :     * Check that each contain same horizontal intervals.
149 :     * If so, combine and return SOME of resulting band.
150 :     * Else return NONE.
151 :     *)
152 :     fun coalesce {lower = BAND{y2,xs,...}, upper = BAND{y1=y1',xs=xs',...}} =
153 :     if xs = xs' then SOME(BAND{y1=y1',y2=y2,xs=xs}) else NONE
154 :    
155 :     fun union (BAND{xs,...},BAND{xs=xs',...},top,bot) = let
156 :     val h = hd xs
157 :     val h' = hd xs'
158 :     fun finalmerge([],ci,xs) = ontop(xs,[ci],1)
159 :     | finalmerge((i as (l,r))::t ,i' as (l',r'),xs) =
160 :     if r' < l then ontop(xs,i'::i::t,2 + length t)
161 :     else if r <= r' then finalmerge(t,i',xs)
162 :     else ontop(xs,(l',r)::t,1 + length t)
163 :     fun loop ([],[],ci,xs) = ontop(xs,[ci],1)
164 :     | loop (x,[],ci,xs) = finalmerge(x,ci,xs)
165 :     | loop ([],x,ci,xs) = finalmerge(x,ci,xs)
166 :     | loop (x as ((i as (x1,x2))::t),x' as ((i' as (x1',x2'))::t'),ci,xs) =
167 :     if x1 < x1' then merge(t,x',i,ci,xs) else merge(x,t',i',ci,xs)
168 :     and merge(t,t',i as (l,r),i' as (l',r'),xs) =
169 :     if r' < l then loop(t,t',i,i'::xs)
170 :     else if r <= r' then loop(t,t',i',xs)
171 :     else loop(t,t',(l',r),xs)
172 :     val (xs'',n) = if #1 h < #1 h' then loop(tl xs,xs',h,[])
173 :     else loop(xs,tl xs',h',[])
174 :     in
175 :     (BAND{y1=top,y2=bot,xs= xs''},n)
176 :     end
177 :    
178 :     fun intersect (BAND{xs,...},BAND{xs=xs',...},top,bot) = let
179 :     fun loop ([],_,xs) = ontop(xs,[],0)
180 :     | loop (_,[],xs) = ontop(xs,[],0)
181 :     | loop (x as ((x1,x2)::t),x' as ((x1',x2')::t'),xs) = let
182 :     val l = Int.max(x1,x1')
183 :     val r = Int.min(x2,x2')
184 :     val xs' = if l < r then (l,r)::xs else xs
185 :     in
186 :     if x2 < x2' then loop(t,x',xs')
187 :     else if x2 > x2' then loop(x,t',xs')
188 :     else loop(t,t',xs')
189 :     end
190 :     in
191 :     case loop(xs,xs',[]) of
192 :     (xs'',n) => (BAND{y1=top,y2=bot,xs= xs''},n)
193 :     end
194 :    
195 :     fun subtract (BAND{xs,...},BAND{xs=xs',...},top,bot) = let
196 :     fun loop ([],_,xs) = ontop(xs,[],0)
197 :     | loop (x,[],xs) = ontop(xs,x,length x)
198 :     | loop (x as ((x1,x2)::t),x' as ((x1',x2')::t'),xs) =
199 :     if x2' <= x1 then loop(x,t',xs)
200 :     else if x2 <= x1' then loop(t,x',(x1,x2)::xs)
201 :     else if x1' <= x1 then
202 :     if x2' < x2 then loop((x2',x2)::t,t',xs)
203 :     else if x2' = x2 then loop(t,t',xs)
204 :     else loop(t,x',xs)
205 :     else
206 :     if x2' < x2 then loop((x2',x2)::t,t',(x1,x1')::xs)
207 :     else if x2' = x2 then loop(t,t',(x1,x1')::xs)
208 :     else loop(t,x',(x1,x1')::xs)
209 :     in
210 :     case loop(xs,xs',[]) of
211 :     (xs'',n) => (BAND{y1=top,y2=bot,xs=xs''},n)
212 :     end
213 :    
214 :     end

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