如何从Netpbm图像转换为Gtk pixbuf(在Haskell中)？

2019年8月4日 180次阅读

我正在开发一个应用程序,其中我(目前为止)发现操作图像的最佳方法是使用Graphics.Netpbm库.我将把许多操作(例如原始文件开发)委托给外部应用程序,我只想要一个非常干净的良好支持的格式.

我实际上让它工作了.我可以告诉ufraw-batch“开发”一个原始文件,并将结果以pnm格式输出到stdout. Graphics.Netpbm.parsePPM解析图像就好了.然后我需要将它转换为pixbuf以显示在GtkImage小部件中,虽然我有一个解决方案,但我认为它非常糟糕.我希望有一个更好的方法来做到这一点.

阅读这段代码时,您可以跳过整个let声明,并了解img_list :: Netpbm.PPM – > [CUChar].

display_image :: Graphics.UI.Gtk.Image -> Netpbm.PPM -> IO ()
display_image canvas image_bitmap =
    let get_rgb_vector = Netpbm.pixelVectorToList . (\(Netpbm.PpmPixelDataRGB8 v) -> v) . Netpbm.ppmData
        vector_to_cuchar_list = map CUChar . concat . map (\(Netpbm.PpmPixelRGB8 r g b) -> r:g:b:[])
        img_list = vector_to_cuchar_list . get_rgb_vector
        len = length . img_list
        width = Netpbm.ppmWidth . Netpbm.ppmHeader
        height = Netpbm.ppmHeight . Netpbm.ppmHeader
    in do
    img_ptr <- mallocBytes (len image_bitmap)
    mapM_ (\(b, off) -> pokeByteOff img_ptr off (b :: CUChar)) (zip (img_list image_bitmap) [0,1..])
    pb <- pixbufNewFromData img_ptr ColorspaceRgb False 8 (width image_bitmap) (height image_bitmap) ((width image_bitmap) * 3)
    imageSetFromPixbuf canvas pb

顶部的函数从许多实用程序开始实际获取原始像素数据.它们也非常混乱,我还不知道更好的方法来组织它们.但是大部分是在阻止.我分配一个C字节数组来存储所有数据.然后我迭代表示图像的[CUChar],将每个字节戳到C数组中的正确位置.然后我从该数据创建一个GtkPixbuf.

微克.什么是更快,更清洁,更安全的方法呢？

pixbufNewFromData接受一个Ptr CUChar作为第一个参数,其中所有解包的Netpbm最终可以为我提供[Word8].所以在我看来,我需要一个干净的功能[Word8] – > Ptr CUChar.它不一定是纯粹的.

我也不介意做一个重大改变,但我的数据流整体是

operation that generates a ByteString of pnm data ---> GtkImage

最佳答案 让我开始语法重写您的代码等效：

{-# LANGUAGE NamedFieldPuns #-}

display_image :: Graphics.UI.Gtk.Image -> Netpbm.PPM -> IO ()
display_image canvas PPM{ ppmData 
                        , ppmHeader = PPMHeader{ ppmWidth  = width
                                               , ppmHeight = height } } = do

    let word8s :: [Word8]
        word8s = case ppmData of

            PpmPixelDataRGB8 vec -> concat [ [r,g,b] | PpmPixelRGB8 r g b <- Netpbm.pixelVectorToList vec ]
            _ -> error "expected RGB8 data"

    img_ptr <- mallocBytes (length word8s)

    forM_ (zip word8s [0..]) $\(word8, off) ->
        pokeByteOff img_ptr off (CUChar word8)

    pb <- pixbufNewFromData img_ptr ColorspaceRgb False 8 width height (width * 3)
    imageSetFromPixbuf canvas pb

现在更安全的方式,只需使用newArray将列表转换为Ptr：

import Foreign.Marshal.Array (newArray)

    img_ptr <- newArray (map CUChar word8s)
    pb <- pixbufNewFromData img_ptr ColorspaceRgb False 8 width height (width * 3)
    imageSetFromPixbuf canvas pb

这非常简短易读.

>请注意,如果pixbufNewFromData创建自己的数据副本,请使用allocaBytes而不是mallocBytes,而使用withArray而不是newArray.否则,你将内存泄漏malloc.

如果您想要更快的方式而不是安全的方式,请不要转换为列表并通过未装箱的U.Vector直接操作：

import qualified Data.Vector.Unboxed as U

    case ppmData of

        PpmPixelDataRGB8 vec -> do

            let len = U.length vec

            img_ptr <- mallocBytes len

            forM_ [0..len-1] $\i -> do
                let PpmPixelRGB8 r g b = vec U.! i
                pokeByteOff img_ptr (3 * off    ) r
                pokeByteOff img_ptr (3 * off + 1) g
                pokeByteOff img_ptr (3 * off + 2) b

            pb <- pixbufNewFromData img_ptr ColorspaceRgb False 8 width height (width * 3)
            imageSetFromPixbuf canvas pb

        _ -> error "expected RGB8 data"

>更快的方法是更改​​netpbm(我写了它,贡献欢迎)并使其使用Vector.Storable而不是Vector.Unboxed – 然后你可以直接获取数据的Ptr而不做任何事情.
>您可能不需要这个更快的版本,因为最有可能解析基于文本的PPM文件将成为瓶颈,而不是访问解析的数据.

更新：我刚刚发布了netpbm-1.0.0,其中包含Storable而不是Unboxed向量.

你可以这样使用

S.unsafeWith vec $\ppmPixelRgb8Ptr -> do
    let word8Ptr = castPtr (ppmPixelRgb8Ptr :: Ptr PpmPixelDataRGB8)
    -- do something with the Ptr
点赞