module ViewTypes where

import List (intersperse)
import FranTk

----------------------------------------------------------------------------------------------------------------
-- tree views

type TreeView =  Listener TreeTag -> Listener TreeTag -> Int -> [Structured]

indent :: Int -> TreeView -> TreeView
indent n f lst lst' m = [SText (replicate n ' ')] ++ f lst lst' (n+m)

noindent n f lst lst' m = f lst lst' (n+m)

stack :: [TreeView] -> TreeView
stack (f:fs) = flat (f : map doindent fs)

doindent :: TreeView -> TreeView
doindent f lst lst' m = [SText ("\n" ++ replicate m ' ')] ++ f lst lst' m

along :: [TreeView] -> TreeView
along fs lst lst' m = if m == 0 then flat fs lst lst' 0 else [SText (replicate m ' ')] ++ flat fs lst lst' m

flat :: [TreeView] -> TreeView
flat fs lst lst' m = concat [f lst lst' m | f <- fs]

crown :: String -> TreeTag -> TreeView
crown  x lbl lst lst' n 
   = [STextTagged [SText x] 
                  (mousePress 3 (tellL lst' lbl) (mousePress 1 (tellL lst lbl) $ mkEditTag [foregroundB blue]))]

stext :: String -> TreeView
stext x lst lst' n = [ SText x]


initmap f [x] = [x]
initmap f (x:xs) = f x : initmap f xs

----------------------------------------------------------------------------------------------------------------
-- tree tags

type TreeTag = String
type Loc = [Int]

tagOfLoc :: Loc -> TreeTag
tagOfLoc l = x
             where x = ( ('p':) . concat . intersperse "p" . map show) l


locOfTag :: TreeTag -> Loc
locOfTag = map read . numbers 
           where numbers [] = []
                 numbers [a]  = []
                 numbers y = y0 : numbers y1
                             where (y0,y1) = span (/='p') (tail y)
