Add files

This commit is contained in:
2021-11-28 11:45:53 +00:00
parent d6fb6adc66
commit 2fd2929bdf
6 changed files with 27 additions and 10 deletions
+1 -1
View File
@@ -105,7 +105,7 @@ data World = World
, _carteRot :: !Float
, _lightSources :: !(IM.IntMap LightSource)
, _tempLightSources :: ![TempLightSource]
, _closeActiveObjects :: [Either FloorItem Button]
, _closeObjects :: [Either FloorItem Button]
, _seenLocations :: IM.IntMap (World -> Point2,String)
, _selLocation :: Int
, _sideEffects :: Universe -> IO Universe
+1 -1
View File
@@ -67,7 +67,7 @@ defaultWorld = World
, _carteRot = 0
, _lightSources = IM.empty
, _tempLightSources = [youLight]
, _closeActiveObjects = []
, _closeObjects = []
, _seenLocations = IM.fromList
[(0, (_crPos . you, "CURRENT POSITION"))
,(1, (const (V2 0 0) , "START POSITION"))
+2 -2
View File
@@ -68,13 +68,13 @@ gotoTerminal w = case _menuLayers w of
spaceAction :: World -> World
spaceAction w = if _carteDisplay w
then w & carteCenter .~ theLoc
else case (_inventoryMode w, listToMaybe $ _closeActiveObjects w) of
else case (_inventoryMode w, listToMaybe $ _closeObjects w) of
(TopInventory,Just (Left flit)) -> pickUpItem 0 flit w
(TopInventory,Just (Right but)) -> updateTopCloseObject (_btID but) $ _btEvent but but w
_ -> w & inventoryMode .~ TopInventory
where
theLoc = fst (_seenLocations w IM.! _selLocation w) w
updateTopCloseObject i w' = w' & closeActiveObjects %~ ( Right (_buttons w' IM.! i) : ) . tail
updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail
pauseGame :: World -> World
pauseGame w = w {_menuLayers = [pauseMenu]}
+4 -4
View File
@@ -69,7 +69,7 @@ rmSelectedInvItem
rmSelectedInvItem cid w = rmInvItem cid (_crInvSel (_creatures w IM.! cid)) w
updateCloseObjects :: World -> World
updateCloseObjects w = w & closeActiveObjects .~ unionBy eTest oldCloseFiltered currentClose
updateCloseObjects w = w & closeObjects .~ unionBy eTest oldCloseFiltered currentClose
where
filt = filter $ \obj -> dist ypos (pos obj) < 40 && hasLOS ypos (pos obj) w
ypos = _crPos $ you w
@@ -84,13 +84,13 @@ updateCloseObjects w = w & closeActiveObjects .~ unionBy eTest oldCloseFiltered
eTest (Left x) (Left y) = _flItID x == _flItID y
eTest _ _ = False
currentClose = filt objs
oldClose = filt $ _closeActiveObjects w
oldClose = filt $ _closeObjects w
oldCloseFiltered = intersectBy eTest oldClose currentClose
closeObjScrollDir :: Float -> World -> World
closeObjScrollDir x
| x > 0 = over closeActiveObjects rotU
| x < 0 = over closeActiveObjects rotD
| x > 0 = over closeObjects rotU
| x < 0 = over closeObjects rotD
| otherwise = id
swapInvDir :: Int -> World -> World
+17
View File
@@ -0,0 +1,17 @@
module Dodge.PreloadData where
import Dodge.Data
--import Dodge.Base
--import Dodge.Base.Window
--import Dodge.Creature.Action
--import Dodge.SoundLogic
--import Dodge.Inventory
--import Geometry
import Preload.Update
--import qualified IntMapHelp as IM
import Control.Lens
sideEffectUpdatePreload :: Int -> Int -> Int -> (Universe -> IO Universe) -> Universe -> IO Universe
sideEffectUpdatePreload divRes x y f u = do
pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData (_uvWorld u))
f $ u & uvWorld . preloadData .~ pdata
+2 -2
View File
@@ -156,7 +156,7 @@ mapWall w wl =
closeObjectTexts :: World -> Picture
closeObjectTexts w = pictures $
renderListAt pushout (negate 20 * fromIntegral invPos)
w (map colAndText $ _closeActiveObjects w)
w (map colAndText $ _closeObjects w)
: maybeToList maybeLine
where
colAndText (Left x) = ( _itName $ _flIt x, _itInvColor $ _flIt x)
@@ -164,7 +164,7 @@ closeObjectTexts w = pictures $
youSel = _crInvSel $ you w
freeSlot = mayIt >>= \it -> checkInvSlotsYou (_flIt it) w
invPos = fromMaybe youSel freeSlot
mayObj = listToMaybe $ _closeActiveObjects w
mayObj = listToMaybe $ _closeObjects w
mayIt = mayObj >>= maybeLeft
maybeLeft (Left x) = Just x
maybeLeft _ = Nothing