-- 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.Gui.QGradient (
  aModule,
  c_QGradient,
  ) where

import Foreign.Hoppy.Generator.Spec (
  addReqIncludes,
  classSetConversionToGc,
  classSetEntityPrefix,
  ident,
  ident1,
  includeStd,
  makeClass,
  mkConstMethod',
  mkCtor,
  mkMethod,
  mkProp,
  np,
  )
import Foreign.Hoppy.Generator.Spec.ClassFeature (
  ClassFeature (Copyable, Equatable),
  classAddFeatures,
  )
import Foreign.Hoppy.Generator.Types (
  enumT,
  constT,
  objT,
  voidT,
  )
import Foreign.Hoppy.Generator.Version (collect, just, test)
import Graphics.UI.Qtah.Generator.Config (qtVersion)
import Graphics.UI.Qtah.Generator.Interface.Core.Types (qreal)
import Graphics.UI.Qtah.Generator.Interface.Gui.QColor (c_QColor)
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
"Gui", String
"QGradient"] ([QtExport] -> QtModule) -> [QtExport] -> QtModule
forall a b. (a -> b) -> a -> b
$
  [Filtered QtExport] -> [QtExport]
forall a. [Filtered a] -> [a]
collect
  [ QtExport -> Filtered QtExport
forall a. a -> Filtered a
just (QtExport -> Filtered QtExport) -> QtExport -> Filtered QtExport
forall a b. (a -> b) -> a -> b
$ Class -> QtExport
forall a. Exportable a => a -> QtExport
qtExport Class
c_QGradient
  , Bool -> QtExport -> Filtered QtExport
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
4, Int
4]) (QtExport -> Filtered QtExport) -> QtExport -> Filtered QtExport
forall a b. (a -> b) -> a -> b
$ CppEnum -> QtExport
forall a. Exportable a => a -> QtExport
qtExport CppEnum
e_CoordinateMode
  , Bool -> QtExport -> Filtered QtExport
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
5, Int
12]) (QtExport -> Filtered QtExport) -> QtExport -> Filtered QtExport
forall a b. (a -> b) -> a -> b
$ CppEnum -> QtExport
forall a. Exportable a => a -> QtExport
qtExport CppEnum
e_Preset
  , QtExport -> Filtered QtExport
forall a. a -> Filtered a
just (QtExport -> Filtered QtExport) -> QtExport -> Filtered QtExport
forall a b. (a -> b) -> a -> b
$ CppEnum -> QtExport
forall a. Exportable a => a -> QtExport
qtExport CppEnum
e_Spread
  , QtExport -> Filtered QtExport
forall a. a -> Filtered a
just (QtExport -> Filtered QtExport) -> QtExport -> Filtered QtExport
forall a b. (a -> b) -> a -> b
$ CppEnum -> QtExport
forall a. Exportable a => a -> QtExport
qtExport CppEnum
e_Type
  ]

c_QGradient :: Class
c_QGradient =
  [Include] -> Class -> Class
