Keep working on firstnamebasis

src/Yaifl.hs

@@ -68,6 +68,7 @@ import Yaifl.Game.Actions.Opening
 import Yaifl.Model.Kinds.AnyObject
 import Yaifl.Model.Kinds.Thing
 import Yaifl.Model.Kinds.Room
+import Yaifl.Model.ObjectType
 
 type PlainWorldModel = 'WorldModel ObjectSpecifics Direction () () ActivityCollection ResponseCollection DynamicText
 
@@ -173,16 +174,6 @@ newWorld = failHorriblyIfMissing $ do
   addBaseObjects
   addBaseActions
 
-makeTypeDAG :: Map ObjectType (Set ObjectType)
-makeTypeDAG = fromList
-  [ ("object", fromList [])
-  , ("thing", fromList ["object"])
-  , ("room", fromList ["object"])
-  , ("container", fromList ["thing"])
-  , ("supporter", fromList ["thing"])
-  , ("door", fromList ["thing"])
-  ]
-
 blankActivityCollection ::
   HasStandardProperties wm
   => ActivityCollection wm

src/Yaifl/Game/Create/Object.hs

@@ -47,7 +47,7 @@ makeObject ::
 makeObject n d ty isT specifics details = do
   e <- generateEntity isT
   t <- getGlobalTime
-  return (e, Object n Nothing Nothing S.empty SingularNamed Improper d e ty t t (fromMaybe identityElement specifics) details)
+  return (e, Object n Nothing PubliclyNamed Nothing S.empty SingularNamed Improper d e ty t t (fromMaybe identityElement specifics) details)
 
 addObject ::
   Pointed s
@@ -191,6 +191,6 @@ addRegion ::
   -> Eff es RegionEntity
 addRegion n = do
   rId <- generateEntity False
-  let r = Region (unsafeTagEntity rId) n S.empty Nothing S.empty identityElement
+  let r = Region (unsafeTagEntity rId) n PubliclyNamed S.empty Nothing S.empty identityElement
   setRegion r
   pure (unsafeTagEntity rId)

src/Yaifl/Game/ObjectSpecifics.hs

@@ -104,6 +104,8 @@ addDoor n ia des f b mbD = do
   let ds = blankDoor (fst f) (fst b)
   d <- addThingInternal n ia des (ObjectType "door")
       (Just $ inj (Proxy @wm) $ DoorSpecifics ds)
