add getting off

yaifl-debugger/src/Main.hs

@@ -0,0 +1,106 @@
+module Main where
+
+import Yaifl.Prelude hiding (on)
+
+import Yaifl
+import Yaifl.Model.Action
+
+import Lens.Micro as L ((^.))
+import Lens.Micro.Mtl as L
+import Control.Monad (void)
+import Control.Monad.State as S (modify)
+import Data.Maybe (fromMaybe)
+import qualified Graphics.Vty as V
+
+import qualified Brick.Main as M
+import qualified Brick.Types as T
+import qualified Brick.Widgets.Border as B
+import qualified Brick.Widgets.List as L
+import qualified Brick.Widgets.Center as C
+import qualified Brick.AttrMap as A
+import qualified Data.Vector as Vec
+import Brick.Types
+  ( Widget
+  )
+import Brick.Widgets.Core
+  ( (<+>)
+  , str
+  , vLimit
+  , hLimit
+  , vBox
+  , withAttr
+  )
+import Brick.Util (fg, on)
+
+main :: IO ()
+main = void $ M.defaultMain theApp initialState
+
+drawUI :: (Show a) => L.List () a -> [Widget ()]
+drawUI l = [ui]
+    where
+        label = str "Item " <+> cur <+> str " of " <+> total
+        cur = case l L.^. (L.listSelectedL) of
+                Nothing -> str "-"
+                Just i -> str (show (i + 1))
+        total = str $ show $ Vec.length $ l L.^. (L.listElementsL)
+        box = B.borderWithLabel label $
+              vLimit 15 $
+              L.renderList listDrawElement True l
+        ui = C.vCenter $ vBox [ C.hCenter box
+                              , str " "
+                              , C.hCenter $ str "Press G/D to switch between Game/Debug modes."
+                              , C.hCenter $ str $ "Currently selected mode: "
+                              , C.hCenter $ str "Press Esc to exit."
+                              ]
+
+appEvent :: T.BrickEvent () e -> T.EventM () (L.List () Char) ()
+appEvent (T.VtyEvent e) =
+    case e of
+        V.EvKey (V.KChar '+') [] -> do
+            els <- L.use L.listElementsL
+            let el = nextElement els
+                pos = Vec.length els
+            S.modify $ L.listInsert pos el
+
+        V.EvKey (V.KChar '-') [] -> do
+            sel <- L.use L.listSelectedL
+            case sel of
+                Nothing -> return ()
+                Just i -> S.modify $ L.listRemove i
+
+        V.EvKey V.KEsc [] -> M.halt
+
+        ev -> L.handleListEvent ev
+    where
+      nextElement :: Vec.Vector Char -> Char
+      nextElement v = fromMaybe '?' $ Vec.find (flip Vec.notElem v) (Vec.fromList ['a' .. 'z'])
+appEvent _ = return ()
+
+listDrawElement :: (Show a) => Bool -> a -> Widget ()
+listDrawElement seoopl a =
+    let selStr s = if sel
+                   then withAttr customAttr (str $ "<" <> s <> ">")
+                   else str s
+    in C.hCenter $ str "Item " <+> (selStr $ show a)
+
+initialState :: L.List () Char
+initialState = L.list () (Vec.fromList ['a','b','c']) 1
+
+customAttr :: A.AttrName
+customAttr = L.listSelectedAttr <> A.attrName "custom"
+
+theMap :: A.AttrMap
+theMap = A.attrMap V.defAttr
+    [ (L.listAttr,            V.white `on` V.blue)
+    , (L.listSelectedAttr,    V.blue `on` V.white)
+    , (customAttr,            fg V.cyan)
+    ]
+
+theApp :: M.App (L.List () Char) e ()
+theApp =
+    M.App { M.appDraw = drawUI
+          , M.appChooseCursor = M.showFirstCursor
+          , M.appHandleEvent = appEvent
+          , M.appStartEvent = return ()
+          , M.appAttrMap = const theMap
+          }

yaifl-debugger/yaifl-debugger.cabal

