Animated scene with trance-inducing color changes. http://share-elm.com/gists/ea4ee817db998ca5d4e0

HypnoticFollower.elm

import Graphics.Collage exposing (..)
import Graphics.Element exposing (..)
import Color exposing (..)
import Mouse
import Signal
import Window
import Time
import List


main = Signal.map3 render Mouse.position Window.dimensions time

type alias Model = 
  { mousePos: (Int, Int)
  , points: List (Int, Int)
  , unitSize: Float
  , t: Float
  , windowWidth: Int
  , windowHeight: Int
  }


render: (Int, Int) -> (Int, Int) -> Float -> Element
render a b c = 
  createModel a b c |> view


time = Time.timestamp (Time.every Time.millisecond) |> Signal.map (fst >> Time.inSeconds)


createModel: (Int, Int) -> (Int, Int) -> Float -> Model
createModel (mouseX, mouseY) (windowWidth, windowHeight) time = 
  let padding = 50
      size = 50
      xfactor = mouseY // 100
      nRows = (windowHeight - 2 * padding) // (size * xfactor)
      nCols = (windowWidth - 2 * padding) // (size * xfactor)
  in 
    { mousePos = (mouseX, windowHeight - mouseY)
    , points = cross (linspaceInclusive (toFloat padding) (toFloat (windowWidth - padding)) nCols) 
                     (linspaceInclusive (toFloat padding) (toFloat (windowHeight - padding)) nRows) 
                 |> List.map (\(a, b) -> (floor a, floor b))
    , unitSize = toFloat size
    , t = (sin (time * ((toFloat mouseX) / 100))) * 0.5 + 0.5
    , windowWidth = windowWidth
    , windowHeight = windowHeight
    }


view: Model -> Element
view model = 
  let moveToOrigin forms = 
        forms 
        |> group 
        |> move ( -0.5 * (toFloat model.windowWidth)
                , -0.5 * (toFloat model.windowHeight)
                )
  in 
    collage  model.windowWidth model.windowHeight
      [ filled 
          (hsla 0.3 1 (0.3 * model.t) 1) 
          (rect (toFloat model.windowWidth) 
                (toFloat model.windowHeight))
      , model.points 
          |> List.concatMap (renderPoint model.mousePos model.unitSize model.t) 
          |> moveToOrigin
      ]


renderPoint: (Int, Int) -> Float -> Float -> (Int, Int) -> List Form
renderPoint (mouseX, mouseY) size t (x, y) =
  let opacity = ((abs (toFloat (mouseX - x))) / 600 |> (+) (0.5 * t))
      hue = ((abs (toFloat (mouseY - y))) / 200 |> (*) 0.5 |> (+) 4.1)
      saturation = ((abs (toFloat (mouseY - x))) / 200 |> (*) -0.3 |> (+) 1.1)
      circ radius = 
        filled (hsla hue saturation 0.7 opacity) (circle radius) 
        |> move ((toFloat x), (toFloat y))
  in 
    [ circ (size / 3)
    , circ (size / 5)
    , circ (size / 10)
    , getLine (toFloat x, toFloat y) (toFloat mouseX, toFloat mouseY) 20 t
    ]
    

getLine center target r t = 
  let theta = getAngle center target
      endpoint = addVector center (fromPolar (r * t * 3.5, theta))
      myLineStyle = { defaultLine 
                      | width <- 1
                      , color <- hsla 1 0 t t
                    }
  in traced myLineStyle (segment center endpoint)
  
  

{-- Utils --}

cross: List a -> List a -> List (a, a)
cross a b =
  List.concatMap (\ai -> List.map ((,) ai) b) a



-- Return list of integers from start to end (not including end)
range: Int -> Int -> List Int
range start end =
  if start < end
    then start :: (range (start + 1) end)
    else []
    


linspace: Float -> Float -> Int -> List Float
linspace start end n =
  let interval = (end - start) / (toFloat n)
  in List.map (\i -> interval * (toFloat i) + start) (range 0 n)



linspaceInclusive: Float -> Float -> Int -> List Float
linspaceInclusive start end n =
  let interval = (end - start) / (toFloat (n - 1))
  in List.map (\i -> interval * (toFloat i) + start) (range 0 n)
  
addVector (x1, y1) (x2, y2) = 
  (x1 + x2, y1 + y2)

subtractVector (x1, y1) (x2, y2) = 
  (x1 - x2, y1 - y2)

getAngle a b = 
  subtractVector b a |> toPolar |> snd