haskell - How to display an image from Repa-DevIL in gtkImage in haskell

Question

I'm working on an image processing program in Haskell. The Repa-DevIL library is good one for image processing. However, I need a GUI which can display the image in real time as it is being processed. How can I use gtkImage to diaplay an image of Repa.Array type?

Answer 1

Converting a Repa Array into a Pixbuf for a gtk Image is fairly straightforward. This function assumes that the Array already holds 32 bit RGBA data.

-- full source with language extensions and includes is below
pixbufNewFromArray :: (Source r Word32) => Array r DIM2 Word32 -> IO Pixbuf
pixbufNewFromArray array = do
    let (Z:. width :. height) = extent array
    pixbuf <- pixbufNew ColorspaceRgb True 8 width height
    rowStrideBytes <- pixbufGetRowstride pixbuf
    let rowStride = rowStrideBytes `quot` 4
    pixbufPixels <- pixbufGetPixels pixbuf
    let copyPixel (x, y) = do
        writeArray pixbufPixels (y * rowStride + x) (index array (Z:. x :. y))
    mapM_ copyPixel $ range ((0, 0), (width-1, height-1))
    return pixbuf

Unfortunately, this isn't all that is needed to integerate Repa with gtk2hs. If you perform the Repa calculations in the context of the main gtk thread, or its event handlers, gtk locks up. The solution to this is to perform all of the Repa calculations on a background thread and send the UI updates to the main thread to be performed. The essence of this is to forkIO in the main thread, and send UI updates back with postGUIAsync.

Complete example

The complete example is divided into 3 parts. Before we can hook Repa up to gtk2hs, we will need some data to display in real time. Then we'll hook our Repa example up to gtk2hs. Finally, we'll provide a minimal appropriate gtk application to display the data. The following are all the import and LANGUAGE directives needed for the example. QuasiQuotes is only needed for the stencil in the example problem.

{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}

-- Repa life example
import Data.Array.Repa.Stencil
import Data.Array.Repa.Stencil.Dim2
import Data.Vector.Unboxed (Unbox)

-- Repa
import Data.Word
import Data.Array.Repa hiding (map)
import qualified Data.Array.Repa as A

-- GTK
import Graphics.UI.Gtk
import Data.Ix (range)
import Data.Array.MArray (writeArray)
import Control.Concurrent

A diversion - the game of life

For example data, we'll use a game of life simulation with an interesting methuselah. The game of life is a simple rule applied to the neighborhood of a pixel. Each pixel is either 0 for no life present or 1 for life present. The rule depends only on the number of neighbors and the value of the pixel. We can bundle all of the needed information from the neighborhood into a single number by a convolution with an appropriate stencil.

lifeStep :: (Source r1 a, Num a, Eq a) => Array r1 DIM2 a -> Array (TR PC5) DIM2 a
lifeStep = smap rule . mapStencil2 (BoundConst 0)
    [stencil2| 1 1  1
               1 16 1
               1 1  1 |]
    where
        {-# INLINE rule #-}
        rule 19 = 1
        rule 3  = 1
        rule 18 = 1
        rule _  = 0

Our interesting example data to start with is life in the form of an "r" pentomino.

rPentomino :: (Num a, Unbox a) => Array U DIM2 a
rPentomino = fromListUnboxed (Z :. 3 :. 3) 
    [0, 1, 1,
     1, 1, 0,
     0, 1, 0]

This life is going to expand into the world around it, to give it room to expand it'd be nice to be able to pad it with additional room.

pad2 :: (Source r1 a) => a -> Int -> Int -> Int -> Int -> Array r1 DIM2 a -> Array D DIM2 a
pad2 a left right bottom top middle =
    traverse middle shape fill
    where
        extents = extent middle
        (Z :. width :. height) = extents
        shape = const (Z :. left + width + right :. bottom + height + top)
        {-# INLINE fill #-}
        fill lookup (Z :. x :. y) =
            if inShape extents newPoint
            then lookup newPoint
            else a
                where
                    newPoint = (Z :. x - left :. y - bottom)

pentominoWorld0 :: (Num a, Unbox a) => Array D DIM2 a
pentominoWorld0 = pad2 0 100 100 100 100 rPentomino

We plan on drawing our life as black pixels on a white background. The following implements the mapping from living or dead cells to these colors in RGBA.

lifeBonW :: (Source r1 a, Num a, Eq a, Shape sh) => Array r1 sh a -> Array D sh Word32
lifeBonW = A.map color
    where
        {-# INLINE color #-}
        color 0 = 0xFFFFFFFF
        color _ = 0xFF000000

Repa to gtk2hs

To connect repa to gtk2hs, we need to be able to convert Repa Arrays into Pixbufs used by gtk2hs. Then we need to draw the Pixbuf on an image. The following converts an Array of RGBA Word32s into an RGBA Pixbuf. RGBA Pixbufs are desirable, because we can write to them a pixel at a time instead of merely a single channel of a pixel at a time.

pixbufNewFromArray :: (Source r Word32) => Array r DIM2 Word32 -> IO Pixbuf
pixbufNewFromArray array = do
    let (Z:. width :. height) = extent array
    pixbuf <- pixbufNew ColorspaceRgb True 8 width height
    rowStrideBytes <- pixbufGetRowstride pixbuf
    let rowStride = rowStrideBytes `quot` 4
    pixbufPixels <- pixbufGetPixels pixbuf
    let copyPixel (x, y) = do
        writeArray pixbufPixels (y * rowStride + x) (index array (Z:. x :. y))
    mapM_ copyPixel $ range ((0, 0), (width-1, height-1))
    return pixbuf

Given a way to render Pixbufs, the next piece of code carries out the game of life simulation, converts Arrays to Pixbufs, and waits between frames.

renderThread :: (Pixbuf -> IO ()) -> IO ()
renderThread draw =
    do
        world0 <- computeP . ofWord8s $ pentominoWorld0
        go world0
    where
        go world = do
            pixbuf <- pixbufNewFromArray . lifeBonW . unboxed $ world
            draw pixbuf
            nextWorld <- computeP . lifeStep $ world
            threadDelay 50000 -- microseconds
            go nextWorld

unboxed and ofWord8s are convenient ways to specify the type of the otherwise very polmorphic Repa Arrays.

unboxed :: Array U sh a -> Array U sh a
unboxed = id

ofWord8s :: Array r sh Word8 -> Array r sh Word8
ofWord8s = id

GTK

The GTK code is minimal, consisting of a single Window and Image. Everything important happens in the line forkIO . renderThread $ postGUIAsync . imageSetFromPixbuf image. It starts the renderThread described earlier, and provides a means of displaying the Pixbuf that will reliably set what the Image displays, doing so in the correct gtk thread.

main = do
    initGUI
    window <- windowNew
    image <- imageNew
    set window [containerChild := image]
    onDestroy window mainQuit
    widgetShowAll window
    forkIO . renderThread $ postGUIAsync . imageSetFromPixbuf image
    mainGUI

Threaded compilation and runtime flags

Like most Repa programs, this should be compiled with the following (and -fllvm if you have it)

-Odph -rtsopts -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -optlo-O3

At runtime, it should be passed the following flags

+RTS -N