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' 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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> LayoutRequest
paraReq }
	paraReq :: Int -> LayoutRequest
paraReq Int
width = 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 $
	  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 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. a -> a
id [Rect -> [Rect]]
hplacers2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rect -> [Rect]
vplacer2
	    ([LayoutRequest]
hreqs,[Rect -> [Rect]]
hplacers2) =
	      forall a b. [(a, b)] -> ([a], [b])
unzip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Placer -> Placer1
unP (Int -> Placer
horizP' Int
hsep)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [LayoutRequest] -> [[LayoutRequest]]
breakLines Int
width 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' = forall a b. ([a] -> (b, [a])) -> [a] -> [b]
chopList forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {a}. ([a], [a]) -> ([a], [a])
atLeastOne 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
wremainforall a. Ord a => a -> a -> Bool
<Int
w
		    then ([],[LayoutRequest]
reqs)
		    else forall {t} {a} {b}. (t -> a) -> (t, b) -> (a, b)
apFst (LayoutRequest
rforall a. a -> [a] -> [a]
:) (Int -> [LayoutRequest] -> ([LayoutRequest], [LayoutRequest])
takeLine (Int
wremainforall a. Num a => a -> a -> a
-Int
wforall 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