nyx-game 1.0.0.0 → 1.0.1.0
raw patch · 15 files changed
+120/−44 lines, 15 filesbinary-addedPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
+ Play.Engine.Input: KeyScale :: Key
+ Play.Engine.MySDL.MySDL: SetNormalWindowScale :: Size -> Request
+ Play.Engine.MySDL.MySDL: SetSmallWindowScale :: Size -> Request
+ Play.Engine.Settings: NormalWindow :: WindowScale
+ Play.Engine.Settings: SmallWindow :: WindowScale
+ Play.Engine.Settings: [_windowScale] :: Settings -> WindowScale
+ Play.Engine.Settings: data WindowScale
+ Play.Engine.Settings: instance GHC.Show.Show Play.Engine.Settings.WindowScale
+ Play.Engine.Settings: windowScale :: Lens' Settings WindowScale
+ Play.Engine.Utils: scalePoint :: Float -> Size -> V2 CInt
- Play.Engine.MySDL.MySDL: apploop :: ResourcesT TVar -> TQueue Response -> Renderer -> a -> ([Response] -> [EventPayload] -> (Scancode -> Bool) -> a -> IO (Either [String] ([Request], a))) -> (a -> IO ()) -> IO a
+ Play.Engine.MySDL.MySDL: apploop :: ResourcesT TVar -> TQueue Response -> Window -> Renderer -> a -> ([Response] -> [EventPayload] -> (Scancode -> Bool) -> a -> IO (Either [String] ([Request], a))) -> (a -> IO ()) -> IO a
- Play.Engine.MySDL.MySDL: runRequest :: ResourcesT TVar -> TQueue Response -> Renderer -> Request -> IO ()
+ Play.Engine.MySDL.MySDL: runRequest :: ResourcesT TVar -> TQueue Response -> Window -> Renderer -> Request -> IO ()
- Play.Engine.Settings: Settings :: !Size -> ![(Key, Scancode)] -> !Keys -> !Keys -> !Bool -> Settings
+ Play.Engine.Settings: Settings :: !Size -> ![(Key, Scancode)] -> !Keys -> !Keys -> !Bool -> WindowScale -> Settings
Files
- README.md +2/−0
- app/Script.hs +5/−0
- app/Script/Boss.hs +8/−2
- app/Script/Level1.hs +18/−8
- app/Script/Level2.hs +26/−17
- app/ShootingBox.hs +6/−6
- app/TextBox.hs +2/−1
- assets/imgs/keys.png binary
- assets/imgs/keys.png~ binary
- nyx-game.cabal +3/−2
- src/Play/Engine/Input.hs +2/−0
- src/Play/Engine/MySDL/MySDL.hs +21/−5
- src/Play/Engine/Runner.hs +17/−3
- src/Play/Engine/Settings.hs +7/−0
- src/Play/Engine/Utils.hs +3/−0
README.md view
@@ -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
app/Script.hs view
@@ -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
app/Script/Boss.hs view
@@ -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
app/Script/Level1.hs view
@@ -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 ]
app/Script/Level2.hs view
@@ -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 ]
app/ShootingBox.hs view
@@ -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
app/TextBox.hs view
@@ -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
assets/imgs/keys.png view
binary file changed (109192 → 127789 bytes)
+ assets/imgs/keys.png~ view
binary file changed (absent → 109192 bytes)
nyx-game.cabal view
@@ -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
src/Play/Engine/Input.hs view
@@ -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
src/Play/Engine/MySDL/MySDL.hs view
@@ -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) =
src/Play/Engine/Runner.hs view
@@ -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
src/Play/Engine/Settings.hs view
@@ -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 }
src/Play/Engine/Utils.hs view
@@ -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