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

Start adding mouse control of inventory

Browse Source
This commit is contained in:
justin
2024-10-15 23:26:08 +01:00
parent e745238b8f
commit cf0873d73b
18 changed files with 333 additions and 269 deletions
Download Patch File Download Diff File Expand all files Collapse all files
data/dodge.config.json
-1
View File
@@ -2,7 +2,6 @@
"_debug_booleans": [
"Show_ms_frame",
"Show_sound",
"Noclip",
"Select_creature"
],
"_debug_view_clip_bounds": "NoRoomClipBoundaries",
ghcidOutput
+4 -13
View File
@@ -1,14 +1,5 @@
/home/justin/Haskell/loop/src/Dodge/HeldUse.hs:70:31-47: error:
• Data constructor not in scope:
CrWeaponFailSound :: Int -> SoundOrigin
• Perhaps you meant ‘CrWeaponSound’ (imported from Dodge.Data.World)
/home/justin/Haskell/loop/src/Dodge/Render/ShapePicture.hs:61:19: warning: [-Wunused-matches]
Defined but not used: ‘cfig’
|
70 | Just 0 -> soundStart (CrWeaponFailSound (_crID cr)) (_crPos cr) click1S Nothing w
| ^^^^^^^^^^^^^^^^^
/home/justin/Haskell/loop/src/Dodge/HeldUse.hs:71:29-45: error:
• Data constructor not in scope:
CrWeaponFailSound :: Int -> SoundOrigin
• Perhaps you meant ‘CrWeaponSound’ (imported from Dodge.Data.World)
|
71 | _ -> soundContinue (CrWeaponFailSound (_crID cr)) (_crPos cr) click1S Nothing w
| ^^^^^^^^^^^^^^^^^
61 | drawDIMouseOver w cfig = fromMaybe mempty $ do
| ^^^^
src/Dodge/Creature/YourControl.hs
+2 -2
View File
@@ -35,7 +35,7 @@ yourControl _ w
intopinv = fromMaybe False $ do
subinv <- w ^? hud . hudElement . subInventory
Just $ case subinv of
NoSubInventory -> True
NoSubInventory{} -> True
_ -> False
handleHotkeys :: World -> World
@@ -169,7 +169,7 @@ pressedMBEffectsTopInventory pkeys w
where
youhammerdown = set (cWorld . lWorld . creatures . ix 0 . crHammerPosition) HammerDown
inTopInv = case w ^. hud . hudElement of
DisplayInventory{_subInventory = NoSubInventory} -> True
DisplayInventory{_subInventory = NoSubInventory{}} -> True
_ -> False
isDown but = but `M.member` pkeys
rotation =
src/Dodge/Data/HUD.hs
+3
View File
@@ -21,6 +21,9 @@ data HUDElement
data SubInventory
= NoSubInventory
{ _nsSelected :: Maybe (Int,Int)
, _nsMouseOver :: Maybe Int
}
| ExamineInventory
| CombineInventory { _ciSections :: SelectionSections CombinableItem }
| LockedInventory
src/Dodge/Default/World.hs
+1 -1
View File
@@ -161,7 +161,7 @@ defaultHUD =
defaultDisplayInventory :: HUDElement
defaultDisplayInventory =
DisplayInventory
{ _subInventory = NoSubInventory
{ _subInventory = NoSubInventory {_nsSelected = Just (0,2), _nsMouseOver = Just 3}
, _diSections = defaultInvSections
}
src/Dodge/DisplayInventory.hs
+2 -1
View File
@@ -30,7 +30,8 @@ import Regex
toggleCombineInv :: Universe -> Universe
toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of
Just CombineInventory{} -> uv & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
Just CombineInventory{} -> uv & uvWorld . hud . hudElement . subInventory
.~ NoSubInventory Nothing Nothing
_ -> uv & uvWorld %~ enterCombineInv (uv ^. uvConfig)
updateCombinePositioning :: Universe -> Universe
src/Dodge/InputFocus.hs
+3 -3
View File
@@ -30,7 +30,7 @@ regexScope ::
Maybe
((SSSExtra -> f SSSExtra) -> HUDElement -> f HUDElement, Int)
regexScope w = case w ^? hud . hudElement . subInventory of
Just NoSubInventory -> case he ^? diSections . sssExtra . sssSelPos . _Just of
Just NoSubInventory{} -> case he ^? diSections . sssExtra . sssSelPos . _Just of
Just (-1, _) -> di (-1)
Just (0, _) -> di (-1)
Just (2, _) -> di 2
@@ -49,7 +49,7 @@ regexFocus ::
Maybe
((SSSExtra -> f SSSExtra) -> HUDElement -> f HUDElement, Int)
regexFocus w = case w ^? hud . hudElement . subInventory of
Just NoSubInventory -> case he ^? diSections . sssExtra . sssSelPos . _Just of
Just NoSubInventory{} -> case he ^? diSections . sssExtra . sssSelPos . _Just of
Just (-1, _) -> di (-1)
Just (2, _) -> di 2
_ -> Nothing
@@ -71,7 +71,7 @@ inputFocus ::
World ->
Maybe ((String -> f String) -> World -> f World)
inputFocus w = case w ^? hud . hudElement . subInventory of
Just NoSubInventory -> case he ^? diSections . sssExtra . sssSelPos . _Just of
Just NoSubInventory{} -> case he ^? diSections . sssExtra . sssSelPos . _Just of
Just (-1, _) -> di (-1)
Just (2, _) -> di 2
_ -> Nothing
src/Dodge/Item/Grammar.hs
+47 -40
View File
@@ -9,11 +9,11 @@ module Dodge.Item.Grammar (
allInvLocs,
) where
import Dodge.Data.ComposedItem
import Control.Applicative
import Data.Bifunctor
import qualified Data.IntMap.Strict as IM
import Data.Maybe
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Dodge.Data.Item
import Dodge.DoubleTree
@@ -21,15 +21,18 @@ import Dodge.Item.Orientation
import LensHelp
import ListHelp
useBreakL :: [(ItemStructuralFunction, ComposeLinkType)]
-> [(ItemStructuralFunction, ComposeLinkType)]
-> LinkTest
useBreakL ::
[(ItemStructuralFunction, ComposeLinkType)] ->
[(ItemStructuralFunction, ComposeLinkType)] ->
LinkTest
useBreakL x y = useBreakListsLinkTest (map (uncurry noa) x) (map (uncurry noa) y)
where
noa a b = (a, ILink b orientAttachment)
useBreakListsLinkTest :: [(ItemStructuralFunction, ItemLink)]
-> [(ItemStructuralFunction, ItemLink)] -> LinkTest
useBreakListsLinkTest ::
[(ItemStructuralFunction, ItemLink)] ->
[(ItemStructuralFunction, ItemLink)] ->
LinkTest
useBreakListsLinkTest llist rlist = LTest ltest rtest
where
ltest (_, sf, _) = do
@@ -41,40 +44,42 @@ useBreakListsLinkTest llist rlist = LTest ltest rtest
(_, linktype) <- safeHead xs
return $ LUpdate linktype (set _3 (useBreakListsLinkTest llist (tail xs))) id
itemToBreakLists
:: ComposedItem
-> ([(ItemStructuralFunction, ComposeLinkType)] , [(ItemStructuralFunction, ComposeLinkType)])
itemToBreakLists ci = case (itm ^. itType,ci ^. cItemFunction) of
-- HELD TORCH -> (getAmmoLinks itm,[])
(_,WeaponPlatformSF) ->
( getAmmoLinks itm
, [(WeaponTargetingSF,WeaponTargetingLink), (WeaponScopeSF,WeaponScopeLink)]
)
-- AMMOMAG {} -> fromMaybe ([],[]) $ do
(_,AmmoMagSF {}) -> fromMaybe ([],[]) $ do
itemToBreakLists ::
ComposedItem ->
([(ItemStructuralFunction, ComposeLinkType)], [(ItemStructuralFunction, ComposeLinkType)])
itemToBreakLists ci = case (itm ^. itType, ci ^. cItemFunction) of
(HELD TORCH,_) -> (getAmmoLinks itm,[])
(_, WeaponPlatformSF) ->
( getAmmoLinks itm
, [(WeaponTargetingSF, WeaponTargetingLink), (WeaponScopeSF, WeaponScopeLink)]
)
(_, AmmoMagSF{}) -> fromMaybe ([], []) $ do
atype <- itm ^? itUse . amagType
return
([ (AmmoModifierSF atype, AmmoModLink)
, (AmmoTargetingSF atype, AmmoTargetingLink)
, (AmmoPayloadSF atype, AmmoPayloadLink)
, (AmmoEffectSF atype, AmmoEffectLink)
, (RemoteScreenSF, RemoteScreenLink)
],[])
(_,WeaponTargetingSF) -> (getAmmoLinks itm ++ [(AugmentedHUDSF,AugmentedHUDLink)],[])
_ -> ([],[])
return
(
[ (AmmoModifierSF atype, AmmoModLink)
, (AmmoTargetingSF atype, AmmoTargetingLink)
, (AmmoPayloadSF atype, AmmoPayloadLink)
, (AmmoEffectSF atype, AmmoEffectLink)
, (RemoteScreenSF, RemoteScreenLink)
]
, []
)
(_, WeaponTargetingSF) -> (getAmmoLinks itm ++ [(AugmentedHUDSF, AugmentedHUDLink)], [])
_ -> ([], [])
where
itm = ci ^. cItem
getAmmoLinks :: Item -> [(ItemStructuralFunction, ComposeLinkType)]
getAmmoLinks itm = map
(\(i, a) -> (AmmoMagSF a,AmmoInLink i a))
(IM.toList $ itm ^. itAmmoSlots)
getAmmoLinks itm =
map
(\(i, a) -> (AmmoMagSF a, AmmoInLink i a))
(IM.toList $ itm ^. itAmmoSlots)
itemToFunction :: Item -> ItemStructuralFunction
itemToFunction itm = case itm ^. itType of
HELD TORCH -> WeaponScopeSF
HELD {} -> WeaponPlatformSF
AMMOMAG {} -> maybe UncomposableIsolateSF AmmoMagSF $ itm ^? itUse . amagType
HELD{} -> WeaponPlatformSF
AMMOMAG{} -> maybe UncomposableIsolateSF AmmoMagSF $ itm ^? itUse . amagType
ATTACH REMOTESCREEN -> RemoteScreenSF
ATTACH BULLETSYNTHESIZER -> AmmoModifierSF BulletAmmo
ATTACH ZOOMSCOPE -> WeaponScopeSF
@@ -87,7 +92,7 @@ itemToFunction itm = case itm ^. itType of
_ -> UncomposableIsolateSF
pciToCI :: PartiallyComposedItem -> ComposedItem
pciToCI (x,y,_) = CItem x y
pciToCI (x, y, _) = CItem x y
basePCI :: Item -> PartiallyComposedItem
basePCI itm = case _itType itm of
@@ -106,9 +111,11 @@ llright itm pci = case pci ^. _1 . itType of
_ -> _tryRightLink (uncurry useBreakL $ itemToBreakLists (CItem itm WeaponTargetingSF)) pci
toLasgunUpdate :: Item -> LinkUpdate
toLasgunUpdate itm = LUpdate (ILink FunctionChangeLink orientAttachment)
(\(par,_,_) -> (par,WeaponPlatformSF,uncurry useBreakL $ itemToBreakLists (CItem itm WeaponPlatformSF)))
(\(chi,_,up) -> (chi,FunctionChangeSF,up))
toLasgunUpdate itm =
LUpdate
(ILink FunctionChangeLink orientAttachment)
(\(par, _, _) -> (par, WeaponPlatformSF, uncurry useBreakL $ itemToBreakLists (CItem itm WeaponPlatformSF)))
(\(chi, _, up) -> (chi, FunctionChangeSF, up))
--itemLinkTestLeft :: Item -> PartiallyComposedItem -> Maybe LinkUpdate
--itemLinkTestLeft itm = _tryLeftLink $
@@ -197,15 +204,15 @@ invTrees' = IM.unions . map (ldtToIM getindex . fmap (^. _1)) . map (fmap (\(x,
-- returns an intmap with trees for root items, indexed by inventory position
invRootTrees :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ItemLink ComposedItem)
invRootTrees = IM.fromDistinctAscList . reverse . map (getid . fmap (\(x, y, _) -> CItem x y)) . invLDT
invRootTrees = IM.fromDistinctAscList . reverse . map (getid . fmap (\(x, y, _) -> CItem x y)) . invLDT
where
getid :: LabelDoubleTree ItemLink ComposedItem -> (Int,LabelDoubleTree ItemLink ComposedItem)
getid :: LabelDoubleTree ItemLink ComposedItem -> (Int, LabelDoubleTree ItemLink ComposedItem)
getid t = (t ^?! ldtValue . cItem . itLocation . ilInvID, t)
-- returns an intmap with indents and locations for all items
allInvLocs :: IM.IntMap Item -> IM.IntMap (Int,LocationLDT ItemLink ComposedItem)
allInvLocs :: IM.IntMap Item -> IM.IntMap (Int, LocationLDT ItemLink ComposedItem)
allInvLocs inv = foldMap (f . LocLDT TopLDT) (IM.elems (invRootTrees inv)) mempty
where
f t = cldtPropagateFold h h g 0 t id
h x _ _ _ = x + 1
g x ldt = (.) (IM.insert (ldt ^?! locLDT . ldtValue . cItem . itLocation . ilInvID) (x,ldt))
g x ldt = (.) (IM.insert (ldt ^?! locLDT . ldtValue . cItem . itLocation . ilInvID) (x, ldt))
src/Dodge/ListDisplayParams.hs
+1 -1
View File
@@ -61,7 +61,7 @@ determineInvSelCursorWidth w = case _rbOptions w of
| otherwise -> topInvW
where
hasnosubinv = case w ^? hud . hudElement . subInventory of
Just NoSubInventory -> True
Just NoSubInventory{} -> True
_ -> False
optionListDisplayParams :: ListDisplayParams
src/Dodge/Render/HUD.hs
+2 -1
View File
@@ -2,6 +2,7 @@
module Dodge.Render.HUD (
drawHUD,
selNumPos, -- this shoud probably be pushed back here
) where
import Control.Lens
@@ -70,7 +71,7 @@ drawInventory sss w cfig =
drawSubInventory :: SubInventory -> Configuration -> World -> Picture
drawSubInventory subinv cfig w = case subinv of
LockedInventory -> mempty -- topInvCursor col cursPos cfig w
NoSubInventory -> drawRBOptions cfig w
NoSubInventory{} -> drawRBOptions cfig w
ExamineInventory -> drawExamineInventory cfig w
DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w
src/Dodge/Render/List.hs
+8 -3
View File
@@ -10,6 +10,7 @@ module Dodge.Render.List (
stackPicturesAt,
toTopLeft,
listCursorChooseBorderScale,
selSecDrawCursorAt,
) where
import Dodge.SelectionSections
@@ -84,9 +85,8 @@ stackPicturesAt = stackPicturesAtOff 0
stackPicturesAtOff :: Int -> [Picture] -> Picture
stackPicturesAtOff i = mconcat . zipWith (drawListElement 10 1 0) [i, i -1 ..]
selSecDrawCursor :: Int -> ListDisplayParams -> SelectionSections a -> Picture
selSecDrawCursor xsize ldp sss = fromMaybe mempty $ do
(i, j) <- sss ^? sssExtra . sssSelPos . _Just
selSecDrawCursorAt :: (Int,Int) -> Int -> ListDisplayParams -> SelectionSections a -> Picture
selSecDrawCursorAt (i,j) xsize ldp sss = fromMaybe mempty $ do
yint <- selSecYint i j sss
xint <- sss ^? sssSections . ix i . ssIndent
si <- sss ^? sssSections . ix i . ssItems . ix j
@@ -101,6 +101,11 @@ selSecDrawCursor xsize ldp sss = fromMaybe mempty $ do
xsize
(_siHeight si)
selSecDrawCursor :: Int -> ListDisplayParams -> SelectionSections a -> Picture
selSecDrawCursor xsize ldp sss = maybe mempty
(\x -> selSecDrawCursorAt x xsize ldp sss)
(sss ^? sssExtra . sssSelPos . _Just)
-- displays a cursor that should match up to list text pictures
listCursorChooseBorderScale ::
Float ->
src/Dodge/Render/ShapePicture.hs
+50 -14
View File
@@ -2,23 +2,27 @@ module Dodge.Render.ShapePicture (
worldSPic,
) where
import Data.Strict.Tuple
import NewInt
import Dodge.Render.List
import Dodge.Render.HUD
import Dodge.ListDisplayParams
import qualified Data.Map.Strict as M
import Control.Lens
import Control.Monad (guard)
import Data.Foldable
import Data.Maybe
import Data.Strict.Tuple
import Dodge.Base
import Dodge.Creature.Picture
import Dodge.Data.Universe
import Dodge.Debug.Picture
import Dodge.Draw
import Dodge.RadarBlip
import Dodge.Render.List
import Dodge.Render.Picture
import Geometry
import qualified IntMapHelp as IM
import NewInt
import Picture
import qualified SDL
import Shape
import ShapePicture
@@ -35,12 +39,40 @@ worldSPic cfig u =
<> foldup btSPic (filtOn _btPos _buttons)
<> foldup mcSPic (filtOn _mcPos _machines)
<> aimDelaySweep w
<> drawMouseSelection w
<> drawDISelections w cfig
<> drawDIMouseOver w cfig
where
w = _uvWorld u
foldup = foldMap'
filtOn f g = IM.filter (pointIsClose . f) (g (_lWorld (_cWorld w)))
pointIsClose = cullPoint cfig w
drawMouseSelection :: World -> SPic
drawMouseSelection w = fromMaybe mempty $ do
guard (SDL.ButtonLeft `M.member` (w ^. input . mouseButtons)
&& not (SDL.ButtonRight `M.member` (w ^. input . mouseButtons))
)
p <- w ^? input . clickPos . ix SDL.ButtonLeft
return $ noShape $ color (withAlpha 0.5 white)
$ setLayer FixedCoordLayer $ polygon $ reverse $ rectVV p (w ^. input . mousePos)
drawDIMouseOver :: World -> Configuration -> SPic
drawDIMouseOver w cfig = fromMaybe mempty $ do
i <- w ^? hud . hudElement . subInventory . nsMouseOver . _Just
sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
return . noShape . setLayer FixedCoordLayer . color white $ selSecDrawCursorAt (0,i) 10 idp sss
drawDISelections :: World -> Configuration -> SPic
drawDISelections w cfig = fromMaybe mempty $ do
(i,j) <- w ^? hud . hudElement . subInventory . nsSelected . _Just
sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
tp <- selNumPos cfig idp sss 0 i
bp <- selNumPos cfig idp sss 0 j
return . noShape . setLayer FixedCoordLayer . color red $ line [tp,bp]
aimDelaySweep :: World -> SPic
aimDelaySweep w = fromMaybe mempty $ do
cr <- w ^? cWorld . lWorld . creatures . ix 0
@@ -85,8 +117,8 @@ drawCreature cr = case _crType cr of
lampCrSPic :: Float -> SPic
lampCrSPic h =
colorSH blue (upperBox Small Typical h $ rectWH 5 5)
:!: setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
colorSH blue (upperBox Small Typical h $ rectWH 5 5)
:!: setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
picAtCrPos1 :: Picture -> Creature -> SPic
--{-# INLINE picAtCrPos #-}
@@ -125,19 +157,23 @@ extraPics cfig u =
<> foldMap drawBul (_bullets lw)
<> foldMap drawBlip (_radarBlips lw)
<> _flares lw
-- <> foldMap (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams lw)
-- <> foldMap (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams lw)
-- <> foldMap (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams lw)
-- <> foldMap (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams lw)
<> foldMap (dbArg (drawLightSource . _lsPict)) (_lightSources lw)
<> testPic cfig w
<> foldMap ppDraw (_pressPlates lw)
<> viewClipBounds cfig w
<> debugDraw cfig w
<> foldMap (`_debugPic` u) (_uvDebug u)
<> setLayer FixedCoordLayer
(toTopLeft cfig . translate (1.3* halfWidth cfig) 0
. drawList
. take 50 . drop (u ^. uvDebugMessageOffset)
. map text $ foldMap (`_debugMessage` u) (_uvDebug u))
<> setLayer
FixedCoordLayer
( toTopLeft cfig . translate (1.3 * halfWidth cfig) 0
. drawList
. take 50
. drop (u ^. uvDebugMessageOffset)
. map text
$ foldMap (`_debugMessage` u) (_uvDebug u)
)
where
w = u ^. uvWorld
lw = w ^. cWorld . lWorld
@@ -151,7 +187,8 @@ ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
floorItemSPic :: FloorItem -> SPic
floorItemSPic flit =
uncurryV translateSPxy (_flItPos flit) $
rotateSP (_flItRot flit)
rotateSP
(_flItRot flit)
(itemSPic $ _flIt flit)
btSPic :: Button -> SPic
@@ -163,4 +200,3 @@ mcSPic :: Machine -> SPic
mcSPic mc =
uncurryV translateSPxy (_mcPos mc) $
rotateSP (_mcDir mc) (drawMachine mc)
src/Dodge/Terminal.hs
+1 -1
View File
@@ -222,7 +222,7 @@ disconnectTerminal tm =
exitTerminalSubInv :: World -> World
exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
Just _ -> w & hud . hudElement . subInventory .~ NoSubInventory
Just _ -> w & hud . hudElement . subInventory .~ NoSubInventory Nothing Nothing
_ -> w
damageCodeCommand :: TerminalCommand
src/Dodge/Update.hs
+1 -1
View File
@@ -288,7 +288,7 @@ checkTermDist w = fromMaybe w $ do
btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
guard $ dist btpos (_crPos $ you w) > 40
return (w & hud . hudElement . subInventory .~ NoSubInventory)
return (w & hud . hudElement . subInventory .~ NoSubInventory Nothing Nothing)
updateWheelEvents :: World -> World
src/Dodge/Update/Input/InGame.hs
+20 -14
View File
@@ -40,7 +40,8 @@ updateUseInputInGame u = case u ^. uvWorld . hud . hudElement of
u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True
CombineInventory{_ciSections = sss}
| inSubInvRegex (u ^. uvWorld) ->
u & uvWorld . hud . hudElement . subInventory . ciSections
u
& uvWorld . hud . hudElement . subInventory . ciSections
%~ doRegexInput (u ^. uvWorld . input) (-1)
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
| lbinitialpress ->
@@ -116,7 +117,7 @@ updateInitialPressInGame uv sc = case sc of
ScancodeP -> pauseGame uv
ScancodeF -> over uvWorld youDropItem uv
ScancodeM -> toggleMap uv
-- ScancodeR -> over (uvWorld . cWorld . lWorld . creatures . ix 0) crReloadToggle uv
-- ScancodeR -> over (uvWorld . cWorld . lWorld . creatures . ix 0) crReloadToggle uv
ScancodeT -> over uvWorld testEvent uv
ScancodeX -> uv & uvWorld %~ toggleTweakInv
ScancodeC -> toggleCombineInv uv
@@ -158,11 +159,11 @@ doRegexInput inp i sss
updateBackspaceRegex :: World -> World
updateBackspaceRegex w = case di ^? subInventory of
Just NoSubInventory
Just NoSubInventory{}
| secfocus (-1) 0 ->
w & hud . hudElement . diSections %~ trybackspace (-1)
& worldEventFlags . at InventoryChange ?~ ()
Just NoSubInventory
Just NoSubInventory{}
| secfocus 2 3 ->
w & hud . hudElement . diSections %~ trybackspace 2
& worldEventFlags . at InventoryChange ?~ ()
@@ -187,11 +188,11 @@ updateBackspaceRegex w = case di ^? subInventory of
updateEnterRegex :: World -> World
updateEnterRegex w = case w ^? hud . hudElement . subInventory of
Just NoSubInventory
Just NoSubInventory{}
| secfocus (-1) 0 ->
w & hud . hudElement . diSections . sssExtra . sssSelPos ?~ (-1, 0)
& hud . hudElement . diSections %~ enterregex (-1)
Just NoSubInventory
Just NoSubInventory{}
| secfocus 2 3 ->
w & hud . hudElement . diSections . sssExtra . sssSelPos ?~ (2, 0)
& hud . hudElement . diSections %~ enterregex 2
@@ -216,7 +217,7 @@ pauseGame u = u & uvScreenLayers .~ [pauseMenu u]
spaceAction :: World -> World
spaceAction w = case w ^. hud . hudElement of
DisplayCarte -> w & hud . carteCenter .~ theLoc
DisplayInventory{_subInventory = NoSubInventory} -> case selectedCloseObject w of
DisplayInventory{_subInventory = NoSubInventory{}} -> case selectedCloseObject w of
Just (Left flit) ->
pickUpItem 0 flit w
& worldEventFlags . at InventoryChange ?~ ()
@@ -225,9 +226,9 @@ spaceAction w = case w ^. hud . hudElement of
& worldEventFlags . at InventoryChange ?~ ()
_ -> w
DisplayInventory{_subInventory = DisplayTerminal{}} ->
w & hud . hudElement . subInventory .~ NoSubInventory
w & hud . hudElement . subInventory .~ NoSubInventory Nothing Nothing
& worldEventFlags . at InventoryChange ?~ ()
_ -> w & hud . hudElement . subInventory .~ NoSubInventory
_ -> w & hud . hudElement . subInventory .~ NoSubInventory Nothing Nothing
where
theLoc =
doWorldPos
@@ -238,25 +239,30 @@ toggleMap :: Universe -> Universe
toggleMap u = case u ^. uvWorld . hud . hudElement of
DisplayCarte ->
u & uvWorld . hud . hudElement
.~ DisplayInventory{_subInventory = NoSubInventory, _diSections = defaultInvSections}
.~ DisplayInventory
{ _subInventory = NoSubInventory Nothing Nothing
, _diSections = defaultInvSections
}
_ -> u & uvWorld . hud . hudElement .~ DisplayCarte
toggleTweakInv :: World -> World
toggleTweakInv w = case w ^? hud . hudElement . subInventory of
Just ExamineInventory{} -> w & thepointer .~ NoSubInventory
Just ExamineInventory{} -> w & thepointer .~ NoSubInventory Nothing Nothing
_ -> w & thepointer .~ ExamineInventory -- mi
where
thepointer = hud . hudElement . subInventory
-- mi = 0 <$ (yourSelectedItem w >>= (^? itTweaks . tweakParams . ix 0))
tryCombine :: SelectionSections CombinableItem -> World -> World
tryCombine sss w = fromMaybe w $ do
(i, j) <- sss ^? sssExtra . sssSelPos . _Just
CombinableItem is it _ <- sss ^? sssSections . ix i . ssItems . ix j . siPayload
return $ snd (createItemYou it (foldr (destroyInvItem 0) w (sort is)))
& cWorld . lWorld . creatures . ix 0 . crHammerPosition .~ HammerDown
return $
snd (createItemYou it (foldr (destroyInvItem 0) w (sort is)))
& cWorld . lWorld . creatures . ix 0 . crHammerPosition .~ HammerDown
maybeExitCombine :: Universe -> Universe
maybeExitCombine u
| ButtonRight `M.member` (u ^. uvWorld . input . mouseButtons) = u
| otherwise = u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
| otherwise = u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory Nothing Nothing
src/Dodge/Update/Scroll.hs
+1 -1
View File
@@ -22,7 +22,7 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
DisplayCarte
| bdown ButtonRight -> w & hud . carteZoom %~ min 0.75 . max 0.05 . ((1 + y * 0.1) *)
| otherwise -> w & cWorld . lWorld . selLocation %~ (`mod` numLocs) . (+ yi)
DisplayInventory{_subInventory = NoSubInventory}
DisplayInventory{_subInventory = NoSubInventory{}}
-- functions that modify the inventory should be centralised so that
-- this lock can be sensibly applied, perhaps
| w ^?! cWorld . lWorld . creatures . ix 0 . crInvLock -> w
src/Geometry/Polygon.hs
+8
View File
@@ -35,6 +35,14 @@ rectXH x h = rectNSWE h (- h) 0 x
rectXY :: Float -> Float -> [Point2]
rectXY x y = rectNSWE y 0 0 x
rectVV :: Point2 -> Point2 -> [Point2]
rectVV (V2 x y) (V2 a b) = rectNSWE n s w e
where
(e,w) | x > a = (x,a)
| otherwise = (a,x)
(n,s) | y > b = (y,b)
| otherwise = (b,y)
square :: Float -> [Point2]
square n = rectWH n n
tags
+179 -172
View File
File diff suppressed because it is too large Load Diff