Question

我正在研究Haskell中的图像处理程序。 Repa-DevIL库适用于图像处理。但是，我需要一个GUI，它可以在处理时实时显示图像。如何使用gtkImage显示Repa.Array类型的图像？

Answer 1

为gtk Array将维修Pixbuf转换为Image非常简单。此函数假定Array已经包含32位RGBA数据。

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

不幸的是，这并不是使用gtk2hs整合Repa所需的全部内容。如果在主gtk线程或其事件处理程序的上下文中执行Repa计算，则gtk会锁定。解决方案是在后台线程上执行所有Repair计算，并将UI更新发送到要执行的主线程。其实质是主线程中的forkIO，并使用postGUIAsync发回UI更新。

完整示例

完整的例子分为3部分。在我们将Repair最多挂起到gtk2hs之前，我们需要实时显示一些数据。然后我们将我们的Repa示例挂钩到gtk2hs。最后，我们将提供最小的适当gtk应用程序来显示数据。以下是该示例所需的所有import和LANGUAGE指令。 QuasiQuotes仅用于示例问题中的模板。

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

转移 - 生命游戏

例如数据，我们将使用有趣的methuselah进行生命模拟游戏。生命游戏是应用于像素邻域的简单规则。每个像素为0表示没有生命存在，或者1表示生命存在。该规则仅取决于邻居的数量和像素的值。我们可以通过带有适当模板的卷积将所有需要的信息从邻域捆绑到一个数字中。

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

我们开始的有趣的示例数据是生活形式的＆＃34; r＆＃34;五格骨牌。

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

这种生活将会扩展到它周围的世界，为它提供扩展空间，能够用额外的空间来填充它。

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

我们计划在白色背景上绘制黑色像素。以下实现了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

修复gtk2hs

要将repa连接到gtk2hs，我们需要能够将Repa Array转换为gtk2hs使用的Pixbuf s。然后我们需要在图像上绘制Pixbuf。以下内容将Array RGBA Word32转换为RGBA Pixbuf。 RGBA Pixbuf是可取的，因为我们可以一次向它们写入一个像素，而不是一次只写一个像素的单个通道。

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

给定一种渲染Pixbuf的方法，下一段代码执行生命模拟游戏，将Array转换为Pixbuf，然后在帧之间等待。

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和ofWord8s是指定其他非常波形的Repa Array的类型的便捷方式。

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

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

GTK

GTK代码很少，由一个Window和Image组成。重要的一切都发生在forkIO . renderThread $ postGUIAsync . imageSetFromPixbuf image行中。它启动前面描述的renderThread，并提供了一种显示Pixbuf的方法，它将可靠地设置Image显示的内容，并在正确的gtk线程中执行此操作。

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

线程编译和运行时标志

与大多数的修复程序一样，这应该使用以下内容进行编译（如果有的话还可以-fllvm）

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

在运行时，应该传递以下标志

+RTS -N

如何在haskell中的gtkImage中显示Repa-DevIL中的图像

1 个答案:

完整示例

转移 - 生命游戏

修复gtk2hs

GTK

线程编译和运行时标志