module Basic where
import TypesettingTricks
--import Int( Num(fromInt) )
import Physical
--import GHC( (->) )
infixr 7 |>
class Signal s where
  mapSignal:: (Physical a, Physical b) => (s a b) -> a -> b
  mapSigList:: (Physical a, Physical b) => (s a b) -> [a] -> [b]
  toSig:: (Physical a, Physical b) => (s a b) -> SignalRep a b
  mapSignal = mapSignal . toSig
  mapSigList = map . mapSignal
  toSig = FunctionRep . mapSignal
instance Signal (->) where
  mapSignal f = f
  toSig = FunctionRep
data {- (Physical a, Physical b) => -} SignalRep a b =
   FunctionRep (a -> b) |
   PieceContRep (PieceCont a b)

instance Eq (SignalRep a b) where
  (==) a b = error "No equality for SignalRep"

instance Show (SignalRep a b) where
  show sr = error "No show for SignalRep"

instance Signal SignalRep where
  mapSignal (FunctionRep f) = mapSignal f
  mapSignal (PieceContRep f) = mapSignal f
  mapSigList (FunctionRep f) = mapSigList f
  mapSigList (PieceContRep f) = mapSigList f
  toSig = id
instance (Physical a, Physical b) => Eq (a -> b) where
  a == b = error "Attempt to apply equality to functions"
binop:: (Physical a, Physical b) => (Float -> Float -> Float) -> 
                                    (a -> b) -> (a -> b) -> a -> b
binop op f g t = toPhysical ((fromPhysical (f t)) `op` (fromPhysical (g t)))
unop:: (Physical a, Physical b ) => (Float -> Float) -> 
                                    (a -> b) -> a -> b
unop op f t = toPhysical (op (fromPhysical (f t)))
instance (Physical a, Physical b) => Num (SignalRep a b) where
  f + g = FunctionRep (binop (+) (mapSignal f) (mapSignal g))
  f * g = FunctionRep (binop (*) (mapSignal f) (mapSignal g))
  negate f = FunctionRep (unop negate (mapSignal f))
  abs f = FunctionRep (unop abs (mapSignal f))
  signum f = FunctionRep (unop abs (mapSignal f))
  fromInteger i = FunctionRep (\t -> toPhysical (fromInteger i))
  --fromInt i = FunctionRep (\t -> toPhysical (fromInt i))
instance (Physical a, Physical b) => 
         Fractional (SignalRep a b) where
  f / g = FunctionRep (binop (/) (mapSignal f) (mapSignal g))
  fromRational r = FunctionRep (\t -> (toPhysical (fromRational r)))
instance (Physical a, Physical b) => 
          Floating (SignalRep a b) where
  pi = FunctionRep (\t -> (toPhysical pi))
  exp   f = FunctionRep (unop exp (mapSignal f))
  log   f = FunctionRep (unop log (mapSignal f))
  sin   f = FunctionRep (unop sin (mapSignal f))
  cos   f = FunctionRep (unop cos (mapSignal f))
  asin  f = FunctionRep (unop asin (mapSignal f))
  acos  f = FunctionRep (unop acos (mapSignal f))
  atan  f = FunctionRep (unop atan (mapSignal f))
  sinh  f = FunctionRep (unop sinh (mapSignal f))
  cosh  f = FunctionRep (unop cosh (mapSignal f))
  asinh f = FunctionRep (unop asinh (mapSignal f))
  acosh f = FunctionRep (unop acosh (mapSignal f))
  atanh f = FunctionRep (unop atanh (mapSignal f))
data Event =
  TimeEvent Float | 
  FunctionEvent (Float -> Bool) |
  BurstEvent Int Event

instance Show Event where
  show (TimeEvent f) = "TimeEvent " ++ show f
  show (FunctionEvent _) = "FunctionEvent"
  show (BurstEvent i e)  = "BurstEvent " ++ show i ++ " " ++ show e

