packages feed

reactive-fieldtrip 0.0 → 0.0.1

raw patch · 5 files changed

+211/−117 lines, 5 filesdep +vector-spacedep ~FieldTripdep ~reactivedep ~reactive-glut

Dependencies added: vector-space

Dependency ranges changed: FieldTrip, reactive, reactive-glut

Files

reactive-fieldtrip.cabal view
@@ -1,11 +1,12 @@ Name:                reactive-fieldtrip-Version:             0.0+Version:             0.0.1 Cabal-Version:       >= 1.2 Synopsis:            Connect Reactive and FieldTrip Category:            Graphics, FRP Description:-  This library connects ''Reactive'' (a functional reactive-  programming library) and ''FieldTrip'' (a functional 3D library).+  This library supports functionally programming reactive, animated, 3D+  graphics.  It connects ''Reactive'' (a functional reactive programming+  library) and ''FieldTrip'' (a functional 3D library).   .   Project wiki page: <http://haskell.org/haskellwiki/project-foo>   .@@ -25,10 +26,14 @@ Library   hs-Source-Dirs:      src   Extensions:-  Build-Depends:       base, reactive, reactive-glut, FieldTrip+  Build-Depends:       base, reactive >= 0.8.7, reactive-glut >= 0.0.4, FieldTrip >= 0.2.1, vector-space   Exposed-Modules:     -                       FTest+                       FRP.Reactive.FieldTrip.Adapter+  Other-Modules:     +                       Test                           ghc-options:         -Wall  --  ghc-prof-options:    -prof -auto-all ++-- vector-space only used for Test
+ src/FRP/Reactive/FieldTrip/Adapter.hs view
@@ -0,0 +1,48 @@+{-# OPTIONS_GHC -Wall #-}+----------------------------------------------------------------------+-- |+-- Module      :  FRP.Reactive.FieldTrip.Adapter+-- Copyright   :  (c) Conal Elliott 2008+-- License     :  BSD3+-- +-- Maintainer  :  conal@conal.net+-- Stability   :  experimental+-- +-- Simple Reactive/FieldTrip adapter+----------------------------------------------------------------------++module FRP.Reactive.FieldTrip.Adapter+  ( Anim, Anim2, Anim3+  , anim2, anim3+  ) where++import Graphics.FieldTrip+import FRP.Reactive+import FRP.Reactive.GLUT.Adapter++-- | Simple viewing transformation.  Just moves geometry away from the user.+view :: Filter3+view = move3Z (-3 :: R)++-- | Interactive animation+type Anim a = UI -> Behavior a++-- | Interactive 2D animation+type Anim2 = Anim Geometry2++-- | Interactive 3D animation+type Anim3 = Anim Geometry3++-- | Present an animation, given a way to render a value.+animate :: Sink a -> Sink (Anim a)+animate f anim = adaptSimple "Reactive + FieldTrip" ((fmap.fmap) f anim)++-- | Present a 2D animation.+anim2 :: Sink Anim2+anim2 = anim3 . (fmap.fmap) flatG++-- | Present a 2D animation.+anim3 :: Sink Anim3+anim3 = animate (renderWith3 gc . view)+ where+   gc = defaultGC { gcErr = 0.005 }
− src/FTest.hs 
@@ -1,111 +0,0 @@-{-# OPTIONS_GHC -Wall #-}-------------------------------------------------------------------------- |--- Module      :  FTest--- Copyright   :  (c) Conal Elliott 2008--- License     :  BSD3--- --- Maintainer  :  conal@conal.net--- Stability   :  experimental--- --- Test Reactive + FieldTrip-------------------------------------------------------------------------module FTest where--import Data.Monoid-import Control.Applicative--import Graphics.FieldTrip--import FRP.Reactive-import FRP.Reactive.GLUT.Adapter---main :: IO ()-main = -- anim2 $ pure.pure $ txt-       -- anim2 $ pure $ rotTxt <$> time-       -- anim2 track-       -- anim2 $ revTxt "Let's have fun!"-       -- anim3 spin-       anim2 $ (fmap.fmap) rotTxt (uiIntegral signFlip)--txt :: Geometry2-txt = utext "Reactive + FieldTrip"----- Accumulate function applications on each left button press-accumLB :: a -> (a->a) -> (UI -> Behavior a)-accumLB a f ui = a `accumB` (f <$ leftButtonPressed ui)---- Flip between 1 & -1 on left button pres-signFlip :: UI -> Behavior Double-signFlip = accumLB 1 negate---- Reverse text on left button press-revTxt :: String -> (UI -> Behavior Geometry2)-revTxt str ui = utext <$> accumLB str reverse ui---- revTxt = (fmap.fmap.fmap) utext (flip accumLB reverse)--rotTxt :: Double -> Geometry2-rotTxt t = rotate2 t *% txt--track :: Anim Geometry2-track = (fmap.fmap) (f . uncurry Vector2) mousePosition- where-   f = (uscale2 (0.5::Float) *%) . utext . show--spin :: Anim Geometry3-spin = spinningG $-         -- usphere-         torusPair-         -- flatG txt--torusPair :: Geometry3-torusPair = f red (1/2) `mappend` pivot3X (f green (-1/2))- where-   tor = torus 1 (2/5)-   f :: Col -> R -> Geometry3-   f col dx = plasmat col (move3X dx tor)---- Start at zero with a velocity of one.  Negate velocity on each event occurrence.-reverseVel :: (UI -> Event a) -> (UI -> Behavior Double)-reverseVel ue = uiIntegral vel- where-    vel ui = 1 `accumB` (negate <$ ue ui)--------plasmat :: Col -> Filter3-plasmat col = materialG (plastic col)--spinningG :: Geometry3 -> Anim Geometry3-spinningG g env = liftA2 (*%) (spinning env) (pure g)--spinning :: Anim (Transform3 Double)-spinning = const (xf . (*2) <$> time)- where-   xf t = translate3 (Vector3 (0::Double) 0 (3*sin (-t/5)))-            `mappend` rotate3 t (Vector3 0.1 0.2 0.3)-            `mappend` scale3 0.2 0.2 0.2--{---------------------------------------------------------------------    Move to reactive-fieldtrip---------------------------------------------------------------------}--view :: Filter3-view = move3Z (-3 :: R)--type Anim a = UI -> Behavior a--animate :: Sink a -> Sink (Anim a)-animate f anim = adaptSimple "Reactive + FieldTrip" ((fmap.fmap) f anim)--anim2 :: Sink (Anim Geometry2)-anim2 = anim3 . (fmap.fmap) flatG--anim3 :: Sink (Anim Geometry3)-anim3 = animate (renderWith3 gc . view)- where-   gc = defaultGC { gcErr = 0.005 }
+ src/Test.hs view
@@ -0,0 +1,152 @@+{-# OPTIONS_GHC -Wall #-}+----------------------------------------------------------------------+-- |+-- Module      :  Test+-- Copyright   :  (c) Conal Elliott 2008+-- License     :  BSD3+-- +-- Maintainer  :  conal@conal.net+-- Stability   :  experimental+-- +-- Test Reactive + FieldTrip+----------------------------------------------------------------------++module Test where++import Data.Monoid+import Control.Applicative++import Data.VectorSpace++import FRP.Reactive+import FRP.Reactive.GLUT.Adapter++import Graphics.FieldTrip++import FRP.Reactive.FieldTrip.Adapter+++main :: IO ()+main = -- anim2 $ pure.pure $ txt+       -- anim2 $ pure $ rotTxt <$> time+       -- anim2 track+       -- anim2 $ revTxt "Let's have fun!"+       -- anim3 spin+       -- anim2 $ (fmap.fmap) rotTxt (uiIntegral signFlip)+       -- anim3 $ (pure.pure) (move3Z (-5::R) (uscale3 (0.5::R) *% torusPair))+       -- anim3 $ drops . leftButtonPressed+       -- anim3 ldrops+       anim3 lplace+       -- anim3 motionTxt++txt :: Geometry2+txt = utext "Reactive + FieldTrip"+++-- Accumulate function applications on each left button press+accumLB :: a -> (a->a) -> Anim a+accumLB a f ui = a `accumB` (f <$ leftButtonPressed ui)++-- Flip between 1 & -1 on left button pres+signFlip :: Anim Double+signFlip = accumLB 1 negate++-- Reverse text on left button press+revTxt :: String -> Anim2+revTxt str ui = utext <$> accumLB str reverse ui++-- revTxt = (fmap.fmap.fmap) utext (flip accumLB reverse)++rotTxt :: Double -> Geometry2+rotTxt t = rotate2 t *% txt++motionTxt :: Anim3+motionTxt = (fmap.fmap) (flatG . (uscale2 (0.5::R) *%) . utext . show) mouseMotion++track :: Anim2+track = (fmap.fmap) (f . uncurry Vector2) mousePosition+ where+   f = (uscale2 (0.5::Float) *%) . utext . show++spin :: Anim3+spin = spinningG $+         -- usphere+         torusPair+         -- flatG txt++torusPair :: Geometry3+torusPair = f red (1/2) `mappend` pivot3X (f green (-1/2))+ where+   tor = torus 1 (2/5)+   f :: Col -> R -> Geometry3+   f col dx = plasmat col (move3X dx tor)++-- Start at zero with a velocity of one.  Negate velocity on each event occurrence.+reverseVel :: (UI -> Event a) -> Anim Double+reverseVel ue = uiIntegral vel+ where+    vel ui = 1 `accumB` (negate <$ ue ui)+++-- Drop a ball on each event occurrence+drops :: Event () -> Behavior Geometry3+drops e = monoidB (g <$> withTimeE_ e)+ where+   g0   = uscale3 (0.3 :: R) *% torusPair+   g t0 = liftA2 (*%) (f <$> time) (pure g0)+    where+      f t = translate3 (Vector3 (t-t0) 0 (-5))++-- Drop a ball on each event occurrence+drops' :: Event (Vector3 Double) -> Event () -> Behavior Geometry3+drops' starts tick = monoidB (g <$> (starts `snapRemainderE` tick))+ where+   g0              = uscale3 (0.3 :: R) *% torusPair+   g (start,tick') = f <$> integral tick' (integral tick' acc)+     where+       f pos = translate3 (start ^+^ pos) *% g0+   acc             = pure ((-2) *^ yVector3)++-- Drop a ball from the mouse on each left button press.+ldrops :: Anim3+ldrops ui =+  drops' (leftButtonPressed ui `snapshot_` mouseMotion ui)+         (framePass ui)++-- Place a ball on each event occurrence+place :: Event (Vector3 Double) -> Behavior Geometry3+place starts = monoidB (g <$> starts)+ where+   g start = f <$> spinningG torusPair (error "blort!")+    where f = (translate3 start *%)++-- Drop a ball from the mouse on each left button press.+lplace :: Anim3+lplace ui = place (leftButtonPressed ui `snapshot_` mouseMotion ui)++-- lplace = place . liftA2 snapshot_ leftButtonPressed mouseMotion++++----++mouseMotion :: Anim (Vector3 Double)+mouseMotion = (fmap.fmap) f mousePosition+ where+   f (mx,my) = vector3 mx my 0++plasmat :: Col -> Filter3+plasmat col = materialG (plastic col)++spinningG :: Geometry3 -> Anim3+spinningG g env = liftA2 (*%) (spinning env) (pure g)++spinning :: Anim (Transform3 Double)+spinning = const (xf . (*2) <$> time)+ where+   xf t =           translate3 (Vector3 (0::Double) 0 (3*sin (-t/5)))+          `mappend` rotate3 t (Vector3 0.1 0.2 0.3)+          `mappend` uscale3 0.2++-- Strange bug: if I increase the scale factor more than a tiny amount+-- above 0.28, I get flat white shading.
wikipage.tw view
@@ -4,7 +4,7 @@  == Abstract == -The '''reactive-fieldtrip''' library connects [[reactive]]] (a functional reactive programming library) and [[FieldTrip]]] (a functional 3D library).+'''reactive-fieldtrip''' connects the [[Reactive]] (FRP) and [[FieldTrip]] (functional 3D) libraries, for functionally programming reactive, animated, 3D graphics.  Besides this wiki page, here are more ways to find out about reactive-fieldtrip: * Read [http://code.haskell.org/reactive-fieldtrip/doc/html/ the library documentation].