更新动态创建内容的可见性

时间:2017-06-29 19:59:27

标签: haskell frp reactive-banana wxhaskell

根据@ HeinrichApfelmus的建议从github复制这个:

这可能只是我的一个使用错误,但是当我尝试为动态创建的UI元素设置条件可见性/布局时,我注意到一个奇怪的现象(当然在WX中)。作为一个玩具示例,我试图创建一个动态创建静态文本元素的小部件,并允许用户通过'<'来“浏览”这些元素。 '>'的按钮。

我注意到的问题是,在创建新标签之前,所有标签都是不可见的,此时焦点上的当前窗口小部件变得可见。无论这是一个错误还是仅仅是我滥用的范例,或者是反应性框架的微妙之处,我不确定如何解决这个问题。这是我现在的代码,它代表了问题:

{-# LANGUAGE RecursiveDo #-}

module Test.Adder where

import Reactive.Banana
import Reactive.Banana.WX
import Graphics.UI.WX.Attributes
import Graphics.UI.WX hiding (Event, newEvent, empty, Identity)
import Graphics.UI.WXCore hiding (Event, Timer, empty, Identity, newEvent)
import Graphics.UI.WXCore.Frame

-- | Combine Unit-Events
anyEvent :: [Event ()] -> Event ()
anyEvent = foldl1 (unionWith (\_ _ -> ()))

-- | Unsugared if-then-else function
if_ :: Bool -> a -> a -> a
if_ True x _ = x
if_ False _ y = y

-- | Apply a function to the value at an index, or return a default value
-- if the index is out of range
(!?) :: (a -> b) -> b -> Int -> ([a] -> b)
(f!? ~y) n xs
  | n < 0 = y
  | otherwise = case drop n xs of
                  x:_ -> f x
                  [] -> y

main :: IO ()
main = start test


create :: Window w -> Int -> Behavior Int -> Event Int -> Event () -> MomentIO (StaticText ())
create t i bi ei eRef = do
  let tx = replicate i '\t' ++ show i

  x <- liftIO $ staticText t [ text := tx ]

  let beq = (==i) <$> bi

  let eMe = filterE (==i) ei

  sink x [ visible :== beq ]
  reactimate (refresh x <$ anyEvent [ eRef, () <$ eMe ])
  return x

test :: IO ()
test = do
    f <- frame [text := "Test"]

    add <- button f [ text := "+" ]

    prv <- button f [ text := "<" ]
    cur <- staticText f []
    nxt <- button f [ text := ">" ]

    tab <- panel f [ clientSize := sz 200 300 ]
    deb <- staticText f []
    ref <- button f [ text := "refresh" ]


    let networkDescription :: MomentIO ()
        networkDescription = mdo
                eAdd <- event0 add command
                eRef <- event0 ref command

                let bNotFirst = (>0) <$> bCur
                    bNotLast  = (<) <$> bCur <*> bNext

                sink prv [ enabled :== bNotFirst ]
                sink cur [ text :== show <$> bCur ]
                sink nxt [ enabled :== bNotLast ]

                ePrev <- event0 prv command
                eNext <- event0 nxt command

                let eDelta :: Enum n => Event (n -> n)
                    eDelta = unions [ pred <$ whenE bNotFirst ePrev
                                    , succ <$ whenE bNotLast  eNext ]
                    eChange = flip ($) <$> bCur <@> eDelta

                bCur <- stepper 0 $ eChange

                (eIndex, bCount) <- mapAccum 0 ((\x -> (x, succ x)) <$ eAdd)

                let bView = (\n i -> if_ (n==0) (0) i) <$> bCount <*> bCur
                    bNext = pred <$> bCount
                    eCreate = (\n -> create tab n bView eChange $ anyEvent [eRef,eAdd]) <$> eIndex

                reCreate <- execute eCreate

                bItemer <- accumB id $ flip (.) . (:) <$> reCreate
                let bItems = ($[]) <$> bItemer
                    bThis = (widget!?(nullLayouts!!0)) <$> bCur <*> bItems

                sink tab [ layout :== bThis ]
                liftIO $ set f [ layout := column 5 [ margin 10 $ row 5 [ widget add
                                                                        , widget prv
                                                                        , widget cur
                                                                        , widget nxt
                                                                        , widget ref
                                                                        ]
                                                    , fill $ widget tab
                                                    ]
                               ]

    network <- compile networkDescription
    actuate network

&GT;

0 个答案:

没有答案