--  IncreekImpl.mesa
--  Last Edited by Wyatt, October 27, 1982 9:58 pm
--  Last Edited by Stone September 18, 1982 10:31 am
--  Last Edited by McGregor,  1-Sep-81 13:06:53
--  Last Edited by Swinehart, April 14, 1982 5:21 pm
--  Last Edited by Paul Rovner, June 9, 1983 5:45 pm
-- <<<Monitor lock presently used only in Creek Create/Delete code>>

DIRECTORY
  InterminalExtra USING[InsertAction],	--temporary hack September 18, 1982 10:32 am
  ClassInscript USING [
    AdvancePage, COmProc, CopyPageDescriptor, GetPageLimits,
    Inscript, InscriptPageDescriptor, InscriptPageDescBody, InscriptPageNumber, KEyProc,
    NewStdInscript, InscriptError, ReadEntry, ResetPageDescriptor, SetPage, WaitForEntry,
    WaitMode],
  ClassIncreek,
  Intime USING [
    AddDeltaTimeToEventTime, EventTime, EventTimeDifference, IsLaterTime, MsTicks,
    ReadEventTime],
  Interminal USING [
    allUp, DefaultMouseGrain, StartActionRecorder, KeyName,
    --<<--MousePosition-->>--, SetMouseGrain],
  List USING [DRemove, Map]
  ;

IncreekImpl: MONITOR
  IMPORTS ClassInscript, Interminal, Intime, List, InterminalExtra
  EXPORTS ClassIncreek
  SHARES ClassIncreek =
  BEGIN OPEN ClassIncreek, S: ClassInscript, K: Interminal, T: Intime;

-- here temporarily.  Delete in Cedar 3.5
InsertAction: PUBLIC PROCEDURE[self: Increek, action: ActionBody] = {
	InterminalExtra.InsertAction[action];
	};

NewStdIncreek: PUBLIC PROCEDURE [template: Increek _ NIL] RETURNS [Increek] = {
    self: InscriptPosition _ NEW[InscriptPositionBody_
		[inscript: stdInscript,
		inscriptPage: NIL,
		ip1: CreatePageDescriptor[stdInscript],
		iP: NIL,
		ip2: CreatePageDescriptor[stdInscript],
		mousePosition: [0,FALSE,0]]];
    self.inscriptPage_LOOPHOLE[self.ip1];
    self.iP_LOOPHOLE[self.ip2];
    {Flow: ENTRY PROC=INLINE { river_CONS[self, river] }; Flow[]; };
    IF template = NIL THEN {
       SetAtLatest[self]; -- sets up rest of state, too
       SetMouseGrain[self]; }
    ELSE CopyIncreek[self: self, template: template];
    RETURN[self]; };
    
    CreatePageDescriptor: PROC[inscript: S.Inscript] RETURNS [d: REF S.InscriptPageDescBody] = {
    	d_NEW[S.InscriptPageDescBody];
	S.ResetPageDescriptor[inscript, LOOPHOLE[d]];};


Release: PUBLIC PROCEDURE [self: InscriptPosition]
	RETURNS [nilIncreek: Increek] = {
	  SetMouseGrain[self]; -- revert to default
	  { Drain: ENTRY PROC=INLINE { river _ List.DRemove[self, river] }; Drain[]; };
	  RETURN[NIL[Increek]]; };

CopyIncreek: PUBLIC PROCEDURE [self: InscriptPosition, template: InscriptPosition] = {
    pd1: REF S.InscriptPageDescBody _ self.ip1;
    pd2: REF S.InscriptPageDescBody _ self.ip2;
    self^ _ template^;
    self.ip1_pd1; self.inscriptPage_LOOPHOLE[pd1]; self.ip2_pd2; self.iP_LOOPHOLE[pd2];
    S.CopyPageDescriptor[self.inscript, self.inscriptPage, template.inscriptPage]; };


