content: {-# LANGUAGE PatternGuards #-}
  --
  -- Event handling
  --
  
  module Event where
  
  import Config
  import World
  
  import Data.Label
  import System.Exit
  import Graphics.Gloss.Interface.IO.Game
  import Data.Array.Accelerate                                        ( Z(..), (:.)(..) )
  
  
  -- Event locations are returned as window coordinates, where the origin is in
  -- the centre of the window and increases to the right and up. If the simulation
  -- size is (100,100) with scale factor of 4, then the event coordinates are
  -- returned in the range [-200,200].
  --
  react :: Config -> Event -> World -> IO World
  react opt event world =
    case event of
      EventKey (Char c) s m _                     -> return $ keyboard c s m
      EventKey (MouseButton LeftButton) s m uv    -> return $ mouse m s (coord uv)
      EventMotion uv                              -> return $ motion (coord uv)
      EventKey (SpecialKey KeyEsc) Down _ _       -> exitSuccess
      _                                           -> return world
    where
      -- Inject a new density source when the left button is clicked.
      --
      -- If the shift key is held, remember the location and add a new velocity
      -- source between the old and new points as the mouse moves.
      --
      mouse key button xy
        | Up   <- shift key, Down <- button
        = world { currentSource = Density xy
                , densitySource = addDensity xy }
  
        | Down <- shift key, Down <- button
        = world { currentSource = Velocity xy }
  
        | Down <- shift key, Up   <- button
        = case currentSource world of
            Velocity x0y0 -> world { currentSource  = None
                                   , velocitySource = addVelocity x0y0 xy }
            _             -> world { currentSource  = None}
  
        | otherwise
        = world { currentSource = None }
  
      -- Handle key presses
      --
      keyboard 'r' Down _         = initialise opt
      keyboard 'd' Down _         = world { displayDensity  = not (displayDensity  world) }
      keyboard 'v' Down _         = world { displayVelocity = not (displayVelocity world) }
      keyboard _   _    _         = world
  
      -- As the mouse moves, keep inserting density sources, or adding source
      -- velocities
      --
      motion xy =
        case currentSource world of
          Density _       -> world { currentSource  = Density xy
                                   , densitySource  = addDensity xy }
          Velocity x0y0   -> world { currentSource  = Velocity xy
                                   , velocitySource = addVelocity x0y0 xy }
          _               -> world
      --
      inbounds (x,y)              = x >= 0 && x < get simulationWidth  opt
                                 && y >= 0 && y < get simulationHeight opt
  
      addDensity ix@(x,y)
        | inbounds ix             = (Z:.y:.x, density) : densitySource world
        | otherwise               = densitySource world
  
      addVelocity ix@(x0,y0) (x1,y1)
        | inbounds ix             = let u = fromIntegral (x1-x0)
                                        v = fromIntegral (y1-y0)
                                    in (Z:.y0:.x0, (u * velocity, v * velocity)) : velocitySource world
        | otherwise               = velocitySource world
      --
      density     = get inputDensity opt
      velocity    = get inputVelocity opt
      zoom        = fromIntegral $ get displayScale opt
      width       = fromIntegral $ get simulationWidth  opt
      height      = fromIntegral $ get simulationHeight opt
      scaleX      = width  / (width  * zoom + 1)
      scaleY      = height / (height * zoom + 1)
      coord (u,v) = ( truncate $ u * scaleX + width /2
                    , truncate $ v * scaleY + height/2)
  
  