Star.elm

import List
import Signal exposing (Mailbox)
import Time exposing (Time)
import Task exposing (Task)
import Color exposing (Color)
import Random exposing (Seed)
import Window
import Debug
import Graphics.Element exposing (Element)
import Graphics.Collage as Collage exposing (Shape)

-- NB: should be in standard library?
sign : Float -> Float
sign a = if a < 0
         then -1
         else if a > 0
              then 1
              else 0

type alias Point = (Float, Float)

type alias Star =
  { size : Float
  , color : Color
  , p : Point
  , v : Point
  , angle : Float
  , inverses : (List Point, List Point, List Point)
  }

newStars : Mailbox Star
newStars = Signal.mailbox { size = 0
                          , color = Color.black
                          , p = (0, -1)
                          , v = (0, 0)
                          , angle = 0
                          , inverses = ([], [], [])
                          }

spawnStar : Seed -> Task x ()
spawnStar seed =
  let timeR = Random.float (200 * Time.millisecond) (2 * Time.second)
      sizeR = Random.float 12 22
      --sizeR = Random.float 8 8
      hueR = Random.float 0 (2 * pi)
      speedR = Random.float 0.3 0.5
      angleR = Random.float (pi / 3) (2 * pi / 3)

      (delay, seed1) = Random.generate timeR seed
      (size, seed2) = Random.generate sizeR seed1
      (hue, seed3) = Random.generate hueR seed2
      (speed, seed4) = Random.generate speedR seed3
      (angle, seed') = Random.generate angleR seed4

      nstar = { size = size
              , color = Color.hsl hue 0.7 0.7
              , p = (0, -size)
              , v = (speed * cos angle, speed * sin angle)
              , angle = angle
              , inverses = ([], [], [])
              }

  in Task.sleep delay `Task.andThen` \_ ->
     Signal.send newStars.address nstar `Task.andThen` \_ ->
     spawnStar seed'

port spawner : Task x ()
port spawner = spawnStar (Random.initialSeed 0)

type Event = Advance Time
           | Spawn Star

updateStars : Event -> List Star -> List Star
updateStars event stars =
  case event of
    Spawn s -> s :: stars
    Advance delta -> 
  let update s =
        let (i1, i2, i3) = s.inverses
            (x, y) = s.p
            (vx, vy) = s.v

            g = 0.0005
            ag = 0.04
            inv = floor (Time.second / delta)
            invw = 40 * sqrt (vx^2 + vy^2)
            nx = vx * delta + x
            ny = -g * delta^2 / 2 + vy * delta + y
            nvy = -g * delta + vy
            nangle = -ag * vx * delta + s.angle
            (ix, iy) = (invw * cos s.angle, -invw * sin s.angle)
            --vangle = if ny - y < 0.0001 then sign (nx - x) * pi / 2 else atan ((nx - x) / (ny - y))
            --(ix, iy) = (invw * cos vangle, -invw * sin vangle)
            ni1 = (x - ix, y - iy)
            ni3 = (x + ix, y + iy)

            hiddenInv = List.all (\(_, yy) -> yy < 0)
        in if vy < 0 && y <= -s.size && hiddenInv i1 && hiddenInv i2 && hiddenInv i3
           then Nothing
           else Just { s
                     | p <- (nx, ny)
                     , v <- (vx, nvy)
                     , angle <- nangle
                     , inverses <- (List.take inv (ni1 :: i1), List.take inv (s.p :: i2), List.take inv (ni3 :: i3))
                     }
  in List.filterMap update stars

star : Float -> Shape
star r =
  let t = 2 * pi / 5
      s = 1 / 2 * (3 - sqrt 5)
      bigs = List.map (\i -> fromPolar (r, t*i)) [1..5]
      smalls = List.map (\i -> fromPolar (s * r, t*i + t / 2)) [1..5]
  in Collage.polygon <| List.concat <| List.map2 (\a b -> [a, b]) bigs smalls

showStars : (Int, Int) -> List Star -> Element
showStars (w, h) stars =
  let w' = toFloat w
      h' = toFloat h
      k = 0.006
      bg = Collage.filled (Color.rgb 0 0 204) <| Collage.rect w' h'
      draw s =
        let (i1, i2, i3) = s.inverses
            drawRev = Collage.traced (Collage.solid s.color) << Collage.path
            m = Collage.move s.p
              <| Collage.rotate (-s.angle)
              <| Collage.filled s.color (star s.size)
        in Collage.move (0, -h' / 2)
           <| Collage.scale (min w' h' * k)
           <| Collage.group [m, drawRev i1, drawRev i2, drawRev i3]
  in Collage.collage w h (bg :: List.map draw (Debug.watch "stars" stars))

main : Signal Element
main = Signal.map2 showStars (Window.dimensions)
       <| Signal.foldp updateStars []
       <| Signal.merge
            (Signal.map Advance <| Time.fps 30)
            (Signal.map Spawn <| newStars.signal)