This commit is contained in:
2023-05-03 20:02:56 +01:00
parent 748e24137f
commit ff512348e0
10 changed files with 81 additions and 111 deletions
+4 -1
View File
@@ -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
-57
View File
@@ -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
+1 -1
View File
@@ -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
-6
View File
@@ -1,6 +0,0 @@
module Dodge.Inventory.Color where
import Color
invDimColor :: Color
invDimColor = greyN 0.7
-12
View File
@@ -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)
+17 -16
View File
@@ -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,19 +28,21 @@ 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
Left flit -> let it = _flIt flit in ( itemDisplay it, _itInvColor it) Left flit -> let it = _flIt flit in (itemDisplay it, _itInvColor it)
Right bt -> ([_btText bt], yellow) Right bt -> ([_btText bt], yellow)
+1 -1
View File
@@ -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
+33
View File
@@ -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
+1 -1
View File
@@ -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
View File
@@ -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