This commit is contained in:
nek0 2020-09-24 01:26:47 +02:00
parent b945cc1fb6
commit 9b30b11e18
7 changed files with 112 additions and 11 deletions

View File

@ -17,11 +17,18 @@ extra-source-files: CHANGELOG.md
executable pituicat executable pituicat
main-is: Main.hs main-is: Main.hs
-- other-modules: other-modules: Types
, Types.Application
, Types.Subsystems
, Types.Map
-- other-extensions: -- other-extensions:
build-depends: base ^>=4.13.0.0 build-depends: base ^>=4.13.0.0
, affection , affection
, stm , stm
, sdl2 , sdl2
, containers
, linear
, text
, elerea
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010

View File

@ -24,14 +24,16 @@ let
license = stdenv.lib.licenses.lgpl3; license = stdenv.lib.licenses.lgpl3;
}) {}; }) {};
f = { mkDerivation, base, stdenv, sdl2, stm }: f = { mkDerivation, base, containers, elerea, linear, stdenv, sdl2, stm
, text}:
mkDerivation { mkDerivation {
pname = "pituicat"; pname = "pituicat";
version = "0.0.0.0"; version = "0.0.0.0";
src = ./.; src = ./.;
isLibrary = false; isLibrary = false;
isExecutable = true; isExecutable = true;
executableHaskellDepends = [ affection base sdl2 stm ]; executableHaskellDepends = [ affection base elerea linear containers
sdl2 stm text];
license = stdenv.lib.licenses.gpl3; license = stdenv.lib.licenses.gpl3;
}; };

View File

@ -1,4 +1,59 @@
{-# LANGUAGE OverloadedStrings #-}
module Main where 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 :: 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

7
src/Types.hs Normal file
View File

@ -0,0 +1,7 @@
module Types
( module T
) where
import Types.Application as T
import Types.Subsystems as T
import Types.Map as T

View File

@ -4,7 +4,7 @@ import Affection
import qualified SDL import qualified SDL
import Control.Concurrent.STM.TMVar import Control.Concurrent.STM
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
@ -17,7 +17,7 @@ data GameData = GameData
-- , gameCurrentLevel :: Tvar Level -- , gameCurrentLevel :: Tvar Level
, gameSubsystems :: Subsystems , gameSubsystems :: Subsystems
, gameActionTranslation :: TVar ActionTranslation , gameActionTranslation :: TVar ActionTranslation
, gameEnded :: TVar Bool , gameRunning :: TVar Bool
} }
data State data State
@ -29,6 +29,7 @@ data State
data MenuState data MenuState
= MenuMain = MenuMain
| MenuSettings | MenuSettings
deriving (Eq , Show)
data Level data Level
= DNAMenu = DNAMenu
@ -53,9 +54,9 @@ data Level
| Complex03 | Complex03
| Complex04 | Complex04
| Base01 | Base01
| Base01 | Base02
| Base01 | Base03
| Base01 | Base04
| Test | Test
deriving (Enum, Eq, Show) deriving (Enum, Eq, Show)

View File

@ -1 +1,8 @@
module Types.Map where module Types.Map where
import Linear
data Map = Map
{ mapLayers :: [Layer]
, mapStart :: V2 Word
}

View File

@ -1,10 +1,10 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MutliParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
module Types.Subsystems where module Types.Subsystems where
import Affection import Affection
import Control.Concurrent.STM.TVar import Control.Concurrent.STM
data Subsystems = Subsystems data Subsystems = Subsystems
{ subWindow :: SubWindow { subWindow :: SubWindow
@ -18,6 +18,28 @@ newtype SubMouse = SubMouse (TVar [(UUID, MouseMessage -> Affection ())])
newtype SubKeyboard = SubKeyboard (TVar [(UUID, KeyboardMessage -> Affection ())]) newtype SubKeyboard = SubKeyboard (TVar [(UUID, KeyboardMessage -> Affection ())])
newtype SubTranslator = SubTranslator (TVar [(UUID, TranslatorMessage -> 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 instance Participant SubWindow where
type Mesg SubWindow = WindowMessage type Mesg SubWindow = WindowMessage