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/trunk/widgets/composite/background.sml
ViewVC logotype

Annotation of /eXene/trunk/widgets/composite/background.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2098 - (view) (download)

1 : monnier 2 (* background.sml
2 :     *
3 :     * COPYRIGHT (c) 1994 by AT&T Bell Laboratories See COPYRIGHT file for details.
4 :     *
5 :     * Background widget.
6 :     * Largely obsolete, as each widget supports its own background now.
7 :     *)
8 :    
9 :     signature BACKGROUND =
10 :     sig
11 :    
12 :     structure W : WIDGET
13 :    
14 :     type background
15 :    
16 :     val background : (W.root * W.view * W.arg list) -> W.widget -> background
17 :    
18 :     val mkBackground : {
19 :     color : W.EXB.color option,
20 :     widget : W.widget
21 :     } -> background
22 :    
23 :     val widgetOf : background -> W.widget
24 :    
25 :     end (* BACKGROUND *)
26 :    
27 :     structure Background : BACKGROUND =
28 :     struct
29 :    
30 :     structure W = Widget
31 :    
32 :     type background = W.widget
33 :    
34 :     val attrs = [
35 :     (Attrs.attr_background, Attrs.AT_Color, Attrs.AV_Str "white")
36 :     ]
37 :    
38 :     fun mkBack (root, color, widget) =
39 :     W.mkWidget{
40 :     root=root,
41 :     args= fn () => {background = SOME color},
42 :     boundsOf = W.boundsFn widget,
43 :     realize= W.realizeFn widget
44 :     }
45 :    
46 :     fun background (root,view,args) widget = let
47 :     val attrs = W.findAttr (W.attrs (view,attrs,args))
48 :     val color = Attrs.getColor (attrs Attrs.attr_background)
49 :     in mkBack (root,color,widget) end
50 :    
51 :     fun mkBackground {color, widget} = let
52 :     val root = W.rootOf widget
53 :     val color = (case color
54 :     of NONE => W.EXB.whiteOfScr (W.screenOf root)
55 :     | SOME color => color
56 :     (* end case *))
57 :     in mkBack (root, color,widget) end
58 :    
59 :     fun widgetOf w = w
60 :    
61 :     end (* Background *)
62 :    

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