{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}

{- |
This executable is a small interactive tour of /h-raylib/:

  * How to open a window and drive the renderer ('beginDrawing'/'endDrawing').
  * How to draw 2D primitives (fills + “strokes” via *Lines* APIs).
  * How to work with colors and alpha blending.
  * How to load and draw textures (including a generated texture).
  * How to render into an offscreen 'RenderTexture' and then draw it to the screen.

Controls are shown in the overlay (toggle with @H@).
-}
module Main (main) where

import Control.Monad (forM_, unless, void, when)
import Data.Fixed (mod')

import qualified Raylib.Core as RL
import qualified Raylib.Core.Shapes as Shapes
import qualified Raylib.Core.Text as Text
import qualified Raylib.Core.Textures as Tex
import qualified Raylib.Util.Colors as C
import Raylib.Util (WindowResources, managed)
import Raylib.Types
  ( BlendMode (..)
  , Color (..)
  , ConfigFlag (..)
  , KeyboardKey (..)
  , MouseButton (..)
  , Rectangle (..)
  , RenderTexture
  , Texture
  , TextureFilter (..)
  , TextureWrap (..)
  , Vector2
  , pattern Vector2
  , renderTexture'texture
  , texture'height
  , texture'width
  )

main :: IO ()
main = do
  RL.setConfigFlags [Msaa4xHint, WindowResizable]
  window <- RL.initWindow screenW screenH "tryraylib: h-raylib primitives demo"
  RL.setTargetFPS 60

  assets <- initAssets window
  loop assets initialState

  shutdown window

-- | Initial window size.
screenW, screenH :: Int
screenW = 1100
screenH = 720

-- | All asset-like things we want to keep alive across frames.
data Assets = Assets
  { assetsTexture :: Texture
  , assetsRenderTexture :: RenderTexture
  }

-- | Initialize GPU resources after the window (OpenGL context) exists.
initAssets :: WindowResources -> IO Assets
initAssets window = do
  image <- Tex.genImageChecked 256 256 32 32 C.rayWhite C.lightGray
  texture <- managed window (Tex.loadTextureFromImage image)
  rt <- managed window (Tex.loadRenderTexture 512 512)

  -- Configure texture defaults once.
  void $ Tex.setTextureWrap texture TextureWrapRepeat
  void $ Tex.setTextureFilter texture TextureFilterPoint

  pure Assets
    { assetsTexture = texture
    , assetsRenderTexture = rt
    }

-- | Manual resource cleanup (the high-level unload APIs need 'WindowResources').
shutdown :: WindowResources -> IO ()
shutdown window =
  RL.closeWindow (Just window)

data Page
  = PageShapes
  | PageColors
  | PageTextures
  deriving (Eq, Enum, Bounded, Show)

-- | The bits of application state that are /not/ owned by raylib.
data DemoState = DemoState
  { stPage :: Page
  , stShowHelp :: Bool
  , stLineThickness :: Float
  , stBlendModeIx :: Int
  , stTextureFilter :: TextureFilter
  , stRotationDeg :: Float
  }

initialState :: DemoState
initialState =
  DemoState
    { stPage = PageShapes
    , stShowHelp = True
    , stLineThickness = 6
    , stBlendModeIx = 0
    , stTextureFilter = TextureFilterPoint
    , stRotationDeg = 0
    }

-- | Input snapshot for a single frame.
data Controls = Controls
  { ctlDt :: Float
  , ctlMouse :: Vector2
  , ctlWheel :: Float
  , ctlMouseDown :: Bool
  , ctlPrevPage :: Bool
  , ctlNextPage :: Bool
  , ctlPage1 :: Bool
  , ctlPage2 :: Bool
  , ctlPage3 :: Bool
  , ctlToggleHelp :: Bool
  , ctlCycleBlend :: Bool
  , ctlToggleFilter :: Bool
  }

readControls :: IO Controls
readControls = do
  dt <- RL.getFrameTime
  mouse <- RL.getMousePosition
  wheel <- RL.getMouseWheelMove
  mouseDown <- RL.isMouseButtonDown MouseButtonLeft

  prevPage <- RL.isKeyPressed KeyLeft
  nextPage <- RL.isKeyPressed KeyRight
  p1 <- RL.isKeyPressed KeyOne
  p2 <- RL.isKeyPressed KeyTwo
  p3 <- RL.isKeyPressed KeyThree
  toggleHelp <- RL.isKeyPressed KeyH
  cycleBlend <- RL.isKeyPressed KeyB
  toggleFilter <- RL.isKeyPressed KeyF

  pure Controls
    { ctlDt = dt
    , ctlMouse = mouse
    , ctlWheel = wheel
    , ctlMouseDown = mouseDown
    , ctlPrevPage = prevPage
    , ctlNextPage = nextPage
    , ctlPage1 = p1
    , ctlPage2 = p2
    , ctlPage3 = p3
    , ctlToggleHelp = toggleHelp
    , ctlCycleBlend = cycleBlend
    , ctlToggleFilter = toggleFilter
    }

-- | Pure state update logic.
stepDemo :: Controls -> DemoState -> DemoState
stepDemo ctl st =
  st
    { stPage = newPage
    , stShowHelp = if ctlToggleHelp ctl then not (stShowHelp st) else stShowHelp st
    , stLineThickness = newThickness
    , stBlendModeIx = newBlendIx
    , stTextureFilter = newFilter
    , stRotationDeg = newRot
    }
 where
  newPage
    | ctlPage1 ctl = PageShapes
    | ctlPage2 ctl = PageColors
    | ctlPage3 ctl = PageTextures
    | ctlNextPage ctl = nextEnum (stPage st)
    | ctlPrevPage ctl = prevEnum (stPage st)
    | otherwise = stPage st

  newThickness =
    clamp 1 30 (stLineThickness st + (ctlWheel ctl * 2))

  newBlendIx
    | ctlCycleBlend ctl = (stBlendModeIx st + 1) `mod` length blendModes
    | otherwise = stBlendModeIx st

  newFilter
    | ctlToggleFilter ctl = toggleTextureFilter (stTextureFilter st)
    | otherwise = stTextureFilter st

  newRot = (stRotationDeg st + ctlDt ctl * 90) `mod'` 360

-- | Main loop driven by 'windowShouldClose'.
loop :: Assets -> DemoState -> IO ()
loop assets = go
 where
  go st = do
    shouldClose <- RL.windowShouldClose
    unless shouldClose $ do
      ctl <- readControls
      let st' = stepDemo ctl st
      drawFrame assets ctl st'
      go st'

drawFrame :: Assets -> Controls -> DemoState -> IO ()
drawFrame assets ctl st = do
  -- Offscreen pass (also a good place for “post-processing” style work).
  drawToRenderTexture assets st

  RL.beginDrawing
  RL.clearBackground C.rayWhite

  drawHeader st
  drawPage assets ctl st
  when (stShowHelp st) (drawHelpOverlay st)

  RL.endDrawing

drawHeader :: DemoState -> IO ()
drawHeader st = do
  fps <- RL.getFPS
  let title = pageTitle (stPage st) <> "  |  FPS: " <> show fps
  Shapes.drawRectangle 0 0 screenW 36 C.darkGray
  Text.drawText title 12 10 18 C.rayWhite

pageTitle :: Page -> String
pageTitle = \case
  PageShapes -> "1: Shapes (fills + strokes)"
  PageColors -> "2: Colors + blending + scissor"
  PageTextures -> "3: Textures + render textures"

drawHelpOverlay :: DemoState -> IO ()
drawHelpOverlay st = do
  let x = 14
  let y = 48
  let w = 520
  let h = 170

  Shapes.drawRectangle x y w h (Tex.fade C.black 0.55)
  Shapes.drawRectangleLines x y w h C.rayWhite

  let helpLines =
        [ "Controls:"
        , "  1/2/3: switch pages   |   Left/Right: cycle pages"
        , "  Mouse wheel: line thickness (" <> show (round (stLineThickness st) :: Int) <> ")"
        , "  B: cycle blend mode (" <> blendModeName (currentBlendMode st) <> ")"
        , "  F: toggle texture filter (" <> textureFilterName (stTextureFilter st) <> ")"
        , "  H: toggle this help overlay"
        , "  ESC: quit"
        ]

  drawTextLines (x + 12) (y + 10) 18 22 C.rayWhite helpLines

drawTextLines :: Int -> Int -> Int -> Int -> Color -> [String] -> IO ()
drawTextLines x0 y0 fontSize lineHeight color ls =
  forM_ (zip [0 :: Int ..] ls) $ \(i, s) ->
    Text.drawText s x0 (y0 + i * lineHeight) fontSize color

drawPage :: Assets -> Controls -> DemoState -> IO ()
drawPage assets ctl st =
  case stPage st of
    PageShapes -> drawShapesPage ctl st
    PageColors -> drawColorsPage ctl st
    PageTextures -> drawTexturesPage assets ctl st

drawShapesPage :: Controls -> DemoState -> IO ()
drawShapesPage ctl st = do
  drawGrid 40 C.lightGray

  let Vector2 mx my = ctlMouse ctl
  let thickness = stLineThickness st

  -- Thick line “stroke” that follows the mouse.
  Shapes.drawLineEx (Vector2 80 120) (Vector2 mx my) thickness C.red
  Shapes.drawCircleV (Vector2 mx my) 8 C.blue
  Shapes.drawCircleLinesV (Vector2 mx my) 20 C.darkBlue

  -- Rectangle: fill + outline.
  let rect = Rectangle 80 160 240 140
  Shapes.drawRectangleRec rect (Tex.fade C.skyBlue 0.5)
  Shapes.drawRectangleLinesEx rect thickness C.blue

  -- Rounded rectangle stroke thickness has its own API.
  let rrect = Rectangle 360 160 260 140
  Shapes.drawRectangleRounded rrect 0.25 12 (Tex.fade C.lime 0.55)
  Shapes.drawRectangleRoundedLinesEx rrect 0.25 12 thickness C.darkGreen

  -- Circles / gradients / rings.
  Shapes.drawCircleGradient 220 420 70 C.yellow C.orange
  Shapes.drawCircleLines 220 420 70 C.darkBrown
  Shapes.drawRing (Vector2 520 420) 40 70 20 320 32 (Tex.fade C.purple 0.6)
  Shapes.drawRingLines (Vector2 520 420) 40 70 20 320 32 C.darkPurple

  -- Regular polygons.
  let polyCenter = Vector2 820 260
  Shapes.drawPoly polyCenter 6 70 (stRotationDeg st) (Tex.fade C.pink 0.6)
  Shapes.drawPolyLinesEx polyCenter 6 70 (stRotationDeg st) thickness C.maroon

  -- Triangle fan + line strip from a pure point generator.
  let star = starPoints (Vector2 820 470) 90 40 5 (stRotationDeg st)
  Shapes.drawTriangleFan star (Tex.fade C.gold 0.65)
  case star of
    [] -> pure ()
    p0 : _ -> Shapes.drawLineStrip (star <> [p0]) C.brown

  Text.drawText "Try moving the mouse; use the wheel to change line thickness." 80 610 18 C.darkGray

drawColorsPage :: Controls -> DemoState -> IO ()
drawColorsPage _ctl st = do
  drawGrid 32 (Tex.fade C.lightGray 0.6)

  let mode = currentBlendMode st
  let blendLabel = "Blend mode (press B): " <> blendModeName mode
  Text.drawText blendLabel 60 70 20 C.darkGray

  RL.beginBlendMode mode

  -- Layered alpha shapes (fill) + outlines (stroke).
  Shapes.drawCircle 220 260 110 (Tex.fade C.red 0.35)
  Shapes.drawCircle 320 260 110 (Tex.fade C.blue 0.35)
  Shapes.drawCircleLines 220 260 110 C.darkGray
  Shapes.drawCircleLines 320 260 110 C.darkGray

  Shapes.drawRectangle 160 380 320 170 (Tex.fade C.green 0.25)
  Shapes.drawRectangleGradientEx
    (Rectangle 160 380 320 170)
    (Tex.fade C.yellow 0.3)
    (Tex.fade C.blue 0.3)
    (Tex.fade C.red 0.3)
    (Tex.fade C.green 0.3)
  Shapes.drawRectangleLinesEx (Rectangle 160 380 320 170) (stLineThickness st) C.darkGray

  RL.endBlendMode

  -- Scissor mode clips rendering.
  Text.drawText "Scissor mode (clipping):" 560 70 20 C.darkGray
  let scX = 560
  let scY = 110
  let scW = 480
  let scH = 260
  Shapes.drawRectangleLines scX scY scW scH C.darkGray

  RL.beginScissorMode scX scY scW scH
  Shapes.drawRectangleGradientH (scX - 80) (scY + 20) (scW + 160) (scH - 40) C.skyBlue C.purple
  Shapes.drawCircleGradient (scX + 250) (scY + 140) 160 C.yellow C.orange
  RL.endScissorMode

  -- Small palette swatches.
  Text.drawText "Palette swatches:" 560 410 20 C.darkGray
  drawSwatches 560 440 34 palette

drawTexturesPage :: Assets -> Controls -> DemoState -> IO ()
drawTexturesPage assets ctl st = do
  -- Apply texture filter based on state (toggle with F).
  void $ Tex.setTextureFilter (assetsTexture assets) (stTextureFilter st)

  drawGrid 40 (Tex.fade C.lightGray 0.55)

  Text.drawText "Generated texture (genImageChecked):" 60 70 20 C.darkGray

  let tex = assetsTexture assets
  Tex.drawTexture tex 60 110 C.white
  Shapes.drawRectangleLines 60 110 256 256 C.darkGray

  -- Draw a region (“sprite sheet style”).
  Text.drawText "drawTextureRec (sub-rectangle):" 360 70 20 C.darkGray
  let src = Rectangle 0 0 128 128
  Tex.drawTextureRec tex src (Vector2 360 110) C.white
  Shapes.drawRectangleLines 360 110 128 128 C.darkGray

  -- Draw with scaling + rotation around an origin.
  Text.drawText "drawTexturePro (scale + rotate + tint):" 60 410 20 C.darkGray

  let Vector2 mx my = ctlMouse ctl
  let dest = Rectangle (mx - 90) (my - 90) 180 180
  let origin = Vector2 90 90
  Tex.drawTexturePro tex (Rectangle 0 0 256 256) dest origin (stRotationDeg st) (Tex.fade C.white 0.85)
  Shapes.drawRectangleLinesEx dest (stLineThickness st) C.darkGray

  Text.drawText "Move mouse to position the sprite." 60 650 18 C.darkGray
  Text.drawText "Left mouse held doesn't do anything yet; it's here to show input polling." 60 670 18 C.darkGray

  drawRenderTexturePreview assets st

drawToRenderTexture :: Assets -> DemoState -> IO ()
drawToRenderTexture assets st = do
  let rt = assetsRenderTexture assets

  RL.beginTextureMode rt
  RL.clearBackground C.blank

  Shapes.drawRectangle 0 0 512 512 (Tex.fade C.black 0.25)
  drawGridIntoRT 32 (Tex.fade C.rayWhite 0.15)

  Shapes.drawCircleGradient 256 256 170 C.blue C.pink
  Shapes.drawRingLines (Vector2 256 256) 120 190 0 360 60 C.rayWhite
  Shapes.drawPolyLinesEx (Vector2 256 256) 6 110 (stRotationDeg st) 10 C.yellow
  Text.drawText "RenderTexture" 168 20 30 C.rayWhite

  RL.endTextureMode

drawRenderTexturePreview :: Assets -> DemoState -> IO ()
drawRenderTexturePreview assets st = do
  Text.drawText "Offscreen render texture:" 720 70 20 C.darkGray

  let rt = assetsRenderTexture assets
  let rtTex = renderTexture'texture rt

  let w = fromIntegral (texture'width rtTex)
  let h = fromIntegral (texture'height rtTex)

  -- Note: render textures are “upside down” when sampled; negative height flips the source.
  let src = Rectangle 0 0 w (-h)
  let dest = Rectangle 720 110 340 340
  let origin = Vector2 0 0

  Tex.drawTexturePro rtTex src dest origin 0 C.white
  Shapes.drawRectangleLinesEx dest (stLineThickness st) C.darkGray

  let label = "This was drawn via beginTextureMode/endTextureMode."
  Text.drawText label 720 462 18 C.darkGray

-- | A simple grid in screen space.
drawGrid :: Int -> Color -> IO ()
drawGrid cellSize color = do
  forM_ [0, cellSize .. screenW] $ \x ->
    Shapes.drawLine x 36 x screenH color
  forM_ [36, 36 + cellSize .. screenH] $ \y ->
    Shapes.drawLine 0 y screenW y color

drawGridIntoRT :: Int -> Color -> IO ()
drawGridIntoRT cellSize color = do
  forM_ [0, cellSize .. 512] $ \x ->
    Shapes.drawLine x 0 x 512 color
  forM_ [0, cellSize .. 512] $ \y ->
    Shapes.drawLine 0 y 512 y color

-- | A small hand-picked palette: (label, color).
palette :: [(String, Color)]
palette =
  [ ("rayWhite", C.rayWhite)
  , ("lightGray", C.lightGray)
  , ("gray", C.gray)
  , ("darkGray", C.darkGray)
  , ("red", C.red)
  , ("orange", C.orange)
  , ("yellow", C.yellow)
  , ("green", C.green)
  , ("skyBlue", C.skyBlue)
  , ("blue", C.blue)
  , ("purple", C.purple)
  , ("magenta", C.magenta)
  ]

drawSwatches :: Int -> Int -> Int -> [(String, Color)] -> IO ()
drawSwatches x0 y0 swatchSize xs = do
  forM_ (zip [0 :: Int ..] xs) $ \(i, (name, col)) -> do
    let x = x0 + (i `mod` 6) * (swatchSize + 10)
    let y = y0 + (i `div` 6) * (swatchSize + 34)
    Shapes.drawRectangle x y swatchSize swatchSize col
    Shapes.drawRectangleLines x y swatchSize swatchSize C.darkGray
    Text.drawText name x (y + swatchSize + 6) 16 C.darkGray

blendModes :: [BlendMode]
blendModes =
  [ BlendAlpha
  , BlendAdditive
  , BlendMultiplied
  , BlendSubtractColors
  , BlendAlphaPremultiply
  ]

currentBlendMode :: DemoState -> BlendMode
currentBlendMode st =
  blendModes !! (stBlendModeIx st `mod` length blendModes)

blendModeName :: BlendMode -> String
blendModeName = \case
  BlendAlpha -> "alpha"
  BlendAdditive -> "additive"
  BlendMultiplied -> "multiplied"
  BlendAddColors -> "add colors"
  BlendSubtractColors -> "subtract colors"
  BlendAlphaPremultiply -> "alpha premultiply"
  BlendCustom -> "custom"
  BlendCustomSeparate -> "custom separate"

textureFilterName :: TextureFilter -> String
textureFilterName = \case
  TextureFilterPoint -> "point (pixelated)"
  TextureFilterBilinear -> "bilinear (smooth)"
  TextureFilterTrilinear -> "trilinear"
  TextureFilterAnisotropic4x -> "anisotropic 4x"
  TextureFilterAnisotropic8x -> "anisotropic 8x"
  TextureFilterAnisotropic16x -> "anisotropic 16x"

toggleTextureFilter :: TextureFilter -> TextureFilter
toggleTextureFilter = \case
  TextureFilterPoint -> TextureFilterBilinear
  _ -> TextureFilterPoint

nextEnum :: (Eq a, Enum a, Bounded a) => a -> a
nextEnum x
  | x == maxBound = minBound
  | otherwise = succ x

prevEnum :: (Eq a, Enum a, Bounded a) => a -> a
prevEnum x
  | x == minBound = maxBound
  | otherwise = pred x

clamp :: Ord a => a -> a -> a -> a
clamp lo hi =
  max lo . min hi

-- | Generate star points in screen space.
--
-- This is intentionally pure; the rendering functions can consume the resulting points.
starPoints :: Vector2 -> Float -> Float -> Int -> Float -> [Vector2]
starPoints (Vector2 cx cy) outer inner spikes rotDeg =
  [ Vector2 (cx + r * cos a) (cy + r * sin a)
  | i <- [0 .. spikes * 2 - 1]
  , let r = if even i then outer else inner
  , let a = degToRad (rotDeg + fromIntegral i * (360 / fromIntegral (spikes * 2)) - 90)
  ]

degToRad :: Float -> Float
degToRad deg =
  deg * pi / 180