
DIRECTORY Ascii, Basics, CharDisplays, DisplayControllers, IO, RefText, Rope;

DisplayControllersImpl: CEDAR PROGRAM
IMPORTS Basics, CharDisplays, IO, RefText, Rope
EXPORTS DisplayControllers

 = {OPEN DisplayControllers;

neverMind: Action м [proc: Naught, overrideable: TRUE];
print: Action м [proc: Print, overrideable: TRUE];

displayDriverClass: ATOM = $TermEmDisplayController;

displayDriverProcs: REF IO.StreamProcs м IO.CreateStreamProcs[
variety: output,
class: displayDriverClass,
flush: FlushDisplay,
putChar: ConsumeChar,
putBlock: ConsumeChars
];

Create: PUBLIC PROC [cd: CharDisplay, cp: ControlProgram] RETURNS [dc: DisplayController] = {
dc м NEW [DisplayControllerRep м [
cd: cd,
cp: cp,
cps: NEW [ControlProgramStateRep м [
curVertex: cp.start,
chars: RefText.New[10]]],
toDisplay: NIL,
fromDisplay: cd.fromDisplay
]];
IF cp.Init # NIL THEN cp.Init[dc];
dc.toDisplay м IO.CreateStream[streamProcs: displayDriverProcs, streamData: dc];
};

SetDriver: PUBLIC PROC [dc: DisplayController, driver: IO.STREAM] = {
dc.driver м driver;
};

FlushDisplay: PROC [self: IO.STREAM] = {
dc: DisplayController = NARROW[self.streamData];
IF dc.cd.class.Destroyed[dc.cd] THEN ERROR IO.Error[StreamClosed, self];
IF dc.cd.class.Flush # NIL THEN dc.cd.class.Flush[dc.cd];
};

ConsumeChar: PROC [self: IO.STREAM, char: CHAR] = {
dc: DisplayController м NARROW[self.streamData];
consumed: BOOL м FALSE;
IF dc.cd.class.Destroyed[dc.cd] THEN ERROR IO.Error[StreamClosed, self];
SELECT dc.cp.bits FROM
7 => char м VAL[Basics.BITAND[ORD[char], 127]];
8 => NULL;
ENDCASE => ERROR;
IF dc.cps.curVertex = dc.cp.start THEN dc.cps.chars.length м 0;
WHILE dc.cps.chars.length >= dc.cps.chars.maxLength DO dc.cps.chars м RefText.New[dc.cps.chars.maxLength*2] ENDLOOP;
dc.cps.chars м RefText.InlineAppendChar[dc.cps.chars, char];
DO
ENABLE CharDisplays.DisplayDestroyed => ERROR IO.Error[StreamClosed, self];
Do: PROC [t: Transition] = INLINE {
t.action.proc[dc: dc, clientData: t.action.clientData];
dc.cps.curVertex м t.newVertex};
v: Vertex м dc.cps.curVertex;
SELECT v.repStyle FROM
epsilon => Do[v.t];
list => {
el: EdgeList м NIL;
IF consumed THEN EXIT;
consumed м TRUE;
FOR el м v.edgeList, el.rest WHILE el # NIL DO
IF el.first.char = char THEN {Do[el.first.transition]; EXIT};
ENDLOOP;
IF el = NIL THEN Do[v.t];
};
array => {
IF consumed THEN EXIT;
consumed м TRUE;
Do[v.edgeArray[char]];
};
ENDCASE => ERROR;
ENDLOOP;
{driver: IO.STREAM = dc.driver;
flush: BOOL м driver = NIL;
IF NOT flush THEN flush м driver.CharsAvail[!IO.Error => {flush м TRUE; CONTINUE}] = 0;
IF flush AND dc.cd.class.Flush # NIL THEN dc.cd.class.Flush[dc.cd];
};
};

ConsumeChars: PROC [self: IO.STREAM, block: REF READONLY TEXT, startIndex: NAT м 0, count: NAT м NAT.LAST] = {
ENABLE CharDisplays.DisplayDestroyed => ERROR IO.Error[StreamClosed, self];

dc: DisplayController м NARROW[self.streamData];

IF startIndex+count > block.maxLength THEN count м block.length - startIndex;

FOR i: INT IN [startIndex..startIndex+count) DO
char: CHAR м block[i];
consumed: BOOL м FALSE;

IF dc.cd.class.Destroyed[dc.cd] THEN ERROR IO.Error[StreamClosed, self];
SELECT dc.cp.bits FROM
7 => char м VAL[Basics.BITAND[ORD[char], 127]];
8 => NULL;
ENDCASE => ERROR;
IF dc.cps.curVertex = dc.cp.start THEN dc.cps.chars.length м 0;
WHILE dc.cps.chars.length >= dc.cps.chars.maxLength DO dc.cps.chars м RefText.New[dc.cps.chars.maxLength*2] ENDLOOP;
dc.cps.chars м RefText.InlineAppendChar[dc.cps.chars, char];

DO
Do: PROC [t: Transition] = INLINE {
t.action.proc[dc: dc, clientData: t.action.clientData];
dc.cps.curVertex м t.newVertex};
v: Vertex м dc.cps.curVertex;
SELECT v.repStyle FROM
epsilon => Do[v.t];
list => {
el: EdgeList м NIL;
IF consumed THEN EXIT;
consumed м TRUE;
FOR el м v.edgeList, el.rest WHILE el # NIL DO
IF el.first.char = char THEN {Do[el.first.transition]; EXIT};
ENDLOOP;
IF el = NIL THEN Do[v.t];
};
array => {
IF consumed THEN EXIT;
consumed м TRUE;
Do[v.edgeArray[char]];
};
ENDCASE => ERROR;
ENDLOOP;

ENDLOOP;

-- Consider flushing
IF dc.cd.class.Flush # NIL THEN  {
IF (dc.driver#NIL) AND (dc.driver.CharsAvail[!IO.Error=>CONTINUE] >0 ) THEN RETURN;
dc.cd.class.Flush[dc.cd]
}
};

NewControlProgram: PUBLIC PROC [Init: PROC [dc: DisplayController] м NIL, clientData: REF ANY м NIL, bits: [7 .. 8] м 8] RETURNS [cp: ControlProgram] = {
sv: Vertex м NEW [VertexRep м [repStyle: array]];
sv.edgeArray м NEW [TransitionArrayRep м ALL[[print, sv]]];
cp м NEW [ControlProgramRep м [
start: sv,
Init: Init,
clientData: clientData,
bits: bits]];
};

AddInstruction: PUBLIC PROC [cp: ControlProgram, steps: StepList, final: Action] = {
v: Vertex м cp.start;
FOR steps м steps, steps.rest WHILE steps # NIL DO
lastStep: BOOL м steps.rest = NIL;
WITH steps.first SELECT FROM
t: REFTEXT => {
lastI: INT = t.length-1;
FOR i: INT IN [0 .. lastI] DO
IF lastStep AND i=lastI
THEN v м Merge[cp: cp, char: t[i], v: v, last: TRUE, a: final]
ELSE v м Merge[cp: cp, char: t[i], v: v, last: FALSE];
ENDLOOP;
IF lastStep THEN final м neverMind;
};
r: ROPE => {
lastI: INT = r.Length[]-1;
FOR i: INT IN [0 .. lastI] DO
IF lastStep AND i=lastI
THEN v м Merge[cp: cp, char: r.Fetch[i], v: v, last: TRUE, a: final]
ELSE v м Merge[cp: cp, char: r.Fetch[i], v: v, last: FALSE];
ENDLOOP;
IF lastStep THEN final м neverMind;
};
d: Decode => {
IF d.len = 0 THEN {
dec0: Action м DecodeAction[d, 0];
dec1: Action м DecodeAction[d, 1];
IF lastStep THEN ERROR;
v м MergeDigits[d: d, cp: cp, last: FALSE, a: dec0, v: v];
IF v # MergeDigits[d: d, cp: cp, last: FALSE, to: v, a: dec1, v: v] THEN ERROR;
}
ELSE {
FOR i: INT IN [0 .. d.len) DO
dec: Action м DecodeAction[d, i];
v м MergeDigits[d: d, cp: cp, last: lastStep AND i=d.len-1 AND final=neverMind, a: dec, v: v];
ENDLOOP;
};
};
ENDCASE => ERROR;
IF (v = cp.start) # (lastStep AND final = neverMind) THEN ERROR;
ENDLOOP;
IF final # neverMind THEN {
IF v = cp.start THEN ERROR;
v м Append[cp: cp, a: final, from: v, to: cp.start]};
IF v # cp.start THEN ERROR;
};

Replaceable: PROC [cp: ControlProgram, t: Transition, from: Vertex, a: Action] RETURNS [boring: BOOL] = {
boring м t.action.overrideable OR ActionEqual[t.action, a]};

ActionEqual: PROC [a1, a2: Action] RETURNS [eq: BOOL] = {
IF a1.proc # a2.proc THEN RETURN [FALSE];
IF a1.clientData = a1.clientData THEN RETURN [TRUE];
WITH a1.clientData SELECT FROM
dd1: DecodeData => WITH a2.clientData SELECT FROM
dd2: DecodeData => RETURN [dd1.i = dd2.i AND dd1.dн = dd2.dн];
ENDCASE => RETURN [FALSE];
ENDCASE => RETURN [FALSE];
};

AddEpsilon: PROC [t: Transition, a: Action] RETURNS [u: Transition] = {
u м [
action: a,
newVertex: NEW [VertexRep м [epsilon, t]]
]};

MergeDigits: PROC
[
d: Decode,
cp: ControlProgram,
last: BOOL,
to: Vertex м NIL,
a: Action,
v: Vertex]
RETURNS [newV: Vertex] = {
deltaMax: NAT м MIN[(LAST[CHAR] - d.org), d.base-1];
newV м to;
FOR c: CHAR IN [d.org .. d.org + deltaMax] DO
xc: CHAR м 0C + XOR[c-0C, d.xor];
ans: Vertex м Merge[cp: cp, last: last, char: xc, to: newV, a: a, v: v];
IF newV = NIL THEN newV м ans ELSE IF newV # ans THEN ERROR;
ENDLOOP;
};

