reactive-glut 0.0.1 → 0.0.2
raw patch · 9 files changed
+33/−230 lines, 9 files
Files
- Makefile +1/−1
- reactive-glut.cabal +2/−5
- src/FRP/Reactive/GLUT/Adapter.hs +16/−12
- src/FRP/Reactive/GLUT/SimpleGL.hs +4/−4
- src/FRP/Reactive/GLUT/SimpleGfx.hs +0/−110
- src/FRP/Reactive/GLUT/UI.hs +5/−5
- src/FTest.hs +0/−88
- src/Test.hs +2/−2
- wikipage.tw +3/−3
Makefile view
@@ -1,1 +1,1 @@-include ../conal-cabal-make.inc+include ../cho-cabal-make.inc
reactive-glut.cabal view
@@ -1,11 +1,11 @@ Name: reactive-glut-Version: 0.0.1+Version: 0.0.2 Cabal-Version: >= 1.2 Synopsis: Connects Reactive and GLUT Category: FRP, graphics Description: This package contains an adapter that connects OpenGL/GLUT to the- library FRP \"Reactive\".+ FRP library \"Reactive\". . Project wiki page: <http://haskell.org/haskellwiki/reactive-glut> .@@ -32,10 +32,7 @@ FRP.Reactive.GLUT.SimpleGL FRP.Reactive.GLUT.UI Test--- Relies on fieldtrip--- FTest ghc-options: -Wall- -- ghc-prof-options: -prof -auto-all
src/FRP/Reactive/GLUT/Adapter.hs view
@@ -12,13 +12,11 @@ ---------------------------------------------------------------------- module FRP.Reactive.GLUT.Adapter- ( adapt+ ( adaptSimple, adapt, simpleInit , Action, Sink- , UI(..)+ , module FRP.Reactive.GLUT.UI ) where --- import Control.Concurrent (yield)- import Control.Applicative ((<$>)) import Control.Monad ((>=>)) @@ -26,19 +24,25 @@ import FRP.Reactive (Behavior,stepper) -import FRP.Reactive.Internal.Misc (Sink,Action)-import FRP.Reactive.Internal.Clock (makeClock,cGetTime)-import FRP.Reactive.Internal.TVal (makeEvent)+import FRP.Reactive.Internal.Misc (Sink,Action)+import FRP.Reactive.Internal.Clock (makeClock,cGetTime)+import FRP.Reactive.Internal.TVal (makeEvent) import FRP.Reactive.Internal.Timing (mkUpdater) import FRP.Reactive.GLUT.UI import FRP.Reactive.GLUT.SimpleGL --- | Adapter to connect @FRP.Reactive@ with @GLUT@.-adapt :: String -> Sink (UI -> Behavior Action)-adapt title f =- do initGfx title- clock <- makeClock+-- | Adapter to connect @FRP.Reactive@ with @GLUT@. Uses given window+-- title and a simple canned initialization. Or do your own+-- initialization and then invoke 'adapt'.+adaptSimple :: String -> Sink (UI -> Behavior Action)+adaptSimple title snk = simpleInit title >> adapt snk++-- | Adapter to connect @FRP.Reactive@ with @GLUT@. Assumes that GL/GLUT+-- have been initialized as desired.+adapt :: Sink (UI -> Behavior Action)+adapt f =+ do clock <- makeClock let mkE = makeEvent clock (mousePosE, mousePosSink ) <- mkE (leftDown , leftDownSink ) <- mkE
src/FRP/Reactive/GLUT/SimpleGL.hs view
@@ -13,7 +13,7 @@ -- With much help from Andy Gill and David Sankel. ---------------------------------------------------------------------- -module FRP.Reactive.GLUT.SimpleGL (initGfx, glwrap, windowPoint) where+module FRP.Reactive.GLUT.SimpleGL (simpleInit, glwrap, windowPoint) where import Graphics.UI.GLUT@@ -35,9 +35,9 @@ h2 = half height half z = realToFrac z / 2 --- Initialize GL graphics-initGfx :: String -> IO ()-initGfx title = do+-- | Simple initialization for GL graphics+simpleInit :: String -> IO ()+simpleInit title = do do getArgsAndInitialize initialDisplayMode $= [ DoubleBuffered, RGBAMode, WithDepthBuffer, WithAlphaComponent ]
− src/FRP/Reactive/GLUT/SimpleGfx.hs
@@ -1,110 +0,0 @@-{-# OPTIONS_GHC -Wall #-}--module FRP.Reactive.GLUT.SimpleGfx- ( initGfx, glwrap, windowPoint- -- remove later- , drawBox- ) where--import Graphics.UI.GLUT--- import Graphics.Rendering.OpenGL as GL--windowWidth, windowHeight :: GLint-windowWidth = 800 -- physical pixels-windowHeight = 600 -- physical pixels--canvasMinX, canvasMaxX, canvasMinY, canvasMaxY :: Double-canvasMaxX = 400 -- logical units-canvasMinX = -400 -- logical units-canvasMaxY = 300 -- logical units-canvasMinY = -300 -- logical units--canvasFarZ, canvasNearZ :: GLclampd-canvasFarZ = 4000-canvasNearZ = -4000---- Initialize GL graphics-initGfx :: String -> IO ()-initGfx title = do- -- Glut Part- getArgsAndInitialize- initialWindowSize $= (Size windowWidth windowHeight)- initialDisplayMode $= [DoubleBuffered, RGBAMode]- createWindow title- -- OpenGL Part- shadeModel $= Smooth- lineSmooth $= Enabled-- lighting $= Enabled- -- Needs to be disabled for fieldtrip- -- colorMaterial $= Just (Front,AmbientAndDiffuse)- light (Light 0) $= Enabled-- -- Enable the following if non-uniform scaling will occur- normalize $= Enabled- -- Enable the following if only uniform scaling will occur- -- rescaleNormal $= Enabled-- -- Set the light up at an infinite distance behind the camera- position (Light 0) $= (Vertex4 0.0 0.0 1.0 0.0)- ambient (Light 0) $= (Color4 0.0 0.0 0.0 1.0)- diffuse (Light 0) $= (Color4 1.0 1.0 1.0 1.0)- specular (Light 0) $= (Color4 1.0 1.0 1.0 1.0)-- -- Some simple defaults here.- materialSpecular (Front) $= (Color4 1.0 1.0 1.0 1.0)- materialEmission (Front) $= (Color4 0.0 0.0 0.0 1.0)- materialShininess (Front) $= 70.0-- blend $= Enabled- blendFunc $= (SrcAlpha, OneMinusSrcAlpha)- lineWidth $= 1.5- clearColor $= Color4 0 0 0 0- pointSmooth $= Enabled- -- pointSize $= 5.0- clearDepth $= canvasFarZ- depthRange $= (canvasNearZ, canvasFarZ)- depthFunc $= Just Lequal- matrixMode $= Projection- loadIdentity- ortho canvasMinX canvasMaxX canvasMinY canvasMaxY canvasNearZ canvasFarZ- matrixMode $= Modelview 0- loadIdentity---- | Convert a window position to a logical X,Y. Logical zero is at the--- origin, and [size??].--- --- TODO: fix to work with variable window size.-windowPoint :: Position -> IO (Double, Double)-windowPoint (Position x y) = return $- let pixToLog p minP maxP l u = - let p0to1 = (realToFrac $ p-minP)/(realToFrac $ maxP-minP)- in (p0to1 * (u-l)) + l- in (pixToLog x 0 (windowWidth-1) canvasMinX canvasMaxX,- -(pixToLog y 0 (windowHeight-1) canvasMinY canvasMaxY))---- | Wrap an OpenGL rendering action, to clear the frame-buffer before--- swap buffers afterward.-glwrap :: IO () -> IO ()-glwrap act = do clearScreen (0.0,0.0,0.0)- -- putStrLn "glwrap"- act- swapBuffers--clearScreen :: (GLdouble, GLdouble, GLdouble) -> IO()-clearScreen (r,g,b) = do- clearColor $= Color4 (realToFrac r) (realToFrac g) (realToFrac b) 0- clear [ColorBuffer, DepthBuffer]---vertexPF :: VertexComponent a => (a,a) -> IO ()-vertexPF = vertex . (uncurry Vertex2)--drawBox :: (MatrixComponent c, Fractional c) => (c, c) -> IO ()-drawBox (centerX,centerY) = preservingMatrix $ do- translate $ Vector3 centerX centerY 0.0- renderPrimitive Polygon (mapM_ vertexPF [- (-10.0::GLdouble ,-10.0),- (-10.0,10.0),- (10.0,10.0),- (10.0,-10.0) ] )
src/FRP/Reactive/GLUT/UI.hs view
@@ -28,11 +28,11 @@ -- | Simple UI type. data UI = UI {- mousePosition :: Behavior (Double,Double),- leftMousePressed :: Event (),- rightMousePressed :: Event (),- keyPressed :: Event Key,- framePass :: Event ()+ mousePosition :: Behavior (Double,Double),+ leftButtonPressed :: Event (),+ rightButtonPressed :: Event (),+ keyPressed :: Event Key,+ framePass :: Event () } -- | Key pressed
− src/FTest.hs
@@ -1,88 +0,0 @@-{-# OPTIONS -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 (Behavior,time)-import FRP.Reactive.GLUT.Adapter---main :: IO ()-main = -- anim2 $ pure.pure $ txt- -- anim2 $ pure $ rotTxt <$> time- -- anim2 track- anim3 spin--txt :: Geometry2-txt = utext "Reactive + FieldTrip"--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)--------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 = adapt "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
@@ -1,4 +1,4 @@-{-# OPTIONS -Wall #-}+{-# OPTIONS_GHC -Wall #-} ---------------------------------------------------------------------- -- | -- Module : Test@@ -20,7 +20,7 @@ import FRP.Reactive.GLUT.Adapter main :: IO ()-main = adapt "Reactive on GLUT" $ (fmap.fmap) view t2+main = adaptSimple "Reactive on GLUT" $ (fmap.fmap) view t2 type G = UI -> Behavior Action
wikipage.tw view
@@ -4,11 +4,11 @@ '''reactive-glut''' connects [[Reactive]] with [[OpenGL#Additional_software|GLUT]] and with [[FieldTrip]]. It also serves as a demonstration for how to hook up imperative (i.e., legacy) libraries [[Reactive]]. -'''Note:''' The <code>conal.net</code> locations below are temporary, while waiting for a project on code.haskell.org.+'''Note:''' The repo has moved from <code>conal.net</code> to <code>code.haskell.org</code>. ~~~~ Besides this wiki page, here are more ways to find out about reactive-glut:-* Read [http://conal.net/repos/reactive-glut/doc/html/ the library documentation].-* Get the code repository: '''<tt>darcs get http://conal.net/repos/reactive-glut</tt>'''.+* Read [http://code.haskell.org/reactive-glut/doc/html/ the library documentation].+* Get the code repository: '''<tt>darcs get http://code.haskell.org/reactive-glut</tt>'''. * Install from [http://hackage.haskell.org/cgi-bin/hackage-scripts/package/reactive-glut Hackage]. * See the [[reactive-glut/Versions| version history]].