source: scenarios/GerminationX/oak/src/oak/world.clj @ 904

Revision 904, 10.0 KB checked in by dave, 10 years ago (diff)

connected game world to fatima

Line 
1;; Copyright (C) 2010 FoAM vzw
2;; This program is free software: you can redistribute it and/or modify
3;; it under the terms of the GNU Affero General Public License as
4;; published by the Free Software Foundation, either version 3 of the
5;; License, or (at your option) any later version.
6;;
7;; This program is distributed in the hope that it will be useful,
8;; but WITHOUT ANY WARRANTY; without even the implied warranty of
9;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
10;; GNU Affero General Public License for more details.
11;;
12;; You should have received a copy of the GNU Affero General Public License
13;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
14
15(ns oak.world
16  (:use
17   oak.remote-agent
18   oak.io)
19  (:import
20   java.util.ArrayList
21   java.net.InetSocketAddress
22   java.nio.channels.ServerSocketChannel
23   java.nio.channels.SocketChannel
24   java.io.File
25   javax.xml.parsers.SAXParser
26   javax.xml.parsers.SAXParserFactory
27   FAtiMA.autobiographicalMemory.AutobiographicalMemory
28   FAtiMA.deliberativeLayer.plan.Effect   
29   FAtiMA.deliberativeLayer.plan.Step
30   FAtiMA.sensorEffector.SpeechAct
31   FAtiMA.wellFormedNames.Name
32   FAtiMA.wellFormedNames.Substitution
33   FAtiMA.wellFormedNames.Symbol
34   FAtiMA.wellFormedNames.Unifier
35   FAtiMA.util.parsers.StripsOperatorsLoaderHandler
36   Language.LanguageEngine))
37 
38(defstruct world
39  :objects
40  :agents
41  :scenery
42  :actions
43  :agent-language
44  :server-socket
45  :time)
46
47(def world-objects (accessor world :objects))
48(def world-agents (accessor world :agents))
49(def world-scenery (accessor world :scenery))
50(def world-actions (accessor world :actions))
51(def world-agent-language (accessor world :agent-language))
52(def world-ssc (accessor world :server-socket))
53(def world-time (accessor world :time))
54
55(defn world-add-agent [world agent]
56  (merge world {:agents (cons agent (world-agents world))}))
57
58(defn load-operators [xml self]
59                (let [op (new StripsOperatorsLoaderHandler self)
60              parser (.newSAXParser (SAXParserFactory/newInstance))]
61          (.parse parser (new File xml) op)
62          op))
63
64(defn make-world [port agent-language-file actions-file objects]
65  (struct world
66          (load-objects objects)
67          []
68          "garden"
69          (.getOperators (load-operators actions-file, "[SELF]"))
70          (new LanguageEngine "name" "M" "Victim" (new File agent-language-file))
71          (let [ssc (ServerSocketChannel/open)]
72            (.configureBlocking ssc false)
73            (.bind (.socket ssc) (new InetSocketAddress port))
74            ssc)
75          0))
76
77; return in the format needed by FAtiMA: token:value token:value ...
78(defn hash-map-to-string [m]
79  (apply
80   str
81   (map
82    (fn [v]
83      (str (first v) ":" (second v) " "))
84    m)))
85
86; look through agents and objects and return the properties for the named thing
87(defn world-get-properties [world name]
88  (reduce
89   (fn [r agent]
90     (if (and (not r) (= (remote-agent-name agent) name))
91       (remote-agent-properties agent)
92       r))
93   (reduce
94    (fn [r object]
95      (if (and (not r) (= (get object "name") name))
96        object
97        r))
98    false
99    (world-objects world))
100   (world-agents world)))
101
102; send a message to all agents
103(defn world-broadcast-all [world msg]
104  (doseq [agent (world-agents world)]
105    (send-msg (remote-agent-socket agent) msg)))
106
107; send a message to all agents except caller
108(defn world-broadcast [world caller msg]
109  (doseq [agent (world-agents world)]
110    (when (not (= (remote-agent-name agent)
111                  (remote-agent-name caller)))
112      (send-msg (remote-agent-socket agent) msg))))
113
114; send a list of all agents and objects to this agent
115(defn world-perceive [world agent]
116  (send-msg (remote-agent-socket agent)
117               (apply str
118                      (concat
119                       (list "AGENTS")
120                       (map
121                        (fn [agent]
122                          (str " " (remote-agent-name agent)))
123                        (world-agents world))
124                       (map
125                        (fn [object]
126                          (str " " (get object "name")))
127                        (world-objects world))))))
128
129(defn world-get-object [world name pos]
130  (reduce
131   (fn [r obj]
132     (if (and (not r) (and (= name (get obj "name"))
133                           (= pos (get obj "position"))))
134       obj r))
135   false
136   (world-objects world)))
137
138(defn world-add-object [world object]
139  (if (not (world-get-object world (get object "name") (get object "position")))
140    (do
141      (println (str "adding " (get object "name") " " (get object "position")))
142      (world-broadcast-all world (str "ENTITY-ADDED " (get object "name")))
143      (merge world {:objects (cons object (world-objects world))}))
144    world))
145
146(defn list->commas [l]
147  (if (not (empty l))
148    (apply str
149           (concat
150            (first l)
151            (map (fn [t] (str "," t)) (rest l))))
152    ""))
153
154(defn convert-to-action-name [action]
155  (let [action (.split action " ")]
156    (Name/ParseName (apply str
157                           (concat
158                            (first action) "("
159                            (list->commas (rest action))
160                            (list ")"))))))
161
162(defn properties-changed [world agent effects]
163  (doseq [e effects]
164    (let [name (.toString (.getName (.GetEffect e)))]
165      (when (and (not (.startsWith name "EVENT"))
166                 (not (.startsWith name "SpeechContext"))
167                 (> (.GetProbability e)
168                    (.nextFloat (remote-agent-random agent))))
169        (world-broadcast world agent (str "PROPERTY-CHANGED " name
170                                    " " (.getValue (.GetEffect e))))))))
171
172(defn update-action-effects [world agent action]
173  (doseq [s (world-actions world)]
174    (let [bindings (new ArrayList)]
175      (.add bindings (new Substitution (new Symbol "[SELF]")
176                          (new Symbol (remote-agent-name agent))))
177      (.add bindings (new Substitution (new Symbol "[AGENT]")
178                          (new Symbol (remote-agent-name agent))))
179      (when (Unifier/Unify (.getName s) action bindings)
180        (let [gstep (.clone s)]
181          (.MakeGround s bindings)
182          (properties-changed world agent (.getEffects gstep)))))))
183   
184
185(defn world-process-agent [world agent msg]
186;  (println (str "world-process-agent got " msg))
187  (let [toks (.split msg " ")
188        type (nth toks 0)]
189    (cond
190     (.startsWith type "<EmotionalState") (merge agent {:emotions (parse-xml msg)})
191     (.startsWith type "<Relations") (merge agent {:relations (parse-xml msg)})
192     (.startsWith type "PROPERTY-CHANGED") agent
193     (= type "look-at")
194     (do
195       (send-msg (remote-agent-socket agent)
196                 (str "LOOK-AT " (nth toks 1) " "
197                      (hash-map-to-string
198                       (world-get-properties world (nth toks 1)))))
199       agent)
200     (= type "say")
201     (do (println "say")
202         (let [say (SpeechAct/ParseFromXml (.substring msg 3))]
203           (if say
204             (let [s (str
205                      (.getActionType say) "("
206                      (.getReceiver say) ","
207                      (.getMeaning say)
208                      (list->commas (.GetParameters say))
209                      ")")]
210               (update-action-effects world agent (Name/ParseName s))
211               (world-broadcast-all world (str "ACTION-FINISHED " (remote-agent-name agent)
212                                               " " msg))
213               (merge agent {:said (cons (str (world-time world)
214                                              ": "
215                                              (.getMeaning say) " to " (.getReceiver say))
216                                         (remote-agent-said agent))}))
217             agent)))
218   
219     (= type "UserSpeech") (do (println "user speech") agent)
220     :else
221     (do
222       (println "action")
223       (println msg)
224       (update-action-effects
225        world agent
226        (convert-to-action-name
227         (apply str
228                (concat type
229                        (if (not (empty (rest toks)))
230                          (list
231                           (second toks)
232                           (map (fn [s] (str s " ")) (rest (rest toks))))
233                          '())))))
234       (world-broadcast-all
235        world
236        (apply str (concat "ACTION-FINISHED " (remote-agent-name agent) " "
237                           (map (fn [s] (str s " ")) toks))))
238       (merge agent {:done (cons (str (world-time world) ": " msg)
239                                 (remote-agent-done agent))})))))
240
241(defn world-check-for-new-agents [world]
242  (let [chan (.accept (world-ssc world))]
243    (if chan
244      (try
245        (let [agent (make-remote-agent chan world)
246              w (world-add-agent world agent)
247              name (remote-agent-name agent)]
248          (println name "enters the" (world-scenery w))
249          (world-broadcast w agent (str "ENTITY-ADDED " name))
250          (world-perceive w agent)
251          w)
252        (catch Exception e (. e printStackTrace) world))
253    world)))
254
255(defn world-perceive-all [world]
256  (doseq [a (world-agents world)]
257    (world-perceive world a)))
258
259(defn world-update-agent [world agent]
260  (let [msgs (read-msg (remote-agent-reader agent))]
261    (if msgs
262      (reduce
263       (fn [agent msg]
264         (world-process-agent world agent msg))
265       agent
266       (.split msgs "\n")))))
267
268(defn world-update-agents [world]
269  (comment (println "updating: "
270          (map
271           (fn [agent] (remote-agent-name agent))
272           (world-agents world))))
273  (merge world
274         {:agents
275          (doall (map
276                  (fn [agent]
277                    (world-update-agent world agent))
278                  (world-agents world)))}))
279 
280(defn world-run [world]
281  (world-update-agents
282   (world-check-for-new-agents
283    (merge world {:time (+ (world-time world) 1)}))))
284                               
285(defn world-crank [world]
286  (Thread/sleep 1000)
287  (println (map (fn [a] (remote-agent-said a)) (world-agents world)))
288  (println (map (fn [a] (remote-agent-done a)) (world-agents world)))
289  ;(println (world-agents world))
290  (recur (world-run world)))
291
292(defn thing []
293  "<h1>ewewew!</h1>")
Note: See TracBrowser for help on using the repository browser.