-- 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𡤀 }
  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𡤀, dots: INTEGER𡤀] = {
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𡤌.mouseGrainTime;
IF c.mouseGrainDots<d THEN d𡤌.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>>