Append: PROC [cp: ControlProgram, a: Action, from, to: Vertex м NIL] RETURNS [newV: Vertex] = {
IF NOT (from.repStyle = list AND from.edgeList = NIL AND from.t = [print, cp.start]) THEN ERROR;
from.repStyle м epsilon;
IF to # NIL THEN {
IF to # from.t.newVertex THEN ERROR;
from.t.action м a;
newV м from.t.newVertex;
}
ELSE {
newV м NEW [VertexRep м [repStyle: list, t: [print, cp.start]]];
from.t м [a, newV];
};
};

Merge: PROC
[
cp: ControlProgram,
last: BOOL,
char: CHAR,
to: Vertex м NIL,
a: Action м neverMind,
v: Vertex]
RETURNS [newV: Vertex]
= {
NextV: PROC RETURNS [v: Vertex] = {
v м IF to # NIL
THEN to
ELSE NEW [VertexRep м [repStyle: list, t: DefaultEnd[cp]]];
};
Update: PROC [oldT: Transition] RETURNS [newT: Transition] = {
oldNext: Vertex м oldT.newVertex;
rbl: BOOL м Replaceable[cp, oldT, v, a];
IF oldNext # to THEN {
IF to # NIL AND ((NOT rbl) OR oldNext # cp.start) THEN ERROR;
IF to = NIL AND (NOT rbl) AND (oldNext = cp.start OR NOT a.overrideable) THEN ERROR;
};
newT м oldT;
IF rbl THEN {
IF oldNext = cp.start OR to # NIL THEN newT м [a, NextV[]] ELSE newT.action м a;
}
ELSE IF to # NIL AND NOT a.overrideable THEN newT м AddEpsilon[newT, a];
};
IF last THEN {
IF to = NIL THEN to м cp.start ELSE IF to # cp.start THEN ERROR;
IF a = neverMind THEN a м print;
};
SELECT v.repStyle FROM
epsilon => ERROR;
list => {
el: EdgeList м NIL;
FOR el м v.edgeList, el.rest WHILE el # NIL DO
IF el.first.char = char THEN EXIT;
ENDLOOP;
IF el = NIL THEN v.edgeList м el м CONS[[char: char, transition: v.t], v.edgeList];
newV м (el.first.transition м Update[el.first.transition]).newVertex;
};
array => {
newV м (v.edgeArray[char] м Update[v.edgeArray[char]]).newVertex;
};
ENDCASE => ERROR;
DO
SELECT newV.repStyle FROM
epsilon => newV м newV.t.newVertex;
list, array => EXIT;
ENDCASE => ERROR;
ENDLOOP;
IF last AND newV # cp.start THEN ERROR;
};

