{-# OPTIONS_GHC -optc-D_LARGEFILE_SOURCE #-}
{-# OPTIONS_GHC -optc-D_LARGEFILE64_SOURCE #-}
{-# OPTIONS_GHC -optc-D_THREAD_SAFE #-}
{-# OPTIONS_GHC -optc-D_REENTRANT #-}
{-# OPTIONS_GHC -optc-DBUILD_DIR="build/debug" #-}
{-# OPTIONS_GHC -optc-DGHC_VERSION=90202 #-}
{-# OPTIONS_GHC -optc-D__APPLE__ #-}
{-# LINE 1 "Ui/Key.hsc" #-}
-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

module Ui.Key (
    Key(..), Modifier(..)
    , to_label, to_mac_label, show_mac_mod
    , decode_key, decode_modifiers
) where
import Prelude hiding (Char, Left, Right)
import Data.Bits ((.&.))
import qualified Data.Char as Char
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified System.Info

import           Foreign.C
import           Global

-- Actually I just need FL/Fl_Enumerations.H



-- | A keystroke.  For 'Char', this is always the unshifted version.  So
-- assuming that , and < live on the same keycap, you will will see
-- Shift + Char \',\', not Char \'<\'.
data Key = Char Char.Char
    | Escape | Backspace | Tab | Enter | Print | KScrollLock
    | Pause | Insert | Home | PageUp | Delete | End | PageDown
    | Left | Up | Right | Down
    | ShiftL | ShiftR | ControlL | ControlR | KCapsLock | AltL | AltR
    | MetaL | MetaR | Menu | KNumLock | KPEnter
    | Keypad Char.Char
    | Function -- fn key on macbook
    | Unknown Int
    deriving (Eq, Ord, Read, Show)

data Modifier = Shift | CapsLock | Control | Alt | NumLock | Meta | ScrollLock
    deriving (Eq, Ord, Read, Show)

instance Pretty Key where
    pretty (Char ' ') = "␣" -- unicode space symbol
    pretty (Char c) = Text.singleton c
    pretty key = Text.toLower $ showt key

instance Pretty Modifier where pretty = showt

to_label :: Key -> Text
to_label = \case
    Char ' ' -> "space"
    Char char -> Text.singleton char
    ControlL -> "ctl"
    ControlR -> "ctlr"
    Keypad char -> "kp-" <> Text.singleton char
    Unknown n -> "?" <> showt n
    Escape -> "esc"
    Delete -> "del"
    Function -> "fn"
    KCapsLock -> "caps"
    Left -> "←"
    Up -> "↑"
    Down -> "↓"
    Right -> "→"
    key -> Text.toLower (showt key)

to_mac_label :: Key -> Text
to_mac_label = \case
    AltL -> "optl"
    AltR -> "optr"
    MetaL -> "cmdl"
    MetaR -> "cmdr"
    Backspace -> "del"
    key -> to_label key

show_mac_mod :: Modifier -> Text
show_mac_mod = \case
    Alt -> "opt"
    Meta -> "cmd"
    mod -> txt $ map Char.toLower $ show mod

decode_key :: CInt -> Key
decode_key code
    | code /= (65421)
{-# LINE 84 "Ui/Key.hsc" #-}
        && (65408) < code && code <= (65469)
{-# LINE 85 "Ui/Key.hsc" #-}
            = Keypad (toEnum (fromIntegral (code - (65408))))
{-# LINE 86 "Ui/Key.hsc" #-}
    | code <= 127 = Char (unshift (toEnum (fromIntegral code)))
    | otherwise = case code of
        (65307) -> Escape
{-# LINE 89 "Ui/Key.hsc" #-}
        (65288) -> Backspace
{-# LINE 90 "Ui/Key.hsc" #-}
        (65289) -> Tab
{-# LINE 91 "Ui/Key.hsc" #-}
        (65293) -> Enter
{-# LINE 92 "Ui/Key.hsc" #-}
        (65377) -> Print
{-# LINE 93 "Ui/Key.hsc" #-}
        (65300) -> KScrollLock
{-# LINE 94 "Ui/Key.hsc" #-}
        (65299) -> Pause
{-# LINE 95 "Ui/Key.hsc" #-}
        (65379) -> Insert
{-# LINE 96 "Ui/Key.hsc" #-}
        (65360) -> Home
{-# LINE 97 "Ui/Key.hsc" #-}
        (65365) -> PageUp
{-# LINE 98 "Ui/Key.hsc" #-}
        (65535) -> Delete
{-# LINE 99 "Ui/Key.hsc" #-}
        (65367) -> End
{-# LINE 100 "Ui/Key.hsc" #-}
        (65366) -> PageDown
{-# LINE 101 "Ui/Key.hsc" #-}
        (65361) -> Left
{-# LINE 102 "Ui/Key.hsc" #-}
        (65362) -> Up
{-# LINE 103 "Ui/Key.hsc" #-}
        (65363) -> Right
{-# LINE 104 "Ui/Key.hsc" #-}
        (65364) -> Down
{-# LINE 105 "Ui/Key.hsc" #-}
        (65505) -> ShiftL
{-# LINE 106 "Ui/Key.hsc" #-}
        (65506) -> ShiftR
{-# LINE 107 "Ui/Key.hsc" #-}
        (65507) -> ControlL
{-# LINE 108 "Ui/Key.hsc" #-}
        (65508) -> ControlR
{-# LINE 109 "Ui/Key.hsc" #-}
        (65509) -> KCapsLock
{-# LINE 110 "Ui/Key.hsc" #-}
        (65513) -> AltL
{-# LINE 111 "Ui/Key.hsc" #-}
        (65514) -> AltR
{-# LINE 112 "Ui/Key.hsc" #-}
        (65511) -> MetaL
{-# LINE 113 "Ui/Key.hsc" #-}
        (65512) -> MetaR
{-# LINE 114 "Ui/Key.hsc" #-}
        (65383) -> Menu
{-# LINE 115 "Ui/Key.hsc" #-}
        (65407) -> KNumLock
{-# LINE 116 "Ui/Key.hsc" #-}
        (65421) -> KPEnter
{-# LINE 117 "Ui/Key.hsc" #-}
        _ -> Unknown (fromIntegral code)

decode_modifiers :: CInt -> [Modifier]
decode_modifiers code = foldr f [] pairs
    where
    f (bit, mod) mods
        | bit .&. code /= 0 = mod : mods
        | otherwise = mods
    pairs =
        [ ((65536), Shift)
{-# LINE 127 "Ui/Key.hsc" #-}
        , ((131072), CapsLock)
{-# LINE 128 "Ui/Key.hsc" #-}
        , ((262144), Control)
{-# LINE 129 "Ui/Key.hsc" #-}
        , ((524288), Alt)
{-# LINE 130 "Ui/Key.hsc" #-}
        , ((1048576), NumLock)
{-# LINE 131 "Ui/Key.hsc" #-}
        , ((4194304), Meta)
{-# LINE 132 "Ui/Key.hsc" #-}
        , ((8388608), ScrollLock)
{-# LINE 133 "Ui/Key.hsc" #-}
        ]

unshift :: Char.Char -> Char.Char
unshift = case System.Info.os of
    "darwin" -> \c -> Map.findWithDefault c c unshifted_osx_usa
    _ -> id

-- | Map a shifted symbol back to its unshifted variant for a US key layout.
-- This is because fltk has a bug on OS X that makes shifted symbols emit the
-- key text, rather than the keycap.
unshifted_osx_usa :: Map.Map Char.Char Char.Char
unshifted_osx_usa = Map.fromList
    [ ('~', '`'), ('_', '-'), ('+', '=')
    , ('{', '['), ('}', ']'), ('|', '\\')
    , (':', ';'), ('"', '\'')
    , ('<', ','), ('>', '.'), ('?', '/')
    ]