Restrict some arguments

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