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/examples/widgets/label-slider.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/examples/widgets/label-slider.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* label-slider.sml
2 :     *
3 :     * COPYRIGHT (c) 1991,1995 by AT&T Bell Laboratories. See COPYRIGHT file for details.
4 :     *)
5 :     structure LabelSlider :
6 :     sig
7 :     val doit' : string list * string -> unit
8 :     val doit : unit -> unit
9 :     val main : string list * 'a -> unit
10 :     end =
11 :     struct
12 :    
13 :     structure W = Widget
14 :     structure Sl = Slider
15 :     structure A = Attrs
16 :    
17 :     val resources = [
18 :     "*relief: raised",
19 :     "*background: forestgreen\n"
20 :     ]
21 :    
22 :     fun mkLabelSlider (root,view) = let
23 :     val lArgs = [(A.attr_label,A.AV_Str "0"),
24 :     (A.attr_width, A.AV_Int 4),
25 :     (A.attr_halign, A.AV_HAlign W.HRight)]
26 :     val label = Label.label (root,view,lArgs)
27 :     val sArgs = [(A.attr_width,A.AV_Int 20),
28 :     (A.attr_isVertical, A.AV_Bool false)]
29 :     val slider = Sl.slider (root,view,sArgs)
30 :     fun set l = Label.setLabel label (Label.Text l)
31 :     val evt = Sl.evtOf slider
32 :     fun loop () = loop (set (makestring (CML.sync evt)))
33 :     in
34 :     CML.spawn loop;
35 :     Box.widgetOf(Box.layout (root,view,[]) (Box.HzCenter [
36 :     (* Glue {nat=20, min=0, max=NONE}, *)
37 :     Box.WBox (Label.widgetOf label),
38 :     Box.Glue {nat=20, min=20, max=SOME 20},
39 :     Box.WBox (Sl.widgetOf slider)
40 :     ]))
41 :     end
42 :    
43 :     fun tester root = let
44 :     fun quit () = (W.delRoot root; RunCML.shutdown())
45 :     val style = W.styleFromStrings (root, resources)
46 :     val name = Styles.mkView {name = Styles.styleName [],
47 :     aliases = [Styles.styleName []]}
48 :     val view = (name,style)
49 :     val lslider = mkLabelSlider (root,view)
50 :     val layout = Box.layout (root,view,[]) (Box.VtCenter [
51 :     Box.WBox lslider,
52 :     Box.HzCenter [Box.Glue{nat=300, min=0, max=NONE}]
53 :     ])
54 :     val shell = Shell.shell (root,view,[]) (Box.widgetOf layout)
55 :     fun loop () =
56 :     if (CIO.input_line CIO.std_in) = "quit\n"
57 :     then quit ()
58 :     else loop ()
59 :     in
60 :     Shell.init shell;
61 :     loop ()
62 :     end
63 :    
64 :     fun doit' (debugFlags, server) = (
65 :     XDebug.init debugFlags;
66 :     RunEXene.runWArgs tester {dpy= SOME server,timeq=NONE}
67 :     )
68 :    
69 :     fun doit () = RunEXene.run tester
70 :    
71 :     fun main (prog::server::_,_) = doit'([], server)
72 :     | main _ = doit ()
73 :    
74 :     end (* LabelSlider *)

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