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