{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Concurrent (threadDelay)
import Control.Monad (unless)
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.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,
  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 = 144

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)

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

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

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

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

type Line = (Pointrel, Pointrel)

type Object = [Line]

{- FOURMOLU_DISABLE -}
square :: Object
square =
  [ (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

  mapM_ (mapM_ (bimapM_ (logPutStr logState . flip (++) " " . show . toP3) (logPrint logState . toP3)) . snd) oldObjs
  logPutStrLn logState ""
  logPutStrLn logState "rotateprint"
  mapM_ (mapM_ (bimapM_ (rotateprint pi . toP3) (rotateprint pi . toP3)) . snd) oldObjs
  logPutStrLn logState "rotateprint"

  logPutStrLn logState ""

  readIORef delta >>= writeIORef delta . (+ (0.25 / 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 ""

  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 = (\vec -> V2 (head vec / last vec) (vec !! 1 / last vec)) . toList

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