From 34d0dcbf03362797fdf55d389c87993417c39d3b Mon Sep 17 00:00:00 2001 From: Rin Date: Fri, 5 Jan 2024 16:48:21 +1100 Subject: [PATCH] Overseer work and Aspect framework --- debug.log | 6 ++++++ package.yaml | 5 ++++- pulsar.cabal | 13 +++++++++++ src/Aspect.hs | 24 +++++++++++++++++++++ src/Item.hs | 11 ++++++++++ src/Lib.hs | 12 ++++++++++- src/Material.hs | 31 +++++++++++++++++++++++++++ src/Overseer.hs | 56 ++++++++++++++++++++++++++++++++++++++++++++++-- src/Structure.hs | 30 ++++++++++++++++++++++++++ stack.yaml | 3 +++ stack.yaml.lock | 21 ++++++++++++++++++ 11 files changed, 208 insertions(+), 4 deletions(-) create mode 100644 debug.log create mode 100644 src/Aspect.hs create mode 100644 src/Item.hs create mode 100644 src/Material.hs create mode 100644 src/Structure.hs diff --git a/debug.log b/debug.log new file mode 100644 index 0000000..26810c3 --- /dev/null +++ b/debug.log @@ -0,0 +1,6 @@ +[1109/122701.492:ERROR:registration_protocol_win.cc(107)] CreateFile: The system cannot find the file specified. (0x2) +[1109/122701.916:ERROR:registration_protocol_win.cc(107)] CreateFile: The system cannot find the file specified. (0x2) +[1121/233647.885:ERROR:registration_protocol_win.cc(107)] CreateFile: The system cannot find the file specified. (0x2) +[1121/233648.610:ERROR:registration_protocol_win.cc(107)] CreateFile: The system cannot find the file specified. (0x2) +[1121/233649.357:ERROR:registration_protocol_win.cc(107)] CreateFile: The system cannot find the file specified. (0x2) +[1121/233650.157:ERROR:registration_protocol_win.cc(107)] CreateFile: The system cannot find the file specified. (0x2) diff --git a/package.yaml b/package.yaml index 1b5014b..6e8fbc3 100644 --- a/package.yaml +++ b/package.yaml @@ -21,7 +21,10 @@ description: Please see the README at = 4.7 && < 5 - ghc >= 9.4.7 - - containers > 0.6.0.0 + - containers > 0.6.0.0 + - unordered-containers > 0.2.19.0 + - dimensional > 1.3 + - parsec > 3.1.16.0 ghc-options: - -Wall diff --git a/pulsar.cabal b/pulsar.cabal index 5d9b6f1..674adec 100644 --- a/pulsar.cabal +++ b/pulsar.cabal @@ -22,8 +22,12 @@ source-repository head library exposed-modules: + Aspect + Item Lib + Material Overseer + Structure other-modules: Paths_pulsar autogen-modules: @@ -44,7 +48,10 @@ library build-depends: base >=4.7 && <5 , containers >0.6.0.0 + , dimensional >1.3 , ghc >=9.4.7 + , parsec >3.1.16.0 + , unordered-containers >0.2.19.0 default-language: GHC2021 executable pulsar-exe @@ -69,8 +76,11 @@ executable pulsar-exe build-depends: base >=4.7 && <5 , containers >0.6.0.0 + , dimensional >1.3 , ghc >=9.4.7 + , parsec >3.1.16.0 , pulsar + , unordered-containers >0.2.19.0 default-language: GHC2021 test-suite pulsar-test @@ -96,6 +106,9 @@ test-suite pulsar-test build-depends: base >=4.7 && <5 , containers >0.6.0.0 + , dimensional >1.3 , ghc >=9.4.7 + , parsec >3.1.16.0 , pulsar + , unordered-containers >0.2.19.0 default-language: GHC2021 diff --git a/src/Aspect.hs b/src/Aspect.hs new file mode 100644 index 0000000..3ec3713 --- /dev/null +++ b/src/Aspect.hs @@ -0,0 +1,24 @@ +module Aspect where + +import Text.ParserCombinators.Parsec + +{-| Aspects represent the tasks that something is suitable for as well as its properties. +-- They are nominally formed of an Aspect type (which amounts to an Enum), as well an amount. +|--} + +-- TODO: Figure out how to structure this... Type level counting???? + +data Aspect Type where + GenericAspect :: { + aspect :: AspectI, + amount :: Int + } -> Aspect a + +parseAspect :: Parser AspectI +parseAspect = do + a <- many char + return $ case a of + "Flam" -> Flammable + "Cond" -> Conductive + "Cool" -> Cooling + diff --git a/src/Item.hs b/src/Item.hs new file mode 100644 index 0000000..b219d30 --- /dev/null +++ b/src/Item.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Item where + +import Numeric.Units.Dimensional.Prelude + +class It where + bounds :: (Int, Int, Int) + volume :: Volume Integer + mass :: Mass Integer + diff --git a/src/Lib.hs b/src/Lib.hs index 05fd355..1058adf 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1,5 +1,15 @@ +{-# OPTIONS_GHC -Wno-unused-top-binds #-} module Lib( - + Has, + IsUID, + ItemUID, + BodyPartUID, + CreatureUID, + StructureUID, + CellUID, + EventUID, + TypeUID, + OverseerUID ) where -- data Status = Success | Partial | Failure deriving (Eq, Ord, Show, Read) diff --git a/src/Material.hs b/src/Material.hs new file mode 100644 index 0000000..6513315 --- /dev/null +++ b/src/Material.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Material where + +import Numeric.Units.Dimensional.Prelude + +{- | + +The Material Module and data-type present the physical properties of materials, for use in items, structures, etc + +-} +-- All temperature points are assumed to be STP, and should be given in Kelvin +data Material = Material { + name :: String, + meltingPoint :: ThermodynamicTemperature Double, --Solid to liquid or vice versa + boilingPoint :: ThermodynamicTemperature Double, --Liquid to vapour or vice versa + tensileStength :: Pressure Integer, --This is going to be in MPa, so no point keeping fractions around + compressiveStrength :: Pressure Integer, + density :: Density Double +} deriving (Show, Eq) + +freezingPoint :: Material -> ThermodynamicTemperature Double +freezingPoint = meltingPoint + +condensationPoint :: Material -> ThermodynamicTemperature Double +condensationPoint = boilingPoint + +defaultMaterial :: Material +defaultMaterial = Material "Default" (10000 *~ kelvin) (100000 *~ kelvin) (100 *~ mega pascal) (100 *~ mega pascal) (100 *~ (kilo gram / cubic meter)) + +genMaterial :: String -> Double -> Double -> Integer -> Integer -> Double -> Material +genMaterial n mp bp ts cs d = Material n (mp *~ kelvin) (bp *~ kelvin) (ts *~ mega pascal) (cs *~ mega pascal) (d *~ (kilo gram / cubic meter)) \ No newline at end of file diff --git a/src/Overseer.hs b/src/Overseer.hs index dfe09b9..cb5cec6 100644 --- a/src/Overseer.hs +++ b/src/Overseer.hs @@ -3,8 +3,14 @@ module Overseer( ) where +import Data.Sequence(Seq) +import Data.Sequence qualified as S +import Data.IntMap.Strict qualified as IMS + import Lib -import Data.Sequence +import Structure +import Material + {-| The Overseer module handles disseminating and redirecting events between the relavent parties. Overall, this means that the Overseer for a type will have the full list of all UIDs in that type. For types with sub-types (such as the Creature -> BodyPart -> Sense relation), the Overseer carries the highest parent type. -- An efficient data structure for searching is required, as there will be many searches per tick. A BST is ideal, however this requires restructuring the UID type to be indicative of position (i.e. it should not be monotonically increasing unless the tree is self-balancing) @@ -15,4 +21,50 @@ import Data.Sequence ---- GameState and Action Definitions ----------------------------------------------------------------------------------------------------- -- TODO: Figure out how to structure actions and event queues --- This will likely require some kind of type-level list \ No newline at end of file +-- This will likely require some kind of type-level list + + +data GameState where + GameStateMk :: { + overseers :: [Has Overseer] + } -> GameState + +-- TODO: Is Partial a desired state? +data Status = Failure | Partial | Success deriving (Eq, Ord, Show, Read) + +data Result k u = ResultMk { + originatior :: (IsUID u) => u, + status :: Status +} + +data Event k u = EventMk { + action :: k -> k, + actor :: (IsUID u) => u, + precedence :: Int -- ^Precedence is a secondary sorting order for each actor +} + +data Overseer k where + OverseerI :: { + itemsI :: Seq k, + eventsI :: Seq (Has (Event k)), -- ^Using sequence for consistency, list is fine here since we operate the list in order + resultsI :: Seq (Has (Result k)), -- ^The use of sequences lets us share results as required with cheap concat + oUID :: OverseerUID + } -> Overseer k + OverseerU :: { -- ^Overseers for 'case class' style definitions of parameters that do are not expected to change - they are defined strictly + itemsU :: IMS.IntMap k, + oUID :: OverseerUID + } -> Overseer k + + +class OverseerType k o t | k -> o, o -> k, k -> t where + -- Where k is the Subject, and i is the UID + items :: (Traversable t) => o -> t k + events :: (Traversable t) => Maybe (t (Event k u)) + results :: (Traversable t) => Maybe (t (Result k u)) + overseerUID :: o -> OverseerUID + +instance OverseerType Material (Overseer Material) IMS.IntMap where + items = itemsU + events = Nothing + results = Nothing + overseerUID = oUID \ No newline at end of file diff --git a/src/Structure.hs b/src/Structure.hs new file mode 100644 index 0000000..d6b276f --- /dev/null +++ b/src/Structure.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Structure where + +import qualified Prelude + +import Numeric.Units.Dimensional.Prelude +import Material +import Lib + +data Structure = Structure { + integrity :: Integer, + mat :: Material, + volume :: Volume Double, -- | Either a discrete volume, or fills the entire cell, TODO: Find out some way to signify + uid :: StructureUID +} deriving Show + +instance Eq Structure where + x == y = Structure.uid x == Structure.uid y + +damageStructure :: Structure -> Integer -> Structure +damageStructure (Structure i m v u) d = Structure (i Prelude.- d) m v u + +repairStructure :: Structure -> Integer -> Structure +repairStructure (Structure i m v u) r = Structure (i Prelude.+ r) m v u + +genStructure :: Integer -> Material -> Double -> StructureUID -> Structure +genStructure i m v = Structure i m (v *~ cubic metre) + +--instance Read Structure where +--TODO: Research read instances \ No newline at end of file diff --git a/stack.yaml b/stack.yaml index 4339eab..05b87a0 100644 --- a/stack.yaml +++ b/stack.yaml @@ -42,6 +42,9 @@ packages: # extra-deps: - containers-0.6.7 + - dimensional-1.5 + - unordered-containers-0.2.19.1 + - parsec-3.1.16.1 # Override default flag values for local packages and extra-deps # flags: {} diff --git a/stack.yaml.lock b/stack.yaml.lock index 694c9f3..5910883 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -11,6 +11,27 @@ packages: size: 2902 original: hackage: containers-0.6.7 +- completed: + hackage: dimensional-1.5@sha256:9c8a862a3ff8f69855b4094e4e097aa1682b05f8b2e78f2d7a3a238037fd5577,4791 + pantry-tree: + sha256: 17e7232695e7243df6d96d839b310003297e6f6228fda2fa99c177f311c48c21 + size: 2399 + original: + hackage: dimensional-1.5 +- completed: + hackage: unordered-containers-0.2.19.1@sha256:1c28ca429e3960de0330908579a427ccacddd700cb84ec1969e2bbe576152add,3698 + pantry-tree: + sha256: e26f35bfab576bd80e7229e3ed9b8b5e7d83c16cf1a679b9608e4862e9acc141 + size: 1517 + original: + hackage: unordered-containers-0.2.19.1 +- completed: + hackage: parsec-3.1.16.1@sha256:5769242043b01bf759b07b7efedcb19607837ee79015fcddde34645664136aed,4691 + pantry-tree: + sha256: aee875443fc603500dcfcb5bea5c116ebcb990037abcf17e8d7020e493a51476 + size: 2698 + original: + hackage: parsec-3.1.16.1 snapshots: - completed: sha256: fb482b8e2d5d061cdda4ba1da2957c012740c893a5ee1c1b99001adae7b1fbe7