SlideShowImpl.mesa
Copyright Ó 1990, 1992 by Xerox Corporation. All rights reserved.
Kenneth A. Pier, March 24, 1993 5:02 pm PST
Bier, March 13, 1991 6:16 pm PST
Michael Plass, March 25, 1992 12:42 pm PST
Russ Atkinson (RRA) August 12, 1992 10:38 pm PDT
DIRECTORY
<<Atom, >>AtomButtons, BiScrollers, BufferedRefresh, <<BufferedRefreshTypes,>> CedarProcess, ChoiceButtons, Commander, CommanderOps, Cursors, FileNames, FS, FunctionCache, Geom2D, Icons, Imager, ImagerBackdoor, ImagerBox, <<ImagingContextConvert,>> ImagerFont, ImagerMaskCapture, ImagerMemory, ImagerTransformation, InterpressInterpreter, IO, IPMaster, MessageWindow, MJSContainers, <<ProcessProps,>> <<PS, PSGraphics, PSTypes,>> Real, RefText, Rope, RuntimeError, SF, SlackProcess, Sliders, TiogaAccess, TiogaAccessViewers, TiogaMenuOps, TIPUser, Vectors2d, ViewerClasses, ViewerOps, ViewerSpecs, ViewerTools;
SlideShowImpl: CEDAR MONITOR IMPORTS <<Atom,>> AtomButtons, BiScrollers, BufferedRefresh, CedarProcess, ChoiceButtons, Commander, CommanderOps, FileNames, FS, FunctionCache, Geom2D, Icons, Imager, ImagerBox, ImagerBackdoor, <<ImagingContextConvert,>> ImagerFont, ImagerMaskCapture, ImagerMemory, ImagerTransformation, InterpressInterpreter, IO, IPMaster, MessageWindow, MJSContainers, <<ProcessProps,>> <<PS,>> Real, RefText, Rope, RuntimeError, SlackProcess, Sliders, TIPUser, TiogaAccess, TiogaAccessViewers, TiogaMenuOps, Vectors2d, ViewerOps, ViewerSpecs, ViewerTools = BEGIN
release: BOOL ¬ TRUE;
ButtonLineEntry: TYPE = AtomButtons.ButtonLineEntry;
PopUpChoices: TYPE = AtomButtons.PopUpChoices;
CacheKey: TYPE ~ REF CacheKeyRep;
CacheKeyRep: TYPE ~ RECORD [
fileName: Rope.ROPE,
pageNumber: INTEGER
];
CacheVal: TYPE ~ REF CacheValRep;
CacheValRep: TYPE ~ RECORD [
iMemContext: ImagerMemory.Context,
boundRect: Imager.Rectangle,
cToV: Imager.Transformation
];
globalCache: FunctionCache.Cache = FunctionCache.Create[maxEntries: 20];
buttonFont: Rope.ROPE = "xerox/tiogafonts/helvetica18b";
popupFont: Rope.ROPE = "xerox/tiogafonts/helvetica18bi";
cribFont: Rope.ROPE = "xerox/tiogafonts/helvetica8b";
fontScale: REAL = 1.0;
buttonLines: INTEGER = 2;
buttonLineHeight: INTEGER = 22;
cribLineHeight: INTEGER = 12;
bsY: INTEGER = (buttonLines*buttonLineHeight)+cribLineHeight+9;
indent: INTEGER = 2; -- indents buttons from left edge for cleaner look
pointsPerMeter: REAL = 72.0/.0254;
SSButtonFont: Imager.Font = Imager.FindFontScaled[buttonFont, fontScale];
SSPopupFont: Imager.Font = Imager.FindFontScaled[popupFont, fontScale];
SSCribFont: Imager.Font = Imager.FindFontScaled[cribFont, fontScale];
visibleGrey: Imager.Color = ImagerBackdoor.MakeStipple[122645B];
invisibleGrey: Imager.Color = ImagerBackdoor.MakeStipple[100040B];
nullBox: Imager.Box = [-Real.LargestNumber, -Real.LargestNumber, Real.LargestNumber, Real.LargestNumber];
nullRect: Imager.Rectangle = [-Real.LargestNumber, -Real.LargestNumber, Real.LargestNumber, Real.LargestNumber];
Data: TYPE = REF Rep;
Rep: TYPE = RECORD [
wDir: Rope.ROPE,
slackHandle: SlackProcess.SlackHandle,
sandwich: BufferedRefresh.Sandwich,
useBR: BOOL ¬ TRUE,
aborted: BOOL ¬ FALSE,
fileName: Rope.ROPE,
container: ViewerClasses.Viewer,
pageNumberViewer: ViewerClasses.Viewer,
pageNumberSlider: ViewerClasses.Viewer,
fileNameViewer: ViewerClasses.Viewer,
biScroller: BiScrollers.BiScroller,
view: ViewerClasses.Viewer, -- the BiScroller inner viewer
startScroll: Imager.VEC ¬ [0.0, 0.0],
startPage: Imager.VEC ¬ [0.0, 0.0],
op: ATOM ¬ $Idle,
where: Imager.VEC ¬ [0.0, 0.0],
pageNumber: INTEGER ¬ 1,
lastPageNumber: INTEGER ¬ 0,
interpress stuff
master: InterpressInterpreter.Master,
pageInMem: INTEGER ¬ 0,-- which page is in iMemContext.
iMemContext: Imager.Context, -- an ImagerMemory context
boundRect: Imager.Rectangle ¬ nullRect,
oldClip: Imager.Box ¬ nullBox,
postscript stuff
<<cachedPSRoot: PS.Root,
psRoot: PS.Root,>>
stream: IO.STREAM
];
Message: PROC [r: Rope.ROPE, clearFirst, blink: BOOL ¬ TRUE] ~ {
MessageWindow.Append[r, clearFirst];
IF blink THEN MessageWindow.Blink[];
};
SSButtonHandleProc: AtomButtons.HandleButtonProc ~ {
atom: ATOM ¬ NARROW[event.first];
SimpleFeedback.PutF[$SystemScript, oneLiner, $Feedback, "%g", IO.atom[atom] ];
[] ¬ CedarProcess.Fork[action: SELECT atom FROM
$SSBigger => Bigger,
$SSSmaller => Smaller,
$SSReset => Vanilla,
$SSToAll => ToAll,
$SSFillAll => FillAll,
$SSResetAll => ResetAll,
$SSFill => Fill,
$SSGet => Get,
$SSHelp => Help,
$SSResize => Resize,
ENDCASE => Unknown,
data: clientData];
};
Lookup: PROC [d: Data, forPage: INTEGER ¬ 0] RETURNS [val: CacheVal] ~ {
PageCompareProc: FunctionCache.CompareProc ~ TRUSTED {
PROC [argument: Domain] RETURNS [good: BOOL];
IF argument=NIL THEN RETURN[FALSE] ELSE {
key: CacheKey ¬ NARROW[argument];
RETURN[key.fileName=d.fileName AND key.pageNumber= (IF forPage=0 THEN d.pageNumber ELSE forPage)];
};
};
val ¬ NARROW[FunctionCache.Lookup[x: globalCache, compare: PageCompareProc, clientID: $SSPage].value];
};
GetCachedTransform: PROC [d: Data] RETURNS [cToV: Imager.Transformation] ~ {
val: CacheVal ¬ Lookup[d];
IF val#NIL THEN cToV ¬ val.cToV;
};
CacheViewingTransform: PROC [d: Data] ~ {
val: CacheVal ¬ Lookup[d];
IF val#NIL THEN val.cToV ¬ bsStyle.GetTransforms[bs: d.biScroller].clientToViewer; -- get the new viewing transforms
};
Bigger: CedarProcess.ForkableProc ~ {
PROC [data: REF] RETURNS [results: REF ← NIL];
d: Data ¬ NARROW[data];
IF d.fileName=NIL THEN {Message["No slides loaded. Can't make Bigger."]; RETURN;};
BiScrollers.Scale[d.biScroller, [byArg[1.2]] ]; -- bigger by 20%
};
Smaller: CedarProcess.ForkableProc ~ {
PROC [data: REF] RETURNS [results: REF ← NIL];
d: Data ¬ NARROW[data];
IF d.fileName=NIL THEN {Message["No slides loaded. Can't make Smaller."]; RETURN;};
BiScrollers.Scale[d.biScroller, [byArg[1.0/1.2]] ]; -- smaller by 20%
};
Fill: CedarProcess.ForkableProc ~ {
PROC [data: REF] RETURNS [results: REF ← NIL];
rx, ry: REAL; -- ratios in X and Y
w, cw, h, ch: REAL; -- conversions from integer
fudge: REAL = 0.96; -- fudge factor
d: Data ¬ NARROW[data];
cacheVal: CacheVal ¬ Lookup[d];
IF d.fileName=NIL OR cacheVal=NIL THEN {
Message["No slides loaded. Can't Fill."];
RETURN;
};
Message[IO.PutFR1["Filling page %g . . . please wait.", IO.int[d.pageNumber]], TRUE, FALSE];
Is cached bound box valid??
IF cacheVal.boundRect.x#nullRect.x THEN d.boundRect ¬ cacheVal.boundRect -- yes
ELSE { -- no. Calculate it.
PlayFake: PROC [cc: Imager.Context] = {
ImagerMemory.Replay[cacheVal.iMemContext, cc];
};
sfBox: SF.Box ¬ SF.maxBox; -- [min: minVec, max: maxVec]
sfBox ¬ ImagerMaskCapture.CaptureBounds[PlayFake, ImagerTransformation.Scale[2.0] ! ImagerMaskCapture.Cant => RESUME];
Playing with fire here. Changing cached entry without monitored record.
Could cause problems with two SlideShows showing the same document.
d.boundRect ¬ cacheVal.boundRect ¬ IF sfBox.min=SF.minVec THEN nullRect ELSE ImagerTransformation.InverseTransformRectangle[ImagerTransformation.Scale[2.0], ImagerBox.RectangleFromBox[[sfBox.min.s, sfBox.min.f, sfBox.max.s, sfBox.max.f]]]; -- Michael Plass magic
};
w ¬ d.boundRect.w; cw ¬ d.sandwich.cw;
h ¬ d.boundRect.h; ch ¬ d.sandwich.ch;
rx ¬ cw/w; -- possible scaling ratio
ry ¬ ch/h; -- another possible scaling ratio
BiScrollers.DoBSUserAction[d.biScroller, LIST[$First, $Vanilla] ]; -- standard transformation. Don't paint
align top midpoint of image with top midpoint of viewer.
BiScrollers.Align[bs: d.biScroller, client: [coord[x: d.boundRect.x+(w/2.0), y: d.boundRect.y+h]], viewer: [fraction[fx: 0.50, fy: 1.00]], paint: FALSE ];
scale about that midpoint by the smaller of the two ratios
BiScrollers.Scale[bs: d.biScroller, op: [byArg[arg: fudge*MIN[rx, ry]]], paint: FALSE ];
move the image down slightly, away from the top border of the viewer
BiScrollers.Shift[bs: d.biScroller, dx: 0.0, dy: -4, paint: TRUE ];
Message[IO.PutFR1[" Page %g fill completed.", IO.int[d.pageNumber]], FALSE, FALSE];
};
Vanilla: CedarProcess.ForkableProc ~ {
PROC [data: REF] RETURNS [results: REF ← NIL];
d: Data ¬ NARROW[data];
BiScrollers.DoBSUserAction[d.biScroller, LIST[$Vanilla] ]; -- standard transformation
};
ToAll: CedarProcess.ForkableProc ~ {
PROC [data: REF] RETURNS [results: REF ← NIL];
d: Data ¬ NARROW[data];
IF d.fileName=NIL THEN Message["No slides loaded. Can't do ToAll."]
ELSE { -- set all page view transforms to the current transform
cToV: Imager.Transformation ¬ bsStyle.GetTransforms[bs: d.biScroller].clientToViewer;
thisPage: INTEGER ¬ d.pageNumber;
FOR nextPage: INTEGER ¬ thisPage+1, nextPage+1 UNTIL nextPage>d.lastPageNumber DO
bsStyle.ChangeTransform[bs: d.biScroller, new: cToV, ageOp: remember, paint: FALSE];
PaintView[d: d, op: $View];
DeltaPage[d: d, newPage: nextPage, paint: TRUE]; -- forces current page to cache transform
ENDLOOP;
FOR nextPage: INTEGER ¬ 1, nextPage+1 UNTIL nextPage>thisPage DO
bsStyle.ChangeTransform[bs: d.biScroller, new: cToV, ageOp: remember, paint: FALSE];
PaintView[d: d, op: $View];
DeltaPage[d: d, newPage: nextPage, paint: TRUE]; -- forces current page to cache transform
ENDLOOP;
Message["ToAll completed.", TRUE, FALSE];
};
};
ResetAll: CedarProcess.ForkableProc ~ {
PROC [data: REF] RETURNS [results: REF ← NIL];
d: Data ¬ NARROW[data];
IF d.fileName=NIL THEN Message["No slides loaded. Can't do ResetAll."]
ELSE { -- set all page view transforms to the vanilla transform
thisPage: INTEGER ¬ d.pageNumber;
FOR nextPage: INTEGER ¬ thisPage+1, nextPage+1 UNTIL nextPage>d.lastPageNumber DO
BiScrollers.DoBSUserAction[d.biScroller, LIST[$First, $Vanilla] ]; -- standard transformation
PaintView[d: d, op: $View];
DeltaPage[d: d, newPage: nextPage, paint: TRUE]; -- forces current page to cache transform
ENDLOOP;
FOR nextPage: INTEGER ¬ 1, nextPage+1 UNTIL nextPage>thisPage DO
BiScrollers.DoBSUserAction[d.biScroller, LIST[$First, $Vanilla] ]; -- standard transformation
PaintView[d: d, op: $View];
DeltaPage[d: d, newPage: nextPage, paint: TRUE]; -- forces current page to cache transform
ENDLOOP;
Message["ResetAll completed.", TRUE, FALSE];
};
};
FillAll: CedarProcess.ForkableProc ~ {
PROC [data: REF] RETURNS [results: REF ← NIL];
d: Data ¬ NARROW[data];
IF d.fileName=NIL THEN Message["No slides loaded. Can't do FillAll."]
ELSE { -- fill and display each page
thisPage: INTEGER ¬ d.pageNumber;
FOR nextPage: INTEGER ¬ thisPage+1, nextPage+1 UNTIL nextPage>d.lastPageNumber DO
[] ¬ Fill[data];
PaintView[d: d, op: $View];
DeltaPage[d: d, newPage: nextPage, paint: TRUE]; -- forces current page to cache transform
ENDLOOP;
FOR nextPage: INTEGER ¬ 1, nextPage+1 UNTIL nextPage>thisPage DO
[] ¬ Fill[data];
PaintView[d: d, op: $View];
DeltaPage[d: d, newPage: nextPage, paint: TRUE]; -- forces current page to cache transform
ENDLOOP;
Message["FillAll completed.", TRUE, FALSE];
};
};
Match: ENTRY PROC [s: IO.STREAM, r: Rope.ROPE] RETURNS [BOOL] = {
uses global scratch buffer
IO.SetIndex[s, 0];
buffer.length ¬ IO.GetBlock[s, buffer, 0, 10];
RETURN[Rope.Match[Rope.Concat[r, "*"], RefText.TrustTextAsRope[buffer], FALSE]];
};
Get: CedarProcess.ForkableProc ~ {
PROC [data: REF] RETURNS [results: REF ← NIL];
Reset: PROC [restoreCursor: BOOL ¬ TRUE] = {
defaultGet ¬ NIL; -- only one shot at default per invocation
d.fileName ¬ NIL;
d.pageNumber ¬ 1;
d.lastPageNumber ¬ 0;
d.container.name ¬ "SlideShow";
d.container.label ¬ "SlideShow";
d.container.file ¬ NIL;
d.boundRect ¬ nullRect;
d.oldClip ¬ nullBox;
reset interpress stuff
IF d.master#NIL THEN {InterpressInterpreter.Close[d.master]; d.master ¬ NIL;};
d.pageInMem ¬ 0;
d.iMemContext ¬ NIL;
reset postscript stuff
<<d.psRoot ¬ NIL;>>
IF d.stream#NIL THEN {d.stream.Close[]; d.stream ¬ NIL;};
SetBigAndBold[d.pageNumberViewer, "0 of 0"];
Sliders.SetContents[d.pageNumberSlider, 0];
ViewerOps.PaintViewer[viewer: d.container, hint: all, clearClient: TRUE];
IF restoreCursor THEN ChangeCursor[d.view, crossHairsCircle];
};
fullName: Rope.ROPE;
bytes: INT ¬ -1;
d: Data ¬ NARROW[data];
fileName: Rope.ROPE ¬ IF defaultGet#NIL THEN defaultGet ELSE ViewerTools.GetContents[d.fileNameViewer];
ViewerTools.SetContents[d.fileNameViewer, fileName, FALSE];
BEGIN -- so the EXITS can use the above variables
dot: INT ¬ 0;
IF Rope.Equal[fileName, NIL] THEN GOTO NoFileName;
ChangeCursor[d.view, hourGlass];
[fullFName: fullName, bytes: bytes] ¬ FS.FileInfo[name: fileName, wDir: d.wDir ! FS.Error => CONTINUE];
IF bytes=-1 THEN GOTO NotFound;
Message[IO.PutFR1["Trying %g . . . ", IO.rope[fullName]], TRUE, FALSE];
Reset[FALSE]; -- immediately clear the viewer for user feedback. Don't change the cursor.
d.stream ¬ FS.StreamOpen[fileName: fullName, wDir: d.wDir ! FS.Error => GOTO StreamOpenFail];
SELECT TRUE FROM
Match[d.stream, "Interpress"] => { -- IP file
d.master ¬ InterpressInterpreter.FromStream[stream: d.stream, log: IPLogError !
FS.Error => {
Message[Rope.Cat[error.explanation, " for ", fullName]];
GOTO Quit;
};
IPMaster.Error => { --ErrorDesc: TYPE = RECORD[code: ATOM, explanation: ROPE, index: INT ¬ 0]
Message[Rope.Cat[error.explanation, " for ", fullName]];
GOTO Quit;
};
Imager.Error => { --ErrorDesc: TYPE = RECORD [code: ATOM, explanation: ROPE]
Message[Rope.Cat[error.explanation, " for ", fullName]];
GOTO Quit;
};
IO.Error, IO.EndOfStream => {
Message[Rope.Concat["IO Stream Error for ", fullName]];
GOTO Quit;
};
RuntimeError.UnnamedError => {
Message[Rope.Concat["Unnamed Error for IP master ", fullName]];
GOTO Quit;
};
];
IF d.master.pages=0 THEN {
Message[Rope.Concat["Zero pages in ", fullName]];
GOTO Quit;
};
d.lastPageNumber ¬ d.master.pages;
d.pageInMem ¬ 0;
d.iMemContext ¬ NIL;
clear the function cache of old SSPage entries (and maybe they'll be collected)
[] ¬ FunctionCache.Obtain[globalCache, FunctionCache.Any, 9999, $SSPage];
};
NOT release <<AND Match[d.stream, "%!"]>> => { -- PS file
<<IF d.psRoot=NIL THEN d.psRoot ¬ GetRoot[d];>>
IO.SetIndex[d.stream, 0];
d.lastPageNumber ¬ 1;
};
ENDCASE => GOTO NotPDL;
set data values common to any PDL type
d.pageNumber ¬ 1;
d.fileName ¬ fullName;
d.container.name ¬ fullName;
d.container.file ¬ fullName;
d.container.label ¬ FileNames.GetShortName[fullName];
IF (dot ¬ Rope.Find[d.container.label, "."])#-1 THEN d.container.label ¬ Rope.Substr[d.container.label, 0, dot];
BiScrollers.DoBSUserAction[d.biScroller, LIST[$Vanilla] ];
ViewerOps.PaintViewer[viewer: d.container, hint: caption, clearClient: FALSE];
DeltaPage[d, 1, FALSE];
Message[IO.PutFR["success. %g slide%g.", IO.int[d.lastPageNumber], IF d.lastPageNumber=1 THEN IO.rope[""] ELSE IO.rope["s"] ], FALSE, FALSE ];
ChangeCursor[d.view, crossHairsCircle];
EXITS
NoFileName => {
Message["No file name. Fill in FILE field and retry."];
Reset[];
};
NotFound => {
Message[Rope.Concat["Could not find ", fileName]];
Reset[];
};
StreamOpenFail => {
Message[Rope.Concat["Could not open ", fullName]];
Reset[];
};
NotPDL => {
Message[Rope.Cat[fullName, " is not an ", pdls, " file"]];
Reset[];
};
Quit => Reset[];
END;
};
<<GetRoot: PROC [d: Data] RETURNS [PS.Root] = {
root: PS.Root;
inner: PROC = {
IF d.cachedPSRoot=NIL THEN d.cachedPSRoot ¬ PS.Create[version: psVersion];
root ¬ d.cachedPSRoot;
};
See PSExecImpl.Create for use of process props to discover PS init file directory.
Special init files needed for specific "devices."
I modified Init.ps to remove extra InitGraphics call that was clobbering the BiScrollers transformation.
InitGraphics in PS masters is still a problem.
ProcessProps.AddPropList[propList: Atom.PutPropOnList[NIL, $PostscriptInitDirectory, psInitDir], inner: inner];
RETURN [root];
};>>
Help: CedarProcess.ForkableProc ~ {
PROC [data: REF] RETURNS [results: REF ← NIL];
open the help viewer and grow it to cover the slideshow display, leaving the control panel visible
goodHeight: INTEGER = ViewerSpecs.openTopY-ViewerSpecs.openBottomY-bsY;
help: ViewerClasses.Viewer;
helpName: Rope.ROPE = FileNames.ConvertToSlashFormat[FS.ExpandName[helpFile, helpWDir ].fullFName];
IF (help ¬ ViewerOps.FindViewer[helpName])=NIL THEN { -- create new help file viewer and load help file
help ¬ ViewerOps.CreateViewer[flavor: $Text, info: [iconic: TRUE, column: left, openHeight: goodHeight], paint: FALSE];
TiogaMenuOps.Load[viewer: help, fileName: helpName];
}
ELSE IF help.column#left THEN ViewerOps.ChangeColumn[help, left]; -- viewer already exists
IF help.file#NIL THEN {
IF help.iconic THEN ViewerOps.OpenIcon[icon: help, closeOthers: FALSE, paint: FALSE];
there may be a better way than the following to manipulate the viewers but this is the only one that I found that works relibably.
ViewerOps.SetOpenHeight[help, goodHeight];
ViewerOps.ComputeColumn[left];
ViewerTools.InhibitUserEdits[help];
ViewerOps.PaintViewer[viewer: help, hint: all]; -- make viewer appear
}
ELSE {
Message["Could not find or open Slideshow HELP"];
ViewerOps.DestroyViewer[help, FALSE];
};
};
Resize: CedarProcess.ForkableProc ~ {
PROC [data: REF] RETURNS [results: REF ← NIL];
d: Data ¬ NARROW[data];
wide: BOOL ¬ d.container.cw > ViewerSpecs.bwScreenWidth - leaveRight;
ViewerOps.MoveBoundary[newLeftWidth: ViewerSpecs.bwScreenWidth - (IF wide THEN leaveRight ELSE 4), newBottomY: IF wide THEN ViewerSpecs.iconRowHeight ELSE 4];
};
Unknown: CedarProcess.ForkableProc ~ {
PROC [data: REF] RETURNS [results: REF ← NIL];
Message["Slideshow saw unknown button ATOM"];
};
FilePressed: ChoiceButtons.SelectionNotifierProc = {
PROC [name: ROPE, : REF ANY];
d: Data ¬ NARROW[clientdata];
ViewerTools.SetSelection[d.fileNameViewer];
};
OptimizeQueue: SlackProcess.OptimizeProc = {
PROC [qeGen: QueueEntryGenerator, actionsOnQueue: NAT] RETURNS [skipActions: NAT];
Notice that skipActions will be at most summary.count -1; The most recent action on the queue will be done if nothing else is appropriate. Always do the last During.
atom, nextAtom: ATOM;
action: LIST OF REF ANY;
IF actionsOnQueue < 2 THEN RETURN [0];
skipActions ¬ 0;
FOR i: NAT IN [0..actionsOnQueue-2] DO
action ¬ NARROW[SlackProcess.GetQueueEntry[qeGen, i].inputAction];
atom ¬ NARROW[action.first];
action ¬ NARROW[SlackProcess.GetQueueEntry[qeGen, i+1].inputAction];
nextAtom ¬ NARROW[action.first];
IF atom = nextAtom THEN {
skipActions ¬ skipActions + 1;
}
ELSE RETURN;
ENDLOOP;
};
SSFlush: Commander.CommandProc = {
FunctionCache.Flush[globalCache];
};
CreateSlideShow: Commander.CommandProc = {
[cmd: Handle] RETURNS [result: REF ← NIL, msg: ROPE ← NIL];
args: LIST OF Rope.ROPE;
argLength: NAT ¬ 0;
filePrompt: ChoiceButtons.PromptDataRef;
nextX: INTEGER ¬ 0;
d: Data ¬ NEW[Rep];
getButton: ButtonLineEntry ¬ [button[name: "Get", events: LIST[LIST[$SSGet]], border: TRUE, font: SSButtonFont]];
biggerButton: ButtonLineEntry ¬ [button[name: "Bigger", events: LIST[LIST[$SSBigger]], border: TRUE, font: SSButtonFont]];
smallerButton: ButtonLineEntry ¬ [button[name: "Smaller", events: LIST[LIST[$SSSmaller]], border: TRUE, font: SSButtonFont]];
fillButton: ButtonLineEntry ¬ [button[name: "Fill", events: LIST[LIST[$SSFill]], border: TRUE, font: SSButtonFont]];
resetButton: ButtonLineEntry ¬ [button[name: "Reset", events: LIST[LIST[$SSReset]], border: TRUE, font: SSButtonFont]];
xformChoices: PopUpChoices ¬ LIST[
[LIST[$SSToAll], "ToAll", "Copy current view transformation to each page"],
[LIST[$SSFillAll], "FillAll", "Fill each page individually"],
[LIST[$SSResetAll], "ResetAll", "Reset view transformation for each page"]
];
xformButton: ButtonLineEntry ¬ [popUpButton[name: "Views", choices: xformChoices, border: TRUE, font: SSPopupFont, disableDecoding: TRUE]];
atButton: ButtonLineEntry ¬ [label[name: "At slide: ", font: SSButtonFont]];
helpButton: ButtonLineEntry ¬ [button[name: "HELP", events: LIST[LIST[$SSHelp]], border: TRUE, font: SSButtonFont]];
resizeButton: ButtonLineEntry ¬ [button[name: "Resize", events: LIST[LIST[$SSResize]], border: TRUE, font: SSButtonFont]];
redButton: ButtonLineEntry ¬ [label[name: "LEFT aborts change or scroll", border: FALSE, font: SSCribFont]];
yellowButton: ButtonLineEntry ¬ [label[name: "MIDDLE changes slides <==>", border: FALSE, font: SSCribFont]];
blueButton: ButtonLineEntry ¬ [label[name: "RIGHT scrolls", border: FALSE, font: SSCribFont]];
bkgnd: BufferedRefresh.Layer ¬ [name: $SSBkgnd, backingMap: TRUE, refreshProc: RefreshBkgnd];
frgnd: BufferedRefresh.Layer ¬ [name: $SSFrgnd, backingMap: FALSE, refreshProc: RefreshFrgnd];
<<psMessages ¬ cmd.out; -- needed for PS error and completion messages.>>
d.useBR ¬ TRUE;
[list: args, length: argLength] ¬ CommanderOps.ParseToList[cmd: cmd ! CommanderOps.Failed => CONTINUE; ];
SELECT argLength FROM
1 => {
IF Rope.Equal[args.first, "-r"] THEN d.useBR ¬ FALSE
ELSE defaultGet ¬ args.first;
};
2 => {
IF Rope.Equal[args.first, "-r"] THEN d.useBR ¬ FALSE;
defaultGet ¬ IF args.rest#NIL THEN args.rest.first ELSE NIL;
};
ENDCASE => defaultGet ¬ NIL;
d.wDir ¬ FileNames.CurrentWorkingDirectory[];
d.slackHandle ¬ SlackProcess.Create[optimizeProc: OptimizeQueue];
d.sandwich ¬ BufferedRefresh.CreateSandwich[LIST[bkgnd, frgnd] ];
d.container ¬ MJSContainers.Create[
viewerFlavor: $VanillaMJSContainer,
info: [
name: "SlideShow",
label: "SlideShow",
file: NIL,
iconic: TRUE,
menu: NIL,
data: d,
icon: ssIcon,
scrollable: FALSE],
paint: FALSE ];
ViewerOps.SetOpenHeight[d.container, bsY];
nextX ¬ AtomButtons.BuildButtonLine[container: d.container, x: indent, y: 0, clientData: d, handleProc: SSButtonHandleProc, entries: LIST[biggerButton, smallerButton, fillButton, resetButton, xformButton, atButton], lineHeight: buttonLineHeight];
d.pageNumberViewer ¬ ViewerTools.MakeNewTextViewer[ info: [wx: nextX, wy: buttonLineHeight-15, ww: 80, wh: buttonLineHeight, parent: d.container, border: FALSE, scrollable: FALSE], paint: FALSE];
nextX ¬ nextX+d.pageNumberViewer.ww;
d.pageNumberSlider ¬ Sliders.Create[
info: [
wx: nextX,
wy: 0,
ww: d.container.ww-nextX,
wh: buttonLineHeight,
border: TRUE,
parent: d.container,
data: d,
scrollable: FALSE],
filterProc: NormalizePageNumber,
sliderProc: PageNumberSlider,
orientation: horizontal,
foreground: visibleGrey,
background: invisibleGrey,
clientData: d,
paint: FALSE];
MJSContainers.ChildXBound[d.container, d.pageNumberSlider];
nextX ¬ AtomButtons.BuildButtonLine[container: d.container, x: indent, y: buttonLineHeight+3, clientData: d, handleProc: SSButtonHandleProc, entries: LIST[getButton, helpButton, resizeButton], lineHeight: buttonLineHeight];
nextX ¬ nextX+2; -- seems to be needed to make layout work
filePrompt ¬ ChoiceButtons.BuildTextPrompt[viewer: d.container, x: nextX, y: buttonLineHeight+5, title: "FILE", default: Rope.Cat["Your ", pdls, " file name here"], font: SSButtonFont, textViewerWidth: d.pageNumberSlider.wx - nextX - 40, clientdata: d, notify: FilePressed];
d.fileNameViewer ¬ filePrompt.textViewer;
nextX ¬ AtomButtons.BuildButtonLine[container: d.container, x: filePrompt.newx, y: buttonLineHeight+7, clientData: d, handleProc: NIL, entries: LIST[redButton], lineHeight: cribLineHeight];
nextX ¬ AtomButtons.BuildButtonLine[container: d.container, x: filePrompt.newx, y: buttonLineHeight+cribLineHeight+7, clientData: d, handleProc: NIL, entries: LIST[yellowButton], lineHeight: cribLineHeight];
nextX ¬ AtomButtons.BuildButtonLine[container: d.container, x: filePrompt.newx, y: buttonLineHeight+2*cribLineHeight+7, clientData: d, handleProc: NIL, entries: LIST[blueButton], lineHeight: cribLineHeight];
d.biScroller ¬ bsStyle.CreateBiScroller[
class: bsClass,
info: [
parent: d.container,
wx: 0,
wy: bsY,
border: TRUE,
scrollable: FALSE,
data: d],
paint: FALSE ];
d.view ¬ d.biScroller.QuaViewer[inner: FALSE]; -- use d.view as temporary for outer viewer
MJSContainers.ChildXBound[d.container, d.view];
MJSContainers.ChildYBound[d.container, d.view];
d.view ¬ d.biScroller.QuaViewer[inner: TRUE]; -- put inner viewer in d.view
ViewerOps.MoveBoundary[newLeftWidth: ViewerSpecs.bwScreenWidth-leaveRight, newBottomY: ViewerSpecs.iconRowHeight];
ViewerOps.OpenIcon[icon: d.container, closeOthers: TRUE, paint: TRUE];
IF defaultGet=NIL THEN defaultGet ¬ defaultWant; -- use defaultWant unless command line specified filename
IF defaultGet#NIL THEN [] ¬ CedarProcess.Fork[action: Get, data: d];
};

