not-gloss-examples 0.2.1 → 0.3.0
raw patch · 5 files changed
+49/−44 lines, 5 filesdep ~basedep ~containersdep ~not-gloss
Dependency ranges changed: base, containers, not-gloss
Files
- not-gloss-examples.cabal +10/−10
- src/Animate.hs +9/−8
- src/Display.hs +8/−8
- src/Play.hs +9/−9
- src/Simulate.hs +13/−9
not-gloss-examples.cabal view
@@ -1,5 +1,5 @@ name: not-gloss-examples-version: 0.2.1+version: 0.3.0 stability: Experimental synopsis: examples for not-gloss license: BSD3@@ -13,33 +13,33 @@ executable not-gloss-display main-is: src/Display.hs- build-depends: not-gloss >= 0.4.1,+ build-depends: not-gloss >= 0.5.0, spatial-math >= 0.1.4 && < 0.2,- base == 4.5.*+ base >= 4.5 && < 4.7 ghc-options: -threaded -O2 executable not-gloss-animate main-is: src/Animate.hs- build-depends: not-gloss >= 0.4.1,+ build-depends: not-gloss >= 0.5.0, spatial-math >= 0.1.4 && < 0.2,- base == 4.5.*+ base >= 4.5 && < 4.7 ghc-options: -threaded -O2 executable not-gloss-simulate main-is: src/Simulate.hs- build-depends: not-gloss >= 0.4.1,+ build-depends: not-gloss >= 0.5.0, spatial-math >= 0.1.4 && < 0.2,- base == 4.5.*+ base >= 4.5 && < 4.7 ghc-options: -threaded -O2 executable not-gloss-game main-is: src/Play.hs- build-depends: not-gloss >= 0.4.1,+ build-depends: not-gloss >= 0.5.0, spatial-math >= 0.1.4 && < 0.2, GLUT == 2.3.*,- containers == 0.4.*,+ containers, X11,- base == 4.5.*+ base >= 4.5 && < 4.7 ghc-options: -threaded -O2
src/Animate.hs view
@@ -13,16 +13,17 @@ x = realToFrac $ -1 + sin (2*time) quat = Quat.normalize $ Quat 1 x (1-x) (x*x) - axes = VisAxes (0.5, 15) (Xyz 0 0 0) (Quat 1 0 0 0)- sphere = VisSphere 0.15 (Xyz 0 x (-1)) Wireframe (makeColor 0.2 0.3 0.8 1)- ellipsoid = VisEllipsoid (0.2, 0.3, 0.4) (Xyz x 0 (-1)) quat Solid (makeColor 1 0.3 0.5 1)- box = VisBox (0.2, 0.2, 0.2) (Xyz 0 0 x) quat Wireframe (makeColor 0 1 1 1)- plane = VisPlane (Xyz 0 0 1) 0 (makeColor 1 1 1 1) (makeColor 0.4 0.6 0.65 0.4)- text k = Vis2dText "OLOLOLOLOLO" (100,500 - k*100*x) TimesRoman24 (makeColor 0 (0.5 + x'/2) (0.5 - x'/2) 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)) $ 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)+ 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 = Vis3dText "trololololo" (Xyz 0 0 (x-0.2)) TimesRoman24 (makeColor 1 0 0 1)+ boxText = Text3d "trololololo" (Xyz 0 0 (x-0.2)) TimesRoman24 (makeColor 1 0 0 1) main :: IO () main = do- animate drawFun+ animate Nothing "animate test" drawFun
src/Display.hs view
@@ -13,16 +13,16 @@ x = -1 quat = Quat.normalize $ Quat 1 2 3 4 - axes = VisAxes (0.5, 15) (Xyz 0 0 0) (Quat 1 0 0 0)- sphere = VisSphere 0.15 (Xyz 0 x (-1)) Wireframe (makeColor 0.2 0.3 0.8 1)- ellipsoid = VisEllipsoid (0.2, 0.3, 0.4) (Xyz x 0 (-1)) quat Solid (makeColor 1 0.3 0.5 1)- box = VisBox (0.2, 0.2, 0.2) (Xyz 0 0 x) quat Wireframe (makeColor 0 1 1 1)- plane = VisPlane (Xyz 0 0 1) 0 (makeColor 1 1 1 1) (makeColor 0.4 0.6 0.65 0.4)- text k = Vis2dText "OLOLOLOLOLO" (100,500 - k*100*x) TimesRoman24 (makeColor 0 (0.5 + x'/2) (0.5 - x'/2) 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)) $ 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)+ 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 = Vis3dText "trololololo" (Xyz 0 0 (x-0.2)) TimesRoman24 (makeColor 1 0 0 1)+ boxText = Text3d "trololololo" (Xyz 0 0 (x-0.2)) TimesRoman24 (makeColor 1 0 0 1) main :: IO () main = do- display drawFun+ display Nothing "display test" drawFun
src/Play.hs view
@@ -7,7 +7,7 @@ import qualified Xyz import Graphics.X11 ( initThreads ) import Vis-import Graphics.UI.GLUT hiding ( motionCallback )+import Graphics.UI.GLUT hiding ( Plane, Sphere, motionCallback ) import qualified Data.Set as Set import Control.Monad ( when )@@ -78,15 +78,15 @@ VisObjects $ [axes,box,ellipsoid,sphere] ++ (map text [-5..5]) ++ [boxText, plane] where x' = -1- axes = VisAxes (0.5, 15) (Xyz 0 0 0) (Quat 1 0 0 0)- sphere = VisSphere 0.15 (Xyz 0 x' (-1)) Wireframe (makeColor 0.2 0.3 0.8 1)- ellipsoid = VisEllipsoid (0.2, 0.3, 0.4) (Xyz x' 0 (-1)) (Quat 1 0 0 0) Solid (makeColor 1 0.3 0.5 1)- box = VisBox (0.2, 0.2, 0.2) (Xyz 0 0 x') (Quat 1 0 0 0) Wireframe (makeColor 0 1 1 1)- plane = VisPlane (Xyz 0 0 1) 0 (makeColor 1 1 1 1) (makeColor 0.4 0.6 0.65 0.4)- text k = Vis2dText "OLOLOLOLOLO" (100,500 - k*100*x') TimesRoman24 (makeColor 0 (0.5 + x''/2) (0.5 - x''/2) 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)+ 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 = Vis3dText "trololololo" (Xyz 0 0 (x'-0.2)) TimesRoman24 (makeColor 1 0 0 1)+ boxText = Text3d "trololololo" (Xyz 0 0 (x'-0.2)) TimesRoman24 (makeColor 1 0 0 1) main :: IO () main = do@@ -94,5 +94,5 @@ setCam (GameState x _ _) = setCamera x drawfun' x = return (drawfun x, Just None) _ <- initThreads- playIO ts state0 drawfun' simfun setCam+ playIO Nothing "play test" ts state0 drawfun' simfun setCam (Just keyMouseCallback) (Just (motionCallback True)) (Just (motionCallback False))
src/Simulate.hs view
@@ -24,16 +24,20 @@ drawFun :: State Double -> VisObject Double drawFun (State (x,_) quat trail) = VisObjects $ [axes,box,ellipsoid,sphere, line] ++ (map text [-5..5]) ++ [boxText, plane] where- axes = VisAxes (0.5, 15) (Xyz 0 0 0) (Quat 1 0 0 0)- sphere = VisSphere 0.15 (Xyz 0 x (-1)) Wireframe (makeColor 0.2 0.3 0.8 1)- ellipsoid = VisEllipsoid (0.2, 0.3, 0.4) (Xyz x 0 (-1)) quat Solid (makeColor 1 0.3 0.5 1)- box = VisBox (0.2, 0.2, 0.2) (Xyz 0 0 x) quat Wireframe (makeColor 0 1 1 1)- plane = VisPlane (Xyz 0 0 1) 0 (makeColor 1 1 1 1) (makeColor 0.4 0.6 0.65 0.4)- text k = Vis2dText "OLOLOLOLOLO" (100,500 - k*100*x) TimesRoman24 (makeColor 0 (0.5 + x'/2) (0.5 - x'/2) 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)) $+ 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)+ 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 = Vis3dText "trololololo" (Xyz 0 0 (x-0.2)) TimesRoman24 (makeColor 1 0 0 1)- line = VisLine' $ zip trail (map (\a -> makeColor 1 0 0 a) (linspace 1 0 (length trail))) -- (makeColor 1 0 0 1)+ boxText = Text3d "trololololo" (Xyz 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] linspace x0 xf n = map (\k -> x0 + (xf - x0) * (fromIntegral k) / (fromIntegral n-1)) [0..(n-1)]@@ -41,4 +45,4 @@ main :: IO () main = do let state0 = State (-1.4,0) (Quat 1 0 0 0) []- simulate ts state0 drawFun simFun+ simulate Nothing "simulate test" ts state0 drawFun simFun