-- GENERATED by C->Haskell Compiler, version 0.28.6 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}
{-# LANGUAGE CPP #-}


module Graphics.UI.FLTK.LowLevel.Fl_Enumerations
    (
     -- * Events
     Event(..),
     When(..),
     FdWhen(..),
     -- * Tree Attributes
     TreeSort(..),
     TreeConnector(..),
     TreeSelect(..),
     SearchDirection(..),
     TreeItemReselectMode(..),
     TreeItemDrawMode(..),
     -- * Keyboard and mouse codes
     SpecialKey(..),
     allSpecialKeys,
     allShortcutSpecialKeys,
     MouseButton(..),
     EventState(..),
     KeyboardKeyMask(..),
     MouseButtonsMask(..),
     allEventStates,
     kb_CommandState, kb_ControlState, kb_KpLast,
     -- * Widget damage types
     Damage(..),
     allDamages,
     -- * Cursor type
     Cursor(..),
     -- * Various modes
     Mode(..),
     Modes(..),
     single,
     allModes,
     allTreeItemDrawModes,
     -- * Alignmenkt
     Alignments(..),
     AlignType(..),
     alignCenter,
     alignTop,
     alignBottom,
     alignLeft,
     alignRight,
     alignInside,
     alignTextOverImage,
     alignClip,
     alignWrap,
     alignImageNextToText,
     alignTextNextToImage,
     alignImageBackdrop,
     alignLeftTop,
     alignRightTop,
     alignLeftBottom,
     alignRightBottom,
     alignPositionMask,
     alignImageMask,
     alignNoWrap,
     alignImageOverText,
     alignTopLeft,
     alignTopRight,
     alignBottomLeft,
     alignBottomRight,
     allAlignTypes,
     allWhen,
     -- * Box types
     Boxtype(..),
     frame,frameBox, circleBox, diamondBox,
     -- * Box functions
     defineRoundUpBox,
     defineShadowBox,
     defineRoundedBox,
     defineRflatBox,
     defineRshadowBox,
     defineDiamondBox,
     defineOvalBox,
     definePlasticUpBox,
     defineGtkUpBox,
     defineIconLabel,
     -- * Fonts
     Font(..),
     FontAttribute(..),
     -- ** (Un-)marshalling
     cFromFont,
     cToFont,
     cFromFontAttribute,
     cToFontAttribute,
     -- ** Font Names
     helvetica,
     helveticaBold,
     helveticaItalic,
     helveticaBoldItalic,
     courier,
     courierBold,
     courierItalic,
     courierBoldItalic,
     times,
     timesBold,
     timesItalic,
     timesBoldItalic,
     symbol,
     screen,
     screenBold,
     zapfDingbats,
     freeFont,

     -- * Colors
     Color(..),
     -- ** (Un-)marshalling
     cFromColor,
     cToColor,
     -- ** Various Color Functions
     inactive,
     contrast,
     colorAverage,
     lighter,
     darker,
     rgbColorWithRgb,
     rgbColorWithGrayscale,
     grayRamp,
     colorCube,
     -- ** Color Names
     foregroundColor,
     background2Color,
     inactiveColor,
     selectionColor,
     gray0Color,
     dark3Color,
     dark2Color,
     dark1Color,
     backgroundColor,
     light1Color,
     light2Color,
     light3Color,
     blackColor,
     redColor,
     greenColor,
     yellowColor,
     blueColor,
     magentaColor,
     cyanColor,
     darkRedColor,
     darkGreenColor,
     darkYellowColor,
     darkBlueColor,
     darkMagentaColor,
     darkCyanColor,
     whiteColor,
     freeColor,
     numFreeColor,
     grayRampColor,
     numGray,
     grayColor,
     colorCubeColor,
     numRed,
     numGreen,
     numBlue,
     -- * Labels
     Labeltype(..),
     symbolLabel,
     defineShadowLabel,
     defineEngravedLabel,
     defineEmbossedLabel,
     defineMultiLabel,
     -- defineIconLabel,
     defineImageLabel,
     -- * Color
     RGB
    )
where
import qualified Foreign.C.Types as C2HSImp
import qualified System.IO.Unsafe as C2HSImp


import C2HS
data Event = NoEvent
           | Push
           | Release
           | Enter
           | Leave
           | Drag
           | Focus
           | Unfocus
           | Keydown
           | Keyup
           | Close
           | Move
           | Shortcut
           | Deactivate
           | Activate
           | Hide
           | Show
           | Paste
           | Selectionclear
           | Mousewheel
           | DndEnter
           | DndDrag
           | DndLeave
           | DndRelease
           | ScreenConfigurationChanged
           | Fullscreen
           | ZoomGesture
  deriving (Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show,Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq)
instance Enum Event where
  succ :: Event -> Event
succ NoEvent = Event
Push
  succ Push = Event
Release
  succ Release = Event
Enter
  succ Enter = Event
Leave
  succ Leave = Event
Drag
  succ Drag = Event
Focus
  succ Focus = Event
Unfocus
  succ Unfocus = Event
Keydown
  succ Keydown = Event
Keyup
  succ Keyup = Event
Close
  succ Close = Event
Move
  succ Move = Event
Shortcut
  succ Shortcut = Event
Deactivate
  succ Deactivate = Event
Activate
  succ Activate = Event
Hide
  succ Hide = Event
Show
  succ Show = Event
Paste
  succ Paste = Event
Selectionclear
  succ Selectionclear = Event
Mousewheel
  succ Mousewheel = Event
DndEnter
  succ DndEnter = Event
DndDrag
  succ DndDrag = Event
DndLeave
  succ DndLeave = Event
DndRelease
  succ DndRelease = Event
ScreenConfigurationChanged
  succ ScreenConfigurationChanged = Event
Fullscreen
  succ Fullscreen = Event
ZoomGesture
  succ ZoomGesture = String -> Event
forall a. HasCallStack => String -> a
error "Event.succ: ZoomGesture has no successor"

  pred :: Event -> Event
pred Push = Event
NoEvent
  pred Release = Event
Push
  pred Enter = Event
Release
  pred Leave = Event
Enter
  pred Drag = Event
Leave
  pred Focus = Event
Drag
  pred Unfocus = Event
Focus
  pred Keydown = Event
Unfocus
  pred Keyup = Event
Keydown
  pred Close = Event
Keyup
  pred Move = Event
Close
  pred Shortcut = Event
Move
  pred Deactivate = Event
Shortcut
  pred Activate = Event
Deactivate
  pred Hide = Event
Activate
  pred Show = Event
Hide
  pred Paste = Event
Show
  pred Selectionclear = Event
Paste
  pred Mousewheel = Event
Selectionclear
  pred DndEnter = Event
Mousewheel
  pred DndDrag = Event
DndEnter
  pred DndLeave = Event
DndDrag
  pred DndRelease = Event
DndLeave
  pred ScreenConfigurationChanged = Event
DndRelease
  pred Fullscreen = Event
ScreenConfigurationChanged
  pred ZoomGesture = Event
Fullscreen
  pred NoEvent = String -> Event
forall a. HasCallStack => String -> a
error "Event.pred: NoEvent has no predecessor"

  enumFromTo :: Event -> Event -> [Event]
enumFromTo from :: Event
from to :: Event
to = Event -> [Event]
go Event
from
    where
      end :: Int
end = Event -> Int
forall a. Enum a => a -> Int
fromEnum Event
to
      go :: Event -> [Event]
go v :: Event
v = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Event -> Int
forall a. Enum a => a -> Int
fromEnum Event
v) Int
end of
                 LT -> Event
v Event -> [Event] -> [Event]
forall a. a -> [a] -> [a]
: Event -> [Event]
go (Event -> Event
forall a. Enum a => a -> a
succ Event
v)
                 EQ -> [Event
v]
                 GT -> []

  enumFrom :: Event -> [Event]
enumFrom from :: Event
from = Event -> Event -> [Event]
forall a. Enum a => a -> a -> [a]
enumFromTo Event
from Event
ZoomGesture

  fromEnum :: Event -> Int
fromEnum NoEvent = 0
  fromEnum Push = 1
  fromEnum Release = 2
  fromEnum Enter = 3
  fromEnum Leave = 4
  fromEnum Drag = 5
  fromEnum Focus = 6
  fromEnum Unfocus = 7
  fromEnum Keydown = 8
  fromEnum Keyup = 9
  fromEnum Close = 10
  fromEnum Move = 11
  fromEnum Shortcut = 12
  fromEnum Deactivate = 13
  fromEnum Activate = 14
  fromEnum Hide = 15
  fromEnum Show = 16
  fromEnum Paste = 17
  fromEnum Selectionclear = 18
  fromEnum Mousewheel = 19
  fromEnum DndEnter = 20
  fromEnum DndDrag = 21
  fromEnum DndLeave = 22
  fromEnum DndRelease = 23
  fromEnum ScreenConfigurationChanged = 24
  fromEnum Fullscreen = 25
  fromEnum ZoomGesture = 26

  toEnum :: Int -> Event
toEnum 0 = Event
NoEvent
  toEnum 1 = Event
Push
  toEnum 2 = Event
Release
  toEnum 3 = Event
Enter
  toEnum 4 = Event
Leave
  toEnum 5 = Event
Drag
  toEnum 6 = Event
Focus
  toEnum 7 = Event
Unfocus
  toEnum 8 = Event
Keydown
  toEnum 9 = Event
Keyup
  toEnum 10 = Event
Close
  toEnum 11 = Event
Move
  toEnum 12 = Event
Shortcut
  toEnum 13 = Event
Deactivate
  toEnum 14 = Event
Activate
  toEnum 15 = Event
Hide
  toEnum 16 = Event
Show
  toEnum 17 = Event
Paste
  toEnum 18 = Event
Selectionclear
  toEnum 19 = Event
Mousewheel
  toEnum 20 = Event
DndEnter
  toEnum 21 = Event
DndDrag
  toEnum 22 = Event
DndLeave
  toEnum 23 = Event
DndRelease
  toEnum 24 = Event
ScreenConfigurationChanged
  toEnum 25 = Event
Fullscreen
  toEnum 26 = Event
ZoomGesture
  toEnum unmatched :: Int
unmatched = String -> Event
forall a. HasCallStack => String -> a
error ("Event.toEnum: Cannot match " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
unmatched)

{-# LINE 408 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

data When = WhenNever
          | WhenChanged
          | WhenNotChanged
          | WhenRelease
          | WhenReleaseAlways
          | WhenEnterKey
          | WhenEnterKeyAlways
          | WhenEnterKeyChanged
  deriving (Int -> TreeItemReselectMode -> ShowS
Int -> TreeSelect -> ShowS
Int -> When -> ShowS
[TreeItemReselectMode] -> ShowS
[TreeSelect] -> ShowS
[When] -> ShowS
TreeItemReselectMode -> String
TreeSelect -> String
When -> String
(Int -> TreeItemReselectMode -> ShowS)
-> (TreeItemReselectMode -> String)
-> ([TreeItemReselectMode] -> ShowS)
-> Show TreeItemReselectMode
(Int -> TreeSelect -> ShowS)
-> (TreeSelect -> String)
-> ([TreeSelect] -> ShowS)
-> Show TreeSelect
(Int -> When -> ShowS)
-> (When -> String) -> ([When] -> ShowS) -> Show When
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TreeItemReselectMode] -> ShowS
$cshowList :: [TreeItemReselectMode] -> ShowS
show :: TreeItemReselectMode -> String
$cshow :: TreeItemReselectMode -> String
showsPrec :: Int -> TreeItemReselectMode -> ShowS
$cshowsPrec :: Int -> TreeItemReselectMode -> ShowS
showList :: [TreeSelect] -> ShowS
$cshowList :: [TreeSelect] -> ShowS
show :: TreeSelect -> String
$cshow :: TreeSelect -> String
showsPrec :: Int -> TreeSelect -> ShowS
$cshowsPrec :: Int -> TreeSelect -> ShowS
showList :: [When] -> ShowS
$cshowList :: [When] -> ShowS
show :: When -> String
$cshow :: When -> String
showsPrec :: Int -> When -> ShowS
$cshowsPrec :: Int -> When -> ShowS
Show,TreeItemReselectMode -> TreeItemReselectMode -> Bool
TreeSelect -> TreeSelect -> Bool
When -> When -> Bool
(TreeItemReselectMode -> TreeItemReselectMode -> Bool)
-> (TreeItemReselectMode -> TreeItemReselectMode -> Bool)
-> Eq TreeItemReselectMode
(TreeSelect -> TreeSelect -> Bool)
-> (TreeSelect -> TreeSelect -> Bool) -> Eq TreeSelect
(When -> When -> Bool) -> (When -> When -> Bool) -> Eq When
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TreeItemReselectMode -> TreeItemReselectMode -> Bool
$c/= :: TreeItemReselectMode -> TreeItemReselectMode -> Bool
== :: TreeItemReselectMode -> TreeItemReselectMode -> Bool
$c== :: TreeItemReselectMode -> TreeItemReselectMode -> Bool
/= :: TreeSelect -> TreeSelect -> Bool
$c/= :: TreeSelect -> TreeSelect -> Bool
== :: TreeSelect -> TreeSelect -> Bool
$c== :: TreeSelect -> TreeSelect -> Bool
/= :: When -> When -> Bool
$c/= :: When -> When -> Bool
== :: When -> When -> Bool
$c== :: When -> When -> Bool
Eq,Eq When
Eq When =>
(When -> When -> Ordering)
-> (When -> When -> Bool)
-> (When -> When -> Bool)
-> (When -> When -> Bool)
-> (When -> When -> Bool)
-> (When -> When -> When)
-> (When -> When -> When)
-> Ord When
When -> When -> Bool
When -> When -> Ordering
When -> When -> When
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: When -> When -> When
$cmin :: When -> When -> When
max :: When -> When -> When
$cmax :: When -> When -> When
>= :: When -> When -> Bool
$c>= :: When -> When -> Bool
> :: When -> When -> Bool
$c> :: When -> When -> Bool
<= :: When -> When -> Bool
$c<= :: When -> When -> Bool
< :: When -> When -> Bool
$c< :: When -> When -> Bool
compare :: When -> When -> Ordering
$ccompare :: When -> When -> Ordering
$cp1Ord :: Eq When
Ord)
instance Enum When where
  succ WhenNever = WhenChanged
  succ WhenChanged = WhenNotChanged
  pred :: SearchDirection -> SearchDirection
