Skip to content

Instantly share code, notes, and snippets.

@funrep

funrep/helmlenses.hs

Created Aug 12, 2013
Embed
What would you like to do?
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
import Control.Applicative
import FRP.Elerea.Simple
import GHC.Float
import FRP.Helm hiding (join, x, y)
import Control.Monad
import Control.Arrow ((&&&), first, second)
import Control.Lens
import Control.Monad.Trans.Class
import Control.Monad.Trans.State
import System.IO.Unsafe
import qualified FRP.Helm.Keyboard as Keyboard
import qualified FRP.Helm.Window as Window
type Vector = (Float, Float)
instance (Num a, Num b) => Num (a,b) where
(x,y) + (x2,y2) = (x + x2, y + y2)
(x,y) - (x2,y2) = (x - x2, y - y2)
(*) = undefined
abs = abs.fst &&& abs.snd
negate = negate.fst &&& negate.snd
signum = signum.fst &&& signum.snd
fromInteger = fromInteger &&& fromInteger
(|*|) = \(x,y) -> ((*x) &&& (*y))
both f (x,y) = (f x, f y)
data Entity = Entity
{ _position :: Vector
}
data World = World
{ _ent :: Entity
}
makeLenses ''World
makeLenses ''Entity
x,y :: Lens' Entity Float
x = lens (fst . _position) (\entity v -> Entity {_position = (v, fst . _position $ entity) })
y = lens (snd . _position) (\entity v -> Entity {_position = (snd . _position $ entity, v) })
render :: (Int, Int) -> World -> Element
render (w,h) wrld = collage w h [move (float2Double (wrld^.ent.x), float2Double (wrld^.ent.y)) $ filled white $ square 100]
main :: IO ()
main = run $ do
dimensions <- Window.dimensions
world <- stateful initWorld (\a -> unsafePerformIO $ execStateT update a)
return $ render <$> dimensions <*> world
initWorld :: World
initWorld = World {_ent = Entity (0,0)}
liftSignal :: SignalGen (Signal a) -> StateT s IO a
liftSignal = lift . join . start
update :: StateT World IO ()
update = do
arrows <- liftSignal Keyboard.arrows
ent.position += both int2Float arrows
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.