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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2
2 :     signature TILE_SERVER =
3 :     sig
4 :     structure EXB : EXENE_BASE
5 :    
6 :     type tile_server
7 :    
8 :     exception BadName
9 :    
10 :     val mkTileServer : (EXB.screen * (Quark.quark -> EXB.image)) -> tile_server
11 :    
12 :     val getTile : tile_server -> string -> EXB.tile
13 :    
14 :     end
15 :    
16 :     structure TileServer : TILE_SERVER =
17 :     struct
18 :    
19 :     structure EXB = EXeneBase
20 :    
21 :     exception BadName
22 :    
23 :     datatype req = GetTile of string
24 :     type reply = EXB.tile option
25 :    
26 :     datatype tile_server = TS of {
27 :     req : req CML.chan,
28 :     reply : reply CML.chan
29 :     }
30 :    
31 :     structure StringTbl = HashTableFn (struct
32 :     type hash_key = Quark.quark
33 :     val sameKey = Quark.same
34 :     val hashVal = Quark.hash
35 :     end)
36 :    
37 :     type tile_tbl = EXB.tile StringTbl.hash_table
38 :    
39 :     fun mkTileServer (scr,imageOf) = let
40 :     exception NotFound
41 :     val tileTbl : tile_tbl = StringTbl.mkTable(32, NotFound)
42 :     val tileIns = StringTbl.insert tileTbl
43 :     val tileFind = StringTbl.find tileTbl
44 :    
45 :     fun wrapIn (ins,f) =
46 :     (f ins before TextIO.closeIn ins)
47 :     handle e => (TextIO.closeIn ins; raise e)
48 :    
49 :     fun mkFileTile (n,q) = let
50 :     val fileName = substring(n,1,size n - 1)
51 :     val ins = TextIO.openIn fileName
52 :     val {image, ...} = wrapIn (ins, BitmapIO.readBitmap)
53 :     val t = EXB.createTileFromImage scr image
54 :     in
55 :     tileIns(q, t); SOME t
56 :     end
57 :    
58 :     fun mkImageTile q = let
59 :     val t = EXB.createTileFromImage scr (imageOf q)
60 :     in tileIns(q,t); SOME t end
61 :    
62 :     fun mkTile (arg as (n, q)) =
63 :     (if String.sub(n, 0) = #"@" then mkFileTile arg else mkImageTile q)
64 :     handle _ => NONE
65 :    
66 :     fun handleReq (GetTile n) = let
67 :     val q = Quark.quark n
68 :     in case tileFind q of NONE => mkTile (n,q) | s => s end
69 :    
70 :     val req = CML.channel () and reply = CML.channel ()
71 :     fun loop () = (CML.send(reply,handleReq(CML.recv req)); loop ())
72 :     in
73 :     XDebug.xspawn("TileServer", loop);
74 :     TS{req = req, reply = reply}
75 :     end
76 :    
77 :     fun getTile (TS{req,reply}) name = (
78 :     CML.send(req, GetTile name);
79 :     case CML.recv reply of SOME s => s | _ => raise BadName
80 :     )
81 :    
82 :     end
83 :    

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