netwire-vinylglfw-examples (empty) → 0.0.0

raw patch · 8 files changed

+308/−0 lines, 8 filesdep +GLFW-bdep +GLUtildep +OpenGLsetup-changed

Dependencies added: GLFW-b, GLUtil, OpenGL, array, base, bytestring, containers, directory, filepath, lens, linear, mtl, netwire, netwire-input, netwire-input-glfw, transformers, vinyl, vinyl-gl

Files

• LICENSE.txt +22/−0
• README.md +3/−0
• Setup.hs +2/−0
• etc/cursor.frag +7/−0
• etc/cursor.vert +7/−0
• netwire-vinylglfw-examples.cabal +43/−0
• src/Cursor.hs +160/−0
• src/CursorProgram.hs +64/−0

@@ -0,0 +1,22 @@+Written by runKleisli. Portions of code & comments copied from netwire-input-glfw (Copyright 2014 Pavel Krajcevski) for educational & research purposes.++++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,3 @@+Port of netwire-input-glfw example to VinylGL & GLSL 1.50. Uses Netwire 5 and Vinyl >= 0.4. NetVinylGLFW is a previous combination of Netwire, VinylGL, & GLFW, but its Netwire and Vinyl versions are outdated as of 2016. The combination with STM that it suggests is embraced by netwire-input-glfw.++Usage: Place the executable and the `etc` folder in the same directory. Change to that directory in the command line and run the executable.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,7 @@+#version 150+uniform vec3 color;+out vec4 fragColor;++void main() {+  fragColor = vec4(color, 1.0);+}

@@ -0,0 +1,7 @@+#version 150+in vec2 position;+uniform vec2 offset;++void main() {+  gl_Position = vec4(offset + 0.1*position, 1.0, 1.0);+}

