mirror of
https://github.com/z0w0/helm.git
synced 2024-09-11 04:15:32 +03:00
Separating out engine functions, adding extra functions to the Engine typeclass but makes it more consistent (gives less space for the engines to do stuff they shouldn't). Additionally, cleaning the code and working on documentation.
This commit is contained in:
parent
1b1af4bc1f
commit
410f86eb9c
@ -10,3 +10,6 @@ insert_final_newline = true
|
|||||||
|
|
||||||
[*.md]
|
[*.md]
|
||||||
trim_trailing_whitespace = false
|
trim_trailing_whitespace = false
|
||||||
|
|
||||||
|
[*.hs]
|
||||||
|
max_line_length = 120
|
2
LICENSE
2
LICENSE
@ -1,4 +1,4 @@
|
|||||||
Copyright (C) 2013-2014, Zack Corr
|
Copyright (C) 2013-2016, Zack Corr
|
||||||
|
|
||||||
Permission is hereby granted, free of charge, to any person obtaining a copy
|
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
of this software and associated documentation files (the "Software"), to
|
of this software and associated documentation files (the "Software"), to
|
||||||
|
100
README.md
100
README.md
@ -12,16 +12,19 @@ the [Elerea FRP framework](https://github.com/cobbpg/elerea). Helm was
|
|||||||
originally inspired by the [Elm programming language](http://elm-lang.org).
|
originally inspired by the [Elm programming language](http://elm-lang.org).
|
||||||
|
|
||||||
In Helm, every piece of input that can be gathered from a user (or the operating system)
|
In Helm, every piece of input that can be gathered from a user (or the operating system)
|
||||||
is hidden behind a subscription. For those unfamiliar with FRP, signals are essentially
|
is contained in a subscription, which is essentially
|
||||||
a value that changes over time. This sort of architecture used for a game allows for pretty
|
as a collection of input events changing over time. Think of it this way - when you hold down
|
||||||
simplistic (and in my opinion, artistic) code.
|
the w and s keys, two keyboard events are being captured at every moment. In this case, a subscription to keyboard presses
|
||||||
|
would then yield you with a collection of two events at every game tick.
|
||||||
|
|
||||||
Documentation of the Helm API is available on [Hackage](http://hackage.haskell.org/package/helm).
|
Helm provides a structure similar to MVC (model-view-controller).
|
||||||
There is currently a heavily work-in-progress guide on [Helm's website](http://helm-engine.org/guide),
|
There is a model (which represents the state of your game),
|
||||||
which is a resource aiming to give thorough explanations of the way Helm and its API work through examples.
|
a view of the current model (i.e. what's actually shown on the screen) and a controller that folds the model
|
||||||
You can [ask on the mailing list](https://groups.google.com/d/forum/helm-dev) if you're having any trouble
|
forward based off of input actions (which are mapped from the subscription events).
|
||||||
with using the engine for games or working on the engine itself, or if you just want to chit-chat about
|
|
||||||
Helm.
|
This presents a powerful paradigm shift for game development. Instead of writing event listeners,
|
||||||
|
Helm treats input events as first-class citizens of the type system, and the actual interaction between
|
||||||
|
the game state and input events becomes immediately clearer.
|
||||||
|
|
||||||
## Features
|
## Features
|
||||||
|
|
||||||
@ -51,67 +54,37 @@ Helm.
|
|||||||
* `Helm.Utilities` contains an assortment of useful functions,
|
* `Helm.Utilities` contains an assortment of useful functions,
|
||||||
* `Helm.Window` contains signals for working with the game window state.
|
* `Helm.Window` contains signals for working with the game window state.
|
||||||
|
|
||||||
## Example
|
|
||||||
|
|
||||||
The simplest example of a Helm game that doesn't require any input from the user is the following:
|
|
||||||
|
|
||||||
```haskell
|
|
||||||
import Helm
|
|
||||||
import qualified Helm.Window as Window
|
|
||||||
|
|
||||||
render :: (Int, Int) -> Element
|
|
||||||
render (w, h) = collage w h [move (100, 100) $ filled red $ square 64]
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = run defaultConfig $ render <~ Window.dimensions
|
|
||||||
```
|
|
||||||
|
|
||||||
It renders a red square at the position `(100, 100)` with a side length of `64`.
|
|
||||||
|
|
||||||
The next example is the barebones of a game that depends on input. It shows how to create
|
|
||||||
an accumulated state that depends on the values sampled from signals (e.g. mouse input).
|
|
||||||
You should see a white square on the screen and pressing the arrow keys allows you to move it.
|
|
||||||
|
|
||||||
```haskell
|
|
||||||
import Helm
|
|
||||||
import qualified Helm.Keyboard as Keyboard
|
|
||||||
import qualified Helm.Window as Window
|
|
||||||
|
|
||||||
data State = State { mx :: Double, my :: Double }
|
|
||||||
|
|
||||||
step :: (Int, Int) -> State -> State
|
|
||||||
step (dx, dy) state = state { mx = (10 * (realToFrac dx)) + mx state,
|
|
||||||
my = (10 * (realToFrac dy)) + my state }
|
|
||||||
|
|
||||||
render :: (Int, Int) -> State -> Element
|
|
||||||
render (w, h) (State { mx = mx, my = my }) =
|
|
||||||
centeredCollage w h [move (mx, my) $ filled white $ square 100]
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = run defaultConfig $ render <~ Window.dimensions ~~ stepper
|
|
||||||
where
|
|
||||||
state = State { mx = 0, my = 0 }
|
|
||||||
stepper = foldp step state Keyboard.arrows
|
|
||||||
```
|
|
||||||
|
|
||||||
## Installing and Building
|
## Installing and Building
|
||||||
|
|
||||||
Helm requires GHC 7.6 (Elerea doesn't work with older versions due to a compiler bug).
|
Before you can install Helm, you'll to follow the
|
||||||
To install the latest (stable) version from the Hackage repository, use:
|
[Gtk2Hs installation guide](https://wiki.haskell.org/Gtk2Hs/Installation)
|
||||||
|
(which is required for the Haskell Cairo bindings). Additionally, Helm
|
||||||
|
requires a GHC version of 7.6 or higher.
|
||||||
|
|
||||||
|
To install the latest stable version from the Hackage repository, use:
|
||||||
|
|
||||||
```
|
```
|
||||||
cabal install helm
|
cabal install helm
|
||||||
```
|
```
|
||||||
|
|
||||||
Alternatively to get the latest development version, you can clone this repository and then run:
|
Alternatively to get the latest development version run:
|
||||||
|
|
||||||
```
|
```
|
||||||
|
git clone git://github.com/z0w0/helm.git
|
||||||
|
cd helm
|
||||||
cabal install
|
cabal install
|
||||||
```
|
```
|
||||||
|
|
||||||
You may need to jump a few hoops to install the Cairo bindings (which are a dependency),
|
## Getting Started
|
||||||
which unfortunately is out of my hands. Read the [installing guide](http://helm-engine.org/guide/installing/)
|
|
||||||
on the website for a few platform-specific instructions.
|
Check out the `examples` directory for some examples; the `hello` example is a particularly good start.
|
||||||
|
Unfortunately, there's little to no example games yet, so if you end up making something cool and lightweight
|
||||||
|
that you'd think would be a good example, feel free to open a pull request!
|
||||||
|
|
||||||
|
## Documentation
|
||||||
|
|
||||||
|
API documentation for the latest stable version of Helm is available on [Hackage](http://hackage.haskell.org/package/helm).
|
||||||
|
Alternatively, if you've cloned this repo, you can build the documentation manually using Haddock.
|
||||||
|
|
||||||
## License
|
## License
|
||||||
|
|
||||||
@ -124,12 +97,5 @@ Helm would benefit from either of the following contributions:
|
|||||||
1. Try out the engine, reporting any issues or suggestions you have.
|
1. Try out the engine, reporting any issues or suggestions you have.
|
||||||
2. Look through the source, get a feel for the code and then
|
2. Look through the source, get a feel for the code and then
|
||||||
contribute some features or fixes. If you plan on contributing
|
contribute some features or fixes. If you plan on contributing
|
||||||
code please submit a pull request and follow the formatting
|
code, please follow [Johan Tibell's Haskell style guide](https://github.com/tibbe/haskell-style-guide/blob/master/haskell-style.md)
|
||||||
styles set out in the current code: 2 space indents, documentation
|
- with one exception allowed - line length may be up to 120 characters (wide screens for life).
|
||||||
on every top-level function, favouring monad operators over
|
|
||||||
do blocks when there is a logical flow of data, spaces between operators
|
|
||||||
and after commas, etc. Please also confirm that the code passes under
|
|
||||||
HLint.
|
|
||||||
|
|
||||||
There are a number of issues [tagged with the bounty tag](https://github.com/switchface/helm/issues?labels=bounty&state=open),
|
|
||||||
meaning they have associated bounties on [Bountysource](https://www.bountysource.com/trackers/290443-helm).
|
|
||||||
|
61
src/Helm.hs
61
src/Helm.hs
@ -13,5 +13,64 @@ module Helm
|
|||||||
,loadSound)
|
,loadSound)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Helm.Engine (Cmd(..), Sub(..), GameConfig(..), Engine(run, loadImage, loadSound))
|
import Control.Exception (finally)
|
||||||
|
import Control.Monad (foldM, void)
|
||||||
|
import Control.Monad.Trans.State.Lazy (evalStateT)
|
||||||
|
import FRP.Elerea.Param (start, embed)
|
||||||
|
|
||||||
|
import Helm.Engine (Cmd(..), Sub(..), GameConfig(..), Engine(..))
|
||||||
import Helm.Graphics
|
import Helm.Graphics
|
||||||
|
|
||||||
|
{-| A data structure describing a game's state (that is running under an engine). -}
|
||||||
|
data Game e m a = Game
|
||||||
|
{ gameConfig :: GameConfig e m a
|
||||||
|
, gameModel :: m
|
||||||
|
, actionSmp :: e -> IO [a]
|
||||||
|
}
|
||||||
|
|
||||||
|
prepare :: Engine e => e -> GameConfig e m a -> IO (Game e m a)
|
||||||
|
prepare engine config = do
|
||||||
|
{- The call to 'embed' here is a little bit hacky, but seems necessary
|
||||||
|
to get this working. This is because 'start' actually computes the signal
|
||||||
|
gen passed to it, and all of our signal gens try to fetch
|
||||||
|
the 'input' value within the top layer signal gen (rather than in the
|
||||||
|
contained signal). But we haven't sampled with the input value yet, so it'll
|
||||||
|
be undefined unless we 'embed'. -}
|
||||||
|
smp <- start $ embed (return engine) gen
|
||||||
|
|
||||||
|
return Game
|
||||||
|
{ gameConfig = config
|
||||||
|
, gameModel = fst initialFn
|
||||||
|
, actionSmp = smp
|
||||||
|
}
|
||||||
|
|
||||||
|
where
|
||||||
|
GameConfig { initialFn, subscriptionsFn = Sub gen } = config
|
||||||
|
|
||||||
|
run :: Engine e => e -> GameConfig e m a -> IO ()
|
||||||
|
run engine config = void $ (prepare engine config >>= step engine) `finally` cleanup engine
|
||||||
|
|
||||||
|
step :: Engine e => e -> Game e m a -> IO ()
|
||||||
|
step engine game = do
|
||||||
|
mayhaps <- sinkEvents engine
|
||||||
|
|
||||||
|
case mayhaps of
|
||||||
|
Nothing -> return ()
|
||||||
|
|
||||||
|
Just sunkEngine -> do
|
||||||
|
actions <- actionSmp sunkEngine
|
||||||
|
model <- foldM (stepModel sunkEngine game) gameModel actions
|
||||||
|
|
||||||
|
render sunkEngine $ viewFn model
|
||||||
|
step sunkEngine $ game { gameModel = model }
|
||||||
|
|
||||||
|
where
|
||||||
|
Game { actionSmp, gameModel, gameConfig = GameConfig { viewFn } } = game
|
||||||
|
|
||||||
|
stepModel :: Engine e => e -> Game e m a -> m -> a -> IO m
|
||||||
|
stepModel engine game model action =
|
||||||
|
evalStateT monad engine >>= foldM (stepModel engine game) upModel
|
||||||
|
|
||||||
|
where
|
||||||
|
Game { gameConfig = GameConfig { updateFn } } = game
|
||||||
|
(upModel, Cmd monad) = updateFn model action
|
||||||
|
@ -12,16 +12,27 @@ import Control.Monad.Trans.Class (lift)
|
|||||||
|
|
||||||
import Helm.Engine (Engine, Cmd(..))
|
import Helm.Engine (Engine, Cmd(..))
|
||||||
|
|
||||||
batch :: Engine e => [Cmd e a] -> Cmd e a
|
-- | Combined a list of mapped commands into a single one.
|
||||||
|
batch ::
|
||||||
|
Engine e
|
||||||
|
=> [Cmd e a] -- ^ The list of mapped commands.
|
||||||
|
-> Cmd e a -- ^ The mapped commands accumulated.
|
||||||
batch cmds = Cmd $ do
|
batch cmds = Cmd $ do
|
||||||
lists <- mapM (\(Cmd m) -> m) cmds
|
lists <- mapM (\(Cmd m) -> m) cmds
|
||||||
|
|
||||||
return $ concat lists
|
return $ concat lists
|
||||||
|
|
||||||
|
-- | A mapped command that does nothing.
|
||||||
none :: Engine e => Cmd e a
|
none :: Engine e => Cmd e a
|
||||||
none = Cmd $ return []
|
none = Cmd $ return []
|
||||||
|
|
||||||
execute :: Engine e => IO a -> (a -> b) -> Cmd e b
|
-- | Execute an IO monad and then map it to a game action.
|
||||||
|
-- This can be used as a kind of 'liftIO'.
|
||||||
|
execute ::
|
||||||
|
Engine e
|
||||||
|
=> IO b -- ^ The IO monad to execute.
|
||||||
|
-> (b -> a) -- ^ The function to map the monad result to an action.
|
||||||
|
-> Cmd e a -- ^ The mapped command.
|
||||||
execute monad f = Cmd $ do
|
execute monad f = Cmd $ do
|
||||||
result <- f <$> lift monad
|
result <- f <$> lift monad
|
||||||
|
|
||||||
|
@ -20,7 +20,9 @@ import Helm.Graphics (Graphics)
|
|||||||
class Engine e where
|
class Engine e where
|
||||||
loadImage :: e -> IO Image
|
loadImage :: e -> IO Image
|
||||||
loadSound :: e -> IO Sound
|
loadSound :: e -> IO Sound
|
||||||
run :: e -> GameConfig e m a -> IO ()
|
render :: e -> Graphics -> IO ()
|
||||||
|
sinkEvents :: e -> IO (Maybe e)
|
||||||
|
cleanup :: e -> IO ()
|
||||||
|
|
||||||
windowSize :: e -> IO (V2 Int)
|
windowSize :: e -> IO (V2 Int)
|
||||||
runningTime :: e -> IO Double
|
runningTime :: e -> IO Double
|
||||||
|
@ -11,9 +11,6 @@ module Helm.Engine.SDL
|
|||||||
,startupWith)
|
,startupWith)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Control.Exception (finally)
|
|
||||||
import Control.Monad (foldM, void)
|
|
||||||
import Control.Monad.Trans.State.Lazy (evalStateT)
|
|
||||||
import Data.Int (Int32)
|
import Data.Int (Int32)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Word (Word32)
|
import Data.Word (Word32)
|
||||||
@ -31,8 +28,7 @@ import SDL.Video (WindowConfig(..))
|
|||||||
import qualified SDL.Video.Renderer as Renderer
|
import qualified SDL.Video.Renderer as Renderer
|
||||||
|
|
||||||
import Helm.Asset
|
import Helm.Asset
|
||||||
import Helm.Engine (GameConfig(..), Cmd(..), Sub(..),
|
import Helm.Engine (Engine(..), Key, MouseButton)
|
||||||
Engine(..), Key, MouseButton)
|
|
||||||
import Helm.Graphics (Graphics(..))
|
import Helm.Graphics (Graphics(..))
|
||||||
import Helm.Graphics2D (Element)
|
import Helm.Graphics2D (Element)
|
||||||
import Helm.Engine.SDL.Keyboard (mapKey)
|
import Helm.Engine.SDL.Keyboard (mapKey)
|
||||||
@ -52,6 +48,7 @@ data SDLEngine = SDLEngine
|
|||||||
{ window :: Video.Window
|
{ window :: Video.Window
|
||||||
, renderer :: Video.Renderer
|
, renderer :: Video.Renderer
|
||||||
, engineConfig :: SDLEngineConfig
|
, engineConfig :: SDLEngineConfig
|
||||||
|
, lastMousePress :: Maybe (Word32, V2 Int32)
|
||||||
|
|
||||||
, mouseMoveEventSignal :: SignalGen SDLEngine (Signal [V2 Int])
|
, mouseMoveEventSignal :: SignalGen SDLEngine (Signal [V2 Int])
|
||||||
, mouseMoveEventSink :: V2 Int -> IO ()
|
, mouseMoveEventSink :: V2 Int -> IO ()
|
||||||
@ -73,19 +70,26 @@ data SDLEngine = SDLEngine
|
|||||||
, windowResizeEventSink :: V2 Int -> IO ()
|
, windowResizeEventSink :: V2 Int -> IO ()
|
||||||
}
|
}
|
||||||
|
|
||||||
{-| A data structure describing a game's state (that is running under an engine). -}
|
|
||||||
data SDLGame m a = SDLGame
|
|
||||||
{ gameConfig :: GameConfig SDLEngine m a
|
|
||||||
, gameModel :: m
|
|
||||||
, running :: Bool
|
|
||||||
, actionSmp :: SDLEngine -> IO [a]
|
|
||||||
, lastMousePress :: Maybe (Word32, V2 Int32)
|
|
||||||
}
|
|
||||||
|
|
||||||
instance Engine SDLEngine where
|
instance Engine SDLEngine where
|
||||||
loadImage _ = return $ Image ()
|
loadImage _ = return $ Image ()
|
||||||
loadSound _ = return $ Sound ()
|
loadSound _ = return $ Sound ()
|
||||||
|
|
||||||
|
render engine (Graphics2D element) = render2d engine element
|
||||||
|
cleanup _ = Init.quit
|
||||||
|
|
||||||
|
sinkEvents engine = do
|
||||||
|
mayhaps <- Event.pumpEvents >> Event.pollEvent
|
||||||
|
|
||||||
|
case mayhaps of
|
||||||
|
-- Handle the quit event exclusively first to simplify our code
|
||||||
|
Just Event.Event { eventPayload = Event.QuitEvent } ->
|
||||||
|
return Nothing
|
||||||
|
|
||||||
|
Just Event.Event { .. } ->
|
||||||
|
sinkEvent engine eventPayload >>= sinkEvents
|
||||||
|
|
||||||
|
Nothing -> return $ Just engine
|
||||||
|
|
||||||
mouseMoveSignal = mouseMoveEventSignal
|
mouseMoveSignal = mouseMoveEventSignal
|
||||||
mouseDownSignal = mouseDownEventSignal
|
mouseDownSignal = mouseDownEventSignal
|
||||||
mouseUpSignal = mouseUpEventSignal
|
mouseUpSignal = mouseUpEventSignal
|
||||||
@ -101,9 +105,6 @@ instance Engine SDLEngine where
|
|||||||
windowSize SDLEngine { window } =
|
windowSize SDLEngine { window } =
|
||||||
fmap (fmap fromIntegral) . SDL.get $ Video.windowSize window
|
fmap (fmap fromIntegral) . SDL.get $ Video.windowSize window
|
||||||
|
|
||||||
run engine config =
|
|
||||||
void $ (prepare engine config >>= step engine) `finally` Init.quit
|
|
||||||
|
|
||||||
{-| Creates the default configuration for the engine. You should change the
|
{-| Creates the default configuration for the engine. You should change the
|
||||||
values where necessary. -}
|
values where necessary. -}
|
||||||
defaultConfig :: SDLEngineConfig
|
defaultConfig :: SDLEngineConfig
|
||||||
@ -142,6 +143,7 @@ startupWith config@SDLEngineConfig{..} = do
|
|||||||
{ window = window
|
{ window = window
|
||||||
, renderer = renderer
|
, renderer = renderer
|
||||||
, engineConfig = config
|
, engineConfig = config
|
||||||
|
, lastMousePress = Nothing
|
||||||
|
|
||||||
, mouseMoveEventSignal = fst mouseMoveEvent
|
, mouseMoveEventSignal = fst mouseMoveEvent
|
||||||
, mouseMoveEventSink = snd mouseMoveEvent
|
, mouseMoveEventSink = snd mouseMoveEvent
|
||||||
@ -173,47 +175,6 @@ startupWith config@SDLEngineConfig{..} = do
|
|||||||
, windowResizable = windowIsResizable
|
, windowResizable = windowIsResizable
|
||||||
}
|
}
|
||||||
|
|
||||||
step :: SDLEngine -> SDLGame m a -> IO (SDLGame m a)
|
|
||||||
step engine game@SDLGame{actionSmp,gameModel,gameConfig = GameConfig{viewFn}} = do
|
|
||||||
sunkGame <- sinkEvents engine game
|
|
||||||
|
|
||||||
if running sunkGame
|
|
||||||
then do
|
|
||||||
actions <- actionSmp engine
|
|
||||||
model <- foldM (stepModel engine game) gameModel actions
|
|
||||||
|
|
||||||
render engine $ viewFn model
|
|
||||||
step engine $ sunkGame { gameModel = model }
|
|
||||||
else return sunkGame
|
|
||||||
|
|
||||||
stepModel :: SDLEngine -> SDLGame m a -> m -> a -> IO m
|
|
||||||
stepModel engine game@SDLGame { gameConfig = GameConfig { updateFn } } model action =
|
|
||||||
evalStateT monad engine >>= foldM (stepModel engine game) model
|
|
||||||
|
|
||||||
where
|
|
||||||
(model, Cmd monad) = updateFn model action
|
|
||||||
|
|
||||||
prepare :: SDLEngine -> GameConfig SDLEngine m a -> IO (SDLGame m a)
|
|
||||||
prepare engine config@GameConfig { initialFn, subscriptionsFn = Sub gen } = do
|
|
||||||
{- The call to 'embed' here is a little bit hacky, but seems necessary
|
|
||||||
to get this working. This is because 'start' actually computes the signal
|
|
||||||
gen passed to it, and all of our signal gens try to fetch
|
|
||||||
the 'input' value within the top layer signal gen (rather than in the
|
|
||||||
contained signal). But we haven't sampled with the input value yet, so it'll
|
|
||||||
be undefined unless we 'embed'. -}
|
|
||||||
smp <- start $ embed (return engine) gen
|
|
||||||
|
|
||||||
return SDLGame
|
|
||||||
{ gameConfig = config
|
|
||||||
, gameModel = fst initialFn
|
|
||||||
, running = True
|
|
||||||
, actionSmp = smp
|
|
||||||
, lastMousePress = Nothing
|
|
||||||
}
|
|
||||||
|
|
||||||
render :: SDLEngine -> Graphics -> IO ()
|
|
||||||
render engine (Graphics2D element) = render2d engine element
|
|
||||||
|
|
||||||
render2d :: SDLEngine -> Element -> IO ()
|
render2d :: SDLEngine -> Element -> IO ()
|
||||||
render2d SDLEngine{window,renderer} element = do
|
render2d SDLEngine{window,renderer} element = do
|
||||||
dims <- SDL.get $ Video.windowSize window
|
dims <- SDL.get $ Video.windowSize window
|
||||||
@ -229,60 +190,46 @@ render2d SDLEngine{window,renderer} element = do
|
|||||||
mode = Renderer.ARGB8888
|
mode = Renderer.ARGB8888
|
||||||
access = Renderer.TextureAccessStreaming
|
access = Renderer.TextureAccessStreaming
|
||||||
|
|
||||||
sinkEvents :: SDLEngine -> SDLGame m a -> IO (SDLGame m a)
|
depoint :: Point f a -> f a
|
||||||
sinkEvents engine game = do
|
|
||||||
mayhaps <- Event.pumpEvents >> Event.pollEvent
|
|
||||||
|
|
||||||
case mayhaps of
|
|
||||||
-- Handle the quit event exclusively first to simplify our code
|
|
||||||
Just Event.Event { eventPayload = Event.QuitEvent } ->
|
|
||||||
return game { running = False }
|
|
||||||
|
|
||||||
Just Event.Event { .. } ->
|
|
||||||
sinkEvent engine game eventPayload >>= sinkEvents engine
|
|
||||||
|
|
||||||
Nothing -> return game
|
|
||||||
|
|
||||||
depoint :: Point f a -> (f a)
|
|
||||||
depoint (P x) = x
|
depoint (P x) = x
|
||||||
|
|
||||||
sinkEvent :: SDLEngine -> SDLGame m a -> Event.EventPayload -> IO (SDLGame m a)
|
sinkEvent :: SDLEngine -> Event.EventPayload -> IO SDLEngine
|
||||||
sinkEvent engine game (Event.WindowResizedEvent Event.WindowResizedEventData { .. }) = do
|
sinkEvent engine (Event.WindowResizedEvent Event.WindowResizedEventData { .. }) = do
|
||||||
windowResizeEventSink engine $ fromIntegral <$> windowResizedEventSize
|
windowResizeEventSink engine $ fromIntegral <$> windowResizedEventSize
|
||||||
|
|
||||||
return game
|
return engine
|
||||||
|
|
||||||
sinkEvent engine game (Event.MouseMotionEvent Event.MouseMotionEventData { .. }) = do
|
sinkEvent engine (Event.MouseMotionEvent Event.MouseMotionEventData { .. }) = do
|
||||||
mouseMoveEventSink engine $ fromIntegral <$> depoint mouseMotionEventPos
|
mouseMoveEventSink engine $ fromIntegral <$> depoint mouseMotionEventPos
|
||||||
|
|
||||||
return game
|
return engine
|
||||||
|
|
||||||
sinkEvent engine game (Event.KeyboardEvent Event.KeyboardEventData { .. }) = do
|
sinkEvent engine (Event.KeyboardEvent Event.KeyboardEventData { .. }) =
|
||||||
case keyboardEventKeyMotion of
|
case keyboardEventKeyMotion of
|
||||||
Event.Pressed -> do
|
Event.Pressed -> do
|
||||||
keyboardDownEventSink engine key
|
keyboardDownEventSink engine key
|
||||||
|
|
||||||
if keyboardEventRepeat
|
if keyboardEventRepeat
|
||||||
then keyboardPressEventSink engine key >> return game
|
then keyboardPressEventSink engine key >> return engine
|
||||||
else return game
|
else return engine
|
||||||
|
|
||||||
Event.Released -> do
|
Event.Released -> do
|
||||||
keyboardUpEventSink engine key
|
keyboardUpEventSink engine key
|
||||||
keyboardPressEventSink engine key
|
keyboardPressEventSink engine key
|
||||||
|
|
||||||
return game
|
return engine
|
||||||
|
|
||||||
where
|
where
|
||||||
Keysym { .. } = keyboardEventKeysym
|
Keysym { .. } = keyboardEventKeysym
|
||||||
key = mapKey keysymKeycode
|
key = mapKey keysymKeycode
|
||||||
|
|
||||||
sinkEvent engine game (Event.MouseButtonEvent Event.MouseButtonEventData { .. }) = do
|
sinkEvent engine (Event.MouseButtonEvent Event.MouseButtonEventData { .. }) =
|
||||||
case mouseButtonEventMotion of
|
case mouseButtonEventMotion of
|
||||||
Event.Pressed -> do
|
Event.Pressed -> do
|
||||||
ticks <- Time.ticks
|
ticks <- Time.ticks
|
||||||
mouseDownEventSink engine tup
|
mouseDownEventSink engine tup
|
||||||
|
|
||||||
return game { lastMousePress = Just (ticks, pos) }
|
return engine { lastMousePress = Just (ticks, pos) }
|
||||||
|
|
||||||
Event.Released -> do
|
Event.Released -> do
|
||||||
mouseUpEventSink engine tup
|
mouseUpEventSink engine tup
|
||||||
@ -293,7 +240,7 @@ sinkEvent engine game (Event.MouseButtonEvent Event.MouseButtonEventData { .. })
|
|||||||
event being in a very close proximity to a previous mouse down event.
|
event being in a very close proximity to a previous mouse down event.
|
||||||
We manually calculate whether this was a click or not. -}
|
We manually calculate whether this was a click or not. -}
|
||||||
case lastMousePress of
|
case lastMousePress of
|
||||||
Just (lastTicks, (V2 lastX lastY)) -> do
|
Just (lastTicks, V2 lastX lastY) -> do
|
||||||
ticks <- Time.ticks
|
ticks <- Time.ticks
|
||||||
|
|
||||||
-- Check that it's a expected amount of time for a click and that the mouse has basically stayed in place
|
-- Check that it's a expected amount of time for a click and that the mouse has basically stayed in place
|
||||||
@ -303,13 +250,13 @@ sinkEvent engine game (Event.MouseButtonEvent Event.MouseButtonEventData { .. })
|
|||||||
|
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
|
|
||||||
return game
|
return engine
|
||||||
|
|
||||||
where
|
where
|
||||||
SDLGame { lastMousePress } = game
|
SDLEngine { lastMousePress } = engine
|
||||||
clickMs = 500 -- How long between mouse down/up to recognise clicks
|
clickMs = 500 -- How long between mouse down/up to recognise clicks
|
||||||
clickRadius = 1 -- The pixel radius to be considered a click.
|
clickRadius = 1 -- The pixel radius to be considered a click.
|
||||||
pos@(V2 x y) = depoint mouseButtonEventPos
|
pos@(V2 x y) = depoint mouseButtonEventPos
|
||||||
tup = (mapMouseButton mouseButtonEventButton, fromIntegral <$> pos)
|
tup = (mapMouseButton mouseButtonEventButton, fromIntegral <$> pos)
|
||||||
|
|
||||||
sinkEvent _ game _ = return game
|
sinkEvent engine _ = return engine
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
{-| Contains the graphics type. -}
|
-- | Contains the graphics type.
|
||||||
module Helm.Graphics (
|
module Helm.Graphics (
|
||||||
-- * Types
|
-- * Types
|
||||||
Graphics(..)
|
Graphics(..)
|
||||||
@ -6,4 +6,6 @@ module Helm.Graphics (
|
|||||||
|
|
||||||
import Helm.Graphics2D (Element)
|
import Helm.Graphics2D (Element)
|
||||||
|
|
||||||
|
-- The graphics type contains any form of structure that
|
||||||
|
-- produces visual graphics to the screen, i.e. either 2D or 3D elements.
|
||||||
data Graphics = Graphics2D Element
|
data Graphics = Graphics2D Element
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
{-| Contains subscriptions to events from the keyboard. -}
|
-- | Contains subscriptions to events from the keyboard.
|
||||||
module Helm.Keyboard
|
module Helm.Keyboard
|
||||||
(
|
(
|
||||||
-- * Types
|
-- * Types
|
||||||
@ -13,19 +13,31 @@ import FRP.Elerea.Param (input, snapshot)
|
|||||||
|
|
||||||
import Helm.Engine (Engine(..), Sub(..), Key(..))
|
import Helm.Engine (Engine(..), Sub(..), Key(..))
|
||||||
|
|
||||||
presses :: Engine e => (Key -> a) -> Sub e a
|
-- | Subscribe to keyboard press events and map to a game action.
|
||||||
|
-- A key press event is produced whenever a key is either released
|
||||||
|
-- or continously held down.
|
||||||
|
presses ::
|
||||||
|
Engine e
|
||||||
|
=> (Key -> a) -- ^ The function to map the key pressed to an action.
|
||||||
|
-> Sub e a -- ^ The mapped subscription.
|
||||||
presses f = Sub $ do
|
presses f = Sub $ do
|
||||||
engine <- input >>= snapshot
|
engine <- input >>= snapshot
|
||||||
|
|
||||||
fmap (fmap f) <$> keyboardPressSignal engine
|
fmap (fmap f) <$> keyboardPressSignal engine
|
||||||
|
|
||||||
downs :: Engine e => (Key -> a) -> Sub e a
|
-- | Subscribe to keyboard down events and map to a game action.
|
||||||
|
downs :: Engine e
|
||||||
|
=> (Key -> a) -- ^ The function to map the key held down to an action.
|
||||||
|
-> Sub e a -- ^ The mapped subscription.
|
||||||
downs f = Sub $ do
|
downs f = Sub $ do
|
||||||
engine <- input >>= snapshot
|
engine <- input >>= snapshot
|
||||||
|
|
||||||
fmap (fmap f) <$> keyboardDownSignal engine
|
fmap (fmap f) <$> keyboardDownSignal engine
|
||||||
|
|
||||||
ups :: Engine e => (Key -> a) -> Sub e a
|
-- | Subscribe to keyboard up events and map to a game action.
|
||||||
|
ups :: Engine e
|
||||||
|
=> (Key -> a) -- ^ The function to map the key released to an action.
|
||||||
|
-> Sub e a -- ^ The mapped subscription.
|
||||||
ups f = Sub $ do
|
ups f = Sub $ do
|
||||||
engine <- input >>= snapshot
|
engine <- input >>= snapshot
|
||||||
|
|
||||||
|
@ -11,30 +11,48 @@ module Helm.Mouse
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import FRP.Elerea.Param (input, snapshot)
|
import FRP.Elerea.Param (input, snapshot)
|
||||||
import Linear.V2 (V2(V2))
|
import Linear.V2 (V2)
|
||||||
|
|
||||||
import Helm.Engine (Sub(..), Engine(..), MouseButton(..))
|
import Helm.Engine (Sub(..), Engine(..), MouseButton(..))
|
||||||
|
|
||||||
moves :: Engine e => (V2 Int -> a) -> Sub e a
|
-- | Subscribe to mouse movement events and map to a game action.
|
||||||
|
moves ::
|
||||||
|
Engine e
|
||||||
|
=> (V2 Int -> a) -- ^ The function to map a mouse position to an action.
|
||||||
|
-> Sub e a -- ^ The mapped subscription.
|
||||||
moves f = Sub $ do
|
moves f = Sub $ do
|
||||||
engine <- input >>= snapshot
|
engine <- input >>= snapshot
|
||||||
|
|
||||||
fmap (fmap f) <$> mouseMoveSignal engine
|
fmap (fmap f) <$> mouseMoveSignal engine
|
||||||
|
|
||||||
clicks :: Engine e => (MouseButton -> V2 Int -> a) -> Sub e a
|
-- | Subscribe to mouse click events and map to a game action.
|
||||||
clicks _ = Sub $ do
|
-- This subscription is for all mouse buttons - you'll need to
|
||||||
|
-- match over a mouse button if you want to capture a specific one.
|
||||||
|
clicks ::
|
||||||
|
Engine e
|
||||||
|
=> (MouseButton -> V2 Int -> a) -- ^ The function to map a mouse button and position to an action.
|
||||||
|
-> Sub e a -- ^ The mapped subscription.
|
||||||
|
clicks f = Sub $ do
|
||||||
engine <- input >>= snapshot
|
engine <- input >>= snapshot
|
||||||
|
|
||||||
fmap (fmap (\(b, p) -> f b p)) <$> mouseClickSignal engine
|
fmap (fmap (uncurry f)) <$> mouseClickSignal engine
|
||||||
|
|
||||||
downs :: Engine e => (MouseButton -> V2 Int -> a) -> Sub e a
|
-- | Subscribe to mouse button down events and map to a game action.
|
||||||
downs _ = Sub $ do
|
downs ::
|
||||||
|
Engine e
|
||||||
|
=> (MouseButton -> V2 Int -> a) -- ^ The function to map a mouse button and position to an action.
|
||||||
|
-> Sub e a -- ^ The mapped subscription.
|
||||||
|
downs f = Sub $ do
|
||||||
engine <- input >>= snapshot
|
engine <- input >>= snapshot
|
||||||
|
|
||||||
fmap (fmap (\(b, p) -> f b p)) <$> mouseDownSignal engine
|
fmap (fmap (uncurry f)) <$> mouseDownSignal engine
|
||||||
|
|
||||||
ups :: Engine e => (MouseButton -> V2 Int -> a) -> Sub e a
|
-- | Subscribe to mouse button up events and map to a game action.
|
||||||
|
ups ::
|
||||||
|
Engine e
|
||||||
|
=> (MouseButton -> V2 Int -> a) -- ^ The function to map a mouse button and position to an action.
|
||||||
|
-> Sub e a -- ^ The mapped subscription.
|
||||||
ups f = Sub $ do
|
ups f = Sub $ do
|
||||||
engine <- input >>= snapshot
|
engine <- input >>= snapshot
|
||||||
|
|
||||||
fmap (fmap (\(b, p) -> f b p)) <$> mouseUpSignal engine
|
fmap (fmap (uncurry f)) <$> mouseUpSignal engine
|
||||||
|
@ -10,7 +10,14 @@ module Helm.Sub
|
|||||||
|
|
||||||
import Helm.Engine (Engine, Sub(..))
|
import Helm.Engine (Engine, Sub(..))
|
||||||
|
|
||||||
batch :: Engine e => [Sub e a] -> Sub e a
|
-- | Combine a list of mapped subscriptions into a single one.
|
||||||
|
-- This is allows for subscriptions to multiple input events to be
|
||||||
|
-- combined into one mapped subscription that encompasses all the actions
|
||||||
|
-- mapped from events.
|
||||||
|
batch ::
|
||||||
|
Engine e
|
||||||
|
=> [Sub e a] -- ^ The list of mapped subscriptions.
|
||||||
|
-> Sub e a -- ^ The mapped subscriptions accumulated.
|
||||||
batch subs = Sub $ do
|
batch subs = Sub $ do
|
||||||
signals <- mapM (\(Sub gen) -> gen) subs
|
signals <- mapM (\(Sub gen) -> gen) subs
|
||||||
|
|
||||||
@ -19,5 +26,6 @@ batch subs = Sub $ do
|
|||||||
|
|
||||||
return $ concat lists
|
return $ concat lists
|
||||||
|
|
||||||
|
-- | A mapped subscription that does nothing.
|
||||||
none :: Engine e => Sub e a
|
none :: Engine e => Sub e a
|
||||||
none = Sub . return $ return []
|
none = Sub . return $ return []
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
{-| Contains functions for composing units of time and
|
-- | Contains functions for composing units of time and
|
||||||
subscriptions to events from the game clock. -}
|
-- subscriptions to events from the game clock.
|
||||||
module Helm.Time
|
module Helm.Time
|
||||||
(
|
(
|
||||||
-- * Types
|
-- * Types
|
||||||
@ -24,48 +24,60 @@ import Control.Monad.IO.Class (liftIO)
|
|||||||
|
|
||||||
import Helm.Engine (Cmd(..), Sub(..), Engine(..))
|
import Helm.Engine (Cmd(..), Sub(..), Engine(..))
|
||||||
|
|
||||||
{-| A type describing an amount of time in an arbitary unit. Use the time
|
-- | A type describing an amount of time in an arbitary unit.
|
||||||
composing/converting functions to manipulate time values. -}
|
-- This type can then be composed with the relevant utility functions.
|
||||||
type Time = Double
|
type Time = Double
|
||||||
|
|
||||||
{-| A time value representing one millisecond. -}
|
-- | A time value representing one millisecond.
|
||||||
millisecond :: Time
|
millisecond :: Time
|
||||||
millisecond = 1
|
millisecond = 1
|
||||||
|
|
||||||
{-| A time value representing one second. -}
|
-- | A time value representing one second.
|
||||||
second :: Time
|
second :: Time
|
||||||
second = 1000
|
second = 1000
|
||||||
|
|
||||||
{-| A time value representing one minute. -}
|
-- | A time value representing one minute.
|
||||||
minute :: Time
|
minute :: Time
|
||||||
minute = 60000
|
minute = 60000
|
||||||
|
|
||||||
{-| A time value representing one hour. -}
|
-- | A time value representing one hour.
|
||||||
hour :: Time
|
hour :: Time
|
||||||
hour = 3600000
|
hour = 3600000
|
||||||
|
|
||||||
{-| Converts a time value to a fractional value, in milliseconds. -}
|
-- | Converts a time value to a fractional value, in milliseconds.
|
||||||
inMilliseconds :: Time -> Double
|
inMilliseconds :: Time -> Double
|
||||||
inMilliseconds n = n
|
inMilliseconds n = n
|
||||||
|
|
||||||
{-| Converts a time value to a fractional value, in seconds. -}
|
-- | Converts a time value to a fractional value, in seconds.
|
||||||
inSeconds :: Time -> Double
|
inSeconds :: Time -> Double
|
||||||
inSeconds n = n / second
|
inSeconds n = n / second
|
||||||
|
|
||||||
{-| Converts a time value to a fractional value, in minutes. -}
|
-- | Converts a time value to a fractional value, in minutes.
|
||||||
inMinutes :: Time -> Double
|
inMinutes :: Time -> Double
|
||||||
inMinutes n = n / minute
|
inMinutes n = n / minute
|
||||||
|
|
||||||
{-| Converts a time value to a fractional value, in hours. -}
|
-- | Converts a time value to a fractional value, in hours.
|
||||||
inHours :: Time -> Double
|
inHours :: Time -> Double
|
||||||
inHours n = n / hour
|
inHours n = n / hour
|
||||||
|
|
||||||
now :: Engine e => (Time -> a) -> Cmd e a
|
-- | Map the running time of the engine to a game action.
|
||||||
|
-- Note that this is not the current clock time but rather the engine time,
|
||||||
|
-- i.e. when the engine first starts running, the applied value will be zero.
|
||||||
|
now ::
|
||||||
|
Engine e
|
||||||
|
=> (Time -> a) -- ^ The function to map the running time to an action.
|
||||||
|
-> Cmd e a -- ^ The mapped command.
|
||||||
now f = Cmd $ do
|
now f = Cmd $ do
|
||||||
engine <- get
|
engine <- get
|
||||||
ticks <- liftIO $ f <$> runningTime engine
|
ticks <- liftIO $ f <$> runningTime engine
|
||||||
|
|
||||||
return [ticks]
|
return [ticks]
|
||||||
|
|
||||||
every :: Engine e => Time -> (Time -> a) -> Sub e a
|
-- | Subscribe to the running time of the engine and map to a game action,
|
||||||
|
-- producing events at a provided interval.
|
||||||
|
every ::
|
||||||
|
Engine e
|
||||||
|
=> Time -- ^ The interval of time to produce events at.
|
||||||
|
-> (Time -> a) -- ^ The function to map the running time to an action.
|
||||||
|
-> Sub e a -- ^ The mapped subscription.
|
||||||
every _ _ = Sub $ return $ return []
|
every _ _ = Sub $ return $ return []
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
{-| Contains signals that sample input from the game window. -}
|
-- | Contains signals that sample input from the game window.
|
||||||
module Helm.Window
|
module Helm.Window
|
||||||
(
|
(
|
||||||
-- * Commands
|
-- * Commands
|
||||||
@ -15,14 +15,22 @@ import Linear.V2 (V2)
|
|||||||
|
|
||||||
import Helm.Engine (Engine(..), Cmd(..), Sub(..))
|
import Helm.Engine (Engine(..), Cmd(..), Sub(..))
|
||||||
|
|
||||||
size :: Engine e => (V2 Int -> a) -> Cmd e a
|
-- | Map the game window size to a game action.
|
||||||
|
size ::
|
||||||
|
Engine e
|
||||||
|
=> (V2 Int -> a) -- ^ The function to map the window size to an action.
|
||||||
|
-> Cmd e a -- ^ The mapped command.
|
||||||
size f = Cmd $ do
|
size f = Cmd $ do
|
||||||
engine <- get
|
engine <- get
|
||||||
sized <- liftIO $ f <$> windowSize engine
|
sized <- liftIO $ f <$> windowSize engine
|
||||||
|
|
||||||
return [sized]
|
return [sized]
|
||||||
|
|
||||||
resizes :: Engine e => (V2 Int -> a) -> Sub e a
|
-- | Subscribe to the resize events from the game window and map to a game action.
|
||||||
|
resizes ::
|
||||||
|
Engine e
|
||||||
|
=> (V2 Int -> a) -- ^ The function to map the changed window size to an action.
|
||||||
|
-> Sub e a -- ^ The mapped subscription.
|
||||||
resizes f = Sub $ do
|
resizes f = Sub $ do
|
||||||
engine <- input >>= snapshot
|
engine <- input >>= snapshot
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user