Refactor window size, update selection cursor on new screen
This commit is contained in:
@@ -53,7 +53,7 @@ worldSPic cfig u =
|
||||
<> foldup floorItemSPic (filtOn _flItPos _floorItems)
|
||||
<> foldup btSPic (filtOn _btPos _buttons)
|
||||
<> foldup mcSPic (filtOn _mcPos _machines)
|
||||
<> aimDelaySweep cfig w
|
||||
<> aimDelaySweep w
|
||||
<> anyTargeting cfig w
|
||||
where
|
||||
w = _uvWorld u
|
||||
@@ -61,22 +61,21 @@ worldSPic cfig u =
|
||||
filtOn f g = IM.filter (pointIsClose . f) (g (_lWorld (_cWorld w)))
|
||||
pointIsClose = cullPoint cfig w
|
||||
|
||||
aimDelaySweep :: Configuration -> World -> SPic
|
||||
aimDelaySweep cfig w = fromMaybe mempty $ do
|
||||
aimDelaySweep :: World -> SPic
|
||||
aimDelaySweep w = fromMaybe mempty $ do
|
||||
cr <- w ^? cWorld . lWorld . creatures . ix 0
|
||||
aimstatus <- cr ^? crStance . posture
|
||||
guard (aimstatus == Aiming)
|
||||
return $ noShape $ drawSweep cr cfig w
|
||||
return $ noShape $ drawSweep cr w
|
||||
|
||||
drawSweep :: Creature -> Configuration -> World -> Picture
|
||||
drawSweep cr cfig w = fromMaybe mempty $ do
|
||||
drawSweep :: Creature -> World -> Picture
|
||||
drawSweep cr w = fromMaybe mempty $ do
|
||||
a <- safeArgV (mwp -.- p)
|
||||
let a'
|
||||
| a - cdir > pi = cdir + 2 * pi
|
||||
| a - cdir < - pi = cdir - 2 * pi
|
||||
| otherwise = cdir
|
||||
return $
|
||||
winScale cfig $
|
||||
setLayer FixedCoordLayer $
|
||||
uncurryV translate (worldPosToScreen campos p) $
|
||||
arcFull (a - rot) 10 white (a' - rot) 1 white (5 + dist mwp p * campos ^. camZoom) white
|
||||
@@ -84,7 +83,7 @@ drawSweep cr cfig w = fromMaybe mempty $ do
|
||||
cdir = _crDir cr
|
||||
rot = campos ^. camRot
|
||||
p = _crPos cr
|
||||
campos = w ^. cWorld . camPos
|
||||
campos = w ^. cWorld . cwCamPos
|
||||
theinput = w ^. input
|
||||
mwp = mouseWorldPos theinput campos
|
||||
|
||||
@@ -135,8 +134,8 @@ shiftDraw' fpos fdir fdraw x =
|
||||
|
||||
cullPoint :: Configuration -> World -> Point2 -> Bool
|
||||
cullPoint cfig w p
|
||||
| debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . camPos . camBoundBox)
|
||||
| otherwise = dist (w ^. cWorld . camPos . camCenter) p < (w ^. cWorld . camPos . camViewDistance)
|
||||
| debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . cwCamPos . camBoundBox)
|
||||
| otherwise = dist (w ^. cWorld . cwCamPos . camCenter) p < (w ^. cWorld . cwCamPos . camViewDistance)
|
||||
|
||||
extraPics :: Configuration -> Universe -> Picture
|
||||
extraPics cfig u =
|
||||
@@ -199,24 +198,23 @@ debugDraw' cfig w bl = case bl of
|
||||
Cr_awareness -> drawCreatureDisplayTexts w
|
||||
Show_sound -> pictures $ M.map (soundPic cfig w) $ _playingSounds w
|
||||
Cr_status -> drawCrInfo cfig (w ^. cWorld)
|
||||
Mouse_position -> drawMousePosition cfig w
|
||||
Walls_info -> drawWlIDs cfig w
|
||||
Mouse_position -> drawMousePosition w
|
||||
Walls_info -> drawWlIDs w
|
||||
Pathing -> drawPathing cfig w
|
||||
Show_nodes_near_select -> undefined --drawNodesNearSelect w
|
||||
Show_path_between -> drawPathBetween w
|
||||
Collision_test -> drawCollisionTest cfig w
|
||||
Collision_test -> drawCollisionTest w
|
||||
|
||||
drawCollisionTest :: Configuration -> World -> Picture
|
||||
drawCollisionTest cfig w =
|
||||
drawCollisionTest :: World -> Picture
|
||||
drawCollisionTest w =
|
||||
setLayer DebugLayer (color orange $ line [a, b])
|
||||
<> foldMap (drawCross . fst) (crHit a b w)
|
||||
<> foldMap (drawCross . _crPos) (crsNearSeg a b w)
|
||||
<> foldMap (drawZoneCol green crZoneSize . zoneOfPoint crZoneSize) (xIntercepts crZoneSize a b)
|
||||
<> foldMap (drawZoneCol yellow crZoneSize . zoneOfPoint crZoneSize) (yIntercepts' crZoneSize a b)
|
||||
<> foldMap (drawLabCrossCol cfig cam blue) (xIntercepts crZoneSize a b)
|
||||
<> foldMap (drawLabCrossCol blue) (xIntercepts crZoneSize a b)
|
||||
where
|
||||
(a, b) = _lrLine (_input w)
|
||||
cam = w ^. cWorld . camPos
|
||||
|
||||
drawCreatureDisplayTexts :: World -> Picture
|
||||
drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (w ^. cWorld . lWorld . creatures)
|
||||
@@ -245,7 +243,7 @@ drawWallsNearYou w = fromMaybe mempty $ do
|
||||
|
||||
drawWallsNearCursor :: World -> Picture
|
||||
drawWallsNearCursor w =
|
||||
setLayer DebugLayer $ foldMap f $ wlsNearPoint (mouseWorldPos (_input w) (_camPos $ _cWorld w)) w
|
||||
setLayer DebugLayer $ foldMap f $ wlsNearPoint (mouseWorldPos (_input w) (_cwCamPos $ _cWorld w)) w
|
||||
where
|
||||
f wl = color rose $ thickLine 3 [a, b]
|
||||
where
|
||||
@@ -309,13 +307,13 @@ drawFarWallDetect w =
|
||||
)
|
||||
$ getViewpoints p (_cWorld w)
|
||||
where
|
||||
p = w ^. cWorld . camPos . camViewFrom
|
||||
p = w ^. cWorld . cwCamPos . camViewFrom
|
||||
|
||||
drawZoneNearPointCursor :: World -> Picture
|
||||
drawZoneNearPointCursor w =
|
||||
foldMap (drawZoneCol orange 50) ps
|
||||
where
|
||||
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
|
||||
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)
|
||||
ps = [zoneOfPoint 50 mwp]
|
||||
|
||||
drawDDATest :: World -> Picture
|
||||
@@ -323,8 +321,8 @@ drawDDATest w =
|
||||
foldMap (drawZoneCol orange 50) ps
|
||||
<> setLayer DebugLayer (color yellow (line [cvf, mwp]))
|
||||
where
|
||||
cvf = w ^. cWorld . camPos . camViewFrom
|
||||
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
|
||||
cvf = w ^. cWorld . cwCamPos . camViewFrom
|
||||
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)
|
||||
ps = zoneOfSeg 50 cvf mwp
|
||||
|
||||
drawZoneCol :: Color -> Float -> V2 Int -> Picture
|
||||
@@ -344,7 +342,7 @@ drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w
|
||||
setLayer DebugLayer $
|
||||
color yellow $
|
||||
uncurryV translate p (circle 5)
|
||||
<> line [w ^. cWorld . camPos . camViewFrom, p]
|
||||
<> line [w ^. cWorld . cwCamPos . camViewFrom, p]
|
||||
|
||||
testPic :: Configuration -> World -> Picture
|
||||
testPic _ _ = mempty
|
||||
@@ -352,7 +350,7 @@ testPic _ _ = mempty
|
||||
drawBoundingBox :: World -> Picture
|
||||
drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x]
|
||||
where
|
||||
(x : xs) = w ^. cWorld . camPos . camBoundBox
|
||||
(x : xs) = w ^. cWorld . cwCamPos . camBoundBox
|
||||
|
||||
ppDraw :: PressPlate -> Picture
|
||||
ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
|
||||
@@ -377,7 +375,7 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig (w ^. cWorld)
|
||||
where
|
||||
p = _soundPos s
|
||||
thePic =
|
||||
rotate (w ^. cWorld . camPos . camRot)
|
||||
rotate (w ^. cWorld . cwCamPos . camRot)
|
||||
. scale theScale theScale
|
||||
. centerText
|
||||
. soundToOnomato
|
||||
@@ -385,31 +383,28 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig (w ^. cWorld)
|
||||
theScale = 0.15 * f (_soundVolume s * 0.0001)
|
||||
f x = 1 - 0.5 * (1 - x)
|
||||
|
||||
drawMousePosition :: Configuration -> World -> Picture
|
||||
drawMousePosition cfig w =
|
||||
drawMousePosition :: World -> Picture
|
||||
drawMousePosition w =
|
||||
setLayer FixedCoordLayer
|
||||
. winScale cfig
|
||||
. uncurryV translate p
|
||||
. uncurryV translate (w ^. input . mousePos)
|
||||
. scale 0.1 0.1
|
||||
. text
|
||||
$ shortPoint2 mwp
|
||||
where
|
||||
p = worldPosToScreen (w ^. cWorld . camPos) mwp
|
||||
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
|
||||
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)
|
||||
|
||||
drawWlIDs :: Configuration -> World -> Picture
|
||||
drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls)
|
||||
drawWlIDs :: World -> Picture
|
||||
drawWlIDs 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"
|
||||
| otherwise =
|
||||
winScale cfig
|
||||
. uncurryV translate p
|
||||
uncurryV translate p
|
||||
. scale 0.1 0.1
|
||||
. text
|
||||
$ show $ _wlID wl
|
||||
where
|
||||
p = worldPosToScreen (w ^. cWorld . camPos) $ 0.5 *.* uncurry (+.+) (_wlLine wl)
|
||||
p = worldPosToScreen (w ^. cWorld . cwCamPos) $ 0.5 *.* uncurry (+.+) (_wlLine wl)
|
||||
|
||||
edgeToPic :: [Point2] -> PathEdge -> Picture
|
||||
edgeToPic poly pe
|
||||
@@ -422,7 +417,7 @@ edgeToPic poly pe
|
||||
drawPathing :: Configuration -> World -> Picture
|
||||
drawPathing cfig w =
|
||||
setLayer DebugLayer $
|
||||
foldMap (edgeToPic (screenPolygon cfig (w ^. cWorld . camPos)) . (^?! _3)) (FGL.labEdges gr)
|
||||
foldMap (edgeToPic (screenPolygon cfig (w ^. cWorld . cwCamPos)) . (^?! _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
|
||||
@@ -459,7 +454,7 @@ drawCrInfo cfig w =
|
||||
renderInfoListsAt (2 * hw - 400) 0 cfig cam $
|
||||
mapMaybe (crDisplayInfo cfig cam) $ IM.elems $ w ^. lWorld . creatures
|
||||
where
|
||||
cam = w ^. camPos
|
||||
cam = w ^. cwCamPos
|
||||
hw = halfWidth cfig
|
||||
|
||||
viewBoundaries :: CWorld -> Picture
|
||||
@@ -468,7 +463,7 @@ viewBoundaries w =
|
||||
color green (foldMap (polygonWire . _grBound) grs)
|
||||
<> color yellow (foldMap (\q -> line [p, q]) $ getViewpoints p w)
|
||||
where
|
||||
p = w ^. camPos . camViewFrom
|
||||
p = w ^. cwCamPos . camViewFrom
|
||||
grs = filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen w)
|
||||
|
||||
viewClipBounds :: Configuration -> World -> Picture
|
||||
|
||||
Reference in New Issue
Block a user