From 24a0cc289f9785311357c07e609aa132f842bb57 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 9 Dec 2021 14:36:26 +0000 Subject: [PATCH] Add menu option to start new game from seed, uses system clipboard --- appDodge/Main.hs | 10 +++-- package.yaml | 1 + src/Dodge/Creature/HandPos.hs | 20 ++++++++-- src/Dodge/Initialisation.hs | 4 +- src/Dodge/Item/Draw.hs | 13 ++----- src/Dodge/Item/Weapon/AmmoParams.hs | 6 ++- src/Dodge/Item/Weapon/BulletGun/Cane.hs | 2 +- src/Dodge/LevelGen.hs | 3 +- src/Dodge/Magnet.hs | 6 ++- src/Dodge/Menu.hs | 51 +++++++++++++------------ src/Dodge/Placement/Instance/Turret.hs | 13 ++++--- src/Dodge/Save.hs | 8 +++- src/Dodge/StartNewGame.hs | 18 +++++++++ 13 files changed, 101 insertions(+), 54 deletions(-) create mode 100644 src/Dodge/StartNewGame.hs diff --git a/appDodge/Main.hs b/appDodge/Main.hs index e2034df45..d3f7ae2c5 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -3,7 +3,9 @@ module Main ) where import Loop import Dodge.Data -import Dodge.LevelGen +import Dodge.StartNewGame +import Dodge.Initialisation +--import Dodge.LevelGen import Dodge.Update import Dodge.Event import Dodge.Render @@ -55,9 +57,9 @@ firstWorldLoad theConfig = do SDL.cursorVisible $= False theKeyConfig <- loadKeyConfig pdata <- doPreload >>= applyWorldConfig theConfig - w <- generateWorldFromSeed 0 - return $ Universe - {_uvWorld = w +-- w <- generateWorldFromSeed 0 + return $ startNewGame $ Universe + {_uvWorld = initialWorld ,_config = theConfig ,_preloadData = pdata ,_menuLayers = [] diff --git a/package.yaml b/package.yaml index 537d3d1e5..3ae1ba63a 100644 --- a/package.yaml +++ b/package.yaml @@ -53,6 +53,7 @@ dependencies: - repa - monad-parallel - parallel +- Clipboard library: source-dirs: src diff --git a/src/Dodge/Creature/HandPos.hs b/src/Dodge/Creature/HandPos.hs index c3af75747..33ab98c85 100644 --- a/src/Dodge/Creature/HandPos.hs +++ b/src/Dodge/Creature/HandPos.hs @@ -1,6 +1,20 @@ module Dodge.Creature.HandPos where import Dodge.Data -import Geometry +--import Geometry +import Control.Lens +import Data.Maybe -crHandPos :: Creature -> Point3 -crHandPos _ = V3 0 0 20 +-- the position of a weapon handle +aimingWeaponHandlePos :: Creature -> Item -> Float +aimingWeaponHandlePos cr it = case it ^? itUse. useAim . aimStance of + Just TwoHandTwist -> -5 + Just OneHand -> 14 + Just TwoHandFlat -> 1.2 * _crRad cr + Just LeaveHolstered -> 0 + Nothing -> 0 +aimingWeaponZeroPos :: Creature -> Item -> Float +aimingWeaponZeroPos cr it = aimingWeaponHandlePos cr it + - fromMaybe 0 (it ^? itDimension . dimPortage . handlePos) +aimingMuzzlePos :: Creature -> Item -> Float +aimingMuzzlePos cr it = aimingWeaponZeroPos cr it + + fromMaybe 0 (it ^? itDimension . dimPortage . muzPos) diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index cfccb061e..5bd441444 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -1,7 +1,7 @@ module Dodge.Initialisation where import Dodge.Default.World import Dodge.Base -import Dodge.Save +--import Dodge.Save import Dodge.Data import Dodge.Creature --import Dodge.Story @@ -28,7 +28,7 @@ initialWorld = defaultWorld , _mousePos = V2 0 0 , _testString = testStringInit , _yourID = 0 - , _sideEffects = return .saveWorldInEmptySlot LevelStartSlot + , _sideEffects = return , _worldEvents = soundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing . foldr ((.) . makeStartCloudAt) id [V3 x y 5 | x <- [-5,-4..5] , y <- [-5,-4..5]] , _pressPlates = IM.empty diff --git a/src/Dodge/Item/Draw.hs b/src/Dodge/Item/Draw.hs index 14e9b9c19..663360b5a 100644 --- a/src/Dodge/Item/Draw.hs +++ b/src/Dodge/Item/Draw.hs @@ -4,6 +4,7 @@ import Dodge.Data --import Picture --import Shape import ShapePicture +import Dodge.Creature.HandPos import qualified Data.IntMap.Strict as IM import Control.Lens @@ -44,12 +45,8 @@ pictureWeaponOnAimItem -> Int -- ^ Position of item in inventory -> SPic pictureWeaponOnAimItem p' cr posInInv - | isSelected && _posture (_crStance cr) == Aiming && isTwisting - = shoulderD twistWep - | isSelected && _posture (_crStance cr) == Aiming && isOneHand - = shoulderD oneHandWep - | isSelected && _posture (_crStance cr) == Aiming && isTwoHandFlat - = shoulderD drawnWep + | isSelected && _posture (_crStance cr) == Aiming = + shoulderD $ translateSPf (aimingWeaponZeroPos cr theIt) 0 p' | isSelected && isTwoHandFlat = handD holsteredTwoFlat | isSelected && isOneHand @@ -61,9 +58,7 @@ pictureWeaponOnAimItem p' cr posInInv shoulderD = translateSPz 18 handD = translateSPz 15 isSelected = _crInvSel cr == posInInv - drawnWep = translateSPf (1.2 * _crRad cr) 0 p twistWep = translateSPf (-5) 0 p - oneHandWep = translateSPf 14 0 p holsteredWep = translateSPf (_crRad cr) 0 (rotateSP (strideRot cr + 1.2) (translateSPf (-5) 0 twistWep)) holsteredTwoFlat = translateSPf (_crRad cr) 0 (rotateSP (twoFlatHRot cr) p) @@ -76,13 +71,13 @@ pictureWeaponOnAimItem p' cr posInInv p = fromMaybe p' $ do x <- theIt ^? itDimension . dimPortage . handlePos return $translateSPf (-x) 0 p' - isTwisting = theIt ^? itUseAimStance == Just TwoHandTwist isOneHand = theIt ^? itUseAimStance == Just OneHand isTwoHandFlat = theIt ^? itUseAimStance == Just TwoHandFlat itUseAimStance = itUse . useAim . aimStance f i = 0.1 * fromIntegral (sLen - i) / fromIntegral sLen sLen = _strideLength $ _crStance cr + strideRot :: Creature -> Float strideRot cr = case cr ^? crStance . carriage of Just (Walking x LeftForward) -> f x diff --git a/src/Dodge/Item/Weapon/AmmoParams.hs b/src/Dodge/Item/Weapon/AmmoParams.hs index 2cfd96d61..44b0060f6 100644 --- a/src/Dodge/Item/Weapon/AmmoParams.hs +++ b/src/Dodge/Item/Weapon/AmmoParams.hs @@ -8,6 +8,7 @@ module Dodge.Item.Weapon.AmmoParams ) where import Dodge.Data import Dodge.Particle.Bullet.Spawn +import Dodge.Creature.HandPos import Geometry import LensHelp @@ -33,14 +34,15 @@ defaultAimParams = AimParams } useAmmoParams :: Item -> Creature -> World -> World -useAmmoParams it = withVelWthHiteff +useAmmoParams it cr = withVelWthHiteff (muzvel *.* _amBulVel b) (_rifling $ _itParams it) (_amBulWth b) muzlength (_amBulEff b) + cr where - muzlength = 20 + muzlength = aimingMuzzlePos cr it muzvel = _muzVel $ _itParams it b = _aoType $ _itConsumption it diff --git a/src/Dodge/Item/Weapon/BulletGun/Cane.hs b/src/Dodge/Item/Weapon/BulletGun/Cane.hs index 83734f0de..7a24d949c 100644 --- a/src/Dodge/Item/Weapon/BulletGun/Cane.hs +++ b/src/Dodge/Item/Weapon/BulletGun/Cane.hs @@ -67,7 +67,7 @@ bangCane = defaultGun , _dimCenter = V3 5 0 0 , _dimPortage = HeldItem {_handlePos = 5 - ,_muzPos = 20 + ,_muzPos = 15 } , _dimSPic = \it -> noPic $ baseCaneShape <> makeSingleClipAt (V3 5 0 3) it diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index be1cf6fc4..1c92b022e 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -3,6 +3,7 @@ module Dodge.LevelGen where import Dodge.Data import Dodge.Floor +import Dodge.Save import Dodge.Layout import Dodge.Initialisation --import Dodge.RandomHelp @@ -19,7 +20,7 @@ import qualified Data.IntMap.Strict as IM generateWorldFromSeed :: Int -> IO World generateWorldFromSeed i = do roomList <- layoutLevelFromSeed 0 i - return $ _gWorld $ generateLevelFromRoomList roomList + return $ saveLevelStartSlot $ _gWorld $ generateLevelFromRoomList roomList initialWorld{_randGen=mkStdGen i} layoutLevelFromSeed :: Int -> Int -> IO (IM.IntMap Room) diff --git a/src/Dodge/Magnet.hs b/src/Dodge/Magnet.hs index 380aab421..373d0171a 100644 --- a/src/Dodge/Magnet.hs +++ b/src/Dodge/Magnet.hs @@ -16,8 +16,9 @@ curveLeftField mg pt = case pt of curveAroundField :: Magnet -> Particle -> Particle curveAroundField mg pt = case pt of - BulletPt{} | dist btpos mgpos < 500 -> pt & btVel' %~ rotateToCircle + BulletPt{} | thedist < 400 -> pt & btVel' %~ rotateToCircle where + thedist = dist btpos mgpos mgpos = _mgPos mg btpos = head $ _btTrail' pt rotateToCircle vel @@ -25,5 +26,6 @@ curveAroundField mg pt = case pt of || (isRHS mgpos btpos (btpos +.+ vel) && isLHS mgpos btpos (mgpos +.+ vNormal vel) ) = rotateV rot vel | otherwise = rotateV (negate rot) vel - rot = 0.5 + rot | thedist < 100 = 0.5 + | otherwise = 0.5 - ((thedist - 100) / 600) _ -> pt diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 360271f1f..94e9dea04 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -5,22 +5,22 @@ module Dodge.Menu ) where import LensHelp import Dodge.Menu.OptionType +import Dodge.StartNewGame import Dodge.Menu.PushPop import Dodge.Data import Dodge.PreloadData import Dodge.Save import Dodge.Config.Update -import SDL --import SDL.Internal.Numbered --import Preload.Update import Dodge.SoundLogic -import Dodge.LevelGen +--import Dodge.LevelGen +import Text.Read +import SDL +import System.Clipboard --import Control.Lens -import System.Random - -pauseMenu :: ScreenLayer -pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause) +--import System.Random slTitleOptionsEff :: String -> [MenuOption] -> (Universe -> IO (Maybe Universe)) -> ScreenLayer slTitleOptionsEff title ops eff = OptionScreen @@ -29,15 +29,34 @@ slTitleOptionsEff title ops eff = OptionScreen , _scDefaultEff = eff , _scOptionFlag = NormalOptions } - +pauseMenu :: ScreenLayer +pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause) pauseMenuOptions :: [MenuOption] pauseMenuOptions = - [ Toggle ScancodeN (return . startNewGame) (const "NEW LEVEL") + [ Toggle ScancodeN (return . Just . startNewGame) (const "NEW LEVEL") , Toggle ScancodeR (return . Just . loadSaveSlot LevelStartSlot) (const "RESTART") + , Toggle ScancodeS (pushScreen $ seedStartMenu "START FROM SEED") (const "START FROM SEED") , Toggle ScancodeO (pushScreen optionMenu ) (const "OPTIONS") , Toggle ScancodeC (pushScreen displayControls) (const "CONTROLS") , InvisibleToggle ScancodeEscape (return . const Nothing) ] +seedStartMenu :: String -> ScreenLayer +seedStartMenu str = slTitleOptionsEff str seedStartOptions popScreen +seedStartOptions :: [MenuOption] +seedStartOptions = + [ Toggle ScancodeP trySeedFromClipboard (const "PASTE NUMBER FROM CLIPBOARD") +-- , Toggle ScancodeI (return . Just . loadSaveSlot LevelStartSlot) (const "INSERT NUMBER") + ] + +trySeedFromClipboard :: Universe -> IO (Maybe Universe) +trySeedFromClipboard u = do + mcstr <- getClipboardString + case mcstr of + Nothing -> pushScreen (seedStartMenu "INPUT UNUSABLE") (u & menuLayers %~ tail) + Just str -> do + case readMaybe str of + Nothing -> pushScreen (seedStartMenu "INPUT UNUSABLE") (u & menuLayers %~ tail) + Just i -> return . Just $ startSeedGame i u slTitleOptions :: String -> [MenuOption] -> ScreenLayer slTitleOptions title ops = slTitleOptionsEff title ops (popScreen . writeConfig) @@ -122,22 +141,6 @@ gameOverMenu = OptionScreen , _scOptionFlag = GameOverOptions } ---startNewGame' :: Universe -> IO (Maybe Universe) ---startNewGame' u = do --- w <- generateWorldFromSeed i --- return $ Just (u & uvWorld .~ w) --- where --- i = fst $ random (_randGen (_uvWorld u)) - -startNewGame :: Universe -> Maybe Universe -startNewGame u = Just $ u - & menuLayers .~ [WaitScreen (const "GENERATING...") 1] - & uvWorld . sideEffects .~ \_ -> do - w <- generateWorldFromSeed i - return (u & menuLayers .~ [] & uvWorld .~ w) - where - i = fst $ random (_randGen (_uvWorld u)) - -- | hacky scodeToChar :: Scancode -> Char scodeToChar = toEnum . (+ 61) . fromIntegral . unwrapScancode diff --git a/src/Dodge/Placement/Instance/Turret.hs b/src/Dodge/Placement/Instance/Turret.hs index 46b036105..cafc57e74 100644 --- a/src/Dodge/Placement/Instance/Turret.hs +++ b/src/Dodge/Placement/Instance/Turret.hs @@ -8,17 +8,17 @@ import Dodge.Wall.Delete import Dodge.WorldEvent.Explosion import Dodge.Item.Weapon.BatteryGuns import Dodge.Item.Weapon.BulletGun.Cane -import Dodge.SoundLogic.LoadSound -import Dodge.SoundLogic +--import Dodge.SoundLogic.LoadSound +--import Dodge.SoundLogic import Dodge.Item.Draw import Geometry import ShapePicture import Shape import Dodge.Base import Dodge.Base.Collide +import LensHelp import Data.List -import Control.Lens import qualified Data.IntMap.Strict as IM putLasTurret :: Float -> Placement @@ -52,10 +52,13 @@ updateTurret rotSpeed mc w | elecDam < 10 = updateFiringStatus . doTurn | otherwise = id -- TODO make this use the same function as the lasgun + it = _tuWeapon (_mcType mc) maybeFire | _tuFireTime (_mcType mc) > 0 - = ( particles %~ (makeLaserAt 5 (mcpos + 15 *.* unitVectorAtAngle mcdir) mcdir :) ) - . soundContinue (MachineSound mcid) mcpos tone440sawtoothquietS (Just 1) + -- massive hack + = _rUse (_itUse it) it (defaultCreature {_crPos = mcpos,_crDir = mcdir}) +-- = ( particles .:~ makeLaserAt 5 (mcpos + 15 *.* unitVectorAtAngle mcdir) mcdir ) +-- . soundContinue (MachineSound mcid) mcpos tone440sawtoothquietS (Just 1) | otherwise = id mcid = _mcID mc ypos = _crPos $ you w diff --git a/src/Dodge/Save.hs b/src/Dodge/Save.hs index 58b97b832..b645241f9 100644 --- a/src/Dodge/Save.hs +++ b/src/Dodge/Save.hs @@ -2,6 +2,7 @@ module Dodge.Save ( saveWorldInEmptySlot , loadSaveSlot , doQuicksave + , saveLevelStartSlot ) where import Dodge.Data @@ -16,7 +17,7 @@ saveWorldInEmptySlot slot w = case M.lookup slot $ _savedWorlds w of _ -> w saveWorldInSlot :: SaveSlot -> Universe -> Universe -saveWorldInSlot slot w = w & savedWorlds %~ M.insert slot (clearKeys (_uvWorld w)) +saveWorldInSlot slot u = u & savedWorlds %~ M.insert slot (clearKeys (_uvWorld u)) loadSaveSlot :: SaveSlot -> Universe -> Universe loadSaveSlot slot u = maybe u @@ -28,3 +29,8 @@ doQuicksave = saveWorldInSlot QuicksaveSlot clearKeys :: World -> World clearKeys = (keys .~ S.empty) . (mouseButtons .~ S.empty) + +saveLevelStartSlot :: World -> World +--saveLevelStartSlot = id +saveLevelStartSlot = sideEffects %~ (fmap (saveWorldInSlot LevelStartSlot) . ) +--saveLevelStartSlot = sideEffects %~ (fmap (undefined) . ) diff --git a/src/Dodge/StartNewGame.hs b/src/Dodge/StartNewGame.hs new file mode 100644 index 000000000..c0e4e9539 --- /dev/null +++ b/src/Dodge/StartNewGame.hs @@ -0,0 +1,18 @@ +module Dodge.StartNewGame where +import Dodge.Data +import Dodge.LevelGen +import Control.Lens +import System.Random + +startNewGame :: Universe -> Universe +startNewGame u = startSeedGame i u + where + i = fst $ random (_randGen (_uvWorld u)) + +startSeedGame :: Int -> Universe -> Universe +startSeedGame i u = u + & menuLayers .~ [WaitScreen (const "GENERATING...") 1] + & uvWorld . sideEffects .~ \_ -> do + w <- generateWorldFromSeed i + return $ u & menuLayers .~ [] & uvWorld .~ w + & savedWorlds . at LevelStartSlot ?~ w