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.