NormalizePageNumber: Sliders.FilterProc = {
d: Data ¬ NARROW[clientData];
lastPageNumber: REAL ¬ d.lastPageNumber;
RETURN [ SELECT TRUE FROM
d.lastPageNumber = 0 => 0.0, -- means no slides loaded; return 0.
ENDCASE => Real.Round[value*lastPageNumber]/lastPageNumber -- normalized page number.
];
};
PageNumberSlider: Sliders.SliderProc = {
d: Data ¬ NARROW[clientData];
lastPageNumber: REAL ¬ d.lastPageNumber;
SELECT reason FROM
abort => {
SetBigAndBold[d.pageNumberViewer, IO.PutFR["%-g of %g", IO.int[d.pageNumber], IO.int[d.lastPageNumber] ]];
};
move => {
newPageInt: INT ¬ MIN[MAX[Real.Round[value*lastPageNumber], 1], d.lastPageNumber];
newContents: Rope.ROPE ¬ IO.PutFR["%-g of %g", IO.int[newPageInt], IO.int[d.lastPageNumber] ];
oldContents: Rope.ROPE ¬ ViewerTools.GetContents[d.pageNumberViewer];
IF Rope.Equal[newContents, oldContents] THEN RETURN;
SetBigAndBold[d.pageNumberViewer, newContents];
};
set => {
DeltaPage[d, MIN[MAX[Real.Round[value*lastPageNumber], 1], d.lastPageNumber]];
};
ENDCASE;
};
DeltaPage: PROC [d: Data, newPage: INT, paint: BOOL ¬ TRUE] = {
IF newPage IN [1..d.lastPageNumber] THEN {
cToV: Imager.Transformation;
newPageReal: REAL ¬ newPage; -- need real value below
lastPageReal: REAL ¬ d.lastPageNumber; -- need real value below
SetBigAndBold[d.pageNumberViewer, IO.PutFR["%-g of %g", IO.int[newPage], IO.int[d.lastPageNumber] ]];
Sliders.SetContents[d.pageNumberSlider, newPageReal/lastPageReal];
CacheViewingTransform[d]; -- remember the current transforms for the old page
d.pageNumber ¬ newPage;
cToV ¬ GetCachedTransform[d]; -- fetch the view transforms for the new page
IF cToV=NIL THEN BiScrollers.DoBSUserAction[d.biScroller, LIST[$First, $Vanilla] ] ELSE bsStyle.ChangeTransform[bs: d.biScroller, new: cToV, ageOp: remember, paint: FALSE];
};
IF paint THEN PaintView[d: d, op: $View];
};
SetBigAndBold: PROC [v: ViewerClasses.Viewer, r: Rope.ROPE] = {
Action: Rope.ActionType = {
-- TYPE = PROC [c: CHAR] RETURNS [quit: BOOL ← FALSE];
notSpace: BOOL ¬ c # ' ;
tiogaChar.char ¬ c;
tiogaChar.looks['x] ¬ notSpace;
tiogaChar.looks['b] ¬ notSpace;
TiogaAccess.Put[writer, tiogaChar];
};
newline: Rope.ROPE ~ "\n";
writer: TiogaAccess.Writer ¬ TiogaAccess.Create[];
tiogaChar: TiogaAccess.TiogaChar ¬ [charSet: 0,
char: ' ,
looks: ALL[FALSE],
format: NIL,
comment: FALSE,
endOfNode: FALSE,
deltaLevel: 0];
TiogaAccess.Put[writer, [charSet: 0,
char: '\n,
looks: ALL[FALSE],
format: NIL,
comment: TRUE,
endOfNode: TRUE,
deltaLevel: 1,
propList: LIST[[$NewlineDelimiter, newline]]]];
[] ¬ Rope.Map[base: r, action: Action];
TiogaAccessViewers.WriteViewer[writer, v];
ViewerTools.InhibitUserEdits[v];
};
ChangeCursor: PROC [v: ViewerClasses.Viewer, cursor: ViewerClasses.CursorType] = {
IF v#NIL THEN v.cursor ¬ cursor;
};
IPLogError: InterpressInterpreter.LogProc ~ { -- [class: INT, code: ATOM, explanation: ROPE]
Message[Rope.Concat["InterpressMaster Error: ", explanation]];
};
barbLength: REAL = 10.0;
offset: REAL = 25.0;
scrolling: Rope.ROPE = "SCROLLING";
nextSlide: Rope.ROPE = "NEXT SLIDE";
previousSlide: Rope.ROPE = "PREVIOUS SLIDE";
scrollingBox: ImagerBox.Box = ImagerBox.BoxFromExtents[ImagerFont.RopeBoundingBox[SSButtonFont, scrolling] ];
nextSlideBox: ImagerBox.Box = ImagerBox.BoxFromExtents[ImagerFont.RopeBoundingBox[SSButtonFont, nextSlide] ];
previousSlideBox: ImagerBox.Box = ImagerBox.BoxFromExtents[ImagerFont.RopeBoundingBox[SSButtonFont, previousSlide] ];
pageWidth: REAL = 72.0*8.5; -- this only works for 8.5 inch wide page on 72 dpi display
pageHeight: REAL = 72.0*11.0; -- this only works for 11 inch high page on 72 dpi display
RefreshFrgnd: BufferedRefresh.RefreshProc ~ {
RefreshProc: TYPE = PROC [dc: Imager.Context, boundRect: Rectangle, clientData: REF ANY] RETURNS [drawnOn: BOOL ← TRUE];
OPEN Vectors2d;
DoRefreshFrgnd: PROC = { -- action proc for DoSave
DoArrow: PROC = { -- another action proc for DoSave
scale the barbs, shaft, strokewidth by the inverse of the biscroller cToV scale factor
barbLeft ¬ Add[zero, Scale[Normalize[[-1.0,1.0]], barbLength]];
barbRight ¬ Add[zero, Scale[Normalize[[1.0,1.0]], barbLength]];
angle ¬ AngleFromVector[VectorFromPoints[shaftTop, d.where] ];
context.SetStrokeWidth[scaleFactor*4];
context.SetColor[Imager.black];
context.MaskVector[shaftTop, d.where];
context.TranslateT[d.where];
context.RotateT[90 + angle];
context.MaskVector[zero, Scale[barbLeft, scaleFactor] ];
context.MaskVector[Scale[barbLeft, scaleFactor], zero];
context.MaskVector[zero, Scale[barbRight, scaleFactor]];
};
DoLabel: PROC = { -- and another action proc for DoSave
scale the box and label by the inverse of the biscroller cToV scale factor
context.TranslateT[d.where];
context.TranslateT[ [offset, offset] ];
context.SetXY[ [0.0, 0.0] ];
context.ScaleT[scaleFactor];
context.SetColor[Imager.white];
context.MaskBox[box];
context.SetFont[SSButtonFont];
context.SetColor[Imager.black];
context.ShowRope[r];
};
box: Imager.Box;
angle: REAL ¬ 0.0;
zero, shaftTop, barbLeft, barbRight: Imager.VEC ¬ [0.0, 0.0];
r: Rope.ROPE;
SELECT d.op FROM
$DuringScroll => {
shaftTop ¬ d.startScroll;
r ¬ scrolling;
box ¬ scrollingBox;
};
$DuringPage => {
shaftTop ¬ d.startPage;
IF d.where.x >= d.startPage.x THEN {
r ¬ nextSlide;
box ¬ nextSlideBox;
}
ELSE {
r ¬ previousSlide;
box ¬ previousSlideBox;
};
};
ENDCASE => {
r ¬ "HUH ??";
box ¬ previousSlideBox; -- don't bother with HUH box
};
context.DoSave[DoArrow];
context.DoSave[DoLabel];
};
d: Data ¬ NARROW[clientData];
scaleFactor: REAL ¬ bsStyle.GetTransforms[bs: d.biScroller].viewerToClient.a;
by using viewerToClient, get the inverse transformation of the view
context: Imager.Context ¬ dc;
IF d.op=$Idle OR d.op=$WindowPaint OR NOT d.useBR THEN RETURN[TRUE];
context.DoSave[DoRefreshFrgnd]; -- might be needed if DoRefreshFrgnd changes
DoRefreshFrgnd[];
};
<<Eject: PSGraphics.PageEjectProc ~ {
for now, stop after a single page is rendered by raising this signal.
If we don't do this the screen gets cleared. This is a problem.
ERROR PS.PostScriptJobAborted
psMessages.PutRope["\nEject Proc called\n"];
};
>>
RefreshBkgnd: BufferedRefresh.RefreshProc ~ {
RefreshProc: TYPE = PROC [dc: Imager.Context, boundRect: Rectangle, clientData: REF ANY] RETURNS [drawnOn: BOOL ← TRUE];
This proc works in conjunction with ReadyBkgrnd, which prepares for display.
DoRefreshBkgnd: PROC = { -- action proc for DoSave
IF d.master#NIL AND d.iMemContext#NIL THEN ImagerMemory.Replay[c: d.iMemContext, into: context]
<<ELSE IF d.psRoot#NIL THEN {
doPSAction: PROC [psContext: PSGraphics.GContext] = TRUSTED {
d.psRoot.context ¬ psContext;
IO.SetIndex[d.stream, 0];
PS.DoStream[self: d.psRoot, in: d.stream, context: psContext];
};
PS.SetStdIO[d.psRoot, psMessages, psMessages];
PS programs doing initgraphics screws up BiScroller transformation.
Often get PS errors with a non Identity BiScroller transformation.
Screen gets cleared at end of jobs.
No way to cache individual pages like in ImagerMemory.
Imager.DoWithBuffer doesn't work with PS interpreter. Why??
ImagingContextConvert.WithPSGraphicsForImager[context, doPSAction, [Eject, NIL]
! PS.PostScriptJobAborted, PS.PostScriptJobError => CONTINUE]; -- expect PostScriptJobAborted after one page for now.
}>>;
};
d: Data ¬ NARROW[clientData];
context: Imager.Context ¬ dc;
context.DoSave[DoRefreshBkgnd];
RETURN[TRUE];
};
SetCA: PROC [c, a: INTEGER ¬ 0] = {
useClip ¬ c=1;
useFill ¬ a=1;
};
useFill: BOOL ¬ FALSE;
useClip: BOOL ¬ TRUE;
ReadyBkgrnd: PROC [d: Data] ~ {
<<IF d.master#NIL AND d.psRoot#NIL THEN GOTO UhOh;>>
IF d.master#NIL AND d.pageInMem#d.pageNumber THEN { -- memory context may be cached
cacheVal: CacheVal ¬ Lookup[d];
IF cacheVal#NIL THEN { -- hit
d.boundRect ¬ cacheVal.boundRect;
d.iMemContext ¬ cacheVal.iMemContext;
}
ELSE { -- miss. Do not do bounding calculation here. Defer to Fill code.
newVal: CacheVal ¬ NEW[CacheValRep];
newKey: CacheKey ¬ NEW[CacheKeyRep];
newKey.fileName ¬ d.fileName;
newKey.pageNumber ¬ d.pageNumber;
d.iMemContext ¬ newVal.iMemContext ¬ ImagerMemory.NewMemoryContext[];
Imager.ScaleT[d.iMemContext, pointsPerMeter]; -- establish IP coord system
Following code required to get the context state to the default assumed by InterpressInterpreter.DoPage
Imager.SetColor[d.iMemContext, Imager.black];
Imager.SetAmplifySpace[d.iMemContext, 1.0];
Imager.SetStrokeWidth[d.iMemContext, 0.0];
Imager.SetStrokeEnd[d.iMemContext, square];
Imager.SetStrokeJoint[d.iMemContext, miter];
InterpressInterpreter.DoPage[d.master, d.pageNumber, d.iMemContext, IPLogError];
d.boundRect ¬ newVal.boundRect ¬ nullRect;
FunctionCache.Insert[x: globalCache, argument: newKey, value: newVal,
size: ImagerMemory.GetContextSize[d.iMemContext], clientID: $SSPage];
};
d.pageInMem ¬ d.pageNumber;
};
<<EXITS
UhOh => {
Message["SlideShow error: both PS and IP masters active. See maintainers."];
};>>
};
PaintView: PROC [d: Data, op: ATOM] ~ {
viewer: ViewerClasses.Viewer ¬ d.view;
ReadyBkgrnd[d]; -- do this BEFORE calling ViewerOps.PaintViewer to keep it out of the paint proc locks
SELECT op FROM
$WindowPaint => {
ViewerOps.PaintViewer[viewer: viewer, hint: all, clearClient: FALSE, whatChanged: $WindowPaint];
};
$View => {
ViewerOps.PaintViewer[viewer: viewer, hint: all, clearClient: FALSE, whatChanged: d];
};
$Shift => {
t: Imager.Transformation ¬ bsStyle.GetTransforms[d.biScroller].clientToViewer;
BiScrollers.Shift[bs: d.biScroller, dx: t.a*(d.where.x-d.startScroll.x), dy: t.e*(d.where.y-d.startScroll.y), paint: TRUE];
};
ENDCASE => {
Message["SlideShow saw undefined paint operation. See maintainers."];
ViewerOps.PaintViewer[viewer: viewer, hint: all, clearClient: FALSE, whatChanged: d];
};
};
ipIgnoreBackingMap, ipNoBuffer: BOOL = FALSE;
<<psIgnoreBackingMap: BOOL = FALSE;>>
<<psNoBuffer: BOOL = TRUE; -- DoWithBuffer doesn't currently work with PS. Problem>>
GetBRParameters: PROC [d: Data, scale: REAL] RETURNS [ignoreBMap, noB: BOOL ¬ TRUE, clip: Imager.Rectangle ¬ nullRect] = {
IF NOT d.useBR THEN RETURN[TRUE, TRUE, nullRect];
<<IF d.psRoot#NIL THEN {
RETURN[psIgnoreBackingMap, psNoBuffer, nullRect]; -- for now
};>>
IF d.master#NIL THEN {
box: Imager.Box;
start: Imager.VEC;
where: Imager.VEC ¬ d.where;
ignoreBMap ¬ ipIgnoreBackingMap;
noB ¬ ipNoBuffer;
IF noB OR (NOT useClip) THEN RETURN;
SELECT d.op FROM
$StartScroll, $DuringScroll => start ¬ d.startScroll;
$StartPage, $DuringPage => start ¬ d.startPage;
ENDCASE => RETURN; -- return default nullRect
need bounding box of feedback region
box ¬ [xmin: MIN[start.x, where.x], ymin: MIN[start.y, where.y], xmax: MAX[start.x, where.x], ymax: MAX [start.y, where.y] ];
box.xmin ¬ box.xmin - offset - scale*previousSlideBox.xmax;
box.ymin ¬ box.ymin - offset - scale*previousSlideBox.ymax;
box.xmax ¬ box.xmax + offset + scale*previousSlideBox.xmax;
box.ymax ¬ box.ymax + offset + scale*previousSlideBox.ymax;
IF d.oldClip.xmin=-Real.LargestNumber THEN {
clip ¬ ImagerBox.RectangleFromBox[box];
d.oldClip ¬ box;
}
ELSE {
clip ¬ ImagerBox.RectangleFromBox[ImagerBox.BoundingBox[d.oldClip, box]];
d.oldClip ¬ box;
};
};
};
DrawSandwich: PROC [d: Data, context: Imager.Context, invalidateBkgnd: BOOL ¬ FALSE] ~ {
DoDrawSandwich: PROC = {
clip: Imager.Rectangle ¬ nullRect;
clientToViewer, viewerToClient: Imager.Transformation;
ignoreBackingMap, noBuffer: BOOL ¬ TRUE;
[clientToViewer, viewerToClient] ¬ bsStyle.GetTransforms[d.biScroller];
[ignoreBackingMap, noBuffer, clip] ¬ GetBRParameters[d, viewerToClient.a];
IF invalidateBkgnd THEN BufferedRefresh.SetLayerOK[d.sandwich, $SSBkgnd, FALSE];
BufferedRefresh.DrawSandwich[d.sandwich, context, clientToViewer, viewerToClient, d, Imager.white, ignoreBackingMap, noBuffer, clip];
};
Imager.DoSave[context, DoDrawSandwich];
};
SSPaint: ViewerClasses.PaintProc ~ TRUSTED {
[self: Viewer, context: Context, whatChanged: REF ANY, clear: BOOL];
ENABLE UNCAUGHT => GOTO Finished; -- return and unlock viewers
d: Data ¬ NARROW[BiScrollers.ClientDataOfViewer[self]];
sanityCheck: BOOL[TRUE..TRUE] ~ (d.view=self);
IF whatChanged=NIL THEN { -- call from window manager. Viewer may have changed size.
SlackProcess.QueueAction[d.slackHandle, Dispatch, LIST[$WindowPaint], d, NIL];
}
ELSE IF whatChanged=$WindowPaint THEN { -- recall for window manager. Viewer may have changed size.
BufferedRefresh.FitSandwichToScreen[d.sandwich, d.view.cw, d.view.ch, context];
DrawSandwich[d, context, TRUE];
}
ELSE DrawSandwich[d, context, d.op=$Idle]; -- invalidateBkgnd for final paint after an interactive operation
EXITS
Finished => Message["SlideShow saw UNCAUGHT ERROR while painting. See maintainers."];
};
SSNotify: ViewerClasses.NotifyProc ~ {-- [self: Viewer, input: LIST OF REF ANY]
d: Data ¬ NARROW[BiScrollers.ClientDataOfViewer[self]];
SlackProcess.QueueAction[d.slackHandle, Dispatch, input, d, NIL];
};
Dispatch: PROC [clientData: REF ANY, inputAction: REF] = {
d: Data ¬ NARROW[clientData];
event: LIST OF REF ¬ NARROW[inputAction];
z: BiScrollers.ClientCoords ¬ IF event.rest#NIL THEN NARROW[event.rest.first] ELSE NIL; -- REF Vec
d.op ¬ NARROW[event.first]; -- ATOM
IF z#NIL THEN d.where ¬ [z.x, z.y]; -- mouseX in BiScroller coords
The following select statement also acts like a little state machine in that it handles aborting operations when the left button is clicked while an operation is in progress.
SELECT d.op FROM
$Abort => {
d.aborted ¬ TRUE;
d.op ¬ $Idle;
};
$WindowPaint => {
d.op ¬ $Idle;
PaintView[d: d, op: $WindowPaint];
};
$StartScroll => {
d.startScroll ¬ d.where;
d.op ¬ $DuringScroll;
d.aborted ¬ FALSE;
IF d.useBR THEN PaintView[d: d, op: $View]; -- track scrolling
};
$DuringScroll => IF ~d.aborted AND d.useBR THEN PaintView[d: d, op: $View]; -- track scrolling
$EndScroll => {
d.op ¬ $Idle;
PaintView[d: d, op: IF d.aborted THEN $WindowPaint ELSE $Shift];
d.aborted ¬ FALSE;
};
$StartPage => {
d.startPage ¬ d.where;
d.op ¬ $DuringPage;
d.aborted ¬ FALSE;
IF d.useBR THEN PaintView[d: d, op: $View]; -- track paging
};
$DuringPage => IF ~d.aborted AND d.useBR THEN PaintView[d: d, op: $View]; -- track paging
$EndPage => {
nextSlide: BOOL ¬ d.where.x >= d.startPage.x;
d.op ¬ $Idle;
IF ~d.aborted THEN DeltaPage[d, d.pageNumber + (IF nextSlide THEN 1 ELSE -1)]
ELSE PaintView[d: d, op: $WindowPaint];
d.aborted ¬ FALSE;
};
ENDCASE => Message[IO.PutFR1["SlideShow: unknown Notify atom %g", IO.atom[d.op] ]];
};
SSDestroy: ViewerClasses.DestroyProc ~ { -- [self: Viewer]
ENABLE UNWIND => NULL;
d: Data ¬ NARROW[BiScrollers.ClientDataOfViewer[self]];
drop stuff so collector has a chance at it if Viewers lets go as well
IF d.stream#NIL THEN {d.stream.Close[]; d.stream ¬ NIL;};
IF d.master#NIL THEN {InterpressInterpreter.Close[d.master]; d.master ¬ NIL;};
[] ¬ bsStyle.Destroy[d.biScroller];
d.sandwich ¬ NIL;
d.container ¬ d.pageNumberViewer ¬ d.pageNumberSlider ¬ d.fileNameViewer ¬ d.view ¬ NIL;
<<d.cachedPSRoot ¬ d.psRoot ¬ NIL;>>
d.iMemContext ¬ NIL;
d.biScroller ¬ NIL;
clear the function cache of old SSPage entries (and maybe they'll be collected)
[] ¬ FunctionCache.Obtain[globalCache, FunctionCache.Any, 9999, $SSPage];
SlackProcess.FlushQueue[d.slackHandle];
d.slackHandle ¬ NIL;
};
SSExtremaProc: PROC [clientData: REF ANY, direction: Geom2D.Vec] RETURNS [min, max: Geom2D.Vec]
~ { --BiScrollers.ExtremaProc
This proc is required by BiScrollers to return the extremes of the displayed data
d: Data ← NARROW[clientData];
area: Geom2D.Rect ¬ [x: 0.0, y: 0.0, w: pageWidth, h: pageHeight];
[min, max] ¬ Geom2D.ExtremaOfRect[r: area, n: direction];
};
SSUserAction: BiScrollers.BSUserActionProc = {
BSUserActionProc: TYPE = PROC [bs: BiScroller, input: LORA];
BiScrollers.DoBSUserAction[bs, input];
};
<<psVersion: REAL = 47.0; -- laserWriterII. Should be irrelevant here
psMessages: IO.STREAM; -- CommanderOps error stream>>
pdls: Rope.ROPE = IF release THEN "IP" ELSE "IP or PS";
localDir: Rope.ROPE = "/tilde/pier/slideshow/";
tipWDir: Rope.ROPE = IF release THEN "/Cedar10.1/PreView/" ELSE localDir;
helpWDir: Rope.ROPE = IF release THEN "/Cedar10.1/PreView/" ELSE localDir;
<<psInitDir: Rope.ROPE = IF release THEN "/Cedar10.1/PreView/" ELSE localDir;>>
leaveRight: INTEGER = IF release THEN 250 ELSE 400; -- fudge factor when taking over the Cedar screen
defaultWant: Rope.ROPE = IF release THEN NIL ELSE Rope.Concat[localDir, "AdultsAtPlay.ip"];
defaultGet: Rope.ROPE ¬ defaultWant; -- defaultGet is a variable
helpFile: Rope.ROPE = "SlideShowHelp.tioga";
ssIcon: Icons.IconFlavor ¬ Icons.NewIconFromFile[Rope.Concat[tipWDir, "SlideShow.icons"], 0];
buffer: REF TEXT = NEW[TEXT[256]];
bsStyle: BiScrollers.BiScrollerStyle;
bsClass: BiScrollers.BiScrollerClass;
InitSlideShow: PROC = {
ssTIP: TIPUser.TIPTable ¬
TIPUser.InstantiateNewTIPTable[Rope.Concat[tipWDir, "SlideShow.tip"]];
bsStyle ¬ BiScrollers.GetStyle[]; -- default has scrollbars
bsClass ¬ bsStyle.NewBiScrollerClass[[
flavor: $SlideShow,
extrema: SSExtremaProc,
notify: SSNotify,
paint: SSPaint,
destroy: SSDestroy,
bsUserAction: SSUserAction,
tipTable: ssTIP,
cursor: crossHairsCircle,
mayStretch: FALSE, -- OK to scale X and Y differently
preserve: [X: 0.5, Y: 1.0] --this specifies that the upper middle of the picture stays fixed when viewer size changes.
]];
};
InitSlideShow[];
Commander.Register[key: "SlideShow", proc: CreateSlideShow, doc: IO.PutFR["\nSlideShow [-r] [%g file]\nCreate a slide show for a set of slides in an %g master\n-r buffered refresh disable", IO.rope[pdls], IO.rope[pdls] ]];
Commander.Register[key: "SSFlush", proc: SSFlush, doc: "Flush cache of ImagerMemory contexts for SlideShow" ];
END.