wxhaskell: Обновление statusField с помощью "по щелчку" панели

Question

Я хотел бы получить несколько советов о том, как обновить "statusField" после нажатия на "панель".

Следующая программа демонстрирует проблему. Программа рисует два кадра. Вы можете представить, что левая рамка является какой-то областью рисования, а правая рамка содержит кнопки "Красный" и "Зеленый". После нажатия кнопки "Красный" текст 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" сам является членом класса "Textual", я не понимаю проблемы.

Для полноты картины упомяну, что я также переключил версии 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"