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

-- | Higher level wrapper around KeycapsC.
module Ui.Keycaps where
import qualified Data.Map as Map

import qualified Util.Rect as Rect
import qualified Ui.Color as Color
import qualified Ui.Key as Key
import qualified Ui.KeycapsT as KeycapsT

import           Global


mac_labels :: Map Key.Key Rect.Rect
mac_labels :: Map Key Rect
mac_labels = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Key, Rect)]]
label_rects forall a. [a] -> [a] -> [a]
++ [(Key, Rect)]
arrows
    where
    label_rects :: [[(Key, Rect)]]
label_rects = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a}. Int -> [(Int, a)] -> [(a, Rect)]
mkrow [Int]
ys [[(Int, Key)]]
qwerty_rows
    qwerty_rows :: [[(Int, Key)]]
qwerty_rows =
        [ [Char] -> [(Int, Key)]
cs [Char]
"`1234567890-=" forall a. [a] -> [a] -> [a]
++ [(Int
30, Key
Key.Delete)]
        , (Int
30, Key
Key.Tab) forall a. a -> [a] -> [a]
: [Char] -> [(Int, Key)]
cs [Char]
"qwertyuiop[]\\"
        , (Int
37, Key
Key.KCapsLock) forall a. a -> [a] -> [a]
: [Char] -> [(Int, Key)]
cs [Char]
"asdfghjkl;'" forall a. [a] -> [a] -> [a]
++ [(Int
37, Key
Key.Enter)]
        , (Int
50, Key
Key.ShiftL) forall a. a -> [a] -> [a]
: [Char] -> [(Int, Key)]
cs [Char]
"zxcvbnm,./" forall a. [a] -> [a] -> [a]
++ [(Int
49, Key
Key.ShiftR)]
        , forall a b. (a -> b) -> [a] -> [b]
map (Int
w,) [Key
Key.Function, Key
Key.ControlL, Key
Key.AltL] forall a. [a] -> [a] -> [a]
++
            [ (Int
26, Key
Key.MetaL), (Int
115, Char -> Key
Key.Char Char
' '), (Int
26, Key
Key.MetaR)
            , (Int
w, Key
Key.AltR)
            ]
        ]
        where cs :: [Char] -> [(Int, Key)]
cs = forall a b. (a -> b) -> [a] -> [b]
map ((Int
w,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Key
Key.Char)
    arrows :: [(Key, Rect)]
arrows =
        [ (Key
Key.Left, Int -> Int -> Int -> Int -> Rect
Rect.xywh (Int -> Int
xn Int
0) Int
y2 Int
w Int
h2)
        , (Key
Key.Up, Int -> Int -> Int -> Int -> Rect
Rect.xywh (Int -> Int
xn Int
1) Int
ly Int
w Int
h2)
        , (Key
Key.Down, Int -> Int -> Int -> Int -> Rect
Rect.xywh (Int -> Int
xn Int
1) Int
y2 Int
w Int
h2)
        , (Key
Key.Right, Int -> Int -> Int -> Int -> Rect
Rect.xywh (Int -> Int
xn Int
2) Int
y2 Int
w Int
h2)
        ]
        where
        xn :: Int -> Int
xn Int
n = Int
lx forall a. Num a => a -> a -> a
+ Int
gap forall a. Num a => a -> a -> a
+ (Int
wforall a. Num a => a -> a -> a
+Int
gap) forall a. Num a => a -> a -> a
* Int
n
        y2 :: Int
y2 = Int
ly forall a. Num a => a -> a -> a
+ Int
h2
    (Int
lx, Int
ly) =
        ( forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Rect -> Int
Rect.r forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall a. [a] -> a
last [[(Key, Rect)]]
label_rects)
        , Rect -> Int
Rect.y forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [[(Key, Rect)]]
label_rects
        )
    mkrow :: Int -> [(Int, a)] -> [(a, Rect)]
mkrow Int
y [(Int, a)]
row =
        [ (a
key, Int -> Int -> Int -> Int -> Rect
Rect.xywh Int
x Int
y Int
w Int
h)
        | (Int
x, (Int
w, a
key)) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
xs [(Int, a)]
row
        ]
        where xs :: [Int]
xs = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (forall a. Num a => a -> a -> a
(+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+Int
gap)) Int
gap (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Int, a)]
row)
    ys :: [Int]
ys = forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
+ (Int
hforall a. Num a => a -> a -> a
+Int
gap)) Int
gap
    w :: Int
w = Int
20
    h :: Int
h = Int
20
    h2 :: Int
h2 = Int
h forall a. Integral a => a -> a -> a
`div` Int
2
    gap :: Int
gap = Int
5

make_layout :: Map Key.Key Rect.Rect -> KeycapsT.Layout
make_layout :: Map Key Rect -> Layout
make_layout Map Key Rect
labels = KeycapsT.Layout
    { lt_size :: (Int, Int)
lt_size = (Int
w, Int
h)
    , lt_bg_color :: Color
lt_bg_color = Color
Color.white
    , lt_keycap_color :: Color
lt_keycap_color = Color
Color.gray8
    , lt_highlight_color :: Color
lt_highlight_color = Double -> Double -> Double -> Color
Color.rgb Double
0.85 Double
0.85 Double
1
    , lt_label_color :: Color
lt_label_color = Color
Color.gray5
    , lt_binding_color :: Color
lt_binding_color = Color
Color.black
    , lt_labels :: Map Keycap Rect
lt_labels = forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys Key -> Keycap
Key.to_mac_label Map Key Rect
labels
    }
    where
    w :: Int
w = Int
5 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Rect -> Int
Rect.r (forall k a. Map k a -> [a]
Map.elems Map Key Rect
labels))
    h :: Int
h = Int
5 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Rect -> Int
Rect.b (forall k a. Map k a -> [a]
Map.elems Map Key Rect
labels))

resolve_bindings :: KeycapsT.Layout -> KeycapsT.Bindings -> KeycapsT.RawBindings
resolve_bindings :: Layout -> Bindings -> RawBindings
resolve_bindings Layout
layout Bindings
bindings =
    [RawBinding] -> RawBindings
KeycapsT.RawBindings forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Keycap, Rect) -> RawBinding
make forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toAscList forall a b. (a -> b) -> a -> b
$ Layout -> Map Keycap Rect
KeycapsT.lt_labels Layout
layout
    where
    make :: (Keycap, Rect) -> RawBinding
make (Keycap
label, Rect
rect) =
        (Int, Int) -> Binding -> RawBinding
KeycapsT.RawBinding (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a. Num a => a -> a -> a
+Int
offset) (Rect -> (Int, Int)
Rect.upper_left Rect
rect)) forall a b. (a -> b) -> a -> b
$
            forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Binding
KeycapsT.no_binding Keycap
label Bindings
bindings
        where
        offset :: Int
offset
            | Keycap
label forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map Key -> Keycap
Key.to_mac_label [Key]
arrows = Int
5
            | Bool
otherwise = Int
15
    arrows :: [Key]
arrows = [Key
Key.Left, Key
Key.Up, Key
Key.Down, Key
Key.Right]