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/Base/Coordinate.hs
+1 -1
View File
@@ -12,7 +12,7 @@ import Dodge.Data.Input
import Geometry
---- | Transform coordinates from world position to screen coordinates.
--worldPosToScreenNorm :: Configuration -> World -> Point2 -> Point2
--worldPosToScreenNorm :: Config -> World -> Point2 -> Point2
--worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
-- where
-- doTranslate p = p -.- (w ^. cWorld . lWorld . wCam . cwcCenter)
src/Dodge/Base/Window.hs
+5 -5
View File
@@ -14,7 +14,7 @@ import Dodge.Data.Config
import Geometry
-- | A box covering the screen in world coordinates
screenPolygon :: Configuration -> Camera -> [Point2]
screenPolygon :: Config -> Camera -> [Point2]
screenPolygon cfig w = map (scTran . scRot . scZoom) $ screenBox cfig
where
scRot = rotateV (w ^. camRot)
@@ -29,7 +29,7 @@ screenPolygonBord ::
Float ->
-- | Y border
Float ->
Configuration ->
Config ->
Camera ->
[Point2]
screenPolygonBord xbord ybord cfig w = [tr, tl, bl, br]
@@ -45,16 +45,16 @@ screenPolygonBord xbord ybord cfig w = [tr, tl, bl, br]
br = theTransform (V2 hw (- hh))
bl = theTransform (V2 (- hw) (- hh))
halfWidth, halfHeight :: Configuration -> Float
halfWidth, halfHeight :: Config -> Float
halfWidth = (0.5 *) . windowXFloat
halfHeight = (0.5 *) . windowYFloat
-- | A box of the size of the screen in screen centered coordinates
screenBox :: Configuration -> [Point2]
screenBox :: Config -> [Point2]
screenBox w = rectNSWE hh (- hh) (- hw) hw
where
hw = halfWidth w
hh = halfHeight w
pointIsOnScreen :: Configuration -> Camera -> Point2 -> Bool
pointIsOnScreen :: Config -> Camera -> Point2 -> Bool
pointIsOnScreen cfig w p = pointInPolygon p $ screenPolygon cfig w
src/Dodge/Config/Load.hs
+1 -1
View File
@@ -6,7 +6,7 @@ import Data.Aeson
import Dodge.Data.Config
import System.Directory
loadDodgeConfig :: IO Configuration
loadDodgeConfig :: IO Config
loadDodgeConfig = do
fExists <- doesFileExist "data/dodge.config.json"
if fExists
src/Dodge/Config/Update.hs
+3 -3
View File
@@ -17,7 +17,7 @@ import Sound
{- |
Write the current world configuration to disk as a json file.
-}
saveConfig :: Configuration -> (a -> IO a) -> a -> IO a
saveConfig :: Config -> (a -> IO a) -> a -> IO a
saveConfig cfig f x = do
-- putStrLn "Saving config to data/dodge.config.json"
BS.writeFile "data/dodge.config.json" $
@@ -27,7 +27,7 @@ saveConfig cfig f x = do
{- |
Apply the volume settings from the world configuration to the running game.
-}
setVol :: Configuration -> IO ()
setVol :: Config -> IO ()
setVol cfig = do
setSoundVolume (_volume_master cfig * _volume_sound cfig)
setMusicVolume (_volume_master cfig * _volume_music cfig)
@@ -36,7 +36,7 @@ setVol cfig = do
Apply /all/ of the values in the world configuration to the running game.
-}
applyWorldConfig ::
Configuration ->
Config ->
PreloadData ->
IO PreloadData
applyWorldConfig cfig pdata = do
src/Dodge/Data/Config.hs
+8 -8
View File
@@ -35,7 +35,7 @@ data NumShadowCasters
| NumShadowCasters20
deriving (Show,Eq,Bounded,Ord,Enum)
data Configuration = Configuration
data Config = Config
{ _volume_master :: Float
, _volume_sound :: Float
, _volume_music :: Float
@@ -58,9 +58,9 @@ data Configuration = Configuration
}
deriving (Show)
windowXFloat :: Configuration -> Float
windowXFloat :: Config -> Float
windowXFloat = fromIntegral . _windowX
windowYFloat :: Configuration -> Float
windowYFloat :: Config -> Float
windowYFloat = fromIntegral . _windowY
data DebugBool
@@ -124,9 +124,9 @@ applyResFactor rf = case rf of
-- EighthRes -> 8
-- SixteenthRes -> 16
defaultConfig :: Configuration
defaultConfig :: Config
defaultConfig =
Configuration
Config
{ _volume_master = 1
, _volume_sound = 1
, _volume_music = 0
@@ -148,13 +148,13 @@ defaultConfig =
, _debug_view_clip_bounds = NoRoomClipBoundaries
}
debugOn :: DebugBool -> Configuration -> Bool
debugOn :: DebugBool -> Config -> Bool
debugOn db = S.member db . _debug_booleans
makeLenses ''Configuration
makeLenses ''Config
deriveJSON defaultOptions ''NumShadowCasters
deriveJSON defaultOptions ''ResFactor
deriveJSON defaultOptions ''ShadowRendering
deriveJSON defaultOptions ''RoomClipping
deriveJSON defaultOptions ''DebugBool
deriveJSON defaultOptions ''Configuration
deriveJSON defaultOptions ''Config
src/Dodge/Data/Universe.hs
+1 -1
View File
@@ -34,7 +34,7 @@ data Universe = Universe
, _uvScreenLayers :: [ScreenLayer]
, _uvIOEffects :: Universe -> IO Universe
, _uvSideEffects :: Seq SideEffect
, _uvConfig :: Configuration
, _uvConfig :: Config
, _uvTestString :: Universe -> [String]
, _uvCanContinue :: Bool
, _uvMSeed :: Maybe Int
src/Dodge/Debug/Picture.hs
+12 -12
View File
@@ -41,7 +41,7 @@ printRotPoint r p =
. uncurryV translate p
$ fold [circle 3, rotate (negate r) $ scale 0.1 0.1 $ text (show p)]
outsideScreenPolygon :: Configuration -> Camera -> [Point2]
outsideScreenPolygon :: Config -> Camera -> [Point2]
outsideScreenPolygon cfig w = [tr, tl, bl, br]
where
scRot = rotateV (w ^. camRot)
@@ -57,7 +57,7 @@ outsideScreenPolygon cfig w = [tr, tl, bl, br]
-- cannot only test if walls are on screen, but also if they are on the cone
-- towards the center of sight
lineOnScreenCone :: Configuration -> World -> Point2 -> Point2 -> Bool
lineOnScreenCone :: Config -> World -> Point2 -> Point2 -> Bool
lineOnScreenCone cfig w p1 p2 =
pointInPolygon p1 sp
|| pointInPolygon p2 sp
@@ -70,7 +70,7 @@ lineOnScreenCone cfig w p1 p2 =
| otherwise = orderPolygon ((w ^. wCam . camViewFrom) : sp')
sps = zip sp (tail sp ++ [head sp])
drawWallFace :: Configuration -> World -> Wall -> Picture
drawWallFace :: Config -> World -> Wall -> Picture
drawWallFace cfig w wall
| isRHS sightFrom x y || not (wlIsOpaque wall) = blank
| otherwise = setDepth (-1) . color (withAlpha 0 black) . polygon $ points
@@ -79,7 +79,7 @@ drawWallFace cfig w wall
points = extendConeToScreenEdge cfig w sightFrom (x, y)
sightFrom = w ^. wCam . camViewFrom
extendConeToScreenEdge :: Configuration -> World -> Point2 -> (Point2, Point2) -> [Point2]
extendConeToScreenEdge :: Config -> World -> Point2 -> (Point2, Point2) -> [Point2]
extendConeToScreenEdge cfig w c (x, y) = orderPolygon $ wallScreenIntersect ++ [x, y] ++ borderPs ++ cornerPs
where
borderPs = mapMaybe (intersectLinefromScreen cfig w c) [x, y]
@@ -93,7 +93,7 @@ extendConeToScreenEdge cfig w c (x, y) = orderPolygon $ wallScreenIntersect ++ [
-- the following assumes that the point a is inside the screen
-- it still works otherwise, but it might intersect two points:
-- it is not obvious which will be returned
intersectLinefromScreen :: Configuration -> World -> Point2 -> Point2 -> Maybe Point2
intersectLinefromScreen :: Config -> World -> Point2 -> Point2 -> Maybe Point2
intersectLinefromScreen cfig w a b =
listToMaybe
. mapMaybe (\(x, y) -> intersectSegLineFrom x y b (b +.+ b -.- a))
@@ -151,7 +151,7 @@ drawZoneCol col s (V2 x y) = setLayer DebugLayer . color col $ thickLine 2 (p :
zipWith (+.+) (square 1) $
map ((s *.*) . (each %~ fromIntegral)) [V2 x y, V2 (x + 1) y, V2 (x + 1) (y + 1), V2 x (y + 1)]
debugDraw :: Configuration -> World -> Picture
debugDraw :: Config -> World -> Picture
{-# INLINE debugDraw #-}
debugDraw cfig w
| Enable_debug `S.member` _debug_booleans cfig =
@@ -162,7 +162,7 @@ debugDraw cfig w
pic = foldMap (debugDraw' cfig w) (_debug_booleans cfig)
ts = map show (S.toList $ _debug_booleans cfig)
debugDraw' :: Configuration -> World -> DebugBool -> Picture
debugDraw' :: Config -> World -> DebugBool -> Picture
{-# INLINE debugDraw' #-}
debugDraw' cfig w bl = case bl of
Enable_debug -> mempty
@@ -315,7 +315,7 @@ viewBoundaries w =
p = w ^. wCam . camViewFrom
grs = filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen $ _cWorld w)
viewClipBounds :: Configuration -> World -> Picture
viewClipBounds :: Config -> World -> Picture
viewClipBounds cfig w
| _debug_view_clip_bounds cfig == AllRoomClipBoundaries =
setLayer DebugLayer $ color green $ foldMap (polygonWire . _cpPoints) (_cwgRoomClipping $ _cwGen (_cWorld w))
@@ -338,7 +338,7 @@ drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x]
where
(x : xs) = w ^. wCam . camBoundBox
soundPic :: Configuration -> World -> Sound -> Picture
soundPic :: Config -> World -> Sound -> Picture
soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w
where
p = _soundPos s
@@ -382,14 +382,14 @@ drawWlIDs w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls
where
p = worldPosToScreen (w ^. wCam) $ 0.5 *.* uncurry (+.+) (_wlLine wl)
drawCrInfo :: Configuration -> World -> Picture
drawCrInfo :: Config -> World -> Picture
drawCrInfo cfig w =
setLayer FixedCoordLayer $
renderInfoListsAt (2 * hw - 400) 0 cfig cam $
mapMaybe crDisplayInfo $ IM.elems $ w ^. cWorld . lWorld . creatures
where
cam = w ^. wCam
-- drawPathing :: Configuration -> World -> Picture
-- drawPathing :: Config -> World -> Picture
-- drawPathing cfig w =
-- setLayer DebugLayer $
-- foldMap (edgeToPic (screenPolygon cfig (w ^. wCam)) . (^?! _3)) (FGL.labEdges gr)
@@ -424,7 +424,7 @@ drawCrInfo cfig w =
fpreShow str = fmap (((rightPad 7 '.' str ++ "...") ++) . show)
hw = halfWidth cfig
drawPathing :: Configuration -> World -> Picture
drawPathing :: Config -> World -> Picture
drawPathing cfig w =
setLayer DebugLayer $
foldMap (edgeToPic (screenPolygon cfig (w ^. wCam)) . (^?! _3)) (FGL.labEdges gr)
src/Dodge/DisplayInventory.hs
+3 -3
View File
@@ -45,7 +45,7 @@ updateCombinePositioning u =
updateCombineSections ::
World ->
Configuration ->
Config ->
IM.IntMap (SelectionSection CombinableItem) ->
IM.IntMap (SelectionSection CombinableItem)
updateCombineSections w cfig =
@@ -115,7 +115,7 @@ displayIndents 3 = 2
displayIndents 5 = 2
displayIndents _ = 0
updateDisplaySections :: World -> Configuration -> IMSS () -> IMSS ()
updateDisplaySections :: World -> Config -> IMSS () -> IMSS ()
updateDisplaySections w cfig =
updateSectionsPositioning
displayIndents
@@ -319,7 +319,7 @@ toggleCombineInv uv =
Just CombineInventory{} -> uvWorld . hud . subInventory .~ NoSubInventory
_ -> uvWorld %~ enterCombineInv (uv ^. uvConfig)
enterCombineInv :: Configuration -> World -> World
enterCombineInv :: Config -> World -> World
enterCombineInv cfig w =
w & hud . subInventory
.~ CombineInventory
src/Dodge/Event/Input.hs
+1 -1
View File
@@ -44,7 +44,7 @@ scToTS = \case
ScancodeDown -> Just TSdown
_ -> Nothing
handleMouseMotionEvent :: MouseMotionEventData -> Configuration -> Input -> Input
handleMouseMotionEvent :: MouseMotionEventData -> Config -> Input -> Input
handleMouseMotionEvent mmev cfig = set mousePos themousepos . set mouseMoving True
where
P (V2 x y) = mouseMotionEventPos mmev
src/Dodge/Picture/SizeInvariant.hs
+2 -2
View File
@@ -34,7 +34,7 @@ import Picture
-- Int ->
-- Picture ->
-- Point2 ->
-- Configuration ->
-- Config ->
-- Camera ->
-- Picture
--fixedSizePicClamp xbord ybord pic p cfig w =
@@ -61,7 +61,7 @@ fixedSizePicClampArrow ::
Float ->
Picture ->
Point2 ->
Configuration ->
Config ->
World ->
Picture
fixedSizePicClampArrow xbord ybord pic p cfig w =
src/Dodge/Render.hs
+2 -2
View File
@@ -432,10 +432,10 @@ doDrawing' win pdata u = do
renderLayer FixedCoordLayer shadV pokeCounts
SDL.glSwapWindow win
getDistortions :: Configuration -> World -> [Distortion]
getDistortions :: Config -> World -> [Distortion]
getDistortions cfig w
| cfig ^. graphics_distortions = w ^. cWorld . lWorld . distortions
| otherwise = []
setViewport :: (Configuration -> ResFactor) -> Configuration -> IO ()
setViewport :: (Config -> ResFactor) -> Config -> IO ()
setViewport f = uncurry (glViewport 0 0) . getWindowSize f
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)
src/Dodge/ScreenPos.hs
+2 -2
View File
@@ -9,10 +9,10 @@ import Picture.Base
fromTopLeft :: Point2 -> ScreenPos
fromTopLeft (V2 x y) = ScreenPos (V2 (-0.5) 0.5) (V2 x (- y))
translateScreenPos :: Configuration -> ScreenPos -> Picture -> Picture
translateScreenPos :: Config -> ScreenPos -> Picture -> Picture
translateScreenPos cfig = uncurryV translate . screenPosAbs cfig
screenPosAbs :: Configuration -> ScreenPos -> Point2
screenPosAbs :: Config -> ScreenPos -> Point2
screenPosAbs cfig sp = sp ^. spScreenOff * V2 w h + sp ^. spPixelOff
where
w = fromIntegral $ cfig ^. windowX
src/Dodge/SelectionList.hs
+1 -1
View File
@@ -7,7 +7,7 @@ import Dodge.Data.Universe
import LensHelp
import Linear
getAvailableListLines :: ListDisplayParams -> Configuration -> Int
getAvailableListLines :: ListDisplayParams -> Config -> Int
getAvailableListLines ldps cfig = floor ((dToBot - vgap) / itmHeight)
where
vgap = ldps ^. ldpVerticalGap
src/Dodge/SelectionSections.hs
+24 -59
View File
@@ -39,10 +39,7 @@ ssScrollUsing ::
IMSS a ->
Maybe Selection ->
Maybe Selection
ssScrollUsing g =
ssScrollMinOnFail
g
. fmap (ssItems %~ IM.filter _siIsSelectable)
ssScrollUsing g = ssScrollMinOnFail g . fmap (ssItems %~ IM.filter _siIsSelectable)
ssScrollMinOnFail ::
(Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)) ->
@@ -60,8 +57,8 @@ ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> Sel i j (q i j)) $ l <|> ssLo
f i j sss
ssSetCursor ::
(IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)) ->
IM.IntMap (SelectionSection a) ->
(IMSS a -> Maybe (Int, Int, SelectionItem a)) ->
IMSS a ->
Maybe Selection ->
Maybe Selection
ssSetCursor f sss msel = fromMaybe msel $ do
@@ -72,111 +69,87 @@ ssSetCursor f sss msel = fromMaybe msel $ do
return xs
return $ Just (Sel i j newxs)
ssLookupMax :: IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupMax :: IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupMax sss = do
(i, _) <- IM.lookupMax sss
ssLookupLE' i sss
ssLookupUp ::
Int ->
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupUp :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupUp i j sss = case ssLookupLT i j sss of
Nothing -> ssLookupMax sss
x -> x
ssLookupDown ::
Int ->
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupDown :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupDown i j sss = case ssLookupGT i j sss of
Nothing -> ssLookupMin sss
x -> x
ssLookupNextMax ::
Int ->
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupNextMax :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupNextMax i j sss = case ssLookupGT i j sss of
Just x@(i',j',_) | i' == i && j' > j -> Just x
_ -> ssLookupMaxInSection i sss <|> ssLookupDown i j sss
ssLookupMaxInSection :: Int -> IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupMaxInSection :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupMaxInSection i sss = do
ss <- sss ^? ix i . ssItems
(j,s) <- IM.lookupMax ss
return (i,j,s)
ssLookupLT ::
Int ->
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupLT :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupLT i j sss = fromMaybe (ssLookupLT' i sss) $ do
ss <- sss ^? ix i
(j', si) <- IM.lookupLT j (ss ^. ssItems)
return $ Just (i, j', si)
ssLookupLT' ::
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupLT' :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupLT' i sss = do
(i', ss) <- IM.lookupLT i sss
case IM.lookupMax (ss ^. ssItems) of
Just (j', si) -> return (i', j', si)
Nothing -> ssLookupLT' i' sss
ssLookupLE' :: Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupLE' :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupLE' i sss = do
(i', ss) <- IM.lookupLE i sss
case IM.lookupMax (ss ^. ssItems) of
Just (j', si) -> return (i', j', si)
Nothing -> ssLookupLT' i' sss
ssLookupMin :: IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupMin :: IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupMin sss = do
(i, _) <- IM.lookupMin sss
ssLookupGE' i sss
ssLookupGT ::
Int ->
Int ->
IM.IntMap (SelectionSection a) ->
Maybe (Int, Int, SelectionItem a)
ssLookupGT :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupGT i j sss = fromMaybe (ssLookupGT' i sss) $ do
ss <- sss ^? ix i
(j', si) <- IM.lookupGT j (ss ^. ssItems)
return $ Just (i, j', si)
ssLookupGT' :: Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupGT' :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupGT' i sss = do
(i', ss) <- IM.lookupGT i sss
case IM.lookupMin (ss ^. ssItems) of
Just (j', si) -> return (i', j', si)
Nothing -> ssLookupGT' i' sss
ssLookupGE' :: Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
ssLookupGE' :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
ssLookupGE' i sss = do
(i', ss) <- IM.lookupGE i sss
case IM.lookupMin (ss ^. ssItems) of
Just (j', si) -> return (i', j', si)
Nothing -> ssLookupGT' i' sss
selSecSelSize :: Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe Int
selSecSelSize :: Int -> Int -> IMSS a -> Maybe Int
selSecSelSize i j = (^? ix i . ssItems . ix j . siHeight)
-- need to check that the vertical gap is correctly put in here
posSelSecYint :: Configuration -> ListDisplayParams -> Float -> Int
posSelSecYint :: Config -> ListDisplayParams -> Float -> Int
posSelSecYint cfig ldp y = floor $ (y0 - y) / (20 / ldp ^. ldpScale + ldp ^. ldpVerticalGap)
where
V2 _ y0 = screenPosAbs cfig (ldp ^. ldpPos)
selSecYint :: Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe Int
selSecYint :: Int -> Int -> IMSS a -> Maybe Int
selSecYint i j sss = do
ss <- sss ^? ix i
return . (secpos +)
@@ -188,7 +161,7 @@ selSecYint i j sss = do
where
secpos = sum . fmap _ssShownLength . fst $ IM.split i sss
inverseSelSecYint :: Int -> IM.IntMap (SelectionSection a) -> XInfinity (Int, Int)
inverseSelSecYint :: Int -> IMSS a -> XInfinity (Int, Int)
inverseSelSecYint yint sss
| yint < 0 = NegInf
| otherwise = fromMaybe PosInf $ do
@@ -202,11 +175,11 @@ inverseSelSecYint yint sss
return $ NonInf (i, j)
inverseSelSecYintXPosCheck ::
Configuration ->
Config ->
ListDisplayParams ->
Float ->
Int ->
IM.IntMap (SelectionSection a) ->
IMSS a ->
Maybe (Int,Int)
inverseSelSecYintXPosCheck cfig ldp x yint sss = do
(i,j) <- inverseSelSecYint yint sss ^? nonInf
@@ -217,14 +190,6 @@ inverseSelSecYintXPosCheck cfig ldp x yint sss = do
guard $ x - x1 < 160 && x > x1
return (i,j)
inverseSelNumPos ::
Configuration ->
ListDisplayParams ->
IM.IntMap (SelectionSection a) ->
Point2 ->
Maybe (Int, Int)
inverseSelNumPos cfig ldp sss (V2 x y) =
inverseSelSecYintXPosCheck cfig ldp x (posSelSecYint cfig ldp y) sss
--getIthPos :: Int -> IM.IntMap (SelectionItem a) -> Int
--getIthPos i sm = sum . fmap _siHeight . fst $ IM.split i sm
inverseSelNumPos :: Config -> ListDisplayParams -> Point2 -> IMSS a -> Maybe (Int, Int)
inverseSelNumPos cfig ldp (V2 x y) =
inverseSelSecYintXPosCheck cfig ldp x (posSelSecYint cfig ldp y)
src/Dodge/SelectionSections/Draw.hs
+3 -3
View File
@@ -16,7 +16,7 @@ import Picture.Base
drawSelectionSections ::
IM.IntMap (SelectionSection a) ->
ListDisplayParams ->
Configuration ->
Config ->
Picture
drawSelectionSections sss ldp cfig =
translateScreenPos cfig (ldp ^. ldpPos) $
@@ -36,7 +36,7 @@ drawSSCursor ::
IM.IntMap (SelectionSection a) ->
ListDisplayParams ->
CursorDisplay ->
Configuration ->
Config ->
Maybe (Int, Int) ->
Picture
drawSSCursor sss ldp curs cfig =
@@ -49,7 +49,7 @@ drawSSMultiCursor ::
Maybe Int ->
ListDisplayParams ->
CursorDisplay ->
Configuration ->
Config ->
Picture
drawSSMultiCursor sss msel mextra ldp curs cfig = translateScreenPos cfig (ldp ^. ldpPos)
. fold
src/Dodge/Update.hs
+9 -9
View File
@@ -339,12 +339,12 @@ checkTermDist w = fromMaybe w $ do
guard $ dist btpos (_crPos $ you w) > 40
return $ w & hud . subInventory .~ NoSubInventory
updateMouseContext :: Configuration -> Universe -> Universe
updateMouseContext :: Config -> Universe -> Universe
updateMouseContext cfig u = case u ^? uvScreenLayers . ix 0 of
Just screen -> u & uvWorld . input . mouseContext .~ getMenuMouseContext screen u
Nothing -> updateMouseContextGame cfig u
updateMouseContextGame :: Configuration -> Universe -> Universe
updateMouseContextGame :: Config -> Universe -> Universe
updateMouseContextGame cfig u = case u ^. uvWorld . input . mouseContext of
OverInvDrag i _ -> u & uvWorld . input . mouseContext .~ invdrag i
OverInvDragSelect{} -> u
@@ -362,25 +362,25 @@ updateMouseContextGame cfig u = case u ^. uvWorld . input . mouseContext of
| ButtonRight `M.member` (w ^. input . mouseButtons) = MouseAiming
| otherwise = MouseInGame
mpos = w ^. input . mousePos
disss = w ^. hud . diSections
invdrag i' = fromMaybe (OverInvDrag i' Nothing) $ do
sss <- w ^? hud . diSections
(i, j) <- inverseSelNumPos cfig invDP sss mpos
-- sss <- w ^? hud . diSections
(i, j) <- inverseSelNumPos cfig invDP mpos disss
return $ OverInvDrag i' (Just (i, j))
overinv = do
sss <- w ^? hud . diSections
selpos@(i, j) <- inverseSelNumPos cfig invDP sss mpos
selpos@(i, j) <- inverseSelNumPos cfig invDP mpos disss
case w ^? hud . subInventory . ciSelection of
Just _ | i == 0 -> return $ OverCombFiltInv selpos
Just _ -> Nothing
_ -> do
guard $ ButtonRight `M.notMember` (w ^. input . mouseButtons)
guard =<< sss ^? ix i . ssItems . ix j . siIsSelectable
guard =<< disss ^? ix i . ssItems . ix j . siIsSelectable
return $ OverInvSelect selpos
overcomb = do
sss <- w ^? hud . subInventory . ciSections
Sel xl xr _ <- w ^? hud . subInventory . ciSelection . _Just
let msel = (xl, xr)
let mpossel = inverseSelNumPos cfig secondColumnParams sss (w ^. input . mousePos)
let mpossel = inverseSelNumPos cfig secondColumnParams (w ^. input . mousePos) sss
return $ case mpossel of
Nothing -> OverCombEscape
Just (-1, i) | (-1, i) == msel -> OverCombFilter
@@ -405,7 +405,7 @@ getMenuMouseContext screen u = case screen ^. scOptions of
Just True -> MouseMenuClick yi
_ -> NoMouseContext
isOverTerminalScreen :: Configuration -> Point2 -> Bool
isOverTerminalScreen :: Config -> Point2 -> Bool
isOverTerminalScreen cfig (V2 x y) =
x <= xmax
&& x >= xmin - 5
src/Dodge/Update/Camera.hs
+8 -8
View File
@@ -27,12 +27,12 @@ import SDL (MouseButton (..))
{- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers;
update where your avatar's view is from. -}
updateCamera :: Configuration -> World -> World
updateCamera :: Config -> World -> World
updateCamera cfig w = case w ^. wCam . camControl of
CamInGame{} -> updateInGameCamera cfig w
CamFloat -> updateFloatingCamera cfig w
updateFloatingCamera :: Configuration -> World -> World
updateFloatingCamera :: Config -> World -> World
updateFloatingCamera cfig w =
w
& updateBounds cfig
@@ -76,7 +76,7 @@ zoomFloatingCamera theinput
-- the 39/40 is taken from zoomSpeed
updateInGameCamera :: Configuration -> World -> World
updateInGameCamera :: Config -> World -> World
updateInGameCamera cfig w =
w
& updateBounds cfig
@@ -84,7 +84,7 @@ updateInGameCamera cfig w =
& rotateCamera cfig
& over wCam (setViewDistance cfig) -- I think this should be updated after the zoom?
moveZoomCamera :: Configuration -> Input -> Creature -> World -> Camera -> Camera
moveZoomCamera :: Config -> Input -> Creature -> World -> Camera -> Camera
moveZoomCamera cfig theinput cr w campos =
campos
& camCenter .~ fromMaybe (_crPos cr +.+ offset) mremotepos
@@ -192,7 +192,7 @@ heldAimZoom = \case
viewDistanceFromItems :: Creature -> Float
viewDistanceFromItems _ = 1
rotateCamera :: Configuration -> World -> World
rotateCamera :: Config -> World -> World
rotateCamera cfig w
| MouseGameRotate <- w ^. input . mouseContext
, Just rotation <-
@@ -231,7 +231,7 @@ clipZoom ::
Float
clipZoom = min 20 . max 0.2
setViewDistance :: Configuration -> Camera -> Camera
setViewDistance :: Config -> Camera -> Camera
setViewDistance cfig w =
w & camViewDistance
.~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. camZoom)
@@ -243,7 +243,7 @@ farWallDistDirection p w = boundPoints $ map f $ getViewpoints p (_cWorld w)
wls q = filter wlIsOpaque $ wlsNearSeg p q w
findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine
findBoundDists :: Configuration -> World -> (Float, Float, Float, Float)
findBoundDists :: Config -> World -> (Float, Float, Float, Float)
findBoundDists cfig w
| debugOn Bound_box_screen cfig = (hh, - hh, hw, - hw)
| otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. wCam . camViewFrom) w
@@ -253,7 +253,7 @@ findBoundDists cfig w
-- this probably doesn't need to be updated every frame,
-- though I'm not sure how often it should be updated
updateBounds :: Configuration -> World -> World
updateBounds :: Config -> World -> World
updateBounds cfig w = case (w ^. cWorld . cClock) `mod` 5 of
0 ->
w
src/Dodge/Update/Input/InGame.hs
+6 -6
View File
@@ -83,7 +83,7 @@ updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud of
& ciSelection .~ msel'
& ciFilter .~ filts'
updateMouseInGame :: Configuration -> World -> World
updateMouseInGame :: Config -> World -> World
updateMouseInGame cfig w
| Just 0 <- lbpress = updateMouseClickInGame cfig w
| Just _ <- lbpress = updateMouseHeldInGame cfig w
@@ -93,13 +93,13 @@ updateMouseInGame cfig w
lbpress = w ^? input . mouseButtons . ix ButtonLeft
lbrelease = w ^? input . mouseButtonsReleased . ix ButtonLeft
updateMouseHeldInGame :: Configuration -> World -> World
updateMouseHeldInGame :: Config -> World -> World
updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
OverInvDragSelect{} | ButtonRight `M.member` (w ^. input . mouseButtons) ->
w & input . mouseContext .~ MouseGameRotate
OverInvDragSelect (Just sstart) _ ->
let sss = w ^. hud . diSections
msel = inverseSelNumPos cfig invDP sss (w ^. input . mousePos)
msel = inverseSelNumPos cfig invDP (w ^. input . mousePos) sss
in case msel of
Nothing -> w & input . mouseContext . mcoSelEnd .~ Nothing
Just (i, j)
@@ -123,7 +123,7 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
OverInvDrag k mmouseover -> doDrag cfig 30 k mmouseover w
_ -> w
doDrag :: Configuration -> Int -> Int -> Maybe (Int, Int) -> World -> World
doDrag :: Config -> Int -> Int -> Maybe (Int, Int) -> World -> World
doDrag cfig n k mmouseover w = fromMaybe w $ do
guard (n /= 0)
ss <- w ^? hud . diSections . ix k . ssItems
@@ -200,7 +200,7 @@ isGroupSelectableSection = \case
3 -> True
_ -> False
updateMouseClickInGame :: Configuration -> World -> World
updateMouseClickInGame :: Config -> World -> World
updateMouseClickInGame cfig w = case w ^. input . mouseContext of
MouseInGame -> fromMaybe (w & input . mouseContext .~ OverInvDragSelect Nothing Nothing) $ do
let sss = w ^. hud . diSections
@@ -303,7 +303,7 @@ collectInvItems secid is w = fromMaybe w $ do
return . h (j + 1) ks $ swapInvItems (\_ _ -> Just (j + 1)) k w'
shiftInvItems ::
Configuration ->
Config ->
Int -> -- recurse limit
Int -> -- section where drag started
(Int, Int) -> -- selection item mouse is over
src/Dodge/Update/Input/ScreenLayer.hs
+2 -2
View File
@@ -71,7 +71,7 @@ mouseClickOptionsList u = fromMaybe u $ do
return $ f u & uvSoundQueue .:~ click1S
_ -> Nothing
ldpVerticalSelection :: Configuration -> ListDisplayParams -> Point2 -> Maybe Int
ldpVerticalSelection :: Config -> ListDisplayParams -> Point2 -> Maybe Int
ldpVerticalSelection cfig ldp (V2 _ y)
| yupper == ylower = Just yupper
| otherwise = Nothing
@@ -84,6 +84,6 @@ ldpVerticalSelection cfig ldp (V2 _ y)
yupper = floor $ (top - (y + ygap)) / yoff
ylower = ceiling ((top - y) / yoff) - 1
setSelectionListRestriction :: Configuration -> ScreenLayer -> ScreenLayer
setSelectionListRestriction :: Config -> ScreenLayer -> ScreenLayer
setSelectionListRestriction cfig =
scAvailableLines .~ getAvailableListLines menuDisplayParams cfig
src/Dodge/WallCreatureCollisions.hs
+1 -1
View File
@@ -19,7 +19,7 @@ colCrsWalls :: Universe -> Universe
--colCrsWalls uv = uv
colCrsWalls uv = uv & uvWorld . cWorld . lWorld . creatures %~ fmap (noclipCheck (_uvConfig uv) (_uvWorld uv))
noclipCheck :: Configuration -> World -> Creature -> Creature
noclipCheck :: Config -> World -> Creature -> Creature
noclipCheck cfig w c
| debugOn Noclip cfig && _crID c == 0 = c -- for noclip
| otherwise = colCrWall w c
src/Dodge/WindowSize.hs
+1 -1
View File
@@ -2,7 +2,7 @@ module Dodge.WindowSize where
import Dodge.Data.Config
getWindowSize :: Integral a => (Configuration -> ResFactor) -> Configuration -> (a,a)
getWindowSize :: Integral a => (Config -> ResFactor) -> Config -> (a,a)
getWindowSize f cfig = (g _windowX, g _windowY)
where
g h = fromIntegral $ applyResFactor (f cfig) (h cfig)
src/Framebuffer/Update.hs
+2 -2
View File
@@ -20,7 +20,7 @@ import Shader.Data
import Unsafe.Coerce
sizeFBOs ::
Configuration ->
Config ->
RenderData ->
IO RenderData
sizeFBOs cfig rdata =
@@ -229,7 +229,7 @@ initializeTexture2D fbo attachpoint x y minfilt magfilt informat = do
glNamedFramebufferTexture (_unFBO fbo) attachpoint to1 0
return to1
--getWindowSize :: Integral a => (Configuration -> ResFactor) -> Configuration -> (a, a)
--getWindowSize :: Integral a => (Config -> ResFactor) -> Config -> (a, a)
--getWindowSize f cfig = (g _windowX, g _windowY)
-- where
-- g h = fromIntegral $ h cfig `div` resFactorNum (f cfig)
src/Preload/Update.hs
+1 -1
View File
@@ -24,7 +24,7 @@ updatePreload u =
u
renderDataResizeUpdate ::
Configuration ->
Config ->
RenderData ->
IO RenderData
renderDataResizeUpdate cfig rdata = do
src/Render.hs
+1 -1
View File
@@ -24,7 +24,7 @@ import Shader.Data
away" from the shape colors.
-}
createLightMap ::
Configuration ->
Config ->
-- | number of walls
GLsizei ->
-- | number of silhoutte lines to draw