GetAction: PUBLIC PROCEDURE [
    self: InscriptPosition, waitMode: WaitMode _ forever, waitInterval: T.MsTicks _ 100,
    acceptance: Acceptance _ clicks] RETURNS [a: ActionBody] =
    -- Acceptance determines which actions will produce valid return values.
    -- Warning: after invalid return, creek may have been advanced.  Client
    -- must save copy to revert.
    -- Can raise IncreekError[outOfBounds]
    BEGIN
    ENABLE S.InscriptError => IF code=entryOutOfBounds THEN
      ERROR IncreekError[outOfBounds];
    inscript: S.Inscript = self.inscript;
    descriptor: S.InscriptPageDescriptor = self.inscriptPage;
    dCopy: S.InscriptPageDescriptor = self.iP;
	actionBody: ActionBody;
    S.CopyPageDescriptor[self: inscript, dest: dCopy, source: descriptor];
   DO -- until Action accepted
    kN: K.KeyName; -- if no actions left, return NIL unless wait
    WHILE ~S.ReadEntry[self: inscript, descriptor: descriptor,
		destination: @actionBody, LengthProc: ActionLength]
      DO
      IF (~S.AdvancePage[inscript, descriptor]) AND
	(~S.WaitForEntry[inscript, waitMode, waitInterval, descriptor, @self.eventTime]) THEN
	    RETURN[timedOutActionBody];
      ENDLOOP;
    self.eT _ T.AddDeltaTimeToEventTime[self.eT, actionBody.deltaDeltaTime];
    WITH thisA: actionBody SELECT FROM
	deltaEventTime =>
	  self.eT _ T.AddDeltaTimeToEventTime[self.eT, thisA.value];
	eventTime => self.eT _ thisA.eventTime;
	ENDCASE;
    IF waitMode=timed AND T.EventTimeDifference[@self.eT, @self.eventTime] > waitInterval THEN {
      S.CopyPageDescriptor[self: inscript, dest: descriptor, source: dCopy]; RETURN[timedOutActionBody]};
    {
      WITH thisA: actionBody SELECT FROM
	mousePosition => self.mousePosition _ thisA.mousePosition;
	deltaMouse => {
	  self.mousePosition.mouseX _ self.mousePosition.mouseX + thisA.value.deltaX;
	  self.mousePosition.mouseY _ self.mousePosition.mouseY + thisA.value.deltaY };
	keyStillDown => {kN _ thisA.value;
	  IF kN=K.KeyName[allUp] THEN {
	    self.keyState_self.chordState_K.allUp; self.downCount_0; }
	  ELSE GO TO RecordDown; };
	keyDown => {kN _ thisA.value; GO TO RecordDown};
	keyUp => {
	  self.keyState.bits[thisA.value] _ up; self.downCount _ PRED[self.downCount]; };
	deltaEventTime, eventTime => NULL;
	ENDCASE => ERROR Internal[4];
	EXITS -- manual cross-jumping.
	  RecordDown=> {
	    IF self.downCount = 0 THEN self.chordState _ K.allUp;
	    self.downCount _ SUCC[self.downCount];
	    self.keyState.bits[kN] _ self.chordState.bits[kN] _ down;
	    };
      };
    IF acceptance = all THEN EXIT;
    -- see lifetime warning at head of file --
    WITH thisE: actionBody SELECT FROM
      mousePosition, deltaMouse => IF acceptance = clicksAndMotion THEN EXIT;
      keyUp, keyDown => IF acceptance <= clicksAndMotion THEN EXIT;
      ENDCASE;
   ENDLOOP; -- until Action accepted
    self.eventTime_self.eT;
    RETURN[actionBody];
    END;

SetAtEarliest: PUBLIC PROCEDURE [self: InscriptPosition] =
    BEGIN
    ENABLE IncreekError=>IF code=outOfBounds THEN RETRY; -- with new "earliest"
    [] _ FullStateFrom[increek: self, pN: S.GetPageLimits[self.inscript].earliestPageNo];
    END;

SetAtLatest: PUBLIC PROCEDURE [self: InscriptPosition] =
    BEGIN
    ENABLE IncreekError=>IF code=outOfBounds THEN RETRY; -- ??
    [] _ FullStateFrom[increek: self, pN: S.GetPageLimits[self.inscript].latestPageNo];
    WHILE GetAction[self: self, waitMode: dontWait, acceptance: all].kind # timedOut DO
      ENDLOOP;
    END;

SetAtTime: PUBLIC PROCEDURE [self: InscriptPosition, eventTime: T.EventTime]
    RETURNS [pR: PosResult] =
    BEGIN
    ENABLE IncreekError=>IF code=outOfBounds THEN RETRY; -- with new limits
    a: ActionBody;
    res: PosResult _ SetPageAtTime[increek: self, t: eventTime];
    -- sets p just beyond basic actions of that page --
    -- next has to be another increek!!
    nextCreek: InscriptPosition;
    IF res # onTime THEN RETURN[res];
    nextCreek _ NewStdIncreek[template: self];
    DO
      ENABLE IncreekError=>IF code=outOfBounds THEN nextCreek_Release[nextCreek];
      -- painfully slow loop!!!!
      CopyIncreek[self: self, template: nextCreek];
      a _ GetAction[self: nextCreek, waitMode: dontWait, acceptance: all];
      IF a.kind=timedOut THEN GOTO TooLate; -- e.g., no actions waiting --
      IF T.IsLaterTime[nextCreek.eventTime, eventTime] THEN GOTO OnTime;
      REPEAT TooLate => res _ tooLate; OnTime => res _ onTime;
      ENDLOOP;
    nextCreek _ Release[self: nextCreek];
    RETURN[res];
    END;
    
