-- | Common Atom functions.
module Language.Atom.Common
  (
  -- * Timers
    Timer
  , timer
  , startTimer
  , startTimerIf
  , timerDone
  -- * One Shots
  , oneShotRise
  , oneShotFall
  -- * Debouncing
  , debounce
  -- * Lookup Tables
  , lookupTable
  , linear
  -- * Hysteresis
  , hysteresis
  ) where

import Data.Word

import Language.Atom.Language

-- | A Timer.
data Timer = Timer (V Word64)

-- | Creates a new timer.
timer :: Name -> Atom Timer
timer name = do
  timer <- word64 name 0
  return $ Timer timer

-- | Starts a Timer.  A timer can be restarted at any time.
startTimer :: Timer -> E Word64 -> Atom ()
startTimer t = startTimerIf t true

-- | Conditionally start a Timer.
startTimerIf :: Timer -> E Bool -> E Word64 -> Atom ()
startTimerIf (Timer t) a time = t <== mux a (clock + time) (value t)

-- | 'True' when a timer has completed.
timerDone :: Timer -> E Bool
timerDone (Timer t) = value t <=. clock


-- | One-shot on a rising transition.
oneShotRise :: E Bool -> Atom (E Bool)
oneShotRise a = do
  last <- bool "last" False
  last <== a
  return $ a &&. not_ (value last)

-- | One-shot on a falling transition.
oneShotFall :: E Bool -> Atom (E Bool)
oneShotFall = oneShotRise . not_


-- | Debounces a boolean given an on and off time (ticks) and an initial state.
debounce :: Name -> E Word64 -> E Word64 -> Bool -> E Bool -> Atom (E Bool)
debounce name onTime offTime init a = atom name $ do
  last  <- bool "last" init
  out   <- bool "out"  init
  timer <- timer "timer"
  atom "on" $ do
    cond $ a &&. not_ (value last)
    startTimer timer onTime
    last <== a
  atom "off" $ do
    cond $ not_ a &&. value last
    startTimer timer offTime
    last <== a
  atom "set" $ do
    cond $ a ==. value last
    cond $ timerDone timer
    out <== value last
  return $ value out


-- | 1-D lookup table.  X values out of table range are clipped at end Y values.
--   Input table must be monotonically increasing in X.
lookupTable :: FloatingE a => [(E a, E a)] -> E a -> E a
lookupTable table x = mux (x >=. x1) y1 $ foldl f y0 table'
  where
  (_,  y0) = head table
  (x1, y1) = last table
  table' = zip (init table) (tail table)
  f a ((x0,y0),(x1,y1)) = mux (x >=. x0) interp a
    where
    slope = (y1 - y0) / (x1 - x0)
    interp = (x - x0) * slope + y0

-- | Linear extrapolation and interpolation on a line with 2 points.
--   The two x points must be different to prevent a divide-by-zero.
linear :: FloatingE a => (E a, E a) -> (E a, E a) -> E a -> E a
linear (x1, y1) (x2, y2) a = slope * a + inter
  where
  slope = y2 - y1 / x2 - x1
  inter = y1 - slope * x1

-- | Hysteresis returns 'True' when the input exceeds @max@ and 'False' when
--   the input is less than @min@.  The state is held when the input is between
--   @min@ and @max@.
--
-- > hysteresis name min max input
hysteresis :: OrdE a => E a -> E a -> E a -> Atom (E Bool)
hysteresis a b u = do
  s <- bool "s" False
  s <== (mux (u >. max) true $ mux (u <. min) false $ value s)
  return $ value s
  where
  min = min_ a b
  max = max_ a b

