#+title: First attempt at a creature!

 #+author: Robert McIntyre

 #+email: rlm@mit.edu

 #+description: 

 #+keywords: simulation, jMonkeyEngine3, clojure

 #+SETUPFILE: ../../aurellem/org/setup.org

 #+INCLUDE: ../../aurellem/org/level-0.org

 

 * ideas

  - [ ] directly change the UV-pixels to show sensor activation

  - [ ] write an explination for why greyscale bitmaps for senses is appropiate

  - [ ] write tests for integration

  - [ ] usertime/gametime HUD display

  - [ ] use sawfish to auto-tile sense windows

  - [ ] sawfish keybinding to automatically delete all sense windows

  - [ ] proprioception sensor map in the style of the other senses

  - [ ] optional fourier view of sound

  - [ ] enable greyscale bitmaps for touch

 

 

 * Intro 

 So far, I've made the following senses -- 

  - Vision

  - Hearing

  - Touch

  - Proprioception

 

 And one effector: 

  - Movement

 

 However, the code so far has only enabled these senses, but has not

 actually implemented them.  For example, there is still a lot of work

 to be done for vision. I need to be able to create an /eyeball/ in

 simulation that can be moved around and see the world from different

 angles. I also need to determine weather to use log-polar or cartesian

 for the visual input, and I need to determine how/wether to

 disceritise the visual input.

 

 I also want to be able to visualize both the sensors and the

 effectors in pretty pictures. This semi-retarted creature will be my

 first attempt at bringing everything together.

 

 * The creature's body

 

 Still going to do an eve-like body in blender, but due to problems

 importing the joints, etc into jMonkeyEngine3, I'm going to do all

 the connecting here in clojure code, using the names of the individual

 components and trial and error. Later, I'll maybe make some sort of

 creature-building modifications to blender that support whatever

 discreitized senses I'm going to make.

 

 #+name: body-1

 #+begin_src clojure 

 (ns cortex.silly

   "let's play!"

   {:author "Robert McIntyre"})

 

 ;; TODO remove this!

 (require 'cortex.import)

 (cortex.import/mega-import-jme3)

 (use '(cortex world util body hearing touch vision))

 

 (rlm.rlm-commands/help)

 (import java.awt.image.BufferedImage)

 (import javax.swing.JPanel)

 (import javax.swing.SwingUtilities)

 (import java.awt.Dimension)

 (import javax.swing.JFrame)

 (import java.awt.Dimension)

 (import com.aurellem.capture.RatchetTimer)

 (declare joint-create)

 (use 'clojure.contrib.def)

 

 (defn points->image

   "Take a sparse collection of points and visuliaze it as a

    BufferedImage."

 

   ;; TODO maybe parallelize this since it's easy

 

   [points]

   (if (empty? points)

     (BufferedImage. 1 1 BufferedImage/TYPE_BYTE_BINARY)

     (let [xs (vec (map first points))

           ys (vec (map second points))

           x0 (apply min xs)

           y0 (apply min ys)

           width (- (apply max xs) x0)

           height (- (apply max ys) y0)

           image (BufferedImage. (inc width) (inc height)

                                 BufferedImage/TYPE_INT_RGB)]

       (dorun

        (for [x (range (.getWidth image))

              y (range (.getHeight image))]

          (.setRGB image x y 0xFF0000)))

       (dorun 

        (for [index (range (count points))]

          (.setRGB image (- (xs index) x0) (- (ys index) y0) -1)))

       

       image)))

 

 (defn average [coll]

   (/ (reduce + coll) (count coll)))

 

 (defn collapse-1d

   "One dimensional analogue of collapse"

   [center line]

   (let [length (count line)

         num-above (count (filter (partial < center) line))

         num-below (- length num-above)]

     (range (- center num-below)

            (+ center num-above))))

 

 (defn collapse

   "Take a set of pairs of integers and collapse them into a

    contigous bitmap."

   [points]

   (if (empty? points) []

       (let

           [num-points (count points)

            center (vector

                    (int (average (map first points)))

                    (int (average (map first points))))

            flattened

            (reduce

             concat 

             (map

              (fn [column]

                (map vector

                     (map first column)

                     (collapse-1d (second center)

                                  (map second column))))

              (partition-by first (sort-by first points))))

            squeezed

            (reduce

             concat 

             (map

              (fn [row]

                (map vector

                     (collapse-1d (first center)

                                  (map first row))

                     (map second row)))

              (partition-by second (sort-by second flattened))))

            relocate

            (let [min-x (apply min (map first squeezed))

                  min-y (apply min (map second squeezed))]

              (map (fn [[x y]]

                     [(- x min-x)

                      (- y min-y)])

                   squeezed))]

         relocate)))

 

 (defn load-bullet []

   (let [sim (world (Node.) {} no-op no-op)]

     (doto sim

       (.enqueue

        (fn []

          (.stop sim)))

       (.start))))

 

 (defn load-blender-model

   "Load a .blend file using an asset folder relative path."

   [^String model]

   (.loadModel

    (doto (asset-manager)

      (.registerLoader BlenderModelLoader (into-array String ["blend"])))

    model))

 

 (defn meta-data [blender-node key]

   (if-let [data (.getUserData blender-node "properties")]

     (.findValue data key)

     nil))

 

 (defn blender-to-jme

   "Convert from Blender coordinates to JME coordinates"

   [#^Vector3f in]

   (Vector3f. (.getX in)

              (.getZ in)

              (- (.getY in))))

 

 (defn jme-to-blender

   "Convert from JME coordinates to Blender coordinates"

   [#^Vector3f in]

   (Vector3f. (.getX in)

              (- (.getZ in))

              (.getY in)))

 

 (defn joint-targets

   "Return the two closest two objects to the joint object, ordered

   from bottom to top according to the joint's rotation."

   [#^Node parts #^Node joint]

   (loop [radius (float 0.01)]

     (let [results (CollisionResults.)]

       (.collideWith

        parts

        (BoundingBox. (.getWorldTranslation joint)

                      radius radius radius)

        results)

       (let [targets

             (distinct

              (map  #(.getGeometry %) results))]

         (if (>= (count targets) 2)

           (sort-by

            #(let [v

                   (jme-to-blender

                    (.mult

                     (.inverse (.getWorldRotation joint))

                     (.subtract (.getWorldTranslation %)

                                (.getWorldTranslation joint))))]

               (println-repl (.getName %) ":" v)

               (.dot (Vector3f. 1 1 1)

                     v))                  

            (take 2 targets))

           (recur (float (* radius 2))))))))

 

 (defn world-to-local

    "Convert the world coordinates into coordinates relative to the 

    object (i.e. local coordinates), taking into account the rotation

    of object."

    [#^Spatial object world-coordinate]

    (let [out (Vector3f.)]

      (.worldToLocal object world-coordinate out) out))

 

 (defn local-to-world

    "Convert the local coordinates into coordinates into world relative

     coordinates" 

    [#^Spatial object local-coordinate]

    (let [world-coordinate (Vector3f.)]

      (.localToWorld object local-coordinate world-coordinate)

      world-coordinate))

 

 (defmulti joint-dispatch

   "Translate blender pseudo-joints into real JME joints."

   (fn [constraints & _] 

     (:type constraints)))

 

 (defmethod joint-dispatch :point

   [constraints control-a control-b pivot-a pivot-b rotation]

   (println-repl "creating POINT2POINT joint")

   (Point2PointJoint.

    control-a

    control-b

    pivot-a

    pivot-b))

 

 (defmethod joint-dispatch :hinge

   [constraints control-a control-b pivot-a pivot-b rotation]

   (println-repl "creating HINGE joint")

   (let [axis

         (if-let

             [axis (:axis constraints)]

           axis

           Vector3f/UNIT_X)

         [limit-1 limit-2] (:limit constraints)

         hinge-axis

         (.mult

          rotation

          (blender-to-jme axis))]

     (doto

         (HingeJoint.

          control-a

          control-b

          pivot-a

          pivot-b

          hinge-axis

          hinge-axis)

       (.setLimit limit-1 limit-2))))

 

 (defmethod joint-dispatch :cone

   [constraints control-a control-b pivot-a pivot-b rotation]

   (let [limit-xz (:limit-xz constraints)

         limit-xy (:limit-xy constraints)

         twist    (:twist constraints)]

     

     (println-repl "creating CONE joint")

     (println-repl rotation)

     (println-repl

      "UNIT_X --> " (.mult rotation (Vector3f. 1 0 0)))

     (println-repl

      "UNIT_Y --> " (.mult rotation (Vector3f. 0 1 0)))

     (println-repl

      "UNIT_Z --> " (.mult rotation (Vector3f. 0 0 1)))

     (doto

         (ConeJoint.

          control-a

          control-b

          pivot-a

          pivot-b

          rotation

          rotation)

       (.setLimit (float limit-xz)

                  (float limit-xy)

                  (float twist)))))

 

 (defn connect

   "here are some examples:

    {:type :point}

    {:type :hinge  :limit [0 (/ Math/PI 2)] :axis (Vector3f. 0 1 0)}

    (:axis defaults to (Vector3f. 1 0 0) if not provided for hinge joints)

 

    {:type :cone :limit-xz 0]

                 :limit-xy 0]

                 :twist 0]}   (use XZY rotation mode in blender!)"

   [#^Node obj-a #^Node obj-b #^Node joint]

   (let [control-a (.getControl obj-a RigidBodyControl)

         control-b (.getControl obj-b RigidBodyControl)

         joint-center (.getWorldTranslation joint)

         joint-rotation (.toRotationMatrix (.getWorldRotation joint))

         pivot-a (world-to-local obj-a joint-center)

         pivot-b (world-to-local obj-b joint-center)]

    

     (if-let [constraints

              (map-vals

               eval

               (read-string

                (meta-data joint "joint")))]

       ;; A side-effect of creating a joint registers

       ;; it with both physics objects which in turn

       ;; will register the joint with the physics system

       ;; when the simulation is started.

       (do

         (println-repl "creating joint between"

                       (.getName obj-a) "and" (.getName obj-b))

         (joint-dispatch constraints

                         control-a control-b

                         pivot-a pivot-b

                         joint-rotation))

       (println-repl "could not find joint meta-data!"))))

 

 (defn assemble-creature [#^Node pieces joints]

   (dorun

    (map

     (fn [geom]

       (let [physics-control

             (RigidBodyControl.

              (HullCollisionShape.

               (.getMesh geom))

              (if-let [mass (meta-data geom "mass")]

                (do

                  (println-repl

                   "setting" (.getName geom) "mass to" (float mass))

                  (float mass))

                (float 1)))]

                

         (.addControl geom physics-control)))

     (filter #(isa? (class %) Geometry )

             (node-seq pieces))))

   (dorun

    (map

     (fn [joint]

       (let [[obj-a obj-b]

             (joint-targets pieces joint)]

         (connect obj-a obj-b joint)))

     joints))

   pieces)

 

 (declare blender-creature)

 

 (def hand "Models/creature1/one.blend")

 

 (def worm "Models/creature1/try-again.blend")

 

 (def touch "Models/creature1/touch.blend")

 

 (defn worm-model [] (load-blender-model worm))

 

 (defn x-ray [#^ColorRGBA color]

   (doto (Material. (asset-manager)

                    "Common/MatDefs/Misc/Unshaded.j3md")

     (.setColor "Color" color)

     (-> (.getAdditionalRenderState)

         (.setDepthTest false))))

 

 (defn colorful []

   (.getChild (worm-model) "worm-21"))

 

 (import jme3tools.converters.ImageToAwt)

 

 (import ij.ImagePlus)

 

 ;; Every Mesh has many triangles, each with its own index.

 ;; Every vertex has its own index as well.

 

 (defn tactile-sensor-image

   "Return the touch-sensor distribution image in BufferedImage format,

    or nil if it does not exist."

   [#^Geometry obj]

   (if-let [image-path (meta-data obj "touch")]

     (ImageToAwt/convert

      (.getImage

       (.loadTexture

        (asset-manager)

        image-path))

     false false 0)))

      

 (import ij.process.ImageProcessor)

 (import java.awt.image.BufferedImage)

 

 (def white -1)

   

 (defn filter-pixels

   "List the coordinates of all pixels matching pred, within the bounds

    provided. Bounds -> [x0 y0 width height]"

   {:author "Dylan Holmes"}

   ([pred #^BufferedImage image]

      (filter-pixels pred image [0 0 (.getWidth image) (.getHeight image)]))

   ([pred #^BufferedImage image [x0 y0 width height]]

      ((fn accumulate [x y matches]

         (cond

          (>= y (+ height y0)) matches

          (>= x (+ width x0)) (recur 0 (inc y) matches)

          (pred (.getRGB image x y))

          (recur (inc x) y (conj matches [x y]))

          :else (recur (inc x) y matches)))

       x0 y0 [])))

 

 (defn white-coordinates

   "Coordinates of all the white pixels in a subset of the image."

   ([#^BufferedImage image bounds]

      (filter-pixels #(= % white) image bounds))

   ([#^BufferedImage image]

      (filter-pixels #(= % white) image)))

 

 (defn triangle

   "Get the triangle specified by triangle-index from the mesh within

   bounds."

   [#^Mesh mesh triangle-index]

   (let [scratch (Triangle.)]

     (.getTriangle mesh triangle-index scratch)

     scratch))

 

 (defn triangle-vertex-indices

   "Get the triangle vertex indices of a given triangle from a given

    mesh."

   [#^Mesh mesh triangle-index]

   (let [indices (int-array 3)]

     (.getTriangle mesh triangle-index indices)

     (vec indices)))

 

 (defn vertex-UV-coord

   "Get the uv-coordinates of the vertex named by vertex-index"

   [#^Mesh mesh vertex-index]

   (let [UV-buffer

         (.getData

          (.getBuffer

           mesh

           VertexBuffer$Type/TexCoord))]

     [(.get UV-buffer (* vertex-index 2))

      (.get UV-buffer (+ 1 (* vertex-index 2)))]))

 

 (defn triangle-UV-coord

   "Get the uv-cooridnates of the triangle's verticies."

   [#^Mesh mesh width height triangle-index]

   (map (fn [[u v]] (vector (* width u) (* height v)))

        (map (partial vertex-UV-coord mesh)

             (triangle-vertex-indices mesh triangle-index))))

   

 (defn same-side?

   "Given the points p1 and p2 and the reference point ref, is point p

   on the same side of the line that goes through p1 and p2 as ref is?" 

   [p1 p2 ref p]

   (<=

    0

    (.dot 

     (.cross (.subtract p2 p1) (.subtract p p1))

     (.cross (.subtract p2 p1) (.subtract ref p1)))))

 

 (defn triangle-seq [#^Triangle tri]

   [(.get1 tri) (.get2 tri) (.get3 tri)])

 

 (defn vector3f-seq [#^Vector3f v]

   [(.getX v) (.getY v) (.getZ v)])

 

 (defn inside-triangle?

   "Is the point inside the triangle?"

   {:author "Dylan Holmes"}

   [#^Triangle tri #^Vector3f p]

   (let [[vert-1 vert-2 vert-3] (triangle-seq tri)]

     (and

      (same-side? vert-1 vert-2 vert-3 p)

      (same-side? vert-2 vert-3 vert-1 p)

      (same-side? vert-3 vert-1 vert-2 p))))

 

 (defn triangle->matrix4f

   "Converts the triangle into a 4x4 matrix: The first three columns

    contain the vertices of the triangle; the last contains the unit

    normal of the triangle. The bottom row is filled with 1s."

   [#^Triangle t]

   (let [mat (Matrix4f.)

         [vert-1 vert-2 vert-3]

         ((comp vec map) #(.get t %) (range 3))

         unit-normal (do (.calculateNormal t)(.getNormal t))

         vertices [vert-1 vert-2 vert-3 unit-normal]]

     (dorun 

      (for [row (range 4) col (range 3)]

        (do

          (.set mat col row (.get (vertices row)col))

          (.set mat 3 row 1))))

     mat))

 

 (defn triangle-transformation

   "Returns the affine transformation that converts each vertex in the

    first triangle into the corresponding vertex in the second

    triangle."

   [#^Triangle tri-1 #^Triangle tri-2]

   (.mult 

    (triangle->matrix4f tri-2)

    (.invert (triangle->matrix4f tri-1))))

 

 (defn point->vector2f [[u v]]

   (Vector2f. u v))

 

 (defn vector2f->vector3f [v]

   (Vector3f. (.getX v) (.getY v) 0))

 

 (defn map-triangle [f #^Triangle tri]

   (Triangle.

    (f 0 (.get1 tri))

    (f 1 (.get2 tri))

    (f 2 (.get3 tri))))

 

 (defn points->triangle

   "Convert a list of points into a triangle."

   [points]

   (apply #(Triangle. %1 %2 %3)

          (map (fn [point]

                 (let [point (vec point)]

                   (Vector3f. (get point 0 0)

                              (get point 1 0)

                              (get point 2 0))))

               (take 3 points))))

 

 (defn convex-bounds

   "Dimensions of the smallest integer bounding square of the list of

    2D verticies in the form: [x y width height]."

   [uv-verts]

   (let [xs (map first uv-verts)

         ys (map second uv-verts)

         x0 (Math/floor (apply min xs))

         y0 (Math/floor (apply min ys))

         x1 (Math/ceil (apply max xs))

         y1 (Math/ceil (apply max ys))]

     [x0 y0 (- x1 x0) (- y1 y0)]))

 

 (defn sensors-in-triangle

   "Find the locations of the touch sensors within a triangle in both

    UV and gemoetry relative coordinates."

   [image mesh tri-index]

   (let [width (.getWidth image)

         height (.getHeight image)

         UV-vertex-coords (triangle-UV-coord mesh width height tri-index)

         bounds (convex-bounds UV-vertex-coords)

         

         cutout-triangle (points->triangle UV-vertex-coords)

         UV-sensor-coords

         (filter (comp (partial inside-triangle? cutout-triangle)

                       (fn [[u v]] (Vector3f. u v 0)))

                 (white-coordinates image bounds))

         UV->geometry (triangle-transformation

                       cutout-triangle

                       (triangle mesh tri-index))

         geometry-sensor-coords

         (map (fn [[u v]] (.mult UV->geometry (Vector3f. u v 0)))

              UV-sensor-coords)]

   {:UV UV-sensor-coords :geometry geometry-sensor-coords}))

 

 (defn-memo locate-feelers

   "Search the geometry's tactile UV image for touch sensors, returning

   their positions in geometry-relative coordinates."

   [#^Geometry geo]

   (let [mesh (.getMesh geo)

         num-triangles (.getTriangleCount mesh)]

     (if-let [image (tactile-sensor-image geo)]

       (map

        (partial sensors-in-triangle image mesh)

        (range num-triangles))

       (repeat (.getTriangleCount mesh) {:UV nil :geometry nil}))))

 

 (use 'clojure.contrib.def)

 

 (defn-memo touch-topology [#^Gemoetry geo]

   (vec (collapse (reduce concat (map :UV (locate-feelers geo))))))

 

 (defn-memo feeler-coordinates [#^Geometry geo]

   (vec (map :geometry (locate-feelers geo))))

 

 (defn enable-touch [#^Geometry geo]

   (let [feeler-coords (feeler-coordinates geo)

         tris (triangles geo)

         limit 0.1

         ;;results (CollisionResults.)

         ]

     (if (empty? (touch-topology geo))

       nil

       (fn [node]

         (let [sensor-origins 

               (map

                #(map (partial local-to-world geo) %)

                feeler-coords)

               triangle-normals 

               (map (partial get-ray-direction geo)

                    tris)

               rays

               (flatten

                (map (fn [origins norm]

                       (map #(doto (Ray. % norm)

                               (.setLimit limit)) origins))

                     sensor-origins triangle-normals))]

           (vector

            (touch-topology geo)

            (vec

             (for [ray rays]

               (do

                 (let [results (CollisionResults.)]

                   (.collideWith node ray results)

                   (let [touch-objects

                         (set

                          (filter #(not (= geo %))

                                  (map #(.getGeometry %) results)))]

                     (if (> (count touch-objects) 0)

                       1 0))))))))))))

   

 (defn touch [#^Node pieces]

   (filter (comp not nil?)

           (map enable-touch

                (filter #(isa? (class %) Geometry)

                        (node-seq pieces)))))

 

 

 ;; human eye transmits 62kb/s to brain Bandwidth is 8.75 Mb/s

 ;; http://en.wikipedia.org/wiki/Retina

 

 (defn test-eye  []

   (.getChild 

    (.getChild (worm-model) "eyes")

    "eye"))

 

 

 (defn retina-sensor-image

   "Return a map of pixel selection functions to BufferedImages

    describing the distribution of light-sensitive components on this

    geometry's surface. Each function creates an integer from the rgb

    values found in the pixel. :red, :green, :blue, :gray are already

    defined as extracting the red green blue and average components

    respectively."

    [#^Spatial eye]

    (if-let [eye-map (meta-data eye "eye")]

      (map-vals

       #(ImageToAwt/convert

         (.getImage (.loadTexture (asset-manager) %))

         false false 0)

       (eval (read-string eye-map)))))

 

 (defn eye-dimensions

   "returns the width and height specified in the metadata of the eye"

   [#^Spatial eye]

   (let [dimensions

           (map #(vector (.getWidth %) (.getHeight %))

                (vals (retina-sensor-image eye)))]

     [(apply max (map first dimensions))

      (apply max (map second dimensions))]))

 

 (defn creature-eyes

   "The eye nodes which are children of the \"eyes\" node in the

   creature."

   [#^Node creature]

   (if-let [eye-node (.getChild creature "eyes")]

     (seq (.getChildren eye-node))

     (do (println-repl "could not find eyes node") [])))

 

 ;; Here's how vision will work.

 

 ;; Make the continuation in scene-processor take FrameBuffer,

 ;; byte-buffer, BufferedImage already sized to the correct

 ;; dimensions. the continuation will decide wether to "mix" them

 ;; into the BufferedImage, lazily ignore them, or mix them halfway

 ;; and call c/graphics card routines.

 

 ;; (vision creature) will take an optional :skip argument which will

 ;; inform the continuations in scene processor to skip the given

 ;; number of cycles; 0 means that no cycles will be skipped.

 

 ;; (vision creature) will return [init-functions sensor-functions].

 ;; The init-functions are each single-arg functions that take the

 ;; world and register the cameras and must each be called before the

 ;; corresponding sensor-functions.  Each init-function returns the

 ;; viewport for that eye which can be manipulated, saved, etc. Each

 ;; sensor-function is a thunk and will return data in the same

 ;; format as the tactile-sensor functions; the structure is

 ;; [topology, sensor-data]. Internally, these sensor-functions

 ;; maintain a reference to sensor-data which is periodically updated

 ;; by the continuation function established by its init-function.

 ;; They can be queried every cycle, but their information may not

 ;; necessairly be different every cycle.

 

 ;; Each eye in the creature in blender will work the same way as

 ;; joints -- a zero dimensional object with no geometry whose local

 ;; coordinate system determines the orientation of the resulting

 ;; eye. All eyes will have a parent named "eyes" just as all joints

 ;; have a parent named "joints". The resulting camera will be a

 ;; ChaseCamera or a CameraNode bound to the geo that is closest to

 ;; the eye marker. The eye marker will contain the metadata for the

 ;; eye, and will be moved by it's bound geometry. The dimensions of

 ;; the eye's camera are equal to the dimensions of the eye's "UV"

 ;; map.

 

 

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

 ;; Ears work the same way as vision.

 

 ;; (hearing creature) will return [init-functions

 ;; sensor-functions]. The init functions each take the world and

 ;; register a SoundProcessor that does foureier transforms on the

 ;; incommong sound data, making it available to each sensor function.

 

 (defn creature-ears

   "The ear nodes which are children of the \"ears\" node in the

   creature."

   [#^Node creature]

   (if-let [ear-node (.getChild creature "ears")]

     (seq (.getChildren ear-node))

     (do (println-repl "could not find ears node") [])))

 

 (defn closest-node

   "The closest object in creature to the given node."

   [#^Node creature #^Node eye]

   (loop [radius (float 0.01)]

     (let [results (CollisionResults.)]

       (.collideWith

        creature

        (BoundingBox. (.getWorldTranslation eye)

                      radius radius radius)

        results)

       (if-let [target (first results)]

         (.getGeometry target)

         (recur (float (* 2 radius)))))))

 

 (defn bind-sense

   "Bind the sense to the Spatial such that it will maintain its

    current position relative to the Spatial no matter how the spatial

    moves. 'sense can be either a Camera or Listener object."

   [#^Spatial obj sense]

   (let [sense-offset (.subtract (.getLocation sense)

                                 (.getWorldTranslation obj))

         initial-sense-rotation (Quaternion. (.getRotation sense))

         base-anti-rotation (.inverse (.getWorldRotation obj))]

     (.addControl

      obj

      (proxy [AbstractControl] []

        (controlUpdate [tpf]

          (let [total-rotation

                (.mult base-anti-rotation (.getWorldRotation obj))]

            (.setLocation sense

                          (.add

                           (.mult total-rotation sense-offset)

                           (.getWorldTranslation obj)))

            (.setRotation sense

                          (.mult total-rotation initial-sense-rotation))))

        (controlRender [_ _])))))

 

 

 (defn update-listener-velocity

   "Update the listener's velocity every update loop."

   [#^Spatial obj #^Listener lis]

   (let [old-position (atom (.getLocation lis))]

     (.addControl

      obj

      (proxy [AbstractControl] []

        (controlUpdate [tpf]

          (let [new-position (.getLocation lis)]

            (.setVelocity

             lis 

             (.mult (.subtract new-position @old-position)

                    (float (/ tpf))))

            (reset! old-position new-position)))

        (controlRender [_ _])))))

 

 (import com.aurellem.capture.audio.AudioSendRenderer)

 

 (defn attach-ear

   [#^Application world #^Node creature #^Spatial ear continuation]

   (let [target (closest-node creature ear)

         lis (Listener.)

         audio-renderer (.getAudioRenderer world)

         sp (sound-processor continuation)]

     (.setLocation lis (.getWorldTranslation ear))

     (.setRotation lis (.getWorldRotation ear))

     (bind-sense target lis)

     (update-listener-velocity target lis)

     (.addListener audio-renderer lis)

     (.registerSoundProcessor audio-renderer lis sp)))

 

 (defn enable-hearing

   [#^Node creature #^Spatial ear]

   (let [hearing-data (atom [])]

     [(fn [world]

        (attach-ear world creature ear

                    (fn [data]

                      (reset! hearing-data (vec data)))))

      [(fn []

         (let [data @hearing-data

               topology              

               (vec (map #(vector % 0) (range 0 (count data))))

               scaled-data

               (vec

                (map

                 #(rem (int (* 255 (/ (+ 1 %) 2)))  256)

                    data))]

           [topology scaled-data]))

         ]]))

 

 (defn hearing

   [#^Node creature]

   (reduce

    (fn [[init-a senses-a]

         [init-b senses-b]]

      [(conj init-a init-b)

       (into senses-a senses-b)])

    [[][]]      

    (for [ear (creature-ears creature)]

      (enable-hearing creature ear))))

 

 (defn attach-eye

   "Attach a Camera to the appropiate area and return the Camera."

   [#^Node creature #^Spatial eye]

   (let [target (closest-node creature eye)

         [cam-width cam-height] (eye-dimensions eye)

         cam (Camera. cam-width cam-height)]

     (.setLocation cam (.getWorldTranslation eye))

     (.setRotation cam (.getWorldRotation eye))

     (.setFrustumPerspective

      cam 45 (/ (.getWidth cam) (.getHeight cam))

      1 1000)

     (bind-sense target cam)

     cam))

 

 (def presets

   {:all    0xFFFFFF

    :red    0xFF0000

    :blue   0x0000FF

    :green  0x00FF00})

 

 (defn enable-vision

   "return [init-function sensor-functions] for a particular eye"

   [#^Node creature #^Spatial eye & {skip :skip :or {skip 0}}]

   (let [retinal-map (retina-sensor-image eye)

         camera (attach-eye creature eye)

         vision-image

         (atom

          (BufferedImage. (.getWidth camera)

                          (.getHeight camera)

                          BufferedImage/TYPE_BYTE_BINARY))]

     [(fn [world]

        (add-eye

         world camera

         (let [counter  (atom 0)]

           (fn [r fb bb bi]

             (if (zero? (rem (swap! counter inc) (inc skip)))

               (reset! vision-image (BufferedImage! r fb bb bi)))))))

      (vec

       (map

        (fn [[key image]]

          (let [whites (white-coordinates image)

                topology (vec (collapse whites))

                mask (presets key)]

            (fn []

              (vector

               topology

               (vec 

                (for [[x y] whites]

                  (bit-and

                   mask (.getRGB @vision-image x y))))))))

        retinal-map))]))

 

 (defn vision

   [#^Node creature & {skip :skip :or {skip 0}}]

   (reduce

    (fn [[init-a senses-a]

         [init-b senses-b]]

      [(conj init-a init-b)

       (into senses-a senses-b)])

    [[][]]      

    (for [eye (creature-eyes creature)]

      (enable-vision creature eye))))

     

 

 (defn blender-creature

   "Return a creature with all joints in place."

   [blender-path]

   (let [model (load-blender-model blender-path)

         joints

         (if-let [joint-node (.getChild model "joints")]

           (seq (.getChildren joint-node))

           (do (println-repl "could not find joints node") []))]

   (assemble-creature model joints)))

 

 (defn debug-window

   "creates function that offers a debug view of sensor data"

   []

   (let [vi (view-image)]

     (fn 

       [[coords sensor-data]]

       (let [image (points->image coords)]

         (dorun

          (for [i (range (count coords))]

            (.setRGB image ((coords i) 0) ((coords i) 1)

                     ({0 0x000000

                       1 0xFFFFFF} (sensor-data i)))))

         (vi image)))))

 

 (defn debug-vision-window

   "creates function that offers a debug view of sensor data"

   []

   (let [vi (view-image)]

     (fn 

       [[coords sensor-data]]

       (let [image (points->image coords)]

         (dorun

          (for [i (range (count coords))]

            (.setRGB image ((coords i) 0) ((coords i) 1)

                    (sensor-data i))))

         (vi image)))))

 

 (defn debug-hearing-window

   "view audio data"

   [height]

   (let [vi (view-image)]

     (fn [[coords sensor-data]]

       (let [image (BufferedImage. (count coords) height

                                   BufferedImage/TYPE_INT_RGB)]

         (dorun

          (for [x (range (count coords))]

            (dorun

             (for [y (range height)]

               (let [raw-sensor (sensor-data x)]

                 (.setRGB image x y

                          (+ raw-sensor

                             (bit-shift-left raw-sensor 8)

                             (bit-shift-left raw-sensor 16))))))))

         (vi image)))))

         

          

 

 ;;(defn test-touch [world creature]

 

 

 

 

 

 

 (defn test-creature [thing]

   (let [x-axis

         (box 1 0.01 0.01 :physical? false :color ColorRGBA/Red)

         y-axis

         (box 0.01 1 0.01 :physical? false :color ColorRGBA/Green)

         z-axis

         (box 0.01 0.01 1 :physical? false :color ColorRGBA/Blue)

         creature (blender-creature thing)

         touch-nerves (touch creature)

         touch-debug-windows (map (fn [_] (debug-window)) touch-nerves)

         [init-vision-fns vision-data] (vision creature)

         vision-debug (map (fn [_] (debug-vision-window)) vision-data)

         me (sphere 0.5 :color ColorRGBA/Blue :physical? false)

         [init-hearing-fns hearing-senses] (hearing creature)

         hearing-windows (map (fn [_] (debug-hearing-window 50))

                              hearing-senses)

         bell (AudioNode. (asset-manager)

                          "Sounds/ear-and-eye.wav" false)

         ;; dream

 

         ]

   (world

    (nodify [creature

             (box 10 2 10 :position (Vector3f. 0 -9 0)

                  :color ColorRGBA/Gray :mass 0)

             x-axis y-axis z-axis

             me

             ])

    (merge standard-debug-controls

           {"key-return"

            (fn [_ value]

              (if value

                (do

                  (println-repl "play-sound")

                  (.play bell))))})

    (fn [world]

      (light-up-everything world)

      (enable-debug world)

      (dorun (map #(% world) init-vision-fns))

      (dorun (map #(% world) init-hearing-fns))

      

      (add-eye world

               (attach-eye creature (test-eye))

               (comp (view-image) BufferedImage!))

      

      (add-eye world (.getCamera world) no-op)

      

      ;;(com.aurellem.capture.Capture/captureVideo

      ;; world (file-str "/home/r/proj/ai-videos/hand"))

      ;;(.setTimer world (RatchetTimer. 60))

      (speed-up world)

      ;;(set-gravity world (Vector3f. 0 0 0))

      )

    (fn [world tpf]

      ;;(dorun 

      ;; (map #(%1 %2) touch-nerves (repeat (.getRootNode world))))

      

 

      

      (dorun

       (map #(%1 (%2 (.getRootNode world)))

            touch-debug-windows touch-nerves))

      

      (dorun

       (map #(%1 (%2))

            vision-debug vision-data))

      (dorun

       (map #(%1 (%2)) hearing-windows hearing-senses))

      

      

      ;;(println-repl (vision-data))

      (.setLocalTranslation me (.getLocation (.getCamera world)))

      

 

      )

    ;;(let [timer (atom 0)]

    ;;  (fn [_ _]

    ;;    (swap! timer inc)

    ;;    (if (= (rem @timer 60) 0)

    ;;      (println-repl (float (/ @timer 60))))))

    )))

 

 

 

 

 

 

 

 

 

 ;;; experiments in collisions

 

 

 

 (defn collision-test []

   (let [b-radius 1

         b-position (Vector3f. 0 0 0)

         obj-b (box 1 1 1 :color ColorRGBA/Blue

                       :position b-position

                       :mass 0)

         node (nodify [obj-b])

         bounds-b

         (doto (Picture.)

           (.setHeight 50)

           (.setWidth 50)

           (.setImage (asset-manager)

                      "Models/creature1/hand.png"

                      false

           ))

         

         ;;(Ray. (Vector3f. 0 -5 0) (.normalize (Vector3f. 0 1 0)))

 

         collisions

         (let [cr (CollisionResults.)]

           (.collideWith node bounds-b cr)

           (println (map #(.getContactPoint %) cr))

           cr)

 

         ;;collision-points

         ;;(map #(sphere 0.1 :position (.getContactPoint %))

         ;;     collisions)

 

         ;;node (nodify (conj collision-points obj-b))

         

         sim

         (world node

                {"key-space"

                 (fn [_ value]

                   (if value

                     (let [cr (CollisionResults.)]

                       (.collideWith node bounds-b cr)

                       (println-repl (map #(.getContactPoint %) cr))

                       cr)))}

                no-op

                no-op)

 

         ]

     sim

     

 ))

    

 

 ;; the camera will stay in its initial position/rotation with relation

 ;; to the spatial.

 

 

 (defn follow-test

   "show a camera that stays in the same relative position to a blue cube."

   []

   (let [camera-pos (Vector3f. 0 30 0)

         rock (box 1 1 1 :color ColorRGBA/Blue

                      :position (Vector3f. 0 10 0)

                      :mass 30

                      )

         rot (.getWorldRotation rock)

         

         table (box 3 1 10 :color ColorRGBA/Gray :mass 0

                    :position (Vector3f. 0 -3 0))]

 

     (world

      (nodify [rock table])

              standard-debug-controls

              (fn [world]

                (let 

                    [cam (doto (.clone (.getCamera world))

                           (.setLocation camera-pos)

                           (.lookAt Vector3f/ZERO

                                    Vector3f/UNIT_X))]

                  (bind-sense rock cam)

                  

                  (.setTimer world (RatchetTimer. 60))

                  (add-eye world cam (comp (view-image) BufferedImage!))

                  (add-eye world (.getCamera world) no-op))

                )

              (fn [_ _] (println-repl rot)))))

        

 

 

 #+end_src

 

 #+results: body-1

 : #'cortex.silly/test-creature

 

 

 * COMMENT purgatory

 #+begin_src clojure

 (defn bullet-trans []

   (let [obj-a (sphere 0.5 :color ColorRGBA/Red

                       :position (Vector3f. -10 5 0))

         obj-b (sphere 0.5 :color ColorRGBA/Blue

                       :position (Vector3f. -10 -5 0)

                       :mass 0)

         control-a (.getControl obj-a RigidBodyControl)

         control-b (.getControl obj-b RigidBodyControl)

         swivel

         (.toRotationMatrix

          (doto (Quaternion.)

            (.fromAngleAxis (/ Math/PI 2)

                            Vector3f/UNIT_X)))]

     (doto 

         (ConeJoint.

          control-a control-b

          (Vector3f. 0 5 0)

          (Vector3f. 0 -5 0)

          swivel swivel)

       (.setLimit (* 0.6 (/ Math/PI 4))

                  (/ Math/PI 4)

                  (* Math/PI 0.8)))

     (world (nodify

             [obj-a obj-b])

             standard-debug-controls

             enable-debug

             no-op)))

 

 

 (defn bullet-trans* []

   (let [obj-a (box 1.5 0.5 0.5 :color ColorRGBA/Red

                    :position (Vector3f. 5 0 0)

                    :mass 90)

         obj-b (sphere 0.5 :color ColorRGBA/Blue

                       :position (Vector3f. -5 0 0)

                       :mass 0)

         control-a (.getControl obj-a RigidBodyControl)

         control-b (.getControl obj-b RigidBodyControl)

         move-up? (atom nil)

         move-down? (atom nil)

         move-left? (atom nil)

         move-right? (atom nil)

         roll-left? (atom nil)

         roll-right? (atom nil)

         force 100

         swivel

         (.toRotationMatrix

          (doto (Quaternion.)

            (.fromAngleAxis (/ Math/PI 2)

                            Vector3f/UNIT_X)))

         x-move

         (doto (Matrix3f.)

           (.fromStartEndVectors Vector3f/UNIT_X

                                 (.normalize (Vector3f. 1 1 0))))

         

         timer (atom 0)]

     (doto 

         (ConeJoint.

          control-a control-b

          (Vector3f. -8 0 0)

          (Vector3f. 2 0 0)

          ;;swivel swivel

          ;;Matrix3f/IDENTITY Matrix3f/IDENTITY

          x-move Matrix3f/IDENTITY 

          )

       (.setCollisionBetweenLinkedBodys false)

       (.setLimit (* 1 (/ Math/PI 4))    ;; twist 

                  (* 1 (/ Math/PI 4))  ;; swing span in X-Y plane

                  (* 0 (/ Math/PI 4))))  ;; swing span in Y-Z plane

     (world (nodify

             [obj-a obj-b])

            (merge standard-debug-controls

                   {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))

                    "key-t" (fn [_ pressed?] (reset! move-down? pressed?))

                    "key-f" (fn [_ pressed?] (reset! move-left? pressed?))

                    "key-g" (fn [_ pressed?] (reset! move-right? pressed?))

                    "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))

                    "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})     

            

            (fn [world]

              (enable-debug world)

              (set-gravity world Vector3f/ZERO)

              )

                            

            (fn [world _]

 

              (if @move-up?

                (.applyForce control-a

                               (Vector3f. force 0 0)

                               (Vector3f. 0 0 0)))

              (if @move-down?

                (.applyForce control-a

                              (Vector3f. (- force) 0 0)

                              (Vector3f. 0 0 0)))

              (if @move-left?

                (.applyForce control-a

                              (Vector3f. 0 force 0)

                              (Vector3f. 0 0 0)))

              (if @move-right?

                (.applyForce control-a

                              (Vector3f. 0 (- force) 0)

                              (Vector3f. 0 0 0)))

 

              (if @roll-left?

                (.applyForce control-a

                              (Vector3f. 0 0 force)

                              (Vector3f. 0 0 0)))

              (if @roll-right?

                (.applyForce control-a

                              (Vector3f. 0 0 (- force))

                              (Vector3f. 0 0 0)))

 

              (if (zero? (rem (swap! timer inc) 100))

                (.attachChild

                 (.getRootNode world)

                 (sphere 0.05 :color ColorRGBA/Yellow

                         :physical? false :position

                         (.getWorldTranslation obj-a)))))

            )

     ))

 

 (defn transform-trianglesdsd

   "Transform that converts each vertex in the first triangle

   into the corresponding vertex in the second triangle."

   [#^Triangle tri-1 #^Triangle tri-2]

   (let [in  [(.get1 tri-1)

              (.get2 tri-1)

              (.get3 tri-1)]

         out [(.get1 tri-2)

              (.get2 tri-2)

              (.get3 tri-2)]]

     (let [translate (doto (Matrix4f.) (.setTranslation (.negate (in 0))))

           in* [(.mult translate (in 0))

                (.mult translate (in 1))

                (.mult translate (in 2))]

           final-translation

           (doto (Matrix4f.)

             (.setTranslation (out 1)))

           

           rotate-1

           (doto (Matrix3f.)

             (.fromStartEndVectors

              (.normalize

               (.subtract

                (in* 1) (in* 0)))

              (.normalize

               (.subtract

                (out 1) (out 0)))))

           in** [(.mult rotate-1 (in* 0))

                 (.mult rotate-1 (in* 1))

                 (.mult rotate-1 (in* 2))]

           scale-factor-1

           (.mult

            (.normalize

             (.subtract

              (out 1)

              (out 0)))

            (/ (.length

                (.subtract (out 1)

                           (out 0)))

               (.length

                (.subtract (in** 1)

                           (in** 0)))))

           scale-1 (doto (Matrix4f.) (.setScale scale-factor-1))

           in*** [(.mult scale-1 (in** 0))

                  (.mult scale-1 (in** 1))

                  (.mult scale-1 (in** 2))]

           

           

           

           

           

           ]

       

       (dorun (map println in))

       (println)

       (dorun (map println in*))

       (println)

       (dorun (map println in**))

       (println)

       (dorun (map println in***))

       (println)

       

     ))))

 

 

 (defn world-setup [joint]

   (let [joint-position (Vector3f. 0 0 0)

         joint-rotation

         (.toRotationMatrix

          (.mult

           (doto (Quaternion.)

             (.fromAngleAxis

              (* 1 (/ Math/PI 4))

              (Vector3f. -1 0 0)))

           (doto (Quaternion.)

             (.fromAngleAxis

              (* 1 (/ Math/PI 2))

              (Vector3f. 0 0 1)))))

         top-position (.mult joint-rotation (Vector3f. 8 0 0))

         

         origin (doto

                    (sphere 0.1 :physical? false :color ColorRGBA/Cyan

                            :position top-position))

         top (doto

                 (sphere 0.1 :physical? false :color ColorRGBA/Yellow

                         :position top-position)

 

               (.addControl

                (RigidBodyControl.

                 (CapsuleCollisionShape. 0.5 1.5 1) (float 20))))

         bottom (doto

                    (sphere 0.1 :physical? false :color ColorRGBA/DarkGray

                            :position (Vector3f. 0 0 0))

                  (.addControl

                (RigidBodyControl.

                 (CapsuleCollisionShape. 0.5 1.5 1) (float 0))))

         table (box 10 2 10 :position (Vector3f. 0 -20 0)

                    :color ColorRGBA/Gray :mass 0)

         a (.getControl top RigidBodyControl)

         b (.getControl bottom RigidBodyControl)]

 

     (cond

      (= joint :cone)

      

        (doto (ConeJoint.

               a b

               (world-to-local top joint-position)

               (world-to-local bottom joint-position)

               joint-rotation

               joint-rotation

               )

 

               

          (.setLimit (* (/ 10) Math/PI)

                     (* (/ 4)  Math/PI)

                     0)))

   [origin top bottom table]))

             

 (defn test-joint [joint]

   (let [[origin top bottom floor] (world-setup joint)

         control (.getControl top RigidBodyControl)

         move-up? (atom false)

         move-down? (atom false)

         move-left? (atom false)

         move-right? (atom false)

         roll-left? (atom false)

         roll-right? (atom false)

         timer (atom 0)]

 

     (world

      (nodify [top bottom floor origin])

      (merge standard-debug-controls

             {"key-r" (fn [_ pressed?] (reset! move-up? pressed?))

              "key-t" (fn [_ pressed?] (reset! move-down? pressed?))

              "key-f" (fn [_ pressed?] (reset! move-left? pressed?))

              "key-g" (fn [_ pressed?] (reset! move-right? pressed?))

              "key-v" (fn [_ pressed?] (reset! roll-left? pressed?))

              "key-b" (fn [_ pressed?] (reset! roll-right? pressed?))})     

      

      (fn [world]

        (light-up-everything world)

        (enable-debug world)

        (set-gravity world (Vector3f. 0 0 0))

        )

      

      (fn [world _]

        (if (zero? (rem (swap! timer inc) 100))

          (do

          ;;  (println-repl @timer)

            (.attachChild (.getRootNode world)

                        (sphere 0.05 :color ColorRGBA/Yellow

                                :position (.getWorldTranslation top)

                                :physical? false))

            (.attachChild (.getRootNode world)

                          (sphere 0.05 :color ColorRGBA/LightGray

                                  :position (.getWorldTranslation bottom)

                                  :physical? false))))

 

        (if @move-up?

          (.applyTorque control

                        (.mult (.getPhysicsRotation control)

                               (Vector3f. 0 0 10))))

        (if @move-down?

          (.applyTorque control

                        (.mult (.getPhysicsRotation control)

                               (Vector3f. 0 0 -10))))

        (if @move-left?

          (.applyTorque control

                        (.mult (.getPhysicsRotation control)

                               (Vector3f. 0 10 0))))

        (if @move-right?

          (.applyTorque control

                        (.mult (.getPhysicsRotation control)

                               (Vector3f. 0 -10 0))))

        (if @roll-left?

          (.applyTorque control

                        (.mult (.getPhysicsRotation control)

                               (Vector3f. -1 0 0))))

        (if @roll-right?

          (.applyTorque control

                        (.mult (.getPhysicsRotation control)

                               (Vector3f. 1 0 0))))))))

 

 

 

 (defprotocol Frame

   (frame [this]))

 

 (extend-type BufferedImage

   Frame

   (frame [image]

     (merge  

      (apply

       hash-map 

       (interleave 

        (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]

                 (vector x y)))

        (doall (for [x (range (.getWidth image)) y (range (.getHeight image))]

                 (let [data (.getRGB image x y)] 

                   (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)

                             :g (bit-shift-right (bit-and 0x00ff00 data) 8)

                             :b (bit-and 0x0000ff data)))))))

      {:width  (.getWidth image) :height (.getHeight image)})))

 

 

 (extend-type ImagePlus

   Frame

   (frame [image+]

     (frame (.getBufferedImage image+))))

 

 

 #+end_src

 

 

 * COMMENT generate source

 #+begin_src clojure :tangle ../src/cortex/silly.clj

 <<body-1>>

 #+end_src