-- | A simple I²C controller.
package I2C where

import Clocks
import GetPut

struct I2CStatus =
  { -- | Whether a read or write is in progress. Writing to this bit does not
    -- affect the internal state of the I²C controller.
    busy :: Bool
  ; -- | Whether the bus is idle. Usually, software will want to use the `busy`
    -- bit instead to determine when to send new commands; the `busIdle` bit is
    -- only set to `True` after the STOP condition. Writing to this bit does
    -- not affect the internal state of the I²C controller.
    busIdle :: Bool
  ; -- | The last ACK bit we received from sending an address. Writing to this
    -- bit does not affect the internal state of the I²C controller.
    addrAck :: Bool
  ; -- | The last ACK bit we received from sending an address, or the next ACK
    -- bit we'll send.
    dataAck :: Bool
  ; -- | A flag set if we detect during a START condition that we've lost
    -- arbitration. If this occurs, no read or write will occur, and the read
    -- or write should be retried later. Writing to this bit does not affect
    -- the internal state of the I²C controller.
    arbitrationLost :: Bool
  ; -- | Not-yet-allocated bits.
    rsvd :: Bit 2
  }
  deriving (Bits)

-- | An I²C controller.
interface I2C =
  -- | The TX side of the SCL pin. High corresponds to high-impedance.
  txSCL :: Bit 1
  -- | The TX side of the SDA pin. High corresponds to high-impedance.
  txSDA :: Bit 1

  -- | The address register, which contains the address in the high 7 bits and
  -- the R/!W bit in the low bit.
  addrReg :: Reg (Bit 8)
  -- | The data register, which can be read into by a read command or written
  -- from by a write command, depending on which the address register's low bit
  -- says to do.
  dataReg :: Reg (Bit 8)
  -- | The status register.
  statusReg :: Reg I2CStatus

  -- | Attempts to trigger a read or write. If one is already in progress (as
  -- indicated by the `busy` status bit being True), does nothing.
  trigger :: Action

-- | Runs an I²C interface on the current clock.
mkI2C' :: Bit 1 -> Bit 1 -> Wire (Bit 1) -> Wire (Bit 1) -> Reg (Bit 8) ->
  Reg (Bit 8) -> Reg I2CStatus -> PulseWire -> Module ()
mkI2C' rxSCL rxSDA txSCL txSDA addrReg dataReg statusReg trigger = module
  n <- mkReg 0
  rules
    "output txSCL": when True ==> txSCL := n
    "flip": when True ==> n := (n + 1)[0:0]
  return ()

-- | Returns an I²C interface that runs on the current clock. This is not what
-- you want, most likely.
mkI2C :: Bit 1 -> Bit 1 -> Module I2C
mkI2C rxSCL rxSDA = module
  txSCL <- mkWire
  txSDA <- mkWire
  addrReg <- mkReg 0
  dataReg <- mkReg 0
  statusReg <- mkReg (I2CStatus
    { busy = False
    ; busIdle = False
    ; addrAck = False
    ; dataAck = False
    ; arbitrationLost = False
    ; rsvd = 0
    })
  trigger <- mkPulseWire
  mkI2C' rxSCL rxSDA txSCL txSDA addrReg dataReg statusReg trigger

  interface I2C
    txSCL = txSCL
    txSDA = txSDA
    addrReg = addrReg
    dataReg = dataReg
    statusReg = statusReg
    trigger = trigger.send

{-
mkI2C' :: Bit 1 -> Bit 1 -> Reg (Bit 1) -> Reg (Bit 1) ->
  SyncFIFOIfc I2CCommand -> SyncFIFOIfc I2CResult -> Module I2C
mkI2C' rxSCL rxSDA txSCL txSDA sendFIFO recvFIFO = module
  state :: Reg (Bit 1) <- mkReg 0
  rules
    "output txSCL": when True ==> txSCL := state
    "flip state": when True ==> state := 1 - state

  {-
  state :: Reg State <- mkReg Idle

  rules
    when True ==> do
      $display "state: " (fshow state)
    when Idle <- state
      rules
        when not sendFIFO.notEmpty ==> do
          $display "Staying idle"
          -- Keep idling.
          txSCL := 1
          txSDA := 1
        when sendFIFO.notEmpty ==> do
          let cmd = sendFIFO.first
          sendFIFO.deq
          $display "Got a command: " (fshow cmd)
          -- See if we can get the bus.
          case rxSDA of
            0 -> do
              -- We lost arbitration -- someone else is driving the bus low.
              recvFIFO.enq ArbitrationLost
            1 -> do
              -- Drive SDA low and wait.
              txSDA := 0
              state := LowerSCLBeforeAddrAndRWBit 7 cmd
    when LowerSCLBeforeAddrAndRWBit i cmd <- state ==> do
      -- Drive SCL low.
      txSCL := 0
      -- Prepare to start writing the address.
      state := WriteAddrAndRWBit i cmd
    when WriteAddrAndRWBit i cmd <- state ==> do
      -- Keep SCL low while writing the data bit.
      txSDA := (getAddrAndRW cmd)[i:i]
      -- Next, we'll raise the clock for a cycle.
      state := RaiseSCLAfterAddrAndRWBit i cmd
    when RaiseSCLAfterAddrAndRWBit i cmd <- state ==> do
      -- Keep SDA the same while raising SCL.
      txSCL := 1
      state := WaitAfterAddrAndRWBit i cmd
    when WaitAfterAddrAndRWBit i cmd <- state ==> do
      if i == 0 then
        state := TODO
      else
        state := LowerSCLBeforeAddrAndRWBit (i - 1) cmd
    when TODO <- state ==> do
      state := TODO
  -}

  interface I2C
    txSCL = txSCL
    txSDA = txSDA
    recv = toGet recvFIFO
    send = toPut sendFIFO

-- | Returns an I²C interface with FIFOs that runs on a divided clock. Note
-- that the clock rate should be twice the bus speed -- to run the bus at
-- 100kbit/s (normal mode), the clock should run at 200kHz.
mkDividedI2C :: Integer -> Bit 1 -> Bit 1 -> Module I2C
mkDividedI2C divisor rxSCL rxSDA = module
  clock <- mkClockDivider divisor
  reset <- mkAsyncResetFromCR divisor clock.slowClock

  rxSCLSync :: SyncBitIfc (Bit 1) <- mkSyncBitFromCC clock.slowClock
  rxSDASync :: SyncBitIfc (Bit 1) <- mkSyncBitFromCC clock.slowClock
  txSCLSync :: Reg (Bit 1) <- mkSyncRegToCC 1 clock.slowClock reset
  txSDASync :: Reg (Bit 1) <- mkSyncRegToCC 1 clock.slowClock reset
  recvFIFO :: SyncFIFOIfc I2CResult <- mkSyncFIFOToCC 16 clock.slowClock reset
  sendFIFO :: SyncFIFOIfc I2CCommand <- mkSyncFIFOFromCC 16 clock.slowClock
  rules
    "copy rxSCL and rxSDA": when True ==> do
      rxSCLSync.send rxSCL
      rxSDASync.send rxSDA

  changeSpecialWires (Just clock.slowClock) (Just reset) Nothing $ module
    mkI2C' rxSCLSync.read rxSDASync.read txSCLSync txSDASync sendFIFO recvFIFO

  interface I2C
    txSCL = txSCLSync
    txSDA = txSDASync
    recv = toGet recvFIFO
    send = toPut sendFIFO
-}

-- vim: set ft=haskell :