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/composite/shape.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/widgets/composite/shape.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* shape.sml
2 :     *
3 :     * COPYRIGHT (c) 1991, 1992 by AT&T Bell Laboratories. See COPYRIGHT file for details.
4 :     *
5 :     * Widget wrappers to constrain widget's shape.
6 :     *)
7 :    
8 :     signature SHAPE =
9 :     sig
10 :    
11 :     structure W : WIDGET
12 :    
13 :     val mkShape : {
14 :     widget : W.widget,
15 :     bounds_fn : ((unit -> W.bounds) -> W.bounds),
16 :     resize_fn : ((unit -> W.bounds) -> bool)
17 :     } -> W.widget
18 :    
19 :     val mkRigid : W.widget -> W.widget
20 :     val mkFlex : W.widget -> W.widget
21 :     val fixSize : (W.widget * W.G.size) -> W.widget
22 :     val freeSize : (W.widget * W.G.size) -> W.widget
23 :    
24 :     end (* SHAPE *)
25 :    
26 :     structure Shape : SHAPE =
27 :     struct
28 :    
29 :     structure W = Widget
30 :    
31 :     local
32 :     open Geometry Interact
33 :     fun doShape shapeFn widget = shapeFn (widget,W.natSize widget)
34 :     fun dummy x = x
35 :     in
36 :    
37 :     fun mkShape wrapfn {widget, bounds_fn = bnds, resize_fn = resize} = let
38 :     val bounds_of = W.boundsFn widget
39 :     fun realize {env=InEnv{m,k,ci,co}, win, sz} = let
40 :     val ochan = CML.channel ()
41 :     fun outEvt ch x = CML.sendEvt(ch, x)
42 :     val cinenv = InEnv{k=k,m=m,ci=ci,co=outEvt ochan}
43 :     val childco = wrapfn(CML.recvEvt ochan)
44 :    
45 :     fun loop () =
46 :     loop (case CML.sync childco of
47 :     CO_KillReq => CML.sync (co CO_KillReq)
48 :     | CO_ResizeReq =>
49 :     if resize bounds_of then CML.sync (co CO_ResizeReq)
50 :     else ()
51 :     )
52 :     in
53 :     CML.spawn loop;
54 :     W.realizeFn widget {env=cinenv,win=win,sz=sz}
55 :     end
56 :     in
57 :     W.mkWidget {
58 :     root = W.rootOf widget,
59 :     args = W.argsFn widget,
60 :     boundsOf = fn () => bnds bounds_of,
61 :     realize = realize
62 :     }
63 :     end
64 :    
65 :     fun fixSize (w, SIZE{wid,ht}) = let
66 :     val bounds = W.fixBounds (wid,ht)
67 :     in
68 :     mkShape dummy {
69 :     widget=w,
70 :     bounds_fn = fn _ => bounds,
71 :     resize_fn = fn _ => false
72 :     }
73 :     end
74 :    
75 :     fun freeSize (w, SIZE{wid,ht}) = let
76 :     val x_dim = W.DIM {base = 0, incr = 1, min = 1, nat = wid, max = NONE}
77 :     val y_dim = W.DIM {base = 0, incr = 1, min = 1, nat = ht, max = NONE}
78 :     val bounds = {x_dim = x_dim, y_dim = y_dim}
79 :     in
80 :     mkShape dummy {
81 :     widget=w,
82 :     bounds_fn = fn _ => bounds,
83 :     resize_fn = fn _ => true
84 :     }
85 :     end
86 :    
87 :     val mkRigid = doShape fixSize
88 :     val mkFlex = doShape freeSize
89 :     val mkShape = mkShape W.wrapQueue
90 :    
91 :     end (* local *)
92 :     end (* Shape *)

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