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

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

fatima integration

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) (= pos (get obj "position")))
133       obj r))
134   false
135   (world-objects world)))
136
137(defn world-add-object [world object]
138  (if (not (world-get-object world (get object "name") (get object "position")))
139    (do
140      (println (str "adding " (get object "name") " " (get object "position")))
141      (world-broadcast-all world (str "ENTITY-ADDED " (get object "name")))
142      (merge world {:objects (cons object (world-objects world))}))
143    world))
144
145(defn list->commas [l]
146  (if (not (empty l))
147    (apply str
148           (concat
149            (first l)
150            (map (fn [t] (str "," t)) (rest l))))
151    ""))
152
153(defn convert-to-action-name [action]
154  (let [action (.split action " ")]
155    (Name/ParseName (apply str
156                           (concat
157                            (first action) "("
158                            (list->commas (rest action))
159                            (list ")"))))))
160
161(defn properties-changed [world agent effects]
162  (doseq [e effects]
163    (let [name (.toString (.getName (.GetEffect e)))]
164      (when (and (not (.startsWith name "EVENT"))
165                 (not (.startsWith name "SpeechContext"))
166                 (> (.GetProbability e)
167                    (.nextFloat (remote-agent-random agent))))
168        (world-broadcast world agent (str "PROPERTY-CHANGED " name
169                                    " " (.getValue (.GetEffect e))))))))
170
171(defn update-action-effects [world agent action]
172  (doseq [s (world-actions world)]
173    (let [bindings (new ArrayList)]
174      (.add bindings (new Substitution (new Symbol "[SELF]")
175                          (new Symbol (remote-agent-name agent))))
176      (.add bindings (new Substitution (new Symbol "[AGENT]")
177                          (new Symbol (remote-agent-name agent))))
178      (when (Unifier/Unify (.getName s) action bindings)
179        (let [gstep (.clone s)]
180          (.MakeGround s bindings)
181          (properties-changed world agent (.getEffects gstep)))))))
182   
183
184(defn world-process-agent [world agent msg]
185;  (println (str "world-process-agent got " msg))
186  (let [toks (.split msg " ")
187        type (nth toks 0)]
188    (cond
189     (.startsWith type "<EmotionalState") (merge agent {:emotions (parse-xml msg)})
190     (.startsWith type "<Relations") (merge agent {:relations (parse-xml msg)})
191     (.startsWith type "PROPERTY-CHANGED") agent
192     (= type "look-at")
193     (do
194       (send-msg (remote-agent-socket agent)
195                 (str "LOOK-AT " (nth toks 1) " "
196                      (hash-map-to-string
197                       (world-get-properties world (nth toks 1)))))
198       agent)
199     (= type "say")
200     (do (println "say")
201         (let [say (SpeechAct/ParseFromXml (.substring msg 3))]
202           (if say
203             (let [s (str
204                      (.getActionType say) "("
205                      (.getReceiver say) ","
206                      (.getMeaning say)
207                      (list->commas (.GetParameters say))
208                      ")")]
209               (update-action-effects world agent (Name/ParseName s))
210               (world-broadcast-all world (str "ACTION-FINISHED " (remote-agent-name agent)
211                                               " " msg))
212               (merge agent {:said (cons (str (world-time world)
213                                              ": "
214                                              (.getMeaning say) " to " (.getReceiver say))
215                                         (remote-agent-said agent))}))
216             agent)))
217   
218     (= type "UserSpeech") (do (println "user speech") agent)
219     :else
220     (do
221       (println "action")
222       (println msg)
223       (update-action-effects
224        world agent
225        (convert-to-action-name
226         (apply str
227                (concat type
228                        (if (not (empty (rest toks)))
229                          (list
230                           (second toks)
231                           (map (fn [s] (str s " ")) (rest (rest toks))))
232                          '())))))
233       (world-broadcast-all
234        world
235        (apply str (concat "ACTION-FINISHED " (remote-agent-name agent) " "
236                           (map (fn [s] (str s " ")) toks))))
237       (merge agent {:done (cons (str (world-time world) ": " msg)
238                                 (remote-agent-done agent))})))))
239
240(defn world-check-for-new-agents [world]
241  (let [chan (.accept (world-ssc world))]
242    (if chan
243      (try
244        (let [agent (make-remote-agent chan world)
245              w (world-add-agent world agent)
246              name (remote-agent-name agent)]
247          (println name "enters the" (world-scenery w))
248          (world-broadcast w agent (str "ENTITY-ADDED " name))
249          (world-perceive w agent)
250          w)
251        (catch Exception e (. e printStackTrace) world))
252    world)))
253
254(defn world-perceive-all [world]
255  (doseq [a (world-agents world)]
256    (world-perceive world a)))
257
258(defn world-update-agent [world agent]
259  (let [msgs (read-msg (remote-agent-reader agent))]
260    (if msgs
261      (reduce
262       (fn [agent msg]
263         (world-process-agent world agent msg))
264       agent
265       (.split msgs "\n")))))
266
267(defn world-update-agents [world]
268  (comment (println "updating: "
269          (map
270           (fn [agent] (remote-agent-name agent))
271           (world-agents world))))
272  (merge world
273         {:agents
274          (doall (map
275                  (fn [agent]
276                    (world-update-agent world agent))
277                  (world-agents world)))}))
278 
279(defn world-run [world]
280  (world-update-agents
281   (world-check-for-new-agents
282    (merge world {:time (+ (world-time world) 1)}))))
283                               
284(defn world-crank [world]
285  (Thread/sleep 1000)
286  (println (map (fn [a] (remote-agent-said a)) (world-agents world)))
287  (println (map (fn [a] (remote-agent-done a)) (world-agents world)))
288  ;(println (world-agents world))
289  (recur (world-run world)))
290
291(defn thing []
292  "<h1>ewewew!</h1>")
Note: See TracBrowser for help on using the repository browser.