{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}

module Allie (WlKeyboardKeyState, LucyFace, LucyFaceFixedSize, AliceGenericMeshHand, AliceShinyMeshHand,
AliceGenericMeshInstance(..), AliceShinyMeshInstance(..), AlicePointLight(..), alicePipeline0PointLightMaxCount,
Callbacks(..), aliceMainloop, newAlice, aliceSetSkyColor, aliceNewLucyFace,
aliceLucyFaceOfSize, lucyFaceAddGlyphs, aliceClearText, aliceAddText,
aliceAddGenericMeshHand, aliceGenericMeshResizeInstanceArr, aliceGenericMeshSetInst,
aliceAddShinyMeshHand, aliceShinyMeshResizeInstanceArr, aliceShinyMeshSetInst, aliceGetCamBack,
aliceGetCamRight, aliceGetCamUp, aliceSetFOV,
aliceGetCamPos, aliceSetCamPos, aliceSetPointLightCount, aliceSetPointLight,
aliceIsPressed
) where

import Geom

import Data.Word (Word8, Word16, Word32, Word64)
import Data.Int (Int8, Int16, Int32, Int64)
import Foreign.Ptr (Ptr, FunPtr, nullPtr, plusPtr, castPtr)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Storable (Storable(..))
import qualified Data.Text
import Data.Text.Encoding (encodeUtf8)
import Data.ByteString (useAsCStringLen)

type Alice = Ptr Word8

-- Ready
foreign import ccall "allie_alice_new" newAlice :: IO Alice

data WlKeyboardKeyState = WlKeyboardKeyStateReleased | WlKeyboardKeyStatePressed | WlKeyboardKeyStateRepeated

-- data AliceAnotherFrameCap s = AliceAnotherFrameCap Alice

foreign import ccall "wrapper" allieMkAliceOnWaylandKeyboardKey ::
  (Ptr () -> Word32 -> Word32 -> IO ()) -> IO (FunPtr (Ptr () -> Word32 -> Word32 -> IO ()))
foreign import ccall "wrapper" allieMkAliceOnAnotherFrame ::
  (Ptr () -> Float -> IO ()) -> IO (FunPtr (Ptr () -> Float -> IO ()))

-- All of that is inside Alice. They hold pointers to Alice
type LucyFace = Ptr Word8
-- Actually stores a pointer to rb-tree node in LucyFace tree. Must not be deleted by without caution
type LucyFaceFixedSize = Ptr Word8

type AliceGenericMeshHand = Ptr Word8

type AliceShinyMeshHand = Ptr Word8

data AliceGenericMeshInstance = AliceGenericMeshInstance Mat4

instance Storable AliceGenericMeshInstance where
  sizeOf _ = sizeOf (undefined :: Mat4)
  alignment _ = 4
  peek _ = error "Please don't"
  poke ptr (AliceGenericMeshInstance modelT) = poke (castPtr ptr :: Ptr Mat4) modelT

-- model_t color_off color_on
data AliceShinyMeshInstance = AliceShinyMeshInstance Mat4 Vec3 Vec3

instance Storable AliceShinyMeshInstance where
  sizeOf _ = sizeOf (undefined :: Mat4)
  alignment _ = 4
  peek _ = error "Don't do that, please"
  poke ptr (AliceShinyMeshInstance modelT colorOff colorOn) = do
    poke (castPtr ptr :: Ptr Mat4) modelT
    poke (castPtr (ptr `plusPtr` (sizeOf (undefined :: Mat4)) ) :: Ptr Vec3) colorOff
    poke (castPtr (ptr `plusPtr` (sizeOf (undefined :: Mat4)) `plusPtr` (sizeOf (undefined :: Vec3))) :: Ptr Vec3) colorOn

-- pos color
data AlicePointLight = AlicePointLight Vec3 Vec3

alicePipeline0PointLightMaxCount :: Int
alicePipeline0PointLightMaxCount = 120

data Callbacks = Callbacks {
  onWaylandKeyboardKey :: (Word32 -> Word32 -> IO ()),
  onAnotherFrame :: (Float -> IO ())
  -- onAnotherFrame :: (forall s. AliceAnotherFrameCap s -> IO ())
  }

