1.1 --- a/org/body.org	Thu Feb 02 01:32:31 2012 -0700
     1.2 +++ b/org/body.org	Thu Feb 02 01:35:21 2012 -0700
     1.3 @@ -106,6 +106,64 @@
     1.4          senses (map (partial joint-proprioception creature) joints)]
     1.5      (fn []
     1.6        (map #(%) senses))))
     1.7 +
     1.8 +(defn tap [obj direction force]
     1.9 +  (let [control (.getControl obj RigidBodyControl)]
    1.10 +    (.applyTorque
    1.11 +     control
    1.12 +     (.mult (.getPhysicsRotation control)
    1.13 +            (.mult (.normalize direction) (float force))))))
    1.14 +
    1.15 +
    1.16 +(defn with-movement
    1.17 +  [object
    1.18 +   [up down left right roll-up roll-down :as keyboard]
    1.19 +   forces
    1.20 +   [root-node
    1.21 +    keymap
    1.22 +    intilization
    1.23 +    world-loop]]
    1.24 +  (let [add-keypress
    1.25 +        (fn [state keymap key]
    1.26 +          (merge keymap
    1.27 +                  {key
    1.28 +                   (fn [_ pressed?]
    1.29 +                     (reset! state pressed?))}))
    1.30 +        move-up? (atom false)
    1.31 +        move-down? (atom false)
    1.32 +        move-left? (atom false)
    1.33 +        move-right? (atom false)
    1.34 +        roll-left? (atom false)
    1.35 +        roll-right? (atom false)
    1.36 +        
    1.37 +        directions [(Vector3f. 0 1 0)(Vector3f. 0 -1 0)
    1.38 +                    (Vector3f. 0 0 1)(Vector3f. 0 0 -1)
    1.39 +                    (Vector3f. -1 0 0)(Vector3f. 1 0 0)]
    1.40 +        atoms [move-left? move-right? move-up? move-down? 
    1.41 +                 roll-left? roll-right?]
    1.42 +
    1.43 +        keymap* (reduce merge
    1.44 +                        (map #(add-keypress %1 keymap %2)
    1.45 +                             atoms
    1.46 +                             keyboard))
    1.47 +        
    1.48 +        splice-loop (fn []
    1.49 +                      (dorun
    1.50 +                       (map
    1.51 +                        (fn [sym direction force]
    1.52 +                          (if @sym
    1.53 +                            (tap object direction force)))
    1.54 +                        atoms directions forces)))
    1.55 +
    1.56 +        world-loop* (fn [world tpf]
    1.57 +                       (world-loop world tpf)
    1.58 +                       (splice-loop))]
    1.59 +
    1.60 +     [root-node
    1.61 +      keymap*
    1.62 +      intilization
    1.63 +      world-loop*]))
    1.64 +
    1.65    
    1.66  #+end_src
    1.67  
    1.68 @@ -336,64 +394,6 @@
    1.69  
    1.70  
    1.71  
    1.72 -(defn tap [obj direction force]
    1.73 -  (let [control (.getControl obj RigidBodyControl)]
    1.74 -    (.applyTorque
    1.75 -     control
    1.76 -     (.mult (.getPhysicsRotation control)
    1.77 -            (.mult (.normalize direction) (float force))))))
    1.78 -
    1.79 -
    1.80 -
    1.81 -(defn with-movement
    1.82 -  [object
    1.83 -   [up down left right roll-up roll-down :as keyboard]
    1.84 -   forces
    1.85 -   [root-node
    1.86 -    keymap
    1.87 -    intilization
    1.88 -    world-loop]]
    1.89 -  (let [add-keypress
    1.90 -        (fn [state keymap key]
    1.91 -          (merge keymap
    1.92 -                  {key
    1.93 -                   (fn [_ pressed?]
    1.94 -                     (reset! state pressed?))}))
    1.95 -        move-up? (atom false)
    1.96 -        move-down? (atom false)
    1.97 -        move-left? (atom false)
    1.98 -        move-right? (atom false)
    1.99 -        roll-left? (atom false)
   1.100 -        roll-right? (atom false)
   1.101 -        
   1.102 -        directions [(Vector3f. 0 1 0)(Vector3f. 0 -1 0)
   1.103 -                    (Vector3f. 0 0 1)(Vector3f. 0 0 -1)
   1.104 -                    (Vector3f. -1 0 0)(Vector3f. 1 0 0)]
   1.105 -        atoms [move-left? move-right? move-up? move-down? 
   1.106 -                 roll-left? roll-right?]
   1.107 -
   1.108 -        keymap* (reduce merge
   1.109 -                        (map #(add-keypress %1 keymap %2)
   1.110 -                             atoms
   1.111 -                             keyboard))
   1.112 -        
   1.113 -        splice-loop (fn []
   1.114 -                      (dorun
   1.115 -                       (map
   1.116 -                        (fn [sym direction force]
   1.117 -                          (if @sym
   1.118 -                            (tap object direction force)))
   1.119 -                        atoms directions forces)))
   1.120 -
   1.121 -        world-loop* (fn [world tpf]
   1.122 -                       (world-loop world tpf)
   1.123 -                       (splice-loop))]
   1.124 -
   1.125 -     [root-node
   1.126 -      keymap*
   1.127 -      intilization
   1.128 -      world-loop*]))
   1.129 -
   1.130  
   1.131  (defn test-proprioception
   1.132    "Testing proprioception: