使用 gtk2hs 的定时器功能

Question

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

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

如果只想重新启动游戏，我可以使用这行代码

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 的顶部，您现在可以使用 timer <- newMVar 0 创建一个新的 MVar，并将其传递给 startTimer。在您的按钮回调中，您可以 takeMVar timer >> putMVar timer 0 重置计时器。

使用 gtk2hs 的定时器功能

Timer function using gtk2hs

haskell

gtk2hs