User interface 结构化Haskell（gtk2hs）GUI'；s

我正在尝试用Gtk2Hs构建中等大小的GUI，但我不太确定构建系统的最佳方式是什么。我正在寻找一种方法来孤立地开发子组件，并最终得到一个不会让我在以后拔头发的结构

主要的困难是由一些组件造成的，例如API是基于连续性的摄影机（即，我需要使用带有

withVideoMode:：Camera Undefined->（摄影机a->IO（））->IO（）

）的摄影机来包装块）。我也想把它们分开，但我还没有找到一个合理的方法来做到这一点

我需要添加的大多数组件都需要初始化，例如设置相机参数或构建小部件，捕捉由其他组件触发的事件，以及在最后进行清理，例如断开硬件连接

到目前为止，我一直在考虑对cps部件使用

ContT

，对组件使用类似Snaplet的东西，并将它们隐藏在某个

状态

的地方。第一个看起来很重，第二个看起来很讨厌，因为我不能在gtk2hs回调中优雅地使用变形金刚

（由于某些原因，GIST今天对我不起作用，因此很抱歉在这里发布了整个庞大的代码）

{-#语言范围的TypeVariables}
{-#语言数据类型}
进口CVSU
导入CV.CVSU.Rectangle
将CV.图像导入为CV
导入CV.Transforms
导入CV.ImageOp
将CV.图形作为CV导入
导入CVSU.PixelImage
进口CVSU.临时森林
导入控制
导入控制
导入控制。并发
进口管制
导入Data.Array.MArray
导入数据.IORef
导入数据，也许吧
导入数据.Word
导入Utils.Rectangle
进口外国货
导入Graphics.UI.Gtk
导入System.Camera.Firewire.Simple
convertToPixbuf:：CV.图像RGB D8->IO Pixbuf
convertToPixbuf cv=withRawImageData cv$\d->do
pixbufNewFromData（castPtr d）颜色间隔符GB假8 w h步幅
式中（w，h）=getSize cv
初始值ECAMERA dc e=do
putStrLn$“初始化摄像头”++显示e
cam所以您的要求是：


CPS风格的API
资源初始化和终结
可能是一个单声道变压器，用于IO
模块性和可组合性

似乎其中一个迭代器库非常适合您。特别是
conduct
具有最成熟的资源定型，但是
pipes
的理论优雅性和可组合性可能也会引起您的兴趣。如果您的代码仅基于
IO
，那么新发布的
IO流也将是一个不错的选择

管道
：

导管
：

io流
：

如果您提供一个小片段或描述您试图完成的内容，我可以尝试使用
管道
（我最熟悉的库）
编写它。您的要点链接似乎已断开。看来我今天只能做些蹩脚的台词了。我在这里包含了代码，虽然它很长。看起来您在
main
中做了很多工作。尝试将资源初始化/终结代码重构为单独的函数，以便可以利用
控件中的
括号
模式。异常
：在main中进行大量工作非常方便。在事先不知道程序应该如何工作的情况下，它避免了大量不必要的变量传递。显然，从长远来看，我不应该这么做，但我的问题是：想不想提供一些链接？
{-#LANGUAGE ScopedTypeVariables#-}
{-#LANGUAGE DataKinds #-}

import CV.CVSU
import CV.CVSU.Rectangle
import CV.Image as CV
import CV.Transforms
import CV.ImageOp 
import CV.Drawing as CV
import CVSU.PixelImage
import CVSU.TemporalForest
import Control.Applicative
import Control.Applicative
import Control.Concurrent
import Control.Monad
import Data.Array.MArray
import Data.IORef
import Data.Maybe
import Data.Word
import Utils.Rectangle
import Foreign.Ptr
import Graphics.UI.Gtk

import System.Camera.Firewire.Simple

convertToPixbuf :: CV.Image RGB D8 -> IO Pixbuf
convertToPixbuf cv = withRawImageData cv $ \stride d -> do
    pixbufNewFromData (castPtr d) ColorspaceRgb False 8 w h stride
   where (w,h) = getSize cv


initializeCamera dc e = do 
    putStrLn $ "Initializing camera "++show e
    cam <- cameraFromID dc e
    setOperationMode cam B
    setISOSpeed  cam ISO_800
    setFrameRate cam Rate_30
    setupCamera cam 20 defaultFlags
    return cam

handleFrame tforest image = do
  pimg    <- toPixelImage (rgbToGray8 image)
  uforest <- temporalForestUpdate tforest pimg
  uimg    <- temporalForestVisualize uforest
  --uimage  <- expectByteRGB =<< fromPixelImage uimg
  temporalForestGetSegments uforest

  --mapM (temporalForestGetSegmentBoundary uforest) ss

createThumbnail img = do 
     pb     <- convertToPixbuf $ unsafeImageTo8Bit $ scaleToSize Linear True (95,95) (unsafeImageTo32F img)
     imageNewFromPixbuf pb


main :: IO ()
main = withDC1394 $ \dc -> do
    -- ** CAMERA Setup **
    cids <- getCameras dc
    cams <- mapM (initializeCamera dc) $ cids

    -- ** Initialize GUI ** 
    initGUI
    pp <- pixbufNew ColorspaceRgb False 8 640 480
    window <- windowNew

    -- * Create the image widgets 
    images <- vBoxNew True 3
    image1  <- imageNewFromPixbuf pp
    image2  <- imageNewFromPixbuf pp
    boxPackStart images image1 PackGrow 0 
    boxPackEnd   images image2 PackGrow 0 

    -- * Create the Control & main widgets
    screen     <- hBoxNew True 3
    control    <- vBoxNew True 3
    info       <- labelNew (Just "This is info")
    but        <- buttonNewWithLabel "Add thumbnail"
    thumbnails <- hBoxNew True 2
    boxPackStart screen images PackGrow 0 
    boxPackStart screen control PackGrow 0 
    boxPackStart control info PackGrow 0 
    boxPackStart control but PackRepel 0 
    boxPackStart control thumbnails PackGrow 0 
    but `onClicked` (do
        info<- labelNew (Just "This is info")
        widgetShowNow info
        boxPackStart thumbnails info PackGrow 0)

    set window [ containerBorderWidth := 10
                   , containerChild := screen ]

    -- ** Start video transmission **
    withVideoMode (cams !! 0) $ \(c :: Camera Mode_640x480_RGB8) -> do
--     withVideoMode (cams !! 1) $ \(c2 :: Camera Mode_640x480_RGB8) -> do
        -- ** Start cameras ** --
        startVideoTransmission c
--        startVideoTransmission c2
        -- ** Setup background subtraction ** --
        Just f <- getFrame c 
        pimg <- toPixelImage (rgbToGray8 f)
        tforest <- temporalForestCreate 16 4 10 130 pimg

        -- * Callback for gtk
        let grabFrame = do
            frame <- getFrame c 
--            frame2 <- getFrame c2 
            maybe (return ()) 
                  (\x -> do
                          ss <- handleFrame tforest x
                          let area = sum [ rArea r | r <- (map segToRect ss)]
                          if area > 10000 
                                then return ()
                                 --putStrLn "Acquiring a thumbnail"
                                 --tn <- createThumbnail x
                                 --boxPackStart thumbnails tn PackGrow 0 
                                 --widgetShowNow tn
                                 --containerResizeChildren thumbnails
                                else return ()
                          labelSetText info ("Area: "++show area)
                          pb <- convertToPixbuf
                                    --  =<< CV.drawLines x (1,0,0) 2 (concat segmentBoundary)
                                    (x <## map (rectOp (1,0,0) 2) (map segToRect ss) )
                          pb2 <- convertToPixbuf x
                          imageSetFromPixbuf image1 pb
                          imageSetFromPixbuf image2 pb2
                          )
                  frame
--            maybe (return ()) 
--                  (convertToPixbuf >=> imageSetFromPixbuf image2)
--                  frame2
            flushBuffer c 
--            flushBuffer c2 
            return True

        timeoutAddFull grabFrame priorityDefaultIdle 20

        -- ** Setup finalizers ** 
        window `onDestroy` do
                    stopVideoTransmission c
                    stopCapture c
                    mainQuit

        -- ** Start GUI **
        widgetShowAll window
        mainGUI