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

Cleanup

Browse Source
This commit is contained in:
justin
2024-10-25 21:05:32 +01:00
parent 6424899afd
commit f6c136cfd6
25 changed files with 334 additions and 333 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render/HUD.hs
+32 -13
View File
@@ -59,7 +59,7 @@ drawHP cfig =
drawInventory :: SelectionSections () -> 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
<> iextra
<> translateScreenPos
cfig
@@ -82,9 +82,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 (0, i) 10 idp curs sss
return . color (withAlpha 0.5 white) $ selSecDrawCursorAt 10 idp curs sss (0, i)
where
curs = CursorDisplay [North,South]
curs = BoundaryCursor [North, South]
getMouseInvSel :: World -> Maybe ((Int, Int), (Int, Int))
getMouseInvSel w = case w ^? hud . hudElement . subInventory . nsSelected of
@@ -130,7 +130,7 @@ drawCombineInventory cfig sss w =
<> drawSSCursor sss msel secondColumnParams curs cfig
<> combineInventoryExtra sss msel cfig w
where
curs = CursorDisplay [North,South,West]
curs = BoundaryCursor [North, South, West]
msel = w ^? hud . hudElement . subInventory . ciSelection . _Just
drawExamineInventory :: Configuration -> World -> Picture
@@ -185,7 +185,9 @@ drawRBOptions :: Configuration -> World -> Picture
drawRBOptions cfig w = fromMaybe mempty $ do
guard $ ButtonRight `M.member` _mouseButtons (_input w)
invid <- you w ^? crManipulation . manObject . imSelectedItem
eslist <- fmap equipSiteToPositions $ you w ^? crInv . ix invid . itUse . uequipEffect . eeSite
eslist <-
fmap equipSiteToPositions $
you w ^? crInv . ix invid . itUse . uequipEffect . eeSite
i <- w ^? rbOptions . opSel
let ae = getEquipmentAllocation w
sss <- w ^? hud . hudElement . diSections
@@ -202,23 +204,36 @@ drawRBOptions cfig w = fromMaybe mempty $ do
return $
toTopLeft cfig $
translate 290 (-1) (ytext midstr)
<> translate 160 (-1) (listCursorChooseBorderScale 0 1 [North, South] curpos 0 white 21 1)
<> translate
160
(-1)
( listCursorChooseBorderScale
0
1
(BoundaryCursor [North, South])
curpos
0
white
21
1
)
<> translate
380
(-1)
( drawListYoff (curpos - i) (map (text . eqPosText) eslist)
<> listCursorChooseBorderScale 0 1 [East] (curpos - i) 0 white 7 (length eslist)
<> listCursorChooseBorderScale 0 1 [West] (curpos + 1) 0 white 7 (length eslist - (i + 1))
<> listCursorChooseBorderScale 0 1 [West] (curpos - i) 0 white 7 i
<> listCursorChooseBorderScale 0 1 (bc East) (curpos - i) 0 white 7 (length eslist)
<> listCursorChooseBorderScale 0 1 (bc West) (curpos + 1) 0 white 7 (length eslist - (i + 1))
<> listCursorChooseBorderScale 0 1 (bc West) (curpos - i) 0 white 7 i
<> maybetopborder i curpos
<> maybebottomborder i (length eslist) curpos
)
<> translate 460 (-1) (ytext extrastr)
where
maybetopborder 0 curpos = listCursorChooseBorderScale 0 1 [North] curpos 0 white 7 1
bc x = BoundaryCursor [x]
maybetopborder 0 curpos = listCursorChooseBorderScale 0 1 (bc North) curpos 0 white 7 1
maybetopborder _ _ = mempty
maybebottomborder a b curpos
| a == b - 1 = listCursorChooseBorderScale 0 1 [South] curpos 0 white 7 1
| a == b - 1 = listCursorChooseBorderScale 0 1 (bc South) curpos 0 white 7 1
| otherwise = mempty
otheritem j = fromMaybe "" $ do
itm <- you w ^? crInv . ix j
@@ -282,8 +297,12 @@ combineInventoryExtra sss msel cfig w = fromMaybe mempty $ do
let idp = invDisplayParams w
return $
translateScreenPos cfig (idp ^. ldpPos) $
selSecDrawCursor 17 idp (CursorDisplay [North, South, East, West])
sss' (Just (0, i))
selSecDrawCursor
17
idp
(BoundaryCursor [North, South, East, West])
sss'
(Just (0, i))
displayTerminal :: Int -> Configuration -> LWorld -> Picture
displayTerminal tid cfig w = fromMaybe mempty $ do
src/Dodge/Render/InfoBox.hs
+27 -7
View File
@@ -1,22 +1,42 @@
module Dodge.Render.InfoBox
( renderInfoListAt
, renderInfoListsAt
) where
module Dodge.Render.InfoBox (
renderInfoListAt,
renderInfoListsAt,
) where
import Dodge.Data.CardinalPoint -- this should be imported implicitly
-- this should be imported implicitly
import Dodge.Base
import Dodge.Data.Camera
import Dodge.Data.CardinalPoint
import Dodge.Data.Config
import Dodge.Data.SelectionList
import Dodge.Render.Connectors
import Dodge.Render.List
import Geometry
import Picture
renderInfoListAt :: Float -> Float -> Configuration -> Camera -> (Point2, [String]) -> Picture
renderInfoListAt ::
Float ->
Float ->
Configuration ->
Camera ->
(Point2, [String]) ->
Picture
renderInfoListAt x y cfig cam (p, ss) =
toTopLeft cfig (renderListAt x y (zip ss (repeat white)))
<> color white (lConnect (V2 (x - hw) (hh -25 - y)) (worldPosToScreen cam p))
<> toTopLeft cfig (translate x (-y) $ listCursorChooseBorderScale 0 1 [North,South] 0 0 white 19 (length ss))
<> toTopLeft
cfig
( translate x (- y) $
listCursorChooseBorderScale
0
1
(BoundaryCursor [North, South])
0
0
white
19
(length ss)
)
where
hw = halfWidth cfig
hh = halfHeight cfig
src/Dodge/Render/List.hs
+47 -53
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Render.List (
renderListAt,
drawList,
@@ -13,14 +14,13 @@ module Dodge.Render.List (
selSecDrawCursorAt,
) where
import Dodge.SelectionSections
import Data.Maybe
import Dodge.Base.Window
import Dodge.Data.CardinalPoint
import Dodge.Data.Config
import Dodge.Data.SelectionList
import Dodge.ScreenPos
import Dodge.SelectionList
import Dodge.SelectionSections
import Geometry
import LensHelp
import ListHelp
@@ -28,38 +28,29 @@ import Picture
drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Picture
drawSelectionList ldps cfig sl =
translateScreenPos
cfig
(ldps ^. ldpPos)
$ drawListYgapScaleYoff
(_ldpVerticalGap ldps)
(_ldpScale ldps)
translateScreenPos cfig (ldps ^. ldpPos) $
drawListYgapScaleYoff
(ldps ^. ldpVerticalGap)
(ldps ^. ldpScale)
0
(makeSelectionListPictures sl)
<> drawSelectionCursor sl ldps (CursorDisplay [North,West,South])
drawSelectionCursor :: SelectionList a
-> ListDisplayParams
-> CursorDisplay
-> Picture
drawSelectionCursor sl = drawCursorAt (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)
<> drawCursorAt
(sl ^. slSelPos)
(sl ^. slItems)
ldps
(BoundaryCursor [North, South])
makeSelectionListPictures :: SelectionList a -> [Picture]
makeSelectionListPictures = concatMap f . getShownItems
makeSelectionListPictures = concatMap f . _slItems
where
f si = map (color (_siColor si) . text) $ _siPictures si
--f si = map ((flip inverseText) ((_siColor si))) $ _siPictures si
drawCursorAt :: Maybe Int -> [SelectionItem a]
-> ListDisplayParams
-> CursorDisplay
-> Picture
drawCursorAt ::
Maybe Int ->
[SelectionItem a] ->
ListDisplayParams ->
CursorDisplay ->
Picture
drawCursorAt mi lis ldps curs = fromMaybe mempty $ do
i <- mi
selit <- lis !? i
@@ -67,7 +58,7 @@ drawCursorAt mi lis ldps curs = fromMaybe mempty $ do
listCursorChooseBorderScale
(_ldpVerticalGap ldps)
(_ldpScale ldps)
(curs ^. cursSides)
curs
(sum . map _siHeight $ take i lis)
(_siOffX selit)
(_siColor selit)
@@ -76,8 +67,8 @@ drawCursorAt mi lis ldps curs = fromMaybe mempty $ do
getLDPWidth :: ListDisplayParams -> Int
getLDPWidth ldps = case _ldpWidth ldps of
FixedSelectionWidth x -> x
_ -> 1
FixedSelectionWidth x -> x
_ -> 1
drawListYoff :: Int -> [Picture] -> Picture
drawListYoff = drawListYgapScaleYoff 0 1
@@ -91,14 +82,14 @@ stackPicturesAt = stackPicturesAtOff 0
stackPicturesAtOff :: Int -> [Picture] -> Picture
stackPicturesAtOff i = mconcat . zipWith (drawListElement 10 1 0) [i, i -1 ..]
selSecDrawCursorAt
:: (Int,Int)
-> Int
-> ListDisplayParams
-> CursorDisplay
-> SelectionSections a
-> Picture
selSecDrawCursorAt (i,j) xsize ldp curs sss = fromMaybe mempty $ do
selSecDrawCursorAt ::
Int ->
ListDisplayParams ->
CursorDisplay ->
SelectionSections a ->
(Int, Int) ->
Picture
selSecDrawCursorAt xsize ldp curs sss (i, j) = fromMaybe mempty $ do
yint <- selSecYint i j sss
xint <- sss ^? sssSections . ix i . ssIndent
si <- sss ^? sssSections . ix i . ssItems . ix j
@@ -106,45 +97,48 @@ selSecDrawCursorAt (i,j) xsize ldp curs sss = fromMaybe mempty $ do
listCursorChooseBorderScale
(ldp ^. ldpVerticalGap)
(ldp ^. ldpScale)
(curs ^. cursSides)
curs
yint
(xint + _siOffX si)
(_siColor si)
xsize
(_siHeight si)
selSecDrawCursor :: Int -> ListDisplayParams
-> CursorDisplay
-> SelectionSections a ->
Maybe (Int,Int) -> Picture
selSecDrawCursor xsize ldp curs sss msel = maybe mempty
(\x -> selSecDrawCursorAt x xsize ldp curs sss)
msel
selSecDrawCursor ::
Int ->
ListDisplayParams ->
CursorDisplay ->
SelectionSections a ->
Maybe (Int, Int) ->
Picture
selSecDrawCursor xsize ldp curs = maybe mempty . selSecDrawCursorAt xsize ldp curs
-- displays a cursor that should match up to list text pictures
listCursorChooseBorderScale ::
Float ->
Float ->
[CardinalPoint] ->
CursorDisplay ->
Int ->
Int ->
Color ->
Int ->
Int ->
Picture
listCursorChooseBorderScale ygap s borders yint xint col cursxsize cursysize =
listCursorChooseBorderScale ygap s curs yint xint col cursxsize cursysize =
translate
((10 * fromIntegral xint - 5) * s)
(- (ygap + (s * 20 + ygap) * fromIntegral yint ))
(- (ygap + (s * 20 + ygap) * fromIntegral yint))
. color col
$ chooseCursorBorders (s * wth) (s * hgt) borders
$ chooseCursorBorders (s * wth) (s * hgt) curs
where
wth = 10 * (fromIntegral cursxsize + 1)
hgt = 20 * fromIntegral cursysize + ygap * (fromIntegral cursysize - 1)
-- note we cannot simply scale lines because they are drawn as solid rectangles
chooseCursorBorders :: Float -> Float -> [CardinalPoint] -> Picture
chooseCursorBorders w h = foldMap (line . toLine)
chooseCursorBorders :: Float -> Float -> CursorDisplay -> Picture
chooseCursorBorders w h = \case
BoundaryCursor ps -> foldMap (line . toLine) ps
BackdropCursor -> polygon . reverse $ rectNSWE 0 h' 0 w
where
h' = negate h
toLine North = [V2 0 0, V2 w 0]
@@ -181,7 +175,7 @@ renderListAt :: Float -> Float -> [(String, Color)] -> Picture
renderListAt tx ty = translate tx (- ty) . drawList . map (\(str, col) -> color col $ text str)
--inverseText :: String -> Color -> Picture
--inverseText str col =
--inverseText str col =
-- translate3 (V3 0 0 (0.5))
-- (color (V4 0 1 0 0.1) ( text str))
-- <>