From e70ca9a8e9c96461e2b9d729a95e585efd260ab9 Mon Sep 17 00:00:00 2001 From: nek0 Date: Thu, 27 Dec 2018 13:49:12 +0100 Subject: [PATCH] more touchy fishy --- haskelloids.cabal | 2 +- shell.nix | 58 +++++++++++++++++++++-------------------------- src/Init.hs | 4 ++-- src/Types.hs | 32 +++++++++++++------------- 4 files changed, 45 insertions(+), 51 deletions(-) diff --git a/haskelloids.cabal b/haskelloids.cabal index a734c52..e6a5f80 100644 --- a/haskelloids.cabal +++ b/haskelloids.cabal @@ -67,7 +67,7 @@ executable haskelloids -- other-extensions: -- 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 , sdl2 >= 2.1.3.1 , OpenGL diff --git a/shell.nix b/shell.nix index 7e7684e..95293b5 100644 --- a/shell.nix +++ b/shell.nix @@ -7,6 +7,28 @@ let 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 ({ mkDerivation, base, bytestring, c2hs, containers, glew, hspec, inline-c, libGL, libGLU, QuickCheck, text, vector, pkgconfig }: @@ -35,38 +57,9 @@ let hydraPlatforms = pkgs.stdenv.lib.platforms.none; }) { 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, base, containers, glew - , linear, OpenGL, random, sdl2, stdenv, stm + f = { mkDerivation, affection, base, containers, glew + , linear, OpenGL, random, stdenv, stm }: mkDerivation { pname = "haskelloids"; @@ -74,8 +67,9 @@ let src = ./.; isLibrary = false; isExecutable = true; + enableExecutableProfiling = true; executableHaskellDepends = [ - affectionNeko base containers linear nanovgNeko OpenGL random sdl2 stm + affection base containers linear nanovgNeko OpenGL random sdl stm ]; executableSystemDepends = [ glew ]; executablePkgconfigDepends = [ glew ]; diff --git a/src/Init.hs b/src/Init.hs index b6f5baf..10a40eb 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -56,8 +56,8 @@ load = do exitFailure liftIO $ logIO A.Debug "Initializing subsystems" subs <- Subsystems - <$> (Window <$> newTVarIO []) - <*> (Keyboard <$> newTVarIO []) + <$> (SubWindow <$> newTVarIO []) + <*> (SubKeyboard <$> newTVarIO []) liftIO $ logIO A.Debug "Setting viewport" GL.viewport $= (GL.Position 0 0, GL.Size 800 600) liftIO $ logIO A.Debug "Returning UserData" diff --git a/src/Types.hs b/src/Types.hs index d217824..9147445 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -63,8 +63,8 @@ data WonLost deriving (Eq) data Subsystems = Subsystems - { subWindow :: Window - , subKeyboard :: Keyboard + { subWindow :: SubWindow + , subKeyboard :: SubKeyboard } data UUIDClean = UUIDClean @@ -72,48 +72,48 @@ data UUIDClean = UUIDClean , uuKeyboard :: [UUID] } -newtype Window = Window (TVar [(UUID, WindowMessage -> Affection UserData ())]) +newtype SubWindow = SubWindow (TVar [(UUID, WindowMessage -> Affection UserData ())]) -instance Participant Window UserData where - type Mesg Window UserData = WindowMessage +instance Participant SubWindow UserData where + type Mesg SubWindow UserData = WindowMessage - partSubscribers (Window t) = do + partSubscribers (SubWindow t) = do subTups <- liftIO $ readTVarIO t return $ map snd subTups - partSubscribe (Window t) funct = do + partSubscribe (SubWindow t) funct = do uuid <- genUUID liftIO $ atomically $ modifyTVar' t ((uuid, funct) :) return uuid - partUnSubscribe (Window t) uuid = + partUnSubscribe (SubWindow t) uuid = liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uuid)) where filterMsg :: (UUID, WindowMessage -> Affection UserData ()) -> UUID -> Bool filterMsg (u, _) p = u /= p -instance SDLSubsystem Window UserData where +instance SDLSubsystem SubWindow UserData where consumeSDLEvents = consumeSDLWindowEvents -newtype Keyboard = Keyboard (TVar [(UUID, KeyboardMessage -> Affection UserData ())]) +newtype SubKeyboard = SubKeyboard (TVar [(UUID, KeyboardMessage -> Affection UserData ())]) -instance Participant Keyboard UserData where - type Mesg Keyboard UserData = KeyboardMessage +instance Participant SubKeyboard UserData where + type Mesg SubKeyboard UserData = KeyboardMessage - partSubscribers (Keyboard t) = do + partSubscribers (SubKeyboard t) = do subTups <- liftIO $ readTVarIO t return $ map snd subTups - partSubscribe (Keyboard t) funct = do + partSubscribe (SubKeyboard t) funct = do uuid <- genUUID liftIO $ atomically $ modifyTVar' t ((uuid, funct) :) return uuid - partUnSubscribe (Keyboard t) uuid = + partUnSubscribe (SubKeyboard t) uuid = liftIO $ atomically $ modifyTVar' t (filter (`filterMsg` uuid)) where filterMsg :: (UUID, KeyboardMessage -> Affection UserData ()) -> UUID -> Bool filterMsg (u, _) p = u /= p -instance SDLSubsystem Keyboard UserData where +instance SDLSubsystem SubKeyboard UserData where consumeSDLEvents = consumeSDLKeyboardEvents