#+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

 

 

 

 * Brainstorming different sensors and effectors.

 

 Every sense that we have should have an effector that changes what

 that sense (or others who have that sense) experiences.

 

 ** Classic Senses

 | Sense                        | Effector                        |

 |------------------------------+---------------------------------|

 | Vision                       | Variable Coloration             |

 | Hearing                      | Speech                          |

 | Proprioception               | Movement                        |

 | Smell/Taste (Chemoreception) | Pheremones                      |

 | Touch                        | Movement / Controllable Texture |

 | Acceleration                 | Movement                        |

 | Balance (sense gravity)      | Movement                        |

 |                              |                                 |

 

 - New Senses/Effectors

 - Levitation

 - Telekenesis

 

 - Symbol Sense

    Where objects in the world can be queried for description /

    symbols.

 

 - Symbol Marking

    The ability to mark objects in the world with your own descriptions

    and symbols.

 

 - Vision 

   Distinguish the polarization of light

   Color

   Movement

 

 * project ideas

  - HACKER for writing muscle-control programs : Presented with

    low-level muscle control/ sense API, generate higher level programs

    for accomplishing various stated goals. Example goals might be

    "extend all your fingers" or "move your hand into the area with

    blue light" or "decrease the angle of this joint".  It would be

    like Sussman's HACKER, except it would operate with much more data

    in a more realistic world.  Start off with "calestanthics" to

    develop subrouitines over the motor control API.  This would be the

    "spinal chord" of a more intelligent creature.  The low level

    programming code might be a turning machine that could develop

    programs to iterate over a "tape" where each entry in the tape

    could control recruitment of the fibers in a muscle.

  - Make a virtual computer in the virtual world which with which the

    creature interacts using its fingers to press keys on a virtual

    keyboard.  The creature can access the internet, watch videos, take

    over the world, anything it wants.

  - Make virtual insturments like pianos, drumbs, etc that it learns to

    play.

  - make a joint that figures out what type of joint it is (range of

    motion)

 

    

 

 

 

 * goals

 

 ** have to get done before winston

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

        appropiate -- 1/2 day

  - [ ] muscle control -- day

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

  - [ ] refactor integration code to distribute to each of the senses

        -- day

  - [ ] create video showing all the senses for Winston -- 2 days 

  - [ ] write summary of project for Winston            \

  - [ ] project proposals for Winston                    \

  - [ ] additional senses to be implemented for Winston   |  -- 2 days 

  - [ ] send Winston package                             /

 

 ** would be cool to get done before winston

  - [X] enable greyscale bitmaps for touch -- 2 hours 

  - [X] use sawfish to auto-tile sense windows -- 6 hours

  - [X] sawfish keybinding to automatically delete all sense windows

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

        days

  - [ ] proof of concept C sense manipulation  -- 2 days 

  - [ ] proof of concept GPU sense manipulation -- week

  - [ ] fourier view of sound -- 2 or 3 days 

  - [ ] dancing music generator -- 1 day, depends on fourier

 

 ** don't have to get done before winston

  - [ ] write tests for integration -- 3 days

  - [ ] usertime/gametime clock HUD display -- day 

  - [ ] find papers for each of the senses justifying my own

        representation -- week

  - [ ] show sensor maps in HUD display? -- 4 days

  - [ ] show sensor maps in AWT display? -- 2 days

 

 

 * 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 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")

   ;; bullet's point2point joints are BROKEN, so we must use the

   ;; generic 6DOF joint instead of an actual Point2Point joint!

 

   ;; should be able to do this:

   (comment 

     (Point2PointJoint.

      control-a

      control-b

      pivot-a

      pivot-b))

 

   ;; but instead we must do this:

   (println-repl "substuting 6DOF joint for POINT2POINT joint!")

   (doto

       (SixDofJoint.

        control-a

        control-b

        pivot-a

        pivot-b

        false)

     (.setLinearLowerLimit Vector3f/ZERO)

     (.setLinearUpperLimit Vector3f/ZERO)

     ;;(.setAngularLowerLimit (Vector3f. 1 1 1))

     ;;(.setAngularUpperLimit (Vector3f. 0 0 0))

 

 ))

 

 

 (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

   ;;dylan

   "Returns the smallest square containing the given

 vertices, as a vector of integers [left top width height]."

  ;; "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

   ;;dylan

   "Locate the touch sensors in the triangle, returning a map of their UV and geometry-relative coordinates."

   ;;"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

                         (filter #(not (= geo (.getGeometry %)))

                                 results)]

                     (- 255

                        (if (empty? touch-objects) 255

                            (rem 

                             (int

                              (* 255 (/ (.getDistance

                                         (first touch-objects)) limit)))

                             256))))))))))))))

                          

   

 (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

   ;;dylan

   "Return the children of the creature's \"eyes\" node."

   ;;"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

   "Return the children of the creature's \"ears\" node."

   ;;dylan

   ;;"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

   "Return the object in creature which is closest to the given node."

   ;;dylan"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)))))))

 

 ;;dylan (defn follow-sense, adjoin-sense, attach-stimuli,

 ;;anchor-qualia, augment-organ, with-organ

 (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))))

 

 

 

 

 

 ;; lower level --- nodes

 ;; closest-node "parse/compile-x" -> makes organ, which is spatial, fn pair

 

 ;; higher level -- organs

 ;; 

 

 ;; higher level --- sense/effector

 ;; these are the functions that provide world i/o, chinese-room style

 

 

 

 

 (defn blender-creature

   "Return a creature with all joints in place."

   [blender-path]

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

         joints (creature-joints model)]

     (assemble-creature model joints)))

 

 (defn gray-scale [num]

   (+ num

      (bit-shift-left num 8)

      (bit-shift-left num 16)))

 

 (defn debug-touch-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)

                     (gray-scale (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 (gray-scale raw-sensor)))))))

 

         (vi image)))))

         

          

 

 ;;(defn test-touch [world creature]

 

 

 

 

 ;; here's how motor-control/ proprioception will work: Each muscle is

 ;; defined by a 1-D array of numbers (the "motor pool") each of which

 ;; represent muscle fibers. A muscle also has a scalar :strength

 ;; factor which determines how strong the muscle as a whole is.

 ;; The effector function for a muscle takes a number < (count

 ;; motor-pool) and that number is said to "activate" all the muscle

 ;; fibers whose index is lower than the number.  Each fiber will apply

 ;; force in proportion to its value in the array.  Lower values cause

 ;; less force.  The lower values can be put at the "beginning" of the

 ;; 1-D array to simulate the layout of actual human muscles, which are

 ;; capable of more percise movements when exerting less force.

 

 ;; I don't know how to encode proprioception, so for now, just return

 ;; a function for each joint that returns a triplet of floats which

 ;; represent relative roll, pitch, and yaw.  Write display code for

 ;; this though.

 

 (defn muscle-fibre-values

   "Take the first row of the image and return the low-order bytes."

   [#^BufferedImage image]

   (let [width (.getWidth image)]

     (for [x (range width)]

       (bit-and

        0xFF

        (.getRGB image x 0)))))

 

 

 (defn draw-sprite [image sprite x y color ]

   (dorun

    (for [[u v] sprite]

      (.setRGB image (+ u x) (+ v y) color))))

 

 (defn view-angle

   "create a debug view of an angle"

   [color]

   (let [image (BufferedImage. 50 50 BufferedImage/TYPE_INT_RGB)

         previous (atom [25 25])

         sprite [[0 0] [0 1]

                 [0 -1] [-1 0] [1 0]]] 

     (fn [angle]

       (let [angle (float angle)]

         (let [position

               [(+ 25 (int (* 20 (Math/cos angle))))

                (+ 25 (int (* 20(Math/sin angle))))]]

           (draw-sprite image sprite (@previous 0) (@previous 1) 0x000000)

           (draw-sprite image sprite (position 0) (position 1) color)

           (reset! previous position))

         image))))

 

 (defn proprioception-debug-window

   []

   (let [yaw (view-angle 0xFF0000)

         roll (view-angle 0x00FF00)

         pitch (view-angle 0xFFFFFF)

         v-yaw (view-image)

         v-roll (view-image)

         v-pitch (view-image)

         ]

     (fn [prop-data]

       (dorun

        (map

         (fn [[y r p]]

           (v-yaw (yaw y))

           (v-roll (roll r))

           (v-pitch (pitch p)))

         prop-data)))))

 

 

 

 

 

 

 

 (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-touch-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/pure.wav" false)

         prop (proprioception creature)

         prop-debug (proprioception-debug-window)

         ;; 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)

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

      ;;(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))))

      

      (prop-debug (prop))

      

      (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/follow-test

 

 

 * 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