packages feed

gloss-examples-1.7.5.1: raster/Fluid/src-repa/Main.hs

-- | Stable fluid flow-solver.
--   Based on "Real-time Fluid Dynamics for Games", Jos Stam, Game developer conference, 2003.
--   Implementation by Ben Lambert-Smith.
--   Converted to Repa 3 by Ben Lippmeier.
--
{-# LANGUAGE ScopedTypeVariables #-}
module Main (main)
where
import Solve.Density
import Solve.Velocity
import Model
import UserEvent
import Args
import Config

import Graphics.Gloss
import Graphics.Gloss.Interface.IO.Game
import System.Mem
import System.Environment       (getArgs)
import Data.Array.Repa.IO.Timing   as R
import Prelude                     as P


main :: IO ()
main 
 = do   -- Parse the command-line arguments.
        args                    <- getArgs
        config                  <- parseArgs args configDefault

        -- Setup the initial fluid model.
        let model       = initModel
                                (configInitialDensity  config)
                                (configInitialVelocity config)

        performGC
        case configBatchMode config of
         False -> runInteractive config model
         True  
          -> do (_, elapsed)    <- time $ do   result <- runBatchMode   config model
                                               result `seq` return ()
                putStrLn $ show $ wallTime milliseconds elapsed


-- | Run the simulation interactively.
runInteractive :: Config -> Model -> IO ()
runInteractive config model0
 = let (scaleX, scaleY)  = configScale config
   in  playIO  (InWindow "Stam's stable fluid. Use left-click right-drag to add density / velocity." 
                        (configWindowSize config) 
                        (20, 20))
                black
                (configRate config)
                model0
                (pictureOfModel (fromIntegral scaleX, fromIntegral scaleY))
                (\event model -> return $ userEvent config event model)
                (\_           -> stepFluid config)


-- | Run in batch mode and dump a .bmp of the final state.
runBatchMode :: Config -> Model -> IO ()
runBatchMode config model
  | stepsPassed model     >= configMaxSteps config
  =     return ()

  | otherwise     
  = do  model'  <- stepFluid config model

        case configFramesMode config of
         Nothing -> return ()
         Just path
          -> do putStrLn $ "frame " ++ show (stepsPassed model) 
                outputBMP path (stepsPassed model) (densityField model)

        runBatchMode config model'


-- Function to step simulator one step forward in time
stepFluid :: Config -> Model -> IO Model
stepFluid config m@(Model df ds vf vs cl step dv cb)
  | step                  >= configMaxSteps config
  , configMaxSteps config >  0  
  = return m

  | otherwise 
  = do  performGC
        vf'     <- velocitySteps config step vf vs
        df'     <- densitySteps  config step df ds vf'
        return  $ Model df' Nothing vf' Nothing cl (step + 1) dv cb