dylan: chat/room.clj annotate

New article: Inductive lattices

author	Dylan Holmes <ocsenave@gmail.com>
date	Tue, 01 Nov 2011 01:55:26 -0500
parents	b4de894a1e2e
children

rev	line source
rlm@2	1 (ns chat.room
rlm@2	2 (:use [clojure.contrib server-socket duck-streams str-utils])
rlm@2	3 (:gen-class))
rlm@2	4
rlm@2	5
rlm@2	6 ;; CHAT ROOMS
rlm@2	7
rlm@2	8 (def rooms (ref {}))
rlm@2	9
rlm@2	10 (defn get-room! "Returns the chat room with the given name, creating it if necessary." [name]
rlm@2	11 (dosync
rlm@2	12 (or (@rooms name)
rlm@2	13 (let [new-room (agent '())]
rlm@2	14 (do (alter rooms assoc name new-room))))))
rlm@2	15
rlm@2	16 (defn say-in-room[room message]
rlm@2	17 (doseq [[_ output] room]
rlm@2	18 (binding [out output]
rlm@2	19 (println message))))
rlm@2	20
rlm@2	21
rlm@2	22 ;; USERS
rlm@2	23
rlm@2	24 (defn user-join[room username output-channel]
rlm@2	25 (conj room [username output-channel]))
rlm@2	26 (defn user-leave[room username]
rlm@2	27 (remove #(= (% 0) username) room))
rlm@2	28
rlm@2	29
rlm@2	30 (def username "Someone")
rlm@2	31 (defn- join-room [room]
rlm@2	32 (send room user-join username out)
rlm@2	33 (send room
rlm@2	34 )

Mercurial > dylan