Remove SelectionIntMap
This commit is contained in:
@@ -52,14 +52,6 @@ data SelectionSection a = SelectionSection
|
|||||||
, _ssDescriptor :: String
|
, _ssDescriptor :: String
|
||||||
}
|
}
|
||||||
|
|
||||||
data SelectionIntMap a = SelectionIntMap
|
|
||||||
{ _smItems :: [SelectionItem a]
|
|
||||||
, _smSelPos :: Maybe Int
|
|
||||||
, _smRegex :: Maybe String
|
|
||||||
, _smShownItems :: IntMap (SelectionItem a)
|
|
||||||
}
|
|
||||||
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
|
||||||
|
|
||||||
data SelectionWidth = FixedSelectionWidth Int
|
data SelectionWidth = FixedSelectionWidth Int
|
||||||
| VariableSelectionWidth (Int -> Int)
|
| VariableSelectionWidth (Int -> Int)
|
||||||
| UseMaxSelectionItemWidth
|
| UseMaxSelectionItemWidth
|
||||||
@@ -94,7 +86,6 @@ data SelectionItem a = SelectionItem
|
|||||||
makeLenses ''ListDisplayParams
|
makeLenses ''ListDisplayParams
|
||||||
makeLenses ''SelectionList
|
makeLenses ''SelectionList
|
||||||
makeLenses ''SelectionItem
|
makeLenses ''SelectionItem
|
||||||
makeLenses ''SelectionIntMap
|
|
||||||
makeLenses ''SelectionSection
|
makeLenses ''SelectionSection
|
||||||
makeLenses ''SelectionSections
|
makeLenses ''SelectionSections
|
||||||
makeLenses ''SectionCursor
|
makeLenses ''SectionCursor
|
||||||
|
|||||||
@@ -6,7 +6,6 @@ module Dodge.Render.HUD (
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Dodge.Inventory
|
import Dodge.Inventory
|
||||||
import SelectionIntMap
|
|
||||||
import Dodge.Data.Combine
|
import Dodge.Data.Combine
|
||||||
import Dodge.Default.SelectionList
|
import Dodge.Default.SelectionList
|
||||||
import Dodge.Creature.Info
|
import Dodge.Creature.Info
|
||||||
|
|||||||
@@ -2,7 +2,6 @@ module Dodge.Render.List where
|
|||||||
|
|
||||||
--import Picture.Text
|
--import Picture.Text
|
||||||
import Dodge.Inventory
|
import Dodge.Inventory
|
||||||
import SelectionIntMap
|
|
||||||
import qualified Data.IntMap.Strict as IM
|
import qualified Data.IntMap.Strict as IM
|
||||||
--import Data.Foldable
|
--import Data.Foldable
|
||||||
import Dodge.SelectionList
|
import Dodge.SelectionList
|
||||||
@@ -29,29 +28,12 @@ drawSelectionList ldps cfig sl =
|
|||||||
(makeSelectionListPictures sl)
|
(makeSelectionListPictures sl)
|
||||||
<> drawSelectionCursor ldps cfig sl
|
<> drawSelectionCursor ldps cfig sl
|
||||||
|
|
||||||
drawSelectionMap :: ListDisplayParams -> Configuration -> SelectionIntMap a -> Picture
|
|
||||||
drawSelectionMap ldps cfig sl =
|
|
||||||
listPicturesAtScaleOff
|
|
||||||
(_ldpVerticalGap ldps)
|
|
||||||
(_ldpScale ldps)
|
|
||||||
(_ldpPosX ldps)
|
|
||||||
(_ldpPosY ldps)
|
|
||||||
cfig
|
|
||||||
0 --(_slOffset sl)
|
|
||||||
(makeSelectionMapPictures sl)
|
|
||||||
<> drawSelectionMapCursor ldps cfig sl
|
|
||||||
|
|
||||||
makeSelectionListPictures :: SelectionList a -> [Picture]
|
makeSelectionListPictures :: SelectionList a -> [Picture]
|
||||||
makeSelectionListPictures sl = concatMap f $ getShownItems sl
|
makeSelectionListPictures sl = concatMap f $ getShownItems sl
|
||||||
where
|
where
|
||||||
f si = map (color (_siColor si) . text) $ _siPictures si
|
f si = map (color (_siColor si) . text) $ _siPictures si
|
||||||
--f si = map (textGrad (_siColor si) (withAlpha 0 (_siColor si))) $ _siPictures si
|
--f si = map (textGrad (_siColor si) (withAlpha 0 (_siColor si))) $ _siPictures si
|
||||||
|
|
||||||
makeSelectionMapPictures :: SelectionIntMap a -> [Picture]
|
|
||||||
makeSelectionMapPictures sl = foldMap f $ _smShownItems sl
|
|
||||||
where
|
|
||||||
f si = map (color (_siColor si) . text) $ _siPictures si
|
|
||||||
|
|
||||||
drawCursorAt :: ListDisplayParams -> Configuration -> Maybe Int -> [SelectionItem a] -> Picture
|
drawCursorAt :: ListDisplayParams -> Configuration -> Maybe Int -> [SelectionItem a] -> Picture
|
||||||
drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do
|
drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do
|
||||||
i <- mi
|
i <- mi
|
||||||
@@ -67,23 +49,6 @@ drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do
|
|||||||
FixedSelectionWidth x -> x
|
FixedSelectionWidth x -> x
|
||||||
_ -> 1
|
_ -> 1
|
||||||
|
|
||||||
drawCursorAt' :: ListDisplayParams -> Configuration -> Int -> IM.IntMap (SelectionItem a) -> Picture
|
|
||||||
drawCursorAt' ldps cfig i lis = fromMaybe mempty $ do
|
|
||||||
selit <- lis IM.!? i
|
|
||||||
f <- case _ldpCursorType ldps of
|
|
||||||
BorderCursor cps -> Just $ listCursorChooseBorderScale (_ldpVerticalGap ldps) (_ldpScale ldps) cps
|
|
||||||
NoCursor -> Nothing
|
|
||||||
let j = getIthPos i lis
|
|
||||||
col = _siColor selit
|
|
||||||
return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) cfig j 0 col wdth (_siHeight selit)
|
|
||||||
where
|
|
||||||
wdth = case _ldpWidth ldps of
|
|
||||||
FixedSelectionWidth x -> x
|
|
||||||
_ -> 1
|
|
||||||
|
|
||||||
drawSelectionMapCursor :: ListDisplayParams -> Configuration -> SelectionIntMap a -> Picture
|
|
||||||
drawSelectionMapCursor ldps cfig sl = drawCursorAt ldps cfig (sl ^. smSelPos) (IM.elems $ _smShownItems sl)
|
|
||||||
|
|
||||||
drawSelectionCursor :: ListDisplayParams -> Configuration -> SelectionList a -> Picture
|
drawSelectionCursor :: ListDisplayParams -> Configuration -> SelectionList a -> Picture
|
||||||
drawSelectionCursor ldps cfig sl = drawCursorAt ldps cfig (f $ sl ^. slSelPos) (getShownItems sl)
|
drawSelectionCursor ldps cfig sl = drawCursorAt ldps cfig (f $ sl ^. slSelPos) (getShownItems sl)
|
||||||
where
|
where
|
||||||
|
|||||||
@@ -119,3 +119,6 @@ ssLookupGE' i sss = do
|
|||||||
case IM.lookupMin (ss ^. ssItems) of
|
case IM.lookupMin (ss ^. ssItems) of
|
||||||
Just (j', si) -> return (i', j', si)
|
Just (j', si) -> return (i', j', si)
|
||||||
Nothing -> ssLookupGT' i' sss
|
Nothing -> ssLookupGT' i' sss
|
||||||
|
|
||||||
|
getIthPos :: Int -> IM.IntMap (SelectionItem a) -> Int
|
||||||
|
getIthPos i sm = sum . fmap _siHeight . fst $ IM.split i sm
|
||||||
|
|||||||
@@ -151,12 +151,6 @@ updateUseInput u = case u ^? uvScreenLayers . _head of
|
|||||||
_ | inCloseRegex (u ^. uvWorld) -> doRegexInput 2 closeRegex closeRegex u
|
_ | inCloseRegex (u ^. uvWorld) -> doRegexInput 2 closeRegex closeRegex u
|
||||||
_ -> M.foldlWithKey' updateKeyInGame u pkeys
|
_ -> M.foldlWithKey' updateKeyInGame u pkeys
|
||||||
where
|
where
|
||||||
inregex sm = fromMaybe False $ do
|
|
||||||
i <- sm ^? smSelPos . _Just
|
|
||||||
si <- sm ^? smShownItems . ix i
|
|
||||||
case si of
|
|
||||||
SelectionRegex {} -> return True
|
|
||||||
_ -> return False
|
|
||||||
pkeys = u ^. uvWorld . input . pressedKeys
|
pkeys = u ^. uvWorld . input . pressedKeys
|
||||||
|
|
||||||
optionScreenUpdate ::
|
optionScreenUpdate ::
|
||||||
|
|||||||
@@ -3,7 +3,6 @@ module Dodge.Update.Scroll (
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Dodge.SelectionSections
|
import Dodge.SelectionSections
|
||||||
import SelectionIntMap
|
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Dodge.Base
|
import Dodge.Base
|
||||||
|
|||||||
@@ -6,19 +6,17 @@ module Dodge.Update.UsingInput (
|
|||||||
import Control.Lens
|
import Control.Lens
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
import Dodge.Base.You
|
import Dodge.Base.You
|
||||||
import Dodge.Combine
|
--import Dodge.Combine
|
||||||
import Dodge.Creature.Impulse.UseItem
|
import Dodge.Creature.Impulse.UseItem
|
||||||
import Dodge.Data.Combine
|
import Dodge.Data.Combine
|
||||||
import Dodge.Data.SelectionList
|
import Dodge.Data.SelectionList
|
||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
import Dodge.InputFocus
|
import Dodge.InputFocus
|
||||||
import Dodge.Inventory
|
--import Dodge.Inventory
|
||||||
import Dodge.Inventory.Add
|
--import Dodge.Inventory.Add
|
||||||
import Dodge.Terminal.LeftButton
|
import Dodge.Terminal.LeftButton
|
||||||
import Geometry
|
import Geometry
|
||||||
import ListHelp
|
|
||||||
import SDL
|
import SDL
|
||||||
import SelectionIntMap
|
|
||||||
|
|
||||||
updateUsingInput :: World -> World
|
updateUsingInput :: World -> World
|
||||||
updateUsingInput w = case w ^. hud . hudElement of
|
updateUsingInput w = case w ^. hud . hudElement of
|
||||||
|
|||||||
@@ -1,61 +0,0 @@
|
|||||||
module SelectionIntMap where
|
|
||||||
|
|
||||||
import Data.Foldable
|
|
||||||
import Data.Maybe
|
|
||||||
import Color
|
|
||||||
import Regex
|
|
||||||
import qualified Data.IntMap.Strict as IM
|
|
||||||
import Dodge.Data.SelectionList
|
|
||||||
import LensHelp
|
|
||||||
|
|
||||||
setShownIntMap :: SelectionIntMap a -> SelectionIntMap a
|
|
||||||
setShownIntMap sm = case sm ^. smRegex of
|
|
||||||
Nothing -> sm & smShownItems .~ IM.fromAscList (zip [0..] allitms)
|
|
||||||
Just str -> sm & smShownItems
|
|
||||||
.~ IM.fromAscList (zip [0..] (f str : filter (regexList str . _siPictures) allitms))
|
|
||||||
where
|
|
||||||
allitms = sm ^. smItems
|
|
||||||
f str = SelectionRegex
|
|
||||||
{ _siPictures = ["FILTER: " ++ str]
|
|
||||||
, _siHeight = 1
|
|
||||||
, _siIsSelectable = True
|
|
||||||
, _siColor = white
|
|
||||||
, _siOffX = 0
|
|
||||||
}
|
|
||||||
|
|
||||||
initialSelPos :: SelectionIntMap a -> SelectionIntMap a
|
|
||||||
initialSelPos sm = sm & smSelPos .~ mi
|
|
||||||
where
|
|
||||||
mi = case sm ^? smShownItems . ix 0 of
|
|
||||||
Nothing -> Nothing
|
|
||||||
Just SelectionRegex {} -> case sm ^? smShownItems . ix 1 of
|
|
||||||
Nothing -> Just 0
|
|
||||||
Just _ -> Just 1
|
|
||||||
_ -> Just 0
|
|
||||||
|
|
||||||
-- assumes that at least one item is selectable!
|
|
||||||
-- also assumes that the integer is 1 or -1
|
|
||||||
moveSelectionMapStep :: Int -> SelectionIntMap a -> SelectionIntMap a
|
|
||||||
moveSelectionMapStep x sm = fromMaybe sm $ do
|
|
||||||
i <- _smSelPos sm
|
|
||||||
(n,_) <- IM.lookupMax (sm ^. smShownItems)
|
|
||||||
let j = (i - x) `mod` (n + 1)
|
|
||||||
case sm ^? smShownItems . ix j . siIsSelectable of
|
|
||||||
Just True -> Just $ sm & smSelPos ?~ j
|
|
||||||
_ -> Just $ moveSelectionMapStep x (sm & smSelPos ?~ j)
|
|
||||||
|
|
||||||
moveSelectionMapSelection :: Int -> SelectionIntMap a -> SelectionIntMap a
|
|
||||||
moveSelectionMapSelection i sm
|
|
||||||
| any _siIsSelectable (sm ^. smShownItems) = foldl'
|
|
||||||
(&)
|
|
||||||
sm
|
|
||||||
(replicate (abs i) (moveSelectionMapStep (signum i)))
|
|
||||||
| otherwise = sm & smSelPos .~ Nothing
|
|
||||||
|
|
||||||
getIthPos :: Int -> IM.IntMap (SelectionItem a) -> Int
|
|
||||||
getIthPos i sm = sum . fmap _siHeight . fst $ IM.split i sm
|
|
||||||
|
|
||||||
getIthYOffset :: Float -> Float -> SelectionIntMap a -> Int -> Float
|
|
||||||
getIthYOffset ygap scale sm i = (scale * 10 + ygap) * (fromIntegral yint + 1)
|
|
||||||
where
|
|
||||||
yint = getIthPos i (sm ^. smShownItems)
|
|
||||||
Reference in New Issue
Block a user