Mostly use String instead of Text
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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}
|
||||
|
||||
@@ -36,7 +36,7 @@ data Input = Input
|
||||
, _lSelect :: Point2
|
||||
, _rSelect :: Point2
|
||||
, _clickMousePos :: Point2
|
||||
, _textInput :: T.Text
|
||||
, _textInput :: String
|
||||
, _scrollTestValue :: Float
|
||||
}
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -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)
|
||||
}
|
||||
|
||||
@@ -66,7 +66,7 @@ data ScreenLayer
|
||||
, _scListDisplayParams :: ListDisplayParams
|
||||
}
|
||||
| InputScreen
|
||||
{ _scInput :: T.Text
|
||||
{ _scInput :: String
|
||||
, _scFooter :: String
|
||||
}
|
||||
-- | WaitScreen
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
}
|
||||
|
||||
+2
-1
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 ->
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 :))
|
||||
)
|
||||
|
||||
+1
-2
@@ -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
|
||||
|
||||
+12
-16
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user