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

Commit before pushing more input events into update

Browse Source
This commit is contained in:
justin
2022-10-29 22:33:10 +01:00
parent afaef480db
commit e3155752ba
36 changed files with 121 additions and 147 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render/ShapePicture.hs
+17 -17
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 . camPos . camBoundBox)
| otherwise = dist (w ^. cWorld . lWorld . camPos . camCenter) p < (w ^. cWorld . lWorld . camPos . camViewDistance)
| debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . camPos . camBoundBox)
| otherwise = dist (w ^. cWorld . camPos . camCenter) p < (w ^. cWorld . camPos . camViewDistance)
extraPics :: Configuration -> World -> Picture
extraPics cfig w =
@@ -176,7 +176,7 @@ debugDraw' cfig w bl = case bl of
Inspect_wall -> drawInspectWalls w
Cr_awareness -> drawCreatureDisplayTexts w
Show_sound -> pictures $ M.map (soundPic cfig w) $ _playingSounds w
Cr_status -> drawCrInfo cfig (w ^. cWorld . lWorld)
Cr_status -> drawCrInfo cfig (w ^. cWorld)
Mouse_position -> drawMousePosition cfig w
Walls_info -> drawWlIDs cfig w
Pathing -> drawPathing cfig w
@@ -195,7 +195,7 @@ drawCollisionTest cfig w =
<> foldMap (drawLabCrossCol cfig cam blue) (xIntercepts crZoneSize a b)
where
(a, b) = _lrLine (_input w)
cam = w ^. cWorld . lWorld . camPos
cam = w ^. cWorld . camPos
drawCreatureDisplayTexts :: World -> Picture
drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (w ^. cWorld . lWorld . creatures)
@@ -279,7 +279,7 @@ drawFarWallDetect w =
$ getViewpoints p (_cWorld w)
-- $ runIdentity $ S.toList_ $ streamViewpoints p w
where
p = w ^. cWorld . lWorld . camPos . camViewFrom
p = w ^. cWorld . camPos . camViewFrom
drawDDATest :: World -> Picture
drawDDATest w =
@@ -290,8 +290,8 @@ drawDDATest w =
-- <> color blue (runIdentity (S.foldMap_ drawCross qs'))
<> setLayer DebugLayer (color yellow (line [cvf, mwp]))
where
cvf = w ^. cWorld . lWorld . camPos . camViewFrom
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)
cvf = w ^. cWorld . camPos . camViewFrom
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
--ps = ddaStreamX 50 cvf mwp
ps = zoneOfSeg 50 cvf mwp
@@ -317,7 +317,7 @@ drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w
setLayer DebugLayer $
color yellow $
uncurryV translate p (circle 5)
<> line [w ^. cWorld . lWorld . camPos . camViewFrom , p]
<> line [w ^. cWorld . camPos . camViewFrom , p]
testPic :: Configuration -> World -> Picture
testPic _ _ = mempty
@@ -333,7 +333,7 @@ testPic _ _ = mempty
drawBoundingBox :: World -> Picture
drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x]
where
(x : xs) = w ^. cWorld . lWorld . camPos . camBoundBox
(x : xs) = w ^. cWorld . camPos . camBoundBox
clDraw :: Cloud -> Picture
clDraw c = translate3 (_clPos c) (drawCloud (_clPict c) c)
@@ -357,11 +357,11 @@ mcSPic mc =
rotateSP (_mcDir mc) (drawMachine mc)
soundPic :: Configuration -> World -> Sound -> Picture
soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig (w ^. cWorld . lWorld)
soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig (w ^. cWorld)
where
p = _soundPos s
thePic =
rotate (w ^. cWorld . lWorld . camPos . camRot)
rotate (w ^. cWorld . camPos . camRot)
. scale theScale theScale
. centerText
. soundToOnomato
@@ -377,8 +377,8 @@ drawMousePosition cfig w =
. text
$ shortPoint2 mwp
where
p = worldPosToScreen (w ^. cWorld . lWorld . camPos) mwp
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)
p = worldPosToScreen (w ^. cWorld . camPos) mwp
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
drawWlIDs :: Configuration -> World -> Picture
drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls)
@@ -392,7 +392,7 @@ drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld .
. text
$ show $ _wlID wl
where
p = worldPosToScreen (w ^. cWorld . lWorld . camPos) $ 0.5 *.* uncurry (+.+) (_wlLine wl)
p = worldPosToScreen (w ^. cWorld . camPos) $ 0.5 *.* uncurry (+.+) (_wlLine wl)
edgeToPic :: [Point2] -> PathEdge -> Picture
edgeToPic poly pe
@@ -405,7 +405,7 @@ edgeToPic poly pe
drawPathing :: Configuration -> World -> Picture
drawPathing cfig w =
setLayer DebugLayer $
foldMap (edgeToPic (screenPolygon cfig (w ^. cWorld . lWorld . camPos)) . (^?! _3)) (FGL.labEdges gr)
foldMap (edgeToPic (screenPolygon cfig (w ^. cWorld . 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
@@ -436,11 +436,11 @@ crDisplayInfo cfig cam cr
fpreShow :: (Show a, Functor f) => String -> f a -> f String
fpreShow str = fmap (((rightPad 7 '.' str ++ "...") ++) . show)
drawCrInfo :: Configuration -> LWorld -> Picture
drawCrInfo :: Configuration -> CWorld -> Picture
drawCrInfo cfig w =
setLayer FixedCoordLayer $
renderInfoListsAt (2 * hw - 400) 0 cfig cam $
mapMaybe (crDisplayInfo cfig cam) $ IM.elems $ w ^. creatures
mapMaybe (crDisplayInfo cfig cam) $ IM.elems $ w ^. lWorld . creatures
where
cam = w ^. camPos
hw = halfWidth cfig