more touchy fishy
This commit is contained in:
parent
3a411e7f15
commit
e70ca9a8e9
4 changed files with 45 additions and 51 deletions
|
@ -67,7 +67,7 @@ executable haskelloids
|
||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
|
|
||||||
-- Other library packages from which modules are imported.
|
-- Other library packages from which modules are imported.
|
||||||
build-depends: base >=4.9 && <4.11
|
build-depends: base >=4.9 && <4.12
|
||||||
, affection >= 0.0.0.9
|
, affection >= 0.0.0.9
|
||||||
, sdl2 >= 2.1.3.1
|
, sdl2 >= 2.1.3.1
|
||||||
, OpenGL
|
, OpenGL
|
||||||
|
|
58
shell.nix
58
shell.nix
|
@ -7,6 +7,28 @@ let
|
||||||
|
|
||||||
inherit (nixpkgs) pkgs;
|
inherit (nixpkgs) pkgs;
|
||||||
|
|
||||||
|
sdl = with haskellPackages; callPackage(
|
||||||
|
{ mkDerivation, base, bytestring, deepseq, exceptions, linear, SDL2
|
||||||
|
, StateVar, stdenv, text, transformers, vector, weigh
|
||||||
|
}:
|
||||||
|
mkDerivation {
|
||||||
|
pname = "sdl2";
|
||||||
|
version = "2.4.1.0";
|
||||||
|
sha256 = "21a569c0c19f8ff2bbe1cf1d3eb32f65e8143806de353cedd240df5e9d088b5c";
|
||||||
|
isLibrary = true;
|
||||||
|
isExecutable = true;
|
||||||
|
enableSeparateDataOutput = true;
|
||||||
|
libraryHaskellDepends = [
|
||||||
|
base bytestring exceptions linear StateVar text transformers vector
|
||||||
|
];
|
||||||
|
librarySystemDepends = [ SDL2 ];
|
||||||
|
libraryPkgconfigDepends = [ SDL2 ];
|
||||||
|
doCheck = false;
|
||||||
|
testHaskellDepends = [ base deepseq linear vector weigh ];
|
||||||
|
description = "Both high- and low-level bindings to the SDL library (version 2.0.4+).";
|
||||||
|
license = stdenv.lib.licenses.bsd3;
|
||||||
|
}) {};
|
||||||
|
|
||||||
nanovgNeko = with haskellPackages; callPackage ({
|
nanovgNeko = with haskellPackages; callPackage ({
|
||||||
mkDerivation, base, bytestring, c2hs, containers, glew, hspec,
|
mkDerivation, base, bytestring, c2hs, containers, glew, hspec,
|
||||||
inline-c, libGL, libGLU, QuickCheck, text, vector, pkgconfig }:
|
inline-c, libGL, libGLU, QuickCheck, text, vector, pkgconfig }:
|
||||||
|
@ -35,38 +57,9 @@ let
|
||||||
hydraPlatforms = pkgs.stdenv.lib.platforms.none;
|
hydraPlatforms = pkgs.stdenv.lib.platforms.none;
|
||||||
}) { inherit (pkgs) glew; inherit (pkgs) libGL; inherit (pkgs) libGLU; inherit (pkgs) pkgconfig; };
|
}) { inherit (pkgs) glew; inherit (pkgs) libGL; inherit (pkgs) libGLU; inherit (pkgs) pkgconfig; };
|
||||||
|
|
||||||
affectionNeko = with haskellPackages; callPackage ({ mkDerivation
|
|
||||||
, base, bytestring, clock, containers, glib, linear, monad-loops, monad-parallel
|
|
||||||
, mtl, OpenGL, sdl2, stdenv, stm, text, uuid, vector }:
|
|
||||||
mkDerivation {
|
|
||||||
pname = "affection";
|
|
||||||
version = "0.0.0.9";
|
|
||||||
#src = pkgs.fetchFromGitHub {
|
|
||||||
# owner = "nek0";
|
|
||||||
# repo = "affection";
|
|
||||||
# rev = "33c99b8888328e4ed17f5c65ac49f5eab2645549";
|
|
||||||
# sha256 = "0psqxqj1a8l5fia49ay2pb72kjnw5i54m6dcmrpz5hi1654aznll";
|
|
||||||
#};
|
|
||||||
src = ../affection;
|
|
||||||
revision = "1";
|
|
||||||
isLibrary = true;
|
|
||||||
libraryHaskellDepends = [
|
|
||||||
base bytestring clock containers glib linear monad-loops
|
|
||||||
monad-parallel mtl OpenGL sdl2 stm text uuid vector
|
|
||||||
];
|
|
||||||
librarySystemDepends = [ ];
|
|
||||||
libraryToolDepends = [ ];
|
|
||||||
configureFlags = [ "-fdebug" ];
|
|
||||||
testHaskellDepends = [ ];
|
|
||||||
homepage = "https://github.com/nek0/affection";
|
|
||||||
description = "A simple Game Engine in Haskell using SDL";
|
|
||||||
license = pkgs.stdenv.lib.licenses.gpl3;
|
|
||||||
hydraPlatforms = pkgs.stdenv.lib.platforms.none;
|
|
||||||
}) { };
|
|
||||||
|
|
||||||
|
f = { mkDerivation, affection, base, containers, glew
|
||||||
f = { mkDerivation, base, containers, glew
|
, linear, OpenGL, random, stdenv, stm
|
||||||
, linear, OpenGL, random, sdl2, stdenv, stm
|
|
||||||
}:
|
}:
|
||||||
mkDerivation {
|
mkDerivation {
|
||||||
pname = "haskelloids";
|
pname = "haskelloids";
|
||||||
|
@ -74,8 +67,9 @@ let
|
||||||
src = ./.;
|
src = ./.;
|
||||||
isLibrary = false;
|
isLibrary = false;
|
||||||
isExecutable = true;
|
isExecutable = true;
|
||||||
|
enableExecutableProfiling = true;
|
||||||
executableHaskellDepends = [
|
executableHaskellDepends = [
|
||||||
affectionNeko base containers linear nanovgNeko OpenGL random sdl2 stm
|
affection base containers linear nanovgNeko OpenGL random sdl stm
|
||||||
];
|
];
|
||||||
executableSystemDepends = [ glew ];
|
executableSystemDepends = [ glew ];
|
||||||
executablePkgconfigDepends = [ glew ];
|
executablePkgconfigDepends = [ glew ];
|
||||||
|
|
|
@ -56,8 +56,8 @@ load = do
|
||||||
exitFailure
|
exitFailure
|
||||||
liftIO $ logIO A.Debug "Initializing subsystems"
|
liftIO $ logIO A.Debug "Initializing subsystems"
|
||||||
subs <- Subsystems
|
subs <- Subsystems
|
||||||
<$> (Window <$> newTVarIO [])
|
<$> (SubWindow <$> newTVarIO [])
|
||||||
<*> (Keyboard <$> newTVarIO [])
|
<*> (SubKeyboard <$> newTVarIO [])
|
||||||
liftIO $ logIO A.Debug "Setting viewport"
|
liftIO $ logIO A.Debug "Setting viewport"
|
||||||
GL.viewport $= (GL.Position 0 0, GL.Size 800 600)
|
GL.viewport $= (GL.Position 0 0, GL.Size 800 600)
|
||||||
liftIO $ logIO A.Debug "Returning UserData"
|
liftIO $ logIO A.Debug "Returning UserData"
|
||||||
|
|
32
src/Types.hs
32
src/Types.hs
|
@ -63,8 +63,8 @@ data WonLost
|
||||||
deriving (Eq)
|
deriving (Eq)
|
||||||
|
|
||||||
data Subsystems = Subsystems
|
data Subsystems = Subsystems
|
||||||
{ subWindow :: Window
|
{ subWindow :: SubWindow
|
||||||
, subKeyboard :: Keyboard
|
, subKeyboard :: SubKeyboard
|
||||||
}
|
}
|
||||||
|
|
||||||
data UUIDClean = UUIDClean
|
data UUIDClean = UUIDClean
|
||||||
|
@ -72,48 +72,48 @@ data UUIDClean = UUIDClean
|
||||||
, uuKeyboard :: [UUID]
|
, uuKeyboard :: [UUID]
|
||||||
}
|
}
|
||||||
|
|
||||||
newtype Window = Window (TVar [(UUID, WindowMessage -> Affection UserData ())])
|
newtype SubWindow = SubWindow (TVar [(UUID, WindowMessage -> Affection UserData ())])
|
||||||
|
|
||||||
instance Participant Window UserData where
|
instance Participant SubWindow UserData where
|
||||||
type Mesg Window UserData = WindowMessage
|
type Mesg SubWindow UserData = WindowMessage
|
||||||
|
|
||||||
partSubscribers (Window t) = do
|
partSubscribers (SubWindow t) = do
|
||||||
subTups <- liftIO $ readTVarIO t
|
subTups <- liftIO $ readTVarIO t
|
||||||
return $ map snd subTups
|
return $ map snd subTups
|
||||||
|
|
||||||
partSubscribe (Window t) funct = do
|
partSubscribe (SubWindow t) funct = do
|
||||||
uuid <- genUUID
|
uuid <- genUUID
|
||||||
liftIO $ atomically $ modifyTVar' t ((uuid, funct) :)
|
liftIO $ atomically $ modifyTVar' t ((uuid, funct) :)
|
||||||
return uuid
|
return uuid
|
||||||
|
|
||||||
partUnSubscribe (Window t) uuid =
|
partUnSubscribe (SubWindow t) uuid =
|
||||||
liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uuid))
|
liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uuid))
|
||||||
where
|
where
|
||||||
filterMsg :: (UUID, WindowMessage -> Affection UserData ()) -> UUID -> Bool
|
filterMsg :: (UUID, WindowMessage -> Affection UserData ()) -> UUID -> Bool
|
||||||
filterMsg (u, _) p = u /= p
|
filterMsg (u, _) p = u /= p
|
||||||
|
|
||||||
instance SDLSubsystem Window UserData where
|
instance SDLSubsystem SubWindow UserData where
|
||||||
consumeSDLEvents = consumeSDLWindowEvents
|
consumeSDLEvents = consumeSDLWindowEvents
|
||||||
|
|
||||||
newtype Keyboard = Keyboard (TVar [(UUID, KeyboardMessage -> Affection UserData ())])
|
newtype SubKeyboard = SubKeyboard (TVar [(UUID, KeyboardMessage -> Affection UserData ())])
|
||||||
|
|
||||||
instance Participant Keyboard UserData where
|
instance Participant SubKeyboard UserData where
|
||||||
type Mesg Keyboard UserData = KeyboardMessage
|
type Mesg SubKeyboard UserData = KeyboardMessage
|
||||||
|
|
||||||
partSubscribers (Keyboard t) = do
|
partSubscribers (SubKeyboard t) = do
|
||||||
subTups <- liftIO $ readTVarIO t
|
subTups <- liftIO $ readTVarIO t
|
||||||
return $ map snd subTups
|
return $ map snd subTups
|
||||||
|
|
||||||
partSubscribe (Keyboard t) funct = do
|
partSubscribe (SubKeyboard t) funct = do
|
||||||
uuid <- genUUID
|
uuid <- genUUID
|
||||||
liftIO $ atomically $ modifyTVar' t ((uuid, funct) :)
|
liftIO $ atomically $ modifyTVar' t ((uuid, funct) :)
|
||||||
return uuid
|
return uuid
|
||||||
|
|
||||||
partUnSubscribe (Keyboard t) uuid =
|
partUnSubscribe (SubKeyboard t) uuid =
|
||||||
liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uuid))
|
liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uuid))
|
||||||
where
|
where
|
||||||
filterMsg :: (UUID, KeyboardMessage -> Affection UserData ()) -> UUID -> Bool
|
filterMsg :: (UUID, KeyboardMessage -> Affection UserData ()) -> UUID -> Bool
|
||||||
filterMsg (u, _) p = u /= p
|
filterMsg (u, _) p = u /= p
|
||||||
|
|
||||||
instance SDLSubsystem Keyboard UserData where
|
instance SDLSubsystem SubKeyboard UserData where
|
||||||
consumeSDLEvents = consumeSDLKeyboardEvents
|
consumeSDLEvents = consumeSDLKeyboardEvents
|
||||||
|
|
Loading…
Reference in a new issue