instance Storable Callbacks where
  sizeOf _ = 8 + 8
  alignment _ = 8
  peek _ = error "Зачем тебе?"
  poke ptr Callbacks{..} = do
    poke (castPtr ptr) =<< allieMkAliceOnWaylandKeyboardKey (\_ -> onWaylandKeyboardKey)
    poke (castPtr ptr `plusPtr` 8) =<< allieMkAliceOnAnotherFrame (\_ ->  onAnotherFrame)

foreign import ccall "allie_alice_mainloop" allieAliceMainloop :: Alice -> Ptr Callbacks -> IO ()

aliceMainloop :: Alice -> Callbacks -> IO ()
aliceMainloop alice cb = alloca $ \ptr -> do
    poke ptr cb
    allieAliceMainloop alice ptr

useAsUtf8StringLen :: String -> (Ptr Word8 -> Word64 -> IO a) -> IO a
useAsUtf8StringLen str cb = useAsCStringLen (encodeUtf8 $ Data.Text.pack $ str) $ \(cstr, len) -> cb (castPtr cstr) (fromIntegral len)

foreign import ccall "allie_alice_set_sky_color" allieAliceSetSkyColor :: Alice -> Float -> Float -> Float -> Float -> IO ()

aliceSetSkyColor :: Alice -> Vec4 -> IO ()
aliceSetSkyColor alice (Vec4 x y z w) = allieAliceSetSkyColor alice x y z w

foreign import ccall "allie_alice_new_lucy_face" allieAliceNewLucyFace :: Alice -> Ptr Word8 -> Word64 -> IO LucyFace

aliceNewLucyFace :: Alice -> String -> IO LucyFace
aliceNewLucyFace alice str = useAsUtf8StringLen str $ \dt len -> allieAliceNewLucyFace alice dt len
  
-- Maps one to one. Fine
foreign import ccall "allie_alice_lucy_face_of_size" aliceLucyFaceOfSize :: LucyFace -> Word32 -> IO LucyFaceFixedSize

-- Mapsone to one. Good. Too bad right now this only works with one range at a time
-- (which means one range per image)
foreign import ccall "allie_lucy_face_add_glyphs" lucyFaceAddGlyphs :: LucyFaceFixedSize -> Word32 -> Word32 -> IO ()

-- Maps one to one
foreign import ccall "allie_alice_clear_text" aliceClearText :: Alice -> IO ()

foreign import ccall "allie_alice_add_text" allieAliceAddText :: Alice -> LucyFaceFixedSize -> Float -> Float -> Float -> Float ->
  Ptr Word8 -> Word64 -> Int32 -> Int32 -> IO ()

aliceAddText :: Alice -> LucyFaceFixedSize -> Vec4 -> String -> Int32 -> Int32 -> IO ()
aliceAddText alice ffs (Vec4 cx cy cz cw) str startPosX startPosY = useAsUtf8StringLen str $ \dt len ->
  allieAliceAddText alice ffs cx cy cz cw dt len startPosX startPosY

foreign import ccall "allie_alice_add_generic_mesh_hand" allieAliceAddGenericMeshHand :: Alice ->
  Ptr Word8 -> Word64 -> Ptr Word8 -> Word64 -> Ptr Word8 -> Word64 -> Ptr Word8 -> Word64 -> IO AliceGenericMeshHand 

-- Path to mesh topology file, path to diffuse texture, path to normal texture, path to specular texture
aliceAddGenericMeshHand :: Alice -> String -> String -> String -> String -> IO AliceGenericMeshHand
aliceAddGenericMeshHand alice p1 p2 p3 p4 = useAsUtf8StringLen p1 $ \d1 l1 ->
  (useAsUtf8StringLen p2 $ \d2 l2 -> (useAsUtf8StringLen p3 $ \d3 l3 -> (useAsUtf8StringLen p4 $ \d4 l4 ->
    allieAliceAddGenericMeshHand alice d1 l1 d2 l2 d3 l3 d4 l4)))


foreign import ccall "allie_alice_add_shiny_mesh_hand" allie_alice_add_shiny_mesh_hand :: Alice -> Ptr Word8 -> Word64 -> IO AliceShinyMeshHand

