Support scenery for example 15

yaifl/run_no

@@ -1 +1 @@
-724
+727

yaifl/src/Yaifl/Game/Activities/PrintingLocaleParagraphAbout.hs

@@ -106,7 +106,7 @@ dontMentionSupporter = Rule "don't mention player's supporter in room descriptio
 
 dontMentionScenery :: LocaleParagraphAboutRule wm
 dontMentionScenery = Rule "don't mention scenery in room descriptions rule" []
-  (\(v, li@(LocaleInfo _ e _)) -> ruleGuardM (e `isKind` "scenery") $ removeFromLocale e v li)
+  (\(v, li@(LocaleInfo _ e _)) -> ruleGuard (thingIsScenery e) $ removeFromLocale e v li)
 
 offerItems :: LocaleParagraphAboutRule wm
 offerItems = notImplementedRule "offer items to writing a paragraph about rule"

yaifl/src/Yaifl/Game/ObjectSpecifics.hs

@@ -191,6 +191,7 @@ addContainer ::
   -> "opened" :? Opened
   -> "location" :? EnclosingEntity
   -> "portable" :? ThingPortable
+  -> "modify" :? Eff '[State (Thing wm)] ()
   -> Eff es ContainerEntity
 addContainer n ia d
   (argF #carryingCapacity -> cc)
@@ -199,13 +200,15 @@ addContainer n ia d
   (argF #openable -> o)
   (argF #opened -> od)
   (argF #location -> l)
-  (argF #portable -> p) = do
+  (argF #portable -> p)
+  (argF #modify -> m) = do
     let cs = makeContainer cc op e o od
     c <- addThing @wm n ia d
         ! #specifics (inj (Proxy @wm) $ ContainerSpecifics cs)
         ! #type (ObjectKind "container")
         ! paramF #location l
         ! paramF #portable p
+        ! paramF #modify m
         ! done
     pure $ tag @Container @ContainerTag cs c
 
@@ -220,15 +223,17 @@ addSupporter ::
   -> "carryingCapacity" :? Int
   -> "location" :? EnclosingEntity
   -> "enterable" :? Enterable
+  -> "modify" :? Eff '[State (Thing wm)] ()
   -> Eff es SupporterEntity
 addSupporter n ia d
-  (argF #carryingCapacity -> cc) (argF #location -> l) (argF #enterable -> e) = do
+  (argF #carryingCapacity -> cc) (argF #location -> l) (argF #enterable -> e) (argF #modify -> m) = do
     let enc = (blankEnclosing { capacity = cc <|> Just 100 })
         sup = Supporter enc (fromMaybe NotEnterable e)
     c <- addThing @wm n ia d
         ! #specifics (inj (Proxy @wm) $ SupporterSpecifics sup)
         ! #type (ObjectKind "supporter")
         ! paramF #location l
+        ! paramF #modify m
         ! done
     pure $ tag @_ @SupporterTag sup c
 

yaifl/src/Yaifl/Model/Query.hs

@@ -42,6 +42,8 @@ module Yaifl.Model.Query
   , enclosingContains
   , getAllObjectsInEnclosing
   , getCommonAncestor
+
+  , makeItScenery
   ) where
 
 import Yaifl.Prelude
@@ -441,6 +443,10 @@ getCommonAncestor t1' t2' = do
               [] -> error "no common ancestor"
               x:xs -> x :| xs) l2
       return $ commAncestor acHier nounHier
+
+makeItScenery :: Eff '[State (Thing wm)] ()
+makeItScenery = (#objectData % #isScenery .= True)
+
 -- My hope is that this can vanish at some point but enclosing is the weird one
 -- we want this class because we want an easier way of doing `propertyAT` for enclosing
 class EnclosingObject o where

yaifl/test/Yaifl/Test/Chapter3/Common.hs

@@ -13,6 +13,7 @@ import Yaifl.Test.Chapter3.UpAndUp
 import Yaifl.Test.Chapter3.Verbosity
 import Yaifl.Test.Chapter3.TheUnbuttonedElevatorAffair
 import Yaifl.Test.Chapter3.DisenchantmentBay
+import Yaifl.Test.Chapter3.DisenchantmentBay2
 import qualified Data.Map as M
 import Yaifl (PlainWorldModel, Game)
 import Yaifl.Test.Chapter3.FirstNameBasis
@@ -37,4 +38,5 @@ spec _allTenses = M.fromList
   , c3Harness ex12 -- Midsummer Day
   , c3Harness ex13 -- Tamed
   , c3Harness ex14 -- Disenchantment Bay
+  , c3Harness ex15 -- Disenchantment Bay 2
   ]

yaifl/test/Yaifl/Test/Chapter3/DisenchantmentBay.hs

@@ -7,7 +7,6 @@ import Yaifl (PlainWorldModel)
 import Yaifl.Game.Create.Object
 import Yaifl.Game.EffectHandlers
 import Yaifl.Game.ObjectSpecifics
-import Yaifl.Model.Kinds (NamePlurality (..))
 import Yaifl.Model.Kinds.Container
 import Yaifl.Model.Kinds.Openable
 import Yaifl.Model.Kinds.Supporter

yaifl/test/Yaifl/Test/Chapter3/DisenchantmentBay2.hs

@@ -0,0 +1,62 @@
+module Yaifl.Test.Chapter3.DisenchantmentBay2 where
+
+import Yaifl.Prelude
+
+import Yaifl (PlainWorldModel)
+
+import Yaifl.Game.Create.Object
+import Yaifl.Game.EffectHandlers
+import Yaifl.Game.ObjectSpecifics
+import Yaifl.Model.Kinds.Container
+import Yaifl.Model.Kinds.Openable
+import Yaifl.Model.Kinds.Supporter
+import Yaifl.Model.Metadata
+import Yaifl.Test.Common
+import Yaifl.Model.Kinds.Object
+import Yaifl.Model.Query
+
+ex15 :: (Text, [Text], Game PlainWorldModel ())
+ex15 = ("Disenchantment Bay 2", disenchantmentBayTestMeWith, disenchantmentBayWorld)
+
+disenchantmentBayWorld :: Game PlainWorldModel ()
+disenchantmentBayWorld = do
+  setTitle "Disenchantment Bay"
+  addRoom "The Cabin" ! #description
+    [wrappedText|The front of the small cabin is entirely occupied with navigational instruments,
+a radar display, and radios for calling back to shore. Along each side runs a bench with faded blue
+vinyl cushions, which can be lifted to reveal the storage space underneath. A glass case against the
+wall contains several fishing rods.
+
+Scratched windows offer a view of the surrounding bay, and there is a door south to the deck.
+A sign taped to one wall announces the menu of tours offered by the Yakutat Charter Boat Company.|]
+
+  gc <- addContainer "glass case"
+    ! #openable Openable
+    ! #opacity Transparent
+    ! #opened Closed
+    ! #modify makeItScenery
+    ! done
+  addThing "collection of fishing rods"
+    ! #location (inThe gc)
+    ! done
+  b <- addSupporter "bench"
+    ! #enterable Enterable
+    ! #modify makeItScenery
+    ! done
+  addThing "blue vinyl cushions"
+    ! #modify (makeItScenery >> #namePlurality .= PluralNamed)
+    ! #location (onThe b)
+    ! done
+  mapM_ (\n -> addThing n ! #modify (makeItScenery >> #namePlurality .= PluralNamed) ! done)
+    [ "navigational instruments"
+    , "scratched windows"
+    , "radios"
+    ]
+  mapM_ (\n -> addThing n ! #modify makeItScenery ! done)
+    [ "sign"
+    , "radar display"
+    ]
+  pass
+
+disenchantmentBayTestMeWith :: [Text]
+disenchantmentBayTestMeWith = ["examine instruments", "x windows", "x sign", "x display", "x radios"]

yaifl/yaifl.cabal

@@ -1,6 +1,6 @@
 cabal-version: 3.6
 name:          yaifl
-version:       0.0.13.724
+version:       0.0.14.727
 synopsis:      Yet another interactive fiction library.
 description:   Yet another interactive fiction library.
 homepage:      https://github.com/PPKFS/yaifl
@@ -201,6 +201,7 @@ test-suite yaifl-test
     Yaifl.Test.Chapter3.Bic
     Yaifl.Test.Chapter3.Common
     Yaifl.Test.Chapter3.DisenchantmentBay
+    Yaifl.Test.Chapter3.DisenchantmentBay2
     Yaifl.Test.Chapter3.FirstNameBasis
     Yaifl.Test.Chapter3.MidsummerDay
     Yaifl.Test.Chapter3.PortRoyal