使用gtk2hs定时器功能

Question

我想使用gtk2hs在Haskell中做一个计时器。 我在这个网站上找到了一个例子wiki.haskell Tutorial Threaded GUI 我可以在我的项目中成功执行这个例子。我面临的唯一问题是为定时器创建一个重启按钮。

我的目标是当人们按下“新游戏”按钮时，新游戏开始并且计时器重置。

如果只想重新开始游戏，我可以用这行代码

onClicked button1 (startNewGame table window) 

，它的工作原理。问题是我找不到将启动定时器功能绑定到按钮的方法。

我试着这样做：

onClicked button1 (do (startTimer box) (startNewGame table window)) 

不工作，也这不起作用：

onClicked button1 (startTimer box) 

我怎么想正确地重新启动一个线程？ 当我运行这段代码：

onClicked button1 (startTimer box) 

我得到这个错误：

gui.hs:29:25: 
    Couldn't match type `ThreadId' with `()' 
    Expected type: IO() 
     Actual type: IO ThreadId 
    In the return type of a call of `startTimer' 
    In the second argument of `onClicked', namely `(startTimer box)' 
    In a stmt of a 'do' block: onClicked button1 (startTimer box) 

我怎样才能在（startTimer所框）功能绑定到一个按钮？

的源代码：

import Graphics.UI.Gtk 
import SetTest 
import qualified Data.Set as Set 
import qualified Data.Map.Strict as Map 
import Control.Monad.Trans(liftIO) 
import Debug.Trace 
import Control.Concurrent 
import Control.Concurrent.MVar 
import System.Exit 

main :: IO() 
main = do 
    initGUI 
    window <- windowNew 
    set window [windowTitle := "Minesweeper", 
       windowDefaultWidth := 450, windowDefaultHeight := 200] 


    box <- vBoxNew False 0 
    containerAdd window box 

    button1 <- buttonNewWithLabel "New game"       
    boxPackStart box button1 PackGrow 0 

    widgetShowAll window 

    table <- tableNew 5 5 True 
    --onClicked button1 (do (startTimer box) (startNewGame table window)) 
    --onClicked button1 (startTimer box) 
    onClicked button1 (startNewGame table window) 
    startTimer box 
    containerAdd window table 
    startNewGame table window 
    boxPackStart box table PackNatural 0 
    widgetShowAll window 
    onDestroy window mainQuit 
    mainGUI 

startTimer :: BoxClass self => self -> IO ThreadId 
startTimer box = do 
        timeLabel <- labelNew Nothing 
        boxPackStart box timeLabel PackNatural 0 
        forkIO $ do 
        let 
         printTime t = do{ 
           threadDelay 1000000; 
           postGUIAsync $ labelSetText timeLabel (show t); 
           printTime (t+1)} 
        printTime 0 

startNewGame:: (WidgetClass self, TableClass self1) => self1 -> self -> IO() 
startNewGame table window = let board = (SetTest.initialize 5 (5,5) (1,1)) :: MyBoard 
          in checkStatusGame table board window 
:: (WidgetClass self, TableClass self1) => 
self1 -> MyBoard -> self -> IO() 
checkStatusGame table board window 
          | won board = do 
              cleanAndGenerateTable board table window True 
              (dialogMessage "hurray hurray hurray" "Gratz, you won!!!") 

          | lost board = do 
              (dialogMessage "Baby rage window" "Soz, you lost...") 
              cleanAndGenerateTable board table window True 
          | otherwise = (cleanAndGenerateTable board table window False) 
cleanAndGenerateTable :: (WidgetClass self, TableClass self1) => 
MyBoard -> self1 -> self -> Bool -> IO() 
cleanAndGenerateTable board table window finished = do 
              let fieldList = [(x,y) | x <- [0 .. (height board)] , y <- [0 .. (width board)] ] 
              children <- containerGetChildren table 
              mapM_ (\child -> containerRemove table child >> widgetDestroy child) children 
              if finished 
              then mapM_(generateTableFinished board table window) fieldList 
              else mapM_ (generateTable board table window) fieldList 
              widgetShowAll window 

generateTable board table window (x,y) 
        | Set.member (x,y) (flaggedCells board) = createButton "flag.jpg" (x,y) table board window    
        | Map.member (x,y) (clickedCells board) = createClickedButton (show (Map.findWithDefault (-1) (x,y) (clickedCells board))) (x,y) table     
        | otherwise = createButton "masked.png" (x,y) table board window 


generateTableFinished board table window (x,y) 
        | Set.member (x,y) (bombs board) = createButtonNoAction "bomb.jpg" (x,y) table board window     
        | Map.member (x,y) (clickedCells board) = createClickedButton (show (Map.findWithDefault (-1) (x,y) (clickedCells board))) (x,y) table     
        | otherwise = createClickedButton (show (Map.findWithDefault (-1) (x,y) (maskedCells board))) (x,y) table 

createButtonNoAction pth (x,y) table board window = do 
            button <- buttonNew 
            box <- hBoxNew False 0 
            image <- imageNewFromFile pth 
            boxPackStart box image PackRepel 0 
            containerAdd button box 
            tableAttachDefaults table button x (x+1) y (y+1) 

createClickedButton lbl (x,y) table = do 
            button <- buttonNew 
            box <- hBoxNew False 0 
            label <- labelNew (Just lbl) 
            boxPackStart box label PackRepel 0 
            containerAdd button box 
            tableAttachDefaults table button x (x+1) y (y+1) 


createButton pth (x,y) table board window = do 
            button <- buttonNew 
            box <- hBoxNew False 0 
            image <- imageNewFromFile pth 
            boxPackStart box image PackRepel 0 
            containerAdd button box 
            tableAttachDefaults table button x (x+1) y (y+1) 
            on button buttonReleaseEvent $ do 
                     click <- eventButton 
                     liftIO $ case click of { LeftButton -> (checkStatusGame table (SetTest.click (x,y) board) window); RightButton -> (checkStatusGame table (SetTest.flag (x,y) board) window) } 
                     return False 
            return() 

dialogMessage title msg = do dialog <- messageDialogNew Nothing [] MessageOther ButtonsOk msg 
           set dialog [windowTitle := title] 
           widgetShowAll dialog 
           dialogRun dialog 
           widgetDestroy dialog 

Answer 1

如果你想与你的计时器线程进行通信，你需要把它的通信通道。 MVar似乎适合在这里。

startTimer :: BoxClass self => self -> MVar Integer -> IO ThreadId 
startTimer box timer = do 
    timeLabel <- labelNew Nothing 
    boxPackStart box timeLabel PackNatural 0 
    forkIO . forever $ do 
    threadDelay 1000000 
    t <- takeMVar timer 
    putMVar timer (t+1) 
    postGUIAsync $ labelSetText timeLabel (show t) 

截至main顶部，你现在可以创建一个新的MVar有timer <- newMVar 0，并通过这startTimer。在你的按钮回调中，你可以用takeMVar timer >> putMVar timer 0来重置定时器。