home *** CD-ROM | disk | FTP | other *** search
/ Amiga Special: Spiele Hits / Hits-CD.iso / aminet / spiele / ammud1_1.lha / AmigaMUD / Src / Basics / TimeKeeper.m < prev    next >
Text File  |  1997-01-30  |  8KB  |  326 lines
  1. /*
  2.  * Amiga MUD
  3.  *
  4.  * Copyright (c) 1997 by Chris Gray
  5.  */
  6.  
  7. /*
  8.  * TimerKeeper.m - code for the timerkeeper machine, used to do time-based
  9.  *    activites for objects, and for startup activities.
  10.  */
  11.  
  12. private tp_timekeeper CreateTable()$
  13. use tp_timekeeper
  14.  
  15. /*
  16.  * define a time and system activation service for objects.
  17.  */
  18.  
  19. define tp_timekeeper TICK_TIME 60$
  20.  
  21. define tp_timekeeper TimeBase CreateThing(nil)$
  22. define tp_timekeeper tb_first CreateThingProp()$
  23. define tp_timekeeper tb_lastTime CreateIntProp()$
  24. define tp_timekeeper tb_afterCount CreateIntProp()$
  25. define tp_timekeeper tb_firstActive CreateThingProp()$
  26.  
  27. define tp_timekeeper tl_next CreateThingProp()$
  28. define tp_timekeeper tl_delay CreateIntProp()$
  29. define tp_timekeeper tl_object CreateThingProp()$
  30. define tp_timekeeper tl_action CreateActionProp()$
  31.  
  32. define tp_timekeeper tb_objectTemp CreateThingProp()$
  33. define tp_timekeeper tb_actionTemp CreateActionProp()$
  34.  
  35. TimeBase@tb_first := TimeBase$
  36. TimeBase@tb_lastTime := Time()$
  37. TimeBase@tb_afterCount := 0$
  38. /* AfterCount is the number of active 'After's for the timer. There will
  39.    be more than one if a new shorter interval arrives, and causes one to
  40.    be triggered for a shorter interval than the other one(s). */
  41. TimeBase@tb_firstActive := TimeBase$
  42.  
  43. CreateMachine("TimeKeeper", TimeBase, nil, nil)$
  44.  
  45. define tp_timekeeper proc callUserCode(thing object; action a)void:
  46.  
  47.     SetEffectiveTo(Owner(object));
  48.     call(a, void)(object);
  49. corp;
  50.  
  51. define tp_timekeeper proc timerStep()void:
  52.     int last, now, delta;
  53.     thing tl, object;
  54.     action a;
  55.  
  56.     TimeBase@tb_afterCount := TimeBase@tb_afterCount - 1;
  57.     last := TimeBase@tb_lastTime;
  58.     now := Time();
  59.     delta := now - last;
  60.     tl := TimeBase@tb_first;
  61.     while tl ~= TimeBase do
  62.     tl@tl_delay := tl@tl_delay - delta;
  63.     tl := tl@tl_next;
  64.     od;
  65.     TimeBase@tb_lastTime := now;
  66.     while
  67.     tl := TimeBase@tb_first;
  68.     tl ~= TimeBase and tl@tl_delay <= 0
  69.     do
  70.     object := tl@tl_object;
  71.     a := tl@tl_action;
  72.     /* Keep pointers so the call is OK! */
  73.     TimeBase@tb_objectTemp := object;
  74.     TimeBase@tb_actionTemp := a;
  75.     /* This assignment will destroy the 'tl' object. */
  76.     TimeBase@tb_first := tl@tl_next;
  77.     /* Do the call after we have deleted this record. */
  78.     callUserCode(object, a);
  79.     /* This may free them. */
  80.     TimeBase -- tb_objectTemp;
  81.     TimeBase -- tb_actionTemp;
  82.     od;
  83.     if TimeBase@tb_afterCount = 0 then
  84.     tl := TimeBase@tb_first;
  85.     if tl ~= TimeBase and tl@tl_delay < TICK_TIME then
  86.         delta := tl@tl_delay;
  87.     else
  88.         delta := TICK_TIME;
  89.     fi;
  90.     TimeBase@tb_afterCount := 1;
  91.     After(IntToFixed(delta), timerStep);
  92.     fi;
  93. corp;
  94.  
  95. define tp_timekeeper proc timerActive()void:
  96.     thing tl,object;
  97.     action a;
  98.     int delta;
  99.  
  100.     while
  101.     tl := TimeBase@tb_firstActive;
  102.     tl ~= TimeBase
  103.     do
  104.     object := tl@tl_object;
  105.     a := tl@tl_action;
  106.     TimeBase@tb_objectTemp := object;
  107.     TimeBase@tb_actionTemp := a;
  108.     TimeBase@tb_firstActive := tl@tl_next;
  109.     callUserCode(object, a);
  110.     TimeBase -- tb_objectTemp;
  111.     TimeBase -- tb_actionTemp;
  112.     od;
  113.  
  114.     TimeBase@tb_afterCount := 1;    /* all cases need this */
  115.     TimeBase@tb_lastTime := Time();
  116.  
  117.     tl := TimeBase@tb_first;
  118.     if tl ~= TimeBase then
  119.     if tl@tl_delay <= 0 then
  120.         /* timerStep will decrement, then re-increment, afterCount */
  121.         timerStep();
  122.     else
  123.         delta := tl@tl_delay;
  124.         if delta > TICK_TIME then
  125.         delta := TICK_TIME;
  126.         fi;
  127.         After(IntToFixed(delta), timerStep);
  128.     fi;
  129.     else
  130.     After(IntToFixed(TICK_TIME), timerStep);
  131.     fi;
  132. corp;
  133.  
  134. ignore SetMachineActive(TimeBase, timerActive)$
  135.  
  136. define tp_timekeeper proc timerSet()status:
  137.     int delay;
  138.  
  139.     delay := TimeBase@tb_first@tl_delay;
  140.     if delay > TICK_TIME then
  141.     delay := TICK_TIME;
  142.     fi;
  143.     After(IntToFixed(delay), timerStep);
  144.     /* increment counter - we have triggered another 'After' */
  145.     TimeBase@tb_afterCount := TimeBase@tb_afterCount + 1;
  146.     continue
  147. corp;
  148.  
  149. /*
  150.  * DoAfter - set things up so that after 'seconds' seconds, action 'a' will
  151.  *    be called with parameter 'object'. It will be called with the
  152.  *    EffectivePlayer set to the owner of 'object'.
  153.  *
  154.  *    Note that these time actions survive a server shutdown/restart - the
  155.  *    delay interval is considered to be seconds of server up-time. This
  156.  *    makes this facility ideal for timed events in scenario time.
  157.  */
  158.  
  159. define t_base proc DoAfter(int seconds; thing object; action a)void:
  160.     int now, delta;
  161.     thing tl, tlNew, next;
  162.  
  163.     if seconds < 0 then
  164.     Print("seconds < 0 in DoAfter\n");
  165.     elif object = nil then
  166.     Print("object = nil in DoAfter\n");
  167.     elif a = nil then
  168.     Print("action = nil in DoAfter\n");
  169.     else
  170.     now := Time();
  171.     delta := now - TimeBase@tb_lastTime;
  172.     tl := TimeBase@tb_first;
  173.     while tl ~= TimeBase do
  174.         tl@tl_delay := tl@tl_delay - delta;
  175.         tl := tl@tl_next;
  176.     od;
  177.     TimeBase@tb_lastTime := now;
  178.     tlNew := CreateThing(nil);
  179.     tlNew@tl_delay := seconds;
  180.     tlNew@tl_object := object;
  181.     tlNew@tl_action := a;
  182.     tl := TimeBase@tb_first;
  183.     if tl = TimeBase or seconds < tl@tl_delay then
  184.         tlNew@tl_next := tl;
  185.         TimeBase@tb_first := tlNew;
  186.         ignore ForceAction(TimeBase, timerSet);
  187.     else
  188.         while
  189.         next := tl@tl_next;
  190.         next ~= TimeBase and next@tl_delay <= seconds
  191.         do
  192.         tl := next;
  193.         od;
  194.         tlNew@tl_next := next;
  195.         tl@tl_next := tlNew;
  196.     fi;
  197.     fi;
  198. corp;
  199.  
  200. /*
  201.  * CancelDoAfter - attempt to cancel an action setup by DoAfter. Note that
  202.  *    DoAfter makes no checks for duplicates. This routine will simply
  203.  *    cancel the first event with the matching object/action that it finds.
  204.  *    In the current implementation, that is the earliest one to trigger.
  205.  *    Return 'false' if no matching event found, else return 'true'.
  206.  */
  207.  
  208. define t_base proc CancelDoAfter(thing object; action a)bool:
  209.     thing tl, next;
  210.  
  211.     tl := TimeBase@tb_first;
  212.     if tl = TimeBase then
  213.     false
  214.     elif tl@tl_object = object and tl@tl_action = a then
  215.     TimeBase@tb_first := tl@tl_next;
  216.     true
  217.     else
  218.     while
  219.         next := tl@tl_next;
  220.         next ~= TimeBase and
  221.         (next@tl_object ~= object or next@tl_action ~= a)
  222.     do
  223.         tl := next;
  224.     od;
  225.     if next = TimeBase then
  226.         false
  227.     else
  228.         tl@tl_next := next@tl_next;
  229.         true
  230.     fi
  231.     fi
  232. corp;
  233.  
  234. /*
  235.  * CancelAllDoAfters - cancel all timer calls for this object. This is
  236.  *    typically done when the object is being destroyed.
  237.  */
  238.  
  239. define t_base proc CancelAllDoAfters(thing object)void:
  240.     thing prev, tl, next;
  241.  
  242.     prev := TimeBase;
  243.     tl := TimeBase@tb_first;
  244.     while tl ~= TimeBase do
  245.     next := tl@tl_next;
  246.     if tl@tl_object = object then
  247.         if prev ~= TimeBase then
  248.         prev@tl_next := next;
  249.         else
  250.         TimeBase@tb_first := next;
  251.         fi;
  252.     else
  253.         prev := tl;
  254.     fi;
  255.     tl := next;
  256.     od;
  257. corp;
  258.  
  259. /*
  260.  * RegisterActiveAction - register an action and object that is to be called
  261.  *    when the server starts up. This facility is most often used to
  262.  *    try to handle the situation of bringing up a database that was
  263.  *    produced by a backup done while the server is active, and thus
  264.  *    the 'idle' actions on the characters and machines have not been
  265.  *    called. This technique is not perfect, but hopefully it helps.
  266.  */
  267.  
  268. define t_base proc RegisterActiveAction(thing object; action a)void:
  269.     thing tlNew;
  270.  
  271.     if object = nil then
  272.     Print("object = nil in RegisterActiveAction\n");
  273.     elif a = nil then
  274.     Print("action = nil in RegisterActiveAction\n");
  275.     else
  276.     tlNew := CreateThing(nil);
  277.     tlNew@tl_object := object;
  278.     tlNew@tl_action := a;
  279.     tlNew@tl_next := TimeBase@tb_firstActive;
  280.     TimeBase@tb_firstActive := tlNew;
  281.     fi;
  282. corp;
  283.  
  284. /*
  285.  * RemoveActiveAction - cancel an action setup by RegisterActiveAction.
  286.  *    Return 'false' if no matching event found, else return 'true'.
  287.  */
  288.  
  289. define t_base proc RemoveActiveAction(thing object; action a)bool:
  290.     thing tl, next;
  291.  
  292.     tl := TimeBase@tb_firstActive;
  293.     if tl = TimeBase then
  294.     false
  295.     elif tl@tl_object = object and tl@tl_action = a then
  296.     TimeBase@tb_firstActive := tl@tl_next;
  297.     true
  298.     else
  299.     while
  300.         next := tl@tl_next;
  301.         next ~= TimeBase and
  302.         (next@tl_object ~= object or next@tl_action ~= a)
  303.     do
  304.         next := tl;
  305.         tl := tl@tl_next;
  306.     od;
  307.     if next = TimeBase then
  308.         false
  309.     else
  310.         tl@tl_next := next@tl_next;
  311.         true
  312.     fi
  313.     fi
  314. corp;
  315.  
  316. define tp_timekeeper proc timerStart()status:
  317.  
  318.     After(IntToFixed(TICK