diff --git a/src/Dodge/Button/Event.hs b/src/Dodge/Button/Event.hs index 6bf549e8c..325732f98 100644 --- a/src/Dodge/Button/Event.hs +++ b/src/Dodge/Button/Event.hs @@ -1,7 +1,6 @@ module Dodge.Button.Event where import Dodge.Data import Dodge.SoundLogic -import Dodge.Placement.Instance.Terminal import Dodge.WorldEffect import Control.Lens diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 5979d48dd..d66ff9b9e 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -24,9 +24,6 @@ import Dodge.SoundLogic import Geometry import Picture -import qualified Data.Text as T -import qualified Data.Map.Strict as M - defaultEquipment :: Item defaultEquipment = defaultItem { _itInvColor = yellow diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index dc71e56fe..e0ee9f71b 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -4,10 +4,9 @@ module Dodge.Event.Keyboard , handleTextInput , guardDisconnectedID ) where -import Dodge.Event.Keyboard +import Dodge.Terminal.LeftButton import Dodge.WorldPos import Dodge.Button.Event -import Dodge.Terminal import Dodge.InputFocus import Dodge.Base import Dodge.Combine diff --git a/src/Dodge/Machine/Destroy.hs b/src/Dodge/Machine/Destroy.hs index cb8ad2365..597e3a521 100644 --- a/src/Dodge/Machine/Destroy.hs +++ b/src/Dodge/Machine/Destroy.hs @@ -1,6 +1,5 @@ module Dodge.Machine.Destroy where import Dodge.WorldEffect -import Dodge.Terminal import Dodge.Wall.Delete import Dodge.Data import Dodge.WorldEvent.Explosion diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index 3194c6856..3867ef801 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -1,16 +1,8 @@ --{-# LANGUAGE TupleSections #-} module Dodge.Terminal where import Dodge.SoundLogic -import Dodge.WorldEvent.Cloud -import Dodge.Data -import Dodge.Inventory.Lock -import Dodge.Placement.Instance.Terminal -import Dodge.Data.WorldEffect -import Dodge.Data.Terminal import Dodge.Data import Dodge.Default ---import Dodge.Base -import Dodge.SoundLogic import Color import Justify import LensHelp @@ -21,12 +13,7 @@ import Data.Char import Data.Maybe import Data.Foldable import qualified Data.Map.Strict as M -import qualified IntMapHelp as IM import qualified Data.Text as T ---import Text.Read - -import System.Random -import Control.Lens basicTerminal :: Terminal basicTerminal = defaultTerminal @@ -230,3 +217,14 @@ togglesToEffects = fmap f . _tmToggles -- \_ -> triggers . ix (_ttTriggerID tt) %~ not] simpleTermMessage :: [String] -> Terminal simpleTermMessage strs = defaultTerminal & tmFutureLines .~ map makeTermLine strs + +commandFutureLines :: String -> Terminal -> World -> [TerminalLine] +commandFutureLines s tm w = fromMaybe [errline "^ INVALID COMMAND"] $ do + (str,args) <- safeUncons $ words s + command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) (getCommands tm) + case doTerminalCommandEffect (_tcEffect command) tm w of + NoArguments tls -> Just tls + OneArgument argtype m -> Just $ fromMaybe [errline $ "^ INVALID ARGUMENT: EXPECTS "++ argtype] + $ safeHead args >>= (m M.!?) + where + errline = makeColorTermLine red diff --git a/src/Dodge/TerminalCommandEffect.hs b/src/Dodge/TerminalCommandEffect.hs index fa7e22e3f..6ff6f602c 100644 --- a/src/Dodge/TerminalCommandEffect.hs +++ b/src/Dodge/TerminalCommandEffect.hs @@ -1,4 +1,3 @@ module Dodge.TerminalCommandEffect where -import Dodge.Data diff --git a/src/Dodge/TmTm.hs b/src/Dodge/TmTm.hs index 78d688541..3b1307e44 100644 --- a/src/Dodge/TmTm.hs +++ b/src/Dodge/TmTm.hs @@ -6,4 +6,5 @@ doTmTm :: TmTm -> Terminal -> Terminal doTmTm tmtm = case tmtm of TmTmClearDisplayedLines -> tmDisplayedLines .~ [] TmTmSetStatus s -> tmStatus .~ s + TmId -> id diff --git a/src/Dodge/TmWdWd.hs b/src/Dodge/TmWdWd.hs index b475cf8c6..0ecc29cee 100644 --- a/src/Dodge/TmWdWd.hs +++ b/src/Dodge/TmWdWd.hs @@ -1,6 +1,4 @@ module Dodge.TmWdWd where -import Dodge.Terminal -import Dodge.Data diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 28521d875..e8eab1e05 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -5,7 +5,6 @@ Description : Simulation update -} module Dodge.Update ( updateUniverse ) where import Dodge.TmTm -import Dodge.Terminal import Color import Dodge.DrWdWd import Dodge.TractorBeam.Update diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index 6d62a861d..d96d16744 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -2,11 +2,10 @@ module Dodge.Update.UsingInput ( updateUsingInput ) where -import Dodge.WorldEffect +import Dodge.Terminal.LeftButton import Dodge.Data import Dodge.Base.You import Dodge.Creature.Impulse.UseItem -import Dodge.Terminal import Dodge.InputFocus import Dodge.Combine import Dodge.Inventory diff --git a/src/Dodge/WorldEffect.hs b/src/Dodge/WorldEffect.hs index 2eedd58a4..b41f5a89e 100644 --- a/src/Dodge/WorldEffect.hs +++ b/src/Dodge/WorldEffect.hs @@ -4,29 +4,15 @@ import Dodge.SoundLogic import Dodge.WorldEvent.Cloud import Dodge.Data import Dodge.Inventory.Lock -import Dodge.Placement.Instance.Terminal -import Dodge.Data.WorldEffect -import Dodge.Data.Terminal -import Dodge.Data import Dodge.Default ---import Dodge.Base -import Dodge.SoundLogic -import Color -import Justify import LensHelp -import Sound.Data -import ListHelp (safeUncons,safeHead) -import Data.Char import Data.Maybe import Data.Foldable import qualified Data.Map.Strict as M import qualified IntMapHelp as IM -import qualified Data.Text as T ---import Text.Read import System.Random -import Control.Lens doWorldEffect :: WdWd -> World -> World doWorldEffect we = case we of @@ -39,6 +25,7 @@ doWorldEffect we = case we of MakeStartCloudAt p -> makeStartCloudAt p TorqueCr x cid -> torqueCr x cid SoundStart so p sid mi -> soundStart so p sid mi + WdWdNegateTrig trid -> triggers . ix trid %~ not accessTerminal :: Maybe Int -> World -> World accessTerminal mtmid w = case mtmid of @@ -64,42 +51,6 @@ torqueCr x cid w -doTerminalEffectLB :: Terminal -> World -> World -doTerminalEffectLB tm w = guardDisconnected tm w $ fromMaybe w $ do - s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText - if null (words s) - then Just $ defocusTerminalInput w - else return $ terminalReturnEffect tm w - -terminalReturnEffect :: Terminal -> World -> World -terminalReturnEffect tm w = guardDisconnected tm w $ fromMaybe w $ do - s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText - return $ runTerminalString s tm $ w - & terminals . ix (_tmID tm) . tmFutureLines .~ [makeTermLine ('>':s)] - -commandFutureLines :: String -> Terminal -> World -> [TerminalLine] -commandFutureLines s tm w = fromMaybe [errline "^ INVALID COMMAND"] $ do - (str,args) <- safeUncons $ words s - command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) (getCommands tm) - case doTerminalCommandEffect (_tcEffect command) tm w of - NoArguments tls -> Just tls - OneArgument argtype m -> Just $ fromMaybe [errline $ "^ INVALID ARGUMENT: EXPECTS "++ argtype] - $ safeHead args >>= (m M.!?) - where - errline = makeColorTermLine red - -runTerminalString :: String -> Terminal -> World -> World -runTerminalString s tm w = w & terminals . ix (_tmID tm) %~ - ( (tmInput .~ TerminalInput T.empty True (0,0)) - . (tmFutureLines ++.~ commandFutureLines s tm w) - . (tmCommandHistory %~ take 10 . (s:)) - ) - -defocusTerminalInput :: World -> World -defocusTerminalInput w = fromMaybe w $ do - tmid <- w ^? hud . hudElement . subInventory . termID - return $ w & terminals . ix tmid . tmInput . tiFocus %~ const False - doCommandInstant :: String -> Terminal -> World -> World doCommandInstant arg tm w = doLineEffectsInstant tm w $ commandFutureLines arg tm w @@ -154,5 +105,5 @@ doTmWdWd tmwdwd = case tmwdwd of TmWdWdTermSound sid -> \tm w -> let tpos = fromMaybe 0 $ w ^? buttons . ix (_tmButtonID tm) . btPos in soundStart TerminalSound tpos sid Nothing w TmWdWdDoDeathTriggers -> doDeathTriggers - --TmWdWdfromWdWd f -> \_ -> doWorldEffect f + TmWdWdfromWdWd f -> \_ -> doWorldEffect f