home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IOInterface / timerDevice.icl < prev    next >
Encoding:
Modula Implementation  |  1997-04-23  |  3.8 KB  |  111 lines  |  [TEXT/3PRM]
  1. implementation module timerDevice;
  2.  
  3. import StdClass;
  4. import StdInt, StdBool;
  5. import ioState;
  6.  
  7. TimerDeviceError :: String String -> .x;
  8. TimerDeviceError f error = Error f "timerDevice" error;
  9.  
  10. ::    DeltaFunction *s :== !s -> *(!(IOState s) -> (!s, !IOState s));
  11.  
  12. TimerFunctions :: DeviceFunctions *s;
  13. TimerFunctions = (ShowTimer, OpenTimer, TimerIO, CloseTimer, HideTimer);
  14.  
  15. ShowTimer :: !(IOState s) -> IOState s;
  16. ShowTimer ioState = ioState;
  17.  
  18. OpenTimer :: !(DeviceSystem s (IOState s)) !(IOState s) -> IOState s;
  19. OpenTimer (TimerSystem timers) ioState
  20.     =    IOStateSetDevice (IOStateSetToolbox tb1 ioState1) (TimerSystemState tHs);
  21.     where {
  22.         (tb, ioState1)    = IOStateGetToolbox ioState;
  23.         (tHs,tb1)        = OpenTimers timers [] tb;
  24.     };
  25. OpenTimer _ _
  26.     =    TimerDeviceError "OpenTimer" "argument is no TimerSystem";
  27.  
  28. OpenTimers :: ![TimerDef s (IOState s)] ![TimerHandle s] !Toolbox -> (![TimerHandle s],!Toolbox);
  29. OpenTimers tDefs tHs tb = StateMap2 OpenTimers` tDefs (tHs,tb);
  30.  
  31. OpenTimers` :: !(TimerDef s (IOState s)) !(![TimerHandle s],!Toolbox) -> (![TimerHandle s],!Toolbox);
  32. OpenTimers` tDef (tHs,tb)
  33. |    TimerHandlesContainId tHs id    = (tHs, tb);
  34.                                     = ([(ValidateTimer tDef, time) : tHs], tb1);
  35.     where {
  36.         (id,_,_,_)    = TimerDef_Attributes tDef;
  37.         (time, tb1)    = TickCount tb;
  38.     };
  39.  
  40. TimerHandlesContainId :: ![TimerHandle s] !TimerId -> Bool;
  41. TimerHandlesContainId [(tDef, sampleTime) : tHs] id
  42. |    id <> id`    = TimerHandlesContainId tHs id;
  43.                 = True;
  44.     where {
  45.         (id`,_,_,_) = TimerDef_Attributes tDef;
  46.     };
  47. TimerHandlesContainId _ _ = False;
  48.  
  49. ValidateTimer :: !(TimerDef s (IOState s)) -> TimerDef s (IOState s);
  50. ValidateTimer tDef
  51. |    intervalTime >= 0    = tDef;
  52.                         = TimerDef_SetInterval tDef 0;
  53.     where {
  54.         (_,_,intervalTime,_) = TimerDef_Attributes tDef;
  55.     };
  56.  
  57.  
  58. /*    Note:    normally the timer device yields False in order to pass events to the other
  59.             devices as well. The only exception should be when one of the event handlers
  60.             quits the interaction. In that case the Boolean result must be True.
  61. */
  62. TimerIO    :: !Event !*s !(IOState *s) -> (!Bool, !*s, !IOState *s);
  63. TimerIO (b,event,m,eventTime,h,v,mods) state ioState
  64. |    event == UpdateEvent || event == ActivateEvent    = (False, state, ioState);
  65.                                                     = ApplyTimers fs state ioState2;
  66.     where {
  67.         (timers,ioState1)    = IOStateGetDevice ioState TimerDevice;
  68.         tHs                    = TimerSystemState_TimerHandles timers;
  69.         (tHs1, fs)            = LetTimersDoIO eventTime tHs;
  70.         ioState2            = IOStateSetDevice ioState1 (TimerSystemState tHs1);
  71.     };
  72.  
  73. TimerSystemState_TimerHandles :: !(DeviceSystemState s) -> TimerHandles s;
  74. TimerSystemState_TimerHandles (TimerSystemState timers) = timers;
  75. TimerSystemState_TimerHandles _
  76.     =     TimerDeviceError "TimerSystemState_TimerHandles" "argument is no TimerSystemState";
  77.  
  78. LetTimersDoIO :: !Int !(TimerHandles s) -> (!TimerHandles s, ![DeltaFunction s]);
  79. LetTimersDoIO eventTime [tH=:(tDef, sampleTime) : tHs]
  80.     | not (Enabled ability)
  81.         = ([tH                    : tHs1], fs);
  82.     | intervalTime==0
  83.         = ([(tDef, eventTime)    : tHs1], [f 1 : fs]);
  84.     | timePassed < intervalTime
  85.         = ([tH                    : tHs1], fs);
  86.         = ([(tDef, sampleTime1) : tHs1], [f nrOfTimes : fs]);
  87.     where {
  88.         nrOfTimes                    = timePassed / intervalTime;
  89.         timePassed                    = eventTime  - sampleTime;
  90.         sampleTime1                    = sampleTime + nrOfTimes * intervalTime;
  91.         (_,ability,intervalTime,f)    = TimerDef_Attributes tDef;
  92.         (tHs1, fs)                    = LetTimersDoIO eventTime tHs;
  93.     };
  94. LetTimersDoIO _ tHs = (tHs, []);
  95.  
  96. ApplyTimers :: ![DeltaFunction *s] !*s !(IOState *s) -> (!Bool, !*s, !IOState *s);
  97. ApplyTimers [f : fs] s ioState
  98. |    closed    = (closed,         s1, ioState2);
  99.             = ApplyTimers fs s1  ioState2;
  100.     where {
  101.         (s1, ioState1)        = f s ioState;
  102.         (closed, ioState2)    = IOStateClosed ioState1;
  103.     };
  104. ApplyTimers _ s ioState = (False, s, ioState);
  105.  
  106. CloseTimer :: !(IOState s) -> IOState s;
  107. CloseTimer ioState = IOStateRemoveDevice ioState TimerDevice;
  108.  
  109. HideTimer :: !(IOState s) -> IOState s;
  110. HideTimer ioState = ioState;
  111.