liveplot (empty) → 0.0.1
raw patch · 11 files changed
+674/−0 lines, 11 filesdep +GLFW-bdep +GLUtildep +OpenGLsetup-changed
Dependencies added: GLFW-b, GLUtil, OpenGL, Vec, andromeda, base, bytestring, containers, directory, filepath, lens, linear, liveplot, mvc, pipes, pipes-extras, pipes-misc, stm, time, transformers, vector, vinyl, vinyl-gl
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- app/App.hs +7/−0
- liveplot.cabal +56/−0
- src/Graphics/Liveplot.hs +21/−0
- src/Graphics/Liveplot/Demo.hs +38/−0
- src/Graphics/Liveplot/Line.hs +89/−0
- src/Graphics/Liveplot/Shaders.hs +58/−0
- src/Graphics/Liveplot/Types.hs +101/−0
- src/Graphics/Liveplot/Utils.hs +71/−0
- src/Graphics/Liveplot/Window.hs +201/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017, Richard Marko++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Anthony Cowley nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/App.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE DataKinds, TypeOperators #-}++import Graphics.Liveplot+import Graphics.Liveplot.Demo++main :: IO ()+main = runDemo
+ liveplot.cabal view
@@ -0,0 +1,56 @@+name: liveplot+version: 0.0.1+synopsis: Liveplotting++description: Live plotting with OpenGL. This Haskell library allows feeding live data via Pipes to OpenGL plots.++license: BSD3+license-file: LICENSE+author: Richard Marko+maintainer: srk@48.io+copyright: Copyright (C) 2017 Richard Marko+category: Graphics+build-type: Simple+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Graphics.Liveplot+ Graphics.Liveplot.Demo+ Graphics.Liveplot.Line+ Graphics.Liveplot.Shaders+ Graphics.Liveplot.Types+ Graphics.Liveplot.Utils+ Graphics.Liveplot.Window+ build-depends: base >= 4.6 && < 5,+ andromeda,+ bytestring,+ containers,+ directory,+ filepath,+ GLFW-b,+ GLUtil,+ lens,+ linear,+ mvc,+ OpenGL,+ pipes,+ pipes-misc,+ pipes-extras,+ stm,+ time,+ transformers,+ Vec,+ vector,+ vinyl,+ vinyl-gl++ default-language: Haskell2010+ ghc-options: -Wall++executable liveplot+ main-is: App.hs+ hs-source-dirs: app+ build-depends: base >= 4.6 && < 5,+ liveplot+ default-language: Haskell2010
+ src/Graphics/Liveplot.hs view
@@ -0,0 +1,21 @@+module Graphics.Liveplot (+ runLiveplot+ , named+ , initGraph+ , lineGraph+ , SensorReading(..)+ , GLApp+ , Event+ , GLfloat+ , rpad+ , ogl) where++import MVC+import Graphics.Liveplot.Window+import Graphics.Liveplot.Types+import Graphics.Liveplot.Utils+import Graphics.Rendering.OpenGL (GLfloat)++runLiveplot :: Plottable a => Managed (View (Either (SensorReading a) GLApp), Controller (Either (SensorReading a) Event)) -> IO ()+runLiveplot app = runMVC () (asPipe defaultPipe) app+
+ src/Graphics/Liveplot/Demo.hs view
@@ -0,0 +1,38 @@+module Graphics.Liveplot.Demo where++import MVC+import qualified MVC.Prelude as MVC+import qualified Pipes.Prelude as Pipes+import Control.Concurrent (threadDelay)++import Graphics.Liveplot++runDemo :: IO()+runDemo = runLiveplot demo++demo :: Managed (View (Either (SensorReading GLfloat) GLApp),+ Controller (Either (SensorReading GLfloat) Event))+demo = do+ let inits = [ lineGraph "adc" (2, 1) (0, 0)+ , lineGraph "dac" (2, 1) (1, 0)]++ (v, c) <- ogl inits++ dat <- MVC.producer (bounded 1) (sinedata 5 10 >-> named "adc")+ dat2 <- MVC.producer (bounded 1) (sinedata 100 10 >-> named "dac")+ return (v, fmap Left (dat <> dat2) <> fmap Right c)++sinedata :: Float -> Float -> Producer GLfloat IO ()+sinedata hz divider =+ hztick hz+ >-> Pipes.map ((/2). (+1) . (sin) . (/divider))++moiredata :: Float -> Producer GLfloat IO ()+moiredata hz =+ hztick hz+ >-> Pipes.map ((/2). (+1) . (sin) . (/2))++hztick :: (Num t, RealFrac t1) => t1 -> MVC.Proxy x' x () t IO b+hztick hz = run 0+ where+ run n = yield n >> (lift $ threadDelay $ floor $ 1000000/hz) >> run (n+1)
+ src/Graphics/Liveplot/Line.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Graphics.Liveplot.Line where+import Data.Vinyl+import Graphics.GLUtil+import Graphics.Rendering.OpenGL+import Graphics.VinylGL+import Linear (V1(..))+import Control.Concurrent.STM++import Graphics.Liveplot.Shaders+import Graphics.Liveplot.Types++type XPos = '("xCoord", V1 GLfloat)++xcoord :: SField XPos+xcoord = SField++monoTex :: Int -> IO TextureObject+monoTex len = do+ t <- freshTextureFloat len 1 TexMono+ textureFilter Texture2D $= ((Linear', Nothing), Linear')+ texture2DWrap $= (Repeated, ClampToEdge)+ return t++line :: GraphInfo -> IO (Maybe [GLfloat] -> GraphInfo -> IO ())+line gi =+ do s <- uncurry simpleShaderProgramBS lineShaders++ let nsamples = graph_samples gi+ xResolution = graph_resolution gi+ pResolution = graph_points gi++ isamples = fromIntegral nsamples+ xCoords :: [GLfloat]+ xCoords = take xResolution $ iterate (+ 2 / fromIntegral xResolution) (-1)+ _pointCoords :: [GLfloat]+ _pointCoords = take pResolution $ iterate (+ 2 / fromIntegral pResolution) (-1)+ yCoords :: [GLfloat]+ yCoords = replicate nsamples 0++ vb <- bufferVertices . map (xcoord =:) $ V1 <$> xCoords -- <*> [0.0]-- [-1.0,1.0] <*> [-1.0,1.0]+ --_vp <- bufferVertices . map (xcoord =:) $ V1 <$> pointCoords+ t <- monoTex nsamples+ reloadTexture t (TexInfo isamples 1 TexMono yCoords)+ -- need to set current program here or setUniforms fails+ currentProgram $= Just (program s)+ setUniforms s (texSampler =: 0)++ --let vp = withViewport (Position 10 10) (Size 1024 60)++ -- no idea why this can't use vp+ pointsVAO <- makeVAO $ do enableVertices' s vb+ bindVertices vb++ linesVAO <- makeVAO $ do enableVertices' s vb+ bindVertices vb+ return $ \d GraphInfo{..} -> do+ currentProgram $= Just (program s)+ setUniforms s graph_appinfo+ let withVP = withVP' graph_viewport graph_scale graph_offset+ case d of+ Just dat -> reloadTexture t (TexInfo isamples 1 TexMono dat)+ Nothing -> return ()+ withVP $ withVAO linesVAO . withTextures2D [t] $+ drawArrays LineStrip 0 (fromIntegral xResolution)++ -- XXX: use point texture+ withVP $ withVAO pointsVAO . withTextures2D [t] $+ drawArrays Points 0 (fromIntegral pResolution)++ where+ texSampler = SField :: SField '("tex", GLint)+ withVP' (Position x y, Size w h) (xsc, ysc) (xoff, yoff) = withViewport+ (Position (x + (fromIntegral yoff) * w')+ (y + (fromIntegral xoff) * h'))+ (Size w' h')+ where+ w' = floor $ fromIntegral w / ysc+ h' = floor $ fromIntegral h / xsc++instance Plottable GLfloat where+ initplot gi = do+ tvar <- atomically $ newTVar Nothing+ draw <- line gi+ return (tvar, bufferTVar (graph_name gi) (graph_samples gi) tvar, draw)
+ src/Graphics/Liveplot/Shaders.hs view
@@ -0,0 +1,58 @@+module Graphics.Liveplot.Shaders where++import Data.Vec ((:.)(..), Vec3, Vec4)++import qualified Data.Vector.Storable as V++import qualified Data.ByteString.Char8 as BS++import Andromeda.Simple.Expr+import Andromeda.Simple.Type+import Andromeda.Simple.GLSL+import Andromeda.Simple.StdLib+import Andromeda.Simple.Render.Compile++compileBS :: Statement () -> Statement () -> (BS.ByteString, BS.ByteString)+compileBS vert frag =+ let vStr = version ++ toGLSL vert+ fStr = version ++ toGLSL frag+ in (BS.pack vStr, BS.pack fStr)+ where+ version :: String+ version = "#version 330 core\n"++test :: IO ()+test =+ let (vs, fs) = compileBS lineVertShader lineFragShader+ in do+ BS.putStrLn vs+ BS.putStrLn fs++lineShaders :: (BS.ByteString, BS.ByteString)+lineShaders = compileBS lineVertShader lineFragShader++positionColor :: (Expr (Vec4 Float), Expr (Vec4 Float))+positionColor =+ let xCoord = fetch "xCoord" (ScalarT SFloat)+ cam = uniform "cam" (Matrix3T SFloat)+ tex = uniform "tex" Sampler2DT+ yCoord = (((texture tex+ (flt ((xCoord + 1)/2) +: flt 0.0)) ~> "r") - (flt 0.5)) * (flt 2.0)++ col = yCoord / 2.0 + 0.5++ in (((cam #* (flt xCoord +: flt yCoord +: flt 1.0)) +: flt 1.0)+ ,(flt (yCoord/2 + 0.5) +: flt (1 - col) +: flt 0.0 +: flt 1.0))++lineVertShader :: Statement ()+lineVertShader = do+ "gl_Position" =: fst positionColor+ out "fColor" $ snd positionColor++outColor :: Expr (Vec4 Float)+outColor =+ let f_color = fetch "fColor" (Vec4T SFloat)+ in f_color++lineFragShader :: Statement ()+lineFragShader = out "fragColor" outColor
+ src/Graphics/Liveplot/Types.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+module Graphics.Liveplot.Types where++import Linear (V2, M33)+import Data.Vinyl+import Graphics.Rendering.OpenGL (GLfloat, Position(..), Size(..))+import Graphics.GLUtil.Camera2D+import Graphics.UI.GLFW+import MVC (Pipe)+import Data.Set (Set)+import Control.Concurrent.STM+import qualified Pipes.Prelude as Pipes++import Graphics.Liveplot.Utils++-- OpenGL events+data Event =+ Timestep Double+ | Keys (Set Key)+ | Buttons (Set MouseButton)+ | MousePos (V2 Double)+ | WinSize (V2 Int)+ | Quit+ deriving Show++-- A record each drawing function will receive.+type Viewport = (Position, Size)+type AppInfo = FieldRec '[ '("cam", M33 GLfloat) ]++data GLApp = GLApp AppInfo Viewport+ deriving Show++data SensorReading a = Reading String a+ deriving (Eq, Show)++instance Functor SensorReading where+ fmap f (Reading s v) = (Reading s (f v))++type PlotInit a = (TVar (Maybe [a]), (SensorReading a) -> IO (), Maybe [a] -> GraphInfo -> IO ())++class Plottable a where+ initplot :: GraphInfo -> IO (PlotInit a)++accepts :: String -> SensorReading t -> Bool+accepts n (Reading s' _) = n == s'++named :: Monad m => String -> Pipe a (SensorReading a) m r+named n = Pipes.map (\x -> Reading n x)++-- buffer value and values in TVar+bufferTVar :: Fractional a =>+ String -> Int -> TVar (Maybe [a]) -> SensorReading a -> IO ()+bufferTVar name buflen tvar sample@(Reading _ val) = do+ case accepts name sample of+ True -> atomically $ do+ mtvar <- readTVar tvar+ case mtvar of+ Just cval -> writeTVar tvar $ Just $ rpad buflen 0.0 $ take buflen $ val:cval+ Nothing -> writeTVar tvar $ Just $ replicate buflen 0.0+ _ -> return ()++data GraphColor = Red | Green+ deriving (Show, Eq, Ord)++data GraphInfo = GraphInfo {+ graph_name :: String+ , graph_appinfo :: AppInfo+ , graph_viewport :: Viewport+ , graph_samples :: Int+ , graph_resolution :: Int+ , graph_color :: GraphColor+ , graph_points :: Int+ , graph_scale :: (Float, Float)+ , graph_offset :: (Int, Int)+ }+ deriving (Show, Eq, Ord)++defaultCam :: Camera GLfloat+defaultCam = camera2D++defaultViewport :: Viewport+defaultViewport = (Position 0 0, Size 1920 1080)++defaultAppInfo :: AppInfo+defaultAppInfo = SField =: camMatrix defaultCam++defGI :: GraphInfo+defGI = GraphInfo {+ graph_name = "unnamed"+ , graph_appinfo = defaultAppInfo+ , graph_viewport = defaultViewport+ , graph_samples = 100+ , graph_resolution = 100+ , graph_color = Red+ , graph_points = 100+ , graph_scale = (1, 1)+ , graph_offset = (0, 0)+ }
+ src/Graphics/Liveplot/Utils.hs view
@@ -0,0 +1,71 @@+module Graphics.Liveplot.Utils(+ dump+ , dbg+ , moveCam+ , cnf+ , cnfEndo+ , rpad+ ) where++import Prelude+import Control.Concurrent.STM+import Data.Monoid (All(..), Any(..))+import Data.Foldable (Foldable, foldMap,foldl',fold)+import Data.Set (Set)+import qualified Data.Set as S++import Linear+import MVC+import Graphics.GLUtil.Camera2D+import Graphics.GLUtil.Camera3D hiding (roll)+import Graphics.UI.GLFW++dump :: View a+dump = asSink (\_ -> return())++dbg :: (Show a) => View a+dbg = asSink (\e -> (putStrLn $ show e) >> return())++-- | Evaluate a boolean formula in conjunctive normal form (CNF) by+-- applying the predicate to each atom according to the logic of its+-- nesting in the formula.+cnf :: (Foldable s, Foldable t) => s (t Bool) -> Bool+cnf = getAll . foldMap (All . getAny . foldMap Any)++-- | Perform a left fold over a set of guarded update functions,+-- evaluating the guards left-to-right. For each guard that passes,+-- its associated update function is composed into a final composite+-- update function.+cnfEndo :: (k -> s -> Bool) -> (k -> s -> s) -> [([[k]], a -> a)] -> s -> a -> a+cnfEndo p del = go+ where go [] _ = id+ go ((k,f):fs) s | cnf (fmap (fmap (`p` s)) k) = go fs (delAll k s) . f+ | otherwise = go fs s+ delAll k s = foldl' (flip del) s (fold k)++-- | Translate and rotate a 'Camera' based on 'UI' input.+moveCam :: (Conjugate a, Epsilon a, RealFloat a) => Set Key -> Camera a -> Camera a+moveCam keys = cnfEndo S.member S.delete + [ ([shift, [Key'Left]], roll na)+ , ([shift, [Key'Right]], roll pa)+ , ([[Key'Left]], track (V2 np 0))+ , ([[Key'Right]], track (V2 pp 0))+ , ([[Key'Up]], track (V2 0 pp))+ , ([[Key'Down]], track (V2 0 np))+ --- XXX: tilting instead of zooming, how to zoom in 2d with cam?+ -- maybe just switch to 3d cam+ , ([[Key'PageUp]], tilt (pa))+ , ([[Key'PageDown]], tilt (na))+ ]+ keys+ where shift = [Key'LeftShift, Key'RightShift]+ -- XXX: pass timeScale as well? (Normalize speeds to 60Hz update)+ timeScale = 1 -- realToFrac $ timeStep ui * 60+ pp = 0.08 * timeScale -- 1D speed+ np = negate pp+ pa = 2 * timeScale -- angular step+ na = negate pa+++rpad :: Int -> a -> [a] -> [a]+rpad n x xs = xs ++ (take (n-(length xs)) $ repeat x)
+ src/Graphics/Liveplot/Window.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE FlexibleContexts #-}+module Graphics.Liveplot.Window where++import Prelude hiding (init)+import Control.Monad+import Control.Lens ((^.), contains, _Left, _Right)+import Data.IORef+import Data.Maybe (isNothing)+import Data.Set (Set)+import qualified Data.Set as S+import Data.Time.Clock+import Graphics.UI.GLFW+import Linear+-- moi+import MVC+import qualified MVC.Prelude as MVC+import Graphics.Rendering.OpenGL+import Graphics.GLUtil.Camera2D+import Data.Vinyl++import Control.Concurrent (threadDelay)+import Control.Concurrent.STM++import Pipes.Extras ((+++))++import Graphics.Liveplot.Types+import Graphics.Liveplot.Utils+--- XXX: this has something to do with orphan instance in G.L.Line+import Graphics.Liveplot.Line++initGraph :: String -> (Float, Float) -> (Int, Int)-> GraphInfo+initGraph name scale' offset = defGI {+ graph_name = name+ , graph_offset = offset+ , graph_scale = scale'+ }++lineGraph :: String -> (Float, Float) -> (Int, Int) -> (GraphInfo, GLfloat)+lineGraph name scale' offset = (defGI+ { graph_name = name+ , graph_offset = offset+ , graph_scale = scale'+ }, 0)++-- add scroll input callback+-- http://www.glfw.org/docs/latest/input_guide.html#scrolling+ogl :: (Plottable a) => [(GraphInfo, a)]+ -> Managed (View (Either (SensorReading a) GLApp), Controller Event)+ogl parts = join $ managed $ \k -> do+ let simpleErrorCallback e s = putStrLn $ unwords [show e, show s]+ let width = 600+ height = 300+ windowTitle = "lala"+ setErrorCallback $ Just simpleErrorCallback+ r <- init+ when (not r) (error "Error initializing GLFW!")++ windowHint $ WindowHint'ClientAPI ClientAPI'OpenGL+ windowHint $ WindowHint'OpenGLForwardCompat True+ windowHint $ WindowHint'OpenGLProfile OpenGLProfile'Core+ windowHint $ WindowHint'ContextVersionMajor 3+ windowHint $ WindowHint'ContextVersionMinor 3++ m@(~(Just w)) <- createWindow width height windowTitle Nothing Nothing+ when (isNothing m) (error "Couldn't create window!")++ makeContextCurrent m++ kbState <- newIORef S.empty+ mbState <- newIORef S.empty+ mpState <- getCursorPos w >>= newIORef . uncurry V2+ wsState <- getWindowSize w >>= newIORef . uncurry V2+ lastTick <- getCurrentTime >>= newIORef+ setKeyCallback w (Just $ keyCallback kbState)+ setMouseButtonCallback w (Just $ mbCallback mbState)+ setCursorPosCallback w (Just $ mpCallback mpState)+ setWindowSizeCallback w $ Just $ \win x y -> do+ wsCallback wsState win x y+ viewport $= (Position 0 0, Size (fromIntegral x) (fromIntegral y))++ blend $= Enabled+ blendFunc $= (SrcAlpha, OneMinusSrcAlpha)++ redraw <- atomically $ newTVar $ Just True++ inits <- flip mapM parts $ \(gi, (_init :: a)) -> initplot gi :: IO (PlotInit a)+ graphInfoTVars <- flip mapM parts $ \(gi, (_init :: a)) -> atomically $ newTVar gi -- :: IO (PlotInit a)+ --graphInfoTVars <- mapM (pure $ atomically $ newTVar defGI) parts+ let (dataTVars, storefns, drawfns) = unzip3 inits+ let tvars = zip dataTVars graphInfoTVars++ let setRedraw = atomically $ writeTVar redraw $ Just True+ let resetRedraw = atomically $ writeTVar redraw $ Nothing++ let tick = do pollEvents+ t <- getCurrentTime+ dt <- realToFrac . diffUTCTime t <$> readIORef lastTick+ writeIORef lastTick t++ keys <- readIORef kbState+ buttons <- readIORef mbState+ pos <- readIORef mpState+ wsize <- readIORef wsState++ mredraw <- readTVarIO redraw+ case mredraw of+ Nothing -> threadDelay 100 >> return ()+ Just _ -> do+ clear [ColorBuffer, DepthBuffer]+ zipWithM_ (\draw (tvar, gtvar) -> do+ mdat <- readTVarIO tvar+ gi <- readTVarIO gtvar+ draw mdat gi+ ) drawfns tvars+ swapBuffers w+ threadDelay 10+ resetRedraw+++ -- XXX: emit only changing values except for timestep?+ return $ [+ Timestep dt+ , Keys keys+ , Buttons buttons+ , MousePos pos+ , WinSize wsize+ ]++ let steptick :: Producer Event IO ()+ steptick = forever $ lift tick >>= mapM_ yield++ let handleAppInfo :: View (GLApp)+ handleAppInfo = asSink $ \(GLApp ai vp) -> do+ let updategi = \x -> x {+ graph_appinfo = ai+ , graph_viewport = vp+ }+ mapM_ (\v -> atomically $ modifyTVar v updategi) graphInfoTVars+ setRedraw++ --let handleData :: (Plottable a) => View (SensorReading a)+ let+ handleData = asSink $ \dat -> do+ mapM_ ($ dat) storefns+ setRedraw++ k $ do+ -- Event producer and drawing function+ evts <- MVC.producer (bounded 1) (steptick)+ -- Data and AppInfo handlers+ let hdat = handles _Left handleData+ hapi = handles _Right handleAppInfo++ return (hapi <> hdat, evts)++-- transform AppInfo and camera according to events from OpenGL+campipe :: (Monad m)+ => AppInfo+ -> Camera GLfloat+ -> Viewport+ -> MVC.Proxy () (Event) () (GLApp) m ()+campipe initai initcam initviewport = go initai initcam initviewport+ where+ fwd ai c vp = yield (GLApp ai vp) >> go ai c vp+ go ai c vp = do+ evt <- await+ case evt of+ Keys k | k ^. contains Key'Escape -> return ()+ | k ^. contains Key'Q -> return ()+ | otherwise -> do+ let newCam = moveCam k c+ let newAi = SField =: (camMatrix newCam)+ fwd newAi newCam vp++ WinSize (V2 sx sy) -> fwd ai c (fst vp, Size (fromIntegral sx) (fromIntegral sy))+ _ -> go ai c vp++defaultCamPipe :: Monad m => MVC.Proxy () (Event) () (GLApp) m ()+defaultCamPipe = campipe defaultAppInfo defaultCam defaultViewport++defaultPipe :: forall m a . (Monad m, Plottable a)+ => Pipe (Either (SensorReading a) Event)+ (Either (SensorReading a) GLApp) m ()+defaultPipe = cat +++ defaultCamPipe++keyCallback :: IORef (Set Key) -> KeyCallback+keyCallback keys _w k _ KeyState'Pressed _mods = modifyIORef' keys (S.insert k)+keyCallback keys _w k _ KeyState'Released _mods = modifyIORef' keys (S.delete k)+keyCallback _ _ _ _ _ _ = return ()++mbCallback :: IORef (Set MouseButton) -> MouseButtonCallback+mbCallback mbs _w b MouseButtonState'Pressed _ = modifyIORef' mbs (S.insert b)+mbCallback mbs _w b MouseButtonState'Released _ = modifyIORef' mbs (S.delete b)++mpCallback :: IORef (V2 Double) -> CursorPosCallback+mpCallback mp _w x y = writeIORef mp (V2 x y)++wsCallback :: IORef (V2 Int) -> WindowSizeCallback+wsCallback ws _w w h = writeIORef ws (V2 w h)