-- This file is part of Qtah.
--
-- Copyright 2015-2021 The Qtah Authors.
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Lesser General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

module Graphics.UI.Qtah.Generator.Interface.Core.QEvent (
  aModule,
  c_QEvent,
  e_Type,
  ) where

import Foreign.Hoppy.Generator.Spec (
  addReqIncludes,
  classSetEntityPrefix,
  ident,
  ident1,
  includeStd,
  makeClass,
  mkBoolIsProp,
  mkConstMethod,
  mkConstMethod',
  mkCtor,
  mkMethod,
  mkStaticMethod',
  np,
  )
import Foreign.Hoppy.Generator.Types (boolT, enumT, intT, voidT)
import Foreign.Hoppy.Generator.Version (collect, just, test)
import Graphics.UI.Qtah.Generator.Config (qtVersion)
import Graphics.UI.Qtah.Generator.Module (AModule (AQtModule), makeQtModule)
import Graphics.UI.Qtah.Generator.Types

{-# ANN module "HLint: ignore Use camelCase" #-}

aModule :: AModule
aModule =
  QtModule -> AModule
AQtModule (QtModule -> AModule) -> QtModule -> AModule
forall a b. (a -> b) -> a -> b
$
  [String] -> [QtExport] -> QtModule
makeQtModule [String
"Core", String
"QEvent"]
  [ Class -> QtExport
QtExportEvent Class
c_QEvent
  , CppEnum -> QtExport
forall a. Exportable a => a -> QtExport
qtExport CppEnum
e_Type
  ]

c_QEvent :: Class
c_QEvent =
  [Include] -> Class -> Class
forall a. HasReqs a => [Include] -> a -> a
addReqIncludes [String -> Include
includeStd String
"QEvent"] (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
  String -> Class -> Class
classSetEntityPrefix String
"" (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
  Identifier -> Maybe ExtName -> [Class] -> [ClassEntity] -> Class
makeClass (String -> Identifier
ident String
"QEvent") Maybe ExtName
forall a. Maybe a
Nothing [] ([ClassEntity] -> Class) -> [ClassEntity] -> Class
forall a b. (a -> b) -> a -> b
$
  [Filtered ClassEntity] -> [ClassEntity]
forall a. [Filtered a] -> [a]
collect
  [ ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Type] -> ClassEntity
forall p. IsParameter p => String -> [p] -> ClassEntity
mkCtor String
"new" [CppEnum -> Type
enumT CppEnum
e_Type]
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"accept" [Parameter]
np Type
voidT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> ClassEntity
mkBoolIsProp String
"accepted"
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"ignore" [Parameter]
np Type
voidT
  , Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
4, Int
4]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$
    String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkStaticMethod' String
"registerEventType" String
"registerEventType" [Parameter]
np Type
intT
  , Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
4, Int
4]) (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$
    String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkStaticMethod' String
"registerEventType" String
"registerEventTypeWithHint" [Type
intT] Type
intT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"spontaneous" [Parameter]
np Type
boolT
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"type" String
"eventType" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ CppEnum -> Type
enumT CppEnum
e_Type  -- 'type' is a Haskell keyword.
  ]

e_Type :: CppEnum
e_Type =
  Identifier -> [Include] -> [String] -> CppEnum
