Skip to content

Commit

Permalink
Split up modules for Model/Update/View and add test
Browse files Browse the repository at this point in the history
  • Loading branch information
Chris Hendrix and Yulia Tolskaya committed Jun 18, 2015
1 parent d99f9a3 commit fcc6fc6
Show file tree
Hide file tree
Showing 5 changed files with 156 additions and 124 deletions.
122 changes: 3 additions & 119 deletions src/Rogue.elm
Original file line number Diff line number Diff line change
@@ -1,127 +1,11 @@
module Rogue where

import Color exposing (..)
import Graphics.Collage exposing (..)
import Graphics.Element exposing (..)
import Keyboard
import Text
import Window
import List exposing (..)
import Time exposing (..)
import String exposing (join)


-- MODEL

type alias Location = (Int, Int)

type alias GameMap =
{ board : Board
, start : Location
, currentPlayerLocation : Location
}

type alias Board = List (List Cell)

type Player = Player

type alias Game =
{ gameMap : GameMap
, player : Player
}

type Cell = Open Location

isAt : Location -> Cell -> Bool
isAt queried (Open current) = queried == current

newBoard : Int -> Board
newBoard i =
map (\row ->
map
(\col -> Open (row, col)
) [0..i]) [0..i]

gameMap : Int -> GameMap
gameMap i =
let startLoc = (0,0) in
{ board = newBoard i
, start = startLoc
, currentPlayerLocation = startLoc
}

defaultGame : Game
defaultGame =
let
g = gameMap 10
in
{ gameMap = g
, player = Player
}

type alias Dir =
{ x : Int
, y : Int
}

type alias Input =
{ dir : Dir
}

numRows : Board -> Int
numRows b = length b

numCols : Board -> Int
numCols = numRows

within : Board -> Location -> Bool
within board (row, col) =
row >= 0 && row < numRows board && col >= 0 && col < numCols board

translate : Location -> Dir -> Location
translate (row,col) dir =
(row - dir.y, col + dir.x)

-- UPDATE

update : Input -> Game -> Game
update i game =
{ game | gameMap <- updateGameMap i game.gameMap }

updateGameMap : Input -> GameMap -> GameMap
updateGameMap {dir} ({board,start,currentPlayerLocation} as gameMap) =
let
newLocation = translate currentPlayerLocation dir
in
if within board newLocation
then
{ gameMap | currentPlayerLocation <- newLocation
}
else
gameMap

-- VIEW

view : Game -> Element
view g = leftAligned (Text.monospace (Text.fromString (toString g.gameMap)))

toString : GameMap -> String
toString {board,start,currentPlayerLocation} =
let
rowifier =
(\row ->
map
(\cell ->
if | isAt currentPlayerLocation cell -> "@"
| isAt start cell -> ""
| otherwise -> "."
)
row
|> join ""
)
in
map rowifier board
|> join "\n"
import Rogue.Model exposing (..)
import Rogue.Update exposing (..)
import Rogue.View exposing (..)

-- SIGNALS

Expand Down
72 changes: 72 additions & 0 deletions src/Rogue/Model.elm
Original file line number Diff line number Diff line change
@@ -0,0 +1,72 @@
module Rogue.Model where

import List exposing (..)

type alias Location = (Int, Int)

type alias GameMap =
{ board : Board
, start : Location
, currentPlayerLocation : Location
}

type alias Board = List (List Cell)

type Player = Player

type alias Game =
{ gameMap : GameMap
, player : Player
}

type Cell = Open Location

isAt : Location -> Cell -> Bool
isAt queried (Open current) = queried == current

newBoard : Int -> Board
newBoard size =
map (\row ->
map
(\col -> Open (row, col)
) [0..(size - 1)]) [0..(size - 1)]

gameMap : Int -> GameMap
gameMap size =
let startLoc = (0,0) in
{ board = newBoard size
, start = startLoc
, currentPlayerLocation = startLoc
}

