meow
This commit is contained in:
parent
b945cc1fb6
commit
9b30b11e18
7 changed files with 112 additions and 11 deletions
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
};
|
||||
|
||||
|
|
57
src/Main.hs
57
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
|
||||
|
|
7
src/Types.hs
Normal file
7
src/Types.hs
Normal 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
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -1 +1,8 @@
|
|||
module Types.Map where
|
||||
|
||||
import Linear
|
||||
|
||||
data Map = Map
|
||||
{ mapLayers :: [Layer]
|
||||
, mapStart :: V2 Word
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Reference in a new issue