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

Add menu option to start new game from seed, uses system clipboard

Browse Source
This commit is contained in:
justin
2021-12-09 14:36:26 +00:00
parent eeda4f3e39
commit 24a0cc289f
13 changed files with 101 additions and 54 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Menu.hs
+27 -24
View File
@@ -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