justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup

Browse Source
This commit is contained in:
justin
2022-07-25 00:56:55 +01:00
parent 1b26ad361d
commit 14c4c47bf5
11 changed files with 16 additions and 77 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Button/Event.hs
-1
View File
@@ -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
src/Dodge/Default.hs
-3
View File
@@ -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
src/Dodge/Event/Keyboard.hs
+1 -2
View File
@@ -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
src/Dodge/Machine/Destroy.hs
-1
View File
@@ -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
src/Dodge/Terminal.hs
+11 -13
View File
@@ -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
src/Dodge/TerminalCommandEffect.hs
-1
View File
@@ -1,4 +1,3 @@
module Dodge.TerminalCommandEffect
where
import Dodge.Data
src/Dodge/TmTm.hs
+1
View File
@@ -6,4 +6,5 @@ doTmTm :: TmTm -> Terminal -> Terminal
doTmTm tmtm = case tmtm of
TmTmClearDisplayedLines -> tmDisplayedLines .~ []
TmTmSetStatus s -> tmStatus .~ s
TmId -> id
src/Dodge/TmWdWd.hs
-2
View File
@@ -1,6 +1,4 @@
module Dodge.TmWdWd
where
import Dodge.Terminal
import Dodge.Data
src/Dodge/Update.hs
-1
View File
@@ -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
src/Dodge/Update/UsingInput.hs
+1 -2
View File
@@ -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
src/Dodge/WorldEffect.hs
+2 -51
View File
@@ -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