This commit is contained in:
2022-04-11 14:14:42 +01:00
parent 059321b33b
commit 3566cec00d
4 changed files with 15 additions and 32 deletions
+2 -6
View File
@@ -104,17 +104,13 @@ allWalls :: World -> IM.IntMap Wall
allWalls = IM.unions . concatMap IM.elems . IM.elems . _znObjects . _wallsZone allWalls = IM.unions . concatMap IM.elems . IM.elems . _znObjects . _wallsZone
creatureNearPoint :: Point2 -> World -> Maybe Creature creatureNearPoint :: Point2 -> World -> Maybe Creature
creatureNearPoint p = L.fold (L.minimumOn (dist p . _crPos)) . creaturesNearPoint p creatureNearPoint = creatureNearPointI 1
creatureNearPointI :: Int -> Point2 -> World -> Maybe Creature creatureNearPointI :: Int -> Point2 -> World -> Maybe Creature
creatureNearPointI n p = L.fold (L.minimumOn (dist p . _crPos)) . creaturesNearPointI n p creatureNearPointI n p = L.fold (L.minimumOn (dist p . _crPos)) . creaturesNearPointI n p
creaturesNearPoint :: Point2 -> World -> IM.IntMap Creature creaturesNearPoint :: Point2 -> World -> IM.IntMap Creature
creaturesNearPoint p w = IM.unions creaturesNearPoint = creaturesNearPointI 1
[f b $ f a $ _znObjects $ _creaturesZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]]
where
(x,y) = crZoneOfPoint p
f i m = fromMaybe IM.empty $ IM.lookup i m
creaturesNearPointI :: Int -> Point2 -> World -> IM.IntMap Creature creaturesNearPointI :: Int -> Point2 -> World -> IM.IntMap Creature
creaturesNearPointI n p w = IM.unions creaturesNearPointI n p w = IM.unions
+1 -1
View File
@@ -22,7 +22,7 @@ saveConfig :: Configuration -> (a -> IO a) -> a -> IO a
saveConfig cfig f x = do saveConfig cfig f x = do
putStrLn "Saving config to data/dodge.config.json" putStrLn "Saving config to data/dodge.config.json"
BS.writeFile "data/dodge.config.json" BS.writeFile "data/dodge.config.json"
$ AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare (AEP.Generic) (False)) cfig $ AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False) cfig
f x f x
{- | {- |
Apply the volume settings from the world configuration to the running game. Apply the volume settings from the world configuration to the running game.
+11 -23
View File
@@ -70,7 +70,6 @@ targetRBPress = defaultTargeting
targetRBCreature :: Targeting targetRBCreature :: Targeting
targetRBCreature = defaultTargeting targetRBCreature = defaultTargeting
& tgUpdate .~ targetRBCreatureUp & tgUpdate .~ targetRBCreatureUp
-- undefined
& tgDraw .~ targetRBCreatureDraw & tgDraw .~ targetRBCreatureDraw
targetCursor :: Targeting targetCursor :: Targeting
targetCursor = defaultTargeting targetCursor = defaultTargeting
@@ -79,10 +78,10 @@ targetCursor = defaultTargeting
targetSimpleDraw :: Int -> Item -> Creature -> Configuration -> World -> Picture targetSimpleDraw :: Int -> Item -> Creature -> Configuration -> World -> Picture
targetSimpleDraw _ it _ cfig w = fromMaybe mempty $ do targetSimpleDraw _ it _ cfig w = fromMaybe mempty $ do
p <- it ^? itTargeting . tgPos . _Just p <- it ^? itTargeting . tgPos . _Just
return $ winScale cfig $ setLayer FixedCoordLayer $ color white return $ winScale cfig
$ uncurryV translate (worldPosToScreen w p) $ setLayer FixedCoordLayer
-- $ rotate (_cameraRot w) $ color white
$ activeTargetCursorPic $ uncurryV translate (worldPosToScreen w p) activeTargetCursorPic
targetRBCreatureUp :: Item -> Creature -> World -> Targeting -> (World, Targeting) targetRBCreatureUp :: Item -> Creature -> World -> Targeting -> (World, Targeting)
targetRBCreatureUp it cr w t targetRBCreatureUp it cr w t
| not $ _itIsHeld it = (w, t | not $ _itIsHeld it = (w, t
@@ -115,10 +114,11 @@ targetRBCreatureUp it cr w t
targetRBCreatureDraw :: Int -> Item -> Creature -> Configuration -> World -> Picture targetRBCreatureDraw :: Int -> Item -> Creature -> Configuration -> World -> Picture
targetRBCreatureDraw _ it _ cfig w = fromMaybe mempty $ do targetRBCreatureDraw _ it _ cfig w = fromMaybe mempty $ do
p <- it ^? itTargeting . tgPos . _Just p <- it ^? itTargeting . tgPos . _Just
return $ winScale cfig $ setLayer FixedCoordLayer $ color white return $ winScale cfig
$ setLayer FixedCoordLayer
$ color white
$ uncurryV translate (worldPosToScreen w p) $ uncurryV translate (worldPosToScreen w p)
-- $ rotate (_cameraRot w) thepic
$ thepic
where where
thepic | _tgActive $ _itTargeting it = activeTargetCursorPic thepic | _tgActive $ _itTargeting it = activeTargetCursorPic
| otherwise = targetCursorPic | otherwise = targetCursorPic
@@ -141,7 +141,9 @@ targCorner = pictures
targetUpdateWith :: (World -> Targeting -> Targeting) targetUpdateWith :: (World -> Targeting -> Targeting)
-> Item -> Creature -> World -> Targeting -> (World,Targeting) -> Item -> Creature -> World -> Targeting -> (World,Targeting)
targetUpdateWith f _ _ w t = (w, f w t) targetUpdateWith f it _ w t
| _itIsHeld it = (w, f w t)
| otherwise = (w,t)
targetCursorUpdate :: World -> Targeting -> Targeting targetCursorUpdate :: World -> Targeting -> Targeting
targetCursorUpdate w t targetCursorUpdate w t
@@ -159,20 +161,6 @@ targetRBPressUpdate w t
| otherwise = t & tgPos %~ const Nothing | otherwise = t & tgPos %~ const Nothing
& tgActive .~ False & tgActive .~ False
targetRBCreatureUpdate :: World -> Targeting -> Targeting
targetRBCreatureUpdate w t
| SDL.ButtonRight `S.member` _mouseButtons w && isJust (t ^? tgID . _Just)
= t & updatePos
& tgActive .~ True
| otherwise = t & tgID .~ fmap _crID (creatureNearPointI 3 mwp w)
& updatePos
& tgActive .~ False
where
mwp = mouseWorldPos w
updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t')
posFromMaybeID Nothing = Nothing
posFromMaybeID (Just i) = w ^? creatures . ix i . crPos
targetLaserUpdate :: Item -> Creature -> World -> Targeting -> (World,Targeting) targetLaserUpdate :: Item -> Creature -> World -> Targeting -> (World,Targeting)
targetLaserUpdate it cr w t targetLaserUpdate it cr w t
| crIsAiming cr = (addLaserPic w,t | crIsAiming cr = (addLaserPic w,t
+1 -2
View File
@@ -2,8 +2,7 @@ module FoldlHelp
( minimumOn ( minimumOn
, premapMaybe , premapMaybe
, module Control.Foldl , module Control.Foldl
) ) where
where
import Control.Foldl import Control.Foldl
data Maybe' a = Just' !a | Nothing' data Maybe' a = Just' !a | Nothing'