Add device and person

src/Yaifl/Game/ObjectSpecifics.hs

@@ -5,6 +5,8 @@ module Yaifl.Game.ObjectSpecifics
   ObjectSpecifics(..)
   , WMHasObjSpecifics(..)
   , addDoor
+  , addDevice
+  , addPerson
   ) where
 
 import Solitude
@@ -29,13 +31,18 @@ import Yaifl.Model.Query
 import Yaifl.Model.WorldModel ( WMObjSpecifics, WorldModel(..), WMSayable, WMDirection )
 import qualified Data.Set as S
 import Yaifl.Model.Tag
+import Yaifl.Model.Kinds.Device
+import Named
+import Yaifl.Model.Kinds.Person
 
 data ObjectSpecifics =
   NoSpecifics
   | EnclosingSpecifics Enclosing
   | ContainerSpecifics Container
   | OpenabilitySpecifics Openability
   | DoorSpecifics Door
+  | DeviceSpecifics Device
+  | PersonSpecifics Person
   deriving stock (Eq, Show, Read)
 
 makePrisms ''ObjectSpecifics
@@ -128,3 +135,28 @@ updateMultiLocatedObject tl = do
       obj <- getObject x
       let enc = getEnclosing x obj
       updateToContain obj enc t) (S.toList $ ml ^. #locations)
+
+addDevice ::
+  forall wm es.
+  WMHasObjSpecifics wm
+  => WMWithProperty wm Enclosing
+  => AddObjects wm es
+  => WMSayable wm -- ^ Name.
+  -> "initialAppearance" :? WMSayable wm
+  -> "description" :? WMSayable wm -- ^ Description.
+  -> "device" :? Device
+  -> Eff es ThingEntity
+addDevice n ia d (argDef #device identityElement -> dev) = addThing n ia d ! #specifics (inj (Proxy @wm) (DeviceSpecifics dev))
+
+addPerson ::
+  forall wm es.
+  WMHasObjSpecifics wm
+  => WMWithProperty wm Enclosing
+  => AddObjects wm es
+  => WMSayable wm -- ^ Name.
+  -> "gender" :! Gender
+  -> "initialAppearance" :? WMSayable wm
+  -> "description" :? WMSayable wm -- ^ Description.
+  -> "carrying" :? Enclosing
+  -> Eff es ThingEntity
+addPerson n (Arg g) ia d (argF #carrying -> e)= addThing n ia d ! #specifics (inj (Proxy @wm) (PersonSpecifics (Person g (fromMaybe defaultPersonEnclosing e))))

src/Yaifl/Model/Kinds/Device.hs

@@ -0,0 +1,19 @@
+module Yaifl.Model.Kinds.Device where
+
+import Solitude
+import Yaifl.Model.TH (makeSpecificsWithout)
+import Yaifl.Model.Kinds.AnyObject
+import Yaifl.Model.Effects
+import Yaifl.Model.HasProperty
+import Yaifl.Model.Query
+import Yaifl.Model.Kinds.Object
+
+newtype Device = Device
+  { switchedOn :: Bool
+  } deriving stock (Eq, Ord, Show, Generic, Read)
+
+instance Pointed Device where
+  identityElement = Device False
+
+makeFieldLabelsNoPrefix ''Device
+makeSpecificsWithout [] ''Device

src/Yaifl/Model/Kinds/Person.hs

@@ -0,0 +1,28 @@
+module Yaifl.Model.Kinds.Person where
+
+import Solitude
+import Yaifl.Model.TH (makeSpecificsWithout)
+import Yaifl.Model.Kinds.AnyObject
+import Yaifl.Model.Effects
+import Yaifl.Model.HasProperty
+import Yaifl.Model.Query
+import Yaifl.Model.Kinds.Enclosing
+import qualified Data.EnumSet as ES
+
+data Gender = Male | Female | NonBinary | Other Text
+  deriving stock (Eq, Ord, Show, Generic, Read)
+
+data Person = Person
+  { gender :: Gender
+  , carrying :: Enclosing
+  } deriving stock (Eq, Ord, Show, Generic, Read)
+
+
+defaultPersonEnclosing :: Enclosing
+defaultPersonEnclosing = Enclosing
+  { contents = ES.empty
+  , capacity = Just 100
+  }
+
+makeFieldLabelsNoPrefix ''Person
+makeSpecificsWithout [] ''Person

test/Yaifl/Test/Chapter3/FirstNameBasis.hs

@@ -7,7 +7,13 @@ import Yaifl.Model.Metadata
 import Yaifl.Test.Common
 import Yaifl.Game.Create.Object
 import Yaifl.Model.Query
-import Named ((!))
+import Named
+import Yaifl.Text.SayQQ
+import Yaifl.Text.AdaptiveNarrative
+import Yaifl.Text.DynamicText
+import Yaifl.Text.Say
+import Yaifl.Game.ObjectSpecifics
+import Yaifl.Model.Kinds.Device
 
 ex11 :: (Text, [Text], Game PlainWorldModel ())
 ex11 = ("First Name Basis", firstNameBasisTestMeWith, firstNameBasisWorld)
@@ -18,11 +24,18 @@ firstNameBasisWorld = do
   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." !
-    #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
+    #description (text "projector description" $ withThing $ \t -> do
+      let ds = getDeviceMaybe t
+      let isOn = fromMaybe False $ ds ^? _Just % #switchedOn
+      [sayingTell|{?if isOn}The projector is now playing a documentary about the early politics of the Mars colony.{?else}
+The air above the projector is disappointingly clear.{?end if}|]) ! defaults
 
+  thp `isUnderstoodAs` ["holo", "holograph", "Misthon", "9000"]
+  lewis <- addPerson "Lewis" ! #gender Male ! #description "A wiry, excitable engineer who just signed aboard last week." ! defaults
+  harper <- addPerson "Harper" ! #gender Male ! #description "Harper's a good guy: taciturn when sober, affectionate when drunk, but rarely annoying in either state." ! defaults
+  "man" `kindIsUnderstoodAs` ["man", "guy", "chap", "lad", "male"]
+  "man" `pluralIsUnderstoodAs` ["men", "guys", "chaps", "lads", "males"]
   pass
 
 firstNameBasisTestMeWith :: [Text]
-firstNameBasisTestMeWith = []
+firstNameBasisTestMeWith = ["x holo", "x man", "lewis", "x guy", "harper", "turn on projector",  "x holo projector", "get men"]