CDPanelFontsImpl.mesa (part of ChipNDale)
Copyright © 1983, 1987 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, June 24, 1983 5:03 pm
Last Edited by: Christian Jacobi, March 24, 1987 12:33:44 pm PST
DIRECTORY
Ascii,
CD,
CDOps,
CDPanel,
CDPanelFonts,
CDPrivate,
CDSequencer,
CDTexts,
CDValue,
Convert,
FileNames,
IO,
PopUpSelection,
Rope,
TerminalIO,
UserProfile,
ViewerClasses,
ViewerOps;
CDPanelFontsImpl: CEDAR MONITOR
IMPORTS Ascii, CDOps, CDPanel, CDTexts, CDValue, Convert, FileNames, IO, PopUpSelection, Rope, TerminalIO, UserProfile, ViewerOps
EXPORTS CDPanelFonts
SHARES CDTexts =
BEGIN
fontNum: NAT = 20;
FontRange: TYPE = [0..fontNum);
FontArray: TYPE = ARRAY FontRange OF CDTexts.CDFont ← ALL[NIL];
LProc: TYPE = PROC [CD.Layer] RETURNS [CD.Layer];
tList: LIST OF CD.Technology ← NIL;
myKey: REFNEW[INT];
myKey2: REFNEW[INT];
NoteTechnology: ENTRY PROC [tech: CD.Technology] RETURNS [first: BOOL] = {
ENABLE UNWIND => NULL;
FOR l: LIST OF CD.Technology ← tList, l.rest WHILE l#NIL DO
IF l.first=tech THEN RETURN [FALSE];
ENDLOOP;
tList ← CONS[tech, tList];
RETURN [TRUE]
};
ImplementIt: PUBLIC PROC [tech: CD.Technology, defaultFonts: LIST OF Rope.ROPE, layerProc: PROC [CD.Layer] RETURNS [CD.Layer]] = {
CDValue.Store[tech, $defaultFontList, defaultFonts];
CDValue.Store[tech, myKey2, NEW[LProc←layerProc]];
IF NoteTechnology[tech].first THEN {
CDPanel.Button[button: [text: "font:"], proc: ChangeDefaultFontComm, tech: tech];
CDPanel.Label[[width: 140, cdValueKey: $panelFontRope, redisplay: TRUE], tech];
CDPanel.Text[button: [text: "pattern: ", xpos: 180], text: [cdValueKey: $pattern, width: -1], tech: tech];
CDPanel.Line[tech];
CDPanel.Text[button: [text: "text: "], text: [cdValueKey: $text, width: -1], tech: tech];
CDPanel.Line[tech];
};
SetupFontsForPanel[tech];
};
CurrentFont: PUBLIC PROC [d: CD.Design] RETURNS [CDTexts.CDFont] = {
WITH CDValue.Fetch[d, $currentFont, technology] SELECT FROM
f: CDTexts.CDFont => RETURN [f];
ENDCASE => RETURN [NIL];
};
CurrentText: PUBLIC PROC [d: CD.Design] RETURNS [Rope.ROPE] = {
RETURN [CDPanel.TakeDownText[d, $text]]
};
SetCurrentText: PUBLIC PROC [d: CD.Design, text: Rope.ROPE] = {
v: ViewerClasses.Viewer ← CDPanel.Create[d];
CDPanel.PutUpText[d, $text, text];
IF v#NIL THEN {
IF v.iconic THEN ViewerOps.OpenIcon[v]
ELSE ViewerOps.BlinkIcon[v, 1, 1, 80]
};
};
FArray: PROC [t: CD.Technology] RETURNS [REF FontArray] = {
ENABLE UNWIND => NULL;
WITH CDValue.Fetch[t, myKey] SELECT FROM
fa: REF FontArray => RETURN [fa];
ENDCASE => {
[] ← CDValue.StoreConditional[t, myKey, NEW[FontArray←ALL[NIL]]];
RETURN [FArray[t]];
}
};
SetCurrentFont: PUBLIC PROC [design: REF, font: CDTexts.CDFont, name: Rope.ROPENIL] = {
IF font=NIL THEN RETURN;
IF name=NIL THEN {
t: CD.Technology ← NIL;
WITH design SELECT FROM
d: CD.Design => t ← d.technology;
tech: CD.Technology => t ← tech;
ENDCASE => NULL;
IF t#NIL THEN name ← FontDescription[font, t.lambda, FALSE];
};
CDValue.Store[design, $panelFontRope, name];
TRUSTED { CDValue.Store[design, $currentFont, LOOPHOLE[font]]; };
WITH design SELECT FROM
d: CD.Design => [] ← CDPanel.PutUp[d, $panelFontRope];
ENDCASE => NULL;
};
NoteProfileChange: UserProfile.ProfileChangedProc = {
FOR tl: LIST OF CD.Technology ← tList, tl.rest WHILE tl#NIL DO
SetupFontsForPanel[tl.first];
ENDLOOP;
};
SupposedFontName: PROC [t: CD.Technology, fn: INT] RETURNS [fontName: Rope.ROPE, scale: INT] = {
--gets a font name and a scale from user profile or default
DefaultFontName: PROC [fn: INT] RETURNS [name: Rope.ROPENIL, scale: INT←-1] = {
rnl: LIST OF Rope.ROPE;
WITH CDValue.Fetch[t, $defaultFontList, global] SELECT FROM
rl: LIST OF Rope.ROPE => rnl ← rl;
ENDCASE => rnl ← fontNameList;
FOR l: LIST OF Rope.ROPE ← rnl, l.rest WHILE l#NIL DO
IF fn<=0 THEN {name ← l.first; EXIT};
fn ← fn-1;
ENDLOOP;
IF name#NIL THEN {
[name, scale] ← Scan[name];
name ← Rope.Concat["Xerox/TiogaFonts/", name];
}
};
SkipSpaces: PROC [r: Rope.ROPE] RETURNS [Rope.ROPE] = {
n: INT ← 0;
l: INT ← Rope.Length[r];
WHILE n<l AND Rope.Fetch[r, n]=' DO n ← n+1 ENDLOOP;
WHILE n<l AND Rope.Fetch[r, l-1]=' DO l ← l-1 ENDLOOP;
RETURN [Rope.Substr[r, n, l-n]]
};
Scan: PROC [r: Rope.ROPE] RETURNS [name: Rope.ROPE, scale: INT←-1] = {
ENABLE IO.EndOfStream => GOTO exit;
name ← SkipSpaces[r];
IF ~Rope.IsEmpty[name] THEN {
s: IO.STREAMIO.RIS[name];
IF Ascii.Digit[Rope.Fetch[name]] THEN scale ← IO.GetInt[s];
name ← SkipSpaces[IO.GetLineRope[s]];
};
EXITS exit => NULL
};
num: Rope.ROPE = Convert.RopeFromInt[fn];
[fontName, scale] ← Scan[UserProfile.Line[key: Rope.Cat["ChipNDale.", t.name, ".Font", num]]];
--for limitted time
IF ~Rope.IsEmpty[fontName] AND scale<1 THEN
scale ← UserProfile.Number[key: Rope.Cat["ChipNDale.", t.name, ".ScaleFont", num], default: t.lambda];
IF Rope.IsEmpty[fontName] THEN [fontName, scale] ← DefaultFontName[fn];
IF scale<1 THEN scale ← t.lambda;
};
SetupFontsForPanel: PROC [t: CD.Technology] = {
--(re)reads font names for one technology (from user profile)
FontForIndex: PROC [t: CD.Technology, fn: FontRange, fontArray: REF FontArray] = {
fontName: Rope.ROPE; scale: INT;
[fontName, scale] ← SupposedFontName[t, fn];
IF fontArray[fn]#NIL
AND Rope.Equal[fontName, fontArray[fn].supposedName, FALSE]
AND scale=fontArray[fn].scaleI THEN RETURN;
IF Rope.IsEmpty[fontName] THEN fontArray[fn] ← NIL
ELSE fontArray[fn] ← CDTexts.MakeFont[name: fontName, scale: scale];
};
firstFont: CDTexts.CDFont←NIL;
far: REF FontArray ← FArray[t];
IF far#NIL THEN
FOR fn: FontRange IN [0..fontNum) DO
FontForIndex[t, fn, far];
IF firstFont=NIL THEN firstFont ← far[fn]
ENDLOOP;
IF firstFont#NIL THEN
SetCurrentFont[t, firstFont, FontDescription[firstFont, t.lambda]];
};
FontDescription: PROC [f: CDTexts.CDFont, lambda: INT, full: BOOLFALSE] RETURNS [name: Rope.ROPENIL] = {
IF f#NIL THEN {
name ← f.supposedName;
IF ~full THEN name ← FileNames.GetShortName[name];
IF f.scaleI#lambda THEN name ← name.Concat[CDOps.LambdaRope[f.scaleI, lambda]]
};
IF Rope.IsEmpty[name] THEN name ← " ?? ";
};
FromPanel: PROC [comm: CDSequencer.Command] RETURNS [BOOL] = {
RETURN [comm.ref=$Panel]
};
ChangeDefaultFontComm: PROC [comm: CDSequencer.Command] = {
n: INT ← 0;
lambda: CD.Number ← comm.design.technology.lambda;
cdFont: CDTexts.CDFont←NIL;
fa: REF FontArray ← FArray[comm.design.technology];
list: LIST OF Rope.ROPENIL;
oldFont: CDTexts.CDFont ← CurrentFont[comm.design];
TerminalIO.PutRope["change default font\n"];
IF FromPanel[comm] AND comm.n#1 AND oldFont#NIL AND comm.b THEN {
up: BOOL ← comm.n=0;
oldSize: INTMIN[oldFont.scaleI, 20000]; --large limit, prevent arithmetic overflow
newSize: INTMIN[(IF up THEN oldSize*2 ELSE (oldSize+1)/2), 10000B];
--smaller, binary limit to make going back [after hitting upper limit] nice
cdFont ← CDTexts.MakeFont[oldFont.supposedName, newSize];
}
ELSE {
FOR i: INT DECREASING IN FontRange DO
IF fa[i]#NIL THEN list ← CONS[FontDescription[fa[i], lambda, FALSE], list]
ENDLOOP;
IF list#NIL THEN n ← PopUpSelection.Request[header: "change font", choice: list];
IF n>0 THEN
FOR i: INT IN FontRange DO
IF fa[i]#NIL THEN {
n←n-1; IF n<=0 THEN {cdFont�[i]; EXIT};
};
ENDLOOP;
};
IF cdFont=NIL THEN TerminalIO.PutRope["discarded\n"]
ELSE {
SetCurrentFont[comm.design, cdFont, FontDescription[cdFont, lambda, FALSE]];
TerminalIO.PutRopes[" ", FontDescription[cdFont, lambda, TRUE], " for text inputs\n"];
};
};
LayerForText: PUBLIC PROC [layer: CD.Layer, technology: REFNIL] RETURNS [lay: CD.Layer] = {
layerProc: REF LProc ← NIL;
WITH technology SELECT FROM
t: CD.Technology => layerProc ← NARROW[CDValue.Fetch[t, myKey2]];
ENDCASE => NULL;
lay ← layer;
IF layerProc#NIL AND layerProc^#NIL THEN lay ← layerProc[lay];
};
fontNameList: LIST OF Rope.ROPE = LIST["Template64", "Gates32", "Helvetica18", "Helvetica14", "Helvetica12", "Helvetica10", "Helvetica8", "Helvetica7", "Helvetica6"];
CDValue.RegisterKey[$defaultFontList, NIL, $chj];
CDValue.RegisterKey[$currentFont, NIL, $chj];
CDValue.RegisterKey[$panelFontRope, NIL, $chj];
CDValue.RegisterKey[$text, NIL, $chj];
CDValue.RegisterKey[$pattern, NIL, $chj];
CDValue.Store[NIL, $defaultFontList, fontNameList];
UserProfile.CallWhenProfileChanges[NoteProfileChange];
END.