{-# 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' Distance
forall a. Num a => a
defaultSep
verticalP :: Placer
verticalP = Distance -> Placer
verticalP' Distance
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 (Placer1 -> Placer) -> Placer1 -> Placer
forall a b. (a -> b) -> a -> b
$ LayoutDir -> Distance -> Placer1
linearP' LayoutDir
ld Distance
sep

linearP' :: LayoutDir -> Distance -> Placer1
linearP' LayoutDir
ld Distance
sep [] = [Char]
-> [Char]
-> (LayoutRequest, Rect -> [Rect])
-> (LayoutRequest, Rect -> [Rect])
forall a1 a2. Show a1 => [Char] -> a1 -> a2 -> a2
ctrace [Char]
"linearP" ([Char]
"linearP "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++LayoutDir -> [Char]
forall a. Show a => a -> [Char]
show LayoutDir
ld[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" []") ((LayoutRequest, Rect -> [Rect])
 -> (LayoutRequest, Rect -> [Rect]))
-> (LayoutRequest, Rect -> [Rect])
-> (LayoutRequest, Rect -> [Rect])
forall a b. (a -> b) -> a -> b
$
		    (Size -> Bool -> Bool -> LayoutRequest
plainLayout Size
1 (LayoutDir
ldLayoutDir -> LayoutDir -> Bool
forall a. Eq a => a -> a -> Bool
==LayoutDir
Horizontal) (LayoutDir
ldLayoutDir -> LayoutDir -> Bool
forall a. Eq a => a -> a -> Bool
==LayoutDir
Vertical),\ Rect
r -> [])
linearP' LayoutDir
ld Distance
sep [LayoutRequest]
requests =
    let minsizes :: [Size]
minsizes = (LayoutRequest -> Size) -> [LayoutRequest] -> [Size]
forall a b. (a -> b) -> [a] -> [b]
map LayoutRequest -> Size
minsize [LayoutRequest]
requests
        totis :: Distance
totis = Distance
sep Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
* (Distance -> Distance -> Distance
forall a. Ord a => a -> a -> a
max Distance
0 ([LayoutRequest] -> Distance
forall (t :: * -> *) a. Foldable t => t a -> Distance
length [LayoutRequest]
requests Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
- Distance
1))
        h :: Distance
h = Distance -> Distance -> Distance
forall a. Ord a => a -> a -> a
max Distance
0 (Distance
h'Distance -> Distance -> Distance
forall a. Num a => a -> a -> a
-Distance
sep)   -- totis + sum (map (xc ld) minsizes)
	(Distance
h',[[Size]]
rpss) = (Distance -> LayoutRequest -> (Distance, [Size]))
-> Distance -> [LayoutRequest] -> (Distance, [[Size]])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
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
xDistance -> Distance -> Distance
forall a. Num a => a -> a -> a
+Distance
rwDistance -> Distance -> Distance
forall a. Num a => a -> a -> a
+Distance
sep,(Size -> Size) -> [Size] -> [Size]
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
xDistance -> Distance -> Distance
forall 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 = ([Distance] -> Distance
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Distance] -> Distance)
-> ([Size] -> [Distance]) -> [Size] -> Distance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Distance
0Distance -> [Distance] -> [Distance]
forall a. a -> [a] -> [a]
:) ([Distance] -> [Distance])
-> ([Size] -> [Distance]) -> [Size] -> [Distance]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Size -> Distance) -> [Size] -> [Distance]
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 (Size -> Distance) -> (Rect -> Size) -> Rect -> Distance
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 (Size -> Distance) -> (Rect -> Size) -> Rect -> Distance
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' = (LayoutRequest -> LayoutRequest)
-> [LayoutRequest] -> [LayoutRequest]
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=LayoutDir
-> (Distance -> Size) -> (Distance -> Size) -> Distance -> Size
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) = (LayoutRequest -> Bool)
-> [LayoutRequest] -> ([LayoutRequest], [LayoutRequest])
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 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0.0 then Double
1.0 else Double
goth Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
fixedh'
                floatR :: Double
floatR =
                    if Double
floath Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0.0 then Double
1.0 else (Double
goth Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
fixedh') Double -> Double -> Double
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
width Double -> Double -> Double
forall a. Num a => a -> a -> a
+ fromInt sep,
                         Size -> Size -> Rect
Rect (LayoutDir -> Distance -> Distance -> Size
mkp LayoutDir
ld (Double -> Distance
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
x) Distance
starty)
                              (LayoutDir -> Distance -> Distance -> Size
mkp LayoutDir
ld (Double -> Distance
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
width) Distance
gotv))
            in  (Double, [Rect]) -> [Rect]
forall a b. (a, b) -> b
snd ((Double -> LayoutRequest -> (Double, Rect))
-> Double -> [LayoutRequest] -> (Double, [Rect])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL Double -> LayoutRequest -> (Double, Rect)
pl Double
startx [LayoutRequest]
requests')
	(Bool
fh',Bool
fv') = LayoutDir -> (Bool, Bool) -> (Bool, Bool)
forall b. LayoutDir -> (b, b) -> (b, b)
vswap LayoutDir
ld (([Bool] -> Bool) -> (LayoutDir -> LayoutRequest -> Bool) -> Bool
forall b t. ([b] -> t) -> (LayoutDir -> LayoutRequest -> b) -> t
allf [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and LayoutDir -> LayoutRequest -> Bool
fixh,([Bool] -> Bool) -> (LayoutDir -> LayoutRequest -> Bool) -> Bool
forall b t. ([b] -> t) -> (LayoutDir -> LayoutRequest -> b) -> t
allf [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or LayoutDir -> LayoutRequest -> Bool
fixv)
	rps' :: [Size]
rps' = [[Size]] -> [Size]
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 ((LayoutRequest -> b) -> [LayoutRequest] -> [b]
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=(Distance -> Size) -> Distance -> Size
forall a. (Distance -> a) -> Distance -> a
memoInt Distance -> Size
ha } 
	      where ha :: Distance -> Size
ha Distance
h = Distance -> Distance -> Size
Point (Distance
totisDistance -> Distance -> Distance
forall a. Num a => a -> a -> a
+[Distance] -> Distance
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Distance]
ws) Distance
h
		      where ws :: [Distance]
ws = (LayoutRequest -> Distance) -> [LayoutRequest] -> [Distance]
forall a b. (a -> b) -> [a] -> [b]
map (Size -> Distance
xcoord (Size -> Distance)
-> (LayoutRequest -> Size) -> LayoutRequest -> Distance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LayoutRequest -> Distance -> Size)
-> Distance -> LayoutRequest -> Size
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=(Distance -> Size) -> Distance -> Size
forall a. (Distance -> a) -> Distance -> a
memoInt Distance -> Size
wa } 
	      where wa :: Distance -> Size
wa Distance
w = Distance -> Distance -> Size
Point Distance
w (Distance
totisDistance -> Distance -> Distance
forall a. Num a => a -> a -> a
+[Distance] -> Distance
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Distance]
hs)
		      where hs :: [Distance]
hs = (LayoutRequest -> Distance) -> [LayoutRequest] -> [Distance]
forall a b. (a -> b) -> [a] -> [b]
map (Size -> Distance
ycoord (Size -> Distance)
-> (LayoutRequest -> Size) -> LayoutRequest -> Distance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LayoutRequest -> Distance -> Size)
-> Distance -> LayoutRequest -> Size
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