SetMouseGrain: PUBLIC ENTRY PROC [self: InscriptPosition, ticks: T.MsTicks_0, dots: INTEGER_0] = {
  t: T.MsTicks; d: INTEGER;
  GetFinestGrain: SAFE PROC[x: REF ANY, tail: LIST OF REF ANY] = TRUSTED {
    c: InscriptPosition=NARROW[x];
    IF c.mouseGrainTime<t THEN t_c.mouseGrainTime;
    IF c.mouseGrainDots<d THEN d_c.mouseGrainDots; };
  [t,d]_K.DefaultMouseGrain[];
  self.mouseGrainTime_IF ticks=0 THEN t ELSE ticks;
  self.mouseGrainDots_IF dots=0 THEN d ELSE dots;
  List.Map[river, GetFinestGrain];
  K.SetMouseGrain[t,d]; };

GetTime: PUBLIC PROCEDURE [self: InscriptPosition] RETURNS [eT: T.EventTime] = {
    RETURN[self.eventTime];};

GetCurrentTime: PUBLIC PROCEDURE [self: InscriptPosition] RETURNS [eT: T.EventTime] = {
    RETURN[T.ReadEventTime[]]; };

IncreekError: PUBLIC ERROR[code: IncreekErrorCode] = CODE;

SetPageAtTime: PROCEDURE [increek: InscriptPosition, t: T.EventTime]
    RETURNS [res: PosResult] = {
    earlyPageNum, latePageNum, nextPageNum: S.InscriptPageNumber;
    [earlyPageNum, latePageNum] _ S.GetPageLimits[increek.inscript];
    latePageNum _ latePageNum + 1; -- "off the end"
    nextPageNum _ earlyPageNum;
    res _ tooEarly;
    DO
      IF T.IsLaterTime[FullStateFrom[increek, nextPageNum], t] THEN
	latePageNum _ nextPageNum
      ELSE {earlyPageNum _ nextPageNum; res _ onTime; };
      nextPageNum _ (earlyPageNum + latePageNum)/2;
      IF nextPageNum = earlyPageNum THEN EXIT;
      ENDLOOP;
    [] _ FullStateFrom[increek, earlyPageNum];
    -- assert p is positioned just after full state recording in result page --
    RETURN --[res]--};

    ActionLength: PROCEDURE [a: Action] RETURNS [wordsToAdvance: CARDINAL] =
    BEGIN
    wordsToAdvance _
      WITH thisA: a SELECT FROM
	mousePosition, penPosition => SIZE[mousePosition ActionBody],
	deltaMouse => SIZE [deltaMouse ActionBody],
	deltaEventTime, keyUp, keyDown, keyStillDown =>
	  SIZE[keyDown ActionBody],
	eventTime => SIZE[eventTime ActionBody],
	ENDCASE => ERROR Internal[1];
    END;

   timedOutActionBody: ActionBody_[contents: timedOut[]];

  FullStateFrom: PROCEDURE [increek: InscriptPosition, pN: S.InscriptPageNumber]
    RETURNS [t: T.EventTime] =
    BEGIN
    a: ActionBody;
    increek.downCount _ 0;
    increek.chordState _ increek.keyState _ K.allUp;
    IF ~S.SetPage[self: increek.inscript, descriptor: increek.inscriptPage, pageNumber: pN] THEN
      ERROR IncreekError[outOfBounds];
    DO
      a _ GetAction[self: increek, waitMode: dontWait, acceptance: all];
      WITH a SELECT FROM
	keyUp, keyDown, keyStillDown, eventTime, deltaMouse => NULL;
	mousePosition => EXIT;
	ENDCASE => ERROR Internal[3] -- timed out or unrecognized --;
      ENDLOOP;
    RETURN[increek.eventTime];
    END;

  -- Procedures for use in initializing Inscript (where belongs this?  It's going to be hard to get right.

  KeyProc: S.KEyProc =
    BEGIN
    a: ActionBody;
    IF S.ReadEntry[self: inscript, descriptor: descriptor,
		destination: @a, LengthProc: ActionLength] THEN
      WITH thisA: a SELECT FROM
	eventTime => RETURN[LOOPHOLE[thisA.eventTime]];
	ENDCASE;
    ERROR S.InscriptError[invalidPageKey];
    END;

  ComProc: S.COmProc = {RETURN[T.IsLaterTime[LOOPHOLE[a], LOOPHOLE[b]]]; };
  
  Internal: ERROR[code: INTEGER] = CODE;
  
  river: LIST OF REF ANY _ NIL;

--<<support of cursor track hack>>
-- <<  currentCursorPosition: POINTER TO MousePosition = LOOPHOLE[426B]; >>
-- <<  xMax: CARDINAL = 608; >>
-- <<  yMax: CARDINAL = 808; >>
--<<end of hack>>

  -- Initialization; Create standard inscript and terminal server, before returning first Increek.
  stdInscript: S.Inscript;

InitializeIncreek: PROC = {
  NSI: PROC[init: BOOLEAN] RETURNS [S.Inscript] = {RETURN[ S.NewStdInscript[
    KeyProc: KeyProc, ComProc: ComProc, initializeFile: init]];};
 -- !!!! reinitialize on any error before giving up --
  stdInscript _ NSI[FALSE!
    S.InscriptError=> IF code=invalidInscriptFile THEN {
      stdInscript_NSI[TRUE]; CONTINUE}];

  K.StartActionRecorder[stdInscript]; };

InitializeIncreek[];

END.
  
-- << (Goes in GetAction just after all Action info is reflected in state >>
-- <<Hack; track mouse correctly on replay>>
 --<<    currentCursorPosition.mouseX_MAX[MIN[xMax, d.mousePosition.mouseX], 0];>>
 --<<    currentCursorPosition.mouseY_MAX[MIN[yMax, d.mousePosition.mouseY], 0]; >>
-- <<End of hack>>

�ʘJšğÏcÜœ
Ïk	œ�œ�-œ�œ›�œw�œC�œ
�œ�œ"�œ�œ<�œ�œ�œ
�œ�
œ�
œ�
œ�*Ïnœ�œ
�	œTŸ
œ�œ
�	œ�œ�œ,�œA�œ2�œ@�œ�œ�œŸœ�œ
�œ
�œ	�œ �œ�œ
�œ�œ"�œ2�œŸœ�œ�
œ�œ�œ
�
œ"�œ
�
œ�
œ�œ
Ÿœ�œ
�	œ�œ3�œŸœ�œ
�œ
�œ7�œ
�œŸœ�œ
�	œC�œ
�
œ+�œ
�
œ]�œ�œ�
œSŸ	œ�œ
�	œK�
œ5�œ�Iœ�Hœ�œ�'œ�œ�œ
�
œ�œ�œ�œ*�
œ+�
œ8�
œ@�
œI�œ
�œ�
œ
�.œ�œ�
œo�œ�œ�
œ$�œ�
œN�œ�œ�œ�
œB�œ�œ
�œ!�
œZ�œ�œ�œ
�
œ?�œ	�
œF�œ#�œ�œ
�œ•�œ�
œ�œ&�
œ�œ
�œ
�œ/�œ
�œT�œ3�œ�œ�œ�œ
�œ�œ�œ�
œ�œf�œ�œ
�œ�*œ�œ�œ
�œ$�œ�œ
�œ�œ�œ
�œ�œ�œ�œ �œ�œŸ
œ�œ
�	œ �œ�œ�œ�œ
�œ�œ*�
œ3�œŸœ�œ
�	œ �œ�œ�œ�œ
�œ�œ*�
œ1�œL�œ�œ�œŸ	œ�œ
�	œ%�
œ�œ�œ�œ�œ�œ
�œ�œX�3œ�$œ%�œ�œ
�œ:�œ�œ�œ�œ%�œ…
�œ�œ
�œ
�œ�œ
�
œ-�œ
�œ�œ9�œ0�œ�œŸ
œ�œ
�œ
�œ!�
œ�œ
�
œ
�œŸœ�œ
�œ�œ
�œ�œ
�œ
�œ
�œ�œ�œ	�œ�œ�œ�œ �
œ,�œ	�œ�œ�œ�œ�œ,�
œŸœ�œ
�	œ�œ�
œ�œŸœ�œ
�	œ�œ�
œ�œ
�
œ%�œ
�œ�œŸ
œ�	œ �
œ�œB�
œ7�
œE�œ8�œ�œ
�
œ5�œ"�œi�œ�œ
�œ�œ5�Kœ�œ
�	œŸœ�	œ
�œ�œ�œ�œ
�œ
�œ �œ+�œN�œ$�œ�œ�œ�œ@Ÿ
œ�	œ!�
œ�œ�
œ�œ[�
œ�œ�
œS�œ�œ �œP�œ�œ
�œ9�œ�œ�œ�œ
�œ�œ�œ�œ�iœ�
œ�œ�œ
�
œ`�œ�œ
�œ
�œ�œ
�œ�œ�œ
�
œ$�œ�
œ�œ
�
œ
�œ�œ�œ�œ�œ�œ
�œ
�œ
�œ�œ�Á
œ�aœ�
œŸœ�œ�œ�œ�œ�œ�
œ�œ�
œT�5œ�œ
�œ�
œ�œ�œ�œ
�œ�œ�
œ=�œ�zœ
�Rœ
�f˜Á[—…—-Ä3Ò