Earth Venus Dance

earthvenusdance.elm

import Graphics.Element exposing (Element)
import Graphics.Collage exposing (Form, collage, circle, rect, move, group, filled, solid, segment, traced)
import Time exposing (Time, fps)
import Color exposing (Color)
import Window
import Signal exposing (Signal, Mailbox)
import Task exposing (Task)
------------------------------

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


------------------------------

type alias State = 
  { system : System
  , lines  : List Line
  , size   : Vector
  , earthRevolutionRate : Float
  }
  
  
initial = 
  { system = initialSystem
  , lines  = []
  , size   = { x = 400, y = 400 }
  , earthRevolutionRate = 0.005
  }
  
type Action 
  = NextFrame Time
  | Resize Vector
  
  
appStartMailbox : Mailbox ()
appStartMailbox = 
  Signal.mailbox ()
  
port appStart : Signal (Task error ())
port appStart = 
  Signal.constant
    (Signal.send appStartMailbox.address ())
    
  
actions : Signal Action
actions = 
  Signal.mergeMany 
    [ firstResize
    , nextframes 
    , resizes
    ]
  
nextframes : Signal Action
nextframes = 
  Signal.map NextFrame (fps 60)
  
 
resizes : Signal Action
resizes = 
  Signal.map (\(x,y) -> Resize { x = toFloat x, y = toFloat y }) Window.dimensions
  
  
firstResize : Signal Action
firstResize = 
  Signal.sampleOn appStartMailbox.signal resizes
  
update : Action -> State -> State 
update action state = 
  case action of 
    Resize size -> 
      { state | size <- size }
      
    NextFrame frame -> 
      let 
          (earthDistance, earthAngle) = 
            toPolar (state.system.earth.position.x, state.system.earth.position.y)
            
          (venusDistance, venusAngle) = 
            toPolar (state.system.venus.position.x, state.system.venus.position.y)
            
          newEarthAngle = 
            earthAngle - state.earthRevolutionRate * frame
            
          venusRevolutionRate = 
            (13 / 8) * state.earthRevolutionRate 
            
          newVenusAngle = 
            venusAngle - venusRevolutionRate * frame
            
          (newEarthX, newEarthY) = 
            fromPolar (earthDistance, newEarthAngle)
            
          (newVenusX, newVenusY) = 
            fromPolar (venusDistance, newVenusAngle)
            
          newEarthPosition = 
            { x = newEarthX
            , y = newEarthY
            }
            
          newVenusPosition = 
            { x = newVenusX
            , y = newVenusY
            }
            
          line = 
            { start = newEarthPosition
            , end   = newVenusPosition
            }
            
          earth = 
            state.system.earth
            
          venus = 
            state.system.venus
            
          newEarth = 
            { earth | position <- newEarthPosition }
            
          newVenus = 
            { venus | position <- newVenusPosition }
            
          system = 
            state.system
            
          newSystem = 
            { system | earth <- newEarth  
                     , venus <- newVenus
            }
            
          lines = 
            if List.length state.lines >= 500
            then 
              []
            else
              line :: state.lines
                
            
      in 
          { state | system <- newSystem
                  , lines  <- lines 
          }
      
  
  
view : State -> Element
view state = 
  let 
      background = 
        rect state.size.x state.size.y
        |> filled Color.black
        
      foreground = 
        drawSystem state.system ++ List.map drawLine state.lines
        
      canvas = 
        background :: foreground
  in 
      canvas
      |> collage (round state.size.x) (round state.size.y)
        

--------------------

type alias System = 
  { sun : Body 
  , earth : Body
  , venus : Body
  }

initialSystem : System 
initialSystem = 
  { sun = 
      { position = { x = 0, y = 0 }
      , radius   = 20
      , color    = Color.yellow
      }
  , venus = 
      { position = { x = 0, y = -100}
      , radius   = 8
      , color    = Color.lightOrange
      }
  , earth = 
      { position = { x = 0, y = -150}
      , radius   = 12
      , color    = Color.blue
      }
  }


drawSystem : System -> List Form 
drawSystem system = 
  [ drawRing system.earth
  , drawBody system.earth
  , drawRing system.venus
  , drawBody system.venus
  , drawBody system.sun
  ]

--------------------

type alias Body = 
  { position : Vector
  , radius   : Float 
  , color    : Color
  }

drawRing : Body -> Form 
drawRing body = 
  let 
      (bodyRadius, _) = 
        toPolar (body.position.x, body.position.y)
        
      ringSize = 
        4
        
      outerRadius = 
        bodyRadius + (ringSize / 2)
        
      innerRadius = 
        bodyRadius - (ringSize / 2)
        
      outerRing = 
        circle outerRadius
        |> filled Color.white
        
      innerRing = 
        circle innerRadius
        |> filled Color.black
  in
      group 
        [ outerRing, innerRing ]
        
        
        
        


drawBody : Body -> Form 
drawBody body = 
  circle body.radius
  |> filled body.color
  |> move (body.position.x, body.position.y)

--------------------

type alias Line = 
  { start : Vector
  , end   : Vector
  }


drawLine : Line -> Form 
drawLine line = 
  segment (line.start.x, line.start.y) (line.end.x, line.end.y)
  |> traced (solid Color.white)

--------------------

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

-------------------