diff --git a/README.md b/README.md index cc195df..060cb52 100644 --- a/README.md +++ b/README.md @@ -258,6 +258,16 @@ If we look at the example, all the objects are TODO +`RPGEngine` is the main module. It contains the `playRPGEngine` function which bootstraps the whole game. It is also + the game loop. From here, `RPGEngine` talks to its submodules. + +These submodules are `Config`, `Data`, `Input`, `Parse` & `Render`. They are all responsible for their own part, either + containing the program configuration, data containers, everything needed to handle input, everything needed to parse a + source file & everything needed to render the game. However, each of these submodules has their own submodules to + divide the work. They are conveniently named after the state of the game that they work with, e.g. the main menu has a + module & when the game is playing is a different module. A special one is `Core`, which is kind of like a library for + every piece. It contains functions that are regularly used by the other modules. + #### Monads/Monad stack TODO diff --git a/lib/Input.hs b/lib/Input.hs new file mode 100644 index 0000000..9f63d99 --- /dev/null +++ b/lib/Input.hs @@ -0,0 +1,10 @@ +-- Go to the next stage of the Game +-- setNextState :: Game -> Game +-- setNextState game = game{ state = newState } +-- where newState = nextState $ state game + +-- -- Get the next state based on the current state +-- nextState :: State -> State +-- nextState Menu {} = defaultLvlSelect +-- nextState Pause {} = Playing +-- nextState _ = Menu diff --git a/lib/RPGEngine.hs b/lib/RPGEngine.hs index f9372e7..a2855cf 100644 --- a/lib/RPGEngine.hs +++ b/lib/RPGEngine.hs @@ -5,33 +5,18 @@ module RPGEngine ( playRPGEngine ) where -import RPGEngine.Data.Defaults -import RPGEngine.Render -import RPGEngine.Input +import RPGEngine.Config ( bgColor, winDimensions, winOffsets ) +import RPGEngine.Render ( initWindow, render, initGame ) +import RPGEngine.Input ( handleAllInput ) -import Graphics.Gloss ( - Color(..) - , white - , play - ) - ------------------------------ Constants ------------------------------ - --- Dimensions for main window -winDimensions :: (Int, Int) -winDimensions = (1280, 720) - --- Offsets for main window -winOffsets :: (Int, Int) -winOffsets = (0, 0) +import Graphics.Gloss ( play ) ---------------------------------------------------------------------- --- This is the gameloop. +-- This is the game loop. -- It can receive input and update itself. It is rendered by a renderer. playRPGEngine :: String -> Int -> IO() -playRPGEngine title fps = do - play window bgColor fps initGame render handleInputs step +playRPGEngine title fps = do + play window bgColor fps initGame render handleAllInput step where window = initWindow title winDimensions winOffsets - step _ g = g -- TODO Do something with step? Check health etc. - handleInputs = handleAllInput + step _ g = g -- TODO Do something with step? Check health etc. \ No newline at end of file diff --git a/lib/RPGEngine/Config.hs b/lib/RPGEngine/Config.hs new file mode 100644 index 0000000..a8d719c --- /dev/null +++ b/lib/RPGEngine/Config.hs @@ -0,0 +1,36 @@ +-- This module should ultimately be replaced by a config file parser +module RPGEngine.Config +-- All entries are exported +where + +import Graphics.Gloss + +----------------------- Window configuration ------------------------- + +-- Dimensions for main window +winDimensions :: (Int, Int) +winDimensions = (1280, 720) + +-- Offsets for main window +winOffsets :: (Int, Int) +winOffsets = (0, 0) + +-- Game background color +bgColor :: Color +bgColor = white + +-- Default scale +zoom :: Float +zoom = 5.0 + +-- Resolution of the texture +resolution :: Float +resolution = 16 + +-- Location of the assets folder containing all images +assetsFolder :: FilePath +assetsFolder = "assets/" + +-- Location of the level folder containing all levels +levelFolder :: FilePath +levelFolder = "levels/" \ No newline at end of file diff --git a/lib/RPGEngine/Data.hs b/lib/RPGEngine/Data.hs index 2ebe39b..23b25c8 100644 --- a/lib/RPGEngine/Data.hs +++ b/lib/RPGEngine/Data.hs @@ -1,28 +1,64 @@ -module RPGEngine.Data where +-- Contains all the data containers of the game. +-- Submodules contain accessors for these data containers. +module RPGEngine.Data +-- All data types are exported +where + +import RPGEngine.Input.Core +import RPGEngine.Render.Core ( Renderer ) -------------------------------- Game -------------------------------- --- TODO Add more +-- A game is the base data container. data Game = Game { - -- Current state of the game - state :: State, - playing :: Level, - levels :: [Level], - player :: Player + state :: State, + levels :: [Level], + player :: Player } +------------------------------- State -------------------------------- + +-- Code reusability +data StateBase = StateBase { + renderer :: Renderer Game, + inputHandler :: InputHandler Game +} + + -- Main menu +data State = Menu { base :: StateBase } + -- Select the level you want to play + | LevelSelection { base :: StateBase, + levelList :: [FilePath], + selector :: ListSelector } + -- Playing a level + | Playing { base :: StateBase, + level :: Level } + -- Paused while playing a level + | Paused { base :: StateBase, + level :: Level } + -- Won a level + | Win { base :: StateBase } + -- Lost a level + | Lose { base :: StateBase } + ------------------------------- Level -------------------------------- data Level = Level { - layout :: Layout, - coordlayout :: [(X, Y, Physical)], - items :: [Item], - entities :: [Entity] + layout :: Layout, + -- All Physical pieces but with their coordinates + index :: [(X, Y, Physical)], + items :: [Item], + entities :: [Entity] } deriving (Eq, Show) -type Layout = [Strip] -type Strip = [Physical] +type X = Int +type Y = Int +type Layout = [Strip] +type Strip = [Physical] + +-- A Physical part of the world. A single tile of the world. A block +-- with stuff on it. data Physical = Void | Walkable | Blocked @@ -30,48 +66,12 @@ data Physical = Void | Exit deriving (Eq, Show) -------------------------------- Player ------------------------------- - -type X = Int -type Y = Int - -data Player = Player { - playerHp :: Maybe Int, - inventory :: [Item], - position :: (X, Y) -} deriving (Eq, Show) - -instance Living Player where - hp = playerHp - -------------------------------- State -------------------------------- - --- Current state of the game. -data State = Menu - | LvlSelect - | Playing - | Pause - | Win - | Lose - -------------------------------- Object ------------------------------- - -class Object a where - id :: a -> String - x :: a -> Int - y :: a -> Int - name :: a -> String - description :: a -> String - actions :: a -> [([Condition], Action)] - value :: a -> Maybe Int - -class Living a where - hp :: a -> Maybe Int +-------------------------------- Item -------------------------------- data Item = Item { itemId :: ItemId, - itemX :: Int, - itemY :: Int, + itemX :: X, + itemY :: Y, itemName :: String, itemDescription :: String, itemActions :: [([Condition], Action)], @@ -79,41 +79,37 @@ data Item = Item { useTimes :: Maybe Int } deriving (Eq, Show) -instance Object Item where - id = itemId - x = itemX - y = itemY - name = itemName - description = itemDescription - actions = itemActions - value = itemValue +type ItemId = String + +------------------------------- Entity ------------------------------- data Entity = Entity { entityId :: EntityId, - entityX :: Int, - entityY :: Int, + entityX :: X, + entityY :: Y, entityName :: String, entityDescription :: String, entityActions :: [([Condition], Action)], entityValue :: Maybe Int, - entityHp :: Maybe Int, + entityHp :: HP, direction :: Direction } deriving (Eq, Show) -instance Object Entity where - id = entityId - x = entityX - y = entityY - name = entityName - description = entityDescription - actions = entityActions - value = entityValue - -instance Living Entity where - hp = entityHp - type EntityId = String -type ItemId = String +type HP = Maybe Int + +data Direction = North + | East + | South + | West + | Stay -- No direction + deriving (Eq, Show) + +data Player = Player { + playerHp :: HP, + inventory :: [Item], + position :: (X, Y) +} deriving (Eq, Show) ------------------------------ Condition ----------------------------- @@ -121,7 +117,7 @@ data Condition = InventoryFull | InventoryContains ItemId | Not Condition | AlwaysFalse - deriving (Show, Eq) + deriving (Eq, Show) ------------------------------- Action ------------------------------- @@ -130,14 +126,5 @@ data Action = Leave | UseItem ItemId | DecreaseHp EntityId ItemId | IncreasePlayerHp ItemId - | Nothing - deriving (Show, Eq) - ------------------------------- Direction ----------------------------- - -data Direction = North - | East - | South - | West - | Center -- Equal to 'stay where you are' - deriving (Show, Eq) \ No newline at end of file + | DoNothing + deriving (Eq, Show) \ No newline at end of file diff --git a/lib/RPGEngine/Data/Default.hs b/lib/RPGEngine/Data/Default.hs new file mode 100644 index 0000000..7129a12 --- /dev/null +++ b/lib/RPGEngine/Data/Default.hs @@ -0,0 +1,67 @@ +module RPGEngine.Data.Default +-- Everything is exported +where +import RPGEngine.Data (Entity (..), Game (..), Item (..), Layout, Player (..), Level (..), StateBase (..), State (..), Physical (..), Direction (..)) +import RPGEngine.Input.Core (ListSelector(..)) +import RPGEngine.Render.LevelSelection (renderLevelSelection) +import RPGEngine.Input.Playing (spawnPlayer) +import RPGEngine.Render.Menu (renderMenu) + +------------------------------ Defaults ------------------------------ + +defaultEntity :: Entity +defaultEntity = Entity { + entityId = "", + entityX = 0, + entityY = 0, + entityName = "Default", + entityDescription = "", + entityActions = [], + entityValue = Prelude.Nothing, + entityHp = Prelude.Nothing, + direction = Stay +} + +defaultItem :: Item +defaultItem = Item { + itemId = "", + itemX = 0, + itemY = 0, + itemName = "Default", + itemDescription = "", + itemActions = [], + itemValue = Prelude.Nothing, + useTimes = Prelude.Nothing +} + +defaultLayout :: Layout +defaultLayout = [ + [Blocked, Blocked, Blocked], + [Blocked, Entrance, Blocked], + [Blocked, Blocked, Blocked] + ] + +defaultLevel :: Level +defaultLevel = Level { + layout = defaultLayout, + index = [ + (0, 0, Blocked), + (0, 1, Blocked), + (0, 2, Blocked), + (1, 0, Blocked), + (1, 1, Entrance), + (1, 2, Blocked), + (2, 0, Blocked), + (2, 1, Blocked), + (2, 2, Blocked) + ], + items = [], + entities = [] +} + +defaultPlayer :: Player +defaultPlayer = Player { + playerHp = Prelude.Nothing, -- Compares to infinity + inventory = [], + position = (0, 0) +} \ No newline at end of file diff --git a/lib/RPGEngine/Data/Defaults.hs b/lib/RPGEngine/Data/Defaults.hs deleted file mode 100644 index e3414eb..0000000 --- a/lib/RPGEngine/Data/Defaults.hs +++ /dev/null @@ -1,65 +0,0 @@ -module RPGEngine.Data.Defaults where - -import RPGEngine.Data -import RPGEngine.Input.Player (spawnPlayer) -import RPGEngine.Input.Level (putCoords) - -defaultEntity :: Entity -defaultEntity = Entity { - entityId = "", - entityX = 0, - entityY = 0, - entityName = "Default", - entityDescription = "", - entityActions = [], - entityValue = Prelude.Nothing, - entityHp = Prelude.Nothing, - direction = Center -} - --- Initialize the game -initGame :: Game -initGame = Game { - state = defaultState, - playing = defaultLevel, - levels = [defaultLevel], - player = spawnPlayer defaultLevel defaultPlayer -} - -defaultItem :: Item -defaultItem = Item { - itemId = "", - itemX = 0, - itemY = 0, - itemName = "Default", - itemDescription = "", - itemActions = [], - itemValue = Prelude.Nothing, - useTimes = Prelude.Nothing -} - -defaultLayout :: Layout -defaultLayout = [ - [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked], - [Blocked, Entrance, Walkable, Walkable, Walkable, Walkable, Exit, Blocked], - [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked] - ] - -defaultLevel :: Level -defaultLevel = Level { - layout = defaultLayout, - coordlayout = putCoords defaultLevel, -- TODO This should go - items = [], - entities = [] -} - -defaultPlayer :: Player -defaultPlayer = Player { - playerHp = Prelude.Nothing, -- Compares to infinity - inventory = [], - position = (0, 0) -} - --- Default state of the game, Menu -defaultState :: State -defaultState = Menu \ No newline at end of file diff --git a/lib/RPGEngine/Data/Game.hs b/lib/RPGEngine/Data/Game.hs new file mode 100644 index 0000000..2b21cd5 --- /dev/null +++ b/lib/RPGEngine/Data/Game.hs @@ -0,0 +1,22 @@ +module RPGEngine.Data.Game +( isLegalMove +) where + +import RPGEngine.Data + ( Player(Player, position), + Direction, + Physical(Exit, Walkable, Entrance), + State(Playing, level), + Game(Game, state, player) ) +import RPGEngine.Data.Level (findAt, directionOffsets) + +------------------------------ Exported ------------------------------ + +-- Check if a move is legal by checking what is located at the new position. +isLegalMove :: Direction -> Game -> Bool +isLegalMove dir g@Game{ state = Playing { level = lvl }, player = p@Player{ position = (x, y) }} = legality + where legality = physical `elem` [Walkable, Entrance, Exit] + physical = findAt newPos lvl + newPos = (x + xD, y + yD) + (xD, yD) = directionOffsets dir +isLegalMove _ _ = False \ No newline at end of file diff --git a/lib/RPGEngine/Data/Level.hs b/lib/RPGEngine/Data/Level.hs new file mode 100644 index 0000000..86ef84d --- /dev/null +++ b/lib/RPGEngine/Data/Level.hs @@ -0,0 +1,36 @@ +module RPGEngine.Data.Level +-- Everything is exported +where + +import GHC.IO (unsafePerformIO) +import System.Directory (getDirectoryContents) +import RPGEngine.Input.Core (ListSelector(..)) +import RPGEngine.Data (Level (..), Physical (..), Direction (..), Entity (..), Game (..), Item (..), Player (..), StateBase (..), State (..), X, Y, Layout) +import RPGEngine.Config (levelFolder) + +------------------------------ Exported ------------------------------ + +-- Find first position of a Physical +-- Graceful exit by giving Nothing if there is nothing found. +findFirstOf :: Level -> Physical -> Maybe (X, Y) +findFirstOf l@Level{ index = index } physical = try + where matches = filter (\(x, y, v) -> v == physical) index + try | not (null matches) = Just $ (\(x, y, _) -> (x, y)) $ head matches + | otherwise = Nothing + +-- What is located at a given position in the level? +findAt :: (X, Y) -> Level -> Physical +findAt pos lvl@Level{ index = index } = try + where matches = map (\(_, _, v) -> v) $ filter (\(x, y, v) -> (x, y) == pos) index + try | not (null matches) = head matches + | otherwise = Void + +directionOffsets :: Direction -> (X, Y) +directionOffsets North = ( 0, 1) +directionOffsets East = ( 1, 0) +directionOffsets South = ( 0, -1) +directionOffsets West = (-1, 0) +directionOffsets Stay = ( 0, 0) + +getLevelList :: [FilePath] +getLevelList = drop 2 $ unsafePerformIO $ getDirectoryContents levelFolder \ No newline at end of file diff --git a/lib/RPGEngine/Data/State.hs b/lib/RPGEngine/Data/State.hs deleted file mode 100644 index 0cc5347..0000000 --- a/lib/RPGEngine/Data/State.hs +++ /dev/null @@ -1,22 +0,0 @@ --- Describes the current state of the game, --- e.g. Main menu, game, pause, win or lose --- Allows to easily go to a next state and change rendering accordingly - -module RPGEngine.Data.State -( State(..) - -, nextState -) where - -import RPGEngine.Data - ----------------------------------------------------------------------- - --- Get the next state based on the current state -nextState :: State -> State -nextState Menu = LvlSelect -nextState Playing = Pause -nextState Pause = Playing -nextState _ = Menu - ----------------------------------------------------------------------- diff --git a/lib/RPGEngine/Input.hs b/lib/RPGEngine/Input.hs index 2fae6bb..485affb 100644 --- a/lib/RPGEngine/Input.hs +++ b/lib/RPGEngine/Input.hs @@ -1,50 +1,15 @@ --- Input for RPG-Engine - +-- Implementations for each state can be found in their respective +-- submodules. module RPGEngine.Input ( handleAllInput ) where -import RPGEngine.Data -import RPGEngine.Data.State import RPGEngine.Input.Core -import RPGEngine.Input.Player +import RPGEngine.Data -import Graphics.Gloss.Interface.IO.Game +------------------------------ Exported ------------------------------ ----------------------------------------------------------------------- - --- Handle all input for RPG-Engine +-- Handle all input of all states of the game. handleAllInput :: InputHandler Game -handleAllInput ev g@Game{ state = Playing } = handlePlayInputs ev g -handleAllInput ev g@Game{ state = LvlSelect } = handleLvlSelectInput ev g -handleAllInput ev g = handleAnyKey setNextState ev g - ----------------------------------------------------------------------- - --- Input for 'Playing' state -handlePlayInputs :: InputHandler Game -handlePlayInputs = composeInputHandlers [ - -- Pause the game - handleKey (Char 'p') (\game -> game{ state = Pause }), - - -- 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 - ] - --- Input for selection a level to load -handleLvlSelectInput :: InputHandler Game -handleLvlSelectInput = composeInputHandlers [] - --- Go to the next stage of the Game -setNextState :: Game -> Game -setNextState game = game{ state = newState } - where newState = nextState $ state game - +handleAllInput ev g@Game{ state = state } = handleInput ev g + where handleInput = inputHandler $ base state \ No newline at end of file diff --git a/lib/RPGEngine/Input/Core.hs b/lib/RPGEngine/Input/Core.hs index e2e81b9..9044c1d 100644 --- a/lib/RPGEngine/Input/Core.hs +++ b/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 \ No newline at end of file diff --git a/lib/RPGEngine/Input/Level.hs b/lib/RPGEngine/Input/Level.hs deleted file mode 100644 index 63391c9..0000000 --- a/lib/RPGEngine/Input/Level.hs +++ /dev/null @@ -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 diff --git a/lib/RPGEngine/Input/LevelSelection.hs b/lib/RPGEngine/Input/LevelSelection.hs new file mode 100644 index 0000000..d2f3578 --- /dev/null +++ b/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 diff --git a/lib/RPGEngine/Input/Lose.hs b/lib/RPGEngine/Input/Lose.hs new file mode 100644 index 0000000..f9c6d0e --- /dev/null +++ b/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 \ No newline at end of file diff --git a/lib/RPGEngine/Input/LvlSelect.hs b/lib/RPGEngine/Input/LvlSelect.hs deleted file mode 100644 index 5b1bf35..0000000 --- a/lib/RPGEngine/Input/LvlSelect.hs +++ /dev/null @@ -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 \ No newline at end of file diff --git a/lib/RPGEngine/Input/Menu.hs b/lib/RPGEngine/Input/Menu.hs new file mode 100644 index 0000000..6903d0d --- /dev/null +++ b/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 +} \ No newline at end of file diff --git a/lib/RPGEngine/Input/Paused.hs b/lib/RPGEngine/Input/Paused.hs new file mode 100644 index 0000000..03522dd --- /dev/null +++ b/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 diff --git a/lib/RPGEngine/Input/Player.hs b/lib/RPGEngine/Input/Player.hs deleted file mode 100644 index be56f27..0000000 --- a/lib/RPGEngine/Input/Player.hs +++ /dev/null @@ -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 \ No newline at end of file diff --git a/lib/RPGEngine/Input/Playing.hs b/lib/RPGEngine/Input/Playing.hs new file mode 100644 index 0000000..b2638e0 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/lib/RPGEngine/Input/Win.hs b/lib/RPGEngine/Input/Win.hs new file mode 100644 index 0000000..37434ee --- /dev/null +++ b/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 \ No newline at end of file diff --git a/lib/RPGEngine/Parse.hs b/lib/RPGEngine/Parse.hs index a8736ad..9b1c976 100644 --- a/lib/RPGEngine/Parse.hs +++ b/lib/RPGEngine/Parse.hs @@ -1,19 +1,16 @@ -module RPGEngine.Parse where +module RPGEngine.Parse +( parse +) where -import RPGEngine.Data -import RPGEngine.Parse.StructElement -import RPGEngine.Parse.Game +import RPGEngine.Data ( Game ) +import RPGEngine.Parse.StructureToGame ( structureToGame ) +import GHC.IO (unsafePerformIO) +import Text.Parsec.String (parseFromFile) +import RPGEngine.Parse.TextToStructure (structure) -import Text.Parsec.String -import System.IO.Unsafe +------------------------------ Exported ------------------------------ ------------------------------ Constants ------------------------------ - -type FileName = String - ----------------------------------------------------------------------- - -parseToGame :: FileName -> Game -parseToGame filename = structToGame struct +parse :: FilePath -> Game +parse filename = structureToGame struct where (Right struct) = unsafePerformIO io - io = parseFromFile structElement filename \ No newline at end of file + io = parseFromFile structure filename \ No newline at end of file diff --git a/lib/RPGEngine/Parse/Core.hs b/lib/RPGEngine/Parse/Core.hs index 7e704ab..ff1be67 100644 --- a/lib/RPGEngine/Parse/Core.hs +++ b/lib/RPGEngine/Parse/Core.hs @@ -1,7 +1,23 @@ -module RPGEngine.Parse.Core where +module RPGEngine.Parse.Core +( parseWith +, parseWithRest +, ignoreWS +) where import Text.Parsec -import Text.Parsec.String + ( ParseError, + anyChar, + endOfLine, + spaces, + string, + anyToken, + choice, + eof, + manyTill, + parse ) +import Text.Parsec.String ( Parser ) + +------------------------------ Exported ------------------------------ -- A wrapper, which takes a parser and some input and returns a -- parsed output. @@ -14,7 +30,7 @@ parseWithRest :: Parser a -> String -> Either ParseError (a, String) parseWithRest parser = parse ((,) <$> parser <*> rest) "" where rest = manyTill anyToken eof --- Ignore all kinds of whitespaces +-- Ignore all kinds of whitespace ignoreWS :: Parser a -> Parser a ignoreWS parser = choice [skipComment, spaces] >> parser where skipComment = do{ string "#"; manyTill anyChar endOfLine; return ()} \ No newline at end of file diff --git a/lib/RPGEngine/Parse/Game.hs b/lib/RPGEngine/Parse/Game.hs deleted file mode 100644 index 9999ffd..0000000 --- a/lib/RPGEngine/Parse/Game.hs +++ /dev/null @@ -1,101 +0,0 @@ -module RPGEngine.Parse.Game where - -import RPGEngine.Data -import RPGEngine.Data.Defaults -import RPGEngine.Parse.StructElement - --------------------------------- Game -------------------------------- - --- TODO -structToGame :: StructElement -> Game -structToGame = undefined - -------------------------------- Player ------------------------------- - -structToPlayer :: StructElement -> Player -structToPlayer (Block block) = structToPlayer' block defaultPlayer -structToPlayer _ = defaultPlayer - -structToPlayer' :: [StructElement] -> Player -> Player -structToPlayer' [] p = p -structToPlayer' ((Entry(Tag "hp") val ):es) p = (structToPlayer' es p){ playerHp = structToMaybeInt val } -structToPlayer' ((Entry(Tag "inventory") (Block inv)):es) p = (structToPlayer' es p){ inventory = structToItems inv } -structToPlayer' _ _ = defaultPlayer - -structToActions :: StructElement -> [([Condition], Action)] -structToActions (Block []) = [] -structToActions (Block block) = structToActions' block [] -structToActions _ = [] - -structToActions' :: [StructElement] -> [([Condition], Action)] -> [([Condition], Action)] -structToActions' [] list = list -structToActions' ((Entry(ConditionList cs) (Regular (Action a))):as) list = structToActions' as ((cs, a):list) -structToActions' _ list = list - -------------------------------- Levels ------------------------------- - -structToLevels :: StructElement -> [Level] -structToLevels (Block struct) = structToLevel <$> struct -structToLevels _ = [defaultLevel] - -structToLevel :: StructElement -> Level -structToLevel (Block entries) = structToLevel' entries defaultLevel -structToLevel _ = defaultLevel - -structToLevel' :: [StructElement] -> Level -> Level -structToLevel' ((Entry(Tag "layout") (Regular (Layout layout))):ls) l = (structToLevel' ls l){ RPGEngine.Data.layout = layout } -structToLevel' ((Entry(Tag "items") (Block items) ):ls) l = (structToLevel' ls l){ items = structToItems items } -structToLevel' ((Entry(Tag "entities") (Block entities) ):ls) l = (structToLevel' ls l){ entities = structToEntities entities } -structToLevel' _ _ = defaultLevel - -------------------------------- Items -------------------------------- - -structToItems :: [StructElement] -> [Item] -structToItems items = structToItem <$> items - -structToItem :: StructElement -> Item -structToItem (Block block) = structToItem' block defaultItem -structToItem _ = defaultItem - -structToItem' :: [StructElement] -> Item -> Item -structToItem' [] i = i -structToItem' ((Entry(Tag "id") (Regular(String id ))):is) i = (structToItem' is i){ itemId = id } -structToItem' ((Entry(Tag "x") (Regular(Integer x ))):is) i = (structToItem' is i){ itemX = x } -structToItem' ((Entry(Tag "y") (Regular(Integer y ))):is) i = (structToItem' is i){ itemY = y } -structToItem' ((Entry(Tag "name") (Regular(String name))):is) i = (structToItem' is i){ itemName = name } -structToItem' ((Entry(Tag "description") (Regular(String desc))):is) i = (structToItem' is i){ itemDescription = desc } -structToItem' ((Entry(Tag "value") val ):is) i = (structToItem' is i){ itemValue = structToMaybeInt val } -structToItem' ((Entry(Tag "actions") actions ):is) i = (structToItem' is i){ itemActions = structToActions actions } -structToItem' ((Entry (Tag "useTimes") useTimes ):is) i = (structToItem' is i){ useTimes = structToMaybeInt useTimes } -structToItem' _ _ = defaultItem - ------------------------------- Entities ------------------------------ - -structToEntities :: [StructElement] -> [Entity] -structToEntities entities = structToEntity <$> entities - -structToEntity :: StructElement -> Entity -structToEntity (Block block) = structToEntity' block defaultEntity -structToEntity _ = defaultEntity - -structToEntity' :: [StructElement] -> Entity -> Entity -structToEntity' [] e = e -structToEntity' ((Entry(Tag "id") (Regular(String id )) ):es) e = (structToEntity' es e){ entityId = id } -structToEntity' ((Entry(Tag "x") (Regular(Integer x )) ):es) e = (structToEntity' es e){ entityX = x } -structToEntity' ((Entry(Tag "y") (Regular(Integer y )) ):es) e = (structToEntity' es e){ entityY = y } -structToEntity' ((Entry(Tag "name") (Regular(String name)) ):es) e = (structToEntity' es e){ entityName = name } -structToEntity' ((Entry(Tag "description") (Regular(String desc)) ):es) e = (structToEntity' es e){ entityDescription = desc } -structToEntity' ((Entry(Tag "actions") actions ):es) e = (structToEntity' es e){ entityActions = structToActions actions } -structToEntity' ((Entry(Tag "value") val ):es) e = (structToEntity' es e){ entityValue = structToMaybeInt val } -structToEntity' ((Entry(Tag "hp") val ):es) e = (structToEntity' es e){ entityHp = structToMaybeInt val } -structToEntity' ((Entry(Tag "direction") (Regular(Direction dir))):es) e = (structToEntity' es e){ RPGEngine.Data.direction = dir } -structToEntity' _ _ = defaultEntity - ----------------------------------------------------------------------- - -structToMaybeInt :: StructElement -> Maybe Int -structToMaybeInt (Regular (Integer val)) = Just val -structToMaybeInt (Regular Infinite) = Prelude.Nothing -structToMaybeInt _ = Prelude.Nothing -- TODO - ----------------------------------------------------------------------- \ No newline at end of file diff --git a/lib/RPGEngine/Parse/StructureToGame.hs b/lib/RPGEngine/Parse/StructureToGame.hs new file mode 100644 index 0000000..ddbcd3d --- /dev/null +++ b/lib/RPGEngine/Parse/StructureToGame.hs @@ -0,0 +1,120 @@ +module RPGEngine.Parse.StructureToGame +-- Everything is exported for testing +where + +import RPGEngine.Data + ( Action, + Condition, + Player(playerHp, inventory), + Entity(entityId, entityX, entityY, entityName, entityDescription, + entityActions, entityValue, entityHp, direction), + Item(itemId, itemX, itemY, itemName, itemDescription, itemValue, + itemActions, useTimes), + Level(layout, items, entities), + Game (..), State (..), StateBase (..) ) +import RPGEngine.Parse.TextToStructure + ( Value(Infinite, Action, Layout, String, Direction, Integer), + Key(Tag, ConditionList), + Structure(..) ) +import RPGEngine.Data.Default (defaultPlayer, defaultLevel, defaultItem, defaultEntity) +import RPGEngine.Render.Playing (renderPlaying) +import RPGEngine.Input.Playing (handleInputPlaying) + +------------------------------ Exported ------------------------------ + +structureToGame :: Structure -> Game +structureToGame (Block [(Entry(Tag "player") playerBlock), (Entry(Tag "levels") levelsBlock)]) = game + where game = Game{ state = newState, levels = newLevels, player = newPlayer } + newState = Playing{ base = playingBase, level = currentLevel } + playingBase = StateBase{ renderer = renderPlaying, inputHandler = handleInputPlaying } + newLevels = structureToLevels levelsBlock + currentLevel = head newLevels + newPlayer = structureToPlayer playerBlock + +------------------------------- Player ------------------------------- + +structureToPlayer :: Structure -> Player +structureToPlayer (Block block) = structureToPlayer' block defaultPlayer +structureToPlayer _ = defaultPlayer + +structureToPlayer' :: [Structure] -> Player -> Player +structureToPlayer' [] p = p +structureToPlayer' ((Entry(Tag "hp") val ):es) p = (structureToPlayer' es p){ playerHp = structureToMaybeInt val } +structureToPlayer' ((Entry(Tag "inventory") (Block inv)):es) p = (structureToPlayer' es p){ inventory = structureToItems inv } +structureToPlayer' _ _ = defaultPlayer + +structureToActions :: Structure -> [([Condition], Action)] +structureToActions (Block []) = [] +structureToActions (Block block) = structureToActions' block [] +structureToActions _ = [] + +structureToActions' :: [Structure] -> [([Condition], Action)] -> [([Condition], Action)] +structureToActions' [] list = list +structureToActions' ((Entry(ConditionList cs) (Regular (Action a))):as) list = structureToActions' as ((cs, a):list) +structureToActions' _ list = list + +------------------------------- Levels ------------------------------- + +structureToLevels :: Structure -> [Level] +structureToLevels (Block struct) = structureToLevel <$> struct +structureToLevels _ = [defaultLevel] + +structureToLevel :: Structure -> Level +structureToLevel (Block entries) = structureToLevel' entries defaultLevel +structureToLevel _ = defaultLevel + +structureToLevel' :: [Structure] -> Level -> Level +structureToLevel' ((Entry(Tag "layout") (Regular (Layout layout))):ls) l = (structureToLevel' ls l){ RPGEngine.Data.layout = layout } +structureToLevel' ((Entry(Tag "items") (Block items) ):ls) l = (structureToLevel' ls l){ items = structureToItems items } +structureToLevel' ((Entry(Tag "entities") (Block entities) ):ls) l = (structureToLevel' ls l){ entities = structureToEntities entities } +structureToLevel' _ _ = defaultLevel + +------------------------------- Items -------------------------------- + +structureToItems :: [Structure] -> [Item] +structureToItems items = structureToItem <$> items + +structureToItem :: Structure -> Item +structureToItem (Block block) = structureToItem' block defaultItem +structureToItem _ = defaultItem + +structureToItem' :: [Structure] -> Item -> Item +structureToItem' [] i = i +structureToItem' ((Entry(Tag "id") (Regular(String id ))):is) i = (structureToItem' is i){ itemId = id } +structureToItem' ((Entry(Tag "x") (Regular(Integer x ))):is) i = (structureToItem' is i){ itemX = x } +structureToItem' ((Entry(Tag "y") (Regular(Integer y ))):is) i = (structureToItem' is i){ itemY = y } +structureToItem' ((Entry(Tag "name") (Regular(String name))):is) i = (structureToItem' is i){ itemName = name } +structureToItem' ((Entry(Tag "description") (Regular(String desc))):is) i = (structureToItem' is i){ itemDescription = desc } +structureToItem' ((Entry(Tag "value") val ):is) i = (structureToItem' is i){ itemValue = structureToMaybeInt val } +structureToItem' ((Entry(Tag "actions") actions ):is) i = (structureToItem' is i){ itemActions = structureToActions actions } +structureToItem' ((Entry (Tag "useTimes") useTimes ):is) i = (structureToItem' is i){ useTimes = structureToMaybeInt useTimes } +structureToItem' _ _ = defaultItem + +------------------------------ Entities ------------------------------ + +structureToEntities :: [Structure] -> [Entity] +structureToEntities entities = structureToEntity <$> entities + +structureToEntity :: Structure -> Entity +structureToEntity (Block block) = structureToEntity' block defaultEntity +structureToEntity _ = defaultEntity + +structureToEntity' :: [Structure] -> Entity -> Entity +structureToEntity' [] e = e +structureToEntity' ((Entry(Tag "id") (Regular(String id )) ):es) e = (structureToEntity' es e){ entityId = id } +structureToEntity' ((Entry(Tag "x") (Regular(Integer x )) ):es) e = (structureToEntity' es e){ entityX = x } +structureToEntity' ((Entry(Tag "y") (Regular(Integer y )) ):es) e = (structureToEntity' es e){ entityY = y } +structureToEntity' ((Entry(Tag "name") (Regular(String name)) ):es) e = (structureToEntity' es e){ entityName = name } +structureToEntity' ((Entry(Tag "description") (Regular(String desc)) ):es) e = (structureToEntity' es e){ entityDescription = desc } +structureToEntity' ((Entry(Tag "actions") actions ):es) e = (structureToEntity' es e){ entityActions = structureToActions actions } +structureToEntity' ((Entry(Tag "value") val ):es) e = (structureToEntity' es e){ entityValue = structureToMaybeInt val } +structureToEntity' ((Entry(Tag "hp") val ):es) e = (structureToEntity' es e){ entityHp = structureToMaybeInt val } +structureToEntity' ((Entry(Tag "direction") (Regular(Direction dir))):es) e = (structureToEntity' es e){ RPGEngine.Data.direction = dir } +structureToEntity' _ _ = defaultEntity + +---------------------------------------------------------------------- + +structureToMaybeInt :: Structure -> Maybe Int +structureToMaybeInt (Regular (Integer val)) = Just val +structureToMaybeInt (Regular Infinite) = Prelude.Nothing +structureToMaybeInt _ = Prelude.Nothing -- TODO \ No newline at end of file diff --git a/lib/RPGEngine/Parse/StructElement.hs b/lib/RPGEngine/Parse/TextToStructure.hs similarity index 86% rename from lib/RPGEngine/Parse/StructElement.hs rename to lib/RPGEngine/Parse/TextToStructure.hs index 35d2b08..6f1b060 100644 --- a/lib/RPGEngine/Parse/StructElement.hs +++ b/lib/RPGEngine/Parse/TextToStructure.hs @@ -1,13 +1,14 @@ -module RPGEngine.Parse.StructElement where +module RPGEngine.Parse.TextToStructure +-- Everything is exported for testing +where -import RPGEngine.Data (Action(..), Condition(..), Layout, Direction(..), Physical(..), Strip) import RPGEngine.Parse.Core ( ignoreWS ) +import RPGEngine.Data (Action (..), Condition (..), Direction (..), Layout, Strip, Physical (..)) + import Text.Parsec - ( char, - many, - try, - alphaNum, + ( alphaNum, + char, digit, noneOf, oneOf, @@ -15,7 +16,9 @@ import Text.Parsec choice, many1, notFollowedBy, - sepBy ) + sepBy, + many, + try ) import qualified Text.Parsec as P ( string ) import Text.Parsec.String ( Parser ) @@ -23,18 +26,18 @@ import Text.Parsec.String ( Parser ) -- See documentation for more details, only a short description is -- provided here. -data StructElement = Block [StructElement] - | Entry Key StructElement -- Key + Value +data Structure = Block [Structure] + | Entry Key Structure -- Key + Value | Regular Value -- Regular value, Integer or String or Infinite deriving (Eq, Show) ---------------------------------------------------------------------- -structElement :: Parser StructElement -structElement = try $ choice [block, entry, regular] +structure :: Parser Structure +structure = try $ choice [block, entry, regular] -- A list of entries -block :: Parser StructElement +block :: Parser Structure block = try $ do open <- ignoreWS $ oneOf openingBrackets middle <- ignoreWS $ choice [entry, block] `sepBy` char ',' @@ -42,15 +45,15 @@ block = try $ do ignoreWS $ char closingBracket return $ Block middle -entry :: Parser StructElement +entry :: Parser Structure entry = try $ do key <- ignoreWS key -- TODO Fix this oneOf ": " -- Can be left out - value <- ignoreWS structElement + value <- ignoreWS structure return $ Entry key value -regular :: Parser StructElement +regular :: Parser Structure regular = try $ Regular <$> value --------------------------------- Key -------------------------------- @@ -108,7 +111,7 @@ data Value = String String ---------------------------------------------------------------------- value :: Parser Value -value = choice [string, integer, infinite, action, direction] +value = choice [layout, string, integer, infinite, action, direction] string :: Parser Value string = try $ String <$> between (char '\"') (char '\"') reading @@ -134,7 +137,7 @@ action = try $ do | script == "useItem" = UseItem arg | script == "decreaseHp" = DecreaseHp first second | script == "increasePlayerHp" = IncreasePlayerHp arg - | otherwise = RPGEngine.Data.Nothing + | otherwise = DoNothing (first, ',':second) = break (== ',') arg return $ Action answer @@ -152,12 +155,15 @@ direction = try $ do make "right" = East make "down" = South make "left" = West - make _ = Center + make _ = Stay layout :: Parser Value layout = try $ do + open <- ignoreWS $ oneOf openingBrackets ignoreWS $ char '|' - list <- ignoreWS strip `sepBy` ignoreWS (char '|') + list <- ignoreWS $ ignoreWS strip `sepBy` ignoreWS (char '|') + let closing = getMatchingClosingBracket open + ignoreWS $ char closing return $ Layout list strip :: Parser Strip @@ -180,7 +186,6 @@ physical = try $ do make 'e' = Exit make _ = Void - ------------------------------ Brackets ------------------------------ openingBrackets :: [Char] diff --git a/lib/RPGEngine/Render.hs b/lib/RPGEngine/Render.hs index 09b9b66..fb9152b 100644 --- a/lib/RPGEngine/Render.hs +++ b/lib/RPGEngine/Render.hs @@ -1,38 +1,21 @@ --- Allows to render the played game - +-- Implementation for each state can be found in their respective +-- submodules. module RPGEngine.Render ( initWindow -, bgColor - +, initGame , render ) where -import RPGEngine.Data - ( State(..), - Game(..), Player (..) ) -import RPGEngine.Render.Level - ( renderLevel ) -import Graphics.Gloss - ( white, - pictures, - text, - Display(InWindow), - Color, - Picture, - scale, - translate ) -import RPGEngine.Render.Player (renderPlayer, focusPlayer) -import RPGEngine.Render.GUI (renderGUI) -import Graphics.Gloss.Data.Picture (color) -import RPGEngine.Render.Core (overlay) -import RPGEngine.Input.LvlSelect (getLvlList) -import RPGEngine.Render.LvlSelect (renderLvlList) +import RPGEngine.Render.Core ( Renderer(..) ) ------------------------------ Constants ------------------------------ - --- Game background color -bgColor :: Color -bgColor = white +import RPGEngine.Data ( State(..), Game(..), StateBase(..) ) +import Graphics.Gloss ( Display ) +import Graphics.Gloss.Data.Display ( Display(InWindow) ) +import Graphics.Gloss.Data.Picture (Picture) +import RPGEngine.Data.Default (defaultLevel, defaultPlayer) +import RPGEngine.Input.Playing (spawnPlayer) +import RPGEngine.Render.Menu (renderMenu) +import RPGEngine.Input.Menu (handleInputMenu) ---------------------------------------------------------------------- @@ -40,43 +23,16 @@ bgColor = white initWindow :: String -> (Int, Int) -> (Int, Int) -> Display initWindow = InWindow --- Render the game +-- Initialize the game +initGame :: Game +initGame = Game { + state = Menu{ base = StateBase{ renderer = renderMenu, inputHandler = handleInputMenu }}, + levels = [defaultLevel], + player = spawnPlayer defaultLevel defaultPlayer +} + +-- Render all different states render :: Game -> Picture -render g@Game{ state = Menu } = renderMenu g -render g@Game{ state = LvlSelect } = renderLevelSelection g -render g@Game{ state = Playing } = renderPlaying g -render g@Game{ state = Pause } = renderPause g -render g@Game{ state = Win } = renderWin g -render g@Game{ state = Lose } = renderLose g - ----------------------------------------------------------------------- - --- TODO -renderMenu :: Game -> Picture -renderMenu _ = text "[Press any key to start]" - --- TODO -renderLevelSelection :: Game -> Picture -renderLevelSelection _ = renderLvlList getLvlList - -renderPlaying :: Game -> Picture -renderPlaying g@Game{ playing = lvl, player = player } = pictures [ - renderLevel lvl, - renderPlayer player, - renderGUI g - ] - -renderPause :: Game -> Picture -renderPause g = pictures [renderPlaying g, pause] - where pause = pictures [ - overlay, - color white $ scale 0.5 0.5 $ text "[Press any key to continue]" - ] - --- TODO -renderWin :: Game -> Picture -renderWin _ = text "Win" - --- TODO -renderLose :: Game -> Picture -renderLose _ = text "Lose" \ No newline at end of file +render g@Game{ state = state } = renderFunc g + where stateBase = base state + renderFunc = renderer stateBase \ No newline at end of file diff --git a/lib/RPGEngine/Render/Core.hs b/lib/RPGEngine/Render/Core.hs index e5155f4..014843e 100644 --- a/lib/RPGEngine/Render/Core.hs +++ b/lib/RPGEngine/Render/Core.hs @@ -1,24 +1,21 @@ -module RPGEngine.Render.Core where +module RPGEngine.Render.Core +( Renderer -import Graphics.Gloss ( Picture, translate, pictures ) -import GHC.IO (unsafePerformIO) -import Graphics.Gloss.Juicy (loadJuicyPNG) -import Data.Maybe (fromJust) -import Graphics.Gloss.Data.Picture (scale) -import Graphics.Gloss.Data.Bitmap (BitmapData(..)) +, getRender +, setRenderPos +, overlay +) where + +import RPGEngine.Config + +import Data.Maybe +import Graphics.Gloss +import GHC.IO +import Graphics.Gloss.Juicy ----------------------------- Constants ------------------------------ --- Default scale -zoom :: Float -zoom = 5.0 - --- Resolution of the texture -resolution :: Float -resolution = 16 - -assetsFolder :: FilePath -assetsFolder = "assets/" +type Renderer a = a -> Picture unknownImage :: FilePath unknownImage = "unknown.png" @@ -54,11 +51,7 @@ library = unknown:entities ++ environment ++ gui ++ items gui = [] items = map (\(f, s) -> (f, renderPNG (assetsFolder ++ "items/" ++ s))) allItems ----------------------------------------------------------------------- - --- Turn a path to a .png file into a Picture. -renderPNG :: FilePath -> Picture -renderPNG path = scale zoom zoom $ fromJust $ unsafePerformIO $ loadJuicyPNG path +------------------------------ Exported ------------------------------ -- Retrieve an image from the library. If the library does not contain -- the requested image, a default is returned. @@ -82,4 +75,10 @@ overlay = setRenderPos offX offY $ pictures voids height = round $ 4320 / resolution / zoom width = round $ 7680 / resolution / zoom offX = negate (width `div` 2) - offY = negate (height `div` 2) \ No newline at end of file + offY = negate (height `div` 2) + +---------------------------------------------------------------------- + +-- Turn a path to a .png file into a Picture. +renderPNG :: FilePath -> Picture +renderPNG path = scale zoom zoom $ fromJust $ unsafePerformIO $ loadJuicyPNG path \ No newline at end of file diff --git a/lib/RPGEngine/Render/GUI.hs b/lib/RPGEngine/Render/GUI.hs deleted file mode 100644 index e29b012..0000000 --- a/lib/RPGEngine/Render/GUI.hs +++ /dev/null @@ -1,10 +0,0 @@ -module RPGEngine.Render.GUI -( renderGUI -) where - -import RPGEngine.Data (Game) -import Graphics.Gloss (Picture, blank) - --- TODO -renderGUI :: Game -> Picture -renderGUI _ = blank diff --git a/lib/RPGEngine/Render/LevelSelection.hs b/lib/RPGEngine/Render/LevelSelection.hs new file mode 100644 index 0000000..ee3da56 --- /dev/null +++ b/lib/RPGEngine/Render/LevelSelection.hs @@ -0,0 +1,33 @@ +module RPGEngine.Render.LevelSelection +( renderLevelSelection +) where + +import RPGEngine.Config ( resolution, zoom ) +import RPGEngine.Data ( Game (..), State (..) ) +import RPGEngine.Data.Level ( getLevelList ) +import RPGEngine.Render.Core ( Renderer ) + +import Graphics.Gloss + ( pictures, text, translate, blank, Picture, color ) +import Graphics.Gloss.Data.Picture (scale) +import RPGEngine.Input.Core (ListSelector (..)) +import Graphics.Gloss.Data.Color (red) + +------------------------------ Exported ------------------------------ + +renderLevelSelection :: Renderer Game +renderLevelSelection Game{ state = state } = result + where result = renderLevelList state + +---------------------------------------------------------------------- + +renderLevelList :: Renderer State +renderLevelList LevelSelection{ levelList = list, selector = selector } = everything + where everything = pictures $ map render entries + sel = selection selector + entries = zip [0::Int .. ] list + render (i, path) | i == sel = color red $ scale zoomed zoomed $ translate 0 (offset i) $ text path + | otherwise = scale zoomed zoomed $ translate 0 (offset i) $ text path + zoomed = 0.1 * zoom + offset i = negate (2 * resolution * zoom * fromIntegral i) +renderLevelList _ = blank \ No newline at end of file diff --git a/lib/RPGEngine/Render/Lose.hs b/lib/RPGEngine/Render/Lose.hs new file mode 100644 index 0000000..b3266e9 --- /dev/null +++ b/lib/RPGEngine/Render/Lose.hs @@ -0,0 +1,14 @@ +module RPGEngine.Render.Lose +( renderLose +) where + +import RPGEngine.Render.Core ( Renderer ) + +import RPGEngine.Data ( Game ) +import Graphics.Gloss ( text ) + +---------------------------------------------------------------------- + +-- TODO +renderLose :: Renderer Game +renderLose _ = text "Win" \ No newline at end of file diff --git a/lib/RPGEngine/Render/LvlSelect.hs b/lib/RPGEngine/Render/LvlSelect.hs deleted file mode 100644 index b395e9d..0000000 --- a/lib/RPGEngine/Render/LvlSelect.hs +++ /dev/null @@ -1,15 +0,0 @@ -module RPGEngine.Render.LvlSelect -( renderLvlList -) where - -import Graphics.Gloss ( Picture, pictures, translate, scale ) -import Graphics.Gloss.Data.Picture (blank, text) -import RPGEngine.Render.Core (resolution, zoom) - --- Render all level names, under each other. -renderLvlList :: [FilePath] -> Picture -renderLvlList list = pictures $ map render entries - where entries = zip [0::Int .. ] list - render (i, path) = scale zoomed zoomed $ translate 0 (offset i) $ text path - zoomed = 0.1 * zoom - offset i = negate (2 * resolution * zoom * fromIntegral i) \ No newline at end of file diff --git a/lib/RPGEngine/Render/Menu.hs b/lib/RPGEngine/Render/Menu.hs new file mode 100644 index 0000000..26ec414 --- /dev/null +++ b/lib/RPGEngine/Render/Menu.hs @@ -0,0 +1,14 @@ +module RPGEngine.Render.Menu +( renderMenu +) where + +import RPGEngine.Render.Core ( Renderer ) + +import RPGEngine.Data ( Game ) +import Graphics.Gloss (text) + +---------------------------------------------------------------------- + +-- TODO +renderMenu :: Renderer Game +renderMenu _ = text "[Press any key to start]" \ No newline at end of file diff --git a/lib/RPGEngine/Render/Paused.hs b/lib/RPGEngine/Render/Paused.hs new file mode 100644 index 0000000..3a49a64 --- /dev/null +++ b/lib/RPGEngine/Render/Paused.hs @@ -0,0 +1,20 @@ +module RPGEngine.Render.Paused +( renderPaused +) where + +import RPGEngine.Render.Core ( Renderer, overlay ) + +import RPGEngine.Data ( Game ) +import Graphics.Gloss ( pictures, scale, text ) +import RPGEngine.Render.Playing ( renderPlaying ) +import Graphics.Gloss.Data.Picture (color) +import Graphics.Gloss.Data.Color (white) + +------------------------------ Exported ------------------------------ + +renderPaused :: Renderer Game +renderPaused g = pictures [renderPlaying g, pause] + where pause = pictures [ + overlay, + color white $ scale 0.5 0.5 $ text "[Press any key to continue]" + ] \ No newline at end of file diff --git a/lib/RPGEngine/Render/Player.hs b/lib/RPGEngine/Render/Player.hs deleted file mode 100644 index 0b6a124..0000000 --- a/lib/RPGEngine/Render/Player.hs +++ /dev/null @@ -1,17 +0,0 @@ -module RPGEngine.Render.Player -( renderPlayer -, focusPlayer -) where - -import RPGEngine.Data (Player(..), Game(..)) -import Graphics.Gloss (Picture, text) -import RPGEngine.Render.Core (getRender, setRenderPos, zoom, resolution) -import Graphics.Gloss.Data.Picture (translate) - -renderPlayer :: Player -> Picture -renderPlayer Player{ position = (x, y) } = setRenderPos x y $ getRender "player" - -focusPlayer :: Game -> Picture -> Picture -focusPlayer Game{ player = Player{ position = (x, y)}} = translate centerX centerY - where centerX = resolution * zoom * fromIntegral (negate x) - centerY = resolution * zoom * fromIntegral (negate y) \ No newline at end of file diff --git a/lib/RPGEngine/Render/Level.hs b/lib/RPGEngine/Render/Playing.hs similarity index 54% rename from lib/RPGEngine/Render/Level.hs rename to lib/RPGEngine/Render/Playing.hs index 4e01968..0f075ba 100644 --- a/lib/RPGEngine/Render/Level.hs +++ b/lib/RPGEngine/Render/Playing.hs @@ -1,12 +1,48 @@ -module RPGEngine.Render.Level -( renderLevel +module RPGEngine.Render.Playing +( renderPlaying ) where -import Graphics.Gloss -import RPGEngine.Data -import RPGEngine.Render.Core (getRender, setRenderPos, zoom, resolution) +import RPGEngine.Render.Core ( Renderer, getRender, setRenderPos ) -renderLevel :: Level -> Picture +import RPGEngine.Data + ( Player(..), + Entity(..), + Item(..), + Physical(..), + Layout, + Level(..), + State(..), + Game(..) ) +import Graphics.Gloss ( Picture, pictures ) +import Graphics.Gloss.Data.Picture (translate) +import RPGEngine.Config (resolution, zoom) + +------------------------------ Exported ------------------------------ + +renderPlaying :: Renderer Game +renderPlaying g@Game{ state = Playing { level = lvl }, player = player } = pictures [ + renderLevel lvl, + renderPlayer player + ] + +------------------------------- Player ------------------------------- + +renderPlayer :: Renderer Player +renderPlayer Player{ position = (x, y) } = move picture + where move = setRenderPos x y + picture = getRender "player" + +-- Center the player in the middle of the screen. +-- Not in use at the moment, might be useful later. +focusPlayer :: Game -> Picture -> Picture +focusPlayer Game{ player = Player{ position = (x, y)}} = move + where move = translate centerX centerY + centerX = resolution * zoom * fromIntegral (negate x) + centerY = resolution * zoom * fromIntegral (negate y) + +------------------------------- Level -------------------------------- + +renderLevel :: Renderer Level renderLevel Level{ layout = l, items = i, entities = e } = level where level = pictures [void, layout, items, entities] void = createVoid @@ -28,6 +64,18 @@ renderStrip list = pictures physicals image Exit = pictures [getRender "tile", getRender "exit"] count = length list - 1 +createVoid :: Picture +createVoid = setRenderPos offX offY $ pictures voids + where voids = [setRenderPos x y void | x <- [0 .. width], y <- [0 .. height]] + void = getRender "void" + intZoom = round zoom :: Int + height = round $ 4320 / resolution / zoom + width = round $ 7680 / resolution / zoom + offX = negate (width `div` 2) + offY = negate (height `div` 2) + +-------------------------- Items & Entities -------------------------- + renderItems :: [Item] -> Picture renderItems list = pictures $ map renderItem list @@ -40,14 +88,4 @@ renderEntities list = pictures $ map renderEntity list renderEntity :: Entity -> Picture renderEntity Entity{ entityId = id, entityX = x, entityY = y} = setRenderPos x y image - where image = getRender id - -createVoid :: Picture -createVoid = setRenderPos offX offY $ pictures voids - where voids = [setRenderPos x y void | x <- [0 .. width], y <- [0 .. height]] - void = getRender "void" - intZoom = round zoom :: Int - height = round $ 4320 / resolution / zoom - width = round $ 7680 / resolution / zoom - offX = negate (width `div` 2) - offY = negate (height `div` 2) \ No newline at end of file + where image = getRender id \ No newline at end of file diff --git a/lib/RPGEngine/Render/Win.hs b/lib/RPGEngine/Render/Win.hs new file mode 100644 index 0000000..55d893b --- /dev/null +++ b/lib/RPGEngine/Render/Win.hs @@ -0,0 +1,14 @@ +module RPGEngine.Render.Win +( renderWin +) where + +import RPGEngine.Render.Core ( Renderer ) + +import RPGEngine.Data ( Game ) +import Graphics.Gloss (text) + +---------------------------------------------------------------------- + +-- TODO +renderWin :: Renderer Game +renderWin _ = text "Win" \ No newline at end of file diff --git a/rpg-engine.cabal b/rpg-engine.cabal index 9e11d89..9043757 100644 --- a/rpg-engine.cabal +++ b/rpg-engine.cabal @@ -13,28 +13,36 @@ library parsec >= 3.1.15.1 exposed-modules: RPGEngine - + + RPGEngine.Config + RPGEngine.Data - RPGEngine.Data.Defaults - RPGEngine.Data.State + RPGEngine.Data.Default + RPGEngine.Data.Game + RPGEngine.Data.Level RPGEngine.Input RPGEngine.Input.Core - RPGEngine.Input.Level - RPGEngine.Input.LvlSelect - RPGEngine.Input.Player + RPGEngine.Input.LevelSelection + RPGEngine.Input.Lose + RPGEngine.Input.Menu + RPGEngine.Input.Paused + RPGEngine.Input.Playing + RPGEngine.Input.Win RPGEngine.Parse RPGEngine.Parse.Core - RPGEngine.Parse.Game - RPGEngine.Parse.StructElement - + RPGEngine.Parse.TextToStructure + RPGEngine.Parse.StructureToGame + RPGEngine.Render RPGEngine.Render.Core - RPGEngine.Render.GUI - RPGEngine.Render.Level - RPGEngine.Render.LvlSelect - RPGEngine.Render.Player + RPGEngine.Render.LevelSelection + RPGEngine.Render.Lose + RPGEngine.Render.Menu + RPGEngine.Render.Paused + RPGEngine.Render.Playing + RPGEngine.Render.Win executable rpg-engine main-is: Main.hs @@ -44,10 +52,10 @@ executable rpg-engine test-suite rpg-engine-test type: exitcode-stdio-1.0 - main-is: RPGEngineSpec.hs + main-is: Spec.hs hs-source-dirs: test default-language: Haskell2010 build-depends: base >=4.7 && <5, hspec <= 2.10.6, hspec-discover, rpg-engine other-modules: - -- Parsing - ParseGameSpec, ParseStructElementSpec + Parser.GameSpec + Parser.StructureSpec diff --git a/test/ParseGameSpec.hs b/test/Parser/GameSpec.hs similarity index 78% rename from test/ParseGameSpec.hs rename to test/Parser/GameSpec.hs index 2a2d7d2..1f167a3 100644 --- a/test/ParseGameSpec.hs +++ b/test/Parser/GameSpec.hs @@ -1,10 +1,11 @@ -module ParseGameSpec where +module Parser.GameSpec where import Test.Hspec -import RPGEngine.Parse.StructElement + import RPGEngine.Data import RPGEngine.Parse.Core -import RPGEngine.Parse.Game +import RPGEngine.Parse.TextToStructure +import RPGEngine.Parse.StructureToGame spec :: Spec spec = do @@ -21,19 +22,21 @@ spec = do let input = "player: { hp: infinite, inventory: [] }" correct = Player { playerHp = Prelude.Nothing, - inventory = [] + inventory = [], + position = (0, 0) } - Right (Entry (Tag "player") struct) = parseWith structElement input - structToPlayer struct `shouldBe` correct + Right (Entry (Tag "player") struct) = parseWith structure input + structureToPlayer struct `shouldBe` correct it "without inventory" $ do let input = "player: { hp: 50, inventory: [] }" correct = Player { playerHp = Just 50, - inventory = [] + inventory = [], + position = (0, 0) } - Right (Entry (Tag "player") struct) = parseWith structElement input - structToPlayer struct `shouldBe` correct + Right (Entry (Tag "player") struct) = parseWith structure input + structureToPlayer struct `shouldBe` correct it "with inventory" $ do let input = "player: { hp: 50, inventory: [ { id: \"dagger\", x: 0, y: 0, name: \"Dolk\", description: \"Basis schade tegen monsters\", useTimes: infinite, value: 10, actions: {} } ] }" @@ -50,10 +53,11 @@ spec = do itemValue = Just 10, useTimes = Prelude.Nothing } - ] + ], + position = (0, 0) } - Right (Entry (Tag "player") struct) = parseWith structElement input - structToPlayer struct `shouldBe` correct + Right (Entry (Tag "player") struct) = parseWith structure input + structureToPlayer struct `shouldBe` correct describe "Layout" $ do it "simple" $ do @@ -72,8 +76,8 @@ spec = do itemActions = [], useTimes = Prelude.Nothing } - Right struct = parseWith structElement input - structToItem struct `shouldBe` correct + Right struct = parseWith structure input + structureToItem struct `shouldBe` correct it "with actions" $ do let input = "{ id: \"key\", x: 3, y: 1, name: \"Doorkey\", description: \"Unlocks a secret door\", useTimes: 1, value: 0, actions: { [not(inventoryFull())] retrieveItem(key), [] leave() } }" @@ -90,27 +94,27 @@ spec = do itemValue = Just 0, useTimes = Just 1 } - Right struct = parseWith structElement input - structToItem struct `shouldBe` correct + Right struct = parseWith structure input + structureToItem struct `shouldBe` correct describe "Actions" $ do it "no conditions" $ do let input = "{[] leave()}" correct = [([], Leave)] - Right struct = parseWith structElement input - structToActions struct `shouldBe` correct + Right struct = parseWith structure input + structureToActions struct `shouldBe` correct it "single condition" $ do let input = "{ [inventoryFull()] useItem(itemId)}" correct = [([InventoryFull], UseItem "itemId")] - Right struct = parseWith structElement input - structToActions struct `shouldBe` correct + Right struct = parseWith structure input + structureToActions struct `shouldBe` correct it "multiple conditions" $ do let input = "{ [not(inventoryFull()), inventoryContains(itemId)] increasePlayerHp(itemId)}" correct = [([Not InventoryFull, InventoryContains "itemId"], IncreasePlayerHp "itemId")] - Right struct = parseWith structElement input - structToActions struct `shouldBe` correct + Right struct = parseWith structure input + structureToActions struct `shouldBe` correct describe "Entities" $ do it "TODO: Simple entity" $ do @@ -118,7 +122,7 @@ spec = do describe "Level" $ do it "Simple layout" $ do - let input = "{ layout: { | * * * * * * \n| * s . . e *\n| * * * * * *\n}, items: [], entities: [] }" + let input = "{ layout: { | * * * * * * \n| * s . . e *\n| * * * * * * }, items: [], entities: [] }" correct = Level { RPGEngine.Data.layout = [ [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked], @@ -128,7 +132,8 @@ spec = do items = [], entities = [] } - Right struct = parseWith structElement input - structToLevel struct `shouldBe` correct + Right struct = parseWith structure input + structureToLevel struct `shouldBe` correct + it "TODO: Complex layout" $ do pending \ No newline at end of file diff --git a/test/ParseStructElementSpec.hs b/test/Parser/StructureSpec.hs similarity index 87% rename from test/ParseStructElementSpec.hs rename to test/Parser/StructureSpec.hs index 0f7464a..e9296b8 100644 --- a/test/ParseStructElementSpec.hs +++ b/test/Parser/StructureSpec.hs @@ -1,10 +1,10 @@ -module ParseStructElementSpec where +module Parser.StructureSpec where import Test.Hspec import RPGEngine.Data import RPGEngine.Parse.Core -import RPGEngine.Parse.StructElement +import RPGEngine.Parse.TextToStructure spec :: Spec spec = do @@ -12,21 +12,21 @@ spec = do it "can parse blocks" $ do let input = "{}" correct = Right $ Block [] - parseWith structElement input `shouldBe` correct + parseWith structure input `shouldBe` correct let input = "{{}}" correct = Right $ Block [Block []] - parseWith structElement input `shouldBe` correct + parseWith structure input `shouldBe` correct let input = "{{}, {}}" correct = Right $ Block [Block [], Block []] - parseWith structElement input `shouldBe` correct + parseWith structure input `shouldBe` correct let input = "{ id: 1 }" correct = Right (Block [ Entry (Tag "id") $ Regular $ Integer 1 ], "") - parseWithRest structElement input `shouldBe` correct + parseWithRest structure input `shouldBe` correct let input = "{ id: \"key\", x: 3, y: 1}" correct = Right $ Block [ @@ -34,14 +34,14 @@ spec = do Entry (Tag "x") $ Regular $ Integer 3, Entry (Tag "y") $ Regular $ Integer 1 ] - parseWith structElement input `shouldBe` correct + parseWith structure input `shouldBe` correct let input = "actions: { [not(inventoryFull())] retrieveItem(key), [] leave()}" correct = Right (Entry (Tag "actions") $ Block [ Entry (ConditionList [Not InventoryFull]) $ Regular $ Action $ RetrieveItem "key", Entry (ConditionList []) $ Regular $ Action Leave ], "") - parseWithRest structElement input `shouldBe` correct + parseWithRest structure input `shouldBe` correct let input = "entities: [ { id: \"door\", x: 4, name:\"Secret door\", description: \"This secret door can only be opened with a key\", direction: left, y: 1}]" correct = Right (Entry (Tag "entities") $ Block [ Block [ @@ -52,7 +52,7 @@ spec = do Entry (Tag "direction") $ Regular $ Direction West, Entry (Tag "y") $ Regular $ Integer 1 ]], "") - parseWithRest structElement input `shouldBe` correct + parseWithRest structure input `shouldBe` correct let input = "entities: [ { id: \"door\", x: 4, y: 1, name:\"Secret door\", description: \"This secret door can only be opened with a key\", actions: { [inventoryContains(key)] useItem(key), [] leave() } } ]" correct = Right (Entry (Tag "entities") $ Block [ Block [ @@ -66,7 +66,7 @@ spec = do Entry (ConditionList []) $ Regular $ Action Leave ] ]], "") - parseWithRest structElement input `shouldBe` correct + parseWithRest structure input `shouldBe` correct let input = "entities: [ { id: \"door\", x: 4, y: 1, name:\"Secret door\", description: \"This secret door can only be opened with a key\", direction: left , actions: { [inventoryContains(key)] useItem(key), [] leave() } } ]" correct = Right (Entry (Tag "entities") $ Block [ Block [ @@ -81,7 +81,7 @@ spec = do Entry (ConditionList []) $ Regular $ Action Leave ] ]], "") - parseWithRest structElement input `shouldBe` correct + parseWithRest structure input `shouldBe` correct it "can parse entries" $ do let input = "id: \"dagger\"" @@ -105,7 +105,7 @@ spec = do Entry (ConditionList [Not InventoryFull]) $ Regular $ Action $ RetrieveItem "key", Entry (ConditionList []) $ Regular $ Action Leave ], "") - parseWithRest structElement input `shouldBe` correct + parseWithRest structure input `shouldBe` correct it "can parse regulars" $ do let input = "this is a string" @@ -237,19 +237,19 @@ spec = do it "can parse directions" $ do let input = "up" correct = Right $ Direction North - parseWith RPGEngine.Parse.StructElement.direction input `shouldBe` correct + parseWith RPGEngine.Parse.TextToStructure.direction input `shouldBe` correct let input = "right" correct = Right $ Direction East - parseWith RPGEngine.Parse.StructElement.direction input `shouldBe` correct + parseWith RPGEngine.Parse.TextToStructure.direction input `shouldBe` correct let input = "down" correct = Right $ Direction South - parseWith RPGEngine.Parse.StructElement.direction input `shouldBe` correct + parseWith RPGEngine.Parse.TextToStructure.direction input `shouldBe` correct let input = "left" correct = Right $ Direction West - parseWith RPGEngine.Parse.StructElement.direction input `shouldBe` correct + parseWith RPGEngine.Parse.TextToStructure.direction input `shouldBe` correct it "can parse layouts" $ do let input = "| * * * * * * * *\n| * s . . . . e *\n| * * * * * * * *" @@ -258,7 +258,16 @@ spec = do [Blocked, Entrance, Walkable, Walkable, Walkable, Walkable, Exit, Blocked], [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked] ] - parseWith RPGEngine.Parse.StructElement.layout input `shouldBe` correct + parseWith RPGEngine.Parse.TextToStructure.layout input `shouldBe` correct + + let input = "{ |* * * * * * * *|* s . . . . e *|* * * * * * * * }" + -- correct = Right $ Entry (Tag "layout") $ Regular $ Layout [ + correct = Right $ Layout [ + [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked], + [Blocked, Entrance, Walkable, Walkable, Walkable, Walkable, Exit, Blocked], + [Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked, Blocked] + ] + parseWith RPGEngine.Parse.TextToStructure.value input `shouldBe` correct describe "Brackets" $ do it "matches closing <" $ do diff --git a/test/RPGEngineSpec.hs b/test/Spec.hs similarity index 100% rename from test/RPGEngineSpec.hs rename to test/Spec.hs