home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / EVENT.ZIP / EVENT.ENG < prev    next >
Encoding:
Text File  |  1986-09-05  |  4.0 KB  |  134 lines
  1. { Event.eng              Version 1.2  86/08/25
  2.  
  3.  Author: Mike Babulic    Compuserve ID: 72307,314   FIDO: 134/1
  4.          3827 Charleswood Dr. N.W.
  5.          Calgary, Alberta,
  6.          CANADA
  7.          T2L 2C7
  8.  
  9.  This utility uses the procedure pointers routines in "ProcParm.p" to create an
  10.  "engine" for writing event-driven programs.
  11.  
  12.  See EVENT.PAS for an example program.
  13. }
  14.  
  15. {---------------------- Event Engine ----------------------------}
  16.  
  17. type   ActionArray = Array [0..1] of ProcPtr;   {Procedures by Event No.}
  18.        ActionPtr = ^ActionArray;
  19.  
  20. var  theAction: ActionPtr;          {Current Action Array used by the Engine}
  21.      EventEngineFinished: boolean;  {see Quit & DoEvents}
  22.  
  23.  
  24. procedure GetNextEvent(var e:integer; p:ProcPtr); EXTERNAL ProcParm[NEAR];
  25.  
  26. procedure DoProcedure(p:ProcPtr);                 EXTERNAL ProcParm[NEAR];
  27.  
  28. procedure PassEvent(e:integer; p:ProcPtr);        EXTERNAL ProcParm[NEAR];
  29.  
  30. procedure DoNothing;  begin  end;
  31.  
  32. procedure Quit;
  33.   begin
  34.     EventEngineFinished := TRUE;
  35.   end;
  36.  
  37. procedure MissingEvent(event:integer);
  38.   begin
  39.     writeln;
  40.     writeln('*** Programmer error! Event number ',event,' has no Action.');
  41.     writeln('       Check your ActionArray definition.');
  42.     writeln;
  43.     Quit;
  44.   end;
  45.  
  46. procedure DoEvents(Events:ProcPtr; Action:ActionPtr; NoSuchEvent:ProcPtr);
  47. {
  48.       Events -- this is your GetNextEvent(var e:integer) procedure. It returns
  49.                 the number of the Action to execute;
  50.       Action -- the n'th item in this array points to the procedure that will
  51.                 execute when event number n occurs;
  52.       NoSuchEvent -- this is what will be done if the programmer was in idiot
  53.                 mode when he/she/it wrote "Events". The Action number "e" that
  54.                 was returned does not exist!
  55. }
  56.   var
  57.     a: ActionPtr;
  58.     Finished: boolean;
  59.     e: integer;
  60.   begin
  61.     {Save current state in case of recursion}
  62.     a := theAction;
  63.     Finished := EventEngineFinished;
  64.     theAction := Action;
  65.     EventEngineFinished := FALSE;
  66.     repeat
  67.       repeat
  68.         GetNextEvent(e,Events);
  69.       until (e>0) or EventEngineFinished;
  70.       if (e>0) and (e<=Action^[0]) then
  71.         DoProcedure(Action^[e])
  72.       else
  73.         PassEvent(e,NoSuchEvent); {Only a programmer error will get you here!}
  74.     until EventEngineFinished;
  75.     {Restore state to what it was before recursion}
  76.       EventEngineFinished := Finished;
  77.       theAction := a;
  78.   end;
  79.  
  80. {----------------------------  ACTIONS routines ------------------------------}
  81.  
  82. procedure ACTIONS;   EXTERNAL  'Actions.bin';
  83.   {   POP AX        ; Offset of Actions
  84.       MOV DX,CS     ; Seg of Actions (TURBO function returns pointer = DX:AX)
  85.       MOV SP,BP     ; Standard TURBO return sequence
  86.       POP BP
  87.       RET 4         ; Pop function variable
  88.   }
  89.   {
  90.  'ACTIONS' is usually used called in a function of the form:
  91.  
  92.      function ActionsArrayInside: ActionPtr;
  93.        begin
  94.          ACTIONS;
  95.          include( >3         (* 3 events *)
  96.                  /proc1      (* do this on event #1 *)
  97.                  /proc2      (* do this on event #2 *)
  98.                  /proc3      (* do this on event #3 *)
  99.          );
  100.        end;
  101.  
  102.  Causes the function to return a pointer to the ActionArray that follows
  103.  the call to 'ACTIONS'.
  104. }
  105.  
  106. function ActionLen(a:ActionPtr):integer;
  107.   begin
  108.     ActionLen := a^[0];
  109.   end;
  110.  
  111. procedure NewActions(var a:ActionPtr; count:integer);
  112.   var i: integer;
  113.   begin
  114.     GetMem(a,count+count+2);
  115.     a^[0] := count;
  116.     for i := 1 to count do a^[i] := ofs(DoNothing);
  117.   end;
  118.  
  119. procedure DisposeActions(var a:ActionPtr);
  120.   begin
  121.     FreeMem(a,ActionLen(a) shl 1 + 2);
  122.   end;
  123.  
  124. procedure CopyActions(aFrom,aTo:ActionPtr);
  125.   var i,max: integer;
  126.   begin
  127.     if ActionLen(aFrom) > ActionLen(aTo) then
  128.       max:=ActionLen(aTo)
  129.     else
  130.       max:=ActionLen(aFrom);
  131.     for i := 1 to max do aTo^[i] := aFrom^[i];
  132.     for i := max+1 to aFrom^[0] do aTo^[i] := ofs(DoNothing);
  133.   end;
  134.