Question

我正在尝试使用gtk2hs在Haskell中创建一个Timer。我在这个网站上找到了一个例子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

如果您想与计时器线程进行通信，则需要将其作为通信通道。这里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。在按钮回调中，您可以getData重置计时器。

定时器功能使用gtk2hs

1 个答案: