-------------------------------------------------------------------------------
--- $Id: ApplyLayout.hs#4 2010/09/21 13:51:11 REDMOND\\satnams $
-------------------------------------------------------------------------------

module Lava.ApplyLayout
where 
import Data.Array.ST
import Control.Monad.State
import Data.Array.Unboxed
import Control.Monad.ST
import Lava.Netlist

-------------------------------------------------------------------------------

applyLayout :: Netlist -> Netlist
applyLayout state
  = state{computedShifts = runST (applyLayout' state)}
 
-------------------------------------------------------------------------------

type MutablePositions s = STUArray s Int Int

-------------------------------------------------------------------------------

applyLayout' :: Netlist -> ST s (Array Int Int, Array Int Int)
applyLayout' state
  = do xs <- newArray (0, n-1) 0 :: ST s (STUArray s Int Int)
       ys <- newArray (0, n-1) 0 :: ST s (STUArray s Int Int)
       applyLayoutElements state (layout state) xs ys 
       xsf <- freeze xs
       ysf <- freeze ys
       return (xsf, ysf)
    where
    n = instCount state 

-------------------------------------------------------------------------------

applyLayoutElements :: Netlist -> [Layout] ->
                       MutablePositions s -> MutablePositions s ->
                       ST s ()
applyLayoutElements state [] xs ys = return ()
applyLayoutElements state (l:ls) xs ys 
  = do applyLayoutElement  state l  xs ys
       applyLayoutElements state ls xs ys

-------------------------------------------------------------------------------

applyLayoutElement :: Netlist ->  Layout -> MutablePositions s ->
                      MutablePositions s -> ST s ()
applyLayoutElement state (Beside (a0,a1) (b0,b1)) xs ys
  = if maybeASize == Nothing then -- nothing to lay out in block A
       return ()
    else
      translateInstances (b0,b1) (dx, 0) xs ys
    where
    insts = instances state
    l = layout state
    maybeASize = sizeOfBlock a0 a1 insts
    Just (dx,dy) = maybeASize 
applyLayoutElement state (Below (a0,a1) (b0,b1)) xs ys
  = if maybeASize == Nothing then -- nothing to lay out in block A
       return ()
    else
       translateInstances (b0,b1) (0, dy) xs ys
    where
    insts = instances state
    l = layout state
    maybeASize = sizeOfBlock a0 a1 insts
    Just (dx,dy) = maybeASize 

-------------------------------------------------------------------------------

sizeOfBlock :: Int -> Int -> [Instance] -> Maybe (Int, Int)
sizeOfBlock a0 a1 instances
  = if xy == [] then
      Nothing
    else
      Just (maximum xPositions - minimum xPositions + 1,
            maximum yPosiitons - minimum yPosiitons + 1)
    where
    positions = [position inst
                  | inst <- instances, instanceNumber inst >= a0 &&
                                       instanceNumber inst <= a1]
    xy = [(x,y) | At (x, y) <- positions]
    xPositions = map fst xy
    yPosiitons = map snd xy 
   
-------------------------------------------------------------------------------

translateInstances :: (Int, Int) -> (Int, Int) ->
                      MutablePositions s -> MutablePositions s -> ST s ()
translateInstances (a,b) dxy xs ys 
   = sequence_ [translateInstance i dxy xs ys | i <- [a..b]]

-------------------------------------------------------------------------------

translateInstance :: Int -> (Int, Int) -> 
                     MutablePositions s -> MutablePositions s ->
                     ST s ()
translateInstance i (dx, dy) xs ys
  = do x <- readArray xs i
       writeArray xs i (x+dx)
       y <- readArray ys i
       writeArray ys i (y+dy)

-------------------------------------------------------------------------------