Cleanup
This commit is contained in:
@@ -1,5 +1,4 @@
|
||||
module Dodge.Base.Coordinate (
|
||||
cartePosToScreen,
|
||||
worldPosToScreen,
|
||||
screenToWorldPos,
|
||||
mouseWorldPos,
|
||||
@@ -7,18 +6,9 @@ module Dodge.Base.Coordinate (
|
||||
|
||||
import Control.Lens
|
||||
import Dodge.Data.Camera
|
||||
import Dodge.Data.HUD
|
||||
import Dodge.Data.Input
|
||||
import Geometry
|
||||
|
||||
---- | Transform coordinates from world position to screen coordinates.
|
||||
--worldPosToScreenNorm :: Config -> World -> Point2 -> Point2
|
||||
--worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
|
||||
-- where
|
||||
-- doTranslate p = p -.- (w ^. cWorld . lWorld . wCam . cwcCenter)
|
||||
-- doZoom p = (w ^. cWorld . lWorld . wCam . cwcZoom) *.* p
|
||||
-- doRotate p = rotateV (negate (w ^. cWorld . lWorld . wCam . cwcRot)) p
|
||||
|
||||
{- | Transform world coordinates to scaled screen coordinates.
|
||||
- These have to be scaled according to the size of the window to get actual screen positions.
|
||||
- This allows for line thicknesses etc to correspond to pixel sizes.
|
||||
@@ -31,33 +21,10 @@ worldPosToScreen cam =
|
||||
. ((cam ^. camZoom) *.*)
|
||||
. (-.- (cam ^. camCenter))
|
||||
|
||||
{- | Transform coordinates from the map position to screen
|
||||
coordinates.
|
||||
-}
|
||||
cartePosToScreen :: HUD -> Point2 -> Point2
|
||||
cartePosToScreen thehud = doRotate . doZoom . doTranslate
|
||||
where
|
||||
doTranslate p = p - (thehud ^. carteCenter) -- _carteCenter (_hud (_cWorld w))
|
||||
doZoom p = (thehud ^. carteZoom) *.* p
|
||||
doRotate p = rotateV (negate $ thehud ^. carteRot) p
|
||||
|
||||
--crToMousePosOffset :: Creature -> World -> (Point2, Float)
|
||||
--crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr, 0)
|
||||
|
||||
-- | The mouse position in world coordinates.
|
||||
mouseWorldPos :: Input -> Camera -> Point2
|
||||
mouseWorldPos inp cam = screenToWorldPos cam (inp ^. mousePos)
|
||||
|
||||
screenToWorldPos :: Camera -> Point2 -> Point2
|
||||
screenToWorldPos cam p =
|
||||
(cam ^. camCenter)
|
||||
+ (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) p
|
||||
|
||||
---- | The mouse position in map coordinates
|
||||
--mouseCartePos :: World -> Point2
|
||||
--mouseCartePos w = (thehud ^. carteCenter)
|
||||
-- +.+
|
||||
-- (1 / (thehud ^. carteZoom))
|
||||
-- *.* rotateV (thehud ^. carteRot) (_mousePos w)
|
||||
-- where
|
||||
-- thehud = w ^. cWorld . lWorld . hud
|
||||
screenToWorldPos cam p =
|
||||
(cam ^. camCenter) + (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) p
|
||||
|
||||
@@ -34,9 +34,6 @@ data HUD = HUD
|
||||
, _diSelection :: Maybe Selection
|
||||
, _diInvFilter :: Maybe String
|
||||
, _diCloseFilter :: Maybe String
|
||||
, _carteCenter :: Point2
|
||||
, _carteZoom :: Float
|
||||
, _carteRot :: Float
|
||||
, _closeItems :: [NewInt ItmInt]
|
||||
, _closeButtons :: [Int]
|
||||
}
|
||||
|
||||
@@ -17,7 +17,7 @@ data ListDisplayParams = ListDisplayParams
|
||||
}
|
||||
|
||||
data CursorDisplay
|
||||
= BoundaryCursor {_cursSides :: [CardinalPoint]}
|
||||
= BoundaryCursor [CardinalPoint]
|
||||
| BackdropCursor
|
||||
|
||||
data SectionCursor = SectionCursor
|
||||
@@ -53,4 +53,4 @@ makeLenses ''ListDisplayParams
|
||||
makeLenses ''SelectionItem
|
||||
makeLenses ''SelSection
|
||||
makeLenses ''SectionCursor
|
||||
makeLenses ''CursorDisplay
|
||||
makePrisms ''CursorDisplay
|
||||
|
||||
@@ -164,9 +164,6 @@ defaultHUD =
|
||||
, _diSelection = Just (Sel 1 0 mempty)
|
||||
, _diInvFilter = mempty
|
||||
, _diCloseFilter = mempty
|
||||
, _carteCenter = V2 0 0
|
||||
, _carteZoom = 0.5
|
||||
, _carteRot = 0
|
||||
, _closeItems = mempty
|
||||
, _closeButtons = mempty
|
||||
}
|
||||
|
||||
@@ -11,29 +11,23 @@ import Dodge.Render.List
|
||||
import Dodge.ScreenPos
|
||||
import Picture
|
||||
|
||||
drawMenuScreen :: Config -> Maybe Int -> ScreenLayer -> Picture
|
||||
drawMenuScreen cf mi = \case
|
||||
OptionScreen{_scTitle = s, _scSelectionList = l} -> drawOptions cf s mi l
|
||||
InputScreen inputstr -> drawInputMenu cf ('>' : inputstr)
|
||||
drawMenuScreen :: Maybe Int -> ScreenLayer -> Config -> Picture
|
||||
drawMenuScreen mi = \case
|
||||
OptionScreen{_scTitle = s, _scSelectionList = l} -> drawOptions s mi l
|
||||
InputScreen inputstr -> drawInputMenu ('>' : inputstr)
|
||||
|
||||
drawInputMenu :: Config -> String -> Picture
|
||||
drawInputMenu cf s = darkenBackground cf <> drawTitle cf s
|
||||
drawInputMenu :: String -> Config -> Picture
|
||||
drawInputMenu s cf = darkenBackground cf <> drawTitle cf s
|
||||
|
||||
drawOptions :: Config -> String -> Maybe Int -> [SelectionItem a] -> Picture
|
||||
drawOptions cf title msel sl =
|
||||
drawOptions :: String -> Maybe Int -> [SelectionItem a] -> Config -> Picture
|
||||
drawOptions title msel sl cf =
|
||||
darkenBackground cf
|
||||
<> drawTitle cf title
|
||||
<> drawSelectionList menuLDP cf sl
|
||||
<> translateScreenPos
|
||||
cf
|
||||
(menuLDP ^. ldpPos)
|
||||
( drawCursorAt
|
||||
msel
|
||||
sl
|
||||
menuLDP
|
||||
50
|
||||
(BoundaryCursor [North, South])
|
||||
)
|
||||
(drawCursorAt msel sl menuLDP 50 (BoundaryCursor [North, South]))
|
||||
|
||||
darkenBackground :: Config -> Picture
|
||||
darkenBackground = color (withAlpha 0.5 black) . polygon . reverse . screenBox
|
||||
|
||||
+36
-44
@@ -1,7 +1,6 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
module Dodge.Render.Picture (
|
||||
fixedCoordPictures,
|
||||
) where
|
||||
|
||||
module Dodge.Render.Picture (fixedCoordPictures) where
|
||||
|
||||
import Control.Lens
|
||||
import Data.Maybe
|
||||
@@ -62,18 +61,18 @@ fpsText x = color col . text $ "ms/frame " ++ show x
|
||||
| otherwise = red
|
||||
|
||||
drawMenuOrHUD :: Config -> Universe -> Picture
|
||||
drawMenuOrHUD cfig u = case u ^. uvScreenLayers of
|
||||
drawMenuOrHUD cf u = case u ^. uvScreenLayers of
|
||||
[] -> drawHUD (u ^. uvConfig) (u ^. uvWorld)
|
||||
(x : _) -> drawMenuScreen cfig (u ^? uvWorld . input . mouseContext . mcoMenuClick) x
|
||||
(x : _) -> drawMenuScreen (u ^? uvWorld . input . mouseContext . mcoMenuClick) x cf
|
||||
|
||||
drawConcurrentMessage :: Universe -> Picture
|
||||
drawConcurrentMessage u =
|
||||
translate 0 (50 - halfHeight cfig)
|
||||
translate 0 (50 - halfHeight cf)
|
||||
. stackPicturesAt
|
||||
. map (centerText . f)
|
||||
$ u ^.. uvSideEffects . each
|
||||
where
|
||||
cfig = _uvConfig u
|
||||
cf = _uvConfig u
|
||||
f (RunningSideEffect ce) = ce ++ " IN PROGRESS"
|
||||
f x = _ceString x ++ " QUEUED"
|
||||
|
||||
@@ -131,43 +130,32 @@ drawCursorByTerminalStatus = \case
|
||||
_ -> drawEmptySet 5
|
||||
|
||||
drawQuitTerminal :: Float -> Picture
|
||||
drawQuitTerminal x = fold
|
||||
[ line [V2 x x, V2 (- x) (- x)]
|
||||
, line [V2 x (-x), V2 (- x) x]
|
||||
, polygonWire (square x)
|
||||
]
|
||||
drawQuitTerminal x =
|
||||
line [V2 x x, V2 (- x) (- x)]
|
||||
<> line [V2 x (- x), V2 (- x) x]
|
||||
<> polygonWire (square x)
|
||||
|
||||
drawEmptySet :: Float -> Picture
|
||||
drawEmptySet x =
|
||||
fold
|
||||
[ 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 =
|
||||
fold
|
||||
[ line [V2 0 0, V2 y y]
|
||||
, line [V2 0 0, V2 y (- y)]
|
||||
, line [V2 0 0, V2 (2 * y) 0]
|
||||
, line [V2 (2 * y) 0, V2 (2 * y) (2 * x)]
|
||||
]
|
||||
line [V2 0 0, V2 y y]
|
||||
<> line [V2 0 0, V2 y (- y)]
|
||||
<> line [V2 0 0, V2 (2 * y) 0]
|
||||
<> line [V2 (2 * y) 0, V2 (2 * y) (2 * x)]
|
||||
where
|
||||
y = 0.7 * x
|
||||
|
||||
--drawReturn = scale 0.1 0.1 . translate (-50) (-100) $ text [toEnum 153]
|
||||
|
||||
drawPlus :: Float -> Picture
|
||||
drawPlus x = fold [line [V2 (- x) 0, V2 x 0], line [V2 0 (- x), V2 0 x]]
|
||||
|
||||
drawMenuClick :: Float -> Picture
|
||||
drawMenuClick z =
|
||||
fold
|
||||
[ line [V2 y 0, V2 x 0]
|
||||
, line [V2 ny 0, V2 nx 0]
|
||||
, line [V2 0 ny, V2 0 nx]
|
||||
, line [V2 0 y, V2 0 x]
|
||||
]
|
||||
line [V2 y 0, V2 x 0]
|
||||
<> line [V2 ny 0, V2 nx 0]
|
||||
<> line [V2 0 ny, V2 0 nx]
|
||||
<> line [V2 0 y, V2 0 x]
|
||||
where
|
||||
x = 0.5 * z
|
||||
y = x + z
|
||||
@@ -176,12 +164,10 @@ drawMenuClick z =
|
||||
|
||||
drawMenuCursor :: Float -> Picture
|
||||
drawMenuCursor z =
|
||||
fold
|
||||
[ line [V2 y 0, V2 x 0]
|
||||
, line [V2 ny 0, V2 nx 0]
|
||||
, line [V2 0 ny, V2 0 nx]
|
||||
, line [V2 0 y, V2 0 x]
|
||||
]
|
||||
line [V2 y 0, V2 x 0]
|
||||
<> line [V2 ny 0, V2 nx 0]
|
||||
<> line [V2 0 ny, V2 0 nx]
|
||||
<> line [V2 0 y, V2 0 x]
|
||||
where
|
||||
x = z
|
||||
y = x + z
|
||||
@@ -278,12 +264,10 @@ drawCombFilter x =
|
||||
|
||||
drawGapPlus :: Float -> Picture
|
||||
drawGapPlus x =
|
||||
fold
|
||||
[ line [V2 (-1.5 * x) 0, V2 (-0.5 * x) 0]
|
||||
, line [V2 (0.5 * x) 0, V2 (1.5 * x) 0]
|
||||
, line [V2 (0.5 * x) (- x), V2 (0.5 * x) x]
|
||||
, line [V2 (-0.5 * x) (- x), V2 (-0.5 * x) x]
|
||||
]
|
||||
line [V2 (-1.5 * x) 0, V2 (-0.5 * x) 0]
|
||||
<> line [V2 (0.5 * x) 0, V2 (1.5 * x) 0]
|
||||
<> line [V2 (0.5 * x) (- x), V2 (0.5 * x) x]
|
||||
<> line [V2 (-0.5 * x) (- x), V2 (-0.5 * x) x]
|
||||
|
||||
aimDelaySweep :: Universe -> Picture
|
||||
aimDelaySweep u = fold $ do
|
||||
@@ -297,7 +281,15 @@ drawAimSweep cr w = fold $ do
|
||||
a <- safeArgV (mwp -.- p)
|
||||
return $
|
||||
uncurryV translate (worldPosToScreen campos p) $
|
||||
arcFull (a - rot) 10 white (a + diffAngles cdir a - rot) 1 white (5 + dist mwp p * campos ^. camZoom) white
|
||||
arcFull
|
||||
(a - rot)
|
||||
10
|
||||
white
|
||||
(a + diffAngles cdir a - rot)
|
||||
1
|
||||
white
|
||||
(5 + dist mwp p * campos ^. camZoom)
|
||||
white
|
||||
where
|
||||
cdir = _crDir cr
|
||||
rot = campos ^. camRot
|
||||
|
||||
+8
-31
@@ -1,10 +1,4 @@
|
||||
--{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
{- |
|
||||
Module : Dodge.Update
|
||||
Description : Simulation update
|
||||
-}
|
||||
module Dodge.Update (updateUniverse) where
|
||||
|
||||
import Color
|
||||
@@ -37,7 +31,6 @@ import Dodge.Laser.Update
|
||||
import Dodge.LinearShockwave.Update
|
||||
import Dodge.ListDisplayParams
|
||||
import Dodge.Machine.Update
|
||||
--import Dodge.Menu
|
||||
import Dodge.ModificationEffect
|
||||
import Dodge.PressPlate
|
||||
import Dodge.Projectile.Update
|
||||
@@ -161,18 +154,14 @@ updateUniverseLast u =
|
||||
updateUniverseMid :: Universe -> Universe
|
||||
updateUniverseMid u = case _uvScreenLayers u of
|
||||
(OptionScreen{_scOptionFlag = LoadingScreen} : _) -> u
|
||||
-- (sl@OptionScreen{_scOptionFlag = GameOverOptions} : _) -> u & updateUseInputOnScreen sl
|
||||
(sl : _) -> u & uvWorld . unpauseClock .~ 0 & updateUseInputOnScreen sl
|
||||
[] ->
|
||||
(uvWorld . unpauseClock +~ 1)
|
||||
. timeFlowUpdate
|
||||
. updateUseInputInGame
|
||||
. over
|
||||
uvWorld
|
||||
(updateMouseInGame (u ^. uvConfig))
|
||||
$ over
|
||||
uvWorld
|
||||
(updateCamera (u ^. uvConfig))
|
||||
(updateMouseInGame (u ^. uvConfig) . (updateCamera (u ^. uvConfig)))
|
||||
u
|
||||
|
||||
timeFlowUpdate :: Universe -> Universe
|
||||
@@ -184,12 +173,11 @@ timeFlowUpdate u = case u ^. uvWorld . timeFlow of
|
||||
over uvWorld (doTimeScroll smoothing) u
|
||||
CameraScrollTimeFlow{} -> u
|
||||
RewindLeftClick 0 _ -> u & uvWorld . timeFlow .~ NormalTimeFlow
|
||||
RewindLeftClick _ _ -> over uvWorld scrollTimeBack u -- & uvWorld . cWorld . timeFlow .~ NormalTimeFlow
|
||||
RewindLeftClick _ _ -> over uvWorld scrollTimeBack u
|
||||
RespawnDelay{} -> functionalUpdate u
|
||||
PausedTimeFlow _ itmloc -> over uvWorld (pauseTime itmloc) u
|
||||
|
||||
pauseTime :: NewInt ItmInt -> World -> World
|
||||
--pauseTime itmloc w
|
||||
pauseTime _ w
|
||||
-- | justPressedButtonLeft || outofcharge = w & timeFlow .~ NormalTimeFlow
|
||||
| justPressedButtonLeft = w & timeFlow .~ NormalTimeFlow
|
||||
@@ -228,16 +216,10 @@ scrollTimeBack w = case w ^? pastWorlds . _head of
|
||||
& mupdateitem x
|
||||
_ -> w
|
||||
where
|
||||
--mupdateitem x = fromMaybe id $ do
|
||||
mupdateitem _ = fromMaybe id $ do
|
||||
--i <- w ^? timeFlow . scrollItemID . unNInt
|
||||
_ <- w ^? timeFlow . scrollItemID . unNInt
|
||||
-- let pointituse = pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse
|
||||
return id
|
||||
|
||||
-- (pointituse . leftConsumption . wpCharge .~ (x -1))
|
||||
-- . (pointituse . leftHammer .~ HammerDown)
|
||||
|
||||
scrollTimeForward :: World -> World
|
||||
scrollTimeForward w = case w ^? timeFlow . futureWorlds . _head of
|
||||
Nothing -> w
|
||||
@@ -250,9 +232,8 @@ scrollTimeForward w = case w ^? timeFlow . futureWorlds . _head of
|
||||
where
|
||||
ramount = (w ^?! timeFlow . reverseAmount) + 1
|
||||
mupdateitem = fromMaybe id $ do
|
||||
--i <- w ^? timeFlow . scrollItemID . unNInt
|
||||
_ <- w ^? timeFlow . scrollItemID . unNInt
|
||||
return id -- pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse . leftConsumption . wpCharge .~ ramount
|
||||
return id
|
||||
|
||||
-- | The update step.
|
||||
functionalUpdate :: Universe -> Universe
|
||||
@@ -477,7 +458,8 @@ pbFlicker pt =
|
||||
d = 4 * fromIntegral (10 + abs ((_pbTimer pt `mod` 20) - 10))
|
||||
|
||||
zoneClouds :: World -> World
|
||||
zoneClouds w = w & clZoning .~ foldl' (flip zoneCloud) mempty (w ^. cWorld . lWorld . clouds)
|
||||
zoneClouds w = w
|
||||
& clZoning .~ foldl' (flip zoneCloud) mempty (w ^. cWorld . lWorld . clouds)
|
||||
|
||||
zoneDusts :: World -> World
|
||||
zoneDusts w = w & dsZoning .~ foldl' (flip zoneDust) mempty (w ^. cWorld . lWorld . dusts)
|
||||
@@ -533,13 +515,9 @@ updateCreatureSoundPositions w =
|
||||
updateIMl :: (World -> IM.IntMap a) -> (a -> a -> World -> World) -> World -> World
|
||||
updateIMl fim fup w = alaf Endo foldMap (dbArg fup) (fim w) w
|
||||
|
||||
--updateIMl fim fup w = foldl' (flip $ dbArg fup) w (fim w)
|
||||
|
||||
updateIMl' :: (World -> IM.IntMap a) -> (a -> World -> World) -> World -> World
|
||||
updateIMl' fim fup w = alaf Endo foldMap fup (fim w) w
|
||||
|
||||
--updateIMl' fim fup w = foldl' (flip fup) w (fim w)
|
||||
|
||||
updateCreatureGroups :: World -> World
|
||||
updateCreatureGroups w =
|
||||
w & cWorld . lWorld . creatureGroups
|
||||
@@ -867,13 +845,12 @@ dustSpringVel a v b
|
||||
radDist = 10
|
||||
|
||||
simpleCrSprings :: World -> World
|
||||
simpleCrSprings w = IM.foldl' (flip crSpring) w $ IM.filter (\cr -> _crZ cr >= 0) $ w ^. cWorld . lWorld . creatures
|
||||
simpleCrSprings w = IM.foldl' (flip crSpring) w
|
||||
$ IM.filter (\cr -> _crZ cr >= 0) $ w ^. cWorld . lWorld . creatures
|
||||
|
||||
-- note that this may in rare cases not push creatures away from each other
|
||||
crSpring :: Creature -> World -> World
|
||||
crSpring c w = foldl' (flip $ crCrSpring c) w cs
|
||||
where
|
||||
cs = crsNearPoint (_crPos c) w
|
||||
crSpring c w = foldl' (flip $ crCrSpring c) w $ crsNearPoint (_crPos c) w
|
||||
|
||||
crCrSpring :: Creature -> Creature -> World -> World
|
||||
crCrSpring c1 c2
|
||||
|
||||
@@ -43,27 +43,25 @@ import NewInt
|
||||
import SDL
|
||||
|
||||
updateUseInputInGame :: Universe -> Universe
|
||||
updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud of
|
||||
HUD{_subInventory = si, _diSelection = disel} -> case si of
|
||||
DisplayTerminal tmid -> updateKeysInTerminal tmid u
|
||||
CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (Sel (-1) _ _))} ->
|
||||
updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . subInventory of
|
||||
DisplayTerminal tmid -> updateKeysInTerminal tmid u
|
||||
CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (Sel (-1) _ _))} ->
|
||||
u
|
||||
& tohud . subInventory %~ docombineregexinput sss msel
|
||||
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
|
||||
_ | disel == Just (-1) ->
|
||||
u
|
||||
& tohud . subInventory %~ docombineregexinput sss msel
|
||||
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
|
||||
_
|
||||
| disel ^? _Just . slSec == Just (-1) ->
|
||||
u
|
||||
& tohud %~ dodisplayregexinput diInvFilter diInvFilter (-1)
|
||||
& uvWorld . worldEventFlags . at InventoryChange ?~ ()
|
||||
& uvWorld %~ setInvPosFromSS
|
||||
_
|
||||
| disel ^? _Just . slSec == Just 2 ->
|
||||
u
|
||||
& tohud %~ dodisplayregexinput diCloseFilter diCloseFilter 2
|
||||
& uvWorld . worldEventFlags . at InventoryChange ?~ ()
|
||||
& uvWorld %~ setInvPosFromSS
|
||||
_ -> updateKeysInGame u
|
||||
& tohud %~ dodisplayregexinput diInvFilter diInvFilter (-1)
|
||||
& uvWorld . worldEventFlags . at InventoryChange ?~ ()
|
||||
& uvWorld %~ setInvPosFromSS
|
||||
_ | disel == Just 2 ->
|
||||
u
|
||||
& tohud %~ dodisplayregexinput diCloseFilter diCloseFilter 2
|
||||
& uvWorld . worldEventFlags . at InventoryChange ?~ ()
|
||||
& uvWorld %~ setInvPosFromSS
|
||||
_ -> updateKeysInGame u
|
||||
where
|
||||
disel = u ^? uvWorld . hud . diSelection . _Just . slSec
|
||||
tohud = uvWorld . hud
|
||||
dodisplayregexinput filterprism filterlens x di = fromMaybe di $ do
|
||||
sss <- di ^? diSections
|
||||
@@ -97,21 +95,22 @@ updateMouseInGame cfig w
|
||||
|
||||
updateMouseHeldInGame :: Config -> World -> World
|
||||
updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
|
||||
OverInvDragSelect{} | ButtonRight `M.member` (w ^. input . mouseButtons) ->
|
||||
OverInvDragSelect{}
|
||||
| ButtonRight `M.member` (w ^. input . mouseButtons) ->
|
||||
w & input . mouseContext .~ MouseGameRotate
|
||||
OverInvDragSelect (Just sstart) _ ->
|
||||
let sss = w ^. hud . diSections
|
||||
msel = inverseSelNumPos cfig invDP (w ^. input . mousePos) sss
|
||||
in case msel of
|
||||
Nothing -> w & input . mouseContext . mcoSelEnd .~ Nothing
|
||||
Just (i, j)
|
||||
| i == fst sstart -> w & input . mouseContext . mcoSelEnd ?~ j
|
||||
| i < fst sstart -> w & input . mouseContext . mcoSelEnd ?~ 0
|
||||
| otherwise ->
|
||||
w & input . mouseContext . mcoSelEnd
|
||||
.~ fmap
|
||||
fst
|
||||
(IM.lookupMax =<< sss ^? ix (fst sstart) . ssItems)
|
||||
in case msel of
|
||||
Nothing -> w & input . mouseContext . mcoSelEnd .~ Nothing
|
||||
Just (i, j)
|
||||
| i == fst sstart -> w & input . mouseContext . mcoSelEnd ?~ j
|
||||
| i < fst sstart -> w & input . mouseContext . mcoSelEnd ?~ 0
|
||||
| otherwise ->
|
||||
w & input . mouseContext . mcoSelEnd
|
||||
.~ fmap
|
||||
fst
|
||||
(IM.lookupMax =<< sss ^? ix (fst sstart) . ssItems)
|
||||
-- not sure how the above performs when filtering...
|
||||
OverInvDragSelect Nothing _ -> fromMaybe w $ do
|
||||
sss <- w ^? hud . diSections
|
||||
@@ -275,9 +274,9 @@ endCombineRegex w = ssSetCursor (ssLookupDown 0 j) sss
|
||||
where
|
||||
sss = w ^. hud . subInventory . ciSections
|
||||
j = fromMaybe 0 $ do
|
||||
itms <- sss ^? ix 0 . ssItems
|
||||
(k, _) <- IM.lookupMin itms
|
||||
return (k -1)
|
||||
itms <- sss ^? ix 0 . ssItems
|
||||
(k, _) <- IM.lookupMin itms
|
||||
return (k -1)
|
||||
|
||||
startDrag :: (Int, Int) -> World -> World
|
||||
startDrag (a, b) w = setcontext $ case w ^? hud . diSelection . _Just of
|
||||
@@ -387,8 +386,7 @@ updateKeysInTerminal tmid u = fromMaybe deactivate $ do
|
||||
x <- u ^? uvWorld . cWorld . lWorld . buttons . ix (tm ^. tmButtonID) . btPos
|
||||
y <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crPos
|
||||
case tm ^. tmStatus of
|
||||
_
|
||||
| dist x y > 40 || not (hasButtonLOS x y (u ^. uvWorld)) -> Nothing
|
||||
_ | dist x y > 40 || not (hasButtonLOS x y (u ^. uvWorld)) -> Nothing
|
||||
TerminalDeactivated -> Nothing
|
||||
TerminalTextInput{} -> Just $ updateKeysTextInputTerminal tmid u
|
||||
TerminalPressTo{} -> Just $ updateKeyContinueTerminal tmid u
|
||||
@@ -398,6 +396,7 @@ updateKeysInTerminal tmid u = fromMaybe deactivate $ do
|
||||
|
||||
updateKeyContinueTerminal :: Int -> Universe -> Universe
|
||||
updateKeyContinueTerminal tmid u
|
||||
| isJust (u ^. uvWorld . input . pressedKeys . at ScancodeEscape) = u
|
||||
| elem 0 $ u ^. uvWorld . input . pressedKeys = u & uvWorld %~ continueTerminal tmid
|
||||
| otherwise = u
|
||||
|
||||
@@ -417,7 +416,7 @@ updateKeysTextInputTerminal tmid u =
|
||||
uvWorld %~ terminalReturnEffect tmid
|
||||
| otherwise = id
|
||||
tryTabComplete
|
||||
| u ^. uvWorld . input . pressedKeys . at ScancodeTab == Just 0 =
|
||||
| u ^. uvWorld . input . pressedKeys . at ScancodeTab == Just 0 =
|
||||
uvWorld . cWorld . lWorld . terminals . ix tmid %~ tabComplete (u ^. uvWorld)
|
||||
| otherwise = id
|
||||
|
||||
@@ -536,7 +535,8 @@ getCloseObj :: World -> Maybe (Either (NewInt ItmInt) Button)
|
||||
getCloseObj w = getSelectedCloseObj w <|> topcitem <|> topcbut
|
||||
where
|
||||
topcitem = do
|
||||
k <- (w ^? hud . diSections . ix 3 . ssItems)
|
||||
k <-
|
||||
(w ^? hud . diSections . ix 3 . ssItems)
|
||||
>>= (fmap fst . IM.lookupMin)
|
||||
Left <$> w ^? hud . closeItems . ix k
|
||||
topcbut = do
|
||||
@@ -545,8 +545,15 @@ getCloseObj w = getSelectedCloseObj w <|> topcitem <|> topcbut
|
||||
|
||||
tryCombine :: (Int, Int) -> World -> World
|
||||
tryCombine (i, j) w = fromMaybe w $ do
|
||||
CombItem is it <- w ^? hud . subInventory
|
||||
. ciSections . ix i . ssItems . ix j . siPayload . _Just
|
||||
CombItem is it <-
|
||||
w
|
||||
^? hud . subInventory
|
||||
. ciSections
|
||||
. ix i
|
||||
. ssItems
|
||||
. ix j
|
||||
. siPayload
|
||||
. _Just
|
||||
p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
|
||||
return $
|
||||
createItemYou it (foldr (destroyInvItem 0 . NInt) w (sort is))
|
||||
|
||||
Reference in New Issue
Block a user