{-# OPTIONS_GHC -Wall #-}

module Vis.Interface ( display
                     , animate
                     , animateIO
                     , simulate
                     , simulateIO
                     , play
                     , playIO
                     ) where

import Data.Maybe ( fromMaybe )
import Graphics.UI.GLUT ( Key, KeyState, Position, Modifiers, Cursor(..) )

import Vis.Vis ( Options(..), vis )
import Vis.Camera ( Camera, Camera0(..), makeCamera, setCamera, cameraMotion, cameraKeyboardMouse )
import Vis.VisObject ( VisObject(..) )

-- | draw a static image
display :: Real b =>
           Options -- ^ user options
           -> VisObject b -- ^ object to draw
           -> IO ()
display :: forall b. Real b => Options -> VisObject b -> IO ()
display Options
opts VisObject b
visobjects = forall b. Real b => Options -> (Float -> VisObject b) -> IO ()
animate Options
opts (\Float
_ -> VisObject b
visobjects)

---- | display an animation
animate :: Real b =>
           Options -- ^ user options
           -> (Float -> VisObject b) -- ^ draw function (takes time since start as input)
           -> IO ()
animate :: forall b. Real b => Options -> (Float -> VisObject b) -> IO ()
animate Options
opts Float -> VisObject b
userDrawFun = forall b. Real b => Options -> (Float -> IO (VisObject b)) -> IO ()
animateIO Options
opts (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> VisObject b
userDrawFun)

-- | display an animation impurely
animateIO :: Real b =>
             Options -- ^ user options
             -> (Float -> IO (VisObject b)) -- ^ draw function (takes time since start as input)
             -> IO ()
animateIO :: forall b. Real b => Options -> (Float -> IO (VisObject b)) -> IO ()
animateIO Options
opts Float -> IO (VisObject b)
userDrawFun =
  forall b a.
Real b =>
Options
-> Double
-> a
-> (FullState a -> IO a)
-> (FullState a -> IO (VisObject b, Maybe Cursor))
-> (a -> IO ())
-> Maybe (a -> Key -> KeyState -> Modifiers -> Position -> a)
-> Maybe (a -> Position -> a)
-> Maybe (a -> Position -> a)
-> IO ()
vis Options
opts Double
ts (()
userState0, Camera
cameraState0) forall {m :: * -> *} {a} {b}. Monad m => (a, b) -> m a
simFun forall {a} {a}. (a, Float) -> IO (VisObject b, Maybe a)
drawFun ((), Camera) -> IO ()
setCameraFun (forall a. a -> Maybe a
Just forall {a} {p} {p}.
(a, Camera) -> Key -> KeyState -> p -> p -> (a, Camera)
kmCallback) (forall a. a -> Maybe a
Just forall {a}. (a, Camera) -> Position -> (a, Camera)
motionCallback) forall a. Maybe a
Nothing
  where
    ts :: Double
ts = Double
0.01
    userState0 :: ()
userState0 = ()
    cameraState0 :: Camera
cameraState0 = Camera0 -> Camera
makeCamera forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Camera0
defaultCamera (Options -> Maybe Camera0
optInitialCamera Options
opts)
    drawFun :: (a, Float) -> IO (VisObject b, Maybe a)
drawFun (a
_,Float
time) = do
      VisObject b
obs <- Float -> IO (VisObject b)
userDrawFun Float
time
      forall (m :: * -> *) a. Monad m => a -> m a
return (VisObject b
obs, forall a. Maybe a
Nothing)
    simFun :: (a, b) -> m a
simFun (a
state,b
_) = forall (m :: * -> *) a. Monad m => a -> m a
return a
state
    kmCallback :: (a, Camera) -> Key -> KeyState -> p -> p -> (a, Camera)
kmCallback (a
state, Camera
camState) Key
k0 KeyState
k1 p
_ p
_ = (a
state, Camera -> Key -> KeyState -> Camera
cameraKeyboardMouse Camera
camState Key
k0 KeyState
k1)
    motionCallback :: (a, Camera) -> Position -> (a, Camera)
motionCallback (a
state, Camera
cameraState) Position
pos = (a
state, Camera -> Position -> Camera
cameraMotion Camera
cameraState Position
pos)
    setCameraFun :: ((), Camera) -> IO ()
    setCameraFun :: ((), Camera) -> IO ()
setCameraFun (()
_,Camera
cameraState) = Camera -> IO ()
setCamera Camera
cameraState


-- | run a simulation
simulate :: Real b =>
            Options -- ^ user options
            -> Double -- ^ sample rate
            -> world -- ^ initial state
            -> (world -> VisObject b) -- ^ draw function
            -> (Float -> world -> world) -- ^ state propogation function (takes time since start and state as inputs)
            -> IO ()
simulate :: forall b world.
Real b =>
Options
-> Double
-> world
-> (world -> VisObject b)
-> (Float -> world -> world)
-> IO ()
simulate Options
opts Double
ts world
state0 world -> VisObject b
userDrawFun Float -> world -> world
userSimFun =
  forall b world.
Real b =>
Options
-> Double
-> world
-> (world -> IO (VisObject b))
-> (Float -> world -> IO world)
-> IO ()
simulateIO Options
opts Double
ts world
state0 (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. world -> VisObject b
userDrawFun) (\Float
t -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> world -> world
userSimFun Float
t))