DefaultEnd: PROC [cp: ControlProgram] RETURNS [t: Transition] =
{t м [action: print, newVertex: cp.start]};

ClearRegAction: PROC [d: Decode] RETURNS [a: Action] =
{a м [proc: ClearReg, clientData: d]};

ClearReg: PROC [dc: DisplayController, clientData: REF ANY] = {
d: Decode м NARROW[clientData];
dc.cps.regs[d.reg] м d.offset};

DecodeData: TYPE = REF DecodeDataRep;
DecodeDataRep: TYPE = RECORD [
d: Decode,
i: NAT];

DecodeAction: PROC [d: Decode, i: NAT] RETURNS [a: Action] =
{a м [proc: DecodeReg, clientData: NEW [DecodeDataRep м [d, i]]]};

DecodeReg: PROC [dc: DisplayController, clientData: REF ANY] = {
dd: DecodeData м NARROW[clientData];
c: CHAR м dc.cps.chars[dc.cps.chars.length-1];
IF dd.i = 0 THEN dc.cps.regs[dd.d.reg] м dd.d.offset;
dc.cps.regs[dd.d.reg] м
(dc.cps.regs[dd.d.reg] - dd.d.offset) * dd.d.base
+ (XOR[c-0C, dd.d.xor] - (dd.d.org - 0C))
+ dd.d.offset;
};

XOR: PROC [i1, i2: INTEGER] RETURNS [i3: INTEGER] =
TRUSTED {i3 м Basics.BITXOR[i1, i2]};

Naught: PUBLIC PROC [dc: DisplayController, clientData: REF ANY] = {};

Print: PUBLIC PROC [dc: DisplayController, clientData: REF ANY] = {
Do: PROC [c: CHAR] = INLINE {dc.cd.class.TakeChar[dc.cd, c, dc.cps.modes[insert]]};
FOR i: INT IN [0 .. dc.cps.chars.length) DO Do[dc.cps.chars[i]] ENDLOOP;
};

}.
   L  
