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

Restrict some arguments

Browse Source
This commit is contained in:
justin
2022-10-28 22:00:38 +01:00
parent d496c4c523
commit 14e2b5cf8f
6 changed files with 55 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Coordinate.hs
+8 -8
View File
@@ -1,13 +1,13 @@
module Dodge.Base.Coordinate module Dodge.Base.Coordinate (
( mouseWorldPos mouseWorldPos,
, cartePosToScreen cartePosToScreen,
, worldPosToScreen worldPosToScreen,
) where ) where
import Control.Lens
import Dodge.Base.WinScale import Dodge.Base.WinScale
import Dodge.Data.Universe import Dodge.Data.Universe
import Geometry import Geometry
import Control.Lens
---- | Transform coordinates from world position to screen coordinates. ---- | Transform coordinates from world position to screen coordinates.
--worldPosToScreenNorm :: Configuration -> World -> Point2 -> Point2 --worldPosToScreenNorm :: Configuration -> World -> Point2 -> Point2
@@ -52,8 +52,8 @@ mouseWorldPos w =
---- | The mouse position in map coordinates ---- | The mouse position in map coordinates
--mouseCartePos :: World -> Point2 --mouseCartePos :: World -> Point2
--mouseCartePos w = (thehud ^. carteCenter) --mouseCartePos w = (thehud ^. carteCenter)
-- +.+ -- +.+
-- (1 / (thehud ^. carteZoom)) -- (1 / (thehud ^. carteZoom))
-- *.* rotateV (thehud ^. carteRot) (_mousePos w) -- *.* rotateV (thehud ^. carteRot) (_mousePos w)
-- where -- where
-- thehud = w ^. cWorld . lWorld . hud -- thehud = w ^. cWorld . lWorld . hud
src/Dodge/Render/ShapePicture.hs
+5 -5
View File
@@ -276,7 +276,7 @@ drawFarWallDetect w =
, fst $ collidePoint p q $ filter wlIsOpaque $ wlsNearSeg p q w , fst $ collidePoint p q $ filter wlIsOpaque $ wlsNearSeg p q w
] ]
) )
$ getViewpoints p w $ getViewpoints p (_cWorld w)
-- $ runIdentity $ S.toList_ $ streamViewpoints p w -- $ runIdentity $ S.toList_ $ streamViewpoints p w
where where
p = w ^. cWorld . lWorld . camPos . camViewFrom p = w ^. cWorld . lWorld . camPos . camViewFrom
@@ -411,8 +411,8 @@ drawPathing cfig w =
dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
gr = w ^. cWorld . lWorld . pathGraph gr = w ^. cWorld . lWorld . pathGraph
crDisplayInfo :: Configuration -> World -> Creature -> Maybe (Point2, [String]) crDisplayInfo :: Configuration -> CamPos -> Creature -> Maybe (Point2, [String])
crDisplayInfo cfig w cr crDisplayInfo cfig cam cr
| _crID cr == 0 = Nothing | _crID cr == 0 = Nothing
| crOnScreen = | crOnScreen =
Just Just
@@ -431,7 +431,7 @@ crDisplayInfo cfig w cr
| otherwise = Nothing | otherwise = Nothing
where where
ap = _crActionPlan cr ap = _crActionPlan cr
crOnScreen = pointOnScreen cfig (w ^. cWorld . lWorld . camPos) $ _crPos cr crOnScreen = pointOnScreen cfig cam $ _crPos cr
fpreShow :: (Show a, Functor f) => String -> f a -> f String fpreShow :: (Show a, Functor f) => String -> f a -> f String
fpreShow str = fmap (((rightPad 7 '.' str ++ "...") ++) . show) fpreShow str = fmap (((rightPad 7 '.' str ++ "...") ++) . show)
@@ -440,7 +440,7 @@ drawCrInfo :: Configuration -> World -> Picture
drawCrInfo cfig w = drawCrInfo cfig w =
setLayer FixedCoordLayer $ setLayer FixedCoordLayer $
renderInfoListsAt (2 * hw - 400) 0 cfig w $ renderInfoListsAt (2 * hw - 400) 0 cfig w $
mapMaybe (crDisplayInfo cfig w) $ IM.elems $ w ^. cWorld . lWorld . creatures mapMaybe (crDisplayInfo cfig (w ^. cWorld . lWorld . camPos)) $ IM.elems $ w ^. cWorld . lWorld . creatures
where where
hw = halfWidth cfig hw = halfWidth cfig
src/Dodge/Render/Walls.hs
+2 -1
View File
@@ -25,7 +25,8 @@ wallsToDraw w =
<*> L.prefilter wlSeeThroughDraw (L.premap f L.list) <*> L.prefilter wlSeeThroughDraw (L.premap f L.list)
<*> L.premap getWallSPic L.mconcat <*> L.premap getWallSPic L.mconcat
) )
(wlsFromIXs w $ zonesExtract (w ^. cWorld . lWorld . wlZoning) $ zoneOfSight wlZoneSize w) (wlsFromIXs w $ zonesExtract (w ^. cWorld . lWorld . wlZoning) $ zoneOfSight wlZoneSize cam)
cam = w ^. cWorld . lWorld . camPos
--wallsToDraw --wallsToDraw
-- :: World -- :: World
src/Dodge/Update.hs
+3 -1
View File
@@ -156,7 +156,7 @@ functionalUpdate w =
. over uvWorld updateDistortions . over uvWorld updateDistortions
. over uvWorld updateCreatureSoundPositions . over uvWorld updateCreatureSoundPositions
. over uvWorld ppEvents . over uvWorld ppEvents
. updateCamera . over uvWorld (updateCamera cfig)
. colCrsWalls . colCrsWalls
. over uvWorld simpleCrSprings . over uvWorld simpleCrSprings
. over uvWorld zoneCreatures . over uvWorld zoneCreatures
@@ -201,6 +201,8 @@ functionalUpdate w =
. over uvWorld updateCloseObjects . over uvWorld updateCloseObjects
. over uvWorld updateWheelEvents . over uvWorld updateWheelEvents
$ over uvWorld updatePastWorlds w $ over uvWorld updatePastWorlds w
where
cfig = _uvConfig w
updateWheelEvents :: World -> World updateWheelEvents :: World -> World
updateWheelEvents w = foldr ($) w (replicate (abs y) (updateWheelEvent (signum y))) updateWheelEvents w = foldr ($) w (replicate (abs y) (updateWheelEvent (signum y)))
src/Dodge/Update/Camera.hs
+30 -32
View File
@@ -17,7 +17,8 @@ import Data.Maybe
import qualified Data.Set as Set import qualified Data.Set as Set
import Dodge.Base import Dodge.Base
import Dodge.Creature.Test import Dodge.Creature.Test
import Dodge.Data.Universe import Dodge.Data.Config
import Dodge.Data.World
import Dodge.Equipment import Dodge.Equipment
import Dodge.GameRoom import Dodge.GameRoom
import Dodge.Zoning.Wall import Dodge.Zoning.Wall
@@ -28,27 +29,25 @@ import qualified SDL
{- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers; {- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers;
update where your avatar's view is from. -} update where your avatar's view is from. -}
updateCamera :: Universe -> Universe updateCamera :: Configuration -> World -> World
updateCamera uv = updateCamera cfig w =
uv w
& over uvWorld (setViewDistance cfig) & over (cWorld . lWorld . camPos) (setViewDistance cfig)
& moveZoomCamera & moveZoomCamera cfig
& over uvWorld updateScopeZoom & updateScopeZoom
& over uvWorld (rotateCamera cfig) & rotateCamera cfig
where
cfig = _uvConfig uv
moveZoomCamera :: Universe -> Universe moveZoomCamera :: Configuration -> World -> World
moveZoomCamera uv = moveZoomCamera cfig w =
uv w
& uvWorld . cWorld . lWorld . camPos . camCenter .~ newcen & cWorld . lWorld . camPos . camCenter .~ newcen
& uvWorld . cWorld . lWorld . camPos . camViewFrom .~ newvf & cWorld . lWorld . camPos . camViewFrom .~ newvf
& uvWorld . cWorld . lWorld . camPos . camZoom .~ newzoom & cWorld . lWorld . camPos . camZoom .~ newzoom
& uvWorld . cWorld . lWorld . camPos . camDefaultZoom .~ newDefaultZoom & cWorld . lWorld . camPos . camDefaultZoom .~ newDefaultZoom
& uvWorld . cWorld . lWorld . camPos . camItemZoom .~ newItemZoom & cWorld . lWorld . camPos . camItemZoom .~ newItemZoom
where where
cfig = _uvConfig uv --cfig = _uvConfig uv
w = _uvWorld uv --w = _uvWorld uv
cpos = _crPos (you w) cpos = _crPos (you w)
newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset
vfoffset = do vfoffset = do
@@ -126,7 +125,6 @@ zoomInLongGun w
where where
decreaseScopeZoomChange = wpPointer . itScope . scopeZoomChange -~ 1 decreaseScopeZoomChange = wpPointer . itScope . scopeZoomChange -~ 1
wpPointer = cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (w ^?! cWorld . lWorld . creatures . ix 0)) wpPointer = cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (w ^?! cWorld . lWorld . creatures . ix 0))
--wp = _crInv (_creatures (_cWorld w) IM.! 0) IM.! crSel (_creatures (_cWorld w) IM.! 0)
wp = ycr ^?! crInv . ix (crSel ycr) wp = ycr ^?! crInv . ix (crSel ycr)
ycr = you w ycr = you w
Just currentZoom = wp ^? itScope . scopeZoom Just currentZoom = wp ^? itScope . scopeZoom
@@ -179,11 +177,11 @@ doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - (w ^.
b = a * (4 / pi) b = a * (4 / pi)
b' = fromIntegral (round b :: Int) b' = fromIntegral (round b :: Int)
rotateCameraBy :: Float -> World -> World rotateCameraBy :: Float -> LWorld -> LWorld
rotateCameraBy x w = rotateCameraBy x w =
w w
& cWorld . lWorld . camPos . camRot +~ x & camPos . camRot +~ x
& cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_lWorld (_cWorld w)) IM.! 0)) & creatures . ix 0 . crInv . ix (crSel (w ^?! creatures . ix 0))
. itScope . itScope
. scopePos . scopePos
%~ rotateV x %~ rotateV x
@@ -191,8 +189,8 @@ rotateCameraBy x w =
rotateCamera :: Configuration -> World -> World rotateCamera :: Configuration -> World -> World
rotateCamera cfig w rotateCamera cfig w
| keyl && keyr = w | keyl && keyr = w
| keyl = rotateCameraBy 0.025 w | keyl = over (cWorld . lWorld) (rotateCameraBy 0.025) w
| keyr = rotateCameraBy (-0.025) w | keyr = over (cWorld . lWorld) (rotateCameraBy (-0.025)) w
| otherwise = ifConfigWallRotate cfig w | otherwise = ifConfigWallRotate cfig w
where where
keyl = SDL.ScancodeQ `Set.member` _keys w && notAtTerminal w keyl = SDL.ScancodeQ `Set.member` _keys w && notAtTerminal w
@@ -216,16 +214,16 @@ clipZoom ::
Float Float
clipZoom = min 20 . max 0.2 clipZoom = min 20 . max 0.2
setViewDistance :: Configuration -> World -> World setViewDistance :: Configuration -> CamPos -> CamPos
setViewDistance cfig w = setViewDistance cfig w =
w & cWorld . lWorld . camPos . camViewDistance w & camViewDistance
.~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. cWorld . lWorld . camPos . camZoom) .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. camZoom)
getViewpoints :: Point2 -> World -> [Point2] getViewpoints :: Point2 -> CWorld -> [Point2]
{-# INLINE getViewpoints #-} {-# INLINE getViewpoints #-}
getViewpoints p w = getViewpoints p w =
concatMap (gameRoomViewpoints p) $ concatMap (gameRoomViewpoints p) $
filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen (_cWorld w)) filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen w)
gameRoomViewpoints :: Point2 -> GameRoom -> [Point2] gameRoomViewpoints :: Point2 -> GameRoom -> [Point2]
{-# INLINE gameRoomViewpoints #-} {-# INLINE gameRoomViewpoints #-}
@@ -239,7 +237,7 @@ gameRoomViewpoints p gr =
farWallDistDirection :: Point2 -> World -> Maybe (Float, Float, Float, Float) farWallDistDirection :: Point2 -> World -> Maybe (Float, Float, Float, Float)
farWallDistDirection p w = farWallDistDirection p w =
boundPoints $ boundPoints $
map f $ getViewpoints p w map f $ getViewpoints p (_cWorld w)
where where
f q = (rotateV (negate (w ^. cWorld . lWorld . camPos . camRot)) . (-.- p)) (foldl' findPoint q (wls q)) f q = (rotateV (negate (w ^. cWorld . lWorld . camPos . camRot)) . (-.- p)) (foldl' findPoint q (wls q))
wls q = filter wlIsOpaque $ wlsNearSeg p q w wls q = filter wlIsOpaque $ wlsNearSeg p q w
src/Dodge/Zoning/World.hs
+7 -6
View File
@@ -1,17 +1,18 @@
module Dodge.Zoning.World where module Dodge.Zoning.World
( zoneOfSight
) where
import Dodge.Data.World import Dodge.Data.CamPos
import Geometry.Data import Geometry.Data
import Control.Lens import Control.Lens
zoneOfSight :: Float -> World -> [Int2] zoneOfSight :: Float -> CamPos -> [Int2]
zoneOfSight s w = zoneOfSight s w =
[ V2 a b [ V2 a b
| a <- [minimum xs .. maximum xs] | a <- [minimum xs .. maximum xs]
, b <- [minimum ys .. maximum ys] , b <- [minimum ys .. maximum ys]
] ]
where where
(xs, ys) = unzip $ map sizeZoneOfPoint $ w ^. cWorld . lWorld . camPos . camBoundBox (xs, ys) = unzip $ map sizeZoneOfPoint $ w ^. camBoundBox
sizeZoneOfPoint (V2 x y) = (f x, f y) sizeZoneOfPoint (V2 x y) = (f x, f y)
where f = floor . (/ s)
f = floor . (/ s)