justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Improve inventory display

Browse Source
This commit is contained in:
justin
2024-10-26 10:53:36 +01:00
parent ae0f2fad0f
commit e2f3d6a378
9 changed files with 280 additions and 249 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/GenWorld.hs
-1
View File
@@ -18,7 +18,6 @@ import Dodge.Data.RoomCluster
import Dodge.Data.World
import Geometry.Data
import qualified IntMapHelp as IM
import Picture.Data
import System.Random
data GenWorld = GenWorld
src/Dodge/Placement/PlaceSpot.hs
-1
View File
@@ -23,7 +23,6 @@ import Dodge.ShiftPoint
import Geometry
import qualified IntMapHelp as IM
import NewInt
import Picture
import System.Random
-- when placing a placement, we update the world and the room and assign an id
src/Dodge/Render/HUD.hs
+12 -11
View File
@@ -59,13 +59,15 @@ drawHP cfig =
drawInventory :: IM.IntMap (SelectionSection ()) -> World -> Configuration -> Picture
drawInventory sss w cfig =
drawSelectionSections sss ldp cfig
<> drawSSCursor sss (w ^? hud . hudElement . diSelection . _Just) ldp curs cfig
-- <> drawSSCursor sss (w ^? hud . hudElement . diSelection . _Just) ldp curs cfig
<> drawSSMultiCursor sss (w ^? hud . hudElement . diSelection . _Just)
(w ^? hud . hudElement . diSelectionExtra)
ldp curs cfig
<> iextra
<> translateScreenPos
cfig
(ldp ^. ldpPos)
(drawDIMouseOver w)
<> drawDISelections w cfig
(drawDIMouseOver w <> drawDISelections w)
<> drawDISelections' w cfig
where
ldp = invDisplayParams w
@@ -82,9 +84,9 @@ drawDIMouseOver w = fromMaybe mempty $ do
(_, i) <- w ^? hud . hudElement . subInventory . nsMouseOver . _Just
sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
return . color (withAlpha 0.5 white) $ selSecDrawCursorAt 10 idp curs sss (0, i)
return . color (withAlpha 0.2 white) $ selSecDrawCursorAt 15 idp curs sss (0, i)
where
curs = BoundaryCursor [North, South]
curs = BackdropCursor
getMouseInvSel :: World -> Maybe ((Int, Int), (Int, Int))
getMouseInvSel w = case w ^? hud . hudElement . subInventory . nsSelected of
@@ -97,14 +99,13 @@ getMouseInvSel' w = do
(i, j) <- w ^? hud . hudElement . diSelection . _Just
return ((i, j), (i, j + x))
drawDISelections :: World -> Configuration -> Picture
drawDISelections w cfig = fromMaybe mempty $ do
((i, j), (a, b)) <- getMouseInvSel w
drawDISelections :: World -> Picture
drawDISelections w = fromMaybe mempty $ do
((_, j), (_, b)) <- getMouseInvSel w
sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
tp <- selNumPosCardinal NorthWest8 cfig idp sss i j
bp <- selNumPosCardinal SouthWest8 cfig idp sss a b
return . color red . line $ sort [tp, bp]
let f x = selSecDrawCursorAt 15 idp BackdropCursor sss (0,x)
return . color (withAlpha 0.2 white) . foldMap f $ [min j b..max j b]
drawDISelections' :: World -> Configuration -> Picture
drawDISelections' w cfig = fromMaybe mempty $ do
src/Dodge/Render/Picture.hs
+16 -15
View File
@@ -2,8 +2,8 @@ module Dodge.Render.Picture (
fixedCoordPictures,
) where
import Control.Monad
import Control.Lens
import Control.Monad
import Data.Maybe
import Dodge.Base.Coordinate
import Dodge.Base.Window
@@ -20,24 +20,26 @@ fixedCoordPictures u =
drawMenuOrHUD cfig u
<> drawConcurrentMessage u
<> drawMouseCursor u
<> toTopLeft cfig (translate (halfWidth cfig) 0 $ drawList (map text (_uvTestString u u)))
<> toTopLeft
cfig
( translate (0.5 * halfWidth cfig) (- halfHeight cfig) $
drawList $
map text $
show (u ^. uvWorld . cWorld . lWorld . lTestInt) :
(u ^. uvWorld . cWorld . lWorld . lTestString)
<> ttl (translate hw 0 $ drawList (map text (_uvTestString u u)))
<> ttl
( translate (0.5 * hw) (- hh)
. drawList
. map text
$ show (u ^. uvWorld . cWorld . lWorld . lTestInt) :
(u ^. uvWorld . cWorld . lWorld . lTestString)
)
<> displayFrameTicks u
<> aimDelaySweep (u ^. uvWorld)
where
cfig = _uvConfig u
hw = halfWidth cfig
hh = halfHeight cfig
ttl = toTopLeft cfig
displayFrameTicks :: Universe -> Picture
displayFrameTicks u
| debugOn Show_ms_frame $ _uvConfig u =
translate (-10) (- halfHeight (_uvConfig u) + 6)
translate (-10) (- halfHeight (_uvConfig u) + 6)
. scale 0.2 0.2
$ fpsText (u ^. uvFrameTicks - u ^. uvLastFrameTicks)
| otherwise = mempty
@@ -59,9 +61,10 @@ drawMenuOrHUD cfig u = case u ^. uvScreenLayers of
drawConcurrentMessage :: Universe -> Picture
drawConcurrentMessage u =
translate 0 (50 - halfHeight cfig) $
stackPicturesAt
(map (centerText . f) $ u ^.. uvSideEffects . each)
translate 0 (50 - halfHeight cfig)
. stackPicturesAt
. map (centerText . f)
$ u ^.. uvSideEffects . each
where
cfig = _uvConfig u
f (RunningSideEffect ce) = ce ++ " IN PROGRESS"
@@ -103,7 +106,6 @@ drawSweep cr w = fromMaybe mempty $ do
| a - cdir < - pi = cdir - 2 * pi
| otherwise = cdir
return $
setLayer FixedCoordLayer $
uncurryV translate (worldPosToScreen campos p) $
arcFull (a - rot) 10 white (a' - rot) 1 white (5 + dist mwp p * campos ^. camZoom) white
where
@@ -113,4 +115,3 @@ drawSweep cr w = fromMaybe mempty $ do
campos = w ^. wCam
theinput = w ^. input
mwp = mouseWorldPos theinput campos
src/Dodge/Room/Room.hs
-1
View File
@@ -23,7 +23,6 @@ import Dodge.PlacementSpot
import Dodge.Room.Airlock
import Dodge.Room.Corridor
import Dodge.Room.Door
import Dodge.Room.Foreground
import Dodge.Room.Girder
import Dodge.Room.Link
import Dodge.Room.Modify.Girder
src/Dodge/SelectionSections/Draw.hs
+53 -18
View File
@@ -1,21 +1,24 @@
module Dodge.SelectionSections.Draw
( drawSelectionSections
, drawSSCursor
) where
module Dodge.SelectionSections.Draw (
drawSelectionSections,
drawSSCursor,
drawSSMultiCursor,
) where
import Control.Lens
import qualified Data.IntMap.Strict as IM
import Data.Maybe
import Dodge.Data.Config
import Dodge.Data.SelectionList
import Dodge.Render.List
import Dodge.ScreenPos
import Dodge.SelectionSections
import Picture.Base
import qualified Data.IntMap.Strict as IM
drawSelectionSections
:: IM.IntMap (SelectionSection a)
-> ListDisplayParams
-> Configuration
-> Picture
drawSelectionSections ::
IM.IntMap (SelectionSection a) ->
ListDisplayParams ->
Configuration ->
Picture
drawSelectionSections sss ldp cfig =
translateScreenPos cfig (ldp ^. ldpPos) $
drawListYgapScaleYoff
@@ -24,13 +27,45 @@ drawSelectionSections sss ldp cfig =
0
(foldMap _ssShownItems sss)
drawSSCursor
:: IM.IntMap (SelectionSection a)
-> Maybe (Int,Int)
-> ListDisplayParams
-> CursorDisplay
-> Configuration
-> Picture
drawSSCursor ::
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int) ->
ListDisplayParams ->
CursorDisplay ->
Configuration ->
Picture
drawSSCursor sss msel ldp curs cfig =
translateScreenPos cfig (ldp ^. ldpPos) $
selSecDrawCursor 15 ldp curs sss msel
selSecDrawCursor 15 ldp curs sss msel
drawSSMultiCursor ::
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int) ->
Maybe Int ->
ListDisplayParams ->
CursorDisplay ->
Configuration ->
Picture
drawSSMultiCursor sss msel mextra ldp curs cfig = translateScreenPos cfig (ldp ^. ldpPos)
. fromMaybe mempty
$ do
(i, j) <- msel
yint <- selSecYint i j sss
xint <- sss ^? ix i . ssIndent
ydown <- mextra
ssitms <- sss ^? ix i . ssItems
let selitms = fst . IM.split (j + ydown + 1) . snd . IM.split (j -1) $ ssitms
ysize = sum . fmap _siHeight $ selitms
maxoff = maximum . fmap _siOffX $ selitms
minoff = minimum . fmap _siOffX $ selitms
col <- fmap (_siColor . fst) $ IM.minView selitms
return $
listCursorChooseBorderScale
(ldp ^. ldpVerticalGap)
(ldp ^. ldpScale)
curs
yint
(xint + minoff)
col
(15 + maxoff - minoff)
ysize