diff options
| author | Camil Staps | 2015-07-01 17:36:37 +0200 |
|---|---|---|
| committer | Camil Staps | 2015-07-01 17:36:37 +0200 |
| commit | 7553b7f9d4dddc2235c137d41de8ce22547bebe3 (patch) | |
| tree | 34f8fb4b36640317d728a60586424f67f9befbe7 /windowevent.icl | |
| parent | gitignore (diff) | |
Initial commit
Diffstat (limited to 'windowevent.icl')
| -rw-r--r-- | windowevent.icl | 1169 |
1 files changed, 1169 insertions, 0 deletions
diff --git a/windowevent.icl b/windowevent.icl new file mode 100644 index 0000000..f77f1fc --- /dev/null +++ b/windowevent.icl @@ -0,0 +1,1169 @@ +implementation module windowevent
+
+
+import StdBool, StdFunc, StdList, StdMisc, StdTuple
+import clCCall_12, clCrossCall_12, windowCrossCall_12
+from ostypes import OSNoWindowPtr
+from oswindow import fromOSscrollbarRange, osScrollbarsAreVisible
+import commondef, controlcreate, deviceevents, iostate, windowaccess
+from StdControlAttribute import isControlKeyboard, getControlKeyboardAtt,
+ isControlMouse, getControlMouseAtt,
+ isControlActivate, isControlDeactivate
+from StdPSt import accPIO
+from StdWindowAttribute import isWindowKeyboard, getWindowKeyboardAtt,
+ isWindowMouse, getWindowMouseAtt,
+ isWindowCursor, getWindowCursorAtt
+from windowcreate import createModalDialogControls
+
+
+windoweventFatalError :: String String -> .x
+windoweventFatalError function error
+ = fatalError function "windowevent" error
+
+
+/* windowEvent filters the scheduler events that can be handled by this window device.
+ For the time being no timer controls are added, so these events are ignored.
+ windowEvent assumes that it is not applied to an empty IOSt.
+*/
+windowEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l)
+windowEvent schedulerEvent pState
+ # (hasDevice,pState) = accPIO (ioStHasDevice WindowDevice) pState
+ | not hasDevice // This condition should never occur: WindowDevice must have been 'installed'
+ = windoweventFatalError "windowFunctions.dEvent" "could not retrieve WindowSystemState from IOSt"
+ | otherwise
+ = windowEvent schedulerEvent pState
+where
+ windowEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l)
+ windowEvent schedulerEvent=:(ScheduleOSEvent osEvent _) pState=:{io=ioState}
+ | not (isWindowOSEvent osEvent.ccMsg)
+ = (False,Nothing,schedulerEvent,pState)
+ | otherwise
+ # (_,wDevice,ioState) = ioStGetDevice WindowDevice ioState
+ # (wMetrics, ioState) = ioStGetOSWindowMetrics ioState
+ windows = windowSystemStateGetWindowHandles wDevice
+ (myEvent,replyToOS,deviceEvent,windows,ioState)
+ = filterOSEvent wMetrics osEvent windows ioState
+ # ioState = ioStSetDevice (WindowSystemState windows) ioState
+ # pState = {pState & io=ioState}
+ schedulerEvent = if (isJust replyToOS) (ScheduleOSEvent osEvent (fromJust replyToOS)) schedulerEvent
+ = (myEvent,deviceEvent,schedulerEvent,pState)
+ where
+ isWindowOSEvent :: !Int -> Bool
+ isWindowOSEvent CcWmACTIVATE = True
+ isWindowOSEvent CcWmBUTTONCLICKED = True
+ isWindowOSEvent CcWmCLOSE = True
+ isWindowOSEvent CcWmCOMBOSELECT = True
+ isWindowOSEvent CcWmDEACTIVATE = True
+ isWindowOSEvent CcWmDRAWCONTROL = True
+ isWindowOSEvent CcWmIDLEDIALOG = True
+ isWindowOSEvent CcWmINITDIALOG = True
+ isWindowOSEvent CcWmKEYBOARD = True
+ isWindowOSEvent CcWmKILLFOCUS = True
+ isWindowOSEvent CcWmLOSTKEY = True
+ isWindowOSEvent CcWmLOSTMOUSE = True
+ isWindowOSEvent CcWmMOUSE = True
+ isWindowOSEvent CcWmPAINT = True
+ isWindowOSEvent CcWmSCROLLBARACTION = True
+ isWindowOSEvent CcWmSETFOCUS = True
+ isWindowOSEvent CcWmSIZE = True
+ isWindowOSEvent CcWmSPECIALBUTTON = True
+ isWindowOSEvent _ = False
+
+ windowEvent schedulerEvent=:(ScheduleMsgEvent msgEvent) pState=:{io=ioState}
+ # (ioId,ioState) = ioStGetIOId ioState
+ | ioId<>recLoc.rlIOId || recLoc.rlDevice<>WindowDevice
+ = (False,Nothing,schedulerEvent,{pState & io=ioState})
+ | otherwise
+ # (_,wDevice,ioState) = ioStGetDevice WindowDevice ioState
+ windows = windowSystemStateGetWindowHandles wDevice
+ (found,windows) = hasWindowHandlesWindow (toWID recLoc.rlParentId) windows
+ deviceEvent = if found (Just (ReceiverEvent msgEvent)) Nothing
+ # ioState = ioStSetDevice (WindowSystemState windows) ioState
+ # pState = {pState & io=ioState}
+ = (found,deviceEvent,schedulerEvent,pState)
+ where
+ recLoc = getMsgEventRecLoc msgEvent
+
+ windowEvent schedulerEvent pState
+ = (False,Nothing,schedulerEvent,pState)
+
+
+/* filterOSEvent filters the OSEvents that can be handled by this window device.
+*/
+filterOSEvent :: !OSWindowMetrics !OSEvent !(WindowHandles (PSt .l)) !(IOSt .l)
+ -> (!Bool,!Maybe [Int],!Maybe DeviceEvent,!WindowHandles (PSt .l), !IOSt .l)
+
+filterOSEvent _ {ccMsg=CcWmBUTTONCLICKED,p1=wPtr,p2=cPtr,p3=mods,p4=toolbarIndex} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (able,wsH) = getWindowStateHandleSelect wsH
+ | not able
+ = (True,Nothing,Nothing,setWindowHandlesWindow wsH windows,ioState)
+ | otherwise
+ # (wids, wsH) = getWindowStateHandleWIDS wsH
+ (itemNr,wsH) = getControlsItemNr cPtr wsH
+ controlSelectInfo = if (itemNr==0) // itemNrs are always > 0
+ Nothing
+ (Just (ControlSelection {csWIDS = wids
+ ,csItemNr = itemNr
+ ,csItemPtr = cPtr
+ ,csMoreData = 0
+ ,csModifiers= toModifiers mods
+ })
+ )
+ = (True,Nothing,controlSelectInfo,setWindowHandlesWindow wsH windows,ioState)
+where
+ getControlsItemNr :: !OSWindowPtr !(WindowStateHandle .pst) -> (!Int,!WindowStateHandle .pst)
+ getControlsItemNr cPtr wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whItems}}}
+ # (_,itemNr,itemHs) = getControlsItemNr cPtr whItems
+ = (itemNr,{wsH & wshHandle=Just {wlsH & wlsHandle={wH & whItems=itemHs}}})
+ where
+ getControlsItemNr :: !OSWindowPtr ![WElementHandle .ls .pst] -> (!Bool,!Int,![WElementHandle .ls .pst])
+ getControlsItemNr cPtr [itemH:itemHs]
+ # (found,itemNr,itemH) = getControlItemNr cPtr itemH
+ | found
+ = (found,itemNr,[itemH:itemHs])
+ | otherwise
+ # (found,itemNr,itemHs) = getControlsItemNr cPtr itemHs
+ = (found,itemNr,[itemH:itemHs])
+ where
+ getControlItemNr :: !OSWindowPtr !(WElementHandle .ls .pst) -> (!Bool,!Int,!WElementHandle .ls .pst)
+ getControlItemNr cPtr (WItemHandle itemH=:{wItemPtr,wItemNr,wItemInfo,wItemKind,wItemSelect,wItemShow,wItems})
+ | cPtr==wItemPtr = (True,itemNr,WItemHandle itemH)
+ | wItemKind==IsRadioControl = (contains (\{radioItemPtr}->radioItemPtr==cPtr) (getWItemRadioInfo wItemInfo).radioItems,itemNr,WItemHandle itemH)
+ | wItemKind==IsCheckControl = (contains (\{checkItemPtr}->checkItemPtr==cPtr) (getWItemCheckInfo wItemInfo).checkItems,itemNr,WItemHandle itemH)
+ | wItemSelect && wItemShow
+ # (found,itemNr,itemHs) = getControlsItemNr cPtr wItems
+ = (found,itemNr,WItemHandle {itemH & wItems=itemHs})
+ | otherwise
+ = (False,0,WItemHandle itemH)
+ where
+ itemNr = if wItemSelect wItemNr 0
+
+ getControlItemNr cPtr (WListLSHandle itemHs)
+ # (found,itemNr,itemHs) = getControlsItemNr cPtr itemHs
+ = (found,itemNr,WListLSHandle itemHs)
+
+ getControlItemNr cPtr (WExtendLSHandle wExH=:{wExtendItems=itemHs})
+ # (found,itemNr,itemHs) = getControlsItemNr cPtr itemHs
+ = (found,itemNr,WExtendLSHandle {wExH & wExtendItems=itemHs})
+
+ getControlItemNr cPtr (WChangeLSHandle wChH=:{wChangeItems=itemHs})
+ # (found,itemNr,itemHs) = getControlsItemNr cPtr itemHs
+ = (found,itemNr,WChangeLSHandle {wChH & wChangeItems=itemHs})
+
+ getControlsItemNr _ []
+ = (False,0,[])
+
+ getControlsItemNr _ _
+ = windoweventFatalError "getControlsItemNr" "window placeholder not expected"
+
+filterOSEvent _ {ccMsg=CcWmCOMBOSELECT,p1=wPtr,p2=cPtr,p3=index} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (able,wsH) = getWindowStateHandleSelect wsH
+ | not able
+ = (True,Nothing,Nothing,setWindowHandlesWindow wsH windows,ioState)
+ | otherwise
+ # (wids, wsH) = getWindowStateHandleWIDS wsH
+ (itemNr,wsH) = getPopUpControlItemNr cPtr wsH
+ controlSelectInfo = if (itemNr==0) // itemNrs are always > 0
+ Nothing
+ (Just (ControlSelection {csWIDS = wids
+ ,csItemNr = itemNr
+ ,csItemPtr = cPtr
+ ,csMoreData = index+1
+ ,csModifiers= NoModifiers
+ })
+ )
+ = (True,Nothing,controlSelectInfo,setWindowHandlesWindow wsH windows,ioState)
+where
+ getPopUpControlItemNr :: !OSWindowPtr !(WindowStateHandle .pst) -> (!Int,!WindowStateHandle .pst)
+ getPopUpControlItemNr cPtr wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whItems}}}
+ # (_,itemNr,itemHs) = getPopUpControlsItemNr cPtr whItems
+ = (itemNr,{wsH & wshHandle=Just {wlsH & wlsHandle={wH & whItems=itemHs}}})
+ where
+ getPopUpControlsItemNr :: !OSWindowPtr ![WElementHandle .ls .pst] -> (!Bool,!Int,![WElementHandle .ls .pst])
+ getPopUpControlsItemNr cPtr [itemH:itemHs]
+ # (found,itemNr,itemH) = getPopUpControlItemNr cPtr itemH
+ | found
+ = (found,itemNr,[itemH:itemHs])
+ | otherwise
+ # (found,itemNr,itemHs) = getPopUpControlsItemNr cPtr itemHs
+ = (found,itemNr,[itemH:itemHs])
+ where
+ getPopUpControlItemNr :: !OSWindowPtr !(WElementHandle .ls .pst) -> (!Bool,!Int,!WElementHandle .ls .pst)
+ getPopUpControlItemNr cPtr (WItemHandle itemH=:{wItemPtr,wItemNr,wItemKind,wItemSelect,wItemShow,wItems})
+ | cPtr==wItemPtr
+ = (True,if (wItemKind==IsPopUpControl && wItemSelect && wItemShow) wItemNr 0,WItemHandle itemH)
+ | wItemShow
+ # (found,itemNr,itemHs) = getPopUpControlsItemNr cPtr wItems
+ = (found,itemNr,WItemHandle {itemH & wItems=itemHs})
+ | otherwise
+ = (False,0,WItemHandle itemH)
+
+ getPopUpControlItemNr cPtr (WListLSHandle itemHs)
+ # (found,itemNr,itemHs) = getPopUpControlsItemNr cPtr itemHs
+ = (found,itemNr,WListLSHandle itemHs)
+
+ getPopUpControlItemNr cPtr (WExtendLSHandle wExH=:{wExtendItems=itemHs})
+ # (found,itemNr,itemHs) = getPopUpControlsItemNr cPtr itemHs
+ = (found,itemNr,WExtendLSHandle {wExH & wExtendItems=itemHs})
+
+ getPopUpControlItemNr cPtr (WChangeLSHandle wChH=:{wChangeItems=itemHs})
+ # (found,itemNr,itemHs) = getPopUpControlsItemNr cPtr itemHs
+ = (found,itemNr,WChangeLSHandle {wChH & wChangeItems=itemHs})
+
+ getPopUpControlsItemNr _ []
+ = (False,0,[])
+
+ getPopUpControlItemNr _ _
+ = windoweventFatalError "getPopUpControlItemNr" "window placeholder not expected"
+
+filterOSEvent _ {ccMsg=CcWmDRAWCONTROL,p1=wPtr,p2=cPtr,p3=gc} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ | otherwise
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ # (controls,wsH) = getUpdateControls cPtr wsH
+ updateInfo = if (isEmpty controls)
+ Nothing
+ (Just (WindowUpdate {updWIDS=wids,updWindowArea=zero,updControls=controls,updGContext=Just gc}))
+ = (True,Nothing,updateInfo,setWindowHandlesWindow wsH windows,ioState)
+where
+ getUpdateControls :: !OSWindowPtr !(WindowStateHandle .pst) -> (![ControlUpdateInfo],!WindowStateHandle .pst)
+ getUpdateControls cPtr wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whItems,whSize}}}
+ # (_,controls,itemHs) = getUpdateControls cPtr (sizeToRect whSize) whItems
+ = (controls,{wsH & wshHandle=Just {wlsH & wlsHandle={wH & whItems=itemHs}}})
+ where
+ getUpdateControls :: !OSWindowPtr !OSRect ![WElementHandle .ls .pst] -> (!Bool,![ControlUpdateInfo],![WElementHandle .ls .pst])
+ getUpdateControls cPtr clipRect [itemH:itemHs]
+ # (found,controls,itemH) = getUpdateControl cPtr clipRect itemH
+ | found
+ = (found,controls,[itemH:itemHs])
+ | otherwise
+ # (found,controls,itemHs) = getUpdateControls cPtr clipRect itemHs
+ = (found,controls,[itemH:itemHs])
+ where
+ getUpdateControl :: !OSWindowPtr !OSRect !(WElementHandle .ls .pst) -> (!Bool,![ControlUpdateInfo],!WElementHandle .ls .pst)
+ getUpdateControl cPtr clipRect (WItemHandle itemH=:{wItemPtr,wItemNr,wItemShow,wItemPos,wItemSize,wItems})
+ | cPtr==wItemPtr
+ = (True,[{cuItemNr=wItemNr,cuItemPtr=wItemPtr,cuArea=clipRect1}],WItemHandle itemH)
+ | wItemShow
+ # (found,controls,itemHs) = getUpdateControls cPtr clipRect1 wItems
+ = (found,controls,WItemHandle {itemH & wItems=itemHs})
+ | otherwise
+ = (False,[],WItemHandle itemH)
+ where
+ clipRect1 = intersectRects clipRect (posSizeToRect wItemPos wItemSize)
+
+ getUpdateControl cPtr clipRect (WListLSHandle itemHs)
+ # (found,controls,itemHs) = getUpdateControls cPtr clipRect itemHs
+ = (found,controls,WListLSHandle itemHs)
+
+ getUpdateControl cPtr clipRect (WExtendLSHandle wExH=:{wExtendItems=itemHs})
+ # (found,controls,itemHs) = getUpdateControls cPtr clipRect itemHs
+ = (found,controls,WExtendLSHandle {wExH & wExtendItems=itemHs})
+
+ getUpdateControl cPtr clipRect (WChangeLSHandle wChH=:{wChangeItems=itemHs})
+ # (found,controls,itemHs) = getUpdateControls cPtr clipRect itemHs
+ = (found,controls,WChangeLSHandle {wChH & wChangeItems=itemHs})
+
+ getUpdateControls _ _ []
+ = (False,[],[])
+
+ getUpdateControls _ _
+ = windoweventFatalError "getUpdateControls" "placeholder not expected"
+
+/* PA: CcWmIDLEDIALOG is sent after a modal dialogue and its controls have been created.
+ At that moment the initialisation action can be evaluated. This is done by the
+ WindowInitialise device event.
+*/
+filterOSEvent _ {ccMsg=CcWmIDLEDIALOG,p1=wPtr} windows ioState
+ # (maybeWIDS,windows) = getWindowHandlesActiveModalDialog windows
+ | isNothing maybeWIDS
+ = (False,Nothing,Nothing,windows,ioState)
+ # wids = fromJust maybeWIDS
+ | wPtr<>wids.wPtr
+ = (False,Nothing,Nothing,windows,ioState)
+ | otherwise
+ = (True,Nothing,Just (WindowInitialise (fromJust maybeWIDS)),windows,ioState)
+
+/* PA: CcWmINITDIALOG is generated for modal and modeless dialogs. It should create all the controls of the
+ dialog, and return the desired position, size, and focus control of the dialog.
+ PA: THE FOLLOWING STATEMENT IS NOT TRUE; FUNCTIONALITY MOVED TO CcWmIDLEDIALOG.
+ In addition, the return DeviceEvent should be WindowInitialise to have the initialisation
+ function evaluated.
+*/
+/* PA: previous version. Now code is shared in windowcreate and windowevent.
+filterOSEvent wMetrics {ccMsg=CcWmINITDIALOG,p1=wPtr} windows ioState
+ # (maybeWIDS,windows) = getWindowHandlesActiveWindow windows
+ | isNothing maybeWIDS
+ = (False,Nothing,Nothing,windows,ioState)
+ # wids = fromJust maybeWIDS
+ | wids.wPtr<>0
+ = (False,Nothing,Nothing,windows,ioState)
+ | otherwise
+ # (_,wsH,windows) = removeWindowHandlesWindow (toWID 0) windows
+ wids = {wids & wPtr=wPtr}
+ wsH = (\wsH->{wsH & wshIds=wids}) wsH
+ # (tb,ioState) = getIOToolbox ioState
+ # (returnOS,wsH,tb) = createDialogControls wMetrics wsH tb
+ # ioState = setIOToolbox tb ioState
+ windows = addWindowHandlesActiveWindow wsH windows
+ = (True,Just returnOS,Nothing,windows,ioState)
+where
+ createDialogControls :: !OSWindowMetrics !(WindowStateHandle .pst) !*OSToolbox
+ -> (![Int], !WindowStateHandle .pst, !*OSToolbox)
+ createDialogControls wMetrics wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whItems=itemHs,whSize={w,h}}}} tb
+ # (itemHs,tb) = createControls wMetrics whDefaultId whCancelId True wPtr itemHs tb
+ # (itemPtr,wH) = getInitActiveControl {wH & whItems=itemHs}
+ r5cci = [-1,-1,w,h,if (itemPtr==OSNoWindowPtr) 0 itemPtr]
+ = (r5cci,{wsH & wshHandle=Just {wlsH & wlsHandle=wH}},tb)
+ where
+ whDefaultId = wH.whDefaultId
+ whCancelId = wH.whCancelId
+ createDialogControls _ _ _
+ = windoweventFatalError "createDialogControls" "placeholder not expected"
+*/
+filterOSEvent wMetrics {ccMsg=CcWmINITDIALOG,p1=wPtr} windows ioState
+ # (maybeWIDS,windows) = getWindowHandlesActiveWindow windows
+ | isNothing maybeWIDS
+ = (False,Nothing,Nothing,windows,ioState)
+ # wids = fromJust maybeWIDS
+ | wids.wPtr<>0
+ = (False,Nothing,Nothing,windows,ioState)
+ # (tb,ioState) = getIOToolbox ioState
+ # (itemPtr,windows,tb) = createModalDialogControls wMetrics wPtr windows tb
+ # ioState = setIOToolbox tb ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found // This alternative can't be reached, because createModalDialogControls has added this handle
+ = windoweventFatalError "filterOSEvent (CcWmINITDIALOG)" "could not retrieve window"
+ | otherwise
+ # ({w,h},wsH) = getWindowStateHandleSize wsH
+ windows = setWindowHandlesWindow wsH windows
+ = (True,Just [-1,-1,w,h,if (itemPtr==OSNoWindowPtr) 0 itemPtr],Nothing,windows,ioState)
+
+filterOSEvent _ {ccMsg=CcWmSCROLLBARACTION,p1=wPtr,p2=cPtr,p3=iBar,p4=action,p5=osThumb} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (able,wsH) = getWindowStateHandleSelect wsH
+ | not able
+ = (True,Nothing,Nothing,setWindowHandlesWindow wsH windows,ioState)
+ | otherwise
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ (sliderEvent,wsH) = getSlidersEvent wids iBar osThumb cPtr wsH
+ = (True,Nothing,Just sliderEvent,setWindowHandlesWindow wsH windows,ioState)
+where
+ getSlidersEvent :: !WIDS !Int !Int !OSWindowPtr !(WindowStateHandle .pst) -> (!DeviceEvent,!WindowStateHandle .pst)
+ getSlidersEvent wids iBar osThumb itemPtr wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whWindowInfo,whItems,whSize={w,h}}}}
+ | wids.wPtr==itemPtr
+ = (WindowScrollAction info,wsH)
+ with
+ info = { wsaWIDS = wids
+ , wsaSliderMove = move min max view osThumb
+ , wsaDirection = if isHorizontal Horizontal Vertical
+ }
+ windowInfo = getWindowInfoWindowData whWindowInfo
+ domainRect = windowInfo.windowDomain
+ isHorizontal = iBar==SB_HORZ
+ (min,max,view) = if isHorizontal
+ (domainRect.rleft,domainRect.rright, w)
+ (domainRect.rtop, domainRect.rbottom,h)
+ # (found,sliderEvent,itemHs)= getSlidersEvent wids iBar osThumb itemPtr whItems
+ | found
+ = (sliderEvent,{wsH & wshHandle=Just {wlsH & wlsHandle={wH & whItems=itemHs}}})
+ | otherwise
+ = windoweventFatalError "getSlidersEvent" "SliderControl could not be located"
+ where
+ getSlidersEvent :: !WIDS !Int !Int !OSWindowPtr ![WElementHandle .ls .pst] -> (!Bool,!DeviceEvent,![WElementHandle .ls .pst])
+ getSlidersEvent wids iBar osThumb itemPtr [itemH:itemHs]
+ # (found,sliderEvent,itemH) = getSliderEvent wids iBar osThumb itemPtr itemH
+ | found
+ = (found,sliderEvent,[itemH:itemHs])
+ | otherwise
+ # (found,sliderEvent,itemHs)= getSlidersEvent wids iBar osThumb itemPtr itemHs
+ = (found,sliderEvent,[itemH:itemHs])
+ where
+ getSliderEvent :: !WIDS !Int !Int !OSWindowPtr !(WElementHandle .ls .pst) -> (!Bool,!DeviceEvent,!WElementHandle .ls .pst)
+ getSliderEvent wids iBar osThumb itemPtr (WItemHandle itemH=:{wItemPtr,wItemNr,wItemKind,wItemShow,wItems,wItemInfo,wItemSize})
+ | itemPtr<>wItemPtr
+ | wItemShow
+ # (found,sliderEvent,itemHs) = getSlidersEvent wids iBar osThumb itemPtr wItems
+ = (found,sliderEvent,WItemHandle {itemH & wItems=itemHs})
+ // otherwise
+ = (False,ControlSliderAction dummySlidersEvent,WItemHandle itemH)
+ | wItemKind==IsCompoundControl
+ = (True,CompoundScrollAction info,WItemHandle itemH)
+ with
+ info = { csaWIDS = wids
+ , csaItemNr = wItemNr
+ , csaItemPtr = itemPtr
+ , csaSliderMove = move min max view osThumb
+ , csaDirection = if isHorizontal Horizontal Vertical
+ }
+ compoundInfo = getWItemCompoundInfo wItemInfo
+ domainRect = compoundInfo.compoundDomain
+ isHorizontal = iBar==SB_HORZ
+ (min,max,view) = if isHorizontal
+ (domainRect.rleft,domainRect.rright, wItemSize.w)
+ (domainRect.rtop, domainRect.rbottom,wItemSize.h)
+ | otherwise
+ = (True,ControlSliderAction info,WItemHandle itemH)
+ with
+ info = { cslWIDS = wids
+ , cslItemNr = wItemNr
+ , cslItemPtr = itemPtr
+ , cslSliderMove = move sliderState.sliderMin sliderState.sliderMax 0 osThumb
+ }
+ sliderInfo = getWItemSliderInfo wItemInfo
+ sliderState = sliderInfo.sliderInfoState
+
+ getSliderEvent wids iBar osThumb itemPtr (WListLSHandle itemHs)
+ # (found,sliderEvent,itemHs) = getSlidersEvent wids iBar osThumb itemPtr itemHs
+ = (found,sliderEvent,WListLSHandle itemHs)
+
+ getSliderEvent wids iBar osThumb itemPtr (WExtendLSHandle wExH=:{wExtendItems=itemHs})
+ # (found,sliderEvent,itemHs) = getSlidersEvent wids iBar osThumb itemPtr itemHs
+ = (found,sliderEvent,WExtendLSHandle {wExH & wExtendItems=itemHs})
+
+ getSliderEvent wids iBar osThumb itemPtr (WChangeLSHandle wChH=:{wChangeItems=itemHs})
+ # (found,sliderEvent,itemHs) = getSlidersEvent wids iBar osThumb itemPtr itemHs
+ = (found,sliderEvent,WChangeLSHandle {wChH & wChangeItems=itemHs})
+
+ getSlidersEvent _ _ _ _ []
+ = (False,ControlSliderAction dummySlidersEvent,[])
+
+ dummySlidersEvent = { cslWIDS=wids,cslItemNr=0,cslItemPtr=0,cslSliderMove=SliderIncSmall }
+
+ getSlidersEvent _ _ _ _ _
+ = windoweventFatalError "getSlidersEvent" "placeholder not expected"
+
+ move :: !Int !Int !Int !Int -> SliderMove
+ move min max view osThumb
+ = case action of
+ SB_LINEUP -> SliderDecSmall
+ SB_LINEDOWN -> SliderIncSmall
+ SB_PAGEUP -> SliderDecLarge
+ SB_PAGEDOWN -> SliderIncLarge
+ SB_THUMBPOSITION-> SliderThumb (fromOSscrollbarRange (min,max) osThumb)
+ SB_THUMBTRACK -> SliderThumb (fromOSscrollbarRange (min,max) osThumb)
+ SB_TOP -> SliderThumb min
+ SB_BOTTOM -> SliderThumb (max-view)
+ SB_ENDSCROLL -> SliderThumb (fromOSscrollbarRange (min,max) osThumb)
+
+filterOSEvent _ {ccMsg=CcWmACTIVATE,p1=wPtr} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (active,wsH) = getWindowStateHandleActive wsH
+ | active // The window is already active, skip
+ = (True,Nothing,Nothing,setWindowHandlesWindow wsH windows,ioState)
+ | otherwise
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ windows = setWindowHandlesWindow wsH windows
+// (activeModal,windows) = getWindowHandlesActiveModalDialog windows
+// = (True,Nothing,if (isJust activeModal) (Just (WindowInitialise wids)) (Just (WindowActivation wids)),windows,ioState) // PA: WindowInitialise? Why? Doesn't smell well
+ = (True,Nothing,Just (WindowActivation wids),windows,ioState) // DvA: always activate/deactivate windows
+
+filterOSEvent _ {ccMsg=CcWmCLOSE,p1=wPtr} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ | otherwise
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ windows = setWindowHandlesWindow wsH windows
+ = (True,Nothing,Just (WindowRequestClose wids),windows,ioState)
+
+filterOSEvent _ {ccMsg=CcWmDEACTIVATE,p1=wPtr} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+// PA: in my version this test was not present.
+ # (active,wsH) = getWindowStateHandleActive wsH
+ | not active // The window is already inactive, skip
+ = (True,Nothing,Nothing,setWindowHandlesWindow wsH windows,ioState)
+// ...PA
+ | otherwise
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ windows = setWindowHandlesWindow wsH windows
+// (activeModal,windows) = getWindowHandlesActiveModalDialog windows
+// = (True,Nothing,if (isJust activeModal) Nothing (Just (WindowDeactivation wids)),windows,ioState)
+ = (True,Nothing,Just (WindowDeactivation wids),windows,ioState) // DvA: always activate/deactivate windows
+
+filterOSEvent _ {ccMsg=CcWmKEYBOARD,p1=wPtr,p2=cPtr,p3=keycode,p4=state,p5=mods} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ | wPtr==cPtr // The keyboard action takes place in the window
+ # (inputTrack,ioState) = ioStGetInputTrack ioState
+ (ok,key,wsH,inputTrack) = okWindowKeyboardState keycode state mods wsH inputTrack
+ # ioState = ioStSetInputTrack inputTrack ioState
+ deviceEvent = if ok (Just (WindowKeyboardAction {wkWIDS=wids,wkKeyboardState=key})) Nothing
+ = (True,Nothing,deviceEvent,setWindowHandlesWindow wsH windows,ioState)
+ with
+ okWindowKeyboardState :: !Int !Int !Int !(WindowStateHandle .pst) !(Maybe InputTrack)
+ -> (!Bool,KeyboardState,!WindowStateHandle .pst, ! Maybe InputTrack)
+ okWindowKeyboardState keycode state mods wsH=:{wshHandle=Just {wlsHandle={whKind,whWindowInfo,whAtts}}} inputTrack
+ | whKind==IsDialog
+ = (False,undef,wsH,inputTrack)
+ | trackingKeyboard wPtr 0 inputTrack // Window is already handle Key(Repeat/Up)
+ | isDownKey // Ignore all key down events
+ = (False,undef,wsH,inputTrack)
+ | pressState==KeyUp
+ = (okKeyboardAtt,keystate,wsH,untrackKeyboard inputTrack) // Clear keyboard tracking
+ // otherwise
+ = (okKeyboardAtt,keystate,wsH,inputTrack)
+ | isDownKey
+ = (okKeyboardAtt,keystate,wsH,trackKeyboard wPtr 0 inputTrack) // Key down sets input track
+ | otherwise
+ = (False,undef,wsH,inputTrack)
+ where
+ keystate = keyState keycode state mods
+ pressState = getKeyboardStateKeyState keystate
+ isDownKey = pressState==KeyDown False
+ (filter,selectState,_) = getWindowKeyboardAtt (snd (cselect isWindowKeyboard (WindowKeyboard (const False) Unable undef) whAtts))
+ okKeyboardAtt = filter keystate && selectState==Able
+ okWindowKeyboardState _ _ _ _ _
+ = windoweventFatalError "okWindowKeyboardState" "placeholder not expected"
+ | otherwise // The keyboard action takes place in a control
+ # (inputTrack,ioState) = ioStGetInputTrack ioState
+ (ok,itemNr,key,wsH,inputTrack)= okControlItemsNrKeyboardState wPtr cPtr keycode state mods wsH inputTrack
+ # ioState = ioStSetInputTrack inputTrack ioState
+ info = { ckWIDS = wids
+ , ckItemNr = itemNr
+ , ckItemPtr = cPtr
+ , ckKeyboardState = key
+ }
+ deviceEvent = if ok (Just (ControlKeyboardAction info)) Nothing
+ = (True,Nothing,deviceEvent,setWindowHandlesWindow wsH windows,ioState)
+ with
+ okControlItemsNrKeyboardState :: !OSWindowPtr !OSWindowPtr !Int !Int !Int !(WindowStateHandle .pst) !(Maybe InputTrack)
+ -> (!Bool,!Int,KeyboardState,!WindowStateHandle .pst, ! Maybe InputTrack)
+ okControlItemsNrKeyboardState wPtr itemPtr keycode state mods wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whItems}}} inputTrack
+ # (_,ok,itemNr,itemPos,itemHs,inputTrack) = okControlsItemNrKeyboardState wPtr itemPtr True keycode state mods whItems inputTrack
+ = (ok,itemNr,itemPos,{wsH & wshHandle=Just {wlsH & wlsHandle={wH & whItems=itemHs}}},inputTrack)
+ where
+ okControlsItemNrKeyboardState :: !OSWindowPtr !OSWindowPtr !Bool !Int !Int !Int ![WElementHandle .ls .pst] !(Maybe InputTrack)
+ -> (!Bool,!Bool,!Int,KeyboardState,![WElementHandle .ls .pst],! Maybe InputTrack)
+ okControlsItemNrKeyboardState wPtr itemPtr contextAble keycode state mods [itemH:itemHs] inputTrack
+ # (found,ok,itemNr,itemPos,itemH,inputTrack) = okControlItemNrKeyboardState wPtr itemPtr contextAble keycode state mods itemH inputTrack
+ | found
+ = (found,ok,itemNr,itemPos,[itemH:itemHs],inputTrack)
+ | otherwise
+ # (found,ok,itemNr,itemPos,itemHs,inputTrack) = okControlsItemNrKeyboardState wPtr itemPtr contextAble keycode state mods itemHs inputTrack
+ = (found,ok,itemNr,itemPos,[itemH:itemHs],inputTrack)
+ where
+ okControlItemNrKeyboardState :: !OSWindowPtr !OSWindowPtr !Bool !Int !Int !Int !(WElementHandle .ls .pst) !(Maybe InputTrack)
+ -> (!Bool,!Bool,!Int,KeyboardState,!WElementHandle .ls .pst, ! Maybe InputTrack)
+ okControlItemNrKeyboardState wPtr itemPtr contextAble keycode state mods
+ (WItemHandle itemH=:{wItemPtr,wItemNr,wItemKind,wItemSelect,wItemShow,wItemAtts})
+ inputTrack
+ | itemPtr<>wItemPtr
+ | not wItemShow
+ = (False,False,0,undef,WItemHandle itemH,inputTrack)
+ // otherwise
+ # (found,ok,itemNr,itemPos,itemHs,inputTrack) = okControlsItemNrKeyboardState wPtr itemPtr contextAble1 keycode state mods itemH.wItems inputTrack
+ = (found,ok,itemNr,itemPos,WItemHandle {itemH & wItems=itemHs},inputTrack)
+ | trackingKeyboard wPtr itemPtr inputTrack // Control is already handling Key(Repeat/Up)
+ | isDownKey // Ignore all key down events
+ = (True,False,0,undef,WItemHandle itemH,inputTrack)
+ | pressState==KeyUp // Clear keyboard tracking
+ = (True,okKeyboardAtt,wItemNr,keystate,WItemHandle itemH,untrackKeyboard inputTrack)
+ // otherwise
+ = (True,okKeyboardAtt,wItemNr,keystate,WItemHandle itemH,inputTrack)
+ | isDownKey // Key down sets input track
+ = (True,okKeyboardAtt,wItemNr,keystate,WItemHandle itemH,trackKeyboard wPtr itemPtr inputTrack)
+ | otherwise
+ = (True,False,0,undef,WItemHandle itemH,inputTrack)
+ where
+ contextAble1 = contextAble && wItemSelect
+ noKeyboardAtt = ControlKeyboard (const False) Unable undef
+ (filter,selectState,_) = getControlKeyboardAtt (snd (cselect isControlKeyboard noKeyboardAtt wItemAtts))
+ okKeyboardAtt = contextAble1 && enabled selectState && filter keystate
+ keystate = keyState keycode state mods
+ pressState = getKeyboardStateKeyState keystate
+ isDownKey = pressState==KeyDown False
+
+ okControlItemNrKeyboardState wPtr itemPtr contextAble keycode state mods (WListLSHandle itemHs) inputTrack
+ # (found,ok,itemNr,itemPos,itemHs,inputTrack) = okControlsItemNrKeyboardState wPtr itemPtr contextAble keycode state mods itemHs inputTrack
+ = (found,ok,itemNr,itemPos,WListLSHandle itemHs,inputTrack)
+
+ okControlItemNrKeyboardState wPtr itemPtr contextAble keycode state mods (WExtendLSHandle wExH=:{wExtendItems=itemHs}) inputTrack
+ # (found,ok,itemNr,itemPos,itemHs,inputTrack) = okControlsItemNrKeyboardState wPtr itemPtr contextAble keycode state mods itemHs inputTrack
+ = (found,ok,itemNr,itemPos,WExtendLSHandle {wExH & wExtendItems=itemHs},inputTrack)
+
+ okControlItemNrKeyboardState wPtr itemPtr contextAble keycode state mods (WChangeLSHandle wChH=:{wChangeItems=itemHs}) inputTrack
+ # (found,ok,itemNr,itemPos,itemHs,inputTrack) = okControlsItemNrKeyboardState wPtr itemPtr contextAble keycode state mods itemHs inputTrack
+ = (found,ok,itemNr,itemPos,WChangeLSHandle {wChH & wChangeItems=itemHs},inputTrack)
+
+ okControlsItemNrKeyboardState _ _ _ _ _ _ itemH inputTrack
+ = (False,False,0,undef,itemH,inputTrack)
+
+ okControlItemsNrKeyboardState _ _ _ _ _ _ _
+ = windoweventFatalError "okControlItemsNrKeyboardState" "window placeholder not expected"
+where
+ keyState :: !Int !Int !Int -> KeyboardState
+ keyState keycode state mods
+ | isSpecial = SpecialKey special ks modifiers
+ | otherwise = CharKey (toChar keycode) ks
+ where
+ modifiers = toModifiers mods
+ ks = case state of
+ KEYDOWN -> KeyDown False
+ KEYREPEAT -> KeyDown True
+ KEYUP -> KeyUp
+ (isSpecial,special) = case keycode of
+ WinBackSpKey-> (True,backSpaceKey)
+ WinBeginKey -> (True,beginKey)
+ WinDelKey -> (True,deleteKey)
+ WinDownKey -> (True,downKey)
+ WinEndKey -> (True,endKey)
+ WinEscapeKey-> (True,escapeKey)
+ WinHelpKey -> (True,helpKey)
+ WinLeftKey -> (True,leftKey)
+ WinPgDownKey-> (True,pgDownKey)
+ WinPgUpKey -> (True,pgUpKey)
+ WinReturnKey-> (True,enterKey)
+ WinRightKey -> (True,rightKey)
+ WinUpKey -> (True,upKey)
+ WinF1Key -> (True,f1Key)
+ WinF2Key -> (True,f2Key)
+ WinF3Key -> (True,f3Key)
+ WinF4Key -> (True,f4Key)
+ WinF5Key -> (True,f5Key)
+ WinF6Key -> (True,f6Key)
+ WinF7Key -> (True,f7Key)
+ WinF8Key -> (True,f8Key)
+ WinF9Key -> (True,f9Key)
+ WinF10Key -> (True,f10Key)
+ WinF11Key -> (True,f11Key)
+ WinF12Key -> (True,f12Key)
+ _ -> (False,undef)
+
+filterOSEvent _ {ccMsg=CcWmKILLFOCUS,p1=wPtr,p2=cPtr} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ (found,itemNr,wsH) = getControlKeyFocusItemNr False cPtr wsH
+ windows = setWindowHandlesWindow wsH windows
+ | not found
+ = (True,Nothing,Nothing,windows,ioState)
+ | otherwise
+ = (True,Nothing,Just (ControlLooseKeyFocus {ckfWIDS=wids,ckfItemNr=itemNr,ckfItemPtr=cPtr}),windows,ioState)
+
+filterOSEvent _ {ccMsg=CcWmLOSTKEY,p1=wPtr,p2=cPtr} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (able,wsH) = getWindowStateHandleSelect wsH
+ | not able
+ = (True,Nothing,Nothing,setWindowHandlesWindow wsH windows,ioState)
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ | wPtr==cPtr // The window lost the keyboard input
+ # (ok,wsH) = okWindowKeyLost wsH
+ deviceEvent = if ok (Just (WindowKeyboardAction {wkWIDS=wids,wkKeyboardState=KeyLost})) Nothing
+ = (True,Nothing,deviceEvent,setWindowHandlesWindow wsH windows,ioState)
+ with
+ okWindowKeyLost :: !(WindowStateHandle .pst) -> (!Bool,!WindowStateHandle .pst)
+ okWindowKeyLost wsH=:{wshHandle=Just {wlsHandle={whKind,whAtts}}}
+ | whKind==IsDialog
+ = (False,wsH)
+ | otherwise
+ = (okKeyAtt,wsH)
+ where
+ (filter,selectState,_) = getWindowKeyboardAtt (snd (cselect isWindowKeyboard (WindowKeyboard (const False) Unable undef) whAtts))
+ okKeyAtt = filter KeyLost && selectState==Able
+ okWindowKeyLost _
+ = windoweventFatalError "okWindowKeyLost" "placeholder not expected"
+ | otherwise // One of the window controls lost the keyboard input
+ # (ok,itemNr,wsH) = okControlItemNrsKeyLost cPtr wsH
+ info = { ckWIDS = wids
+ , ckItemNr = itemNr
+ , ckItemPtr = cPtr
+ , ckKeyboardState = KeyLost
+ }
+ deviceEvent = if (ok && itemNr>0) (Just (ControlKeyboardAction info)) Nothing
+ = (True,Nothing,deviceEvent,setWindowHandlesWindow wsH windows,ioState)
+ with
+ okControlItemNrsKeyLost :: !OSWindowPtr !(WindowStateHandle .pst) -> (!Bool,!Int,!WindowStateHandle .pst)
+ okControlItemNrsKeyLost itemPtr wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whItems}}}
+ # (_,ok,itemNr,itemHs) = okControlsItemNrKeyLost True itemPtr whItems
+ = (ok,itemNr,{wsH & wshHandle=Just {wlsH & wlsHandle={wH & whItems=itemHs}}})
+ where
+ okControlsItemNrKeyLost :: !Bool !OSWindowPtr ![WElementHandle .ls .pst] -> (!Bool,!Bool,!Int,![WElementHandle .ls .pst])
+ okControlsItemNrKeyLost contextAble itemPtr [itemH:itemHs]
+ # (found,ok,itemNr,itemH) = okControlItemNrKeyLost contextAble itemPtr itemH
+ | found
+ = (found,ok,itemNr,[itemH:itemHs])
+ | otherwise
+ # (found,ok,itemNr,itemHs) = okControlsItemNrKeyLost contextAble itemPtr itemHs
+ = (found,ok,itemNr,[itemH:itemHs])
+ where
+ okControlItemNrKeyLost :: !Bool !OSWindowPtr !(WElementHandle .ls .pst) -> (!Bool,!Bool,!Int,!WElementHandle .ls .pst)
+ okControlItemNrKeyLost contextAble itemPtr (WItemHandle itemH=:{wItemPtr,wItemNr,wItemSelect,wItemShow,wItemAtts,wItems})
+ | itemPtr<>wItemPtr
+ | wItemShow
+ # (found,okKey,itemNr,itemHs) = okControlsItemNrKeyLost contextAble1 itemPtr wItems
+ = (found,okKey,itemNr,WItemHandle {itemH & wItems=itemHs})
+ // otherwise
+ = (False,False,0,WItemHandle itemH)
+ | otherwise
+ = (True,okKeyAtt,wItemNr,WItemHandle itemH)
+ where
+ contextAble1= contextAble && wItemSelect
+ (filter,selectState,_)
+ = getControlKeyboardAtt (snd (cselect isControlKeyboard (ControlKeyboard (const False) Unable undef) wItemAtts))
+ okKeyAtt = contextAble1 && enabled selectState && filter KeyLost
+
+ okControlItemNrKeyLost contextAble itemPtr (WListLSHandle itemHs)
+ # (found,okKey,itemNr,itemHs) = okControlsItemNrKeyLost contextAble itemPtr itemHs
+ = (found,okKey,itemNr,WListLSHandle itemHs)
+
+ okControlItemNrKeyLost contextAble itemPtr (WExtendLSHandle wExH=:{wExtendItems=itemHs})
+ # (found,okKey,itemNr,itemHs) = okControlsItemNrKeyLost contextAble itemPtr itemHs
+ = (found,okKey,itemNr,WExtendLSHandle {wExH & wExtendItems=itemHs})
+
+ okControlItemNrKeyLost contextAble itemPtr (WChangeLSHandle wChH=:{wChangeItems=itemHs})
+ # (found,okKey,itemNr,itemHs) = okControlsItemNrKeyLost contextAble itemPtr itemHs
+ = (found,okKey,itemNr,WChangeLSHandle {wChH & wChangeItems=itemHs})
+
+ okControlsItemNrKeyLost _ _ []
+ = (False,False,0,[])
+
+ okControlItemNrsKeyLost _ _
+ = windoweventFatalError "okControlItemNrsKeyLost" "placeholder not expected"
+
+filterOSEvent _ {ccMsg=CcWmLOSTMOUSE,p1=wPtr,p2=cPtr} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (able,wsH) = getWindowStateHandleSelect wsH
+ | not able
+ = (True,Nothing,Nothing,setWindowHandlesWindow wsH windows,ioState)
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ | wPtr==cPtr // The window lost the mouse input
+ # (ok,wsH) = okWindowMouseLost wsH
+ deviceEvent = if ok (Just (WindowMouseAction {wmWIDS=wids,wmMouseState=MouseLost})) Nothing
+ = (True,Nothing,deviceEvent,setWindowHandlesWindow wsH windows,ioState)
+ with
+ okWindowMouseLost :: !(WindowStateHandle .pst) -> (!Bool,!WindowStateHandle .pst)
+ okWindowMouseLost wsH=:{wshHandle=Just {wlsHandle={whKind,whAtts}}}
+ | whKind==IsDialog
+ = (False,wsH)
+ | otherwise
+ = (okMouseAtt,wsH)
+ where
+ (filter,selectState,_) = getWindowMouseAtt (snd (cselect isWindowMouse (WindowMouse (const False) Unable undef) whAtts))
+ okMouseAtt = filter MouseLost && selectState==Able
+ okWindowMouseLost _
+ = windoweventFatalError "okWindowMouseLost" "placeholder not expected"
+ | otherwise // One of the window controls lost the mouse input
+ # (ok,itemNr,wsH) = okControlItemNrsMouseLost cPtr wsH
+ info = { cmWIDS = wids
+ , cmItemNr = itemNr
+ , cmItemPtr = cPtr
+ , cmMouseState = MouseLost
+ }
+ deviceEvent = if (ok && itemNr>0) (Just (ControlMouseAction info)) Nothing
+ = (True,Nothing,deviceEvent,setWindowHandlesWindow wsH windows,ioState)
+ with
+ okControlItemNrsMouseLost :: !OSWindowPtr !(WindowStateHandle .pst) -> (!Bool,!Int,!WindowStateHandle .pst)
+ okControlItemNrsMouseLost itemPtr wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whItems}}}
+ # (_,ok,itemNr,itemHs) = okControlsItemNrMouseLost True itemPtr whItems
+ = (ok,itemNr,{wsH & wshHandle=Just {wlsH & wlsHandle={wH & whItems=itemHs}}})
+ where
+ okControlsItemNrMouseLost :: !Bool !OSWindowPtr ![WElementHandle .ls .pst] -> (!Bool,!Bool,!Int,![WElementHandle .ls .pst])
+ okControlsItemNrMouseLost contextAble itemPtr [itemH:itemHs]
+ # (found,ok,itemNr,itemH) = okControlItemNrMouseLost contextAble itemPtr itemH
+ | found
+ = (found,ok,itemNr,[itemH:itemHs])
+ | otherwise
+ # (found,ok,itemNr,itemHs) = okControlsItemNrMouseLost contextAble itemPtr itemHs
+ = (found,ok,itemNr,[itemH:itemHs])
+ where
+ okControlItemNrMouseLost :: !Bool !OSWindowPtr !(WElementHandle .ls .pst) -> (!Bool,!Bool,!Int,!WElementHandle .ls .pst)
+ okControlItemNrMouseLost contextAble itemPtr (WItemHandle itemH=:{wItemPtr,wItemNr,wItemSelect,wItemShow,wItemAtts,wItems})
+ | itemPtr<>wItemPtr
+ | wItemShow
+ # (found,ok,itemNr,itemHs) = okControlsItemNrMouseLost contextAble1 itemPtr wItems
+ = (found,ok,itemNr,WItemHandle {itemH & wItems=itemHs})
+ // otherwise
+ = (False,False,0,WItemHandle itemH)
+ | otherwise
+ = (True,okMouseAtt,wItemNr,WItemHandle itemH)
+ where
+ contextAble1= contextAble && wItemSelect
+ (filter,selectState,_)
+ = getControlMouseAtt (snd (cselect isControlMouse (ControlMouse (const False) Unable undef) wItemAtts))
+ okMouseAtt = contextAble1 && enabled selectState && filter MouseLost
+
+ okControlItemNrMouseLost contextAble itemPtr (WListLSHandle itemHs)
+ # (found,ok,itemNr,itemHs) = okControlsItemNrMouseLost contextAble itemPtr itemHs
+ = (found,ok,itemNr,WListLSHandle itemHs)
+
+ okControlItemNrMouseLost contextAble itemPtr (WExtendLSHandle wExH=:{wExtendItems=itemHs})
+ # (found,ok,itemNr,itemHs) = okControlsItemNrMouseLost contextAble itemPtr itemHs
+ = (found,ok,itemNr,WExtendLSHandle {wExH & wExtendItems=itemHs})
+
+ okControlItemNrMouseLost contextAble itemPtr (WChangeLSHandle wChH=:{wChangeItems=itemHs})
+ # (found,ok,itemNr,itemHs) = okControlsItemNrMouseLost contextAble itemPtr itemHs
+ = (found,ok,itemNr,WChangeLSHandle {wChH & wChangeItems=itemHs})
+
+ okControlsItemNrMouseLost _ _ []
+ = (False,False,0,[])
+
+ okControlItemNrsMouseLost _ _
+ = windoweventFatalError "okControlItemNrsMouseLost" "placeholder not expected"
+
+filterOSEvent _ {ccMsg=CcWmMOUSE,p1=wPtr,p2=cPtr,p3=action,p4=x,p5=y,p6=mods} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (able,wsH) = getWindowStateHandleSelect wsH
+ | not able
+ = (True,Nothing,Nothing,setWindowHandlesWindow wsH windows,ioState)
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ | wPtr==cPtr // The mouse action takes place in the window
+ # (inputTrack,ioState) = ioStGetInputTrack ioState
+ (ok,mouse,wsH,inputTrack) = okWindowMouseState action {x=x,y=y} wsH inputTrack
+ deviceEvent = if ok (Just (WindowMouseAction {wmWIDS=wids,wmMouseState=mouse})) Nothing
+ # ioState = ioStSetInputTrack inputTrack ioState
+ = (True,Nothing,deviceEvent,setWindowHandlesWindow wsH windows,ioState)
+ with
+ okWindowMouseState :: !Int !Point2 !(WindowStateHandle .pst) !(Maybe InputTrack)
+ -> (!Bool,MouseState,!WindowStateHandle .pst, ! Maybe InputTrack)
+ okWindowMouseState action eventPos wsH=:{wshHandle=Just {wlsHandle={whKind,whWindowInfo,whAtts}}} inputTrack
+ | whKind==IsDialog
+ = (False,undef,wsH,inputTrack)
+ | trackingMouse wPtr 0 inputTrack // Window is already handling Mouse(Drag/Up)
+ | isDownButton || buttonstate==ButtonStillUp // Ignore all mouse down and mouse move events
+ = (False,undef,wsH,inputTrack)
+ | buttonstate==ButtonUp // Clear mouse tracking
+ = (okMouseAtt,mousestate,wsH,untrackMouse inputTrack)
+ // otherwise
+ = (okMouseAtt,mousestate,wsH,inputTrack)
+ | isDownButton // Mouse down event sets input track
+ = (okMouseAtt,mousestate,wsH,trackMouse wPtr 0 inputTrack)
+ | isMember buttonstate [ButtonStillDown,ButtonUp] // Ignore all mouse drag and up events when not tracking
+ = (False,undef,wsH,inputTrack)
+ | otherwise
+ = (okMouseAtt,mousestate,wsH,inputTrack)
+ where
+ origin = (getWindowInfoWindowData whWindowInfo).windowOrigin
+ mousestate = mouseState action (eventPos+origin)
+ buttonstate = getMouseStateButtonState mousestate
+ isDownButton = isMember buttonstate [ButtonDown,ButtonDoubleDown,ButtonTripleDown]
+ (filter,selectState,_) = getWindowMouseAtt (snd (cselect isWindowMouse (WindowMouse (const False) Unable undef) whAtts))
+ okMouseAtt = filter mousestate && selectState==Able
+ okWindowMouseState _ _ _ _
+ = windoweventFatalError "okWindowMouseState" "placeholder not expected"
+ | otherwise // The mouse action takes place in a control
+ # (inputTrack,ioState) = ioStGetInputTrack ioState
+ (ok,itemNr,mouse,wsH,inputTrack)
+ = okControlItemsNrMouseState wPtr cPtr action {x=x,y=y} wsH inputTrack
+ # ioState = ioStSetInputTrack inputTrack ioState
+ info = { cmWIDS = wids
+ , cmItemNr = itemNr
+ , cmItemPtr = cPtr
+ , cmMouseState = mouse
+ }
+ deviceEvent = if ok (Just (ControlMouseAction info)) Nothing
+ = (True,Nothing,deviceEvent,setWindowHandlesWindow wsH windows,ioState)
+ with
+ okControlItemsNrMouseState :: !OSWindowPtr !OSWindowPtr !Int !Point2 !(WindowStateHandle .pst) !(Maybe InputTrack)
+ -> (!Bool,!Int,MouseState,!WindowStateHandle .pst, ! Maybe InputTrack)
+ okControlItemsNrMouseState wPtr itemPtr action eventPos wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whItems}}} inputTrack
+ # (_,ok,itemNr,itemPos,itemHs,inputTrack)
+ = okControlsItemNrMouseState True wPtr itemPtr action eventPos whItems inputTrack
+ = (ok,itemNr,itemPos,{wsH & wshHandle=Just {wlsH & wlsHandle={wH & whItems=itemHs}}},inputTrack)
+ where
+ okControlsItemNrMouseState :: !Bool !OSWindowPtr !OSWindowPtr !Int !Point2 ![WElementHandle .ls .pst] !(Maybe InputTrack)
+ -> (!Bool,!Bool,!Int,MouseState,![WElementHandle .ls .pst], !Maybe InputTrack)
+ okControlsItemNrMouseState contextAble wPtr itemPtr action eventPos [itemH:itemHs] inputTrack
+ # (found,ok,itemNr,itemPos,itemH,inputTrack)
+ = okControlItemNrMouseState contextAble wPtr itemPtr action eventPos itemH inputTrack
+ | found
+ = (found,ok,itemNr,itemPos,[itemH:itemHs],inputTrack)
+ | otherwise
+ # (found,ok,itemNr,itemPos,itemHs,inputTrack) = okControlsItemNrMouseState contextAble wPtr itemPtr action eventPos itemHs inputTrack
+ = (found,ok,itemNr,itemPos,[itemH:itemHs],inputTrack)
+ where
+ okControlItemNrMouseState :: !Bool !OSWindowPtr !OSWindowPtr !Int !Point2 !(WElementHandle .ls .pst) !(Maybe InputTrack)
+ -> (!Bool,!Bool,!Int,MouseState,!WElementHandle .ls .pst, !Maybe InputTrack)
+ okControlItemNrMouseState contextAble wPtr itemPtr action eventPos
+ (WItemHandle itemH=:{wItemPtr,wItemSelect,wItemKind,wItemNr,wItemShow,wItemAtts,wItems,wItemInfo})
+ inputTrack
+ | itemPtr<>wItemPtr
+ | wItemShow
+ # (found,ok,itemNr,mousestate,itemHs,inputTrack) = okControlsItemNrMouseState contextAble1 wPtr itemPtr action eventPos wItems inputTrack
+ = (found,ok,itemNr,mousestate,WItemHandle {itemH & wItems=itemHs},inputTrack)
+ // otherwise
+ = (False,False,0,undef,WItemHandle itemH,inputTrack)
+ | trackingMouse wPtr itemPtr inputTrack // Control is already handling Mouse(Drag/Up)
+ | isDownButton || buttonstate==ButtonStillUp // Ignore all mouse down and mouse move events
+ = (True,False,0,undef,WItemHandle itemH,inputTrack)
+ | buttonstate==ButtonUp // Clear mouse tracking
+ = (True,okMouseAtt,wItemNr,mousestate,WItemHandle itemH,untrackMouse inputTrack)
+ // otherwise
+ = (True,okMouseAtt,wItemNr,mousestate,WItemHandle itemH,inputTrack)
+ | isDownButton // Mouse down event sets input track
+ = (True,okMouseAtt,wItemNr,mousestate,WItemHandle itemH,trackMouse wPtr itemPtr inputTrack)
+ | isMember buttonstate [ButtonStillDown,ButtonUp] // Ignore all mouse drag and up events when not tracking
+ = (True,False,0,undef,WItemHandle itemH,inputTrack)
+ | otherwise
+ = (True,okMouseAtt,wItemNr,mousestate,WItemHandle itemH,inputTrack)
+ where
+ contextAble1= contextAble && wItemSelect
+ (filter,selectState,_)
+ = getControlMouseAtt (snd (cselect isControlMouse (ControlMouse (const False) Unable undef) wItemAtts))
+ okMouseAtt = contextAble1 && enabled selectState && filter mousestate
+ mousestate = mouseState action (origin+eventPos)
+ buttonstate = getMouseStateButtonState mousestate
+ isDownButton= isMember buttonstate [ButtonDown,ButtonDoubleDown,ButtonTripleDown]
+ origin = case wItemKind of
+ IsCustomButtonControl -> zero
+ IsCustomControl -> zero
+ IsCompoundControl -> (getWItemCompoundInfo wItemInfo).compoundOrigin
+ _ -> windoweventFatalError "okControlItemsNrMouseState" "mouse event generated for unexpected control"
+
+ okControlItemNrMouseState contextAble wPtr itemPtr action eventPos (WListLSHandle itemHs) inputTrack
+ # (found,ok,itemNr,mousestate,itemHs,inputTrack) = okControlsItemNrMouseState contextAble wPtr itemPtr action eventPos itemHs inputTrack
+ = (found,ok,itemNr,mousestate,WListLSHandle itemHs,inputTrack)
+
+ okControlItemNrMouseState contextAble wPtr itemPtr action eventPos (WExtendLSHandle wExH=:{wExtendItems=itemHs}) inputTrack
+ # (found,ok,itemNr,mousestate,itemHs,inputTrack) = okControlsItemNrMouseState contextAble wPtr itemPtr action eventPos itemHs inputTrack
+ = (found,ok,itemNr,mousestate,WExtendLSHandle {wExH & wExtendItems=itemHs},inputTrack)
+
+ okControlItemNrMouseState contextAble wPtr itemPtr action eventPos (WChangeLSHandle wChH=:{wChangeItems=itemHs}) inputTrack
+ # (found,ok,itemNr,mousestate,itemHs,inputTrack) = okControlsItemNrMouseState contextAble wPtr itemPtr action eventPos itemHs inputTrack
+ = (found,ok,itemNr,mousestate,WChangeLSHandle {wChH & wChangeItems=itemHs},inputTrack)
+
+ okControlsItemNrMouseState _ _ _ _ _ [] inputTrack
+ = (False,False,0,undef,[],inputTrack)
+
+ okControlItemsNrMouseState _ _ _ _ _ _
+ = windoweventFatalError "okControlItemsNrMouseState" "placeholder not expected"
+where
+ modifiers = toModifiers mods
+ nrDown = case action of
+ BUTTONDOWN -> 1
+ BUTTONDOUBLEDOWN -> 2
+ _ -> 3
+ mouseState action pos = case action of
+ BUTTONSTILLUP -> MouseMove pos modifiers
+ BUTTONUP -> MouseUp pos modifiers
+ BUTTONSTILLDOWN -> MouseDrag pos modifiers
+ _ -> MouseDown pos modifiers nrDown
+
+filterOSEvent _ {ccMsg=CcWmSETFOCUS,p1=wPtr,p2=cPtr} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ (found,itemNr,wsH) = getControlKeyFocusItemNr True cPtr wsH
+ windows = setWindowHandlesWindow wsH windows
+ | not found
+ = (True,Nothing,Nothing,windows,ioState)
+ | otherwise
+ = (True,Nothing,Just (ControlGetKeyFocus {ckfWIDS=wids,ckfItemNr=itemNr,ckfItemPtr=cPtr}),windows,ioState)
+
+filterOSEvent wMetrics {ccMsg=CcWmSIZE,p1=wPtr,p2=w,p3=h,p4=usersizing} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (wKind,wsH) = getWindowStateHandleWindowKind wsH
+ | wKind==IsDialog // This alternative should never occur
+ = windoweventFatalError "filterOSEvent" "WindowSizeAction event generated for Dialog"
+ | otherwise
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ # (tb,ioState) = getIOToolbox ioState
+ (info,wsH,tb) = getWindowStateHandleSize wids w h (usersizing<>0) wsH tb
+ # ioState = setIOToolbox tb ioState
+ windows = setWindowHandlesWindow wsH windows
+ = (True,Nothing,Just (WindowSizeAction info),windows,ioState)
+where
+ getWindowStateHandleSize :: !WIDS !Int !Int !Bool !(WindowStateHandle .pst) !*OSToolbox
+ -> (!WindowSizeActionInfo,!WindowStateHandle .pst, !*OSToolbox)
+ getWindowStateHandleSize wids newW newH usersizing wsH=:{wshHandle=Just {wlsHandle=wH=:{whSize,whWindowInfo}}} tb
+ = ({wsWIDS=wids,wsSize={w=newW`,h=newH`},wsUpdateAll=not usersizing},wsH,tb)
+ where
+ windowInfo = getWindowInfoWindowData whWindowInfo
+ domainRect = windowInfo.windowDomain
+ hasScrolls = (isJust windowInfo.windowHScroll,isJust windowInfo.windowVScroll)
+ (visHScroll,visVScroll) = osScrollbarsAreVisible wMetrics domainRect (toTuple whSize) hasScrolls
+ newW` = if visVScroll (newW+wMetrics.osmVSliderWidth) newW // Correct newW in case of visible vertical scrollbar
+ newH` = if visHScroll (newH+wMetrics.osmHSliderHeight) newH // Correct newH in case of visible horizontal scrollbar
+ getWindowStateHandleSize _ _ _ _ _ _
+ = windoweventFatalError "getWindowStateHandleSize" "placeholder not expected"
+
+filterOSEvent _ {ccMsg=CcWmSPECIALBUTTON,p1=wPtr,p2=okOrCancel} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ | otherwise
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ (okId,wsH) = getWindowStateHandleDefaultId wsH
+ (cancelId,wsH) = getWindowStateHandleCancelId wsH
+ okOrCancelEvent = if (okOrCancel==ISOKBUTTON) (if (isJust okId) (Just (WindowOK wids)) Nothing)
+ (if (okOrCancel==ISCANCELBUTTON) (if (isJust cancelId) (Just (WindowCANCEL wids)) Nothing)
+ (windoweventFatalError "filterOSEvent (CcWmSPECIALBUTTON)" "incorrect argument"))
+ = (True,Nothing,okOrCancelEvent,setWindowHandlesWindow wsH windows,ioState)
+
+/* The CcWmPAINT message is generated to update the indicated rectangle of the argument window.
+*/
+filterOSEvent _ {ccMsg=CcWmPAINT,p1=wPtr,p2=left,p3=top,p4=right,p5=bottom,p6=gc} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ | otherwise
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ windows = setWindowHandlesWindow wsH windows
+ updRect = fromTuple4 (left,top,right,bottom)
+ updateInfo = {updWIDS=wids,updWindowArea=updRect,updControls=[],updGContext=if (gc==0) Nothing (Just gc)}
+ = (True,Nothing,Just (WindowUpdate updateInfo),windows,ioState)
+
+filterOSEvent _ _ _ _
+ = windoweventFatalError "filterOSEvent" "unmatched OSEvent"
+
+
+/* PA: moved to clCCall_12:
+toModifiers :: !Int -> Modifiers
+toModifiers i
+ = { shiftDown = shifton
+ , optionDown = alton
+ , commandDown = ctrlon
+ , controlDown = ctrlon
+ , altDown = alton
+ }
+where
+ shifton = i bitand SHIFTBIT <> 0
+ alton = i bitand ALTBIT <> 0
+ ctrlon = i bitand CTRLBIT <> 0
+*/
+
+getControlKeyFocusItemNr :: !Bool !OSWindowPtr !(WindowStateHandle .pst) -> (!Bool,!Int,!WindowStateHandle .pst)
+getControlKeyFocusItemNr activated cPtr wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH}}
+ # (found,itemNr,itemHs) = getControlsKeyFocusItemNr` activated cPtr wH.whItems
+ = (found,itemNr,{wsH & wshHandle=Just {wlsH & wlsHandle={wH & whItems=itemHs}}})
+where
+ getControlsKeyFocusItemNr` :: !Bool !OSWindowPtr ![WElementHandle .ls .pst] -> (!Bool,!Int,![WElementHandle .ls .pst])
+ getControlsKeyFocusItemNr` activated cPtr []
+ = (False,0,[])
+ getControlsKeyFocusItemNr` activated cPtr [itemH:itemHs]
+ # (found,itemNr,itemH) = getControlKeyFocusItemNr` activated cPtr itemH
+ | found
+ = (found,itemNr,[itemH:itemHs])
+ | otherwise
+ # (found,itemNr,itemHs) = getControlsKeyFocusItemNr` activated cPtr itemHs
+ = (found,itemNr,[itemH:itemHs])
+ where
+ getControlKeyFocusItemNr` :: !Bool !OSWindowPtr !(WElementHandle .ls .pst) -> (!Bool,!Int,!WElementHandle .ls .pst)
+ getControlKeyFocusItemNr` activated cPtr (WItemHandle itemH=:{wItemPtr,wItemNr,wItemKind,wItemSelect,wItemAtts,wItems})
+ | cPtr==wItemPtr
+ | not (isMember wItemKind [IsCompoundControl,IsCustomControl,IsEditControl,IsPopUpControl])
+ = (True,0,WItemHandle itemH)
+ /* PA: deze tests zijn verwijderd
+ | not wItemSelect
+ = (0,WItemHandle itemH)
+ | contains reqAttribute wItemAtts
+ = (wItemNr,WItemHandle itemH)
+ // otherwise
+ = (0,WItemHandle itemH)
+ */
+ // otherwise
+ = (True,wItemNr,WItemHandle itemH)
+ | not (isRecursiveControl wItemKind)
+ = (False,0,WItemHandle itemH)
+ | otherwise
+ # (found,itemNr,itemHs) = getControlsKeyFocusItemNr` activated cPtr wItems
+ = (found,itemNr,WItemHandle {itemH & wItems=itemHs})
+ /* where
+ reqAttribute = if activated isControlActivate isControlDeactivate // PA: wordt niet meer gebruikt
+ */
+ getControlKeyFocusItemNr` activated cPtr (WListLSHandle itemHs)
+ # (found,itemNr,itemHs) = getControlsKeyFocusItemNr` activated cPtr itemHs
+ = (found,itemNr,WListLSHandle itemHs)
+
+ getControlKeyFocusItemNr` activated cPtr (WExtendLSHandle wExH=:{wExtendItems=itemHs})
+ # (found,itemNr,itemHs) = getControlsKeyFocusItemNr` activated cPtr itemHs
+ = (found,itemNr,WExtendLSHandle {wExH & wExtendItems=itemHs})
+
+ getControlKeyFocusItemNr` activated cPtr (WChangeLSHandle wChH=:{wChangeItems=itemHs})
+ # (found,itemNr,itemHs) = getControlsKeyFocusItemNr` activated cPtr itemHs
+ = (found,itemNr,WChangeLSHandle {wChH & wChangeItems=itemHs})
+getControlKeyFocusItemNr _ _ _
+ = windoweventFatalError "getControlKeyFocusItemNr" "window placeholder not expected"
+
+
+// Access operations on InputTrack:
+
+trackingMouse :: !OSWindowPtr !OSWindowPtr !(Maybe InputTrack) -> Bool
+trackingMouse wPtr cPtr (Just {itWindow,itControl,itKind={itkMouse}})
+ = wPtr==itWindow && cPtr==itControl && itkMouse
+trackingMouse _ _ _
+ = False
+
+trackingKeyboard :: !OSWindowPtr !OSWindowPtr !(Maybe InputTrack) -> Bool
+trackingKeyboard wPtr cPtr (Just {itWindow,itControl,itKind={itkKeyboard}})
+ = wPtr==itWindow && cPtr==itControl && itkKeyboard
+trackingKeyboard _ _ _
+ = False
+
+trackMouse :: !OSWindowPtr !OSWindowPtr !(Maybe InputTrack) -> Maybe InputTrack
+trackMouse wPtr cPtr (Just it=:{itWindow,itControl,itKind=itk})
+ | wPtr<>itWindow || cPtr<>itControl
+ = windoweventFatalError "trackMouse" "incorrect window/control parameters"
+ | otherwise
+ = Just {it & itKind={itk & itkMouse=True}}
+trackMouse wPtr cPtr nothing
+// = Just {itWindow=wPtr,itControl=cPtr,itKind={itkMouse=True,itkKeyboard=False}}
+ = Just { itWindow = wPtr
+ , itControl = cPtr
+ , itKind = { itkMouse = True
+ , itkKeyboard = False
+ , itkChar = 0 // PA: assuming the fields itkChar and itkSlider are not used on Windows platform
+ , itkSlider = Nothing // dito
+ }
+ }
+
+untrackMouse :: !(Maybe InputTrack) -> Maybe InputTrack
+untrackMouse (Just it=:{itKind=itk})
+ | itk.itkKeyboard
+ = Just {it & itKind={itk & itkMouse=False}}
+ | otherwise
+ = Nothing
+untrackMouse nothing
+ = nothing
+
+untrackKeyboard :: !(Maybe InputTrack) -> Maybe InputTrack
+untrackKeyboard (Just it=:{itKind=itk})
+ | itk.itkMouse
+ = Just {it & itKind={itk & itkKeyboard=False}}
+ | otherwise
+ = Nothing
+untrackKeyboard nothing
+ = nothing
+
+trackKeyboard :: !OSWindowPtr !OSWindowPtr !(Maybe InputTrack) -> Maybe InputTrack
+trackKeyboard wPtr cPtr (Just it=:{itWindow,itControl,itKind=itk})
+ | wPtr<>itWindow || cPtr<>itControl
+ = windoweventFatalError "trackKeyboard" "incorrect window/control parameters"
+ | otherwise
+ = Just {it & itKind={itk & itkKeyboard=True}}
+trackKeyboard wPtr cPtr nothing
+// = Just {itWindow=wPtr,itControl=cPtr,itKind={itkMouse=False,itkKeyboard=True}}
+ = Just { itWindow = wPtr
+ , itControl = cPtr
+ , itKind = { itkMouse = False
+ , itkKeyboard = True
+ , itkChar = 0 // PA: assuming the fields itkChar and itkSlider are not used on Windows platform
+ , itkSlider = Nothing // dito
+ }
+ }
|