Main.hs

module Main where

import GridProto.Classic
import GridProto.Core

main :: IO ()
main = runClassic classic

classic :: Classic (Int, Int, Bool)
classic = Classic
  { title = "Hello World"
  , rows = sides
  , cols = sides
  , tilePixelSize = 64
  , backgroundColor = Black2
  , setupFn = return (0, 0, False)
  , updateFn = update
  , cleanupFn = const (return ())
  , tileMapFn = tileMap sides
  , sfxFn = \(x,y,_) -> if x == 7 && y == 7 then [Achievement] else []
  , quitFn = quit
  }
  where
    sides = 8

update :: Input -> (Int, Int, Bool) -> IO (Int, Int, Bool)
update Input{mouse=Mouse{mousePosition=(mx,my),mouseButton=mouseButton},keys=keys} _
  | mouseButton == Pressed = return (mx,my, mx == 0 && my == 0)
  | otherwise = return (mx, my, lookupKey keys Escape == Released)

tileMap :: Int -> (Int, Int, Bool) -> Map (Int, Int) Tile
tileMap sides (mx,my,click) = fromList $ do
  y <- [0..(sides - 1)]
  x <- [0..(sides - 1)]
  let color = Just $
        if (mx,my) == (x,y)
          -- Mouse color
          then if click then Green1 else Red1
          -- Alternate background colors
          else if (x + y) `mod` 2 == 0 then Brown1 else Brown2
  let (symbol, shape) =
        if (x + y) `mod` 2 == 1
          then (Nothing, Nothing)
          else if y >= 0 && y <= 2
            then (Just ('W', White1), Just (Circle,  White1))
            else if y >= 5 && y <= 7
              then (Just ('B', Black1), Just (Circle, Black1))
              else (Nothing, Nothing)
  return ((x,y), Tile symbol shape color)


quit :: (Int, Int, Bool) -> Bool
quit (_,_,True) = True
quit _ = False