<> <> <> <> DIRECTORY Ascii, CD, CDOps, CDPanel, CDPanelFonts, CDPrivate, CDSequencer, CDTexts, CDValue, Convert, FileNames, IO, PopUpSelection, Rope, RopeList, TerminalIO, UserProfile, ViewerClasses, ViewerOps; CDPanelFontsImpl: CEDAR MONITOR IMPORTS Ascii, CDOps, CDPanel, CDTexts, CDValue, Convert, FileNames, IO, PopUpSelection, Rope, RopeList, 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: REF _ NEW[INT]; myKey2: REF _ NEW[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.ROPE_NIL] = { 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.ROPE_NIL, 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 GOTO exit; name _ SkipSpaces[r]; IF ~Rope.IsEmpty[name] THEN { s: IO.STREAM _ IO.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: BOOL_FALSE] RETURNS [name: Rope.ROPE_NIL] = { 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.ROPE _ NIL; 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: INT _ MIN[oldFont.scaleI, 20000]; --large limit, prevent arithmetic overflow newSize: INT _ MIN[(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_fa[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: REF_NIL] 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]; CDValue.Store[NIL, $pattern, RopeList.Cons[LIST["*.icon", "*.sch"], "*"]]; UserProfile.CallWhenProfileChanges[NoteProfileChange]; END. <<>>