gistfile1.hs

module Main where

-- http://www.f13g.com/%A5%D7%A5%ED%A5%B0%A5%E9%A5%DF%A5%F3%A5%B0/Haskell/GLUT/#content_1_7

import System.Random
import Graphics.Gloss
import Graphics.Gloss.Interface.Pure.Simulate

data Particle
  = Particle { position :: Point
             , velocity :: Vector }

data State
  = State { generator :: StdGen
          , particles :: [Particle] }

numParticles :: Int
numParticles = 32

sizeParticle :: Float
sizeParticle = 1.0

main :: IO ()
main
  = getStdGen
    >>= \g ->
      simulate
        (InWindow "Particles" (200,200) (10,10))
        black
        20
        (initialState g)
        updatePicture
        evolve

initialState :: StdGen -> State
initialState g
  = State { generator = g
          , particles = [newParticle g] }

updatePicture :: State -> Picture
updatePicture
  = pictures . (map fromParticle) . particles

evolve :: ViewPort -> Float -> State -> State
evolve _ _ s
  = s { generator = snd (next (generator s))
      , particles
          = filter activeParticle
          $ map moveParticle
            $ particles s ++
                 replicate numParticles
                   (newParticle (generator s)) }

newParticle :: StdGen -> Particle
newParticle g
  = Particle { position = (-50.0, 0.0)
             , velocity = newVelocity }
  where newVelocity :: Vector
        newVelocity = (x, y)
        (x, g') = randomR (0.5, 0.7) g
        (y, _ ) = randomR (0.5, 0.8) g'

fromParticle :: Particle -> Picture
fromParticle p
  = Color white
    $ Translate x y
    $ ThickCircle sizeParticle sizeParticle
  where (x, y) = position p

activeParticle :: Particle -> Bool
activeParticle p = y > (-50.5)
  where (_, y) = position p

moveParticle :: Particle -> Particle
moveParticle p
  = Particle { position
                 = (position p) `addP`
                   (velocity p)
             , velocity
                 = (velocity p) `addP`
                   (0.0, (-0.01)) }
  where addP :: Point -> Point -> Point
        addP (x, y) (u, v) = (x + u, y + v)