具有活性香蕉和gtk2hs的活性表

Question

我写了一个小应用程序,跟踪我在电视剧中的进展.该应用程序使用功能反应式编程(FRP)和反应式香蕉在Haskell中编写.

该应用程序可以:

• 添加/删除新的电视系列到表
• 改变一个系列的季节和剧集

我在编写代码时会遇到问题,这些代码会在表格中添加新的电视剧并连接新事件.从CRUD例子在这里并没有完全帮助我,因为我有更多的要求,那么就从列表中选择一个元素.

如何以FRP方式从CRUD示例中编写类似reactiveTable函数的reactiveListDisplay函数？如何在编译网络后为删除按钮和季节和剧集旋转按钮添加事件？

data Series = Series { name :: String
                     , season :: Int
                     , episode :: Int
                     }


insertIntoTable :: TableClass t => t -> SeriesChangeHandler -> SeriesRemoveHandler -> Series -> IO ()
insertIntoTable table changeHandler removeHandler (Series name s e) = do
   (rows, cols) <- tableGetSize table
   tableResize table (rows+1) cols

   nameLabel     <- labelNew $ Just name 
   adjustmentS   <- adjustmentNew (fromIntegral s) 1 1000 1 0 0
   adjustmentE   <- adjustmentNew (fromIntegral e) 1 1000 1 0 0
   seasonButton  <- spinButtonNew adjustmentS 1.0 0
   episodeButton <- spinButtonNew adjustmentE 1.0 0
   removeButton  <- buttonNewWithLabel "remove"
   let getSeries = do
            s <- spinButtonGetValue seasonButton
            e <- spinButtonGetValue episodeButton
            return $ Series name (round s) (round e)
       handleSeries onEvent widget handler = do
            onEvent widget $ do
                series <- getSeries
                handler series

    handleSeries onValueSpinned seasonButton  changeHandler
    handleSeries onValueSpinned episodeButton changeHandler
    onPressed removeButton $ do
        series <- getSeries
        containerRemove table nameLabel
        containerRemove table seasonButton 
        containerRemove table episodeButton 
        containerRemove table removeButton 
        removeHandler series

    let tadd widget x = tableAdd table widget x (rows - 1)
    tadd nameLabel     0
    tadd seasonButton  1
    tadd episodeButton 2
    tadd removeButton  3
    widgetShowAll table


main :: IO ()
main = do

    initGUI

    window     <- windowNew
    scroll     <- scrolledWindowNew Nothing Nothing
    table      <- tableNew 1 5 True
    addButton  <- buttonNewWithLabel "add series"
    vbox       <- vBoxNew False 10

    containerAdd window vbox
    boxPackStart vbox addButton PackNatural 0

    let networkDescription :: forall t. Frameworks t => Moment t ()
        networkDescription = do

            addEvent <- eventButton addButton

            (changeHandler,fireChange) <- liftIO $ newAddHandler
            changeEvent <- fromAddHandler changeHandler
            (removeHandler,fireRemove) <- liftIO $ newAddHandler
            removeEvent <- fromAddHandler removeHandler

            let insertIntoTable' = insertIntoTable table fireChange fireRemove
                addSeries e = do
                     s <- addSeriesDialog
                     liftIO $ insertIntoTable' s

            liftIO $ mapM_ insertIntoTable' initSeries

            reactimate $ addSeries         <$> addEvent
            reactimate $ updateSeries conn <$> changeEvent
            reactimate $ removeSeries conn <$> removeEvent

    network <- compile networkDescription
    actuate network

    onDestroy window $ do
        D.disconnect conn
        mainQuit

    widgetShowAll window
    mainGUI

我想重构insertIntoTable方法以使用事件和行为而不是使用简单的回调.

编辑:

我已经尝试了带有ListStore后端的gtk TreeView.在这种情况下,您不需要动态事件切换.我编写了下面的函数来获取插入,更改和删除事件的列表行为.它工作^^reactiveList

reactiveList :: (Frameworks t)
    => ListStore a
    -> Event t (Int,a) -- insert event
    -> Event t (Int,a) -- change event
    -> Event t (Int,a) -- remove event
    -> Moment t (Behavior t [a])
reactiveList store insertE changeE removeE = do

    (listHandler,fireList) <- liftIO $ newAddHandler

    let onChange f (i,a) = do
            f i a
            list <- listStoreToList store
            fireList list

    reactimate $ onChange (listStoreInsert store)         <$> insertE
    reactimate $ onChange (listStoreSetValue store)       <$> changeE
    reactimate $ onChange (const . listStoreRemove store) <$> removeE

    initList <- liftIO $ listStoreToList store
    fromChanges initList listHandler


