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

Add in "linear" lWorld to separate time reversable worlds

Browse Source
This commit is contained in:
justin
2022-10-28 12:24:51 +01:00
parent 5f6bd43599
commit 7e790b7153
130 changed files with 827 additions and 980 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render/HUD.hs
+8 -9
View File
@@ -27,7 +27,7 @@ import Picture
import SDL (MouseButton (..))
hudDrawings :: Universe -> Picture
hudDrawings uv = case _hudElement $ _hud (_cWorld w) of
hudDrawings uv = case w ^. cWorld . lWorld . hud . hudElement of
DisplayCarte -> drawCarte cfig w
DisplayInventory subinv ->
drawInGameHUD uv
@@ -55,7 +55,7 @@ inventoryDisplay cfig w = listPicturesAt 0 0 cfig invlist
invlist =
concatMap (itemText' cr) (IM.toList inv)
++ displayFreeSlots
++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects (_cWorld w))
++ concatMap (closeObjectToTextPictures nfreeslots) (w ^. cWorld . lWorld . closeObjects)
-- ++ map floorItemsColor (concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w))
-- floorItemsColor = case _hudElement (_hud w) of
-- DisplayInventory NoSubInventory -> id
@@ -162,7 +162,7 @@ itmInfo mit = fromMaybe [] $ do
displayTerminal :: Int -> Configuration -> World -> Picture
displayTerminal tid cfig w = fromMaybe mempty $ do
tm <- w ^? cWorld . terminals . ix tid
tm <- w ^? cWorld . lWorld . terminals . ix tid
return $
pictures
[ invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
@@ -332,9 +332,9 @@ drawCarte cfig w =
++ mapOverlay cfig w
++ [mainListCursor white iPos cfig]
where
iPos = _selLocation (_cWorld w)
locs = map (\(_, s) -> (s, white)) . IM.elems . _seenLocations $ _cWorld w
locPoss = map (cartePosToScreen cfig w . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations $ _cWorld w
iPos = w ^. cWorld . lWorld . selLocation
locs = map (\(_, s) -> (s, white)) . IM.elems . _seenLocations . _lWorld $ _cWorld w
locPoss = map (cartePosToScreen cfig w . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w
locTexts = map fst locs
displayListEndCoords :: Configuration -> [String] -> [Point2]
@@ -348,7 +348,7 @@ displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [
mapOverlay :: Configuration -> World -> [Picture]
mapOverlay cfig w =
(color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
(mapMaybe (mapWall cfig w) . IM.elems $ _walls (_cWorld w))
(mapMaybe (mapWall cfig w) . IM.elems $ w ^. cWorld . lWorld . walls)
mapWall :: Configuration -> World -> Wall -> Maybe Picture
mapWall cfig w wl =
@@ -445,5 +445,4 @@ displayHP cid cfig w =
. text
. leftPad 5 ' '
. show
. _crHP
$ _creatures (_cWorld w) IM.! cid
$ w ^?! cWorld . lWorld . creatures . ix cid . crHP
src/Dodge/Render/Lights.hs
+4 -4
View File
@@ -10,13 +10,13 @@ import Control.Lens
lightsToRender :: Configuration -> World -> [(Point3, Float, Point3)]
lightsToRender cfig w =
mapMaybe getLS (IM.elems $ _lightSources (_cWorld w))
++ mapMaybe getTLS (_tempLightSources (_cWorld w))
mapMaybe getLS (IM.elems $ w ^. cWorld . lWorld . lightSources)
++ mapMaybe getTLS (w ^. cWorld . lWorld . tempLightSources)
where
getLS = getlsparam . _lsParam
getTLS = getlsparam . _tlsParam
cbox = w ^. cWorld . cwCam . cwcBoundBox
cpos = w ^. cWorld . cwCam . cwcCenter
cbox = w ^. cWorld . lWorld . cwCam . cwcBoundBox
cpos = w ^. cWorld . lWorld . cwCam . cwcCenter
getlsparam ls
| not (pointInPolygon lpos cbox) && extraculltest = Nothing
| otherwise = Just (_lsPos ls, rad ^ (2 :: Int), _lsCol ls)
src/Dodge/Render/ShapePicture.hs
+34 -32
View File
@@ -58,7 +58,7 @@ worldSPic cfig w =
<> singleSPic (anyTargeting cfig w)
where
foldup = foldMap'
filtOn f g = IM.filter (pointIsClose . f) (g (_cWorld w))
filtOn f g = IM.filter (pointIsClose . f) (g (_lWorld (_cWorld w)))
pointIsClose = cullPoint cfig w
anyTargeting :: Configuration -> World -> SPic
@@ -116,33 +116,35 @@ shiftDraw' fpos fdir fdraw x =
cullPoint :: Configuration -> World -> Point2 -> Bool
cullPoint cfig w p
| debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . cwCam . cwcBoundBox)
| otherwise = dist (w ^. cWorld . cwCam . cwcCenter) p < (w ^. cWorld . cwCam . cwcViewDistance)
| 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)
extraPics :: Configuration -> World -> Picture
extraPics cfig w =
pictures (_decorations (_cWorld w))
<> concatMapPic drawTractorBeam (_tractorBeams (_cWorld w))
<> concatMapPic drawLinearShockwave (_linearShockwaves (_cWorld w))
<> concatMapPic drawShockwave (_shockwaves (_cWorld w))
<> concatMapPic drawLaser (_lasersToDraw (_cWorld w))
<> concatMapPic drawTeslaArc (_teslaArcs (_cWorld w))
pictures (_decorations lw)
<> concatMapPic drawTractorBeam (_tractorBeams lw)
<> concatMapPic drawLinearShockwave (_linearShockwaves lw)
<> concatMapPic drawShockwave (_shockwaves lw)
<> concatMapPic drawLaser (_lasersToDraw lw)
<> concatMapPic drawTeslaArc (_teslaArcs lw)
-- <> concatMapPic drawParticle (_particles w)
<> concatMapPic drawRadarSweep (_radarSweeps (_cWorld w))
<> concatMapPic drawFlame (_flames (_cWorld w))
<> concatMapPic drawEnergyBall (_energyBalls (_cWorld w))
<> concatMapPic drawSpark (_sparks (_cWorld w))
<> concatMapPic drawBul (_bullets (_cWorld w))
<> concatMapPic drawBlip (_radarBlips (_cWorld w))
<> concatMapPic drawFlare (_flares (_cWorld w))
<> concatMapPic (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams (_cWorld w))
<> concatMapPic (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams (_cWorld w))
<> concatMapPic (dbArg (drawLightSource . _lsPict)) (_lightSources (_cWorld w))
<> concatMapPic drawRadarSweep (_radarSweeps lw)
<> concatMapPic drawFlame (_flames lw)
<> concatMapPic drawEnergyBall (_energyBalls lw)
<> concatMapPic drawSpark (_sparks lw)
<> concatMapPic drawBul (_bullets lw)
<> concatMapPic drawBlip (_radarBlips lw)
<> concatMapPic drawFlare (_flares lw)
<> concatMapPic (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams lw)
<> concatMapPic (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams lw)
<> concatMapPic (dbArg (drawLightSource . _lsPict)) (_lightSources lw)
<> testPic cfig w
<> concatMapPic clDraw (_clouds (_cWorld w))
<> concatMapPic ppDraw (_pressPlates (_cWorld w))
<> concatMapPic clDraw (_clouds lw)
<> concatMapPic ppDraw (_pressPlates lw)
<> viewClipBounds cfig w
<> debugDraw cfig w
where
lw = w ^. cWorld . lWorld
debugDraw :: Configuration -> World -> Picture
{-# INLINE debugDraw #-}
@@ -195,7 +197,7 @@ drawCollisionTest cfig w =
(a, b) = _lrLine w
drawCreatureDisplayTexts :: World -> Picture
drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (_creatures (_cWorld w))
drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (w ^. cWorld . lWorld . creatures)
drawPathBetween :: World -> Picture
drawPathBetween w =
@@ -223,7 +225,7 @@ drawInspectWalls w =
setLayer DebugLayer (color orange $ line [a,b]) <>
foldMap (drawInspectWall w) (
filter (isJust . uncurry (intersectSegSeg a b) . _wlLine) $
IM.elems $ _walls (_cWorld w)
IM.elems $ w ^. cWorld . lWorld . walls
)
where
(a, b) = _lLine w
@@ -238,7 +240,7 @@ drawInspectWall w wl =
drawDoorPaths :: World -> Int -> Picture
drawDoorPaths w drid = fromMaybe mempty $ do
paths <- w ^? cWorld . doors . ix drid . drObstructs
paths <- w ^? cWorld . lWorld . doors . ix drid . drObstructs
return $ foldMap' (drawPathEdge . (^. penPathEdge)) paths
drawPathEdge :: PathEdge -> Picture
@@ -276,7 +278,7 @@ drawFarWallDetect w =
$ getViewpoints p w
-- $ runIdentity $ S.toList_ $ streamViewpoints p w
where
p = w ^. cWorld . cwCam . cwcViewFrom
p = w ^. cWorld . lWorld . cwCam . cwcViewFrom
drawDDATest :: World -> Picture
drawDDATest w =
@@ -287,7 +289,7 @@ drawDDATest w =
-- <> color blue (runIdentity (S.foldMap_ drawCross qs'))
<> setLayer DebugLayer (color yellow (line [cvf, mwp]))
where
cvf = w ^. cWorld . cwCam . cwcViewFrom
cvf = w ^. cWorld . lWorld . cwCam . cwcViewFrom
mwp = mouseWorldPos w
--ps = ddaStreamX 50 cvf mwp
ps = zoneOfSeg 50 cvf mwp
@@ -314,7 +316,7 @@ drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w
setLayer DebugLayer $
color yellow $
uncurryV translate p (circle 5)
<> line [w ^. cWorld . cwCam . cwcViewFrom , p]
<> line [w ^. cWorld . lWorld . cwCam . cwcViewFrom , p]
testPic :: Configuration -> World -> Picture
testPic _ _ = mempty
@@ -330,7 +332,7 @@ testPic _ _ = mempty
drawBoundingBox :: World -> Picture
drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x]
where
(x : xs) = w ^. cWorld . cwCam . cwcBoundBox
(x : xs) = w ^. cWorld . lWorld . cwCam . cwcBoundBox
clDraw :: Cloud -> Picture
clDraw c = translate3 (_clPos c) (drawCloud (_clPict c) c)
@@ -358,7 +360,7 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w
where
p = _soundPos s
thePic =
rotate (w ^. cWorld . cwCam . cwcRot)
rotate (w ^. cWorld . lWorld . cwCam . cwcRot)
. scale theScale theScale
. centerText
. soundToOnomato
@@ -378,7 +380,7 @@ drawMousePosition cfig w =
mwp = mouseWorldPos w
drawWlIDs :: Configuration -> World -> Picture
drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (_walls (_cWorld w))
drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls)
where
f wl
| dist (_crPos $ you w) (fst (_wlLine wl)) > 200 = mempty -- this should be improved with a better "on screen test"
@@ -406,7 +408,7 @@ drawPathing cfig w =
<> foldMap dispInc (graphToIncidence gr)
where
dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
gr = _pathGraph (_cWorld w)
gr = w ^. cWorld . lWorld . pathGraph
crDisplayInfo :: Configuration -> World -> Creature -> Maybe (Point2, [String])
crDisplayInfo cfig w cr
@@ -437,7 +439,7 @@ drawCrInfo :: Configuration -> World -> Picture
drawCrInfo cfig w =
setLayer FixedCoordLayer $
renderInfoListsAt (2 * hw - 400) 0 cfig w $
mapMaybe (crDisplayInfo cfig w) $ IM.elems $ _creatures (_cWorld w)
mapMaybe (crDisplayInfo cfig w) $ IM.elems $ w ^. cWorld . lWorld . creatures
where
hw = halfWidth cfig
src/Dodge/Render/Walls.hs
+1 -1
View File
@@ -25,7 +25,7 @@ wallsToDraw w =
<*> L.prefilter wlSeeThroughDraw (L.premap f L.list)
<*> L.premap getWallSPic L.mconcat
)
(wlsFromIXs w $ zonesExtract (w ^. cWorld . wlZoning) $ zoneOfSight' wlZoneSize w)
(wlsFromIXs w $ zonesExtract (w ^. cWorld . lWorld . wlZoning) $ zoneOfSight' wlZoneSize w)
--wallsToDraw
-- :: World