Main.hs

module Main where

import GridProto.Classic
import GridProto.Core

main :: IO ()
main = runClassic classic

classic :: Classic (Int, Int, Color)
classic = Classic
  { title = "Controller Example"
  , rows = sides
  , cols = sides
  , tilePixelSize = 64
  , backgroundColor = Black2
  , setupFn = return (halfSide, halfSide, Red0)
  , updateFn = update
  , cleanupFn = const (return ())
  , tileMapFn = tileMap
  , sfxFn = const []
  , quitFn = const False
  }
  where

sides, halfSide :: Int
sides = 9
halfSide = sides `div` 2

update :: Input -> (Int, Int, Color) -> IO (Int, Int, Color)
update input (_,_,color) = return $ let
  color' = case (aButton c, bButton c, xButton c, yButton c) of
    (Pressed,_,_,_) -> Red0
    (_,Pressed,_,_) -> Blue0
    (_,_,Pressed,_) -> Green0
    (_,_,_,Pressed) -> Yellow0
    _ -> color
  axis = leftAxis c
  adjust v = halfSide + round (fromIntegral halfSide * v)
  in (adjust (xAxis axis), adjust (yAxis axis), color')
  where
    c = controller1 input

tileMap :: (Int, Int, Color) -> Map (Int, Int) Tile
tileMap (x,y,color) = fromList [((x,y), Tile Nothing shape Nothing)]
  where
    shape = Just $ (FillCircle, color)