more touchy fishy

This commit is contained in:
nek0 2018-12-27 13:49:12 +01:00
parent 3a411e7f15
commit e70ca9a8e9
4 changed files with 45 additions and 51 deletions

View file

@ -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

View file

@ -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 ];

View file

@ -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"

View file

@ -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