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

Annotation of /sml/trunk/src/eXene/examples/mixer/mixer.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* mixer.sml
2 :     *
3 :     * COPYRIGHT (c) 1991,1995 by AT&T Bell Laboratories. See COPYRIGHT file for details.
4 :     *)
5 :     structure Mixer :
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 :     structure W = Widget
13 :     structure A = Attrs
14 :     structure CS = ColorState
15 :    
16 :     open Geometry
17 :    
18 :     val resources = ["*background: gray"]
19 :    
20 :     val maxcolor = 0w65535
21 :     val medcolor = maxcolor div 0w2
22 :     val mincolor = 0w0
23 :    
24 :     val border_width = 4
25 :     val slider_width = 20
26 :     val hue_box_dim = 25
27 :     val big_spot_ht = 400
28 :     val big_spot_wid = 150
29 :    
30 :     val hglue = Box.Glue {nat=5, min=5, max=SOME 5}
31 :     val vglue = Box.Glue {nat=5, min=1, max=NONE}
32 :    
33 :     val pause = Time.fromMilliseconds 500
34 :    
35 :     val redc = W.EXB.RGB{red=medcolor, green=0w0, blue=0w0}
36 :     val greenc = W.EXB.RGB{red=0w0, green=medcolor, blue=0w0}
37 :     val bluec = W.EXB.RGB{red=0w0, green=0w0, blue=medcolor}
38 :     val blackc = W.EXB.RGB{red=0w0, green=0w0, blue=0w0}
39 :    
40 :     fun mk_red n = W.EXB.RGB{red = n, green=mincolor, blue=mincolor}
41 :     fun mk_green n = W.EXB.RGB{red = mincolor, green=n, blue=mincolor}
42 :     fun mk_blue n = W.EXB.RGB{red = mincolor, green=mincolor, blue=n}
43 :    
44 :     fun makeMixer (root, view) = let
45 :     val white = W.EXB.whiteOfScr (Root.screenOf root)
46 :     val colorOf = Root.colorOf root
47 :     fun quit () = let
48 :     fun q () = (CML.sync(CML.timeOutEvt pause);
49 :     Root.delRoot root;
50 :     RunCML.shutdown())
51 :     in CML.spawn q; () end
52 :    
53 :     val switch = Toggle.toggleSwitch (root,view,[]) (fn _ => quit ())
54 :     val switch_line = Box.HzCenter [
55 :     vglue,
56 :     Box.WBox (Toggle.widgetOf switch),
57 :     hglue
58 :     ]
59 :    
60 :     fun mkDisplayBox c w = let
61 :     val args = [(A.attr_background, A.AV_Color c),
62 :     (A.attr_borderWidth, A.AV_Int border_width)]
63 :     val dpy = Frame.frame (root,view,args) (Shape.mkRigid w)
64 :     in
65 :     Box.HzCenter [vglue,Box.WBox (Frame.widgetOf dpy),vglue]
66 :     end
67 :    
68 :     fun paintSpot spot c =
69 :     (Spot.setSpot spot c)
70 :     handle _ => (TextIO.print "out of color cells\n"; quit())
71 :    
72 :     val spot = Spot.spot (root,view)
73 :     {color = blackc, ht = big_spot_ht, wid =big_spot_wid}
74 :     val paint = paintSpot spot
75 :     val color_screen = mkDisplayBox white (Spot.widgetOf spot)
76 :    
77 :     val cc = CS.mkColorState blackc
78 :     val send_cc = CS.sendChangeColor cc
79 :     val cc_evt = CS.evtOfColorState cc
80 :     fun painter () = painter (paint (CML.sync cc_evt))
81 :    
82 :     fun mkcolorcomplex (W.EXB.RGB c) mk_color mkmsg = let
83 :     val color = colorOf (W.EXB.CMS_RGB c)
84 :     val l_args = [(A.attr_label, A.AV_Str " 0"),
85 :     (A.attr_background, A.AV_Color color)]
86 :     val label = Label.label (root,view,l_args)
87 :     val display = mkDisplayBox color (Label.widgetOf label)
88 :     val s_args = [(A.attr_isVertical, A.AV_Bool true),
89 :     (A.attr_background, A.AV_Str "gray"),
90 :     (A.attr_width, A.AV_Int slider_width),
91 :     (A.attr_fromValue, A.AV_Int 0),
92 :     (A.attr_toValue, A.AV_Int(Word.toIntX maxcolor))]
93 :     val slider = Slider.slider (root, view, s_args)
94 :     val spot = Spot.spot (root,view)
95 :     {color = blackc,ht = hue_box_dim,wid = hue_box_dim}
96 :     val screen = mkDisplayBox white (Spot.widgetOf spot)
97 :     val line = Box.HzCenter [
98 :     hglue,
99 :     screen,
100 :     hglue,
101 :     Box.WBox (Slider.widgetOf slider),
102 :     hglue,
103 :     display,
104 :     hglue
105 :     ]
106 :    
107 :     val set = Label.setLabel label
108 :     val evt = CML.wrap(Slider.evtOf slider, Word.fromInt)
109 :     val paint = paintSpot spot
110 :     fun printer_loop () = let
111 :     val n = CML.sync evt
112 :     in
113 :     set (Label.Text (Word.fmt StringCvt.DEC n));
114 :     paint (mk_color n);
115 :     send_cc (mkmsg n);
116 :     printer_loop ()
117 :     end
118 :     in (line, printer_loop) end
119 :    
120 :     val (red_line, red_printer_loop) =
121 :     mkcolorcomplex redc mk_red CS.ChangeR
122 :     val (green_line, green_printer_loop) =
123 :     mkcolorcomplex greenc mk_green CS.ChangeG
124 :     val (blue_line, blue_printer_loop) =
125 :     mkcolorcomplex bluec mk_blue CS.ChangeB
126 :    
127 :     in
128 :     CML.spawn red_printer_loop;
129 :     CML.spawn green_printer_loop;
130 :     CML.spawn blue_printer_loop ;
131 :     CML.spawn painter;
132 :     Box.widgetOf (Box.mkLayout root (Box.VtCenter [
133 :     vglue,
134 :     color_screen,
135 :     vglue,
136 :     switch_line,
137 :     vglue,
138 :     red_line,
139 :     vglue,
140 :     green_line,
141 :     vglue,
142 :     blue_line,
143 :     vglue
144 :     ]))
145 :     end (* end makeMixer *)
146 :    
147 :    
148 :     fun init root = let
149 :     val style = W.styleFromStrings (root, resources)
150 :     val name = Styles.mkView {name = Styles.styleName [],
151 :     aliases = [Styles.styleName []]}
152 :     val view = (name,style)
153 :     val mix = makeMixer (root,view)
154 :     val args = [(Attrs.attr_title, Attrs.AV_Str "RGB Mixer"),
155 :     (Attrs.attr_iconName, Attrs.AV_Str "MIX")]
156 :     val shell = Shell.shell (root,view,args) mix
157 :     in Shell.init shell end
158 :    
159 :     fun doit' (debugFlags, server) = (
160 :     XDebug.init debugFlags;
161 :     RunEXene.runWArgs init {dpy= SOME server,timeq=NONE}
162 :     )
163 :    
164 :     fun doit () = RunEXene.run init
165 :    
166 :     fun main (prog::server::_,_) = doit' ([], server)
167 :     | main _ = doit ()
168 :    
169 :     end; (* Mixer *)

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