module Tak.ShowPTN (ptn) where

import Data.Matrix

import Tak.Types

ptn :: Board -> Play -> String
ptn _ (Place stone loc) = (stoneCode stone) ++ (strLoc loc)
ptn board (Move loc dir drops) = carry ++ (strLoc loc) ++ (dirCode dir)
        ++ (dropCode drops) ++ stoneCode (fst $ head $ board ! loc) where
    carry
        | total > 1 = show total
        | otherwise = ""
    total = sum drops
    dirCode PosX = ">"
    dirCode NegX = "<"
    dirCode PosY = "+"
    dirCode NegY = "-"
    dropCode (_ : []) = ""
    dropCode ds = concatMap show ds

strLoc :: (Int, Int) -> String
strLoc (x, y) = file x ++ rank y

file :: Int -> String
file i = ["abcdefghijklmnopqrstuvwxyz" !! (i - 1)]

rank :: Int -> String
rank i = show i

stoneCode :: Stone -> String
stoneCode Flat = ""
stoneCode Standing = "S"
stoneCode Cap = "C"