makeQtEnum (String -> String -> Identifier
ident1 String
"QEvent" String
"Type") [String -> Include
includeStd String
"QEvent"]
  [ -- Built-in event types:
    String
"None"
  , String
"ActionAdded"
  , String
"ActionChanged"
  , String
"ActionRemoved"
  , String
"ActivationChange"
  , String
"ApplicationActivate"
  , String
"ApplicationActivated"
  , String
"ApplicationDeactivate"
  , String
"ApplicationFontChange"
  , String
"ApplicationLayoutDirectionChange"
  , String
"ApplicationPaletteChange"
  , String
"ApplicationStateChange"
  , String
"ApplicationWindowIconChange"
  , String
"ChildAdded"
  , String
"ChildPolished"
  , String
"ChildRemoved"
  , String
"Clipboard"
  , String
"Close"
  , String
"CloseSoftwareInputPanel"
  , String
"ContentsRectChange"
  , String
"ContextMenu"
  , String
"CursorChange"
  , String
"DeferredDelete"
  , String
"DragEnter"
  , String
"DragLeave"
  , String
"DragMove"
  , String
"Drop"
  , String
"DynamicPropertyChange"
  , String
"EnabledChange"
  , String
"Enter"
    -- "EnterEditFocus" is omitted -- it depends on keypadNavigation.
  , String
"EnterWhatsThisMode"
  , String
"Expose"
  , String
"FileOpen"
  , String
"FocusIn"
  , String
"FocusOut"
  , String
"FocusAboutToChange"
  , String
"FontChange"
  , String
"Gesture"
  , String
"GestureOverride"
  , String
"GrabKeyboard"
  , String
"GrabMouse"
  , String
"GraphicsSceneContextMenu"
  , String
"GraphicsSceneDragEnter"
  , String
"GraphicsSceneDragLeave"
  , String
"GraphicsSceneDragMove"
  , String
"GraphicsSceneDrop"
  , String
"GraphicsSceneHelp"
  , String
"GraphicsSceneHoverEnter"
  , String
"GraphicsSceneHoverLeave"
  , String
"GraphicsSceneHoverMove"
  , String
"GraphicsSceneMouseDoubleClick"
  , String
"GraphicsSceneMouseMove"
  , String
"GraphicsSceneMousePress"
  , String
"GraphicsSceneMouseRelease"
  , String
"GraphicsSceneMove"
  , String
"GraphicsSceneResize"
  , String
"GraphicsSceneWheel"
  , String
"Hide"
  , String
"HideToParent"
  , String
"HoverEnter"
  , String
"HoverLeave"
  , String
"HoverMove"
  , String
"IconDrag"
  , String
"IconTextChange"
  , String
"InputMethod"
  , String
"InputMethodQuery"
  , String
"KeyboardLayoutChange"
  , String
"KeyPress"
  , String
"KeyRelease"
  , String
"LanguageChange"
  , String
"LayoutDirectionChange"
  , String
"LayoutRequest"
  , String
"Leave"
    -- "LeaveEditFocus" is omitted -- it depends on keypadNavigation.
  , String
"LeaveWhatsThisMode"
  , String
"LocaleChange"
  , String
"NonClientAreaMouseButtonDblClick"
  , String
"NonClientAreaMouseButtonPress"
  , String
"NonClientAreaMouseButtonRelease"
  , String
"NonClientAreaMouseMove"
  , String
"MacSizeChange"
  , String
"MetaCall"
  , String
"ModifiedChange"
  , String
"MouseButtonDblClick"
  , String
"MouseButtonPress"
  , String
"MouseButtonRelease"
  , String
"MouseMove"
  , String
"MouseTrackingChange"
  , String
"Move"
  , String
"NativeGesture"
  , String
"OrientationChange"
  , String
"Paint"
  , String
"PaletteChange"
  , String
"ParentAboutToChange"
  , String
"ParentChange"
  , String
"PlatformPanel"
  , String
"PlatformSurface"
  , String
"Polish"
  , String
"PolishRequest"
  , String
"QueryWhatsThis"
  , String
"ReadOnlyChange"
  , String
"RequestSoftwareInputPanel"
  , String
"Resize"
  , String
"ScrollPrepare"
  , String
"Scroll"
  , String
"Shortcut"
  , String
"ShortcutOverride"
  , String
"Show"
  , String
"ShowToParent"
  , String
"SockAct"
  , String
"StateMachineSignal"
  , String
"StateMachineWrapped"
  , String
"StatusTip"
  , String
"StyleChange"
  , String
"TabletMove"
  , String
"TabletPress"
  , String
"TabletRelease"
  , String
"OkRequest"
  , String
"TabletEnterProximity"
  , String
"TabletLeaveProximity"
  , String
"ThreadChange"
  , String
"Timer"
  , String
"ToolBarChange"
  , String
"ToolTip"
  , String
"ToolTipChange"
  , String
"TouchBegin"
  , String
"TouchCancel"
  , String
"TouchEnd"
  , String
"TouchUpdate"
  , String
"UngrabKeyboard"
  , String
"UngrabMouse"
  , String
"UpdateLater"
  , String
"UpdateRequest"
  , String
"WhatsThis"
  , String
"WhatsThisClicked"
  , String
"Wheel"
  , String
"WinEventAct"
  , String
"WindowActivate"
  , String
"WindowBlocked"
  , String
"WindowDeactivate"
  , String
"WindowIconChange"
  , String
"WindowStateChange"
  , String
"WindowTitleChange"
  , String
"WindowUnblocked"
  , String
"WinIdChange"
  , String
"ZOrderChange"

    -- Custom event types:
  , String
"User"
  , String
"MaxUser"
  ]