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

Move towards resolving picture rendering bug

Browse Source 
The bug concerns a mutable vector storing the amount of data that has
been poked.
This commit is contained in:
justin
2026-01-01 23:44:18 +00:00
parent 0a8725f68d
commit 2c978b4de1
19 changed files with 316 additions and 315 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Combine/Graph.hs
+1 -2
View File
@@ -1,6 +1,6 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Combine.Graph ( combinationsDotGraph) where
module Dodge.Combine.Graph (combinationsDotGraph) where
import Dodge.Data.CombAmount
import Data.Bifunctor
@@ -91,7 +91,6 @@ belowNumX bt = case maxShowX bt of
--toCombNodeLabel (CombNode Right{}) = ""
combinationsDotGraph :: Text
--combinationsDotGraph = toStrict . printDotGraph . graphToDot nonClusteredParams $ combinationsGraph
combinationsDotGraph =
toStrict . printDotGraph . graphToDot myParams $
combinationsGraph
src/Dodge/Data/Config.hs
+2 -1
View File
@@ -98,7 +98,7 @@ data DebugBool
| Circ_collision_test
| Show_far_wall_detect
| Show_walls_near_point_cursor
| Show_walls_near_point_you
| Show_walls_near_you
| Show_walls_near_segment
| Show_zone_near_point_cursor
| Show_zone_circ
@@ -106,6 +106,7 @@ data DebugBool
| Show_path_between
| Show_writable_values
| Show_mouse_click_pos
| Muzzle_positions
deriving (Eq, Ord, Bounded, Enum, Show)
data ResFactor = DoubleRes | FullRes | HalfRes | QuarterRes | EighthRes | SixteenthRes
src/Dodge/Debug.hs
+25 -2
View File
@@ -2,6 +2,13 @@
module Dodge.Debug (debugEvents, drawDebug) where
import Geometry.Data
import Dodge.Render.Label
import Dodge.Data.DoubleTree
import Dodge.HeldUse
import Dodge.DoubleTree
import Dodge.Item.Grammar
import NewInt
import AesonHelp
import Control.Lens
import Control.Monad
@@ -55,7 +62,7 @@ debugItem = \case
Show_wall_search_rays -> mempty
Show_dda_test -> mempty
Show_far_wall_detect -> mempty
Show_walls_near_point_you -> mempty
Show_walls_near_you -> mempty
Show_zone_near_point_cursor -> mempty
Show_zone_circ -> mempty
Inspect_wall -> mempty
@@ -70,6 +77,7 @@ debugItem = \case
Show_mouse_click_pos -> debugMouseClickPos
Debug_get -> doDebugGet
Debug_put -> debugPutItems
Muzzle_positions -> mempty
debugGet :: Universe -> [String]
debugGet u = foldMap getPretty $ u ^. uvWorld . cWorld . lWorld . shockwaves
@@ -224,7 +232,7 @@ drawDebug u = \case
Show_wall_search_rays -> drawWallSearchRays $ _uvWorld u
Show_dda_test -> drawDDATest $ _uvWorld u
Show_far_wall_detect -> drawFarWallDetect $ _uvWorld u
Show_walls_near_point_you -> drawWallsNearYou $ _uvWorld u
Show_walls_near_you -> drawWallsNearYou $ _uvWorld u
Show_zone_near_point_cursor -> drawZoneNearPointCursor $ _uvWorld u
Show_zone_circ -> drawZoneCirc $ _uvWorld u
Inspect_wall -> drawInspectWalls $ _uvWorld u
@@ -239,3 +247,18 @@ drawDebug u = \case
Show_path_between -> drawPathBetween u
Show_writable_values -> mempty
Show_mouse_click_pos -> mempty
Muzzle_positions -> showMuzzlePositions u
showMuzzlePositions :: Universe -> Picture
showMuzzlePositions u = fold $ do
cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0
invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt
loc <- invIndents ((\k -> u ^?! uvWorld . cWorld . lWorld . items . ix k) <$> _crInv cr)
^? ix invid . _2
return . color red $ setLayer DebugLayer $ reduceLocDT (f cr) loc
where
f cr loc = foldMap g $ map (muzzlePos loc cr) (itemMuzzles $ loc ^. locDT . dtValue . _1)
where
g :: Point3Q -> Picture
g pq = translate3 (pq ^. _1) $ crossPic 5
src/Dodge/Debug/Picture.hs
+2 -1
View File
@@ -72,7 +72,7 @@ lineOnScreenCone cfig w p1 p2 =
drawWallFace :: Config -> World -> Wall -> Picture
drawWallFace cfig w wall
| isRHS sightFrom x y || not (wlIsOpaque wall) = blank
| isRHS sightFrom x y || not (wlIsOpaque wall) = mempty
| otherwise = setDepth (-1) . color (withAlpha 0 black) . polygon $ points
where
(x, y) = _wlLine wall
@@ -226,6 +226,7 @@ drawWallsNearYou w = concat $ do
return $ setLayer DebugLayer $ foldMap f $ wlsNearPoint p w
where
f wl = color violet $ thickLine 3 [a, b]
<> uncurryV translate (0.5 *^ (a + b)) (scale 0.05 0.05 . text $ show (_wlID wl))
where
(a, b) = _wlLine wl
src/Dodge/Picture.hs
+1 -1
View File
@@ -8,7 +8,7 @@ import Picture
wedgeOfThickness :: Float -> Point2 -> Point2 -> Picture
wedgeOfThickness t x y
| x == y = blank
| x == y = mempty
| otherwise = fold
[uncurryV translate x $ circleSolid (0.5*t)
,polygon [x +.+ n x y, x -.- n x y, y]
src/Dodge/Picture/SizeInvariant.hs
+1 -1
View File
@@ -75,7 +75,7 @@ fixedSizePicClampArrow xbord ybord pic p cfig w =
borderPoint = intersectSegPolyFirst campos p bords
windowPoint = intersectSegPolyFirst campos p winps
arrowPic = case borderPoint of
Nothing -> blank
Nothing -> mempty
Just bp -> thickLine 5 [bp, fromMaybe p windowPoint]
(V2 x y) = fromMaybe p borderPoint
campos = w ^. wCam . camCenter
src/Dodge/Render.hs
+4
View File
@@ -77,6 +77,8 @@ doDrawing' win pdata u = do
(0, 0, 0)
ws
)
UMV.forM_ pokeCounts $ print
print "--"
nCloudVs' <- -- foldM (pokeCloud $ pdata ^. cloudVBO . vboPtr) 0 (w ^. cWorld . lWorld . clouds)
V.foldM'
(pokeCloud (pdata ^. cloudVBO . vboPtr))
@@ -412,7 +414,9 @@ doDrawing' win pdata u = do
glEnable GL_BLEND
--glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
glBlendFunc GL_ONE GL_ONE_MINUS_SRC_ALPHA -- assume premultiplied alpha
glDisable GL_CULL_FACE
renderLayer DebugLayer shadV pokeCounts
glEnable GL_CULL_FACE
withArray (scaleMatrix (2 / windowXFloat cfig) (2 / windowYFloat cfig)) $
glNamedBufferSubData (pdata ^. matUBO) 0 64
glDepthMask GL_TRUE
src/Dodge/Render/Label.hs
+1
View File
@@ -20,6 +20,7 @@ drawPointLabel p =
drawCrossCol :: Color -> Point2 -> Picture
drawCrossCol col p = setLayer DebugLayer . color col . uncurryV translate p $ crossPic 5
--drawCrossCol col p = mempty
drawCross :: Point2 -> Picture
drawCross = drawCrossCol red
src/Dodge/Render/Picture.hs
+1 -1
View File
@@ -149,7 +149,7 @@ drawQuitTerminal x =
<> polygonWire (square x)
drawEmptySet :: Float -> Picture
drawEmptySet x = line [V2 x x, V2 (- x) (- x)] <> circle x
drawEmptySet x = line [V2 x x, -(V2 x x)] <> circle x
drawReturn :: Float -> Picture
drawReturn x =
src/Dodge/Render/ShapePicture.hs
+40 -39
View File
@@ -1,12 +1,6 @@
--{-# LANGUAGE LambdaCase #-}
module Dodge.Render.ShapePicture (worldSPic) where
import Dodge.DoubleTree
import Dodge.Data.DoubleTree
import Dodge.HeldUse
import NewInt
import Dodge.Item.Grammar
import Dodge.Render.Label
import Dodge.Debug
import Control.Lens
import Data.Foldable
@@ -27,30 +21,31 @@ import ShapePicture
worldSPic :: Config -> Universe -> SPic
worldSPic cfig u =
(mempty :!: extraPics cfig u)
<> foldup propSPic (filtOn _prPos _props)
<> foldMap' debrisSPic (filtOn' (xyV3 . _dbPos) _debris)
<> foldup drawProjectile (filtOn (^. pjPos . _xy) _projectiles)
<> foldup drawPulseBall (filtOn _pbPos _pulseBalls)
<> foldup (shiftDraw _blPos _blDir (const drawBlock)) (filtOn _blPos _blocks)
<> foldMap' (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn' _fsPos _foreShapes)
<> foldup (drawCreature (lw ^. items)) (filtOn (^. crPos . _xy) _creatures)
<> foldup
(Prelude.uncurry floorItemSPic)
( IM.intersectionWith
(,)
(lw ^. items)
(filtOn _flItPos _floorItems)
)
<> foldup btSPic (filtOn _btPos _buttons)
<> foldup (mcSPic (w ^. cWorld)) (filtOn _mcPos _machines)
<> foldMap' drawChasm (w ^. cWorld . chasms)
<> w ^. cWorld . lWorld . tempSPic
<> testSPic cfig u
-- (mempty :!: extraPics cfig u)
-- <> foldup propSPic (filtOn _prPos _props)
-- <> foldMap' debrisSPic (filtOn' (xyV3 . _dbPos) _debris)
-- <> foldup drawProjectile (filtOn (^. pjPos . _xy) _projectiles)
-- <> foldup drawPulseBall (filtOn _pbPos _pulseBalls)
-- <> foldup (shiftDraw _blPos _blDir (const drawBlock)) (filtOn _blPos _blocks)
-- <> foldMap' (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn' _fsPos _foreShapes)
-- <> foldup (drawCreature (lw ^. items)) (filtOn (^. crPos . _xy) _creatures)
-- <> foldup
-- (Prelude.uncurry floorItemSPic)
-- ( IM.intersectionWith
-- (,)
-- (lw ^. items)
-- (filtOn _flItPos _floorItems)
-- )
-- <> foldup btSPic (filtOn _btPos _buttons)
-- <> foldup (mcSPic (w ^. cWorld)) (filtOn _mcPos _machines)
-- <> foldMap' drawChasm (w ^. cWorld . chasms)
-- <> w ^. cWorld . lWorld . tempSPic
-- <>
testSPic cfig u
where
w = u ^. uvWorld
lw = w ^. cWorld . lWorld
foldup = foldMap'
--foldup = foldMap'
filtOn f g = IM.filter (pointIsClose . f) (g lw)
filtOn' f g = filter (pointIsClose . f) (g lw)
pointIsClose = cullPoint cfig w
@@ -59,18 +54,24 @@ testSPic :: Config -> Universe -> SPic
testSPic cfig u = noShape $ testPic cfig u
testPic :: Config -> Universe -> Picture
testPic _ u = fold $ do
cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0
-- return mempty
invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt
loc <- invIndents ((\k -> u ^?! uvWorld . cWorld . lWorld . items . ix k) <$> _crInv cr)
^? ix invid . _2
return . color red $ setLayer DebugLayer $ reduceLocDT (f cr) loc
where
f cr loc = foldMap g $ map (muzzlePos loc cr) (itemMuzzles $ loc ^. locDT . dtValue . _1)
where
g :: Point3Q -> Picture
g pq = translate3 (pq ^. _1) $ crossPic 5
testPic _ _ = setLayer DebugLayer
$ mempty
-- <> color white (line [0,10])
-- <> text "A"
<> translate 20 20 (arc pi 0 10)
<> translate 0 20 (circleSolidCol white red 10)
-- fold $ do
-- cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0
---- return mempty
-- invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt
-- loc <- invIndents ((\k -> u ^?! uvWorld . cWorld . lWorld . items . ix k) <$> _crInv cr)
-- ^? ix invid . _2
-- return . color red $ setLayer DebugLayer $ reduceLocDT (f cr) loc
-- where
-- f cr loc = foldMap g $ map (muzzlePos loc cr) (itemMuzzles $ loc ^. locDT . dtValue . _1)
-- where
-- g :: Point3Q -> Picture
-- g pq = translate3 (pq ^. _1) $ crossPic 5
drawBlock :: Block -> SPic
src/Dodge/Update.hs
+1 -1
View File
@@ -328,7 +328,7 @@ muzzleWallCheck w cr = fromMaybe cr $ do
let ps = reduceLocDT f loc ^.. each . _1 . _xy
cp = cr ^. crPos . _xy
r <- boundPointsRect (cp : ps)
let wls = uncurry wlsNearRect r w
let wls = uncurry wlsNearRect r w & filter (not . _wlTouchThrough)
vs = mapMaybe (g cp wls) ps
return $ if null vs
then cr