Main.hs

   1 module Main where
   2
   3 import Graphics.Rendering.OpenGL
   4 import Graphics.UI.GLUT
   5 import Data.IORef
   6 import Data.Time.Clock
   7 import Fermions
   8
   9 tick :: NominalDiffTime
  10 tick = 0.025
  11
  12 defaultFermionNum :: Float
  13 defaultFermionNum = 100
  14
  15 boxTransform :: Vector -> Vector
  16 boxTransform (x,y,z) = (x/boxSpan, y/boxSpan, z/boxSpan)
  17
  18 pointerTransform :: Size -> (Float, Float) -> Vector
  19 pointerTransform (Size w h) (x, y) = (((2 * x / fromIntegral w) - 1) * boxSpan, (1 - (2 * y / fromIntegral h)) * boxSpan, 0)
  20
  21 main :: IO ()
  22 main = do
  23   (_, args) <- getArgsAndInitialize
  24   _ <- createWindow "Pudding!"
  25   particles <- newIORef (initialState (if null args then defaultFermionNum else (read (head args))))
  26   t <- getCurrentTime
  27   lastUpdate <- newIORef t
  28   displayCallback $= (display particles)
  29   idleCallback $= Just (idle particles lastUpdate)
  30   keyboardMouseCallback $= Just (keyboardMouse particles)
  31   reshapeCallback $= Just reshape
  32   mainLoop
  33
  34 display :: IORef [Fermion] -> IO ()
  35 display particleRef = do
  36   particles <- readIORef particleRef
  37   --putStrLn (show particles)
  38   clear [ColorBuffer]
  39   renderPrimitive Points $ mapM_ getVertex (map (boxTransform . getFermionPos) particles)
  40   flush
  41
  42 keyboardMouse :: (Show a, Show b) => IORef [Fermion] -> Key -> a -> b -> Position -> IO()
  43 keyboardMouse particleRef (Char '1') _ _ (Position x y) = do
  44   viewport' <- get viewport
  45   particles <- readIORef particleRef
  46   let (_, size) = viewport'
  47       pos = (pointerTransform size (fromIntegral x, fromIntegral y))
  48     in do
  49       putStr "Number of particles now: "
  50       putStrLn (show (length particles + 1))
  51       writeIORef particleRef ((pos, (0,0,0), 10, 0) : particles)
  52 keyboardMouse _ _ _ _ _ = return ()
  53
  54 reshape :: Size -> IO ()
  55 reshape s = do
  56   viewport $= (Position 0 0, s)
  57
  58 idle :: IORef [Fermion] -> IORef UTCTime -> IO ()
  59 idle particleRef updateTimeRef = do
  60   lastUpdate <- readIORef updateTimeRef
  61   t <- getCurrentTime
  62   if (t `diffUTCTime` lastUpdate) > tick
  63      then do
  64         particles <- readIORef particleRef
  65         writeIORef particleRef (advanceState particles)
  66         writeIORef updateTimeRef t
  67         postRedisplay Nothing
  68   else
  69     return ()
  70
  71 getVertex :: Vector -> IO ()
  72 getVertex (x, y, z) = vertex $ Vertex3 x y z