如何从 Netpbm 图像转换为 Gtk pixbuf（在 Haskell 中）？

Question

我正在开发一个应用程序，其中我（迄今为止）发现的处理图像的最佳方法是使用 Graphics.Netpbm 库。我将把许多操作（例如原始文件开发）委托给外部应用程序，我只想要一个非常干净且受支持的格式。

我确实让它工作了。我可以告诉 ufraw-batch “开发”一个原始文件并将结果以 pnm 格式输出到标准输出。 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

顶部的函数从许多实用程序开始，以实际获取原始像素数据。它们也很乱，我真的不知道有更好的方法来组织它们。但总的部分在 do 块中。我分配了一个 C 字节数组来存储所有数据。然后我遍历表示图像的 [CUChar]，将每个单独的字节插入 C 数组中的正确位置。然后我根据这些数据创建一个 GtkPixbuf。

呃。有什么更快、更清洁、更安全的方法来做到这一点？

pixbufNewFromData 接受Ptr CUChar 作为第一个参数，其中包含所有展开的 Netpbm 最终可以为我提供[Word8]。所以在我看来，我需要一个干净的函数来执行[Word8] -> Ptr CUChar。它不必是纯粹的。

我也不介意进行重大更改，但我的数据流总体上是

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

Answer 1

让我从等效的语法重写代码开始：

{-# 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