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
2025-08-26 18:51:14 +01:00
parent b87c3380b8
commit 1ebdbdd8ae
34 changed files with 210 additions and 246 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render/HUD.hs
+21 -21
View File
@@ -45,14 +45,14 @@ import NewInt
import Picture
import SDL (MouseButton (..))
drawHUD :: Configuration -> World -> Picture
drawHUD :: Config -> World -> Picture
drawHUD cfig w = case w ^. hud of
-- DisplayCarte -> drawCarte cfig w
HUD {_diSections = sections, _subInventory = subinv} ->
drawInventory sections w cfig
<> drawSubInventory subinv cfig w
drawInventory :: IM.IntMap (SelectionSection ()) -> World -> Configuration -> Picture
drawInventory :: IM.IntMap (SelectionSection ()) -> World -> Config -> Picture
drawInventory sss w cfig =
drawSelectionSections sss invDP cfig
<> drawSSCursor sss invDP curs cfig (f $ w ^? hud . diSelection . _Just)
@@ -74,7 +74,7 @@ drawRootCursor ::
IM.IntMap (SelectionSection ()) ->
Maybe (Int, Int) ->
ListDisplayParams ->
Configuration ->
Config ->
Picture
drawRootCursor w sss msel ldp cfig = fromMaybe mempty $ do
cr <- w ^? cWorld . lWorld . creatures . ix 0
@@ -102,7 +102,7 @@ getRootItemBounds i inv = do
y <- locDTLeftmost root ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
return (x, y)
drawMouseOver :: Configuration -> World -> Picture
drawMouseOver :: Config -> World -> Picture
drawMouseOver cfig w =
concat
(invsel <|> combinvsel <|> drawDragSelecting cfig w)
@@ -129,7 +129,7 @@ drawMouseOver cfig w =
. color (withAlpha 0.2 white)
$ selSecDrawCursorAt idp curs sss (j, i)
drawDragSelected :: Configuration -> World -> Maybe Picture
drawDragSelected :: Config -> World -> Maybe Picture
drawDragSelected cfig w = do
ys <- w ^? hud . diSelection . _Just . slSet
guard $
@@ -146,7 +146,7 @@ drawDragSelected cfig w = do
. IS.foldr f mempty
$ ys
drawDragSelecting :: Configuration -> World -> Maybe Picture
drawDragSelecting :: Config -> World -> Maybe Picture
drawDragSelecting cfig w = do
OverInvDragSelect (Just (i, j)) (Just b) <- w ^? input . mouseContext
sss <- w ^? hud . diSections
@@ -156,7 +156,7 @@ drawDragSelecting cfig w = do
. foldMap f
$ [min j b .. max j b]
drawSubInventory :: SubInventory -> Configuration -> World -> Picture
drawSubInventory :: SubInventory -> Config -> World -> Picture
drawSubInventory subinv cfig w = case subinv of
-- LockedInventory -> mempty -- topInvCursor col cursPos cfig w
NoSubInventory{} -> drawRBOptions cfig w
@@ -176,7 +176,7 @@ drawMapperInventory itid w = fold $ do
f = worldPosToScreen (w ^. wCam)
drawCombineInventory ::
Configuration ->
Config ->
IM.IntMap (SelectionSection CombinableItem) ->
World ->
Picture
@@ -191,7 +191,7 @@ drawCombineInventory cfig sss w =
fmap (\(Sel x y _) -> (x, y)) $
w ^? hud . subInventory . ciSelection . _Just
drawExamineInventory :: Configuration -> World -> Picture
drawExamineInventory :: Config -> World -> Picture
drawExamineInventory cfig w =
invHead cfig "EXAMINE"
<> drawSelectionList
@@ -244,7 +244,7 @@ yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
return . g $ Right but
_ -> x
drawRBOptions :: Configuration -> World -> Picture
drawRBOptions :: Config -> World -> Picture
drawRBOptions cfig w = fold $ do
guard $ ButtonRight `M.member` _mouseButtons (_input w)
invid <- you w ^? crManipulation . manObject . imSelectedItem
@@ -314,7 +314,7 @@ equipAllocString = \case
drawItemConnections ::
IM.IntMap (SelectionSection ()) ->
Configuration ->
Config ->
IM.IntMap (Maybe (Int, Int), [Int], [Int]) ->
Picture
drawItemConnections sss cfig =
@@ -324,7 +324,7 @@ drawItemConnections sss cfig =
drawItemChildrenConnect ::
IM.IntMap (SelectionSection ()) ->
Configuration ->
Config ->
Int ->
[Int] ->
Picture
@@ -338,7 +338,7 @@ drawItemChildrenConnect sss cfig i is = fromMaybe mempty $ do
combineInventoryExtra ::
IM.IntMap (SelectionSection CombinableItem) ->
Maybe (Int, Int) ->
Configuration ->
Config ->
World ->
Picture
combineInventoryExtra sss msel cfig w = fold $ do
@@ -358,7 +358,7 @@ combineInventoryExtra sss msel cfig w = fold $ do
sss'
(Just (0, i))
drawTerminalDisplay :: Configuration -> Terminal -> Picture
drawTerminalDisplay :: Config -> Terminal -> Picture
drawTerminalDisplay cfig tm =
invHead cfig ("T-" ++ show tid)
<> drawSelectionList secondColumnParams cfig f
@@ -387,7 +387,7 @@ drawTerminalDisplay cfig tm =
-- | hasfoc = clockCycle 10 (V.fromList [[cFilledRect] , "."]) w
lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
lnkMidPosInvSelsCol :: Config -> World -> Int -> Color -> [Int] -> Picture
lnkMidPosInvSelsCol cfig w i col = fromMaybe mempty . foldMap f
where
f j = do
@@ -398,7 +398,7 @@ lnkMidPosInvSelsCol cfig w i col = fromMaybe mempty . foldMap f
invcol <- selSecSelCol 0 j sss
return $ zConnectColMidX (rp - V2 5 0) (lp + V2 155 0) (rp ^. _1 - 20) col col col invcol
invHead :: Configuration -> String -> Picture
invHead :: Config -> String -> Picture
invHead cfig =
translateScreenPos cfig (fromTopLeft (V2 subInvX 80))
. dShadCol white
@@ -408,7 +408,7 @@ invHead cfig =
--locPoss = map (cartePosToScreen cfig (w ^. hud) . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w
--locTexts = map fst locs
--displayListEndCoords :: Configuration -> [String] -> [Point2]
--displayListEndCoords :: Config -> [String] -> [Point2]
--displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [1 ..]
-- where
-- f :: Int -> Point2
@@ -416,7 +416,7 @@ invHead cfig =
-- h :: String -> Point2 -> Point2
-- h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y
--closeObjectTexts :: Configuration -> World -> Picture
--closeObjectTexts :: Config -> World -> Picture
--closeObjectTexts cfig w = pictures $
-- renderListAt pushout (negate 20 * fromIntegral invPos) cfig (map colAndText $ _closeObjects w)
-- : maybeToList maybeLine
@@ -448,9 +448,9 @@ invHead cfig =
-- would be nice to add parameter to orient this with NSEW, cf cursor
selNumPos ::
Configuration ->
Config ->
ListDisplayParams ->
IM.IntMap (SelectionSection a) ->
IMSS a ->
Int ->
Int ->
Maybe Point2
@@ -472,7 +472,7 @@ selNumPos = selNumPosCardinal West8
-- need to be able to determine a selection item's width for this
selNumPosCardinal ::
CardinalEightPoint ->
Configuration ->
Config ->
ListDisplayParams ->
IM.IntMap (SelectionSection a) ->
Int ->
src/Dodge/Render/HUD/Carte.hs
+4 -4
View File
@@ -11,7 +11,7 @@ module Dodge.Render.HUD.Carte (
--import qualified IntMapHelp as IM
--import Picture
--
----drawCarte :: Configuration -> World -> Picture
----drawCarte :: Config -> World -> Picture
----drawCarte cfig w =
---- fold $
---- toTopLeft cfig (renderListAt 0 0 locs) :
@@ -38,7 +38,7 @@ module Dodge.Render.HUD.Carte (
-- (x, y) = _wlLine wl
-- c = _wlColor wl
--
----mapWall :: Configuration -> HUD -> Wall -> Maybe Picture
----mapWall :: Config -> HUD -> Wall -> Maybe Picture
----mapWall cfig thehud wl
---- | _wlSeen wl = Just . color c . polygon $ map (cartePosToScreen cfig thehud) [x, x +.+ n2, y +.+ n2, y]
---- | otherwise = Nothing
@@ -48,7 +48,7 @@ module Dodge.Render.HUD.Carte (
---- (x, y) = _wlLine wl
---- c = _wlColor wl
--
--mainListCursor :: Color -> Int -> Configuration -> Picture
--mainListCursor :: Color -> Int -> Config -> Picture
--mainListCursor c = openCursorAt 120 c 5 0
--
--openCursorAt ::
@@ -61,7 +61,7 @@ module Dodge.Render.HUD.Carte (
-- Float ->
-- -- | y offset (discrete)
-- Int ->
-- Configuration ->
-- Config ->
-- Picture
--openCursorAt wth col xoff yoff yint w =
-- translate (xoff - halfWidth w) (halfHeight w - (20 * fromIntegral yint + yoff) - 20) $
src/Dodge/Render/InfoBox.hs
+2 -2
View File
@@ -17,7 +17,7 @@ import Picture
renderInfoListAt ::
Float ->
Float ->
Configuration ->
Config ->
Camera ->
(Point2, [String]) ->
Picture
@@ -41,7 +41,7 @@ renderInfoListAt x y cfig cam (p, ss) =
hw = halfWidth cfig
hh = halfHeight cfig
renderInfoListsAt :: Float -> Float -> Configuration -> Camera -> [(Point2, [String])] -> Picture
renderInfoListsAt :: Float -> Float -> Config -> Camera -> [(Point2, [String])] -> Picture
renderInfoListsAt x y cfig w =
fst . foldr f (mempty, 0)
where
src/Dodge/Render/Lights.hs
+1 -1
View File
@@ -11,7 +11,7 @@ import Geometry
import qualified IntMapHelp as IM
import Control.Lens
lightsToRender :: Configuration -> Camera -> LWorld -> [(Point3, Float, Point3)]
lightsToRender :: Config -> Camera -> LWorld -> [(Point3, Float, Point3)]
{-# INLINE lightsToRender #-}
lightsToRender cfig campos w = take (fromEnum $ cfig ^. graphics_num_shadow_casters) $
sortOn (\(_,x,_) -> negate x) $
src/Dodge/Render/List.hs
+6 -6
View File
@@ -32,7 +32,7 @@ import LensHelp
import ListHelp
import Picture
drawSelectionList :: ListDisplayParams -> Configuration -> [SelectionItem a] -> Picture
drawSelectionList :: ListDisplayParams -> Config -> [SelectionItem a] -> Picture
drawSelectionList ldps cfig sl =
translateScreenPos cfig (ldps ^. ldpPos) $
drawListYgapScaleYoff
@@ -41,7 +41,7 @@ drawSelectionList ldps cfig sl =
0
(makeSelectionListPictures sl)
drawTitleBackground :: Configuration -> Picture
drawTitleBackground :: Config -> Picture
drawTitleBackground cfig =
translateScreenPos cfig (fromTopLeft (V2 (subInvX - 5) 75))
. polygon
@@ -50,7 +50,7 @@ drawTitleBackground cfig =
drawSelectionListBackground ::
ListDisplayParams ->
Configuration ->
Config ->
Int -> -- list length
Picture
drawSelectionListBackground ldp cfig l =
@@ -164,7 +164,7 @@ chooseCursorBorders w h = \case
toLine South = [V2 w h', V2 0 h']
toLine West = [V2 0 h', V2 0 0]
--fillScreenText :: Configuration -> String -> Picture
--fillScreenText :: Config -> String -> Picture
--fillScreenText cfig str =
-- scale wscale hscale
-- . centerText
@@ -175,7 +175,7 @@ chooseCursorBorders w h = \case
-- hw = halfWidth cfig
-- hh = halfHeight cfig
--fillWidthText :: Configuration -> String -> Picture
--fillWidthText :: Config -> String -> Picture
--fillWidthText cfig str =
-- scale thescale thescale
-- . centerText
@@ -216,5 +216,5 @@ dShadCol :: Color -> Picture -> Picture
{-# INLINE dShadCol #-}
dShadCol c p = color black (translate 1.2 (-1.2) p) <> color c p
toTopLeft :: Configuration -> Picture -> Picture
toTopLeft :: Config -> Picture -> Picture
toTopLeft cfig = translate (- halfWidth cfig) (halfHeight cfig)
src/Dodge/Render/MenuScreen.hs
+6 -6
View File
@@ -13,14 +13,14 @@ import Dodge.Render.List
import Dodge.ScreenPos
import Picture
drawMenuScreen :: Configuration -> Maybe Int -> ScreenLayer -> Picture
drawMenuScreen :: Config -> Maybe Int -> ScreenLayer -> Picture
drawMenuScreen cfig spos screen = case screen of
OptionScreen{_scTitle = titf, _scSelectionList = slist} ->
drawOptions cfig titf spos slist
InputScreen inputstr help -> drawInputMenu cfig ('>' : inputstr) help
drawInputMenu ::
Configuration ->
Config ->
-- | Title
String ->
-- | Help Text
@@ -33,7 +33,7 @@ drawInputMenu cfig title footer =
, drawFooterText cfig red footer
]
drawOptions :: Configuration -> String -> Maybe Int -> [SelectionItem a] -> Picture
drawOptions :: Config -> String -> Maybe Int -> [SelectionItem a] -> Picture
drawOptions cfig title msel sl =
darkenBackground cfig
<> drawTitle cfig title
@@ -49,10 +49,10 @@ drawOptions cfig title msel sl =
(BoundaryCursor [North, South])
)
darkenBackground :: Configuration -> Picture
darkenBackground :: Config -> Picture
darkenBackground = color (withAlpha 0.5 black) . polygon . reverse . screenBox
drawTitle :: Configuration -> String -> Picture
drawTitle :: Config -> String -> Picture
drawTitle cfig = translate (- hw) (hh -80) . scale 0.4 0.4 . text
where
hh = halfHeight cfig
@@ -69,7 +69,7 @@ placeString ::
Picture
placeString x y sc = color white . translate x y . scale sc sc . text
drawFooterText :: Configuration -> Color -> String -> Picture
drawFooterText :: Config -> Color -> String -> Picture
drawFooterText cfig col = color col . placeString (- hw + 30) (- hh + 10) 0.1
where
hh = halfHeight cfig
src/Dodge/Render/Picture.hs
+1 -1
View File
@@ -61,7 +61,7 @@ fpsText x = color col . text $ "ms/frame " ++ show x
| x < 50 = orange
| otherwise = red
drawMenuOrHUD :: Configuration -> Universe -> Picture
drawMenuOrHUD :: Config -> Universe -> Picture
drawMenuOrHUD cfig u = case u ^. uvScreenLayers of
[] -> drawHUD (u ^. uvConfig) (u ^. uvWorld)
(x : _) -> drawMenuScreen cfig (u ^? uvWorld . input . mouseContext . mcoMenuClick) x
src/Dodge/Render/ShapePicture.hs
+3 -3
View File
@@ -18,7 +18,7 @@ import Shape
import ShapePicture
import Linear.V3
worldSPic :: Configuration -> Universe -> SPic
worldSPic :: Config -> Universe -> SPic
worldSPic cfig u =
(mempty :!: extraPics cfig u)
<> foldup propSPic (filtOn _prPos _props)
@@ -87,12 +87,12 @@ shiftDraw' fpos fdir fdraw x =
. rotateSP (fdir x)
$ fdraw x
cullPoint :: Configuration -> World -> Point2 -> Bool
cullPoint :: Config -> World -> Point2 -> Bool
cullPoint cfig w p
| debugOn Close_shape_culling cfig = pointInPolygon p (w ^. wCam . camBoundBox)
| otherwise = dist (w ^. wCam . camCenter) p < (w ^. wCam . camViewDistance)
extraPics :: Configuration -> Universe -> Picture
extraPics :: Config -> Universe -> Picture
extraPics cfig u =
setLayer FixedCoordLayer (fixedCoordPictures u)
<> foldMap drawTractorBeam (_tractorBeams lw)