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

Annotation of /sml/trunk/src/eXene/examples/bricks/brickview.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (view) (download)

1 : monnier 2 (* brickview.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 AT&T Research.
4 :     *)
5 :    
6 :     signature BRICKVIEW =
7 :     sig
8 :     structure W : WIDGET
9 :     structure U : BRICK_UTIL
10 :    
11 :     type brick_view
12 :    
13 :     val mkBrickView : W.root -> (U.Position * U.MseEvt CML.chan * U.Palette) -> brick_view
14 :     val widgetOf : brick_view -> W.widget
15 :    
16 :     val showView : brick_view -> string -> unit
17 :     val endView : brick_view -> string -> unit
18 :     val markView : brick_view -> unit
19 :     val normView : brick_view -> unit
20 :    
21 :     val setText : brick_view -> string -> unit
22 :     val highlightOn : brick_view -> unit
23 :     val highlightOff : brick_view -> unit
24 :     end
25 :    
26 :     structure BrickView : BRICKVIEW =
27 :     struct
28 :     structure W = Widget
29 :     structure U = BrickUtil
30 :    
31 :     open Geometry Interact Widget U
32 :    
33 :     datatype brick_view = BV of {
34 :     widget : widget,
35 :     highlight : bool -> unit,
36 :     setTextFn : string -> unit,
37 :     showViewFn : string -> unit,
38 :     endViewFn : string -> unit,
39 :     markViewFn : unit -> unit,
40 :     normViewFn : unit -> unit
41 :     }
42 :    
43 :     fun mkBrickView root (pt, brickCh, palette : Palette) = let
44 :     val label = Label.mkLabel root {
45 :     label = "",
46 :     font = SOME BrickFont,
47 :     foregrnd = NONE,
48 :     backgrnd = SOME (#brick palette),
49 :     align = HCenter}
50 :    
51 :     val widget' = Shape.fixSize (Label.widgetOf label,SIZE{wid=BrickSizeH,ht=BrickSizeV})
52 :     val frame = Frame.mkFrame {
53 :     color = SOME (#darkLines palette),
54 :     width = 1,
55 :     widget = widget'}
56 :     val (widget, revt) = filterMouse (Frame.widgetOf frame)
57 :    
58 :     val reqChan = CML.channel ()
59 :    
60 :     fun setText txt me = (Label.setLabel label (Label.Text txt); me)
61 :    
62 :     fun showText (backc, framec) txt _ = (
63 :     Label.setBackground label backc;
64 :     Label.setLabel label (Label.Text txt);
65 :     Frame.setColor frame framec;
66 :     framec)
67 :    
68 :     val showView = showText (#concrete palette, SOME(#lightLines palette))
69 :     val endView = showText (#brick palette, SOME(#lightLines palette))
70 :     val markView = showText (#mark palette, SOME(#darkLines palette)) "ok"
71 :     val normView = showText (#brick palette, SOME(#darkLines palette)) ""
72 :    
73 :     val hilite = SOME(#highlightLines palette)
74 :     fun highlight true me = (Frame.setColor frame hilite; me)
75 :     | highlight false me = (Frame.setColor frame me; me)
76 :    
77 :     fun handleMouse (MOUSE_FirstDown{but,...}, _) =
78 :     (CML.send(brickCh,Down(but,pt)); true)
79 :     | handleMouse (MOUSE_LastUp{but,...}, true) =
80 :     (CML.send(brickCh,Up(but,pt)); false)
81 :     | handleMouse (MOUSE_Leave _, true) =
82 :     (CML.send(brickCh,Cancel pt); false)
83 :     | handleMouse (_,me) = me
84 :    
85 :     fun main ((m,_),me) = let
86 :     fun loop (updown,border) =
87 :     loop(CML.select [
88 :     CML.wrap(m, fn evt => (handleMouse (msgBodyOf evt, updown),border)),
89 :     CML.wrap(CML.recvEvt reqChan, fn f => (updown, f border))
90 :     ])
91 :     in
92 :     loop me
93 :     end
94 :    
95 :     fun initLoop () = let
96 :     fun loop (me as (updown,border)) = CML.select [
97 :     CML.wrap(revt, fn evt => main(evt,me)),
98 :     CML.wrap(CML.recvEvt reqChan, fn f => loop(updown, f border))
99 :     ]
100 :     in
101 :     loop (false, SOME (#darkLines palette))
102 :     end
103 :     in
104 :     CML.spawn initLoop;
105 :     BV {
106 :     widget = widget,
107 :     highlight = fn b => CML.send(reqChan,highlight b),
108 :     setTextFn = fn t => CML.send(reqChan,setText t),
109 :     showViewFn = fn t => CML.send(reqChan,showView t),
110 :     endViewFn = fn t => CML.send(reqChan,endView t),
111 :     normViewFn = fn () => CML.send(reqChan,normView),
112 :     markViewFn = fn () => CML.send(reqChan,markView)
113 :     }
114 :     end
115 :    
116 :     fun widgetOf (BV{widget,...}) = widget
117 :    
118 :     fun showView (BV{showViewFn,...}) txt = showViewFn txt
119 :     fun endView (BV{endViewFn,...}) txt = endViewFn txt
120 :     fun markView (BV{markViewFn,...}) = markViewFn ()
121 :     fun normView (BV{normViewFn,...}) = normViewFn ()
122 :    
123 :     fun setText (BV{setTextFn,...}) txt = setTextFn txt
124 :     fun highlightOn (BV{highlight,...}) = highlight true
125 :     fun highlightOff (BV{highlight,...}) = highlight false
126 :    
127 :     end
128 :    
129 :    

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