packages feed

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 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