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/util/image-server.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/widgets/util/image-server.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* image-server.sml
2 :     *
3 :     * COPYRIGHT (c) 1994 by AT&T Bell Laboratories. See COPYRIGHT file for details
4 :     *
5 :     * This provides a name to eXene image server.
6 :     *)
7 :    
8 :     signature IMAGE_SERVER =
9 :     sig
10 :     structure EXB : EXENE_BASE
11 :    
12 :     exception BadName
13 :    
14 :     type image_server
15 :    
16 :     val mkImageServer : (Quark.quark * EXB.image) list -> image_server
17 :     val getImage : image_server -> Quark.quark -> EXB.image
18 :     val addImage : image_server -> Quark.quark * EXB.image -> unit
19 :    
20 :     end
21 :    
22 :     structure ImageServer : IMAGE_SERVER =
23 :     struct
24 :    
25 :     structure EXB = EXeneBase
26 :    
27 :     exception BadName
28 :    
29 :     datatype req =
30 :     GetImage of Quark.quark
31 :     | AddImage of (Quark.quark * EXB.image)
32 :    
33 :     datatype reply =
34 :     Image of EXB.image
35 :     | Okay
36 :     | Error
37 :    
38 :     datatype image_server = IS of {req : req CML.chan, rep : reply CML.chan}
39 :    
40 :     structure StringTbl = HashTableFn (struct
41 :     type hash_key = Quark.quark
42 :     val sameKey = Quark.same
43 :     val hashVal = Quark.hash
44 :     end)
45 :    
46 :     type image_tbl = EXB.image StringTbl.hash_table
47 :    
48 :     fun mkImageServer inits = let
49 :     exception NotFound
50 :     val imageTbl : image_tbl = StringTbl.mkTable(32, NotFound)
51 :     val imageIns = StringTbl.insert imageTbl
52 :     val imageFind = StringTbl.find imageTbl
53 :     val reqCh = CML.channel () and replyCh = CML.channel ()
54 :    
55 :     fun handleReq (GetImage n) =
56 :     (case imageFind n
57 :     of NONE => Error
58 :     | SOME i => Image i)
59 :     | handleReq (AddImage (q,i)) =
60 :     case imageFind q
61 :     of NONE => (imageIns (q,i); Okay)
62 :     | SOME _ => Error
63 :    
64 :     fun loop () = (CML.send(replyCh,handleReq(CML.recv reqCh)); loop ())
65 :     in
66 :     app imageIns inits;
67 :     XDebug.xspawn("ImageServer", loop);
68 :     IS{req=reqCh,rep=replyCh}
69 :     end
70 :    
71 :     fun getImage (IS{req,rep}) name = (
72 :     CML.send(req, GetImage name);
73 :     case CML.recv rep of Image i => i | _ => raise BadName
74 :     )
75 :     fun addImage (IS{req,rep}) arg = (
76 :     CML.send(req, AddImage arg);
77 :     case CML.recv rep of Okay => () | _ => raise BadName
78 :     )
79 :    
80 :     end
81 :    

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