{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Monad (unless)
import Data.Bifunctor (Bifunctor (bimap))
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),
    V4 (V4),
    Window,
    WindowConfig (windowGraphicsContext, windowInitialSize),
    WindowGraphicsContext (OpenGLContext),
    clear,
    createRenderer,
    createWindow,
    defaultOpenGL,
    defaultRenderer,
    defaultWindow,
    destroyWindow,
    drawLine,
    get,
    initialize,
    present,
    quit,
    rendererDrawColor,
    waitEvent,
    windowSize,
    ($=),
  )
import SDL.Input.Keyboard.Codes

main :: IO ()
main = do
  initialize [InitVideo]

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

  renderer <- createRenderer window (-1) defaultRenderer

  loop renderer window

  destroyWindow window

  quit

loop :: Renderer -> Window -> IO ()
loop renderer window = waitEvent >>= _loop renderer window

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

triangle :: [(V2 Float, V2 Float)]
triangle =
  [ (V2 0.25 0.75, V2 0.5 0.25),
    (V2 0.5 0.25, V2 0.75 0.75),
    (V2 0.75 0.75, V2 0.25 0.75)
  ]

_loop :: Renderer -> Window -> Event -> IO ()
_loop renderer window event = do
  let stop =
        case eventPayload event of
          QuitEvent -> True
          KeyboardEvent kevent -> case keyboardEventKeyMotion kevent of
            Pressed -> False
            Released
              | keyof kevent `elem` exitCodes -> True
              | otherwise -> False
          _ -> False

  rendererDrawColor renderer $= V4 255 255 255 255
  clear renderer

  rendererDrawColor renderer $= V4 0 0 0 255

  size <- get $ windowSize window
  mapM_ (uncurry (drawLine renderer) . bimap (tosdl size) (tosdl size)) triangle

  present renderer

  unless stop continue
  where
    continue = waitEvent >>= _loop renderer window
    keyof = keysymKeycode . keyboardEventKeysym

tosdl :: V2 CInt -> V2 Float -> Point V2 CInt
tosdl size rel = P $ fmap round $ fmap fromIntegral size * rel