Cleanup
This commit is contained in:
@@ -20,7 +20,6 @@ import Dodge.Data.Config
|
|||||||
import Dodge.Data.SelectionList
|
import Dodge.Data.SelectionList
|
||||||
import Dodge.Data.Universe
|
import Dodge.Data.Universe
|
||||||
import Dodge.Inventory.CheckSlots
|
import Dodge.Inventory.CheckSlots
|
||||||
import Dodge.Inventory.Color
|
|
||||||
import Dodge.Inventory.SelectionList
|
import Dodge.Inventory.SelectionList
|
||||||
import Dodge.SelectionList
|
import Dodge.SelectionList
|
||||||
import LensHelp
|
import LensHelp
|
||||||
@@ -130,6 +129,10 @@ updateDisplaySections w cfig sss =
|
|||||||
return $ IM.filter (plainRegex str) itms
|
return $ IM.filter (plainRegex str) itms
|
||||||
numfiltitems = " " ++ show (length itms - length itms') ++ " FILTERED"
|
numfiltitems = " " ++ show (length itms - length itms') ++ " FILTERED"
|
||||||
|
|
||||||
|
|
||||||
|
invDimColor :: Color
|
||||||
|
invDimColor = greyN 0.7
|
||||||
|
|
||||||
-- it is annoying that this is necessary
|
-- it is annoying that this is necessary
|
||||||
updateInventorySectionItems :: World -> World
|
updateInventorySectionItems :: World -> World
|
||||||
updateInventorySectionItems w = w
|
updateInventorySectionItems w = w
|
||||||
|
|||||||
@@ -1,39 +1,29 @@
|
|||||||
--{-# LANGUAGE TupleSections #-}
|
--{-# LANGUAGE TupleSections #-}
|
||||||
module Dodge.Inventory (
|
module Dodge.Inventory (
|
||||||
selSecSelPos,
|
|
||||||
checkInvSlotsYou,
|
checkInvSlotsYou,
|
||||||
rmSelectedInvItem,
|
rmSelectedInvItem,
|
||||||
selNumTextEndPos,
|
|
||||||
selSecSelCol,
|
|
||||||
selNumEndMidHeight,
|
|
||||||
rmInvItem,
|
rmInvItem,
|
||||||
updateCloseObjects,
|
updateCloseObjects,
|
||||||
updateRBList,
|
updateRBList,
|
||||||
checkTermDist,
|
|
||||||
closeObjScrollDir,
|
closeObjScrollDir,
|
||||||
changeSwapSel,
|
changeSwapSel,
|
||||||
scrollAugInvSel,
|
scrollAugInvSel,
|
||||||
crNumFreeSlots,
|
crNumFreeSlots,
|
||||||
crInvSize,
|
crInvSize,
|
||||||
selectedCloseObject,
|
selectedCloseObject,
|
||||||
invDimColor,
|
|
||||||
setInvPosFromSS,
|
setInvPosFromSS,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad
|
|
||||||
import Color
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
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
|
||||||
import Dodge.Data.Config
|
|
||||||
import Dodge.Data.SelectionList
|
import Dodge.Data.SelectionList
|
||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
import Dodge.DisplayInventory
|
import Dodge.DisplayInventory
|
||||||
import Dodge.Euse
|
import Dodge.Euse
|
||||||
import Dodge.Inventory.CheckSlots
|
import Dodge.Inventory.CheckSlots
|
||||||
import Dodge.Inventory.CloseObject
|
import Dodge.Inventory.CloseObject
|
||||||
import Dodge.Inventory.Color
|
|
||||||
import Dodge.ItEffect
|
import Dodge.ItEffect
|
||||||
import Dodge.Reloading
|
import Dodge.Reloading
|
||||||
import Dodge.SelectionSections
|
import Dodge.SelectionSections
|
||||||
@@ -110,52 +100,6 @@ rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crMan
|
|||||||
Just i -> rmInvItem cid i w
|
Just i -> rmInvItem cid i w
|
||||||
Nothing -> w
|
Nothing -> w
|
||||||
|
|
||||||
-- there are still more ListDisplayParams to integrate here
|
|
||||||
selNumTextEndPos :: Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Maybe Point2
|
|
||||||
selNumTextEndPos cfig ldp sss i j = do
|
|
||||||
ipos <- selSecSelPos i j sss
|
|
||||||
return $ V2 (150 - hw) (hh - ((s * 10 + ygap) * (fromIntegral ipos + 1)))
|
|
||||||
where
|
|
||||||
s = _ldpScale ldp
|
|
||||||
ygap = _ldpVerticalGap ldp
|
|
||||||
hh = halfHeight cfig
|
|
||||||
hw = halfWidth cfig
|
|
||||||
|
|
||||||
selNumEndMidHeight ::
|
|
||||||
Configuration ->
|
|
||||||
ListDisplayParams ->
|
|
||||||
SelectionSections a ->
|
|
||||||
Int ->
|
|
||||||
Int ->
|
|
||||||
Maybe Point2
|
|
||||||
selNumEndMidHeight cfig ldp sss i j = do
|
|
||||||
ipos <- selSecSelPos i j sss
|
|
||||||
size <- selSecSelSize i j sss
|
|
||||||
--let bump = negate $ (10 * s + ygap) * fromIntegral size
|
|
||||||
return $ V2 (150 - hw) (hh - ((10 * s + ygap) * (fromIntegral ipos + fromIntegral size * 0.5)))
|
|
||||||
where
|
|
||||||
s = _ldpScale ldp
|
|
||||||
ygap = _ldpVerticalGap ldp
|
|
||||||
hh = halfHeight cfig
|
|
||||||
hw = halfWidth cfig
|
|
||||||
|
|
||||||
selSecSelCol :: Int -> Int -> SelectionSections a -> Maybe Color
|
|
||||||
selSecSelCol i j sss = sss ^? sssSections . ix i . ssItems . ix j . siColor
|
|
||||||
|
|
||||||
checkTermDist :: World -> World
|
|
||||||
--checkTermDist w = case w ^? hud . hudElement . subInventory . termID of
|
|
||||||
-- Just tmid -> fromMaybe (w & hud . hudElement . subInventory .~ NoSubInventory) $ do
|
|
||||||
-- btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
|
|
||||||
-- btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
|
|
||||||
-- guard $ dist btpos (_crPos $ you w) < 40
|
|
||||||
-- return w
|
|
||||||
-- Nothing -> w
|
|
||||||
checkTermDist w = fromMaybe w $ do
|
|
||||||
tmid <- w ^? hud . hudElement . subInventory . termID
|
|
||||||
btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
|
|
||||||
btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
|
|
||||||
guard $ dist btpos (_crPos $ you w) > 40
|
|
||||||
return (w & hud . hudElement . subInventory .~ NoSubInventory)
|
|
||||||
|
|
||||||
-- this looks ugly...
|
-- this looks ugly...
|
||||||
updateCloseObjects :: World -> World
|
updateCloseObjects :: World -> World
|
||||||
@@ -209,7 +153,6 @@ updateRBList w
|
|||||||
mcurrentitemid = do
|
mcurrentitemid = do
|
||||||
i <- cr ^? crManipulation . manObject . inInventory . ispItem
|
i <- cr ^? crManipulation . manObject . inInventory . ispItem
|
||||||
cr ^? crInv . ix i . itID
|
cr ^? crInv . ix i . itID
|
||||||
--curinvid = crSel cr
|
|
||||||
cr = you w
|
cr = you w
|
||||||
|
|
||||||
chooseEquipmentPosition :: Creature -> [EquipPosition] -> Int
|
chooseEquipmentPosition :: Creature -> [EquipPosition] -> Int
|
||||||
|
|||||||
@@ -8,7 +8,7 @@ import Control.Lens
|
|||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Dodge.Base.You
|
import Dodge.Base.You
|
||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
import Dodge.Inventory.ItemSpace
|
import Dodge.Item.SlotsTaken
|
||||||
import qualified IntMapHelp as IM
|
import qualified IntMapHelp as IM
|
||||||
|
|
||||||
{- | checks whether or not an item will fit in your inventory
|
{- | checks whether or not an item will fit in your inventory
|
||||||
|
|||||||
@@ -1,6 +0,0 @@
|
|||||||
module Dodge.Inventory.Color where
|
|
||||||
import Color
|
|
||||||
|
|
||||||
invDimColor :: Color
|
|
||||||
invDimColor = greyN 0.7
|
|
||||||
|
|
||||||
@@ -1,12 +0,0 @@
|
|||||||
module Dodge.Inventory.ItemSpace (
|
|
||||||
itSlotsTaken,
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Control.Lens
|
|
||||||
import Dodge.Data.Item
|
|
||||||
import Dodge.Module
|
|
||||||
|
|
||||||
itSlotsTaken :: Item -> Int
|
|
||||||
itSlotsTaken it = case it ^? itUse . useAmount of
|
|
||||||
Nothing -> moduleSizes it + ceiling (_itInvSize it)
|
|
||||||
Just i -> moduleSizes it + ceiling (_itInvSize it * fromIntegral i)
|
|
||||||
@@ -1,22 +1,21 @@
|
|||||||
module Dodge.Inventory.SelectionList
|
module Dodge.Inventory.SelectionList (
|
||||||
( invSelectionItem
|
invSelectionItem,
|
||||||
, closeObjectToSelectionItem
|
closeObjectToSelectionItem,
|
||||||
)
|
) where
|
||||||
where
|
|
||||||
|
|
||||||
import Dodge.Item.Display
|
|
||||||
import Dodge.Inventory.ItemSpace
|
|
||||||
import Picture.Base
|
|
||||||
import Dodge.Data.SelectionList
|
import Dodge.Data.SelectionList
|
||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
|
import Dodge.Item.SlotsTaken
|
||||||
|
import Dodge.Item.Display
|
||||||
import LensHelp
|
import LensHelp
|
||||||
|
import Picture.Base
|
||||||
|
|
||||||
invSelectionItem :: Creature -> Int -> Item -> SelectionItem ()
|
invSelectionItem :: Creature -> Int -> Item -> SelectionItem ()
|
||||||
invSelectionItem cr i it = SelectionItem
|
invSelectionItem cr i it =
|
||||||
|
SelectionItem
|
||||||
{ _siPictures = pics
|
{ _siPictures = pics
|
||||||
, _siHeight = length pics
|
, _siHeight = length pics
|
||||||
, _siIsSelectable = True
|
, _siIsSelectable = True
|
||||||
--, _siWidth = 15
|
|
||||||
, _siColor = col
|
, _siColor = col
|
||||||
, _siOffX = 0
|
, _siOffX = 0
|
||||||
, _siPayload = ()
|
, _siPayload = ()
|
||||||
@@ -29,17 +28,19 @@ invSelectionItem cr i it = SelectionItem
|
|||||||
_ -> itemDisplay it
|
_ -> itemDisplay it
|
||||||
|
|
||||||
closeObjectToSelectionItem :: Either FloorItem Button -> SelectionItem ()
|
closeObjectToSelectionItem :: Either FloorItem Button -> SelectionItem ()
|
||||||
closeObjectToSelectionItem e = SelectionItem
|
closeObjectToSelectionItem e =
|
||||||
|
SelectionItem
|
||||||
{ _siPictures = pics
|
{ _siPictures = pics
|
||||||
, _siHeight = length pics
|
, _siHeight = length pics
|
||||||
, _siIsSelectable = True
|
, _siIsSelectable = True
|
||||||
--, _siWidth = 15
|
, --, _siWidth = 15
|
||||||
, _siColor = col
|
_siColor = col
|
||||||
, _siOffX = 2
|
, _siOffX = 2
|
||||||
, _siPayload = ()
|
, _siPayload = ()
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
(pics, col) = closeObjectToTextPictures e
|
(pics, col) = closeObjectToTextPictures e
|
||||||
|
|
||||||
--
|
--
|
||||||
closeObjectToTextPictures :: Either FloorItem Button -> ([String], Color)
|
closeObjectToTextPictures :: Either FloorItem Button -> ([String], Color)
|
||||||
closeObjectToTextPictures e = case e of
|
closeObjectToTextPictures e = case e of
|
||||||
|
|||||||
@@ -7,7 +7,7 @@ module Dodge.Item.Display (
|
|||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Sequence
|
import Data.Sequence
|
||||||
import Dodge.Data.Creature
|
import Dodge.Data.Creature
|
||||||
import Dodge.Inventory.ItemSpace
|
import Dodge.Item.SlotsTaken
|
||||||
import Dodge.Module
|
import Dodge.Module
|
||||||
import LensHelp
|
import LensHelp
|
||||||
import Padding
|
import Padding
|
||||||
|
|||||||
@@ -3,6 +3,7 @@ module Dodge.Render.HUD (
|
|||||||
drawHUD,
|
drawHUD,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Dodge.SelectionSections
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
@@ -432,3 +433,35 @@ displayHP cid cfig =
|
|||||||
. leftPad 5 ' '
|
. leftPad 5 ' '
|
||||||
. show
|
. show
|
||||||
. (^?! cWorld . lWorld . creatures . ix cid . crHP)
|
. (^?! cWorld . lWorld . creatures . ix cid . crHP)
|
||||||
|
|
||||||
|
-- there are still more ListDisplayParams to integrate here
|
||||||
|
selNumTextEndPos :: Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Maybe Point2
|
||||||
|
selNumTextEndPos cfig ldp sss i j = do
|
||||||
|
ipos <- selSecSelPos i j sss
|
||||||
|
return $ V2 (150 - hw) (hh - ((s * 10 + ygap) * (fromIntegral ipos + 1)))
|
||||||
|
where
|
||||||
|
s = _ldpScale ldp
|
||||||
|
ygap = _ldpVerticalGap ldp
|
||||||
|
hh = halfHeight cfig
|
||||||
|
hw = halfWidth cfig
|
||||||
|
|
||||||
|
selNumEndMidHeight ::
|
||||||
|
Configuration ->
|
||||||
|
ListDisplayParams ->
|
||||||
|
SelectionSections a ->
|
||||||
|
Int ->
|
||||||
|
Int ->
|
||||||
|
Maybe Point2
|
||||||
|
selNumEndMidHeight cfig ldp sss i j = do
|
||||||
|
ipos <- selSecSelPos i j sss
|
||||||
|
size <- selSecSelSize i j sss
|
||||||
|
--let bump = negate $ (10 * s + ygap) * fromIntegral size
|
||||||
|
return $ V2 (150 - hw) (hh - ((10 * s + ygap) * (fromIntegral ipos + fromIntegral size * 0.5)))
|
||||||
|
where
|
||||||
|
s = _ldpScale ldp
|
||||||
|
ygap = _ldpVerticalGap ldp
|
||||||
|
hh = halfHeight cfig
|
||||||
|
hw = halfWidth cfig
|
||||||
|
|
||||||
|
selSecSelCol :: Int -> Int -> SelectionSections a -> Maybe Color
|
||||||
|
selSecSelCol i j sss = sss ^? sssSections . ix i . ssItems . ix j . siColor
|
||||||
|
|||||||
@@ -4,12 +4,12 @@ module Dodge.Render.List where
|
|||||||
|
|
||||||
--import Data.Foldable
|
--import Data.Foldable
|
||||||
|
|
||||||
|
import Dodge.SelectionSections
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Dodge.Base.Window
|
import Dodge.Base.Window
|
||||||
import Dodge.Data.CardinalPoint
|
import Dodge.Data.CardinalPoint
|
||||||
import Dodge.Data.Config
|
import Dodge.Data.Config
|
||||||
import Dodge.Data.SelectionList
|
import Dodge.Data.SelectionList
|
||||||
import Dodge.Inventory
|
|
||||||
import Dodge.SelectionList
|
import Dodge.SelectionList
|
||||||
import Geometry
|
import Geometry
|
||||||
import LensHelp
|
import LensHelp
|
||||||
|
|||||||
+10
-2
@@ -6,8 +6,7 @@ Description : Simulation update
|
|||||||
-}
|
-}
|
||||||
module Dodge.Update (updateUniverse) where
|
module Dodge.Update (updateUniverse) where
|
||||||
|
|
||||||
--import Dodge.InputFocus
|
import Control.Monad
|
||||||
|
|
||||||
import Dodge.Update.Input.InGame
|
import Dodge.Update.Input.InGame
|
||||||
import Dodge.Update.Input.ScreenLayer
|
import Dodge.Update.Input.ScreenLayer
|
||||||
import Dodge.Debug
|
import Dodge.Debug
|
||||||
@@ -279,6 +278,15 @@ functionalUpdate w =
|
|||||||
-- . over uvWorld updateInventorySelectionList
|
-- . over uvWorld updateInventorySelectionList
|
||||||
$ over uvWorld updatePastWorlds w
|
$ over uvWorld updatePastWorlds w
|
||||||
|
|
||||||
|
checkTermDist :: World -> World
|
||||||
|
checkTermDist w = fromMaybe w $ do
|
||||||
|
tmid <- w ^? hud . hudElement . subInventory . termID
|
||||||
|
btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
|
||||||
|
btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
|
||||||
|
guard $ dist btpos (_crPos $ you w) > 40
|
||||||
|
return (w & hud . hudElement . subInventory .~ NoSubInventory)
|
||||||
|
|
||||||
|
|
||||||
updateWheelEvents :: World -> World
|
updateWheelEvents :: World -> World
|
||||||
updateWheelEvents w
|
updateWheelEvents w
|
||||||
| yi == 0 = w
|
| yi == 0 = w
|
||||||
|
|||||||
Reference in New Issue
Block a user