instance Eq Event where
  (TimeEvent x) == (TimeEvent y) = x == y
  (BurstEvent i e) == (BurstEvent i' e') = (i' == i) && (e' == e)
eventOccurs:: Event -> Float -> Float
eventOccurs (TimeEvent t) x = if x < t then x else t
eventOccurs (FunctionEvent f) x = stepEval f x
eventOccurs (BurstEvent i e) x = 
          if i == 1 then
            eventOccurs e x
          else
            eventOccurs (BurstEvent (i-1) e) ((eventOccurs e x) + eventEps x)
stepEval:: (Float -> Bool) -> Float -> Float
stepEval f x = if f x then x else stepEval f (x + eventEps x)
data ZeroIndicator = LocalZero | GlobalZero deriving (Eq, Show)
data {- (Physical a, Physical b) => -} FunctionWindow a b = 
     Window ZeroIndicator Event (SignalRep a b)
     deriving (Eq, Show)
data PieceCont a b = Windows [FunctionWindow a b]
     deriving (Eq, Show)
instance Signal PieceCont where
  mapSignal (Windows []) t = toPhysical 0.0
  mapSignal (Windows wl) t = (mapSignal s) (toPhysical t')
      where (t', (Window z e s), wl') = getWindow 0.0 (fromPhysical t) wl
  toSig = PieceContRep
getWindow:: (Physical a, Physical b) => 
            Float -> Float -> [ FunctionWindow a b ] -> 
            (Float, FunctionWindow a b, [ FunctionWindow a b ])
getWindow st t [] = (t, Window LocalZero e f, [])
                    where e = TimeEvent (realmul 2 t)
                          f = FunctionRep (\t -> toPhysical 0.0)
getWindow st t (w:wl) = if t' <= wt then (t',w,w:wl) 
                        else getWindow (st+wt) t wl
    where wt = eventOccurs e t'
          (Window z e s) = w
          t' = if z == LocalZero then t-st else t
(|>) :: (Physical a, Physical b) => FunctionWindow a b -> 
        PieceCont a b -> PieceCont a b
w |> (Windows wl) = Windows (w:wl)
nullWindow = Windows []
cycleWindows:: (Physical a, Physical b) => 
                PieceCont a b -> PieceCont a b
cycleWindows (Windows wl) = Windows (cycle wl)
constant:: (Physical a, Physical b) => b -> SignalRep a b
constant x = FunctionRep (\t -> x)
linear:: (Physical a, Physical b) => Float -> b -> SignalRep a b
linear m b  = FunctionRep (\x -> toPhysical (realmul m (fromPhysical x) + (fromPhysical b)))
sine:: (Physical a, Physical b) => 
       b -> Frequency -> Float -> SignalRep a b
