module Main where

import Nove
import Nove.Verse

import Zero ( total )

import Terminal.Game
import System.Random ( randoms, initStdGen )
import Data.Colour.RGBSpace ( RGB (..) )
import Data.Colour.RGBSpace.HSV ( hsv )
import Data.Maybe ( isJust )
import Data.Foldable ( find )
import Data.Bifunctor ( bimap )
import Data.Map as Map ( Map, assocs, toAscList, filterWithKey )
import Data.IntMap ( (!) )
import Control.Monad ( join )
import Control.Applicative ( (<|>) )

-- Game IO loop

main :: IO ()
main = do
   (r:rs) <- randoms <$> initStdGen
   playGame $ Game
      { gTPS = 90
      , gInitState = (State { center = r , rand = r },set (Hex { look = pick r total , seed = rs , parent = Nothing , i = 1 }) 0 (verse size))
      , gLogicFunction = logic
      , gDrawFunction = draw
      }

size :: Int
size = 11

pick :: Int -> [a] -> Maybe a
pick i ls
   | null ls = Nothing
   | otherwise = Just $ ls !! mod i (length ls)

data Hex = Hex { look :: Maybe Dir , seed :: [Int] , parent :: Maybe Dir , i :: Int }

instance Atom Hex where
   void = Hex { look = Nothing , seed = [] , parent = Nothing , i = 0 }
   move = const Nothing
   lock = const True

data State = State { center :: Int , rand :: Int }

logic :: GEnv -> (State,Verse Hex) -> Event -> Either () (State,Verse Hex)
logic _ (s,v) e
   | Tick <- e = Right (s,sim maze () v)
   | KeyPress 'r' <- e , r : rs <- seed (nodes v ! 0) = Right (s { rand = r },set (Hex { look = pick r total , seed = rs , parent = Nothing , i = 1 }) 0 (verse size))
   | KeyPress 'h' <- e = Right (s { center = shift v 1 H $ center s },v)
   | KeyPress 'j' <- e = Right (s { center = shift v 1 N $ center s },v)
   | KeyPress 'k' <- e = Right (s { center = shift v 1 I $ center s },v)
   | KeyPress 'l' <- e = Right (s { center = shift v 1 L $ center s },v)
   | otherwise = Right (s,v)

draw :: GEnv -> (State,Verse Hex) -> Plane
draw e (s,v) = centerFull e $ hcat [hex,ui] & (1,1) % makeTransparent ' ' (word "hex maze")
   where

   canvas :: Plane
   canvas = blankPlane (2 * succ (2 * size) + 2) (succ (2 * size) + 2)

   hex :: Plane
   hex = foldl (&) canvas [ write (x,y) | x <- [-size..size] , y <- [-size..size] , abs (x + y) <= size ]

   spectrum :: Int -> Colour Float
   spectrum i = sRGB r g b
     where

     RGB r g b = hsv (fromIntegral (mod i n) / fromIntegral n * 360) 1 1
     n = 6 * size * size

   write :: (Int,Int) -> Draw
   write (x,y)
      | Just _ <- look h = c %.< cell '*' # color White Dull
      | 0 < i h = c %.< cell 'o' # rgbColor (spectrum $ i h + rand s)
      | otherwise = c %.< cell ' '
      where

      h :: Hex
      h = node v n

      -- get index of node taking scroll into account
      n :: Int
      n = shift v mx L . shift v my I $ coordToIndex v (mod (x - div y size * size) (3 * size) , mod y size)
         where

         (mx,my) = indexToCoord v (center s)

      -- stretch, tilt, margin, translate to library coordinate system (1-based (y,x))
      c :: (Int,Int)
      c = join bimap succ (y + size , 2 * (x + size) + y)

   ui :: Plane
-- ui = word "> ui content here <"
   ui = foldl (&) canvas
      [ (1,1) % vcat [info]
      ]
      where

      info :: Plane
         | Just h <- find (isJust . look) $ nodes v = stringPlane $ unlines $ unwords <$>
            [ ["value:" , show $ i h]
            , ["look:" , show $ look h]
            , ["anchor:" , show $ parent h]
            ]
         | otherwise = word "none"  # color Red Vivid

maze :: Automata () Hex
maze = Automata f
   where

   f :: () -> Map Dir Hex -> Hex -> Hex
   f () ns h
      -- new
      | Just (dir,n) <- looker , r : rs <- seed n , 0 <- i h = h { look = go r <|> Just dir , seed = rs , parent = Just dir , i = succ (i n) }
      -- backtrace/branch
      | Just _       <- looker , r : rs <- seed h            = h { look = go r <|> parent h , seed = rs }
      -- sleep
      | otherwise                                            = h { look = Nothing }
      where

      -- backtrace/branch
      go :: Int -> Maybe Dir
      go r = pick r (fst <$> filter ((== 0) . i . snd) (toAscList ns))

      looker :: Maybe (Dir,Hex)
      looker
         | a : _ <- assocs $ filterWithKey l ns = Just a
         | otherwise = Nothing
         where

         l :: Dir -> Hex -> Bool
         l dir n
            | Just d <- look n = dir == opposite d
            | otherwise = False