How can I convert from a Netpbm image to Gtk pixbuf (in Haskell)?

Question

I am working on an application in which the best way that I (so far) have discovered that I am manipulating images is with the Graphics.Netpbm library. I will delegate many operations, such as raw file development, to an external application, and I just need a very clean, well-supported format.

I really got his job. I can tell ufraw-batch to “develop” the raw file and output the result in pnm format to stdout. Graphics.Netpbm.parsePPM perfectly parses the image. Then I need to convert it to pixbuf for display in GtkImage widgets, and although I have a solution, I think it is pretty important. I would like it to be better.

When reading this wall of code, you can skip the entire let declaration and understand that 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 rgb) -> 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 

The function at the top starts with many utilities to actually get the original pixel data. They are also quite dirty, and I don’t know yet how best to organize them. But the gross part is in the do block. I allocate an array of C arrays to store all the data. Then I repeat [CUChar], which represents the image, knocking every single byte to the right place in array C. And then I create GtkPixbuf from this data.

Ug. What is a faster, cleaner and safer way to do this?

pixbufNewFromData takes Ptr CUChar as the first parameter, where Netpbm with all the deployments can ultimately provide me [Word8] . Therefore, in my opinion, I need a pure function that does [Word8] -> Ptr CUChar . It does not have to be clean.

I also do not mind making major changes, but my data flow as a whole

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

Answer 1

Let me start with the syntax, rewriting your code equivalently:

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

Now it's safer just using newArray to convert the list to 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 

It is quite short and easy to read.

• Note that if pixbufNewFromData creates its own copy of the data, use allocaBytes instead of mallocBytes and withArray instead of newArray . Otherwise, you will lose malloc memory.

---

If instead of a safe method you need a faster method, do not convert it to lists and do not act directly through unboxed 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 rgb = 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" 

• An even faster way would be to change netpbm (I wrote it, contributions are welcome) and use Vector.Storable from Vector.Unboxed - then you can directly get Ptr to the data without any action.
• You probably do not need this faster version, since parsing PPM text files is likely to become a bottleneck, not access to the data being analyzed.

---

Update: I just released netpbm-1.0.0 , which has Storable instead of Unboxed vectors inside.

So you can use

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