{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Concurrent (threadDelay)
import Control.Monad (unless)
import Control.Monad.IO.Class (MonadIO)
import Data.Bifunctor (Bifunctor (bimap))
import Data.Foldable (Foldable (toList))
import Data.Functor ((<&>))
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Foreign.C (CInt)
import SDL (
  Event (eventPayload),
  EventPayload (KeyboardEvent, QuitEvent),
  InitFlag (InitVideo),
  InputMotion (Pressed, Released),
  KeyboardEventData (keyboardEventKeyMotion, keyboardEventKeysym),
  Keysym (keysymKeycode),
  Point (P),
  Renderer,
  V2 (V2),
  V3 (V3),
  V4 (V4),
  Window,
  WindowConfig (windowGraphicsContext, windowInitialSize),
  WindowGraphicsContext (OpenGLContext),
  clear,
  createRenderer,
  createWindow,
  defaultOpenGL,
  defaultRenderer,
  defaultWindow,
  destroyWindow,
  drawLine,
  drawPoint,
  get,
  initialize,
  pollEvents,
  present,
  quit,
  rendererDrawColor,
  windowSize,
  ($=),
 )
import SDL.Input.Keyboard.Codes
import System.IO.Unsafe (unsafePerformIO)
import Text.Printf (printf)

fps :: Int
fps = 60

data LoggingState = On | Off

{-# INLINE logState #-}
logState :: LoggingState
logState = Off

{-# INLINE logPrint #-}
logPrint :: (Show a) => LoggingState -> a -> IO ()
logPrint On = print
logPrint Off = return . donothing

{-# INLINE logPutStr #-}
logPutStr :: LoggingState -> String -> IO ()
logPutStr On = putStr
logPutStr Off = return . donothing

{-# INLINE logPutStrLn #-}
logPutStrLn :: LoggingState -> String -> IO ()
logPutStrLn On = putStrLn
logPutStrLn Off = return . donothing

{-# INLINE donothing #-}
donothing :: a -> ()
donothing _ = ()

main :: IO ()
main = do
  logPutStrLn logState "to2D test:"
  logPutStr logState "V3 0.5 0.5 0: "
  logPrint logState $ to2D $ V3 0.5 0.5 0
  logPutStr logState "V3 0.5 0.5 1: "
  logPrint logState $ to2D $ V3 0.5 0.5 1
  logPutStr logState "V3 0.5 0.5 2: "
  logPrint logState $ to2D $ V3 0.5 0.5 2

  logPutStr logState "V3 0.75 0.5 0: "
  logPrint logState $ to2D $ V3 0.75 0.5 0
  logPutStr logState "V3 0.75 0.5 1: "
  logPrint logState $ to2D $ V3 0.75 0.5 1
  logPutStr logState "V3 0.75 0.5 2: "
  logPrint logState $ to2D $ V3 0.75 0.5 2
  logPutStrLn logState ""

  let tmpPoint =
        Lines
          ( [ Line (p3 0 0 0, p3 1 0 0)
            ],
            p3 0 0 0
          )
  let movedPoint = move (Right (V3 0 0 1 :: V3 Float)) tmpPoint
  let rotatedPoint = rotate X Z (pi / 2) movedPoint
  let rotatedPoint2 = rotate X Z (-(pi / 2)) rotatedPoint
  let movedBackPoint = move (Right (V3 0 0 (-1) :: V3 Float)) rotatedPoint2
  putStr "tmpPoint: "
  print tmpPoint
  putStr "movedPoint: "
  print movedPoint
  putStr "debugGetCenteredObject movedPoint: "
  print $ debugGetCenteredObject movedPoint
  putStr "rotatedPoint: "
  print rotatedPoint
  putStr "rotatedPoint2: "
  print rotatedPoint2
  putStr "movedBackPoint: "
  print movedBackPoint

  initialize [InitVideo]

  window <-
    createWindow
      "Test"
      defaultWindow{windowGraphicsContext = OpenGLContext defaultOpenGL, windowInitialSize = V2 800 800}

  renderer <- createRenderer window (-1) defaultRenderer

  loop renderer window

  destroyWindow window

  quit

exitCodes :: [Keycode]
exitCodes = [KeycodeQ, KeycodeEscape]

type Point2D = V2 Float

type Line2D = (Point2D, Point2D)

type Point3D = V3 Float

type Line3D = (Point3D, Point3D)

class Drawable a where
  draw :: (MonadIO m, Functor m) => Window -> Renderer -> a -> m ()
  absRotate :: Direction -> Direction -> Float -> a -> a
  rotate :: Direction -> Direction -> Float -> a -> a
  move :: Either (V2 Float) (V3 Float) -> a -> a
  movePrecise :: a -> a -> a

data Pointrel = P2 Point2D | P3 Point3D deriving (Show)

p2 :: Float -> Float -> Pointrel
p2 x y = P2 (V2 x y)

p3 :: Float -> Float -> Float -> Pointrel
p3 x y z = P3 (V3 x y z)

toP2 :: Pointrel -> Point2D
toP2 (P2 pnt) = pnt
toP2 (P3 pnt) = to2D pnt

toP3 :: Pointrel -> Point3D
toP3 (P3 pnt) = pnt
toP3 (P2 pnt) = let oldvec = toList pnt in V3 (head oldvec) (last oldvec) 0

instance Drawable Pointrel where
  draw window renderer (P3 pnt) = draw window renderer $ P2 $ to2D pnt
  draw window renderer pnt = get (windowSize window) >>= drawPoint renderer . flip tosdl pnt
  move (Left d2) (P2 p2D) = P2 $ p2D + d2
  move (Right d3) (P2 p2D) = P3 $ (\x -> V3 (head x) (last x) (0 :: Float)) (toList p2D) + d3
  move (Left d2) (P3 p3D) = P3 $ (\x -> V3 (head x) (last x) (0 :: Float)) (toList d2) + p3D
  move (Right d3) (P3 p3D) = P3 $ p3D + d3
  movePrecise a (P2 b) = move (Left b) a
  movePrecise a (P3 b) = move (Right b) a
  absRotate dir1 dir2 ang (P3 pnt) = P3 $ _rotate dir1 dir2 ang pnt
  absRotate dir1 dir2 ang pnt = P3 $ _rotate dir1 dir2 ang $ toP3 pnt
  rotate _ _ _ = id

newtype Line = Line (Pointrel, Pointrel) deriving (Show)
toLines :: [(Pointrel, Pointrel)] -> [Line]
toLines = map Line
unLine :: Line -> (Pointrel, Pointrel)
unLine (Line points) = points

instance Drawable Line where
  draw window renderer (Line points) = get (windowSize window) >>= (\size -> uncurry (drawLine renderer) $ bimap (tosdl size) (tosdl size) points)
  move a (Line (b, c)) = Line (move a b, move a c)
  movePrecise (Line (a1, b1)) (Line (a2, b2)) = Line (movePrecise a1 a2, movePrecise b1 b2)
  absRotate dir1 dir2 ang (Line line) = Line $ bimap (absRotate dir1 dir2 ang) (absRotate dir1 dir2 ang) line
  rotate dir1 dir2 ang (Line (P2 p_1, P2 p_2)) = let mid = (p_1 + p_2) / 2 in move (Left mid) $ absRotate dir1 dir2 ang $ Line (P2 (p_1 - mid), P2 (p_2 - mid))
  rotate dir1 dir2 ang (Line (P2 _p_1, P3 p_2)) =
    let
      p_1 = toP3 (P2 _p_1)
      mid = (p_1 + p_2) / 2
     in
      move (Right mid) $ absRotate dir1 dir2 ang $ Line (P3 (p_1 - mid), P3 (p_2 - mid))
  rotate dir1 dir2 ang (Line (P3 p_1, P2 _p_2)) =
    let
      p_2 = toP3 (P2 _p_2)
      mid = (p_1 + p_2) / 2
     in
      move (Right mid) $ absRotate dir1 dir2 ang $ Line (P3 (p_1 - mid), P3 (p_2 - mid))
  rotate dir1 dir2 ang (Line (P3 p_1, P3 p_2)) = let mid = (p_1 + p_2) / 2 in move (Right mid) $ absRotate dir1 dir2 ang $ Line (P3 (p_1 - mid), P3 (p_2 - mid))

data Object = Lines ([Line], Pointrel) | Points ([Pointrel], Pointrel) deriving (Show)

instance Drawable Object where
  draw window renderer (Lines (obj, _)) = mapM_ (draw window renderer) obj
  draw window renderer (Points (obj, _)) = mapM_ (draw window renderer) obj
  move a (Lines (b, c)) = Lines (map (move a) b, move a c)
  move a (Points (b, c)) = Points (map (move a) b, move a c)
  movePrecise _ = id
  absRotate dir1 dir2 ang (Lines (obj, center)) = Lines (map (absRotate dir1 dir2 ang) obj, center)
  absRotate dir1 dir2 ang (Points (obj, center)) = Points (map (absRotate dir1 dir2 ang) obj, center)
  rotate dir1 dir2 ang (Lines (obj, P3 center)) = move (Right center) $ absRotate dir1 dir2 ang $ Lines (map (move $ Right $ center * (-1)) obj, p3 0 0 0)
  rotate dir1 dir2 ang (Lines (obj, P2 center)) = move (Left center) $ absRotate dir1 dir2 ang $ Lines (map (move $ Left $ center * (-1)) obj, p2 0 0)
  rotate dir1 dir2 ang (Points (obj, P3 center)) = move (Right center) $ absRotate dir1 dir2 ang $ Points (map (move $ Right $ center * (-1)) obj, p3 0 0 0)
  rotate dir1 dir2 ang (Points (obj, P2 center)) = move (Left center) $ absRotate dir1 dir2 ang $ Points (map (move $ Left $ center * (-1)) obj, p2 0 0)

debugGetCenteredObject :: Object -> Object
debugGetCenteredObject (Lines (obj, P3 center)) = Lines (map (move $ Right $ center * (-1)) obj, P3 center)
debugGetCenteredObject (Lines (obj, P2 center)) = Lines (map (move $ Left $ center * (-1)) obj, P2 center)
debugGetCenteredObject (Points (obj, P3 center)) = Points (map (move $ Right $ center * (-1)) obj, P3 center)
debugGetCenteredObject (Points (obj, P2 center)) = Points (map (move $ Left $ center * (-1)) obj, P2 center)

{- FOURMOLU_DISABLE -}
square :: Object
square =
  Lines
    ( toLines
        [ (p3 (-1) (-1) 0, p3   1   (-1) 0),
          (p3 (-1) (-1) 0, p3 (-1)    1  0),
          (p3 (-1) (-1) 0, p3 (-1)  (-1) 2),

          (p3   1    1  0, p3   1     1  2),
          (p3   1    1  0, p3   1   (-1) 0),
          (p3   1    1  0, p3 (-1)    1  0),

          (p3 (-1)   1  2, p3    1    1  2),
          (p3 (-1)   1  2, p3  (-1) (-1) 2),
          (p3 (-1)   1  2, p3  (-1)   1  0),

          (p3   1  (-1) 2, p3    1    1  2),
          (p3   1  (-1) 2, p3  (-1) (-1) 2),
          (p3   1  (-1) 2, p3    1  (-1) 0)
        ],
      p3 0 0 1
    )
{- FOURMOLU_ENABLE -}

data Direction = X | Y | Z

_rotate :: Direction -> Direction -> Float -> Point3D -> Point3D
_rotate X Y ang pnt =
  let (c, s, toRotate, x, y, z) = (cos ang, sin ang, toList pnt, head toRotate, toRotate !! 1, last toRotate)
   in V3 ((x * c) - (y * s)) ((x * s) + (y * c)) z
_rotate X Z ang pnt =
  let (c, s, toRotate, x, y, z) = (cos ang, sin ang, toList pnt, head toRotate, toRotate !! 1, last toRotate)
   in V3 ((x * c) + (z * s)) y ((z * c) - (s * x))
_rotate Y Z ang pnt =
  let (c, s, toRotate, x, y, z) = (cos ang, sin ang, toList pnt, head toRotate, toRotate !! 1, last toRotate)
   in V3 x ((y * c) - (z * s)) ((y * s) + (z * c))
_rotate Y X a p = _rotate X Y a p
_rotate Z X a p = _rotate X Z a p
_rotate Z Y a p = _rotate Y Z a p
_rotate X X _ _ = error "cant't rotate around 2 axis simultaniously"
_rotate Y Y _ _ = error "cant't rotate around 2 axis simultaniously"
_rotate Z Z _ _ = error "cant't rotate around 2 axis simultaniously"

_rotateprint :: LoggingState -> Float -> Point3D -> IO ()
_rotateprint On ang pnt =
  let (c, s, toRotate, x, y, z) = (cos ang, sin ang, toList pnt, head toRotate, toRotate !! 1, last toRotate)
   in printf "c: %f, s: %f, x: %f, y: %f, z: %f\n" c s x y z
_rotateprint Off _ _ = return ()

rotateprint :: Float -> Point3D -> IO ()
rotateprint = _rotateprint logState

objects :: IORef [(Int, Object)]
{-# NOINLINE objects #-}
objects = unsafePerformIO (newIORef [(0 :: Int, square)])

delta :: IORef Float
{-# NOINLINE delta #-}
delta = unsafePerformIO (newIORef 0)

loop :: Renderer -> Window -> IO ()
loop renderer window = do
  events <- pollEvents
  stop <-
    mapM
      ( \event -> case eventPayload event of
          QuitEvent -> return True
          KeyboardEvent kevent -> case keyboardEventKeyMotion kevent of
            Pressed -> return False
            Released
              | keyof kevent `elem` exitCodes -> return True
              | otherwise -> return False
          _ -> return False
      )
      events

  rendererDrawColor renderer $= V4 255 255 255 255
  clear renderer

  rendererDrawColor renderer $= V4 0 0 0 255

  -- size <- get $ windowSize window

  -- oldObjs <- readIORef objects

  -- readIORef delta >>= writeIORef delta . (+ (0.05 / fromIntegral fps))
  tmpDelta <- readIORef delta
  let ang = 2 * pi * tmpDelta
  -- readIORef objects >>= (writeIORef objects . map (second (map (bimap (P3 . (+) (V3 0 0 delta) . toP3) (P3 . (+) (V3 0 0 delta) . toP3)))))
  -- readIORef objects >>= (writeIORef objects . map (second (map (bimap (P3 . rotate X Z ang . toP3) (P3 . rotate X Z ang . toP3)))))

  rotated <- readIORef objects <&> map snd -- <&> map (rotate Y Z ang . snd)
  mapM_ (logPrint logState) rotated
  -- let rotated = map (map (bimap (P3 . rotate X Y ang . toP3) (P3 . rotate X Z ang . toP3))) rotated1
  let moved = map (move (Right (V3 0 0 tmpDelta))) rotated
  mapM_ (logPrint logState) moved

  logPutStrLn logState ""

  -- putStr "\ESC[H\ESC[2J"
  -- mapM_ (mapM_ (bimapM_ (putStr . flip (++) " " . show . toP3) (print . toP3))) moved
  mapM_ (draw window renderer . rotate Y Z ang . rotate X Y ang . rotate X Z ang) moved
  -- mapM_ (draw window renderer) moved

  present renderer

  writeIORef delta $ (+) tmpDelta $ 0.25 / fromIntegral fps
  unless (or stop) continue
 where
  continue = threadDelay (1000000 `div` fps) >> loop renderer window
  keyof = keysymKeycode . keyboardEventKeysym

{-
 - we apply the formula
 - (x, y, z) -> (x/z, y/z)
 - then change back from -1..1 to 0..2
 - and finally from 0..2 to 0..1
 -}
to2D :: Point3D -> Point2D
to2D pointin
  | last vec == 0 = to2D $ pointin + V3 0 0 0.01
  | otherwise = V2 (head vec / last vec) ((vec !! 1) / last vec)
 where
  vec = toList pointin

{-
 - size `toIntegral`
 - rel from -1..1 to 0..2
 - rel from  0..2 to 0..1
 - multiply size to rel
 - round it
 - return it in point form
 -}
tosdl :: V2 CInt -> Pointrel -> Point V2 CInt
tosdl size (P2 rel) = P $ fmap round $ fmap fromIntegral size * (1 - ((rel + 1) / 2))
tosdl size (P3 rel) = tosdl size $ P2 $ to2D rel