From 7553b7f9d4dddc2235c137d41de8ce22547bebe3 Mon Sep 17 00:00:00 2001 From: Camil Staps Date: Wed, 1 Jul 2015 17:36:37 +0200 Subject: Initial commit --- windowevent.icl | 1169 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1169 insertions(+) create mode 100644 windowevent.icl (limited to 'windowevent.icl') 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 + } + } -- cgit v1.2.3