From e6631c1bb6b69da26e7535c1829b59614474cf1c Mon Sep 17 00:00:00 2001 From: avery Date: Sun, 22 Dec 2024 19:21:47 +0000 Subject: [PATCH] Example 12 passes --- cabal.project | 2 +- yaifl/run_no | 2 +- yaifl/src/Yaifl/Game/ActionProcessing.hs | 11 ++- yaifl/src/Yaifl/Game/Actions/Exiting.hs | 8 ++- yaifl/src/Yaifl/Game/Actions/GettingOff.hs | 38 +++++++--- yaifl/src/Yaifl/Game/Parser.hs | 2 +- yaifl/src/Yaifl/Model/Action.hs | 1 + yaifl/test/testcases/Chapter3/Starry Void | 4 +- yaifl/test/testcases/Chapter3/Tamed | 83 ++++++++++++++++++++++ yaifl/yaifl.cabal | 4 +- 10 files changed, 135 insertions(+), 20 deletions(-) create mode 100644 yaifl/test/testcases/Chapter3/Tamed diff --git a/cabal.project b/cabal.project index 90f69fa..8321022 100644 --- a/cabal.project +++ b/cabal.project @@ -1,7 +1,7 @@ source-repository-package type: git location: https://github.com/haskell-effectful/effectful.git - tag: a235b074cd68d770cbe732dc2a65067ff0c754f5 + tag: 54236f4e7b975d46bcc8108285c0c09483f8dd93 subdir: effectful-core subdir: effectful-plugin subdir: effectful-th diff --git a/yaifl/run_no b/yaifl/run_no index 694f34b..8a26022 100644 --- a/yaifl/run_no +++ b/yaifl/run_no @@ -1 +1 @@ -673 \ No newline at end of file +686 \ No newline at end of file diff --git a/yaifl/src/Yaifl/Game/ActionProcessing.hs b/yaifl/src/Yaifl/Game/ActionProcessing.hs index 28830b9..c81764a 100644 --- a/yaifl/src/Yaifl/Game/ActionProcessing.hs +++ b/yaifl/src/Yaifl/Game/ActionProcessing.hs @@ -13,6 +13,7 @@ import Yaifl.Model.Rules.Rulebook import Yaifl.Model.Rules.Run import Effectful.Reader.Static import Breadcrumbs +import Yaifl.Model.Actions.Args actionProcessingRules :: forall wm. ActionProcessing wm @@ -64,9 +65,13 @@ actionProcessingRules = ActionProcessing $ \aSpan a@((Action{..}) :: Action wm r , Rule "report stage rule" [] ( \v -> do - ignoreSpanIfEmptyRulebook reportRules - r <- runRulebookAndReturnVariables (Just aSpan) False reportRules v - return (first Just $ fromMaybe (v, Nothing) r)) + addAnnotation $ show (silently (actionOptions v)) + if silently (actionOptions v) + then return (Just v, Nothing) + else do + ignoreSpanIfEmptyRulebook reportRules + r <- runRulebookAndReturnVariables (Just aSpan) False reportRules v + return (first Just $ fromMaybe (v, Nothing) r)) , notImplementedRule "clean actions rule" ]) u) where diff --git a/yaifl/src/Yaifl/Game/Actions/Exiting.hs b/yaifl/src/Yaifl/Game/Actions/Exiting.hs index dfb493f..02bab52 100644 --- a/yaifl/src/Yaifl/Game/Actions/Exiting.hs +++ b/yaifl/src/Yaifl/Game/Actions/Exiting.hs @@ -16,6 +16,8 @@ import Yaifl.Model.Kinds.AnyObject import Yaifl.Model.Metadata import Yaifl.Model.Kinds.Supporter import Breadcrumbs +import Yaifl.Game.Move +import Yaifl.Model.Entity data ExitingResponses wm @@ -49,7 +51,7 @@ exitingAction = (makeAction "exiting") , carryOutRules = makeActionRulebook "carry out exiting rulebook" [ standardExiting ] , reportRules = makeActionRulebook "report exiting rulebook" [ notImplementedRule "standard report exiting" - , notImplementedRule "describe room emerged into" + , describeExited ] } @@ -81,7 +83,9 @@ cantExceedCapacity :: ExitingRule wm cantExceedCapacity = notImplementedRule "can't exit if this exceeds carrying capacity" standardExiting :: WMWithProperty wm Enclosing => ExitingRule wm -standardExiting = makeRule "standard exiting" [] $ \a@Args{variables=v} -> rulePass +standardExiting = makeRule "standard exiting" [] $ \a@Args{variables=v} -> do + o <- getObject (thingContainedBy $ getTaggedObject v) + bool (Just True) Nothing <$> move (source a) (tagObject @_ @EnclosingTag (thingContainedBy $ getTaggedObject v) o) describeExited :: ExitingRule wm diff --git a/yaifl/src/Yaifl/Game/Actions/GettingOff.hs b/yaifl/src/Yaifl/Game/Actions/GettingOff.hs index 027cb0f..88d8bac 100644 --- a/yaifl/src/Yaifl/Game/Actions/GettingOff.hs +++ b/yaifl/src/Yaifl/Game/Actions/GettingOff.hs @@ -15,10 +15,12 @@ import Yaifl.Model.Kinds.Supporter import Yaifl.Game.Move (move) import Yaifl.Model.Query import Yaifl.Model.Entity +import Yaifl.Model.Kinds.AnyObject +import Breadcrumbs data GettingOffResponses wm -type GettingOffAction wm = Action wm () 'TakesThingParameter (SupporterThing wm) +type GettingOffAction wm = Action wm () ('TakesOneOf 'TakesThingParameter 'TakesNoParameter) (SupporterThing wm) gettingOffAction :: (WithPrintingNameOfSomething wm, WMWithProperty wm Enclosing, WMWithProperty wm Container, WMWithProperty wm Supporter) => GettingOffAction wm gettingOffAction = (makeAction "getting off") @@ -26,10 +28,12 @@ gettingOffAction = (makeAction "getting off") , understandAs = ["get off"] , matches = [("from", TakesThingParameter)] , parseArguments = ParseArguments $ \(UnverifiedArgs Args{..}) -> do - let mbS = getSupporterMaybe (fst variables) - case mbS of - Nothing -> return $ FailedParse "can't get off a not-supporter" - Just s -> return $ SuccessfulParse (tagObject s (fst variables)) + offFrom <- case fst variables of + Left thingToExit -> return (Just thingToExit) + Right _ -> getThingMaybe $ thingContainedBy source + let mbS = getSupporterMaybe =<< offFrom + case (offFrom, mbS) of + (Just t, Just s) -> return $ SuccessfulParse (tagObject s t) {- if the actor is on the noun, continue the action; if the actor is carried by the noun, continue the action; @@ -38,10 +42,11 @@ gettingOffAction = (makeAction "getting off") tense]moment[otherwise]time[end if]." (A); stop the action. -} - , carryOutRules = makeActionRulebook "carry out gettingOff rulebook" [ standardGettingOff ] + _ -> return $ FailedParse "can't get off a not-supporter" + , carryOutRules = makeActionRulebook "carry out getting off rulebook" [ standardGettingOff ] , reportRules = makeActionRulebook "report getting off rulebook" - [ notImplementedRule "standard report getting off" - , notImplementedRule "describe room stood up into" + [ reportGettingOff + , describeExited ] } @@ -54,4 +59,21 @@ standardGettingOff = makeRule "standard getting off rule" [] $ \Args{source=s, v let supporterHolder = thingContainedBy (getTaggedObject v) e' <- getEnclosingObject supporterHolder move s (tagObject @_ @EnclosingTag (snd e') (fst e')) + rulePass + +reportGettingOff :: + WithPrintingNameOfSomething wm + => GettingOffRule wm +reportGettingOff = makeRule "standard report getting off rule" [] $ \a@Args{source=s, variables=v} -> do + -- if the action is not silent: + unlessSilent a + -- say "[The actor] [get] off [the noun]." (A); + [saying|{The s} #{get} off {the v}.|] + rulePass + +describeExited :: + GettingOffRule wm +describeExited = makeRule "describe room stood up into rule" forPlayer' $ \a@Args{variables=v} -> do + -- TODO: reckon darkness + parseAction ((actionOptions a) { silently = True }) [ConstantParameter "going"] "look" rulePass \ No newline at end of file diff --git a/yaifl/src/Yaifl/Game/Parser.hs b/yaifl/src/Yaifl/Game/Parser.hs index 49403bc..2c1914d 100644 --- a/yaifl/src/Yaifl/Game/Parser.hs +++ b/yaifl/src/Yaifl/Game/Parser.hs @@ -111,7 +111,7 @@ runActionHandlerAsWorldActions = interpret $ \_ -> \case Nothing -> do addAnnotation $ (("Argument mismatch because we got " <> show (S.fromList $ match:additionalArgs) <> " and we expected " <> show (goesWithA @goesWith Proxy)) :: Text) return $ Left (("Argument mismatch because we got " <> show (S.fromList $ match:additionalArgs) <> " and we expected " <> show (goesWithA @goesWith Proxy)) :: Text) - Just v' -> Right <$> tryAction actionOpts a (UnverifiedArgs $ Args { actionOptions = ActionOptions False False, timestamp = ts, source = actor, variables = (v', parsedArgs) }) + Just v' -> Right <$> tryAction actionOpts a (UnverifiedArgs $ Args { actionOptions = actionOpts, timestamp = ts, source = actor, variables = (v', parsedArgs) }) case nouns of Left ex -> do addAnnotation ex diff --git a/yaifl/src/Yaifl/Model/Action.hs b/yaifl/src/Yaifl/Model/Action.hs index 67d08b4..5eceb39 100644 --- a/yaifl/src/Yaifl/Model/Action.hs +++ b/yaifl/src/Yaifl/Model/Action.hs @@ -109,6 +109,7 @@ type ActionRulebook wm ac v = Rulebook wm ((:>) (Reader ac)) (Args wm v) Bool type ActionRule wm ac v = Rule wm ((:>) (Reader ac)) (Args wm v) Bool data ActionInterrupt = ContinueAction | StopAction + deriving stock (Eq, Ord, Enum, Bounded, Generic, Read, Show) makeFieldLabelsNoPrefix ''Action diff --git a/yaifl/test/testcases/Chapter3/Starry Void b/yaifl/test/testcases/Chapter3/Starry Void index 653787b..45c9c2f 100644 --- a/yaifl/test/testcases/Chapter3/Starry Void +++ b/yaifl/test/testcases/Chapter3/Starry Void @@ -29,8 +29,8 @@ You close the magician's booth. >look The Starry Void -The door stands open to the outside. +A crack of light indicates the way back out to the center ring. >examine crack of light -The booth door is wide open. +The booth door is shut, admitting only a thin crack of light. diff --git a/yaifl/test/testcases/Chapter3/Tamed b/yaifl/test/testcases/Chapter3/Tamed new file mode 100644 index 0000000..f16fafd --- /dev/null +++ b/yaifl/test/testcases/Chapter3/Tamed @@ -0,0 +1,83 @@ +----------------- +----- Tamed ----- +----------------- + +Center Ring (on the pedestal) +Off to one side is a magician's booth, used in disappearing acts. The exterior is covered with painted gilt stars. + +You can also see a cage (closed) (in which is a lion) here. + +>get in cage + +You can't get into the closed cage. + +>open cage + +You open the cage. + +>get in cage + +(getting off the pedestal) + +You get into the cage. + +In the cage you can see a lion. + +The lion eyes you with obvious discontent. + +>z + +Time passes. + +The lion eyes you with obvious discontent. + +>close cage + +You close the cage. + +Though the lion does not move, you are aware that it is watching you closely. + +>out + +You can't get out of the closed cage. + +Though the lion does not move, you are aware that it is watching you closely. + +>open cage + +You open the cage. + +The lion eyes you with obvious discontent. + +>get on pedestal + +(getting out of the cage) + +You get onto the pedestal. + +>get off + +You get off the pedestal. + +Center Ring +Off to one side is a magician's booth, used in disappearing acts. The exterior is covered with painted gilt stars. + +You can also see a cage (in which is a lion) and a pedestal here. + +>look + +Center Ring +Off to one side is a magician's booth, used in disappearing acts. The exterior is covered with painted gilt stars. + +You can also see a cage (in which is a lion) and a pedestal here. + +>enter booth + +You get into the magician's booth. + +>out + +Center Ring +Off to one side is a magician's booth, used in disappearing acts. The exterior is covered with painted gilt stars. + +You can also see a cage (in which is a lion) and a pedestal here. diff --git a/yaifl/yaifl.cabal b/yaifl/yaifl.cabal index d4d53a1..47a14b1 100644 --- a/yaifl/yaifl.cabal +++ b/yaifl/yaifl.cabal @@ -1,6 +1,6 @@ cabal-version: 3.6 name: yaifl -version: 0.0.11.584 +version: 0.0.12.686 synopsis: Yet another interactive fiction library. description: Yet another interactive fiction library. homepage: https://github.com/PPKFS/yaifl @@ -47,7 +47,7 @@ common common-options -fprint-potential-instances -fno-warn-unused-do-bind -haddock -fwrite-ide-info -fplugin=Effectful.Plugin -Wunused-packages - default-language: GHC2021 + default-language: GHC2024 default-extensions: DataKinds DefaultSignatures