-- | Directions in an array.
module Music.Theory.Array.Direction where

import Data.List {- base -}
import Data.Maybe {- base -}

import qualified Music.Theory.Array.Cell_Ref as T {- hmt -}
import qualified Music.Theory.List as T {- hmt -}

-- * LOC / VEC

-- | (column,row)
type LOC n = (n,n)

-- | (Δcolumn,Δrow), rows /descend/, ie. down is positive, up is negative.
type VEC n = (n,n)

vector_add :: Num n => VEC n -> VEC n -> VEC n
vector_add :: forall n. Num n => VEC n -> VEC n -> VEC n
vector_add (n
c1,n
r1) (n
c2,n
r2) = (n
c1 forall a. Num a => a -> a -> a
+ n
c2,n
r1 forall a. Num a => a -> a -> a
+ n
r2)

vector_sub :: Num n => VEC n -> VEC n -> VEC n
vector_sub :: forall n. Num n => VEC n -> VEC n -> VEC n
vector_sub (n
c1,n
r1) (n
c2,n
r2) = (n
c1 forall a. Num a => a -> a -> a
- n
c2,n
r1 forall a. Num a => a -> a -> a
- n
r2)

vector_sum :: Num n => [VEC n] -> VEC n
vector_sum :: forall n. Num n => [VEC n] -> VEC n
vector_sum = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall n. Num n => VEC n -> VEC n -> VEC n
vector_add

apply_vec :: Num n => LOC n -> VEC n -> LOC n
apply_vec :: forall n. Num n => VEC n -> VEC n -> VEC n
apply_vec (n
c,n
r) (n
dc,n
dr) = (n
c forall a. Num a => a -> a -> a
+ n
dc,n
r forall a. Num a => a -> a -> a
+ n
dr)

-- | Segment 'VEC' into a sequence of unit steps.
--
-- > let r = [[(0,0)],[(0,1)],[(0,1),(-1,0)],[(0,1),(0,1),(0,1),(-1,0),(-1,0)]]
-- > in map segment_vec [(0,0),(0,1),(-1,1),(-2,3)] == r
segment_vec :: Integral n => VEC n -> [VEC n]
segment_vec :: forall n. Integral n => VEC n -> [VEC n]
segment_vec VEC n
v =
    case VEC n
v of
      (n
0,n
0) -> [VEC n
v]
      (n
c,n
r) -> forall i a. Integral i => i -> a -> [a]
genericReplicate (forall a. Num a => a -> a
abs n
r) (n
0,forall a. Num a => a -> a
signum n
r) forall a. [a] -> [a] -> [a]
++ forall i a. Integral i => i -> a -> [a]
genericReplicate (forall a. Num a => a -> a
abs n
c) (forall a. Num a => a -> a
signum n
c,n
0)

derive_vec :: Num n => LOC n -> LOC n -> VEC n
derive_vec :: forall n. Num n => VEC n -> VEC n -> VEC n
derive_vec (n
c1,n
r1) (n
c2,n
r2) = (n
c2 forall a. Num a => a -> a -> a
- n
c1,n
r2 forall a. Num a => a -> a -> a
- n
r1)

unfold_path :: Num n => LOC n -> [VEC n] -> [LOC n]
unfold_path :: forall n. Num n => LOC n -> [LOC n] -> [LOC n]
unfold_path = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall n. Num n => VEC n -> VEC n -> VEC n
apply_vec

-- * DIRECTION (non-diagonal)

type DIRECTION_S = String

-- | Directions are D=down, L=left, R=right, U=up.
is_direction :: String -> Bool
is_direction :: String -> Bool
is_direction = (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"DLRU.") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head

type DIRECTION_C = Char

-- | Reads either S|D W|L E|R N|U, reverse lookup gives SWEN. A period
-- indicates (0,0). S=south, W=west, E=east, N=north.
direction_char_to_vector_tbl :: Num n => [(DIRECTION_C,VEC n)]
direction_char_to_vector_tbl :: forall n. Num n => [(Char, VEC n)]
direction_char_to_vector_tbl =
    [(Char
'.',(n
0,n
0))
    ,(Char
'S',(n
0,n
1)),(Char
'W',(-n
1,n
0)),(Char
'E',(n
1,n
0)),(Char
'N',(n
0,-n
1))
    ,(Char
'D',(n
0,n
1)),(Char
'L',(-n
1,n
0)),(Char
'R',(n
1,n
0)),(Char
'U',(n
0,-n
1))]

-- > map direction_char_to_vector "LU"
direction_char_to_vector :: Num n => DIRECTION_C -> VEC n
direction_char_to_vector :: forall n. Num n => Char -> VEC n
direction_char_to_vector Char
d = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"dir?") forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Char
d forall n. Num n => [(Char, VEC n)]
direction_char_to_vector_tbl

-- > let r = [(0,-1),(0,1),(-1,0),(1,0),(-1,-1),(1,1),(-2,0),(-1,-1)]
-- > in map direction_to_vector (words "U D L R UL DR LL LU") == r
direction_to_vector :: Num n => [DIRECTION_C] -> VEC n
direction_to_vector :: forall n. Num n => String -> VEC n
direction_to_vector = forall n. Num n => [VEC n] -> VEC n
vector_sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall n. Num n => Char -> VEC n
direction_char_to_vector

vector_to_direction_char :: (Eq n, Num n) => VEC n -> DIRECTION_C
vector_to_direction_char :: forall n. (Eq n, Num n) => VEC n -> Char
vector_to_direction_char VEC n
v =
    let r :: Maybe Char
r = forall v k. Eq v => v -> [(k, v)] -> Maybe k
T.reverse_lookup VEC n
v forall n. Num n => [(Char, VEC n)]
direction_char_to_vector_tbl
    in forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"vec->dir?") Maybe Char
r

-- | Direction sequence to cell references.
dir_seq_to_cell_seq :: (String,[String]) -> [String]
dir_seq_to_cell_seq :: (String, [String]) -> [String]
dir_seq_to_cell_seq (String
l,[String]
v) =
    let p :: [VEC Int]
p = forall a b. (a -> b) -> [a] -> [b]
map forall n. Num n => String -> VEC n
direction_to_vector [String]
v
        c :: VEC Int
c = String -> VEC Int
T.parse_cell_index String
l
    in forall a b. (a -> b) -> [a] -> [b]
map (Cell_Ref -> String
T.cell_ref_pp forall b c a. (b -> c) -> (a -> b) -> a -> c
. VEC Int -> Cell_Ref
T.index_to_cell) (forall n. Num n => LOC n -> [LOC n] -> [LOC n]
unfold_path VEC Int
c [VEC Int]
p)