Mercurial > urweb

annotate demo/chat.ur @ 699:4e260887d8f2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Chat demo
author Adam Chlipala <adamc@hcoop.net>
date Sun, 05 Apr 2009 11:48:55 -0400
parents
children 1a317a707d71
rev   line source
adamc@699 1 structure Room = Broadcast.Make(struct
adamc@699 2 type t = string
adamc@699 3 end)
adamc@699 4
adamc@699 5 sequence s
adamc@699 6 table t : { Id : int, Title : string, Room : Room.topic }
adamc@699 7
adamc@699 8 fun chat id =
adamc@699 9 r <- oneRow (SELECT t.Title, t.Room FROM t WHERE t.Id = {[id]});
adamc@699 10 ch <- Room.subscribe r.T.Room;
adamc@699 11
adamc@699 12 newLine <- source "";
adamc@699 13 buf <- Buffer.create;
adamc@699 14
adamc@699 15 let
adamc@699 16 fun onload () =
adamc@699 17 let
adamc@699 18 fun listener () =
adamc@699 19 s <- recv ch;
adamc@699 20 Buffer.write buf s;
adamc@699 21 listener ()
adamc@699 22 in
adamc@699 23 listener ()
adamc@699 24 end
adamc@699 25
adamc@699 26 fun getRoom () =
adamc@699 27 r <- oneRow (SELECT t.Room FROM t WHERE t.Id = {[id]});
adamc@699 28 return r.T.Room
adamc@699 29
adamc@699 30 fun speak line =
adamc@699 31 room <- getRoom ();
adamc@699 32 Room.send room line
adamc@699 33
adamc@699 34 fun doSpeak () =
adamc@699 35 line <- get newLine;
adamc@699 36 set newLine "";
adamc@699 37 speak line
adamc@699 38 in
adamc@699 39 return <xml><body onload={onload ()}>
adamc@699 40 <h1>{[r.T.Title]}</h1>
adamc@699 41
adamc@699 42 <button value="Send:" onclick={doSpeak ()}/> <ctextbox source={newLine}/>
adamc@699 43
adamc@699 44 <h2>Messages</h2>
adamc@699 45
adamc@699 46 <dyn signal={Buffer.render buf}/>
adamc@699 47
adamc@699 48 </body></xml>
adamc@699 49 end
adamc@699 50
adamc@699 51 fun list () =
adamc@699 52 queryX' (SELECT * FROM t)
adamc@699 53 (fn r =>
adamc@699 54 count <- Room.subscribers r.T.Room;
adamc@699 55 return <xml><tr>
adamc@699 56 <td>{[r.T.Id]}</td>
adamc@699 57 <td><a link={chat r.T.Id}>{[r.T.Title]}</a></td>
adamc@699 58 <td>{[count]}</td>
adamc@699 59 <td><a link={delete r.T.Id}>[delete]</a></td>
adamc@699 60 </tr></xml>)
adamc@699 61
adamc@699 62 and delete id =
adamc@699 63 dml (DELETE FROM t WHERE Id = {[id]});
adamc@699 64 main ()
adamc@699 65
adamc@699 66 and main () =
adamc@699 67 let
adamc@699 68 fun create r =
adamc@699 69 id <- nextval s;
adamc@699 70 room <- Room.create;
adamc@699 71 dml (INSERT INTO t (Id, Title, Room) VALUES ({[id]}, {[r.Title]}, {[room]}));
adamc@699 72 main ()
adamc@699 73 in
adamc@699 74 ls <- list ();
adamc@699 75 return <xml><body>
adamc@699 76 <h1>Current Channels</h1>
adamc@699 77
adamc@699 78 <table>
adamc@699 79 <tr> <th>ID</th> <th>Title</th> <th>#Subscribers</th> </tr>
adamc@699 80 {ls}
adamc@699 81 </table>
adamc@699 82
adamc@699 83 <h1>New Channel</h1>
adamc@699 84
adamc@699 85 <form>
adamc@699 86 Title: <textbox{#Title}/><br/>
adamc@699 87 <submit action={create}/>
adamc@699 88 </form>
adamc@699 89 </body></xml>
adamc@699 90 end