DIRECTORY
Commander USING [CommandProc, Register],
CommandTool USING [CurrentWorkingDirectory, ParseToList],
Convert USING [IntFromRope],
FS USING [ComponentPositions, Error, ExpandName, FileInfo],
GriffinImageUtils USING [GriffinToImagerCalls, ReadGriffinImage],
Icons USING [IconFlavor, NewIconFromFile],
Imager,
ImagerBackdoor USING [GetBounds],
ImagerInterpress USING [Close, Create, DoPage, Ref],
ImagerMemory USING [NewMemoryContext, Replay],
ImagerTypeface USING [Find],
ImagerTypefaceExtras USING [GenericCreatorProc, GenericCreatorRep, RegisterGenericCreator],
Interpress USING [DoPage, LogProc, Open, OpenMaster],
IO USING [PutRope],
IPViewers,
Menus USING [AppendMenuEntry, ClickProc, CreateEntry, CreateMenu, Menu],
MessageWindow USING [Append, Blink],
Rope USING [Cat, Find, Index, Length, ROPE, Substr],
UserProfile USING [ListOfTokens],
ViewerClasses USING [InitProc, PaintProc, SaveProc, Viewer, ViewerClass, ViewerClassRec, ViewerRec],
ViewerOps USING [CreateViewer, DestroyViewer, PaintViewer, RegisterViewerClass, SaveViewer],
ViewerTools USING [GetSelectionContents];
OPEN IPViewers;
Viewer: TYPE ~ ViewerClasses.Viewer;
Context: TYPE ~ Imager.Context;
ROPE: TYPE ~ Rope.ROPE;
Data: TYPE ~ REF DataRep;
DataRep:
TYPE ~
RECORD [
dirOnly: BOOLEAN ← FALSE, --TRUE => viewer.file contains only a working directory
preamble: Context, --Played for every page
currentPage: CARDINAL ← 0,
pages: SEQUENCE nPages: CARDINAL OF Page
];
Page:
TYPE ~
RECORD [
context: Context,
bounds: Imager.Rectangle
];
InvalidPage: PUBLIC ERROR ~ CODE;
BadName: ERROR ~ CODE;
Create:
PUBLIC PROC [info: ViewerClasses.ViewerRec ← [], paint:
BOOL ←
TRUE, pages:
CARDINAL ← 1]
RETURNS [v: IPViewer] ~ {
data: Data;
v ← ViewerOps.CreateViewer[$IPViewer, info, paint];
data ← NARROW[v.data];
IF data.dirOnly OR pages > data.nPages THEN SetNumberOfPages[v, pages];
};
DoActions:
PUBLIC PROC [v: IPViewer, action:
PROC [context: Imager.Context], page:
CARDINAL ← 0] ~ {
data: Data ~ NARROW[v.data];
IF ~(page IN [0..data.nPages)) THEN ERROR InvalidPage[];
action[data.pages[page].context];
IF ~v.newVersion
THEN {
v.newVersion ← TRUE;
ViewerOps.PaintViewer[v, caption];
};
};
SetBounds:
PUBLIC PROC [v: Viewer, bounds: Imager.Rectangle, page:
CARDINAL ← 0] ~ {
data: Data ~ NARROW[v.data];
IF ~(page IN [0..data.nPages)) THEN ERROR InvalidPage[];
data.pages[page].bounds ← bounds;
};
GetContext:
PUBLIC UNSAFE PROC [v: IPViewer, page:
CARDINAL ← 0]
RETURNS [context: Imager.Context] ~ {
data: Data ~ NARROW[v.data];
IF ~(page IN [0..data.nPages)) THEN ERROR InvalidPage[];
RETURN [data.pages[page].context];
};
SetNumberOfPages:
PUBLIC PROC [v: IPViewer, pages:
CARDINAL] ~ {
oldData: Data ~ NARROW[v.data];
newData: Data ~ NEW[DataRep[pages]];
numberToCopy: CARDINAL ~ MIN[oldData.nPages, pages];
v.data ← newData;
newData.dirOnly ← oldData.dirOnly;
newData.preamble ← oldData.preamble;
newData.currentPage ← oldData.currentPage;
FOR index:
CARDINAL
IN [0..numberToCopy)
DO
newData.pages[index] ← oldData.pages[index];
ENDLOOP;
FOR index:
CARDINAL
IN [numberToCopy..newData.nPages)
DO
newData.pages[index].context ← ImagerMemory.NewMemoryContext[];
newData.pages[index].bounds ← [x: 0, y: 0, w: 8.5*Imager.metersPerInch, h: 11*Imager.metersPerInch];
ENDLOOP;
};
IPSave: ViewerClasses.SaveProc ~ {
PROC [self: Viewer, force: BOOL ← FALSE]
ref: ImagerInterpress.Ref ~ ImagerInterpress.Create[fileName: self.file];
data: Data ~ NARROW[self.data];
IF ~self.newVersion THEN RETURN; --Don't waste time on unedited things
IF data.dirOnly
THEN {
MessageWindow.Append["Can't SAVE -- no file name!"];
MessageWindow.Blink[];
RETURN;
};
FOR index:
CARDINAL
IN [0..data.nPages)
DO
Action:
PROC [c: Imager.Context] ~ {
ImagerMemory.Replay[data.pages[index].context, c];
};
ImagerInterpress.DoPage[ref, Action];
ENDLOOP;
ImagerInterpress.Close[ref];
self.newVersion ← FALSE;
SetNameAndLabel[self];
ViewerOps.PaintViewer[self, caption];
};
IPInit: ViewerClasses.InitProc ~ {
data: Data ← NEW[DataRep[1]];
data.pages[0] ← [context: ImagerMemory.NewMemoryContext[], bounds: [x: 0, y: 0, w: 8.5*Imager.metersPerInch, h: 11*Imager.metersPerInch]];
self.data ← data;
IF Rope.Length[GetWDirFromName[self.file]]=0 THEN self.file ← Rope.Cat[CommandTool.CurrentWorkingDirectory[], self.file];
{
--See if just a directory, and set name appropriately
self.file ← FS.ExpandName[self.file ! FS.Error => IF error.group=user THEN GOTO DirectoryOnly].fullFName;
EXITS DirectoryOnly => {
fullFName: ROPE ~ FS.ExpandName[Rope.Cat[self.file, "Z"]].fullFName;
self.file ← Rope.Substr[base: fullFName, len: Rope.Length[fullFName]-1];
data.dirOnly ← TRUE;
};
};
SetNameAndLabel[self];
IF ~data.dirOnly
THEN {
LoadContext[self];
self.newVersion ← FALSE;
ViewerOps.PaintViewer[self, caption];
};
};
IPPaint: ViewerClasses.PaintProc ~ {
PROC [self: Viewer, context: Imager.Context, whatChanged: REF, clear: BOOL]
RETURNS [quit: BOOL ← FALSE]
Center the context in the viewer
data: Data ~ NARROW[self.data];
page: CARDINAL ~ data.currentPage;
screenBounds: Imager.Rectangle ~ ImagerBackdoor.GetBounds[context];
imageBounds: Imager.Rectangle ~ IF (data.currentPage IN [0..data.nPages)) THEN data.pages[page].bounds ELSE [0, 0, 8.5, 11];
dx: REAL ~ screenBounds.w/2;
dy: REAL ~ screenBounds.h/2;
scale: REAL ~ MIN[screenBounds.w/imageBounds.w, screenBounds.h/imageBounds.h];
IF ~data.currentPage IN [0..data.nPages) THEN RETURN;
Imager.SetGray[context, .75]; --Background gray
Imager.MaskRectangle[context, screenBounds];
Imager.TranslateT[context, [dx, dy]];
Imager.ScaleT[context, scale];
Imager.TranslateT[context, [-(imageBounds.x+imageBounds.w/2), -(imageBounds.y+imageBounds.h/2)]];
Imager.SetColor[context, Imager.white];
Imager.MaskRectangle[context, imageBounds];
Imager.ClipRectangle[context, imageBounds];
Imager.SetColor[context, Imager.black];
ImagerMemory.Replay[data.pages[page].context, context];
};
Clear: Menus.ClickProc ~ {
PROC [parent: REF ANY, clientData: REF ANY ← NIL,
mouseButton: MouseButton ← red, shift, control: BOOL ← FALSE]
v: Viewer ~ NARROW[parent];
SetNumberOfPages[v, 0];
v.file ← GetWDirFromName[v.file];
SetNameAndLabel[v];
ViewerOps.PaintViewer[v, all];
};
Get: Menus.ClickProc ~ {
PROC [parent: REF ANY, clientData: REF ANY ← NIL,
mouseButton: MouseButton ← red, shift, control: BOOL ← FALSE]
v: Viewer ~ NARROW[parent];
name: ROPE ← FigureFileNameFromSelection[v ! BadName => GOTO BailOut];
includesVersion: BOOLEAN ← Rope.Find[name, "!"]#-1; --Was a version specified?
name ←
FS.FileInfo[name !
FS.Error => {
IF error.group=user
THEN {
MessageWindow.Append[Rope.Cat[name, " not found."], TRUE];
MessageWindow.Blink[];
GOTO BailOut;
};
}].fullFName;
IF ~includesVersion THEN name ← Rope.Substr[base: name, len: Rope.Index[s1: name, s2: "!"]];
v.file ← name;
LoadContext[v];
SetNameAndLabel[v];
ViewerOps.PaintViewer[v, all];
EXITS BailOut => NULL
};
Store: Menus.ClickProc ~ {
PROC [parent: REF ANY, clientData: REF ANY ← NIL,
mouseButton: MouseButton ← red, shift, control: BOOL ← FALSE]
v: Viewer ~ NARROW[parent];
data: Data ~ NARROW[v.data];
name: ROPE ← FigureFileNameFromSelection[v ! BadName => GOTO BailOut];
v.file ← name;
v.newVersion ← TRUE;
data.dirOnly ← FALSE;
SetNameAndLabel[v];
ViewerOps.SaveViewer[v];
EXITS BailOut => NULL;
};
StoreDocumentation: Menus.ClickProc ~ {
v: Viewer ~ NARROW[parent];
name: ROPE ← FigureFileNameFromSelection[v ! BadName => GOTO BailOut];
MessageWindow.Append[Rope.Cat["Confirm Store to file: ", name]];
EXITS BailOut => NULL;
};
Save: Menus.ClickProc ~ {
PROC [parent: REF ANY, clientData: REF ANY ← NIL,
mouseButton: MouseButton ← red, shift, control: BOOL ← FALSE]
v: Viewer ~ NARROW[parent];
SetNameAndLabel[v];
ViewerOps.SaveViewer[v];
};
LoadFromInterpress: Menus.ClickProc ~ {
v: Viewer ~ NARROW[parent];
LoadContext[v, FigureFileNameFromSelection[v] ! BadName => GOTO BailOut];
EXITS BailOut => NULL
};
LoadFromGriffin: Menus.ClickProc ~ {
ImageGriffin:
PROC [context: Context] ~ {
OPEN GriffinImageUtils;
Imager.ScaleT[context, Imager.metersPerMica];
GriffinToImagerCalls[context, ReadGriffinImage[name]];
v.newVersion ← TRUE;
ViewerOps.PaintViewer[v, all];
};
v: Viewer ~ NARROW[parent];
data: Data ~ NARROW[v.data];
name: ROPE ← FigureFileNameFromSelection[v ! BadName => GOTO Fail];
name ←
FS.FileInfo[name !
FS.Error => {
IF error.group=user
THEN {
MessageWindow.Append[Rope.Cat[name, " not found."], TRUE];
MessageWindow.Blink[];
GOTO Fail;
};
}].fullFName;
DoActions[NARROW[parent], ImageGriffin, data.currentPage];
EXITS Fail => NULL
};
TurnPage: Menus.ClickProc ~ {
ENABLE ANY => GOTO InvalidNumber;
v: Viewer ~ NARROW[parent];
data: Data ~ NARROW[v.data];
newPage:
CARDINAL ←
SELECT mouseButton
FROM
red => IF shift THEN LAST[CARDINAL] ELSE data.currentPage+1,
yellow => CARDINAL[Convert.IntFromRope[ViewerTools.GetSelectionContents[] ! ANY => GOTO InvalidNumber]-1],
blue => IF shift THEN 0 ELSE data.currentPage-1,
ENDCASE => ERROR;
IF data.nPages=0 THEN GOTO NoPages;
newPage ← MIN[data.nPages-1, newPage];
data.currentPage ← newPage;
ViewerOps.PaintViewer[v, client];
EXITS
InvalidNumber => {
MessageWindow.Append["Invalid number", TRUE];
MessageWindow.Blink[];
};
NoPages => {
MessageWindow.Append["No pages to turn.", TRUE];
MessageWindow.Blink[];
};
};
IPOpen: Commander.CommandProc ~ {
args: LIST OF ROPE ~ CommandTool.ParseToList[cmd].list;
msg ← NIL;
FOR each:
LIST
OF
ROPE ← args, each.rest
UNTIL each=
NIL
DO
viewer: Viewer;
fullName: ROPE ← FS.ExpandName[each.first, CommandTool.CurrentWorkingDirectory[]].fullFName;
IF Rope.Find[each.first, "!"]=-1 THEN fullName ← Rope.Substr[base: fullName, len: Rope.Index[s1: fullName, s2: "!"]]; --Strip bang off
viewer ← Create[[file: fullName, iconic:
TRUE] ! FS.Error =>
IF error.group=user
THEN {
IO.PutRope[cmd.err, error.explanation]; IO.PutRope[cmd.err, "\n"];
result ← $Failure;
IF viewer#NIL THEN ViewerOps.DestroyViewer[viewer ! ANY => CONTINUE];
CONTINUE;
}];
ENDLOOP;
};
IPNew: Commander.CommandProc~ {
[] ← Create[[file: CommandTool.CurrentWorkingDirectory[], iconic: FALSE] ! BadName => CONTINUE];
};
LogProc: Interpress.LogProc ~ {
ERROR;
};
LoadContext:
PROC [v: Viewer, file:
ROPE ←
NIL, expandIfNeeded:
BOOLEAN ←
TRUE] ~ {
IF file=NIL THEN file ← v.file;
file ←
FS.FileInfo[file !
FS.Error => {
IF error.group=user
THEN {
MessageWindow.Append[Rope.Cat[file, " not found."], TRUE];
MessageWindow.Blink[];
};
}].fullFName;
{
data: Data ← NARROW[v.data];
ipMaster: Interpress.OpenMaster ~ Interpress.Open[fileName: file, logProc: LogProc ! FS.Error => IF error.group=user THEN GOTO Fail];
IF expandIfNeeded
AND ipMaster.pages > data.nPages
THEN {
SetNumberOfPages[v, ipMaster.pages];
data ← NARROW[v.data];
};
FOR index:
CARDINAL
IN [0..
MIN[
CARDINAL[ipMaster.pages], data.nPages])
DO
Interpress.DoPage[ipMaster, index+1, data.pages[index].context];
ENDLOOP;
v.newVersion ← TRUE;
ViewerOps.PaintViewer[v, all];
};
EXITS Fail => ERROR BadName[];
};
FigureFileNameFromSelection:
PROC [v: Viewer]
RETURNS [f:
ROPE] ~ {
wDir: ROPE ← GetWDirFromName[v.file];
name: ROPE ← ViewerTools.GetSelectionContents[];
IF Rope.Length[name]=0
THEN {
MessageWindow.Append["Please select file name."];
MessageWindow.Blink[];
ERROR BadName;
};
f ← FS.ExpandName[name, wDir
! FS.Error => {
IF error.group=user
THEN {
MessageWindow.Append["Illegal file name."];
MessageWindow.Blink[];
GOTO ReportBadName;
};
}
].fullFName;
EXITS ReportBadName => ERROR BadName;
};
SetNameAndLabel:
PROC [v: Viewer] ~ {
data: Data ~ NARROW[v.data];
prefixes: LIST OF ROPE ~ UserProfile.ListOfTokens["Viewers.SuppressIconPrefix", NIL];
v.name ← v.label ← v.file;
IF ~data.dirOnly
THEN {
v.name ← Rope.Cat[v.name, " (?)"];
};
IF v.newVersion THEN v.name ← Rope.Cat[v.name, " [Edited]"];
v.icon ← IF v.newVersion THEN pvIconBlack ELSE pvIconWhite;
FOR each:
LIST
OF
ROPE ← prefixes, each.rest
UNTIL each=
NIL
DO
IF Rope.Find[s1: v.label, s2: each.first, case: FALSE]=0 THEN v.label ← Rope.Substr[base: v.label, start: Rope.Length[each.first]];
ENDLOOP;
};
GetWDirFromName:
PROC [name:
ROPE]
RETURNS [wDir:
ROPE] ~ {
cp: FS.ComponentPositions;
fullName: ROPE;
[fullFName: fullName, cp: cp] ←
FS.ExpandName[name !
FS.Error =>
IF error.group=user
AND error.code=$illegalName
THEN {
[fullFName: fullName, cp: cp] ← FS.ExpandName[Rope.Cat[name, "Z"]];
fullName ← Rope.Substr[base: fullName, len: Rope.Length[fullName]-1];
CONTINUE;
}];
RETURN [Rope.Substr[base: fullName, len: cp.base.start]];
};
pvIconWhite: Icons.IconFlavor ~ Icons.NewIconFromFile["Persistent.icons", 0];
pvIconBlack: Icons.IconFlavor ~ Icons.NewIconFromFile["Persistent.icons", 1];
pvMenu: Menus.Menu ← Menus.CreateMenu[];
pvClass: ViewerClasses.ViewerClass ~ NEW[ViewerClasses.ViewerClassRec ← [
flavor: $IPViewer,
save: IPSave,
paint: IPPaint,
init: IPInit,
menu: pvMenu,
icon: pvIconWhite
]];
FontSubstitution: ImagerTypefaceExtras.GenericCreatorProc ~ {
RETURN [ImagerTypeface.Find["Xerox/PressFonts/Helvetica-mrr"]];
};
Init:
PROC ~ {
{
--Set up the menu
OPEN Menus;
AppendMenuEntry[pvMenu, CreateEntry[name: "Clear", proc: Clear]];
AppendMenuEntry[pvMenu, CreateEntry[name: "Reset", proc: Reset, documentation: ResetDocumentation, guarded: TRUE]];
AppendMenuEntry[pvMenu, CreateEntry[name: "Get", proc: Get]];
AppendMenuEntry[pvMenu, CreateEntry[name: "Store", proc: Store, documentation: NEW[ Menus.ClickProc ← StoreDocumentation], guarded: TRUE]];
AppendMenuEntry[pvMenu, CreateEntry[name: "Save", proc: Save]];
AppendMenuEntry[pvMenu, CreateEntry[name: "LoadFromInterpress", proc: LoadFromInterpress]];
AppendMenuEntry[pvMenu, CreateEntry[name: "LoadFromGriffin", proc: LoadFromGriffin]];
AppendMenuEntry[pvMenu, CreateEntry[name: "Page", proc: TurnPage]];
ViewerOps.RegisterViewerClass[$IPViewer, pvClass];
};
Commander.Register[key: "IPOpen", proc: IPOpen, doc: "IPOpen fileName - open an interpress viewer"];
Commander.Register[key: "IPNew", proc: IPNew, doc: "Open an empty interpress viewer"];
ImagerTypefaceExtras.RegisterGenericCreator[NEW[ImagerTypefaceExtras.GenericCreatorRep ← [data: NIL, proc: FontSubstitution, priority: 0]]];
};
Init[];