aliceAddShinyMeshHand :: Alice -> String -> IO AliceShinyMeshHand
aliceAddShinyMeshHand alice p = useAsUtf8StringLen p $ \dt len -> allie_alice_add_shiny_mesh_hand alice dt len

-- Maps well
foreign import ccall "allie_alice_generic_mesh_resize_instance_arr" aliceGenericMeshResizeInstanceArr :: Alice -> AliceGenericMeshHand -> Word64 -> IO ()

foreign import ccall "allie_alice_shiny_mesh_resize_instance_arr" aliceShinyMeshResizeInstanceArr :: Alice -> AliceShinyMeshHand -> Word64 -> IO ()

foreign import ccall "allie_alice_generic_mesh_set_inst" allieAliceGenericMeshSetInst :: AliceGenericMeshHand -> Word64 -> Ptr AliceGenericMeshInstance -> IO ()

aliceGenericMeshSetInst :: AliceGenericMeshHand -> Word64 -> AliceGenericMeshInstance -> IO ()
aliceGenericMeshSetInst mesh index obj = alloca $ \ptr -> do
  poke ptr obj
  allieAliceGenericMeshSetInst mesh index ptr

foreign import ccall "allie_alice_shiny_mesh_set_inst" allie_alice_shiny_mesh_set_inst :: AliceShinyMeshHand -> Word64 -> Ptr AliceShinyMeshInstance -> IO ()

aliceShinyMeshSetInst :: AliceShinyMeshHand -> Word64 -> AliceShinyMeshInstance -> IO ()
aliceShinyMeshSetInst mesh index obj = alloca $ \ptr -> do
  poke ptr obj
  allie_alice_shiny_mesh_set_inst mesh index ptr


foreign import ccall "allie_alice_get_cam_back" allie_alice_get_cam_back :: Alice -> Ptr Vec3 -> IO ()

aliceGetCamBack :: Alice -> IO Vec3
aliceGetCamBack alice = alloca $ \ptr -> do
  allie_alice_get_cam_back alice ptr
  peek ptr

foreign import ccall "allie_alice_get_cam_right" allie_alice_get_cam_right :: Alice -> Ptr Vec3 -> IO ()

aliceGetCamRight :: Alice -> IO Vec3
aliceGetCamRight alice = alloca $ \ptr -> do
  allie_alice_get_cam_right alice ptr
  peek ptr

foreign import ccall "allie_alice_get_cam_up" allie_alice_get_cam_up :: Alice -> Ptr Vec3 -> IO ()

aliceGetCamUp :: Alice -> IO Vec3
aliceGetCamUp alice = alloca $ \ptr -> do
  allie_alice_get_cam_up alice ptr
  peek ptr


foreign import ccall "allie_alice_get_cam_pos" allie_alice_get_cam_pos :: Alice -> Ptr Vec3 -> IO ()

aliceGetCamPos :: Alice -> IO Vec3
aliceGetCamPos alice = alloca $ \ptr -> do
  allie_alice_get_cam_pos alice ptr
  peek ptr

foreign import ccall "allie_alice_set_cam_pos" allie_alice_set_cam_pos :: Alice -> Float -> Float -> Float -> IO ()

aliceSetCamPos :: Alice -> Vec3 -> IO ()
aliceSetCamPos alice (Vec3 x y z) =  allie_alice_set_cam_pos alice x y z 

-- Easy mapping
foreign import ccall "allie_alice_set_fov" aliceSetFOV :: Alice -> Float -> IO ()

-- Maps well
foreign import ccall "allie_alice_set_point_light_count" aliceSetPointLightCount :: Alice -> Int -> IO ()

foreign import ccall "allie_alice_set_point_light" allie_alice_set_point_light :: Alice -> Int
  -> Float -> Float -> Float -> Float -> Float -> Float -> IO ()

aliceSetPointLight :: Alice -> Int -> AlicePointLight -> IO ()
aliceSetPointLight alice index (AlicePointLight (Vec3 px py pz) (Vec3 cx cy cz)) =
  allie_alice_set_point_light alice index px py pz cx cy cz

foreign import ccall "alice_is_pressed" aliceIsPressed :: Alice -> Word32 -> IO Bool