2013-03-13 13 views
5

Sto provando a costruire GUI di medie dimensioni con Gtk2Hs e non sono del tutto sicuro di quale sarebbe il modo migliore per strutturare il sistema. Sto cercando un modo per sviluppare sottocomponenti in isolamento e in generale per finire con una struttura che non mi lascerà tirare fuori i capelli più tardi.Strutturazione haskell (gtk2hs) GUI

La difficoltà principale è causata da componenti come fotocamere per le quali l'API è basata su continuazione (ad esempio, ho bisogno di avvolgere il blocco utilizzando le telecamere con withVideoMode :: Camera Undefined -> (Camera a -> IO()) -> IO()). Vorrei separare anche questi, ma non ho trovato un modo ragionevole per farlo.

maggior parte dei componenti che ho bisogno di aggiungere richiedono inizializzazione, come ad esempio l'impostazione dei parametri della fotocamera o widget da costruzione, cattura eventi che vengono attivati ​​da altri componenti e pulizia, come scollegare l'hardware, alla fine.

Finora, ho pensato di utilizzare ContT per le parti cps e qualcosa come snaplet per i componenti e nasconderli in qualche State da qualche parte. In primo luogo sembra terribilmente pesante e il secondo sembra brutto dato che non posso usare elegantemente i trasformatori nei callback di gtk2hs.

(Per qualche motivo GIST non funzionano per me oggi, quindi si scusa per la pubblicazione di tutto il codice enorme qui)

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

il tuo link di ricerca sembra essere rotto – cdk

+0

Hmm. Sembra che oggi riesca a creare solo degli elenchi rotti. Ho incluso il codice qui, anche se è piuttosto lungo. – aleator

+0

sembra che tu stia facendo un sacco di lavoro su 'main'. Prova a refactoring il codice di inizializzazione/finalizzazione delle risorse in funzioni separate in modo da poter sfruttare il pattern 'parentesi' da' Control.Exception': http://hackage.haskell.org/packages/archive/base/latest/doc/ html/Control-Exception-Base.html # v: parentesi – cdk

risposta

3

Così i vostri requisiti sono:

  • stile CPS API
  • Inizializzazione e finalizzazione delle risorse
  • probabilmente un trasformatore monad, per IO
  • modularità a nd composability

sembra che una delle librerie iteratore sia perfetta per te. In particolare, conduit ha la finalizzazione delle risorse più mature, ma l'eleganza teorica e la componibilità di pipes potrebbero interessarti. Se il tuo codice è solo basato su IO, anche il nuovo rilascio io-streams sarebbe una buona scelta.

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

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

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

Se si fornisce un piccolo frammento o la descrizione di ciò che si sta cercando di realizzare, potrei provare a scrivere utilizzando pipes (la libreria con la quale mi è più familiare)

+0

Cura di fornire alcuni collegamenti? – horsh

Problemi correlati