<<>>
<<G2dPlayCmdImpl.mesa>>
<<Copyright Ó 1988, 1992 by Xerox Corporation.  All rights reserved.>>
<<Bloomenthal, July 20, 1992 12:49 pm PDT>>

DIRECTORY AIS, AISExtras, BasicTime, CedarProcess, Commander, CommanderOps, Controls, Convert, FileNames, FS, G2dTool, 
ImagerSample, IO, MessageWindow, Process, Real, Rope, RopeFile, SF, ViewerClasses, ViewerTools;

G2dPlayCmdImpl: CEDAR MONITOR
IMPORTS AIS, AISExtras, BasicTime, CedarProcess, CommanderOps, Controls, Convert, FileNames, FS, G2dTool, ImagerSample, IO, 
MessageWindow, Process, Real, Rope, ViewerTools

~ BEGIN
<<Types>>
Box:                        TYPE ~ ImagerSample.Box;
SampleMap:                TYPE ~ ImagerSample.SampleMap;
ROPE:                        TYPE ~ Rope.ROPE;
Viewer:                    TYPE ~ ViewerClasses.Viewer;

StartStop:                    TYPE ~ RECORD [start, stop: NAT];

Map:                        TYPE ~ RECORD [fbA, fbB: SampleMap Ź NIL];
MapSequence:            TYPE ~ REF MapSequenceRep;
MapSequenceRep:        TYPE ~ RECORD [
length:                            CARDINAL Ź 0,
element:                            SEQUENCE maxLength: CARDINAL OF Map
];

Key:                        TYPE ~ REF KeyRep;
KeyRep:                    TYPE ~ RECORD [
start, stop, x, y:                    INT,
maps:                                LIST OF INT,
box:                                Box Ź [[0, 0], [INTEGER.LAST, INTEGER.LAST]],
speed:                                REAL,
color:                                BOOL
];

KeySequence:            TYPE ~ REF KeySequenceRep;
KeySequenceRep:        TYPE ~ RECORD [
length:                            CARDINAL Ź 0,
element:                            SEQUENCE maxLength: CARDINAL OF Key
];

Data:                        TYPE ~ REF DataRep;
DataRep:                    TYPE ~ RECORD [
dir:                                ROPE Ź NIL,
fileName:                            ROPE Ź NIL,
keys:                                KeySequence Ź NIL,
maps:                                MapSequence Ź NIL,
frame, speed:                        Controls.Control Ź NIL,
startButton, stopButton:            Controls.Button Ź NIL,
process:                            CedarProcess.Process Ź NIL,
function:                            ROPE Ź NIL,
bw, fbA, fbB:                    SampleMap Ź NIL,
outer:                                Viewer Ź NIL
];
<<Play Command>>
PlayCmd: Commander.CommandProc ~ {
argv: CommanderOps.ArgumentVector Ź CommanderOps.Parse[cmd];
IF argv.argc # 2
THEN RETURN[$Failure, "usage: Play <play file>"]
ELSE {
stop, start: INT;
d: Data Ź NEW[DataRep];
d.dir Ź FileNames.CurrentWorkingDirectory[];
d.fileName Ź FS.ExpandName[FileNames.ResolveRelativePath[argv[1]]].fullFName;
msg Ź Parse[d];
IF msg # NIL THEN RETURN[$Failure, msg];
IF d.keys = NIL THEN RETURN[$Failure, "No keys!"];
d.speed Ź Controls.NewControl[name: "xSpeed", type: hSlider, clientData: d, min: 0.01, max: 100.0, init: 1.0, w: 130, taper: exp, 
proc: Speed, textLocation: [left, left]];
d.frame Ź Controls.NewControl[name: "Frame", proc: Frame, type: hSlider, clientData: d, min: 0, max: 0, init: 0, w: 130, precision: 
0, textLocation: [left, left]];
d.startButton Ź Controls.TextButton["Start", "0   "];
d.stopButton Ź Controls.TextButton["Stop", "0   "];
d.outer Ź Controls.OuterViewer[
name: Rope.Cat["2dPlay ", argv[1]],
column: right,
controls: LIST[d.frame, d.speed],
buttons: LIST[
Controls.ClickButton["Stop", Button, d],
Controls.ClickButton["ReRead", Button, d],
Controls.ClickButton["Play", Button, d],
Controls.ClickButton["Cycle", Button, d],
Controls.ClickButton["Shuttle", Button, d],
d.startButton,
d.stopButton,
Controls.ClickButton[name: "Store", proc: Store, clientData: d, guarded: TRUE]],
destroyProc: DestroyProc,
clientData: d
].parent;
d.frame.min Ź REAL[start Ź d.keys[0].start];
d.frame.max Ź REAL[stop Ź d.keys[d.keys.length-1].stop];
ViewerTools.SetContents[d.startButton.textViewer, IO.PutFR["%g", IO.int[start]]];
ViewerTools.SetContents[d.stopButton.textViewer, IO.PutFR["%g", IO.int[stop]]];
};
};

DestroyProc: Controls.DestroyProc ~ {CedarProcess.Abort[NARROW[clientData, Data].process]};
<<Reading AIS files>>
GetMapError: ERROR;

GetMap: PROC [aisName: ROPE, place: BOOL] RETURNS [map: Map] ~ {
GetSingleAIS: PROC [name: ROPE] RETURNS [s: SampleMap] ~ {
fRef: AIS.FRef Ź AIS.OpenFile[name];
IF place THEN placement Ź AIS.ReadPlacement[fRef];
IF fRef.raster.bitsPerPixel = 0 THEN fRef.raster.bitsPerPixel Ź 1;    -- 1 bit AIS weirdosity
s Ź ImagerSample.Copy[AISExtras.SampleMapFromFRef[fRef]];
};
Place: PROC [map: SampleMap] RETURNS [s: SampleMap] ~ {
s Ź ImagerSample.Shift[map, [placement.yBottom, placement.xLeft]];
}; 
placement: AIS.Placement;
name1, name2, name3: ROPE;
[name1, name2, name3] Ź GetNames[aisName];
SELECT TRUE FROM
name1 # NIL AND name2 = NIL AND name3 = NIL => {
map.fbA Ź GetSingleAIS[aisName];
IF place THEN map.fbA Ź Place[map.fbA];
};
name1 # NIL AND name2 # NIL AND name3 # NIL => {
map.fbA Ź RGFromRedAndGrn[GetSingleAIS[name1], GetSingleAIS[name2]];
map.fbB Ź GetSingleAIS[name3];
IF place THEN map Ź [Place[map.fbA], Place[map.fbB]];
};
ENDCASE => ERROR GetMapError;
};