succ :: TreeItemDrawMode -> TreeItemDrawMode
succ WhenNotChanged = WhenRelease
  succ WhenRelease = WhenReleaseAlways
  succ WhenReleaseAlways = WhenEnterKey
  pred :: TreeSelect -> TreeSelect
succ WhenEnterKey = WhenEnterKeyAlways
  succ WhenEnterKeyAlways = WhenEnterKeyChanged
  succ WhenEnterKeyChanged = error "When.succ: WhenEnterKeyChanged has no successor"

  pred WhenChanged = WhenNever
  pred WhenNotChanged = WhenChanged
  pred WhenRelease = WhenNotChanged
  pred WhenReleaseAlways = WhenRelease
  pred WhenEnterKey = WhenReleaseAlways
  pred WhenEnterKeyAlways = WhenEnterKey
  pred WhenEnterKeyChanged = WhenEnterKeyAlways
  pred WhenNever = error "When.pred: WhenNever has no predecessor"

  enumFromTo :: When -> When -> [When]
enumFromTo from :: When
from to :: When
to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> When
v When -> [When] -> [When]
forall a. a -> [a] -> [a]
: When -> [When]
go (When -> When
forall a. Enum a => a -> a
succ When
v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from WhenEnterKeyChanged

  fromEnum WhenNever = 0
  fromEnum WhenChanged = 1
  fromEnum WhenNotChanged = 2
  fromEnum WhenRelease = 4
  fromEnum WhenReleaseAlways = 6
  fromEnum WhenEnterKey = 8
  fromEnum WhenEnterKeyAlways = 10
  fromEnum WhenEnterKeyChanged = 11

  toEnum 0 = WhenNever
  toEnum 1 = WhenChanged
  toEnum 2 = WhenNotChanged
  toEnum 4 = WhenRelease
  toEnum 6 = WhenReleaseAlways
  toEnum 8 = WhenEnterKey
  toEnum 10 = WhenEnterKeyAlways
  toEnum 11 = WhenEnterKeyChanged
  toEnum unmatched = error ("When.toEnum: Cannot match " ++ show unmatched)

{-# LINE 409 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

data FdWhen = CanRead
            | CanWrite
            | OnExcept
  deriving (Show,Eq,Ord)
instance Enum FdWhen where
  succ CanRead = CanWrite
  succ CanWrite = OnExcept
  succ OnExcept = error "FdWhen.succ: OnExcept has no successor"

  pred CanWrite = CanRead
  pred OnExcept = CanWrite
  pred CanRead = error "FdWhen.pred: CanRead has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from OnExcept

  fromEnum CanRead = 1
  fromEnum CanWrite = 4
  fromEnum OnExcept = 8

  toEnum 1 = CanRead
  toEnum 4 = CanWrite
  toEnum 8 = OnExcept
  toEnum unmatched = error ("FdWhen.toEnum: Cannot match " ++ show unmatched)

{-# LINE 410 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

data TreeSort = TreeSortNone
              | TreeSortAscending
              | TreeSortDescending
  deriving (Show,Eq)
instance Enum TreeSort where
  succ TreeSortNone = TreeSortAscending
  succ TreeSortAscending = TreeSortDescending
  succ TreeSortDescending = error "TreeSort.succ: TreeSortDescending has no successor"

  pred TreeSortAscending = TreeSortNone
  pred TreeSortDescending = TreeSortAscending
  pred TreeSortNone = error "TreeSort.pred: TreeSortNone has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from TreeSortDescending

  fromEnum TreeSortNone = 0
  fromEnum TreeSortAscending = 1
  fromEnum TreeSortDescending = 2

  toEnum 0 = TreeSortNone
  toEnum 1 = TreeSortAscending
  toEnum 2 = TreeSortDescending
  toEnum unmatched = error ("TreeSort.toEnum: Cannot match " ++ show unmatched)

{-# LINE 411 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

data TreeConnector = TreeConnectorNone
                   | TreeConnectorDotted
                   | TreeConnectorSolid
  deriving (Show,Eq)
instance Enum TreeConnector where
  succ TreeConnectorNone = TreeConnectorDotted
  succ TreeConnectorDotted = TreeConnectorSolid
  succ TreeConnectorSolid = error "TreeConnector.succ: TreeConnectorSolid has no successor"

  pred TreeConnectorDotted = TreeConnectorNone
  pred TreeConnectorSolid = TreeConnectorDotted
  pred TreeConnectorNone = error "TreeConnector.pred: TreeConnectorNone has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from TreeConnectorSolid

  fromEnum TreeConnectorNone = 0
  fromEnum TreeConnectorDotted = 1
  fromEnum TreeConnectorSolid = 2

  toEnum 0 = TreeConnectorNone
  toEnum 1 = TreeConnectorDotted
  toEnum 2 = TreeConnectorSolid
  toEnum unmatched = error ("TreeConnector.toEnum: Cannot match " ++ show unmatched)

{-# LINE 412 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

data TreeSelect = TreeSelectNone
                | TreeSelectSingle
                | TreeSelectMulti
                | TreeSelectSingleDraggable
  deriving (Show,Eq)
instance Enum TreeSelect where
  succ TreeSelectNone = TreeSelectSingle
  succ TreeSelectSingle = TreeSelectMulti
  succ TreeSelectMulti = TreeSelectSingleDraggable
  succ TreeSelectSingleDraggable = error "TreeSelect.succ: TreeSelectSingleDraggable has no successor"

  pred TreeSelectSingle = TreeSelectNone
  pred TreeSelectMulti = TreeSelectSingle
  pred TreeSelectSingleDraggable = TreeSelectMulti
  pred TreeSelectNone = error "TreeSelect.pred: TreeSelectNone has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from TreeSelectSingleDraggable

  fromEnum TreeSelectNone = 0
  fromEnum TreeSelectSingle = 1
  fromEnum TreeSelectMulti = 2
  fromEnum TreeSelectSingleDraggable = 3

  toEnum 0 = TreeSelectNone
  toEnum 1 = TreeSelectSingle
  toEnum 2 = TreeSelectMulti
  toEnum 3 = TreeSelectSingleDraggable
  toEnum unmatched = error ("TreeSelect.toEnum: Cannot match " ++ show unmatched)

{-# LINE 413 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

data SearchDirection = SearchDirectionUp
                     | SearchDirectionDown
  deriving (Show,Eq)
instance Enum SearchDirection where
  succ SearchDirectionUp = SearchDirectionDown
  succ SearchDirectionDown = error "SearchDirection.succ: SearchDirectionDown has no successor"

  pred SearchDirectionDown = SearchDirectionUp
  pred SearchDirectionUp = error "SearchDirection.pred: SearchDirectionUp has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from SearchDirectionDown

  fromEnum SearchDirectionUp = 65362
  fromEnum SearchDirectionDown = 65364

  toEnum 65362 = SearchDirectionUp
  toEnum 65364 = SearchDirectionDown
  toEnum unmatched = error ("SearchDirection.toEnum: Cannot match " ++ show unmatched)

{-# LINE 414 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

data TreeItemReselectMode = TreeSelectableOnce
                          | TreeSelectableAlways
  deriving (Show,Eq)
instance Enum TreeItemReselectMode where
  succ TreeSelectableOnce = TreeSelectableAlways
  succ TreeSelectableAlways = error "TreeItemReselectMode.succ: TreeSelectableAlways has no successor"

  pred TreeSelectableAlways = TreeSelectableOnce
  pred TreeSelectableOnce = error "TreeItemReselectMode.pred: TreeSelectableOnce has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from TreeSelectableAlways

  fromEnum TreeSelectableOnce = 0
  fromEnum TreeSelectableAlways = 1

  toEnum 0 = TreeSelectableOnce
  toEnum 1 = TreeSelectableAlways
  toEnum unmatched = error ("TreeItemReselectMode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 415 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

data TreeItemDrawMode = TreeItemDrawDefault
                      | TreeItemDrawLabelAndWidget
                      | TreeItemHeightFromWidget
  deriving (Show,Eq,Ord)
instance Enum TreeItemDrawMode where
  succ TreeItemDrawDefault = TreeItemDrawLabelAndWidget
  succ TreeItemDrawLabelAndWidget = TreeItemHeightFromWidget
  succ TreeItemHeightFromWidget = error "TreeItemDrawMode.succ: TreeItemHeightFromWidget has no successor"

  pred TreeItemDrawLabelAndWidget = TreeItemDrawDefault
  pred TreeItemHeightFromWidget = TreeItemDrawLabelAndWidget
  pred TreeItemDrawDefault = error "TreeItemDrawMode.pred: TreeItemDrawDefault has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from TreeItemHeightFromWidget

  fromEnum TreeItemDrawDefault = 0
  fromEnum TreeItemDrawLabelAndWidget = 1
  fromEnum TreeItemHeightFromWidget = 2

  toEnum 0 = TreeItemDrawDefault
  toEnum 1 = TreeItemDrawLabelAndWidget
  toEnum 2 = TreeItemHeightFromWidget
  toEnum unmatched = error ("TreeItemDrawMode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 416 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

data SpecialKey = Kb_VolumeDown
                | Kb_VolumeMute
                | Kb_VolumeUp
                | Kb_MediaPlay
                | Kb_MediaStop
                | Kb_MediaPrev
                | Kb_MediaNext
                | Kb_HomePage
                | Kb_Mail
                | Kb_Search
                | Kb_Back
                | Kb_Forward
                | Kb_Stop
                | Kb_Refresh
                | Kb_Sleep
                | Kb_Favorites
                | Kb_Unrecognized
                | Button
                | Kb_Backspace
                | Kb_Tab
                | Kb_Clear
                | Kb_IsoKey
                | Kb_Enter
                | Kb_Pause
                | Kb_Escape
                | Kb_Kana
                | Kb_Eisu
                | Kb_Yen
                | Kb_JisUnderscore
                | Kb_Home
                | Kb_Left
                | Kb_Up
                | Kb_Right
                | Kb_Down
                | Kb_PageUp
                | Kb_PageDown
                | Kb_End
                | Kb_Print
                | Kb_Insert
                | Kb_Menu
                | Kb_Help
                | Kb_Kp
                | Kb_KpEnter
                | Kb_F
                | Kb_Flast
                | Kb_ShiftL
                | Kb_ShiftR
                | Kb_ControlL
                | Kb_ControlR
                | Kb_CapsLock
                | Kb_MetaL
                | Kb_MetaR
                | Kb_AltL
                | Kb_AltR
                | Kb_Delete
  deriving (Show,Eq,Ord)
instance Enum SpecialKey where
  succ Kb_VolumeDown = Kb_VolumeMute
  succ Kb_VolumeMute = Kb_VolumeUp
  succ Kb_VolumeUp = Kb_MediaPlay
  succ Kb_MediaPlay = Kb_MediaStop
  succ Kb_MediaStop = Kb_MediaPrev
  succ Kb_MediaPrev = Kb_MediaNext
  succ Kb_MediaNext = Kb_HomePage
  succ Kb_HomePage = Kb_Mail
  succ Kb_Mail = Kb_Search
  succ Kb_Search = Kb_Back
  succ Kb_Back = Kb_Forward
  succ Kb_Forward = Kb_Stop
  succ Kb_Stop = Kb_Refresh
  succ Kb_Refresh = Kb_Sleep
  succ Kb_Sleep = Kb_Favorites
  succ Kb_Favorites = Kb_Unrecognized
  succ Kb_Unrecognized = Button
  succ Button = Kb_Backspace
  succ Kb_Backspace = Kb_Tab
  succ Kb_Tab = Kb_Clear
  succ Kb_Clear = Kb_IsoKey
  succ Kb_IsoKey = Kb_Enter
  succ Kb_Enter = Kb_Pause
  succ Kb_Pause = Kb_Escape
  succ Kb_Escape = Kb_Kana
  succ Kb_Kana = Kb_Eisu
  succ Kb_Eisu = Kb_Yen
  succ Kb_Yen = Kb_JisUnderscore
  succ Kb_JisUnderscore = Kb_Home
  succ Kb_Home = Kb_Left
  succ Kb_Left = Kb_Up
  succ Kb_Up = Kb_Right
  succ Kb_Right = Kb_Down
  succ Kb_Down = Kb_PageUp
  succ Kb_PageUp = Kb_PageDown
  succ Kb_PageDown = Kb_End
  succ Kb_End = Kb_Print
  succ Kb_Print = Kb_Insert
  succ Kb_Insert = Kb_Menu
  succ Kb_Menu = Kb_Help
  succ Kb_Help = Kb_Kp
  succ Kb_Kp = Kb_KpEnter
  succ Kb_KpEnter = Kb_F
  succ Kb_F = Kb_Flast
  succ Kb_Flast = Kb_ShiftL
  succ Kb_ShiftL = Kb_ShiftR
  succ Kb_ShiftR = Kb_ControlL
  succ Kb_ControlL = Kb_ControlR
  succ Kb_ControlR = Kb_CapsLock
  succ Kb_CapsLock = Kb_MetaL
  succ Kb_MetaL = Kb_MetaR
  succ Kb_MetaR = Kb_AltL
  succ Kb_AltL = Kb_AltR
  succ Kb_AltR = Kb_Delete
  succ Kb_Delete = error "SpecialKey.succ: Kb_Delete has no successor"

  pred Kb_VolumeMute = Kb_VolumeDown
  pred Kb_VolumeUp = Kb_VolumeMute
  pred Kb_MediaPlay = Kb_VolumeUp
  pred Kb_MediaStop = Kb_MediaPlay
  pred Kb_MediaPrev = Kb_MediaStop
  pred Kb_MediaNext = Kb_MediaPrev
  pred Kb_HomePage = Kb_MediaNext
  pred :: Damage -> Damage
pred Kb_Mail = Kb_HomePage
  pred Kb_Search = Kb_Mail
  pred Kb_Back = Kb_Search
  pred Kb_Forward = Kb_Back
  pred Kb_Stop = Kb_Forward
  pred Kb_Refresh = Kb_Stop
  pred Kb_Sleep = Kb_Refresh
  pred Kb_Favorites = Kb_Sleep
  pred Kb_Unrecognized = Kb_Favorites
  pred Button = Kb_Unrecognized
  pred Kb_Backspace = Button
  pred Kb_Tab = Kb_Backspace
  pred Kb_Clear = Kb_Tab
  pred Kb_IsoKey = Kb_Clear
  pred Kb_Enter = Kb_IsoKey
  pred Kb_Pause = Kb_Enter
  pred Kb_Escape = Kb_Pause
  pred Kb_Kana = Kb_Escape
  pred Kb_Eisu = Kb_Kana
  pred Kb_Yen = Kb_Eisu
  pred Kb_JisUnderscore = Kb_Yen
  pred Kb_Home = Kb_JisUnderscore
  pred Kb_Left = Kb_Home
  pred Kb_Up = Kb_Left
  pred Kb_Right = Kb_Up
  pred Kb_Down = Kb_Right
  pred Kb_PageUp = Kb_Down
  pred Kb_PageDown = Kb_PageUp
  pred Kb_End = Kb_PageDown
  pred Kb_Print = Kb_End
  pred Kb_Insert = Kb_Print
  pred Kb_Menu = Kb_Insert
  pred Kb_Help = Kb_Menu
  pred Kb_Kp = Kb_Help
  pred Kb_KpEnter = Kb_Kp
  pred Kb_F = Kb_KpEnter
  pred Kb_Flast = Kb_F
  pred Kb_ShiftL = Kb_Flast
  pred Kb_ShiftR = Kb_ShiftL
  pred Kb_ControlL = Kb_ShiftR
  pred Kb_ControlR = Kb_ControlL
  pred Kb_CapsLock = Kb_ControlR
  succ :: AlignType -> AlignType
pred Kb_MetaL = Kb_CapsLock
  pred Kb_MetaR = Kb_MetaL
  pred Kb_AltL = Kb_MetaR
  pred Kb_AltR = Kb_AltL
  pred Kb_Delete = Kb_AltR
  pred Kb_VolumeDown = error "SpecialKey.pred: Kb_VolumeDown has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from Kb_Delete

  fromEnum Kb_VolumeDown = 61201
  fromEnum Kb_VolumeMute = 61202
  fromEnum Kb_VolumeUp = 61203
  fromEnum Kb_MediaPlay = 61204
  fromEnum Kb_MediaStop = 61205
  fromEnum Kb_MediaPrev = 61206
  fromEnum Kb_MediaNext = 61207
  fromEnum Kb_HomePage = 61208
  fromEnum Kb_Mail = 61209
  fromEnum Kb_Search = 61211
  fromEnum Kb_Back = 61222
  fromEnum Kb_Forward = 61223
  fromEnum Kb_Stop = 61224
  fromEnum Kb_Refresh = 61225
  fromEnum Kb_Sleep = 61231
  fromEnum Kb_Favorites = 61232
  fromEnum Kb_Unrecognized = 61233
  enumFrom :: Cursor -> [Cursor]
fromEnum Button = 65256
  fromEnum Kb_Backspace = 65288
  fromEnum Kb_Tab = 65289
  fromEnum Kb_Clear = 65291
  fromEnum Kb_IsoKey = 65292
  fromEnum Kb_Enter = 65293
  fromEnum Kb_Pause = 65299
  fromEnum Kb_Escape = 65307
  enumFrom :: AlignType -> [AlignType]
fromEnum Kb_Kana = 65326
  fromEnum Kb_Eisu = 65327
  fromEnum Kb_Yen = 65328
  fromEnum Kb_JisUnderscore = 65329
  fromEnum Kb_Home = 65360
  fromEnum Kb_Left = 65361
  fromEnum Kb_Up = 65362
  fromEnum Kb_Right = 65363
  fromEnum Kb_Down = 65364
  fromEnum Kb_PageUp = 65365
  fromEnum Kb_PageDown = 65366
  fromEnum Kb_End = 65367
  fromEnum Kb_Print = 65377
  fromEnum Kb_Insert = 65379
  fromEnum Kb_Menu = 65383
  fromEnum Kb_Help = 65384
  fromEnum Kb_Kp = 65408
  fromEnum Kb_KpEnter = 65421
  fromEnum Kb_F = 65469
  fromEnum Kb_Flast = 65504
  fromEnum Kb_ShiftL = 65505
  fromEnum Kb_ShiftR = 65506
  fromEnum Kb_ControlL = 65507
  fromEnum Kb_ControlR = 65508
  fromEnum Kb_CapsLock = 65509
  fromEnum Kb_MetaL = 65511
  fromEnum Kb_MetaR = 65512
  fromEnum Kb_AltL = 65513
  fromEnum Kb_AltR = 65514
  fromEnum Kb_Delete = 65535

  toEnum 61201 = Kb_VolumeDown
  toEnum 61202 = Kb_VolumeMute
  toEnum 61203 = Kb_VolumeUp
  toEnum 61204 = Kb_MediaPlay
  toEnum 61205 = Kb_MediaStop
  toEnum 61206 = Kb_MediaPrev
  toEnum 61207 = Kb_MediaNext
  toEnum 61208 = Kb_HomePage
  toEnum 61209 = Kb_Mail
  toEnum 61211 = Kb_Search
  toEnum 61222 = Kb_Back
  toEnum 61223 = Kb_Forward
  toEnum 61224 = Kb_Stop
  toEnum 61225 = Kb_Refresh
  toEnum 61231 = Kb_Sleep
  toEnum 61232 = Kb_Favorites
  toEnum 61233 = Kb_Unrecognized
  toEnum 65256 = Button
  toEnum 65288 = Kb_Backspace
  toEnum 65289 = Kb_Tab
  toEnum 65291 = Kb_Clear
  toEnum 65292 = Kb_IsoKey
  toEnum 65293 = Kb_Enter
  toEnum 65299 = Kb_Pause
  toEnum 65307 = Kb_Escape
  toEnum 65326 = Kb_Kana
  toEnum 65327 = Kb_Eisu
  toEnum 65328 = Kb_Yen
  toEnum 65329 = Kb_JisUnderscore
  toEnum 65360 = Kb_Home
  toEnum 65361 = Kb_Left
  toEnum 65362 = Kb_Up
  toEnum 65363 = Kb_Right
  toEnum 65364 = Kb_Down
  toEnum 65365 = Kb_PageUp
  toEnum 65366 = Kb_PageDown
  toEnum 65367 = Kb_End
  toEnum 65377 = Kb_Print
  toEnum 65379 = Kb_Insert
  toEnum 65383 = Kb_Menu
  toEnum 65384 = Kb_Help
  toEnum 65408 = Kb_Kp
  toEnum 65421 = Kb_KpEnter
  toEnum 65469 = Kb_F
  toEnum 65504 = Kb_Flast
  toEnum 65505 = Kb_ShiftL
  toEnum 65506 = Kb_ShiftR
  toEnum 65507 = Kb_ControlL
  toEnum 65508 = Kb_ControlR
  toEnum 65509 = Kb_CapsLock
  toEnum 65511 = Kb_MetaL
  toEnum 65512 = Kb_MetaR
  toEnum 65513 = Kb_AltL
  toEnum 65514 = Kb_AltR
  toEnum 65535 = Kb_Delete
  toEnum unmatched = error ("SpecialKey.toEnum: Cannot match " ++ show unmatched)

{-# LINE 417 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}


allShortcutSpecialKeys :: [CInt]
allShortcutSpecialKeys = [
  fromIntegral $ fromEnum (Kb_Backspace),
  fromIntegral $ fromEnum (Kb_Tab),
  fromIntegral $ fromEnum (Kb_Clear),
  fromIntegral $ fromEnum (Kb_Enter),
  fromIntegral $ fromEnum (Kb_Pause),
  fromIntegral $ fromEnum (Kb_ScrollLockState),
  fromIntegral $ fromEnum (Kb_Escape),
  fromIntegral $ fromEnum (Kb_Home),
  fromIntegral $ fromEnum (Kb_Left),
  fromIntegral $ fromEnum (Kb_Up),
  fromIntegral $ fromEnum (Kb_Right),
  fromIntegral $ fromEnum (Kb_Down),
  fromIntegral $ fromEnum (Kb_PageUp),
  fromIntegral $ fromEnum (Kb_PageDown),
  fromIntegral $ fromEnum (Kb_End),
  fromIntegral $ fromEnum (Kb_Print),
  fromIntegral $ fromEnum (Kb_Insert),
  fromIntegral $ fromEnum (Kb_Menu),
  fromIntegral $ fromEnum (Kb_NumLockState),
  fromIntegral $ fromEnum (Kb_KpEnter),
  fromIntegral $ fromEnum (Kb_ShiftL),
  fromIntegral $ fromEnum (Kb_ShiftR),
  fromIntegral $ fromEnum (Kb_ControlL),
  fromIntegral $ fromEnum (Kb_ControlR),
  fromIntegral $ fromEnum (Kb_CapsLock),
  fromIntegral $ fromEnum (Kb_MetaL),
  fromIntegral $ fromEnum (Kb_MetaR),
  fromIntegral $ fromEnum (Kb_AltL),
  fromIntegral $ fromEnum (Kb_AltR),
  fromIntegral $ fromEnum (Kb_Delete)
  ]

allSpecialKeys :: [SpecialKey]
allSpecialKeys = [
    Button,
    Kb_Backspace,
    Kb_Clear,
    Kb_Tab,
    Kb_IsoKey,
    Kb_Enter,
    Kb_Pause,
    Kb_Escape,
    Kb_Kana,
    Kb_Eisu,
    Kb_Yen,
    Kb_JisUnderscore,
    Kb_Home,
    Kb_Left,
    Kb_Up,
    Kb_Right,
    Kb_Down,
    Kb_PageUp,
    Kb_PageDown,
    Kb_End,
    Kb_Print,
    Kb_Insert,
    Kb_Menu,
    Kb_Help,
    Kb_Kp,
    Kb_KpEnter,
    Kb_F,
    Kb_Flast,
    Kb_ShiftL,
    Kb_ShiftR,
    Kb_ControlL,
    Kb_ControlR,
    Kb_CapsLock,
    Kb_MetaL,
    Kb_MetaR,
    Kb_AltL,
    Kb_AltR,
    Kb_Delete,
    Kb_VolumeDown,
    Kb_VolumeMute,
    Kb_VolumeUp,
    Kb_MediaPlay,
    Kb_MediaStop,
    Kb_MediaPrev,
    Kb_MediaNext,
    Kb_HomePage,
    Kb_Mail,
    Kb_Search,
    Kb_Back,
    Kb_Forward,
    Kb_Stop,
    Kb_Refresh,
    Kb_Sleep,
    Kb_Favorites
  ]

data MouseButton = Mouse_Left
                 | Mouse_Middle
                 | Mouse_Right
  deriving (Show,Eq)
instance Enum MouseButton where
  succ Mouse_Left = Mouse_Middle
  succ Mouse_Middle = Mouse_Right
  succ Mouse_Right = error "MouseButton.succ: Mouse_Right has no successor"

  pred Mouse_Middle = Mouse_Left
  pred Mouse_Right = Mouse_Middle
  pred Mouse_Left = error "MouseButton.pred: Mouse_Left has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from Mouse_Right

  fromEnum Mouse_Left = 1
  fromEnum Mouse_Middle = 2
  fromEnum Mouse_Right = 3

  toEnum 1 = Mouse_Left
  toEnum 2 = Mouse_Middle
  toEnum 3 = Mouse_Right
  toEnum unmatched = error ("MouseButton.toEnum: Cannot match " ++ show unmatched)

{-# LINE 511 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

data EventState = Kb_ShiftState
                | Kb_CapsLockState
                | Kb_CtrlState
                | Kb_AltState
                | Kb_NumLockState
                | Kb_MetaState
                | Kb_ScrollLockState
                | Mouse_Button1State
                | Mouse_Button2State
                | Mouse_Button3State
  deriving (Show,Eq,Ord)
instance Enum EventState where
  succ Kb_ShiftState = Kb_CapsLockState
  succ Kb_CapsLockState = Kb_CtrlState
  succ Kb_CtrlState = Kb_AltState
  succ Kb_AltState = Kb_NumLockState
  succ Kb_NumLockState = Kb_MetaState
  succ Kb_MetaState = Kb_ScrollLockState
  succ Kb_ScrollLockState = Mouse_Button1State
  succ Mouse_Button1State = Mouse_Button2State
  succ Mouse_Button2State = Mouse_Button3State
  succ Mouse_Button3State = error "EventState.succ: Mouse_Button3State has no successor"

  pred Kb_CapsLockState = Kb_ShiftState
  pred Kb_CtrlState = Kb_CapsLockState
  pred Kb_AltState = Kb_CtrlState
  pred Kb_NumLockState = Kb_AltState
  pred Kb_MetaState = Kb_NumLockState
  pred Kb_ScrollLockState = Kb_MetaState
  pred Mouse_Button1State = Kb_ScrollLockState
  pred Mouse_Button2State = Mouse_Button1State
  pred Mouse_Button3State = Mouse_Button2State
  pred Kb_ShiftState = error "EventState.pred: Kb_ShiftState has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from Mouse_Button3State

  fromEnum Kb_ShiftState = 65536
  fromEnum Kb_CapsLockState = 131072
  fromEnum Kb_CtrlState = 262144
  fromEnum Kb_AltState = 524288
  fromEnum Kb_NumLockState = 1048576
  fromEnum Kb_MetaState = 4194304
  fromEnum Kb_ScrollLockState = 8388608
  fromEnum Mouse_Button1State = 16777216
  fromEnum Mouse_Button2State = 33554432
  fromEnum Mouse_Button3State = 67108864

  toEnum 65536 = Kb_ShiftState
  toEnum 131072 = Kb_CapsLockState
  toEnum 262144 = Kb_CtrlState
  toEnum 524288 = Kb_AltState
  toEnum 1048576 = Kb_NumLockState
  toEnum 4194304 = Kb_MetaState
  toEnum 8388608 = Kb_ScrollLockState
  toEnum 16777216 = Mouse_Button1State
  toEnum 33554432 = Mouse_Button2State
  toEnum 67108864 = Mouse_Button3State
  toEnum unmatched = error ("EventState.toEnum: Cannot match " ++ show unmatched)

{-# LINE 512 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

data KeyboardKeyMask = Kb_KeyMask
  deriving (Show,Eq,Ord)
instance Enum KeyboardKeyMask where
  succ Kb_KeyMask = error "KeyboardKeyMask.succ: Kb_KeyMask has no successor"

  pred Kb_KeyMask = error "KeyboardKeyMask.pred: Kb_KeyMask has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from Kb_KeyMask

  fromEnum Kb_KeyMask = 65535

  toEnum 65535 = Kb_KeyMask
  toEnum unmatched = error ("KeyboardKeyMask.toEnum: Cannot match " ++ show unmatched)

{-# LINE 513 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

data MouseButtonsMask = Mouse_ButtonsMask
  deriving (Show,Eq,Ord)
instance Enum MouseButtonsMask where
  succ Mouse_ButtonsMask = error "MouseButtonsMask.succ: Mouse_ButtonsMask has no successor"

  pred Mouse_ButtonsMask = error "MouseButtonsMask.pred: Mouse_ButtonsMask has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from Mouse_ButtonsMask

  fromEnum Mouse_ButtonsMask = 2130706432

  toEnum 2130706432 = Mouse_ButtonsMask
  toEnum unmatched = error ("MouseButtonsMask.toEnum: Cannot match " ++ show unmatched)

{-# LINE 514 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

kb_CommandState, kb_ControlState :: EventState
kb_CommandState = Kb_CtrlState
kb_ControlState = Kb_MetaState
kb_KpLast :: SpecialKey
kb_KpLast = Kb_F
data Damage = DamageChild
            | DamageExpose
            | DamageScroll
            | DamageOverlay
            | DamageUser1
            | DamageUser2
            | DamageAll
  deriving (Show,Eq,Ord)
instance Enum Damage where
  succ DamageChild = DamageExpose
  succ DamageExpose = DamageScroll
  succ DamageScroll = DamageOverlay
  succ DamageOverlay = DamageUser1
  succ DamageUser1 = DamageUser2
  succ DamageUser2 = DamageAll
  succ DamageAll = error "Damage.succ: DamageAll has no successor"

  pred DamageExpose = DamageChild
  pred DamageScroll = DamageExpose
  pred DamageOverlay = DamageScroll
  pred DamageUser1 = DamageOverlay
  pred DamageUser2 = DamageUser1
  pred DamageAll = DamageUser2
  pred DamageChild = error "Damage.pred: DamageChild has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from DamageAll

  fromEnum DamageChild = 1
  fromEnum DamageExpose = 2
  fromEnum DamageScroll = 4
  fromEnum DamageOverlay = 8
  fromEnum DamageUser1 = 16
  fromEnum DamageUser2 = 32
  fromEnum DamageAll = 128

  toEnum 1 = DamageChild
  toEnum 2 = DamageExpose
  toEnum 4 = DamageScroll
  toEnum 8 = DamageOverlay
  toEnum 16 = DamageUser1
  toEnum 32 = DamageUser2
  toEnum 128 = DamageAll
  toEnum unmatched = error ("Damage.toEnum: Cannot match " ++ show unmatched)

{-# LINE 525 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

allDamages :: [Damage]
allDamages =
  [
   DamageChild
   , DamageExpose
   , DamageScroll
   , DamageOverlay
   , DamageUser1
   , DamageUser2
   , DamageAll
  ]

data Cursor = CursorDefault
            | CursorSW
            | CursorSE
            | CursorS
            | CursorMove
            | CursorHand
            | CursorArrow
            | CursorW
            | CursorHelp
            | CursorE
            | CursorCross
            | CursorNW
            | CursorNE
            | CursorN
            | CursorWait
            | CursorInsert
            | CursorNS
            | CursorWE
            | CursorNWSE
            | CursorNesw
            | CursorNone
  deriving (Show,Eq,Ord)
instance Enum Cursor where
  succ CursorDefault = CursorSW
  succ CursorSW = CursorSE
  succ CursorSE = CursorS
  succ CursorS = CursorMove
  succ CursorMove = CursorHand
  succ CursorHand = CursorArrow
  succ CursorArrow = CursorW
  succ CursorW = CursorHelp
  succ CursorHelp = CursorE
  succ CursorE = CursorCross
  succ CursorCross = CursorNW
  succ CursorNW = CursorNE
  succ CursorNE = CursorN
  succ CursorN = CursorWait
  succ CursorWait = CursorInsert
  succ CursorInsert = CursorNS
  succ CursorNS = CursorWE
  succ CursorWE = CursorNWSE
  succ CursorNWSE = CursorNesw
  succ CursorNesw = CursorNone
  succ CursorNone = error "Cursor.succ: CursorNone has no successor"

  pred CursorSW = CursorDefault
  pred CursorSE = CursorSW
  pred CursorS = CursorSE
  pred CursorMove = CursorS
  pred CursorHand = CursorMove
  pred CursorArrow = CursorHand
  pred CursorW = CursorArrow
  pred CursorHelp = CursorW
  pred CursorE = CursorHelp
  pred CursorCross = CursorE
  pred CursorNW = CursorCross
  pred CursorNE = CursorNW
  pred CursorN = CursorNE
  pred CursorWait = CursorN
  pred CursorInsert = CursorWait
  pred CursorNS = CursorInsert
  pred CursorWE = CursorNS
  pred CursorNWSE = CursorWE
  pred CursorNesw = CursorNWSE
  pred CursorNone = CursorNesw
  pred CursorDefault = error "Cursor.pred: CursorDefault has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from CursorNone

  fromEnum CursorDefault = 0
  fromEnum CursorSW = 7
  fromEnum CursorSE = 8
  fromEnum CursorS = 9
  fromEnum CursorMove = 27
  fromEnum CursorHand = 31
  fromEnum CursorArrow = 35
  fromEnum CursorW = 36
  fromEnum CursorHelp = 47
  fromEnum CursorE = 49
  fromEnum CursorCross = 66
  fromEnum CursorNW = 68
  fromEnum CursorNE = 69
  fromEnum CursorN = 70
  fromEnum CursorWait = 76
  fromEnum CursorInsert = 77
  fromEnum CursorNS = 78
  fromEnum CursorWE = 79
  fromEnum CursorNWSE = 80
  fromEnum CursorNesw = 81
  fromEnum CursorNone = 255

  toEnum 0 = CursorDefault
  toEnum 7 = CursorSW
  toEnum 8 = CursorSE
  toEnum 9 = CursorS
  toEnum 27 = CursorMove
  toEnum 31 = CursorHand
  toEnum 35 = CursorArrow
  toEnum 36 = CursorW
  toEnum 47 = CursorHelp
  toEnum 49 = CursorE
  toEnum 66 = CursorCross
  toEnum 68 = CursorNW
  toEnum 69 = CursorNE
  toEnum 70 = CursorN
  toEnum 76 = CursorWait
  toEnum 77 = CursorInsert
  toEnum 78 = CursorNS
  toEnum 79 = CursorWE
  toEnum 80 = CursorNWSE
  toEnum 81 = CursorNesw
  toEnum 255 = CursorNone
  toEnum unmatched = error ("Cursor.toEnum: Cannot match " ++ show unmatched)

{-# LINE 538 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

data Mode = ModeRGB
          | ModeIndex
          | ModeDouble
          | ModeAccum
          | ModeAlpha
          | ModeDepth
          | ModeStencil
          | ModeRGB8
          | ModeMultisample
          | ModeStereo
          | ModeFakeSingle
          | ModeOpenGL3
  deriving (Show,Eq,Ord)
instance Enum Mode where
  succ ModeRGB = ModeIndex
  succ ModeIndex = ModeDouble
  succ ModeDouble = ModeAccum
  succ ModeAccum = ModeAlpha
  succ ModeAlpha = ModeDepth
  succ ModeDepth = ModeStencil
  succ ModeStencil = ModeRGB8
  succ ModeRGB8 = ModeMultisample
  succ ModeMultisample = ModeStereo
  succ ModeStereo = ModeFakeSingle
  succ ModeFakeSingle = ModeOpenGL3
  succ ModeOpenGL3 = error "Mode.succ: ModeOpenGL3 has no successor"

  pred ModeIndex = ModeRGB
  pred ModeDouble = ModeIndex
  pred ModeAccum = ModeDouble
  pred ModeAlpha = ModeAccum
  pred ModeDepth = ModeAlpha
  pred ModeStencil = ModeDepth
  pred ModeRGB8 = ModeStencil
  pred ModeMultisample = ModeRGB8
  pred ModeStereo = ModeMultisample
  pred ModeFakeSingle = ModeStereo
  pred ModeOpenGL3 = ModeFakeSingle
  pred ModeRGB = error "Mode.pred: ModeRGB has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from ModeOpenGL3

  fromEnum ModeRGB = 0
  fromEnum ModeIndex = 1
  fromEnum ModeDouble = 2
  fromEnum ModeAccum = 4
  fromEnum ModeAlpha = 8
  fromEnum ModeDepth = 16
  fromEnum ModeStencil = 32
  fromEnum ModeRGB8 = 64
  fromEnum ModeMultisample = 128
  fromEnum ModeStereo = 256
  fromEnum ModeFakeSingle = 512
  fromEnum ModeOpenGL3 = 1024

  toEnum 0 = ModeRGB
  toEnum 1 = ModeIndex
  toEnum 2 = ModeDouble
  toEnum 4 = ModeAccum
  toEnum 8 = ModeAlpha
  toEnum 16 = ModeDepth
  toEnum 32 = ModeStencil
  toEnum 64 = ModeRGB8
  toEnum 128 = ModeMultisample
  toEnum 256 = ModeStereo
  toEnum 512 = ModeFakeSingle
  toEnum 1024 = ModeOpenGL3
  toEnum unmatched = error ("Mode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 539 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

-- Fl_Mode Aliases
single :: Mode
single = ModeRGB
newtype Modes = Modes [Mode] deriving (Show,Eq,Ord)
allModes :: [Mode]
allModes =
  [
    ModeRGB,
    ModeIndex,
    ModeDouble,
    ModeAccum,
    ModeAlpha,
    ModeDepth,
    ModeStencil,
    ModeRGB8,
    ModeMultisample,
    ModeStereo,
    ModeFakeSingle
    , ModeOpenGL3
  ]

data AlignType = AlignTypeCenter
               | AlignTypeTop
               | AlignTypeBottom
               | AlignTypeLeft
               | AlignTypeLeftTop
               | AlignTypeRight
               | AlignTypeRightTop
               | AlignTypeLeftBottom
               | AlignTypeRightBottom
               | AlignTypeInside
               | AlignTypeTextOverImage
               | AlignTypeClip
               | AlignTypeWrap
               | AlignTypeImageNextToText
               | AlignTypeTextNextToImage
               | AlignTypeImageBackdrop
  deriving (Show,Eq,Ord)
instance Enum AlignType where
  succ AlignTypeCenter = AlignTypeTop
  succ AlignTypeTop = AlignTypeBottom
  succ AlignTypeBottom = AlignTypeLeft
  succ AlignTypeLeft = AlignTypeLeftTop
  succ AlignTypeLeftTop = AlignTypeRight
  succ AlignTypeRight = AlignTypeRightTop
  succ AlignTypeRightTop = AlignTypeLeftBottom
  succ AlignTypeLeftBottom = AlignTypeRightBottom
  succ AlignTypeRightBottom = AlignTypeInside
  succ AlignTypeInside = AlignTypeTextOverImage
  succ AlignTypeTextOverImage = AlignTypeClip
  succ AlignTypeClip = AlignTypeWrap
  succ AlignTypeWrap = AlignTypeImageNextToText
  succ AlignTypeImageNextToText = AlignTypeTextNextToImage
  succ AlignTypeTextNextToImage = AlignTypeImageBackdrop
  succ AlignTypeImageBackdrop = error "AlignType.succ: AlignTypeImageBackdrop has no successor"

  pred AlignTypeTop = AlignTypeCenter
  pred AlignTypeBottom = AlignTypeTop
  pred AlignTypeLeft = AlignTypeBottom
  pred AlignTypeLeftTop = AlignTypeLeft
  pred AlignTypeRight = AlignTypeLeftTop
  pred AlignTypeRightTop = AlignTypeRight
  pred AlignTypeLeftBottom = AlignTypeRightTop
  pred AlignTypeRightBottom = AlignTypeLeftBottom
  pred AlignTypeInside = AlignTypeRightBottom
  pred AlignTypeTextOverImage = AlignTypeInside
  pred AlignTypeClip = AlignTypeTextOverImage
  pred AlignTypeWrap = AlignTypeClip
  pred AlignTypeImageNextToText = AlignTypeWrap
  pred AlignTypeTextNextToImage = AlignTypeImageNextToText
  pred AlignTypeImageBackdrop = AlignTypeTextNextToImage
  pred AlignTypeCenter = error "AlignType.pred: AlignTypeCenter has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from AlignTypeImageBackdrop

  fromEnum AlignTypeCenter = 0
  fromEnum AlignTypeTop = 1
  fromEnum AlignTypeBottom = 2
  fromEnum AlignTypeLeft = 4
  fromEnum AlignTypeLeftTop = 7
  fromEnum AlignTypeRight = 8
  fromEnum AlignTypeRightTop = 11
  fromEnum AlignTypeLeftBottom = 13
  fromEnum AlignTypeRightBottom = 14
  fromEnum AlignTypeInside = 16
  fromEnum AlignTypeTextOverImage = 32
  fromEnum AlignTypeClip = 64
  fromEnum AlignTypeWrap = 128
  fromEnum AlignTypeImageNextToText = 256
  fromEnum AlignTypeTextNextToImage = 288
  fromEnum AlignTypeImageBackdrop = 512

  toEnum 0 = AlignTypeCenter
  toEnum 1 = AlignTypeTop
  toEnum 2 = AlignTypeBottom
  toEnum 4 = AlignTypeLeft
  toEnum 7 = AlignTypeLeftTop
  toEnum 8 = AlignTypeRight
  toEnum 11 = AlignTypeRightTop
  toEnum 13 = AlignTypeLeftBottom
  toEnum 14 = AlignTypeRightBottom
  toEnum 16 = AlignTypeInside
  toEnum 32 = AlignTypeTextOverImage
  toEnum 64 = AlignTypeClip
  toEnum 128 = AlignTypeWrap
  toEnum 256 = AlignTypeImageNextToText
  toEnum 288 = AlignTypeTextNextToImage
  toEnum 512 = AlignTypeImageBackdrop
  toEnum unmatched = error ("AlignType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 563 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

newtype Alignments = Alignments [AlignType] deriving (Eq, Show, Ord)
alignCenter :: Alignments
alignCenter = Alignments [AlignTypeCenter]
alignTop :: Alignments
alignTop = Alignments [AlignTypeTop]
alignBottom :: Alignments
alignBottom = Alignments [AlignTypeBottom]
alignLeft :: Alignments
alignLeft = Alignments [AlignTypeLeft]
alignRight :: Alignments
alignRight = Alignments [AlignTypeRight]
alignInside :: Alignments
alignInside = Alignments [AlignTypeInside]
alignTextOverImage :: Alignments
alignTextOverImage = Alignments [AlignTypeTextOverImage]
alignClip :: Alignments
alignClip = Alignments [AlignTypeClip]
alignWrap :: Alignments
alignWrap = Alignments [AlignTypeWrap]
alignImageNextToText :: Alignments
alignImageNextToText = Alignments [AlignTypeImageNextToText]
alignTextNextToImage :: Alignments
alignTextNextToImage = Alignments [AlignTypeTextNextToImage]
alignImageBackdrop :: Alignments
alignImageBackdrop = Alignments [AlignTypeImageBackdrop]
alignLeftTop :: Alignments
alignLeftTop = Alignments [AlignTypeLeftTop]
alignRightTop :: Alignments
alignRightTop = Alignments [AlignTypeRightTop]
alignLeftBottom :: Alignments
alignLeftBottom = Alignments [AlignTypeLeftBottom]
alignRightBottom :: Alignments
alignRightBottom = Alignments [AlignTypeRightBottom]
alignPositionMask :: Alignments
alignPositionMask = Alignments [AlignTypeLeft, AlignTypeRight, AlignTypeTop, AlignTypeBottom]
alignImageMask :: Alignments
alignImageMask = Alignments [AlignTypeImageBackdrop, AlignTypeImageNextToText, AlignTypeTextOverImage]
alignNoWrap :: Alignments
alignNoWrap = alignCenter
alignImageOverText :: Alignments
alignImageOverText = alignCenter
alignTopLeft :: Alignments
alignTopLeft = Alignments [AlignTypeTop, AlignTypeLeft]
alignTopRight :: Alignments
alignTopRight = Alignments [AlignTypeTop, AlignTypeRight]
alignBottomLeft :: Alignments
alignBottomLeft = Alignments [AlignTypeBottom, AlignTypeLeft]
alignBottomRight :: Alignments
alignBottomRight = Alignments [AlignTypeBottom, AlignTypeRight]
allAlignTypes :: [AlignType]
allAlignTypes = [
      AlignTypeCenter,
      AlignTypeTop,
      AlignTypeBottom,
      AlignTypeLeft,
      AlignTypeRight,
      AlignTypeInside,
      AlignTypeTextOverImage,
      AlignTypeClip,
      AlignTypeWrap,
      AlignTypeImageNextToText,
      AlignTypeTextNextToImage,
      AlignTypeImageBackdrop,
      AlignTypeLeftTop,
      AlignTypeRightTop,
      AlignTypeLeftBottom,
      AlignTypeRightBottom
      ]
allWhen :: [When]
allWhen = [
    WhenNever,
    WhenChanged,
    WhenNotChanged,
    WhenRelease,
    WhenReleaseAlways,
    WhenEnterKey,
    WhenEnterKeyAlways,
    WhenEnterKeyChanged
  ]

allEventStates :: [EventState]
allEventStates = [
    Kb_ShiftState,
    Kb_CapsLockState,
    Kb_CtrlState,
    Kb_AltState,
    Kb_NumLockState,
    Kb_MetaState,
    Kb_ScrollLockState,
    Mouse_Button1State,
    Mouse_Button2State,
    Mouse_Button3State
  ]

allTreeItemDrawModes :: [TreeItemDrawMode]
allTreeItemDrawModes = [
    TreeItemDrawDefault,
    TreeItemDrawLabelAndWidget,
    TreeItemHeightFromWidget
  ]

data Boxtype = NoBox
             | FlatBox
             | UpBox
             | DownBox
             | UpFrame
             | DownFrame
             | ThinUpBox
             | ThinDownBox
             | ThinUpFrame
             | ThinDownFrame
             | EngravedBox
             | EmbossedBox
             | EngravedFrame
             | EmbossedFrame
             | BorderBox
             | ShadowBox
             | BorderFrame
             | ShadowFrame
             | RoundedBox
             | RshadowBox
             | RoundedFrame
             | RFlatBox
             | RoundUpBox
             | RoundDownBox
             | DiamondUpBox
             | DiamondDownBox
             | OvalBox
             | OshadowBox
             | OvalFrame
             | FloatBox
             | PlasticUpBox
             | PlasticDownBox
             | PlasticUpFrame
             | PlasticDownFrame
             | PlasticThinUpBox
             | PlasticThinDownBox
             | PlasticRoundUpBox
             | PlasticRoundDownBox
             | GtkUpBox
             | GtkDownBox
             | GtkUpFrame
             | GtkDownFrame
             | GtkThinUpBox
             | GtkThinDownBox
             | GtkThinUpFrame
             | GtkThinDownFrame
             | GtkRoundUpBox
             | GtkRoundDownBox
             | GleamUpBox
             | GleamDownBox
             | GleamUpFrame
             | GleamDownFrame
             | GleamThinUpBox
             | GleamThinDownBox
             | GleamRoundUpBox
             | GleamRoundDownBox
             | FreeBoxtype
             deriving (Int -> Boxtype -> ShowS
[Boxtype] -> ShowS
Boxtype -> String
(Int -> Boxtype -> ShowS)
-> (Boxtype -> String) -> ([Boxtype] -> ShowS) -> Show Boxtype
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Boxtype] -> ShowS
$cshowList :: [Boxtype] -> ShowS
show :: Boxtype -> String
$cshow :: Boxtype -> String
showsPrec :: Int -> Boxtype -> ShowS
$cshowsPrec :: Int -> Boxtype -> ShowS
Show, Boxtype -> Boxtype -> Bool
(Boxtype -> Boxtype -> Bool)
-> (Boxtype -> Boxtype -> Bool) -> Eq Boxtype
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Boxtype -> Boxtype -> Bool
$c/= :: Boxtype -> Boxtype -> Bool
== :: Boxtype -> Boxtype -> Bool
$c== :: Boxtype -> Boxtype -> Bool
Eq, Eq Boxtype
Eq Boxtype =>
(Boxtype -> Boxtype -> Ordering)
-> (Boxtype -> Boxtype -> Bool)
-> (Boxtype -> Boxtype -> Bool)
-> (Boxtype -> Boxtype -> Bool)
-> (Boxtype -> Boxtype -> Bool)
-> (Boxtype -> Boxtype -> Boxtype)
-> (Boxtype -> Boxtype -> Boxtype)
-> Ord Boxtype
Boxtype -> Boxtype -> Bool
Boxtype -> Boxtype -> Ordering
Boxtype -> Boxtype -> Boxtype
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Boxtype -> Boxtype -> Boxtype
$cmin :: Boxtype -> Boxtype -> Boxtype
max :: Boxtype -> Boxtype -> Boxtype
$cmax :: Boxtype -> Boxtype -> Boxtype
>= :: Boxtype -> Boxtype -> Bool
$c>= :: Boxtype -> Boxtype -> Bool
> :: Boxtype -> Boxtype -> Bool
$c> :: Boxtype -> Boxtype -> Bool
<= :: Boxtype -> Boxtype -> Bool
$c<= :: Boxtype -> Boxtype -> Bool
< :: Boxtype -> Boxtype -> Bool
$c< :: Boxtype -> Boxtype -> Bool
compare :: Boxtype -> Boxtype -> Ordering
$ccompare :: Boxtype -> Boxtype -> Ordering
$cp1Ord :: Eq Boxtype
Ord)
instance Enum Boxtype where
  fromEnum :: Boxtype -> Int
fromEnum NoBox = 0
  fromEnum FlatBox = 1
  fromEnum UpBox = 2
  fromEnum DownBox = 3
  fromEnum UpFrame = 4
  fromEnum DownFrame = 5
  fromEnum ThinUpBox = 6
  fromEnum ThinDownBox = 7
  fromEnum ThinUpFrame = 8
  fromEnum ThinDownFrame = 9
  fromEnum EngravedBox = 10
  fromEnum EmbossedBox = 11
  fromEnum EngravedFrame = 12
  fromEnum EmbossedFrame = 13
  fromEnum BorderBox = 14
  fromEnum ShadowBox = Int
forall a. Num a => a
defineShadowBox_
  fromEnum BorderFrame = 16
  fromEnum ShadowFrame = Int
forall a. Num a => a
defineShadowBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2
  fromEnum RoundedBox = Int
forall a. Num a => a
defineRoundedBox_
  fromEnum RshadowBox = Int
forall a. Num a => a
defineRshadowBox_
  fromEnum RoundedFrame = Int
forall a. Num a => a
defineRoundedBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2
  fromEnum RFlatBox = Int
forall a. Num a => a
defineRflatBox_
  fromEnum RoundUpBox = Int
forall a. Num a => a
defineRoundUpBox_
  fromEnum RoundDownBox = Int
forall a. Num a => a
defineRoundUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
  fromEnum DiamondUpBox = Int
forall a. Num a => a
defineDiamondBox_
  fromEnum DiamondDownBox = Int
forall a. Num a => a
defineDiamondBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
  fromEnum OvalBox = Int
forall a. Num a => a
defineOvalBox_
  fromEnum OshadowBox = Int
forall a. Num a => a
defineOvalBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
  fromEnum OvalFrame = Int
forall a. Num a => a
defineOvalBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2
  fromEnum FloatBox = Int
forall a. Num a => a
defineOvalBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3
  fromEnum PlasticUpBox = Int
forall a. Num a => a
definePlasticUpBox_
  fromEnum PlasticDownBox = Int
forall a. Num a => a
definePlasticUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
  fromEnum PlasticUpFrame = Int
forall a. Num a => a
definePlasticUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2
  fromEnum PlasticDownFrame = Int
forall a. Num a => a
definePlasticUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3
  fromEnum PlasticThinUpBox = Int
forall a. Num a => a
definePlasticUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4
  fromEnum PlasticThinDownBox = Int
forall a. Num a => a
definePlasticUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 5
  fromEnum PlasticRoundUpBox = Int
forall a. Num a => a
definePlasticUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 6
  fromEnum PlasticRoundDownBox = Int
forall a. Num a => a
definePlasticUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 7
  fromEnum GtkUpBox = Int
forall a. Num a => a
defineGtkUpBox_
  fromEnum GtkDownBox = Int
forall a. Num a => a
defineGtkUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
  fromEnum GtkUpFrame = Int
forall a. Num a => a
defineGtkUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2
  fromEnum GtkDownFrame = Int
forall a. Num a => a
defineGtkUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3
  fromEnum GtkThinUpBox = Int
forall a. Num a => a
defineGtkUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4
  fromEnum GtkThinDownBox = Int
forall a. Num a => a
defineGtkUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 5
  fromEnum GtkThinUpFrame = Int
forall a. Num a => a
defineGtkUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 6
  fromEnum GtkThinDownFrame = Int
forall a. Num a => a
defineGtkUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 7
  fromEnum GtkRoundUpBox = Int
forall a. Num a => a
defineGtkUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 8
  fromEnum GtkRoundDownBox = Int
forall a. Num a => a
defineGtkUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 9
  fromEnum GleamUpBox = Int
forall a. Num a => a
defineGleamUpBox_
  fromEnum GleamDownBox = Int
forall a. Num a => a
defineGleamUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
  fromEnum GleamUpFrame = Int
forall a. Num a => a
defineGleamUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2
  fromEnum GleamDownFrame = Int
forall a. Num a => a
defineGleamUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3
  fromEnum GleamThinUpBox = Int
forall a. Num a => a
defineGleamUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4
  fromEnum GleamThinDownBox = Int
forall a. Num a => a
defineGleamUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 5
  fromEnum GleamRoundUpBox = Int
forall a. Num a => a
defineGleamUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 6
  fromEnum GleamRoundDownBox = Int
forall a. Num a => a
defineGleamUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 7
  fromEnum FreeBoxtype = 48

  toEnum :: Int -> Boxtype
toEnum 0 = Boxtype
NoBox
  toEnum 1 = Boxtype
FlatBox
  toEnum 2 = Boxtype
UpBox
  toEnum 3 = Boxtype
DownBox
  toEnum 4 = Boxtype
UpFrame
  toEnum 5 = Boxtype
DownFrame
  toEnum 6 = Boxtype
ThinUpBox
  toEnum 7 = Boxtype
ThinDownBox
  toEnum 8 = Boxtype
ThinUpFrame
  toEnum 9 = Boxtype
ThinDownFrame
  toEnum 10 = Boxtype
EngravedBox
  toEnum 11 = Boxtype
EmbossedBox
  toEnum 12 = Boxtype
EngravedFrame
  toEnum 13 = Boxtype
EmbossedFrame
  toEnum 14 = Boxtype
BorderBox
  toEnum 16 = Boxtype
BorderFrame
  toEnum 48 = Boxtype
FreeBoxtype
  toEnum x :: Int
x | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineShadowBox_ = Boxtype
ShadowBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineShadowBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 = Boxtype
ShadowFrame
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineRoundedBox_  = Boxtype
RoundedBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineRshadowBox_ = Boxtype
RshadowBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineRoundedBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 = Boxtype
RoundedFrame
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineRflatBox_ = Boxtype
RFlatBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineRoundUpBox_ = Boxtype
RoundUpBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineRoundUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 = Boxtype
RoundDownBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineDiamondBox_ = Boxtype
DiamondUpBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineDiamondBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 = Boxtype
DiamondDownBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineOvalBox_ = Boxtype
OvalBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineOvalBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 = Boxtype
OshadowBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineOvalBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 = Boxtype
OvalFrame
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineOvalBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3 = Boxtype
FloatBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
definePlasticUpBox_ = Boxtype
PlasticUpBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
definePlasticUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 = Boxtype
PlasticDownBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
definePlasticUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 = Boxtype
PlasticUpFrame
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
definePlasticUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3 = Boxtype
PlasticDownFrame
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
definePlasticUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4 = Boxtype
PlasticThinUpBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
definePlasticUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 5 = Boxtype
PlasticThinDownBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
definePlasticUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 6 = Boxtype
PlasticRoundUpBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
definePlasticUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 7 = Boxtype
PlasticRoundDownBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineGtkUpBox_  = Boxtype
GtkUpBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineGtkUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 = Boxtype
GtkDownBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineGtkUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 = Boxtype
GtkUpFrame
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineGtkUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3 = Boxtype
GtkDownFrame
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineGtkUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4 = Boxtype
GtkThinUpBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineGtkUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 5 = Boxtype
GtkThinDownBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineGtkUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 6 = Boxtype
GtkThinUpFrame
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineGtkUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 7 = Boxtype
GtkThinDownFrame
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineGtkUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 8 = Boxtype
GtkRoundUpBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineGtkUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 9 = Boxtype
GtkRoundDownBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineGleamUpBox_  = Boxtype
GleamUpBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineGleamUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 = Boxtype
GleamDownBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineGleamUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 = Boxtype
GleamUpFrame
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineGleamUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3 = Boxtype
GleamDownFrame
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineGleamUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4 = Boxtype
GleamThinUpBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineGleamUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 5 = Boxtype
GleamThinDownBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineGleamUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 6 = Boxtype
GleamRoundUpBox
           | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineGleamUpBox_ Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 7 = Boxtype
GleamRoundDownBox
           | Bool
otherwise = String -> Boxtype
forall a. HasCallStack => String -> a
error ("Boxtype.toEnum: Cannot match " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show Bool
otherwise)
frame,frameBox, circleBox, diamondBox :: Boxtype
frame :: Boxtype
frame = Boxtype
EngravedFrame
frameBox :: Boxtype
frameBox = Boxtype
EngravedBox
circleBox :: Boxtype
circleBox = Boxtype
RoundDownBox
diamondBox :: Boxtype
diamondBox = Boxtype
DiamondDownBox


-- Fonts
newtype Font = Font Int deriving (Font -> Font -> Bool
(Font -> Font -> Bool) -> (Font -> Font -> Bool) -> Eq Font
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Font -> Font -> Bool
$c/= :: Font -> Font -> Bool
== :: Font -> Font -> Bool
$c== :: Font -> Font -> Bool
Eq, Int -> Font -> ShowS
[Font] -> ShowS
Font -> String
(Int -> Font -> ShowS)
-> (Font -> String) -> ([Font] -> ShowS) -> Show Font
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Font] -> ShowS
$cshowList :: [Font] -> ShowS
show :: Font -> String
$cshow :: Font -> String
showsPrec :: Int -> Font -> ShowS
$cshowsPrec :: Int -> Font -> ShowS
Show, Eq Font
Eq Font =>
(Font -> Font -> Ordering)
-> (Font -> Font -> Bool)
-> (Font -> Font -> Bool)
-> (Font -> Font -> Bool)
-> (Font -> Font -> Bool)
-> (Font -> Font -> Font)
-> (Font -> Font -> Font)
-> Ord Font
Font -> Font -> Bool
Font -> Font -> Ordering
Font -> Font -> Font
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Font -> Font -> Font
$cmin :: Font -> Font -> Font
max :: Font -> Font -> Font
$cmax :: Font -> Font -> Font
>= :: Font -> Font -> Bool
$c>= :: Font -> Font -> Bool
> :: Font -> Font -> Bool
$c> :: Font -> Font -> Bool
<= :: Font -> Font -> Bool
$c<= :: Font -> Font -> Bool
< :: Font -> Font -> Bool
$c< :: Font -> Font -> Bool
compare :: Font -> Font -> Ordering
$ccompare :: Font -> Font -> Ordering
$cp1Ord :: Eq Font
Ord)
data FontAttribute = Bold | Italic | BoldItalic deriving (Int -> FontAttribute -> ShowS
[FontAttribute] -> ShowS
FontAttribute -> String
(Int -> FontAttribute -> ShowS)
-> (FontAttribute -> String)
-> ([FontAttribute] -> ShowS)
-> Show FontAttribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontAttribute] -> ShowS
$cshowList :: [FontAttribute] -> ShowS
show :: FontAttribute -> String
$cshow :: FontAttribute -> String
showsPrec :: Int -> FontAttribute -> ShowS
$cshowsPrec :: Int -> FontAttribute -> ShowS
Show, FontAttribute -> FontAttribute -> Bool
(FontAttribute -> FontAttribute -> Bool)
-> (FontAttribute -> FontAttribute -> Bool) -> Eq FontAttribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontAttribute -> FontAttribute -> Bool
$c/= :: FontAttribute -> FontAttribute -> Bool
== :: FontAttribute -> FontAttribute -> Bool
$c== :: FontAttribute -> FontAttribute -> Bool
Eq, Eq FontAttribute
Eq FontAttribute =>
(FontAttribute -> FontAttribute -> Ordering)
-> (FontAttribute -> FontAttribute -> Bool)
-> (FontAttribute -> FontAttribute -> Bool)
-> (FontAttribute -> FontAttribute -> Bool)
-> (FontAttribute -> FontAttribute -> Bool)
-> (FontAttribute -> FontAttribute -> FontAttribute)
-> (FontAttribute -> FontAttribute -> FontAttribute)
-> Ord FontAttribute
FontAttribute -> FontAttribute -> Bool
FontAttribute -> FontAttribute -> Ordering
FontAttribute -> FontAttribute -> FontAttribute
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FontAttribute -> FontAttribute -> FontAttribute
$cmin :: FontAttribute -> FontAttribute -> FontAttribute
max :: FontAttribute -> FontAttribute -> FontAttribute
$cmax :: FontAttribute -> FontAttribute -> FontAttribute
>= :: FontAttribute -> FontAttribute -> Bool
$c>= :: FontAttribute -> FontAttribute -> Bool
> :: FontAttribute -> FontAttribute -> Bool
$c> :: FontAttribute -> FontAttribute -> Bool
<= :: FontAttribute -> FontAttribute -> Bool
$c<= :: FontAttribute -> FontAttribute -> Bool
< :: FontAttribute -> FontAttribute -> Bool
$c< :: FontAttribute -> FontAttribute -> Bool
compare :: FontAttribute -> FontAttribute -> Ordering
$ccompare :: FontAttribute -> FontAttribute -> Ordering
$cp1Ord :: Eq FontAttribute
Ord, Int -> FontAttribute
FontAttribute -> Int
FontAttribute -> [FontAttribute]
FontAttribute -> FontAttribute
FontAttribute -> FontAttribute -> [FontAttribute]
FontAttribute -> FontAttribute -> FontAttribute -> [FontAttribute]
(FontAttribute -> FontAttribute)
-> (FontAttribute -> FontAttribute)
-> (Int -> FontAttribute)
-> (FontAttribute -> Int)
-> (FontAttribute -> [FontAttribute])
-> (FontAttribute -> FontAttribute -> [FontAttribute])
-> (FontAttribute -> FontAttribute -> [FontAttribute])
-> (FontAttribute
    -> FontAttribute -> FontAttribute -> [FontAttribute])
-> Enum FontAttribute
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FontAttribute -> FontAttribute -> FontAttribute -> [FontAttribute]
$cenumFromThenTo :: FontAttribute -> FontAttribute -> FontAttribute -> [FontAttribute]
enumFromTo :: FontAttribute -> FontAttribute -> [FontAttribute]
$cenumFromTo :: FontAttribute -> FontAttribute -> [FontAttribute]
enumFromThen :: FontAttribute -> FontAttribute -> [FontAttribute]
$cenumFromThen :: FontAttribute -> FontAttribute -> [FontAttribute]
enumFrom :: FontAttribute -> [FontAttribute]
$cenumFrom :: FontAttribute -> [FontAttribute]
fromEnum :: FontAttribute -> Int
$cfromEnum :: FontAttribute -> Int
toEnum :: Int -> FontAttribute
$ctoEnum :: Int -> FontAttribute
pred :: FontAttribute -> FontAttribute
$cpred :: FontAttribute -> FontAttribute
succ :: FontAttribute -> FontAttribute
$csucc :: FontAttribute -> FontAttribute
Enum)
cFromFont :: Font -> CInt
cFromFont :: Font -> CInt
cFromFont (Font f :: Int
f) = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
f
cToFont :: CInt -> Font
cToFont :: CInt -> Font
cToFont f :: CInt
f = Int -> Font
Font (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
f)

cFromFontAttribute :: FontAttribute -> CInt
cFromFontAttribute :: FontAttribute -> CInt
cFromFontAttribute Bold = Font -> CInt
cFromFont Font
helveticaBold
cFromFontAttribute Italic = Font -> CInt
cFromFont Font
helveticaItalic
cFromFontAttribute BoldItalic = Font -> CInt
cFromFont Font
helveticaBoldItalic

cToFontAttribute :: CInt -> Maybe FontAttribute
cToFontAttribute :: CInt -> Maybe FontAttribute
cToFontAttribute attributeCode :: CInt
attributeCode =
      case (CInt
attributeCode CInt -> Font -> Bool
`has` Font
helveticaBold, CInt
attributeCode CInt -> Font -> Bool
`has` Font
helveticaItalic) of
        (True,True) -> FontAttribute -> Maybe FontAttribute
forall a. a -> Maybe a
Just FontAttribute
BoldItalic
        (True,False) -> FontAttribute -> Maybe FontAttribute
forall a. a -> Maybe a
Just FontAttribute
Bold
        (False,True) -> FontAttribute -> Maybe FontAttribute
forall a. a -> Maybe a
Just FontAttribute
Italic
        (False,False) -> Maybe FontAttribute
forall a. Maybe a
Nothing
      where
        has :: CInt -> Font -> Bool
        has :: CInt -> Font -> Bool
has code :: CInt
code (Font f :: Int
f) = CInt
code CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
f) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0
helvetica :: Font
helvetica :: Font
helvetica = Int -> Font
Font 0
helveticaBold :: Font
helveticaBold :: Font
helveticaBold = Int -> Font
Font 1
helveticaItalic :: Font
helveticaItalic :: Font
helveticaItalic = Int -> Font
Font 2
helveticaBoldItalic :: Font
helveticaBoldItalic :: Font
helveticaBoldItalic = Int -> Font
Font 3
courier :: Font
courier :: Font
courier = Int -> Font
Font 4
courierBold :: Font
courierBold :: Font
courierBold = Int -> Font
Font 5
courierItalic :: Font
courierItalic :: Font
courierItalic = Int -> Font
Font 6
courierBoldItalic :: Font
courierBoldItalic :: Font
courierBoldItalic = Int -> Font
Font 7
times :: Font
times :: Font
times = Int -> Font
Font 8
timesBold :: Font
timesBold :: Font
timesBold = Int -> Font
Font 9
timesItalic :: Font
timesItalic :: Font
timesItalic = Int -> Font
Font 10
timesBoldItalic :: Font
timesBoldItalic :: Font
timesBoldItalic = Int -> Font
Font 11
symbol :: Font
symbol :: Font
symbol = Int -> Font
Font 12
screen :: Font
screen :: Font
screen = Int -> Font
Font 13
screenBold :: Font
screenBold :: Font
screenBold = Int -> Font
Font 14
zapfDingbats :: Font
zapfDingbats :: Font
zapfDingbats = Int -> Font
Font 15
freeFont :: Font
freeFont :: Font
freeFont = Int -> Font
Font 16

-- Colors

newtype Color = Color CUInt deriving (Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq,Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> ShowS
$cshowsPrec :: Int -> Color -> ShowS
Show,Eq Color
Eq Color =>
(Color -> Color -> Ordering)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Color)
-> (Color -> Color -> Color)
-> Ord Color
Color -> Color -> Bool
Color -> Color -> Ordering
Color -> Color -> Color
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Color -> Color -> Color
$cmin :: Color -> Color -> Color
max :: Color -> Color -> Color
$cmax :: Color -> Color -> Color
>= :: Color -> Color -> Bool
$c>= :: Color -> Color -> Bool
> :: Color -> Color -> Bool
$c> :: Color -> Color -> Bool
<= :: Color -> Color -> Bool
$c<= :: Color -> Color -> Bool
< :: Color -> Color -> Bool
$c< :: Color -> Color -> Bool
compare :: Color -> Color -> Ordering
$ccompare :: Color -> Color -> Ordering
$cp1Ord :: Eq Color
Ord)
foregroundColor :: Color
foregroundColor :: Color
foregroundColor = CUInt -> Color
Color 0
background2Color :: Color
background2Color :: Color
background2Color = CUInt -> Color
Color 7
inactiveColor :: Color
inactiveColor :: Color
inactiveColor = CUInt -> Color
Color 8
selectionColor :: Color
selectionColor :: Color
selectionColor = CUInt -> Color
Color 15
gray0Color :: Color
gray0Color :: Color
gray0Color = CUInt -> Color
Color 32
dark3Color :: Color
dark3Color :: Color
dark3Color = CUInt -> Color
Color 39
dark2Color :: Color
dark2Color :: Color
dark2Color = CUInt -> Color
Color 45
dark1Color :: Color
dark1Color :: Color
dark1Color = CUInt -> Color
Color 47
backgroundColor :: Color
backgroundColor :: Color
backgroundColor = CUInt -> Color
Color 49
light1Color :: Color
light1Color :: Color
light1Color = CUInt -> Color
Color 50
light2Color :: Color
light2Color :: Color
light2Color = CUInt -> Color
Color 52
light3Color :: Color
light3Color :: Color
light3Color = CUInt -> Color
Color 54
blackColor :: Color
blackColor :: Color
blackColor = CUInt -> Color
Color 56
redColor :: Color
redColor :: Color
redColor = CUInt -> Color
Color 88
greenColor :: Color
greenColor :: Color
greenColor = CUInt -> Color
Color 63
yellowColor :: Color
yellowColor :: Color
yellowColor = CUInt -> Color
Color 95
blueColor :: Color
blueColor :: Color
blueColor = CUInt -> Color
Color 216
magentaColor :: Color
magentaColor :: Color
magentaColor = CUInt -> Color
Color 248
cyanColor :: Color
cyanColor :: Color
cyanColor = CUInt -> Color
Color 223
darkRedColor :: Color
darkRedColor :: Color
darkRedColor = CUInt -> Color
Color 72
darkGreenColor :: Color
darkGreenColor :: Color
darkGreenColor = CUInt -> Color
Color 60
darkYellowColor :: Color
darkYellowColor :: Color
darkYellowColor = CUInt -> Color
Color 76
darkBlueColor :: Color
darkBlueColor :: Color
darkBlueColor = CUInt -> Color
Color 136
darkMagentaColor :: Color
darkMagentaColor :: Color
darkMagentaColor = CUInt -> Color
Color 152
darkCyanColor :: Color
darkCyanColor :: Color
darkCyanColor = CUInt -> Color
Color 140
whiteColor :: Color
whiteColor :: Color
whiteColor = CUInt -> Color
Color 255
freeColor :: Color
freeColor :: Color
freeColor = CUInt -> Color
Color 16
numFreeColor :: Color
numFreeColor :: Color
numFreeColor =CUInt -> Color
Color 16
grayRampColor :: Color
grayRampColor :: Color
grayRampColor = CUInt -> Color
Color 32
numGray:: Color
numGray :: Color
numGray= CUInt -> Color
Color 24
grayColor :: Color
grayColor :: Color
grayColor = Color
backgroundColor
colorCubeColor :: Color
colorCubeColor :: Color
colorCubeColor = CUInt -> Color
Color 56
numRed :: Color
numRed :: Color
numRed = CUInt -> Color
Color 5
numGreen :: Color
numGreen :: Color
numGreen = CUInt -> Color
Color 8
numBlue :: Color
numBlue :: Color
numBlue = CUInt -> Color
Color 5

-- Fl_LabelType

data Labeltype = NormalLabelType
               | NoLabelType
               | ShadowLabelType
               | EngravedLabelType
               | EmbossedLabelType
               | IconLabelType
               | MultiLabelType
               | ImageLabelType
               | FreeLabelType deriving (Labeltype -> Labeltype -> Bool
(Labeltype -> Labeltype -> Bool)
-> (Labeltype -> Labeltype -> Bool) -> Eq Labeltype
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Labeltype -> Labeltype -> Bool
$c/= :: Labeltype -> Labeltype -> Bool
== :: Labeltype -> Labeltype -> Bool
$c== :: Labeltype -> Labeltype -> Bool
Eq, Int -> Labeltype -> ShowS
[Labeltype] -> ShowS
Labeltype -> String
(Int -> Labeltype -> ShowS)
-> (Labeltype -> String)
-> ([Labeltype] -> ShowS)
-> Show Labeltype
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Labeltype] -> ShowS
$cshowList :: [Labeltype] -> ShowS
show :: Labeltype -> String
$cshow :: Labeltype -> String
showsPrec :: Int -> Labeltype -> ShowS
$cshowsPrec :: Int -> Labeltype -> ShowS
Show, Eq Labeltype
Eq Labeltype =>
(Labeltype -> Labeltype -> Ordering)
-> (Labeltype -> Labeltype -> Bool)
-> (Labeltype -> Labeltype -> Bool)
-> (Labeltype -> Labeltype -> Bool)
-> (Labeltype -> Labeltype -> Bool)
-> (Labeltype -> Labeltype -> Labeltype)
-> (Labeltype -> Labeltype -> Labeltype)
-> Ord Labeltype
Labeltype -> Labeltype -> Bool
Labeltype -> Labeltype -> Ordering
Labeltype -> Labeltype -> Labeltype
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Labeltype -> Labeltype -> Labeltype
$cmin :: Labeltype -> Labeltype -> Labeltype
max :: Labeltype -> Labeltype -> Labeltype
$cmax :: Labeltype -> Labeltype -> Labeltype
>= :: Labeltype -> Labeltype -> Bool
$c>= :: Labeltype -> Labeltype -> Bool
> :: Labeltype -> Labeltype -> Bool
$c> :: Labeltype -> Labeltype -> Bool
<= :: Labeltype -> Labeltype -> Bool
$c<= :: Labeltype -> Labeltype -> Bool
< :: Labeltype -> Labeltype -> Bool
$c< :: Labeltype -> Labeltype -> Bool
compare :: Labeltype -> Labeltype -> Ordering
$ccompare :: Labeltype -> Labeltype -> Ordering
$cp1Ord :: Eq Labeltype
Ord)

instance Enum Labeltype where
    fromEnum :: Labeltype -> Int
fromEnum NormalLabelType = 0
    fromEnum NoLabelType = 1
    fromEnum ShadowLabelType = Int
forall a. Num a => a
defineShadowLabel_
    fromEnum EngravedLabelType = Int
forall a. Num a => a
defineEngravedLabel_
    fromEnum EmbossedLabelType = Int
forall a. Num a => a
defineEmbossedLabel_
    fromEnum MultiLabelType = Int
forall a. Num a => a
defineMultiLabel_
    fromEnum ImageLabelType = Int
forall a. Num a => a
defineImageLabel_
    fromEnum IconLabelType = Int
forall a. Num a => a
defineIconLabel_
    fromEnum FreeLabelType = 8

    toEnum :: Int -> Labeltype
toEnum 0 = Labeltype
NormalLabelType
    toEnum 1 = Labeltype
NoLabelType
    toEnum x :: Int
x | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineShadowLabel_ = Labeltype
ShadowLabelType
             | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineEngravedLabel_ = Labeltype
EngravedLabelType
             | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineEmbossedLabel_ = Labeltype
EmbossedLabelType
             | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineMultiLabel_ = Labeltype
MultiLabelType
             | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineIconLabel_ = Labeltype
IconLabelType
             | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
defineImageLabel_ = Labeltype
ImageLabelType
    toEnum 8 = Labeltype
FreeLabelType
    toEnum otherwise :: Int
otherwise = String -> Labeltype
forall a. HasCallStack => String -> a
error ("LabelType.toEnum: Cannot match " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
otherwise)

symbolLabel :: Labeltype
symbolLabel :: Labeltype
symbolLabel = Labeltype
NormalLabelType

defineRoundUpBox_ :: (Num a) => a
defineRoundUpBox_ :: a
defineRoundUpBox_ =
    CInt -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> a) -> CInt -> a
forall a b. (a -> b) -> a -> b
$ (IO CInt -> CInt
forall a. IO a -> a
C2HSImp.unsafePerformIO IO CInt
fl_define_FL_ROUND_UP_BOXC)
{-# LINE 1018 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}


defineRoundUpBox :: Boxtype
defineRoundUpBox :: Boxtype
defineRoundUpBox =
    Int -> Boxtype
forall a. Enum a => Int -> a
toEnum Int
forall a. Num a => a
defineRoundUpBox_

defineShadowBox_ :: (Num a) => a
defineShadowBox_ :: a
defineShadowBox_ =
    CInt -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> a) -> CInt -> a
forall a b. (a -> b) -> a -> b
$ (IO CInt -> CInt
forall a. IO a -> a
C2HSImp.unsafePerformIO IO CInt
fl_define_FL_SHADOW_BOXC)
{-# LINE 1026 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}


defineShadowBox :: Boxtype
defineShadowBox :: Boxtype
defineShadowBox =
    Int -> Boxtype
forall a. Enum a => Int -> a
toEnum Int
forall a. Num a => a
defineShadowBox_

defineRoundedBox_ :: (Num a) => a
defineRoundedBox_ :: a
defineRoundedBox_ =
    CInt -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> a) -> CInt -> a
forall a b. (a -> b) -> a -> b
$ (IO CInt -> CInt
forall a. IO a -> a
C2HSImp.unsafePerformIO IO CInt
fl_define_FL_ROUNDED_BOXC)
{-# LINE 1034 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

defineRoundedBox :: Boxtype
defineRoundedBox :: Boxtype
defineRoundedBox = Int -> Boxtype
forall a. Enum a => Int -> a
toEnum Int
forall a. Num a => a
defineRoundedBox_

defineRflatBox_ :: (Num a) => a
defineRflatBox_ :: a
defineRflatBox_ =
    CInt -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> a) -> CInt -> a
forall a b. (a -> b) -> a -> b
$ (IO CInt -> CInt
forall a. IO a -> a
C2HSImp.unsafePerformIO IO CInt
fl_define_FL_RFLAT_BOXC)
{-# LINE 1040 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

defineRflatBox :: Boxtype
defineRflatBox :: Boxtype
defineRflatBox = Int -> Boxtype
forall a. Enum a => Int -> a
toEnum Int
forall a. Num a => a
defineRflatBox_

defineRshadowBox_ :: (Num a) => a
defineRshadowBox_ :: a
defineRshadowBox_ =
    CInt -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> a) -> CInt -> a
forall a b. (a -> b) -> a -> b
$ (IO CInt -> CInt
forall a. IO a -> a
C2HSImp.unsafePerformIO IO CInt
fl_define_FL_RSHADOW_BOXC)
{-# LINE 1046 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

defineRshadowBox :: Boxtype
defineRshadowBox :: Boxtype
defineRshadowBox = Int -> Boxtype
forall a. Enum a => Int -> a
toEnum Int
forall a. Num a => a
defineRshadowBox_

defineDiamondBox_ :: (Num a) => a
defineDiamondBox_ :: a
defineDiamondBox_ =
    CInt -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> a) -> CInt -> a
forall a b. (a -> b) -> a -> b
$ (IO CInt -> CInt
forall a. IO a -> a
C2HSImp.unsafePerformIO IO CInt
fl_define_FL_DIAMOND_BOXC)
{-# LINE 1052 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

defineDiamondBox :: Boxtype
defineDiamondBox :: Boxtype
defineDiamondBox = Int -> Boxtype
forall a. Enum a => Int -> a
toEnum Int
forall a. Num a => a
defineDiamondBox_

defineOvalBox_ :: (Num a) => a
defineOvalBox_ :: a
defineOvalBox_ =
    CInt -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> a) -> CInt -> a
forall a b. (a -> b) -> a -> b
$ (IO CInt -> CInt
forall a. IO a -> a
C2HSImp.unsafePerformIO IO CInt
fl_define_FL_OVAL_BOXC)
{-# LINE 1058 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

defineOvalBox :: Boxtype
defineOvalBox :: Boxtype
defineOvalBox = Int -> Boxtype
forall a. Enum a => Int -> a
toEnum Int
forall a. Num a => a
defineOvalBox_

definePlasticUpBox_ :: (Num a) => a
definePlasticUpBox_ :: a
definePlasticUpBox_ =
    CInt -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> a) -> CInt -> a
forall a b. (a -> b) -> a -> b
$ (IO CInt -> CInt
forall a. IO a -> a
C2HSImp.unsafePerformIO IO CInt
fl_define_FL_PLASTIC_UP_BOXC)
{-# LINE 1064 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

definePlasticUpBox :: Boxtype
definePlasticUpBox :: Boxtype
definePlasticUpBox = Int -> Boxtype
forall a. Enum a => Int -> a
toEnum Int
forall a. Num a => a
definePlasticUpBox_

defineGtkUpBox_ :: (Num a) => a
defineGtkUpBox_ :: a
defineGtkUpBox_ =
    CInt -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> a) -> CInt -> a
forall a b. (a -> b) -> a -> b
$ (IO CInt -> CInt
forall a. IO a -> a
C2HSImp.unsafePerformIO IO CInt
fl_define_FL_GTK_UP_BOXC)
{-# LINE 1070 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

defineGtkUpBox :: Boxtype
defineGtkUpBox :: Boxtype
defineGtkUpBox = Int -> Boxtype
forall a. Enum a => Int -> a
toEnum Int
forall a. Num a => a
defineGtkUpBox_

defineGleamUpBox_ :: (Num a ) => a
defineGleamUpBox_ :: a
defineGleamUpBox_ =
  CInt -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> a) -> CInt -> a
forall a b. (a -> b) -> a -> b
$ (IO CInt -> CInt
forall a. IO a -> a
C2HSImp.unsafePerformIO IO CInt
fl_define_FL_GLEAM_UP_BOXC)
{-# LINE 1076 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}


defineShadowLabel_ :: (Num a) => a
defineShadowLabel_ :: a
defineShadowLabel_ =
   CInt -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> a) -> CInt -> a
forall a b. (a -> b) -> a -> b
$ (IO CInt -> CInt
forall a. IO a -> a
C2HSImp.unsafePerformIO IO CInt
fl_define_FL_SHADOW_LABELC)
{-# LINE 1080 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

defineShadowLabel :: Labeltype
defineShadowLabel :: Labeltype
defineShadowLabel = Int -> Labeltype
forall a. Enum a => Int -> a
toEnum Int
forall a. Num a => a
defineShadowLabel_

defineEngravedLabel_ :: (Num a) => a
defineEngravedLabel_ :: a
defineEngravedLabel_ =
   CInt -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> a) -> CInt -> a
forall a b. (a -> b) -> a -> b
$ (IO CInt -> CInt
forall a. IO a -> a
C2HSImp.unsafePerformIO IO CInt
fl_define_FL_ENGRAVED_LABELC)
{-# LINE 1086 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}


defineEngravedLabel :: Labeltype
defineEngravedLabel :: Labeltype
defineEngravedLabel = Int -> Labeltype
forall a. Enum a => Int -> a
toEnum Int
forall a. Num a => a
defineEngravedLabel_

defineEmbossedLabel_ :: (Num a) => a
defineEmbossedLabel_ :: a
defineEmbossedLabel_ =
   CInt -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> a) -> CInt -> a
forall a b. (a -> b) -> a -> b
$ (IO CInt -> CInt
forall a. IO a -> a
C2HSImp.unsafePerformIO IO CInt
fl_define_FL_EMBOSSED_LABELC)
{-# LINE 1093 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}


defineEmbossedLabel :: Labeltype
defineEmbossedLabel :: Labeltype
defineEmbossedLabel = Int -> Labeltype
forall a. Enum a => Int -> a
toEnum Int
forall a. Num a => a
defineEmbossedLabel_

defineIconLabel_ :: (Num a) => a
defineIconLabel_ :: a
defineIconLabel_ =
   CInt -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> a) -> CInt -> a
forall a b. (a -> b) -> a -> b
$ (IO CInt -> CInt
forall a. IO a -> a
C2HSImp.unsafePerformIO IO CInt
fl_define_FL_ICON_LABELC)
{-# LINE 1100 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}


defineIconLabel :: Labeltype
defineIconLabel :: Labeltype
defineIconLabel = Int -> Labeltype
forall a. Enum a => Int -> a
toEnum Int
forall a. Num a => a
defineIconLabel_

defineMultiLabel_ :: (Num a) => a
defineMultiLabel_ :: a
defineMultiLabel_ =
   CInt -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> a) -> CInt -> a
forall a b. (a -> b) -> a -> b
$ (IO CInt -> CInt
forall a. IO a -> a
C2HSImp.unsafePerformIO IO CInt
fl_define_FL_MULTI_LABELC)
{-# LINE 1107 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}


defineMultiLabel :: Labeltype
defineMultiLabel :: Labeltype
defineMultiLabel = Int -> Labeltype
forall a. Enum a => Int -> a
toEnum Int
forall a. Num a => a
defineMultiLabel_

defineImageLabel_ :: (Num a) => a
defineImageLabel_ :: a
defineImageLabel_ =
   CInt -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> a) -> CInt -> a
forall a b. (a -> b) -> a -> b
$ (IO CInt -> CInt
forall a. IO a -> a
C2HSImp.unsafePerformIO IO CInt
fl_define_FL_IMAGE_LABELC)
{-# LINE 1114 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}


defineImageLabel :: Labeltype
defineImageLabel :: Labeltype
defineImageLabel = Int -> Labeltype
forall a. Enum a => Int -> a
toEnum Int
forall a. Num a => a
defineImageLabel_

cFromColor :: Color -> CUInt
cFromColor :: Color -> CUInt
cFromColor (Color c :: CUInt
c) = CUInt -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
c
cToColor :: CUInt-> Color
cToColor :: CUInt -> Color
cToColor c :: CUInt
c = CUInt -> Color
Color (CUInt -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
c)

type RGB = (CUChar, CUChar, CUChar)

inactive :: (Color) -> (Color)
inactive :: Color -> Color
inactive a1 :: Color
a1 =
  IO Color -> Color
forall a. IO a -> a
C2HSImp.unsafePerformIO (IO Color -> Color) -> IO Color -> Color
forall a b. (a -> b) -> a -> b
$
  let {a1' :: CUInt
a1' = Color -> CUInt
cFromColor Color
a1} in 
  CUInt -> IO CUInt
inactive'_ CUInt
a1' IO CUInt -> (CUInt -> IO Color) -> IO Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CUInt
res ->
  let {res' :: Color
res' = CUInt -> Color
cToColor CUInt
res} in
  return (res')

{-# LINE 1127 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

contrast :: (Color) -> (Color) -> (Color)
contrast a1 a2 =
  C2HSImp.unsafePerformIO $
  let {a1' = cFromColor a1} in 
  let {a2' = cFromColor a2} in 
  contrast'_ a1' a2' >>= \res ->
  let {res' = cToColor res} in
  return (res')

{-# LINE 1130 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

colorAverage :: (Color) -> (Color) -> (Double) -> (Color)
colorAverage a1 a2 a3 =
  C2HSImp.unsafePerformIO $
  let {a1' = cFromColor a1} in 
  let {a2' = cFromColor a2} in 
  let {a3' = realToFrac a3} in 
  colorAverage'_ a1' a2' a3' >>= \res ->
  let {res' = cToColor res(IO Color -> Color) -> IO Color -> Color
forall a b. (a -> b) -> a -> b
} in
  return (res')

{-# LINE 1135 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

lighter :: (Color) -> (Color)
lighter a1 =
  IO Color -> Color
forall a. IO a -> a
C2HSImp.unsafePerformIO (IO Color -> Color) -> IO Color -> Color
forall a b. (a -> b) -> a -> b
$
  let {a1' :: CUInt
a1' = Color -> CUInt
cFromColor Color
a1} in 
  CUInt -> IO CUInt
lighter'_ CUInt
a1' IO CUInt -> (CUInt -> IO Color) -> IO Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res ->
  let {res' = cToColor res} in
  return (res')

{-# LINE 1137 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

darker :: (Color) -> (Color)
darker a1 =
  C2HSImp.unsafePerformIO $
  let {a1' = cFromColor a1} in 
  darker'_ a1' >>= \res ->
  let {res' = cToColor res} in
  return (res')

{-# LINE 1139 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

rgbColorWithRgb' :: (CUChar) -> (CUChar) -> (CUChar) -> IO ((CUInt))
rgbColorWithRgb' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  rgbColorWithRgb''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 1144 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

rgbColorWithRgb :: RGB -> IO Color
rgbColorWithRgb (r,g,b) = rgbColorWithRgb' r g b >>= return . Color

rgbColorWithGrayscale :: (Char) -> (Color)
rgbColorWithGrayscale a1 =
  C2HSImp.unsafePerformIO $
  let {a1' = castCharToCUChar a1} in 
  rgbColorWithGrayscale'_ a1' >>= \res ->
  let {res' = cToColor res} in
  return (res')

{-# LINE 1150 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

grayRamp :: (Int) -> (Color)
grayRamp a1 =
  C2HSImp.unsafePerformIO $
  let {a1' = fromIntegral a1} in 
  grayRamp'_ a1' >>= \res ->
  let {res' = cToColor res} in
  return (res')

{-# LINE 1151 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}

colorCube :: (Int) -> (Int) -> (Int) -> (Color)
colorCube a1 a2 a3 =
  C2HSImp.unsafePerformIO $
  let {a1' = fromIntegral a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  colorCube'_ a1' a2' a3' >>= \res ->
  let {res' = cToColor res} in
  return (res')

{-# LINE 1153 "src/Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs" #-}


foreign import ccall unsafe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_define_FL_ROUND_UP_BOXC"
  fl_define_FL_ROUND_UP_BOXC :: (IO C2HSImp.CInt)

foreign import ccall unsafe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_define_FL_SHADOW_BOXC"
  fl_define_FL_SHADOW_BOXC :: (IO C2HSImp.CInt)

foreign import ccall unsafe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_define_FL_ROUNDED_BOXC"
  fl_define_FL_ROUNDED_BOXC :: (IO C2HSImp.CInt)

foreign import ccall unsafe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_define_FL_RFLAT_BOXC"
  fl_define_FL_RFLAT_BOXC :: (IO C2HSImp.CInt)

foreign import ccall unsafe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_define_FL_RSHADOW_BOXC"
  fl_define_FL_RSHADOW_BOXC :: (IO C2HSImp.CInt)

foreign import ccall unsafe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_define_FL_DIAMOND_BOXC"
  fl_define_FL_DIAMOND_BOXC :: (IO C2HSImp.CInt)

foreign import ccall unsafe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_define_FL_OVAL_BOXC"
  fl_define_FL_OVAL_BOXC :: (IO C2HSImp.CInt)

foreign import ccall unsafe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_define_FL_PLASTIC_UP_BOXC"
  fl_define_FL_PLASTIC_UP_BOXC :: (IO C2HSImp.CInt)

foreign import ccall unsafe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_define_FL_GTK_UP_BOXC"
  fl_define_FL_GTK_UP_BOXC :: (IO C2HSImp.CInt)

foreign import ccall unsafe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_define_FL_GLEAM_UP_BOXC"
  fl_define_FL_GLEAM_UP_BOXC :: (IO C2HSImp.CInt)

foreign import ccall unsafe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_define_FL_SHADOW_LABELC"
  fl_define_FL_SHADOW_LABELC :: (IO C2HSImp.CInt)

foreign import ccall unsafe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_define_FL_ENGRAVED_LABELC"
  fl_define_FL_ENGRAVED_LABELC :: (IO C2HSImp.CInt)

foreign import ccall unsafe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_define_FL_EMBOSSED_LABELC"
  fl_define_FL_EMBOSSED_LABELC :: (IO C2HSImp.CInt)

foreign import ccall unsafe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_define_FL_ICON_LABELC"
  fl_define_FL_ICON_LABELC :: (IO C2HSImp.CInt)

foreign import ccall unsafe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_define_FL_MULTI_LABELC"
  fl_define_FL_MULTI_LABELC :: (IO C2HSImp.CInt)

foreign import ccall unsafe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_define_FL_IMAGE_LABELC"
  fl_define_FL_IMAGE_LABELC :: (IO C2HSImp.CInt)

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_inactiveC"
  inactive'_ :: (C2HSImp.CUInt -> (IO C2HSImp.CUInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_contrastC"
  contrast'_ :: (C2HSImp.CUInt -> (C2HSImp.CUInt -> (IO C2HSImp.CUInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_color_averageC"
  colorAverage'_ :: (C2HSImp.CUInt -> (C2HSImp.CUInt -> (C2HSImp.CFloat -> (IO C2HSImp.CUInt))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_lighterC"
  lighter'_ :: (C2HSImp.CUInt -> (IO C2HSImp.CUInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_darkerC"
  darker'_ :: (C2HSImp.CUInt -> (IO C2HSImp.CUInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_rgb_color_with_rgbC"
  rgbColorWithRgb''_ :: (C2HSImp.CUChar -> (C2HSImp.CUChar -> (C2HSImp.CUChar -> (IO C2HSImp.CUInt))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_rgb_color_with_grayscaleC"
  rgbColorWithGrayscale'_ :: (C2HSImp.CUChar -> (IO C2HSImp.CUInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_gray_rampC"
  grayRamp'_ :: (C2HSImp.CInt -> (IO C2HSImp.CUInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Fl_Enumerations.chs.h fl_color_cubeC"
  colorCube'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CUInt))))