content: -- |
  -- Description : Testing of the Elevator simulator.
  -- Copyright   : The University of Nottingham, 2004
  --  Authors    : Henrik Nilsson
  --
  -- Part of Elevator example.
  module Main where
  
  import Data.List (sortBy, intersperse)
  import Data.Maybe (catMaybes)
  
  import FRP.Yampa
  
  import Elevator
  
  smplPer = 0.01
  
  lbps :: SF a (Event ())
  lbps = afterEach [(3.0, ()), (2.0, ()), (50.0, ())]
  
  rbps :: SF a (Event ())
  rbps = afterEach [(20.0, ()), (2.0, ()), (18.0, ()), (15.001, ())]
  
  -- Looks for interesting events by inspecting the input events
  -- and the elevator position over the interval [0, t_max].
  
  data State = Stopped | GoingUp | GoingDown deriving Eq
  
  testElevator :: Time -> [(Time, ((Event (), Event ()), Position))]
  testElevator t_max = takeWhile ((<= t_max) . fst) tios
    where
      -- Time, Input, and Output
      tios = embed (localTime &&& ((lbps &&& rbps >>^ dup) >>> second elevator))
                   (deltaEncode smplPer (repeat ()))
  
  findEvents :: [(Time, ((Event (), Event ()), Position))]
                -> [(Time, Position, String)]
  findEvents []                     = []
  findEvents tios@((_, (_, y)) : _) = feAux Stopped y tios
    where
      feAux _    _    []                             = []
      feAux sPre yPre ((t, ((lbp, rbp), y)) : tios') =
          if not (null message)
            then (t, y, message) : feAux s y tios'
            else feAux s y tios'
        where
          s = if y == yPre
                then Stopped
                else if yPre < y
                       then GoingUp
                       else
                           GoingDown
  
          ms = if s /= sPre
                 then
                   case s of
                     Stopped ->   Just "elevator stopped"
                     GoingUp ->   Just "elevator started going up"
                     GoingDown -> Just "elevator started going down"
                 else
                   Nothing
  
          mu = if isEvent lbp
                 then Just "up button pressed"
                 else Nothing
  
          md = if isEvent rbp
                 then Just "down button pressed"
                 else Nothing
  
          message = concat (intersperse ", " (catMaybes [ms, mu, md]))
  
  formatEvent :: (Time, Position, String) -> String
  formatEvent (t, y, m) = "t = " ++ t' ++ ",\ty = " ++ y' ++ ":\t" ++ m
    where
      t' = show (fromIntegral (round (t * 100)) / 100)
      y' = show (fromIntegral (round (y * 100)) / 100)
  
  ppEvents []       = return ()
  ppEvents (e : es) = putStrLn (formatEvent e) >> ppEvents es
  
  main = ppEvents (findEvents (testElevator 100))
  