@@ -0,0 +1,94 @@
+cabal-version: 3.6
+name:          yaifl-debugger
+version:       0.0.0.1
+synopsis:      Some sort of TUI debugger for yaifl.
+description:   Some sort of TUI debugger for yaifl.
+homepage:      https://github.com/PPKFS/yaifl
+bug-reports:   https://github.com/PPKFS/yaifl/issues
+license:       MIT
+author:        Avery
+maintainer:    Avery <[email protected]>
+copyright:     2024 Avery
+category:      Game Development
+build-type:    Simple
+tested-with:   GHC == 9.4.7
+
+source-repository head
+  type:     git
+  location: https://github.com/PPKFS/yaifl.git
+
+common common-options
+  build-depends:
+    base >= 4.17.2 && < 5,
+    containers >= 0.6.7 && < 1.7,
+    template-haskell >= 2.19.0 && < 3.20,
+    effectful-core >= 2.3.0 && < 3.4,
+    effectful-plugin >= 1.1.0 && < 2.2,
+    effectful-th >= 1.0.0 && < 2.1,
+    enummapset >= 0.7.2 && < 1.8,
+    text >= 2.0.2 && < 3.1,
+    haskell-src-exts >= 1.23.1 && < 2.0,
+    haskell-src-meta >= 0.8.13 && < 2.0,
+    megaparsec >= 9.6.1 && < 10.0,
+    named >= 0.3.0 && < 1.0,
+    prettyprinter >= 1.7.1 && < 3.0,
+    prettyprinter-ansi-terminal >= 1.1.3 && < 2.0,
+    split >= 0.2.4 && < 2.0,
+    text-display >= 0.0.5 && < 1.0,
+    breadcrumbs >= 1.0.0.0 && <= 10.0.0.0,
+    solitude >= 0.0.0.0 && <= 10.0.0.0,
+    random
+
+  ghc-options:
+    -Wall -Wcompat -Widentities -Wredundant-constraints
+    -Wno-unused-packages -Wno-deprecations -fhide-source-paths
+    -Wno-unused-top-binds -Wmissing-deriving-strategies -O2
+    -flate-specialise -fspecialise-aggressively
+    -fprint-potential-instances -fno-warn-unused-do-bind -haddock
+    -fwrite-ide-info -fplugin=Effectful.Plugin -Wunused-packages -threaded
+
+  default-language:   GHC2021
+  default-extensions:
+    DataKinds
+    DefaultSignatures
+    DeriveAnyClass
+    DerivingStrategies
+    DuplicateRecordFields
+    FunctionalDependencies
+    InstanceSigs
+    LambdaCase
+    MultiWayIf
+    NoImplicitPrelude
+    OverloadedLabels
+    OverloadedStrings
+    PatternSynonyms
+    QuasiQuotes
+    StrictData
+    TemplateHaskell
+    TypeFamilies
+    UndecidableInstances
+    ViewPatterns
+
+executable yaifl-debugger
+  import:          common-options
+  hs-source-dirs:  src
+  main-is: Main.hs
+  other-modules:
+
+  build-depends:
+    , effectful-th
+    , enummapset
+    , haskell-src-exts
+    , haskell-src-meta
+    , megaparsec
+    , prettyprinter
+    , prettyprinter-ansi-terminal
+    , split
+    , yaifl
+    , brick
+    , vty
+    , mtl
+    , vector
+    , microlens
+    , microlens-mtl
+    , placeholder

yaifl/run_no

@@ -1 +1 @@
-652
+653

yaifl/src/Yaifl/Game/Actions/Exiting.hs

@@ -42,8 +42,8 @@ exitingAction = (makeAction "exiting")
             Just x ->
               case getSupporterMaybe t of
                 Nothing -> SuccessfulParse (tagObject x t)
-                Just _ -> ConversionTo "get off")
-        (return $ ConversionTo "go out") outFrom
+                Just _ -> ConversionTo "get off " [ThingParameter t])
+        (return $ ConversionTo "go out" []) outFrom
   , beforeRules = makeActionRulebook "before exiting rulebook" []
   , insteadRules = makeActionRulebook "instead of exiting rulebook" []
   , checkRules = makeActionRulebook "check exiting rulebook"

yaifl/src/Yaifl/Game/Actions/GettingOff.hs

