diff --git a/src/Dodge/Config/Data.hs b/src/Dodge/Config/Data.hs index 3a1e1f30e..704eb5e4d 100644 --- a/src/Dodge/Config/Data.hs +++ b/src/Dodge/Config/Data.hs @@ -11,7 +11,7 @@ data Configuration = Configuration , _volume_music :: Float , _wall_textured :: Bool , _cloud_shadows :: Bool - , _resolution_factor :: Int -- ^ Higher values divide screen size, i.e. make the resolution worse + , _resolution_factor :: ResFactor , _windowX :: Float , _windowY :: Float , _windowPosX :: Int @@ -25,6 +25,17 @@ data Configuration = Configuration , _debug_pathing :: Bool } deriving (Generic, Show) +data ResFactor = FullRes | HalfRes | QuarterRes + deriving (Generic, Show, Eq, Ord, Enum, Bounded) +instance ToJSON ResFactor where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ResFactor +resFactorNum :: ResFactor -> Int +resFactorNum rf = case rf of + FullRes -> 1 + HalfRes -> 2 + QuarterRes -> 4 + makeLenses ''Configuration instance ToJSON Configuration where @@ -39,7 +50,7 @@ defaultConfig = Configuration , _volume_music = 1 , _wall_textured = True , _cloud_shadows = True - , _resolution_factor = 1 + , _resolution_factor = FullRes , _windowX = 800 , _windowY = 600 , _windowPosX = 0 diff --git a/src/Dodge/Config/Update.hs b/src/Dodge/Config/Update.hs index 732bc8c16..b08ea5a56 100644 --- a/src/Dodge/Config/Update.hs +++ b/src/Dodge/Config/Update.hs @@ -29,7 +29,7 @@ setVol :: Configuration -> IO () setVol cfig = do setSoundVolume ( _volume_master cfig * _volume_sound cfig) setMusicVolume ( _volume_master cfig * _volume_music cfig) - +-- what? setVolThen :: Configuration -> (a -> IO a) -> a -> IO a setVolThen cfig f a = do setVol cfig @@ -47,4 +47,4 @@ applyWorldConfig cfig pdata = do where x = round $ _windowX cfig y = round $ _windowY cfig - divRes = _resolution_factor cfig + divRes = resFactorNum $ _resolution_factor cfig diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index af190efe3..959eba526 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -144,29 +144,28 @@ performAction cr w ac = case ac of (imps , _) -> (imps, Just $ DoReplicatePartial sac (t-1) sac) NoAction -> ([],Nothing) -startReloadingWeapon - :: Creature - -> World - -> Maybe World +startReloadingWeapon :: Creature -> World -> Maybe World startReloadingWeapon cr w = let cid = _crID cr it = _crInv cr IM.! _crInvSel cr itRef = creatures . ix cid . crInv . ix (_crInvSel cr) in case it of - Weapon {_wpAmmo = LoadableAmmo {_wpMaxAmmo=maxA,_wpLoadedAmmo=lA ,_wpReloadState=rS,_wpReloadTime=rT}} - | lA < maxA && rS == 0 -> Just $ set ( itRef . wpAmmo . wpLoadedAmmo) maxA - $ set ( itRef . wpAmmo . wpReloadState) rT w + Weapon {_itConsumption = LoadableAmmo {_wpMaxAmmo=maxA,_wpLoadedAmmo=lA ,_wpReloadState=rS,_wpReloadTime=rT}} + | lA < maxA && rS == 0 -> Just $ set ( itRef . itConsumption . wpLoadedAmmo) maxA + $ set ( itRef . itConsumption . wpReloadState) rT w _ -> Nothing {- | Start reloading if clip is empty. -} crAutoReload :: Creature -> Creature -crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpAmmo . wpLoadedAmmo of +crAutoReload cr = case cr ^? ptrItConsumption' . wpLoadedAmmo of Just 0 | _posture (_crStance cr) /= Aiming - -> cr & crInv . ix (_crInvSel cr) . wpAmmo . wpReloadState %~ (`fromMaybe` reloadT) - & crInv . ix (_crInvSel cr) . wpAmmo . wpLoadedAmmo %~ (`fromMaybe` maxA) + -> cr & ptrItConsumption . wpReloadState %~ (`fromMaybe` reloadT) + & ptrItConsumption . wpLoadedAmmo %~ (`fromMaybe` maxA) _ -> cr where - reloadT = cr ^? crInv . ix (_crInvSel cr) . wpAmmo . wpReloadTime - maxA = cr ^? crInv . ix (_crInvSel cr) . wpAmmo . wpMaxAmmo + ptrItConsumption = crInv . ix (_crInvSel cr) . itConsumption + ptrItConsumption' = crInv . ix (_crInvSel cr) . itConsumption + reloadT = cr ^? ptrItConsumption' . wpReloadTime + maxA = cr ^? ptrItConsumption' . wpMaxAmmo {- | Teleport a creature to the mouse position -} blinkAction :: Creature diff --git a/src/Dodge/Creature/ReaderUpdate.hs b/src/Dodge/Creature/ReaderUpdate.hs index 636d0ad2d..d51132174 100644 --- a/src/Dodge/Creature/ReaderUpdate.hs +++ b/src/Dodge/Creature/ReaderUpdate.hs @@ -122,7 +122,7 @@ reloadOverrideR :: Creature -> Reader World Creature reloadOverrideR cr - | cr ^? crInv . ix (_crInvSel cr) . wpAmmo . wpLoadedAmmo == Just 0 + | cr ^? crInv . ix (_crInvSel cr) . itConsumption . wpLoadedAmmo == Just 0 && cr ^. crStance . posture == Aiming = return $ cr & crActionPlan . crStrategy .~ StrategyActions Reload reloadActions | otherwise = return cr diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index cf3225197..326389bf6 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -144,7 +144,7 @@ invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr) itpointer = creatures . ix (_crID cr) . crInv . ix i weaponReloadSounds :: Creature -> World -> World -weaponReloadSounds cr w = case cr ^? crInv . ix (_crInvSel cr) . wpAmmo of +weaponReloadSounds cr w = case cr ^? crInv . ix (_crInvSel cr) . itConsumption of Just am@LoadableAmmo{} -> case _wpReloadType am of PassiveReload stype |_wpReloadTime am ==_wpReloadState am -> soundContinue (CrReloadSound 0) (_crPos cr) stype Nothing w @@ -153,6 +153,7 @@ weaponReloadSounds cr w = case cr ^? crInv . ix (_crInvSel cr) . wpAmmo of ActiveReload | _wpReloadState am == 0 -> w ActiveReload -> soundContinue (CrReloadSound cid) (_crPos cr) reloadS (Just 1) w Just ChargeableAmmo {} -> w + Just ItemItselfConsumable {} -> w Nothing -> w where cid = _crID cr @@ -185,7 +186,7 @@ isFrictionless cr = case cr ^? crStance . carriage of _ -> False stepReloading :: Creature -> Creature -stepReloading cr = over (crInv . ix iSel . wpAmmo . wpReloadState) decreaseToZero cr +stepReloading cr = over (crInv . ix iSel . itConsumption . wpReloadState) decreaseToZero cr where iSel = _crInvSel cr diff --git a/src/Dodge/Creature/Test.hs b/src/Dodge/Creature/Test.hs index b9fa9a72b..ca610d721 100644 --- a/src/Dodge/Creature/Test.hs +++ b/src/Dodge/Creature/Test.hs @@ -35,12 +35,12 @@ onBoth :: (a -> b -> c) -> (d -> a) -> (d -> b) -> d -> c onBoth f g h x = f (g x) (h x) crIsReloading :: (World, Creature) -> Bool -crIsReloading (_,cr) = case cr ^? crInv . ix (_crInvSel cr) . wpAmmo . wpReloadState of +crIsReloading (_,cr) = case cr ^? crInv . ix (_crInvSel cr) . itConsumption . wpReloadState of Just t -> t > 0 _ -> False crIsReloadingR :: Creature -> Reader World Bool -crIsReloadingR cr = return $ case cr ^? crInv . ix (_crInvSel cr) . wpAmmo . wpReloadState of +crIsReloadingR cr = return $ case cr ^? crInv . ix (_crInvSel cr) . itConsumption . wpReloadState of Just t -> t > 0 _ -> False @@ -114,7 +114,7 @@ crAwayFromPostR cr = return $ case find sentinelGoal $ _crGoal $ _crActionPlan c sentinelGoal _ = False crHasAmmo :: (World,Creature) -> Bool -crHasAmmo (_,cr) = maybe False (> 0) $ cr ^? crInv . ix (_crInvSel cr) . wpAmmo . wpLoadedAmmo +crHasAmmo (_,cr) = maybe False (> 0) $ cr ^? crInv . ix (_crInvSel cr) . itConsumption . wpLoadedAmmo crCanShoot :: (World,Creature) -> Bool crCanShoot p = crIsAiming p && crHasAmmo p diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 667288184..e20d16483 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -133,7 +133,7 @@ data ScreenLayer = OptionScreen { _scTitle :: Universe -> String , _scOptions :: [MenuOption] - , _scDefaultEff :: Universe -> IO (Maybe Universe) -- IO (Maybe Universe)? + , _scDefaultEff :: Universe -> IO (Maybe Universe) , _scOptionFlag :: OptionScreenFlag } | ColumnsScreen String [(String,String)] @@ -148,19 +148,19 @@ data ScreenLayer data MenuOption = Toggle { _moKey :: Scancode - , _moEff :: Universe -> Maybe Universe + , _moEff :: Universe -> IO (Maybe Universe) , _moString :: Universe -> String } | Toggle2 { _moKey1 :: Scancode - , _moEff1 :: Universe -> Maybe Universe + , _moEff1 :: Universe -> IO (Maybe Universe) , _moKey2 :: Scancode - , _moEff2 :: Universe -> Maybe Universe + , _moEff2 :: Universe -> IO (Maybe Universe) , _moString :: Universe -> String } | InvisibleToggle { _moKey :: Scancode - , _moEff :: Universe -> Maybe Universe + , _moEff :: Universe -> IO (Maybe Universe) } data InventoryMode = TopInventory @@ -332,9 +332,9 @@ data AimParams = AimParams } _itUseAimStance :: Item -> AimStance _itUseAimStance = _aimStance . _useAim . _itUse -data ItemAmmo +data ItemConsumption = LoadableAmmo - { _aoType :: AmmoType + { _aoType :: AmmoType , _wpMaxAmmo :: Int , _wpLoadedAmmo :: Int , _wpReloadTime :: Int @@ -345,28 +345,38 @@ data ItemAmmo { _wpMaxCharge :: Int , _wpCharge :: Int } + | ItemItselfConsumable + { _itMaxStack' :: Int + , _itAmount' :: Int + } +data ItemType + = Weapon' + { _wpSpread :: Float + , _wpRange :: Float + , _wpNumBarrels :: Int + } + | UtilityItem + | ConsumableItem data Item = Weapon - { _itName :: String - , _wpAmmo :: ItemAmmo + { _itName :: String + , _itConsumption :: ItemConsumption , _itUse :: ItemUse - , _wpSpread :: Float - , _wpRange :: Float , _itFloorPict :: Item -> SPic - , _itZoom :: ItZoom + , _itZoom :: ItZoom , _itEquipPict :: Creature -> Int -> SPic , _itScroll :: Float -> Creature -> Item -> Item , _itIdentity :: ItemIdentity , _itAttachment :: ItAttachment - , _itID :: Maybe Int + , _itID :: Maybe Int , _itEffect :: ItEffect , _itInvDisplay :: Item -> String , _itInvColor :: Color , _itTargeting :: Maybe (World -> Maybe Point2, Int -> Item -> Creature -> World -> Picture) , _itWorldTrigger :: Maybe (Int -> World -> Bool) - , _wpNumBarrels :: Int , _itDimension :: ItemDimension , _itCurseStatus :: CurseStatus + , _itType :: ItemType } | Consumable { _itName :: String @@ -880,7 +890,7 @@ makeLenses ''ItemPos makeLenses ''ItEffect makeLenses ''ItZoom makeLenses ''FloorItem -makeLenses ''ItemAmmo +makeLenses ''ItemConsumption makeLenses ''AmmoType makeLenses ''PjParam makeLenses ''Prop @@ -907,3 +917,4 @@ makeLenses ''UseDelay makeLenses ''AimParams makeLenses ''Universe makeLenses ''LSParam +makeLenses ''ItemType diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index dc27eb9d2..13fe5303c 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/src/Dodge/Default/Weapon.hs @@ -11,7 +11,7 @@ import Geometry import Control.Lens -defaultAmmo :: ItemAmmo +defaultAmmo :: ItemConsumption defaultAmmo = LoadableAmmo { _aoType = GenericAmmo , _wpMaxAmmo = 15 @@ -84,7 +84,7 @@ defaultGun = Weapon { _itName = "default" , _itCurseStatus = Uncursed , _itIdentity = Pistol - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo , _itUse = defaultrUse , _wpSpread = 0.02 , _wpRange = 20 diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 649039d0a..f74dd9529 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -45,7 +45,7 @@ handleEvent e = case eventPayload e of MouseMotionEvent mmev -> return . handleMouseMotionEvent mmev MouseButtonEvent mbev -> return . handleMouseButtonEvent mbev MouseWheelEvent mwev -> return . handleMouseWheelEvent mwev - WindowSizeChangedEvent sev -> return . handleResizeEvent sev + WindowSizeChangedEvent sev -> handleResizeEvent sev WindowMovedEvent mev -> return . handleWindowMoveEvent mev _ -> return . Just @@ -74,8 +74,10 @@ handleWindowMoveEvent mev u = Just $ u P (V2 x y) = windowMovedEventPosition mev {- | Resets the world window size, and resizes the fbo that gets the light map drawn into it. -} -handleResizeEvent :: WindowSizeChangedEventData -> Universe -> Maybe Universe -handleResizeEvent sev u = Just $ u +-- using a sideeffect here for the io change seems to work better, more testing +-- later may be a good idea +handleResizeEvent :: WindowSizeChangedEventData -> Universe -> IO (Maybe Universe) +handleResizeEvent sev u = return . Just $ u & config . windowX .~ fromIntegral x & config . windowY .~ fromIntegral y & uvWorld . sideEffects %~ sideEffectUpdatePreload divRes x y @@ -83,7 +85,7 @@ handleResizeEvent sev u = Just $ u x = fromIntegral x' y = fromIntegral y' V2 x' y' = windowSizeChangedEventSize sev - divRes = u ^. config . resolution_factor + divRes = resFactorNum $ u ^. config . resolution_factor handlePressedMouseButton :: MouseButton -> Universe -> Maybe Universe handlePressedMouseButton but w @@ -123,14 +125,14 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of invKeyDown = ScancodeCapsLock `S.member` _keys w moveYourAmmoSel :: Int -> World -> World -moveYourAmmoSel i w = case yourItem w ^? wpAmmo . aoType. amPjParams of +moveYourAmmoSel i w = case yourItem w ^? itConsumption . aoType. amPjParams of Just l -> w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w)) - . wpAmmo . aoType. amParamSel %~ (`mod` length l) . subtract i + . itConsumption . aoType. amParamSel %~ (`mod` length l) . subtract i _ -> w moveYourAmmoParam :: Int -> World -> World -moveYourAmmoParam i w = case yourItem w ^? wpAmmo . aoType. amPjParams . ix paramid . pjMaxParam of +moveYourAmmoParam i w = case yourItem w ^? itConsumption . aoType. amPjParams . ix paramid . pjMaxParam of Just n -> w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w)) - . wpAmmo . aoType. amPjParams . ix paramid . pjIntParam %~ (`mod` n) . (+ i) + . itConsumption . aoType. amPjParams . ix paramid . pjIntParam %~ (`mod` n) . (+ i) _ -> w where - paramid = _amParamSel $ _aoType $ _wpAmmo $ yourItem w + paramid = _amParamSel $ _aoType $ _itConsumption $ yourItem w diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index 7af0deac4..eb4e60f82 100644 --- a/src/Dodge/Event/Menu.hs +++ b/src/Dodge/Event/Menu.hs @@ -5,7 +5,9 @@ module Dodge.Event.Menu import Dodge.Data import Dodge.Debug.Terminal import Dodge.Menu +import Dodge.Menu.PushPop +import Data.Maybe import Control.Monad --import Control.Lens import SDL @@ -14,28 +16,25 @@ handlePressedKeyInMenu :: ScreenLayer -> Scancode -> Universe -> IO (Maybe Unive handlePressedKeyInMenu mState scode = case mState of OptionScreen { _scOptions = mos, _scDefaultEff = defeff} -> optionListToEffects mos defeff scode - DisplayScreen {} -> return . popScreen - ColumnsScreen {} -> return . popScreen + DisplayScreen {} -> popScreen + ColumnsScreen {} -> popScreen WaitScreen {} -> return . Just InputScreen s -> case scode of - ScancodeEscape -> return . popScreen - ScancodeReturn -> return . popScreen . applyTerminalString s + ScancodeEscape -> popScreen + ScancodeReturn -> popScreen . applyTerminalString s ScancodeBackspace - -> return . (popScreen >=> pushScreen (InputScreen $ dropLast s)) - _ -> return . (popScreen >=> pushScreen (InputScreen $ s ++ [scodeToChar scode])) + -> return . (popScreen' >=> pushScreen' (InputScreen $ dropLast s)) + _ -> return . (popScreen' >=> pushScreen' (InputScreen $ s ++ [scodeToChar scode])) where dropLast (x:xs) = init (x:xs) dropLast _ = [] optionListToEffects :: [MenuOption] -> (Universe -> IO (Maybe Universe)) -> Scancode -> Universe -> IO (Maybe Universe) -optionListToEffects mos defaulteff sc w = case lookup sc listEffects of - Nothing -> defaulteff w - Just eff -> return $ eff w - where - listEffects = concatMap menuOptionToEffects mos +optionListToEffects mos defaulteff sc = fromMaybe defaulteff . + lookup sc $ concatMap menuOptionToEffects mos -menuOptionToEffects :: MenuOption -> [(Scancode,Universe -> Maybe Universe)] +menuOptionToEffects :: MenuOption -> [(Scancode,Universe -> IO (Maybe Universe))] menuOptionToEffects Toggle {_moKey = k, _moEff = eff} = [(k,eff)] menuOptionToEffects InvisibleToggle {_moKey = k, _moEff = eff} = [(k,eff)] menuOptionToEffects Toggle2 diff --git a/src/Dodge/Item/Weapon/AmmoParams.hs b/src/Dodge/Item/Weapon/AmmoParams.hs index 23b2a3680..1dd2d252d 100644 --- a/src/Dodge/Item/Weapon/AmmoParams.hs +++ b/src/Dodge/Item/Weapon/AmmoParams.hs @@ -34,12 +34,12 @@ defaultAimParams = AimParams useAmmoParams :: Item -> Creature -> World -> World useAmmoParams it = withVelWthHiteff (_amBulVel b) (_amBulWth b) (_amBulEff b) where - b = _aoType $ _wpAmmo it + b = _aoType $ _itConsumption it useAmmoParamsVelMod :: Float -> Item -> Creature -> World -> World useAmmoParamsVelMod vfact it = withDelayedVelWthHiteff vfact (_amBulVel b) (_amBulWth b) (_amBulEff b) where - b = _aoType $ _wpAmmo it + b = _aoType $ _itConsumption it {- | Creates a bullet with a given velocity, width, and 'HitEffect' -} withVelWthHiteff @@ -74,11 +74,11 @@ withDelayedVelWthHiteff vfact vel width hiteff cr = over particles (newbul : ) loadedAmmo :: Item -> Int loadedAmmo it - | _wpReloadState (_wpAmmo it) == 0 = _wpLoadedAmmo (_wpAmmo it) + | _wpReloadState (_itConsumption it) == 0 = _wpLoadedAmmo (_itConsumption it) | otherwise = 0 fractionLoadedAmmo :: Item -> Float -fractionLoadedAmmo it = fromIntegral (loadedAmmo it) / fromIntegral (_wpMaxAmmo (_wpAmmo it)) +fractionLoadedAmmo it = fromIntegral (loadedAmmo it) / fromIntegral (_wpMaxAmmo (_itConsumption it)) fractionLoadedAmmo2 :: Item -> Float -fractionLoadedAmmo2 it = 1 - (1 - fromIntegral (loadedAmmo it) / fromIntegral (_wpMaxAmmo (_wpAmmo it)))**2 +fractionLoadedAmmo2 it = 1 - (1 - fromIntegral (loadedAmmo it) / fromIntegral (_wpMaxAmmo (_itConsumption it)))**2 diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index f07c26510..3bc59c969 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -37,7 +37,7 @@ teslaGun :: Item teslaGun = defaultGun { _itName = "TESLA" , _itIdentity = TeslaGun - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _wpMaxAmmo = 200 , _wpLoadedAmmo = 200 , _wpReloadTime = 80 @@ -67,7 +67,7 @@ lasGun :: Item lasGun = defaultAutoGun { _itName = "LASGUN ////" , _itIdentity = LasGun - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _wpMaxAmmo = 200 , _wpLoadedAmmo = 200 , _wpReloadTime = 80 @@ -105,7 +105,7 @@ tractorGun :: Item tractorGun = defaultAutoGun { _itName = "TRACTORGUN" , _itIdentity = TractorGun - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _wpMaxAmmo = 10000 , _wpLoadedAmmo = 10000 , _wpReloadTime = 40 diff --git a/src/Dodge/Item/Weapon/Bezier.hs b/src/Dodge/Item/Weapon/Bezier.hs index 19867500c..9ca2d3424 100644 --- a/src/Dodge/Item/Weapon/Bezier.hs +++ b/src/Dodge/Item/Weapon/Bezier.hs @@ -42,7 +42,7 @@ bezierGun = defaultGun , _itScroll = \_ _ -> removeItTarget , _itEffect = rbSetTarget , _itZoom = defaultItZoom - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _wpMaxAmmo = 50 } } diff --git a/src/Dodge/Item/Weapon/Booster.hs b/src/Dodge/Item/Weapon/Booster.hs index 587e59c4f..5b5f3acd2 100644 --- a/src/Dodge/Item/Weapon/Booster.hs +++ b/src/Dodge/Item/Weapon/Booster.hs @@ -37,8 +37,8 @@ boostSelfL -> World -> World boostSelfL x cr invid w = case boostPoint x cr w of - Left p -> crEff p (wpAmmo . wpLoadedAmmo .~ 0) - Right p -> crEff p (wpAmmo . wpLoadedAmmo -~ 1) + Left p -> crEff p (itConsumption . wpLoadedAmmo .~ 0) + Right p -> crEff p (itConsumption . wpLoadedAmmo -~ 1) where cid = _crID cr cpos = _crPos cr @@ -113,7 +113,7 @@ boosterGun :: Item boosterGun = defaultGun { _itName = "BOOSTER" , _itIdentity = Blinker - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _wpMaxAmmo = 100 , _wpLoadedAmmo = 100 , _wpReloadTime = 20 diff --git a/src/Dodge/Item/Weapon/BulletGuns.hs b/src/Dodge/Item/Weapon/BulletGuns.hs index 06f4b46a5..6e787feee 100644 --- a/src/Dodge/Item/Weapon/BulletGuns.hs +++ b/src/Dodge/Item/Weapon/BulletGuns.hs @@ -34,7 +34,7 @@ autoGun :: Item autoGun = defaultAutoGun { _itName = "AUTOGUN" , _itIdentity = AutoGun - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _aoType = basicBullet , _wpMaxAmmo = 30 , _wpLoadedAmmo = 30 @@ -84,7 +84,7 @@ pistol :: Item pistol = defaultGun { _itName = "PISTOL" , _itIdentity = Pistol - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _aoType = basicBullet , _wpMaxAmmo = 15 , _wpLoadedAmmo = 15 @@ -128,7 +128,7 @@ hvAutoGun :: Item hvAutoGun = defaultAutoGun { _itName = "AUTO-HV" , _itIdentity = HvAutoGun - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _aoType = hvBullet , _wpMaxAmmo = 100 , _wpLoadedAmmo = 100 @@ -164,7 +164,7 @@ ltAutoGun :: Item ltAutoGun = defaultAutoGun { _itName = "AUTO-LT" , _itIdentity = LtAutoGun - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _aoType = ltBullet , _wpMaxAmmo = 25 , _wpLoadedAmmo = 25 @@ -200,7 +200,7 @@ miniGun :: Item miniGun = defaultAutoGun { _itName = "MINI-G" , _itIdentity = MiniGun - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _aoType = basicBullet , _wpMaxAmmo = 1500 , _wpLoadedAmmo = 1500 @@ -262,7 +262,7 @@ miniGun = defaultAutoGun miniGunPictItem :: Item -> SPic miniGunPictItem it = miniGunPict spin (loadedAmmo it) where - spin = (-10) * _wpLoadedAmmo (_wpAmmo it) + _warmTime (_useDelay $ _itUse it) + spin = (-10) * _wpLoadedAmmo (_itConsumption it) + _warmTime (_useDelay $ _itUse it) miniGunPict :: Int -> Int -> SPic miniGunPict spin am = @@ -290,7 +290,7 @@ spreadGun :: Item spreadGun = defaultGun { _itName = "SPREAD" , _itIdentity = SpreadGun - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _aoType = basicBullet , _wpMaxAmmo = 5 , _wpLoadedAmmo = 5 @@ -323,7 +323,7 @@ multGun :: Item multGun = defaultGun { _itName = "MULTGUN" , _itIdentity = MultGun - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _aoType = basicBullet , _wpMaxAmmo = 2 , _wpLoadedAmmo = 2 @@ -368,7 +368,7 @@ longGun :: Item longGun = defaultGun { _itName = "LONGGUN" , _itIdentity = LongGun - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _aoType = hvBullet , _wpMaxAmmo = 1 , _wpLoadedAmmo = 1 diff --git a/src/Dodge/Item/Weapon/Drone.hs b/src/Dodge/Item/Weapon/Drone.hs index b506de27c..d0bc2c1b3 100644 --- a/src/Dodge/Item/Weapon/Drone.hs +++ b/src/Dodge/Item/Weapon/Drone.hs @@ -22,7 +22,7 @@ lasDrones :: Item lasDrones = defaultGun { _itName = "DRONES" , _itIdentity = Generic - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _aoType = DroneAmmo { _amString = "LASDRONE" } , _wpMaxAmmo = 2 , _wpLoadedAmmo = 2 @@ -58,7 +58,7 @@ aDroneWithItemParams -> World aDroneWithItemParams it cr w = over props (IM.insert i theShell) w where - am = _wpAmmo it + am = _itConsumption it i = IM.newKey $ _props w pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) dir = _crDir cr diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index 55104726a..8353fd35c 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -79,10 +79,10 @@ itemLaserScopeEffect --glowPoint = case listToMaybe $ thingsHitLongLine sp xp w of -- Just (pos,E3x2 wl) -> pos +.+ 2 *.* wallNormal wl -- _ -> ep -.- 2 *.* unitVectorAtAngle d - it = (cr ^. crInv) IM.! invid + wpammo = _itConsumption $ (cr ^. crInv) IM.! invid reloadFrac - | _wpLoadedAmmo (_wpAmmo it) == 0 = 1 - | otherwise = fromIntegral (_wpReloadState (_wpAmmo it)) / fromIntegral (_wpReloadTime (_wpAmmo it)) + | _wpLoadedAmmo wpammo == 0 = 1 + | otherwise = fromIntegral (_wpReloadState wpammo) / fromIntegral (_wpReloadTime wpammo) --col = mixColors reloadFrac (1-reloadFrac) red green {- | Automatically send out radar pulses that detect walls. -} autoRadarEffect :: ItEffect diff --git a/src/Dodge/Item/Weapon/InventoryDisplay.hs b/src/Dodge/Item/Weapon/InventoryDisplay.hs index 31038c1a7..8dfa77361 100644 --- a/src/Dodge/Item/Weapon/InventoryDisplay.hs +++ b/src/Dodge/Item/Weapon/InventoryDisplay.hs @@ -15,11 +15,12 @@ basicWeaponDisplay :: Item -> String basicWeaponDisplay it = midPadL 10 ' ' thename (' ' : thenumber) ++ theparam where thename = _itName it - thenumber = case it ^? wpAmmo of + thenumber = case it ^? itConsumption of Just am@LoadableAmmo{} -> case _wpReloadState am of 0 -> show $ _wpLoadedAmmo am x -> "R" ++ show x Just am@ChargeableAmmo{} -> show $ _wpCharge am + Just x@ItemItselfConsumable{} -> show $ _itMaxStack' x Nothing -> "" theparam = fromMaybe [] . listToMaybe diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index 9c2953b96..76ba12e2d 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -37,7 +37,7 @@ launcher :: Item launcher = defaultGun { _itName = "ROCKO" , _itIdentity = Launcher - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _aoType = defaultShellAmmo { _amPayload = makeExplosionAt , _amString = "" @@ -140,7 +140,7 @@ aRocketWithItemParams -> World aRocketWithItemParams it cr w = over props (IM.insert i theShell) w where - am = _wpAmmo it + am = _itConsumption it i = IM.newKey $ _props w pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) dir = _crDir cr @@ -240,7 +240,7 @@ remoteLauncher :: Item remoteLauncher = defaultGun { _itName = "ROCKO-REM" , _itIdentity = RemoteLauncher - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _aoType = defaultShellAmmo { _amPayload = makeExplosionAt , _amString = "" diff --git a/src/Dodge/Item/Weapon/Radar.hs b/src/Dodge/Item/Weapon/Radar.hs index a38c558fb..2b961e875 100644 --- a/src/Dodge/Item/Weapon/Radar.hs +++ b/src/Dodge/Item/Weapon/Radar.hs @@ -22,7 +22,7 @@ radar :: Item radar = defaultGun { _itName = "RADAR" , _itIdentity = Generic - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _wpMaxAmmo = 100 , _wpLoadedAmmo = 100 , _wpReloadTime = 200 @@ -44,7 +44,7 @@ sonar :: Item sonar = defaultGun { _itName = "SONAR" , _itIdentity = Generic - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _wpMaxAmmo = 100 , _wpLoadedAmmo = 100 , _wpReloadTime = 200 diff --git a/src/Dodge/Item/Weapon/Spawn.hs b/src/Dodge/Item/Weapon/Spawn.hs index 5a8bd51c4..19e8d4580 100644 --- a/src/Dodge/Item/Weapon/Spawn.hs +++ b/src/Dodge/Item/Weapon/Spawn.hs @@ -17,7 +17,7 @@ Creates a creature next to the creature using the item. -} spawnGun :: Creature -> Item spawnGun cr = defaultGun { _itName = "SPAWNER" - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _wpMaxAmmo = 1 , _wpLoadedAmmo = 1 , _wpReloadTime = 80 diff --git a/src/Dodge/Item/Weapon/SprayGuns.hs b/src/Dodge/Item/Weapon/SprayGuns.hs index add92322e..aeb2b14ad 100644 --- a/src/Dodge/Item/Weapon/SprayGuns.hs +++ b/src/Dodge/Item/Weapon/SprayGuns.hs @@ -34,7 +34,7 @@ poisonSprayer :: Item poisonSprayer = defaultAutoGun { _itName = "POISON" , _itIdentity = PoisonSprayer - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _wpMaxAmmo = 500 , _wpLoadedAmmo = 500 , _wpReloadTime = 100 @@ -58,7 +58,7 @@ flamer :: Item flamer = defaultAutoGun { _itName = "FLAMER" , _itIdentity = Flamethrower - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _wpMaxAmmo = 250 , _wpLoadedAmmo = 250 , _wpReloadTime = 100 diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index c7abc0572..18a8d8336 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -95,10 +95,13 @@ withThickSmokeI eff item cr w = eff item cr -- fire. ammoCheckI :: ChainEffect ammoCheckI eff item cr w - | _wpLoadedAmmo (_wpAmmo item) <= 0 - = fromMaybe w (startReloadingWeapon cr w) - | _wpReloadState (_wpAmmo item) > 0 = w + | _wpLoadedAmmo (_itConsumption item) <= 0 = fromMaybe w (startReloadingWeapon cr w) + | _wpReloadState (_itConsumption item) > 0 = w | otherwise = eff item cr w + +itUseAmmo :: Int -> Item -> Item +itUseAmmo x = itConsumption . wpLoadedAmmo %~ (max 0 . subtract x) + {- | Fires at an increasing rate. Has different effect after first fire. Applies ammo check and use cooldown check. -} @@ -109,12 +112,12 @@ rateIncAB rateIncAB exeffFirst exeffCont eff item cr w | repeatFire = w & pointItem %~ ( (itUse . useDelay . rateMax .~ max fastRate (currentRate - 1)) - . (wpAmmo . wpLoadedAmmo -~ 1) + . itUseAmmo 1 . (itUse . useDelay . rateTime .~ currentRate) ) & exeffCont eff item cr | firstFire = w & pointItem %~ ( (itUse . useDelay . rateMax .~ startRate - 1) - . (wpAmmo . wpLoadedAmmo -~ 1) + . itUseAmmo 1 . (itUse . useDelay . rateTime .~ startRate) ) & exeffFirst eff item cr | otherwise = w @@ -125,15 +128,15 @@ rateIncAB exeffFirst exeffCont eff item cr w itRef = _crInvSel cr pointItem = creatures . ix cid . crInv . ix itRef currentRate = _rateMax (_useDelay (_itUse item)) - repeatFire = _wpReloadState (_wpAmmo item) == 0 && _rateTime (_useDelay (_itUse item)) == 1 - firstFire = _wpReloadState (_wpAmmo item) == 0 && _rateTime (_useDelay (_itUse item)) == 0 + repeatFire = _wpReloadState (_itConsumption item) == 0 && _rateTime (_useDelay (_itUse item)) == 1 + firstFire = _wpReloadState (_itConsumption item) == 0 && _rateTime (_useDelay (_itUse item)) == 0 {- | Apply effect after a warm up. -} -- note this is quite unsafe, requires the item to have the correct delay type withWarmUp :: SoundID -- ^ warm up sound id -> ChainEffect withWarmUp soundID f item cr w - | _wpReloadState (_wpAmmo item) /= 0 = w + | _wpReloadState (_itConsumption item) /= 0 = w | curWarmUp < maxWarmUp = w & pointerToItem . itUse . useDelay . warmTime +~ 2 & soundContinue (CrWeaponSound cid 0) (_crPos cr) soundID (Just 2) @@ -218,7 +221,7 @@ useAmmo :: Int -- ^ amount of ammo to use -> ChainEffect useAmmo amAmount eff item cr = eff item cr - . (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . wpAmmo . wpLoadedAmmo -~ amAmount) + . (creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itConsumption . wpLoadedAmmo -~ amAmount) {- | Applies a world effect after an item use cooldown check. -} useTimeCheck :: ChainEffect @@ -243,7 +246,7 @@ hammerCheckI f it cr w = case it ^? itUse . useHammer . hammerPosition of ammoUseCheck :: ChainEffect ammoUseCheck f item cr w | fireCondition = f item cr w & pointerToItem %~ - ( (wpAmmo . wpLoadedAmmo -~ 1) + ( itUseAmmo 1 . (itUse . useDelay . rateTime .~ _rateMax ( _useDelay (_itUse item)) )) | reloadCondition = fromMaybe w $ startReloadingWeapon cr w | otherwise = w @@ -251,10 +254,10 @@ ammoUseCheck f item cr w cid = _crID cr itRef = _crInvSel cr pointerToItem = creatures . ix cid . crInv . ix itRef - fireCondition = _wpReloadState (_wpAmmo item) == 0 + fireCondition = _wpReloadState (_itConsumption item) == 0 && _rateTime (_useDelay (_itUse item)) == 0 - && _wpLoadedAmmo (_wpAmmo item) > 0 - reloadCondition = _wpLoadedAmmo (_wpAmmo item) == 0 + && _wpLoadedAmmo (_itConsumption item) > 0 + reloadCondition = _wpLoadedAmmo (_itConsumption item) == 0 {- | Applies a world effect after a hammer position check. Arbitrary inventory position. -} hammerCheckL @@ -278,7 +281,7 @@ shootL -> World shootL f cr invid w | fireCondition = f cr invid w & pointerToItem %~ - ( (wpAmmo . wpLoadedAmmo -~ 1) + ( itUseAmmo 1 . (itUse . useDelay . rateTime .~ _rateMax (_useDelay (_itUse item))) ) | reloadCondition = fromMaybe w $ startReloadingWeapon cr w | otherwise = w @@ -286,10 +289,10 @@ shootL f cr invid w cid = _crID cr item = _crInv cr IM.! invid pointerToItem = creatures . ix cid . crInv . ix invid - fireCondition = _wpReloadState (_wpAmmo item) == 0 + fireCondition = _wpReloadState (_itConsumption item) == 0 && _rateTime (_useDelay (_itUse item)) == 0 - && _wpLoadedAmmo (_wpAmmo item) > 0 - reloadCondition = _wpLoadedAmmo (_wpAmmo item) == 0 + && _wpLoadedAmmo (_itConsumption item) > 0 + reloadCondition = _wpLoadedAmmo (_itConsumption item) == 0 withTempLight :: Int -> Float -> V3 Float -> ChainEffect withTempLight time rad col eff item cr = eff item cr . over tempLightSources (theTLS :) diff --git a/src/Dodge/Item/Weapon/Utility.hs b/src/Dodge/Item/Weapon/Utility.hs index 1828b78a3..da39c561d 100644 --- a/src/Dodge/Item/Weapon/Utility.hs +++ b/src/Dodge/Item/Weapon/Utility.hs @@ -20,7 +20,7 @@ rewindGun :: Item rewindGun = defaultGun { _itName = "REWINDER" , _itIdentity = Rewinder - , _wpAmmo = ChargeableAmmo + , _itConsumption = ChargeableAmmo { _wpMaxCharge = 250 , _wpCharge = 0 } @@ -30,11 +30,12 @@ rewindGun = defaultGun rewindEffect :: ItEffect -> Creature -> Int -> World -> World rewindEffect _ cr invid w | Just invid == _crLeftInvSel cr = w & rewindWorlds %~ (take maxcharge . (w' : )) - & creatures . ix (_crID cr) . crInv . ix invid . wpAmmo . wpCharge .~ length (_rewindWorlds w) + & ptrWpCharge .~ length (_rewindWorlds w) | otherwise = w & rewindWorlds .~ [] - & creatures . ix (_crID cr) . crInv . ix invid . wpAmmo . wpCharge .~ 0 + & ptrWpCharge .~ 0 where - maxcharge = _wpMaxCharge . _wpAmmo $ _crInv cr IM.! invid + ptrWpCharge = creatures . ix (_crID cr) . crInv . ix invid . itConsumption . wpCharge + maxcharge = _wpMaxCharge . _itConsumption $ _crInv cr IM.! invid w' = w & rewindWorlds .~ [] & rewinding .~ True @@ -55,7 +56,7 @@ shrinkGun :: Item shrinkGun = defaultGun { _itName = "SHRINKER" , _itIdentity = Generic - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _wpMaxAmmo = 100 , _wpLoadedAmmo = 100 , _wpReloadTime = 20 @@ -87,7 +88,7 @@ blinkGun :: Item blinkGun = defaultGun { _itName = "BLINKER" , _itIdentity = Blinker - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _wpMaxAmmo = 100 , _wpLoadedAmmo = 100 , _wpReloadTime = 20 @@ -121,7 +122,7 @@ forceFieldGun :: Item forceFieldGun = defaultGun { _itName = "FORCEFIELD" , _itIdentity = ForceFieldGun - , _wpAmmo = defaultAmmo + , _itConsumption = defaultAmmo { _wpMaxAmmo = 100 , _wpLoadedAmmo = 100 , _wpReloadTime = 40 diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 6d23f2df1..b1d8cecfd 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -6,6 +6,9 @@ module Dodge.Menu , gameOverMenu ) where +import LensHelp +import Dodge.Menu.OptionType +import Dodge.Menu.PushPop import Dodge.Data import Dodge.PreloadData import Dodge.Save @@ -16,12 +19,14 @@ import SDL.Internal.Numbered import Dodge.SoundLogic import Dodge.LevelGen -import Control.Lens +--import Control.Lens import System.Random -titleOptions title ops = titleOptionsEff title ops (return . popScreen . writeConfig) +slTitleOptions :: String -> [MenuOption] -> ScreenLayer +slTitleOptions title ops = slTitleOptionsEff title ops (popScreen . writeConfig) -titleOptionsEff title ops eff = OptionScreen +slTitleOptionsEff :: String -> [MenuOption] -> (Universe -> IO (Maybe Universe)) -> ScreenLayer +slTitleOptionsEff title ops eff = OptionScreen { _scTitle = const title , _scOptions = ops , _scDefaultEff = eff @@ -29,19 +34,17 @@ titleOptionsEff title ops eff = OptionScreen } optionMenu :: ScreenLayer -optionMenu = titleOptionsEff "OPTIONS" optionsOptions (return . popScreen) +optionMenu = slTitleOptionsEff "OPTIONS" optionsOptions popScreen optionsOptions :: [MenuOption] optionsOptions = - [ anOption ScancodeV soundMenu "VOLUME" - , anOption ScancodeG graphicsMenu "GRAPHICS" - , anOption ScancodeP gameplayMenu "GAMEPLAY" - , anOption ScancodeD debugMenu "DEBUG OPTIONS" + [ makeSubmenuOption ScancodeV soundMenu "VOLUME" + , makeSubmenuOption ScancodeG graphicsMenu "GRAPHICS" + , makeSubmenuOption ScancodeP gameplayMenu "GAMEPLAY" + , makeSubmenuOption ScancodeD debugMenu "DEBUG OPTIONS" ] - where - anOption scode submenu t = Toggle scode (pushScreen submenu) (const t) debugMenu :: ScreenLayer -debugMenu = titleOptions +debugMenu = slTitleOptions "OPTIONS:GAMEPLAY" debugMenuOptions debugMenuOptions :: [MenuOption] @@ -54,77 +57,54 @@ debugMenuOptions = ] where doption scode l t rec - = Toggle scode (Just . (config . l %~ not)) (\w -> t ++ ":" ++ show (rec $ _config w)) + = Toggle scode (return . Just . (config . l %~ not)) (\w -> t ++ ":" ++ show (rec $ _config w)) gameplayMenu :: ScreenLayer -gameplayMenu = titleOptions +gameplayMenu = slTitleOptions "OPTIONS:GAMEPLAY" gameplayMenuOptions gameplayMenuOptions :: [MenuOption] gameplayMenuOptions = - [ option ScancodeR rotate_to_wall "ROTATE TO WALL" _rotate_to_wall - , option ScancodeS show_sound "SHOW VISUAL SOUNDS" _show_sound + [ makeBoolOption ScancodeR rotate_to_wall "ROTATE TO WALL" + , makeBoolOption ScancodeS show_sound "SHOW VISUAL SOUNDS" ] - where - option scode l t rec = Toggle scode (Just . (config . l %~ not)) - (\w -> t ++ ":" ++ show (rec $ _config w)) + soundMenu :: ScreenLayer -soundMenu = titleOptions +soundMenu = slTitleOptions "OPTIONS:VOLUME" soundMenuOptions soundMenuOptions :: [MenuOption] soundMenuOptions = - [ Toggle2 ScancodeY (master dec . sw) - ScancodeU (master inc . sw) (\w -> "MASTER VOLUME:" ++ mavol w) - , Toggle2 ScancodeH (soundEffs dec . sw) - ScancodeJ (soundEffs inc . sw) (\w -> "EFFECTS VOLUME:" ++ snvol w) - , Toggle2 ScancodeN (music dec . sw) - ScancodeM (music inc . sw) (\w -> "MUSIC VOLUME:" ++ muvol w) + [ theoption ScancodeY volume_master ScancodeU "MASTER VOLUME:" _volume_master + , theoption ScancodeH volume_sound ScancodeJ "EFFECTS VOLUME:" _volume_sound + , theoption ScancodeN volume_music ScancodeM "MUSIC VOLUME:" _volume_music ] where + theoption scod1 stype scod2 str voltype = Toggle2 + scod1 + (change dec stype) + scod2 + (change inc stype) + (\w -> str ++ show (round $ 10 * voltype (_config w)::Int)) + change g vt = return . Just . (config . vt %~ g) . sw dec x = max 0 (x - 0.1) inc x = min 1 (x + 0.1) sw w = w & uvWorld . sideEffects %~ setVolThen (_config w) - master g = Just . (config . volume_master %~ g) - soundEffs g = Just . (config . volume_sound %~ g) - music g = Just . (config . volume_music %~ g) - cfig w = _config w - mavol w = f $ _volume_master $ cfig w - snvol w = f $ _volume_sound $ cfig w - muvol w = f $ _volume_music $ cfig w - f x = show (round $ 10 * x :: Int) - -pushScreen :: ScreenLayer -> Universe -> Maybe Universe -pushScreen ml w = Just $ w & menuLayers %~ (ml :) - -popScreen :: Universe -> Maybe Universe -popScreen = Just . (menuLayers %~ tail) writeConfig :: Universe -> Universe writeConfig w = w & uvWorld . sideEffects %~ saveConfig (_config w) graphicsMenu :: ScreenLayer -graphicsMenu = titleOptions "OPTIONS:GRAPHICS" graphicsMenuOptions +graphicsMenu = slTitleOptions "OPTIONS:GRAPHICS" graphicsMenuOptions graphicsMenuOptions :: [MenuOption] graphicsMenuOptions = - [ Toggle ScancodeW (Just . (config . wall_textured %~ not)) wtextstring - , Toggle ScancodeS upf resostring - , Toggle ScancodeD (Just . (config . cloud_shadows %~ not)) cshadstring + [ makeEnumOption ScancodeS resolution_factor "RESOLUTION" updateFramebufferSize + , makeBoolOption ScancodeW wall_textured "WALL TEXTURES" + , makeBoolOption ScancodeD cloud_shadows "CLOUD SHADOWS" ] - where - wtextstring w = "WALL TEXTURES:" ++ show (_wall_textured $ _config w) - resostring w = "RESOLUTION: 1/" ++ show (_resolution_factor $ _config w) - upf w = Just $ updateFramebufferSize $ w & config . resolution_factor %~ cycleResolution - cshadstring w = "CLOUD SHADOWS:" ++ show (_cloud_shadows $ _config w) - -cycleResolution :: (Eq a, Num a, Num p) => a -> p -cycleResolution 1 = 2 -cycleResolution 2 = 4 -cycleResolution 4 = 1 -cycleResolution _ = 1 gameOverMenu :: ScreenLayer gameOverMenu = OptionScreen @@ -135,15 +115,15 @@ gameOverMenu = OptionScreen } pauseMenu :: ScreenLayer -pauseMenu = titleOptionsEff "PAUSED" pauseMenuOptions (return . unpause) +pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause) pauseMenuOptions :: [MenuOption] pauseMenuOptions = - [ Toggle ScancodeN startNewGame (const "NEW LEVEL") - , Toggle ScancodeR (Just . loadSaveSlot LevelStartSlot) (const "RESTART") + [ Toggle ScancodeN (return . startNewGame) (const "NEW LEVEL") + , Toggle ScancodeR (return . Just . loadSaveSlot LevelStartSlot) (const "RESTART") , Toggle ScancodeO (pushScreen optionMenu ) (const "OPTIONS") , Toggle ScancodeC (pushScreen displayControls) (const "CONTROLS") - , InvisibleToggle ScancodeEscape (const Nothing) + , InvisibleToggle ScancodeEscape (return . const Nothing) ] startNewGame :: Universe -> Maybe Universe startNewGame w = Just $ w @@ -154,10 +134,6 @@ startNewGame w = Just $ w where i = fst $ random (_randGen (_uvWorld w)) ---uvWorldSideEffects :: Int -> Universe -> b -> IO Universe ---uvWorldSideEffects i w = const (generateWorldFromSeed i <&> config .~ _config w) - - -- | hacky scodeToChar :: Scancode -> Char scodeToChar = toEnum . (+ 61) . fromIntegral . toNumber @@ -165,13 +141,6 @@ scodeToChar = toEnum . (+ 61) . fromIntegral . toNumber --charToScode :: Char -> Scancode --charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum -updateFramebufferSize :: Universe -> Universe -updateFramebufferSize u = u & uvWorld . sideEffects %~ sideEffectUpdatePreload divRes x y - where - (x,y) = (round $ _windowX cfig, round $ _windowY cfig) - cfig = _config u - divRes = u ^. config . resolution_factor - --levelMenu :: Int -> ScreenLayer --levelMenu x = OptionScreen -- { _scTitle = const $ "LEVEL "++ show x diff --git a/src/Dodge/Menu/OptionType.hs b/src/Dodge/Menu/OptionType.hs new file mode 100644 index 000000000..1f9026811 --- /dev/null +++ b/src/Dodge/Menu/OptionType.hs @@ -0,0 +1,22 @@ +{-# OPTIONS -fno-warn-missing-signatures #-} +module Dodge.Menu.OptionType where +import Dodge.Data +import Dodge.Menu.PushPop +import Control.Lens + +makeBoolOption scode lns t = Toggle + scode + (return . Just . (config . lns #%~ not)) + (\u -> t ++ ":" ++ show (u ^# config . lns)) + +makeEnumOption scode lns str sideeff = Toggle + scode + (\u -> Just <$> sideeff (u & config . lns #%~ cycleEnum) ) + (\u -> str ++ ":" ++ show (u ^# config . lns)) + +makeSubmenuOption scode submenu t = Toggle scode (pushScreen submenu) (const t) + +cycleEnum :: (Eq a, Enum a,Bounded a) => a -> a +cycleEnum x + | x == maxBound = minBound + | otherwise = succ x diff --git a/src/Dodge/Menu/PushPop.hs b/src/Dodge/Menu/PushPop.hs new file mode 100644 index 000000000..9ffc5cd96 --- /dev/null +++ b/src/Dodge/Menu/PushPop.hs @@ -0,0 +1,14 @@ +module Dodge.Menu.PushPop where +import Dodge.Data +import LensHelp + +popScreen' :: Universe -> Maybe Universe +popScreen' = Just . (menuLayers %~ tail) +popScreen :: Universe -> IO (Maybe Universe) +popScreen = return . popScreen' + + +pushScreen' :: ScreenLayer -> Universe -> Maybe Universe +pushScreen' ml = Just . (menuLayers .:~ ml) +pushScreen :: ScreenLayer -> Universe -> IO (Maybe Universe) +pushScreen ml = return . pushScreen' ml diff --git a/src/Dodge/Placement/Instance/Sensor.hs b/src/Dodge/Placement/Instance/Sensor.hs index c3a755def..0dfe3c3a1 100644 --- a/src/Dodge/Placement/Instance/Sensor.hs +++ b/src/Dodge/Placement/Instance/Sensor.hs @@ -25,7 +25,7 @@ damageSensor damF wdth upf ps = pContID ps ( PutLS theLS) , _mcLSs = [lsid] } where - theLS = lsPosCol (V3 0 0 30) (0.1) + theLS = lsPosCol (V3 0 0 30) 0.1 lightSensor :: Float -> (Machine -> World -> World) -> PlacementSpot -> Placement lightSensor = damageSensor senseLasering diff --git a/src/Dodge/PreloadData.hs b/src/Dodge/PreloadData.hs index 4ece667b5..280bde1b8 100644 --- a/src/Dodge/PreloadData.hs +++ b/src/Dodge/PreloadData.hs @@ -15,3 +15,15 @@ sideEffectUpdatePreload :: Int -> Int -> Int -> (Universe -> IO Universe) -> Uni sideEffectUpdatePreload divRes x y f u = do pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData u) f $ u & preloadData .~ pdata + +updatePreload :: Int -> Int -> Int -> Universe -> IO Universe +updatePreload divRes x y u = do + pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData u) + return $ u & preloadData .~ pdata + +updateFramebufferSize :: Universe -> IO Universe +updateFramebufferSize u = updatePreload divRes x y u + where + (x,y) = (round $ _windowX cfig, round $ _windowY cfig) + cfig = _config u + divRes = resFactorNum $ u ^. config . resolution_factor diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 5399968fa..b08c002f3 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -38,7 +38,7 @@ doDrawing pdata u = do camzoom = _cameraZoom w trans = _cameraCenter w wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig) - resFact = cfig ^. resolution_factor + resFact = resFactorNum $ cfig ^. resolution_factor (wallPointsCol,windowPoints) = wallsAndWindows cfig w lightPoints = lightsForGloom w viewFroms@(V2 vfx vfy) = _cameraViewFrom w diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 72383457e..43c30147f 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -58,7 +58,7 @@ subInventoryDisplay cfig w = case _inventoryMode w of col = itCol it cursorsZ :: Configuration -> Int -> Item -> Picture -cursorsZ cfig ipos it = case it ^? wpAmmo . aoType . amParamSel of +cursorsZ cfig ipos it = case it ^? itConsumption . aoType . amParamSel of Nothing -> f $ zConnect sp (V2 (155- hw) ( hh - 77.5)) Just jpos -> f $ zConnect sp (V2 (155 - hw) ( hh - (20 * fromIntegral jpos + 77.5))) where @@ -75,12 +75,12 @@ topInvCursor col iPos cfig w | otherwise = mainListCursor col iPos cfig ammoTweakStrings :: Item -> [String] -ammoTweakStrings it = case it ^? wpAmmo . aoType . amPjParams of +ammoTweakStrings it = case it ^? itConsumption . aoType . amPjParams of Just l -> map pjTweakString l _ -> ["NOT TWEAKABLE"] mCurs :: Item -> Configuration -> World -> Picture -mCurs it cfig w = case it ^? wpAmmo . aoType . amParamSel of +mCurs it cfig w = case it ^? itConsumption . aoType . amParamSel of Nothing -> [] Just i | ButtonRight `S.member` _mouseButtons w ->