{-# LANGUAGE LambdaCase #-}

module Internal.Karel where

import Text.Printf

import Internal.Types
import Internal.World

data Karel = Karel
  { karelPosition :: Vector,
    karelDirection :: Direction,
    karelBeepers :: Int,
    karelWorld :: World
  }
  deriving (Eq)

getHeader :: Karel -> String
getHeader karel = unlines [
    printf " %8s   %s  %s  %s" "POSITION" "FACING" "BEEP-BAG" "BEEP-POS",
    printf "(%3d, %3d)  %6s  %8d  %8d" x y dir bag pos,
    " Y +" <> replicate (4 * width - 1) '-' <> "+"
  ]
  where
    (x, y) = karelPosition karel
    dir = show $ karelDirection karel
    bag = karelBeepers karel
    pos = getBeepersAt (x, y) $ karelWorld karel
    (width, _) = worldDimensions $ karelWorld karel

getFooter :: Karel -> String
getFooter karel = unlines [
    "   +" <> replicate (4 * width - 1) '-' <> "+",
    "    " <> foldl1 (<>) [ printf " %-2d " column | column <- [1..width] ] <> " X"
  ]
  where
    (width, _) = worldDimensions $ karelWorld karel

mapDirection :: Karel -> String
mapDirection karel = case karelDirection karel of
  North -> " ^ "
  East -> " > "
  South -> " v "
  West -> " < "

mapCell :: Karel -> Int -> Int -> String
mapCell karel x y
  | karelPosition karel == (x, y) = mapDirection karel
  | beepersAt > 0 = printf " %-2d" beepersAt
  | otherwise = " . "
  where beepersAt = getBeepersAt (x, y) $ karelWorld karel

mapWall :: Karel -> Int -> Int -> String
mapWall karel x y = leftPart <> rightPart
  where
    world = karelWorld karel
    (width, height) = worldDimensions world
    wallAtNorth = hasWallAt (x, y) North world
    vWallAbove = hasWallAt (x, y + 1) East world
    vWallBelow = hasWallAt (x, y - 1) East world
    vWallAt = hasWallAt (x, y) East world
    verticalWall = vWallAt && vWallAbove
    wallEnds = wallAtNorth && (not $ hasWallAt (x + 1, y) North world)
    wallStarts = wallAtNorth && x > 1 && (not $ hasWallAt (x - 1, y) North world)
    noVWall = not (hasWallAt (x, y) West world || hasWallAt (x, y + 1) West world)
    leftPart
      | wallStarts && noVWall = "+-"
      | wallAtNorth = "--"
      | otherwise = "  "
    rightPart
      | wallAtNorth && wallEnds && verticalWall = "-|"
      | wallEnds = "-+"
      | wallAtNorth && (vWallAbove) = "-+"
      | wallAtNorth = "--"
      | verticalWall && hasWallAt (x+1, y) North world = " +"
      | verticalWall = " |"
      | not vWallAbove && vWallAt = " +"
      | not vWallAt && vWallAbove = " +"
      | otherwise = "  "

getRow :: Karel -> Int -> String
getRow karel row
  | row == height = line
  | otherwise = horizontalWalls <> "\n" <> line
  where
    world = karelWorld karel
    (width, height) = worldDimensions world
    horizontalWalls = "   |" <> foldl1 (<>) [
      mapWall karel column row
      | column <- [1..width]
      ]
    line = (printf "%2d |" row) <> foldl1 (<>) [
      position <> wall
      | column <- [1..width],
      let wall = if hasWallAt (column, row) East world then "|" else " ",
      let position = mapCell karel column row
      ]

getMap :: Karel -> String
getMap karel = unlines [
  getRow karel row
  | row <- reverse [1..height]
  ]
  where (_, height) = worldDimensions $ karelWorld karel

instance Show Karel where
  show karel = getHeader karel <> getMap karel <> getFooter karel

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

changeBeepers :: Int -> Karel -> Karel
changeBeepers db robot
  | checkedCount <= 0 = error ("There are no beepers to " ++ msg)
  | otherwise =
    robot
      { karelBeepers = inBag + db,
        karelWorld = setBeepersAt position (atPosition - db) world
      }
  where
    (position, world) = (karelPosition robot, karelWorld robot)
    inBag = karelBeepers robot
    atPosition = getBeepersAt position world
    (checkedCount, msg) =
      if db == 1 then (atPosition, "pick up") else (inBag, "put down")

defaultKarel :: World -> Karel
defaultKarel world =
  Karel
    { karelPosition = (1, 1),
      karelDirection = East,
      karelBeepers = 0,
      karelWorld = world
    }

initialPosition :: Vector -> Karel -> Karel
initialPosition pos robot
  | not $ positionWithinWorld (karelWorld robot) pos = error "Invalid position"
  | otherwise =
    robot
      { karelPosition = pos
      }

initialDirection :: Direction -> Karel -> Karel
initialDirection dir robot =
  robot
    { karelDirection = dir
    }

initialBeepersInBag :: Int -> Karel -> Karel
initialBeepersInBag beepers robot
  | beepers < 0 = error "Invalid count of beepers"
  | otherwise =
    robot
      { karelBeepers = beepers
      }