diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index cd3b5ef11..3d5f04e9c 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -8,7 +8,6 @@ module Dodge.Combine ( enterCombineInv, ) where -import qualified Data.Text as T import qualified Data.IntSet as IS import Control.Lens import Control.Monad @@ -95,7 +94,7 @@ toggleCombineInv w = case w ^. hud . hudElement of enterCombineInv :: World -> World enterCombineInv w = w & hud . hudElement . subInventory .~ CombineInventory { _subInvSel = mi - , _subInvRegex = T.pack "" + , _subInvRegex = "" , _subInvRegexInput = False } where diff --git a/src/Dodge/Data/HUD.hs b/src/Dodge/Data/HUD.hs index 0560a834e..6f1f95fbf 100644 --- a/src/Dodge/Data/HUD.hs +++ b/src/Dodge/Data/HUD.hs @@ -10,7 +10,6 @@ import Dodge.Data.Button import Dodge.Data.FloorItem import Control.Lens import Geometry.Data -import qualified Data.Text as T data HUDElement = DisplayInventory @@ -22,7 +21,7 @@ data HUDElement data SubInventory = NoSubInventory | ExamineInventory {_subInvSel :: Maybe Int} - | CombineInventory {_subInvSel :: Maybe Int, _subInvRegex :: T.Text + | CombineInventory {_subInvSel :: Maybe Int, _subInvRegex :: String , _subInvRegexInput :: Bool} | LockedInventory | DisplayTerminal {_termID :: Int} diff --git a/src/Dodge/Data/Input.hs b/src/Dodge/Data/Input.hs index 508b82e3f..57687b653 100644 --- a/src/Dodge/Data/Input.hs +++ b/src/Dodge/Data/Input.hs @@ -36,7 +36,7 @@ data Input = Input , _lSelect :: Point2 , _rSelect :: Point2 , _clickMousePos :: Point2 - , _textInput :: T.Text + , _textInput :: String , _scrollTestValue :: Float } diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index ef8d4ba21..7da947333 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -46,6 +46,11 @@ data SelectionItem a = SelectionItem } | SelectionFilter { _siPictures :: [String] + , _siHeight :: Int + , _siIsSelectable :: Bool + , _siWidth :: Int + , _siColor :: Color + , _siOffX :: Int } --deriving (Eq, Ord, Show, Read) --Generic, Flat) diff --git a/src/Dodge/Data/Terminal.hs b/src/Dodge/Data/Terminal.hs index 475af3346..f136be657 100644 --- a/src/Dodge/Data/Terminal.hs +++ b/src/Dodge/Data/Terminal.hs @@ -10,7 +10,6 @@ import Control.Lens import Data.Aeson import Data.Aeson.TH import qualified Data.Map.Strict as M -import qualified Data.Text as T import Dodge.Data.WorldEffect data TerminalStatus = TerminalOff | TerminalBusy | TerminalReady @@ -18,7 +17,7 @@ data TerminalStatus = TerminalOff | TerminalBusy | TerminalReady --deriving (Eq, Ord, Show, Read) --Generic, Flat) data TerminalInput = TerminalInput - { _tiText :: T.Text + { _tiText :: String , _tiFocus :: Bool , _tiSel :: (Int, Int) } diff --git a/src/Dodge/Data/Universe.hs b/src/Dodge/Data/Universe.hs index 746b4f477..48b4b382b 100644 --- a/src/Dodge/Data/Universe.hs +++ b/src/Dodge/Data/Universe.hs @@ -66,7 +66,7 @@ data ScreenLayer , _scListDisplayParams :: ListDisplayParams } | InputScreen - { _scInput :: T.Text + { _scInput :: String , _scFooter :: String } -- | WaitScreen diff --git a/src/Dodge/Debug/Terminal.hs b/src/Dodge/Debug/Terminal.hs index 48c1f807c..a5b7b0e79 100644 --- a/src/Dodge/Debug/Terminal.hs +++ b/src/Dodge/Debug/Terminal.hs @@ -8,7 +8,6 @@ import Control.Lens --import Control.Monad --import Data.List import Data.Maybe -import qualified Data.Text as T import Dodge.Creature import Dodge.Data.Universe import Dodge.Inventory.Add @@ -71,7 +70,7 @@ parseNum :: [String] -> Int parseNum xs = fromMaybe 1 $ xs ^? ix 0 >>= readMaybe showTerminalError :: String -> String -> Universe -> Universe -showTerminalError cmd s = uvScreenLayers .:~ InputScreen (T.pack cmd) s +showTerminalError cmd s = uvScreenLayers .:~ InputScreen cmd s applySetTerminalString :: String -> Universe -> Universe applySetTerminalString [] = id diff --git a/src/Dodge/Default/Terminal.hs b/src/Dodge/Default/Terminal.hs index 746bd5bd1..b847bea24 100644 --- a/src/Dodge/Default/Terminal.hs +++ b/src/Dodge/Default/Terminal.hs @@ -1,7 +1,6 @@ module Dodge.Default.Terminal where import qualified Data.Map.Strict as M -import qualified Data.Text as T import Dodge.Data.Terminal import Dodge.Data.WorldEffect @@ -29,7 +28,7 @@ defaultTerminal = defaultTerminalInput :: TerminalInput defaultTerminalInput = TerminalInput - { _tiText = T.pack "" + { _tiText = "" , _tiFocus = True , _tiSel = (0, 0) } diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index eabf76b9d..cf11988b2 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -15,6 +15,7 @@ module Dodge.Event ( handleEvent, ) where +import qualified Data.Text as T import Dodge.Concurrent import Dodge.Data.Universe import Dodge.Event.Input @@ -24,7 +25,7 @@ import SDL handleEvent :: Event -> Universe -> Universe handleEvent e u = case eventPayload e of - TextInputEvent tev -> inputpoint (handleTextInput (textInputEventText tev)) u + TextInputEvent tev -> inputpoint (handleTextInput (T.unpack $ textInputEventText tev)) u KeyboardEvent kev -> inputpoint (handleKeyboardEvent kev) u MouseMotionEvent mmev -> inputpoint (handleMouseMotionEvent mmev cfig) u MouseButtonEvent mbev -> inputpoint (handleMouseButtonEvent mbev) u diff --git a/src/Dodge/Event/Input.hs b/src/Dodge/Event/Input.hs index 0a630eab1..2c846b696 100644 --- a/src/Dodge/Event/Input.hs +++ b/src/Dodge/Event/Input.hs @@ -7,7 +7,6 @@ module Dodge.Event.Input ( handleMouseWheelEvent, ) where -import qualified Data.Text as T import Dodge.Data.Config import Dodge.Data.Input import LensHelp @@ -15,8 +14,8 @@ import SDL -- annoyingly, the text input event doesn't register backspace, so deletion has to be -- dealt with separately -handleTextInput :: T.Text -> Input -> Input -handleTextInput text = textInput %~ (`T.append` text) +handleTextInput :: String -> Input -> Input +handleTextInput text = textInput %~ (++ text) -- | Handles keyboard press and release. handleKeyboardEvent :: KeyboardEventData -> Input -> Input diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 5411c4fd8..969d394fa 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -7,7 +7,6 @@ import Dodge.Creature.Info import Control.Lens import qualified Data.Map.Strict as M import Data.Maybe -import qualified Data.Text as T import qualified Data.Vector as V import Dodge.Base import Dodge.Clock @@ -97,7 +96,7 @@ drawSubInventory subinv cfig w = case subinv of titledSub cfig ("COMBINE") - (combineListSelection w mi (T.unpack regex) x) + (combineListSelection w mi regex x) <> combineInventoryExtra mi cfig w titledSub :: Configuration -> String -> SelectionList a -> Picture @@ -250,7 +249,7 @@ displayTerminal tid cfig w = fromMaybe mempty $ do displayTermInput tm = case _tmInput tm of TerminalInput s hasfoc _ -> (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)]) displayInputText tm s - | _tmStatus tm == TerminalReady = '>' : T.unpack s + | _tmStatus tm == TerminalReady = '>' : s | otherwise = "" displayBlinkCursor hasfoc | hasfoc = clockCycle 10 (V.fromList ["_", ""]) w diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index 79393a68a..af14bffaf 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -1,7 +1,7 @@ module Dodge.Render.List where --import Data.Foldable -import Regex +import Dodge.SelectionList import Data.Maybe import Dodge.Base.WinScale import Dodge.Base.Window @@ -26,20 +26,9 @@ drawSelectionList ldps cfig sl = <> drawSelectionCursor ldps cfig sl makeSelectionListPictures :: SelectionList a -> [Picture] -makeSelectionListPictures sl = regex ++ concatMap f theitems +makeSelectionListPictures sl = concatMap f $ getShownItems sl where - theitems = case sl ^. slRegex of - "" -> _slItems sl - str -> filter (doregex str) (_slItems sl) - doregex str = regexList str . _siPictures - regex = case sl ^. slRegex of - "" | not (sl ^. slRegexInput) -> [] - str -> [text $ "SEARCH: " ++ str] f si = map (color (_siColor si) . text) $ _siPictures si - --case sl ^. slSizeRestriction of --- SelectionSizeRestriction {} -> concatMap (_siPictures . fst) $ _slShownItems sl --- _ -> concatMap _siPictures $ _slItems sl - drawCursorAt :: ListDisplayParams -> Configuration -> Maybe Int -> [SelectionItem a] -> Picture drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do @@ -57,16 +46,13 @@ drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do _ -> 1 drawSelectionCursor :: ListDisplayParams -> Configuration -> SelectionList a -> Picture -drawSelectionCursor ldps cfig sl = drawCursorAt ldps cfig (f $ sl ^. slSelPos) (g $ sl ^. slItems) +drawSelectionCursor ldps cfig sl = drawCursorAt ldps cfig (f $ sl ^. slSelPos) (getShownItems sl) where -- the following is quite hacky f = case sl ^. slRegex of + _ | sl ^. slRegexInput -> const (Just 0) "" | not (sl ^. slRegexInput) -> id _ -> fmap (+1) - g (x:xs) = case sl ^. slRegex of - "" | not (sl ^. slRegexInput) -> (x:xs) - _ -> ((x & siHeight .~ 1) : x : xs) - g _ = [] -- given a list of pictures that are each the size of a "text" call, displays them as -- a list on the screen diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index 93f8c5977..56a7ed8f6 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -6,7 +6,6 @@ module Dodge.Render.MenuScreen ( import Dodge.Base.WinScale import Dodge.Data.SelectionList import Dodge.Render.List -import qualified Data.Text as T import Dodge.Base.Window import Dodge.Data.Universe import Picture @@ -15,7 +14,7 @@ drawMenuScreen :: Configuration -> ScreenLayer -> Picture drawMenuScreen cfig screen = case screen of OptionScreen{_scTitle = titf, _scSelectionList = selpos, _scListDisplayParams = ldps} -> drawOptions ldps cfig titf selpos - InputScreen inputstr help -> drawInputMenu cfig ('>' : T.unpack inputstr) help + InputScreen inputstr help -> drawInputMenu cfig ('>' : inputstr) help drawInputMenu :: Configuration -> diff --git a/src/Dodge/SelectionList.hs b/src/Dodge/SelectionList.hs index bc4f56a88..8c9edc359 100644 --- a/src/Dodge/SelectionList.hs +++ b/src/Dodge/SelectionList.hs @@ -2,6 +2,7 @@ module Dodge.SelectionList where --import Color --import Dodge.WindowLayout +import Color import Regex import Dodge.Data.Universe import LensHelp @@ -26,7 +27,14 @@ defaultSelectionList = SelectionList getShownItems :: SelectionList a -> [SelectionItem a] getShownItems sl = case sl ^. slRegex of - "" -> _slItems sl - str -> SelectionFilter ["FILTER: "++str] : filter (doregex str) (_slItems sl) + "" | not (sl ^. slRegexInput) -> _slItems sl + str -> SelectionFilter + { _siPictures = ["FILTER: "++str] + , _siHeight = 1 + , _siIsSelectable = False + , _siWidth = length $ "FILTER: "++str + , _siColor = white + , _siOffX = 0 + }: filter (doregex str) (_slItems sl) where doregex str = regexList str . _siPictures diff --git a/src/Dodge/Terminal/LeftButton.hs b/src/Dodge/Terminal/LeftButton.hs index 9d73d4bb8..75f0725b7 100644 --- a/src/Dodge/Terminal/LeftButton.hs +++ b/src/Dodge/Terminal/LeftButton.hs @@ -1,7 +1,6 @@ module Dodge.Terminal.LeftButton where import Data.Maybe -import qualified Data.Text as T import Dodge.Data.World import Dodge.Terminal--oops import LensHelp @@ -9,7 +8,7 @@ import LensHelp doTerminalEffectLB :: Terminal -> World -> World doTerminalEffectLB tm w = guardDisconnected tm w $ fromMaybe w $ do - s <- fmap T.unpack $ w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText + s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText if null (words s) then Just $ defocusTerminalInput w else return $ terminalReturnEffect tm w @@ -17,7 +16,7 @@ doTerminalEffectLB tm w = guardDisconnected tm w $ terminalReturnEffect :: Terminal -> World -> World terminalReturnEffect tm w = guardDisconnected tm w $ fromMaybe w $ do - s <- fmap T.unpack $ w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText + s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText return $ runTerminalString s tm $ w @@ -31,7 +30,7 @@ defocusTerminalInput w = fromMaybe w $ do runTerminalString :: String -> Terminal -> World -> World runTerminalString s tm w = w & cWorld . lWorld . terminals . ix (_tmID tm) - %~ ( (tmInput .~ TerminalInput T.empty True (0, 0)) + %~ ( (tmInput .~ TerminalInput mempty True (0, 0)) . (tmFutureLines ++.~ commandFutureLines s tm w) . (tmCommandHistory %~ take 10 . (s :)) ) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index f74b1e95f..3cbf60862 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -12,7 +12,6 @@ import Control.Applicative import Data.List import qualified Data.Map.Strict as M import Data.Maybe -import qualified Data.Text as T import Dodge.Base import Dodge.Beam import Dodge.Bullet @@ -89,7 +88,7 @@ maybeOpenTerminal u = case u ^. uvWorld . input . pressedKeys . at ScancodeSemic gotoTerminal :: Universe -> Universe gotoTerminal w = case _uvScreenLayers w of (InputScreen{} : _) -> w - _ -> w & uvScreenLayers .:~ InputScreen T.empty "Enter command" + _ -> w & uvScreenLayers .:~ InputScreen mempty "Enter command" mouseClickOptionsList :: ScreenLayer -> Universe -> Universe mouseClickOptionsList screen u = fromMaybe u $ do diff --git a/src/Dodge/Update/Input.hs b/src/Dodge/Update/Input.hs index 87cf14cfc..219eb976a 100644 --- a/src/Dodge/Update/Input.hs +++ b/src/Dodge/Update/Input.hs @@ -6,7 +6,7 @@ module Dodge.Update.Input ( ) where import qualified Data.Map.Strict as M -import qualified Data.Text as T +import Data.Char import Dodge.Base.You import Dodge.Button.Event import Dodge.Combine @@ -23,8 +23,8 @@ import Dodge.WorldPos import LensHelp import SDL -doTextInputOver :: ASetter' Universe T.Text -> Universe -> Universe -doTextInputOver p u = u & p %~ (`T.append` T.toUpper thetext) +doTextInputOver :: ASetter' Universe String -> Universe -> Universe +doTextInputOver p u = u & p %~ (++ map toUpper thetext) & checkBackspace where thetext = u ^. uvWorld . input . textInput @@ -32,10 +32,9 @@ doTextInputOver p u = u & p %~ (`T.append` T.toUpper thetext) | backspaceInputted u = p %~ doBackspace | otherwise = id -doBackspace :: T.Text -> T.Text -doBackspace t = case T.unsnoc t of - Nothing -> t - Just (t', _) -> t' +doBackspace :: String -> String +doBackspace [] = [] +doBackspace s = init s backspaceInputted :: Universe -> Bool backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBackspace of @@ -44,17 +43,14 @@ backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBacks _ -> False doSubInvRegexInput :: Universe -> Universe -doSubInvRegexInput u = u - & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvRegex) - & checkEndStatus +doSubInvRegexInput u + | any ( (== Just InitialPress) . (`M.lookup` pkeys)) [ScancodeReturn,ScancodeEscape,ScancodeSlash] + = u & uvWorld . hud . hudElement . subInventory . subInvRegexInput .~ False + | otherwise = u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvRegex) where pkeys = u ^. uvWorld . input . pressedKeys - checkEndStatus - | any ( (== Just InitialPress) . (`M.lookup` pkeys)) [ScancodeReturn,ScancodeEscape,ScancodeSlash] - = uvWorld . hud . hudElement . subInventory . subInvRegexInput .~ False - | otherwise = id -doInputScreenInput :: T.Text -> Universe -> Universe +doInputScreenInput :: String -> Universe -> Universe doInputScreenInput s u = u & doTextInputOver (uvScreenLayers . _head . scInput) & checkEndStatus @@ -62,7 +58,7 @@ doInputScreenInput s u = pkeys = u ^. uvWorld . input . pressedKeys checkEndStatus | ScancodeReturn `M.member` pkeys = (uvScreenLayers %~ tail) - . applyTerminalString (words $ T.unpack s) + . applyTerminalString (words s) | ScancodeEscape `M.member` pkeys = uvScreenLayers %~ tail | otherwise = id diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index 032f35ad5..f3e44537a 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -4,7 +4,6 @@ module Dodge.Update.Scroll ( import qualified Data.Map.Strict as M import Data.Maybe -import qualified Data.Text as T import Dodge.Base import Dodge.Combine import Dodge.Data.Universe @@ -87,7 +86,7 @@ terminalWheelEvent yi tmid w setInput i j w' tm = tm & tmInput . tiSel .~ (i, j) - & tmInput . tiText .~ T.pack (_tcString tc ++ " " ++ arg) + & tmInput . tiText .~ (_tcString tc ++ " " ++ arg) where tc = scrollCommands tm !! i arg = getArguments' tc tm w' !! j