reflex-dom-fragment-shader-canvas 0.1.0.1 → 0.1.0.2

raw patch · 3 files changed

+53/−44 lines, 3 files

Files

• ChangeLog.md +4/−0
• Reflex/Dom/FragmentShaderCanvas.hs +46/−41
• reflex-dom-fragment-shader-canvas.cabal +3/−3

@@ -1,5 +1,9 @@ # Revision history for reflex-dom-fragment-shader-canvas +## 0.1.0.2 -- 2018-10-12++* Silently ignore if the webgl context cannot be enabled+ ## 0.1.0.1 -- 2018-08-08  * Try to work around the problem of lost WebGL contexts

@@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -Wno-unused-do-bind #-} module Reflex.Dom.FragmentShaderCanvas (fragmentShaderCanvas, trivialFragmentShader) where @@ -67,55 +68,59 @@   -- adaption of   -- https://blog.mayflower.de/4584-Playing-around-with-pixel-shaders-in-WebGL.html -  gl <- getContextUnsafe canvas ("experimental-webgl"::Text) ([]::[()])-  gl <- unsafeCastTo WebGLRenderingContext gl+  getContext canvas ("experimental-webgl"::Text) ([]::[()]) >>= \case+    Nothing -> do+      -- jsg "console" ^. js1 "log" (gl ^. js1 "getShaderInfoLog" vertexShader)+      return ()+    Just gl -> do+      gl <- unsafeCastTo WebGLRenderingContext gl -  w <- getDrawingBufferWidth gl-  h <- getDrawingBufferHeight gl-  viewport gl 0 0 w h+      w <- getDrawingBufferWidth gl+      h <- getDrawingBufferHeight gl+      viewport gl 0 0 w h -  buffer <- createBuffer gl-  bindBuffer gl ARRAY_BUFFER (Just buffer)-  array <- liftDOM (new (jsg ("Float32Array"::Text))-        [[ -1.0, -1.0,-            1.0, -1.0,-           -1.0,  1.0,-           -1.0,  1.0,-            1.0, -1.0,-            1.0,  1.0 :: Double]])-    >>= unsafeCastTo Float32Array-  let array' = uncheckedCastTo ArrayBuffer array-  bufferData gl ARRAY_BUFFER (Just array') STATIC_DRAW+      buffer <- createBuffer gl+      bindBuffer gl ARRAY_BUFFER (Just buffer)+      array <- liftDOM (new (jsg ("Float32Array"::Text))+            [[ -1.0, -1.0,+                1.0, -1.0,+               -1.0,  1.0,+               -1.0,  1.0,+                1.0, -1.0,+                1.0,  1.0 :: Double]])+        >>= unsafeCastTo Float32Array+      let array' = uncheckedCastTo ArrayBuffer array+      bufferData gl ARRAY_BUFFER (Just array') STATIC_DRAW -  vertexShader <- createShader gl VERTEX_SHADER-  shaderSource gl (Just vertexShader) vertexShaderSource-  compileShader gl (Just vertexShader)-  -- jsg "console" ^. js1 "log" (gl ^. js1 "getShaderInfoLog" vertexShader)+      vertexShader <- createShader gl VERTEX_SHADER+      shaderSource gl (Just vertexShader) vertexShaderSource+      compileShader gl (Just vertexShader)+      -- jsg "console" ^. js1 "log" (gl ^. js1 "getShaderInfoLog" vertexShader) -  fragmentShader <- createShader gl FRAGMENT_SHADER-  shaderSource gl (Just fragmentShader) fragmentShaderSource-  compileShader gl (Just fragmentShader)-  -- jsg "console" ^. js1 "log" (gl ^. js1 "getShaderInfoLog" fragmentShader)-  err <- getShaderInfoLog gl (Just fragmentShader)-  printErr err+      fragmentShader <- createShader gl FRAGMENT_SHADER+      shaderSource gl (Just fragmentShader) fragmentShaderSource+      compileShader gl (Just fragmentShader)+      -- jsg "console" ^. js1 "log" (gl ^. js1 "getShaderInfoLog" fragmentShader)+      err <- getShaderInfoLog gl (Just fragmentShader)+      printErr err -  program <- createProgram gl-  attachShader gl (Just program) (Just vertexShader)-  attachShader gl (Just program) (Just fragmentShader)-  linkProgram gl (Just program)-  useProgram gl (Just program)-  -- jsg "console" ^. js1 "log" (gl ^. js1 "getProgramInfoLog" program)+      program <- createProgram gl+      attachShader gl (Just program) (Just vertexShader)+      attachShader gl (Just program) (Just fragmentShader)+      linkProgram gl (Just program)+      useProgram gl (Just program)+      -- jsg "console" ^. js1 "log" (gl ^. js1 "getProgramInfoLog" program) -  positionLocation <- getAttribLocation gl (Just program) ("a_position" :: Text)-  enableVertexAttribArray gl (fromIntegral positionLocation)-  vertexAttribPointer gl (fromIntegral positionLocation) 2 FLOAT False 0 0-  -- liftJSM $ jsg ("console"::Text) ^. js1 ("log"::Text) program+      positionLocation <- getAttribLocation gl (Just program) ("a_position" :: Text)+      enableVertexAttribArray gl (fromIntegral positionLocation)+      vertexAttribPointer gl (fromIntegral positionLocation) 2 FLOAT False 0 0+      -- liftJSM $ jsg ("console"::Text) ^. js1 ("log"::Text) program -  windowSizeLocation <- getUniformLocation gl (Just program) ("u_windowSize" :: Text)-  uniform2f gl (Just windowSizeLocation) (fromIntegral w) (fromIntegral h)+      windowSizeLocation <- getUniformLocation gl (Just program) ("u_windowSize" :: Text)+      uniform2f gl (Just windowSizeLocation) (fromIntegral w) (fromIntegral h) -  drawArrays gl TRIANGLES 0 6-  return ()+      drawArrays gl TRIANGLES 0 6+      return ()  webglcontextrestored :: DOM.EventName HTMLCanvasElement WebGLContextEvent webglcontextrestored = DOM.unsafeEventName "webglcontextrestored"

@@ -1,14 +1,14 @@ name:                reflex-dom-fragment-shader-canvas-version:             0.1.0.1+version:             0.1.0.2 synopsis:            A reflex-dom widget to draw on a canvas with a fragment shader program description:-  This simple reflex-dom widget takes a `Dynamic t Text` value representing+  This simple reflex-dom widget takes a @Dynamic t Text@ value representing   the source code of a WebGL fragment shader, and renders it to   a HTML canvas element.   .   A live demo can be found at <https://nomeata.github.io/reflex-dom-fragment-shader-canvas/>.   .-  It also provides possible compiler errors in another `Dynamic t Text`.+  It also provides possible compiler errors in another @Dynamic t Text@. homepage:            https://github.com/nomeata/reflex-dom-fragment-shader-canvas license:             MIT license-file:        LICENSE