not-gloss-examples 0.3.0 → 0.4.0
raw patch · 6 files changed
+57/−55 lines, 6 filesdep +lineardep ~GLUTdep ~not-glossdep ~spatial-math
Dependencies added: linear
Dependency ranges changed: GLUT, not-gloss, spatial-math
Files
- changelog.txt +2/−0
- not-gloss-examples.cabal +13/−10
- src/Animate.hs +7/−8
- src/Display.hs +7/−8
- src/Play.hs +16/−16
- src/Simulate.hs +12/−13
+ changelog.txt view
@@ -0,0 +1,2 @@+0.4.0:+- use spatial-math 0.2 which uses `linear`
not-gloss-examples.cabal view
@@ -1,5 +1,5 @@ name: not-gloss-examples-version: 0.3.0+version: 0.4.0 stability: Experimental synopsis: examples for not-gloss license: BSD3@@ -11,32 +11,35 @@ build-type: Simple cabal-version: >=1.8 +extra-source-files: changelog.txt+ executable not-gloss-display main-is: src/Display.hs- build-depends: not-gloss >= 0.5.0,- spatial-math >= 0.1.4 && < 0.2,+ build-depends: not-gloss >= 0.6.0,+ linear >= 1.3.1, base >= 4.5 && < 4.7 ghc-options: -threaded -O2 executable not-gloss-animate main-is: src/Animate.hs- build-depends: not-gloss >= 0.5.0,- spatial-math >= 0.1.4 && < 0.2,+ build-depends: not-gloss >= 0.6.0,+ linear >= 1.3.1, base >= 4.5 && < 4.7 ghc-options: -threaded -O2 executable not-gloss-simulate main-is: src/Simulate.hs- build-depends: not-gloss >= 0.5.0,- spatial-math >= 0.1.4 && < 0.2,+ build-depends: not-gloss >= 0.6.0,+ linear >= 1.3.1, base >= 4.5 && < 4.7 ghc-options: -threaded -O2 executable not-gloss-game main-is: src/Play.hs- build-depends: not-gloss >= 0.5.0,- spatial-math >= 0.1.4 && < 0.2,- GLUT == 2.3.*,+ build-depends: not-gloss >= 0.6.0,+ spatial-math >= 0.2.0 && < 0.3,+ linear >= 1.3.1,+ GLUT, containers, X11, base >= 4.5 && < 4.7
src/Animate.hs view
@@ -2,8 +2,7 @@ module Main where -import SpatialMath-import qualified Quat+import Linear import Vis @@ -11,18 +10,18 @@ drawFun time = VisObjects $ [axes,box,ellipsoid,sphere] ++ (map text [-5..5]) ++ [boxText, plane] where x = realToFrac $ -1 + sin (2*time)- quat = Quat.normalize $ Quat 1 x (1-x) (x*x)+ quat = normalize $ Quaternion 1 (V3 x (1-x) (x*x)) axes = Axes (0.5, 15)- sphere = Trans (Xyz 0 x (-1)) $ Sphere 0.15 Wireframe (makeColor 0.2 0.3 0.8 1)+ sphere = Trans (V3 0 x (-1)) $ Sphere 0.15 Wireframe (makeColor 0.2 0.3 0.8 1) - ellipsoid = Trans (Xyz x 0 (-1)) $ RotQuat quat $ Ellipsoid (0.2, 0.3, 0.4) Solid (makeColor 1 0.3 0.5 1)- box = Trans (Xyz 0 0 x) $ RotQuat quat $ Box (0.2, 0.2, 0.2) Wireframe (makeColor 0 1 1 1)- plane = Plane (Xyz 0 0 1) (makeColor 1 1 1 1) (makeColor 0.4 0.6 0.65 0.4)+ ellipsoid = Trans (V3 x 0 (-1)) $ RotQuat quat $ Ellipsoid (0.2, 0.3, 0.4) Solid (makeColor 1 0.3 0.5 1)+ box = Trans (V3 0 0 x) $ RotQuat quat $ Box (0.2, 0.2, 0.2) Wireframe (makeColor 0 1 1 1)+ plane = Plane (V3 0 0 1) (makeColor 1 1 1 1) (makeColor 0.4 0.6 0.65 0.4) text k = Text2d "OLOLOLOLOLO" (100,500 - k*100*x) TimesRoman24 (makeColor 0 (0.5 + x'/2) (0.5 - x'/2) 1) where x' = realToFrac $ (x + 1)/0.4*k/5- boxText = Text3d "trololololo" (Xyz 0 0 (x-0.2)) TimesRoman24 (makeColor 1 0 0 1)+ boxText = Text3d "trololololo" (V3 0 0 (x-0.2)) TimesRoman24 (makeColor 1 0 0 1) main :: IO () main = do
src/Display.hs view
@@ -2,8 +2,7 @@ module Main where -import SpatialMath-import qualified Quat+import Linear import Vis @@ -11,17 +10,17 @@ drawFun = VisObjects $ [axes,box,ellipsoid,sphere] ++ (map text [-5..5]) ++ [boxText, plane] where x = -1- quat = Quat.normalize $ Quat 1 2 3 4+ quat = normalize $ Quaternion 1 (V3 2 3 4) axes = Axes (0.5, 15)- sphere = Trans (Xyz 0 x (-1)) $ Sphere 0.15 Wireframe (makeColor 0.2 0.3 0.8 1)- ellipsoid = Trans (Xyz x 0 (-1)) $ RotQuat quat $ Ellipsoid (0.2, 0.3, 0.4) Solid (makeColor 1 0.3 0.5 1)- box = Trans (Xyz 0 0 x) $ RotQuat quat $ Box (0.2, 0.2, 0.2) Wireframe (makeColor 0 1 1 1)- plane = Plane (Xyz 0 0 1) (makeColor 1 1 1 1) (makeColor 0.4 0.6 0.65 0.4)+ sphere = Trans (V3 0 x (-1)) $ Sphere 0.15 Wireframe (makeColor 0.2 0.3 0.8 1)+ ellipsoid = Trans (V3 x 0 (-1)) $ RotQuat quat $ Ellipsoid (0.2, 0.3, 0.4) Solid (makeColor 1 0.3 0.5 1)+ box = Trans (V3 0 0 x) $ RotQuat quat $ Box (0.2, 0.2, 0.2) Wireframe (makeColor 0 1 1 1)+ plane = Plane (V3 0 0 1) (makeColor 1 1 1 1) (makeColor 0.4 0.6 0.65 0.4) text k = Text2d "OLOLOLOLOLO" (100,500 - k*100*x) TimesRoman24 (makeColor 0 (0.5 + x'/2) (0.5 - x'/2) 1) where x' = realToFrac $ (x + 1)/0.4*k/5- boxText = Text3d "trololololo" (Xyz 0 0 (x-0.2)) TimesRoman24 (makeColor 1 0 0 1)+ boxText = Text3d "trololololo" (V3 0 0 (x-0.2)) TimesRoman24 (makeColor 1 0 0 1) main :: IO () main = do
src/Play.hs view
@@ -3,8 +3,8 @@ module Main ( main ) where -import SpatialMath-import qualified Xyz+import Linear+import SpatialMath ( Euler(..), rotateXyzAboutZ, rotVecByEulerB2A ) import Graphics.X11 ( initThreads ) import Vis import Graphics.UI.GLUT hiding ( Plane, Sphere, motionCallback )@@ -18,21 +18,21 @@ faceHeight :: Double faceHeight = 1.5 -data PlayerState = Running (Xyz Double) (Xyz Double) (Euler Double)+data PlayerState = Running (V3 Double) (V3 Double) (Euler Double) data GameState = GameState { playerState :: PlayerState , keySet :: Set.Set Key , lastMousePos :: Maybe (GLint,GLint) } -toVertex :: (Real a, Fractional b) => Xyz a -> Vertex3 b-toVertex xyz = (\(Xyz x y z) -> Vertex3 x y z) $ fmap realToFrac xyz+toVertex :: (Real a, Fractional b) => V3 a -> Vertex3 b+toVertex xyz = (\(V3 x y z) -> Vertex3 x y z) $ fmap realToFrac xyz setCamera :: PlayerState -> IO ()-setCamera (Running (Xyz x y z) _ euler) = lookAt (toVertex xyz0) (toVertex target) (Vector3 0 0 (-1))+setCamera (Running (V3 x y z) _ euler) = lookAt (toVertex xyz0) (toVertex target) (Vector3 0 0 (-1)) where- xyz0 = Xyz x y (z-faceHeight)- target = xyz0 + rotVecByEulerB2A euler (Xyz 1 0 0)+ xyz0 = V3 x y (z-faceHeight)+ target = xyz0 + rotVecByEulerB2A euler (V3 1 0 0) simfun :: Float -> GameState -> IO GameState simfun _ (GameState (Running pos _ euler0@(Euler yaw _ _)) keys lmp) = do@@ -41,9 +41,9 @@ y' = (fromIntegral y) `div` 2 when (Just (x',y') /= lmp) (pointerPosition $= (Position x' y'))- return $ GameState (Running (pos + (Xyz.scale ts v)) v euler0) keys (Just (x',y'))+ return $ GameState (Running (pos + (ts *^ v)) v euler0) keys (Just (x',y')) where- v = rotateXyzAboutZ (Xyz (w-s) (d-a) 0) (-yaw)+ v = rotateXyzAboutZ (V3 (w-s) (d-a) 0) yaw where w = if Set.member (Char 'w') keys then 3 else 0 a = if Set.member (Char 'a') keys then 3 else 0@@ -79,18 +79,18 @@ where x' = -1 axes = Axes (0.5, 15)- sphere = Trans (Xyz 0 x' (-1)) $ Sphere 0.15 Wireframe (makeColor 0.2 0.3 0.8 1)- ellipsoid = Trans (Xyz x' 0 (-1)) $ Ellipsoid (0.2, 0.3, 0.4) Solid (makeColor 1 0.3 0.5 1)- box = Trans (Xyz 0 0 x') $ Box (0.2, 0.2, 0.2) Wireframe (makeColor 0 1 1 1)- plane = Plane (Xyz 0 0 1) (makeColor 1 1 1 1) (makeColor 0.4 0.6 0.65 0.4)+ sphere = Trans (V3 0 x' (-1)) $ Sphere 0.15 Wireframe (makeColor 0.2 0.3 0.8 1)+ ellipsoid = Trans (V3 x' 0 (-1)) $ Ellipsoid (0.2, 0.3, 0.4) Solid (makeColor 1 0.3 0.5 1)+ box = Trans (V3 0 0 x') $ Box (0.2, 0.2, 0.2) Wireframe (makeColor 0 1 1 1)+ plane = Plane (V3 0 0 1) (makeColor 1 1 1 1) (makeColor 0.4 0.6 0.65 0.4) text k = Text2d "OLOLOLOLOLO" (100,500 - k*100*x') TimesRoman24 (makeColor 0 (0.5 + x''/2) (0.5 - x''/2) 1) where x'' = realToFrac $ (x' + 1)/0.4*k/5- boxText = Text3d "trololololo" (Xyz 0 0 (x'-0.2)) TimesRoman24 (makeColor 1 0 0 1)+ boxText = Text3d "trololololo" (V3 0 0 (x'-0.2)) TimesRoman24 (makeColor 1 0 0 1) main :: IO () main = do- let state0 = GameState (Running (Xyz (-2) 0 0) 0 (Euler 0 0 0)) (Set.empty) Nothing+ let state0 = GameState (Running (V3 (-2) 0 0) 0 (Euler 0 0 0)) (Set.empty) Nothing setCam (GameState x _ _) = setCamera x drawfun' x = return (drawfun x, Just None) _ <- initThreads
src/Simulate.hs view
@@ -2,41 +2,40 @@ module Main where -import SpatialMath-import qualified Quat+import Linear import Vis ts :: Double ts = 0.01 -data State a = State (a,a) (Quat a) [Xyz a]+data State a = State (a,a) (Quaternion a) [V3 a] simFun :: Float -> State Double -> State Double-simFun _ (State (x0,v) q0 trail0) = State (x, v + 5*ts*(-1 - x)) (Quat.qmult' q0 dq) trail+simFun _ (State (x0,v) q0 trail0) = State (x, v + 5*ts*(-1 - x)) (normalize (q0 * dq)) trail where- dq = Quat 1 (x*ts) (v*ts) (x*v*ts)+ dq = Quaternion 1 (V3 (x*ts) (v*ts) (x*v*ts)) x = x0 + v*ts trail- | length trail0 < 75 = (Xyz 0 x (-1)):trail0- | otherwise = take 75 ((Xyz 0 x (-1)):trail0)+ | length trail0 < 75 = (V3 0 x (-1)):trail0+ | otherwise = take 75 ((V3 0 x (-1)):trail0) drawFun :: State Double -> VisObject Double drawFun (State (x,_) quat trail) = VisObjects $ [axes,box,ellipsoid,sphere, line] ++ (map text [-5..5]) ++ [boxText, plane] where axes = Axes (0.5, 15)- sphere = Trans (Xyz 0 x (-1)) $ Sphere 0.15 Wireframe (makeColor 0.2 0.3 0.8 1)- ellipsoid = Trans (Xyz x 0 (-1)) $+ sphere = Trans (V3 0 x (-1)) $ Sphere 0.15 Wireframe (makeColor 0.2 0.3 0.8 1)+ ellipsoid = Trans (V3 x 0 (-1)) $ RotQuat quat $ Ellipsoid (0.2, 0.3, 0.4) Solid (makeColor 1 0.3 0.5 1)- box = Trans (Xyz 0 0 x) $+ box = Trans (V3 0 0 x) $ RotQuat quat $ Box (0.2, 0.2, 0.2) Wireframe (makeColor 0 1 1 1)- plane = Plane (Xyz 0 0 1) (makeColor 1 1 1 1) (makeColor 0.4 0.6 0.65 0.4)+ plane = Plane (V3 0 0 1) (makeColor 1 1 1 1) (makeColor 0.4 0.6 0.65 0.4) text k = Text2d "OLOLOLOLOLO" (100,500 - k*100*x) TimesRoman24 (makeColor 0 (0.5 + x'/2) (0.5 - x'/2) 1) where x' = realToFrac $ (x + 1)/0.4*k/5- boxText = Text3d "trololololo" (Xyz 0 0 (x-0.2)) TimesRoman24 (makeColor 1 0 0 1)+ boxText = Text3d "trololololo" (V3 0 0 (x-0.2)) TimesRoman24 (makeColor 1 0 0 1) line = Line' $ zip trail (map (\a -> makeColor 1 0 0 a) (linspace 1 0 (length trail))) -- (makeColor 1 0 0 1) linspace :: Fractional a => a -> a -> Int -> [a]@@ -44,5 +43,5 @@ main :: IO () main = do- let state0 = State (-1.4,0) (Quat 1 0 0 0) []+ let state0 = State (-1.4,0) (Quaternion 1 (V3 0 0 0)) [] simulate Nothing "simulate test" ts state0 drawFun simFun