From 9b30b11e18ca91e98c0f393ae4676ec845a19873 Mon Sep 17 00:00:00 2001 From: nek0 Date: Thu, 24 Sep 2020 01:26:47 +0200 Subject: [PATCH] meow --- pituicat.cabal | 9 ++++++- shell.nix | 6 +++-- src/Main.hs | 57 +++++++++++++++++++++++++++++++++++++++- src/Types.hs | 7 +++++ src/Types/Application.hs | 11 ++++---- src/Types/Map.hs | 7 +++++ src/Types/Subsystems.hs | 26 ++++++++++++++++-- 7 files changed, 112 insertions(+), 11 deletions(-) create mode 100644 src/Types.hs diff --git a/pituicat.cabal b/pituicat.cabal index defb475..15d6959 100644 --- a/pituicat.cabal +++ b/pituicat.cabal @@ -17,11 +17,18 @@ extra-source-files: CHANGELOG.md executable pituicat main-is: Main.hs - -- other-modules: + other-modules: Types + , Types.Application + , Types.Subsystems + , Types.Map -- other-extensions: build-depends: base ^>=4.13.0.0 , affection , stm , sdl2 + , containers + , linear + , text + , elerea hs-source-dirs: src default-language: Haskell2010 diff --git a/shell.nix b/shell.nix index 58650af..4d6e217 100644 --- a/shell.nix +++ b/shell.nix @@ -24,14 +24,16 @@ let license = stdenv.lib.licenses.lgpl3; }) {}; - f = { mkDerivation, base, stdenv, sdl2, stm }: + f = { mkDerivation, base, containers, elerea, linear, stdenv, sdl2, stm + , text}: mkDerivation { pname = "pituicat"; version = "0.0.0.0"; src = ./.; isLibrary = false; isExecutable = true; - executableHaskellDepends = [ affection base sdl2 stm ]; + executableHaskellDepends = [ affection base elerea linear containers + sdl2 stm text]; license = stdenv.lib.licenses.gpl3; }; diff --git a/src/Main.hs b/src/Main.hs index 65ae4a0..f09e900 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,4 +1,59 @@ +{-# LANGUAGE OverloadedStrings #-} module Main where +import Affection + +import qualified Data.Text as T + +import qualified SDL + +import Control.Concurrent.STM + +import qualified Data.Map.Strict as M + +import Linear + +-- internal imports + +import Types + +instance Affectionate GameData where + preLoop _ = return () + handleEvents _ _ = return () + update _ _ = return () + draw _ = return () + loadState = Main.init + cleanUp _ = return () + hasNextStep = liftIO . atomically . readTVar . gameRunning + main :: IO () -main = putStrLn "Hello, Haskell!" +main = do + let config = AffectionConfig + { initComponents = All + , windowTitle = "Pituicat" + , windowConfigs = + [ ( 0 + , SDL.defaultWindow + { SDL.windowInitialSize = V2 800 600 + , SDL.windowResizable = True + , SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL + { SDL.glProfile = SDL.Core SDL.Normal 3 3 + } + } + , SDL.Windowed + ) + ] + } :: AffectionConfig GameData + withAffection config + +init :: IO GameData +init = GameData + <$> newTVarIO Loading + <*> (Subsystems + <$> (SubWindow <$> newTVarIO []) + <*> (SubMouse <$> newTVarIO []) + <*> (SubKeyboard <$> newTVarIO []) + <*> (SubTranslator <$> newTVarIO []) + ) + <*> newTVarIO (M.fromList []) + <*> newTVarIO True diff --git a/src/Types.hs b/src/Types.hs new file mode 100644 index 0000000..c19876b --- /dev/null +++ b/src/Types.hs @@ -0,0 +1,7 @@ +module Types + ( module T + ) where + +import Types.Application as T +import Types.Subsystems as T +import Types.Map as T diff --git a/src/Types/Application.hs b/src/Types/Application.hs index 39bb576..342d819 100644 --- a/src/Types/Application.hs +++ b/src/Types/Application.hs @@ -4,7 +4,7 @@ import Affection import qualified SDL -import Control.Concurrent.STM.TMVar +import Control.Concurrent.STM import qualified Data.Map.Strict as M @@ -17,7 +17,7 @@ data GameData = GameData -- , gameCurrentLevel :: Tvar Level , gameSubsystems :: Subsystems , gameActionTranslation :: TVar ActionTranslation - , gameEnded :: TVar Bool + , gameRunning :: TVar Bool } data State @@ -29,6 +29,7 @@ data State data MenuState = MenuMain | MenuSettings + deriving (Eq , Show) data Level = DNAMenu @@ -53,9 +54,9 @@ data Level | Complex03 | Complex04 | Base01 - | Base01 - | Base01 - | Base01 + | Base02 + | Base03 + | Base04 | Test deriving (Enum, Eq, Show) diff --git a/src/Types/Map.hs b/src/Types/Map.hs index 9caf187..63c4ed7 100644 --- a/src/Types/Map.hs +++ b/src/Types/Map.hs @@ -1 +1,8 @@ module Types.Map where + +import Linear + +data Map = Map + { mapLayers :: [Layer] + , mapStart :: V2 Word + } diff --git a/src/Types/Subsystems.hs b/src/Types/Subsystems.hs index e285c11..055d3c6 100644 --- a/src/Types/Subsystems.hs +++ b/src/Types/Subsystems.hs @@ -1,10 +1,10 @@ {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE MutliParamTypeClasses #-} +{-# LANGUAGE MultiParamTypeClasses #-} module Types.Subsystems where import Affection -import Control.Concurrent.STM.TVar +import Control.Concurrent.STM data Subsystems = Subsystems { subWindow :: SubWindow @@ -18,6 +18,28 @@ newtype SubMouse = SubMouse (TVar [(UUID, MouseMessage -> Affection ())]) newtype SubKeyboard = SubKeyboard (TVar [(UUID, KeyboardMessage -> Affection ())]) newtype SubTranslator = SubTranslator (TVar [(UUID, TranslatorMessage -> Affection ())]) +data TranslatorMessage = TranslatorMessage + { tmAction :: Action + , tmTime :: Double + } + deriving (Eq, Show) + +instance Message TranslatorMessage where + msgTime (TranslatorMessage _ t) = t + +data Action + = MoveLeft + | MoveRight + | Jump + | JumpDown + | Activate + | ReleasePowerup1 + | ReleasePowerup2 + | ReleasePowerup3 + | Spit + | Pause + deriving (Enum, Eq, Show) + instance Participant SubWindow where type Mesg SubWindow = WindowMessage