{-# LANGUAGE CPP #-}
module Placers(linearP, verticalP, horizontalP, horizontalP', verticalP') where
import Geometry
import LayoutDir
import LayoutRequest
import Spacers(Distance(..))
import Data.List(mapAccumL)
import Utils(part)
import Defaults(defaultSep)
import Maptrace(ctrace) -- debugging
--import NonStdTrace(trace)
import IntMemo

#ifndef __HBC__
#define fromInt fromIntegral
#endif
 
horizontalP :: Placer
horizontalP = Distance -> Placer
horizontalP' forall a. Num a => a
defaultSep
verticalP :: Placer
verticalP = Distance -> Placer
verticalP' forall a. Num a => a
defaultSep

horizontalP' :: Distance -> Placer
horizontalP' = LayoutDir -> Distance -> Placer
linearP LayoutDir
Horizontal
verticalP' :: Distance -> Placer
verticalP' = LayoutDir -> Distance -> Placer
linearP LayoutDir
Vertical

linearP :: LayoutDir -> Distance -> Placer
linearP :: LayoutDir -> Distance -> Placer
linearP LayoutDir
ld Distance
sep = Placer1 -> Placer
P forall a b. (a -> b) -> a -> b
$ LayoutDir -> Distance -> Placer1
linearP' LayoutDir
ld Distance
sep

linearP' :: LayoutDir -> Distance -> Placer1
linearP' LayoutDir
ld Distance
sep [] = forall {a1} {a2}. Show a1 => [Char] -> a1 -> a2 -> a2
ctrace [Char]
"linearP" ([Char]
"linearP "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show LayoutDir
ldforall a. [a] -> [a] -> [a]
++[Char]
" []") forall a b. (a -> b) -> a -> b
$
		    (Size -> Bool -> Bool -> LayoutRequest
plainLayout Size
1 (LayoutDir
ldforall a. Eq a => a -> a -> Bool
==LayoutDir
Horizontal) (LayoutDir
ldforall a. Eq a => a -> a -> Bool
==LayoutDir
Vertical),\ Rect
r -> [])
linearP' LayoutDir
ld Distance
sep [LayoutRequest]
requests =
    let minsizes :: [Size]
minsizes = forall a b. (a -> b) -> [a] -> [b]
map LayoutRequest -> Size
minsize [LayoutRequest]
requests
        totis :: Distance
totis = Distance
sep forall a. Num a => a -> a -> a
* (forall a. Ord a => a -> a -> a
max Distance
0 (forall (t :: * -> *) a. Foldable t => t a -> Distance
length [LayoutRequest]
requests forall a. Num a => a -> a -> a
- Distance
1))
        h :: Distance
h = forall a. Ord a => a -> a -> a
max Distance
0 (Distance
h'forall a. Num a => a -> a -> a
-Distance
sep)   -- totis + sum (map (xc ld) minsizes)
	(Distance
h',[[Size]]
rpss) = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Distance -> LayoutRequest -> (Distance, [Size])
adjust Distance
0 [LayoutRequest]
requests
	  where adjust :: Distance -> LayoutRequest -> (Distance, [Size])
adjust Distance
x (Layout {minsize :: LayoutRequest -> Size
minsize=Size
rsz,refpoints :: LayoutRequest -> [Size]
refpoints=[Size]
rps}) =
		    (Distance
xforall a. Num a => a -> a -> a
+Distance
rwforall a. Num a => a -> a -> a
+Distance
sep,forall a b. (a -> b) -> [a] -> [b]
map Size -> Size
adj1 [Size]
rps)
		  where adj1 :: Size -> Size
adj1 Size
p = LayoutDir -> Distance -> Distance -> Size
mkp LayoutDir
ld (Distance
xforall a. Num a => a -> a -> a
+LayoutDir -> Size -> Distance
xc LayoutDir
ld Size
p) (LayoutDir -> Size -> Distance
yc LayoutDir
ld Size
p)
		        rw :: Distance
rw = LayoutDir -> Size -> Distance
xc LayoutDir
ld Size
rsz
        v :: Distance
v = (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Distance
0forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (LayoutDir -> Size -> Distance
yc LayoutDir
ld)) [Size]
minsizes
        line2 :: Rect -> [Rect]
line2 Rect
gotr =
            let goth :: Double
goth = (fromInt . xc ld . rectsize) gotr - fromInt totis
                gotv :: Distance
gotv = (LayoutDir -> Size -> Distance
yc LayoutDir
ld forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rect -> Size
rectsize) Rect
gotr
                startx :: Double
startx = (fromInt . xc ld . rectpos) gotr
                starty :: Distance
starty = (LayoutDir -> Size -> Distance
yc LayoutDir
ld forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rect -> Size
rectpos) Rect
gotr
#if 0
-- Old solution
		requests' = requests
#else
-- New, experimental solution:
		requests' :: [LayoutRequest]
requests' = forall a b. (a -> b) -> [a] -> [b]
map LayoutRequest -> LayoutRequest
req' [LayoutRequest]
requests
		  where
		    req' :: LayoutRequest -> LayoutRequest
req' LayoutRequest
req = LayoutRequest
req {minsize :: Size
minsize=Distance -> Size
adj Distance
gotv}
		      where adj :: Distance -> Size
adj=forall {p}. LayoutDir -> p -> p -> p
orthogonal LayoutDir
ld (LayoutRequest -> Distance -> Size
wAdj LayoutRequest
req) (LayoutRequest -> Distance -> Size
hAdj LayoutRequest
req)
#endif
                ([LayoutRequest]
fih, [LayoutRequest]
flh) = forall {a}. (a -> Bool) -> [a] -> ([a], [a])
part (LayoutDir -> LayoutRequest -> Bool
fixh LayoutDir
ld) [LayoutRequest]
requests'
                fixedh' :: Double
fixedh' =
		  (fromInt . sum . map (xc ld . minsize)) fih
                floath :: Double
floath = (fromInt . sum . map (xc ld . minsize)) flh
                fixedR :: Double
fixedR = if Double
floath forall a. Ord a => a -> a -> Bool
> Double
0.0 then Double
1.0 else Double
goth forall a. Fractional a => a -> a -> a
/ Double
fixedh'
                floatR :: Double
floatR =
                    if Double
floath forall a. Eq a => a -> a -> Bool
== Double
0.0 then Double
1.0 else (Double
goth forall a. Num a => a -> a -> a
- Double
fixedh') forall a. Fractional a => a -> a -> a
/ Double
floath
                rR' :: LayoutRequest -> Double
rR' LayoutRequest
req = if LayoutDir -> LayoutRequest -> Bool
fixh LayoutDir
ld LayoutRequest
req then Double
fixedR else Double
floatR
                pl :: Double -> LayoutRequest -> (Double, Rect)
pl Double
x LayoutRequest
req =
                    let width :: Double
width = (fromInt . xc ld . minsize) req * rR' req
                    in  (Double
x forall a. Num a => a -> a -> a
+ Double
width forall a. Num a => a -> a -> a
+ fromInt sep,
                         Size -> Size -> Rect
Rect (LayoutDir -> Distance -> Distance -> Size
mkp LayoutDir
ld (forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
x) Distance
starty)
                              (LayoutDir -> Distance -> Distance -> Size
mkp LayoutDir
ld (forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
width) Distance
gotv))
            in  forall a b. (a, b) -> b
snd (forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Double -> LayoutRequest -> (Double, Rect)
pl Double
startx [LayoutRequest]
requests')
	(Bool
fh',Bool
fv') = forall {b}. LayoutDir -> (b, b) -> (b, b)
vswap LayoutDir
ld (forall {b} {t}.
([b] -> t) -> (LayoutDir -> LayoutRequest -> b) -> t
allf forall (t :: * -> *). Foldable t => t Bool -> Bool
and LayoutDir -> LayoutRequest -> Bool
fixh,forall {b} {t}.
([b] -> t) -> (LayoutDir -> LayoutRequest -> b) -> t
allf forall (t :: * -> *). Foldable t => t Bool -> Bool
or LayoutDir -> LayoutRequest -> Bool
fixv)
	rps' :: [Size]
rps' = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Size]]
rpss --concatMap refpoints requests
	allf :: ([b] -> t) -> (LayoutDir -> LayoutRequest -> b) -> t
allf [b] -> t
conn LayoutDir -> LayoutRequest -> b
fix = [b] -> t
conn (forall a b. (a -> b) -> [a] -> [b]
map (LayoutDir -> LayoutRequest -> b
fix LayoutDir
ld) [LayoutRequest]
requests)
	req0 :: LayoutRequest
req0 = Size -> Bool -> Bool -> [Size] -> LayoutRequest
refpLayout (LayoutDir -> Distance -> Distance -> Size
mkp LayoutDir
ld Distance
h Distance
v) Bool
fh' Bool
fv' [Size]
rps'
	req :: LayoutRequest
req =
	  case LayoutDir
ld of
	    LayoutDir
Horizontal -> LayoutRequest
req0 { hAdj :: Distance -> Size
hAdj=forall a. (Distance -> a) -> Distance -> a
memoInt Distance -> Size
ha } 
	      where ha :: Distance -> Size
ha Distance
h = Distance -> Distance -> Size
Point (Distance
totisforall a. Num a => a -> a -> a
+forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Distance]
ws) Distance
h
		      where ws :: [Distance]
ws = forall a b. (a -> b) -> [a] -> [b]
map (Size -> Distance
xcoord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip LayoutRequest -> Distance -> Size
hAdj Distance
h) [LayoutRequest]
requests
	    LayoutDir
Vertical -> LayoutRequest
req0 { wAdj :: Distance -> Size
wAdj=forall a. (Distance -> a) -> Distance -> a
memoInt Distance -> Size
wa } 
	      where wa :: Distance -> Size
wa Distance
w = Distance -> Distance -> Size
Point Distance
w (Distance
totisforall a. Num a => a -> a -> a
+forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Distance]
hs)
		      where hs :: [Distance]
hs = forall a b. (a -> b) -> [a] -> [b]
map (Size -> Distance
ycoord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip LayoutRequest -> Distance -> Size
wAdj Distance
w) [LayoutRequest]
requests
    in (LayoutRequest
req,Rect -> [Rect]
line2)

#ifdef __NHC__
fromInt = fromIntegral
#endif