From fc0fd5fa37f6bff99b6d33c08d903a46db30916c Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 23 Feb 2023 11:46:45 +0000 Subject: [PATCH] Introduce idea of world event flags --- data/texture/charMap.png | Bin 3456 -> 3431 bytes src/Dodge/Creature/Impulse/UseItem.hs | 1 + src/Dodge/Data/World.hs | 6 ++ src/Dodge/Default/World.hs | 1 + src/Dodge/DisplayInventory.hs | 23 ++++---- src/Dodge/Inventory.hs | 80 +++++++++++++++----------- src/Dodge/Update.hs | 36 +++++++----- 7 files changed, 87 insertions(+), 60 deletions(-) diff --git a/data/texture/charMap.png b/data/texture/charMap.png index e646154b7e75d11a7f605f3e001e4f93d869ad49..fabef9ac6236a3c783bb275a749aaf915cfd1c44 100644 GIT binary patch delta 2956 zcmV;73v={<8|NC3B!3NhR9JLUVRs;Ka&Km7Y-J#Hd2nSQWq4_3004N}tygW5BP$O4 z&nfl@NJ2NH`wEEQg-+B%I!GE60ujtqIJ@`D{GvpU6`x_%X zeES3G_uxMee}CCnK0V@}e=vVY{W+ZX`<&(H>{oQ7bs*Z`8CA;%I(H2wPQ)h9vX0B} zRy^Bt1un0nCdgSe>%^55#9-wVYP4w3q5a&G5-v90Y`8Ng%QNO;9Gr4_YWJeUCLv24 zoF(r9LYwfXFZApi&wfdcofly$6O0j-{N+{t?#JJ`%6~a|A)*J+_Fx6S_+~ELxXj&8 z%mN{F-n{7p@W=J0zkW$9q$-T*1G6K*QRmCVRQi!y^6)H}r?|hhpxAmFfIrw<;SAEg zQSBs3ovJY#5pZ-6G~hW);|T^xl^2}kCepbWJKw#r#^{;L%AM~pvq ziu|$W$bX@sqD@u1ntIXD(WSSpy?5(ZBo+rIOCJGH>-cTeuFi7v&IiocYmIJvWC%O_F;mqoap5YjBz6{ZkGWh zG+)lDQ)_&gyPVayDyIx5^>R}dUB*CR+r)b4le-_x{VU#z`oH3h|B1PBsr!F0S3upL zdHaU7b^BaCjJ>MxVp;{&x8`EY!rIs1n+rM+o#X?zSE|eG=(0LnT}J}8aYU>Rg_z6gTitGF}fVZdgf5W)u$Oy?YJ+B)2NIcxcK7Zv~Pjs4mj zs$<95JSH-Rqc&*n3O$C^90bw3}67)|TGmsr<2OBBJPkcyDJ!s~kl#cU+CoR9CcHl00mF!)2A8cqYf`8m% zWcJ;5`atk0w)UQBXKDavsAa<{@D^ZvD|Qw^%#2ibxE7vByp03^QmbUm1MlmKL@nD! z?HmU4_|AQ)fSFXkyx2e+JEy&HiY_?ofr^Dt@vU%+-XI1?qT&D}$O$>w1AQ=ktg$-9 z%(T#rb0NwRrhE6sKyAL4)q z)a68n7=106kJ+*yyC#lB7hK5~49M36fFe4F?I<0N57N&SdKWYC?VLXm_m;*b7v~ z9_;`)xO)Fy`_eUl^$T^|CZNSZD*?(FE1GzRXmyMtvWkrA?7$HVw#C};Kt?92d?)_; z>hQ#;X(DG%vE6S4RiKwLZ-3E)nZ+m;G9~9 z6Ft(5;b^oqjUXlI9r6+=4~XSj_vA7@w!AsviUh^6D$mk$Qv}tY?LI&O{N6uipb(!q zI1s+3+zHoC{eD*YGVPmvzHalj@)vW;Z}@`tb7%mQp7W}6r-N2GtsMF1xrapK~#9!?VU+( zkv|2g{r4Y*eUDuzUU4)TzCZxh6}Y+0lzk)l-}9{>OV000000B5rA`+kQy zjOsBv4gdh4jxCvSq*4|D?qvg_^I!Tt0Cclu9Q1A5HtXE%x_#gG@AIQ`KPvWeesn+Y z9)F`cM&2P>_K5@0sEudsr?i_=-ja`{H$&wW>t8Le)_;|3s%1R+tZ3g%|5nQ$uglc` zSbk=!R^0!n=bpSr*GKAqw){HEN99vJUuj=OKP)*%`n%H4Gq$N(w%Zaxm2I8{C}1lt1E;Z?W44Rw0)!JEAp?_KXOcMZ`F3G{WWS2JLQ)tuh{2E z|F6`~sw7ULX^NM#10=)A(q9*`wCSRS#&0Fz0I)9V1 zNapdlmkr>RpVhMyEA!!wgHWW7-nAonMOI_F+s)FSQT>kBjLv)ImG{V=S5_Fm>on5u z$m(LITva}^_FdVJuIQr`JwMu)k*rp?*^}G8V!tD8o3*dAzMIjj?7gh_^z3;xgQ{|W z#pbED&9lMkSmwP)CPQI%Z|}U?et&BDqn>1*AJKtmhL4xQqh$P8L)^K`C0JWDzChEw@rx5SF7`fPJNB) z*Q-ugpV+QE--FKfJtF`Vo#a>!LVtJv>ulRA0zTDMUiBTbj%0Op+naQ*){hSTw^sDLcI^uA zMB7EpqU#R8t?tW}0OVcvG3eBf)y{Lb{X8=O*dgPt49?jzx}0(=_|`GT0004iB@T?b z%5ofFA}Lx|ML(-6P*+ZTuL}0eoP*2+F?!xQmUW_5If&6rk&08$@qgY|wBHjrYl60_ z{ndU~?Y}E+;7G@3tG#MAPM3YX>jYj|0Y0Pebj?jN!Q0OM^N!A0X8_Rp{Aoq|s`ly* zvc>TS0F}?E;jOGLz5ex5{<4PcD#ye61mg9$mzrFuzg7OK)wWT+R&VfRZIq?#l&@?8 zHgg0jKjq_nQ&7iA+RZ6&c?th@l2=JNkc@^W34^XN@CI(~sz; zd(|=EjC!t+Ys8tntAlq&8&)=I&OYzkKFsEy*7(S(I{-Y5TYLiG?Ew(k)U9JfrO3~z zH4Q#r+qV5%xpJqr|ESDt@~*B5RZ{>noA%98x~)A1X7!71YJV7ckIXe$Ij?x;O#WH< z%-*9C6s&&Z>FIw|KhzZG&P_2p_sCFI+D2JftNMSmZ>+MjUHf2k*RR8wRI?^B{a-zw zZQq&xcJ=>`pKa|LW3v4xBA-h8DRa2Y^S!K{$WKs5Wjgznr0zfgS#<#LYq{f3&#f Cl<)HZ delta 2979 zcmV;U3taT)8h{&+B!3QiR9JLUVRs;Ka&Km7Y-J#Hd2nSQWq4_3004N}tyXK&QB!MK30|KgYgB(8%3@B%2 z#>4y^B-;7aPURV>t=EG#x6h#te%<5gctd$ku{-qpAm@Mj+)xZC&5B;ayo4m*tG^HI#NDR*+o^F#qkpPe{%liQMGeFa{(t(y{F3^0InTNG^u5<>b-gGM)kje|y`giyLC1l$$^A@m7|x1kyGO&} zx#s{mGe;gcf*LVc*@+5G>a=Oydr%<6!ix=e=3u#PF2;>R4o~GAwArM|6bD(sD}lNq z{2mM4dE1>Y$T9OIbY;R|bSVF)BmLXU-#OCWaUh}#Xn(m_Auc}3MHq*Ax5PSZOP?X(68eDctNuH41jnrcSSHHU?3|=C8cc4 zMg$xk1a(BtQh0y?s+A{#8ix;o1ZtmW^H*NwCtWBFWZ>{ytsbiv! zu{!#9vqevC67Tmn~my^$o3U z*=5(Q+qUnv`#Wn7t3MpS!5TfR@n!1tvv=0ent#mRhM;37^>7BpxDXh(!vF-$hqLTd z3LoYUXSp4htBfG);U-NwjDf`~C*Xhm^#xs4vxpo6{A{M)0#2^(9<$(pvtUOE2 zvwx2|XQV<40Ie-bL~Bx*LsxTx?R9qx?mJIy3$W3szSMUBY%N1$g>EKyrIssDPbym=30n(}szTn`0Y@K; z%VZ!~)}}JoQIRuJy9Nxlu+MneI=EdkR)4bA!|Sl9!+iuOi0rbI9ddyz0}P<7SS7Hf z8LXiB%m(*cR>q)N;qY+CVYLUUcRwjHxIhHD7C9HAU1Xzz16zC}SRFp*wRi(vY!09U zD81;2zL0ARHN!g83q)?T1cL${xk7IiP(&@Kqy(zIA)3Nqq84P;9*}!?umjdMHh($| zT=LMx0M+u`HjV|Xsph-TB@V?zkvyXTfgHduHz+TIa208LwB&QN*p@}sE(H|AW@)!d z76Won)WuQDf|#J8Xav0$$aKDN;_9<5Sb?O{wcu~#+Tbe^t7O#Vm96Z3wkM@bWIvJx zd8S)vRcm~5%p*x&jiO9tbLle=P%BO0U$CBu_YgyrQyvxs0UdBw2p$G=1utEFC=wM0kxUfw zT{0-2APnn;WZ^bI2V$Pf?m|b!s$odhw8Vt*?55fGDdxHfR+La+F(uMrV}CZ3GpIJd z#El)y$Q#0jpUg=EgGX%aAs87}hQq%A79@mJMT)SszzP-;zhG|x%%Q|4We+yRv$pD^ z0&{#T!~v+sWsX|BXnD3Y#X`06%Iw`*y`ntYQ0&4Hk$&4#v$RGpdMfBzQma+iPQ|c7;gg z_5R~ETA$bSWX+cz>3f&&-+vqa#}S@B>33qF=;l)b+nBm2jymA%NF!t0l6J&|>acwR zgaZj4NP(^c)$gha^`oV~0h=30A<`s1va>n{!U2C45hfbze`%lq00m=7L_t(|+U=d) zZsZ^gMw_aa`~J_l53o}9s?rnz{`><;I_KO}oeT-sV2p8?j}HI<000000DzsG=Xu_x z9S(oLcHJs>^@QTB*K3*4*->4|B?RG`&U0-`QI}RR*tbqIj?*a`FrK-y`Is3w*H>aRC%kmOC7IXdswNz zNO{FRd&YmJezQ6&`tj;ZX^YagthptdDX_a-^_&(hzj}8ytJ`-90=#oOv-2DPfQNst zO2cODc(sekQ8cstT-}Ktl^@l!l2K;EjtRxP+cA@ovYV&q%d;C(9o?SwpI-gi@AR%) zh%XzuDh}vl>W4OEM2jalIiDdW>rsDSJ# z)=tZwXEUfW_g8G5YTL3IfNDD;847=+dt294`KjgGeiC`Urw@2De5?!}CF5sSzW4mA z?Hm~b0B~6Vpj|-C9E;YVzD^$MYX%+%ZnaVF1vsn#NMzBTZAWDBAFZR;iL}z8SElG& z0fDS+vbs^*qAVn=J}`1>yt@-CQi7}WZ;jEXI%t_7KvsWBKrNc0?QM59ecXQE;1aL*QC>V|=`08 z+9r7X)vW)Z^v!I5cJ}&gJLaDf3X4ij}#owrY(Q^-~9GqPNAg_}%TOd@Ay-L|$5%9_G@~Ul& zE+n(N+m;<#-9IY&|IGGTa;*yRc;%vI(NzcFR*&UO0P-&97*zI;)r;q9`?)g!SfOKe z1F7N}89!j=UslX906+j>$pS`Qoc9*;JqN9~u&y%XQR93^<9kH}-s68jcn(ZboN?v) z?6c@1YSjYKo5G)26jZeP3i&;OT@KnR`K#kDJAPN%z+N98?e?nKI92n_T^)F32YAQW zshYd00;*B{zT@JoG5|Px{b_}KReN;@-Lmip0F_U#;mzzWz5caQ{<4N`w;`PE7OQoN z$hS?ki@uMxa>vMf=$wBw;YSb4QBTTO4gni21eAliEFDy(0!NFKKgb*kc!&PGLx#}ka@<;})*~SZ4ru4|U6C0VqFHSUmZB9mnx+<<6Zd|6YHYk@K$Z3T0COBZu~l z^f%gJpViNMsG+AFk?&LoaVq*l>q>ZJpCI0e!mUy&L`QQ_k;De_{loTWSr4| z^8TfDPsTm~tbmjy9HGyT@v9(zj^p@?lmGzWw=C93*ZwJ=YzD)-^&$EXlQ9h+82|uO Z@E?v@RiNq5p`ri)002ovPDHLkV1kQm+R^|3 diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index 6ece4c7fc..270b383c5 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -26,6 +26,7 @@ useItem cr' w = fromMaybe (f w) $ do itRef <- cr ^? crManipulation . manObject . inInventory . ispItem it <- cr ^? crInv . ix itRef return $ itemEffect cr it w + & worldEventFlags . at InventoryChange ?~ () where f = cWorld . lWorld . creatures . ix (_crID cr') . crHammerPosition .~ HammerDown diff --git a/src/Dodge/Data/World.hs b/src/Dodge/Data/World.hs index 9a2147057..857c6017d 100644 --- a/src/Dodge/Data/World.hs +++ b/src/Dodge/Data/World.hs @@ -13,6 +13,7 @@ module Dodge.Data.World ( module Dodge.Data.Input, ) where +import Data.Set (Set) import Dodge.Data.SaveSlot import Control.Lens import qualified Data.Map.Strict as M @@ -24,6 +25,10 @@ import Dodge.Data.SoundOrigin import Sound.Data import System.Random +data WorldEventFlag = InventoryChange + | CombineInventoryChange + deriving (Eq,Ord,Enum,Bounded) + data World = World { _cWorld :: CWorld , _randGen :: StdGen @@ -33,6 +38,7 @@ data World = World , _testFloat :: Float , _rbOptions :: RightButtonOptions , _hud :: HUD + , _worldEventFlags :: Set WorldEventFlag } -- deriving (Eq, Ord, Show, Read) --Generic, Flat) diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 8d75e574c..a4fb1c75a 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -40,6 +40,7 @@ defaultWorld = , _testFloat = 0 , _rbOptions = NoRightButtonOptions , _hud = defaultHUD + , _worldEventFlags = mempty } defaultCWGen :: CWGen diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index 0dd209990..bb80ac9e7 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/src/Dodge/DisplayInventory.hs @@ -2,8 +2,9 @@ module Dodge.DisplayInventory ( toggleCombineInv, - updatePositionHUD, updateInventorySectionItems, + updateInventoryPositioning, + updateCombinePositioning, ) where import Dodge.ListDisplayParams @@ -25,21 +26,17 @@ import LensHelp import Picture.Base import Regex --- this should ONLY change the shownitems -updatePositionHUD :: Universe -> Universe -updatePositionHUD u = case u ^? uvWorld . hud . hudElement . subInventory of - Just NoSubInventory -> u & updateDisplayInventory - Just CombineInventory {} -> u & uvWorld . hud . hudElement . subInventory . ciSections - %~ updateCombineInventory (_uvWorld u) (_uvConfig u) - _ -> u - toggleCombineInv :: Universe -> Universe toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of Just CombineInventory{} -> uv & uvWorld . hud . hudElement . subInventory .~ NoSubInventory _ -> uv & uvWorld %~ enterCombineInv (uv ^. uvConfig) -updateCombineInventory :: World -> Configuration -> SelectionSections CombinableItem -> SelectionSections CombinableItem -updateCombineInventory w cfig sss = +updateCombinePositioning :: Universe -> Universe +updateCombinePositioning u = u & uvWorld . hud . hudElement . subInventory . ciSections + %~ updateCombineSections (_uvWorld u) (_uvConfig u) + +updateCombineSections :: World -> Configuration -> SelectionSections CombinableItem -> SelectionSections CombinableItem +updateCombineSections w cfig sss = sss & sssSections %~ updateSectionsPositioning mselpos @@ -83,8 +80,8 @@ orRegex f x str = case words str of [] -> True xs -> any (f x) xs -updateDisplayInventory :: Universe -> Universe -updateDisplayInventory u = u & uvWorld . hud . hudElement . diSections +updateInventoryPositioning :: Universe -> Universe +updateInventoryPositioning u = u & uvWorld . hud . hudElement . diSections %~ updateDisplaySections (_uvWorld u) (_uvConfig u) updateDisplaySections :: World -> Configuration -> SelectionSections () -> SelectionSections () diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index dff86db15..8760c253c 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -22,22 +22,22 @@ module Dodge.Inventory ( setInvPosFromSS, ) where -import Dodge.DisplayInventory -import Dodge.SelectionSections -import Control.Applicative -import Dodge.Data.SelectionList import Color +import Control.Applicative import qualified Data.Map.Strict as M import Data.Maybe import Dodge.Base import Dodge.Data.Config +import Dodge.Data.SelectionList import Dodge.Data.World +import Dodge.DisplayInventory import Dodge.Euse import Dodge.Inventory.CheckSlots import Dodge.Inventory.CloseObject import Dodge.Inventory.Color import Dodge.ItEffect import Dodge.Reloading +import Dodge.SelectionSections import Geometry import qualified IntMapHelp as IM import LensHelp @@ -45,6 +45,7 @@ import ListHelp import Padding -- TODO check what happens to selection index when dropping non-selected items + -- | after this the item at the inventory position will no longer exist rmInvItem :: -- | Creature id @@ -55,6 +56,7 @@ rmInvItem :: World rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount of Just x | x > 1 -> w & pointcid . crInv . ix invid . itUse . useAmount -~ 1 + & worldEventFlags . at InventoryChange ?~ () _ -> w & pointcid %~ crCancelReloading @@ -66,16 +68,16 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount & pointcid . crInvEquipped %~ IM.delete invid & pointcid . crInvEquipped %~ IM.mapKeys g & updateselection + & worldEventFlags . at InventoryChange ?~ () where - getcid = cWorld . lWorld . creatures . ix cid pointcid = cWorld . lWorld . creatures . ix cid updateselection - | cid == 0 && cr ^? crManipulation . manObject . inInventory . ispItem == Just invid - = scrollAugInvSel (-1) . scrollAugInvSel 1 . updateInventorySectionItems - | otherwise - = pointcid . crManipulation . manObject . inInventory . ispItem %~ g + | cid == 0 && cr ^? crManipulation . manObject . inInventory . ispItem == Just invid = + scrollAugInvSel (-1) . scrollAugInvSel 1 . updateInventorySectionItems + | otherwise = + pointcid . crManipulation . manObject . inInventory . ispItem %~ g cr = w ^?! cWorld . lWorld . creatures . ix cid itm = _crInv cr IM.! invid @@ -111,13 +113,14 @@ rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crMan Nothing -> w selNumPos :: ManipulatedObject -> World -> Maybe Int -selNumPos mo w = w ^? hud . hudElement . diSections >>= - case mo of - InInventory SortInventory -> selSecSelPos (-1) 0 - InInventory (SelItem i _) -> selSecSelPos 0 i - SelNothing -> selSecSelPos 1 0 - InNearby SortNearby -> selSecSelPos 2 0 - InNearby (SelCloseObject i) -> selSecSelPos 3 i +selNumPos mo w = + w ^? hud . hudElement . diSections + >>= case mo of + InInventory SortInventory -> selSecSelPos (-1) 0 + InInventory (SelItem i _) -> selSecSelPos 0 i + SelNothing -> selSecSelPos 1 0 + InNearby SortNearby -> selSecSelPos 2 0 + InNearby (SelCloseObject i) -> selSecSelPos 3 i -- there are still more ListDisplayParams to integrate here selNumTextEndPos :: Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Maybe Point2 @@ -130,8 +133,13 @@ selNumTextEndPos cfig ldp sss i j = do hh = halfHeight cfig hw = halfWidth cfig -selNumEndMidHeight :: Configuration -> ListDisplayParams -> SelectionSections a -> Int - -> Int -> Maybe Point2 +selNumEndMidHeight :: + Configuration -> + ListDisplayParams -> + SelectionSections a -> + Int -> + Int -> + Maybe Point2 selNumEndMidHeight cfig ldp sss i j = do ipos <- selSecSelPos i j sss size <- selSecSelSize i j sss @@ -165,12 +173,12 @@ updateCloseObjects w = & updatecursorposifnecessary where newcloseobjects = unionBy closeObjEq oldCloseFiltered currentClose - updatecursorposifnecessary - = case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject. inNearby . ispCloseObject of - Just i + updatecursorposifnecessary = + case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject of + Just i | i >= length newcloseobjects -> scrollAugInvSel 1 - | isNothing (w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems . ix i) - -> scrollAugInvSel (-1) + | isNothing (w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems . ix i) -> + scrollAugInvSel (-1) _ -> id filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w ypos = _crPos $ you w @@ -321,17 +329,21 @@ closeObjScrollDir x changeSwapInvSel :: Int -> World -> World changeSwapInvSel k w = case you w ^? crManipulation . manObject of - Just (InInventory (SelItem i _)) -> w & cWorld . lWorld . creatures . ix 0 %~ updatecreature i - Just (InNearby (SelCloseObject i)) -> w - & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject + Just (InInventory (SelItem i _)) -> + w & cWorld . lWorld . creatures . ix 0 %~ updatecreature i + & worldEventFlags . at InventoryChange ?~ () + Just (InNearby (SelCloseObject i)) -> + w + & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject .~ ((i - k) `mod` numCO) & hud . closeObjects %~ swapIndices i ((i - k) `mod` numCO) + & worldEventFlags . at InventoryChange ?~ () _ -> w where updatecreature i = (crInv %~ IM.safeSwapKeys (i `mod` n) (swapi i)) . (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel i) - . (crManipulation . manObject . inInventory . ispItem %~ (`mod` n) . subtract k) + . (crManipulation . manObject . inInventory . ispItem %~ (`mod` n) . subtract k) . (crInvEquipped %~ IM.safeSwapKeys i (swapi i)) . swapSite i (swapi i) . swapSite (swapi i) i @@ -352,15 +364,17 @@ scrollAugInvSel yi w | yi == 0 = w | otherwise = w & hud . hudElement . diSections %~ scrollSelectionSections yi + & worldEventFlags . at InventoryChange ?~ () & setInvPosFromSS setInvPosFromSS :: World -> World -setInvPosFromSS w = w - & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel +setInvPosFromSS w = + w + & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel where thesel = fromMaybe SelNothing $ do sss <- w ^? hud . hudElement . diSections - (i,j) <- sss ^? sssExtra . sssSelPos . _Just + (i, j) <- sss ^? sssExtra . sssSelPos . _Just case i of (-1) -> Just $ InInventory SortInventory 0 -> Just $ InInventory (SelItem j NoInvSelAction) @@ -368,10 +382,10 @@ setInvPosFromSS w = w 2 -> Just $ InNearby SortNearby 3 -> Just $ InNearby $ SelCloseObject j _ -> error "selection out of bounds" - selectedCloseObject :: World -> Maybe (Either FloorItem Button) selectedCloseObject w = do - i <- you w ^? crManipulation . manObject . inNearby . ispCloseObject - <|> fmap fst (IM.lookupMin =<< w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems) + i <- + you w ^? crManipulation . manObject . inNearby . ispCloseObject + <|> fmap fst (IM.lookupMin =<< w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems) w ^? hud . closeObjects . ix i diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index e7c179f46..de47ca501 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -7,8 +7,7 @@ Description : Simulation update module Dodge.Update (updateUniverse) where --import Dodge.InputFocus -import Dodge.DisplayInventory -import Dodge.ScrollValue + import Color import Control.Applicative import Data.List @@ -21,6 +20,7 @@ import Dodge.CrGroupUpdate import Dodge.Creature.Update --import Dodge.Data.SelectionList import Dodge.Data.Universe +import Dodge.DisplayInventory import Dodge.Distortion import Dodge.DrWdWd import Dodge.EnergyBall @@ -43,6 +43,7 @@ import Dodge.Projectile.Update import Dodge.Prop.Update import Dodge.RadarBlip import Dodge.RadarSweep +import Dodge.ScrollValue import Dodge.Shockwave.Update import Dodge.SoundLogic import Dodge.Spark @@ -69,10 +70,10 @@ updateUniverse :: Universe -> Universe updateUniverse u = updateUniverseLast . advanceScrollAmount + . updateWorldEventFlags . maybeOpenTerminal . over (uvWorld . input . textInput) (const mempty) . updateUniverseMid - . updatePositionHUD . updateUseInput . over uvWorld (updateCamera cfig) . over (uvWorld . input) updateScrollTestValue @@ -81,6 +82,17 @@ updateUniverse u = where cfig = u ^. uvConfig +updateWorldEventFlags :: Universe -> Universe +updateWorldEventFlags u = + (uvWorld . worldEventFlags .~ mempty) + . updateInventoryPositioning + $ foldr updateWorldEventFlag u (u ^. uvWorld . worldEventFlags) + +updateWorldEventFlag :: WorldEventFlag -> Universe -> Universe +updateWorldEventFlag wef = case wef of + InventoryChange -> id -- TODO determine more precisely when the inventory does change + CombineInventoryChange -> updateCombinePositioning + maybeOpenTerminal :: Universe -> Universe maybeOpenTerminal u = case u ^. uvWorld . input . pressedKeys . at ScancodeSemicolon of Just InitialPress -> gotoTerminal u @@ -91,11 +103,6 @@ gotoTerminal w = case _uvScreenLayers w of (InputScreen{} : _) -> w _ -> w & uvScreenLayers .:~ InputScreen mempty "Enter command" - - - - - updateUniverseLast :: Universe -> Universe updateUniverseLast = over uvWorld (input . mouseButtons . each .~ True) -- to determine if the mouse button is held @@ -248,13 +255,12 @@ functionalUpdate w = -- where -- y = w ^. input . scrollAmount updateWheelEvents :: World -> World -updateWheelEvents w +updateWheelEvents w | yi == 0 = w | otherwise = updateWheelEvent yi w where yi = w ^. input . scrollAmount - advanceScrollAmount :: Universe -> Universe advanceScrollAmount u = u @@ -267,10 +273,11 @@ updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. lWorld --updatePastWorlds w = w & pastWorlds .~ [] doWorldEvents :: World -> World -doWorldEvents w = foldl' - (flip doWdWd) - (w & cWorld . lWorld . worldEvents .~ []) - (w ^. cWorld . lWorld . worldEvents) +doWorldEvents w = + foldl' + (flip doWdWd) + (w & cWorld . lWorld . worldEvents .~ []) + (w ^. cWorld . lWorld . worldEvents) updateLasers :: World -> World updateLasers w = @@ -565,6 +572,7 @@ updateSeenWalls w = foldl' markWallSeen w (map (_wlID . snd) $ allVisibleWalls w markWallSeen :: World -> Int -> World markWallSeen w i = w & cWorld . seenWalls . at i ?~ () + --markWallSeen !w !i = w & cWorld . lWorld . walls %~ IM.adjust markSeen i -- in the past there might have been a space leak, which the following was meant -- to fix