imj-game-hamazed (empty) → 0.1.0.2
raw patch · 36 files changed
+2640/−0 lines, 36 filesdep +basedep +containersdep +imj-animationsetup-changed
Dependencies added: base, containers, imj-animation, imj-base, imj-game-hamazed, imj-prelude, matrix, mtl, terminal-size, text, vector
Files
- CHANGELOG.md +8/−0
- LICENSE +30/−0
- README.md +74/−0
- Setup.hs +2/−0
- app/Main.hs +9/−0
- imj-game-hamazed.cabal +106/−0
- src/Imj/Game/Hamazed.hs +84/−0
- src/Imj/Game/Hamazed/Color.hs +86/−0
- src/Imj/Game/Hamazed/Env.hs +38/−0
- src/Imj/Game/Hamazed/Infos.hs +69/−0
- src/Imj/Game/Hamazed/KeysMaps.hs +31/−0
- src/Imj/Game/Hamazed/Level.hs +128/−0
- src/Imj/Game/Hamazed/Level/Types.hs +48/−0
- src/Imj/Game/Hamazed/Loop/Create.hs +60/−0
- src/Imj/Game/Hamazed/Loop/Deadlines.hs +113/−0
- src/Imj/Game/Hamazed/Loop/Event.hs +38/−0
- src/Imj/Game/Hamazed/Loop/Event/Priorities.hs +22/−0
- src/Imj/Game/Hamazed/Loop/Event/Types.hs +65/−0
- src/Imj/Game/Hamazed/Loop/Render.hs +47/−0
- src/Imj/Game/Hamazed/Loop/Run.hs +79/−0
- src/Imj/Game/Hamazed/Loop/Timing.hs +26/−0
- src/Imj/Game/Hamazed/Loop/Update.hs +200/−0
- src/Imj/Game/Hamazed/Parameters.hs +127/−0
- src/Imj/Game/Hamazed/Types.hs +34/−0
- src/Imj/Game/Hamazed/World.hs +233/−0
- src/Imj/Game/Hamazed/World/Create.hs +86/−0
- src/Imj/Game/Hamazed/World/InTerminal.hs +64/−0
- src/Imj/Game/Hamazed/World/Number.hs +43/−0
- src/Imj/Game/Hamazed/World/Render.hs +52/−0
- src/Imj/Game/Hamazed/World/Ship.hs +56/−0
- src/Imj/Game/Hamazed/World/Size.hs +39/−0
- src/Imj/Game/Hamazed/World/Space.hs +337/−0
- src/Imj/Game/Hamazed/World/Space/Types.hs +70/−0
- src/Imj/Game/Hamazed/World/Types.hs +106/−0
- test/Spec.hs +17/−0
- test/Test/Imj/Render.hs +13/−0
+ CHANGELOG.md view
@@ -0,0 +1,8 @@+# Changelog++This project adheres to [Haskell PVP](https://pvp.haskell.org/).+++## 0.1.0.2 [2018-01-01]++- Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Olivier Sohn (c) 2017 - 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Olivier Sohn nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,74 @@+# What is it?++It's a terminal ascii game where you fly a ship through numbers. The goal is to shoot+the numbers whose sum will be equal to the level's target. It's easy at the beginning,+but higher levels have more and more numbers, and less and less space to navigate through them!+The last level is level 12: I never reached it, but I hope somebody will :).++# Demos++## No walls, square world++[](https://asciinema.org/a/151434)++## Random walls, rectangular world++[](https://asciinema.org/a/151404)++# Configurability++The game can be configured in "world shape" (square, rectangle) and "kind of walls"+(none, deterministic, random).++++You can define your own keyboard mapping by modifying the 'eventFromKey' function+defined [here](src/Game/Event.hs), the default mapping being:+- ship acceleration : 's' 'e' 'd' 'f'+- laser shots : 'j' 'i' 'k' 'l'++# Supported Platforms / Terminals:++|OS |Support|+|---------|-------|+|OS X |Yes |+|Linux |Yes |+|Windows |No (see [this](https://ghc.haskell.org/trac/ghc/ticket/7353)) |++Your terminal window should have a dimension of at least {height = 42, width = 146}.+If it is too small, the program will fail with the following error message:++```+From game thread:++Minimum terminal size : Window {height = 42, width = 146}.+Current terminal size : Window {height = 22, width = 165}.+The current terminal size doesn't match the minimum size,+please adjust your terminal size and restart the executable.+```++# Version history+- 2.1 :+ - New animations :+ - With colors (8-bit)+ - Also between levels+ - Using physics and gravity+ - "Terminal size"-aware+- 2.0 :+ - World is configurable (square or rectangle, with or without random walls)+ - Explosion animations+ - Optimized rendering (delta rendering)+- 1.0 :+ - The world is a square. (Note : ship acceleration was 'w' 'a' 's' 'd' at that time)++# Build++You can build and run using [stack](https://docs.haskellstack.org):++`stack build --pedantic && stack exec hamazed-exe`++# Credits++## Delta rendering++The initial idea for delta rendering is based on [code written by Rafael Ibraim](https://gist.github.com/ibraimgm/40e307d70feeb4f117cd)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,9 @@+module Main where++import Control.Monad(void)++import Imj.Game.Hamazed( run )++main :: IO ()+main =+ void run
+ imj-game-hamazed.cabal view
@@ -0,0 +1,106 @@+name: imj-game-hamazed+version: 0.1.0.2+Category: Animation, Game, Graphics, Education, Application+Synopsis: A game with flying numbers and 8-bit color animations.+Description: In Hamazed, you are a 'BattleShip' pilot surrounded by flying 'Number's.+ .++ Your mission is to shoot exactly the 'Number's whose sum will equate the+ current 'Level' 's /target number/.+ .++ The higher the 'Level' (1..12), the more 'Number's are flying around (up-to 16).+ And the smaller the 'World' gets.+ .++ Good luck !+homepage: https://github.com/OlivierSohn/hamazed/blob/master/imj-game-hamazed//README.md+bug-reports: https://github.com/OlivierSohn/hamazed/issues/+license: BSD3+license-file: LICENSE+author: Olivier Sohn+maintainer: olivier.sohn@gmail.com+copyright: 2017 - 2018 Olivier Sohn+build-type: Simple+extra-source-files: README.md CHANGELOG.md+cabal-version: >=1.10++Tested-With: GHC == 8.0.2, GHC == 8.2.2++library+ hs-source-dirs: src+ other-modules:+ exposed-modules: Imj.Game.Hamazed+ , Imj.Game.Hamazed.Color+ , Imj.Game.Hamazed.Env+ , Imj.Game.Hamazed.KeysMaps+ , Imj.Game.Hamazed.Level+ , Imj.Game.Hamazed.Level.Types+ , Imj.Game.Hamazed.Parameters+ , Imj.Game.Hamazed.Infos+ , Imj.Game.Hamazed.Loop.Create+ , Imj.Game.Hamazed.Loop.Deadlines+ , Imj.Game.Hamazed.Loop.Event.Priorities+ , Imj.Game.Hamazed.Loop.Event.Types+ , Imj.Game.Hamazed.Loop.Event+ , Imj.Game.Hamazed.Loop.Render+ , Imj.Game.Hamazed.Loop.Run+ , Imj.Game.Hamazed.Loop.Timing+ , Imj.Game.Hamazed.Loop.Update+ , Imj.Game.Hamazed.Types+ , Imj.Game.Hamazed.World+ , Imj.Game.Hamazed.World.Create+ , Imj.Game.Hamazed.World.InTerminal+ , Imj.Game.Hamazed.World.Number+ , Imj.Game.Hamazed.World.Render+ , Imj.Game.Hamazed.World.Ship+ , Imj.Game.Hamazed.World.Size+ , Imj.Game.Hamazed.World.Space+ , Imj.Game.Hamazed.World.Space.Types+ , Imj.Game.Hamazed.World.Types+ build-depends: base >= 4.8 && < 4.11+ , containers >= 0.5.9.2+ , matrix >= 0.3.5.0+ , mtl >= 2.2.1 && < 2.3+ , terminal-size >= 0.3.2.1 && < 0.3.3+ , text ==1.2.*+ , vector >= 0.12.0.1 && < 0.12.1+ , imj-animation ==0.1.*+ , imj-animation ==0.1.*+ , imj-base ==0.1.*+ , imj-prelude ==0.1.*++ ghc-options: -Wall -fpedantic-bottoms -Wredundant-constraints+ -fexcess-precision -optc-ffast-math+ default-language: Haskell2010++executable imj-game-hamazed-exe+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -Wall -fpedantic-bottoms -Wredundant-constraints+ -threaded -rtsopts -with-rtsopts=-maxN4+ -fexcess-precision -optc-ffast-math+ build-depends: base >= 4.8 && < 4.11+ , imj-game-hamazed+ , imj-prelude ==0.1.*+ default-language: Haskell2010++test-suite imj-game-hamazed-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ other-modules: Test.Imj.Render+ main-is: Spec.hs+ build-depends: base >= 4.8 && < 4.11+ , imj-base ==0.1.*+ , imj-game-hamazed+ , mtl >= 2.2.1 && < 2.3+ , text ==1.2.*+ ghc-options: -Wall -fpedantic-bottoms -Wredundant-constraints+ -threaded -rtsopts -with-rtsopts=-maxN4+ -fexcess-precision -optc-ffast-math+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/OlivierSohn/hamazed/+ subdir: imj-game-hamazed
+ src/Imj/Game/Hamazed.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE LambdaCase #-}+++module Imj.Game.Hamazed+ ( -- * The game+ {-| In Hamazed, you are a 'BattleShip' pilot surrounded by flying 'Number's.++ Your mission is to shoot exactly the 'Number's whose sum will equate the+ current 'Level' 's /target number/.++ The higher the 'Level' (1..12), the more 'Number's are flying around (up-to 16).+ And the smaller the 'World' gets.++ Good luck !++ /Note that to adapt the keyboard layout, you can modify 'eventFromKey'./+ -}+ run+ -- * Game loop+ {-| Hamazed is a /synchronous/, /event-driven/ program. Its /simplified/ main loop is:++ * 'getNextDeadline'++ * \(deadline\) = the next foreseen 'Deadline'.++ * 'getEventForMaybeDeadline'++ * \(event\) =++ * a key-press occuring /before/ \(deadline\) expires+ * or the \(deadline\) event++ * 'update'++ * Update 'GameState' according to \(event\)++ * 'render'++ * Render (using "Imj.Graphics.Render.Delta" to avoid+ <https://en.wikipedia.org/wiki/Screen_tearing screen tearing>).+ -}+ , getNextDeadline+ , getEventForMaybeDeadline+ , update+ , render+ -- * Deadlines+ , Deadline(..)+ , DeadlineType(..)+ -- * Events+ , Event(..)+ , ActionTarget(..)+ , MetaAction(..)+ -- * GameState+ {-| 'GameState' has two fields of type 'World' : during 'Level' transitions,+ we render the /old/ 'World' while using the /new/ 'World' 's+ dimensions to animate the UI accordingly (see "Imj.Graphics.UI.Animation"). -} -- TODO this could be done differently+ , GameState(..)+ -- * Environment+ {- | -}+ , module Imj.Game.Hamazed.Env+ -- * Keyboard layout+ , eventFromKey+ -- * Reexport+ , module Imj.Game.Hamazed.World+ , UIAnimation(..)+ ) where++import Imj.Prelude++import Imj.Game.Hamazed.Color+import Imj.Game.Hamazed.Env+import Imj.Game.Hamazed.KeysMaps+import Imj.Game.Hamazed.Level+import Imj.Game.Hamazed.Level.Types+import Imj.Game.Hamazed.Loop.Deadlines+import Imj.Game.Hamazed.Loop.Event+import Imj.Game.Hamazed.Loop.Render+import Imj.Game.Hamazed.Loop.Run+import Imj.Game.Hamazed.Loop.Timing+import Imj.Game.Hamazed.Loop.Update+import Imj.Game.Hamazed.Parameters+import Imj.Game.Hamazed.Types+import Imj.Game.Hamazed.World
+ src/Imj/Game/Hamazed/Color.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE NoImplicitPrelude #-}++{-| This module defines the colors of every game element, except animations. -}++module Imj.Game.Hamazed.Color (+ -- * Ship colors+ shipColor+ , shipColors+ , shipColorSafe+ , shipColorsSafe+ -- * Numbers colors+ , numberColor+ -- * Materials colors+ , wallColors+ , airColors+ -- * UI colors+ , worldFrameColors+ , ammoColor+ , bracketsColor+ -- ** Text colors+ , configColors+ , messageColor+ , neutralMessageColor+ -- * Reexports+ , module Imj.Graphics.Color+ ) where++import Imj.Prelude++import Imj.Game.Hamazed.Level.Types+import Imj.Graphics.Color++configColors :: LayeredColor+configColors = LayeredColor (gray 0) (gray 8)++wallColors :: LayeredColor+wallColors = LayeredColor (gray 0) (gray 3)++airColors :: LayeredColor+airColors = LayeredColor black white++neutralMessageColor :: LayeredColor+neutralMessageColor = onBlack $ gray 10++ammoColor :: Color8 Foreground+ammoColor = gray 14++bracketsColor :: Color8 Foreground+bracketsColor = worldFrameFgColor++messageColor :: GameStops -> LayeredColor+messageColor Won = onBlack $ rgb 4 3 1+messageColor (Lost _) = onBlack $ gray 6++shipColors :: LayeredColor+shipColors = LayeredColor shipBgColor shipColor++shipColorsSafe :: LayeredColor+shipColorsSafe = LayeredColor shipBgColorSafe shipColorSafe++shipColor :: Color8 Foreground+shipColor = rgb 5 4 4++shipColorSafe :: Color8 Foreground+shipColorSafe = rgb 5 0 0++shipBgColor :: Color8 Background+shipBgColor = black++shipBgColorSafe :: Color8 Background+shipBgColorSafe = rgb 1 0 0++-- | Cycles through the 6 colors of the cube delimited in RGB space by+-- (5,4,1) and (5,5,3).+numberColor :: Int -> LayeredColor+numberColor i = onBlack $ rgb r g b+ where+ r = 5+ g = fromIntegral $ 4 + (0 + quot i 2) `mod` 2 -- [0..1] , slow changes+ b = fromIntegral $ 1 + (0 + quot i 1) `mod` 3 -- [0..2] , 2x faster changes++worldFrameFgColor :: Color8 Foreground+worldFrameFgColor = rgb 2 1 1++worldFrameColors :: LayeredColor+worldFrameColors = LayeredColor black worldFrameFgColor
+ src/Imj/Game/Hamazed/Env.hs view
@@ -0,0 +1,38 @@+-- Environment of the Hamazed game, also used as an example in "Imj.Graphics.Render.Delta" :+-- /from a MonadIO, MonadReader YourEnv monad/++{-# OPTIONS_HADDOCK hide #-}++module Imj.Game.Hamazed.Env(+ Env+ , createEnv+ ) where++import Imj.Graphics.Class.Draw(Draw(..))+import Imj.Graphics.Class.Render(Render(..))+import Imj.Graphics.Render.Delta(newDefaultEnv, DeltaEnv)+++-- | The environment of <https://github.com/OlivierSohn/hamazed Hamazed> program+newtype Env = Env {+ _envDeltaEnv :: DeltaEnv+}++-- | Forwards to the 'Draw' instance of 'DeltaEnv'.+instance Draw Env where+ drawChar' (Env a) = drawChar' a+ drawChars' (Env a) = drawChars' a+ drawTxt' (Env a) = drawTxt' a+ drawStr' (Env a) = drawStr' a+ {-# INLINE drawChar' #-}+ {-# INLINE drawChars' #-}+ {-# INLINE drawTxt' #-}+ {-# INLINE drawStr' #-}+-- | Forwards to the 'Render' instance of 'DeltaEnv'.+instance Render Env where+ renderToScreen' (Env a) = renderToScreen' a+ {-# INLINE renderToScreen' #-}++-- | Constructor of 'Env'+createEnv :: IO Env+createEnv = Env <$> newDefaultEnv
+ src/Imj/Game/Hamazed/Infos.hs view
@@ -0,0 +1,69 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Imj.Game.Hamazed.Infos(+ mkInfos+ , mkLeftInfo+ , InfoType(..)+ ) where++import Imj.Prelude++import Data.Char( intToDigit )+import Data.List( length, foldl' )+import Data.Text(pack, singleton)++import Imj.Game.Hamazed.Color+import Imj.Game.Hamazed.Level.Types+import Imj.Graphics.Text.ColorString++data InfoType = Normal | ColorAnimated++mkLevelCS :: InfoType -> Int -> [ColorString]+mkLevelCS t level =+ let txt c = colored "Level " white <> colored (pack (show level)) c <> colored (" of " <> pack (show lastLevel)) white+ in case t of+ Normal -> [txt white]+ ColorAnimated -> [txt red, txt white]++mkAmmoCS :: InfoType -> Int -> [ColorString]+mkAmmoCS _ ammo =+ let s = colored (singleton '[') bracketsColor+ <> colored (pack $ replicate ammo '.') ammoColor+ <> colored (singleton ']') bracketsColor+ in [s]++mkObjectiveCS :: InfoType -> Int -> [ColorString]+mkObjectiveCS t target =+ let txt c = colored "Objective : " white <> colored (pack (show target)) c+ in case t of+ Normal -> [txt white]+ ColorAnimated -> [txt red, txt white]+++mkShotNumbersCS :: InfoType -> [Int] -> [ColorString]+mkShotNumbersCS _ nums =+ let lastIndex = length nums - 1+ first = colored (singleton '[') bracketsColor+ last_ = colored (singleton ']') bracketsColor+ middle = snd $ foldl' (\(i,s) n -> let num = intToDigit n+ t = case i of+ 0 -> singleton num+ _ -> pack [num, ' ']+ in (i-1, s <> colored' t (numberColor n))) (lastIndex, first) nums++ in [middle <> last_]++mkLeftInfo :: InfoType -> Int -> [Int] -> [[ColorString]]+mkLeftInfo t ammo shotNums =+ [mkAmmoCS t ammo, mkShotNumbersCS t shotNums]++mkUpDownInfo :: InfoType -> Level -> ([ColorString], [ColorString])+mkUpDownInfo t (Level level target _) =+ (mkObjectiveCS t target, mkLevelCS t level)++mkInfos :: InfoType -> Int -> [Int] -> Level -> (([ColorString], [ColorString]), [[ColorString]])+mkInfos t ammo shotNums level =+ (mkUpDownInfo t level, mkLeftInfo t ammo shotNums)
+ src/Imj/Game/Hamazed/KeysMaps.hs view
@@ -0,0 +1,31 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE LambdaCase #-}++module Imj.Game.Hamazed.KeysMaps+ ( eventFromKey+ ) where++import Imj.Prelude++import Imj.Game.Hamazed.Loop.Event.Types+import Imj.Geo.Discrete.Types+import Imj.Input.Types+++-- | Maps a 'Key' (pressed by the player) to an 'Event'.+eventFromKey :: Key -> Maybe Event+eventFromKey = \case+ Escape -> Just $ Interrupt Quit+ AlphaNum c -> case c of+ 'k' -> Just $ Action Laser Down+ 'i' -> Just $ Action Laser Up+ 'j' -> Just $ Action Laser LEFT+ 'l' -> Just $ Action Laser RIGHT+ 'd' -> Just $ Action Ship Down+ 'e' -> Just $ Action Ship Up+ 's' -> Just $ Action Ship LEFT+ 'f' -> Just $ Action Ship RIGHT+ _ -> Nothing+ _ -> Nothing
+ src/Imj/Game/Hamazed/Level.hs view
@@ -0,0 +1,128 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}++module Imj.Game.Hamazed.Level+ ( renderLevelMessage+ , renderLevelState+ , messageDeadline+ , getEventForMaybeDeadline+ ) where++import Imj.Prelude++import Control.Monad.IO.Class(MonadIO)+import Control.Monad.Reader.Class(MonadReader)++import System.Timeout( timeout )++import Imj.Game.Hamazed.Color+import Imj.Game.Hamazed.Level.Types+import Imj.Game.Hamazed.Loop.Event.Priorities+import Imj.Game.Hamazed.Loop.Event.Types+import Imj.Game.Hamazed.KeysMaps+import Imj.Geo.Discrete+import Imj.Graphics.Render+import Imj.Input.NonBlocking+import Imj.Input.Blocking+import Imj.Input.Types+import Imj.Timing++eventFromKey' :: Level -> Key -> Maybe Event+eventFromKey' (Level n _ finished) key =+ case finished of+ Nothing -> eventFromKey key+ Just (LevelFinished stop _ ContinueMessage) -> Just $+ case stop of+ Won -> if n < lastLevel+ then+ StartLevel (succ n)+ else+ EndGame+ (Lost _) -> StartLevel firstLevel+ _ -> Nothing -- between level end and proposal to continue++messageDeadline :: Level -> SystemTime -> Maybe Deadline+messageDeadline (Level _ _ mayLevelFinished) t =+ maybe Nothing+ (\(LevelFinished _ timeFinished messageType) ->+ case messageType of+ InfoMessage ->+ let finishedSinceSeconds = diffSystemTime t timeFinished+ delay = 2+ nextMessageStep = addToSystemTime (delay - finishedSinceSeconds) t+ in Just $ Deadline (KeyTime nextMessageStep) DisplayContinueMessage+ ContinueMessage -> Nothing)+ mayLevelFinished++-- | Returns a /player event/ or the 'Event' associated to the 'Deadline' if the+-- 'Deadline' expired before the /player/ could press a 'Key'.+getEventForMaybeDeadline :: Level+ -- ^ Current level+ -> Maybe Deadline+ -- ^ May contain a 'Deadline'+ -> SystemTime+ -- ^ Current time+ -> IO (Maybe Event)+getEventForMaybeDeadline level mayDeadline curTime =+ case mayDeadline of+ (Just (Deadline k@(KeyTime deadline) deadlineType)) -> do+ let+ timeToDeadlineMicros = diffTimeSecToMicros $ diffSystemTime deadline curTime+ eventWithinDurationMicros level timeToDeadlineMicros k deadlineType+ Nothing -> eventFromKey' level <$> getKeyThenFlush++eventWithinDurationMicros :: Level -> Int -> KeyTime -> DeadlineType -> IO (Maybe Event)+eventWithinDurationMicros level durationMicros k step =+ (\case+ Just key -> eventFromKey' level key+ _ -> Just $ Timeout (Deadline k step)+ ) <$> getCharWithinDurationMicros durationMicros step++getCharWithinDurationMicros :: Int -> DeadlineType -> IO (Maybe Key)+getCharWithinDurationMicros durationMicros step =+ if durationMicros < 0+ -- overdue+ then+ if playerEventPriority > deadlinePriority step+ then+ tryGetKeyThenFlush+ else+ return Nothing+ else+ timeout durationMicros getKeyThenFlush++{-# INLINABLE renderLevelState #-}+renderLevelState :: (Draw e, MonadReader e m, MonadIO m)+ => Coords Pos+ -> Int+ -> LevelFinished+ -> m ()+renderLevelState s level (LevelFinished stop _ messageState) = do+ let topLeft = translateInDir RIGHT s+ stopMsg = case stop of+ (Lost reason) -> "You Lose (" <> reason <> ")"+ Won -> "You Win!"+ drawTxt stopMsg topLeft (messageColor stop)+ when (messageState == ContinueMessage) $+ drawTxt+ (if level == lastLevel+ then+ "You reached the end of the game!"+ else+ let action = case stop of+ (Lost _) -> "restart"+ Won -> "continue"+ in "Hit a key to " <> action <> " ...")+ (move 2 Down topLeft) neutralMessageColor+++{-# INLINABLE renderLevelMessage #-}+renderLevelMessage :: (Draw e, MonadReader e m, MonadIO m)+ => Level+ -> Coords Pos+ -> m ()+renderLevelMessage (Level level _ levelState) rightMiddle =+ mapM_ (renderLevelState rightMiddle level) levelState
+ src/Imj/Game/Hamazed/Level/Types.hs view
@@ -0,0 +1,48 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}++module Imj.Game.Hamazed.Level.Types+ ( Level(..)+ , LevelFinished(..)+ , MessageState(..)+ , GameStops(..)+ , firstLevel+ , lastLevel+ ) where+++import Imj.Prelude++import Imj.Timing++data Level = Level {+ _levelNumber :: !Int+ -- ^ From 1 to 12+ , _levelTarget :: !Int+ -- ^ The /target number/+ , _levelStatus :: !(Maybe LevelFinished)+}++data LevelFinished = LevelFinished {+ _levelFinishedResult :: !GameStops+ -- ^ Lost or won+ , _levelFinishedWhen :: !SystemTime+ , _levelFinishedCurrentMessage :: !MessageState+}++data MessageState = InfoMessage+ | ContinueMessage+ deriving(Eq, Show)++data GameStops = Lost Text+ -- ^ 'Text' is the reason why the 'Level' was lost.+ | Won++-- | 12+lastLevel :: Int+lastLevel = 12++-- | 1+firstLevel :: Int+firstLevel = 1
+ src/Imj/Game/Hamazed/Loop/Create.hs view
@@ -0,0 +1,60 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}++module Imj.Game.Hamazed.Loop.Create+ ( mkInitialState+ ) where++import Imj.Prelude++import Control.Monad.IO.Class(MonadIO)++import Imj.Game.Hamazed.Color+import Imj.Game.Hamazed.Infos+import Imj.Game.Hamazed.Parameters+import Imj.Game.Hamazed.Types+import Imj.Game.Hamazed.World.Create+import Imj.Game.Hamazed.World.Size+import Imj.Game.Hamazed.World.InTerminal+import Imj.Graphics.UI.Animation+import Imj.Graphics.UI.Colored+import Imj.Timing++mkInitialState :: (MonadIO m)+ => GameParameters+ -> Int+ -> Maybe GameState+ -> m (Either String GameState)+mkInitialState (GameParameters shape wallType) levelNumber mayState = do+ let numbers = [1..(3+levelNumber)] -- more and more numbers as level increases+ target = sum numbers `quot` 2+ newLevel = Level levelNumber target Nothing+ newSize = worldSizeFromLevel levelNumber shape+ newAmmo = 10+ newShotNums = []+ make ew = do+ newWorld <- mkWorld ew newSize wallType numbers newAmmo+ t <- liftIO getSystemTime+ let (curWorld, level, ammo, shotNums) =+ maybe+ (newWorld, newLevel, 0, [])+ (\(GameState _ w@(World _ (BattleShip _ curAmmo _ _) _ _ _)+ _ curShotNums curLevel _) ->+ (w, curLevel, curAmmo, curShotNums))+ mayState+ curInfos = mkInfos Normal ammo shotNums level+ newInfos = mkInfos ColorAnimated newAmmo newShotNums newLevel+ uiAnimation =+ mkUIAnimation+ (Colored worldFrameColors $ mkWorldContainer curWorld, curInfos)+ (Colored worldFrameColors $ mkWorldContainer newWorld, newInfos)+ t+ gameDeadline =+ if isFinished uiAnimation+ then+ Just $ KeyTime t+ else+ Nothing+ return $ Right $ GameState gameDeadline curWorld newWorld newShotNums newLevel uiAnimation+ mkInTerminal newSize >>= either (return . Left) make
+ src/Imj/Game/Hamazed/Loop/Deadlines.hs view
@@ -0,0 +1,113 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE LambdaCase #-}++module Imj.Game.Hamazed.Loop.Deadlines+ ( getNextDeadline+ ) where++import Imj.Prelude++import Data.List( minimumBy, find )+import Data.Maybe( catMaybes )++import Imj.Game.Hamazed.Level+import Imj.Game.Hamazed.Loop.Event.Types+import Imj.Game.Hamazed.Types+import Imj.Graphics.UI.Animation+import Imj.Graphics.Animation.Design.Update+import Imj.Timing+++{- | Returns the next 'Deadline' to handle.++We prefer having time-accurate game motions for central items of the game+(the 'BattleShip', the 'Number's) than having time-accurate explosive 'Animation's.++Hence, when multiple overdue deadlines are competing, the following priorities apply+(higher number = higher priority):++\[+\newcommand\T{\Rule{0pt}{.5em}{.3em}}+ \begin{array}{|c|c|c|}+ \hline+ \textbf{ Priority } \T & \textbf{ Name } \T & \textbf{ Description } \\\hline+ \text{ 5 } & \text{ AnimateUI } \T & \text{ Inter-level animations } \\\hline+ \text{ 4 } & \text{ DisplayContinueMessage } \T & \textit{ Press a key to continue } \\\hline+ \text{ 3 } & \text{ MoveFlyingItems } \T & \text{ Move the BattleShip and Numbers } \\\hline+ \text{ 2 } & \textit{ Player event } \T & \text{ Handle a key-press } \\\hline+ \text{ 1 } & \text{ Animate } \T & \text{ Update animations (explosions and others)} \\\hline+ \end{array}+\]++When no 'Deadline' is overdue, we return the closest one in time, irrespective+of its priority.+-}+{-We /could/ apply priorities for non-overdue deadlines, too. For example if a+'MoveFlyingItems' very closely follows an 'Animate' (say, 15 millisecond after),+we could swap their order so as to have a better guarantee that the game motion+will happen in-time and not be delayed by a potentially heavy animation update.+But it's very unlikely that it will make a difference, except if updating+the 'Animation's becomes /very/ slow for some reason.+-}+getNextDeadline :: GameState+ -- ^ Current state+ -> SystemTime+ -- ^ The current time.+ -> Maybe Deadline+getNextDeadline s t =+ let l = getDeadlinesByDecreasingPriority s t+ in overdueDeadline t l <|> earliestDeadline' l++earliestDeadline' :: [Deadline] -> Maybe Deadline+earliestDeadline' [] = Nothing+earliestDeadline' l = Just $ minimumBy (\(Deadline t1 _) (Deadline t2 _) -> compare t1 t2 ) l++overdueDeadline :: SystemTime -> [Deadline] -> Maybe Deadline+overdueDeadline t = find (\(Deadline (KeyTime t') _) -> t' < t)++-- | priorities are : uiAnimation > message > game > player key > animation+getDeadlinesByDecreasingPriority :: GameState -> SystemTime -> [Deadline]+getDeadlinesByDecreasingPriority s@(GameState _ _ _ _ level _) t =+ catMaybes [ uiAnimationDeadline s+ , messageDeadline level t+ , getMoveFlyingItemsDeadline s+ , animationDeadline s+ ]++getMoveFlyingItemsDeadline :: GameState -> Maybe Deadline+getMoveFlyingItemsDeadline (GameState nextGameStep _ _ _ (Level _ _ levelFinished) _) =+ maybe+ (maybe+ Nothing+ (\s -> Just $ Deadline s MoveFlyingItems)+ nextGameStep)+ (const Nothing)+ levelFinished++animationDeadline :: GameState -> Maybe Deadline+animationDeadline (GameState _ world _ _ _ _) =+ maybe Nothing (\ti -> Just $ Deadline ti Animate) $ earliestAnimationDeadline world++uiAnimationDeadline :: GameState -> Maybe Deadline+uiAnimationDeadline (GameState _ _ _ _ _ uianim) =+ maybe+ Nothing+ (\deadline -> Just $ Deadline deadline AnimateUI)+ $ getUIAnimationDeadline uianim++-- | Returns the earliest 'Animation' deadline.+earliestAnimationDeadline :: World -> Maybe KeyTime+earliestAnimationDeadline (World _ _ _ animations _) =+ earliestKeyTime $ map getDeadline animations+++-- | Returns the earliest deadline+earliestKeyTime :: [KeyTime] -> Maybe KeyTime+earliestKeyTime deadlines =+ if null deadlines+ then+ Nothing+ else+ Just $ minimum deadlines
+ src/Imj/Game/Hamazed/Loop/Event.hs view
@@ -0,0 +1,38 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE LambdaCase #-}++module Imj.Game.Hamazed.Loop.Event+ ( needsRendering+ , getEvent+ -- * Reexports+ , module Imj.Game.Hamazed.Loop.Event.Types+ ) where++import Imj.Prelude++import Imj.Game.Hamazed.Level+import Imj.Game.Hamazed.Loop.Deadlines+import Imj.Game.Hamazed.Loop.Event.Types+import Imj.Game.Hamazed.Types+import Imj.Timing++-- | Tells if after handling an 'Event' we should render or not.+needsRendering :: Event -> Bool+needsRendering = \case+ (Action Ship _) -> False -- When the ship accelerates, nothing changes visually+ _ -> True++getEvent :: GameState -> IO Event+getEvent state = do+ mayEvent <- getEvent' state+ case mayEvent of+ Just event -> return event+ Nothing -> getEvent state++getEvent' :: GameState -> IO (Maybe Event)+getEvent' state@(GameState _ _ _ _ level _) = do+ t <- getSystemTime+ let deadline = getNextDeadline state t+ getEventForMaybeDeadline level deadline t
+ src/Imj/Game/Hamazed/Loop/Event/Priorities.hs view
@@ -0,0 +1,22 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}++module Imj.Game.Hamazed.Loop.Event.Priorities+ ( deadlinePriority+ , playerEventPriority+ ) where++import Imj.Prelude++import Imj.Game.Hamazed.Loop.Event.Types++playerEventPriority :: Int+playerEventPriority = 40++-- Note that if changing priorities here you should also change 'getDeadlinesByDecreasingPriority'+deadlinePriority :: DeadlineType -> Int+deadlinePriority AnimateUI = playerEventPriority + 30+deadlinePriority DisplayContinueMessage = playerEventPriority + 20+deadlinePriority MoveFlyingItems = playerEventPriority + 10+deadlinePriority Animate = playerEventPriority - 10
+ src/Imj/Game/Hamazed/Loop/Event/Types.hs view
@@ -0,0 +1,65 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}++module Imj.Game.Hamazed.Loop.Event.Types+ ( Event(..)+ , Deadline(..)+ , ActionTarget(..)+ , DeadlineType(..)+ , MetaAction(..)+ -- * Reexports (for haddock hyperlinks)+ , module Imj.Game.Hamazed.World.Types+ , module Imj.Graphics.Animation.Design.Create+ ) where++import Imj.Prelude++import Imj.Game.Hamazed.Types+import Imj.Game.Hamazed.World.Types+import Imj.Geo.Discrete+import Imj.Graphics.Animation.Design.Create+import Imj.Timing++-- | A foreseen game or animation update.+data Deadline = Deadline {+ _deadlineTime :: !KeyTime+ , _deadlineType :: !DeadlineType+} deriving(Eq, Show)++data Event = Action !ActionTarget !Direction+ -- ^ A player action on an 'ActionTarget' in a 'Direction'.+ | Timeout !Deadline+ -- ^ The 'Deadline' that needs to be handled immediately.+ | StartLevel !Int+ -- ^ New level.+ | EndGame+ -- ^ End of game.+ | Interrupt !MetaAction+ -- ^ A game interruption.+ deriving(Eq, Show)++data MetaAction = Quit+ -- ^ The player decided to quit the game.+ | Configure+ -- ^ The player wants to configure the game /(Not implemented yet)/+ | Help+ -- ^ The player wants to read the help page /(Not implemented yet)/+ deriving(Eq, Show)++data DeadlineType = MoveFlyingItems+ -- ^ Move 'Number's and 'BattleShip' according to their current+ -- speeds.+ | Animate+ -- ^ Update one or more 'Animation's.+ | DisplayContinueMessage+ -- ^ Show the /Hit a key to continue/ message+ | AnimateUI+ -- ^ Update the inter-level animation+ deriving(Eq, Show)++data ActionTarget = Ship+ -- ^ The player wants to accelerate the 'BattleShip'+ | Laser+ -- ^ The player wants to shoot with the laser.+ deriving(Eq, Show)
+ src/Imj/Game/Hamazed/Loop/Render.hs view
@@ -0,0 +1,47 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE LambdaCase #-}++module Imj.Game.Hamazed.Loop.Render+ ( render+ ) where++import Imj.Prelude++import Imj.Game.Hamazed.Level+import Imj.Game.Hamazed.Loop.Event+import Imj.Game.Hamazed.Types+import Imj.Game.Hamazed.World+import Imj.Game.Hamazed.World.Space.Types+import Imj.Graphics.Animation.Design.Types+import Imj.Graphics.Animation.Design.Render+import Imj.Graphics.UI.RectContainer+++-- | Renders the game to the screen, using "Imj.Graphics.Render.Delta" to avoid+-- <https://en.wikipedia.org/wiki/Screen_tearing screen tearing>.+{-# INLINABLE render #-}+render :: (Render e, MonadReader e m, MonadIO m)+ => GameState -> m ()+render (GameState _ world@(World _ _ space animations (InTerminal _ curUpperLeft))+ _ _ level wa) =+ renderSpace space curUpperLeft >>=+ (\worldCorner -> do+ renderAnimations worldCorner animations+ -- TODO merge 2 functions below (and no need to pass worldCorner)+ renderWorld world+ let (_,_,_,rightMiddle) = getSideCentersAtDistance (mkWorldContainer world) 3 2+ renderLevelMessage level rightMiddle+ renderUIAnimation wa -- render it last so that when it animates+ -- to reduce, it goes over numbers and ship+ ) >> renderToScreen++{-# INLINABLE renderAnimations #-}+renderAnimations :: (Draw e, MonadReader e m, MonadIO m)+ => Coords Pos+ -> [Animation]+ -> m ()+renderAnimations worldCorner animations = do+ let renderAnimation a = renderAnim a worldCorner+ mapM_ renderAnimation animations
+ src/Imj/Game/Hamazed/Loop/Run.hs view
@@ -0,0 +1,79 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE LambdaCase #-}++module Imj.Game.Hamazed.Loop.Run+ ( run+ ) where++import Imj.Prelude+import qualified Prelude (putStrLn)++import Control.Monad.IO.Class(MonadIO)+import Control.Monad.Reader.Class(MonadReader)+import Control.Monad.Reader(runReaderT)+import System.Info(os)++import Imj.Game.Hamazed.Env+import Imj.Game.Hamazed.Loop.Create+import Imj.Game.Hamazed.Loop.Event+import Imj.Game.Hamazed.Loop.Render+import Imj.Game.Hamazed.Loop.Update+import Imj.Game.Hamazed.Parameters+import Imj.Game.Hamazed.Types+import Imj.Graphics.Render+import Imj.Graphics.Render.Delta+import Imj.Threading++{- | Runs the Hamazed game.++If your current terminal window is too small, the program will error and+tell you what is the minimum window size to run the game.++The game doesn't run on Windows, because with GHC,+<https://ghc.haskell.org/trac/ghc/ticket/7353 IO operations cannot be interrupted on Windows>.+-}+run :: IO ()+run =+ if os == "mingw32"+ then+ Prelude.putStrLn $ "Windows is not currently supported,"+ ++ " due to this GHC bug: https://ghc.haskell.org/trac/ghc/ticket/7353."+ else+ void doRun++doRun :: IO Termination+doRun =+ runThenRestoreConsoleSettings+ (createEnv >>= runAndWaitForTermination . runReaderT gameWorker)++{-# INLINABLE gameWorker #-}+gameWorker :: (Render e, MonadReader e m, MonadIO m)+ => m ()+gameWorker =+ getGameParameters >>= runGameWorker+++{-# INLINABLE runGameWorker #-}+runGameWorker :: (Render e, MonadReader e m, MonadIO m)+ => GameParameters+ -> m ()+runGameWorker params =+ mkInitialState params firstLevel Nothing+ >>= \case+ Left err -> error err+ Right ew -> loop params ew++{-# INLINABLE loop #-}+loop :: (Render e, MonadReader e m, MonadIO m)+ => GameParameters+ -> GameState+ -> m ()+loop params state = do+ liftIO (getEvent state) >>= \evt -> case evt of+ (Interrupt _) -> return ()+ _ -> do+ newState <- liftIO $ update params state evt+ when (needsRendering evt) $ render newState+ loop params newState
+ src/Imj/Game/Hamazed/Loop/Timing.hs view
@@ -0,0 +1,26 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}++-- | This modules handle time constants of the game logic.++module Imj.Game.Hamazed.Loop.Timing+ ( gameMotionPeriod+ , module Imj.Timing+ ) where++import Imj.Prelude++import Imj.Timing++gameMotionPeriod :: DiffTime+gameMotionPeriod =+ fromIntegral gameMotionPeriodMicros / 1000000++-- using the "incremental" render backend, there is no flicker+-- using the "full" render backend, flicker starts at 40+gameMotionPeriodMicros :: Int+gameMotionPeriodMicros =+ millis * 1000+ where+ millis = 160 -- 20 seems to match screen refresh frequency
+ src/Imj/Game/Hamazed/Loop/Update.hs view
@@ -0,0 +1,200 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}++module Imj.Game.Hamazed.Loop.Update+ ( update+ ) where++import Imj.Prelude++import Data.Maybe( catMaybes, isNothing )++import Imj.Game.Hamazed.Infos+import Imj.Game.Hamazed.Level.Types+import Imj.Game.Hamazed.Loop.Create+import Imj.Game.Hamazed.Loop.Event+import Imj.Game.Hamazed.Loop.Timing+import Imj.Game.Hamazed.Parameters+import Imj.Game.Hamazed.Types+import Imj.Game.Hamazed.World+import Imj.Game.Hamazed.World.Number+import Imj.Game.Hamazed.World.Ship+import Imj.Game.Hamazed.World.Space.Types+import Imj.GameItem.Weapon.Laser+import Imj.Geo.Continuous+import Imj.Geo.Discrete+import Imj.Graphics.Animation.Design.Types+import Imj.Graphics.Animation.Design.Update+import Imj.Graphics.Animation+import Imj.Graphics.UI.RectContainer+import Imj.Util+++-- | Updates the state. It needs IO just to generate random numbers in case+-- 'Event' is 'StartLevel'+{-# INLINABLE update #-}+update :: GameParameters+ -- ^ 'World' creation parameters, used in case the 'Event' is 'StartLevel'.+ -> GameState+ -- ^ The current state+ -> Event+ -- ^ The 'Event' that should be handled here.+ -> IO GameState+update+ params+ state@(GameState b world@(World c d space animations e)+ futWorld f h@(Level level target mayLevelFinished) anim) = \case+ StartLevel nextLevel ->+ mkInitialState params nextLevel (Just state) >>= \case+ Left err -> error err+ Right s -> return s+ (Timeout (Deadline gt AnimateUI)) ->+ return $ updateAnim gt state+ (Timeout (Deadline _ DisplayContinueMessage)) ->+ return $ case mayLevelFinished of+ Just (LevelFinished stop finishTime _) ->+ let newLevel = Level level target (Just $ LevelFinished stop finishTime ContinueMessage)+ in GameState b world futWorld f newLevel anim+ Nothing -> state+ (Timeout (Deadline k Animate)) -> do+ let newAnimations = mapMaybe (\a -> if shouldUpdate a k+ then updateAnimation a+ else Just a) animations+ return $ GameState b (World c d space newAnimations e) futWorld f h anim+ (Timeout (Deadline gt MoveFlyingItems)) -> do+ let movedState = GameState (Just $ addDuration gameMotionPeriod gt) (moveWorld gt world) futWorld f h anim+ return $ onHasMoved movedState gt+ Action Laser dir ->+ if isFinished anim+ then+ getSystemTime >>= return . (onLaser state dir)+ else+ return $ state+ Action Ship dir ->+ return $ accelerateShip' dir state+ (Interrupt _) ->+ return state+ EndGame -> -- TODO instead, go back to game configuration ?+ return state+++onLaser :: GameState+ -> Direction+ -> SystemTime+ -> GameState+onLaser+ (GameState b world@(World _ (BattleShip posspeed ammo safeTime collisions)+ space animations e)+ futureWorld g (Level i target finished)+ (UIAnimation (UIEvolutions j upDown left) k l))+ dir t =+ let (remainingBalls, destroyedBalls, maybeLaserRay, newAmmo) =+ laserEventAction dir world+ outerSpaceAnims_ =+ if null destroyedBalls+ then+ maybe [] (outerSpaceAnims t world) maybeLaserRay+ else+ []+ newAnimations =+ destroyedNumbersAnimations (Left t) dir world destroyedBalls+ ++ maybe [] (\r -> laserAnims world r t) maybeLaserRay+ ++ outerSpaceAnims_++ newWorld = World remainingBalls (BattleShip posspeed newAmmo safeTime collisions)+ space (newAnimations ++ animations) e+ destroyedNumbers = map (\(Number _ n) -> n) destroyedBalls+ allShotNumbers = g ++ destroyedNumbers+ newLeft =+ if null destroyedNumbers && ammo == newAmmo+ then+ left+ else+ let frameSpace = mkWorldContainer world+ infos = mkLeftInfo Normal newAmmo allShotNumbers+ (_, _, leftMiddle, _) = getSideCentersAtDistance frameSpace 3 2+ in mkTextAnimRightAligned leftMiddle leftMiddle infos 0 -- 0 duration, since animation is over anyway+ newFinished = finished <|> checkTargetAndAmmo newAmmo (sum allShotNumbers) target t+ newLevel = Level i target newFinished+ newAnim = UIAnimation (UIEvolutions j upDown newLeft) k l+ in assert (isFinished newAnim) $ GameState b newWorld futureWorld allShotNumbers newLevel newAnim++-- | The world has moved, so we update it.+onHasMoved :: GameState+ -> KeyTime+ -> GameState+onHasMoved+ (GameState b world@(World balls ship@(BattleShip _ _ safeTime collisions) space animations e)+ futureWorld shotNums (Level i target finished) anim)+ keyTime@(KeyTime t) =+ let newAnimations = shipAnims world keyTime+ remainingBalls =+ if isNothing safeTime+ then+ filter (`notElem` collisions) balls+ else+ balls+ newWorld = World remainingBalls ship space (newAnimations ++ animations) e+ finishIfShipCollides =+ maybe+ (case map (\(Number _ n) -> n) collisions of+ [] -> Nothing+ l -> Just $ LevelFinished (Lost $ "collision with " <> showListOrSingleton l) t InfoMessage )+ (const Nothing)+ safeTime+ newLevel = Level i target (finished <|> finishIfShipCollides)+ in assert (isFinished anim) $ GameState b newWorld futureWorld shotNums newLevel anim+++outerSpaceAnims :: SystemTime+ -> World+ -> LaserRay Actual+ -> [Animation]+outerSpaceAnims t world@(World _ _ (Space _ sz _) _ _) ray@(LaserRay dir _) =+ let laserTarget = afterEnd ray+ in case onOuterBorder laserTarget sz of+ Just outDir -> outerSpaceAnims' t world laserTarget $ assert (dir == outDir) dir+ Nothing -> []++outerSpaceAnims' :: SystemTime+ -> World+ -> Coords Pos+ -> Direction+ -> [Animation]+outerSpaceAnims' t@(MkSystemTime _ nanos) world fronteerPoint dir =+ let char = niceChar $ fromIntegral nanos -- cycle character every nano second+ speed = scalarProd 0.8 $ speed2vec $ coordsForDirection dir+ outerSpacePoint = translateInDir dir fronteerPoint+ interaction = environmentInteraction world TerminalWindow+ in fragmentsFreeFall speed outerSpacePoint interaction (Speed 1) (Left t) char+++laserAnims :: World+ -> LaserRay Actual+ -> SystemTime+ -> [Animation]+laserAnims world ray t =+ let interaction = environmentInteraction world WorldFrame+ in catMaybes [laserAnimation ray interaction (Left t)]+++accelerateShip' :: Direction -> GameState -> GameState+accelerateShip' dir (GameState c (World wa ship wc wd we) b f g h) =+ let newShip = accelerateShip dir ship+ world = World wa newShip wc wd we+ in GameState c world b f g h++updateAnim :: KeyTime -> GameState -> GameState+updateAnim kt (GameState _ curWorld futWorld j k (UIAnimation evolutions _ it)) =+ let nextIt@(Iteration _ nextFrame) = nextIteration it+ (world, gameDeadline, worldAnimDeadline) =+ maybe+ (futWorld , Just kt, Nothing)+ (\dt ->+ (curWorld, Nothing, Just $ addDuration (floatSecondsToDiffTime dt) kt))+ $ getDeltaTime evolutions nextFrame+ wa = UIAnimation evolutions worldAnimDeadline nextIt+ in GameState gameDeadline world futWorld j k wa
+ src/Imj/Game/Hamazed/Parameters.hs view
@@ -0,0 +1,127 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}++module Imj.Game.Hamazed.Parameters(+ GameParameters(..)+ , getGameParameters+ ) where++import Imj.Prelude++import Control.Monad.IO.Class(MonadIO)+import Control.Monad.Reader.Class(MonadReader)++import Imj.Game.Hamazed.Color+import Imj.Game.Hamazed.World.Create+import Imj.Game.Hamazed.World.InTerminal+import Imj.Game.Hamazed.World.Render+import Imj.Game.Hamazed.World.Size+import Imj.Game.Hamazed.World.Space+import Imj.Game.Hamazed.World.Types+import Imj.Geo.Discrete+import Imj.Graphics.Text.Alignment+import Imj.Graphics.UI.Animation+import Imj.Graphics.UI.Colored+import Imj.Input.Blocking+import Imj.Input.Types+import Imj.Timing+++data GameParameters = GameParameters {+ _gameParamsWorldShape :: !WorldShape+ , _gameParamsWallDistrib :: !WallDistribution+}++minRandomBlockSize :: Int+minRandomBlockSize = 6 -- using 4 it once took a very long time (one minute, then I killed the process)+ -- 6 has always been ok++initialParameters :: GameParameters+initialParameters = GameParameters Square None++-- | Displays the configuration UI showing the game creation options,+-- and returns when the player has finished chosing the options.+{-# INLINABLE getGameParameters #-}+getGameParameters :: (Render e, MonadReader e m, MonadIO m)+ => m GameParameters+getGameParameters = update initialParameters++{-# INLINABLE update #-}+update :: (Render e, MonadReader e m, MonadIO m)+ => GameParameters+ -> m GameParameters+update params = do+ render' params+ liftIO getKeyThenFlush >>= \case+ AlphaNum c ->+ if c == ' '+ then+ return params+ else+ update $ updateFromChar c params+ _ -> return params++updateFromChar :: Char -> GameParameters -> GameParameters+updateFromChar c p@(GameParameters shape wallType) =+ case c of+ '1' -> GameParameters Square wallType+ '2' -> GameParameters Rectangle2x1 wallType+ 'e' -> GameParameters shape None+ 'r' -> GameParameters shape Deterministic+ 't' -> GameParameters shape (Random $ RandomParameters minRandomBlockSize StrictlyOneComponent)+ _ -> p+++{-# INLINABLE dText #-}+dText :: (Draw e, MonadReader e m, MonadIO m)+ => Text+ -> Coords Pos+ -> m (Coords Pos)+dText txt pos =+ drawTxt txt pos configColors >> return (translateInDir Down pos)++{-# INLINABLE dText_ #-}+dText_ :: (Draw e, MonadReader e m, MonadIO m)+ => Text+ -> Coords Pos+ -> m ()+dText_ txt pos =+ void (dText txt pos)++{-# INLINABLE render' #-}+render' :: (Render e, MonadReader e m, MonadIO m)+ => GameParameters+ -> m ()+render' (GameParameters shape wall) = do+ let worldSize@(Size (Length rs) (Length cs)) = worldSizeFromLevel 1 shape+ mkInTerminal worldSize >>= \case+ Left err -> error err+ Right rew@(InTerminal _ ul) -> do+ world@(World _ _ space _ _) <- mkWorld rew worldSize wall [] 0+ _ <- renderSpace space ul >>=+ \worldCoords -> do+ renderWorld world+ let middle = move (quot cs 2) RIGHT worldCoords+ middleCenter = move (quot (rs-1) 2 ) Down middle+ middleLow = move (rs-1) Down middle+ leftMargin = 3+ left = move (quot (rs-1) 2 - leftMargin) LEFT middleCenter+ drawAlignedTxt "Game configuration" configColors (mkCentered $ translateInDir Down middle)+ >>= drawAlignedTxt_ "------------------" configColors+ drawAlignedTxt_ "Hit 'Space' to start game" configColors (mkCentered $ translateInDir Up middleLow)++ translateInDir Down <$> dText "- World shape" (move 5 Up left)+ >>= dText "'1' -> width = height"+ >>= dText_ "'2' -> width = 2 x height"+ translateInDir Down <$> dText "- World walls" left+ >>= dText "'e' -> no walls"+ >>= dText "'r' -> deterministic walls"+ >>= dText_ "'t' -> random walls"++ t <- liftIO getSystemTime+ let infos = (Colored worldFrameColors $ mkWorldContainer world, (([""],[""]),[[""],[""]]))+ renderUIAnimation $ mkUIAnimation infos infos t+ renderToScreen
+ src/Imj/Game/Hamazed/Types.hs view
@@ -0,0 +1,34 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}++module Imj.Game.Hamazed.Types+ ( GameState(..)+ -- * Reexports+ , module Imj.Game.Hamazed.Level.Types+ , module Imj.Game.Hamazed.World.Types+ , UIAnimation+ ) where++import Imj.Prelude++import Imj.Game.Hamazed.Level.Types+import Imj.Game.Hamazed.Loop.Timing+import Imj.Game.Hamazed.World.Types+import Imj.Graphics.UI.Animation+++data GameState = GameState {+ _gameStateNextMotionStep :: !(Maybe KeyTime)+ -- ^ When the next 'World' motion update should happen,+ , _gameStatePreviousWorld :: !World+ -- ^ The previous 'World'+ , _gameStateCurrentWorld :: !World+ -- ^ The current 'World'+ , _gameStateShotNumbers :: ![Int]+ -- ^ Which 'Number's were shot+ , _gameStateLevel :: !Level+ -- ^ The current 'Level'+ , _gameStateUIAnimation :: !UIAnimation+ -- ^ Inter-level animation.+}
+ src/Imj/Game/Hamazed/World.hs view
@@ -0,0 +1,233 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Imj.Game.Hamazed.World+ (+ -- * Parameters+ {-| When the game starts, the player can chose 'World' parameters:++ * 'WorldShape' : square or rectangular 'World' where the width is twice the height+ * 'WallDistribution' : Should the 'World' have walls, and what kind of walls.+ -}+ getGameParameters+ , GameParameters(..)+ -- * Level+ {-| There are 12 levels in Hamazed, numbered from 1 to 12.+ -}+ , Level(..)+ -- ** Level termination+ {-| [Target number]+ Each level has a different /target number/ which represents the sum of shot+ 'Number's that should be reached to finish the 'Level'.++ A 'Level' is finished once the sum of shot 'Number's amounts to the /target number/. -}+ , checkTargetAndAmmo+ -- * World+ {- | A 'World' brings together:++ * game elements : 'Space', 'BattleShip' and 'Number's,+ * rendering elements: 'Animation's,+ * terminal-awareness : 'InTerminal'+ -}+ , World(..)+ -- ** Create the world+ {-|+ The 'World' size decreases with increasing 'Level' numbers.++ 'worldSizeFromLevel' gives the 'Size' of the 'World' based on+ the 'Level' number and the 'WorldShape':+ -}+ , worldSizeFromLevel+ {-|+ Once we have the 'Size' of the 'World', we can create it using 'mkWorld':+ -}+ , mkWorld+ -- ** Update World+ -- | Every 'gameMotionPeriod' seconds, the positions of 'BattleShip' and 'Numbers'+ -- are updated according to their speeds:+ , gameMotionPeriod+ , moveWorld+ -- ** Render World+ , renderWorld+ -- ** World utilities+ -- | 'laserEventAction' returns the effect a laser shot it has on the 'World'.+ , laserEventAction+ -- * InTerminal+ -- | 'InTerminal' allows to place the game in the center of the terminal.+ , mkInTerminal+ , InTerminal(..)+ -- * Space+ {-| 'Space' describes the environment in which 'Number's and the 'BattleShip'+ live.++ It can be composed of 'Air', where 'BattleShip' and 'Number's are free to move, and of+ 'Wall'.+ -}+ , Space+ , Material(..)+ -- ** Simple creation+ , mkEmptySpace+ , mkDeterministicallyFilledSpace+ -- ** Randomized creation+ {-| 'mkRandomlyFilledSpace' places 'Wall's at random and discards resulting+ 'Space's which have more than one 'Air' connected component.++ This way, the 'BattleShip' is guaranteed to be able to reach any part of+ the 'Space', and 'Number's.++ Generating a big 'Space' with a very small block size can+ be computationnaly expensive because the probability to have a single 'Air'+ connected component drops very fast (probably at least exponentially)+ towards zero with increasing sizes. -}+ , mkRandomlyFilledSpace+ , RandomParameters(..)+ , Strategy(..)+ -- ** Collision detection+ {- | 'location' is the standard collision detection function that considers+ that being outside the world means being in collision.++ 'scopedLocation' prevides more options with the use of 'Boundaries' to+ defines the collision detection scopes.+ -}+ , location+ , scopedLocation+ , Boundaries(..)+ -- ** Collision detection utilities+ , createRandomNonCollidingPosSpeed+ -- ** Render+ , renderSpace+ -- * Movable items+ -- | A movable item's 'PosSpeed' is updated using 'updateMovableItem'+ -- at each 'MoveFlyingItems' event:+ , updateMovableItem+ -- ** BattleShip+ , BattleShip(..)+ -- *** Accelerate BattleShip+ -- | The 'BattleShip' is controlled in (discrete) acceleration by the player+ -- using the keyboard.+ , accelerateShip+ -- ** Number+ -- | 'Number's can be shot by the 'BattleShip' to finish the 'Level'.+ --+ -- Number can collide with the 'BattleShip', hence triggering colorfull+ -- 'Animation' explosions.+ --+ -- 'Number's never change speed, except when they rebound on 'Wall's, of course.+ , Number(..)+ -- * UI+ {- | UI elements around the 'World' are:++ * a 'RectContainer' created by 'mkWorldContainer' to visually delimit the 'World'+ * 'ColorString' information, placed around the 'RectContainer':++ * Up: 'Level' target+ * Left: remaining ammunitions / shot 'Number's+ * Down: 'Level' number+ -}+ , mkWorldContainer+ -- ** Inter-level animations+ , module Imj.Graphics.UI.Animation+ -- * Secondary types+ , WallDistribution(..)+ , WorldShape(..)+ , LevelFinished(..)+ , GameStops(..)+ -- * Reexports+ , module Imj.Graphics.Render+ , ColorString+ ) where++import Imj.Prelude++import Control.Monad.IO.Class(MonadIO)+import Control.Monad.Reader.Class(MonadReader)++import Data.Text( pack )++import Imj.Game.Hamazed.Loop.Event+import Imj.Game.Hamazed.Loop.Timing+import Imj.Game.Hamazed.Level.Types+import Imj.Game.Hamazed.Parameters+import Imj.Game.Hamazed.World.Create+import Imj.Game.Hamazed.World.InTerminal+import Imj.Game.Hamazed.World.Number+import Imj.Game.Hamazed.World.Render+import Imj.Game.Hamazed.World.Size+import Imj.Game.Hamazed.World.Space+import Imj.GameItem.Weapon.Laser+import Imj.Geo.Discrete+import Imj.Graphics.Render+import Imj.Graphics.Text.ColorString+import Imj.Graphics.UI.Animation++-- | Note that the position of the 'BattleShip' remains unchanged.+accelerateShip :: Direction -> BattleShip -> BattleShip+accelerateShip dir (BattleShip (PosSpeed pos speed) ba bb bc) =+ let newSpeed = translateInDir dir speed+ in BattleShip (PosSpeed pos newSpeed) ba bb bc++-- | Moves elements of game logic ('Number's, 'BattleShip').+--+-- Note that 'Animation's are not updated.+moveWorld :: KeyTime+ -- ^ The current time+ -> World+ -> World+moveWorld (KeyTime curTime) (World balls (BattleShip shipPosSpeed ammo safeTime _) size anims e) =+ let newSafeTime = case safeTime of+ (Just t) -> if curTime > t+ then+ Nothing+ else+ safeTime+ _ -> Nothing+ newBalls = map (\(Number ps n) -> Number (updateMovableItem size ps) n) balls+ newPosSpeed@(PosSpeed pos _) = updateMovableItem size shipPosSpeed+ collisions = getColliding pos newBalls+ newShip = BattleShip newPosSpeed ammo newSafeTime collisions+ in World newBalls newShip size anims e++-- TODO use Number Live Number Dead+-- | Computes the effect of an laser shot on the 'World'.+laserEventAction :: Direction+ -- ^ The direction of the laser shot+ -> World+ -> ([Number], [Number], Maybe (LaserRay Actual), Int)+ -- ^ 'Number's still alive, 'Number's destroyed, maybe an actual laser ray, Ammo left.+laserEventAction dir (World balls (BattleShip (PosSpeed shipCoords _) ammo _ _) space _ _) =+ let (maybeLaserRayTheoretical, newAmmo) =+ if ammo > 0 then+ (LaserRay dir <$> shootLaserWithOffset shipCoords dir Infinite (`location` space), pred ammo)+ else+ (Nothing, ammo)++ ((remainingBalls, destroyedBalls), maybeLaserRay) =+ maybe+ ((balls,[]), Nothing)+ (\r -> computeActualLaserShot balls (\(Number (PosSpeed pos _) _) -> pos) r DestroyFirstObstacle)+ maybeLaserRayTheoretical++ in (remainingBalls, destroyedBalls, maybeLaserRay, newAmmo)+++checkTargetAndAmmo :: Int+ -- ^ Remaining ammo+ -> Int+ -- ^ The current sum of all shot 'Numbers'+ -> Int+ -- ^ The 'Level' 's target number.+ -> SystemTime+ -- ^ The current time+ -> Maybe LevelFinished+checkTargetAndAmmo ammo sumNumbers target t =+ maybe Nothing (\stop -> Just $ LevelFinished stop t InfoMessage) allChecks+ where+ allChecks = checkSum <|> checkAmmo++ checkSum = case compare sumNumbers target of+ LT -> Nothing+ EQ -> Just Won+ GT -> Just $ Lost $ pack $ show sumNumbers ++ " is bigger than " ++ show target+ checkAmmo+ | ammo <= 0 = Just $ Lost $ pack "no ammo left"+ | otherwise = Nothing
+ src/Imj/Game/Hamazed/World/Create.hs view
@@ -0,0 +1,86 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}++module Imj.Game.Hamazed.World.Create+ ( mkWorld+ , updateMovableItem+ ) where++import Imj.Prelude++import Control.Monad.IO.Class(MonadIO, liftIO)++import Imj.Game.Hamazed.World.Number+import Imj.Game.Hamazed.World.Ship+import Imj.Game.Hamazed.World.Space+import Imj.Game.Hamazed.World.Types+import Imj.Geo.Discrete+import Imj.Physics.Discrete.Collision+import Imj.Timing++mkWorld :: (MonadIO m)+ => InTerminal+ -- ^ Tells where to draw the 'World' from+ -> Size+ -- ^ The dimensions+ -> WallDistribution+ -- ^ How the 'Wall's should be constructed+ -> [Int]+ -- ^ The numbers for which we will create 'Number's.+ -> Int+ -- ^ Ammunition : how many laser shots are available.+ -> m World+mkWorld e s walltype nums ammo = do+ space <- case walltype of+ None -> return $ mkEmptySpace s+ Deterministic -> return $ mkDeterministicallyFilledSpace s+ Random rParams -> liftIO $ mkRandomlyFilledSpace rParams s+ t <- liftIO getSystemTime+ balls <- mapM (createRandomNumber space) nums+ ship@(PosSpeed pos _) <- liftIO $ createShipPos space balls+ return $ World balls (BattleShip ship ammo (Just $ addToSystemTime 5 t) (getColliding pos balls)) space [] e+++-- | Updates 'PosSpeed' of a movable item, according to 'Space'.+updateMovableItem :: Space+ -- ^ The surrounding 'Space' will be taken into account for collisions.+ -> PosSpeed+ -- ^ The current position and speed of the moving item.+ -> PosSpeed+ -- ^ The updated position and speed.+updateMovableItem space ps@(PosSpeed pos _) =+ let (newPs@(PosSpeed newPos _), collision) =+ mirrorSpeedAndMoveToPrecollisionIfNeeded (`location` space) ps+ in case collision of+ PreCollision ->+ if pos /= newPos+ then+ newPs+ else+ -- Precollision position is the same as the previous position, we try to move+ doBallMotionUntilCollision space newPs+ NoCollision -> doBallMotion newPs++-- if we ever change this, we should chek other places where we use sumPosSpeed+-- to use this function instead+doBallMotion :: PosSpeed -> PosSpeed+doBallMotion (PosSpeed pos speed) =+ PosSpeed (sumPosSpeed pos speed) speed++-- | Changes the position until a collision is found.+-- Doesn't change the speed+doBallMotionUntilCollision :: Space -> PosSpeed -> PosSpeed+doBallMotionUntilCollision space (PosSpeed pos speed) =+ let trajectory = bresenham $ mkSegment pos $ sumPosSpeed pos speed+ newPos = maybe (last trajectory) snd $ firstCollision (`location` space) trajectory+ in PosSpeed newPos speed+++createRandomNumber :: (MonadIO m)+ => Space+ -> Int+ -> m Number+createRandomNumber space i = do+ ps <- liftIO $ createRandomNonCollidingPosSpeed space+ return $ Number ps i
+ src/Imj/Game/Hamazed/World/InTerminal.hs view
@@ -0,0 +1,64 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}++module Imj.Game.Hamazed.World.InTerminal+ ( mkInTerminal+ ) where++import Imj.Prelude++import Control.Monad.IO.Class(MonadIO)++import qualified System.Console.Terminal.Size as Terminal( Window(..), size )++import Imj.Game.Hamazed.World.Size+import Imj.Game.Hamazed.World.Types+import Imj.Geo.Discrete.Types++-- | Minimal margin between the upper left corner of the console+-- and upper left corner of the world+minimalWorldMargin :: Int+minimalWorldMargin = 4++-- | Will compute the position of the 'World' so as to display it in the+-- center of the terminal window.+{-# INLINABLE mkInTerminal #-}+mkInTerminal :: (MonadIO m)+ => Size+ -- ^ Measures the dimensions of the /inner/ content of the 'World',+ -- excluding the outer frame.+ -> m (Either String InTerminal)+mkInTerminal s = do+ mayTermSize <- liftIO Terminal.size+ return $ InTerminal mayTermSize <$> worldUpperLeftToCenterIt' s mayTermSize+++worldUpperLeftToCenterIt' :: Size -> Maybe (Terminal.Window Int) -> Either String (Coords Pos)+worldUpperLeftToCenterIt' worldSize mayTermSize =+ case mayTermSize of+ Just termSize@(Terminal.Window h w) ->+ let (Size rs cs) = maxWorldSize+ heightMargin = 2 * (1 {-outer walls-} + 1 {-1 line above and below-})+ widthMargin = 2 * (1 {-outer walls-} + 4 {-brackets, spaces-} + 16 * 2 {-display all numbers-})+ minSize@(Terminal.Window minh minw) =+ Terminal.Window (fromIntegral rs + heightMargin)+ (fromIntegral cs + widthMargin)+ in if h < minh || w < minw+ then+ Left $ "\nMinimum terminal size : " ++ show minSize+ ++ ".\nCurrent terminal size : " ++ show termSize+ ++ ".\nThe current terminal size doesn't match the minimum size,"+ ++ "\nplease adjust your terminal size and restart the executable"+ ++ ".\n"+ else+ Right $ worldUpperLeftFromTermSize termSize worldSize+ Nothing -> Right $ Coords (Coord minimalWorldMargin) (Coord minimalWorldMargin)++-- | upper left for the /outer/ content of the 'World', i.e including the /outer/+-- frame.+worldUpperLeftFromTermSize :: Terminal.Window Int -> Size -> (Coords Pos)+worldUpperLeftFromTermSize (Terminal.Window h w) (Size rs cs) =+ let walls = 2 :: Int+ in toCoords (quot (fromIntegral h-(rs+ fromIntegral walls)) 2)+ (quot (fromIntegral w-(cs+ fromIntegral walls)) 2)
+ src/Imj/Game/Hamazed/World/Number.hs view
@@ -0,0 +1,43 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}++module Imj.Game.Hamazed.World.Number(+ getColliding+ , computeActualLaserShot+ , destroyedNumbersAnimations+ ) where++import Imj.Prelude++import Data.Char( intToDigit )++import Imj.Game.Hamazed.Loop.Event+import Imj.GameItem.Weapon.Laser+import Imj.Geo.Continuous+import Imj.Geo.Discrete+import Imj.Graphics.Animation++getColliding :: Coords Pos -> [Number] -> [Number]+getColliding pos =+ filter (\(Number (PosSpeed pos' _) _) -> pos == pos')++destroyedNumbersAnimations :: Either SystemTime KeyTime+ -> Direction -- ^ 'Direction' of the laser shot+ -> World -- ^ the 'World' the 'Number's live in+ -> [Number]+ -> [Animation]+destroyedNumbersAnimations keyTime dir world =+ let laserSpeed = speed2vec $ coordsForDirection dir+ in concatMap (destroyedNumberAnimations keyTime laserSpeed world)++destroyedNumberAnimations :: Either SystemTime KeyTime+ -> Vec2 Vel+ -> World+ -> Number+ -> [Animation]+destroyedNumberAnimations k laserSpeed world (Number (PosSpeed pos _) n) =+ let char = intToDigit n+ envFunc = environmentInteraction world WorldFrame+ in catMaybes ([animatedPolygon n pos envFunc (Speed 1) k char])+ ++ fragmentsFreeFallThenExplode (scalarProd 0.8 laserSpeed) pos envFunc (Speed 2) k char
+ src/Imj/Game/Hamazed/World/Render.hs view
@@ -0,0 +1,52 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}++module Imj.Game.Hamazed.World.Render+ ( renderUIAnimation+ , renderWorld+ ) where++import Imj.Prelude++import Data.Char( intToDigit )+import Data.Maybe( isNothing, isJust )++import Imj.Game.Hamazed.Color+import Imj.Game.Hamazed.World.Space.Types+import Imj.Game.Hamazed.World.Space+import Imj.Game.Hamazed.World.Types+import Imj.Geo.Discrete+import Imj.Physics.Discrete.Collision+import Imj.Graphics.UI.Animation+++{-# INLINABLE renderWorld #-}+renderWorld :: (Draw e, MonadReader e m, MonadIO m)+ => World+ -> m ()+renderWorld+ (World balls (BattleShip (PosSpeed shipCoords _) _ safeTime collisions)+ space _ (InTerminal _ upperLeft)) = do+ -- render numbers, including the ones that will be destroyed, if any+ let s = translateInDir Down $ translateInDir RIGHT upperLeft+ mapM_ (\b -> renderNumber b space s) balls+ when ((null collisions || isJust safeTime) && (InsideWorld == location shipCoords space)) $ do+ let colors =+ if isNothing safeTime+ then+ shipColors+ else+ shipColorsSafe+ drawChar '+' (sumCoords shipCoords s) colors+++{-# INLINABLE renderNumber #-}+renderNumber :: (Draw e, MonadReader e m, MonadIO m)+ => Number+ -> Space+ -> Coords Pos+ -> m ()+renderNumber (Number (PosSpeed pos _) i) space b =+ when (location pos space == InsideWorld) $+ drawChar (intToDigit i) (sumCoords pos b) (numberColor i)
+ src/Imj/Game/Hamazed/World/Ship.hs view
@@ -0,0 +1,56 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE LambdaCase #-}++module Imj.Game.Hamazed.World.Ship+ ( shipAnims+ , createShipPos+ ) where++import Imj.Prelude++import Data.Char( intToDigit )+import Data.List( foldl' )+import Data.Maybe( isNothing )++import Imj.Game.Hamazed.Loop.Event+import Imj.Game.Hamazed.World.Space+import Imj.Geo.Discrete+import Imj.Geo.Continuous+import Imj.Graphics.Animation++{- | If the ship is colliding and not in "safe time", and the event is a gamestep,+this function creates an animation where the ship and the colliding number explode.++The ship animation will have the initial speed of the number and vice-versa,+to mimic the rebound due to the collision.+-}+shipAnims :: World+ -> KeyTime+ -> [Animation]+shipAnims world@(World _ (BattleShip (PosSpeed shipCoords shipSpeed) _ safeTime collisions) _ _ _) k =+ if not (null collisions) && isNothing safeTime+ then+ -- when number and ship explode, they exchange speeds+ let collidingNumbersAvgSpeed = foldl' sumCoords zeroCoords $ map (\(Number (PosSpeed _ speed) _) -> speed) collisions+ numSpeed = scalarProd 0.4 $ speed2vec collidingNumbersAvgSpeed+ shipSpeed2 = scalarProd 0.4 $ speed2vec shipSpeed+ (Number _ n) = head collisions+ interaction = environmentInteraction world WorldFrame+ in fragmentsFreeFallThenExplode numSpeed shipCoords interaction (Speed 1) (Right k) '|'+ +++ fragmentsFreeFallThenExplode shipSpeed2 shipCoords interaction (Speed 1) (Right k) (intToDigit n)+ else+ []+++createShipPos :: Space -> [Number] -> IO PosSpeed+createShipPos space numbers = do+ let numPositions = map (\(Number (PosSpeed pos _) _) -> pos) numbers+ candidate@(PosSpeed pos _) <- createRandomNonCollidingPosSpeed space+ if pos `notElem` numPositions+ then+ return candidate+ else+ createShipPos space numbers
+ src/Imj/Game/Hamazed/World/Size.hs view
@@ -0,0 +1,39 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}++module Imj.Game.Hamazed.World.Size+ ( maxWorldSize+ , worldSizeFromLevel+ ) where++import Imj.Prelude++import Imj.Game.Hamazed.Level.Types+import Imj.Game.Hamazed.World.Types+import Imj.Geo.Discrete.Types++maxLevelHeight :: Length Height+maxLevelHeight = 36++maxLevelWidth :: Length Width+maxLevelWidth = 2 * fromIntegral maxLevelHeight++maxWorldSize :: Size+maxWorldSize = Size maxLevelHeight maxLevelWidth++heightFromLevel :: Int -> Length Height+heightFromLevel level =+ maxLevelHeight + fromIntegral (2 * (firstLevel-level)) -- less and less space as level increases+++worldSizeFromLevel :: Int+ -- ^ 'Level' number+ -> WorldShape -> Size+worldSizeFromLevel level shape =+ let h = heightFromLevel level+ -- we need even world dimensions to ease level construction+ w = fromIntegral $ assert (even h) h * case shape of+ Square -> 1+ Rectangle2x1 -> 2+ in Size h w
+ src/Imj/Game/Hamazed/World/Space.hs view
@@ -0,0 +1,337 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE LambdaCase #-}++module Imj.Game.Hamazed.World.Space+ ( Space+ , Material(..)+ , mkEmptySpace+ , mkDeterministicallyFilledSpace+ , mkRandomlyFilledSpace+ , RandomParameters(..)+ , Strategy(..)+ , location+ , scopedLocation+ , Boundaries(..)+ , renderSpace+ , createRandomNonCollidingPosSpeed+ -- * Reexports+ , module Imj.Graphics.Render+ ) where++import Imj.Prelude++import Control.Monad.IO.Class(MonadIO)+import Control.Monad.Reader.Class(MonadReader)+import System.Console.Terminal.Size( Window(..) )+import Data.Graph( Graph+ , graphFromEdges+ , components )+import Data.List(length, group, concat, mapAccumL)+import Data.Maybe(mapMaybe)+import Data.Matrix( getElem+ , fromLists+ , getMatrixAsVector+ , Matrix+ , nrows, ncols )+import Data.Vector(Vector, slice, (!))+import Foreign.C.Types( CInt(..) )++import Imj.Game.Hamazed.Color+import Imj.Game.Hamazed.World.Space.Types+import Imj.Geo.Discrete+import Imj.Graphics.Render+import Imj.Physics.Discrete+import Imj.Util++-- | Creates a 'PosSpeed' such that its position is not colliding,+-- and moves to precollision and mirrors speed if a collision is detected for+-- the next step (see 'mirrorSpeedAndMoveToPrecollisionIfNeeded').+createRandomNonCollidingPosSpeed :: Space -> IO PosSpeed+createRandomNonCollidingPosSpeed space = do+ pos <- randomNonCollidingPos space+ dx <- randomSpeed+ dy <- randomSpeed+ return $ fst+ $ mirrorSpeedAndMoveToPrecollisionIfNeeded (`location` space)+ $ PosSpeed pos (Coords (Coord dx) (Coord dy))++oneRandom :: Int -> Int -> IO Int+oneRandom a b = do+ r <- randomRsIO a b+ return $ head $ take 1 r++randomSpeed :: IO Int+randomSpeed = oneRandom (-1) 1++randomNonCollidingPos :: Space -> IO (Coords Pos)+randomNonCollidingPos space@(Space _ worldSize _) = do+ coords <- randomCoords worldSize+ case getMaterial coords space of+ Wall -> randomNonCollidingPos space+ Air -> return coords++randomInt :: Int -> IO Int+randomInt sz =+ oneRandom 0 (sz-1)++randomCoords :: Size -> IO (Coords Pos)+randomCoords (Size rs cs) = do+ r <- randomCoord $ fromIntegral rs+ c <- randomCoord $ fromIntegral cs+ return $ Coords r c++randomCoord :: Coord a -> IO (Coord a)+randomCoord (Coord sz) = Coord <$> randomInt sz++forEachRowPure :: Matrix CInt -> Size -> (Coord Row -> (Coord Col -> Material) -> b) -> [b]+forEachRowPure mat (Size nRows nColumns) f =+ let rowIndexes = [0..fromIntegral $ nRows-1] -- index of inner row+ internalRowLength = nInternalColumns+ rowLength = internalRowLength - 2+ nInternalColumns = nColumns + 2 -- size of a column in the matrix+ matAsOneVector = flatten mat -- this is O(1)+ in map (\rowIdx -> do+ let internalRowIdx = succ rowIdx+ startInternalIdx = fromIntegral internalRowIdx * fromIntegral nInternalColumns :: Int+ startIdx = succ startInternalIdx+ row = slice startIdx (fromIntegral rowLength) matAsOneVector+ f rowIdx (\c -> mapInt $ row ! fromIntegral c)) rowIndexes++-- unfortunately I didn't find a Matrix implementation that supports arbitrary types+-- so I need to map my type on a CInt+mapMaterial :: Material -> CInt+mapMaterial Air = 0+mapMaterial Wall = 1++mapInt :: CInt -> Material+mapInt 0 = Air+mapInt 1 = Wall+mapInt _ = error "mapInt arg out of bounds"++-- | Creates a rectangular empty space of size specified in parameters.+mkEmptySpace :: Size -> Space+mkEmptySpace s =+ let air = mapMaterial Air+ in mkSpaceFromInnerMat s [[air]]++-- | Creates a rectangular deterministic space of size specified in parameters.+mkDeterministicallyFilledSpace :: Size -> Space+mkDeterministicallyFilledSpace s@(Size heightEmptySpace widthEmptySpace) =+ let wall = mapMaterial Wall+ air = mapMaterial Air++ w = fromIntegral widthEmptySpace+ h = fromIntegral heightEmptySpace+ middleRow = replicate w air+ collisionRow = replicate 2 air ++ replicate (w-4) wall ++ replicate 2 air+ ncolls = 8 :: Int+ nEmpty = h - ncolls+ n1 = quot nEmpty 2+ n2 = nEmpty - n1+ l = replicate n1 middleRow ++ replicate ncolls collisionRow ++ replicate n2 middleRow+ in mkSpaceFromInnerMat s l++-- | Creates a rectangular random space of size specified in parameters, with a+-- one-element border. 'IO' is used for random numbers generation.+mkRandomlyFilledSpace :: RandomParameters -> Size -> IO Space+mkRandomlyFilledSpace (RandomParameters blockSize strategy) s = do+ smallWorldMat <- mkSmallWorld s blockSize strategy++ let innerMat = replicateElements blockSize $ map (replicateElements blockSize) smallWorldMat+ return $ mkSpaceFromInnerMat s innerMat++-- TODO We could measure, on average, how many tries it takes to generate a graph+-- that meets the requirement for usual values of:+-- - probability of having air vs. a wall at any cell+-- - size of the small world+{- | Generates a random world with the constraint that it should have+a single "Air" connected component. The function recurses and builds a new random world+until the constraint is met.+It might take "a long time" especially if worldsize is big and multFactor is small.+An interesting problem would be to compute the complexity of this function.+To do so we need to know the probability to have a unique connected component in+the random graph defined in the function.+-}+mkSmallWorld :: Size+ -- ^ Size of the big world+ -> Int+ -- ^ Pixel width (if 1, the small world will have the same size as the big one)+ -> Strategy+ -> IO [[CInt]]+ -- ^ the "small world"+mkSmallWorld s@(Size heightEmptySpace widthEmptySpace) multFactor strategy = do+ let nCols = quot widthEmptySpace $ fromIntegral multFactor+ nRows = quot heightEmptySpace $ fromIntegral multFactor+ mkRandomRow _ = take (fromIntegral nCols) <$> rands -- TODO use a Matrix directly+ smallMat <- mapM mkRandomRow [0..nRows-1]++ let mat = fromLists smallMat+ graph = graphOfIndex (mapMaterial Air) mat+ case strategy of+ StrictlyOneComponent -> case components graph of+ [_] -> return smallMat -- TODO return Matrix (mat) instead of list of list+ _ -> mkSmallWorld s multFactor strategy++graphOfIndex :: CInt -> Matrix CInt -> Graph+graphOfIndex matchIdx mat =+ let sz@(nRows,nCols) = size mat+ coords = [Coords (Coord r) (Coord c) | c <-[0..nCols-1], r <- [0..nRows-1], mat `at` (r, c) == matchIdx]+ edges = map (\c -> (c, c, connectedNeighbours matchIdx c mat sz)) coords+ (graph, _, _) = graphFromEdges edges+ in graph++-- these functions adapt the API of matrix to the API of hmatrix+size :: Matrix a -> (Int, Int)+size mat = (nrows mat, ncols mat)++flatten :: Matrix a -> Vector a+flatten = getMatrixAsVector++at :: Matrix a -> (Int, Int) -> a+at mat (i, j) = getElem (succ i) (succ j) mat -- indexes start at 1 in Data.Matrix++connectedNeighbours :: CInt -> Coords Pos -> Matrix CInt -> (Int, Int) -> [Coords Pos]+connectedNeighbours matchIdx coords mat (nRows,nCols) =+ let neighbours = [translateInDir LEFT coords, translateInDir Down coords]+ in mapMaybe (\other@(Coords (Coord r) (Coord c)) ->+ if r < 0 || c < 0 || r >= nRows || c >= nCols || mat `at` (r, c) /= matchIdx+ then+ Nothing+ else+ Just other) neighbours++mkSpaceFromInnerMat :: Size -> [[CInt]] -> Space+mkSpaceFromInnerMat s innerMatMaybeSmaller =+ let innerMat = extend s innerMatMaybeSmaller+ mat = fromLists $ addBorder s innerMat+ in Space mat s $ matToRenderGroups mat s++extend :: Size -> [[a]] -> [[a]]+extend (Size rs cs) mat =+ extend' (fromIntegral rs) $ map (extend' $ fromIntegral cs) mat++extend' :: Int -> [a] -> [a]+extend' _ [] = error "extend empty list not supported"+extend' sz l@(_:_) =+ let len = length l+ addsTotal = sz - assert (len <= sz) len+ addsLeft = quot addsTotal 2+ addsRight = addsTotal - addsLeft+ in replicate addsLeft (head l) ++ l ++ replicate addsRight (last l)++rands :: IO [CInt]+rands = randomRsIO 0 1++addBorder :: Size -> [[CInt]] -> [[CInt]]+addBorder (Size _ widthEmptySpace) l =+ let nCols = fromIntegral widthEmptySpace + 2 * borderSize+ wall = mapMaterial Wall+ wallRow = replicate nCols wall+ encloseIn b e = b ++ e ++ b+ in encloseIn (replicate borderSize wallRow) $ map (encloseIn $ replicate borderSize wall) l++borderSize :: Int+borderSize = 1++matToRenderGroups :: Matrix CInt -> Size -> [RenderGroup]+matToRenderGroups mat s@(Size _ cs) =+ concat $+ forEachRowPure mat s $+ \row accessMaterial ->+ snd $ mapAccumL+ (\col listMaterials@(material:_) ->+ let count = length listMaterials+ materialColor = case material of+ Wall -> wallColors+ Air -> airColors+ materialChar = case material of+ Wall -> 'Z'+ Air -> ' '+ in (col + fromIntegral count,+ RenderGroup (Coords row col) materialColor materialChar count))+ (Coord 0) $ group $ map accessMaterial [0..fromIntegral $ pred cs]++getInnerMaterial :: Coords Pos -> Space -> Material+getInnerMaterial (Coords (Coord r) (Coord c)) (Space mat _ _) =+ mapInt $ mat `at` (r+borderSize, c+borderSize)+++-- | <https://hackage.haskell.org/package/matrix-0.3.5.0/docs/Data-Matrix.html#v:getElem Indices start at 1>:+-- @Coord 0 0@ corresponds to indexes 1 1 in matrix+getMaterial :: Coords Pos -> Space -> Material+getMaterial coords@(Coords r c) space@(Space _ (Size rs cs) _)+ | r < 0 || c < 0 = Wall+ | r > fromIntegral(rs-1) || c > fromIntegral(cs-1) = Wall+ | otherwise = getInnerMaterial coords space++materialToLocation :: Material -> Location+materialToLocation m = case m of+ Wall -> OutsideWorld+ Air -> InsideWorld++-- | Considers that outside 'Space', everything is 'OutsideWorld'+location :: Coords Pos -> Space -> Location+location c s = materialToLocation $ getMaterial c s++-- | Considers that outside 'Space', everything is 'InsideWorld'+strictLocation :: Coords Pos -> Space -> Location+strictLocation coords@(Coords r c) space@(Space _ (Size rs cs) _)+ | r < 0 || c < 0 || r > fromIntegral(rs-1) || c > fromIntegral(cs-1) = InsideWorld+ | otherwise = materialToLocation $ getInnerMaterial coords space+++{-# INLINABLE renderSpace #-}+renderSpace :: (Draw e, MonadReader e m, MonadIO m)+ => Space+ -> Coords Pos+ -- ^ World upper left coordinates w.r.t terminal frame.+ -> m (Coords Pos)+renderSpace (Space _ _ renderedWorld) upperLeft = do+ let worldCoords = move borderSize Down $ move borderSize RIGHT upperLeft+ mapM_ (renderGroup worldCoords) renderedWorld+ return worldCoords++{-# INLINABLE renderGroup #-}+renderGroup :: (Draw e, MonadReader e m, MonadIO m)+ => Coords Pos+ -> RenderGroup+ -> m ()+renderGroup worldCoords (RenderGroup pos colors char count) =+ drawChars count char (sumCoords pos worldCoords) colors++scopedLocation :: Space+ -> Maybe (Window Int)+ -- ^ The terminal size+ -> Coords Pos+ -- ^ The world upper left coordinates w.r.t terminal frame.+ -> Boundaries+ -- ^ The scope+ -> Coords Pos+ -- ^ The coordinates to test+ -> Location+scopedLocation space@(Space _ sz _) mayTermWindow wcc =+ -- Use a big terminal by default, it will just make animations be updated for longer+ -- than they should:+ let worldLocation = (`location` space)+ worldLocationExcludingBorders = (`strictLocation` space)+ (Window h w) = fromMaybe (Window {height = 150, width = 400}) mayTermWindow+ terminalLocation coordsInWorld =+ let (Coords (Coord r) (Coord c)) = sumCoords coordsInWorld wcc+ in if r >= 0 && r < h && c >= 0 && c < w+ then+ InsideWorld+ else+ OutsideWorld+ productLocations l l' = case l of+ InsideWorld -> l'+ OutsideWorld -> OutsideWorld+ in \case+ WorldFrame -> worldLocation+ TerminalWindow -> (\coo-> if containsWithOuterBorder coo sz+ then+ OutsideWorld+ else+ terminalLocation coo)+ Both -> (\coo-> productLocations (terminalLocation coo) (worldLocationExcludingBorders coo))
+ src/Imj/Game/Hamazed/World/Space/Types.hs view
@@ -0,0 +1,70 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}++module Imj.Game.Hamazed.World.Space.Types+ ( Space(..)+ , Material(..)+ , RandomParameters(..)+ , Strategy(..)+ , RenderGroup(..)+ , Boundaries(..)+ , module Imj.Geo.Discrete.Types+ ) where++import Imj.Prelude++import Data.Matrix( Matrix )++import Foreign.C.Types( CInt(..) )++import Imj.Geo.Discrete.Types+import Imj.Graphics.Color.Types++data Strategy = StrictlyOneComponent+ -- ^ There should be a single connected component of air.+ --+ -- This way, the ship can reach any allowed location without having to go+ -- through 'Wall's.++-- TODO support a world / air ratio (today it is 50 50)+-- | Parameters for random walls creation.+data RandomParameters = RandomParameters {+ _randomWallsBlockSize :: !Int -- TODO support 'Size' to have non-square blocks+ -- ^ The size of a square wall block.+ --+ -- Note that the smaller the block size, the harder it will be for the algorithm to find+ -- a random world with a single component of air.+ , _randomWallsStrategy :: !Strategy+ -- ^ Space characteristics (only /one connected component/ is available for the moment)+}++data RenderGroup = RenderGroup {+ _renderGroupCoords :: !(Coords Pos)+ , _renderGroupColors :: !LayeredColor+ , _renderGroupChar :: !Char+ , _renderGroupCount :: !Int+}++data Space = Space {+ _space :: !(Matrix CInt)+ -- ^ The material matrix.+ , _spaceSize :: !Size+ -- ^ The AABB of the space, excluding the outer border.+ , _spaceRender :: ![RenderGroup]+ -- ^ How to render the space.+}++data Material = Air+ -- ^ In it, ship and numbers can move.+ | Wall+ -- ^ Ship and numbers rebound on 'Wall's.+ deriving(Eq, Show)++data Boundaries = WorldFrame+ -- ^ Just the world.+ | TerminalWindow+ -- ^ The terminal, not the world.+ | Both+ -- ^ The terminal.+ deriving(Show)
+ src/Imj/Game/Hamazed/World/Types.hs view
@@ -0,0 +1,106 @@+{-# OPTIONS_HADDOCK hide #-}++{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE LambdaCase #-}++module Imj.Game.Hamazed.World.Types+ ( World(..)+ , WallDistribution(..)+ , WorldShape(..)+ , BattleShip(..)+ , Number(..)+ , Boundaries(..)+ , mkWorldContainer+ , InTerminal(..)+ , environmentInteraction+ -- * Reexports+ , module Imj.Iteration+ , module Imj.Graphics.Text.Animation+ , module Imj.Physics.Discrete.Types+ , Terminal.Window+ , RectContainer(..)+ ) where++import Imj.Prelude++import qualified System.Console.Terminal.Size as Terminal( Window(..))++import Imj.Game.Hamazed.World.Space.Types+import Imj.Game.Hamazed.World.Space+import Imj.Geo.Discrete+import Imj.Graphics.Animation.Design.Types+import Imj.Graphics.Text.Animation+import Imj.Graphics.UI.RectContainer+import Imj.Iteration+import Imj.Physics.Discrete.Types+import Imj.Physics.Discrete+import Imj.Timing+++data WorldShape = Square+ -- ^ Width = Height+ | Rectangle2x1+ -- ^ Width = 2 * Height++-- | How should walls be created?+data WallDistribution = None+ -- ^ No 'Wall's.+ | Deterministic+ -- ^ A Rectangular 'Wall' in the middle of the level.+ | Random !RandomParameters+ -- ^ 'Wall's are created with an algorithm involving random numbers.++-- | Helper function to create a 'RectContainer' containing a 'World'.+mkWorldContainer :: World -> RectContainer+mkWorldContainer (World _ _ (Space _ sz _) _ (InTerminal _ upperLeft)) =+ RectContainer sz upperLeft++data World = World {+ _worldNumbers :: ![Number]+ -- ^ The remaining 'Number's (shot 'Number's are removed from the list)+ , _worldShip :: !BattleShip+ -- ^ The player's 'BattleShip'+ , _worldSpace :: !Space+ -- ^ The 'Space' in which 'BattleShip' and 'Number's evolve+ , _worldAnimations :: ![Animation]+ -- ^ Visual animations. They don't have an influence on the game, they are just here+ -- for aesthetics.+ , _worldEmbedded :: !InTerminal+ -- ^ To know where we should draw the 'World' from, w.r.t terminal frame.+}++data InTerminal = InTerminal {+ _inTerminalSize :: !(Maybe (Terminal.Window Int))+ -- ^ The size of the terminal window+ , _inTerminalUpperLeft :: !(Coords Pos)+ -- ^ The 'World' 's 'RectContainer' upper left coordinates,+ -- w.r.t terminal frame.+} deriving (Show)++data BattleShip = BattleShip {+ _shipPosSpeed :: !PosSpeed+ -- ^ Discrete position and speed.+ , _shipAmmo :: !Int+ -- ^ How many laser shots are left.+ , _shipSafeUntil :: !(Maybe SystemTime)+ -- ^ At the beginning of each level, the ship is immune to collisions with 'Number's+ -- for a given time. This field holds the time at which the immunity ends.+ , _shipCollisions :: ![Number]+ -- ^ Which 'Number's are currently colliding with the 'BattleShip'.+} deriving(Show)+++data Number = Number {+ _numberPosSpeed :: !PosSpeed+ -- ^ Discrete position and speed.+ , _numberNum :: !Int+ -- ^ Which number it represents (1 to 16).+} deriving(Eq, Show)++-- | An interaction function taking into account a 'World' and 'Boundaries'+environmentInteraction :: World -> Boundaries -> Coords Pos -> InteractionResult+environmentInteraction (World _ _ space _ (InTerminal mayTermWindow upperLeft)) scope =+ let worldCorner = translate' 1 1 upperLeft+ in scopedLocation space mayTermWindow worldCorner scope >>> \case+ InsideWorld -> Stable+ OutsideWorld -> Mutation
+ test/Spec.hs view
@@ -0,0 +1,17 @@+import Control.Monad.Reader(runReaderT)++import Imj.Graphics.Render+import Imj.Graphics.Render.Delta(runThenRestoreConsoleSettings)++import Imj.Game.Hamazed.Env++import Test.Imj.Render++main :: IO ()+main = do+ putStrLn "" -- for readablilty++ runThenRestoreConsoleSettings $+ createEnv+ >>= runReaderT (testSpace >> -- this is it visible in the logs, not in the console+ renderToScreen)
+ test/Test/Imj/Render.hs view
@@ -0,0 +1,13 @@+module Test.Imj.Render(testSpace) where++import Control.Monad( void )+import Control.Monad.Reader(liftIO)++import Imj.Game.Hamazed.World.Space+import Imj.Geo.Discrete.Types++testSpace :: (MonadReader e m, Draw e, MonadIO m) => m ()+testSpace = do+ let blocksSize = 6+ s <- liftIO $ mkRandomlyFilledSpace (RandomParameters blocksSize StrictlyOneComponent) (Size 36 72)+ void (renderSpace s (Coords 0 0))