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

module Main where

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

fps :: Int
fps = 1

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

  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

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

data Object = Lines [Line] | Points [Pointrel]

instance Drawable Object where
  draw window renderer (Lines obj) = mapM_ (draw window renderer) obj
  draw window renderer (Points obj) = mapM_ (draw window renderer) obj

{- FOURMOLU_DISABLE -}
square :: Object
square = Lines $ toLines [
    (p3 (-0.5) (-0.5) (-0.5), p3   0.5  (-0.5) (-0.5)),
    (p3 (-0.5) (-0.5) (-0.5), p3 (-0.5)   0.5  (-0.5)),
    (p3 (-0.5) (-0.5) (-0.5), p3 (-0.5) (-0.5)   0.5),

    (p3   0.5    0.5  (-0.5), p3   0.5    0.5    0.5),
    (p3   0.5    0.5  (-0.5), p3   0.5  (-0.5) (-0.5)),
    (p3   0.5    0.5  (-0.5), p3 (-0.5)   0.5  (-0.5)),

    (p3 (-0.5)   0.5    0.5, p3    0.5    0.5    0.5),
    (p3 (-0.5)   0.5    0.5, p3  (-0.5) (-0.5)   0.5),
    (p3 (-0.5)   0.5    0.5, p3  (-0.5)   0.5  (-0.5)),

    (p3   0.5  (-0.5)   0.5, p3    0.5    0.5    0.5),
    (p3   0.5  (-0.5)   0.5, p3  (-0.5) (-0.5)   0.5),
    (p3   0.5  (-0.5)   0.5, p3    0.5  (-0.5) (-0.5))
  ]
{- 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 ((x * s) + (z * c))
_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.25 / fromIntegral fps))
  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 (map (bimap (P3 . rotate X Z ang . toP3) (P3 . rotate X Z ang . toP3)) . snd)
  -- let rotated = map (map (bimap (P3 . rotate X Y ang . toP3) (P3 . rotate X Z ang . toP3))) rotated1
  let moved = map (map (bimap (P3 . (+) (V3 0 0 tmpDelta) . toP3) (P3 . (+) (V3 0 0 tmpDelta) . toP3))) rotated

  readIORef objects >>= mapM_ (mapM_ (logPrint logState) . snd)
  logPutStrLn logState ""

  -- putStr "\ESC[H\ESC[2J"
  mapM_ (mapM_ (bimapM_ (putStr . flip (++) " " . show . toP3) (print . toP3))) moved
  mapM_ (mapM_ (uncurry (drawLine renderer) . bimap (tosdl size) (tosdl size))) moved

  present renderer

  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 1 (-1) 1
  | 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