-- | ditaa clone in haskell

-- -------------------------------------------------------------------
-- Copyright (C) 2017 by Sascha Wilde <wilde@sha-bang.de>

-- This program is free software under the GNU GPL (>=v2)
-- Read the file COPYING coming with the software for details.
-- -------------------------------------------------------------------

module Dihaa (Glyph(..), Text, Dia, lines2text, text2dia)
where

import TwoD

data Glyph = LineH | LineV
           | CornerNW | CornerNE | CornerSW | CornerSE
           | TeeWNE | TeeWSE | TeeNWS | TeeNES
           | Cross
           | ArrowN | ArrowS | ArrowW | ArrowE
           | Space
           | Verbatim Char
  deriving (Eq, Show)

type Text = TwoD Char
type Dia = TwoD Glyph

toGlyph :: Char -> TwoD Char -> Int -> Int -> Glyph
toGlyph ' ' _ _ _ = Space
toGlyph c t x y
  | c == '─' = LineH
  | c == '│' = LineV
  | c == '┌' = CornerNW
  | c == '┐' = CornerNE
  | c == '└' = CornerSW
  | c == '┘' = CornerSE
  | c == '┴' = TeeWNE
  | c == '┬' = TeeWSE
  | c == '┤' = TeeNWS
  | c == '├' = TeeNES
  | c == '┼' = Cross
  | c == '▲' = ArrowN
  | c == '▼' = ArrowS
  | c == '◀' = ArrowW
  | c == '▶' = ArrowE
  | c == '|'
    && ( nOsIsIn "|+"
         || nIsIn "^"
         || sIsIn "v" ) = LineV
  | c == '-'
    && ( wOeIsIn "-+"
         || wIsIn "<"
         || eIsIn ">" ) = LineH
  | c == '^'
    && sIsIn "|+" = ArrowN
  | c == 'v'
    && nIsIn "|+" = ArrowS
  | c == '<'
    && eIsIn "-+" = ArrowW
  | c == '>'
    && wIsIn "-+" = ArrowE
  | c == '+'
    && nIsIn "|+^" && wIsIn "<-+"
    && sIsIn "|+v" && eIsIn ">-+" = Cross
  | c == '+'
    && nAsIsIn "|+" && wIsIn "-+<" = TeeNWS
  | c == '+'
    && nAsIsIn "|+" && eIsIn "-+>" = TeeNES
  | c == '+'
    && wAeIsIn "-+" && nIsIn "|+^" = TeeWNE
  | c == '+'
    && wAeIsIn "-+" && sIsIn "|+v" = TeeWSE
  | c == '+'
    && eIsIn "-+>" && sIsIn "|+v" = CornerNW
  | c == '+'
    && wIsIn "-+<" && sIsIn "|+v" = CornerNE
  | c == '+'
    && eIsIn "-+>" && nIsIn "|+^" = CornerSW
  | c == '+'
    && wIsIn "-+<" && nIsIn "|+^" = CornerSE
  | otherwise = Verbatim c
  where
    nIsIn = isInAny [getN] x y t
    sIsIn = isInAny [getS] x y t
    wIsIn = isInAny [getW] x y t
    eIsIn = isInAny [getE] x y t
    nOsIsIn = isInAny [getN,getS] x y t
    wOeIsIn = isInAny [getW,getE] x y t
    nAsIsIn = isInAll [getN,getS] x y t
    wAeIsIn = isInAll [getW,getE] x y t

lines2text :: [[Char]] -> Text
lines2text x = fromLists x

text2dia :: Text -> Dia
text2dia = mapTwoDXY toGlyph