import Allie
import Geom
import Control.Monad (forM_, when)
import Data.Char (ord)
import Data.IORef (newIORef, readIORef, writeIORef, modifyIORef)
import Data.Word(Word32, Word64)

lucyFaceAddGlyphRange :: LucyFaceFixedSize -> Char -> Char -> IO ()
lucyFaceAddGlyphRange ffs a b = lucyFaceAddGlyphs ffs aInt (bInt - aInt + 1)
  where aInt = ((fromIntegral $ ord a) :: Word32)
        bInt = ((fromIntegral $ ord b) :: Word32)

-- Game configurable

goodColorOfCube :: (Integral a) => a -> Vec3
goodColorOfCube i = ((Vec3 100 0 0) ^*^ t) ^+^ ((Vec3 0 50 90) ^*^ (1 - t)) where t = ((fromIntegral i :: Float) / 4)

goodLightPos :: (Integral a) => a -> Vec3
goodLightPos i = ((Vec3 0 2 1) ^*^ t) ^+^ ((Vec3 5 1 1) ^*^ (1 - t)) where t = ((fromIntegral i :: Float) / 4)

projectDirOntoPlane :: Vec3 -> Vec2
projectDirOntoPlane (Vec3 x y z) = normalize (Vec2 x z)

heroHeight :: Float
heroHeight = 1.89

heroCamPos :: Vec2 -> Vec3
heroCamPos (Vec2 x z) = Vec3 x heroHeight z

puckLevitationHeight :: Float
puckLevitationHeight = 0.4 + 0.2

puckSpots :: [Vec2]
puckSpots = [(Vec2 (-10) (-10)), (Vec2 (-15) (-15)) , (Vec2 (-18) (-18)), (Vec2 (-18) (-25)), (Vec2 (-18) (-30))]

main :: IO()
main = do
  alice <- newAlice
  aliceSetSkyColor alice (Vec4 0.9 0 0.6 1)
  aliceSetCamPos alice (Vec3 0 heroHeight 0)
  face <- aliceNewLucyFace alice "src/l3/fonts/DMSerifText-Regular.ttf"
  faceOf40 <- aliceLucyFaceOfSize face 40
  lucyFaceAddGlyphRange faceOf40 ' ' '~'
  lucyFaceAddGlyphRange faceOf40 'а' 'я'
  lucyFaceAddGlyphRange faceOf40 'А' 'Я'
  aliceAddText alice faceOf40 (Vec4 1 1 0 1) "Privet" 100 200

  weirdStructure <- aliceAddGenericMeshHand alice "gen/l2/models/log_10_2_6.AliceGenericMesh"
    "src/l3/textures/log_10_2_6_diffuse.png" "gen/l2/textures/log_10_2_6_NORMAL.png" "src/l3/textures/log_10_2_6_specular.png"
  aliceGenericMeshResizeInstanceArr alice weirdStructure 1

  aliceGenericMeshSetInst weirdStructure 0 (AliceGenericMeshInstance (mat4Transit (Vec3 (-3.0) (0.0) (-5.0))))
  
  floorTile <- aliceAddGenericMeshHand alice "gen/l2/models/quad.AliceGenericMesh"
    "src/l3/textures/asphalt_diffuse.png" "gen/l2/textures/flat_NORMAL.png" "src/l3/textures/funny_floor_specular.png"
  aliceGenericMeshResizeInstanceArr alice floorTile 49 

  puck <- aliceAddGenericMeshHand alice "gen/l2/models/puck.AliceGenericMesh"
    "src/l3/textures/puck_diffuse.png" "gen/l2/textures/puck_NORMAL.png" "src/l3/textures/puck_specular.png"

  forM_ [0..6] $ \x -> forM_ [0..6] $ \z ->
    aliceGenericMeshSetInst floorTile (z * 7 + x) (AliceGenericMeshInstance
    (mat4Transit (Vec3 ((fromIntegral x) * 10 - 35) 0 ((fromIntegral z) * 10 - 35))))

  cube <- aliceAddShinyMeshHand alice "gen/l2/models/cube.AliceShinyMesh"
  aliceShinyMeshResizeInstanceArr alice cube 5

  aliceSetPointLightCount alice 5
  forM_ [0..4] $ \i -> do
    aliceShinyMeshSetInst cube i (AliceShinyMeshInstance (mat4Transit (goodLightPos i)) (Vec3 0.0 0.0 0.0) (goodColorOfCube i))  
    aliceSetPointLight alice (fromIntegral i) (AlicePointLight (goodLightPos i) (goodColorOfCube i))

  aliceGenericMeshResizeInstanceArr alice puck (fromIntegral $ length puckSpots)
  forM_ (zip[0..] puckSpots) $ \(i, (Vec2 x z)) -> aliceGenericMeshSetInst puck (fromIntegral i) (AliceGenericMeshInstance
    (mat4Transit (Vec3 x puckLevitationHeight z )))

  heroPos <- newIORef (Vec2 0 0)
  puckRotation <- newIORef (0 :: Float)
  
  -- Create the Callbacks structure.
  let callbacks = Callbacks myonKeyboardKey myonAnotherFrame where
      myonKeyboardKey keysym keyAction = do
        putStrLn ("Got a keypress") 
      myonAnotherFrame fl = do
        curPuckRotation <- readIORef puckRotation
        writeIORef puckRotation (curPuckRotation + fl * 0.2)

        --forM_ (zip[0..] puckSpots) $ \(i, (Vec2 x z)) -> aliceGenericMeshSetInst puck (fromIntegral i) (AliceGenericMeshInstance
        --  (rot4) ^*^ (mat4Transit (Vec3 x puckLevitationHeight z )))


        backDir <- aliceGetCamBack alice
        let projBack = projectDirOntoPlane backDir
        rightDir <- aliceGetCamRight alice
        let projRight = projectDirOntoPlane rightDir
        goForward <- aliceIsPressed alice (fromIntegral $ ord 'w')
        when goForward $ do
          curHeroPos <- readIORef heroPos
          let nextHeroPos = (curHeroPos ^+^ (projBack ^*^ (fl * (-10))))
          writeIORef heroPos nextHeroPos
          aliceSetCamPos alice $ heroCamPos nextHeroPos
        goBackward <- aliceIsPressed alice (fromIntegral $ ord 's')
        when goBackward $ do
          curHeroPos <- readIORef heroPos
          let nextHeroPos = (curHeroPos ^+^ (projBack ^*^ (fl * (10))))
          writeIORef heroPos nextHeroPos
          aliceSetCamPos alice $ heroCamPos nextHeroPos
        goLeft <- aliceIsPressed alice (fromIntegral $ ord 'a')
        when goLeft $ do
          curHeroPos <- readIORef heroPos
          let nextHeroPos = (curHeroPos ^+^ (projRight ^*^ (fl * (-10))))
          writeIORef heroPos nextHeroPos
          aliceSetCamPos alice $ heroCamPos nextHeroPos
        goRight <- aliceIsPressed alice (fromIntegral $ ord 'd')
        when goRight $ do
          curHeroPos <- readIORef heroPos
          let nextHeroPos = (curHeroPos ^+^ (projRight ^*^ (fl * (10))))
          writeIORef heroPos nextHeroPos
          aliceSetCamPos alice $ heroCamPos nextHeroPos


  -- Allocate space for the struct, poke it, and pass to C.
  aliceMainloop alice callbacks
