Add a unified Graphics.Config datatype
This commit is contained in:
parent
37ac2e0aef
commit
a53e0204c0
12
Graphics/Config.hs
Normal file
12
Graphics/Config.hs
Normal file
|
@ -0,0 +1,12 @@
|
||||||
|
module Graphics.Config where
|
||||||
|
|
||||||
|
import FRP.Yampa (Time)
|
||||||
|
import GOL.Rule (Rule)
|
||||||
|
import Graphics.Gloss (Color)
|
||||||
|
|
||||||
|
data Config = Config
|
||||||
|
{ cellColor :: Color,
|
||||||
|
rule :: Rule,
|
||||||
|
tickRate :: Time,
|
||||||
|
windowSize :: (Int, Int)
|
||||||
|
}
|
|
@ -6,6 +6,7 @@ module Graphics.Display where
|
||||||
import Control.Monad.Representable.Reader
|
import Control.Monad.Representable.Reader
|
||||||
import Data.Maybe (mapMaybe)
|
import Data.Maybe (mapMaybe)
|
||||||
import GOL.Space
|
import GOL.Space
|
||||||
|
import Graphics.Config
|
||||||
import Graphics.Gloss
|
import Graphics.Gloss
|
||||||
|
|
||||||
-- * Drawing the display grid
|
-- * Drawing the display grid
|
||||||
|
@ -27,7 +28,8 @@ drawCells xs size =
|
||||||
let poss = (,) <$> [0 .. sizex @f -1] <*> [0 .. sizey @f -1]
|
let poss = (,) <$> [0 .. sizex @f -1] <*> [0 .. sizey @f -1]
|
||||||
in mapMaybe (\pos -> drawCell xs pos size) poss
|
in mapMaybe (\pos -> drawCell xs pos size) poss
|
||||||
|
|
||||||
drawGrid :: forall f. DisplayableSpace f => f Bool -> (Int, Int) -> Picture
|
drawGrid :: forall f. DisplayableSpace f => Config -> f Bool -> Picture
|
||||||
drawGrid xs (w, h) =
|
drawGrid config xs =
|
||||||
let size = fromIntegral $ if w > h then h `div` sizey @f else w `div` sizex @f
|
let (w, h) = windowSize config
|
||||||
in color white $ pictures $ drawCells xs size
|
size = fromIntegral $ if w > h then h `div` sizey @f else w `div` sizex @f
|
||||||
|
in color (cellColor config) $ pictures $ drawCells xs size
|
|
@ -12,6 +12,7 @@ executable main
|
||||||
GOL.Space,
|
GOL.Space,
|
||||||
GOL.Engine,
|
GOL.Engine,
|
||||||
Graphics.GlossUtils,
|
Graphics.GlossUtils,
|
||||||
|
Graphics.Config,
|
||||||
Graphics.Engine,
|
Graphics.Engine,
|
||||||
Graphics.Display
|
Graphics.Display
|
||||||
build-depends: base,
|
build-depends: base,
|
||||||
|
|
Loading…
Reference in a new issue