{-# 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=90205 #-}
{-# OPTIONS_GHC -optc-D__APPLE__ #-}
{-# LINE 1 "Ui/KeycapsC.hsc" #-}
-- 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

{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
-- | Low level fltk binding for drawing the keycaps.
module Ui.KeycapsC (create, destroy, update) where
#ifdef STUB_OUT_FLTK
import           Ui.KeycapsCStub
#else
import qualified Data.Map as Map
import qualified Util.FFI as FFI
import qualified Util.Rect as Rect

import qualified Ui.Color as Color
import qualified Ui.Fltk as Fltk
import qualified Ui.PtrMap as PtrMap

import           Global
import           ForeignC
import           Ui.KeycapsT




-- | The PtrMap only has room for a single keycaps window, so will destroy
-- any existing window.
create :: (Int, Int) -> Layout -> Fltk.Fltk ()
create (x, y) layout = Fltk.fltk $ do
    destroy_
    layoutp <- FFI.new layout -- The widget will take ownership.
    win <- c_create (i x) (i y) (i w) (i h) layoutp
    PtrMap.set_keycaps $ Just win
    where
    (w, h) = lt_size layout
    i = FFI.c_int

-- KeycapsWindow *keycaps_create(
--     int x, int y, int w, int h, const Keycaps::Layout *layout);
foreign import ccall "keycaps_create"
    c_create :: CInt -> CInt -> CInt -> CInt -> Ptr Layout -> IO (Ptr CWindow)

destroy :: Fltk.Fltk ()
destroy = Fltk.fltk destroy_

destroy_ :: IO ()
destroy_ = whenJustM PtrMap.lookup_keycaps $ \win -> do
    c_destroy win
    PtrMap.set_keycaps Nothing

foreign import ccall "keycaps_destroy" c_destroy :: Ptr CWindow -> IO ()

update :: RawBindings -> Fltk.Fltk ()
update (RawBindings bindings) = Fltk.fltk $
    whenJustM PtrMap.lookup_keycaps $ \win -> do
        withArrayLen bindings $ \bindings_len bindingsp ->
            c_update win bindingsp (FFI.c_int bindings_len)

-- void keycaps_update(
--     KeycapsWindow *window, const Keycaps::Binding *bindings,
--     int bindings_len);
foreign import ccall "keycaps_update"
    c_update :: Ptr CWindow -> Ptr RawBinding -> CInt -> IO ()


-- * instances

{-
    struct Layout {
        Color bg_color;
        Color keycap_color; // Base keycap color.
        Color highlight_color; // Change keycap color on mouse over.
        Color label_color; // Color of labels_texts.
        Color binding_color; // Color of Binding::text.

        IRect *rects;
        int rects_len;

        IPoint *labels_points;
        const char **labels_texts;
        int labels_len;
    }
-}
instance CStorable Layout where
    sizeOf _ = (64)
{-# LINE 87 "Ui/KeycapsC.hsc" #-}
    alignment _ = alignment nullPtr
    poke p (Layout
            { lt_bg_color, lt_keycap_color, lt_highlight_color
            , lt_label_color, lt_binding_color
            , lt_labels
            }) = do
        let rects = Map.elems lt_labels
            labels = Map.keys lt_labels
            points =
                [ (x + fst label_offset, y + snd label_offset)
                | (x, y) <- map Rect.upper_left rects
                ]
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p lt_bg_color
{-# LINE 100 "Ui/KeycapsC.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p lt_keycap_color
{-# LINE 101 "Ui/KeycapsC.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p lt_highlight_color
{-# LINE 102 "Ui/KeycapsC.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) p lt_label_color
{-# LINE 103 "Ui/KeycapsC.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) p lt_binding_color
{-# LINE 104 "Ui/KeycapsC.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) p =<< newArray rects
{-# LINE 105 "Ui/KeycapsC.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) p $ FFI.c_int (Map.size lt_labels)
{-# LINE 106 "Ui/KeycapsC.hsc" #-}
        labelps <- mapM FFI.newCStringNull0 labels
        ((\hsc_ptr -> pokeByteOff hsc_ptr 40)) p =<< newArray points
{-# LINE 108 "Ui/KeycapsC.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 48)) p =<< newArray labelps
{-# LINE 109 "Ui/KeycapsC.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 56)) p $ FFI.c_int (length lt_labels)
{-# LINE 110 "Ui/KeycapsC.hsc" #-}

label_offset :: (Int, Int)
label_offset = (1, 8)

{-
    struct Binding {
        IPoint point;
        // Text to appear on the keycap, utf8 encoded.
        const char *text;
        // A longer description for the binding, utf8 encoded.
        const char *doc;
        // Replace Layout::keycap_color if != Color::black.
        Color color;
    }
-}
instance CStorable RawBinding where
    sizeOf _ = (32)
{-# LINE 127 "Ui/KeycapsC.hsc" #-}
    alignment _ = alignment nullPtr
    poke p (RawBinding point (Binding { b_text, b_doc, b_color })) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p point
{-# LINE 130 "Ui/KeycapsC.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p =<< FFI.newCStringNull0 b_text
{-# LINE 131 "Ui/KeycapsC.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) p =<< FFI.newCStringNull0 b_doc
{-# LINE 132 "Ui/KeycapsC.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) p $ fromMaybe Color.black b_color
{-# LINE 133 "Ui/KeycapsC.hsc" #-}

#endif