Example of Alternative to elm-animation

elm-animation-alt.elm

import Html exposing (Html, Attribute)
import Html.Attributes
import Html.Events

import Signal exposing (Address)

import Json.Decode exposing (Decoder, (:=))
import Time

import List


decoder : Decoder {x : Int, y : Int}
decoder = 
  Json.Decode.object2 (\x y -> { x = x, y = y })
    ("pageX" := Json.Decode.int)
    ("pageY" := Json.Decode.int)
    
    
onClick : Address a -> ({x : Int, y : Int} -> a) -> Attribute
onClick address constructor = 
  Html.Events.on "click" decoder (Signal.message address << constructor)

(=>) = (,)

type alias Range = 
  { start : Float
  , end   : Float
  , delta : Float
  }
  
fromRange : Range -> Timeline Float
fromRange {start, end, delta} = 
  let 
      rangeCount = (end - start) / delta |> floor
      
      inc = 
        if start < end then delta else -delta
      
      next = 
        List.indexedMap 
          (\n _ -> start + inc + (toFloat n) * delta)
          (List.repeat rangeCount 0)
  in 
      { previous = []
      , current  = start
      , next     = next
      }

type alias Timeline a = 
  { previous : List a 
  , current  : a
  , next     : List a
  }
  
constant : a -> Timeline a 
constant a = 
  Timeline [] a []
  
map : (a -> b) -> Timeline a -> Timeline b
map f {previous, current, next} = 
  Timeline (List.map f previous) (f current) (List.map f next)
  
  
map2 : (a -> b -> c) -> Timeline a -> Timeline b -> Timeline c
map2 f ta tb = 
  Timeline 
    (List.map2 f ta.previous tb.previous) 
    (f ta.current tb.current) 
    (List.map2 f ta.next tb.next)
    
    
timeline : Float -> Timeline Float
timeline dt = 
  Range 0 1 dt
  |> fromRange
  
lerp : Float -> Float -> Float -> Float
lerp start end t = 
  (1 - t) * start + (t * end)
  
  
step : Timeline a -> Timeline a
step timeline = 
  case timeline.next of 
    [] ->
      timeline
    n :: ns ->
      { timeline | previous <- timeline.current :: timeline.previous
                 , current  <- n 
                 , next     <- ns
      }
      
      

type alias State = 
  { position : Timeline { x : Int, y : Int } }
  
initial = 
  { position = constant { x = 0, y = 0 } }
  
type Action 
  = Click { x : Int, y : Int }
  | NextFrame
  
view : Address Action -> State -> Html
view address {position} = 
  let 
      containerStyles = 
        [ "position" => "absolute"
        , "height" => "100vh"
        , "width" => "100vw"
        , "top" => "0"
        , "left" => "0"
        ]
        
      circleStyles = 
        [ "position" => "absolute"
        , "left" => (toString (position.current.x - 25) ++ "px")
        , "top" => (toString (position.current.y - 25) ++ "px")
        , "background-color" => "red"
        , "width" => "50px"
        , "height" => "50px"
        , "border-radius" => "50%"
        ]
   in 
      Html.div 
          [ Html.Attributes.style containerStyles
          , onClick address Click 
          ]
          [ Html.div 
                [ Html.Attributes.style circleStyles ]
                []
          ]
          



update : Action -> State -> State
update action state = 
  case action of 
    Click {x,y} ->
      { state | position <- 
          let t = timeline 0.1
              
              pos dt = 
                let x' = lerp (toFloat state.position.current.x) (toFloat x) dt |> floor
                    y' = lerp (toFloat state.position.current.y) (toFloat y) dt |> floor
                in 
                    { x = x' , y = y' }
          in 
              map pos t
      }
                
               
       
    NextFrame -> 
      { state | position <- step state.position }




{address, signal} = Signal.mailbox NextFrame

signal' = 
  Signal.merge signal 
    (Signal.sampleOn (Time.fps 60) (Signal.constant NextFrame))
    

main = 
  Signal.map (view address)
    (Signal.foldp update initial signal')