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

Camera position refactor

Browse Source
This commit is contained in:
justin
2022-10-28 15:32:46 +01:00
parent 27fe1c7a96
commit 2e7cd0aec2
24 changed files with 184 additions and 163 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render/Lights.hs
+2 -2
View File
@@ -15,8 +15,8 @@ lightsToRender cfig w =
where
getLS = getlsparam . _lsParam
getTLS = getlsparam . _tlsParam
cbox = w ^. cWorld . lWorld . cwCam . cwcBoundBox
cpos = w ^. cWorld . lWorld . cwCam . cwcCenter
cbox = w ^. cWorld . lWorld . camPos . camBoundBox
cpos = w ^. cWorld . lWorld . camPos . camCenter
getlsparam ls
| not (pointInPolygon lpos cbox) && extraculltest = Nothing
| otherwise = Just (_lsPos ls, rad ^ (2 :: Int), _lsCol ls)
src/Dodge/Render/ShapePicture.hs
+10 -10
View File
@@ -116,8 +116,8 @@ shiftDraw' fpos fdir fdraw x =
cullPoint :: Configuration -> World -> Point2 -> Bool
cullPoint cfig w p
| debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . lWorld . cwCam . cwcBoundBox)
| otherwise = dist (w ^. cWorld . lWorld . cwCam . cwcCenter) p < (w ^. cWorld . lWorld . cwCam . cwcViewDistance)
| debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . lWorld . camPos . camBoundBox)
| otherwise = dist (w ^. cWorld . lWorld . camPos . camCenter) p < (w ^. cWorld . lWorld . camPos . camViewDistance)
extraPics :: Configuration -> World -> Picture
extraPics cfig w =
@@ -278,7 +278,7 @@ drawFarWallDetect w =
$ getViewpoints p w
-- $ runIdentity $ S.toList_ $ streamViewpoints p w
where
p = w ^. cWorld . lWorld . cwCam . cwcViewFrom
p = w ^. cWorld . lWorld . camPos . camViewFrom
drawDDATest :: World -> Picture
drawDDATest w =
@@ -289,7 +289,7 @@ drawDDATest w =
-- <> color blue (runIdentity (S.foldMap_ drawCross qs'))
<> setLayer DebugLayer (color yellow (line [cvf, mwp]))
where
cvf = w ^. cWorld . lWorld . cwCam . cwcViewFrom
cvf = w ^. cWorld . lWorld . camPos . camViewFrom
mwp = mouseWorldPos w
--ps = ddaStreamX 50 cvf mwp
ps = zoneOfSeg 50 cvf mwp
@@ -316,7 +316,7 @@ drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w
setLayer DebugLayer $
color yellow $
uncurryV translate p (circle 5)
<> line [w ^. cWorld . lWorld . cwCam . cwcViewFrom , p]
<> line [w ^. cWorld . lWorld . camPos . camViewFrom , p]
testPic :: Configuration -> World -> Picture
testPic _ _ = mempty
@@ -332,7 +332,7 @@ testPic _ _ = mempty
drawBoundingBox :: World -> Picture
drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x]
where
(x : xs) = w ^. cWorld . lWorld . cwCam . cwcBoundBox
(x : xs) = w ^. cWorld . lWorld . camPos . camBoundBox
clDraw :: Cloud -> Picture
clDraw c = translate3 (_clPos c) (drawCloud (_clPict c) c)
@@ -356,11 +356,11 @@ mcSPic mc =
rotateSP (_mcDir mc) (drawMachine mc)
soundPic :: Configuration -> World -> Sound -> Picture
soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w
soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig (w ^. cWorld . lWorld)
where
p = _soundPos s
thePic =
rotate (w ^. cWorld . lWorld . cwCam . cwcRot)
rotate (w ^. cWorld . lWorld . camPos . camRot)
. scale theScale theScale
. centerText
. soundToOnomato
@@ -404,7 +404,7 @@ edgeToPic poly pe
drawPathing :: Configuration -> World -> Picture
drawPathing cfig w =
setLayer DebugLayer $
foldMap (edgeToPic (screenPolygon cfig w) . (^?! _3)) (FGL.labEdges gr)
foldMap (edgeToPic (screenPolygon cfig (w ^. cWorld . lWorld . camPos)) . (^?! _3)) (FGL.labEdges gr)
<> foldMap dispInc (graphToIncidence gr)
where
dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
@@ -430,7 +430,7 @@ crDisplayInfo cfig w cr
| otherwise = Nothing
where
ap = _crActionPlan cr
crOnScreen = pointOnScreen cfig w $ _crPos cr
crOnScreen = pointOnScreen cfig (w ^. cWorld . lWorld . camPos) $ _crPos cr
fpreShow :: (Show a, Functor f) => String -> f a -> f String
fpreShow str = fmap (((rightPad 7 '.' str ++ "...") ++) . show)