springfirstattempt.elm

import Html exposing (Html)
import Html.Attributes
import Time
import Mouse
import Signal

-----------

infixl 2 =>
(=>) = (,)


-----------

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

-----------

type alias Vector = 
  { x : Float , y : Float }

type alias Ball = 
  { radius   : Float 
  , position : Vector
  }
  
type alias AnimatedBall = 
  { radius : Float 
  , position : 
      { x : Spring , y : Spring }
  }
  
toAnimatedBall : Ball -> AnimatedBall 
toAnimatedBall ball = 
  let   
      stiffness = 0.8 -- tweek these
      friction  = 1   -- values
  in 
      { radius   = ball.radius
      , position =
          { x = 
              { stiffness   = stiffness 
              , friction    = friction 
              , position    = ball.position.x
              , velocity    = 0
              , destination = ball.position.x
              }
          , y = 
              { stiffness   = stiffness 
              , friction    = friction 
              , position    = ball.position.y
              , velocity    = 0
              , destination = ball.position.y
              }
          }
      }
   
   
toBall : AnimatedBall -> Ball 
toBall animatedBall = 
  { radius = animatedBall.radius 
  , position = 
      { x = animatedBall.position.x.position
      , y = animatedBall.position.y.position
      }
  }
  
initial = toAnimatedBall
  { radius = 30
  , position = { x = 100 , y = 100 }
  }
  
  
type Action 
  = MoveTo Vector
  | NextFrame Float
  
  
update : Action -> AnimatedBall -> AnimatedBall 
update action animatedBall =
  case action of
    NextFrame framerate -> 
      let 
          newX = step framerate animatedBall.position.x
          newY = step framerate animatedBall.position.y
      in 
          { animatedBall | position <- { x = newX , y = newY } }
          
    MoveTo destination -> 
      let
          x = animatedBall.position.x 
          y = animatedBall.position.y
          
          newX = { x | destination <- destination.x }
          newY = { y | destination <- destination.y }
      in 
          { animatedBall | position <- { x = newX , y = newY } }
          
  
view : Ball -> Html 
view ball = 
  let 
      containerStyle = 
          [ "position" => "absolute"
          , "top"      => toString ball.position.y ++ "px"
          , "left"     => toString ball.position.x ++ "px"
          , "width"    => toString ball.radius ++ "px"
          , "height"   => toString ball.radius ++ "px"
          , "border-radius" => "50%"
          , "background-color" => "red"
          ]
  in 
      Html.div 
          [ Html.Attributes.style containerStyle ]
          []
          
          
          
mouse : Signal Action 
mouse = 
  --Signal.sampleOn Mouse.clicks 
    (Signal.map (\(x,y) -> MoveTo { x = toFloat x , y = toFloat y } ) Mouse.position)
    
    
frame : Signal Action 
frame = 
  Signal.map (\time -> NextFrame (time / 100)) (Time.fps 60)


actions = 
  Signal.merge mouse frame


  
main = 
  Signal.map (toBall >> view)
    (Signal.foldp update initial actions)





-----------

epsilon = 0.0001

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