Restrict some arguments
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
@@ -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
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user