1.1 --- a/org/util.org	Fri Feb 03 06:41:16 2012 -0700
     1.2 +++ b/org/util.org	Fri Feb 03 06:47:05 2012 -0700
     1.3 @@ -398,6 +398,62 @@
     1.4    {"key-space" (fire-cannon-ball)})
     1.5  
     1.6     
     1.7 +(defn tap [obj direction force]
     1.8 +  (let [control (.getControl obj RigidBodyControl)]
     1.9 +    (.applyTorque
    1.10 +     control
    1.11 +     (.mult (.getPhysicsRotation control)
    1.12 +            (.mult (.normalize direction) (float force))))))
    1.13 +
    1.14 +
    1.15 +(defn with-movement
    1.16 +  [object
    1.17 +   [up down left right roll-up roll-down :as keyboard]
    1.18 +   forces
    1.19 +   [root-node
    1.20 +    keymap
    1.21 +    intilization
    1.22 +    world-loop]]
    1.23 +  (let [add-keypress
    1.24 +        (fn [state keymap key]
    1.25 +          (merge keymap
    1.26 +                  {key
    1.27 +                   (fn [_ pressed?]
    1.28 +                     (reset! state pressed?))}))
    1.29 +        move-up? (atom false)
    1.30 +        move-down? (atom false)
    1.31 +        move-left? (atom false)
    1.32 +        move-right? (atom false)
    1.33 +        roll-left? (atom false)
    1.34 +        roll-right? (atom false)
    1.35 +        
    1.36 +        directions [(Vector3f. 0 1 0)(Vector3f. 0 -1 0)
    1.37 +                    (Vector3f. 0 0 1)(Vector3f. 0 0 -1)
    1.38 +                    (Vector3f. -1 0 0)(Vector3f. 1 0 0)]
    1.39 +        atoms [move-left? move-right? move-up? move-down? 
    1.40 +                 roll-left? roll-right?]
    1.41 +
    1.42 +        keymap* (reduce merge
    1.43 +                        (map #(add-keypress %1 keymap %2)
    1.44 +                             atoms
    1.45 +                             keyboard))
    1.46 +        
    1.47 +        splice-loop (fn []
    1.48 +                      (dorun
    1.49 +                       (map
    1.50 +                        (fn [sym direction force]
    1.51 +                          (if @sym
    1.52 +                            (tap object direction force)))
    1.53 +                        atoms directions forces)))
    1.54 +
    1.55 +        world-loop* (fn [world tpf]
    1.56 +                       (world-loop world tpf)
    1.57 +                       (splice-loop))]
    1.58 +    [root-node
    1.59 +     keymap*
    1.60 +     intilization
    1.61 +     world-loop*]))
    1.62 +
    1.63  
    1.64  
    1.65  #+end_src