{-

-- | A channel is a uni-directional communication link that ensures one read for every write.
data Channel a = Channel a (V Bool)

-- | Creates a new channel, with a given name and data.
channel :: a -> Atom (Channel a)
channel a = do
  hasData <- bool False
  return $ Channel a hasData

-- | Write data to a 'Channel'.  A write will only suceed if the 'Channel' is empty.
writeChannel :: Channel a -> Action ()
writeChannel (Channel _ hasData) = do
  when $ not_ $ value hasData
  hasData <== true

-- | Read data from a 'Channel'.  A read will only suceed if the 'Channel' has data to be read.
readChannel :: Channel a -> Action a
readChannel (Channel a hasData) = do
  when $ value hasData
  hasData <== false
  return a

-- | Fades one signal to another.
module Language.Atom.Common.Fader
  ( Fader
  , FaderInit (..)
  , fader
  , fadeToA
  , fadeToB
  , fadeToCenter
  ) where

import Language.Atom

-- | Fader object.
data Fader = Fader (V Int)

-- | Fader initalization.
data FaderInit = OnA | OnB | OnCenter

toA = 0
toB = 1
toCenter = 2

-- | Fader construction.  Name, fade rate, fader init, and signal A and B.
fader :: Name -> Double -> FaderInit -> E Double -> E Double -> Atom (Fader, E Double)
fader name rate init a b = scope name $ do
  --assert "positiveRate" $ rate >= 0

  target <- int (case init of {OnA -> toA; OnB -> toB; OnCenter -> toCenter})
  perA <- double (case init of {OnA -> 1;   OnB -> 0;   OnCenter -> 0.5})

  rule "toA" $ do
    when $ value target ==. intC toA
    when $ value perA <. 1
    perA <== mux (1 - value perA <. doubleC rate) 1 (value perA + doubleC rate)

  rule "toB" $ do
    when $ value target ==. intC toB
    when $ value perA >. 0
    perA <== mux (value perA <. doubleC rate) 0 (value perA - doubleC rate)

  rule "toCenterFrom0" $ do
    when $ value target ==. intC toCenter
    when $ value perA <. 0.5
    perA <== mux (0.5 - value perA <. doubleC rate) 0.5 (value perA + doubleC rate)

  rule "toCenterFrom1" $ do
    when $ value target ==. intC toCenter
    when $ value perA >. 0.5
    perA <== mux (value perA - 0.5 <. doubleC rate) 0.5 (value perA - doubleC rate)

  return (Fader target, (a * value perA + b * (1 - value perA)) / 2)

-- | Fade to signal A.
fadeToA :: Fader -> Action ()
fadeToA (Fader target) = target <== intC toA

-- | Fade to signal B.
fadeToB :: Fader -> Action ()
fadeToB (Fader target) = target <== intC toB

-- | Fade to center, ie average of signal A and B.
fadeToCenter :: Fader -> Action ()
fadeToCenter (Fader target) = target <== intC toCenter

module Language.Atom.Common.Process
  ( Process (..)
  , process
  ) where

import Language.Atom

data Process
  = Par [Process]
  | Seq [Process]
  | Alt [Process]
  | Rep Process
  | Act Action

process :: Name -> Process -> Atom ()

-- | Time integrated threshold functions typically used in condition monitoring.
module Language.Atom.Common.Threshold
  ( boolThreshold
  , floatingThreshold
  ) where

import Language.Atom


-- | Boolean thresholding over time.  Output is set when internal counter hits limit, and cleared when counter is 0.
boolThreshold :: Name -> Int -> Bool -> E Bool -> Atom (E Bool)
boolThreshold name num init input = scope name $ do
  --assert "positiveNumber" $ num >= 0

  state <- bool init
  count <- int  (if init then num else 0)

  rule "update" $ do
    when $ value count >. 0 &&. value count <. num
    count <== value count + mux input 1 (-1)

  rule "low" $ do
    when $ value count ==. 0
    state <== false

  rule "high" $ do
    when $ value count ==. intC num
    state <== true

  return $ value state

-- | Integrating threshold.  Output is set with integral reaches limit, and cleared when integral reaches 0.
doubleThreshold :: Name -> Double -> E Double -> Atom (E Bool)
doubleThreshold name lim input = scope name $ do
  --assert "positiveLimit" $ lim >= 0

  state <- bool False
  sum <- double 0

  (high,low) <- priority

  rule "update"
    sum <== value sum + input
    low

  rule "clear" $ do
    when $ value sum <=. 0
    state <== false
    sum <== 0
    high

  rule "set" $ do
    when $ value sum >=. doubleC lim
    state <== true
    sum <== doubleC lim
    high

  return  $ value state

-- | Capturing data that can either be valid or invalid.
module Language.Atom.Common.ValidData
  ( ValidData
  , validData
  , getValidData
  , whenValid
  , whenInvalid
  ) where

import Language.Atom

-- | 'ValidData' captures the data and its validity condition.
--   'ValidData' is abstract to prevent rules from using invalid data.
data ValidData a = ValidData a (E Bool)

-- | Create 'ValidData' given the data and validity condition.
validData :: a -> E Bool -> ValidData a
validData = ValidData

-- | Get a valid data.  Action is disabled if data is invalid.
getValidData :: ValidData a -> Action a
getValidData (ValidData a v) = cond v >> return a

-- | Action enabled if 'ValidData' is valid.
whenValid :: ValidData a -> Action ()
whenValid (ValidData _ v) = cond v

-- | Action enabled if 'ValidData' is not valid.
whenInvalid :: ValidData a -> Action ()
whenInvalid (ValidData _ v) = cond $ not_ v
-}