Add files
This commit is contained in:
+1
-1
@@ -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
|
||||
|
||||
@@ -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"))
|
||||
|
||||
@@ -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]}
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user