4

在模块GHCJS.DOM.JSFFI.Generated.CanvasRenderingContext2DputImageData中有以下类型的函数：

putImageData ::
  Control.Monad.IO.Class.MonadIO m =>
  CanvasRenderingContext2D
  -> Maybe GHCJS.DOM.Types.ImageData -> Float -> Float -> m ()

第二个参数的类型为Maybe GHCJS.DOM.Types.ImageData。此类型在模块GHCJS.DOM.Types中定义为围绕 JSVal 值的新类型包装器：

newtype ImageData = ImageData {unImageData :: GHCJS.Prim.JSVal}

我有一个类型的值，ByteString它始终具有 4 个字节，每个像素的 RGBA 值。如何将我的 ByteString 值转换为 GHCJS.Prim.JSVal？

4

3 回答 3

4

编辑：看起来我原来的答案太以 GHC 为中心。添加了可能适用于 GHCJS 的未经测试的修复。

编辑#2：为示例添加了我的stack.yaml文件。

您可以使用GHCJS.DOM.ImageData.newImageData来构造ImageData对象。它要求数据是一个GHCJS.DOM.Types.Uint8ClampedArray（RGBA 格式的字节数组）。

GHCJS.Buffer从ByteStrings 到Buffers （通过fromByteString）以及从那里到类型化数组（例如）有转换函数getUint8Array。他们直接在 GHCJS 下进行转换，即使在普通的 GHC 下，他们也使用 base64 转换作为中介，这应该很快。不幸的是，getUint8ClampedArray没有包含转换函数（对于普通的 GHC，它看起来fromByteString可能会被破坏——在 jsaddle 0.8.3.0 中，它调用了错误的 JavaScript 帮助函数）。

对于普通的 GHC，以下似乎有效（第一行是fromByteString从显然不正确的助手中复制的h$newByteArrayBase64String）：

uint8ClampedArrayFromByteString :: ByteString -> GHCJSPure (Uint8ClampedArray)
uint8ClampedArrayFromByteString bs = GHCJSPure $ do
  buffer <- SomeBuffer <$> jsg1 "h$newByteArrayFromBase64String"
                                (decodeUtf8 $ B64.encode bs)
  arrbuff <- ghcjsPure (getArrayBuffer (buffer :: MutableBuffer))
  liftDOM (Uint8ClampedArray <$> new (jsg "Uint8ClampedArray") [pToJSVal arrbuff])

这是一个未经测试的可能工作的 GHCJS 版本。如果他们修复了上述 jsaddle 错误，它也应该在普通 GHC 下工作：

