147 lines
3.2 KiB
Haskell
147 lines
3.2 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Karel
|
|
( -- data types
|
|
Vector,
|
|
Direction (..),
|
|
Karel (..),
|
|
-- public interface
|
|
step,
|
|
turnLeft,
|
|
pickBeeper,
|
|
putBeeper,
|
|
frontIsClear,
|
|
beepersPresent,
|
|
facingNorth,
|
|
beepersInBag,
|
|
-- for creating world
|
|
worldWithDimensions,
|
|
setBeepersAt,
|
|
addWallAt,
|
|
removeWallAt,
|
|
-- for creating Karel
|
|
defaultRobot,
|
|
positionOfRobot,
|
|
directionOfRobot,
|
|
beepersOfRobot,
|
|
)
|
|
where
|
|
|
|
import World
|
|
( Direction (..),
|
|
Vector,
|
|
World,
|
|
addWallAt,
|
|
getBeepersAt,
|
|
hasWallAt,
|
|
positionWithinWorld,
|
|
removeWallAt,
|
|
setBeepersAt,
|
|
worldWithDimensions,
|
|
)
|
|
|
|
data Karel = Karel
|
|
{ position :: Vector,
|
|
direction :: Direction,
|
|
beepers :: Int,
|
|
world :: World
|
|
}
|
|
deriving (Show, Eq)
|
|
|
|
defaultRobot :: World -> Karel
|
|
defaultRobot itsWorld =
|
|
Karel
|
|
{ position = (1, 1),
|
|
direction = East,
|
|
beepers = 0,
|
|
world = itsWorld
|
|
}
|
|
|
|
positionOfRobot :: Vector -> Karel -> Karel
|
|
positionOfRobot robot_position robot
|
|
| not $ positionWithinWorld (world robot) robot_position = error "Invalid position"
|
|
| otherwise =
|
|
robot
|
|
{ position = robot_position
|
|
}
|
|
|
|
directionOfRobot :: Direction -> Karel -> Karel
|
|
directionOfRobot robot_direction robot =
|
|
robot
|
|
{ direction = robot_direction
|
|
}
|
|
|
|
beepersOfRobot :: Int -> Karel -> Karel
|
|
beepersOfRobot robot_beepers robot
|
|
| robot_beepers < 0 = error "Invalid count of beepers"
|
|
| otherwise =
|
|
robot
|
|
{ beepers = robot_beepers
|
|
}
|
|
|
|
stepVector :: Direction -> Vector
|
|
stepVector = \case
|
|
North -> (0, 1)
|
|
East -> (1, 0)
|
|
South -> (0, -1)
|
|
West -> (-1, 0)
|
|
|
|
leftTurn :: Direction -> Direction
|
|
leftTurn = \case
|
|
North -> West
|
|
West -> South
|
|
South -> East
|
|
East -> North
|
|
|
|
step :: Karel -> Karel
|
|
step robot
|
|
| hasWallAt position' direction' (world robot) = error "Cannot pass through the wall"
|
|
| otherwise =
|
|
robot
|
|
{ position = (x + dx, y + dy)
|
|
}
|
|
where
|
|
position' = position robot
|
|
direction' = direction robot
|
|
(x, y) = position'
|
|
(dx, dy) = stepVector direction'
|
|
|
|
turnLeft :: Karel -> Karel
|
|
turnLeft robot =
|
|
robot
|
|
{ direction = leftTurn $ direction robot
|
|
}
|
|
|
|
pickBeeper :: Karel -> Karel
|
|
pickBeeper robot
|
|
| beepersAtPosition <= 0 = error "There are no beepers to pick up"
|
|
| otherwise =
|
|
robot
|
|
{ beepers = beepers robot + 1,
|
|
world = setBeepersAt (position robot) (beepersAtPosition - 1) (world robot)
|
|
}
|
|
where
|
|
beepersAtPosition = getBeepersAt (position robot) (world robot)
|
|
|
|
putBeeper :: Karel -> Karel
|
|
putBeeper robot
|
|
| beepers robot <= 0 = error "There are no beepers to put down"
|
|
| otherwise =
|
|
robot
|
|
{ beepers = beepers robot - 1,
|
|
world = setBeepersAt (position robot) (beepersAtPosition + 1) (world robot)
|
|
}
|
|
where
|
|
beepersAtPosition = getBeepersAt (position robot) (world robot)
|
|
|
|
frontIsClear :: Karel -> Bool
|
|
frontIsClear robot = not $ hasWallAt (position robot) (direction robot) (world robot)
|
|
|
|
beepersPresent :: Karel -> Bool
|
|
beepersPresent robot = (> 0) $ getBeepersAt (position robot) (world robot)
|
|
|
|
facingNorth :: Karel -> Bool
|
|
facingNorth = (== North) . direction
|
|
|
|
beepersInBag :: Karel -> Bool
|
|
beepersInBag = (> 0) . beepers
|