module Main where ------------- -- Imports -- import FRP.Spice.Graphics import FRP.Spice.Math import FRP.Spice import Data.Default ---------- -- Code -- -- Some directions up, down, left, right :: Vector Float up = Vector ( 0) ( 1) down = Vector ( 0) (-1) left = Vector (-1) ( 0) right = Vector ( 1) ( 0) -- The speed in which pos should move speedCfg :: Float speedCfg = 0.5 -- The size rendered squares should take size :: Float size = 0.05 -- Applying the speed to a vector speed :: DeltaTime -> Vector Float -> Vector Float speed dt vec = vec * Vector (speedCfg * dt) (speedCfg * dt) -- A basic game type data BasicGame = BasicGame { pos :: Vector Float , mousePos :: Vector Float } -- Updating the game updatePos :: DeltaTime -> Input -> BasicGame -> BasicGame updatePos dt input game = move dt game [ (keyboard input ! CharKey 'W', speed dt up ) , (keyboard input ! CharKey 'S', speed dt down ) , (keyboard input ! CharKey 'A', speed dt left ) , (keyboard input ! CharKey 'D', speed dt right) ] where move :: DeltaTime -> BasicGame -> [(Bool, Vector Float)] -> BasicGame move dt game [] = game move dt game@(BasicGame pos _) ((True , d):xs) = move dt (game { pos = pos + d }) xs move dt game ((False, _):xs) = move dt game xs -- Updating the mouse position updateMousePosition :: Input -> BasicGame -> BasicGame updateMousePosition input game@(BasicGame _ mousePos) = game { mousePos = mousePosition input } updateGame :: DeltaTime -> Input -> BasicGame -> BasicGame updateGame dt input game = updateMousePosition input $ updatePos dt input game -- Rendering the game renderGame :: BasicGame -> Scene renderGame (BasicGame pos mousePos) = do bindColor $ color3i 0 0 255 renderRectangle ((mousePos * Vector 0 1) - (Vector 1 0)) $ Vector 2 2 bindColor $ color3i 255 0 0 renderSquare pos size bindColor $ color3i 0 255 0 renderSquare mousePos size -- Giving BasicGame a Game instance. instance Game BasicGame where update dt input game = updateGame dt input game render game = renderGame game -- Starting the game main :: IO () main = startEngine defaultWindowConfig $ BasicGame def def