module Wired.Model where



import Control.Monad.Reader
import Control.Monad.Writer
import Data.Function
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Data.String

import Data.Hardware.Internal
import Lava.Internal
import Layout.Internal



class CellLibrary lib => WiredLibrary lib
  where
    lambda :: TypeOf lib -> Length
      -- Half feature size

type Guide = (Signal, Layer, Direction, Length)
  -- A roting guide associated with a signal.

type Wired lib = LayoutT Guide CellId (Lava lib)
  -- Each box is associated with a cell. Space may be associated with a guide.

class ( MonadLava lib m
      , WiredLibrary lib
      , MonadLayout Guide CellId m
      )
   => MonadWired lib m

instance ( MonadLava lib m
         , WiredLibrary lib
         , MonadLayout Guide CellId m
         )
      => MonadWired lib m



runWired
    :: CellLibrary lib
    => Wired lib a -> (a, (DesignDB lib, Floorplan Guide CellId))

runWired w = (a,(ds,fp))
  where
    ((a,fp),ds) = runLava $ runLayoutT w



stripLayout :: MonadLava lib m => LayoutT s b m a -> m a
stripLayout = liftM fst . runLayoutT



instance MonadLava lib m => MonadLava lib (LayoutT s b m)
  where
    newPrimInpId = lift newPrimInpId
    newCellId    = lift newCellId
    declare      = lift . declare

    listenDecls (LayoutT ma) = LayoutT $ do
        pl <- ask
        ((a,fps),decls) <- lift $ lift $
            listenDecls $ runWriterT $ runReaderT ma pl
        tell fps
        return (a,decls)



convertGuide
    :: (Position, AbsBlock Guide CellId)
    -> (Signal, (Layer,Position,Position))

convertGuide bl = (sig,(lay,pos1,pos2))
  where
    ((x,y), Space _ (Just (sig,lay,dir,len))) = bl

    pos1 = blockCenter bl

    pos2 = case dir of
      Rightwards -> (x + icast len, y)
      Leftwards  -> (x - icast len, y)
      Upwards    -> (x, y + icast len)
      Downwards  -> (x, y - icast len)



mkGuideDB
    :: Floorplan Guide CellId -> Map Signal [(Layer,Position,Position)]

mkGuideDB fp = Map.fromListWith (++)
    [ (sig,[g])
      | bl@(_, Space _ (Just _)) <- fst $ absolutize fp
      , let (sig,g) = convertGuide bl
    ]
  -- Can be conveniently used with totalLookup.



renderWired :: forall lib a . WiredLibrary lib => String -> Wired lib a -> IO ()
renderWired title w = renderFloorplan_ lam title fp []
  where
    lam = icast $ lambda (T::TypeOf lib)
    fp  = snd $ snd $ runWired w
  -- Lambda is a reasonable scale for lines and names.



fpToLines :: Floorplan Guide CellId -> [(Position,Position)]
fpToLines fp = concat
    [ rectiSpanning [pos | (_,pos,_) <- guides]
      | (_,guides) <- Map.toList $ mkGuideDB fp
    ]

  -- Returns the lines between the guides in the floorplan. Guides associated
  -- with the same signal end up in the same cluster. This sort of assumes that
  -- the cells have guides marking the position of each of their pins, otherwise
  -- the lines will only include the guides between the cells (if any), and the
  -- cells will look disconnected when drawn.
  --
  -- The guides are treated as single points regardless of their length.



renderWiredWithNets :: forall lib a .
    WiredLibrary lib => String -> Wired lib a -> IO ()

renderWiredWithNets title w = renderFloorplan_ lam title fp (fpToLines fp)
  where
    lam = icast $ lambda (T::TypeOf lib)
    fp  = snd $ snd $ runWired w



guide
    :: (MonadWired lib m, PortStruct p Signal t)
    => Direction -> Length -> Layer -> Width -> (p -> m p)

guide dir len lay pitch = mapPortM $ \sig -> do
    space_ (icast pitch) (Just (sig,lay,dir,len))
    return sig



guidePos
    :: (MonadWired lib m, PortStruct p Signal t)
    => Direction -> Length -> Layer -> Position -> (p -> m p)

guidePos dir len lay (x,y) = translate x y . guide dir len lay 0



mkCell
    :: MonadWired lib m
    => Name
    -> Width
    -> Height
    -> m a
    -> m a

mkCell nm x y ma = do
    (a, [Cell cid _ _]) <- listenDecls ma
    block x y nm cid a



showOri :: IsString str => Orientation -> str
showOri (flipped,dir) = fromString $
    (if flipped then "F" else "") ++ showDir dir
  where
    showDir Rightwards = "E"
    showDir Leftwards  = "W"
    showDir Upwards    = "N"
    showDir Downwards  = "S"

  -- Uses the notion of orientation from the Cadence DEF format.
  --
  --    .------,            .------,
  -- N: |     #|        FN: |#     |
  --    |     #|            |#     |
  --    |      |            |      |
  --    '------'            '------'
  --
  --    .------,            .------,
  -- S: |      |        FS: |      |
  --    |#     |            |     #|
  --    |#     |            |     #|
  --    '------'            '------'
  --
  --    .------,            .------,
  -- W: |###   |        FW: |   ###|
  --    |      |            |      |
  --    |      |            |      |
  --    '------'            '------'
  --
  --    .------,            .------,
  -- E: |      |        FE: |      |
  --    |      |            |      |
  --    |   ###|            |###   |
  --    '------'            '------'
  --
  -- So N is the standard orientation and S/W/E are rotations of the standard
  -- orientation. FN/FS/FW/FE are simply flipped around the y-axis.

  -- *** Needed?