main :: IO ()
main = do

    initGUI

    window     <- windowNew
    addButton  <- buttonNewWithLabel "add series"
    vbox       <- vBoxNew False 10
    seriesList <- listStoreNew (initSeries :: [Series])
    listView   <- treeViewNewWithModel seriesList

    treeViewSetHeadersVisible listView True

    let newCol title newRenderer f = do
            col <- treeViewColumnNew
            treeViewColumnSetTitle col title
            renderer <- newRenderer
            cellLayoutPackStart col renderer False
            cellLayoutSetAttributes col renderer seriesList f
            treeViewAppendColumn listView col
            return renderer

    newCol "Image"  cellRendererPixbufNew $ \s -> [cellPixbuf :=> newPixbuf s]
    newCol "Name"   cellRendererTextNew   $ \s -> [cellText   :=  name s]
    seasonSpin <- newCol "Season" cellRendererSpinNew   $ \s ->
        [ cellRendererSpinAdjustment :=> adjustmentNew (fromIntegral (season s)) 1 1000 1 0 0
        , cellText := (show $ season s)
        , cellTextEditable := True
        ]
    episodeSpin <- newCol "Episode" cellRendererSpinNew   $ \s ->
        [ cellRendererSpinAdjustment :=> adjustmentNew (fromIntegral (episode s)) 1 1000 1 0 0
        , cellText := (show $ episode s)
        , cellTextEditable := True
        ]

    containerAdd window vbox
    boxPackStart vbox listView PackGrow 0
    boxPackStart vbox addButton PackNatural 0

    let networkDescription :: forall t. Frameworks t => Moment t ()
        networkDescription = do

            (addHandler,fireAdd) <- liftIO $ newAddHandler
            maybeSeriesE <- fromAddHandler addHandler
            (removeHandler,fireRemove) <- liftIO $ newAddHandler
            removeE <- fromAddHandler removeHandler

            -- when the add button was pressed,
            -- open a dialog and return maybe a new series
            askSeriesE <- eventButton addButton
            reactimate $ (const $ fireAdd =<< askSeries) <$> askSeriesE

            -- ommit all nothing series
            let insertE  = filterJust maybeSeriesE
                insert0E = ((,) 0) <$> insertE

            seasonSpinE  <- eventSpin seasonSpin  seriesList
            episodeSpinE <- eventSpin episodeSpin seriesList
            let changeSeason  (i,d,s) = (i,s {season = round d})
                changeEpisode (i,d,s) = (i,s {episode = round d})
            let changeE = (changeSeason <$> seasonSpinE) `union` (changeEpisode <$> episodeSpinE)

            listB <- reactiveList seriesList insert0E changeE removeE
            listE <- (changes listB)

            reactimate $ (putStrLn . unlines . map show) <$> listE
            reactimate $ insertSeries conn       <$> insertE
            reactimate $ updateSeries conn . snd <$> changeE
            reactimate $ removeSeries conn . snd <$> removeE

            return ()

    network <- compile networkDescription
    actuate network

    onDestroy window $ do
        D.disconnect conn
        mainQuit

    widgetShowAll window
    mainGUI

我愿意接受意见和建议.

Answer 1

听起来你的问题比 CRUD 问题更接近Bar Tab示例。

添加新小部件以及新行为和事件的基本思想是使用所谓的“动态事件切换”。本质上，这是一种将新创建的事件和行为放回到网络中的方法。

创建新小部件的操作有两个部分。第一部分是使用liftIO. 第二个是获取其输入并trimE酌情使用trimB。省略大部分 GTk 特定的细节（我不知道如何使用 GTk :P），它看起来像这样：

let newSeries name = do 
  label <- liftIO . labelNew $ Just name
  liftIO $ tadd labelNew 0
  {- ... the rest of your controls here ... -}
  seasonNumber <- trimB $ getSpinButtonBehavior seasonButton
  {- ... wrap the rest of the inputs using trimB and trimE ... -}
  return (label, seasonNumber, ...)

因此，此函数创建一个新的小部件，“修剪”其输入并将值返回给您。现在您必须实际使用这些值：

newSeasons <- execute (FrameworkMoment newSeries <$> nameEvents)

每次您想要添加新系列时，这里nameEvents应该包含一个带有新系列名称的事件。Event String

现在您已经拥有了所有新季节的流，您可以使用诸如stepper.

有关更多详细信息（包括从所有小部件中获取聚合信息之类的信息），请查看实际的示例代码。