{-# OPTIONS -fglasgow-exts #-} ----------------------------------------------------------------------------------------- {-| Module : Events Copyright : (c) Daan Leijen 2003 License : wxWindows Maintainer : daan@cs.uu.nl Stability : provisional Portability : portable Dynamically set (and get) Haskell event handlers for basic wxWindows events. Note that one should always call 'skipCurrentEvent' when an event is not processed in the event handler so that other eventhandlers can process the event. -} ----------------------------------------------------------------------------------------- module Graphics.UI.WXCore.Events ( -- * Set event handlers -- ** Controls buttonOnCommand , checkBoxOnCommand , choiceOnCommand , comboBoxOnCommand , comboBoxOnTextEnter , controlOnText , listBoxOnCommand , spinCtrlOnCommand -- , listBoxOnDClick , radioBoxOnCommand , sliderOnCommand , textCtrlOnTextEnter , listCtrlOnListEvent , treeCtrlOnTreeEvent , gridOnGridEvent -- ** Windows , windowOnMouse , windowOnKeyChar , windowOnKeyDown , windowOnKeyUp , windowAddOnClose , windowOnClose , windowOnDestroy , windowAddOnDelete , windowOnDelete , windowOnCreate , windowOnIdle , windowOnTimer , windowOnSize , windowOnFocus , windowOnActivate , windowOnPaint , windowOnPaintRaw , windowOnContextMenu , windowOnScroll , htmlWindowOnHtmlEvent -- ** Event handlers , evtHandlerOnMenuCommand , evtHandlerOnEndProcess , evtHandlerOnInput , evtHandlerOnInputSink , evtHandlerOnTaskBarIconEvent -- ** Raw STC export , EventSTC(..) , stcOnSTCEvent , stcGetOnSTCEvent -- ** Print events , EventPrint(..) , printOutOnPrint -- * Get event handlers -- ** Controls , buttonGetOnCommand , checkBoxGetOnCommand , choiceGetOnCommand , comboBoxGetOnCommand , comboBoxGetOnTextEnter , controlGetOnText , listBoxGetOnCommand , spinCtrlGetOnCommand -- , listBoxGetOnDClick , radioBoxGetOnCommand , sliderGetOnCommand , textCtrlGetOnTextEnter , listCtrlGetOnListEvent , treeCtrlGetOnTreeEvent , gridGetOnGridEvent -- ** Windows , windowGetOnMouse , windowGetOnKeyChar , windowGetOnKeyDown , windowGetOnKeyUp , windowGetOnClose , windowGetOnDestroy , windowGetOnDelete , windowGetOnCreate , windowGetOnIdle , windowGetOnTimer , windowGetOnSize , windowGetOnFocus , windowGetOnActivate , windowGetOnPaint , windowGetOnPaintRaw , windowGetOnContextMenu , windowGetOnScroll , htmlWindowGetOnHtmlEvent -- ** Event handlers , evtHandlerGetOnMenuCommand , evtHandlerGetOnEndProcess , evtHandlerGetOnInputSink , evtHandlerGetOnTaskBarIconEvent -- ** Printing , printOutGetOnPrint -- * Timers , windowTimerAttach , windowTimerCreate , timerOnCommand , timerGetOnCommand -- Idle events , appRegisterIdle -- * Calenders , EventCalendar(..) , calendarCtrlOnCalEvent , calendarCtrlGetOnCalEvent -- * Types -- ** Streams , StreamStatus(..), streamStatusFromInt -- ** Modifiers , Modifiers(..) , showModifiers , noneDown, justShift, justAlt, justControl, justMeta, isNoneDown , isNoShiftAltControlDown -- ** Mouse events , EventMouse (..) , showMouse , mousePos, mouseModifiers -- ** Keyboard events , EventKey (..), Key(..) , keyKey, keyModifiers, keyPos , showKey, showKeyModifiers -- * Set event handlers -- ** Drop Target events , DragResult (..) , dropTargetOnData , dropTargetOnDrop , dropTargetOnEnter , dropTargetOnDragOver , dropTargetOnLeave -- ** On DragAndDropEvent , DragMode (..) , dragAndDrop -- *** Special handler for Drop File event , fileDropTarget -- *** Special handler for Drop Text event , textDropTarget -- ** Scroll events , EventScroll(..), Orientation(..) , scrollOrientation, scrollPos -- ** Tree control events , EventTree(..) -- ** List control events , EventList(..), ListIndex -- ** Grid control events , EventGrid(..), Row, Column -- ** Html window events , EventHtml(..) -- * TaskBar icon events , EventTaskBarIcon(..) -- * Current event , propagateEvent , skipCurrentEvent , withCurrentEvent -- * Primitive , appOnInit -- ** Client data , treeCtrlSetItemClientData , evtHandlerWithClientData , evtHandlerSetClientData , objectWithClientData , objectSetClientData -- ** Input sink , inputSinkEventLastString -- ** Keys , KeyCode , modifiersToAccelFlags , keyCodeToKey, keyToKeyCode -- ** Events , windowOnEvent, windowOnEventEx -- ** Generic , OnEvent , evtHandlerOnEvent , evtHandlerOnEventConnect -- ** Unsafe , unsafeTreeCtrlGetItemClientData , unsafeEvtHandlerGetClientData , unsafeObjectGetClientData , unsafeGetHandlerState , unsafeWindowGetHandlerState ) where import Data.List( intersperse, findIndex ) import System.Environment( getProgName, getArgs ) import Foreign.StablePtr import Foreign.Ptr import Foreign.C.String import Foreign.Marshal.Alloc import Foreign.Marshal.Array import Foreign.Marshal.Utils import Data.Char ( chr ) -- used in stc import Data.Maybe ( fromMaybe ) import Control.Concurrent.MVar import System.IO.Unsafe( unsafePerformIO ) import qualified Graphics.UI.WXCore.IntMap as IntMap import Graphics.UI.WXCore.WxcTypes import Graphics.UI.WXCore.WxcDefs import Graphics.UI.WXCore.WxcClasses import Graphics.UI.WXCore.WxcClassInfo import Graphics.UI.WXCore.Types import Graphics.UI.WXCore.Draw import Graphics.UI.WXCore.Defines ------------------------------------------------------------------------------------------ -- Controls (COMMAND events) ------------------------------------------------------------------------------------------ -- | Set an event handler for a push button. buttonOnCommand :: Button a -> IO () -> IO () buttonOnCommand button eventHandler = windowOnEvent button [wxEVT_COMMAND_BUTTON_CLICKED] eventHandler (\evt -> eventHandler) -- | Get the current button event handler on a window. buttonGetOnCommand :: Window a -> IO (IO ()) buttonGetOnCommand button = unsafeWindowGetHandlerState button wxEVT_COMMAND_BUTTON_CLICKED skipCurrentEvent -- | Set an event handler for "updated text", works for example on a 'TextCtrl' and 'ComboBox'. controlOnText :: Control a -> IO () -> IO () controlOnText control eventHandler = windowOnEvent control [wxEVT_COMMAND_TEXT_UPDATED] eventHandler (\evt -> eventHandler) -- | Get the current event handler for updated text. controlGetOnText :: Control a -> IO (IO ()) controlGetOnText control = unsafeWindowGetHandlerState control wxEVT_COMMAND_TEXT_UPDATED skipCurrentEvent -- | Set an event handler for an enter command in a text control. textCtrlOnTextEnter :: TextCtrl a -> IO () -> IO () textCtrlOnTextEnter textCtrl eventHandler = windowOnEvent textCtrl [wxEVT_COMMAND_TEXT_ENTER] eventHandler (\evt -> eventHandler) -- | Get the current text enter event handler. textCtrlGetOnTextEnter :: TextCtrl a -> IO (IO ()) textCtrlGetOnTextEnter textCtrl = unsafeWindowGetHandlerState textCtrl wxEVT_COMMAND_TEXT_ENTER skipCurrentEvent {- -- | Set an event handler for when a user tries to type more than than the maximally -- allowed text in a text control. textCtrlOnTextMaxLen :: IO () -> TextCtrl a -> IO () textCtrlOnTextMaxLen eventHandler textCtrl = windowOnEvent textCtrl [wxEVT_COMMAND_TEXT_MAXLEN] eventHandler (\evt -> eventHandler) -- | Get the current maximal text event handler. textCtrlGetOnTextMaxLen :: TextCtrl a -> IO (IO ()) textCtrlGetOnTextMaxLen textCtrl = unsafeWindowGetHandlerState textCtrl wxEVT_COMMAND_TEXT_MAXLEN skipCurrentEvent -} -- | Set an event handler for an enter command in a combo box. comboBoxOnTextEnter :: ComboBox a -> IO () -> IO () comboBoxOnTextEnter comboBox eventHandler = windowOnEvent comboBox [wxEVT_COMMAND_TEXT_ENTER] eventHandler (\evt -> eventHandler) -- | Get the current text enter event handler. comboBoxGetOnTextEnter :: ComboBox a -> IO (IO ()) comboBoxGetOnTextEnter comboBox = unsafeWindowGetHandlerState comboBox wxEVT_COMMAND_TEXT_ENTER skipCurrentEvent -- | Set an event handler for when a combo box item is selected. comboBoxOnCommand :: ComboBox a -> IO () -> IO () comboBoxOnCommand comboBox eventHandler = windowOnEvent comboBox [wxEVT_COMMAND_COMBOBOX_SELECTED] eventHandler (\evt -> eventHandler) -- | Get the current combo box event handler for selections comboBoxGetOnCommand :: ComboBox a -> IO (IO ()) comboBoxGetOnCommand comboBox = unsafeWindowGetHandlerState comboBox wxEVT_COMMAND_COMBOBOX_SELECTED skipCurrentEvent -- | Set an event handler for when a listbox item is (de)selected. listBoxOnCommand :: ListBox a -> IO () -> IO () listBoxOnCommand listBox eventHandler = windowOnEvent listBox [wxEVT_COMMAND_LISTBOX_SELECTED] eventHandler (\evt -> eventHandler) -- | Get the current listbox event handler for selections. listBoxGetOnCommand :: ListBox a -> IO (IO ()) listBoxGetOnCommand listBox = unsafeWindowGetHandlerState listBox wxEVT_COMMAND_LISTBOX_SELECTED skipCurrentEvent {- -- | Set an event handler for when a listbox item is double clicked. Takes the selected -- item index as an argument. listBoxOnDClick :: (Int -> IO ()) -> ListBox a -> IO () listBoxOnDClick eventHandler listBox = windowOnEvent listBox [wxEVT_COMMAND_LISTBOX_DCLICK] eventHandler dclickHandler where dclickHandler event = do index <- commandEventGetInt (objectCast event) eventHandler index -- | Get the current double click listbox event handler. listBoxGetOnDClick :: ListBox a -> IO (IO ()) listBoxGetOnDClick listBox = unsafeWindowGetHandlerState listBox wxEVT_COMMAND_LISTBOX_DCLICK (\index -> skipCurrentEvent) -} -- | Set an event handler for when a choice item is (de)selected. choiceOnCommand :: Choice a -> IO () -> IO () choiceOnCommand choice eventHandler = windowOnEvent choice [wxEVT_COMMAND_CHOICE_SELECTED] eventHandler (\evt -> eventHandler) -- | Get the current choice command event handler. choiceGetOnCommand :: Choice a -> IO (IO ()) choiceGetOnCommand choice = unsafeWindowGetHandlerState choice wxEVT_COMMAND_CHOICE_SELECTED skipCurrentEvent -- | Set an event handler for when a radiobox item is selected. radioBoxOnCommand :: RadioBox a -> IO () -> IO () radioBoxOnCommand radioBox eventHandler = windowOnEvent radioBox [wxEVT_COMMAND_RADIOBOX_SELECTED] eventHandler (\evt -> eventHandler) -- | Get the current radio box command handler. radioBoxGetOnCommand :: RadioBox a -> IO (IO ()) radioBoxGetOnCommand radioBox = unsafeWindowGetHandlerState radioBox wxEVT_COMMAND_RADIOBOX_SELECTED skipCurrentEvent -- | Set an event handler for when a slider item changes. sliderOnCommand :: Slider a -> IO () -> IO () sliderOnCommand slider eventHandler = windowOnEvent slider [wxEVT_COMMAND_SLIDER_UPDATED] eventHandler (\evt -> eventHandler) -- | Get the current slider command event handler. sliderGetOnCommand :: Slider a -> IO (IO ()) sliderGetOnCommand slider = unsafeWindowGetHandlerState slider wxEVT_COMMAND_SLIDER_UPDATED skipCurrentEvent -- | Set an event handler for when a checkbox clicked. checkBoxOnCommand :: CheckBox a -> (IO ()) -> IO () checkBoxOnCommand checkBox eventHandler = windowOnEvent checkBox [wxEVT_COMMAND_CHECKBOX_CLICKED] eventHandler (\evt -> eventHandler) -- | Get the current check box event handler. checkBoxGetOnCommand :: CheckBox a -> IO (IO ()) checkBoxGetOnCommand checkBox = unsafeWindowGetHandlerState checkBox wxEVT_COMMAND_CHECKBOX_CLICKED (skipCurrentEvent) -- | Set an event handler for when a spinCtrl clicked. spinCtrlOnCommand :: SpinCtrl a -> (IO ()) -> IO () spinCtrlOnCommand spinCtrl eventHandler = windowOnEvent spinCtrl [wxEVT_COMMAND_SPINCTRL_UPDATED] eventHandler (\evt -> eventHandler) -- | Get the current check box event handler. spinCtrlGetOnCommand :: SpinCtrl a -> IO (IO ()) spinCtrlGetOnCommand spinCtrl = unsafeWindowGetHandlerState spinCtrl wxEVT_COMMAND_SPINCTRL_UPDATED (skipCurrentEvent) {----------------------------------------------------------------------------------------- wxStyledTextCtrl's event -----------------------------------------------------------------------------------------} -- | Scintilla events. * Means extra information is available (excluding position, -- key and modifiers) but not yet implemented. ! means it's done data EventSTC = STCChange -- ^ ! wxEVT_STC_CHANGE. | STCStyleNeeded -- ^ ! wxEVT_STC_STYLENEEDED. | STCCharAdded Char Int -- ^ ? wxEVT_STC_CHARADDED. The position seems to be broken | STCSavePointReached -- ^ ! wxEVT_STC_SAVEPOINTREACHED. | STCSavePointLeft -- ^ ! wxEVT_STC_SAVEPOINTLEFT. | STCROModifyAttempt -- ^ ! wxEVT_STC_ROMODIFYATTEMPT. | STCKey -- ^ * wxEVT_STC_KEY. -- kolmodin 20050304: -- is this event ever raised? not under linux. -- according to davve, not under windows either | STCDoubleClick -- ^ ! wxEVT_STC_DOUBLECLICK. | STCUpdateUI -- ^ ! wxEVT_STC_UPDATEUI. | STCModified Int Int (Maybe String) Int Int Int Int Int -- ^ ? wxEVT_STC_MODIFIED. | STCMacroRecord Int Int Int -- ^ ! wxEVT_STC_MACRORECORD iMessage wParam lParam | STCMarginClick Bool Bool Bool Int Int -- ^ ? wxEVT_STC_MARGINCLICK. -- kolmodin 20050304: -- Add something nicer for alt, shift and ctrl? -- Perhaps a new datatype or a tuple. | STCNeedShown Int Int -- ^ ! wxEVT_STC_NEEDSHOWN length position. | STCPainted -- ^ ! wxEVT_STC_PAINTED. | STCUserListSelection Int String -- ^ ! wxEVT_STC_USERLISTSELECTION listType text | STCUriDropped String -- ^ ! wxEVT_STC_URIDROPPED | STCDwellStart Point -- ^ ! wxEVT_STC_DWELLSTART | STCDwellEnd Point -- ^ ! wxEVT_STC_DWELLEND | STCStartDrag Int Int String -- ^ ! wxEVT_STC_START_DRAG. | STCDragOver Point DragResult -- ^ ! wxEVT_STC_DRAG_OVER | STCDoDrop String DragResult -- ^ ! wxEVT_STC_DO_DROP | STCZoom -- ^ ! wxEVT_STC_ZOOM | STCHotspotClick -- ^ ! wxEVT_STC_HOTSPOT_CLICK | STCHotspotDClick -- ^ ! wxEVT_STC_HOTSPOT_DCLICK | STCCalltipClick -- ^ ! wxEVT_STC_CALLTIP_CLICK | STCAutocompSelection -- ^ ! wxEVT_STC_AUTOCOMP_SELECTION | STCUnknown -- ^ Unknown event. Should never occur. instance Show EventSTC where show STCChange = "(stc event: change)" show STCStyleNeeded = "(stc event: style needed)" show (STCCharAdded c p) = "(stc event: char added: " ++ show c ++ " at position " ++ show p ++ ")" show STCSavePointReached = "(stc event: save point reached)" show STCSavePointLeft = "(stc event: save point left)" show STCROModifyAttempt = "(stc event: read only modify attempt)" show STCKey = "(stc event: key)" show STCDoubleClick = "(stc event: double click)" show STCUpdateUI = "(stc event: update ui)" show (STCModified p mt t len ladd line fln flp) = "(stc event: modified: position " ++ show p ++ ", modtype " ++ show mt ++ ", text " ++ show t ++ ", length " ++ show len ++ ", lines added " ++ show ladd ++ ", line " ++ show line ++ ", fln " ++ show fln ++ ", flp " ++ show flp ++ ")" show (STCMacroRecord m wp lp) = "(stc event: macro record, message " ++ show m ++ ", wParam " ++ show wp ++ ", lParam " ++ show lp ++ ")" show (STCMarginClick alt shift ctrl p m) = "(stc event: margin " ++ show m ++ " clicked, pos " ++ show p ++ ", modifiers = [" ++ (if alt then "alt, " else "") ++ (if shift then "shift, " else "") ++ (if ctrl then "control" else "") ++ "])" show (STCNeedShown p len) = "(stc event: need to show lines from " ++ show p ++ ", length " ++ show len ++ ")" show STCPainted = "(stc event: painted)" show (STCUserListSelection lt t) = "(stc event: user list selection, type " ++ show lt ++ ", text " ++ show t ++ ")" show (STCUriDropped t) = "(stc event: uri dropped: " ++ t ++ ")" show (STCDwellStart p) = "(stc event: dwell start, (x,y) " ++ show p ++ ")" show (STCDwellEnd p) = "(stc event: dwell end, (x,y) " ++ show p ++ ")" show (STCStartDrag lin car str) = "(stc event: start drag, line " ++ show lin ++ ", caret " ++ show car ++ ", text " ++ show str ++ ")" show (STCDragOver p res) = "(stc event: drag over, (x,y) " ++ show p ++ ", dragResult " ++ show res ++ ")" show (STCDoDrop str res) = "(stc event: do drop, text " ++ show str ++ ", dragResult " ++ show res ++ ")" show STCZoom = "(stc event: zoom)" show STCHotspotClick = "(stc event: hotspot click)" show STCHotspotDClick = "(stc event: hotspot double click)" show STCCalltipClick = "(stc event: calltip clicked)" show STCAutocompSelection = "(stc event: autocomp selectioned)" show STCUnknown = "(stc event: unknown)" fromSTCEvent :: StyledTextEvent a -> IO EventSTC fromSTCEvent event = do et <- eventGetEventType event case lookup et stcEvents of Just action -> action event Nothing -> return STCUnknown stcEvents :: [(EventId, StyledTextEvent a -> IO EventSTC)] stcEvents = [ (wxEVT_STC_CHANGE, \_ -> return STCChange) , (wxEVT_STC_STYLENEEDED, \_ -> return STCStyleNeeded) , (wxEVT_STC_CHARADDED, charAdded) , (wxEVT_STC_SAVEPOINTREACHED, \_ -> return STCSavePointReached) , (wxEVT_STC_SAVEPOINTLEFT, \_ -> return STCSavePointLeft) , (wxEVT_STC_ROMODIFYATTEMPT, \_ -> return STCROModifyAttempt) , (wxEVT_STC_KEY, \_ -> return STCKey) , (wxEVT_STC_DOUBLECLICK, \_ -> return STCDoubleClick) , (wxEVT_STC_UPDATEUI, \_ -> return STCUpdateUI) , (wxEVT_STC_MODIFIED, modified) , (wxEVT_STC_MACRORECORD, macroRecord) , (wxEVT_STC_MARGINCLICK, marginClick) , (wxEVT_STC_NEEDSHOWN, needShown) , (wxEVT_STC_PAINTED, \_ -> return STCPainted) , (wxEVT_STC_USERLISTSELECTION, userListSelection) , (wxEVT_STC_URIDROPPED, uriDropped) , (wxEVT_STC_DWELLSTART, dwellStart) , (wxEVT_STC_DWELLEND, dwellEnd) , (wxEVT_STC_START_DRAG, startDrag) , (wxEVT_STC_DRAG_OVER, dragOver) , (wxEVT_STC_DO_DROP, doDrop) , (wxEVT_STC_ZOOM, \_ -> return STCZoom) , (wxEVT_STC_HOTSPOT_CLICK, \_ -> return STCHotspotClick) , (wxEVT_STC_CALLTIP_CLICK, \_ -> return STCCalltipClick) -- TODO: STCAutocompSelection event is not tested yet. , (wxEVT_STC_AUTOCOMP_SELECTION, \_ -> return STCAutocompSelection) ] where charAdded evt = do c <- styledTextEventGetKey evt let c' | c < 0 = chr $ c + 256 | otherwise = chr c p <- styledTextEventGetPosition evt return $ STCCharAdded c' p modified evt = do p <- styledTextEventGetPosition evt mt <- styledTextEventGetModificationType evt t <- styledTextEventGetText evt len <- styledTextEventGetLength evt ladd <- styledTextEventGetLinesAdded evt line <- styledTextEventGetLine evt fln <- styledTextEventGetFoldLevelNow evt flp <- styledTextEventGetFoldLevelPrev evt -- TODO: t should only be returned under some modificationtype conditions -- or should we always return it? return $ STCModified p mt (Just t) len ladd line fln flp macroRecord evt = do m <- styledTextEventGetMessage evt wp <- styledTextEventGetWParam evt lp <- styledTextEventGetLParam evt return $ STCMacroRecord m wp lp marginClick evt = do alt <- styledTextEventGetAlt evt shift <- styledTextEventGetShift evt ctrl <- styledTextEventGetControl evt p <- styledTextEventGetPosition evt m <- styledTextEventGetMargin evt return $ STCMarginClick alt shift ctrl p m needShown evt = do p <- styledTextEventGetPosition evt len <- styledTextEventGetLength evt return $ STCNeedShown p len {- -- expEVT_STC_POSCHANGED is removed in wxWidgets-2.6.x. posChanged evt = do p <- styledTextEventGetPosition evt return $ STCPosChanged p -} userListSelection evt = do lt <- styledTextEventGetListType evt text <- styledTextEventGetText evt return $ STCUserListSelection lt text uriDropped evt = do t <- styledTextEventGetText evt return $ STCUriDropped t dwellStart evt = do x <- styledTextEventGetX evt y <- styledTextEventGetY evt return $ STCDwellStart (point x y) dwellEnd evt = do x <- styledTextEventGetX evt y <- styledTextEventGetY evt return $ STCDwellEnd (point x y) startDrag evt = do lin <- styledTextEventGetLine evt car <- styledTextEventGetPosition evt str <- styledTextEventGetDragText evt return $ STCStartDrag lin car str dragOver evt = do x <- styledTextEventGetX evt y <- styledTextEventGetY evt res <- styledTextEventGetDragResult evt return $ STCDragOver (point x y) $ toDragResult res doDrop evt = do str <- styledTextEventGetDragText evt res <- styledTextEventGetDragResult evt return $ STCDoDrop str $ toDragResult res stcOnSTCEvent :: StyledTextCtrl a -> (EventSTC -> IO ()) -> IO () stcOnSTCEvent stc handler = do windowOnEvent stc stcEventsAll handler eventHandler where eventHandler event = do eventSTC <- fromSTCEvent (objectCast event) if isSTCUnknown eventSTC then return () -- what else? else handler eventSTC isSTCUnknown :: EventSTC -> Bool isSTCUnknown STCUnknown = True isSTCUnknown _ = False -- most of the events can probably be ignored stcEventsAll = map fst stcEvents stcGetOnSTCEvent :: StyledTextCtrl a -> IO (EventSTC -> IO ()) stcGetOnSTCEvent window = unsafeWindowGetHandlerState window (head $ map fst stcEvents) (\ev -> skipCurrentEvent) {----------------------------------------------------------------------------------------- Printing -----------------------------------------------------------------------------------------} -- | Printer events. data EventPrint = PrintBeginDoc (IO ()) Int Int -- ^ Print a copy: cancel, start page, end page | PrintEndDoc | PrintBegin -- ^ Begin a print job. | PrintEnd | PrintPrepare -- ^ Prepare: chance to call 'printOutSetPageLimits' for example. | PrintPage (IO ()) (DC ()) Int -- ^ Print a page: cancel, printer device context, page number. | PrintUnknown Int -- ^ Unknown print event with event code -- | Convert a 'PrintEvent' object to an 'EventPrint' value. fromPrintEvent :: WXCPrintEvent a -> IO EventPrint fromPrintEvent event = do tp <- eventGetEventType event case lookup tp printEvents of Just f -> f event Nothing -> return (PrintUnknown tp) -- | Print event list. printEvents :: [(Int,WXCPrintEvent a -> IO EventPrint)] printEvents = [(wxEVT_PRINT_PAGE, \ev -> do page <- wxcPrintEventGetPage ev pout <- wxcPrintEventGetPrintout ev dc <- printoutGetDC pout let cancel = wxcPrintEventSetContinue ev False return (PrintPage cancel dc page)) ,(wxEVT_PRINT_BEGIN_DOC,\ev -> do page <- wxcPrintEventGetPage ev epage<- wxcPrintEventGetEndPage ev let cancel = wxcPrintEventSetContinue ev False return (PrintBeginDoc cancel page epage)) ,(wxEVT_PRINT_PREPARE, \ev -> return PrintPrepare) ,(wxEVT_PRINT_END_DOC, \ev -> return PrintEndDoc) ,(wxEVT_PRINT_BEGIN, \ev -> return PrintBegin) ,(wxEVT_PRINT_END, \ev -> return PrintEnd) ] -- | Set an event handler for printing. printOutOnPrint :: WXCPrintout a -> (EventPrint -> IO ()) -> IO () printOutOnPrint printOut eventHandler = do evtHandler <- wxcPrintoutGetEvtHandler printOut evtHandlerOnEvent evtHandler idAny idAny (map fst printEvents) eventHandler (\_ -> return ()) printHandler where printHandler event = do eventPrint <- fromPrintEvent (objectCast event) eventHandler eventPrint -- | Get the current print handler printOutGetOnPrint :: WXCPrintout a -> IO (EventPrint -> IO ()) printOutGetOnPrint printOut = do evtHandler <- wxcPrintoutGetEvtHandler printOut unsafeGetHandlerState evtHandler idAny wxEVT_PRINT_PAGE (\ev -> skipCurrentEvent) {----------------------------------------------------------------------------------------- Scrolling -----------------------------------------------------------------------------------------} -- | Scroll events. data EventScroll = ScrollTop !Orientation !Int -- ^ scroll to top | ScrollBottom !Orientation !Int -- ^ scroll to bottom | ScrollLineUp !Orientation !Int -- ^ scroll line up | ScrollLineDown !Orientation !Int -- ^ scroll line down | ScrollPageUp !Orientation !Int -- ^ scroll page up | ScrollPageDown !Orientation !Int -- ^ scroll page down | ScrollTrack !Orientation !Int -- ^ frequent event when user drags the thumbtrack | ScrollRelease !Orientation !Int -- ^ thumbtrack is released deriving Show -- | The orientation of a widget. data Orientation = Horizontal | Vertical deriving (Eq, Show) -- | Get the orientation of a scroll event. scrollOrientation :: EventScroll -> Orientation scrollOrientation scroll = case scroll of ScrollTop orient pos -> orient ScrollBottom orient pos -> orient ScrollLineUp orient pos -> orient ScrollLineDown orient pos -> orient ScrollPageUp orient pos -> orient ScrollPageDown orient pos -> orient ScrollTrack orient pos -> orient ScrollRelease orient pos -> orient -- | Get the position of the scroll bar. scrollPos :: EventScroll -> Int scrollPos scroll = case scroll of ScrollTop orient pos -> pos ScrollBottom orient pos -> pos ScrollLineUp orient pos -> pos ScrollLineDown orient pos -> pos ScrollPageUp orient pos -> pos ScrollPageDown orient pos -> pos ScrollTrack orient pos -> pos ScrollRelease orient pos -> pos fromScrollEvent :: ScrollWinEvent a -> IO EventScroll fromScrollEvent event = do orient <- scrollWinEventGetOrientation event pos <- scrollWinEventGetPosition event tp <- eventGetEventType event let orientation | orient == wxHORIZONTAL = Horizontal | otherwise = Vertical case lookup tp scrollEvents of Just evt -> return (evt orientation pos) Nothing -> return (ScrollRelease orientation pos) scrollEvents :: [(Int,Orientation -> Int -> EventScroll)] scrollEvents = [(wxEVT_SCROLLWIN_TOP, ScrollTop) ,(wxEVT_SCROLLWIN_BOTTOM, ScrollBottom) ,(wxEVT_SCROLLWIN_LINEUP, ScrollLineUp) ,(wxEVT_SCROLLWIN_LINEDOWN, ScrollLineDown) ,(wxEVT_SCROLLWIN_PAGEUP, ScrollPageUp) ,(wxEVT_SCROLLWIN_PAGEDOWN, ScrollPageDown) ,(wxEVT_SCROLLWIN_THUMBTRACK, ScrollTrack) ,(wxEVT_SCROLLWIN_THUMBRELEASE, ScrollRelease) ] -- | Set a scroll event handler. windowOnScroll :: Window a -> (EventScroll -> IO ()) -> IO () windowOnScroll window eventHandler = windowOnEvent window (map fst scrollEvents) eventHandler scrollHandler where scrollHandler event = do eventScroll <- fromScrollEvent (objectCast event) eventHandler eventScroll -- | Get the current scroll event handler of a window. windowGetOnScroll :: Window a -> IO (EventScroll -> IO ()) windowGetOnScroll window = unsafeWindowGetHandlerState window wxEVT_SCROLLWIN_TOP (\scroll -> skipCurrentEvent) {-------------------------------------------------------------------------- Html event --------------------------------------------------------------------------} -- | Html window events data EventHtml = HtmlCellClicked String EventMouse Point -- ^ A /cell/ is clicked. Contains the cell /id/ attribute value, the mouse event and the logical coordinates. | HtmlCellHover String -- ^ The mouse hovers over a cell. Contains the cell /id/ attribute value. | HtmlLinkClicked String String String EventMouse Point -- ^ A link is clicked. Contains the hyperlink, the frame target, the cell /id/ attribute value, the mouse event, and the logical coordinates. | HtmlSetTitle String -- ^ Called when a @