<> <> <> <> <> <> <> <<(changed opening of Standard.icons to only use local name, also changed the global variable icons to be a REF to an array, instead of taking 128 words in the global frame!)>> <> <<(rewrote Decompose)>> <> <<(added Viewers.SuppressIconPrefix feature)>> <> <<(converted to Imager)>> DIRECTORY Font, FS USING [Close, Error, Open, GetInfo, OpenFile, Read], Imager, ImagerOps, Icons, Rope USING [Fetch, Length, ROPE, Run], UserProfile USING [CallWhenProfileChanges, ProfileChangedProc, Token], VFonts USING [EstablishFont, Font, FontAscent], ViewerExtras USING [ImagerFont], VM USING [Interval, Allocate, AddressForPageNumber, Free, wordsPerPage]; IconsImpl: CEDAR MONITOR IMPORTS Font, FS, Imager, ImagerOps, Rope, UserProfile, VFonts, VM EXPORTS Icons = BEGIN OPEN Icons; ROPE: TYPE = Rope.ROPE; DrawIcon: PUBLIC ENTRY DrawIconProc = { <> imager: Imager.Context ~ ImagerOps.ImagerFromGraphics[context]; leading: INTEGER = 3; iconInfo: IconRef _ icons[LOOPHOLE[flavor]]; prefix: ROPE _ NIL; IF iconInfo.proc=NIL THEN { <> <> IF iconInfo.label THEN { iconFont: Font.FONT; fontHeight: INTEGER; pos: Imager.VEC _ [x+iconInfo.lx, y+iconInfo.ly+iconInfo.lh]; indent: REAL _ 0; map: MapType ~ { pos.y _ pos.y-fontHeight; Imager.SetXY[imager, pos]; pos.y _ pos.y-leading; Imager.ShowRope[imager, rope, start, len]; pos.x _ pos.x+indent; indent _ 0; }; IF Font.RopeWidth[bigIconFont, label].x <= iconInfo.lw THEN { iconFont _ bigIconFont; fontHeight _ bigFontHeight; } ELSE { iconFont _ smallIconFont; fontHeight _ smallFontHeight; indent _ Font.CharWidth[iconFont, ' ].x; }; Imager.ClipRectangle[imager, pos.x, pos.y, iconInfo.lw, -iconInfo.lh]; Imager.SetFont[imager, iconFont]; IF iconInfo.invertLabel THEN Imager.SetColor[imager, Imager.white]; IF iconFont=bigIconFont THEN map[label, 0, INT.LAST] ELSE Decompose[label, iconInfo.lw, indent, iconFont, map]; }; } ELSE iconInfo.proc[flavor, context, x, y, label]; }; GetFonts: ENTRY PROC = { bigFont: VFonts.Font _ VFonts.EstablishFont["Helvetica", 8]; smallFont: VFonts.Font _ VFonts.EstablishFont["Helvetica", 7]; bigFontHeight _ VFonts.FontAscent[bigFont]; smallFontHeight _ VFonts.FontAscent[smallFont]; bigIconFont _ ViewerExtras.ImagerFont[bigFont]; smallIconFont _ ViewerExtras.ImagerFont[smallFont]; }; bigIconFont: Font.FONT; bigFontHeight: INTEGER; smallIconFont: Font.FONT; smallFontHeight: INTEGER; suppressIconPrefix: ROPE _ NIL; ChangePrefix: UserProfile.ProfileChangedProc ~ { suppressIconPrefix _ UserProfile.Token[key: "Viewers.SuppressIconPrefix", default: NIL]; }; MapType: TYPE ~ PROC[rope: ROPE, start, len: INT]; Decompose: PROC[name: ROPE, width, indent: REAL, font: Font.FONT, map: MapType] = { start: INT _ 0; stop: INT _ name.Length[]; extensionStart, extensionLen: INT _ 0; Build: PROC[start: INT] ~ { maxw: REAL _ (IF start=0 THEN width ELSE width-indent); sw: REAL _ 0; -- width of string so far next: INT _ -1; FOR i: INT IN[start..stop) DO c: CHAR ~ name.Fetch[i]; sw _ sw+Font.CharWidth[font, c].x; IF sw>maxw THEN { IF next<0 THEN next _ MAX[i, start+1]; EXIT }; -- stop here SELECT c FROM '], '>, '/, ' => next _ i+1; -- could end a line IN['A..'Z], IN['0..'9] => IF i>start THEN next _ i; -- next line could start here ENDCASE; REPEAT FINISHED => next _ stop; ENDLOOP; IF next>start THEN map[name, start, next-start]; IF next0 THEN map[name, extensionStart, extensionLen]; }; IF suppressIconPrefix#NIL THEN { prefixLen: INT ~ suppressIconPrefix.Length[]; IF Rope.Run[s1: name, s2: suppressIconPrefix, case: FALSE]=prefixLen THEN start _ prefixLen; }; FOR i: INT DECREASING IN[start..stop) DO IF name.Fetch[i]='. THEN { extensionStart _ i; extensionLen _ stop-i; stop _ i; EXIT }; ENDLOOP; Build[start]; }; <> <> <> <<{>> <> <> <> <> <> <> <> <> <> <> <> <> <<};>> <<>> iconBitmap: REF; <<_ NEW[GraphicsOps.BitmapRep _ [NIL, iconW/16, iconW, iconH]];>> maxIcons: CARDINAL = 64; IconArray: TYPE = ARRAY [0..maxIcons) OF IconRef; icons: REF IconArray _ NEW[IconArray _ ALL[NIL]]; nextFlavor: IconFlavor _ document; NewFlavor: ENTRY PROC RETURNS [newFlavor: IconFlavor] = { newFlavor _ nextFlavor; nextFlavor _ SUCC[newFlavor]; IF LOOPHOLE[nextFlavor, CARDINAL] >= maxIcons THEN ERROR; }; NewIcon: PUBLIC PROC [info: IconRef] RETURNS [newFlavor: IconFlavor] = { newFlavor _ NewFlavor[]; icons[LOOPHOLE[newFlavor]] _ info; }; IconsFromFile: PROC [file: ROPE] RETURNS [first: IconFlavor, nRead: INTEGER] = TRUSTED { fh: FS.OpenFile _ FS.Open[file]; pages: INT _ FS.GetInfo[fh].pages; space: VM.Interval _ VM.Allocate[count: pages]; iconBase: LONG POINTER TO IconFileFormat _ VM.AddressForPageNumber[space.page]; FS.Read[file: fh, from: 0, nPages: pages, to: iconBase]; first _ nextFlavor; nRead _ pages/(SIZE[IconFileFormat]/VM.wordsPerPage); FOR n: INTEGER IN [0..nRead) DO [] _ NewIcon[NEW[IconRep _ [iconBase.bits, iconBase.label, iconBase.invertLabel, 0--filler--, iconBase.lx, iconBase.ly, iconBase.lw, iconBase.lh]]]; iconBase _ iconBase+SIZE[IconFileFormat]; ENDLOOP; VM.Free[space]; FS.Close[fh]; }; NewIconFromFile: PUBLIC PROC [file: ROPE, n: CARDINAL] RETURNS [newFlavor: IconFlavor] = TRUSTED { fh: FS.OpenFile _ FS.Open[file]; pages: INT _ FS.GetInfo[fh].pages; space: VM.Interval _ VM.Allocate[count: pages]; iconBase: LONG POINTER TO IconFileFormat _ VM.AddressForPageNumber[space.page]; FS.Read[file: fh, from: 0, nPages: pages, to: iconBase]; iconBase _ iconBase + (n*SIZE[IconFileFormat]); newFlavor _ NewIcon[NEW[IconRep _ [iconBase.bits, iconBase.label, iconBase.invertLabel, 0--filler--, iconBase.lx, iconBase.ly, iconBase.lw, iconBase.lh]]]; VM.Free[space]; FS.Close[fh]; }; {-- Font and Icon initialization takes place here. ok: BOOL _ TRUE; GetFonts[]; [] _ IconsFromFile["Standard.icons" ! FS.Error => IF error.group # bug THEN {ok _ FALSE; CONTINUE}]; IF NOT ok THEN [] _ IconsFromFile["[]<>Standard.icons"]; <> }; UserProfile.CallWhenProfileChanges[ChangePrefix]; END.