1

Below is a Haskell program which launches a wxHaskell notebook.

It works, except that I cannot manage to handle a page change event so as to get the index of the newly selected page. I get the previous one instead (see comment "PROBLEM" in the code below).

There is a warning about this behaviour in the C wxNotebook Class Reference documentation (see section on getSelection) as well as in the "Detailed Description" section of the wxBookCtrlEvent Class Reference documetnation but I do not understand at all how to make use of it.

Could anyone please show me some working code for a notebook where one gets the new page index when a new page is selected by the user (by clicking on its title)?

A secondary question: I do not understand what the argument 0 is next to --???.

Thank you in advance!

module Main where

import Graphics.UI.WX 
import Graphics.UI.WXCore 

main :: IO ()
main = 
   start $
    do 

    f <- frame []
    nbk <- notebook f []

    pages <- sequence [ do
                        p <- panel nbk []
                        return $ tab ("Page "++show i) (container p $ label ("Page " ++ show i))
                    | i <- [0..3]]

    set f [layout :=  fill $ tabs nbk pages,clientSize := sz 300 100]



    let h event = case event of 
                    wxEVT_COMMAND_NOTEBOOK_PAGE_CHANGED -> 
                        do
                        i <- notebookGetSelection nbk -- PROBLEM: gives the OLD index
                        infoDialog f "Event otification" $ "Notebook selected page: " ++ show i
                        propagateEvent

    windowOnEvent nbk 
                  [wxEVT_COMMAND_NOTEBOOK_PAGE_CHANGED]
                  0 -- ???
                  h
basil85
  • 11
  • 3

1 Answers1

1

This strange looking code works for me. I found it on a japanese (?) blog. Unfortunately I don't have the link anymore..

import Graphics.UI.WX
import Graphics.UI.WXCore

import Foreign.Marshal.Alloc
import Foreign.Storable
import Foreign.Ptr
import Foreign.C.Types

import System.IO.Unsafe

main :: IO ()
main = start gui

gui :: IO ()
gui = do
    f  <- frame []
    nb <- notebook f []
    p1 <- panel nb []
    b1 <- button p1 [text := "*"]
    p2 <- panel nb []
    b2 <- button p2 [text := "!"]

    set nb [on click := (\pt -> onMouse nb pt >>= print)]
    set f [ layout := tabs nb [ tab "p1" $ container p1 $ widget b1
                              , tab "p2" $ container p2 $ widget b2]]


onMouse :: Notebook() -> Point -> IO Int
onMouse nb p = propagateEvent >> notebookHitTest nb p flag


{-# NOINLINE flag #-}
flag :: Ptr CInt
flag  =  unsafePerformIO flag'
  where flag' = do
             work <- malloc::IO (Ptr CInt)
             poke work (fromIntegral wxBK_HITTEST_ONPAGE)
             return work
Schoon
  • 394
  • 1
  • 9