module Data.Component.Basic where
import Data.Aeson
import Data.Aeson.Types
import Data.Typeable
import qualified SDL
import qualified SDL.Vect as Vect
import MiniLight
data Config = Config {
size :: Vect.V2 Int,
position :: Vect.V2 Int
}
instance FromJSON Config where
parseJSON = withObject "config" $ \v -> do
sizeMaybe <- v .:? "size"
size <- (\w -> maybe (return 0) w sizeMaybe) $ withObject "size" $ \v ->
Vect.V2 <$> v .: "width" <*> v .: "height"
positionMaybe <- v .:? "position"
position <- (\w -> maybe (return 0) w positionMaybe) $ withObject "position" $ \v ->
Vect.V2 <$> v .: "x" <*> v .: "y"
return $ Config size position
wrapConfig
:: (Config -> a -> Parser r) -> (Object -> Parser a) -> Value -> Parser r
wrapConfig f p = withObject "wrapConfig" $ \v -> do
other <- p v
conf <- parseJSON (Object v)
f conf other
areaRectangle :: Config -> SDL.Rectangle Int
areaRectangle conf = SDL.Rectangle (SDL.P (position conf)) (size conf)
data Signal where
MousePressed
:: Vect.V2 Int
-> Signal
MouseReleased
:: Vect.V2 Int
-> Signal
MouseOver
:: Vect.V2 Int
-> Signal
deriving Typeable
instance EventType Signal where
getEventType (MousePressed _) = "mouse-pressed"
getEventType (MouseReleased _) = "mouse-released"
getEventType (MouseOver _) = "mouse-over"
wrapFigures :: Config -> [Figure] -> [Figure]
wrapFigures conf = map (translate (position conf))
wrapSignal
:: ( HasLightEnv env
, HasLoopEnv env
, HasComponentEnv env
, MonadIO m
, ComponentUnit c
)
=> (c -> Config)
-> (Event -> c -> LightT env m c)
-> (Event -> c -> LightT env m c)
wrapSignal getter f ev comp = do
emitBasicSignal ev (getter comp)
f ev comp
emitBasicSignal
:: (HasLightEnv env, HasLoopEnv env, HasComponentEnv env, MonadIO m)
=> Event
-> Config
-> LightT env m ()
emitBasicSignal (RawEvent (SDL.Event _ (SDL.MouseMotionEvent (SDL.MouseMotionEventData _ _ _ (SDL.P pos) _)))) conf
| contains (areaRectangle conf) (fmap fromEnum pos)
= emit $ MouseOver $ fmap fromEnum pos - position conf
emitBasicSignal (RawEvent (SDL.Event _ (SDL.MouseButtonEvent (SDL.MouseButtonEventData _ state _ _ _ (SDL.P pos))))) conf
| contains (areaRectangle conf) (fmap fromEnum pos)
= emit
$ ( case state of
SDL.Pressed -> MousePressed
SDL.Released -> MouseReleased
)
$ fmap fromEnum pos
- position conf
emitBasicSignal _ _ = return ()
contains :: (Ord a, Num a) => SDL.Rectangle a -> Vect.V2 a -> Bool
contains (SDL.Rectangle (Vect.P (Vect.V2 x y)) (Vect.V2 w h)) (Vect.V2 px py) =
x <= px && px <= x + w && y <= py && py <= y + h