@@ -0,0 +1,43 @@+name:                netwire-vinylglfw-examples+version:             0.0.0+synopsis:            Netwire/GLFW/VinylGL input handling demo+description:         Port of netwire-input-glfw example to VinylGL & GLSL 1.50. Uses Netwire 5 and Vinyl >= 0.4. NetVinylGLFW is a previous combination of Netwire, VinylGL, & GLFW, but its Netwire and Vinyl versions are outdated as of 2016. The combination with STM that it suggests is embraced by netwire-input-glfw.+license:             MIT+license-file:        LICENSE.txt+author:              Rand Kleisli+maintainer:          runKleisli@openmailbox.org+category:            Game+build-type:          Simple+extra-source-files:  README.md+data-files:          etc/*.frag, etc/*.vert+cabal-version:       >=1.10++source-repository head+  type:           git+  location:       https://github.com/runKleisli/netwire-vinylglfw-examples++executable netwire-vinylglfw-example+  main-is:        Cursor.hs+  other-modules:  CursorProgram+  hs-source-dirs: src+  ghc-options:    -Wall -rtsopts -O3++  build-depends:  base > 4.5 && < 5,+                  lens >= 3.9,+                  vinyl >= 0.4,+                  netwire >= 5,+                  netwire-input,+                  netwire-input-glfw >=0.0.5 && <= 0.0.6,+                  OpenGL >= 2.9.2,+                  GLFW-b >= 1.4,+                  linear >= 1.1,+                  GLUtil >= 0.7,+                  vinyl-gl >= 0.2,+                  transformers,+                  array,+                  bytestring,+                  mtl >= 2.2.1,+                  containers >= 0.5,+                  directory >= 1.2,+                  filepath ==1.3.*+  default-language:  Haskell2010

@@ -0,0 +1,160 @@+{-# LANGUAGE DataKinds, TypeOperators #-}++module Main where++--------------------------------------------------------------------------------+import qualified Control.Monad as Monad (when)+import Data.Maybe (isNothing)++import Control.Monad.State+import Control.Wire hiding (unless)++import FRP.Netwire.Input+import FRP.Netwire.Input.GLFW++import qualified Graphics.UI.GLFW as GLFW+import qualified Graphics.Rendering.OpenGL as GL++import Data.Vinyl hiding ((<+>))+import qualified Data.Vinyl as Vy ((<+>))+import Linear (V2(..), V3(..))+import System.Directory (getCurrentDirectory, setCurrentDirectory)++import CursorProgram (cursorCircle)++++-- Some type synonyms to keep our code clean+type RenderFn = V2 GL.GLfloat -> V3 GL.GLfloat -> IO ()+type GameMonad = GLFWInputT IO+type GameSession = Session IO (Timed Float ())++cursorCircRenderFn :: IO RenderFn+cursorCircRenderFn = do+	cursorCircle' <- cursorCircle+	return $ \ofs -> \col -> cursorCircle'+		( SField =: ofs Vy.<+> SField =: col+			:: FieldRec [ '("offset", V2 GL.GLfloat)+				, '("color", V3 GL.GLfloat) ] )++-- This wire produces the position of the circle. It simply follows the mouse cursor+-- but negates the y-value. The origin of the mouse coordinates are in the top left+-- corner of the screen with the y-axis pointing down while the y-axis for rendering+-- points up.+posWire :: Monoid e => Wire s e GameMonad a (V2 GL.GLfloat)+posWire = mouseCursor >>> (second $ arr negate) >>> (arr $ uncurry V2)++-- This wire produces color for the circle. If the R, G, or B keys are pressed,+-- then the circle will turn red, green, or blue, respectively. Otherwise,+-- the red and green channels of the circle pulsate+colorWire :: (HasTime t s, Monoid e) => Wire s e GameMonad a (V3 GL.GLfloat)+colorWire =+  -- Key debounced means that it will only flash blue for one frame+  (keyDebounced GLFW.Key'B >>> (pure $ V3 0 0 1)) <|>++  -- Key pressed means that it will remain this color+  (keyPressed GLFW.Key'R >>> (pure $ V3 1 0 0)) <|>+  (keyPressed GLFW.Key'G >>> (pure $ V3 0 1 0)) <|>++  -- Otherwise, pulsate based on the amount of time passed+  (timeF >>> (arr (cos &&& sin)) >>> (arr $ \(x, y) -> V3 x y 1))++-- This wire simply takes a vertex position and color and renders according to the+-- passed in renderFn. In reality, this wire doesn't need to be a wire, and could just+-- be a monad to render, but this way we can render what we need without having to+-- go through the plumbing of our main game loop+renderWire :: Monoid e => RenderFn -> Wire s e GameMonad (V2 GL.GLfloat, V3 GL.GLfloat) ()+renderWire rfn = mkGen_ $ \(pos, color) -> lift $ rfn pos color >> (return $ Right ())++-- Wire that behaves like the identity wire until Q is pressed, then inhibits forever.+-- We can compose our main gameWire with this wire to simply quit the program when q is pressed+quitWire :: Monoid e => Wire s e GameMonad a a+quitWire = (mkId &&& eventWire) >>> (rSwitch mkId)+  where+    eventWire :: Monoid e => Wire s e GameMonad a (Event (Wire s e m a a))+    eventWire = (keyPressed GLFW.Key'Q >>> pure mkEmpty >>> now) <|> never++-- This is our main game wire, it feeds the position and color into the rendering loop+-- and finally quits if q is pressed.+gameWire :: (HasTime t s, Monoid e) => RenderFn -> Wire s e GameMonad a ()+gameWire rfn = posWire &&& colorWire >>> (renderWire rfn) >>> quitWire++run :: GLFW.Window -> GLFWInputControl -> IO ()+run win ictl = do+  -- initialize the input+  ipt <- getInput ictl++  -- Binding this loads the shaders & compiles the shader program,+  -- & can be done per-frame or on scene change just as well.+  cursCirc <- cursorCircRenderFn++  runGame ipt (countSession_ 0.02) (gameWire cursCirc)++  where++    -- The game loop takes the current input state, the time session and+    -- our main game wire, and simply steps the wire until it inhibits.+    runGame ipt sess w = do++      -- Before rendering clear the framebuffer+      GL.clearColor GL.$= GL.Color4 0.0 0.0 0.0 1+      GL.clear [GL.ColorBuffer]++      -- Poll the current input+      ipt' <- pollGLFW ipt ictl++      -- Figure out our next timestep+      (timeState, sess') <- stepSession sess++      -- Since the GameMonad is a 'StateT GLFWInputState m', in order to+      -- step the wires, we have to extract the value from our wire. That means+      -- that when we runStateT, we will get the results of our wire and a new+      -- state (for example if the wire debounced any keys). This is what we pass+      -- back to GLFW.+      --  renderPrg :: IO ((Either e (), Wire s e GameMonad a ()), GLFWInputState)+      let renderPrg = runGLFWInputT (stepWire w timeState (Right undefined)) ipt'++      -- Now run the actual IO program to extract the values from it.+      ((result, w'), ipt'') <- renderPrg++      -- End of frame cleanup+      GL.flush+      GLFW.swapBuffers win++      -- Our quit condition is if the OS asked us to quit, or the wire inhibits+      -- (i.e. someone hit the Q key)+      case result of+        Left () -> return ()+        Right () -> do+          q <- GLFW.windowShouldClose win+          unless q $ runGame ipt'' sess' w'++initGL :: String -> Int -> Int -> IO (GLFW.Window, GLFWInputControl)+initGL windowTitle width height = do+	currDir <- getCurrentDirectory++	r <- GLFW.init+	Monad.when (not r) (error "Error initializing GLFW!")++	-- GLSL version determined by GL version+	GLFW.windowHint $ GLFW.WindowHint'ClientAPI GLFW.ClientAPI'OpenGL+	GLFW.windowHint $ GLFW.WindowHint'OpenGLForwardCompat True+	GLFW.windowHint $ GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Core+	GLFW.windowHint $ GLFW.WindowHint'ContextVersionMajor 3+	GLFW.windowHint $ GLFW.WindowHint'ContextVersionMinor 2++	m@(~(Just w)) <- GLFW.createWindow width height windowTitle Nothing Nothing+	Monad.when (isNothing m) (error "Couldn't create window!")++	GLFW.makeContextCurrent m++	-- Hack for retina displays+	(szx, szy) <- GLFW.getFramebufferSize w+	GL.viewport GL.$= (GL.Position 0 0, GL.Size (fromIntegral szx) (fromIntegral szy))++	setCurrentDirectory currDir++	mkInputControl w >>= (\x -> return (w, x))++main :: IO ()+main = initGL "Netwire Input Demo" 400 400 >>= uncurry run

@@ -0,0 +1,64 @@+{-# LANGUAGE DataKinds, FlexibleContexts, TypeOperators #-}+module CursorProgram where++import Data.Vinyl+import Graphics.GLUtil+import Graphics.Rendering.OpenGL hiding (normal, normalize, light, Normal, Color)+import Linear (V2(..), V3(..))+import Graphics.VinylGL+import Foreign.Ptr (nullPtr)+import System.FilePath ((</>))+import Data.Word (Word16)++-----+-- Shader params+-----++type Pos = '("position", V2 GLfloat)++pos :: SField Pos+pos = SField++-----+-- Parameter data+-----++cursorNumSlices :: Num a => a+cursorNumSlices = 50++cursorNumIdxs :: GLsizei -- = NumArrayIndices+cursorNumIdxs = toEnum $ cursorNumSlices + 2++cursorpts :: [V2 GLfloat]+cursorpts = take (cursorNumSlices+2) $ (V2 0 0) : (zipWith V2 (map cos winding) (map sin winding))+	where+		winding :: [Float]+		winding = [0,(2*pi/(fromIntegral cursorNumSlices))..]++{-+Changing this from Word16 implies drawElements called w/ UnsignedInt instead of UnsignedShort and removing the import of (Word.Word16).+-}+cursorinds :: [Word16]+cursorinds = take (cursorNumSlices+2) [0,1..]++-----+-- Shader program+-----+type CursorCircleStyle = '[ '("offset", V2 GLfloat), '("color", V3 GLfloat) ]++cursorCircle :: (CursorCircleStyle <: i) => IO (FieldRec i -> IO ())+cursorCircle = do+		sprog <- simpleShaderProgram ("etc"</>"cursor.vert") ("etc"</>"cursor.frag")+		vb <- bufferVertices . map (pos =:) $ cursorpts+		eb <- makeBuffer ElementArrayBuffer cursorinds+		vao <- makeVAO $ do+			currentProgram $= Just (program sprog)+			enableVertices' sprog vb+			bindVertices vb+			bindBuffer ElementArrayBuffer $= Just eb+		let ss = setUniforms sprog+		return $ \appInfo -> withVAO vao $ do+			currentProgram $= Just (program sprog)+			ss (rcast appInfo :: FieldRec CursorCircleStyle)+			-- triangle fan drawing+			drawElements TriangleFan cursorNumIdxs UnsignedShort nullPtr