+      -- A door is always fixed in place.
+      -- A door is never pushable between rooms.
       (Just $ (\x -> x & #portable .~ FixedInPlace & #pushableBetweenRooms .~ False) $ fromMaybe (blankThingData ia) mbD)
       (Just (coerceTag $ fst f))
   updateMultiLocatedObject d

src/Yaifl/Model/Kinds/Door.hs

@@ -6,8 +6,6 @@ module Yaifl.Model.Kinds.Door
   , TaggedDoor
   , blankDoor
   , getDoorMaybe
-  , isOpen
-  , isClosed
   , tagDoorObject
   ) where
 
@@ -42,20 +40,6 @@ blankDoor x y = Door False defaultDoorOpenability x y (MultiLocated $ S.fromList
 makeFieldLabelsNoPrefix ''Door
 makeSpecificsWithout [] ''Door
 
-isClosed ::
-  WMWithProperty wm Openability
-  => CanBeAny wm o
-  => o
-  -> Bool
-isClosed o = Just Closed == (O.opened <$> getOpenabilityMaybe o)
-
-isOpen ::
-  WMWithProperty wm Openability
-  => CanBeAny wm o
-  => o
-  -> Bool
-isOpen o = Just Open == (O.opened <$> getOpenabilityMaybe o)
-
 instance Taggable Door DoorTag
 
 type TaggedDoor wm = TaggedObject (Thing wm) DoorTag

src/Yaifl/Model/Kinds/Object.hs

@@ -14,6 +14,7 @@ module Yaifl.Model.Kinds.Object (
   -- ** Components
   , NamePlurality(..)
   , NameProperness(..)
+  , NamePrivacy(..)
   -- ** Objects
   , Object(..)
   , Timestamp(..)
@@ -47,6 +48,10 @@ data NamePlurality = SingularNamed | PluralNamed
 data NameProperness = Improper | Proper
   deriving stock (Show, Eq, Ord, Bounded, Enum, Generic, Read)
 
+-- | If the object should have an indefinite article or not.
+data NamePrivacy = PrivatelyNamed | PubliclyNamed
+  deriving stock (Show, Eq, Ord, Bounded, Enum, Generic, Read)
+
 -- | See also `Yaifl.Model.Metadata.typeDAG`. An object type is just a string that has some relations to other types.
 -- there is no data or polymorphism connected to a type, so it's very possible to call something a supporter without
 -- having some supporter properties.
@@ -66,6 +71,7 @@ newtype Timestamp = Timestamp
 data Object wm objData objSpecifics = Object
   { name :: WMSayable wm
   , pluralName :: Maybe (WMSayable wm)
+  , namePrivacy :: NamePrivacy
   , indefiniteArticle :: Maybe (WMSayable wm)
   , understandAs :: Set (Set Text)
   , namePlurality :: NamePlurality

src/Yaifl/Model/Kinds/Openable.hs

@@ -10,6 +10,8 @@ module Yaifl.Model.Kinds.Openable
   , defaultContainerOpenability
   , Openable(..)
   , Opened(..)
+  , isOpen
+  , isClosed
   , openIt
   , closeIt
   ) where
@@ -56,4 +58,18 @@ defaultContainerOpenability :: Openability
 defaultContainerOpenability = Openability Open NotOpenable
 
 defaultDoorOpenability :: Openability
-defaultDoorOpenability = Openability Closed Openable
+defaultDoorOpenability = Openability Closed Openable
+
+isClosed ::
+  WMWithProperty wm Openability
+  => CanBeAny wm o
+  => o
+  -> Bool
+isClosed o = Just Closed == (opened <$> getOpenabilityMaybe o)
+
+isOpen ::
+  WMWithProperty wm Openability
+  => CanBeAny wm o
+  => o
+  -> Bool
+isOpen o = Just Open == (opened <$> getOpenabilityMaybe o)

src/Yaifl/Model/Kinds/Region.hs

@@ -4,13 +4,15 @@ import Solitude
 import Yaifl.Model.Entity (TaggedEntity, RoomEntity)
 import qualified Data.Set as S
 import Yaifl.Model.WorldModel
+import Yaifl.Model.Kinds.Object
 
 data RegionTag
 type RegionEntity = TaggedEntity RegionTag
 
 data Region wm = Region
   { regionID :: RegionEntity
   , name :: Text
+  , namePrivacy :: NamePrivacy
   , subRegions :: S.Set RegionEntity
   , superRegion :: Maybe RegionEntity
   , rooms :: S.Set RoomEntity

src/Yaifl/Model/Kinds/Thing.hs

@@ -49,6 +49,7 @@ data ThingData wm = ThingData
   , handled :: ThingHandled
   , portable :: ThingPortable
   , pushableBetweenRooms :: Bool
+  , isScenery :: Bool
   , initialAppearance :: WMSayable wm
   } deriving stock (Generic)
 
@@ -59,7 +60,7 @@ makeFieldLabelsNoPrefix ''ThingData
 
 -- | A default thing (when given an initial appearance).
 blankThingData :: WMSayable wm -> ThingData wm
-blankThingData = ThingData (coerceTag voidID) NotLit NotWearable Described NotHandled Portable True
+blankThingData = ThingData (coerceTag voidID) NotLit NotWearable Described NotHandled Portable True False
 
 -- | An `Object` with `ThingData`.
 newtype Thing wm = Thing (Object wm (ThingData wm) (WMObjSpecifics wm))

src/Yaifl/Model/ObjectType.hs

@@ -1,13 +1,13 @@
 module Yaifl.Model.ObjectType
   ( isType
-
+  , makeTypeDAG
   ) where
 
 import Yaifl.Model.Metadata
 import Solitude
 import Yaifl.Model.Kinds.Object
 import Effectful.Optics
-import Data.Set
+import qualified Data.Set as S
 
 -- | Determine whether an object is of a certain type. This is separate to anything on Haskell's side
 -- and the type system.
@@ -31,8 +31,26 @@ isType o = isTypeInternal (o ^. #objectType)
         Nothing -> noteError (const False) ("Found no type entry for " <> show obj)
         Just iv ->
           if
-            e' `member` iv || obj == e'
+            e' `S.member` iv || obj == e'
           then
             return True
           else
-            anyM (`isTypeInternal` e') iv
+            anyM (`isTypeInternal` e') iv
+
+makeTypeDAG :: Map ObjectType (Set ObjectType)
+makeTypeDAG = fromList
+  [ ("object", fromList [])
+  , ("thing", fromList ["object"])
+  , ("room", fromList ["object"])
+  -- probably useless because we don't have first class directions
+  , ("direction", fromList [])
+  , ("container", fromList ["thing"])
+  , ("supporter", fromList ["thing"])
+  , ("backdrop", fromList ["thing"])
+  , ("person", fromList ["animal"])
+  , ("animal", fromList ["thing"])
+  -- same as direction, probably useless
+  , ("region", fromList [])
+  , ("door", fromList ["thing"])
+  -- we also haven't (yet) got concepts
+  ]

src/Yaifl/Text/DynamicText.hs

@@ -1,5 +1,7 @@
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
 module Yaifl.Text.DynamicText
   ( DynamicText(..)
+  , text
   ) where
 
 import Yaifl.Model.WorldModel
@@ -9,6 +11,7 @@ import Effectful.Writer.Static.Local (Writer, tell)
 import Data.Text.Display
 import Data.Text.Lazy.Builder (fromText)
 import Yaifl.Text.Say
+import Yaifl.Model.Rules.RuleEffects
 
 newtype DynamicText (wm :: WorldModel) = DynamicText (Either Text (Text, RuleLimitedEffect wm (Writer Text) ()))
 
@@ -21,4 +24,12 @@ instance IsString (DynamicText wm) where
 
 instance SayableValue (DynamicText wm) wm where
   sayTell (DynamicText (Left t)) = tell t
-  sayTell (DynamicText (Right (_, RuleLimitedEffect e))) = inject e
+  sayTell (DynamicText (Right (_, RuleLimitedEffect e))) = inject e
+
+text ::
+  SayableValue (WMSayable wm) wm
+  => Display (WMSayable wm)
+  => Text
+  -> Eff (Writer Text : ConcreteRuleStack wm) ()
+  -> DynamicText wm
+text t f = DynamicText $ Right (t, RuleLimitedEffect f)

test/Yaifl/Test/Chapter3/FirstNameBasis.hs

@@ -7,6 +7,7 @@ import Yaifl.Model.Metadata
 import Yaifl.Test.Common
 import Yaifl.Game.Create.Object
 import Yaifl.Model.Query
+import Named ((!))
 
 ex11 :: (Text, [Text], Game PlainWorldModel ())
 ex11 = ("First Name Basis", firstNameBasisTestMeWith, firstNameBasisWorld)
@@ -16,8 +17,9 @@ firstNameBasisWorld = do
   setTitle "First Name Basis"
   tcl <- addRoom "The Crew Lounge" [wrappedText|Deliberately spartan: the crew feels weight restrictions here first,
 so there aren't any chairs, just a few thin pads on the ground.|]
-  thp <- addDevice "holographic projector" "The one major source of entertainment is the holographic projector, a top of the line Misthon 9000, on which you view every beam you can get."
-  thp `isUnderstoodAs` ["holo", "holograph", "Misthon", "9000"] !: "description" "[if switched on]The projector is now playing a documentary about the early politics of the Mars colony.[otherwise]The air above the projector is disappointingly clear.[end if]"
+  thp <- addDevice "holographic projector" "The one major source of entertainment is the holographic projector, a top of the line Misthon 9000, on which you view every beam you can get." !
+    #description ()"[if switched on]The projector is now playing a documentary about the early politics of the Mars colony.[otherwise]The air above the projector is disappointingly clear.[end if]"
+  thp `isUnderstoodAs` ["holo", "holograph", "Misthon", "9000"]
   lewis <- addPerson "Lewis" Male
 
   pass

test/Yaifl/Test/Chapter3/SlightlyWrong.hs

@@ -9,7 +9,6 @@ import Yaifl.Test.Common
 import Solitude
 import Yaifl.Model.Kinds.Room
 import Yaifl.Text.AdaptiveNarrative
-import Yaifl.Model.Rules.Rulebook
 import Yaifl.Text.SayQQ
 import Yaifl.Model.Rules.RuleEffects
 import Yaifl.Text.DynamicText
@@ -28,13 +27,12 @@ awnDesc =
 swcN :: DynamicText wm
 swcN = "Slightly Wrong Chamber"
 
-swcDesc :: DynamicText wm
-swcDesc = DynamicText $ Right ("description of slightly wrong chamber", RuleLimitedEffect $ do
+swcDesc :: DynamicText PlainWorldModel
+swcDesc = text "description of slightly wrong chamber" $ do
   obj <- view #objectData <$> getMentionedRoom
   when (isVisited obj /= Visited)
     [sayingTell|When you first step into the room, you are bothered by the sense that something is not quite right: perhaps the lighting, perhaps the angle of the walls. |]
   [sayingTell|A mural on the far wall depicts a woman with a staff, tipped with a pine-cone. She appears to be watching you.|]
-  )
 
 ex4World :: Game PlainWorldModel ()
 ex4World = do

test/Yaifl/Test/Chapter3/StarryVoid.hs

@@ -18,6 +18,7 @@ import Yaifl.Model.Rules.RuleEffects
 import Yaifl.Text.AdaptiveNarrative
 import Yaifl.Text.DynamicText
 import Yaifl.Text.SayQQ
+import Yaifl.Model.Kinds.Openable
 
 ex7 :: (Text, [Text], Game PlainWorldModel ())
 ex7 = ("Starry Void", starryVoidTestMeWith, starryVoidWorld)

yaifl.cabal

@@ -181,6 +181,7 @@ test-suite yaifl-test
     Yaifl.Test.Chapter3.PortRoyal2
     Yaifl.Test.Chapter3.PortRoyal3
     Yaifl.Test.Chapter3.SlightlyWrong
+    Yaifl.Test.Chapter3.FirstNameBasis
     Yaifl.Test.Chapter3.StarryVoid
     Yaifl.Test.Chapter3.TheUnbuttonedElevatorAffair
     Yaifl.Test.Chapter3.UpAndUp