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/widgets/util/3d.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/widgets/util/3d.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* 3d.sml
2 :     *
3 :     * COPYRIGHT (c) 1994 AT&T Bell Laboratories.
4 :     *)
5 :    
6 :     structure ThreeD : THREE_D =
7 :     struct
8 :     structure G = Geometry
9 :     structure D = Drawing
10 :    
11 :     open Geometry Drawing
12 :    
13 :     datatype relief = Flat | Raised | Sunken | Groove | Ridge
14 :    
15 :     fun draw3DRect drawable (RECT {x,y,wid,ht},width) = let
16 :     val point_list =
17 :     [PT {x=x,y=y+ht},
18 :     PT {x=x,y=y},
19 :     PT {x=x+wid,y=y},
20 :     PT {x=x+wid-width,y=y+width},
21 :     PT {x=x+width,y=y+width},
22 :     PT {x=x+width,y=y+ht-width},
23 :     PT {x=x,y=y+ht}]
24 :     val r1 = RECT {x=x,y=y+ht-width, wid=wid,ht=width}
25 :     val r2 = RECT {x=x+wid-width,y=y, wid=width,ht=ht}
26 :     val dblw = width + width
27 :     in
28 :     if wid < dblw orelse ht < dblw then fn _ => ()
29 :     else fn {top,bottom} => (
30 :     fillRect drawable bottom r1;
31 :     fillRect drawable bottom r2;
32 :     fillPolygon drawable top {verts=point_list, shape=NonconvexShape})
33 :     end
34 :    
35 :     fun draw3DRect2 drawable (rect as (RECT {x,y,wid,ht}),width) = let
36 :     val halfWidth = width div 2
37 :     val halfWidth' = width - halfWidth
38 :     val outer = draw3DRect drawable (rect,halfWidth')
39 :     val r' = RECT {x=x+halfWidth',
40 :     y=y+halfWidth',
41 :     wid=wid-2*halfWidth',
42 :     ht=ht-2*halfWidth'}
43 :     val inner = draw3DRect drawable (r', halfWidth)
44 :     in
45 :     fn pens => (outer pens; inner {top= #bottom pens,bottom= #top pens})
46 :     end
47 :    
48 :     fun drawRect drawable {rect,width,relief} =
49 :     case relief of
50 :     Flat => let val f = draw3DRect drawable (rect,width)
51 :     in fn ({base,...} : WidgetBase.shades) => f {top=base,bottom=base} end
52 :     | Raised => let val f = draw3DRect drawable (rect,width)
53 :     in fn {light,dark,...} => f {top=light,bottom=dark} end
54 :     | Sunken => let val f = draw3DRect drawable (rect,width)
55 :     in fn {light,dark,...} => f {top=dark,bottom=light} end
56 :     | Ridge => let val f = draw3DRect2 drawable (rect,width)
57 :     in fn {light,dark,...} => f {top=light,bottom=dark} end
58 :     | Groove => let val f = draw3DRect2 drawable (rect,width)
59 :     in fn {light,dark,...} => f {top=dark,bottom=light} end
60 :    
61 :     fun drawFilledRect dr {rect,relief=Flat,width} shades =
62 :     fillRect dr (#base shades) rect
63 :     | drawFilledRect dr {rect,width=0,relief=_} shades =
64 :     fillRect dr (#base shades) rect
65 :     | drawFilledRect dr (a as {rect=RECT{x,y,wid,ht},width,...}) shades = let
66 :     val delta = width + width
67 :     val rect' = RECT{x=x+width,y=y+width,wid=wid - delta,ht=ht - delta}
68 :     in
69 :     fillRect dr (#base shades) rect';
70 :     drawRect dr a shades
71 :     end
72 :    
73 :     fun draw3DRoundRect drawable {rect, width, c_wid, c_ht} = let
74 :     val RECT{x, y, wid, ht} = rect
75 :     val halfwidth = width div 2
76 :     val x = x + halfwidth
77 :     val y = y + halfwidth
78 :     val w = wid - 2*halfwidth
79 :     val h = ht - 2*halfwidth
80 :     val w2 = c_wid+c_wid
81 :     val h2 = c_ht+c_ht
82 :     val (ew, ew2) = if (w2 > w) then (0, 0) else (c_wid, w2)
83 :     val (eh, eh2) = if (h2 > h) then (0, 0) else (c_ht, h2)
84 :     in
85 :     fn {top,bottom} => let
86 :     val top = Drawing.updatePen(top,[Drawing.PV_LineWidth width])
87 :     val bottom = Drawing.updatePen(bottom,[Drawing.PV_LineWidth width])
88 :     in
89 :     Drawing.drawArcs drawable top [
90 :     ARC{x= x, y= y, wid= ew2, ht= eh2, angle1= 180*64,
91 :     angle2= ~90*64},
92 :     ARC{x= x+ew, y= y, wid= w - ew2, ht= 0, angle1= 180*64,
93 :     angle2= ~180*64},
94 :    
95 :     ARC{x= x, y= y+eh, wid= 0, ht= h - eh2, angle1= 270*64,
96 :     angle2= ~180*64},
97 :     ARC{x= x+w - ew2, y= y, wid= ew2, ht= eh2,
98 :     angle1= 45*64, angle2= 45*64},
99 :     ARC{x= x, y= y+h - eh2, wid= ew2, ht= eh2, angle1= 225*64,
100 :     angle2= ~45*64}
101 :     ];
102 :    
103 :     Drawing.drawArcs drawable bottom [
104 :     ARC{x= x+w - ew2, y= y, wid= ew2, ht= eh2,
105 :     angle1= 45*64, angle2= ~45*64},
106 :     ARC{x= x+w, y= y+eh, wid= 0, ht= h - eh2, angle1= 90*64,
107 :     angle2= ~180*64},
108 :     ARC{x= x+w - ew2, y= y+h - eh2, wid= ew2, ht= eh2,
109 :     angle1= 0,angle2= ~90*64},
110 :     ARC{x= x+ew, y= y+h, wid= w - ew2, ht= 0, angle1= 0,
111 :     angle2= ~180*64},
112 :     ARC{x= x, y= y+h - eh2, wid= ew2, ht= eh2, angle1= 270*64,
113 :     angle2= ~45*64}]
114 :     end
115 :     end
116 :    
117 :     fun draw3DRoundRect2 drawable {rect as RECT{x,y,wid,ht}, width, c_wid, c_ht} = let
118 :     val halfWidth = width div 2
119 :     val halfWidth' = width - halfWidth
120 :     val outer = draw3DRoundRect drawable
121 :     {rect=rect,width=halfWidth',c_wid=c_wid,c_ht=c_ht}
122 :     val r' = RECT {x=x+halfWidth',
123 :     y=y+halfWidth',
124 :     wid=wid-2*halfWidth',
125 :     ht=ht-2*halfWidth'}
126 :     val inner = draw3DRoundRect drawable
127 :     {rect=r',width=halfWidth,c_wid=c_wid,c_ht=c_ht}
128 :     in
129 :     fn pens => (outer pens; inner {top= #bottom pens,bottom= #top pens})
130 :     end
131 :    
132 :    
133 :     fun drawRoundRect drawable {rect, width, c_wid, c_ht, relief} =
134 :     case relief of
135 :     Flat => let val f = draw3DRoundRect drawable
136 :     {rect=rect,width=width,c_wid=c_wid,c_ht=c_ht}
137 :     in fn ({base,...} : WidgetBase.shades) => f {top=base,bottom=base} end
138 :     | Raised => let val f = draw3DRoundRect drawable
139 :     {rect=rect,width=width,c_wid=c_wid,c_ht=c_ht}
140 :     in fn {light,dark,...} => f {top=light,bottom=dark} end
141 :     | Sunken => let val f = draw3DRoundRect drawable
142 :     {rect=rect,width=width,c_wid=c_wid,c_ht=c_ht}
143 :     in fn {light,dark,...} => f {top=dark,bottom=light} end
144 :     | Ridge => let val f = draw3DRoundRect2 drawable
145 :     {rect=rect,width=width,c_wid=c_wid,c_ht=c_ht}
146 :     in fn {light,dark,...} => f {top=light,bottom=dark} end
147 :     | Groove => let val f = draw3DRoundRect2 drawable
148 :     {rect=rect,width=width,c_wid=c_wid,c_ht=c_ht}
149 :     in fn {light,dark,...} => f {top=dark,bottom=light} end
150 :    
151 :    
152 :    
153 :     (*
154 :     * The table below is used for a quick approximation in
155 :     * computing a new point parallel to a given line
156 :     * An index into the table is 128 times the slope of the
157 :     * original line (the slope must always be between 0.0
158 :     * and 1.0). The value of the table entry is 128 times
159 :     * the amount to displace the new line in y for each unit
160 :     * of perpendicular distance. In other words, the table
161 :     * maps from the tangent of an angle to the inverse of
162 :     * its cosine. If the slope of the original line is greater
163 :     * than 1, then the displacement is done in x rather than in y.
164 :     *)
165 :    
166 :     val shiftTable = let
167 :     fun compute i = let
168 :     val tangent = (real i) / 128.0
169 :     in Real.trunc ((128.0 / Math.cos(Math.atan tangent)) + 0.5) end
170 :     val v = Vector.tabulate(129,compute)
171 :     in fn i => Vector.sub(v,i) end
172 :    
173 :     (* Given two points on a line, compute a point on a
174 :     * new line that is parallel to the given line and
175 :     * a given distance away from it.
176 :     *)
177 :     fun shiftLine (p1 as PT{x,y},p2,distance) = let
178 :     fun << (w,i) = Word.toInt (Word.<< (Word.fromInt w, i))
179 :     fun >> (w,i) = Word.toInt (Word.>> (Word.fromInt w, i))
180 :     infix << >>
181 :     val (PT{x=dx,y=dy}) = subPt(p2,p1)
182 :     val (dy,dyNeg) = if dy < 0 then (~dy,true) else (dy,false)
183 :     val (dx,dxNeg) = if dx < 0 then (~dx,true) else (dx,false)
184 :     fun adjust(dy,dx) =
185 :     ((distance * shiftTable((dy << 0w7) div dx)) + 64) >> 0w7
186 :     in
187 :     if dy <= dx then let
188 :     val dy = adjust(dy,dx)
189 :     in PT{x=x,y= y + (if dxNeg then dy else ~dy)} end
190 :     else let
191 :     val dx = adjust(dx,dy)
192 :     in PT{x= x + (if dyNeg then ~dx else dx),y=y} end
193 :     end
194 :    
195 :     (* Find the intersection of two lines with the given endpoints.
196 :     * Return NONE if lines are parallel
197 :     *)
198 :    
199 :     fun intersect (a1 as (PT{x=a1x,y=a1y}),a2, b1 as (PT{x=b1x,y=b1y}),b2) = let
200 :     val PT {x=ax,y=ay} = subPt(a2,a1)
201 :     val PT {x=bx,y=by} = subPt(b2,b1)
202 :     val axby = ax * by
203 :     val bxay = bx * ay
204 :     val axbx = ax * bx
205 :     val ayby = ay * by
206 :     fun solve (p,q) = let
207 :     val (p,q) = if q < 0 then (~p,~q) else (p,q)
208 :     in
209 :     if p < 0 then ~(((~p) + q div 2) div q)
210 :     else (p + (q div 2)) div q
211 :     end
212 :     in
213 :     if axby = bxay then NONE
214 :     else let
215 :     val x = solve (a1x*bxay - b1x*axby + (b1y - a1y)*axbx,bxay - axby)
216 :     val y = solve (a1y*axby - b1y*bxay + (b1x - a1x)*ayby,axby - bxay)
217 :     in (SOME (PT{x=x,y=y})) end
218 :     end
219 :    
220 :     fun makePerp (PT{x,y},PT{x=x',y=y'}) = PT{x=x+(y'-y),y=y-(x'-x)}
221 :    
222 :     fun last2Pts [] = raise LibBase.Impossible "ThreeD.last2Pts"
223 :     | last2Pts [v1,v2] = (v1,v2)
224 :     | last2Pts (v::vs) = last2Pts vs
225 :    
226 :     (*
227 :     * draw3DPoly draws a polygon of given width. The widening occurs
228 :     * on the left of the polygon as it is traversed. If the width
229 :     * is negative, the widening occurs on the right. Duplicate points
230 :     * are ignored. If there are less than two distinct points, nothing
231 :     * is drawn.
232 :     *
233 :     * The main loop below (loop2) is executed once for each vertex in
234 :     * the polgon. At the beginning of each iteration things look like this:
235 :     *
236 :     * poly1 /
237 :     * * /
238 :     * | /
239 :     * b1 * poly0
240 :     * | |
241 :     * | |
242 :     * | |
243 :     * | |
244 :     * | |
245 :     * | | p1 p2
246 :     * b2 *--------------------*
247 :     * |
248 :     * |
249 :     * *----*--------------------*
250 :     * poly2 newb1 newb2
251 :     *
252 :     * For each interation, we:
253 :     * (a) Compute poly2 (the border corner corresponding to p1)
254 :     * As part of this process, compute a new b1 and b2 value
255 :     * for the next side (p1-p2) of the polygon.
256 :     * (b) Draw the polygon (poly0,poly1,poly2,p1)
257 :     *
258 :     * The above situation doesn't exist until two points have
259 :     * been processed. We start with the last two points in the list
260 :     * (in loop0) to get an initial b1 and b2. Then, in loop1, we
261 :     * use the first point to get a new b1 and b2, with which we
262 :     * can calculate an initial poly1 (poly0 is the last point in
263 :     * the list). At this point, we can start the main loop.
264 :     *
265 :     * If two consecutive segments of the polygon are parallel,
266 :     * then things get more complex. (See findIntersect).
267 :     * Consider the following diagram:
268 :     *
269 :     * poly1
270 :     * *----b1-----------b2------a
271 :     * \
272 :     * \
273 :     * *---------*----------* b
274 :     * poly0 p2 p1 /
275 :     * /
276 :     * --*--------*----c
277 :     * newB1 newB2
278 :     *
279 :     * Instead of using the intersection and p1 as the last two points
280 :     * in the polygon and as poly1 and poly0 in the next iteration, we
281 :     * use a and b, and b and c, respectively.
282 :     *
283 :     * Do the computation in three stages:
284 :     * 1. Compute a point "perp" such that the line p1-perp
285 :     * is perpendicular to p1-p2.
286 :     * 2. Compute the points a and c by intersecting the lines
287 :     * b1-b2 and newb1-newb2 with p1-perp.
288 :     * 3. Compute b by shifting p1-perp to the right and
289 :     * intersecting it with p1-p2.
290 :     *)
291 :    
292 :     fun draw3DPoly _ ([],_) _ = ()
293 :     | draw3DPoly _ ([_],_) _ = ()
294 :     | draw3DPoly drawable (ps as (iP::_),width) {top,bottom} = let
295 :     val (p1,p2) = last2Pts ps
296 :     fun calcOffPoints (v1,v2) = let
297 :     val b1 = shiftLine (v1,v2,width)
298 :     in (b1,addPt(b1,subPt(v2,v1))) end
299 :     fun findIntersect (p1,p2,newb1,newb2,b1,b2) =
300 :     case intersect(newb1,newb2,b1,b2) of
301 :     SOME x => (x,p1,x)
302 :     | NONE => let
303 :     val perp = makePerp (p1,p2)
304 :     val SOME poly2 = intersect (p1,perp,b1,b2)
305 :     val SOME c = intersect (p1,perp,newb1,newb2)
306 :     val shift1 = shiftLine (p1,perp,width)
307 :     val shift2 = addPt(shift1,subPt(perp,p1))
308 :     val SOME poly3 = intersect (p1,p2,shift1,shift2)
309 :     in (poly2,poly3,c) end
310 :     fun draw (p0,p1,p2,p3) = let
311 :     val PT{x=dx,y=dy} = subPt(p3,p0)
312 :     val pen =
313 :     if dx > 0 then if dy <= dx then bottom else top
314 :     else if dy < dx then bottom else top
315 :     in
316 :     fillPolygon drawable pen {verts=[p0,p1,p2,p3],
317 :     shape=ConvexShape}
318 :     end
319 :    
320 :     fun loop2(p1,[],b1,b2,poly0,poly1) =
321 :     if p1 = iP then ()
322 :     else let
323 :     val (newb1,newb2) = calcOffPoints (p1,iP)
324 :     val (poly2,poly3,_) = findIntersect (p1,iP,newb1,newb2,b1,b2)
325 :     in draw (poly0,poly1,poly2,poly3) end
326 :     | loop2(p1,p2::ps,b1,b2,poly0,poly1) =
327 :     if p1 = p2 then loop2(p1,ps,b1,b2,poly0,poly1)
328 :     else let
329 :     val (newb1,newb2) = calcOffPoints (p1,p2)
330 :     val (poly2,poly3,c) = findIntersect (p1,p2,newb1,newb2,b1,b2)
331 :     in
332 :     draw (poly0,poly1,poly2,poly3);
333 :     loop2(p2,ps,newb1,newb2,poly3,c)
334 :     end
335 :     fun loop1(p1,[],_,_) = ()
336 :     | loop1(p1,p2::ps,b1,b2) =
337 :     if p1 = p2 then loop1(p1,ps,b1,b2)
338 :     else let
339 :     val (newb1,newb2) = calcOffPoints (p1,p2)
340 :     val (poly2,poly3,c) = findIntersect (p1,p2,newb1,newb2,b1,b2)
341 :     in loop2(p2,ps,newb1,newb2,poly3,c) end
342 :     fun loop0(_,[]) = ()
343 :     | loop0(p1,p2::ps) =
344 :     if p1 = p2 then loop0(p2,ps)
345 :     else let
346 :     val (b1,b2) = calcOffPoints (p1,p2)
347 :     in loop1(p2,ps,b1,b2) end
348 :     in
349 :     loop0(p1,p2::ps)
350 :     end
351 :    
352 :     fun draw3DPoly2 drawable (pts,width) = let
353 :     val halfWidth = width div 2
354 :     val outer = draw3DPoly drawable (pts,halfWidth)
355 :     val inner = draw3DPoly drawable (pts,~halfWidth)
356 :     in
357 :     fn pens => (outer pens; inner {top= #bottom pens,bottom= #top pens})
358 :     end
359 :    
360 :     fun drawPoly drawable {pts,width,relief} =
361 :     case relief of
362 :     Flat => let val f = draw3DPoly drawable (pts,width)
363 :     in fn ({base,...} : WidgetBase.shades) => f {top=base,bottom=base} end
364 :     | Raised => let val f = draw3DPoly drawable (pts,width)
365 :     in fn {light,dark,...} => f {top=light,bottom=dark} end
366 :     | Sunken => let val f = draw3DPoly drawable (pts,width)
367 :     in fn {light,dark,...} => f {top=dark,bottom=light} end
368 :     | Ridge => let val f = draw3DPoly2 drawable (pts,width)
369 :     in fn {light,dark,...} => f {top=light,bottom=dark} end
370 :     | Groove => let val f = draw3DPoly2 drawable (pts,width)
371 :     in fn {light,dark,...} => f {top=dark,bottom=light} end
372 :    
373 :     end
374 :    
375 :    

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