<> <> <> <> <> <> <<(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!)>> DIRECTORY FS USING [Close, Error, Open, GetInfo, OpenFile, Read], Graphics USING [ClipBox, Context, DrawRope, FontRef, RopeWidth, SetColor, SetCP, white], GraphicsOps USING [BitmapRep, DrawBitmap], Icons, Rope USING [Concat, Fetch, Length, Map, ROPE, Substr], VFonts USING [EstablishFont, Font, FontAscent, GraphicsFont], VM USING [Interval, Allocate, AddressForPageNumber, Free, wordsPerPage]; IconsImpl: CEDAR MONITOR IMPORTS FS, Graphics, GraphicsOps, Rope, VFonts, VM EXPORTS Icons = BEGIN OPEN Icons; DrawIcon: PUBLIC ENTRY DrawIconProc = BEGIN leading: INTEGER = 3; iconInfo: IconRef _ icons[LOOPHOLE[flavor]]; prefix: Rope.ROPE _ NIL; IF iconInfo.proc=NIL THEN BEGIN iconBitmap.base _ iconInfo; -- bits guaranteed first in record!!! Graphics.SetCP[context, x, y+iconH]; GraphicsOps.DrawBitmap[context, iconBitmap, iconW, iconH]; IF iconInfo.label THEN BEGIN iconFont: Graphics.FontRef; fontHeight: INTEGER; iy: INTEGER _ y+iconInfo.ly+iconInfo.lh; segments: LIST OF Rope.ROPE; IF Graphics.RopeWidth[bigIconFont, label].xw <= iconInfo.lw THEN BEGIN iconFont _ bigIconFont; fontHeight _ bigFontHeight; segments _ LIST[label]; END ELSE BEGIN iconFont _ smallIconFont; fontHeight _ smallFontHeight; segments _ Decompose[label, iconInfo.lw, iconFont]; END; Graphics.ClipBox[context, [x+iconInfo.lx, y+iconInfo.ly, x+iconInfo.lx+iconInfo.lw, iy]]; IF iconInfo.invertLabel THEN Graphics.SetColor[context, Graphics.white]; WHILE segments#NIL DO segment: Rope.ROPE _ segments.first; suffix: Rope.ROPE _ IF segments.rest=NIL OR segment.Fetch[segment.Length[]-1]='\040 OR segments.rest.first.Fetch[0]='. THEN NIL ELSE "-"; iy _ iy-fontHeight; Graphics.SetCP[context, x+iconInfo.lx, iy]; iy _ iy - leading; Graphics.DrawRope[self: context, font: iconFont, rope: prefix.Concat[segment.Concat[suffix]]]; prefix _ " "; segments _ segments.rest; ENDLOOP; END; END ELSE iconInfo.proc[flavor, context, x, y, label]; END; GetFonts: ENTRY PROC = BEGIN bigFont: VFonts.Font _ VFonts.EstablishFont["Helvetica", 8]; smallFont: VFonts.Font _ VFonts.EstablishFont["Helvetica", 7]; bigFontHeight _ VFonts.FontAscent[bigFont]; smallFontHeight _ VFonts.FontAscent[smallFont]; bigIconFont _ VFonts.GraphicsFont[bigFont]; smallIconFont _ VFonts.GraphicsFont[smallFont]; END; bigIconFont: Graphics.FontRef; bigFontHeight: INTEGER; smallIconFont: Graphics.FontRef; smallFontHeight: INTEGER; wSlop: INTEGER = 5; Decompose: PROC [name: Rope.ROPE, width: REAL, font: Graphics.FontRef] RETURNS [segments: LIST OF Rope.ROPE _ NIL] = BEGIN candidate, useMe: Rope.ROPE _ NIL; end: INT _ 0; len: INT _ Rope.Length[name]; haveExtension, inWord: BOOL _ FALSE; SkipToNextWord: PROC [c: CHAR] RETURNS [BOOL] = CHECKED { IF c IN ['A..'Z] OR c = '/ OR c IN ['0..'9] THEN { IF inWord THEN RETURN[TRUE] } ELSE inWord _ TRUE; IF c='. THEN RETURN[haveExtension _ TRUE]; end _ end+1; RETURN[FALSE]; }; Build: PROC[start: INT] RETURNS [LIST OF Rope.ROPE] = { IF start>=len THEN RETURN[NIL]; end _ start+1; inWord _ FALSE; IF haveExtension THEN end _ len ELSE [] _ Rope.Map[base: name, start: end, action: SkipToNextWord]; RETURN[CONS[name.Substr[start, end-start], Build[end]]]; }; Coalesce: PROC[segs: LIST OF Rope.ROPE] RETURNS [LIST OF Rope.ROPE] = { c: Rope.ROPE; IF segs=NIL OR segs.rest=NIL THEN RETURN[segs]; IF segs.rest.first.Fetch[0]#'. AND Graphics.RopeWidth[font, c _ segs.first.Concat[segs.rest.first]].xw<=width THEN RETURN[Coalesce[CONS[c, segs.rest.rest]]]; RETURN[CONS[segs.first, Coalesce[segs.rest]]]; }; width _ width+wSlop; -- allow small amount of clipping. RETURN[Coalesce[Build[0]]]; END; iconBitmap: REF GraphicsOps.BitmapRep _ 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] = BEGIN newFlavor _ nextFlavor; nextFlavor _ SUCC[newFlavor]; IF LOOPHOLE[nextFlavor, CARDINAL] >= maxIcons THEN ERROR; END; NewIcon: PUBLIC PROC [info: IconRef] RETURNS [newFlavor: IconFlavor] = BEGIN newFlavor _ NewFlavor[]; icons[LOOPHOLE[newFlavor]] _ info; END; IconsFromFile: PROC [file: Rope.ROPE] RETURNS [first: IconFlavor, nRead: INTEGER] = TRUSTED BEGIN 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]; END; NewIconFromFile: PUBLIC PROC [file: Rope.ROPE, n: CARDINAL] RETURNS [newFlavor: IconFlavor] = TRUSTED BEGIN 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]; END; {-- 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"]; <> }; END.