sine mag omeg phase = FunctionRep (\x -> toPhysical (realmul (fromPhysical mag) (sin (realmul (realmul (realmul 2 pi) (fromPhysical omeg)) (fromPhysical x) + phase))))
waveform:: (Physical a, Physical b) => a -> [b] -> SignalRep a b
waveform samp ampls =
  let stepSlope y y' = realdiv ((fromPhysical y') - (fromPhysical y)) (fromPhysical samp)
      makeWin (v,v') = Window LocalZero (TimeEvent (fromPhysical samp)) 
                       (linear (stepSlope v v') v)
      points = cycle ampls
  in PieceContRep (Windows (map makeWin (zip points (tail points))))
random:: (Physical a, Physical b) => 
         Integer -> a -> SignalRep a b
random i s = waveform s (map toPhysical (rand i))
ramp:: (Physical a, Physical b) => a -> b -> SignalRep a b
ramp per v = 
  let sig = linear (realdiv (fromPhysical v) (fromPhysical per)) (toPhysical 0.0)
  in PieceContRep (Windows (cycle ([Window LocalZero (TimeEvent (fromPhysical per)) sig ])))
triangle:: (Physical a, Physical b) => a -> b -> SignalRep a b
triangle per v =
  let sl = realmul 2.0 (realdiv (fromPhysical v) (fromPhysical per))
      qper = realdiv (fromPhysical v) 4.0
      wins =  (Window LocalZero (TimeEvent qper) (linear sl (toPhysical 0.0))) |>
              (Window LocalZero (TimeEvent (realmul 2.0 qper)) (linear (- sl) v)) |>
              (Window LocalZero (TimeEvent qper) (linear sl (toPhysical (- (fromPhysical v))))) |>
               nullWindow
  in PieceContRep (cycleWindows wins)
step:: (Physical a, Physical b) => a -> b -> SignalRep a b
step tr lvl = FunctionRep (\t -> if (fromPhysical t) < (fromPhysical tr) then (toPhysical 0.0) else lvl)
square:: (Physical a, Physical b) => a -> b -> SignalRep a b
square per lvl =
  let trans = realdiv (fromPhysical per) 2.0
      nlvl = asTypeOf (toPhysical (- (fromPhysical lvl))) lvl
      f t = if (fromPhysical t) < trans then lvl else nlvl
      wins = Windows [Window LocalZero (TimeEvent (fromPhysical per)) (FunctionRep f)]
  in PieceContRep (cycleWindows wins)
pulse:: (Physical a, Physical b) => a -> a -> b -> SignalRep a b
pulse st wid lvl =
  let tr = (fromPhysical st) + (fromPhysical wid)
      f t = if (fromPhysical t) < (fromPhysical st) then (toPhysical 0.0)
            else if (fromPhysical t) < tr then lvl else (toPhysical 0.0)
  in FunctionRep f
trap:: (Physical a, Physical b) => a -> a -> a -> a -> b -> 
                                   SignalRep a b
trap st r wid f lvl =
  let stepSlope y y' t = realdiv (y' -  y) (fromPhysical t)
      bigwin = realmul 10000000 ((fromPhysical st) + (fromPhysical wid))
      wins = Window LocalZero (TimeEvent (fromPhysical st)) (constant (toPhysical 0.0)) |>
             Window LocalZero (TimeEvent (fromPhysical r)) (linear (stepSlope 0.0 (fromPhysical lvl) r) (toPhysical 0.0)) |>
             Window LocalZero (TimeEvent (fromPhysical wid)) (constant lvl) |>
             Window LocalZero (TimeEvent (fromPhysical f)) (linear (stepSlope (fromPhysical lvl) 0.0 f) lvl) |>
             Window LocalZero (TimeEvent bigwin) (constant (toPhysical 0.0)) |>
             nullWindow
  in PieceContRep wins
expc:: (Physical a, Physical b) => Float -> SignalRep a b
expc damp = FunctionRep (\t -> toPhysical (exp (- (realmul (fromPhysical t) damp))))
data {- (Physical indep, Physical dep) => -} BasicSignal indep dep =
    Overshoot {start_delay::indep,
               pulse_width::indep,
               ringing::dep,
               oscillation::Frequency,
               damp_fac::Float}
  | Pulse_dc {start_delay::indep,
              pulse_width::indep,
              rise_time::indep,
              fall_time::indep,
              period::indep,
              dc_offset::dep,
              amplitude::dep,
              over::BasicSignal indep dep,
              under::BasicSignal indep dep}
  | Pulse_ac {start_delay::indep,
              pulse_width::indep,
              period::indep,
              dc_offset::dep,
              amplitude::dep,
              frequency::Frequency,
              phase::Float}
  deriving (Eq, Show)

data {- (Eq a, Eq b) => -} Foo a b = Foo { x :: a, y :: b}

foo :: (Eq a, Eq b) => Foo a b
foo = Foo{}

{-
overshoot:: (Physical a, Physical b) => BasicSignal a b
overshoot = Overshoot{}
pulse_dc:: (Physical a, Physical b) => BasicSignal a b
pulse_dc = Pulse_dc {over = Overshoot{start_delay=toPhysical 0.0,
                                            ringing=(toPhysical 0.0),
                                            oscillation=toPhysical 1.0,
                                            damp_fac=1.0},
                     under = Overshoot{start_delay=toPhysical 0.0,
                                             ringing=(toPhysical 0.0),
                                             oscillation=toPhysical 1.0,
                                             damp_fac=1.0},
                     start_delay = toPhysical 0.0,
                     dc_offset = toPhysical 0.0}

pulse_ac:: (Physical a, Physical b) => BasicSignal a b
pulse_ac = Pulse_ac {dc_offset = toPhysical 0.0,
                     amplitude = toPhysical 0.0}
-}

makeWin:: (Physical a, Physical b) => a -> a -> 
           SignalRep a b -> SignalRep a b
makeWin st wid sig =
  let wins = Window LocalZero (TimeEvent (fromPhysical st)) (constant (toPhysical 0.0)) |>
             Window LocalZero (TimeEvent (fromPhysical wid)) sig |>
             nullWindow
  in PieceContRep wins
instance Signal BasicSignal where
  toSig (Overshoot start_delay pulse_width ringing oscillation damp_fac) =
    let ring = sine ringing oscillation 0.0
        cond = asTypeOf (expc damp_fac) ring
        sig = temp ring cond
        temp:: (Physical a, Physical b) => SignalRep a b -> 
                SignalRep a b -> SignalRep a b
        temp f g = FunctionRep (binop (*) (mapSignal f) (mapSignal g))
--        temp f g = f * g
--        temp f g = asTypeOf (f * g) ring
        wins = Window LocalZero (TimeEvent (fromPhysical start_delay)) (constant (toPhysical 0.0)) |>
               Window LocalZero (TimeEvent (fromPhysical pulse_width)) sig |>
               nullWindow
    in PieceContRep wins
  toSig Pulse_dc{ start_delay = start_delay
                , rise_time   = rise_time
		, pulse_width = pulse_width
		, fall_time   = fall_time
		, dc_offset   = dc_offset
		, period      = period
		, amplitude   = amplitude
		, over        = over
		, under       = under
		} =
    let pul = trap start_delay rise_time pulse_width fall_time amplitude
        so = toPhysical ((fromPhysical start_delay) + (fromPhysical rise_time))
        su = toPhysical ((fromPhysical so) + (fromPhysical pulse_width) + (fromPhysical fall_time))
        oversh = toSig over{start_delay=so}
        undersh = toSig under{start_delay=su}
        off = constant dc_offset
        temp:: (Physical a, Physical b) => SignalRep a b -> 
                SignalRep a b -> SignalRep a b
        temp f g = FunctionRep (binop (+) (mapSignal f) (mapSignal g))
        sig = temp (temp (temp pul oversh) undersh) off
        wins = (Window LocalZero (TimeEvent (fromPhysical period)) sig) |>
                nullWindow
    in PieceContRep (cycleWindows wins)
sumSig:: (Physical a, Physical b, Signal s, Signal s') =>
         (s a b) -> (s' a b) -> SignalRep a b
sumSig f f' = 
   let s1 t = fromPhysical (mapSignal f t)
       s2 t = fromPhysical (mapSignal f' t)
   in FunctionRep (\t -> toPhysical ((s1 t) + (s2 t)))
mulSig:: (Physical a, Physical b, Signal s, Signal s') =>
         (s a b) -> (s' a b) -> SignalRep a b
mulSig f f' = 
   let f1 t = fromPhysical (mapSignal f t)
       f2 t = fromPhysical (mapSignal f' t)
   in FunctionRep (\t -> toPhysical ((f1 t) * (f2 t)))

eventEps:: Float -> Float
eventEps x = let eps = realdiv x 1000 in if 0.01 < eps then 0.01 else eps