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

Move towards serializing saves/loads faster

Browse Source
This commit is contained in:
justin
2022-08-19 11:12:43 +01:00
parent c74d3b04bf
commit 9df0fa8692
38 changed files with 542 additions and 384 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Collide.hs
+1 -1
View File
@@ -178,7 +178,7 @@ allVisibleWalls :: World -> [(Point2, Wall)]
{-# INLINE allVisibleWalls #-}
allVisibleWalls w = concatMap (flip (visibleWalls vPos) w . (+.+ vPos)) $ nRays 20
where
vPos = _cameraViewFrom $ _cWorld w
vPos = w ^. cWorld . cwCam . cwcViewFrom
--allVisibleWalls :: World -> StreamOf (Point2,Wall)
--{-# INLINE allVisibleWalls #-}
src/Dodge/Base/Coordinate.hs
+9 -8
View File
@@ -3,14 +3,15 @@ module Dodge.Base.Coordinate where
import Dodge.Base.WinScale
import Dodge.Data.Universe
import Geometry
import Control.Lens
-- | Transform coordinates from world position to screen coordinates.
worldPosToScreenNorm :: Configuration -> World -> Point2 -> Point2
worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
where
doTranslate p = p -.- _cameraCenter (_cWorld w)
doZoom p = _cameraZoom (_cWorld w) *.* p
doRotate p = rotateV (negate $ _cameraRot (_cWorld w)) p
doTranslate p = p -.- (w ^. cWorld . cwCam . cwcCenter)
doZoom p = (w ^. cWorld . cwCam . cwcZoom) *.* p
doRotate p = rotateV (negate (w ^. cWorld . cwCam . cwcRot)) p
{- | Transform world coordinates to scaled screen coordinates.
- These have to be scaled according to the size of the window to get actual screen positions.
@@ -18,9 +19,9 @@ worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTransla
-}
worldPosToScreen :: World -> Point2 -> Point2
worldPosToScreen w =
rotateV (negate $ _cameraRot (_cWorld w))
. (_cameraZoom (_cWorld w) *.*)
. (-.- _cameraCenter (_cWorld w))
rotateV (negate $ w ^. cWorld . cwCam . cwcRot)
. ((w ^. cWorld . cwCam . cwcZoom) *.*)
. (-.- (w ^. cWorld . cwCam . cwcCenter))
{- | Transform coordinates from the map position to screen
coordinates.
@@ -38,8 +39,8 @@ crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr, 0)
-- | The mouse position in world coordinates.
mouseWorldPos :: World -> Point2
mouseWorldPos w =
_cameraCenter (_cWorld w)
+.+ (1 / _cameraZoom (_cWorld w)) *.* rotateV (_cameraRot (_cWorld w)) (_mousePos w)
(w ^. cWorld . cwCam . cwcCenter)
+.+ (1 / (w ^. cWorld . cwCam . cwcZoom)) *.* rotateV (w ^. cWorld . cwCam . cwcRot) (_mousePos w)
-- | The mouse position in map coordinates
mouseCartePos :: World -> Point2
src/Dodge/Base/Window.hs
+6 -7
View File
@@ -9,18 +9,17 @@ module Dodge.Base.Window (
import Dodge.Data.Universe
import Geometry
import Control.Lens
-- | A box covering the screen in world coordinates
screenPolygon :: Configuration -> World -> [Point2]
screenPolygon cfig w = map (scTran . scRot . scZoom) $ screenBox cfig
where
-- [tr,tl,bl,br]
scRot = rotateV (_cameraRot (_cWorld w))
scRot = rotateV (w ^. cWorld . cwCam . cwcRot)
scZoom p
| _cameraZoom (_cWorld w) /= 0 = (1 / _cameraZoom (_cWorld w)) *.* p
| (w ^. cWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . cwCam . cwcZoom)) *.* p
| otherwise = p
scTran p = p +.+ _cameraCenter (_cWorld w)
scTran p = p +.+ (w ^. cWorld . cwCam . cwcCenter)
-- tr = scTran $ scRot $ scZoom (V2 ( halfWidth w) ( halfHeight w))
-- tl = scTran $ scRot $ scZoom (V2 (-halfWidth w) ( halfHeight w))
@@ -41,9 +40,9 @@ screenPolygonBord xbord ybord cfig w = [tr, tl, bl, br]
hw = halfWidth cfig - xbord
hh = halfHeight cfig - ybord
scZoom p
| _cameraZoom (_cWorld w) /= 0 = (1 / _cameraZoom (_cWorld w)) *.* p
| (w ^. cWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . cwCam . cwcZoom)) *.* p
| otherwise = p
theTransform = (+.+ _cameraCenter (_cWorld w)) . rotateV (_cameraRot (_cWorld w)) . scZoom
theTransform = (+.+ (w ^. cWorld . cwCam . cwcCenter)) . rotateV (w ^. cWorld . cwCam . cwcRot) . scZoom
tr = theTransform (V2 hw hh)
tl = theTransform (V2 (- hw) hh)
br = theTransform (V2 hw (- hh))
src/Dodge/Creature/Picture/Awareness.hs
+3 -2
View File
@@ -5,6 +5,7 @@ import Dodge.Clock
import Dodge.Data.World
import Geometry
import Picture
import Control.Lens
creatureDisplayText :: World -> Creature -> Picture
creatureDisplayText w cr =
@@ -26,8 +27,8 @@ creatureDisplayText w cr =
w
cr
where
campos = _cameraViewFrom (_cWorld w)
theScale = 0.15 / _cameraZoom (_cWorld w)
campos = w ^. cWorld . cwCam . cwcViewFrom
theScale = 0.15 / (w ^. cWorld . cwCam . cwcZoom)
cpos = _crPos cr
v = cpos -.- campos
(V2 x y) = campos +.+ v +.+ _crRad cr *.* normalizeV v
src/Dodge/Creature/YourControl.hs
+3 -3
View File
@@ -56,12 +56,12 @@ wasdWithAiming w speed cr
| otherwise = crMvAbsolute (speed *.* movAbs) . set crMvDir dir
theTurn cr' = creatureTurnTowardDir (_crMvDir cr') 0.2 cr'
movDir = wasdDir w
dir = _cameraRot (_cWorld w) + argV movDir
movAbs = rotateV (_cameraRot (_cWorld w)) $ normalizeV movDir
dir = (w ^. cWorld . cwCam . cwcRot) + argV movDir
movAbs = rotateV (w ^. cWorld . cwCam . cwcRot) $ normalizeV movDir
isAiming = _posture (_crStance cr) == Aiming
mouseDir = case cr ^? crInv . ix (crSel cr) . itScope . scopePos of
Just _ -> argV $ mouseWorldPos w -.- _crPos cr
_ -> argV (_mousePos w) + _cameraRot (_cWorld w)
_ -> argV (_mousePos w) + (w ^. cWorld . cwCam . cwcRot)
wasdM :: SDL.Scancode -> Point2
wasdM scancode = case scancode of
src/Dodge/CullBox.hs
+4 -3
View File
@@ -12,7 +12,7 @@ import Geometry
findBoundDists :: Configuration -> World -> (Float, Float, Float, Float)
findBoundDists cfig w
| debugOn Bound_box_screen cfig = (hh, - hh, hw, - hw)
| otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (_cameraCenter (_cWorld w)) w
| otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection ((w ^. cWorld . cwCam . cwcCenter)) w
where
hw = halfWidth cfig
hh = halfHeight cfig
@@ -20,8 +20,9 @@ findBoundDists cfig w
updateBounds :: Universe -> Universe
updateBounds uv =
uv
& uvWorld . cWorld . boundDist .~ bdists
& uvWorld . cWorld . boundBox .~ map ((+.+ _cameraCenter (_cWorld w)) . rotateV (_cameraRot (_cWorld w))) (rectNSWE n s w' e)
& uvWorld . cWorld . cwCam . cwcBoundDist .~ bdists
& uvWorld . cWorld . cwCam . cwcBoundBox
.~ map ((+.+ w ^. cWorld . cwCam . cwcCenter) . rotateV (w ^. cWorld . cwCam . cwcRot)) (rectNSWE n s w' e)
where
w = _uvWorld uv
cfig = _uvConfig uv
src/Dodge/Data/CWorld.hs
+38 -9
View File
@@ -1,5 +1,6 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Dodge.Data.CWorld (
module Dodge.Data.CWorld,
@@ -46,6 +47,8 @@ module Dodge.Data.CWorld (
module Dodge.Data.WorldEffect,
) where
import TH.Derive
import Data.Store
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
@@ -99,16 +102,29 @@ import qualified IntMapHelp as IM
import MaybeHelp
import Picture.Data
data CWCam = CWCam
{ _cwcCenter :: Point2
, _cwcRot :: Float
, _cwcZoom :: Float -- smaller values zoom out
, _cwcItemZoom :: Float
, _cwcDefaultZoom :: Float
, _cwcViewFrom :: Point2
, _cwcViewDistance :: Float
, _cwcBoundBox :: [Point2]
, _cwcBoundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative
}
data CWorld = CWorld
{ _cameraCenter :: Point2
, _cameraRot :: Float
, _cameraZoom :: Float -- smaller values zoom out
, _itemZoom :: Float
, _defaultZoom :: Float
, _cameraViewFrom :: Point2
, _viewDistance :: Float
, _boundBox :: [Point2]
, _boundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative
--{ _cameraCenter :: Point2
--, _cameraRot :: Float
--, _cameraZoom :: Float -- smaller values zoom out
--, _itemZoom :: Float
--, _defaultZoom :: Float
--, _cameraViewFrom :: Point2
--, _viewDistance :: Float
--, _boundBox :: [Point2]
--, _boundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative
{ _cwCam :: CWCam
, _creatures :: IM.IntMap Creature
, _crZoning :: IM.IntMap (IM.IntMap IS.IntSet)
, _creatureGroups :: IM.IntMap CrGroupParams
@@ -176,6 +192,14 @@ data CWorld = CWorld
, _worldClock :: Int
, _genParams :: GenParams
, _deathDelay :: Maybe Int
, _cwSeed :: Int
}
data CWGen = CWGen
{ _cwgParams :: GenParams
, _cwgWorldBounds :: Bounds
, _cwgGameRooms :: [GameRoom] -- consider using an IntMap
, _cwgRoomClipping :: [ConvexPoly]
}
data WorldBeams = WorldBeams
@@ -188,5 +212,10 @@ data WorldBeams = WorldBeams
deriveJSON defaultOptions ''CWorld
deriveJSON defaultOptions ''WorldBeams
deriveJSON defaultOptions ''CWCam
makeLenses ''CWorld
makeLenses ''WorldBeams
makeLenses ''CWCam
-- $($(derive [d|
-- instance Deriving (Store CWorld)
-- |]))
src/Dodge/Data/Universe.hs
+9 -2
View File
@@ -27,6 +27,8 @@ data Universe = Universe
, _uvConcEffects :: ConcEffect
, _uvConfig :: Configuration
, _uvTestString :: Universe -> [String]
, _uvCanContinue :: Bool
, _uvMSeed :: Maybe Int
}
data ConcEffect = NoConcEffect
@@ -62,10 +64,14 @@ data ScreenLayer
-- { _scDisplay :: Universe -> Picture
-- }
data MenuOptionDisplay = MODString {_modString :: String}
| MODBlockedString {_modString :: String}
| MODStringOption {_modString :: String,_modOption :: String}
data MenuOption
= Toggle
{ _moEff :: Universe -> IO (Maybe Universe)
, _moString :: Universe -> Either String (String, String)
, _moString :: Universe -> MenuOptionDisplay
, _moKey :: Scancode
}
| Toggle2
@@ -73,7 +79,7 @@ data MenuOption
, _moEff1 :: Universe -> IO (Maybe Universe)
, _moKey2 :: Scancode
, _moEff2 :: Universe -> IO (Maybe Universe)
, _moString :: Universe -> Either String (String, String)
, _moString :: Universe -> MenuOptionDisplay
}
| InvisibleToggle
{ _moKey :: Scancode
@@ -85,3 +91,4 @@ data IntID a = IntID Int a
makeLenses ''Universe
makeLenses ''ScreenLayer
makeLenses ''ConcEffect
makeLenses ''MenuOptionDisplay
src/Dodge/Debug/Picture.hs
+7 -6
View File
@@ -1,5 +1,6 @@
module Dodge.Debug.Picture where
import Control.Lens
import Data.Maybe
import Dodge.Base.Wall
import Dodge.Base.Window
@@ -19,11 +20,11 @@ printRotPoint r p =
outsideScreenPolygon :: Configuration -> World -> [Point2]
outsideScreenPolygon cfig w = [tr, tl, bl, br]
where
scRot = rotateV (_cameraRot (_cWorld w))
scRot = rotateV (w ^. cWorld . cwCam . cwcRot)
scZoom p
| _cameraZoom (_cWorld w) /= 0 = (1 / _cameraZoom (_cWorld w)) *.* p
| (w ^. cWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . cwCam . cwcZoom)) *.* p
| otherwise = error "Trying to set screen zoom to zero"
scTran p = p +.+ _cameraCenter (_cWorld w)
scTran p = p +.+ (w ^. cWorld . cwCam . cwcCenter)
tr = f 3 3
tl = f (-3) 3
br = f 3 (-3)
@@ -39,10 +40,10 @@ lineOnScreenCone cfig w p1 p2 =
|| any (isJust . uncurry (intersectSegSeg p1 p2)) sps
where
sp' = screenPolygon cfig w
vp = _cameraViewFrom (_cWorld w)
vp = w ^. cWorld . cwCam . cwcViewFrom
sp
| pointInPolygon vp sp' = sp'
| otherwise = orderPolygon (_cameraViewFrom (_cWorld w) : sp')
| otherwise = orderPolygon ((w ^. cWorld . cwCam . cwcViewFrom) : sp')
sps = zip sp (tail sp ++ [head sp])
pointOnScreen :: Configuration -> World -> Point2 -> Bool
@@ -55,7 +56,7 @@ drawWallFace cfig w wall
where
(x, y) = _wlLine wall
points = extendConeToScreenEdge cfig w sightFrom (x, y)
sightFrom = _cameraViewFrom (_cWorld w)
sightFrom = w ^. cWorld . cwCam . cwcViewFrom
extendConeToScreenEdge :: Configuration -> World -> Point2 -> (Point2, Point2) -> [Point2]
extendConeToScreenEdge cfig w c (x, y) = orderPolygon $ wallScreenIntersect ++ [x, y] ++ borderPs ++ cornerPs
src/Dodge/Default/World.hs
+18 -15
View File
@@ -33,17 +33,25 @@ defaultWorld =
, _rbOptions = NoRightButtonOptions
}
defaultCWCam :: CWCam
defaultCWCam = CWCam
{ _cwcCenter = V2 0 0
, _cwcRot = 0
, _cwcZoom = 1
, _cwcDefaultZoom = 1
, _cwcViewFrom = V2 0 0
, _cwcViewDistance = 1000
, _cwcItemZoom = 1
, _cwcBoundBox = square 100
, _cwcBoundDist = (100, -100, 100, -100)
}
defaultCWorld :: CWorld
defaultCWorld =
CWorld
{ _cameraCenter = V2 0 0
, _cameraRot = 0
, _cameraZoom = 1
{ _cwCam = defaultCWCam
, _magnets = IM.empty
, _itemZoom = 1
, _defaultZoom = 1
, _cameraViewFrom = V2 0 0
, _viewDistance = 1000
, _modifications = IM.empty
, _creatures = IM.empty
, _crZoning = mempty --Zoning IM.empty crZoneSize zoneOfCreature
@@ -57,9 +65,7 @@ defaultCWorld =
, _projectiles = IM.empty
, _instantBullets = []
, _bullets = []
, -- , _instantParticles = []
-- , _particles = []
_flames = []
, _flames = []
, _radarSweeps = []
, _sparks = []
, _posEvents = []
@@ -121,11 +127,8 @@ defaultCWorld =
, _maybeWorld = Nothing'
, _rewindWorlds = []
, _genParams = GenParams M.empty
, -- , _genPlacements = IM.empty
-- , _genRooms = IM.empty
_deathDelay = Nothing
, _boundBox = square 100
, _boundDist = (100, -100, 100, -100)
, _deathDelay = Nothing
, _cwSeed = 0
}
defaultWorldHammers :: M.Map WorldHammer HammerPosition
src/Dodge/Event.hs
+1 -1
View File
@@ -108,7 +108,7 @@ wheelEvent y w = case _hudElement $ _hud (_cWorld w) of
(_, EquipOptions{}) -> scrollRBOption y w
(Nothing, _) -> closeObjScrollDir y w
(Just f, _) -> w & cWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ doHeldScroll f y (you w)
| lbDown -> w & cWorld . cameraZoom +~ y
| lbDown -> w & cWorld . cwCam . cwcZoom +~ y
| invKeyDown -> changeSwapInvSel yi w
| otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
DisplayInventory (TweakInventory mi)
src/Dodge/Initialisation.hs
+1 -1
View File
@@ -16,7 +16,7 @@ splashScreen =
initialWorld :: World
initialWorld =
defaultWorld
& cWorld . cameraZoom .~ 10
& cWorld . cwCam . cwcZoom .~ 10
& cWorld . creatures .~ IM.fromList [(0, startCr)]
& cWorld . worldEvents .~ SoundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing :
[MakeStartCloudAt (V3 x y 5) | x <- [-5, -4 .. 5], y <- [-5, -4 .. 5]]
src/Dodge/Item/Weapon/TriggerType.hs
+4 -4
View File
@@ -579,7 +579,7 @@ torqueBefore torque feff item cr w
w
& randGen .~ g
& cWorld . creatures . ix cid . crDir +~ rot
& cWorld . cameraRot +~ rot
& cWorld . cwCam . cwcRot +~ rot
| otherwise = feff item cr $ set randGen g $ over (cWorld . creatures . ix cid . crDir) (+ rot) w
where
cid = _crID cr
@@ -600,7 +600,7 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w
w
& randGen .~ g
& cWorld . creatures . ix cid . crDir +~ rot'
& cWorld . cameraRot +~ rot'
& cWorld . cwCam . cwcRot +~ rot'
| otherwise = feff item cr $ set randGen g $ over (cWorld . creatures . ix cid . crDir) (+ rot') w
where
cid = _crID cr
@@ -613,7 +613,7 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w
withTorqueAfter :: ChainEffect
withTorqueAfter feff item cr w
-- | cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff item cr w
| cid == 0 = set randGen g $ over (cWorld . cameraRot) (+ rot) $ feff item cr w
| cid == 0 = set randGen g $ over (cWorld . cwCam . cwcRot) (+ rot) $ feff item cr w
| otherwise = set randGen g $ over (cWorld . creatures . ix cid . crDir) (+ rot) $ feff item cr w
where
cid = _crID cr
@@ -651,7 +651,7 @@ sideEffectOnFrame i sf f it cr w =
torqueSideEffect :: Float -> Item -> Creature -> World -> World
torqueSideEffect torque _ cr w
| cid == 0 = set randGen g $ over (cWorld . cameraRot) (+ rot) w
| cid == 0 = set randGen g $ over (cWorld . cwCam . cwcRot) (+ rot) w
| otherwise = set randGen g $ over (cWorld . creatures . ix cid . crDir) (+ rot) w
where
cid = _crID cr
src/Dodge/Layout.hs
+1 -1
View File
@@ -56,7 +56,7 @@ generateLevelFromRoomList gr' w =
randomCompass :: World -> World
randomCompass w = w & cWorld . cameraRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w)
randomCompass w = w & cWorld . cwCam . cwcRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w)
putFloorTiles :: GenWorld -> GenWorld
putFloorTiles gw = gw & gwWorld . cWorld . floorTiles .~ floorsFromGenWorld gw
src/Dodge/LevelGen.hs
+1
View File
@@ -28,6 +28,7 @@ generateWorldFromSeed i = do
postGenerationProcessing $
_gwWorld (generateLevelFromRoomList roomList initialWorld{_randGen = mkStdGen i})
& cWorld . roomClipping .~ bounds
& cWorld . cwSeed .~ i
postGenerationProcessing :: World -> World
postGenerationProcessing w = foldl' assignPushDoors w (_doors (_cWorld w))
src/Dodge/LoadSeed.hs
+16
View File
@@ -0,0 +1,16 @@
module Dodge.LoadSeed
where
import System.Directory
import Text.Read
loadSeed :: IO (Maybe Int)
loadSeed = maybeReadFile "saveSlot/seed" >>= (return . (>>= readMaybe))
maybeReadFile :: String -> IO (Maybe String)
maybeReadFile fpath = do
fexists <- doesFileExist fpath
if fexists
then do
str <- readFile fpath
return (Just str)
else return Nothing
src/Dodge/Menu.hs
+19 -14
View File
@@ -21,6 +21,7 @@ import Padding
import SDL
import System.Clipboard
import Text.Read
import Data.Maybe
splashMenu :: ScreenLayer
splashMenu =
@@ -30,17 +31,21 @@ splashMenu =
splashMenuOptions :: [MenuOption]
splashMenuOptions =
basicKeyOptions
[ Toggle (return . Just . loadSaveSlot (SaveSlotNum 0)) (opText "CONTINUE")
, Toggle (return . Just . startNewGameInSlot 0) (opText "NEW GAME")
, Toggle (return . Just . reloadLevelStart) (opText "RESTART")
, Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "NEW FROM SEED")
[ Toggle (return . Just . loadSaveSlot (SaveSlotNum 0)) displaycontinue
, Toggle (return . Just . startNewGameInSlot 0) (opText "NEW WITH RANDOM SEED")
, Toggle (return . Just . reloadLevelStart) (displaywhenseed "NEW WITH LAST SEED")
, Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "NEW WITH SPECIFIC SEED")
, Toggle (pushScreen optionMenu) (opText "OPTIONS")
, Toggle (pushScreen displayControls) (opText "VIEW CONTROLS")
, Toggle (return . Just) (opText "VIEW CURRENT SEED")
, Toggle (return . Just) (displaywhenseed "VIEW LAST SEED")
, Toggle (return . const Nothing) (opText "QUIT")
]
where
opText = const . Left
opText = const . MODString
displaycontinue u | _uvCanContinue u = MODString "CONTINUE"
| otherwise = MODBlockedString "CONTINUE"
displaywhenseed str u | isNothing (_uvMSeed u) = MODBlockedString str
| otherwise = MODString str
pauseMenu :: ScreenLayer
pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause)
@@ -60,7 +65,7 @@ pauseMenuOptions =
++ [ InvisibleToggle ScancodeEscape (return . const Nothing)
]
where
opText = const . Left
opText = const . MODString
saveQuit :: Universe -> IO (Maybe Universe)
saveQuit u =
@@ -78,7 +83,7 @@ seedStartMenu str = slTitleOptionsEff str seedStartOptions popScreen
seedStartOptions :: [MenuOption]
seedStartOptions =
[ Toggle trySeedFromClipboard (const $ Left "PASTE NUMBER FROM CLIPBOARD") ScancodeA
[ Toggle trySeedFromClipboard (const $ MODString "PASTE NUMBER FROM CLIPBOARD") ScancodeA
-- , Toggle ScancodeI (return . Just . loadSaveSlot LevelStartSlot) (const "INSERT NUMBER")
]
@@ -101,10 +106,10 @@ optionMenu = slTitleOptionsEff "OPTIONS" optionsOptions popScreen
optionsOptions :: [MenuOption]
optionsOptions =
basicKeyOptions
[ makeSubmenuOption soundMenu $ Left "VOLUME"
, makeSubmenuOption graphicsMenu $ Left "GRAPHICS"
, makeSubmenuOption gameplayMenu $ Left "GAMEPLAY"
, makeSubmenuOption debugMenu $ Left "DEBUG OPTIONS"
[ makeSubmenuOption soundMenu $ MODString "VOLUME"
, makeSubmenuOption graphicsMenu $ MODString "GRAPHICS"
, makeSubmenuOption gameplayMenu $ MODString "GAMEPLAY"
, makeSubmenuOption debugMenu $ MODString "DEBUG OPTIONS"
]
debugMenu :: ScreenLayer
@@ -124,7 +129,7 @@ debugMenuOptions =
f bd =
Toggle
(return . Just . (uvConfig . debug_booleans . at bd %~ toggleJust))
(Right . g bd . (^? uvConfig . debug_booleans . ix bd))
(uncurry MODStringOption . g bd . (^? uvConfig . debug_booleans . ix bd))
g bd Nothing = (show bd, "False")
g bd _ = (show bd, "True")
@@ -176,7 +181,7 @@ soundMenuOptions =
(change dec stype)
scod2
(change inc stype)
(\w -> Right (str, leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w) :: Int)))
(\w -> MODStringOption str (leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w) :: Int)))
change g vt uv = sw uv >> return (Just $ uv & uvConfig . vt %~ g)
dec x = max 0 (x - 0.1)
inc x = min 1 (x + 0.1)
src/Dodge/Menu/OptionType.hs
+2 -2
View File
@@ -8,12 +8,12 @@ import Dodge.Menu.PushPop
makeBoolOption lns t =
Toggle
(return . Just . (uvConfig . lns #%~ not))
(\u -> Right (t, show (u ^# uvConfig . lns)))
(\u -> MODStringOption t (show (u ^# uvConfig . lns)))
makeEnumOption lns str sideeff =
Toggle
(\u -> Just <$> sideeff (u & uvConfig . lns #%~ cycleEnum))
(\u -> Right (str, show (u ^# uvConfig . lns)))
(\u -> MODStringOption str (show (u ^# uvConfig . lns)))
makeSubmenuOption submenu t = Toggle (pushScreen submenu) (const t)
src/Dodge/Picture/SizeInvariant.hs
+9 -8
View File
@@ -1,5 +1,6 @@
module Dodge.Picture.SizeInvariant where
import Control.Lens
import Data.Maybe
import Dodge.Base.Window
import Dodge.Data.Universe
@@ -18,9 +19,9 @@ fixedSizePicAt pic p w =
. scale theScale theScale
$ pic
where
campos = _cameraViewFrom (_cWorld w)
campos = w ^. cWorld . cwCam . cwcViewFrom
v = p -.- campos
theScale = 1 / _cameraZoom (_cWorld w)
theScale = 1 / (w ^. cWorld . cwCam . cwcZoom)
(V2 x y) = campos +.+ v
fixedSizePicClamp ::
@@ -40,11 +41,11 @@ fixedSizePicClamp xbord ybord pic p cfig w =
. scale theScale theScale
$ pic
where
r = negate $ _cameraRot (_cWorld w)
z = _cameraZoom (_cWorld w)
campos = _cameraViewFrom (_cWorld w)
r = negate $ w ^. cWorld . cwCam . cwcRot
z = w ^. cWorld . cwCam . cwcZoom
campos = w ^. cWorld . cwCam . cwcViewFrom
v = p -.- campos
theScale = 1 / _cameraZoom (_cWorld w)
theScale = 1 / (w ^. cWorld . cwCam . cwcZoom)
(V2 x y) = campos +.+ rotateV (negate r) (V2 xr' yr')
(V2 xr yr) = rotateV r v
xr' = absClamp ((halfWidth cfig - fromIntegral xbord) / z) xr
@@ -74,8 +75,8 @@ fixedSizePicClampArrow xbord ybord pic p cfig w =
Nothing -> blank
Just bp -> thickLine 5 [bp, fromMaybe p windowPoint]
(V2 x y) = fromMaybe p borderPoint
campos = _cameraCenter (_cWorld w)
theScale = 1 / _cameraZoom (_cWorld w)
campos = w ^. cWorld . cwCam . cwcCenter
theScale = 1 / (w ^. cWorld . cwCam . cwcZoom)
absClamp ::
-- | clamping value, assumed positive
src/Dodge/Projectile/Update.hs
+1 -1
View File
@@ -99,7 +99,7 @@ setRemoteDir cid itid pj w = w & cWorld . projectiles . ix (_prjID pj) . prjAcc
| SDL.ButtonRight `M.member` _mouseButtons w
&& w ^? cWorld . creatures . ix cid . crInvSel . iselPos
== w ^? cWorld . itemLocations . ix itid . ipInvID
= _cameraRot (_cWorld w) + argV (_mousePos w)
= (w ^. cWorld . cwCam . cwcRot) + argV (_mousePos w)
| otherwise = _prjDir pj
doThrust :: Proj -> World -> World
src/Dodge/Render.hs
+4 -4
View File
@@ -32,14 +32,14 @@ doDrawing pdata u = do
sTicks <- SDL.ticks
let w = _uvWorld u
cfig = _uvConfig u
rot = _cameraRot (_cWorld w)
camzoom = _cameraZoom (_cWorld w)
trans = _cameraCenter (_cWorld w)
rot = w ^. cWorld . cwCam . cwcRot
camzoom = w ^. cWorld . cwCam . cwcZoom
trans = w ^. cWorld . cwCam . cwcCenter
wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig)
resFact = resFactorNum $ cfig ^. graphics_resolution_factor
(wallPointsCol, windowPoints, wallSPics) = wallsToDraw w
lightPoints = lightsToRender cfig w
viewFroms@(V2 vfx vfy) = _cameraViewFrom (_cWorld w)
viewFroms@(V2 vfx vfy) = w ^. cWorld . cwCam . cwcViewFrom
viewFrom3d = Vector3 vfx vfy 20
shadV = _pictureShaders pdata
lwShad = _lightingWallShadShader pdata
src/Dodge/Render/Lights.hs
+3 -2
View File
@@ -6,6 +6,7 @@ import Data.Maybe
import Dodge.Data.Universe
import Geometry
import qualified IntMapHelp as IM
import Control.Lens
lightsToRender :: Configuration -> World -> [(Point3, Float, Point3)]
lightsToRender cfig w =
@@ -14,8 +15,8 @@ lightsToRender cfig w =
where
getLS = getlsparam . _lsParam
getTLS = getlsparam . _tlsParam
cbox = _boundBox (_cWorld w)
cpos = _cameraCenter (_cWorld w)
cbox = w ^. cWorld . cwCam . cwcBoundBox
cpos = w ^. cWorld . cwCam . cwcCenter
getlsparam ls
| not (pointInPolygon lpos cbox) && extraculltest = Nothing
| otherwise = Just (_lsPos ls, rad ^ (2 :: Int), _lsCol ls)
src/Dodge/Render/List.hs
+23
View File
@@ -59,6 +59,29 @@ listCursorNESW = listCursorChooseBorder [True, True, True, True]
listCursorNSW :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
listCursorNSW = listCursorChooseBorder [True, False, True, True]
fillScreenText :: Configuration -> String -> Picture
fillScreenText cfig str =
winScale cfig
. scale wscale hscale
. centerText
$ str
where
wscale = hw*0.02/fromIntegral (length str)
hscale = hh*0.01
hw = halfWidth cfig
hh = halfHeight cfig
fillWidthText :: Configuration -> String -> Picture
fillWidthText cfig str =
winScale cfig
. scale thescale thescale
. centerText
$ str
where
thescale = hw*0.02/fromIntegral (length str)
hw = halfWidth cfig
listTextPictureAt :: Float -> Float -> Configuration -> Int -> Picture -> Picture
listTextPictureAt xoff yoff cfig yint =
winScale cfig
src/Dodge/Render/MenuScreen.hs
+22 -8
View File
@@ -64,7 +64,7 @@ drawOptions u title ops off footer =
, drawFooterText cfig red footer
]
++ zipWith
(\s vpos -> placeString (- hw + 50) vpos 0.2 s)
(\s vpos -> placeColorString (- hw + 50) vpos 0.2 s)
ops''
[hh -100, hh -150 ..]
where
@@ -77,7 +77,7 @@ drawOptions u title ops off footer =
x | x < length ops -> take (availableMenuLines cfig) (drop off visibleops)
_ -> visibleops
ops'' = case availableMenuLines cfig of
x | x < length ops -> map (menuOptionToString u maxOptionLength) ops' ++ ["SPACE: MORE OPTIONS"]
x | x < length ops -> map (menuOptionToString u maxOptionLength) ops' ++ [(white,"SPACE: MORE OPTIONS")]
_ -> map (menuOptionToString u maxOptionLength) ops'
visibleops = filter notInvisible ops
notInvisible InvisibleToggle{} = False
@@ -88,8 +88,8 @@ drawOptions u title ops off footer =
optionValueOffset :: Universe -> MenuOption -> Int
optionValueOffset u mo = case _moString mo u of
Left _ -> 0
Right (s, _) -> length s
MODStringOption s _ -> length s
_ -> 0
darkenBackground :: Configuration -> Picture
darkenBackground = color (withAlpha 0.5 black) . polygon . reverse . screenBox
@@ -111,18 +111,32 @@ placeString ::
Picture
placeString x y sc = color white . translate x y . scale sc sc . text
placeColorString ::
-- | x distance from center
Float ->
-- | y distance from center
Float ->
-- | scale
Float ->
(Color,String) ->
Picture
placeColorString x y sc (col,str) = color col . translate x y . scale sc sc . text $ str
drawFooterText :: Configuration -> Color -> String -> Picture
drawFooterText cfig col = color col . placeString (- hw + 30) (- hh + 10) 0.1
where
hh = halfHeight cfig
hw = halfWidth cfig
menuOptionToString :: Universe -> Int -> MenuOption -> String
menuOptionToString w padAmount mo = theKeys ++ optionText
menuOptionToString :: Universe -> Int -> MenuOption -> (Color,String)
menuOptionToString w padAmount mo = (thecol,theKeys ++ optionText)
where
thecol = case _moString mo w of
MODBlockedString {} -> greyN 0.5
_ -> white
optionText = case _moString mo w of
Left s -> s
Right (s, t) -> rightPad padAmount '.' s ++ t
MODStringOption s t -> rightPad padAmount '.' s ++ t
x -> _modString x
theKeys = case mo of
Toggle{_moKey = k} -> stc k : ":"
Toggle2{_moKey1 = k1, _moKey2 = k2} -> stc k1 : '/' : stc k2 : ":"
src/Dodge/Render/Outline.hs
+14
View File
@@ -0,0 +1,14 @@
module Dodge.Render.Outline
where
import Picture
hackOutline :: Color -> Float -> Picture -> Picture
hackOutline col x pic = pictures
(map (color col)
[ translate x 0 pic
, translate (-x) 0 pic
, translate 0 x pic
, translate 0 (-x) pic
]
) <> pic
src/Dodge/Render/Picture.hs
+13 -11
View File
@@ -2,6 +2,7 @@ module Dodge.Render.Picture (
fixedCoordPictures,
) where
import Control.Lens
import Dodge.Base.WinScale
import Dodge.Base.Window
import Dodge.Data.Universe
@@ -10,7 +11,6 @@ import Dodge.Render.List
import Dodge.Render.MenuScreen
import Geometry
import Picture
import Control.Lens
fixedCoordPictures :: Universe -> Picture
fixedCoordPictures u =
@@ -27,16 +27,18 @@ fixedCoordPictures u =
drawConcurrentMessage :: Universe -> Picture
drawConcurrentMessage u = case u ^. uvConcEffects of
BlockingConcEffect str -> listPicturesAt
(halfWidth cfig)
(halfHeight cfig)
cfig
[text str]
BackgroundConcEffect str -> listPicturesAt
(halfWidth cfig)
(_windowY cfig - 50)
cfig
[text str]
BlockingConcEffect str -> fillWidthText cfig str
--listPicturesAt
--(halfWidth cfig)
--(halfHeight cfig)
--cfig
--[centerText str]
BackgroundConcEffect str ->
listPicturesAt
(halfWidth cfig)
(_windowY cfig - 50)
cfig
[centerText str]
_ -> mempty
where
cfig = _uvConfig u
src/Dodge/Render/ShapePicture.hs
+15 -7
View File
@@ -118,8 +118,8 @@ shiftDraw' fpos fdir fdraw x =
cullPoint :: Configuration -> World -> Point2 -> Bool
cullPoint cfig w p
| debugOn Close_shape_culling cfig = pointInPolygon p (_boundBox (_cWorld w))
| otherwise = dist (_cameraCenter (_cWorld w)) p < _viewDistance (_cWorld w)
| debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . cwCam . cwcBoundBox)
| otherwise = dist (w ^. cWorld . cwCam . cwcCenter) p < (w ^. cWorld . cwCam . cwcViewDistance)
extraPics :: Configuration -> World -> Picture
extraPics cfig w =
@@ -277,7 +277,7 @@ drawFarWallDetect w =
)
$ runIdentity $ S.toList_ $ streamViewpoints p w
where
p = _cameraViewFrom (_cWorld w)
p = w ^. cWorld . cwCam . cwcViewFrom
drawDDATest :: World -> Picture
drawDDATest w =
@@ -288,7 +288,7 @@ drawDDATest w =
-- <> color blue (runIdentity (S.foldMap_ drawCross qs'))
<> setLayer DebugLayer (color yellow (line [cvf, mwp]))
where
cvf = _cameraViewFrom (_cWorld w)
cvf = w ^. cWorld . cwCam . cwcViewFrom
mwp = mouseWorldPos w
--ps = ddaStreamX 50 cvf mwp
ps = zoneOfSeg' 50 cvf mwp
@@ -315,15 +315,23 @@ drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w
setLayer DebugLayer $
color yellow $
uncurryV translate p (circle 5)
<> line [_cameraViewFrom (_cWorld w), p]
<> line [w ^. cWorld . cwCam . cwcViewFrom , p]
testPic :: Configuration -> World -> Picture
testPic _ _ = mempty
--testPic cfig _ = setLayer FixedCoordLayer $ listPicturesAt 100 100 cfig $ map centerText
-- ["A"
-- ,"AA"
-- ,"AAA"
-- ,"AAAA"
-- ,"AAAAA"
-- ,"AAAAAA"
-- ]
drawBoundingBox :: World -> Picture
drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x]
where
(x : xs) = _boundBox (_cWorld w)
(x : xs) = w ^. cWorld . cwCam . cwcBoundBox
clDraw :: Cloud -> Picture
clDraw c = translate3 (_clPos c) (drawCloud (_clPict c) c)
@@ -351,7 +359,7 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w
where
p = _soundPos s
thePic =
rotate (_cameraRot (_cWorld w))
rotate (w ^. cWorld . cwCam . cwcRot)
. scale theScale theScale
. centerText
. soundToOnomato
src/Dodge/Save.hs
+1 -1
View File
@@ -47,7 +47,7 @@ saveSlotPath QuicksaveSlot = "saveSlot/QuickSave"
saveSlotPath (LevelStartSlot i) = "saveSlot/LevelStart" ++ show i
saveWorldInSlot :: SaveSlot -> Universe -> Universe
saveWorldInSlot slot u = tryConcEffect False "ASDF" (writeSaveSlot slot u) u
saveWorldInSlot slot u = tryConcEffect False "SAVING" (writeSaveSlot slot u) u
reloadLevelStart :: Universe -> Universe
reloadLevelStart = loadSaveSlot (LevelStartSlot 0)
src/Dodge/SoundLogic.hs
+2 -2
View File
@@ -212,9 +212,9 @@ soundAngle p w
. radToDeg
. normalizeAngle
. (+ pi)
$ argV (vNormal (p -.- earPos)) - _cameraRot (_cWorld w)
$ argV (vNormal (p -.- earPos)) - _cwcRot (_cwCam (_cWorld w))
where
earPos = _cameraViewFrom (_cWorld w)
earPos = w ^. cWorld . cwCam . cwcViewFrom
{- | Uses the first free origin from a list.
Does nothing if all origins are already creating sounds.
src/Dodge/StartNewGame.hs
+2 -1
View File
@@ -22,7 +22,8 @@ startSeedGame _ i = tryConcEffect True "GENERATING" (startSeedGameConc i)
startSeedGameConc :: Int -> IO (Universe -> Maybe Universe)
startSeedGameConc seed = do
w <- generateWorldFromSeed seed
return $ Just
writeFile "saveSlot/seed" $ show seed
return $ Just
. saveWorldInSlot (LevelStartSlot 0)
. (uvScreenLayers .~ [])
. (uvWorld .~ w)
src/Dodge/Update/Camera.hs
+17 -17
View File
@@ -45,11 +45,11 @@ updateCamera uv =
moveZoomCamera :: Universe -> Universe
moveZoomCamera uv =
uv
& uvWorld . cWorld . cameraCenter .~ newcen
& uvWorld . cWorld . cameraViewFrom .~ newvf
& uvWorld . cWorld . cameraZoom .~ newzoom
& uvWorld . cWorld . defaultZoom .~ newDefaultZoom
& uvWorld . cWorld . itemZoom .~ newItemZoom
& uvWorld . cWorld . cwCam . cwcCenter .~ newcen
& uvWorld . cWorld . cwCam . cwcViewFrom .~ newvf
& uvWorld . cWorld . cwCam . cwcZoom .~ newzoom
& uvWorld . cWorld . cwCam . cwcDefaultZoom .~ newDefaultZoom
& uvWorld . cWorld . cwCam . cwcItemZoom .~ newItemZoom
where
cfig = _uvConfig uv
w = _uvWorld uv
@@ -64,7 +64,7 @@ moveZoomCamera uv =
guard (SDL.ButtonRight `M.member` _mouseButtons w)
yourItem w ^? _Just . itScope . scopePos
newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset
offset = rotateV (_cameraRot (_cWorld w)) $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos w
offset = rotateV (w ^. cWorld . cwCam . cwcRot) $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos w
--newzoom = changeZoom (_cameraZoom w) idealZoom'
newzoom = case yourItem w ^? _Just . itScope of
Just zs@ZoomScope{} -> _scopeZoom zs
@@ -72,17 +72,17 @@ moveZoomCamera uv =
idealDefaultZoom = clipZoom wallZoom
newDefaultZoom = case yourItem w ^? _Just . itScope of
Just zs@ZoomScope{} -> _scopeZoom zs
_ -> changeZoom (_defaultZoom (_cWorld w)) idealDefaultZoom
_ -> changeZoom (w ^. cWorld . cwCam . cwcDefaultZoom) idealDefaultZoom
idealItemZoom = fromMaybe 1 $ do
guard $ crIsAiming (you w)
zoomFromItem' <$> (yourItem w ^? _Just . itUse . heldAim . aimZoom)
newItemZoom = changeZoom (_itemZoom (_cWorld w)) idealItemZoom
newItemZoom = changeZoom (w ^. cWorld . cwCam . cwcItemZoom) idealItemZoom
changeZoom curZoom idealZoom
| curZoom > idealZoom + 0.01 = ((zoomOutSpeed -1) * curZoom + idealZoom) / zoomOutSpeed
| curZoom < idealZoom - 0.01 = ((zoomInSpeed -1) * curZoom + idealZoom) / zoomInSpeed
| otherwise = idealZoom
--wallZoom = farWallDist newvf cfig w
wallZoom = min4 (_boundDist (_cWorld w))
wallZoom = min4 (w ^. cWorld . cwCam . cwcBoundDist)
min4 (a, b, c, d) = minimum [hh / maxd a, hh / maxd (- b), hw / maxd c, hw / maxd (- d)]
maxd = max distFromEqmnt
distFromEqmnt = foldr max 1 $ IM.mapMaybe (_eeViewDist . _equipEffect . _itUse) $ getCrEquipment $ you w
@@ -135,7 +135,7 @@ zoomInLongGun w
wp = _crInv (_creatures (_cWorld w) IM.! 0) IM.! crSel (_creatures (_cWorld w) IM.! 0)
Just currentZoom = wp ^? itScope . scopeZoom
newzoom = (wp ^?! itScope . scopeZoom) / zoomSpeed
mousep = rotateV (_cameraRot (_cWorld w)) $ _mousePos w
mousep = rotateV (w ^. cWorld . cwCam . cwcRot) $ _mousePos w
zoomOutLongGun :: World -> World
zoomOutLongGun w
@@ -171,11 +171,11 @@ rotateToOverlappingWall w =
p = _crPos (you w)
doWallRotate :: Wall -> World -> World
doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - _cameraRot (_cWorld w)
doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - (w ^. cWorld . cwCam . cwcRot)
where
rotateUsing a
| b - b' > 0.01 = w & cWorld . cameraRot +~ 0.01
| b - b' < negate 0.01 = w & cWorld . cameraRot -~ 0.01
| b - b' > 0.01 = w & cWorld . cwCam . cwcRot +~ 0.01
| b - b' < negate 0.01 = w & cWorld . cwCam . cwcRot -~ 0.01
| otherwise = w
where
--b = a * (2 / pi)
@@ -185,7 +185,7 @@ doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - _camer
rotateCameraBy :: Float -> World -> World
rotateCameraBy x w =
w
& cWorld . cameraRot +~ x
& cWorld . cwCam . cwcRot +~ x
& cWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_cWorld w) IM.! 0))
. itScope
. scopePos
@@ -221,8 +221,8 @@ clipZoom = min 20 . max 0.2
setViewDistance :: Configuration -> World -> World
setViewDistance cfig w =
w & cWorld . viewDistance
.~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / _cameraZoom (_cWorld w)
w & cWorld . cwCam . cwcViewDistance
.~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. cWorld . cwCam . cwcZoom)
-- .~ max (halfWidth cfig) (halfHeight cfig) / _cameraZoom w
@@ -245,7 +245,7 @@ farWallDistDirection p w =
boundPoints $
S.map f vps
where
f q = (rotateV (negate $ _cameraRot (_cWorld w)) . (-.- p)) (foldl' findPoint q (wls q))
f q = (rotateV (negate $ (w ^. cWorld . cwCam . cwcRot)) . (-.- p)) (foldl' findPoint q (wls q))
wls q = filter wlIsOpaque $ wlsNearSeg p q w
findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine
vps = streamViewpoints p w
src/Dodge/Update/UsingInput.hs
+1 -1
View File
@@ -60,7 +60,7 @@ updatePressedButtons' pkeys w
w & hammers . ix DoubleMouseHam .~ HammerDown
| isDown ButtonRight && inTopInv = w
| isDown ButtonMiddle =
w & cWorld . cameraRot -~ rotation
w & cWorld . cwCam . cwcRot -~ rotation
& cWorld . clickMousePos .~ _mousePos w
| isDown ButtonLeft = w & hammers . ix DoubleMouseHam .~ HammerDown
| otherwise = w
src/Dodge/WorldEffect.hs
+1 -1
View File
@@ -58,7 +58,7 @@ accessTerminal mtmid w = case mtmid of
torqueCr :: Float -> Int -> World -> World
torqueCr x cid w
| cid == 0 = set randGen g $ over (cWorld . cameraRot) (+ rot) w
| cid == 0 = set randGen g $ over (cWorld . cwCam . cwcRot) (+ rot) w
| otherwise = set randGen g $ over (cWorld . creatures . ix cid . crDir) (+ rot) w
where
(rot, g) = randomR (- x, x) $ _randGen w
src/Dodge/Zone.hs
+1 -1
View File
@@ -56,7 +56,7 @@ zoneOfSight x' w = S.each
]
where
--(xs,ys) = unzip $ map zoneOfPoint $ screenPolygon cfig w -- ++ [_cameraViewFrom w]
(xs,ys) = unzip $ map (sizeZoneOfPoint x') $ _boundBox $ _cWorld w -- ++ [_cameraViewFrom w]
(xs,ys) = unzip $ map (sizeZoneOfPoint x') $ w ^. cWorld . cwCam . cwcBoundBox
sizeZoneOfPoint s (V2 x y) = (f x, f y)
where
f = floor . (/ s)
src/Dodge/Zoning/World.hs
+2 -1
View File
@@ -2,6 +2,7 @@ module Dodge.Zoning.World where
import Dodge.Data.World
import Geometry.Data
import Control.Lens
zoneOfSight' :: Float -> World -> [Int2]
zoneOfSight' s w =
@@ -10,7 +11,7 @@ zoneOfSight' s w =
, b <- [minimum ys .. maximum ys]
]
where
(xs, ys) = unzip $ map sizeZoneOfPoint $ _boundBox (_cWorld w) -- ++ [_cameraViewFrom w]
(xs, ys) = unzip $ map sizeZoneOfPoint $ w ^. cWorld . cwCam . cwcBoundBox
sizeZoneOfPoint (V2 x y) = (f x, f y)
where
f = floor . (/ s)