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