diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -1,1 +1,1 @@ -include ../conal-cabal-make.inc +include ../cho-cabal-make.inc diff --git a/reactive-glut.cabal b/reactive-glut.cabal --- a/reactive-glut.cabal +++ b/reactive-glut.cabal @@ -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: . @@ -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 diff --git a/src/FRP/Reactive/GLUT/Adapter.hs b/src/FRP/Reactive/GLUT/Adapter.hs --- a/src/FRP/Reactive/GLUT/Adapter.hs +++ b/src/FRP/Reactive/GLUT/Adapter.hs @@ -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 diff --git a/src/FRP/Reactive/GLUT/SimpleGL.hs b/src/FRP/Reactive/GLUT/SimpleGL.hs --- a/src/FRP/Reactive/GLUT/SimpleGL.hs +++ b/src/FRP/Reactive/GLUT/SimpleGL.hs @@ -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 ] diff --git a/src/FRP/Reactive/GLUT/SimpleGfx.hs b/src/FRP/Reactive/GLUT/SimpleGfx.hs deleted file mode 100644 --- a/src/FRP/Reactive/GLUT/SimpleGfx.hs +++ /dev/null @@ -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) ] ) diff --git a/src/FRP/Reactive/GLUT/UI.hs b/src/FRP/Reactive/GLUT/UI.hs --- a/src/FRP/Reactive/GLUT/UI.hs +++ b/src/FRP/Reactive/GLUT/UI.hs @@ -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 diff --git a/src/FTest.hs b/src/FTest.hs deleted file mode 100644 --- a/src/FTest.hs +++ /dev/null @@ -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 } diff --git a/src/Test.hs b/src/Test.hs --- a/src/Test.hs +++ b/src/Test.hs @@ -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 diff --git a/wikipage.tw b/wikipage.tw --- a/wikipage.tw +++ b/wikipage.tw @@ -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 conal.net locations below are temporary, while waiting for a project on code.haskell.org. +'''Note:''' The repo has moved from conal.net to code.haskell.org. ~~~~ 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: '''darcs get http://conal.net/repos/reactive-glut'''. +* Read [http://code.haskell.org/reactive-glut/doc/html/ the library documentation]. +* Get the code repository: '''darcs get http://code.haskell.org/reactive-glut'''. * Install from [http://hackage.haskell.org/cgi-bin/hackage-scripts/package/reactive-glut Hackage]. * See the [[reactive-glut/Versions| version history]].