-- This file:
--   http://angg.twu.net/HASKELL/twod-1.hs.html
--   http://angg.twu.net/HASKELL/twod-1.hs
--           (find-angg "HASKELL/twod-1.hs")
-- Author: Eduardo Ochs <eduardoochs@gmail.com>
--
-- (defun e () (interactive) (find-angg "HASKELL/twod-1.hs"))
--
-- (find-books "__comp/__comp.el" "haskell-hutton")
-- (find-huttonbookpage 119 "8.3    Newtype declarations")
-- (find-huttonbooktext 119 "8.3    Newtype declarations")
-- newtype TwoD = TD (Int, Int, [String])

import Data.Char

newtype TwoD = TD [String]

tdwd :: TwoD -> Int
tdwd (TD (line:lines)) = length line
tdwd (TD []) = 0

tdht :: TwoD -> Int
tdht (TD lines) = length lines

tdtos :: TwoD -> String
tdtos (TD []) = ""
tdtos (TD (line:lines)) = line ++ "\n" ++ tdtos (TD lines)

-- putStr:
-- file:///usr/share/doc/ghc-doc/html/libraries/base-4.11.1.0/Prelude.html#g:27
-- https://hackage.haskell.org/package/base-4.14.1.0/docs/Prelude.html#g:27
--
tdpr :: TwoD -> IO ()
tdpr td = putStr (tdtos td)

-- repeat and take:
-- file:///usr/share/doc/ghc-doc/html/libraries/base-4.11.1.0/Prelude.html#g:17
-- https://hackage.haskell.org/package/base-4.14.1.0/docs/Prelude.html#g:17
--
repeatn :: Int -> a -> [a]
repeatn n o = take n (repeat o)

tdrect :: Int -> Int -> Char -> TwoD
tdrect ht wd c = TD (repeatn ht (repeatn wd c))

{-
* (eepitch-ghci)
* (eepitch-kill)
* (eepitch-ghci)
:load twod-1.hs

tdtos (TD ["one", "two", "three"])
tdpr  (TD ["one", "two", "three"])
tdpr  (tdrect 4 3 'o')

-}


tdabove0 :: TwoD -> TwoD -> TwoD
tdabove0 (TD linesabove) (TD linesbelow) = TD (linesabove ++ linesbelow)

tdleftof0 :: TwoD -> TwoD -> TwoD
tdleftof0 (TD linesleft) (TD linesright) = TD (map (\ (a,b) -> a ++ b) (zip linesleft linesright))

{-
* (eepitch-ghci)
* (eepitch-kill)
* (eepitch-ghci)
:load twod-1.hs
tdpr ((tdrect 2 5 'a') `tdabove0`  (tdrect 3 5 'b'))
tdpr ((tdrect 5 2 'a') `tdleftof0` (tdrect 4 3 'b'))

-}

-- (find-es "haskell" "where")
--
tdabove_l :: TwoD -> TwoD -> TwoD
tdabove_l tda tdb = (tda `tdleftof0` tdasp) `tdabove0` (tdb `tdleftof0` tdbsp)
  where wd = max (tdwd tda) (tdwd tdb)
        tdasp = tdrect (tdht tda) (wd - tdwd tda) ' '
        tdbsp = tdrect (tdht tdb) (wd - tdwd tdb) ' '
  
tdabove_r :: TwoD -> TwoD -> TwoD
tdabove_r tda tdb = (tdasp `tdleftof0` tda) `tdabove0` (tdbsp `tdleftof0` tdb)
  where wd = max (tdwd tda) (tdwd tdb)
        tdasp = tdrect (tdht tda) (wd - tdwd tda) ' '
        tdbsp = tdrect (tdht tdb) (wd - tdwd tdb) ' '

{-
* (eepitch-ghci)
* (eepitch-kill)
* (eepitch-ghci)
:load twod-1.hs
tdpr ((tdrect 2 5 'a') `tdabove_l` (tdrect 3 4 'b'))
tdpr ((tdrect 2 5 'a') `tdabove_r` (tdrect 3 4 'b'))

-}

tdleftof_a :: TwoD -> TwoD -> TwoD
tdleftof_a tdl tdr = (tdl `tdabove0` tdlsp) `tdleftof0` (tdr `tdabove0` tdrsp)
  where ht = max (tdht tdl) (tdht tdr)
        tdlsp = tdrect (ht - tdht tdl) (tdwd tdl) ' '
        tdrsp = tdrect (ht - tdht tdr) (tdwd tdr) ' '
  
tdleftof_b :: TwoD -> TwoD -> TwoD
tdleftof_b tdl tdr = (tdlsp `tdabove0` tdl) `tdleftof0` (tdrsp `tdabove0` tdr)
  where ht = max (tdht tdl) (tdht tdr)
        tdlsp = tdrect (ht - tdht tdl) (tdwd tdl) ' '
        tdrsp = tdrect (ht - tdht tdr) (tdwd tdr) ' '
  
{-
* (eepitch-ghci)
* (eepitch-kill)
* (eepitch-ghci)
:load twod-1.hs
tdpr ((tdrect 2 5 'a') `tdleftof_a` (tdrect 3 4 'b'))
tdpr ((tdrect 2 5 'a') `tdleftof_b` (tdrect 3 4 'b'))

-}

tdabovewithbar :: TwoD -> TwoD -> Char -> String -> TwoD
tdabovewithbar tda tdb c label = tda `tdabove_l` (tdbar `tdabove_l` tdb)
  where wd = max (tdwd tda) (tdwd tdb)
        bar = (repeatn wd c) ++ label
        tdbar = TD [bar]


ttt :: String -> TwoD
ttt (ht:wd:c:"") = tdrect (ord ht - 48) (ord wd - 48) c
ttt (ht:wd:"")   = TD [] 
ttt (ht:"")      = TD [] 
ttt ("")         = TD [] 

tddnleftof :: TwoD -> TwoD -> TwoD
tddnleftof tdl tdr = (tdl `tdleftof_b` (TD ["  "])) `tdleftof_b` tdr

tddnconcat :: [TwoD] -> TwoD
tddnconcat tds = foldr tddnleftof (TD []) tds

{-
* (eepitch-ghci)
* (eepitch-kill)
* (eepitch-ghci)
:load twod-1.hs
tdpr (ttt "34a")
tdpr (tddnconcat [ttt "34a", ttt "25b", ttt "16c"])
tdpr (tdabovewithbar (tddnconcat [ttt "34a", ttt "25b", ttt "16c"]) (ttt "16d") '-' "foo")

tdpr (tddnleftof (ttt "25a") (ttt "34b"))


tdpr (tdabovewithbar (tdrect 2 5 'a') `tdleftof_a` (tdrect 3 4 'b'))

-}





-- (find-huttonbookpage 70 "5.3     The zip function")
-- (find-huttonbooktext 70 "5.3     The zip function")
tdmaxht :: [TwoD] -> Int
tdmaxht tds = foldr max 0 (map tdht tds)

tdaddlinesbelow :: TwoD -> Int -> Char -> TwoD
tdaddlinesbelow td n c = td `tdabove0` (tdrect n (tdwd td) c)




-- tdhconcat :: [TwoD] -> Twod





                                          
-- tdextendbelow :: Int -> TwoD -> TwoD
-- tdextendbelow newht (TD lines) = (TD lines) `tdabove` ++ emptylines)

--  where td = TD lines
--        wd = tdwd td
--        ht = tdht ht
--        newlines = 
--
--    oldht = length lines
--        n = newht - oldht
--        emptylines = tdrect