2013-03-13 10 views
5

Ich versuche, mittelgroße GUI mit Gtk2Hs zu bauen und ich bin nicht ganz sicher, was wäre der beste Weg, um das System zu strukturieren. Ich suche nach einer Möglichkeit, Teilkomponenten isoliert zu entwickeln und im Allgemeinen mit einer Struktur zu enden, die mich später nicht die Haare reißen lässt.Strukturierung von Haskell (gtk2hs) GUI's

Die Hauptschwierigkeit wird durch Komponenten wie Kameras verursacht, für die die API fortsetzungsbasiert ist (dh ich muss den Block mit den Kameras mit withVideoMode :: Camera Undefined -> (Camera a -> IO()) -> IO() umwickeln). Ich möchte diese auch trennen, aber ich habe keinen vernünftigen Weg gefunden, dies zu tun. am Ende

Die meisten Komponenten, die ich brauche hinzufügen erfordern Initialisierung, wie Kameraparameter oder Gebäude Widgets Einstellung fangen Ereignisse, die von anderen Komponenten und Bereinigungs, wie Trennen Hardware ausgelöst werden.

Bis jetzt habe ich gedacht, ContT für die cps-Teile und so etwas wie Snaplets für die Komponenten zu verwenden und sie irgendwo irgendwo versteckt. Das erste scheint furchtbar Schwergewicht und das zweite scheint böse, da ich Transformatoren in gtk2hs Callbacks nicht elegant verwenden kann.

(Aus irgendeinem Grund Logen für mich heute nicht arbeiten, entschuldigt sich so für den ganzen riesigen Code hier veröffentlichen)

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

Ihr Gist-Link scheint gebrochen zu sein – cdk

+0

Hmm. Es sieht so aus, als könnte ich heute nur noch gebrochene Äste machen. Ich habe den Code hier eingefügt, obwohl es ziemlich lang ist. – aleator

+0

es scheint, als ob du viel Arbeit in 'main' machst. Versuchen Sie, den Ressourceninitialisierungs-/Finalisierungscode in separate Funktionen umzuwandeln, damit Sie das 'bracket'-Muster aus' Control.Exception' nutzen können: http://hackage.haskell.org/packages/archive/base/latest/doc/ html/Control-Exception-Base.html # v: Klammer – cdk

Antwort

3

So Ihre Anforderungen sind:

  • CPS Stil API
  • Ressourceninitialisierung und Finalisierung
  • wahrscheinlich ein Monodentrafo, für IO
  • Modularität a nd zusammensetzbarkeit

es scheint wie eine der iterator-bibliotheken ist perfekt für sie. Insbesondere conduit hat die reifste Ressource Finalisierung, aber die theoretische Eleganz und die Kombinierbarkeit von pipes könnte Sie auch interessieren. Wenn Ihr Code nur IO basiert, dann wäre die neu erschienene io-streams auch eine gute Wahl.

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

Wenn Sie einen kleinen Schnipsel oder eine Beschreibung von dem, was Sie versuchen zu erreichen, könnte ich versuchen, es pipes mit schreiben (die Bibliothek, die ich am meisten kenne)

+0

Interessieren Sie sich für einige Links? – horsh

Verwandte Themen