forall a. HasReqs a => [Include] -> a -> a
addReqIncludes [String -> Include
includeStd String
"QGradient"] (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
  Class -> Class
classSetConversionToGc (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
  [ClassFeature] -> Class -> Class
classAddFeatures [ClassFeature
Copyable, ClassFeature
Equatable] (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
"QGradient") 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
  [ Bool -> ClassEntity -> Filtered ClassEntity
forall a. Bool -> a -> Filtered a
test (Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
5, Int
12]) (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_Preset]
  , 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 -> Type -> ClassEntity
mkProp String
"coordinateMode" (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ CppEnum -> Type
enumT CppEnum
e_CoordinateMode
  , ClassEntity -> Filtered ClassEntity
forall a. a -> Filtered a
just (ClassEntity -> Filtered ClassEntity)
-> ClassEntity -> Filtered ClassEntity
forall a b. (a -> b) -> a -> b
$ String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkMethod String
"setColorAt" [Type
qreal, Type -> Type
constT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Class -> Type
objT Class
c_QColor] 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 -> Type -> ClassEntity
mkProp String
"spread" (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ CppEnum -> Type
enumT CppEnum
e_Spread
  -- TODO void setStops(const QGradientStops &stopPoints)
  -- TODO QGradientStops stops() const
  , 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
"getType" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ CppEnum -> Type
enumT CppEnum
e_Type
  ]

e_CoordinateMode :: CppEnum
e_CoordinateMode =
  Identifier -> [Include] -> [String] -> CppEnum
makeQtEnum (String -> String -> Identifier
ident1 String
"QGradient" String
"CoordinateMode") [String -> Include
includeStd String
"QGradient"] ([String] -> CppEnum) -> [String] -> CppEnum
forall a b. (a -> b) -> a -> b
$
  [ String
"LogicalMode"
  , String
"StretchToDeviceMode"
  , String
"ObjectBoundingMode"
  ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
  [String
"ObjectMode" | Version
qtVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int
5, Int
12]]

e_Preset :: CppEnum
e_Preset =
  Identifier -> [Include] -> [String] -> CppEnum
makeQtEnum (String -> String -> Identifier
ident1 String
"QGradient" String
"Preset") [String -> Include
includeStd String
"QGradient"]
  [ String
"WarmFlame"
    {- TODO Fix off-by-one.  Also it looks like some of these are missing from
     the Qt headers (Arielle's Smile, Above Clouds)?
  , (1, ["night", "fade"])
  , (2, ["spring", "warmth"])
  , (3, ["juicy", "peach"])
  , (4, ["young", "passion"])
  , (5, ["lady", "lips"])
  , (6, ["sunny", "morning"])
  , (7, ["rainy", "ashville"])
  , (8, ["frozen", "dreams"])
  , (9, ["winter", "neva"])
  , (10, ["dusty", "grass"])
  , (11, ["tempting", "azure"])
  , (12, ["heavy", "rain"])
  , (13, ["amy", "crisp"])
  , (14, ["mean", "fruit"])
  , (15, ["deep", "blue"])
  , (16, ["ripe", "malinka"])
  , (17, ["cloudy", "knoxville"])
  , (18, ["malibu", "beach"])
  , (19, ["new", "life"])
  , (20, ["true", "sunset"])
  , (21, ["morpheus", "den"])
  , (22, ["rare", "wind"])
  , (23, ["near", "moon"])
  , (24, ["wild", "apple"])
  , (25, ["saint", "petersburg"])
  , (26, ["arielle's", "smile"])
  , (27, ["plum", "plate"])
  , (28, ["everlasting", "sky"])
  , (29, ["happy", "fisher"])
  , (30, ["blessing"])
  , (31, ["sharpeye", "eagle"])
  , (32, ["ladoga", "bottom"])
  , (33, ["lemon", "gate"])
  , (34, ["itmeo", "branding"])
  , (35, ["zeus", "miracle"])
  , (36, ["old", "hat"])
  , (37, ["star", "wine"])
  , (38, ["deep", "bluee"])
  , (39, ["coup", "de", "grace"])
  , (40, ["happy", "acid"])
  , (41, ["awesome", "pine"])
  , (42, ["new", "york"])
  , (43, ["shy", "rainbow"])
  , (44, ["loon", "crest"])
  , (45, ["mixed", "hopes"])
  , (46, ["fly", "high"])
  , (47, ["strong", "bliss"])
  , (48, ["fresh", "milk"])
  , (49, ["snow", "again"])
  , (50, ["february", "ink"])
  , (51, ["kind", "steel"])
  , (52, ["soft", "grass"])
  , (53, ["grown", "early"])
  , (54, ["sharp", "blues"])
  , (55, ["shady", "water"])
  , (56, ["dirty", "beauty"])
  , (57, ["great", "whale"])
  , (58, ["teen", "notebook"])
  , (59, ["polite", "rumors"])
  , (60, ["sweet", "period"])
  , (61, ["wide", "matrix"])
  , (62, ["soft", "cherish"])
  , (63, ["red", "salvation"])
  , (64, ["burning", "spring"])
  , (65, ["night", "party"])
  , (66, ["sky", "glider"])
  , (67, ["heaven", "peach"])
  , (68, ["purple", "division"])
  , (69, ["aqua", "splash"])
  , (70, ["above", "clouds"])
  , (71, ["spiky", "naga"])
  , (72, ["love", "kiss"])
  , (73, ["sharp", "glass"])
  , (74, ["clean", "mirror"])
  , (75, ["premium", "dark"])
  , (76, ["cold", "evening"])
  , (77, ["cochiti", "lake"])
  , (78, ["summer", "games"])
  , (79, ["passionate", "bed"])
  , (80, ["mountain", "rock"])
  , (81, ["desert", "hump"])
  , (82, ["jungle", "day"])
  , (83, ["phoenix", "start"])
  , (84, ["october", "silence"])
  , (85, ["faraway", "river"])
  , (86, ["alchemist", "lab"])
  , (87, ["over", "sun"])
  , (88, ["premium", "white"])
  , (89, ["mars", "party"])
  , (90, ["eternal", "constance"])
  , (91, ["japan", "blush"])
  , (92, ["smiling", "rain"])
  , (93, ["cloudy", "apple"])
  , (94, ["big", "mango"])
  , (95, ["healthy", "water"])
  , (96, ["amour", "amour"])
  , (97, ["risky", "concrete"])
  , (98, ["strong", "stick"])
  , (99, ["vicious", "stance"])
  , (100, ["palo", "alto"])
  , (101, ["happy", "memories"])
  , (102, ["midnight", "bloom"])
  , (103, ["crystalline"])
  , (104, ["raccoon", "back"])
  , (105, ["party", "bliss"])
  , (106, ["confident", "cloud"])
  , (107, ["le", "cocktail"])
  , (108, ["river", "city"])
  , (109, ["frozen", "berry"])
  , (110, ["elegance"])
  , (111, ["child", "care"])
  , (112, ["flying", "lemon"])
  , (113, ["new", "retrowave"])
  , (114, ["hidden", "jaguar"])
  , (115, ["above", "the", "sky"])
  , (116, ["nega"])
  , (117, ["dense", "water"])
  , (118, ["chemic", "aqua"])
  , (119, ["seashore"])
  , (120, ["marble", "wall"])
  , (121, ["cheerful", "caramel"])
  , (122, ["night", "sky"])
  , (123, ["magic", "lake"])
  , (124, ["young", "grass"])
  , (125, ["colorful", "peach"])
  , (126, ["gentle", "care"])
  , (127, ["plum", "bath"])
  , (128, ["happy", "unicorn"])
  , (129, ["full", "metall"])
  , (130, ["african", "field"])
  , (131, ["solid", "stone"])
  , (132, ["orange", "juice"])
  , (133, ["glass", "water"])
  , (134, ["slick", "carbon"])
  , (135, ["north", "miracle"])
  , (136, ["fruit", "blend"])
  , (137, ["millennium", "pine"])
  , (138, ["high", "flight"])
  , (139, ["mole", "hall"])
  , (140, ["earl", "gray"])
  , (141, ["space", "shift"])
  , (142, ["forest", "inei"])
  , (143, ["royal", "garden"])
  , (144, ["rich", "metal"])
  , (145, ["juicy", "cake"])
  , (146, ["smart", "indigo"])
  , (147, ["sand", "strike"])
  , (148, ["norse", "beauty"])
  , (149, ["aqua", "guidance"])
  , (150, ["sun", "veggie"])
  , (151, ["sea", "lord"])
  , (152, ["black", "sea"])
  , (153, ["grass", "shampoo"])
  , (154, ["landing", "aircraft"])
  , (155, ["witch", "dance"])
  , (156, ["sleepless", "night"])
  , (157, ["angel", "care"])
  , (158, ["crystal", "river"])
  , (159, ["soft", "lipstick"])
  , (160, ["salt", "mountain"])
  , (161, ["perfect", "white"])
  , (162, ["fresh", "oasis"])
  , (163, ["strict", "november"])
  , (164, ["morning", "salad"])
  , (165, ["deep", "relief"])
  , (166, ["sea", "strike"])
  , (167, ["night", "call"])
  , (168, ["supreme", "sky"])
  , (169, ["light", "blue"])
  , (170, ["mind", "crawl"])
  , (171, ["lily", "meadow"])
  , (172, ["sugar", "lollipop"])
  , (173, ["sweet", "dessert"])
  , (174, ["magic", "ray"])
  , (175, ["teen", "party"])
  , (176, ["frozen", "heat"])
  , (177, ["gagarin", "view"])
  , (178, ["fabled", "sunset"])
  , (179, ["perfect", "blue"])
  -}
  ]

e_Spread :: CppEnum
e_Spread =
  Identifier -> [Include] -> [String] -> CppEnum
makeQtEnum (String -> String -> Identifier
ident1 String
"QGradient" String
"Spread") [String -> Include
includeStd String
"QGradient"]
  [ String
"PadSpread"
  , String
"ReflectSpread"
  , String
"RepeatSpread"
  ]

e_Type :: CppEnum
e_Type =
  Identifier -> [Include] -> [String] -> CppEnum
makeQtEnum (String -> String -> Identifier
ident1 String
"QGradient" String
"Type") [String -> Include
includeStd String
"QGradient"]
  [ String
"LinearGradient"
  , String
"RadialGradient"
  , String
"ConicalGradient"
  , String
"NoGradient"
  ]