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

 

 * objectives

  - [X] get an overall bitmap-like image for touch

  - [X] write code to visuliaze this bitmap

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

  - [ ] write an explination for why b&w bitmaps for senses is appropiate

  - [ ] clean up touch code and write visulazation test

  - [ ] do the same for eyes

 

 * 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 view-image

   "Initailizes a JPanel on which you may draw a BufferedImage.

    Returns a function that accepts a BufferedImage and draws it to the

    JPanel."

   []

   (let [image

         (atom

          (BufferedImage. 1 1 BufferedImage/TYPE_4BYTE_ABGR))

         panel 

         (proxy [JPanel] []

           (paint

             [graphics]

             (proxy-super paintComponent graphics)

             (.drawImage graphics @image 0 0 nil)))

         frame (JFrame. "Display Image")]

     (SwingUtilities/invokeLater

      (fn []

        (doto frame

          (-> (.getContentPane) (.add panel))

          (.pack)

          (.setLocationRelativeTo nil)

          (.setResizable true)

          (.setVisible true))))

     (fn [#^BufferedImage i]

       (reset! image i)

       (.setSize frame (+ 8 (.getWidth i)) (+ 28 (.getHeight i)))

       (.repaint panel 0 0 (.getWidth i) (.getHeight i)))))

 

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

       (dorun 

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

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

       

       image)))

 

 (defn test-data

   []

   (vec

    (for [a (range 0 1000 2)

          b (range 0 1000 2)]

      (vector a b))

   ))

 

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

   ;;(println (meta-data joint "joint"))

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

 

 (defn blender-creature [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)))

 

 (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 ImagePlus format, or

    nil if it does not exist."

   [#^Geometry obj]

   (let [mat (.getMaterial obj)]

     (if-let [texture-param

              (.getTextureParam

               mat

               MaterialHelper/TEXTURE_TYPE_DIFFUSE)]

       (let

           [texture

            (.getTextureValue texture-param)

            im (.getImage texture)]

         (ImageToAwt/convert im 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))

 

 (defn triangle

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

   [#^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.)

         ]

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

   (map enable-touch

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

                (node-seq pieces))))

 

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

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

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

         ]

   (world

    (nodify [creature

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

                  :color ColorRGBA/Gray :mass 0)

             x-axis y-axis z-axis

             ])

    standard-debug-controls

    (fn [world]

      (light-up-everything world)

      (enable-debug world)

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

      

 

      )

    ;;(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 [a-radius 1 

         a-position (Vector3f. -0.25 3 0)

         b-radius 1

         b-position (Vector3f. 0.25 3 0)

 

 

         obj-a (box 1 1 1 :color ColorRGBA/Red

                       :position a-position

                       :physical? false)

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

                       :position b-position

                       :physical? false)

         node (nodify [obj-a obj-b])

         bounds-a (BoundingBox. a-position 1 1 1)

         bounds-b (BoundingBox. b-position 1 1 1)

         sim

         (world node

                {}

                no-op

                no-op)

 

         ]

     (.setBound (.getMesh obj-a) bounds-a)

     (.updateBound (.getMesh obj-a))

 

     

     (.setBound (.getMesh obj-b) bounds-b)

     (.updateBound (.getMesh obj-b))

 

 

 

     (let [cr (CollisionResults.)]

       (.collideWith node bounds-a cr)

       [cr sim])

     

 ))

    

     

                          

   

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