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

Revision 437, 9.5 KB checked in by dave, 10 years ago (diff)

added germination x

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  (println "make-world")
66  (struct world
67          (load-objects objects)
68          []
69          "garden"
70          (.getOperators (load-operators actions-file, "[SELF]"))
71          (new LanguageEngine "name" "M" "Victim" (new File agent-language-file))
72          (let [ssc (ServerSocketChannel/open)]
73            (.configureBlocking ssc false)
74            (.bind (.socket ssc) (new InetSocketAddress port))
75            ssc)
76          0))
77
78; return in the format needed by FAtiMA: token:value token:value ...
79(defn hash-map-to-string [m]
80  (apply
81   str
82   (map
83    (fn [v]
84      (str (first v) ":" (second v) " "))
85    m)))
86
87; look through agents and objects and return the properties for the named thing
88(defn world-get-properties [world name]
89  (reduce
90   (fn [r agent]
91     (if (and (not r) (= (remote-agent-name agent) name))
92       (remote-agent-properties agent)
93       r))
94   (reduce
95    (fn [r object]
96      (if (and (not r) (= (get object "name") name))
97        object
98        r))
99    false
100    (world-objects world))
101   (world-agents world)))
102
103; send a message to all agents
104(defn world-broadcast-all [world msg]
105  (doseq [agent (world-agents world)]
106    (send-msg (remote-agent-socket agent) msg)))
107
108; send a message to all agents except caller
109(defn world-broadcast [world caller msg]
110  (doseq [agent (world-agents world)]
111    (when (not (= (remote-agent-name agent)
112                  (remote-agent-name caller)))
113      (send-msg (remote-agent-socket agent) msg))))
114
115; send a list of all agents and objects to this agent
116(defn world-perceive [world agent]
117  (send-msg (remote-agent-socket agent)
118               (apply str
119                      (concat
120                       (list "AGENTS")
121                       (map
122                        (fn [agent]
123                          (str " " (remote-agent-name agent)))
124                        (world-agents world))
125                       (map
126                        (fn [object]
127                          (str " " (get object "name")))
128                        (world-objects world))))))
129
130
131(defn world-add-object [world object]
132  (world-broadcast-all world (str "ENTITY-ADDED " (get object "name")))
133  (merge world {:objects (cons object (world-objects world))}))
134
135(defn list->commas [l]
136  (if (not (empty l))
137    (apply str
138           (concat
139            (first l)
140            (map (fn [t] (str "," t)) (rest l))))
141    ""))
142
143(defn convert-to-action-name [action]
144  (let [action (.split action " ")]
145    (Name/ParseName (apply str
146                           (concat
147                            (first action) "("
148                            (list->commas (rest action))
149                            (list ")"))))))
150
151(defn properties-changed [world agent effects]
152  (doseq [e effects]
153    (let [name (.toString (.getName (.GetEffect e)))]
154      (when (and (not (.startsWith name "EVENT"))
155                 (not (.startsWith name "SpeechContext"))
156                 (> (.GetProbability e)
157                    (.nextFloat (remote-agent-random agent))))
158        (world-broadcast world agent (str "PROPERTY-CHANGED " name
159                                    " " (.getValue (.GetEffect e))))))))
160
161(defn update-action-effects [world agent action]
162  (doseq [s (world-actions world)]
163    (let [bindings (new ArrayList)]
164      (.add bindings (new Substitution (new Symbol "[SELF]")
165                          (new Symbol (remote-agent-name agent))))
166      (.add bindings (new Substitution (new Symbol "[AGENT]")
167                          (new Symbol (remote-agent-name agent))))
168      (when (Unifier/Unify (.getName s) action bindings)
169        (let [gstep (.clone s)]
170          (.MakeGround s bindings)
171          (properties-changed world agent (.getEffects gstep)))))))
172   
173
174(defn world-process-agent [world agent msg]       
175  (let [toks (.split msg " ")
176        type (nth toks 0)]
177    (cond
178     (.startsWith type "<EmotionalState") (merge agent {:emotions (parse-xml msg)})
179     (.startsWith type "<Relations") (merge agent {:relations msg})
180     (.startsWith type "PROPERTY-CHANGED") agent
181     (= type "look-at")
182     (do
183       (send-msg (remote-agent-socket agent)
184                 (str "LOOK-AT " (nth toks 1) " "
185                      (hash-map-to-string
186                       (world-get-properties world (nth toks 1)))))
187       agent)
188     (= type "say")
189     (do (println "say")
190         (let [say (SpeechAct/ParseFromXml (.substring msg 3))]
191           (if say
192             (let [s (str
193                      (.getActionType say) "("
194                      (.getReceiver say) ","
195                      (.getMeaning say)
196                      (list->commas (.GetParameters say))
197                      ")")]
198               (update-action-effects world agent (Name/ParseName s))
199               (world-broadcast-all world (str "ACTION-FINISHED " (remote-agent-name agent)
200                                               " " msg))
201               (merge agent {:said (cons (str (world-time world)
202                                              ": "
203                                              (.getMeaning say) " to " (.getReceiver say))
204                                         (remote-agent-said agent))}))
205             agent)))
206   
207     (= type "UserSpeech") (do (println "user speech") agent)
208     :else
209     (do
210       (println "action")
211       (update-action-effects
212        world agent
213        (convert-to-action-name
214         (apply str
215                (concat type
216                        (if (not (empty (rest toks)))
217                          (list
218                           (second toks)
219                           (map (fn [s] (str s " ")) (rest (rest toks))))
220                          '())))))
221        (world-broadcast-all
222         world
223         (apply str (concat "ACTION-FINISHED " (remote-agent-name agent)
224                            (map (fn [s] (str s " ")) (rest toks)))))
225        (merge agent {:done (cons (str (world-time world) ": " msg)
226                                  (remote-agent-done agent))})))))
227
228(defn world-check-for-new-agents [world]
229  (let [chan (.accept (world-ssc world))]
230    (if chan
231      (try
232        (let [agent (make-remote-agent chan world)
233              w (world-add-agent world agent)
234              name (remote-agent-name agent)]
235          (println name "enters the" (world-scenery w))
236          (world-broadcast w agent (str "ENTITY-ADDED " name))
237          (world-perceive w agent)
238          w)
239        (catch Exception e (. e printStackTrace) world))
240    world)))
241
242(defn world-perceive-all [world]
243  (doseq [a (world-agents world)]
244    (world-perceive world a)))
245
246(defn world-update-agent [world agent]
247  (let [msgs (read-msg (remote-agent-socket agent))]
248    (if msgs
249      (reduce
250       (fn [agent msg]
251         (world-process-agent world agent msg))
252       agent
253       (.split msgs "\n")))))
254
255(defn world-update-agents [world]
256  (println "updating: "
257          (map
258           (fn [agent] (remote-agent-name agent))
259           (world-agents world)))
260  (merge world
261         {:agents
262          (map
263           (fn [agent]
264             (world-update-agent world agent))
265           (world-agents world))}))
266 
267(defn world-run [world]
268  (world-update-agents
269   (world-check-for-new-agents
270    (merge world {:time (+ (world-time world) 1)}))))
271                               
272(defn world-crank [world]
273  (Thread/sleep 1000)
274  (println (map (fn [a] (remote-agent-said a)) (world-agents world)))
275  (println (map (fn [a] (remote-agent-done a)) (world-agents world)))
276  ;(println (world-agents world))
277  (recur (world-run world)))
278
279(defn thing []
280  "<h1>ewewew!</h1>")
Note: See TracBrowser for help on using the repository browser.