module Vis.Interface ( display
, animate
, animateIO
, simulate
, simulateIO
, play
, playIO
) where
import Graphics.UI.GLUT ( Key, KeyState, Position, Modifiers, Cursor(..) )
import Vis.Vis ( vis )
import Vis.Camera ( makeCamera, Camera0(..), setCamera, cameraMotion, cameraKeyboardMouse )
import Vis.VisObject ( VisObject(..) )
display :: Real b =>
Maybe ((Int,Int),(Int,Int))
-> String
-> VisObject b
-> IO ()
display sizepos name visobjects = animate sizepos name (\_ -> visobjects)
animate :: Real b =>
Maybe ((Int,Int),(Int,Int))
-> String
-> (Float -> VisObject b)
-> IO ()
animate sizepos name userDrawFun = animateIO sizepos name (return . userDrawFun)
animateIO :: Real b =>
Maybe ((Int,Int),(Int,Int))
-> String
-> (Float -> IO (VisObject b))
-> IO ()
animateIO sizepos name userDrawFun =
vis sizepos name ts (userState0, cameraState0) simFun drawFun setCameraFun (Just kmCallback) (Just motionCallback) Nothing
where
ts = 0.01
userState0 = ()
cameraState0 = makeCamera $ Camera0 { phi0 = 60
, theta0 = 20
, rho0 = 7}
drawFun (_,time) = do
obs <- userDrawFun time
return (obs, Nothing)
simFun (state,_) = return state
kmCallback (state, camState) k0 k1 _ _ = (state, cameraKeyboardMouse camState k0 k1)
motionCallback (state, cameraState) pos = (state, cameraMotion cameraState pos)
setCameraFun (_,cameraState) = setCamera cameraState
simulate :: Real b =>
Maybe ((Int,Int),(Int,Int))
-> String
-> Double
-> world
-> (world -> VisObject b)
-> (Float -> world -> world)
-> IO ()
simulate sizepos name ts state0 userDrawFun userSimFun =
simulateIO sizepos name ts state0 (return . userDrawFun) (\t -> return . (userSimFun t))
simulateIO :: Real b =>
Maybe ((Int,Int),(Int,Int))
-> String
-> Double
-> world
-> (world -> IO (VisObject b))
-> (Float -> world -> IO world)
-> IO ()
simulateIO sizepos name ts userState0 userDrawFun userSimFun =
vis sizepos name ts (userState0, cameraState0) simFun drawFun setCameraFun (Just kmCallback) (Just motionCallback) Nothing
where
drawFun ((userState, _),_) = do
obs <- userDrawFun userState
return (obs, Nothing)
simFun ((userState,cameraState),time) = do
nextUserState <- userSimFun time userState
return (nextUserState, cameraState)
cameraState0 = makeCamera $ Camera0 { phi0 = 60
, theta0 = 20
, rho0 = 7}
kmCallback (state, camState) k0 k1 _ _ = (state, cameraKeyboardMouse camState k0 k1)
motionCallback (state, cameraState) pos = (state, cameraMotion cameraState pos)
setCameraFun (_,cameraState) = setCamera cameraState
play :: Real b =>
Maybe ((Int,Int),(Int,Int))
-> String
-> 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 sizepos name ts userState0 userDrawFun userSimFun =
vis sizepos name ts userState0 simFun drawFun
where
drawFun (userState, _) = return $ userDrawFun userState
simFun (userState,time) = return $ userSimFun time userState
playIO :: Real b =>
Maybe ((Int,Int),(Int,Int))
-> String
-> 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 sizepos name ts userState0 userDrawFun userSimFun =
vis sizepos name ts userState0 simFun drawFun
where
drawFun (userState, _) = userDrawFun userState
simFun (userState,time) = userSimFun time userState