not-gloss 0.6.1.0 → 0.7.0.0
raw patch · 5 files changed
+71/−41 lines, 5 files
Files
- Vis.hs +17/−1
- Vis/Interface.hs +20/−28
- Vis/Vis.hs +29/−11
- changelog.txt +4/−0
- not-gloss.cabal +1/−1
Vis.hs view
@@ -1,6 +1,8 @@ {-# OPTIONS_GHC -Wall #-} -module Vis ( display+module Vis ( Options(..)+ , defaultOpts+ , display , animate , simulate , play@@ -16,6 +18,20 @@ import Graphics.UI.GLUT ( SpecialKey(..), BitmapFont(..), Flavour(..) ) +import Vis.Vis ( Options(..) ) import Vis.Interface ( display, animate, simulate, play, animateIO, simulateIO, playIO ) import Vis.VisObject ( VisObject(..) ) import Vis.GlossColor++-- | Some reasonable default options.+-- Consider changing the window name with something like:+--+-- > myOptions = defaultOpts {optWindowName = "my rad program"}+defaultOpts :: Options+defaultOpts =+ Options+ { optBackgroundColor = Nothing+ , optWindowSize = Nothing+ , optWindowPosition = Nothing+ , optWindowName = "not-gloss"+ }
Vis/Interface.hs view
@@ -11,35 +11,31 @@ import Graphics.UI.GLUT ( Key, KeyState, Position, Modifiers, Cursor(..) ) -import Vis.Vis ( vis )+import Vis.Vis ( Options, vis ) import Vis.Camera ( makeCamera, Camera0(..), setCamera, cameraMotion, cameraKeyboardMouse ) import Vis.VisObject ( VisObject(..) ) - -- | draw a static image display :: Real b =>- Maybe ((Int,Int),(Int,Int)) -- ^ optional (window size, window position)- -> String -- ^ window name+ Options -- ^ user options -> VisObject b -- ^ object to draw -> IO ()-display sizepos name visobjects = animate sizepos name (\_ -> visobjects)+display opts visobjects = animate opts (\_ -> visobjects) ---- | display an animation animate :: Real b =>- Maybe ((Int,Int),(Int,Int)) -- ^ optional (window size, window position)- -> String -- ^ window name+ Options -- ^ user options -> (Float -> VisObject b) -- ^ draw function -> IO ()-animate sizepos name userDrawFun = animateIO sizepos name (return . userDrawFun)+animate opts userDrawFun = animateIO opts (return . userDrawFun) -- | display an animation impurely animateIO :: Real b =>- Maybe ((Int,Int),(Int,Int)) -- ^ optional (window size, window position)- -> String -- ^ window name+ Options -- ^ user options -> (Float -> IO (VisObject b)) -- ^ draw function -> IO ()-animateIO sizepos name userDrawFun =- vis sizepos name ts (userState0, cameraState0) simFun drawFun setCameraFun (Just kmCallback) (Just motionCallback) Nothing+animateIO opts userDrawFun =+ vis opts ts (userState0, cameraState0) simFun drawFun setCameraFun (Just kmCallback) (Just motionCallback) Nothing where ts = 0.01 userState0 = ()@@ -57,27 +53,25 @@ -- | run a simulation simulate :: Real b =>- Maybe ((Int,Int),(Int,Int)) -- ^ optional (window size, window position)- -> String -- ^ window name+ Options -- ^ user options -> Double -- ^ sample rate -> world -- ^ initial state -> (world -> VisObject b) -- ^ draw function -> (Float -> world -> world) -- ^ state propogation function (takes current time and state as inputs) -> IO ()-simulate sizepos name ts state0 userDrawFun userSimFun =- simulateIO sizepos name ts state0 (return . userDrawFun) (\t -> return . (userSimFun t))+simulate opts ts state0 userDrawFun userSimFun =+ simulateIO opts ts state0 (return . userDrawFun) (\t -> return . (userSimFun t)) -- | run a simulation impurely simulateIO :: Real b =>- Maybe ((Int,Int),(Int,Int)) -- ^ optional (window size, window position)- -> String -- ^ window name+ Options -- ^ user options -> Double -- ^ sample rate -> world -- ^ initial state -> (world -> IO (VisObject b)) -- ^ draw function -> (Float -> world -> IO world) -- ^ state propogation function (takes current time and state as inputs) -> IO ()-simulateIO sizepos name ts userState0 userDrawFun userSimFun =- vis sizepos name ts (userState0, cameraState0) simFun drawFun setCameraFun (Just kmCallback) (Just motionCallback) Nothing+simulateIO opts ts userState0 userDrawFun userSimFun =+ vis opts ts (userState0, cameraState0) simFun drawFun setCameraFun (Just kmCallback) (Just motionCallback) Nothing where drawFun ((userState, _),_) = do obs <- userDrawFun userState@@ -96,8 +90,7 @@ ---- | play a game play :: Real b =>- Maybe ((Int,Int),(Int,Int)) -- ^ optional (window size, window position)- -> String -- ^ window name+ Options -- ^ user options -> Double -- ^ sample time -> world -- ^ initial state -> (world -> (VisObject b, Maybe Cursor)) -- ^ draw function, can give a different cursor@@ -107,8 +100,8 @@ -> Maybe (world -> Position -> world) -- ^ mouse drag callback -> Maybe (world -> Position -> world) -- ^ mouse move callback -> IO ()-play sizepos name ts userState0 userDrawFun userSimFun =- vis sizepos name ts userState0 simFun drawFun+play opts ts userState0 userDrawFun userSimFun =+ vis opts ts userState0 simFun drawFun where drawFun (userState, _) = return $ userDrawFun userState simFun (userState,time) = return $ userSimFun time userState@@ -116,8 +109,7 @@ ---- | play a game impurely playIO :: Real b =>- Maybe ((Int,Int),(Int,Int)) -- ^ optional (window size, window position)- -> String -- ^ window name+ Options -- ^ user options -> Double -- ^ sample time -> world -- ^ initial state -> (world -> IO (VisObject b, Maybe Cursor)) -- ^ draw function, can give a different cursor@@ -127,8 +119,8 @@ -> Maybe (world -> Position -> world) -- ^ mouse drag callback -> Maybe (world -> Position -> world) -- ^ mouse move callback -> IO ()-playIO sizepos name ts userState0 userDrawFun userSimFun =- vis sizepos name ts userState0 simFun drawFun+playIO opts ts userState0 userDrawFun userSimFun =+ vis opts ts userState0 simFun drawFun where drawFun (userState, _) = userDrawFun userState simFun (userState,time) = userSimFun time userState
Vis/Vis.hs view
@@ -1,6 +1,7 @@ {-# OPTIONS_GHC -Wall #-} -module Vis.Vis ( vis+module Vis.Vis ( Options(..)+ , vis , FullState ) where @@ -14,12 +15,25 @@ import Graphics.Rendering.OpenGL.Raw import Vis.VisObject ( VisObject(..), drawObjects, setPerspectiveMode )+import qualified Vis.GlossColor as GC --- user state and internal states+-- | user state and internal states type FullState a = (a, Float) -myGlInit :: Maybe ((Int,Int), (Int,Int)) -> String -> IO ()-myGlInit sizepos progName = do+data Options =+ Options+ { -- ^ optional background color+ optBackgroundColor :: Maybe GC.Color+ -- ^ optional (x,y) window size in pixels+ , optWindowSize :: Maybe (Int,Int)+ -- ^ optional (x,y) window origin in pixels+ , optWindowPosition :: Maybe (Int,Int)+ -- ^ window name+ , optWindowName :: String+ } deriving Show++myGlInit :: Options -> IO ()+myGlInit opts = do initialDisplayMode $= [ DoubleBuffered, RGBAMode, WithDepthBuffer ] Size x y <- get screenSize@@ -30,13 +44,18 @@ y0 = intScale 0.05 y yf = intScale 0.95 y - ((xsize,ysize),(xpos,ypos)) = fromMaybe ((xf-x0,yf-y0), (x0,y0)) sizepos+ (xsize, ysize) = fromMaybe (xf - x0, yf - y0) (optWindowSize opts)+ (xpos, ypos) = fromMaybe (x0,y0) (optWindowPosition opts) initialWindowSize $= Size (fromIntegral xsize) (fromIntegral ysize) initialWindowPosition $= Position (fromIntegral xpos) (fromIntegral ypos)- _ <- createWindow progName+ _ <- createWindow (optWindowName opts) - clearColor $= Color4 0 0 0 0+ case optBackgroundColor opts of+ Nothing -> clearColor $= Color4 0 0 0 0+ Just col -> clearColor $= Color4 (realToFrac r) (realToFrac g) (realToFrac b) (realToFrac a)+ where+ (r,g,b,a) = GC.rgbaOfColor col shadeModel $= Smooth depthFunc $= Just Less lighting $= Enabled@@ -79,8 +98,7 @@ vis :: Real b =>- Maybe ((Int,Int),(Int,Int)) -- ^ optional (window size, window position)- -> String -- ^ window name+ Options -- ^ user options -> Double -- ^ sample time -> a -- ^ initial state -> (FullState a -> IO a) -- ^ sim function@@ -90,12 +108,12 @@ -> Maybe (a -> Position -> a) -- ^ motion callback -> Maybe (a -> Position -> a) -- ^ passive motion callback -> IO ()-vis sizepos windowname ts x0 userSimFun userDraw userSetCamera+vis opts ts x0 userSimFun userDraw userSetCamera userKeyMouseCallback userMotionCallback userPassiveMotionCallback = do -- init glut/scene _ <- getArgsAndInitialize - myGlInit sizepos windowname+ myGlInit opts -- create internal state let fullState0 = (x0, 0)
changelog.txt view
@@ -1,3 +1,7 @@+0.7.0.0:+- pass in user options with Options type+- add an optional background color argument+ 0.6.0.0: - use spatial-math 0.2, which uses types from `linear` package
not-gloss.cabal view
@@ -1,5 +1,5 @@ name: not-gloss-version: 0.6.1.0+version: 0.7.0.0 stability: Experimental synopsis: Painless 3D graphics, no affiliation with gloss description:{