DisplayControllersImpl.Mesa
Copyright ╙ 1990, 1992 by Xerox Corporation.  All rights reserved.
Mike Spreitzer August 26, 1986 9:23:58 pm PDT
Last tweaked by Mike Spreitzer on November 6, 1989 3:34:13 pm PST
Norman Adams, March 13, 1990 2:05 pm PST
Add conditional to FlushDisplay, add method for putBlock.
Consider Flushing:
Э╩╚  ХNewlineDelimiter
Ц(cedarcode) styleЩ codeЩKЪЬ
╧eЬ7ЩBKЩ-KЩAЩ(KЩ9ЧЧKШ KЪ╧k	Ь2ЮЬШMKШ Ъ╨bxЬЮЬЮШ%KЪЮЬЮЬШ/KЪЮЬШKШ KЪЬЮЬШKШ KЪЬ1ЮЬШ7KЪЬ,ЮЬШ2KШ KЪЬЮЬШ4KШ ЪЬЮЬЮЬЮЬШ>KШKШKШKШKШKШЧKШ Ъ╧nЬЮЬЮЬ'ЮЬШ]ЪЬЮЬШ"KШKШЪЬЮЬШ$KЪЬШKЪЬШЧKЪЬЮЬШKЪЬШKЪЬШЧKЪЮЬЮЬЮЬШ"KЪЬЮЬ?ШPKШЧKШ Ъ
а	ЬЮЬЮЬ!ЮЬЮЬШEKШKШЧKШ ЪаЬЮЬЮЬЮЬШ(KЪЬЮЬШ0KЪЮЬЮЬЮЬЮЬШHKЪЮЬЮЬЮЬШ9KШЧKШ Ъ
аЬЮЬЮЬЮЬЮЬШ3KЪЬЮЬШ0KЪЬ
ЮЬЮЬШKЪЮЬЮЬЮЬЮЬШHЪЮЬЮШKЪЬЮЬЮЬЮЬШ/KЪЬЮЬШ
KЪЮЬЮЬШЧKЪЮЬ ЮЬШ?KЪЮЬ/ЮЬ6ЮЬШtKШ<ЪЮШKЪЮЬ"ЮЬЮЬШKЪаЬЮЬЮЬШ#KШ7KШ ЧKШЪЮЬЮШKЪЬШЪЬ	Ш	KЪЬЮЬШKЪЮЬ
ЮЬЮЬШKЪЬЮЬШЪЮЬЮЬЮЬЮШ.KЪЮЬЮЬЮЬШ=KЪЮЬШЧKЪЮЬЮЬЮЬ	ШKШЧЪЬ
Ш
KЪЮЬ
ЮЬЮЬШKЪЬЮЬШKШKШЧKЪЮЬЮЬШЧKЪЮЬШЧЩKЪЬ	ЮЬЮЬШKЪЬЮЬЮЬШKЪЮЬЮЬЮЬЮЬЮЬЮЬШWKЪЮЬЮЬЮЬЮЬШCKШЧKШKШ ЧЪаЬЮЬЮ	Ь	ЮЬЮЬЮЬЮЬЮЬЮЬШnKЪЮЬ"ЮЬЮЬШKKШ KЪЬЮЬШ0KШ KЪЮЬ$ЮЬ#ШMKШ ЪЮЬЮЬЮЬ ЮШ/KЪЬЮЬШKЪЬ
ЮЬЮЬШKШ KЪЮЬЮЬЮЬЮЬШHЪЮЬЮШKЪЬЮЬЮЬЮЬШ/KЪЬЮЬШ
KЪЮЬЮЬШЧKЪЮЬ ЮЬШ?KЪЮЬ/ЮЬ6ЮЬШtKШ=ЪЮШЪаЬЮЬЮЬШ#KШ7KШ ЧKШЪЮЬЮШKЪЬШЪЬ	Ш	KЪЬЮЬШKЪЮЬ
ЮЬЮЬШKЪЬЮЬШЪЮЬЮЬЮЬЮШ.KЪЮЬЮЬЮЬШ=KЪЮЬШЧKЪЮЬЮЬЮЬ	ШKШЧЪЬ
Ш
KЪЮЬ
ЮЬЮЬШKЪЬЮЬШKШKШЧKЪЮЬЮЬШЧKЪЮЬШ	ЧKЪЮЬШKШ KЪ╧cШЪЮЬЮЬЮЬШ"KЪЮЬЮЬЮЬЮЬЮЬЮШSKЪЬШKШЧKШЧЧKШ ЪаЬЮЬЮЬаЬЮЬЮЬЮЬЮЬЮЬЮЬШЩKЪЬЮЬ!Ш1KЪЬЮЬЮЬШ;ЪЬЮЬШKЪЬ
Ш
KЪаЬШKШKШЧKШЧKШ ЪаЬЮЬЮЬ9ШTKШЪЮЬЮЬ	ЮЬЮШ2KЪЬ
ЮЬЮЬШ"ЪЮЬЮЬЮШЪЬЮЬШKЪЬЮЬШЪЮЬЮЬЮЬЮШЪЮЬ
ЮЬШKЪЮЬ+ЮЬШ>KЪЮЬ+ЮЬШ6ЧKЪЮЬШЧKЪЮЬ
ЮЬШ#KЪЬШЧЪЬЮЬШKЪЬЮЬШЪЮЬЮЬЮЬЮШЪЮЬ
ЮЬШKЪЮЬ1ЮЬШDKЪЮЬ1ЮЬШ<ЧKЪЮЬШЧKЪЮЬ
ЮЬШ#KЪЬШЧШЪЮЬЮЬШKШ"KШ"KЪЮЬ
ЮЬЮЬШKЪЬ$ЮЬШ:KЪЮЬ%ЮЬЮЬЮЬШOKШЧЪЮЬШЪЮЬЮЬЮЬЮШKШ!KЪЬ-ЮЬЮЬ Ш^KЪЮЬШЧKШЧKШЧKЪЮЬЮЬШЧKЪЮЬЮЬЮЬЮЬШ@KЪЮЬШЧЪЮЬЮЬШKЪЮЬЮЬЮЬШKШ5ЧKЪЮЬЮЬЮЬШKШЧKШ ЪаЬЮЬ>ЮЬ
ЮЬШiKЪЬЮЬШ<ЧKШ ЪаЬЮЬЮЬЮЬШ9KЪЮЬЮЬЮЬЮЬШ)KЪЮЬЮЬЮЬЮЬШ4ЪЮЬЮЬЮШЪЬЮЬЮЬЮШ1KЪЬЮЬЮЬШ>KЪЮЬЮЬЮЬШЧKЪЮЬЮЬЮЬШЧKШЧKШ Ъа
ЬЮЬЮЬШGШKШ
KЪЬЮЬШ)KШЧЧKШ ЪаЬЮШШKШ
KШKЪЬЮЬШKЪЬЮЬШKШ
KШ
ЧKЪЮЬШKЪ	Ь
ЮЬЮЬЮЬЮЬШ4KШ
ЪЮЬЮЬЮЬЮШ-KЪЬЮЬЮЬШ!KШHKЪЮЬЮЬЮЬЮЬЮЬЮЬЮЬШ<KЪЮЬШЧKШЧKШ ЪаЬЮЬ4ЮЬЮЬШ_KЪЮЬЮЬЮЬЮЬЮЬЮЬЮЬШ`KШЪЮЬЮЬЮЬШKЪЮЬЮЬЮЬШ$KШKШKШЧЪЮЬШKЪЬЮЬ6Ш@KШKШЧKШЧKШ ЪаЬЮШЪЬШKШKЪЬЮЬШKЪЬЮЬШKЪЬЮЬШKШKШ
ЧKЪЮЬШKШЪаЬЮЬЮЬШ#ЪЬЮЬЮШKЪЮЬШKЪЮЬЮЬ3Ш;ЧKШЧЪаЬЮЬЮЬШ>KШ!KЪЬЮЬШ(ЪЮЬЮЬШKЪЮЬЮЬЮЬЮЬЮЬЮЬЮЬШ=KЪЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШTKЪЬШЧKШЪЮЬЮЬШKЪ
ЮЬЮЬЮЬЮЬЮЬШPKШЧKЪЮЬЮЬЮЬЮЬЮЬЮЬШHKШЧЪЮЬЮЬШKЪЮЬЮЬЮЬЮЬЮЬЮЬЮЬШ@KЪЮЬЮЬШ KШЧЪЮЬЮШKЪЬЮЬШЪЬ	Ш	KЪЬЮЬШЪЮЬЮЬЮЬЮШ.KЪЮЬЮЬЮЬШ"KЪЮЬШЧKЪЮЬЮЬЮЬЮЬ,ШSKШEKШЧЪЬ
Ш
KШAKШЧKЪЮЬЮЬШЧЪЮШЪЮЬЮШKШ#KЪЬЮЬШKЪЮЬЮЬШЧKЪЮЬШЧKЪЮЬЮЬЮЬЮЬШ'KШЧKШ Ъа
ЬЮЬЮЬШ?KШ+ЧKШ ЪаЬЮЬЮЬШ6KШ&ЧKШ ЪаЬЮЬ%ЮЬЮЬШ?KЪЬЮЬШKШЧKШ KЪЬЮЬЮЬШ%ЪЬЮЬЮЬШKШ
KЪЬЮЬШЧKШ ЪаЬЮЬЮЬЮЬШ<KЪЬ#ЮЬШBЧKШ Ъа	ЬЮЬ%ЮЬЮЬШ@KЪЬЮЬШ$KЪЬЮЬ'Ш.KЪЮЬ
ЮЬ%Ш5ШKЪЬ1Ш1KЪЬЮЬ#Ш)KЪЬШЧKШЧKШ Ъ
ЮЬЮЬ
ЮЬЮЬЮЬШ3KЪЮЬЮЬ
Ш%ЧKШ KЪ
аЬЮЬЮЬ%ЮЬЮЬШFKШ Ъ
аЬЮЬЮЬ%ЮЬЮЬШCKЪаЬЮЬЮЬЮЬ8ШSKЪ
ЮЬЮЬЮЬЮЬЮЬШHKЪЬШЧKШ KШЧЧ ЕЧ    '▐  7Є  