-- | run a simulation impurely
simulateIO :: Real b =>
              Options -- ^ user options
              -> Double -- ^ sample rate    
              -> world -- ^ initial state
              -> (world -> IO (VisObject b)) -- ^ draw function
              -> (Float -> world -> IO world) -- ^ state propogation function (takes time since start and state as inputs)
              -> IO ()
simulateIO :: forall b world.
Real b =>
Options
-> Double
-> world
-> (world -> IO (VisObject b))
-> (Float -> world -> IO world)
-> IO ()
simulateIO Options
opts Double
ts world
userState0 world -> IO (VisObject b)
userDrawFun Float -> world -> IO world
userSimFun =
  forall b a.
Real b =>
Options
-> Double
-> a
-> (FullState a -> IO a)
-> (FullState a -> IO (VisObject b, Maybe Cursor))
-> (a -> IO ())
-> Maybe (a -> Key -> KeyState -> Modifiers -> Position -> a)
-> Maybe (a -> Position -> a)
-> Maybe (a -> Position -> a)
-> IO ()
vis Options
opts Double
ts (world
userState0, Camera
cameraState0) forall {b}. ((world, b), Float) -> IO (world, b)
simFun forall {b} {b} {a}. ((world, b), b) -> IO (VisObject b, Maybe a)
drawFun forall {a}. (a, Camera) -> IO ()
setCameraFun (forall a. a -> Maybe a
Just forall {a} {p} {p}.
(a, Camera) -> Key -> KeyState -> p -> p -> (a, Camera)
kmCallback) (forall a. a -> Maybe a
Just forall {a}. (a, Camera) -> Position -> (a, Camera)
motionCallback) forall a. Maybe a
Nothing
  where
    drawFun :: ((world, b), b) -> IO (VisObject b, Maybe a)
drawFun ((world
userState, b
_),b
_) = do
      VisObject b
obs <- world -> IO (VisObject b)
userDrawFun world
userState
      forall (m :: * -> *) a. Monad m => a -> m a
return (VisObject b
obs, forall a. Maybe a
Nothing)

    simFun :: ((world, b), Float) -> IO (world, b)
simFun ((world
userState,b
cameraState),Float
time) = do
      world
nextUserState <- Float -> world -> IO world
userSimFun Float
time world
userState
      forall (m :: * -> *) a. Monad m => a -> m a
return (world
nextUserState, b
cameraState)
    cameraState0 :: Camera
cameraState0 = Camera0 -> Camera
makeCamera forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Camera0
defaultCamera (Options -> Maybe Camera0
optInitialCamera Options
opts)
    kmCallback :: (a, Camera) -> Key -> KeyState -> p -> p -> (a, Camera)
kmCallback (a
state, Camera
camState) Key
k0 KeyState
k1 p
_ p
_ = (a
state, Camera -> Key -> KeyState -> Camera
cameraKeyboardMouse Camera
camState Key
k0 KeyState
k1)
    motionCallback :: (a, Camera) -> Position -> (a, Camera)
motionCallback (a
state, Camera
cameraState) Position
pos = (a
state, Camera -> Position -> Camera
cameraMotion Camera
cameraState Position
pos)
    setCameraFun :: (a, Camera) -> IO ()
setCameraFun (a
_,Camera
cameraState) = Camera -> IO ()
setCamera Camera
cameraState