defaultGame : Game
defaultGame =
let
g = gameMap 10
in
{ gameMap = g
, player = Player
}

type alias Dir =
{ x : Int
, y : Int
}

type alias Input =
{ dir : Dir
}

numRows : Board -> Int
numRows b = length b

numCols : Board -> Int
numCols = numRows

within : Board -> Location -> Bool
within board (row, col) =
row >= 0 && row < numRows board && col >= 0 && col < numCols board

translate : Location -> Dir -> Location
translate (row,col) dir =
(row - dir.y, col + dir.x)
19 changes: 19 additions & 0 deletions src/Rogue/Update.elm
Original file line number Diff line number Diff line change
@@ -0,0 +1,19 @@
module Rogue.Update where

import Rogue.Model exposing (..)

update : Input -> Game -> Game
update i game =
{ game | gameMap <- updateGameMap i game.gameMap }

updateGameMap : Input -> GameMap -> GameMap
updateGameMap {dir} ({board,start,currentPlayerLocation} as gameMap) =
let
newLocation = translate currentPlayerLocation dir
in
if within board newLocation
then
{ gameMap | currentPlayerLocation <- newLocation
}
else
gameMap
31 changes: 31 additions & 0 deletions src/Rogue/View.elm
Original file line number Diff line number Diff line change
@@ -0,0 +1,31 @@
module Rogue.View where

import Color exposing (..)
import Graphics.Collage exposing (..)
import Graphics.Element exposing (..)
import String exposing (join)
import Text
import List exposing (..)

import Rogue.Model exposing (..)

view : Game -> Element
view g = leftAligned (Text.monospace (Text.fromString (toString g.gameMap)))

toString : GameMap -> String
toString {board,start,currentPlayerLocation} =
let
rowifier =
(\row ->
map
(\cell ->
if | isAt currentPlayerLocation cell -> "@"
| isAt start cell -> ""
| otherwise -> "."
)
row
|> join ""
)
in
map rowifier board
|> join "\n"
36 changes: 31 additions & 5 deletions test/RogueTest.elm
Original file line number Diff line number Diff line change
Expand Up @@ -3,12 +3,38 @@ module RogueTest where
import ElmTest.Test exposing (..)
import ElmTest.Assertion exposing (..)

import Rogue
import Rogue.Model exposing (..)
import Rogue.Update exposing (..)
import String

tests : Test
tests = suite "A Test Suite"
[ test "Addition" (assertEqual (3 + 7) 10)
, test "String.left" (assertEqual "a" (String.left 1 "abcdefg"))
, test "This test should fail" (assert False)
]
[ test_updateGameMap_does_not_move_outside_of_bounds

]

test_updateGameMap_does_not_move_outside_of_bounds : Test
test_updateGameMap_does_not_move_outside_of_bounds =
let
game = gameMap 2
gameAtTopLeft = { game | currentPlayerLocation <- (0,0) }
left = Input { x =-1, y = 0 }
up = Input { x=0, y=1 }
gameAtBottomRight = { game | currentPlayerLocation <- (1,1) }
right = Input { x =1, y = 0 }
down = Input { x=0, y=-1 }
in
suite "Update does not move outside of bounds"
[ test "Left" (
assertEqual gameAtTopLeft.currentPlayerLocation (updateGameMap left gameAtTopLeft).currentPlayerLocation
)
, test "Up" (
assertEqual gameAtTopLeft.currentPlayerLocation (updateGameMap up gameAtTopLeft).currentPlayerLocation
)
, test "Right" (
assertEqual gameAtBottomRight.currentPlayerLocation (updateGameMap right gameAtBottomRight).currentPlayerLocation
)
, test "Down" (
assertEqual gameAtBottomRight.currentPlayerLocation (updateGameMap down gameAtBottomRight).currentPlayerLocation
)
]

0 comments on commit fcc6fc6

Please sign in to comment.