@@ -0,0 +1,61 @@
+{-# LANGUAGE RecordWildCards #-}
+module Yaifl.Game.Actions.GettingOff where
+
+import Yaifl.Model.Action
+import Yaifl.Prelude
+import Yaifl.Model.Actions.Args
+import Yaifl.Model.Rules.Rulebook
+import Yaifl.Text.Responses
+import Yaifl.Model.Kinds.Object
+import Yaifl.Model.Kinds.Direction
+import Yaifl.Model.WorldModel
+import Yaifl.Text.Say
+import Yaifl.Model.Kinds
+import Yaifl.Model.HasProperty
+import Yaifl.Model.Kinds.Enclosing
+import Yaifl.Game.Move
+import Yaifl.Model.Kinds.Container
+import Yaifl.Model.Tag
+import Yaifl.Model.Entity (EnclosingTag)
+import Yaifl.Model.Query
+import Yaifl.Model.Kinds.AnyObject
+import Yaifl.Model.Metadata
+import Yaifl.Model.Kinds.Supporter
+
+data GettingOffResponses wm
+
+type GettingOffAction wm = Action wm () ('TakesOneOf 'TakesObjectParameter 'TakesNoParameter) (EnclosingThing wm)
+
+gettingOffAction :: (WithPrintingNameOfSomething wm, WMWithProperty wm Enclosing, WMWithProperty wm Container, WMWithProperty wm Supporter) => GettingOffAction wm
+gettingOffAction = (makeAction "getting off")
+  { name = "getting off"
+  , understandAs = ["get off"]
+  , matches = [("from", TakesObjectParameter)]
+  , parseArguments = ParseArguments $ \(UnverifiedArgs a@Args{..}) -> do
+      outFrom <- case fst variables of
+          Left thingToExit -> return (toAny thingToExit)
+          Right _ -> getObject $ thingContainedBy source
+      return $ asThingOrRoom
+        (\t ->
+          case getEnclosingMaybe (toAny t) of
+            Nothing -> FailedParse "that's not exitable"
+            Just x ->
+              case getSupporterMaybe t of
+                Nothing -> SuccessfulParse (tagObject x t)
+                Just _ -> ConversionTo "get off " [ThingParameter t])
+        (return $ ConversionTo "go out" []) outFrom
+  , beforeRules = makeActionRulebook "before gettingOff rulebook" []
+  , insteadRules = makeActionRulebook "instead of gettingOff rulebook" []
+  , checkRules = makeActionRulebook "check gettingOff rulebook"
+    [ convertExitGoing
+    , cantExitNotInExitable
+    , cantExitGetOff
+    ]
+  , carryOutRules = makeActionRulebook "carry out gettingOff rulebook" [ standardGettingOff ]
+  , reportRules = makeActionRulebook "report gettingOff rulebook"
+    [ notImplementedRule "standard report gettingOff"
+    , notImplementedRule "describe room emerged into"
+    ]
+  }
+
+type GettingOffRule wm = ActionRule wm (GettingOffAction wm) (EnclosingThing wm)

yaifl/src/Yaifl/Game/Actions/Going.hs

@@ -115,7 +115,7 @@ goingActionSet ::
   (ParseArgumentEffects wm es, WMStdDirections wm, WMWithProperty wm Door)
   => WithPrintingNameOfSomething wm
   => UnverifiedArgs wm ('Optionally ('TakesOneOf 'TakesDirectionParameter 'TakesObjectParameter))
-  -> Eff es (ParseArgumentResult (GoingActionVariables wm))
+  -> Eff es (ParseArgumentResult wm (GoingActionVariables wm))
 goingActionSet (UnverifiedArgs Args{..}) = do
   --now the thing gone with is the item-pushed-between-rooms;
   thingGoneWith <- getMatchingThing "with"
@@ -171,7 +171,7 @@ cantGoThatWay ::
   => Thing wm
   -> Maybe (Thing wm)
   -> Room wm
-  -> Eff es (ParseArgumentResult a)
+  -> Eff es (ParseArgumentResult wm a)
 cantGoThatWay source mbDoorThrough fromRoom = do
   whenM (isPlayer source) $ do
     let possExits = Map.keys $ getAllConnections fromRoom

yaifl/src/Yaifl/Game/Parser.hs

@@ -51,7 +51,7 @@ runAction opts uArgs act = withSpan "run action" (act ^. #name) $ \aSpan -> do
     FailedParse err -> do
       addAnnotation err
       pure (Just False)
-    ConversionTo newCommand -> rightToMaybe <$> parseAction opts [] newCommand
+    ConversionTo newCommand args -> rightToMaybe <$> parseAction opts args newCommand
     SuccessfulParse args -> do
       -- running an action is simply evaluating the action processing rulebook.
       (ActionProcessing ap) <- use @(WorldActions wm) #actionProcessing

yaifl/src/Yaifl/Model/Action.hs

@@ -58,15 +58,15 @@ newtype InsteadRules wm = InsteadRules
 
 type ParseArgumentEffects wm es = (WithMetadata es, NoMissingObjects wm es, RuleEffects wm es)
 
-data ParseArgumentResult v =
+data ParseArgumentResult wm v =
   FailedParse Text
   | SuccessfulParse v
-  | ConversionTo Text
-  deriving stock (Eq, Ord, Show, Generic, Functor)
+  | ConversionTo Text [NamedActionParameter wm]
+  deriving stock (Show, Generic, Functor)
 
 -- | `ParseArguments` is the equivalent of Inform7's `set rulebook variables`.
 newtype ParseArguments wm ia v = ParseArguments
-  { runParseArguments :: forall es. (ParseArgumentEffects wm es, Refreshable wm v) => ia -> Eff es (ParseArgumentResult v)
+  { runParseArguments :: forall es. (ParseArgumentEffects wm es, Refreshable wm v) => ia -> Eff es (ParseArgumentResult wm v)
   }
 
 -- | An 'Action' is a command that the player types, or that an NPC chooses to execute.