home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Open Prolog 1.0.3d23 / External Predicates… / Sources / countHLE.p next >
Encoding:
Text File  |  1995-11-10  |  3.3 KB  |  116 lines  |  [TEXT/MPS ]
  1. {$D+} { MacsBug symbols on }
  2. {$R-} { No range checking }
  3.  
  4. UNIT countHLE;
  5.  
  6.   INTERFACE
  7.  
  8.     USES appleEvents,standardFile,
  9.          prlxdefinitions, prlxLibraries;
  10.  
  11.     PROCEDURE entrypoint(plist: prlxptr);
  12.  
  13.   IMPLEMENTATION
  14.  
  15.     TYPE
  16.       eventPtr = ^eventRecord;
  17.       longintH = ^longintP;
  18.       longintP = ^longint;
  19.  
  20.     PROCEDURE main(plist: prlxptr);
  21.       FORWARD;
  22.  
  23.     PROCEDURE entrypoint(plist: prlxptr);
  24.  
  25.       BEGIN
  26.         main(plist);
  27.       END;
  28.  
  29.     FUNCTION eventCounter(myData: longintH;
  30.                           theEvent: eventPtr): longint;
  31.  
  32.       BEGIN
  33.  
  34.         IF OSType(theEvent^.message) = kCoreEventClass THEN
  35.           myData^^ := myData^^ + 1;
  36.  
  37.         eventCounter := messageNoReply;
  38.  
  39.         {send messageNoReply back to allow the event to be processed normally}
  40. {any other reply will bypass normal event processing and will be the output of the user interface loop}
  41.         {a benign reply for an event you use up would be 'messageOK'}
  42.  
  43.       END;
  44.  
  45.     PROCEDURE main;
  46.  
  47.       TYPE
  48.         integerHandle = ^integerPtr;
  49.         integerPtr = ^integer;
  50.         longintHandle = ^longintPtr;
  51.         longintPtr = ^longint;
  52.  
  53.       VAR
  54.         numberOfMenus, i: integer;
  55.         theMenuHandle: menuHandle;
  56.         theMenuList: handle;
  57.         t: str255;
  58.         t1: ptr;
  59.         t2: longint;
  60.         menuExists: boolean;
  61.  
  62.       BEGIN
  63.         WITH plist^ DO
  64.           BEGIN
  65.           CASE request OF
  66.             getPRLXInfo:
  67.               BEGIN
  68.               data[1] := 1; {number of predicates defined}
  69.               data[2] := eventsVersion;
  70.               END;
  71.             initialisepredicate:
  72.               CASE id OF
  73.                 1:
  74.                   BEGIN
  75.                   s := 'system$count$high$level$events'; {name}
  76.                   data[1] := 1; {arity 1 - count}
  77.                   data[2] := longint(newHandle(sizeof(longint)));
  78.                   longintH(data[2])^^ := 0;
  79.                   callbackrequest := sendEvents; {get prolog to pass raw events
  80.                                                   to… }
  81.                   callbackdata[1] := ord(@eventCounter); {this function (note
  82.                                                           its parameter passing
  83.                                                           scheme) }
  84.                   callbackdata[2] := data[2]; {this will be the 'myData' passed
  85.                                                to eventCounter}
  86.                   callback(entrypoint);
  87.                   END;
  88.                 OTHERWISE
  89.                   errorstr('predicate index out of range at initialise', plist);
  90.               END;
  91.             callpredicate:
  92.               BEGIN
  93.               determinate := true;
  94.               CASE id OF
  95.                 1:
  96.                   BEGIN
  97.                   successful := returnValue(1, longintH(data[2])^^, plist);
  98.                   END;
  99.                 OTHERWISE
  100.                   errorstr('predicate index out of range at call', plist);
  101.               END;
  102.               END;
  103.             closepredicate:
  104.               BEGIN
  105.               CASE id OF
  106.                 1: ;
  107.                 OTHERWISE
  108.                   errorstr('predicate index out of range at close', plist);
  109.               END;
  110.               END;
  111.             OTHERWISE errorstr('unknown call to external procedures', plist);
  112.           END;
  113.           END;
  114.       END;
  115. END.
  116.