Restructuring, #9

lib/RPGEngine/Input/Core.hs

@@ -1,21 +1,26 @@
--- Allows to create a massive inputHandler that can handle anything
--- after you specify what you want it to do.
-
 module RPGEngine.Input.Core
-( InputHandler(..)
+( InputHandler
+, ListSelector(..)
+    
 , composeInputHandlers
 , handle
 , handleKey
 , handleAnyKey
 ) where
 
-import Graphics.Gloss.Interface.IO.Game
+import Graphics.Gloss.Interface.Pure.Game
+    ( Event(EventKey), Key(..), KeyState(Down), SpecialKey )
 
 ----------------------------- Constants ------------------------------
 
 type InputHandler a = Event -> (a -> a)
 
-----------------------------------------------------------------------
+data ListSelector = ListSelector {
+    selection :: Int,
+    selected  :: Bool
+}
+
+------------------------------ Exported ------------------------------
 
 -- Compose multiple InputHandlers into one InputHandler that handles
 -- all of them.
@@ -26,8 +31,8 @@ composeInputHandlers (ih:ihs) ev a = composeInputHandlers ihs ev (ih ev a)
 -- Handle any event
 handle :: Event -> (a -> a) -> InputHandler a
 handle (EventKey key _ _ _) = handleKey key
--- handle (EventMotion _)      = undefined
--- handle (EventResize _)      = undefined
+-- handle (EventMotion _)      = undefined -- TODO
+-- handle (EventResize _)      = undefined -- TODO
 handle _                    = const (const id)
 
 -- Handle a event by pressing a key
@@ -41,7 +46,7 @@ handleAnyKey :: (a -> a) -> InputHandler a
 handleAnyKey f (EventKey _ Down _ _) = f
 handleAnyKey _ _                     = id
 
-----------------------------------------------------------------------
+--------------------------- Help functions ---------------------------
 
 handleCharKey :: Char -> (a -> a) -> InputHandler a
 handleCharKey c1 f (EventKey (Char c2) Down _ _)
@@ -53,4 +58,4 @@ handleSpecialKey :: SpecialKey -> (a -> a) -> InputHandler a
 handleSpecialKey sk1 f (EventKey (SpecialKey sk2) Down _ _)
     | sk1 == sk2 = f
     | otherwise  = id
-handleSpecialKey _   _ _ = id
+handleSpecialKey _   _ _ = id

lib/RPGEngine/Input/Level.hs

@@ -1,27 +0,0 @@
-module RPGEngine.Input.Level
-( putCoords
-, findFirst
-, whatIsAt
-) where
-import RPGEngine.Data (Level (..), Y, X, Physical(..))
-
--- Map all Physicals onto coordinates
-putCoords :: Level -> [(X, Y, Physical)]
-putCoords l@Level{ layout = lay } = concatMap (\(a, bs) -> map (\(b, c) -> (b, a, c)) bs) numberedList
-    where numberedStrips = zip [0::Int .. ] lay
-          numberedList   = map (\(x, strip) -> (x, zip [0::Int ..] strip)) numberedStrips
-
--- Find first position of a Physical
--- Graceful exit by giving Nothing if there is nothing found.
-findFirst :: Level -> Physical -> Maybe (X, Y)
-findFirst l@Level{ coordlayout = lay } physical = try
-    where matches   = filter (\(x, y, v) -> v == physical) lay
-          try | not (null matches) = Just $ (\(x, y, _) -> (x, y)) $ head matches
-              | otherwise          = Nothing
-
--- What is located at a given position in the level?
-whatIsAt :: (X, Y) -> Level -> Physical
-whatIsAt pos lvl@Level{ coordlayout = lay } = try
-    where matches = map (\(_, _, v) -> v) $ filter (\(x, y, v) -> (x, y) == pos) lay
-          try | not (null matches) = head matches
-              | otherwise          = Void

lib/RPGEngine/Input/LevelSelection.hs

@@ -0,0 +1,49 @@
+module RPGEngine.Input.LevelSelection 
+( handleInputLevelSelection
+) where
+
+import RPGEngine.Input.Core
+    ( composeInputHandlers, handleKey, InputHandler, ListSelector (..) )
+
+import RPGEngine.Config ( levelFolder )
+import RPGEngine.Data ( Game (..), Direction (..), State (..), StateBase (..) )
+
+import Graphics.Gloss.Interface.IO.Game
+    ( Key(SpecialKey), SpecialKey(KeySpace) )
+import Graphics.Gloss.Interface.IO.Interact (SpecialKey(..))
+import RPGEngine.Render.Playing (renderPlaying)
+import RPGEngine.Input.Playing (handleInputPlaying)
+import RPGEngine.Parse (parse)
+
+------------------------------ Exported ------------------------------
+
+handleInputLevelSelection :: InputHandler Game
+handleInputLevelSelection = composeInputHandlers [
+    handleKey (SpecialKey KeySpace) selectLevel,
+
+    handleKey (SpecialKey KeyUp)   $ moveSelector North,
+    handleKey (SpecialKey KeyDown) $ moveSelector South
+    ]
+
+----------------------------------------------------------------------
+
+-- Select a level and load it in
+selectLevel :: Game -> Game
+selectLevel game@Game{ state = LevelSelection{ levelList = list, selector = selector }} = newGame
+    where newGame      = parse $ levelFolder ++ (list !! index)
+          index        = selection selector
+selectLevel g = g
+
+-- Move the selector either up or down
+moveSelector :: Direction -> Game -> Game
+moveSelector dir game@Game{ state = state@LevelSelection{ levelList = list, selector = selector } } = newGame
+    where newGame      = game{ state = newState }
+          newState     = state{ selector = newSelector }
+          newSelector  | constraint = selector{ selection = newSelection }
+                       | otherwise = selector
+          constraint   = 0 <= newSelection && newSelection < length list
+          newSelection = selection selector + diff
+          diff         | dir == North = -1
+                       | dir == South =  1
+                       | otherwise    =  0
+moveSelector _ g = g

lib/RPGEngine/Input/Lose.hs

@@ -0,0 +1,13 @@
+module RPGEngine.Input.Lose
+( handleInputLose
+) where
+
+import RPGEngine.Input.Core ( InputHandler )
+
+import RPGEngine.Data ( Game )
+
+------------------------------ Exported ------------------------------
+
+-- TODO
+handleInputLose :: InputHandler Game
+handleInputLose = undefined

lib/RPGEngine/Input/LvlSelect.hs

@@ -1,12 +0,0 @@
-module RPGEngine.Input.LvlSelect
-( getLvlList
-) where
-
-import GHC.IO (unsafePerformIO)
-import System.Directory (getDirectoryContents)
-
-lvlFolder :: FilePath
-lvlFolder = "levels"
-
-getLvlList :: [FilePath]
-getLvlList = unsafePerformIO $ getDirectoryContents lvlFolder

lib/RPGEngine/Input/Menu.hs

@@ -0,0 +1,36 @@
+module RPGEngine.Input.Menu
+( handleInputMenu
+) where
+
+import RPGEngine.Input.Core ( InputHandler, composeInputHandlers, handleAnyKey, ListSelector (..) )
+
+import RPGEngine.Data ( Game (..), State (..), StateBase (..) )
+import RPGEngine.Render.LevelSelection (renderLevelSelection)
+import RPGEngine.Input.LevelSelection (handleInputLevelSelection)
+import RPGEngine.Data.Level (getLevelList)
+
+------------------------------ Exported ------------------------------
+
+handleInputMenu :: InputHandler Game
+handleInputMenu = composeInputHandlers [
+    handleAnyKey selectLevel
+    ]
+
+----------------------------------------------------------------------
+
+selectLevel :: Game -> Game
+selectLevel g@Game{ state = state } = g{ state = defaultLevelSelection }
+
+defaultLevelSelection :: State
+defaultLevelSelection = LevelSelection { base = base, selector = defaultSelector, levelList = levels }
+    where base = StateBase {
+        renderer = renderLevelSelection,
+        inputHandler = handleInputLevelSelection
+        }
+          levels = getLevelList
+
+defaultSelector :: ListSelector
+defaultSelector = ListSelector { 
+    selection = 0, 
+    selected = False
+}

lib/RPGEngine/Input/Paused.hs

@@ -0,0 +1,12 @@
+module RPGEngine.Input.Paused 
+( handleInputPaused
+) where
+
+import RPGEngine.Input.Core ( InputHandler )
+
+import RPGEngine.Data ( Game )
+
+------------------------------ Exported ------------------------------
+
+handleInputPaused :: InputHandler Game
+handleInputPaused = undefined

lib/RPGEngine/Input/Player.hs

@@ -1,44 +0,0 @@
-module RPGEngine.Input.Player
-( spawnPlayer
-, movePlayer
-) where
-
-import RPGEngine.Data (Game(..), Direction(..), Player(..), X, Y, Physical (..), Level(..))
-import RPGEngine.Input.Level (whatIsAt, findFirst)
-import Data.Maybe (fromJust, isNothing)
-
------------------------------ Constants ------------------------------
-
-
-diffs :: Direction -> (X, Y)
-diffs North  = ( 0,  1)
-diffs East   = ( 1,  0)
-diffs South  = ( 0, -1)
-diffs West   = (-1,  0)
-diffs Center = ( 0,  0)
-
-----------------------------------------------------------------------
-
--- Set the initial position of the player in a given level.
-spawnPlayer :: Level -> Player -> Player
-spawnPlayer l@Level{ layout = lay } p@Player{ position = prevPos } = p{ position = newPos }
-    where try    = findFirst l Entrance
-          newPos | isNothing try = prevPos
-                 | otherwise     = fromJust try
-
--- Move a player in a direction if possible.
-movePlayer :: Direction -> Game -> Game
-movePlayer dir g@Game{ player = p@Player{ position = (x, y) }} = newGame
-    where newGame   = g{ player   = newPlayer }
-          newPlayer = p{ position = newCoord  }
-          newCoord  | isLegalMove dir g = (x + xD, y + yD)
-                    | otherwise         = (x, y)
-          (xD, yD)  = diffs dir
-
--- Check if a move is legal by checking what is located at the new position.
-isLegalMove :: Direction -> Game -> Bool
-isLegalMove dir g@Game{ playing = lvl, player = p@Player{ position = (x, y) }} = legality
-    where legality = physical `elem` [Walkable, Entrance, Exit]
-          physical = whatIsAt newPos lvl
-          newPos   = (x + xD, y + yD)
-          (xD, yD) = diffs dir

lib/RPGEngine/Input/Playing.hs

@@ -0,0 +1,80 @@
+module RPGEngine.Input.Playing 
+( handleInputPlaying
+, spawnPlayer
+) where
+
+import RPGEngine.Input.Core
+    ( composeInputHandlers, handleKey, InputHandler )
+
+import RPGEngine.Data
+    ( Player(Player, position),
+      Direction(West, North, East, South),
+      Physical(Entrance),
+      Y,
+      X,
+      Level(Level, layout),
+      State(..),
+      StateBase(StateBase, renderer, inputHandler),
+      Game(Game, state, player) )
+import RPGEngine.Data.Level ( findFirstOf, directionOffsets )
+import RPGEngine.Data.Game ( isLegalMove )
+import RPGEngine.Input.Paused ( handleInputPaused )
+import RPGEngine.Render.Paused ( renderPaused )
+import Graphics.Gloss.Interface.IO.Game (Key(..))
+import Graphics.Gloss.Interface.IO.Interact (SpecialKey(..))
+import Data.Maybe (isNothing, fromJust)
+
+------------------------------ Exported ------------------------------
+
+handleInputPlaying :: InputHandler Game
+handleInputPlaying = composeInputHandlers [
+    -- Pause the game
+    handleKey (Char 'p') pauseGame,
+
+    -- Player movement
+    handleKey (SpecialKey KeyUp)    $ movePlayer North,
+    handleKey (SpecialKey KeyRight) $ movePlayer East,
+    handleKey (SpecialKey KeyDown)  $ movePlayer South,
+    handleKey (SpecialKey KeyLeft)  $ movePlayer West,
+
+    handleKey (Char 'w') $ movePlayer North,
+    handleKey (Char 'd') $ movePlayer East,
+    handleKey (Char 's') $ movePlayer South,
+    handleKey (Char 'a') $ movePlayer West
+    ]
+
+-- Set the initial position of the player in a given level.
+spawnPlayer :: Level -> Player -> Player
+spawnPlayer l@Level{ layout = lay } p@Player{ position = prevPos } = p{ position = newPos }
+    where try    = findFirstOf l Entrance
+          newPos | isNothing try = prevPos
+                 | otherwise     = fromJust try
+
+----------------------------------------------------------------------
+
+pauseGame :: Game -> Game
+pauseGame g@Game{ state = Playing{ level = level } } = pausedGame
+    where pausedGame  = g{ state = pausedState }
+          pausedState = Paused{ base = newBase, level = level }
+          newBase     = StateBase { renderer = renderPaused, inputHandler = handleInputPaused }
+
+-- Move a player in a direction if possible.
+movePlayer :: Direction -> Game -> Game
+movePlayer dir g@Game{ player = p@Player{ position = (x, y) }} = newGame
+    where newGame   = g{ player   = newPlayer }
+          newPlayer = p{ position = newCoord  }
+          newCoord  | isLegalMove dir g = (x + xD, y + yD)
+                    | otherwise         = (x, y)
+          (xD, yD)  = directionOffsets dir
+
+-- TODO
+goToNextLevel :: Game -> Game
+goToNextLevel = undefined
+
+----------------------------------------------------------------------
+
+-- Map all Physicals onto coordinates
+putCoords :: Level -> [(X, Y, Physical)]
+putCoords l@Level{ layout = lay } = concatMap (\(a, bs) -> map (\(b, c) -> (b, a, c)) bs) numberedList
+    where numberedStrips = zip [0::Int .. ] lay
+          numberedList   = map (\(x, strip) -> (x, zip [0::Int ..] strip)) numberedStrips

lib/RPGEngine/Input/Win.hs

@@ -0,0 +1,13 @@
+module RPGEngine.Input.Win 
+( handleInputWin
+) where
+
+import RPGEngine.Input.Core ( InputHandler )
+
+import RPGEngine.Data ( Game )
+
+------------------------------ Exported ------------------------------
+
+-- TODO
+handleInputWin :: InputHandler Game
+handleInputWin = undefined