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/lib/protocol/xwin.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/lib/protocol/xwin.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* xwin.sml
2 :     *
3 :     * COPYRIGHT (c) 1990,1991 by John H. Reppy. See COPYRIGHT file for details.
4 :     *)
5 :    
6 :     structure XWin : sig
7 :    
8 :     (* window configuration values *)
9 :     datatype xwin_val
10 :     = XWV_BackgroundPixmap_None
11 :     | XWV_BackgroundPixmap_ParentRelative
12 :     | XWV_BackgroundPixmap of XProtTypes.pixmap_id
13 :     | XWV_BackgroundPixel of XProtTypes.pixel
14 :     | XWV_BorderPixmap_CopyFromParent
15 :     | XWV_BorderPixmap of XProtTypes.pixmap_id
16 :     | XWV_BorderPixel of XProtTypes.pixel
17 :     | XWV_BitGravity of XProtTypes.gravity
18 :     | XWV_WinGravity of XProtTypes.gravity
19 :     | XWV_BackingStore of XProtTypes.backing_store
20 :     | XWV_BackingPlanes of XProtTypes.plane_mask
21 :     | XWV_BackingPixel of XProtTypes.pixel
22 :     | XWV_SaveUnder of bool
23 :     | XWV_EventMask of XProtTypes.event_mask
24 :     | XWV_DoNotPropagateMask of XProtTypes.event_mask
25 :     | XWV_OverrideRedirect of bool
26 :     | XWV_ColorMap_CopyFromParent
27 :     | XWV_ColorMap of XProtTypes.colormap_id
28 :     | XWV_Cursor_None
29 :     | XWV_Cursor of XProtTypes.cursor_id
30 :    
31 :     val newXWin : XIo.connection -> {
32 :     id : XProtTypes.win_id,
33 :     parent : XProtTypes.win_id,
34 :     in_only : bool option,
35 :     depth : int,
36 :     visual : XProtTypes.visual_id option,
37 :     geom : Geometry.win_geom,
38 :     attrs : xwin_val list
39 :     } -> unit
40 :     (* Create a new X-window with the given xid *)
41 :    
42 :     val mapXWin : XIo.connection -> XProtTypes.win_id -> unit
43 :     (* Map a window *)
44 :    
45 :     val changeXWinAttrs : XIo.connection -> (XProtTypes.win_id * xwin_val list)
46 :     -> unit
47 :     (* change window attributes *)
48 :    
49 :     end = struct
50 :    
51 :     structure G = Geometry
52 :     structure XTy = XProtTypes
53 :     structure XDpy = XDisplay
54 :    
55 :     (* window configuration values *)
56 :     datatype xwin_val
57 :     = XWV_BackgroundPixmap_None
58 :     | XWV_BackgroundPixmap_ParentRelative
59 :     | XWV_BackgroundPixmap of XProtTypes.pixmap_id
60 :     | XWV_BackgroundPixel of XProtTypes.pixel
61 :     | XWV_BorderPixmap_CopyFromParent
62 :     | XWV_BorderPixmap of XProtTypes.pixmap_id
63 :     | XWV_BorderPixel of XProtTypes.pixel
64 :     | XWV_BitGravity of XProtTypes.gravity
65 :     | XWV_WinGravity of XProtTypes.gravity
66 :     | XWV_BackingStore of XProtTypes.backing_store
67 :     | XWV_BackingPlanes of XProtTypes.plane_mask
68 :     | XWV_BackingPixel of XProtTypes.pixel
69 :     | XWV_SaveUnder of bool
70 :     | XWV_EventMask of XProtTypes.event_mask
71 :     | XWV_DoNotPropagateMask of XProtTypes.event_mask
72 :     | XWV_OverrideRedirect of bool
73 :     | XWV_ColorMap_CopyFromParent
74 :     | XWV_ColorMap of XProtTypes.colormap_id
75 :     | XWV_Cursor_None
76 :     | XWV_Cursor of XProtTypes.cursor_id
77 :    
78 :     fun doWinVal arr = let
79 :     fun update (i, x) = Array.update (arr, i, SOME x)
80 :     in
81 :     fn (XWV_BackgroundPixmap_None) => update (0, 0w0)
82 :     | (XWV_BackgroundPixmap_ParentRelative) => update (0, 0w1)
83 :     | (XWV_BackgroundPixmap(XTy.XID p)) => update (0, p)
84 :     | (XWV_BackgroundPixel(XTy.PIXEL p)) => update (1, Word.fromInt p)
85 :     | (XWV_BorderPixmap_CopyFromParent) => update (2, 0w0)
86 :     | (XWV_BorderPixmap(XTy.XID p)) => update (2, p)
87 :     | (XWV_BorderPixel(XTy.PIXEL p)) => update (3, Word.fromInt p)
88 :     | (XWV_BitGravity g) => update (4, XCvtFuns.gravityToWire g)
89 :     | (XWV_WinGravity g) => update (5, XCvtFuns.gravityToWire g)
90 :     | (XWV_BackingStore XTy.BS_NotUseful) => update (6, 0w0)
91 :     | (XWV_BackingStore XTy.BS_WhenMapped) => update (6, 0w1)
92 :     | (XWV_BackingStore XTy.BS_Always) => update (6, 0w2)
93 :     | (XWV_BackingPlanes(XTy.PLANEMASK m)) => update (7, m)
94 :     | (XWV_BackingPixel(XTy.PIXEL p)) => update (8, Word.fromInt p)
95 :     | (XWV_OverrideRedirect b) => update (9, XCvtFuns.boolToWire b)
96 :     | (XWV_SaveUnder b) => update (10, XCvtFuns.boolToWire b)
97 :     | (XWV_EventMask(XTy.XEVTMASK m)) => update (11, m)
98 :     | (XWV_DoNotPropagateMask(XTy.XEVTMASK m)) => update (12, m)
99 :     | (XWV_ColorMap_CopyFromParent) => update (13, 0w0)
100 :     | (XWV_ColorMap(XTy.XID x)) => update (13, x)
101 :     | (XWV_Cursor_None) => update (14, 0w0)
102 :     | (XWV_Cursor(XTy.XID x)) => update (14, x)
103 :     end
104 :     val doWinValList = XCvtFuns.doValList 15 doWinVal
105 :    
106 :     (* Create a new X-window with the given xid *)
107 :     fun newXWin conn {id, parent, in_only, depth, visual, geom, attrs} = let
108 :     val msg = XRequest.encodeCreateWindow {
109 :     win = id,
110 :     parent = parent,
111 :     input_only = in_only,
112 :     depth = depth,
113 :     visual = visual,
114 :     geom = geom,
115 :     vals = doWinValList attrs
116 :     }
117 :     in
118 :     XIo.request conn msg
119 :     end
120 :    
121 :     (* Map a window *)
122 :     fun mapXWin conn w = (XIo.request conn (XRequest.encodeMapWindow{win=w}))
123 :    
124 :     (* change window attributes *)
125 :     fun changeXWinAttrs conn (win, attrs) = (
126 :     XIo.request conn (XRequest.encodeChangeWindowAttributes{
127 :     win = win, vals = doWinValList attrs
128 :     });
129 :     XIo.flushOut conn)
130 :    
131 :     end (* XWin *)

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