2021-12-28 00:46:39 -05:00
|
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
{-# LANGUAGE TypeApplications #-}
|
|
|
|
|
|
|
|
module Graphics.Display where
|
|
|
|
|
|
|
|
import Control.Monad.Representable.Reader
|
|
|
|
import Data.Maybe (mapMaybe)
|
|
|
|
import GOL.Space
|
|
|
|
import Graphics.Gloss
|
|
|
|
|
2021-12-28 11:21:26 -05:00
|
|
|
-- * Drawing the display grid
|
|
|
|
|
2021-12-28 00:46:39 -05:00
|
|
|
square :: Float -> Point -> Picture
|
|
|
|
square size (x, y) = translate (x + size / 2) y (rectangleUpperSolid size size)
|
|
|
|
|
|
|
|
squareAtIndex :: (Int, Int) -> Float -> Picture
|
|
|
|
squareAtIndex (x, y) size = square size (fromIntegral x * size, fromIntegral y * size)
|
|
|
|
|
|
|
|
drawCell :: DisplayableSpace f => f Bool -> (Int, Int) -> Float -> Maybe Picture
|
|
|
|
drawCell xs pos size =
|
|
|
|
if index xs pos
|
|
|
|
then Just $ squareAtIndex pos size
|
|
|
|
else Nothing
|
|
|
|
|
2021-12-28 11:21:26 -05:00
|
|
|
drawCells :: forall f. DisplayableSpace f => f Bool -> Float -> [Picture]
|
|
|
|
drawCells xs size =
|
2021-12-28 00:46:39 -05:00
|
|
|
let poss = (,) <$> [0 .. sizex @f -1] <*> [0 .. sizey @f -1]
|
2021-12-28 11:21:26 -05:00
|
|
|
in mapMaybe (\pos -> drawCell xs pos size) poss
|
|
|
|
|
|
|
|
drawGrid :: forall f. DisplayableSpace f => f Bool -> (Int, Int) -> Picture
|
|
|
|
drawGrid xs (w, h) =
|
|
|
|
let size = fromIntegral $ if w > h then h `div` sizey @f else w `div` sizex @f
|
|
|
|
in color white $ pictures $ drawCells xs size
|