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/basics/widget-base.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/widgets/basics/widget-base.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (view) (download)

1 : monnier 2 (* widget-base.sml
2 :     *
3 :     * COPYRIGHT (c) 1991 by AT&T Bell Laboratories.
4 :     *
5 :     * Definitions for basic widget types.
6 :     *)
7 :    
8 :     signature WIDGET_BASE =
9 :     sig
10 :    
11 :     structure G : GEOMETRY
12 :     structure CML : CML
13 :    
14 :     datatype valign = VCenter | VTop | VBottom
15 :     datatype halign = HCenter | HRight | HLeft
16 :     datatype gravity = Center | North | South | East | West |
17 :     NorthWest | NorthEast | SouthWest | SouthEast
18 :    
19 :     (* Widget states (e.g., on/off); the bool is the state, and the constructor
20 :     * specifies whether the state can be affected by user action (e.g., mouse
21 :     * click).
22 :     *)
23 :     datatype wstate
24 :     = Active of bool (* state may be affected by user actions *)
25 :     | Inactive of bool (* state cannot be affected by user actions *)
26 :    
27 :     datatype arrow_dir = AD_Up | AD_Down | AD_Left | AD_Right
28 :    
29 :     type shades = ShadeServer.shades
30 :    
31 :     exception BadIncrement
32 :    
33 :     datatype dim = DIM of {
34 :     base : int,
35 :     incr : int,
36 :     min : int,
37 :     nat : int,
38 :     max : int option
39 :     }
40 :    
41 :     (* type bounds = { x_dim : dim, y_dim : dim } *)
42 :     type bounds
43 :     val mkBounds : { x_dim : dim, y_dim : dim } -> bounds
44 :    
45 :     val fixDim : int -> dim
46 :     val flexDim : int -> dim
47 :     val natDim : dim -> int
48 :     val minDim : dim -> int
49 :     val maxDim : dim -> int option
50 :     val fixBounds : (int * int) -> bounds
51 :     val compatibleDim : dim * int -> bool
52 :     val compatibleSize : bounds * G.size -> bool
53 :    
54 :     type win_args
55 :    
56 :     val wrapCreate : (EXeneBase.window * G.rect * win_args) -> EXeneBase.window
57 :    
58 :     val wrapQueue : 'a CML.event -> 'a CML.event
59 :    
60 :    
61 :     end (* WIDGET_BASE *)
62 :    
63 :     structure WidgetBase : WIDGET_BASE =
64 :     struct
65 :    
66 :     structure G = Geometry
67 :     structure EXB = EXeneBase
68 :     structure CML = CML
69 :    
70 :     open G
71 :    
72 :     datatype valign = VCenter | VTop | VBottom
73 :     datatype halign = HCenter | HRight | HLeft
74 :     datatype gravity = Center | North | South | East | West |
75 :     NorthWest | NorthEast | SouthWest | SouthEast
76 :    
77 :     datatype wstate = Active of bool | Inactive of bool
78 :    
79 :     datatype arrow_dir = AD_Up | AD_Down | AD_Left | AD_Right
80 :    
81 :     type shades = ShadeServer.shades
82 :    
83 :     exception BadIncrement
84 :    
85 :     datatype dim = DIM of {
86 :     base : int,
87 :     incr : int,
88 :     min : int,
89 :     nat : int,
90 :     max : int option
91 :     }
92 :    
93 :     type bounds = { x_dim : dim, y_dim : dim }
94 :     fun mkBounds x = x
95 :    
96 :     fun fixDim x = DIM {base = x, incr = 1, min = 0, nat = 0, max = SOME 0}
97 :     fun flexDim x = DIM {base = x, incr = 1, min = 0, nat = 0, max = NONE}
98 :     fun natDim (DIM{base,incr,nat,...}) = base + incr*nat
99 :     fun minDim (DIM{base,incr,min,...}) = base + incr*min
100 :     fun maxDim (DIM{base,incr,max=NONE,...}) = NONE
101 :     | maxDim (DIM{base,incr,max=SOME max,...}) = SOME(base + incr*max)
102 :    
103 :     fun fixBounds (x,y) = {x_dim = fixDim x, y_dim = fixDim y}
104 :    
105 :     fun compatibleDim (dim,v) =
106 :     (minDim dim <= v) andalso
107 :     case maxDim dim of
108 :     NONE => true
109 :     | SOME max => v <= max
110 :    
111 :     fun compatibleSize ({x_dim,y_dim} : bounds, SIZE{wid,ht}) =
112 :     compatibleDim(x_dim,wid) andalso compatibleDim(y_dim,ht)
113 :    
114 :     type win_args = {background : EXB.color option}
115 :    
116 :     fun wrapCreate (pwin, rect, args : win_args) = let
117 :     open EXB
118 :     val SIZE{wid,ht} = sizeOfRect rect
119 :     in
120 :     if (wid <= 0) orelse (ht <= 0)
121 :     then LibBase.failure{
122 :     module="Widget",
123 :     func="wrapCreate",
124 :     msg="invalid size"
125 :     }
126 :     else ();
127 :     EXeneWin.createSimpleSubwin pwin {
128 :     geom = WGEOM{pos=originOfRect rect, sz=sizeOfRect rect, border=0},
129 :     backgrnd = #background args,
130 :     border = NONE (* not used *)
131 :     }
132 :     end
133 :    
134 :     fun wrapQueue ine = let
135 :     val outchan = CML.channel()
136 :     fun loop ([],[]) = loop([CML.sync ine],[])
137 :     | loop ([],l) = loop(rev l,[])
138 :     | loop (l as e::tl,rest) =
139 :     loop (CML.select [
140 :     CML.wrap(CML.sendEvt(outchan,e),fn () => (tl,rest)),
141 :     CML.wrap(ine,fn e => (l,e::rest))
142 :     ])
143 :     in
144 :     CML.spawn(fn () => loop ([],[]));
145 :     CML.recvEvt outchan
146 :     end
147 :    
148 :     end (* WidgetBase *)

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