---- | play a game
play :: Real b =>
        Options -- ^ user options
        -> Double -- ^ sample time
        -> world -- ^ initial state
        -> (world -> (VisObject b, Maybe Cursor)) -- ^ draw function, can give a different cursor
        -> (Float -> world -> world) -- ^ state propogation function (takes time since start and state as inputs)
        -> (world -> IO ()) -- ^ set where camera looks
        -> Maybe (world -> Key -> KeyState -> Modifiers -> Position -> world) -- ^ keyboard/mouse press callback
        -> Maybe (world -> Position -> world) -- ^ mouse drag callback
        -> Maybe (world -> Position -> world) -- ^ mouse move callback
        -> IO ()
play :: forall b world.
Real b =>
Options
-> Double
-> world
-> (world -> (VisObject b, Maybe Cursor))
-> (Float -> world -> world)
-> (world -> IO ())
-> Maybe
     (world -> Key -> KeyState -> Modifiers -> Position -> world)
-> Maybe (world -> Position -> world)
-> Maybe (world -> Position -> world)
-> IO ()
play Options
opts Double
ts world
userState0 world -> (VisObject b, Maybe Cursor)
userDrawFun Float -> world -> world
userSimFun =
  forall b a.
Real b =>
Options
-> Double
-> a
-> (FullState a -> IO a)
-> (FullState a -> IO (VisObject b, Maybe Cursor))
-> (a -> IO ())
-> Maybe (a -> Key -> KeyState -> Modifiers -> Position -> a)
-> Maybe (a -> Position -> a)
-> Maybe (a -> Position -> a)
-> IO ()
vis Options
opts Double
ts world
userState0 forall {m :: * -> *}. Monad m => (world, Float) -> m world
simFun forall {m :: * -> *} {b}.
Monad m =>
(world, b) -> m (VisObject b, Maybe Cursor)
drawFun
  where
    drawFun :: (world, b) -> m (VisObject b, Maybe Cursor)
drawFun (world
userState, b
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ world -> (VisObject b, Maybe Cursor)
userDrawFun world
userState
    simFun :: (world, Float) -> m world
simFun (world
userState,Float
time) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Float -> world -> world
userSimFun Float
time world
userState


---- | play a game impurely
playIO :: Real b =>
          Options -- ^ user options
          -> Double -- ^ sample time
          -> world -- ^ initial state
          -> (world -> IO (VisObject b, Maybe Cursor)) -- ^ draw function, can give a different cursor
          -> (Float -> world -> IO world) -- ^ state propogation function (takes time since start and state as inputs)
          -> (world -> IO ()) -- ^ set where camera looks
          -> Maybe (world -> Key -> KeyState -> Modifiers -> Position -> world) -- ^ keyboard/mouse press callback
          -> Maybe (world -> Position -> world) -- ^ mouse drag callback
          -> Maybe (world -> Position -> world) -- ^ mouse move callback
          -> IO ()
playIO :: forall b world.
Real b =>
Options
-> Double
-> world
-> (world -> IO (VisObject b, Maybe Cursor))
-> (Float -> world -> IO world)
-> (world -> IO ())
-> Maybe
     (world -> Key -> KeyState -> Modifiers -> Position -> world)
-> Maybe (world -> Position -> world)
-> Maybe (world -> Position -> world)
-> IO ()
playIO Options
opts Double
ts world
userState0 world -> IO (VisObject b, Maybe Cursor)
userDrawFun Float -> world -> IO world
userSimFun =
  forall b a.
Real b =>
Options
-> Double
-> a
-> (FullState a -> IO a)
-> (FullState a -> IO (VisObject b, Maybe Cursor))
-> (a -> IO ())
-> Maybe (a -> Key -> KeyState -> Modifiers -> Position -> a)
-> Maybe (a -> Position -> a)
-> Maybe (a -> Position -> a)
-> IO ()
vis Options
opts Double
ts world
userState0 (world, Float) -> IO world
simFun forall {b}. (world, b) -> IO (VisObject b, Maybe Cursor)
drawFun
  where
    drawFun :: (world, b) -> IO (VisObject b, Maybe Cursor)
drawFun (world
userState, b
_) = world -> IO (VisObject b, Maybe Cursor)
userDrawFun world
userState
    simFun :: (world, Float) -> IO world
simFun (world
userState,Float
time) = Float -> world -> IO world
userSimFun Float
time world
userState


defaultCamera :: Camera0
defaultCamera :: Camera0
defaultCamera =
  Camera0
  { phi0 :: Double
phi0 = Double
60
  , theta0 :: Double
theta0 = Double
20
  , rho0 :: Double
rho0 = Double
7}