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

View File

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

View File

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

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

View File

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

View File

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