{- ****************************************************************************** * A F R P * * * * Example: Elevator * * Purpose: Testing of the Elevator simulator. * * Authors: Henrik Nilsson * * * * Copyright (c) The University of Nottingham, 2004 * * * ****************************************************************************** -} 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))