{-# LANGUAGE CPP #-}
module AutoPlacer(autoP,autoP') where
import LayoutRequest
import Geometry
import Placers(horizontalP',verticalP')
import Spacers() -- synonym Distance, for hbc
import AlignP(idP)
--import LayoutDir
import CmdLineEnv(argFlag)
import Defaults(defaultSep)
import Data.Ratio
import Debug.Trace(trace)

-- should get hints somehow
autoP :: Placer
autoP = Size -> Placer
autoP' Size
forall a. Num a => a
defaultSep

autoP' :: Size -> Placer
autoP' :: Size -> Placer
autoP' (Point Int
hsep Int
vsep) = Placer1 -> Placer
P (Placer1 -> Placer) -> Placer1 -> Placer
forall a b. (a -> b) -> a -> b
$ \ [LayoutRequest]
requests ->
 case [LayoutRequest]
requests of
   [] -> String -> Placer2 -> Placer2
forall a. String -> a -> a
trace String
"autoP []" (Placer2 -> Placer2) -> Placer2 -> Placer2
forall a b. (a -> b) -> a -> b
$ (Size -> Bool -> Bool -> LayoutRequest
plainLayout Size
1 Bool
True Bool
True, \ Rect
r -> [])
   [LayoutRequest
r] -> Placer -> Placer1
unP Placer
idP [LayoutRequest]
requests
   [LayoutRequest]
_ -> Placer2
p where
        h2 :: Placer2
h2@(LayoutRequest
h,Rect -> [Rect]
_) = Placer -> Placer1
unP (Int -> Placer
horizontalP' Int
hsep) [LayoutRequest]
requests
	v2 :: Placer2
v2@(LayoutRequest
v,Rect -> [Rect]
_) = Placer -> Placer1
unP (Int -> Placer
verticalP' Int
vsep) [LayoutRequest]
requests
	p :: Placer2
p = if Placer2 -> [LayoutRequest] -> (Ratio Int, Int)
goodness Placer2
h2 [LayoutRequest]
requests(Ratio Int, Int) -> (Ratio Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
<Placer2 -> [LayoutRequest] -> (Ratio Int, Int)
goodness Placer2
v2 [LayoutRequest]
requests
            then Placer2
h2 else Placer2
v2

{-
--godness : measure how good a layout is.
-- 1st: a layout is better if it uses less screen space.
-- 2nd: a layout is better if it is more quadratic 
-- (rather than long and narrow)
goodness (Layout {minsize=Point x y}) = (x*y,x+y)
                                 -- (area, circumference of rect / 2)
-- This doesn't work, because of separation between fudgets...
-}

goodness :: Placer2 -> [LayoutRequest] -> (Ratio Int, Int)
goodness =
  if String -> Bool -> Bool
argFlag String
"sg" Bool
False
  then \ Placer2
p1 [LayoutRequest]
rs -> (Int
1Int -> Int -> Ratio Int
forall a. Integral a => a -> a -> Ratio a
%Int
1,LayoutRequest -> Int
simpleGoodness (Placer2 -> LayoutRequest
forall a b. (a, b) -> a
fst Placer2
p1))
  else Placer2 -> [LayoutRequest] -> (Ratio Int, Int)
newGoodness

simpleGoodness :: LayoutRequest -> Int
simpleGoodness (Layout {minsize :: LayoutRequest -> Size
minsize=Point Int
w Int
h}) = Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h

#if 1
-- normal version
newGoodness :: Placer2 -> [LayoutRequest] -> (Ratio Int, Int)
newGoodness (Layout {minsize :: LayoutRequest -> Size
minsize=s :: Size
s@(Point Int
w Int
h)},Rect -> [Rect]
placer2) [LayoutRequest]
reqs =
    (Int
wasted Int -> Int -> Ratio Int
forall a. Integral a => a -> a -> Ratio a
% (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
h),Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h)
  where
    wasted :: Int
wasted = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((LayoutRequest -> Rect -> Int)
-> [LayoutRequest] -> [Rect] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith LayoutRequest -> Rect -> Int
waste [LayoutRequest]
reqs (Rect -> [Rect]
placer2 (Size -> Size -> Rect
Rect Size
origin Size
s)))
    waste :: LayoutRequest -> Rect -> Int
waste (Layout {minsize :: LayoutRequest -> Size
minsize=Point Int
rw Int
rh,fixedh :: LayoutRequest -> Bool
fixedh=Bool
fh,fixedv :: LayoutRequest -> Bool
fixedv=Bool
fv}) (Rect Size
_ (Point Int
aw Int
ah)) =
      case (Bool
fh,Bool
fv) of
        (Bool
True,Bool
True) -> Int
awInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
ahInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
rwInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rh
	(Bool
False,Bool
False) -> Int
0
	(Bool
True,Bool
False) -> (Int
awInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
rw)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
ah
	(Bool
False,Bool
True) -> (Int
ahInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
rh)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
aw
#else
-- Röjemo's debug version
-- needs updating
newGoodness (Layout {minsize=s@(Point w h)},placer2) reqs =
     trace ("w = " ++ show w ++ "\n"
         ++ "h = " ++ show h ++ "\n"
         ++ "wlist = " ++ show wlist ++ "\n"
         ++ "wasted = " ++ show wasted ++ "\n"
         ++ "w*h = " ++ show (w*h) ++ "\n"
         ++ "(wasted % (w*h),w+h) = " ++ show     (wasted % (w*h),w+h) ++ "\n")
    (wasted % (w*h),w+h)
  where
    wlist =  (zipWith waste reqs (placer2 (Rect origin s)))
    wasted = sum wlist
    waste (Layout (Point rw rh) fh fv) (Rect _ (Point aw ah)) =
      case (fh,fv) of
        (True,True) ->    trace ("aw*ah-rw*rh = " ++ show aw ++ '*':show ah ++ '-':show rw ++ '*':show rh ++ "\n") $ aw*ah-rw*rh
        (False,False) ->  trace ("0\n")  0
        (True,False) ->   trace ("(aw-rw)*ah = (" ++ show aw ++ '-':show rw ++ ")*" ++ show ah ++ "\n") $ (aw-rw)*ah
        (False,True) ->   trace ("(ah-rh)*aw = (" ++ show ah ++ '-':show rh ++ ")*" ++ show aw ++ "\n") $ (ah-rh)*aw
#endif