module ParagraphP where
import LayoutRequest
import Geometry
--import ListUtil(chopList)
import HbcUtils(apFst,chopList)
import Defaults(defaultSep)
import Placers(verticalP')
import Spacers() -- synonym Distance, for hbc
import HorizontalAlignP(horizontalAlignP')
--import Maptrace(ctrace)
import Utils(oo)
import CmdLineEnv(argReadKey)
--import IntMemo

paragraphP :: Placer
paragraphP = Size -> Placer
paragraphP' Size
forall a. Num a => a
defaultSep
paragraphP' :: Size -> Placer
paragraphP' = (Int -> Placer) -> Size -> Placer
paragraphP'' Int -> Placer
horizontalAlignP'

paragraphP'' :: (Int->Placer) -> Size -> Placer
paragraphP'' :: (Int -> Placer) -> Size -> Placer
paragraphP'' Int -> Placer
horizP' (Point Int
hsep Int
vsep) = Placer1 -> Placer
P Placer1
paP
  where
    paP :: Placer1
paP [LayoutRequest]
reqs = ({-ctrace "paraReq" (req, wAdj req $ xcoord $ minsize req)-} LayoutRequest
req,Rect -> [Rect]
paraPlacer2)
      where
	width0 :: Int
width0 = [Char] -> Int -> Int
forall p. (Read p, Show p) => [Char] -> p -> p
argReadKey [Char]
"paragraph-width" Int
600 :: Int
	req :: LayoutRequest
req = (Int -> LayoutRequest
paraReq Int
width0) { wAdj :: Int -> Size
wAdj=LayoutRequest -> Size
minsize (LayoutRequest -> Size) -> (Int -> LayoutRequest) -> Int -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> LayoutRequest
paraReq }
	paraReq :: Int -> LayoutRequest
paraReq Int
width = (LayoutRequest, Rect -> [Rect]) -> LayoutRequest
forall a b. (a, b) -> a
fst (Int -> (LayoutRequest, Rect -> [Rect])
paraP Int
width)
	paraPlacer2 :: Rect -> [Rect]
paraPlacer2 rect :: Rect
rect@(Rect Size
_ (Point Int
w Int
_)) =
	  --ctrace "paraPlacer2" rect $
	  (LayoutRequest, Rect -> [Rect]) -> Rect -> [Rect]
forall a b. (a, b) -> b
snd (Int -> (LayoutRequest, Rect -> [Rect])
paraP Int
w) Rect
rect
	paraP :: Int -> (LayoutRequest, Rect -> [Rect])
paraP = {-memoInt-} Int -> (LayoutRequest, Rect -> [Rect])
paraP' -- memoInt slows down and consumes a lot of heap
	paraP' :: Int -> (LayoutRequest, Rect -> [Rect])
paraP' Int
width = (LayoutRequest
vreq,Rect -> [Rect]
placer2)
	  where
	    (LayoutRequest
vreq,Rect -> [Rect]
vplacer2) = Placer -> Placer1
unP (Int -> Placer
verticalP' Int
vsep) [LayoutRequest]
hreqs
	    placer2 :: Rect -> [Rect]
placer2 = [[Rect]] -> [Rect]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Rect]] -> [Rect]) -> (Rect -> [[Rect]]) -> Rect -> [Rect]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Rect -> [Rect]) -> Rect -> [Rect])
-> [Rect -> [Rect]] -> [Rect] -> [[Rect]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Rect -> [Rect]) -> Rect -> [Rect]
forall a. a -> a
id [Rect -> [Rect]]
hplacers2 ([Rect] -> [[Rect]]) -> (Rect -> [Rect]) -> Rect -> [[Rect]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rect -> [Rect]
vplacer2
	    ([LayoutRequest]
hreqs,[Rect -> [Rect]]
hplacers2) =
	      [(LayoutRequest, Rect -> [Rect])]
-> ([LayoutRequest], [Rect -> [Rect]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(LayoutRequest, Rect -> [Rect])]
 -> ([LayoutRequest], [Rect -> [Rect]]))
-> ([LayoutRequest] -> [(LayoutRequest, Rect -> [Rect])])
-> [LayoutRequest]
-> ([LayoutRequest], [Rect -> [Rect]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Placer1 -> [[LayoutRequest]] -> [(LayoutRequest, Rect -> [Rect])]
forall a b. (a -> b) -> [a] -> [b]
map (Placer -> Placer1
unP (Int -> Placer
horizP' Int
hsep)) ([[LayoutRequest]] -> [(LayoutRequest, Rect -> [Rect])])
-> ([LayoutRequest] -> [[LayoutRequest]])
-> [LayoutRequest]
-> [(LayoutRequest, Rect -> [Rect])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [LayoutRequest] -> [[LayoutRequest]]
breakLines Int
width ([LayoutRequest] -> ([LayoutRequest], [Rect -> [Rect]]))
-> [LayoutRequest] -> ([LayoutRequest], [Rect -> [Rect]])
forall a b. (a -> b) -> a -> b
$ [LayoutRequest]
reqs

	breakLines :: Int -> [LayoutRequest] -> [[LayoutRequest]]
breakLines Int
w [LayoutRequest]
rs = {-ctrace "breakLines" (w,map length rss)-} [[LayoutRequest]]
rss
	    where rss :: [[LayoutRequest]]
rss = Int -> [LayoutRequest] -> [[LayoutRequest]]
breakLines' Int
w [LayoutRequest]
rs

	breakLines' :: Int -> [LayoutRequest] -> [[LayoutRequest]]
breakLines' = ([LayoutRequest] -> ([LayoutRequest], [LayoutRequest]))
-> [LayoutRequest] -> [[LayoutRequest]]
forall a b. ([a] -> (b, [a])) -> [a] -> [b]
chopList (([LayoutRequest] -> ([LayoutRequest], [LayoutRequest]))
 -> [LayoutRequest] -> [[LayoutRequest]])
-> (Int -> [LayoutRequest] -> ([LayoutRequest], [LayoutRequest]))
-> Int
-> [LayoutRequest]
-> [[LayoutRequest]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([LayoutRequest], [LayoutRequest])
-> ([LayoutRequest], [LayoutRequest])
forall a. ([a], [a]) -> ([a], [a])
atLeastOne (([LayoutRequest], [LayoutRequest])
 -> ([LayoutRequest], [LayoutRequest]))
-> (Int -> [LayoutRequest] -> ([LayoutRequest], [LayoutRequest]))
-> Int
-> [LayoutRequest]
-> ([LayoutRequest], [LayoutRequest])
forall t1 t2 t3 t4.
(t1 -> t2) -> (t3 -> t4 -> t1) -> t3 -> t4 -> t2
`oo` Int -> [LayoutRequest] -> ([LayoutRequest], [LayoutRequest])
takeLine)
	takeLine :: Int -> [LayoutRequest] -> ([LayoutRequest], [LayoutRequest])
takeLine Int
wremain [LayoutRequest]
reqs = 
	  case [LayoutRequest]
reqs of
	    [] -> ([],[])
	    LayoutRequest
r:[LayoutRequest]
rs -> --ctrace "takeLine" (wremain,w) $
		    if Int
wremainInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
w
		    then ([],[LayoutRequest]
reqs)
		    else ([LayoutRequest] -> [LayoutRequest])
-> ([LayoutRequest], [LayoutRequest])
-> ([LayoutRequest], [LayoutRequest])
forall t a b. (t -> a) -> (t, b) -> (a, b)
apFst (LayoutRequest
rLayoutRequest -> [LayoutRequest] -> [LayoutRequest]
forall a. a -> [a] -> [a]
:) (Int -> [LayoutRequest] -> ([LayoutRequest], [LayoutRequest])
takeLine (Int
wremainInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
hsep) [LayoutRequest]
rs)
	      where w :: Int
w=Size -> Int
xcoord (LayoutRequest -> Size
minsize LayoutRequest
r)

atLeastOne :: ([a], [a]) -> ([a], [a])
atLeastOne ([],a
x:[a]
xs) = ([a
x],[a]
xs)
atLeastOne ([a], [a])
xsys = ([a], [a])
xsys