-- Copyright 2020 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

-- | Types used by "Ui.KeycapsC".  It's a separate module to avoid the FFI
-- dependency when possible.
module Ui.KeycapsT where
import qualified Util.Rect as Rect
import qualified Ui.Color as Color

import           Global


data Layout = Layout {
    Layout -> (Int, Int)
lt_size :: (Int, Int) -- ^ width and height for the window
    , Layout -> Color
lt_bg_color :: Color.Color
    , Layout -> Color
lt_keycap_color :: Color.Color
    , Layout -> Color
lt_highlight_color :: Color.Color
    , Layout -> Color
lt_label_color :: Color.Color
    , Layout -> Color
lt_binding_color :: Color.Color
    , Layout -> Map KeyDoc Rect
lt_labels :: Map Keycap Rect.Rect
    } deriving (Int -> Layout -> ShowS
[Layout] -> ShowS
Layout -> String
(Int -> Layout -> ShowS)
-> (Layout -> String) -> ([Layout] -> ShowS) -> Show Layout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Layout] -> ShowS
$cshowList :: [Layout] -> ShowS
show :: Layout -> String
$cshow :: Layout -> String
showsPrec :: Int -> Layout -> ShowS
$cshowsPrec :: Int -> Layout -> ShowS
Show)

type Keycap = Text
-- | Binding text that shows up on the keycap.
type KeyDoc = Text
-- | Longer binding text that shows up on mouseover.
type Doc = Text

type Bindings = Map Keycap Binding

data Binding = Binding {
    Binding -> Maybe Color
b_color :: Maybe Color.Color
    , Binding -> KeyDoc
b_text :: KeyDoc
    , Binding -> KeyDoc
b_doc :: Doc
    } deriving (Int -> Binding -> ShowS
[Binding] -> ShowS
Binding -> String
(Int -> Binding -> ShowS)
-> (Binding -> String) -> ([Binding] -> ShowS) -> Show Binding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Binding] -> ShowS
$cshowList :: [Binding] -> ShowS
show :: Binding -> String
$cshow :: Binding -> String
showsPrec :: Int -> Binding -> ShowS
$cshowsPrec :: Int -> Binding -> ShowS
Show)

instance Pretty Binding where
    pretty :: Binding -> KeyDoc
pretty (Binding Maybe Color
mb_color KeyDoc
text KeyDoc
doc) =
        KeyDoc
text KeyDoc -> KeyDoc -> KeyDoc
forall a. Semigroup a => a -> a -> a
<> KeyDoc
"(" KeyDoc -> KeyDoc -> KeyDoc
forall a. Semigroup a => a -> a -> a
<> KeyDoc
doc KeyDoc -> KeyDoc -> KeyDoc
forall a. Semigroup a => a -> a -> a
<> KeyDoc
")[" KeyDoc -> KeyDoc -> KeyDoc
forall a. Semigroup a => a -> a -> a
<> Maybe Color -> KeyDoc
forall a. Pretty a => a -> KeyDoc
pretty Maybe Color
mb_color KeyDoc -> KeyDoc -> KeyDoc
forall a. Semigroup a => a -> a -> a
<> KeyDoc
"]"

-- | Since Bindings have to have the same indices of 'lt_labels', I need dummy
-- ones to fill out the array.
no_binding :: Binding
no_binding :: Binding
no_binding = Binding
    { b_color :: Maybe Color
b_color = Maybe Color
forall a. Maybe a
Nothing
    , b_text :: KeyDoc
b_text = KeyDoc
""
    , b_doc :: KeyDoc
b_doc = KeyDoc
""
    }

-- | Low level type, for sending to fltk.
newtype RawBindings = RawBindings [RawBinding]
    deriving (Int -> RawBindings -> ShowS
[RawBindings] -> ShowS
RawBindings -> String
(Int -> RawBindings -> ShowS)
-> (RawBindings -> String)
-> ([RawBindings] -> ShowS)
-> Show RawBindings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawBindings] -> ShowS
$cshowList :: [RawBindings] -> ShowS
show :: RawBindings -> String
$cshow :: RawBindings -> String
showsPrec :: Int -> RawBindings -> ShowS
$cshowsPrec :: Int -> RawBindings -> ShowS
Show)
data RawBinding = RawBinding Rect.Point Binding
    deriving (Int -> RawBinding -> ShowS
[RawBinding] -> ShowS
RawBinding -> String
(Int -> RawBinding -> ShowS)
-> (RawBinding -> String)
-> ([RawBinding] -> ShowS)
-> Show RawBinding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawBinding] -> ShowS
$cshowList :: [RawBinding] -> ShowS
show :: RawBinding -> String
$cshow :: RawBinding -> String
showsPrec :: Int -> RawBinding -> ShowS
$cshowsPrec :: Int -> RawBinding -> ShowS
Show)

-- | Phantom type for ptr to the window object.
data CWindow