Overseer work and Aspect framework

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)

package.yaml

@@ -21,7 +21,10 @@ description:         Please see the README at <https://gitea.treehouse.systems/R
 dependencies:
   - base >= 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

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

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
+

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
+

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)

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

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

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

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: {}

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