GetNames: PROC [fileName: ROPE] RETURNS [name1, name2, name3: ROPE Ź NIL] ~ {
<<Figure out the real ais names; stolen from CtFileImpl:>>
GetColorAISNames: PUBLIC PROC [name: ROPE] RETURNS [red, grn, blu: ROPE] ~ {
FileChoice: PROC [name, r, g, b: ROPE] RETURNS [result: ROPE] ~ {
AisSuffix: PROC [base, suffix: ROPE] RETURNS [name: ROPE] ~ {
name Ź IO.PutFR["%g-%g.ais", IO.rope[base], IO.rope[suffix]];
};
IF FileExists[result Ź AisSuffix[name, r]] THEN RETURN;
IF FileExists[result Ź AisSuffix[name, g]] THEN RETURN;
IF NOT FileExists[result Ź AisSuffix[name, b]] THEN RETURN[NIL];
};
IF (red Ź FileChoice[name, "red", "r", "r"]) = NIL THEN RETURN[NIL, NIL, NIL];
IF (grn Ź FileChoice[name, "grn", "green", "g"]) = NIL THEN RETURN[NIL, NIL, NIL];
IF (blu Ź FileChoice[name, "blu", "blue", "b"]) = NIL THEN RETURN[NIL, NIL, NIL];
};
FileExists: PROC [name: ROPE] RETURNS [ok: BOOL Ź TRUE] ~ {
[] Ź FS.FileInfo[name ! FS.Error => {ok Ź FALSE; CONTINUE}];
};
name: ROPE Ź FileNames.ResolveRelativePath[fileName];
suffix: ROPE Ź FileNames.Tail[FileNames.StripVersionNumber[name], '.];
IF Rope.Equal[suffix, "ais", FALSE] AND FileExists[name] THEN RETURN[name];
[name1, name2, name3] Ź GetColorAISNames[name];
IF name1 # NIL AND name2 # NIL AND name3 # NIL THEN RETURN;
IF FileExists[Rope.Cat[name, ".ais"]] THEN RETURN[Rope.Cat[name, ".ais"]];
IF FileExists[name] THEN RETURN[name];
};

RGFromRedAndGrn: PROC [red, grn: SampleMap] RETURNS [rgMap: SampleMap] ~ {
<<Convert two 8 bpp maps to one 16 bpp map, for fbB display; stolen from CtMiscImpl:>>
GetRedGrn: PUBLIC PROC [rg: SampleMap] RETURNS [SampleMap] ~ TRUSTED {
size: SF.Vec Ź ImagerSample.GetSize[rg];
bitsPerLine: INT Ź ImagerSample.GetBitsPerLine[NARROW[rg]];
RETURN[ImagerSample.ObtainUnsafeDescriptor[size: [size.s, 2*size.f], bitsPerSample: 8, bitsPerLine: bitsPerLine, base: 
ImagerSample.GetBase[NARROW[rg]], ref: rg, words: ImagerSample.WordsForMap[size, 16, bitsPerLine]]];
};
box: SF.Box Ź ImagerSample.GetBox[red];
size: SF.Vec Ź ImagerSample.GetSize[red];
xMin2: NAT Ź 2*box.min.f;
redLineBuf: ImagerSample.SampleBuffer Ź ImagerSample.ObtainScratchSamples[size.f];
grnLineBuf: ImagerSample.SampleBuffer Ź ImagerSample.ObtainScratchSamples[size.f];
temp: SampleMap Ź GetRedGrn[rgMap Ź ImagerSample.NewSampleMap[box, 16]];
FOR y: INT IN [box.min.s..box.max.s) DO
ImagerSample.GetSamples[red, [y, 0],, redLineBuf, 0, size.f];
ImagerSample.GetSamples[grn, [y, 0],, grnLineBuf, 0, size.f];
ImagerSample.PutSamples[temp, [y, xMin2], [0, 2], redLineBuf, 0, size.f];
ImagerSample.PutSamples[temp, [y, 1+xMin2], [0, 2], grnLineBuf, 0, size.f];
ENDLOOP;
ImagerSample.ReleaseScratchSamples[redLineBuf];
ImagerSample.ReleaseScratchSamples[grnLineBuf];
};
<<Parsing>>
InsertKey: PROC [d: Data, key: Key] ~ {
IF d.keys = NIL THEN d.keys Ź NEW[KeySequenceRep[1]];
IF d.keys.length = d.keys.maxLength THEN {
old: KeySequence Ź d.keys;
d.keys Ź NEW[KeySequenceRep[MAX[Real.Ceiling[1.3*old.maxLength], 3]]];
FOR i: NAT IN [0..old.length) DO d.keys[i] Ź old[i]; ENDLOOP;
d.keys.length Ź old.length;
};
FOR n: NAT IN [0..d.keys.length) DO
IF key.start >= d.keys[n].start THEN LOOP;
FOR nn: NAT DECREASING IN [n..d.keys.length) DO
d.keys[nn+1] Ź d.keys[nn];
ENDLOOP;
d.keys[n] Ź key;
EXIT;
REPEAT FINISHED => d.keys[d.keys.length] Ź key;
ENDLOOP;
d.keys.length Ź d.keys.length+1;
};

InsertMap: PROC [d: Data, aisName: ROPE, nMap: NAT, place: BOOL] ~ {
IF d.maps = NIL THEN d.maps Ź NEW[MapSequenceRep[nMap+1]];
IF d.maps.maxLength <= nMap THEN {
old: MapSequence Ź d.maps;
d.maps Ź NEW[MapSequenceRep[nMap+1]];
FOR i: NAT IN [0..old.length) DO d.maps[i] Ź old[i]; ENDLOOP;
d.maps.length Ź old.length;
};
d.maps[nMap] Ź GetMap[aisName, place];
d.maps.length Ź MAX[d.maps.length, nMap+1];
};

Parse: PROC [d: Data, timingsOnly: BOOL Ź FALSE] RETURNS [errorMsg: ROPE Ź NIL] ~ {
ENABLE FS.Error, GetMapError => CONTINUE;
ReadLine: PROC ~ {
Peek: PROC ~ {
DO
SELECT IO.PeekChar[line] FROM ':, '~, ', => [] Ź IO.GetChar[line]; ENDCASE => EXIT;
ENDLOOP;
};
GetInt: PROC RETURNS [INT] ~ {Peek[]; RETURN[IO.GetInt[line]]};
GetReal: PROC RETURNS [REAL] ~ {Peek[]; RETURN[IO.GetReal[line]]};
rope: ROPE Ź IO.GetLineRope[in];
line: IO.STREAM Ź IO.RIS[rope];
DO
ENABLE {
IO.Error => {errorMsg Ź "IO error"; EXIT};
IO.EndOfStream => EXIT;
};
Eq: PROC [r: ROPE] RETURNS [b: BOOL] ~ {b Ź Rope.Equal[r, op, FALSE]};
op: ROPE Ź IO.GetCedarTokenRope[line].token;
IF IO.PeekChar[line ! IO.EndOfStream => CONTINUE] = ': THEN [] Ź IO.GetChar[line];
CedarProcess.CheckAbort[];
SELECT TRUE FROM
Eq["place"] => place Ź TRUE;
Eq["noplace"] => place Ź FALSE;
Eq["color"] => color Ź TRUE;
Eq["bw"] => color Ź FALSE;
Eq["speed"] => speed Ź GetReal[];
Eq["image"] => {
n: INT Ź GetInt[];
IF NOT timingsOnly THEN {
aisName: ROPE Ź IO.GetTokenRope[line, IO.IDProc].token;
MessageWindow.Append[IO.PutFR["\t\t\tReading image %g", IO.int[n]], TRUE];
InsertMap[d, aisName, n, place
! FS.Error, GetMapError => errorMsg Ź Rope.Cat["Can't open ", aisName]]
};
};
Eq["frame"], Eq["frames"] => {
start: INT Ź GetInt[];
stop: INT Ź IF Eq["frames"] THEN GetInt[] ELSE start;
dummy: ROPE Ź IO.GetTokenRope[line].token;    -- "image"
maps: LIST OF INT Ź LIST[GetInt[]];
DO
nMap: INT Ź GetInt[! IO.EndOfStream => EXIT];
maps Ź CONS[nMap, maps];
ENDLOOP;
InsertKey[d, NEW[KeyRep Ź [start, stop, x+xOff, y+yOff, maps, box, speed, color]]];
};
Eq["box"] => {
box.min.f Ź GetInt[];
box.min.s Ź GetInt[];
box.max.f Ź box.min.f+GetInt[];
box.max.s Ź box.min.s+GetInt[];
};
Eq["x"] => x Ź GetInt[];
Eq["y"] => y Ź GetInt[];
Eq["xOffset"] => xOff Ź GetInt[];
Eq["yOffset"] => yOff Ź GetInt[];
ENDCASE;
ENDLOOP;
};
box: Box Ź [[0, 0], [LAST[INTEGER], LAST[INTEGER]]];
speed: REAL Ź 30.0;
x, y, xOff, yOff: INT Ź 0;
color, place: BOOL Ź FALSE;
in: IO.STREAM Ź FS.StreamOpen[d.fileName
! FS.Error => errorMsg Ź Rope.Cat["Can't open ", d.fileName]];
IF d.keys # NIL THEN d.keys.length Ź 0;
IF d.maps # NIL THEN d.maps.length Ź 0;
DO ReadLine[! IO.EndOfStream => EXIT]; ENDLOOP;
IO.Close[in];
};
<<Buttons, Controls>>
Stop: PROC [d: Data] ~ {
CedarProcess.Abort[d.process];
[] Ź CedarProcess.Join[d.process];
};

GetStartStop: PROC [d: Data] RETURNS [ss: StartStop] ~ {
ss.start Ź Convert.IntFromRope[ViewerTools.GetContents[d.startButton.textViewer]];
ss.stop Ź Convert.IntFromRope[ViewerTools.GetContents[d.stopButton.textViewer]];
};

Frame: Controls.ControlProc ~ {
d: Data Ź NARROW[control.clientData];
ss: StartStop Ź GetStartStop[d];
Stop[d];
IF (control.whatChanged = $TypedIn OR
(control.mouse.state#up AND Real.Round[control.valuePrev]#Real.Round[control.value]))
AND d.keys # NIL AND control.value IN [ss.start..ss.stop]
THEN {
f: NAT Ź Real.Round[control.value];
IF d.bw = NIL THEN InitDestMaps[d];
FOR n: NAT IN [0..d.keys.length) DO
k: Key Ź d.keys[n];
IF f IN [k.start..k.stop] THEN {ShowKey[d, k, n]; EXIT};
ENDLOOP;
};
};

Speed: ENTRY Controls.ControlProc ~ {BROADCAST w};

Button: Controls.ClickProc ~ {
d: Data Ź NARROW[clientData];
Stop[d];
d.function Ź parent.name;
d.process Ź CedarProcess.Fork[ForkButton, d];
};

ForkButton: CedarProcess.ForkableProc ~ {
d: Data Ź NARROW[data];
SELECT TRUE FROM
Rope.Equal["ReRead", d.function] => [] Ź Parse[d, TRUE ! FS.Error => CONTINUE];
Rope.Equal["Play", d.function] => Play[d];
Rope.Equal["Cycle", d.function] => DO Play[d]; ENDLOOP;
Rope.Equal["Shuttle", d.function] => DO Play[d, TRUE]; ENDLOOP;
ENDCASE;
};
<<Playback>>
w: CONDITION;
WaitMSecs: ENTRY PROC [mSecs: INT] ~ TRUSTED {
ENABLE UNWIND => NULL;
Process.SetTimeout[@w, Process.MsecToTicks[mSecs]];
Process.EnableAborts[@w];
WAIT w;
};

ShowKey: PROC [d: Data, k: Key, nKey: INT] ~ {
IF k.color AND d.fbA = NIL THEN {
IF nKey = 0 THEN Blink["Turn on color display"];
RETURN;
};
FOR maps: LIST OF INT Ź k.maps, maps.rest WHILE maps # NIL DO
map: Map Ź d.maps[maps.first];
<<IF NOT k.color THEN Terminal.WaitForBWVerticalRetrace[Terminal.Current[]];>>
IF k.color 
THEN {
IF map.fbB # NIL AND d.fbB = NIL THEN {
IF nKey = 0 THEN Blink["Need 24 bpp (full color) mode"];
RETURN;
};
IF map.fbA = NIL THEN {
Blink[IO.PutFR["No image for key %g", IO.int[nKey]]];
RETURN;
};
ImagerSample.Transfer[d.fbA, ImagerSample.Clip[map.fbA, k.box], [k.y, k.x]];
IF d.fbB # NIL AND map.fbB # NIL THEN
ImagerSample.Transfer[d.fbB, map.fbB, [k.y, k.x]];
}
ELSE ImagerSample.Transfer[d.bw, map.fbA, [k.y, k.x]];
ENDLOOP;
};

InitDestMaps: PROC [d: Data] ~ {
<<vt: Terminal.Virtual _ Terminal.Current[];>>
<<fb: Terminal.FrameBuffer _ Terminal.GetColorFrameBufferA[vt];>>
<<d.bw _ ImagerSample.MapFromFrameBuffer[Terminal.GetBWFrameBuffer[vt]];>>
<<IF fb # NIL THEN d.fbA _ ImagerSample.MapFromFrameBuffer[fb];>>
<<IF (fb _ Terminal.GetColorFrameBufferB[vt]) # NIL>>
<<THEN d.fbB _ ImagerSample.MapFromFrameBuffer[fb]>>
};

Play: PROC [d: Data, shuttle: BOOL Ź FALSE] ~ {
IF d.keys # NIL THEN {
InitTimes: PROC ~ {
period Ź 1000000.0/REAL[key.speed*d.speed.value];        -- microseconds
nextTime Ź BasicTime.PulsesToMicroseconds[BasicTime.GetClockPulses[]]+period;
};
ShowFrame: PROC [f: NAT, forward: BOOL Ź TRUE] ~ {
CedarProcess.CheckAbort[];
Controls.SetSliderDialValue[d.frame, f];
IF f IN (key.start..key.stop] THEN RETURN;
IF (NOT forward AND kId = 0) OR (forward AND kId = d.keys.length-1) THEN RETURN;
IF forward
THEN WHILE key.stop < f DO
IF kId = d.keys.length-1 THEN RETURN;    -- frame f is not in the script
key Ź d.keys[kId Ź kId+1];
ENDLOOP
ELSE WHILE key.start > f DO
IF kId = 0 THEN RETURN;                    -- frame f is not in the script
key Ź d.keys[kId Ź kId-1];
ENDLOOP;
DO
dT: REAL Ź nextTime-BasicTime.PulsesToMicroseconds[BasicTime.GetClockPulses[]];
IF dT > 0.0
THEN WaitMSecs[Real.Round[dT/2000.0]]    -- wait half the difference
ELSE EXIT;
ENDLOOP;
ShowKey[d, key, kId];
IF d.speed.value # d.speed.valuePrev
THEN {InitTimes[]; d.speed.valuePrev Ź d.speed.value}
ELSE nextTime Ź nextTime+period/(key.speed*d.speed.value); -- microsecs;
};
kId: NAT Ź 0;
key: Key Ź d.keys[kId];
period, nextTime: REAL;
ss: StartStop Ź GetStartStop[d ! Convert.Error => GOTO Bad];
InitDestMaps[d];
InitTimes[];
FOR n: NAT IN [ss.start..ss.stop] DO ShowFrame[n]; ENDLOOP;
IF shuttle THEN FOR n: NAT DECREASING IN [ss.start..ss.stop] DO
ShowFrame[n, FALSE];
ENDLOOP;
};
EXITS Bad => Blink["Bad start or stop value(s)"];
};

Store: Controls.ClickProc ~ {
d: Data Ź NARROW[clientData];
ss: StartStop Ź GetStartStop[d ! Convert.Error => GOTO Bad];
InitDestMaps[d];
IF d.fbA = NIL
THEN Blink["Turn on color display"]
ELSE {
Save: PROC [n: NAT, suffix: ROPE, map: SampleMap] ~ {
name: ROPE Ź IO.PutFR["%g.%g%g", IO.rope[base], IO.int[n], IO.rope[suffix]];
MessageWindow.Append[Rope.Cat["\t\tStoring", name], TRUE];
AISExtras.AISFromSampleMap[name, map];
};
maps: Imager.PixelMap Ź NIL;
<<maps: Imager.PixelMap _ IF d.fbB # NIL>>
<<THEN maps _ ImagerFullColorContext.PixelMapFromFrameBuffers[>>
<<Terminal.GetColorFrameBufferA[Terminal.Current[]],>>
<<Terminal.GetColorFrameBufferB[Terminal.Current[]]]>>
<<ELSE NIL;>>
shortName: ROPE Ź FileNames.GetShortName[d.fileName];
base: ROPE Ź Rope.Cat[d.dir, Rope.Substr[shortName, 0, Rope.Index[shortName, 0, "."]]];
FOR n: NAT IN [ss.start..ss.stop] DO
key: Key Ź d.keys[n];
CedarProcess.CheckAbort[];
IF NOT key.color
THEN Blink[IO.PutFR["Skipping key %g -- not on color display", IO.int[n]]]
ELSE {
ShowKey[d, key, n];
IF maps # NIL
THEN {
Save[n, "-red.ais", maps[0]];
Save[n, "-grn.ais", maps[1]];
Save[n, "-blu.ais", maps[2]];
}
ELSE Save[n, ".ais", d.fbA];
};
ENDLOOP;
};
EXITS Bad => Blink["Bad start or stop value(s)"];
};
<<Support>>
Blink: PROC [message: ROPE] ~ {
MessageWindow.Append[Rope.Cat["\t\t", message], TRUE];
MessageWindow.Blink[];
};
<<Start Code>>
G2dTool.Register["2dPlay", PlayCmd, "Play a series of ais files"];
<<>>
END.