wxhaskell：使用面板的“單擊時”更新statusField

Question

我想要一些有關單擊“面板”后如何更新“ statusField”的建議。

下面的程序演示了該問題。 該程序繪制兩個框架。 您可以想象左邊的框是某種繪圖區域，右邊的框包含按鈕“ Red”和“ Green”。 單擊標記為“紅色”的按鈕后，statusField的文本將更新為“當前顏色：紅色”。 標有“綠色”的按鈕會將文本更新為“當前顏色：綠色”。

用戶單擊左側面板后如何更改statusField的文本？ 例如，將其更改為“您成功單擊了繪圖面板”。

為什么不能在“單擊”中進行與“在命令中進行”按鈕相同的操作？ （請參見下面的源中的注釋。）

非常感謝你。

module Main where

import Graphics.UI.WX

-- | NOP (= No Operation)
data Command = Nop
             | Red
             | Green
               deriving (Eq)

main :: IO ()
main
  = start hello


hello :: IO ()
hello 
    = do  currentCommand <- varCreate $ Nop               -- current command performed on next click on "pDrawingarea"

          status <- statusField    [text := "Welcome."]

          -- Frames and Panels
          f            <- frame   [ text := "Demo"
                                  , bgcolor := lightgrey ]

          pButtons     <- panel f [ bgcolor := lightgrey]
          pDrawingarea <- panel f [ on paint := draw
                                  , bgcolor := lightgrey
                                  ]

          set pDrawingarea [on click :=  do drawingAreaOnClick status currentCommand pDrawingarea
                                            -- set status [text := "User clicked on the panel."]
                                            -- Problem: uncommenting the line above shows the problem
                           ]

          bRed <- button pButtons [text := "Red",  on command := do varSet currentCommand Red
                                                                    set status [text := "Current color: Red"]
                                 ]

          bGreen <- button pButtons [text := "Green",  on command := do varSet currentCommand Green
                                                                        set status [text := "Current color: Green"]
                                    ]

          set pButtons [ layout := column 1 [ hstretch.expand $ widget bRed
                                            , hstretch.expand $ widget bGreen
                                            ]
                       ]

          set f [ statusBar := [status]
                , layout := row 3 [
                                    minsize (sz 600 500) $ stretch.expand $  widget pDrawingarea
                                  , vstretch.expand $ rule 3 500
                                  , minsize (sz 200 500) $ vstretch.expand $ widget pButtons
                                  ]    
                ]

          return ()

draw ::  DC a -> Rect -> IO ()
draw  dc viewArea
    = do putStrLn "Imagine some code to repaint the screen."


drawingAreaOnClick :: statusField -> Var Command -> Panel () -> Point -> IO ()
drawingAreaOnClick sf command panel pt
    = do c <- varGet command
         case c of 
            Red   -> do putStrLn "Imagine some code to do red painting"
            Green -> do putStrLn "Imagine some code to do green painting"

Answer 1

花了很多時間解決這個問題后，我找到了解決方案。

解決方案是更改

drawingAreaOnClick :: statusField -> Var Command -> Panel () -> Point -> IO ()

至

drawingAreaOnClick :: Textual x =>  x -> Var Command -> Panel () -> Point -> IO ()

因為“ statusField”本身是“文本”類的成員，所以我不理解問題。

為了完整起見，我會提到我也切換了GHC版本。最初的問題發生在GHC 7.8.4中，我發現的解決方案適用於GHC 7.10.3。 我不能說GHC版本是否會影響問題。

供參考的完整工作代碼：

module Main where

import Graphics.UI.WX

-- | NOP (= No Operation)
data Command = Nop
             | Red
             | Green
               deriving (Eq)

main :: IO ()
main
  = start hello


hello :: IO ()
hello 
    = do  currentCommand <- varCreate Nop               -- current command performed on next click on "pDrawingarea"


          status <- statusField    [text := "Welcome."]

          -- not needed:     currentStatus <- varCreate status


          -- Frames and Panels
          f            <- frame   [ text := "Demo"
                                  , bgcolor := lightgrey ]

          pButtons     <- panel f [ bgcolor := lightgrey]
          pDrawingarea <- panel f [ on paint := draw
                                  , bgcolor := lightgrey
                                  ]

          set pDrawingarea [on click :=  do drawingAreaOnClick status currentCommand pDrawingarea
                                            -- set status [text := "User clicked on the panel."]
                                            -- Problem: uncommenting the line above shows the problem
                           ]

          bRed <- button pButtons [text := "Red",  on command := do varSet currentCommand Red
                                                                    set status [text := "Current color: Red"]
                                 ]

          bGreen <- button pButtons [text := "Green",  on command := do varSet currentCommand Green
                                                                        set status [text := "Current color: Green"]
                                                                        --sf <- varGet currentStatus
                                                                        -- set sf [text := "yyy"]

                                    ]

          set pButtons [ layout := column 1 [ hstretch.expand $ widget bRed
                                            , hstretch.expand $ widget bGreen
                                            ]
                       ]

          set f [ statusBar := [status]
                , layout := row 3 [
                                    minsize (sz 600 500) $ stretch.expand $  widget pDrawingarea
                                  , vstretch.expand $ rule 3 500
                                  , minsize (sz 200 500) $ vstretch.expand $ widget pButtons
                                  ]    
                ]

          return ()

draw ::  DC a -> Rect -> IO ()
draw  dc viewArea
    = do putStrLn "Imagine some code to repaint the screen."


drawingAreaOnClick ::  Textual x =>  x -> Var Command -> Panel () -> Point -> IO ()
drawingAreaOnClick sf command panel pt
    = do c <- varGet command
         set sf [text := "Drawing on the screen."]
         case c of 
            Red   -> do putStrLn "Imagine some code to do red painting"
            Green -> do putStrLn "Imagine some code to do green painting"