2013-03-13 16 views
5

私はGtk2Hsで中規模のGUIを構築しようとしていますが、私はシステムを構成する最善の方法は何もわかりません。私は、孤立してサブコンポーネントを開発する方法を探していて、一般的には後で私の髪を引き抜かない構造になってしまいます。構造化Haskell(gtk2hs)GUIの

主な問題は、APIが継続しているカメラなどのコンポーネント(つまり、withVideoMode :: Camera Undefined -> (Camera a -> IO()) -> IO()のカメラを使用してブロックをラップする必要がある)が原因です。私もこれらを分けたいですが、私はこれを行う合理的な方法を見つけていません。私は追加する必要が

ほとんどのコンポーネントは、このようなカメラパラメータや建物のウィジェットは、そのような最後に、ハードウェアを取り外すなどの他のコンポーネントとクリーンアップ、によってトリガーされる引くイベントを設定するなど、初期が必要です。

これまでのところ、私はContTをcpsの部分に使用し、コンポーネントのスナップショットのようなものをどこかのStateに隠すことを考えました。まずgtk2hsのコールバックでトランスフォーマーをエレガントに使うことができないので、最初はひどく重いように見えます。

(何らかの理由の要旨は、私のために動作しないために、今日、ので、ここでは全体の巨大なコードを投稿して謝罪)

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

あなたのリンクは壊れているようです – cdk

+0

うーん。今日は壊れた要点しか作ることができないようです。私はここにコードを含めましたが、かなり長いです。 – aleator

+0

あなたは 'main'で多くの仕事をしているようです。リソースの初期化/終了コードを別々の関数にリファクタリングして、 'Control.Exception'の' bracket'パターンを利用できるようにしてください:http://hackage.haskell.org/packages/archive/base/latest/doc/ html/Control-Exception-Base.html#v:ブラケット – cdk

答えて

3

だからあなたの要件は次のとおりです。

  • CPSスタイルのAPI
  • リソースの初期化とファイナライズ
  • おそらくモナド変圧器、IO用
  • モジュール性a合成可能性

イテレータライブラリの1つがあなたにぴったりのようです。特に、conduitは最も成熟したリソースファイナライズを持っていますが、理論的な優雅さと合成可能性はpipesにも興味があります。あなたのコードがIOベースの場合は、新たにリリースされたio-streamsも良い選択です。

pipeshttp://hackage.haskell.org/packages/archive/pipes/3.1.0/doc/html/Control-Proxy-Tutorial.html

conduithttps://www.fpcomplete.com/school/pick-of-the-week/conduit-overview

io-streamshttp://hackage.haskell.org/packages/archive/io-streams/1.0.1.0/doc/html/System-IO-Streams-Tutorial.html

あなたが達成しようとしているものの小さなスニペットや説明を提供する場合、私はpipesを使用して、それを書くことを試みることができます(私が最もよく知っている図書館)

+0

いくつかのリンクを提供するように気をつけますか? – horsh

関連する問題