not-gloss 0.3.0.1 → 0.4.0

raw patch · 3 files changed

+26/−21 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Vis/Interface.hs +10/−5
• Vis/Vis.hs +15/−15
• not-gloss.cabal +1/−1

@@ -9,7 +9,7 @@                      , playIO                      ) where -import Graphics.UI.GLUT ( Key, KeyState, Position, Modifiers )+import Graphics.UI.GLUT ( Key, KeyState, Position, Modifiers, Cursor(..) )  import Vis.Vis ( vis ) import Vis.Camera ( makeCamera, Camera0(..), setCamera, cameraMotion, cameraKeyboardMouse )@@ -34,7 +34,9 @@     cameraState0 = makeCamera $ Camera0 { phi0 = 60                                         , theta0 = 20                                         , rho0 = 7}-    drawFun (_,time) = userDrawFun time+    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)@@ -61,7 +63,10 @@ simulateIO ts userState0 userDrawFun userSimFun =   vis ts (userState0, cameraState0) simFun drawFun setCameraFun (Just kmCallback) (Just motionCallback) Nothing   where-    drawFun ((userState, _),_) = userDrawFun userState+    drawFun ((userState, _),_) = do+      obs <- userDrawFun userState+      return (obs, Nothing)+     simFun ((userState,cameraState),time) = do       nextUserState <- userSimFun time userState       return (nextUserState, cameraState)@@ -77,7 +82,7 @@ play :: Real b =>         Double -- ^ sample time         -> world -- ^ initial state-        -> (world -> (VisObject b)) -- ^ draw function+        -> (world -> (VisObject b, Maybe Cursor)) -- ^ draw function, can give a different cursor         -> (Float -> world -> world) -- ^ state propogation function (takes current time and state as inputs)         -> (world -> IO ()) -- ^ set where camera looks         -> Maybe (world -> Key -> KeyState -> Modifiers -> Position -> world) -- ^ keyboard/mouse press callback@@ -95,7 +100,7 @@ playIO :: Real b =>           Double -- ^ sample time           -> world -- ^ initial state-          -> (world -> IO (VisObject b)) -- ^ draw function+          -> (world -> IO (VisObject b, Maybe Cursor)) -- ^ draw function, can give a different cursor           -> (Float -> world -> IO world) -- ^ state propogation function (takes current time and state as inputs)           -> (world -> IO ()) -- ^ set where camera looks           -> Maybe (world -> Key -> KeyState -> Modifiers -> Position -> world) -- ^ keyboard/mouse press callback

@@ -7,7 +7,7 @@ import Data.IORef ( newIORef ) import System.Exit ( exitSuccess ) import Data.Time.Clock ( getCurrentTime, diffUTCTime, addUTCTime )-import Control.Concurrent ( MVar, readMVar, swapMVar, newMVar, forkIO, threadDelay )+import Control.Concurrent ( MVar, readMVar, swapMVar, newMVar, takeMVar, putMVar, forkIO, threadDelay ) import Control.Monad ( unless, forever ) import Graphics.UI.GLUT import Graphics.Rendering.OpenGL.Raw@@ -77,15 +77,17 @@        Double -- ^ sample time        -> a   -- ^ initial state        -> (FullState a -> IO a)             -- ^ sim function-       -> (FullState a -> IO (VisObject b)) -- ^ draw function+       -> (FullState a -> IO (VisObject b, Maybe Cursor)) -- ^ draw function, can give a different cursor        -> (a -> IO ())                      -- ^ set camera function        -> Maybe (a -> Key -> KeyState -> Modifiers -> Position -> a) -- ^ keyboard/mouse callback        -> Maybe (a -> Position -> a)              -- ^ motion callback        -> Maybe (a -> Position -> a)              -- ^ passive motion callback        -> IO ()-vis ts x0 userSimFun userDraw userSetCamera userKeyMouseCallback userMotionCallback userPassiveMotionCallback = do+vis ts x0 userSimFun userDraw userSetCamera+  userKeyMouseCallback userMotionCallback userPassiveMotionCallback = do   -- init glut/scene-  (progName, _args) <- getArgsAndInitialize+  (progName, _) <- getArgsAndInitialize+     myGlInit progName       -- create internal state@@ -98,8 +100,10 @@      -- setup the callbacks   let makePictures x = do-        visobs <- userDraw x+        (visobs,cursor') <- userDraw x         drawObjects $ (fmap realToFrac) visobs+        case cursor' of Nothing -> return ()+                        Just cursor'' -> cursor $= cursor''        setCamera = do         (state,_) <- readMVar stateMVar@@ -111,25 +115,22 @@         _ -> case userKeyMouseCallback of           Nothing -> return ()           Just cb -> do-            (state0',time) <- readMVar stateMVar-            let state1 = cb state0' k0 k1 k2 k3-            _ <- state1 `seq` swapMVar stateMVar (state1, time)+            (state0',time) <- takeMVar stateMVar+            putMVar stateMVar (cb state0' k0 k1 k2 k3, time)             postRedisplay Nothing        motionCallback' pos = case userMotionCallback of         Nothing -> return ()         Just cb -> do-          (state0',ts') <- readMVar stateMVar-          let state1 = cb state0' pos-          _ <- state1 `seq` swapMVar stateMVar (state1,ts')+          (state0',ts') <- takeMVar stateMVar+          putMVar stateMVar (cb state0' pos, ts')           postRedisplay Nothing        passiveMotionCallback' pos = case userPassiveMotionCallback of         Nothing -> return ()         Just cb -> do-          (state0',ts') <- readMVar stateMVar-          let state1 = cb state0' pos-          _ <- state1 `seq` swapMVar stateMVar (state1,ts')+          (state0',ts') <- takeMVar stateMVar+          putMVar stateMVar (cb state0' pos, ts')           postRedisplay Nothing    displayCallback $= drawScene stateMVar visReadyMVar setCamera makePictures@@ -140,7 +141,6 @@    -- start main loop   mainLoop-  simThread :: MVar (FullState a) -> MVar Bool -> (FullState a -> IO a) -> Double -> IO () simThread stateMVar visReadyMVar userSimFun ts = do

@@ -1,5 +1,5 @@ name:                not-gloss-version:             0.3.0.1+version:             0.4.0 stability:           Experimental synopsis:            Painless 3D graphics, no affiliation with gloss description:{