springfocus.elm

type alias Spring a = 
  { stiffness   : Float 
  , friction    : Float 
  , position    : a 
  , velocity    : a 
  , destination : a 
  }
 
 
 
---------- 

type alias Focus big small =
  { get    : big -> small
  , update : (small -> small) -> big -> big
  }

create : (big -> small) -> ((small -> small) -> big -> big) -> Focus big small
create get update =
  { get=get, update=update }


type alias Vector = 
  { x : Float , y : Float }
   
x = create .x (\update p -> { p | x <- update p.x })
y = create .y (\update p -> { p | y <- update p.y })



-----------

makeSpring : Float -> Float -> Focus a Float -> a -> Spring a 
makeSpring stiffness friction {get, update} position = 
  let 
      velocity = 
        update (always 0) position 
        
      destination = 
        position 
        
  in 
      { stiffness   = stiffness
      , friction    = friction 
      , position    = position 
      , velocity    = velocity
      , destination = destination 
      }


  
-----------------  
  
epsilon = 0.0001  
  
animate : Float -> Focus a Float -> Spring a -> Spring a 
animate frameRate {get, update} spring = 
  let 
      position = 
        get spring.position 
        
      velocity = 
        get spring.velocity 
        
      destination = 
        get spring.destination 
        
      fspring = 
        -spring.stiffness * (position - destination)
        
      fdamper = 
        -spring.friction * velocity 
        
      a = 
        fspring + fdamper 
        
      newX = 
        position + velocity * frameRate 
        
      newV = 
        velocity + a * frameRate 
        
  in 
      if 
          abs (newV - velocity) < epsilon && abs (newX - position) < epsilon
      then 
          { spring | position <- update (always destination) spring.position
                   , velocity <- update (always 0) spring.velocity
          }
      else 
          { spring | position <- update (always newX) spring.position
                   , velocity <- update (always newV) spring.velocity
          }
     
     
---------------