DIRECTORY
Atom USING [GetPName, GetProp, PropList, PutProp],
Basics USING [bitsPerWord],
BasicTime USING [Now],
Buttons USING [Button, ButtonProc, Create, SetDisplayStyle],
Commander USING [CommandProc, Register],
CommandTool USING [CurrentWorkingDirectory],
Containers USING [ChildXBound, ChildYBound, Container, Create],
ImagerBackdoor USING [DrawBits],
IO USING [Close, Error, PutF, STREAM, time],
Labels USING [Create, Label, Set],
Loader USING [BCDBuildTime],
Process USING [MsecToTicks, SetTimeout],
Rope USING [Equal, IsEmpty, Length, ROPE, FromRefText],
Rules USING [Create, Rule],
TapeOps USING [DriveNumber],
TapeStreams USING [ConversionRecord],
TapeToolInternal USING [Action, BuildOperations, Create, ExecuteOp, Flush,
GetToolParameters, Parameters, PrompterSeq, ReactToProfile, RegisterIdle, RegisterProfile,
TapeTool, TapeToolOp, TapeToolRecord, UnRegisterIdle, UnregisterProfile],
TypeScript USING [Create],
UserProfile USING [CallWhenProfileChanges],
VFonts USING [CharWidth, Font, StringWidth],
ViewerClasses USING [PaintProc, Viewer, ViewerClass, ViewerClassRec],
ViewerEvents USING [EventProc, EventRegistration, RegisterEventProc, UnRegisterEventProc],
ViewerIO USING [CreateViewerStreams],
ViewerOps USING [AddProp, CreateViewer, FetchProp, MoveViewer,
PaintViewer, RegisterViewerClass, SetOpenHeight],
ViewerTools USING [GetContents, GetSelectedViewer, InhibitUserEdits, MakeNewTextViewer,
SelPosRec, SetContents, SetSelection];
TapeToolInterfaceImpl:
CEDAR
MONITOR
IMPORTS Atom, BasicTime, Buttons, Commander, CommandTool, Containers, ImagerBackdoor, IO, Labels, Loader, Process, Rope, Rules, TapeToolInternal, TypeScript, UserProfile, VFonts, ViewerEvents, ViewerIO, ViewerOps, ViewerTools
EXPORTS TapeToolInternal = BEGIN
OPEN Tool: TapeToolInternal;
TapeTool: TYPE ~ Tool.TapeTool;
PrompterSeq: TYPE ~ Tool.PrompterSeq;
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
---- ---- ---- ---- ---- ---- ---- ----
Global "Variables" (constant after init)
---- ---- ---- ---- ---- ---- ---- ----
promptW: NAT = 13;
promptH: NAT = 10;
promptWpl: NAT ~ (promptW + Basics.bitsPerWord - 1)/Basics.bitsPerWord;
PromptArray: TYPE = ARRAY [0..promptWpl*promptH) OF WORD;
prompt: REF PromptArray ~ NEW[PromptArray ← [001600B, 000700B, 00340B, 000160B, 177770B, 177770B, 000160B, 000340B, 000700B, 001600B]];
tapeToolPrompter: ViewerClasses.ViewerClass =
NEW[ViewerClasses.ViewerClassRec ← [paint: PaintPrompter]];
---- ---- ---- ---- ---- ---- ---- ----
Configuration Parameters (private)
---- ---- ---- ---- ---- ---- ---- ----
minFeedbackLines: NAT = 4;
interactionQuestionLines: NAT = 1;
idleMessage: ROPE ← " ";
offScreen: INT = -9999;
---- ---- ---- ---- ---- ---- ---- ----
Tool Construction
---- ---- ---- ---- ---- ---- ---- ----
NewTapeTool:
PROC
[iconic:
BOOL, wDir:
ROPE ←
NIL, pgt:
BOOL ←
FALSE]
RETURNS [ tool: Tool.TapeTool ] =
BEGIN
AddSeparatingRule:
PROC =
BEGIN
rule: Rules.Rule = Rules.Create[info: [
wx: 0,
wy: tool.height,
ww: 9999, -- arbitrary; Containers.ChildXBound overrides
wh: 1,
parent: tool.outer
]];
Containers.ChildXBound[tool.outer, rule]; -- constrain rule to be width of parent
tool.height ← tool.height + tool.params.entryVSpace; -- spacing after rule
END;
BuildBailOut:
PROC =
BEGIN
prev: ViewerClasses.Viewer;
prev ← Buttons.Create[
info: [name: "Stop!",
wx: tool.params.entryHSpace,
wy: tool.height,
wh: tool.params.entryHeight,
parent: tool.outer,
border: TRUE
],
proc: AbortOperation,
fork: TRUE,
clientData: tool,
guarded: TRUE,
font: tool.params.font
];
tool.height ← tool.height + tool.params.entryHeight + tool.params.entryVSpace;
AddSeparatingRule[];
END;
BuildServerInfo:
PROC =
BEGIN
prev: ViewerClasses.Viewer;
prev ← Buttons.Create[
info: [name: "Server:",
wx: tool.params.entryHSpace,
wy: tool.height,
wh: tool.params.entryHeight,
parent: tool.outer,
border: FALSE
],
proc: SelectServerName,
fork: FALSE,
clientData: tool,
font: tool.params.font
];
tool.serverNameViewer ← ViewerTools.MakeNewTextViewer[info: [
wx: prev.wx + prev.ww + tool.params.entryHSpace/2,
wy: tool.height,
ww: VFonts.CharWidth['M, tool.params.font] * 7,
wh: tool.params.entryHeight,
data: tool.params.defaultServer,
parent: tool.outer,
scrollable: FALSE,
border: FALSE
]];
prev ← Buttons.Create[
info: [name: "Drive:",
wx: tool.serverNameViewer.wx + tool.serverNameViewer.ww + tool.params.entryHSpace,
wy: tool.height,
wh: tool.params.entryHeight,
parent: tool.outer,
border: FALSE
],
proc: SelectDriveNumber,
fork: FALSE,
clientData: tool,
font: tool.params.font
];
tool.driveNumberViewer ← ViewerTools.MakeNewTextViewer[
info: [
wx: prev.wx + prev.ww + tool.params.entryHSpace/2,
wy: tool.height,
ww: VFonts.CharWidth['0, tool.params.font] * 4, -- arbitrary; Containers.ChildXBound overrides
wh: tool.params.entryHeight,
data: "0",
parent: tool.outer,
scrollable: FALSE,
border: FALSE
]
];
prev ← Buttons.Create[
info: [name: "Density:",
wx: tool.driveNumberViewer.wx + tool.driveNumberViewer.ww + tool.params.entryHSpace,
wy: tool.height,
wh: tool.params.entryHeight,
parent: tool.outer,
border: FALSE
],
proc: SelectDensity,
fork: FALSE,
clientData: tool,
font: tool.params.font
];
tool.densityLabel ← Labels.Create[
info: [
wx: prev.wx + prev.ww + tool.params.entryHSpace/2,
wy: tool.height,
ww: VFonts.CharWidth['M, tool.params.font] * 7,
wh: tool.params.entryHeight,
name: (IF pgt THEN "800 bpi NRZI" ELSE "1600 bpi PE"),
parent: tool.outer,
border: FALSE
]
];
tool.density ← IF pgt THEN NRZI800 ELSE PE1600;
tool.height ← tool.height + tool.params.entryHeight + tool.params.entryVSpace;
AddSeparatingRule[];
END; -- BuildServerInfo
BuildFileInfo:
PROC =
BEGIN
prev: ViewerClasses.Viewer;
prev ← Buttons.Create[
info: [name: "File(s):",
wx: tool.params.entryHSpace,
wy: tool.height,
wh: tool.params.entryHeight,
parent: tool.outer,
border: FALSE
],
proc: SelectFileName,
fork: FALSE,
clientData: tool,
guarded: FALSE,
font: tool.params.font
];
tool.fileNameViewer ← ViewerTools.MakeNewTextViewer[info: [
wx: prev.wx + prev.ww + tool.params.entryHSpace,
wy: tool.height,
ww: 9999,
wh: tool.params.entryHeight,
data:
IF tool.params.fileNamePrefixes = NIL THEN NIL
ELSE IF tool.params.localDisk THEN NIL ELSE tool.params.fileNamePrefixes.first,
parent: tool.outer,
scrollable: TRUE,
border: FALSE
]];
Containers.ChildXBound[container: tool.outer, child: tool.fileNameViewer];
tool.height ← tool.height + tool.params.entryHeight + tool.params.entryVSpace;
prev ← Buttons.Create[
info: [name: "WD:",
wx: tool.params.entryHSpace,
wy: tool.height,
wh: tool.params.entryHeight,
parent: tool.outer,
border: FALSE
],
proc: SelectWDName,
fork: FALSE,
clientData: tool,
guarded: FALSE,
font: tool.params.font
];
tool.wdViewer ← ViewerTools.MakeNewTextViewer[info: [
wx: prev.wx + prev.ww + tool.params.entryHSpace/2,
wy: tool.height,
ww: VFonts.CharWidth['M, tool.params.font] * 12,
wh: tool.params.entryHeight,
data: (IF wDir.IsEmpty[] THEN "///" ELSE wDir),
parent: tool.outer,
scrollable: FALSE,
border: FALSE
]];
IF tool.params.localDisk
THEN
BEGIN
prev ← Buttons.Create[
info: [name: "Include Tioga Format:",
wx: tool.wdViewer.wx + tool.wdViewer.ww + tool.params.entryHSpace/2,
wy: tool.height,
wh: tool.params.entryHeight,
parent: tool.outer,
border: FALSE
],
proc: SelectTiogaRead,
fork: FALSE,
clientData: tool,
font: tool.params.font
];
tool.tiogaReadLabel ← Labels.Create[
info: [
wx: prev.wx + prev.ww + tool.params.entryHSpace/2,
wy: tool.height,
ww: 9999,
wh: tool.params.entryHeight,
name: "yes",
parent: tool.outer,
border: FALSE
]
];
Containers.ChildXBound[container: tool.outer, child: tool.tiogaReadLabel];
END;
tool.height ← tool.height + tool.params.entryHeight + tool.params.entryVSpace;
prev ← Buttons.Create[
info: [name: "Block size:",
wx: tool.params.entryHSpace,
wy: tool.height,
wh: tool.params.entryHeight,
parent: tool.outer,
border: FALSE
],
proc: SelectBlockSize,
fork: FALSE,
clientData: tool,
font: tool.params.font
];
tool.blockingViewer ← ViewerTools.MakeNewTextViewer[info: [
wx: prev.wx + prev.ww + tool.params.entryHSpace/3,
wy: tool.height,
ww: VFonts.CharWidth['0, tool.params.font] * 8,
wh: tool.params.entryHeight,
data: (IF pgt THEN " 512" ELSE " 1024"),
parent: tool.outer,
scrollable: FALSE,
border: FALSE
]];
tool.hlreclContainer ← Containers.Create[info: [
wx: 194, wy: tool.height,
ww: 9999, -- arbitrary; Containers.ChildXBound overrides
wh: tool.params.entryHeight,
parent: tool.outer,
border: FALSE,
scrollable: FALSE
]];
tool.lreclContainer ← Containers.Create[info: [
wx: 0, wy: 0,
ww: 9999, -- arbitrary; Containers.ChildXBound overrides
wh: tool.params.entryHeight,
parent: tool.hlreclContainer,
border: FALSE,
scrollable: FALSE
]];
tool.lreclX ← tool.lreclContainer.wx;
tool.lreclY ← tool.lreclContainer.wy;
prev ← Buttons.Create[
info: [name: "LRecl:",
wx: 0,
wy: 0,
wh: tool.params.entryHeight,
parent: tool.lreclContainer,
border: FALSE
],
proc: SelectLRecl,
fork: FALSE,
clientData: tool,
font: tool.params.font
];
tool.lreclViewer ← ViewerTools.MakeNewTextViewer[info: [
wx: prev.wx + prev.ww + tool.params.entryHSpace/3,
wy: 0,
ww: VFonts.CharWidth['0, tool.params.font] * 8,
wh: tool.params.entryHeight,
data: " 0",
parent: tool.lreclContainer,
scrollable: FALSE,
border: FALSE
]];
Containers.ChildXBound[container: tool.outer, child: tool.hlreclContainer];
Containers.ChildXBound[container: tool.hlreclContainer, child: tool.lreclContainer];
tool.height ← tool.height + tool.params.entryHeight + tool.params.entryVSpace;
prev ← Buttons.Create[
info: [name: "Pad:",
wx: tool.params.entryHSpace,
wy: tool.height,
wh: tool.params.entryHeight,
parent: tool.outer,
border: FALSE
],
proc: SelectFillBlock,
fork: FALSE,
clientData: tool,
font: tool.params.font
];
tool.fillBlockLabel ← Labels.Create[
info: [
wx: prev.wx + prev.ww + tool.params.entryHSpace/3,
wy: tool.height,
ww: VFonts.StringWidth["with Blanks ", tool.params.font],
wh: tool.params.entryHeight,
name: "with Blanks",
parent: tool.outer,
border: FALSE
]
];
prev ← Buttons.Create[
info: [name: "Conversions:",
wx: 194,
wy: tool.height,
wh: tool.params.entryHeight,
parent: tool.outer,
border: FALSE
],
proc: SelectConversion,
fork: FALSE,
clientData: tool,
font: tool.params.font
];
tool.conversionsViewer ← ViewerTools.MakeNewTextViewer[
info: [
wx: prev.wx + prev.ww + tool.params.entryHSpace/3,
wy: tool.height,
ww: 9999,
wh: tool.params.entryHeight,
data: (IF pgt THEN "ToPGT" ELSE NIL),
parent: tool.outer,
scrollable: TRUE,
border: FALSE
]
];
tool.height ← tool.height + tool.params.entryHeight + tool.params.entryVSpace;
Containers.ChildXBound[container: tool.outer, child: tool.conversionsViewer];
AddSeparatingRule[];
END;
BuildInteraction:
PROC =
BEGIN
h: INT ← 0;
tool.interaction ← Containers.Create[info: [
wx: 0, wy: tool.height,
ww: 9999, -- arbitrary; Containers.ChildXBound overrides
wh: (interactionQuestionLines + 1) * tool.params.entryHeight + 2,
parent: tool.outer,
border: FALSE,
scrollable: FALSE
]];
tool.question ← ViewerTools.MakeNewTextViewer[info: [
wx: tool.params.entryHSpace,
wy: 0,
ww: 9999, -- arbitrary; Containers.ChildXBound overrides
wh: interactionQuestionLines * tool.params.entryHeight,
data: idleMessage,
parent: tool.interaction,
scrollable: TRUE,
border: FALSE
]];
Containers.ChildXBound[container: tool.interaction, child: tool.question];
ViewerTools.InhibitUserEdits[tool.question];
tool.height ← tool.height + tool.question.wh + 2;
tool.autoConfirmButton ← Buttons.Create[
info: [name: "Auto-Confirm",
wx: tool.params.entryHSpace,
wy: tool.question.wh + 2,
wh: tool.params.entryHeight,
parent: tool.interaction,
border: TRUE
],
proc: AutoConfirmButton,
fork: FALSE,
clientData: tool,
font: tool.params.font
];
tool.prompt ← Containers.Create[info: [
wx: tool.autoConfirmButton.wx + tool.autoConfirmButton.ww + tool.params.entryHSpace,
wy: tool.question.wh + 2,
ww: 9999, -- arbitrary; Containers.ChildXBound overrides
wh: tool.params.entryHeight,
parent: tool.interaction,
border: FALSE,
scrollable: FALSE
]];
tool.prompter ← ViewerOps.CreateViewer[
flavor: $TapeToolPrompter,
info: [
wx: tool.params.entryHSpace,
wy: 0,
ww: promptW+Tool.PrompterSeq.LAST,
wh: promptH,
data: tool,
parent: tool.prompt,
scrollable: FALSE,
border: FALSE
]
];
tool.yesButton ← Buttons.Create[
info: [name: "Yes",
wx: tool.prompter.wx + tool.prompter.ww + tool.params.entryHSpace,
wy: 0,
wh: tool.params.entryHeight,
parent: tool.prompt,
border: TRUE
],
proc: YesButton,
fork: FALSE,
clientData: tool,
font: tool.params.font
];
tool.noButton ← Buttons.Create[
info: [name: "No",
wx: tool.yesButton.wx + tool.yesButton.ww + tool.params.entryHSpace,
wy: 0,
wh: tool.params.entryHeight,
parent: tool.prompt,
border: TRUE
],
proc: NoButton,
fork: FALSE,
clientData: tool,
font: tool.params.font
];
TRUSTED{Process.SetTimeout[@tool.responseMade, Process.MsecToTicks[90]]};
Containers.ChildXBound[container: tool.interaction, child: tool.prompt];
tool.promptX ← tool.prompt.wx;
tool.promptY ← tool.prompt.wy;
DisableQuestion[tool];
tool.height ← tool.height + tool.prompt.wh + 2;
AddSeparatingRule[];
Containers.ChildXBound[container: tool.outer, child: tool.interaction];
END;
***Main Body of NewTapeTool***
v: ViewerClasses.Viewer;
tool ← NEW[Tool.TapeToolRecord];
tool.params ← Tool.GetToolParameters[];
tool.outer ← Containers.Create[
info: [
name: "Tape Tool", iconic: TRUE, column: right, scrollable: FALSE
],
paint: TRUE
];
-- closeEvent ← ViewerEvents.RegisterEventProc[proc: MyClose, event: close];
tool.destroyEvent ← ViewerEvents.RegisterEventProc[proc: MyDestroy, event: destroy];
Tool.RegisterIdle[tool];
Tool.RegisterProfile[tool];
tool.height ← tool.params.entryVSpace;
BuildBailOut[];
BuildServerInfo[];
Tool.BuildOperations[tool];
BuildFileInfo[];
BuildInteraction[];
v ← TypeScript.Create[
info: [
wx: 0,
wy: tool.height + 5,
ww: 9999,
wh: 9999,
parent: tool.outer,
border: FALSE]
];
tool.height ← tool.height + minFeedbackLines * tool.params.entryHeight + tool.params.entryVSpace;
tool.typeScript ← ViewerIO.CreateViewerStreams[name: "TapeTool.log", viewer: v, backingFile: "TapeTool.log"].out;
Containers.ChildXBound[container: tool.outer, child: v];
Containers.ChildYBound[container: tool.outer, child: v];
ViewerTools.InhibitUserEdits[v];
ViewerOps.MoveViewer[tool.lreclContainer, 0, offScreen,
tool.lreclContainer.ww, tool.lreclContainer.wh, TRUE];
ViewerOps.AddProp[tool.outer, $TapeToolViewer, tool];
ViewerOps.SetOpenHeight[tool.outer, tool.height];
ViewerOps.PaintViewer[tool.outer, all];
tool.serverName ← tool.params.defaultServer;
tool.driveNumber ← 0;
Labels.Set[tool.statusLabel, "Connection Closed"];
tool.typeScript.PutF["TapeTool of %t\nSession began at %t\n", IO.time[Loader.BCDBuildTime[]], IO.time[BasicTime.Now[]]];
tool.opsQueue ← Tool.Create[tool];
END;
ShowLReclViewer:
PUBLIC
PROC [tool: Tool.TapeTool] =
BEGIN
ViewerOps.MoveViewer[tool.lreclContainer, 0, 0,
tool.lreclContainer.ww, tool.lreclContainer.wh, TRUE];
END;
RemoveLReclViewer:
PUBLIC
PROC [tool: Tool.TapeTool] =
BEGIN
ViewerOps.MoveViewer[tool.lreclContainer, 0, offScreen,
tool.lreclContainer.ww, tool.lreclContainer.wh, TRUE];
END;
YesButton: Buttons.ButtonProc =
BEGIN
ENABLE UNWIND => NULL;
tool: Tool.TapeTool ← NARROW[clientData];
ResponseSeen[tool, TRUE];
END;
NoButton: Buttons.ButtonProc =
BEGIN
ENABLE UNWIND => NULL;
tool: Tool.TapeTool ← NARROW[clientData];
ResponseSeen[tool, FALSE];
END;
AutoConfirmButton: Buttons.ButtonProc =
BEGIN
ENABLE UNWIND => NULL;
tool: Tool.TapeTool ← NARROW[clientData];
IF (tool.autoConfirm ←
NOT tool.autoConfirm)
THEN
BEGIN
Buttons.SetDisplayStyle[NARROW[parent], $WhiteOnBlack];
ResponseSeen[tool, TRUE];
END
ELSE Buttons.SetDisplayStyle[NARROW[parent], $BlackOnWhite];
END;
ResponseSeen:
ENTRY
PROC [tool: TapeTool, value:
BOOL] =
BEGIN
ENABLE UNWIND => NULL;
ResponseSeenInternal[tool, value];
END;
ResponseSeenInternal:
INTERNAL
PROC [tool: TapeTool, value:
BOOL] =
BEGIN
ENABLE UNWIND => NULL;
tool.responseValue ← value;
tool.responseSeen ← TRUE;
BROADCAST tool.responseMade; -- wakes up both prompter and main operation
END;
WaitForResponse:
PUBLIC PROC
[tool: TapeTool, ignoreAutoConfirm: BOOL ← FALSE] RETURNS [value: BOOL ← FALSE] = BEGIN
p: PROCESS ← NIL;
WaitForResponseEntry:
ENTRY
PROC [tool: TapeTool] =
BEGIN
ENABLE UNWIND => NULL;
tool.responseSeen ← FALSE;
p ← FORK PrompterProcess[tool];
UNTIL tool.responseSeen
DO
WAIT tool.responseMade;
IF tool.AbortNow
THEN BEGIN
tool.responseValue ← FALSE;
tool.responseSeen ← TRUE;
BROADCAST tool.responseMade;
DisableQuestion[tool];
ERROR ABORTED;
END;
ENDLOOP;
value ← tool.responseValue;
END;
IF NOT ignoreAutoConfirm THEN IF tool.autoConfirm THEN RETURN [TRUE];
EnableQuestion[tool];
WaitForResponseEntry[tool];
DisableQuestion[tool];
TRUSTED{JOIN p};
END;
PrompterProcess:
PROC [tool: TapeTool] =
BEGIN
Done:
ENTRY
PROC [tool: TapeTool]
RETURNS [
BOOL] =
BEGIN
ENABLE UNWIND => NULL;
IF tool.AbortNow THEN RETURN[FALSE];
WAIT tool.responseMade;
RETURN[tool.responseSeen]
END;
UNTIL Done[tool] DO ViewerOps.PaintViewer[tool.prompter, all]; ENDLOOP;
ViewerOps.PaintViewer[tool.prompter, all]; -- clears prompter entirely
END;
PaintPrompter: ViewerClasses.PaintProc =
BEGIN
tool: TapeTool = NARROW[self.data];
IF ~tool.responseSeen
THEN
BEGIN
-- strictly speaking, should be inside the monitor
ImagerBackdoor.DrawBits[context: context,
base: LOOPHOLE[prompt], wordsPerLine: promptWpl,
fMin: 0, sMin: 0, fSize: promptW, sSize: promptH,
tx: tool.prompterSeq, ty: promptH];
tool.prompterSeq ← (tool.prompterSeq + 2)
MOD PrompterSeq.
LAST.
SUCC;
END;
END;
AbortOperation: Buttons.ButtonProc =
BEGIN
tool: Tool.TapeTool ← NARROW[clientData];
AbortOperationEntry:
ENTRY
PROC [tool: TapeTool] =
BEGIN
ENABLE UNWIND => NULL;
IF NOT tool.active THEN RETURN; -- tool is idle
tool.AbortNow ← TRUE;
ResponseSeenInternal[tool, FALSE]; -- wake up waiting operation, if any.
END;
AbortOperationEntry[tool];
END;
EnableQuestion:
PUBLIC PROC [tool: TapeTool] =
BEGIN
ViewerOps.MoveViewer[tool.prompt, tool.promptX, tool.promptY, tool.prompt.ww, tool.prompt.wh, TRUE];
END;
DisableQuestion:
PUBLIC PROC [tool: TapeTool] =
BEGIN
ViewerOps.MoveViewer[tool.prompt, 0, offScreen, tool.prompt.ww, tool.prompt.wh, TRUE];
END;
SelectServerName: Buttons.ButtonProc =
BEGIN
tool: Tool.TapeTool ← NARROW[clientData];
ViewerTools.SetSelection[tool.serverNameViewer];
END;
SelectDriveNumber: Buttons.ButtonProc =
BEGIN
tool: Tool.TapeTool ← NARROW[clientData];
ViewerTools.SetSelection[tool.driveNumberViewer];
END;
SelectDensity: Buttons.ButtonProc =
BEGIN
tool: Tool.TapeTool ← NARROW[clientData];
SELECT tool.density FROM
PE1600 => { Labels.Set[tool.densityLabel, "800 bpi NRZI"]; tool.density ← NRZI800};
NRZI800 => { Labels.Set[tool.densityLabel, "1600 bpi PE"]; tool.density ← PE1600};
ENDCASE => ERROR;
END;
SelectBlockSize: Buttons.ButtonProc =
BEGIN
tool: Tool.TapeTool ← NARROW[clientData];
ViewerTools.SetSelection[tool.blockingViewer];
END;
SelectLRecl: Buttons.ButtonProc =
BEGIN
tool: Tool.TapeTool ← NARROW[clientData];
ViewerTools.SetSelection[tool.lreclViewer];
END;
SelectFileName: Buttons.ButtonProc =
BEGIN
tool: Tool.TapeTool ← NARROW[clientData];
selection: REF ViewerTools.SelPosRec ← NIL;
SELECT
TRUE
FROM
mouseButton = blue => ViewerTools.SetContents[tool.fileNameViewer, NIL];
ViewerTools.GetSelectedViewer[] = tool.fileNameViewer =>
BEGIN
NextName:
PROC [this:
ROPE, list:
LIST
OF
ROPE]
RETURNS [next:
ROPE ←
NIL] =
BEGIN
IF list = NIL THEN RETURN;
FOR l:
LIST
OF
ROPE ← list, l.rest
UNTIL l =
NIL
DO
IF this.Equal[l.first, FALSE] THEN RETURN[IF l.rest = NIL THEN list.first ELSE l.rest.first]
ENDLOOP;
RETURN[list.first]
END;
contents: ROPE ← ViewerTools.GetContents[tool.fileNameViewer];
ViewerTools.SetContents[tool.fileNameViewer,
contents ← NextName[contents, tool.params.fileNamePrefixes]];
selection ← NEW[ViewerTools.SelPosRec ← [start: contents.Length[], length: 0]];
END;
ENDCASE;
ViewerTools.SetSelection[tool.fileNameViewer, selection];
END;
SelectWDName: Buttons.ButtonProc =
BEGIN
tool: Tool.TapeTool ← NARROW[clientData];
ViewerTools.SetSelection[tool.wdViewer];
END;
SelectConversion: Buttons.ButtonProc =
BEGIN
tool: Tool.TapeTool ← NARROW[clientData];
selection: REF ViewerTools.SelPosRec ← NIL;
SELECT
TRUE
FROM
mouseButton = blue => ViewerTools.SetContents[tool.conversionsViewer, NIL];
ViewerTools.GetSelectedViewer[] = tool.conversionsViewer =>
BEGIN
NextName:
PROC [this:
ROPE, r:
REF]
RETURNS
[next:
ROPE ←
NIL, val:
REF TapeStreams.ConversionRecord ←
NIL]
=
BEGIN
WITH r
SELECT
FROM
list: Atom.PropList =>
BEGIN
FOR l: Atom.PropList ← list, l.rest
UNTIL l =
NIL
DO
IF this.Equal[ToRope[l.first.key],
FALSE]
THEN {
IF l.rest =
NIL
THEN RETURN[NIL, NIL]
ELSE RETURN[ToRope[l.rest.first.key], ToConvert[l.rest.first.val]]};
ENDLOOP;
RETURN[ToRope[list.first.key], ToConvert[list.first.val]];
END;
ENDCASE => NULL;
END;
contents: ROPE ← ViewerTools.GetContents[tool.conversionsViewer];
trans: REF TapeStreams.ConversionRecord;
[contents, trans] ← NextName[contents, Atom.GetProp[$TapeTool, $Conversions]];
IF trans #
NIL
AND trans.name = $ToEbcdic
THEN ShowLReclViewer[tool] ELSE RemoveLReclViewer[tool];
ViewerTools.SetContents[tool.conversionsViewer, contents];
selection ← NEW[ViewerTools.SelPosRec ← [start: contents.Length[], length: 0]];
END;
ENDCASE;
ViewerTools.SetSelection[tool.conversionsViewer, selection];
END;
SelectFillBlock: Buttons.ButtonProc =
BEGIN
tool: Tool.TapeTool ← NARROW[clientData];
SELECT tool.fillBlock
FROM
truncate => { Labels.Set[tool.fillBlockLabel, "with Blanks"]; tool.fillBlock ← blanks };
blanks => { Labels.Set[tool.fillBlockLabel, "with Zeros"]; tool.fillBlock ← zeroes };
zeroes => { Labels.Set[tool.fillBlockLabel, "truncate"]; tool.fillBlock ← truncate };
ENDCASE => ERROR;
END;
SelectTiogaRead: Buttons.ButtonProc =
BEGIN
tool: Tool.TapeTool ← NARROW[clientData];
Labels.Set[tool.tiogaReadLabel, (IF tool.tiogaReadValue THEN "no" ELSE "yes")];
tool.tiogaReadValue ← NOT tool.tiogaReadValue;
END;
MyDestroy: ViewerEvents.EventProc =
BEGIN
tool: Tool.TapeTool ← NARROW[ViewerOps.FetchProp[viewer, $TapeToolViewer]];
IF tool = NIL THEN RETURN;
ViewerEvents.UnRegisterEventProc[proc: tool.destroyEvent, event: destroy];
Tool.UnRegisterIdle[tool];
Tool.UnregisterProfile[tool];
IF tool.open THEN { Tool.Flush[tool.opsQueue]; Tool.ExecuteOp[tool: tool, op: [op: Close]]; };
IO.Close[tool.typeScript ! IO.Error => CONTINUE];
END;
ToRope:
PROC [ r:
REF
ANY ]
RETURNS [ rope:
ROPE ] =
BEGIN
WITH r
SELECT
FROM
ro: ROPE => rope ← ro;
a: ATOM => rope ← Atom.GetPName[a];
t: REF TEXT => rope ← Rope.FromRefText[t];
ENDCASE => ERROR;
END;
ToConvert:
PROC [ r:
REF
ANY ]
RETURNS [ val:
REF TapeStreams.ConversionRecord ←
NIL] =
BEGIN
WITH r
SELECT
FROM
t: REF TapeStreams.ConversionRecord => val ← t;
ENDCASE => val ← NIL;
END;
MakeNewTapeTool: Commander.CommandProc =
BEGIN
Atom.PutProp[$TapeTool, $state, NewTapeTool[TRUE, CommandTool.CurrentWorkingDirectory[], FALSE]];
END;
MakePGTTapeTool: Commander.CommandProc =
BEGIN
Atom.PutProp[$TapeTool, $state, NewTapeTool[TRUE, CommandTool.CurrentWorkingDirectory[], TRUE]];
END;
Commander.Register["TapeTool", MakeNewTapeTool, "Generate a new TapeTool"];
Commander.Register["PGTape", MakePGTTapeTool, "Generate a new TapeTool for PGT tapes"];
ViewerOps.RegisterViewerClass[$TapeToolPrompter, tapeToolPrompter];
UserProfile.CallWhenProfileChanges[Tool.ReactToProfile];
END....