uint8ClampedArrayFromByteString :: ByteString -> GHCJSPure (Uint8ClampedArray)
uint8ClampedArrayFromByteString bs = GHCJSPure $ do
  (buffer,_,_) <- ghcjsPure (fromByteString bs)
  buffer' <- thaw buffer
  arrbuff <- ghcjsPure (getArrayBuffer buffer')
  liftDOM (Uint8ClampedArray <$> new (jsg "Uint8ClampedArray") [pToJSVal arrbuff])

我没有正在运行的 GHCJS 安装，但这是我在普通 GHC 下使用 JSaddle+Warp 测试的完整工作示例，它似乎可以正常工作（即，如果您将浏览器指向 localhost:6868，它会在画布元素）：

module Main where

import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Text.Encoding (decodeUtf8)
import qualified Data.ByteString.Base64 as B64 (encode)
import Language.Javascript.JSaddle (js, js1, jss, jsg, jsg1,
                                    new, pToJSVal, GHCJSPure(..), ghcjsPure, JSM,
                                    fromJSVal, toJSVal, Object)
import Language.Javascript.JSaddle.Warp (run)
import JSDOM.Types (liftDOM, Uint8ClampedArray(..), RenderingContext(..))
import JSDOM.ImageData
import JSDOM.HTMLCanvasElement
import JSDOM.CanvasRenderingContext2D
import GHCJS.Buffer (getArrayBuffer, MutableBuffer)
import GHCJS.Buffer.Types (SomeBuffer(..))
import Control.Lens ((^.))

main :: IO ()
main = run 6868 $ do
  let smallImage = BS.pack [0xff,0x00,0x00,0xff,  0xff,0x00,0x00,0xff,  0xff,0x00,0x00,0xff,
                            0x00,0x00,0x00,0xff,  0x00,0xff,0x00,0xff,  0x00,0x00,0x00,0xff,
                            0x00,0x00,0xff,0xff,  0x00,0x00,0xff,0xff,  0x00,0x00,0xff,0xff,
                            0x00,0x00,0xff,0xff,  0x00,0x00,0x00,0xff,  0x00,0x00,0xff,0xff]
  img <- makeImageData 3 4 smallImage
  doc <- jsg "document"
  doc ^. js "body" ^. jss "innerHTML" "<canvas id=c width=10 height=10></canvas>"
  Just canvas <- doc ^. js1 "getElementById" "c" >>= fromJSVal
  Just ctx <- getContext canvas "2d" ([] :: [Object])
  let ctx' = CanvasRenderingContext2D (unRenderingContext ctx)
  putImageData ctx' img 3 4
  return ()

uint8ClampedArrayFromByteString :: ByteString -> GHCJSPure (Uint8ClampedArray)
uint8ClampedArrayFromByteString bs = GHCJSPure $ do
  buffer <- SomeBuffer <$> jsg1 "h$newByteArrayFromBase64String"
                                (decodeUtf8 $ B64.encode bs)
  arrbuff <- ghcjsPure (getArrayBuffer (buffer :: MutableBuffer))
  liftDOM (Uint8ClampedArray <$> new (jsg "Uint8ClampedArray") [pToJSVal arrbuff])

makeImageData :: Int -> Int -> ByteString -> JSM ImageData
makeImageData width height dat
  = do dat' <- ghcjsPure (uint8ClampedArrayFromByteString dat)
       newImageData dat' (fromIntegral width) (Just (fromIntegral height))

为了构建它，我使用了以下内容stack.yaml：

resolver: lts-8.12
extra-deps:
- ghcjs-dom-0.8.0.0
- ghcjs-dom-jsaddle-0.8.0.0
- jsaddle-0.8.3.0
- jsaddle-warp-0.8.3.0
- jsaddle-dom-0.8.0.0
- ref-tf-0.4.0.1
于 2017-04-23T19:00:26.413 回答
3

正如 KA Buhr 所指出的，在将 转换ByteString为 a之后Uint8ClampedArray，您可以将钳位数组传递给以newImageData获取所需的ImageData对象。

您可以使用内联 Javascript 函数来生成Uint8ClampedArray. 要通过ByteStringJavascript FFI，请使用Data.ByteString.useAsCStringLen.

下面的代码显示了如何做到这一点。

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE JavaScriptFFI #-}
{-# LANGUAGE CPP #-}

import Reflex.Dom
import Data.Monoid ((<>))
import Control.Monad.IO.Class (liftIO)
import GHCJS.DOM.ImageData (newImageData)
import GHCJS.DOM.HTMLCanvasElement (getContext)
import GHCJS.DOM.JSFFI.Generated.CanvasRenderingContext2D (putImageData)
import GHCJS.DOM.Types (CanvasRenderingContext2D(..), castToHTMLCanvasElement, Uint8ClampedArray(..))
import Foreign.Ptr (Ptr)
import GHCJS.Types (JSVal)
import GHCJS.Marshal.Pure (pFromJSVal, pToJSVal)
import Data.Map (Map)
import Data.Text as T (Text, pack)
import Data.ByteString as BS (ByteString, pack, useAsCStringLen)

-- Some code and techniques taken from these sites:
-- http://lpaste.net/154691
-- https://www.snip2code.com/Snippet/1032978/Simple-Canvas-Example/

-- import inline Javascript code as Haskell function : jsUint8ClampedArray
foreign import javascript unsafe 
    -- Arguments
    --     pixels : Ptr a -- Pointer to a ByteString 
    --     len    : JSVal -- Number of pixels
    "(function(){ return new Uint8ClampedArray($1.u8.slice(0, $2)); })()" 
    jsUint8ClampedArray :: Ptr a -> JSVal -> IO JSVal

-- takes pointer and length arguments as passed by useAsCStringLen
newUint8ClampedArray :: (Ptr a, Int) -> IO Uint8ClampedArray
newUint8ClampedArray (pixels, len) = 
    pFromJSVal <$> jsUint8ClampedArray pixels (pToJSVal len)

canvasAttrs :: Int -> Int -> Map T.Text T.Text
canvasAttrs w h =    ("width" =: T.pack (show w)) 
                  <> ("height" =: T.pack (show h))

main = mainWidget $ do
    -- first, generate some test pixels
    let boxWidth = 120
        boxHeight = 30
        boxDataLen = boxWidth*boxHeight*4 -- 4 bytes per pixel

        reds = take boxDataLen $ concat $ repeat [0xff,0x00,0x00,0xff]
        greens = take boxDataLen $ concat $ repeat [0x00,0xff,0x00,0xff]
        blues = take boxDataLen $ concat $ repeat [0x00,0x00,0xff,0xff]

        pixels = reds ++ greens ++ blues
        image = BS.pack pixels -- create a ByteString with the pixel data.

    -- create Uint8ClampedArray representation of pixels
    imageArray <- liftIO $ BS.useAsCStringLen image newUint8ClampedArray

    let imageWidth = boxWidth
        imageHeight = (length pixels `div` 4) `div` imageWidth

    -- use Uint8ClampedArray representation of pixels to create ImageData
    imageData <- newImageData (Just imageArray) (fromIntegral imageWidth) (fromIntegral imageHeight)

    -- demonstrate the imageData is what we expect by displaying it.
    (element, _) <- elAttr' "canvas" (canvasAttrs 300 200) $ return ()
    let canvasElement = castToHTMLCanvasElement(_element_raw element)
    elementContext <-  getContext canvasElement ("2d" :: String)

    let renderingContext = CanvasRenderingContext2D elementContext
    putImageData renderingContext (Just imageData) 80 20

这是带有示例代码的存储库的链接：https ://github.com/dc25/stackOverflow__how-to-convert-a-bytestring-value-to-a-jsval

这是现场演示的链接：https ://dc25.github.io/stackOverflow__how-to-convert-a-bytestring-value-to-a-jsval/

于 2017-04-23T17:53:20.843 回答
1

您可以使用 hoogle 通过它的类型签名来查找函数ByteString -> GHCJS.Prim.JSVal。https://www.stackage.org/lts-8.11/hoogle?q=ByteString+-%3E+GHCJS.Prim.JSVal

结果中有这个： https ://www.stackage.org/haddock/lts-8.11/ghcjs-base-stub-0.1.0.2/GHCJS-Prim.html#v:toJSString

toJSString :: String -> JSVal

所以现在你只需要一个函数来做ByteString -> String。

于 2017-04-23T16:45:52.543 回答