module Main where
import Zero ( back, forw )
import Nove
import Nove.Verse
import Nove.Cells
import Nove.Draw.Ansi
import Terminal.Game
import System.Random ( randoms, initStdGen )
import Data.Colour.RGBSpace ( RGB (..) )
import Data.Colour.RGBSpace.HSV ( hsv )
import Data.Bifunctor ( bimap )
import Data.IntMap qualified as IntMap
import Control.Monad ( join )
-- Game IO loop
main :: IO ()
main = do
   r <- randoms <$> initStdGen
   io 19
      State { play = True , algo = Terra , center = 0 , rand = drop size r }
      (noise r $ verse size)
size :: Int
size = 17
noise :: [Int] -> Verse Hex -> Verse Hex
noise r v = v { nodes = IntMap.mapWithKey (\k -> const $ Hex $ mod (r !! k) 8) $ nodes v }
newtype Hex = Hex Int
   deriving (Eq, Enum, Ord, Num)
instance Bounded Hex where
   minBound = Hex 0
   maxBound = Hex 7
instance Atom Hex where
   void = minBound
data State = State { play :: Bool , algo :: Algo , center :: Int , rand :: [Int] }
data Algo = Terra | Terr2 | Waves | Pulse | Dois | Bees | Fish | Fish2 | Glider
   deriving (Show, Eq, Enum, Bounded)
cells :: Automaton State Hex
cells = Automaton f
   where
   f :: Cell State Hex
   f s
      | Terra  <- algo s = terra 1 s
      | Terr2  <- algo s = terra 2 s
      | Waves  <- algo s = waves s
      | Pulse  <- algo s = pulse s
      | Dois   <- algo s = dois s
      | Bees   <- algo s = bees s
      | Fish   <- algo s = gene [2] [2] 3 s
      | Fish2  <- algo s = gene [2,4] [2,4] 3 s
      | Glider <- algo s = gene [1,3,4] [2,3,4,5] 5 s
instance Ansi State Hex where
   logic :: GEnv -> (State,Verse Hex) -> Event -> Either () (State,Verse Hex)
   logic _ (s,v) e
      | KeyPress 'q' <- e = Left ()
      | 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)
      | KeyPress 'r' <- e = Right (s { rand = drop size $ rand s } , noise (rand s) v )
      | KeyPress 's' <- e = Right (s { algo = forw $ algo s } , v)
      | KeyPress 'S' <- e = Right (s { algo = back $ algo s } , v)
      | KeyPress 'p' <- e = Right (s { play = not $ play s } , v)
      | KeyPress '.' <- e = Right (s { play = False } , v')
      | play s, Tick <- e = Right (s , v')
      | otherwise = Right (s , v)
      where
      v' = sim cells s v
   draw :: GEnv -> (State,Verse Hex) -> Plane
   draw e (s,v) = centerFull e $ hcat [hex,ui] & (1,1) % makeTransparent ' ' (word "cells demo")
      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) = c %.< cell (" ·~+=≠co" !! fromEnum h) # k
         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)
         k :: Draw
            | 0 <- fromEnum h , play s = paletteColor $ xterm6LevelRGB 0 1 0
            | 1 <- fromEnum h , play s = paletteColor $ xterm6LevelRGB 0 1 1
            | 2 <- fromEnum h , play s = paletteColor $ xterm6LevelRGB 1 1 2
            | 3 <- fromEnum h , play s = paletteColor $ xterm6LevelRGB 2 1 3
            | 4 <- fromEnum h , play s = paletteColor $ xterm6LevelRGB 3 1 4
            | 5 <- fromEnum h , play s = paletteColor $ xterm6LevelRGB 4 2 5
            | 6 <- fromEnum h , play s = paletteColor $ xterm6LevelRGB 5 3 5
            | 7 <- fromEnum h , play s = paletteColor $ xterm6LevelRGB 5 4 5
            | 0 <- fromEnum h = paletteColor $ xterm24LevelGray 2
            | 1 <- fromEnum h = paletteColor $ xterm24LevelGray 5
            | 2 <- fromEnum h = paletteColor $ xterm24LevelGray 8
            | 3 <- fromEnum h = paletteColor $ xterm24LevelGray 11
            | 4 <- fromEnum h = paletteColor $ xterm24LevelGray 14
            | 5 <- fromEnum h = paletteColor $ xterm24LevelGray 17
            | 6 <- fromEnum h = paletteColor $ xterm24LevelGray 23
            | 7 <- fromEnum h = paletteColor $ xterm24LevelGray 23
            | otherwise = paletteColor $ xterm24LevelGray 0
      ui :: Plane
      ui = foldl (&) canvas
         [ (1,1) % vcat [info] # color Cyan Dull
         ]
         where
         info :: Plane
         info = word $ show $ algo s

module Nove.Draw.Ansi where
import Nove.Verse
import Terminal.Game
-- Game IO loop
class Atom a => Ansi state a where
   logic :: GEnv -> (state,Verse a) -> Event -> Either () (state,Verse a)
   draw :: GEnv -> (state,Verse a) -> Plane
io :: Ansi state a => TPS -> state -> Verse a -> IO ()
io tps s v = do
   playGame $ Game
      { gTPS = tps
      , gInitState = (s,v)
      , gLogicFunction = logic
      , gDrawFunction = draw
      }