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/widgets/basics/root.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/widgets/basics/root.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (view) (download)

1 : monnier 2 (* root.sml
2 :     *
3 :     * COPYRIGHT (c) 1994 by AT&T Bell Laboratories.
4 :     *
5 :     * Definitions for widget root.
6 :     *)
7 :    
8 :     signature ROOT =
9 :     sig
10 :    
11 :     structure EXB : EXENE_BASE
12 :    
13 :     type root
14 :     type style
15 :    
16 :     val mkRoot : (string * EXB.authentication option) -> root
17 :     val delRoot : root -> unit
18 :     val sameRoot : root * root -> bool
19 :     val displayOf : root -> EXB.display
20 :     val screenOf : root -> EXB.screen
21 :     val shades : root -> EXB.color -> WidgetBase.shades
22 :     val tile : root -> string -> EXB.tile
23 :     val colorOf : root -> EXB.color_spec -> EXB.color
24 :     val openFont : root -> string -> EXB.font
25 :     val stdCursor : root -> EXeneBase.std_cursor -> EXeneBase.cursor
26 :     val ringBell : root -> int -> unit
27 :    
28 :     val sizeOfScr : root -> Geometry.size
29 :     val sizeMMOfScr : root -> Geometry.size
30 :     val depthOfScr : root -> int
31 :    
32 :     val isMonochrome : root -> bool
33 :    
34 :     val styleOf : root -> style
35 :     val styleFromStrings : root * string list -> style
36 :    
37 :     end (* ROOT *)
38 :    
39 :     structure Root =
40 :     struct
41 :    
42 :     structure EXB = EXeneBase
43 :    
44 :     (* Root object, corresponding to display/screen pair.
45 :     * server = "" => "unix:0.0"
46 :     * = ":d" => "unix:d.0"
47 :     * = "host:d" => "host:d.0"
48 :     * = "host:d.s" => "host:d.s"
49 :     * where host is an internet address (e.g., "128.84.254.97") or "unix".
50 :     *
51 :     * At present, screen is always the default screen.
52 :     *)
53 :     type style = Styles.style
54 :    
55 :     datatype root = Root of {
56 :     id : unit ref,
57 :     scr : EXB.screen,
58 :     mkshade : EXB.color -> ShadeServer.shades,
59 :     mktile : string -> EXB.tile,
60 :     style : style,
61 :     idGen : unit -> int
62 :     }
63 :    
64 :     val initImages = [
65 :     (Quark.quark "lightGray", Images.lightGray),
66 :     (Quark.quark "gray", Images.gray)
67 :     ]
68 :    
69 :     fun mkRoot (server, auth) = let
70 :     val scr = EXB.defaultScreenOf (EXB.openDisplay (server, auth))
71 :     val idChan = CML.channel ()
72 :     fun idLoop i = (CML.send(idChan,i);idLoop(i+1))
73 :     val is = ImageServer.mkImageServer initImages
74 :     val ts = TileServer.mkTileServer (scr,ImageServer.getImage is)
75 :     val ss = ShadeServer.mkShadeServer scr
76 :     val tilef = TileServer.getTile ts
77 :     in
78 :     CML.spawn (fn () => idLoop 0);
79 :     Root {
80 :     id = ref (),
81 :     scr = scr,
82 :     style = Styles.emptyStyle {scr=scr,tilef=tilef},
83 :     mktile = tilef,
84 :     mkshade = ShadeServer.getShades ss,
85 :     idGen = fn () => CML.recv idChan}
86 :     end
87 :    
88 :     fun screenOf (Root {scr,...}) = scr
89 :     fun displayOf (Root {scr,...}) = EXB.displayOfScr scr
90 :     fun delRoot root = EXB.closeDisplay (displayOf root)
91 :     fun sameRoot (Root {id,...},Root{id=id',...}) = id = id'
92 :     fun shades (Root{mkshade,...}) c = mkshade c
93 :     fun tile (Root{mktile,...}) s = mktile s
94 :     fun colorOf (Root{scr,...}) color_spec = EXB.colorOfScr scr color_spec
95 :     fun openFont (Root{scr,...}) = Font.openFont (EXB.displayOfScr scr)
96 :     fun stdCursor (Root{scr,...}) = EXB.stdCursor (EXB.displayOfScr scr)
97 :     fun ringBell (Root{scr,...}) = EXB.ringBell (EXB.displayOfScr scr)
98 :     fun sizeOfScr (Root{scr,...}) = EXB.sizeOfScr scr
99 :     fun sizeMMOfScr (Root{scr,...}) = EXB.sizeMMOfScr scr
100 :     fun depthOfScr (Root{scr,...}) = EXB.depthOfScr scr
101 :    
102 :     fun styleOf (Root {style,...}) = style
103 :    
104 :     fun isMonochrome (Root{scr,...}) =
105 :     EXB.displayClassOfScr scr = EXB.StaticGray andalso
106 :     EXB.depthOfScr scr = 1
107 :    
108 :     fun styleFromStrings (Root{scr,mktile,...}, sl) =
109 :     Styles.styleFromStrings ({scr=scr,tilef=mktile},sl)
110 :    
111 :     end (* Root *)

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