diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,6 +2,8 @@ A bullet hell game written in Haskell. +Click 'R' 5 times to expose a secret menu. + ## How to Run ### From Source diff --git a/app/Script.hs b/app/Script.hs --- a/app/Script.hs +++ b/app/Script.hs @@ -21,6 +21,7 @@ data Command = Wait !Actions Int | WaitUntil !Actions (Maybe IPoint -> [Enemy] -> Bool) + | If (Maybe IPoint -> [Enemy] -> Bool) Script | Spawn (Result [Enemy]) | LoadTextBox !Actions (Result TB.TextBox) | WaitTextBox !Actions TB.TextBox @@ -81,6 +82,10 @@ WaitUntil acts test : rest | test mcPos enemies -> pure (acts, rest) | otherwise -> pure (acts, WaitUntil acts test : rest) + + If test cmds : rest + | test mcPos enemies -> pure (noAction, cmds <> rest) + | otherwise -> pure (noAction, rest) Spawn spawned : rest -> (, rest) . (\s -> noAction { spawn = s }) <$> spawned diff --git a/app/Script/Boss.hs b/app/Script/Boss.hs --- a/app/Script/Boss.hs +++ b/app/Script/Boss.hs @@ -12,6 +12,7 @@ import qualified TextBox as TB import qualified Data.Map as M import qualified Script.End as End +import Data.Maybe (isNothing) boss :: Bool -> Int -> Scene @@ -78,7 +79,7 @@ | tryNum < 7 -> [ LoadTextBox act{ stopTheWorld = True } $ TB.make TB.Top 4 - "Didn't you have enough yet?" + "Haven't you have enough yet?" (M.lookup "astral-avatar" ts) (M.lookup "unispace" fs) ] | tryNum < 10 -> @@ -111,8 +112,13 @@ ] ++ -- Boss [ Spawn $ sequence [Fast.make (Point 350 (-100)) ts] - , WaitUntil noAction (const $ null) + , WaitUntil noAction (\nyx bullets -> isNothing nyx || null bullets) + , If (const . isNothing) + [ Wait noAction 90 + , FadeOut act{ command = Replace $ boss False (tryNum + 1) } 0 + , Wait noAction 30 + ] , StopMusic , Wait act{ stopTheWorld = False } 2 , Wait act{ stopTheWorld = True } 150 diff --git a/app/Script/Level1.hs b/app/Script/Level1.hs --- a/app/Script/Level1.hs +++ b/app/Script/Level1.hs @@ -15,6 +15,8 @@ import qualified Script.Level2 as L2 import qualified TextBox as TB import qualified Data.Map as M +import Data.Maybe (isNothing) +import Data.List (intersperse) level1 :: Bool -> Scene @@ -50,8 +52,15 @@ , Wait noAction 60 ] ++ + intersperse + ( If (const . isNothing) + [ Wait noAction 90 + , FadeOut act{ command = Replace $ level1 False } 0 + ] + ) + -- First sequence - concat + ( concat ( replicate 3 $ concat [ spawnStaticAndWait 200 300 ts , spawnStaticAndWait 600 200 ts @@ -94,12 +103,13 @@ , [spawnTwoCDEs (Right ()) (Left ()) ts] ] ++ - -- First wave done - [ WaitUntil noAction (const $ null) - , Wait noAction 200 - , Wait act{ stopTheWorld = True } 30 - , Wait act{ command = Replace $ L2.level2 False } 60 - ] + -- First wave done + [ WaitUntil noAction (\nyx bullets -> isNothing nyx || null bullets) + , Wait noAction 200 + , Wait act{ stopTheWorld = True } 30 + , Wait act{ command = Replace $ L2.level2 False } 60 + ] + ) spawnTwoCDEs dir1 dir2 ts = Spawn $ sequence @@ -111,5 +121,5 @@ [ Spawn $ sequence [ St.make (Point posx (-100)) (Point 0 1) target ts ] - , Wait noAction 120 + , Wait noAction 100 ] diff --git a/app/Script/Level2.hs b/app/Script/Level2.hs --- a/app/Script/Level2.hs +++ b/app/Script/Level2.hs @@ -13,6 +13,8 @@ import qualified Script.Boss as Boss import qualified TextBox as TB import qualified Data.Map as M +import Data.Maybe (isNothing) +import Data.List (intersperse) level2 :: Bool -> Scene @@ -44,28 +46,34 @@ [ LoadTextBox act{ stopTheWorld = True } $ TB.make TB.Bottom 4 "This is harder than I expected..." (M.lookup "nyx-avatar" ts) (M.lookup "unispace" fs) ] ++ + intersperse + ( If (const . isNothing) + [ Wait noAction 60 + , FadeOut act{ command = Replace $ level2 False } 0 + ] + ) -- Second wave - concat + ( concat [ [ Spawn $ sequence [CDE.make (Point 100 (-180)) (Right ()) ts] - , Wait noAction 100 + , Wait noAction 50 ] - , spawnStaticAndWait 400 300 ts + , spawnStaticAndWait 450 300 ts , [ Spawn $ sequence [CDE.make (Point 700 (-180)) (Left ()) ts] - , Wait noAction 100 + , Wait noAction 80 ] - , [ Spawn $ sequence [CDE.make (Point 650 (-150)) (Left ()) ts] - , Wait noAction 100 + , [ Spawn $ sequence [CDE.make (Point 600 (-150)) (Left ()) ts] + , Wait noAction 60 ] , [ Spawn $ sequence [CDE.make (Point 100 (-180)) (Right ()) ts] - , Wait noAction 100 + , Wait noAction 40 ] , spawnStaticAndWait 600 300 ts , spawnStaticAndWait 250 250 ts , [ spawnTwoCDEs (Left ()) (Right ()) ts - , Wait noAction 100 + , Wait noAction 70 , spawnTwoCDEs (Right ()) (Left ()) ts - , Wait noAction 100 + , Wait noAction 70 ] , [ spawnTwoCDEs (Left ()) (Right ()) ts , Wait noAction 60 @@ -79,13 +87,14 @@ ] ] ++ - -- Second wave done - [ WaitUntil noAction (const $ null) - , Wait noAction 200 - , StopMusic - , Wait act{ stopTheWorld = True } 30 - , Wait act{ command = Replace $ Boss.boss True 0 } 60 - ] + -- Second wave done + [ WaitUntil noAction (\nyx bullets -> isNothing nyx || null bullets) + , Wait noAction 200 + , StopMusic + , Wait act{ stopTheWorld = True } 30 + , Wait act{ command = Replace $ Boss.boss True 0 } 60 + ] + ) spawnTwoCDEs dir1 dir2 ts = Spawn $ sequence @@ -97,5 +106,5 @@ [ Spawn $ sequence [ St.make (Point posx (-100)) (Point 0 1) target ts ] - , Wait noAction 120 + , Wait noAction 110 ] diff --git a/app/ShootingBox.hs b/app/ShootingBox.hs --- a/app/ShootingBox.hs +++ b/app/ShootingBox.hs @@ -94,7 +94,7 @@ , mkTexture = nyxSprites , mkSize = Point 180 380 , mkMaxPos = 4 - , mkSpeed = 5 + , mkSpeed = 6 } , _bullet = nyxBullet , _hitTimer = -1 @@ -183,17 +183,17 @@ newBullet :: MainChar -> [Bullet] newBullet mc | mc ^. size . x == charSize ^. x = - [ mkBullet (mc ^. bullet) (Point 0 (-1)) mv 2 70 ((mc ^. pos) `addPoint` Point (mc ^. size . x `div` 4) 0) - , mkBullet (mc ^. bullet) (Point 0 (-1)) mv 2 70 ((mc ^. pos) `addPoint` Point ((mc ^. size . x `div` 4) * 3) 0) + [ mkBullet (mc ^. bullet) (Point 0 (-1)) mv 2 160 ((mc ^. pos) `addPoint` Point (mc ^. size . x `div` 4) 0) + , mkBullet (mc ^. bullet) (Point 0 (-1)) mv 2 160 ((mc ^. pos) `addPoint` Point ((mc ^. size . x `div` 4) * 3) 0) ] | otherwise = - [ mkBullet (mc ^. bullet) (Point 0 (-1)) mv 5 140 ((mc ^. pos) `addPoint` Point (charSize ^. x `div` 2) 0) + [ mkBullet (mc ^. bullet) (Point 0 (-1)) mv 5 230 ((mc ^. pos) `addPoint` Point (charSize ^. x `div` 2) 0) ] where mv = MV.make $ MV.defArgs - { MV.maxspeed = Point 0 10 - , MV.accel = Point 0 10 + { MV.maxspeed = Point 0 13 + , MV.accel = Point 0 5 } checkHit :: [Bullet] -> MainChar -> MainChar diff --git a/app/TextBox.hs b/app/TextBox.hs --- a/app/TextBox.hs +++ b/app/TextBox.hs @@ -94,7 +94,7 @@ update :: Input -> TextBox -> Result (Maybe TextBox) update input tb - | keyClicked KeyA input + | keyClicked KeyA input || keyClicked KeyStart input , let (l, t) = Zip.last (tb ^. text) in l == T.length t = pure Nothing | otherwise = do @@ -117,6 +117,7 @@ (\(txt :: Zip.ListZipper (Int, T.Text)) -> if | keyClicked KeyA input + || keyClicked KeyStart input || tb ^. textSpeed == 0 -> fmap (\(_, t) -> (T.length t, t)) txt | tb ^. textTimer == 0 diff --git a/assets/imgs/keys.png b/assets/imgs/keys.png Binary files a/assets/imgs/keys.png and b/assets/imgs/keys.png differ diff --git a/assets/imgs/keys.png~ b/assets/imgs/keys.png~ new file mode 100644 Binary files /dev/null and b/assets/imgs/keys.png~ differ diff --git a/nyx-game.cabal b/nyx-game.cabal --- a/nyx-game.cabal +++ b/nyx-game.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: d0bc9f96b3fcc14525f919a9d33cc8471aa6e14f4873d9f02cf078a8dd4631e5 +-- hash: b6f7615556a9715bdb4b67827293a6d8f5f1cd53caa5ad5b465066e07e3796d5 name: nyx-game -version: 1.0.0.0 +version: 1.0.1.0 synopsis: A bullet-hell game made with SDL2. description: A purely functional bullet-hell game made with SDL2. Visit https://gilmi.me/nyx for more details. category: Game @@ -36,6 +36,7 @@ assets/imgs/crossdown.png assets/imgs/customer.png assets/imgs/keys.png + assets/imgs/keys.png~ assets/imgs/nyx-avatar.png assets/imgs/nyx-bullet.png assets/imgs/nyx-sprites-animated.png diff --git a/src/Play/Engine/Input.hs b/src/Play/Engine/Input.hs --- a/src/Play/Engine/Input.hs +++ b/src/Play/Engine/Input.hs @@ -40,6 +40,7 @@ | KeyD | KeyM | KeyP + | KeyScale | KeyStart | KeyQuit deriving (Show, Read, Eq, Ord, Bounded, Enum, Generic, NFData) @@ -69,6 +70,7 @@ , (SDL.ScancodeV, KeyD) , (SDL.ScancodeM, KeyM) , (SDL.ScancodeP, KeyP) + , (SDL.ScancodeF12, KeyScale) ] -- can't have more than one binding to the same key as this will create a state accumulation problem diff --git a/src/Play/Engine/MySDL/MySDL.hs b/src/Play/Engine/MySDL/MySDL.hs --- a/src/Play/Engine/MySDL/MySDL.hs +++ b/src/Play/Engine/MySDL/MySDL.hs @@ -27,6 +27,10 @@ import qualified SDL.Mixer as Mix import SDL.Vect (V2(..), V4(..)) +import Play.Engine.Types (Size) +import Play.Engine.Utils (scalePoint) + + --import Debug.Trace -- | Config window @@ -41,6 +45,7 @@ SDLF.initialize window <- SDL.createWindow title winConf + SDL.showWindow window mJoystick <- getJoystick @@ -72,12 +77,13 @@ apploop :: ResourcesT TVar -> TQueue Response + -> SDL.Window -> SDL.Renderer -> a -> ([Response] -> [SDL.EventPayload] -> (SDL.Scancode -> Bool) -> a -> IO (Either [String] ([Request], a))) -> (a -> IO ()) -> IO a -apploop resources responsesQueue renderer world update render = do +apploop resources responsesQueue window renderer world update render = do -- measure ticks at the start start <- SDL.ticks @@ -90,7 +96,7 @@ liftIO $ mapM (hPutStrLn stderr . ("*** Error: " ++)) errs >> pure world Right (reqs, newWorld) -> do render newWorld - void $ async $ mapConcurrently_ (runRequest resources responsesQueue renderer) reqs + void $ async $ mapConcurrently_ (runRequest resources responsesQueue window renderer) reqs if checkEvent SDL.QuitEvent events then pure world else do @@ -106,7 +112,7 @@ -- measure ticks at the end and regulate FPS end <- SDL.ticks regulateFPS 60 start end - apploop resources responsesQueue renderer newWorld update render + apploop resources responsesQueue window renderer newWorld update render -- | Will wait until ticks pass regulateFPS :: Word32 -> Word32 -> Word32 -> IO () @@ -182,6 +188,8 @@ | PlayMusic (String, FilePath) | MuteMusic | UnmuteMusic + | SetNormalWindowScale Size + | SetSmallWindowScale Size data Response = ResourcesLoaded Resources @@ -208,8 +216,8 @@ <*> newTVarIO M.empty <*> newTVarIO M.empty -runRequest :: ResourcesT TVar -> TQueue Response -> SDL.Renderer -> Request -> IO () -runRequest resources queue renderer req = +runRequest :: ResourcesT TVar -> TQueue Response -> SDL.Window -> SDL.Renderer -> Request -> IO () +runRequest resources queue window renderer req = flip catch (\(SomeException e) -> atomically $ writeTQueue queue $ Exception $ show e) $ case req of Load files -> do @@ -231,6 +239,14 @@ Mix.setMusicVolume 0 UnmuteMusic -> do Mix.setMusicVolume 100 + SetSmallWindowScale size -> do + SDL.windowSize window SDL.$= (scalePoint 0.7 size) + SDL.rendererScale renderer SDL.$= 0.7 + SDL.setWindowPosition window SDL.Centered + SetNormalWindowScale size -> do + SDL.windowSize window SDL.$= fmap fromIntegral size + SDL.rendererScale renderer SDL.$= 1 + SDL.setWindowPosition window SDL.Centered loadResource renderer resources (n, r) = diff --git a/src/Play/Engine/Runner.hs b/src/Play/Engine/Runner.hs --- a/src/Play/Engine/Runner.hs +++ b/src/Play/Engine/Runner.hs @@ -40,6 +40,7 @@ MySDL.apploop resources responsesQueue + window ren (settings, stack) update @@ -54,7 +55,7 @@ -> (SDL.Scancode -> Bool) -> (Settings, Stack Scene) -> IO (Either [String] ([MySDL.Request], (Settings, Stack Scene))) -update responses payload isKeyPressed (settings, stack) = +update responses payload isKeyPressed (settings, stack) = do let (keys, joykeys) = makeEvents (_keyStats settings) (_joyKeyStats settings) payload isKeyPressed (_keyMap settings) @@ -62,8 +63,15 @@ | keyClicked' KeyM keys = not | otherwise = id + toggleWindowScale + | keyClicked' KeyScale keys = \case + NormalWindow -> SmallWindow + SmallWindow -> NormalWindow + | otherwise = id + settings' = settings & over muteMusic toggleMuteFlag + & over windowScale toggleWindowScale & set keyStats keys & set joyKeyStats joykeys @@ -72,8 +80,14 @@ | not (settings' ^. muteMusic) = (:) MySDL.UnmuteMusic | otherwise = id - in pure - . fmap (\(setts, (reqs, states)) -> (toggleMuteCmd reqs, (setts, states))) + toggleWindowScaleCmd + | keyClicked' KeyScale keys = case settings' ^. windowScale of + NormalWindow -> (:) $ MySDL.SetNormalWindowScale $ settings' ^. windowSize + SmallWindow -> (:) $ MySDL.SetSmallWindowScale $ settings' ^. windowSize + | otherwise = id + + pure + . fmap (\(setts, (reqs, states)) -> (toggleWindowScaleCmd $ toggleMuteCmd reqs, (setts, states))) . (joykeys `deepseq` keys `deepseq` runResult $! settings') $ updateScenes (Input (M.unionWith max keys joykeys) responses) stack diff --git a/src/Play/Engine/Settings.hs b/src/Play/Engine/Settings.hs --- a/src/Play/Engine/Settings.hs +++ b/src/Play/Engine/Settings.hs @@ -18,9 +18,15 @@ , _keyStats :: !Keys , _joyKeyStats :: !Keys , _muteMusic :: !Bool + , _windowScale :: WindowScale } deriving (Show) +data WindowScale + = SmallWindow + | NormalWindow + deriving Show + makeLenses ''Settings type Result a = SM.StateT Settings (Except [String]) a @@ -34,4 +40,5 @@ , _keyStats = initKeyStats , _joyKeyStats = initKeyStats , _muteMusic = False + , _windowScale = NormalWindow } diff --git a/src/Play/Engine/Utils.hs b/src/Play/Engine/Utils.hs --- a/src/Play/Engine/Utils.hs +++ b/src/Play/Engine/Utils.hs @@ -66,6 +66,9 @@ (.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d (.:) f g a b = f (g a b) +scalePoint :: Float -> Size -> V2 C.CInt +scalePoint ratio = fmap (floor . (*) ratio . fromIntegral) + absPoint :: IPoint -> IPoint absPoint = fmap abs