IconsImpl.mesa;
McGregor on October 20, 1982 4:28 pm
Maxwell, January 3, 1983 12:53 pm
Plass, April 20, 1983 10:00 am
Paul Rovner, August 10, 1983 3:59 pm
Russ Atkinson, November 16, 1983 7:19 pm
(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.ROPENIL;
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.ROPEIF 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.ROPENIL] =
BEGIN
candidate, useMe: Rope.ROPENIL;
end: INT ← 0;
len: INT ← Rope.Length[name];
haveExtension, inWord: BOOLFALSE;
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: BOOLTRUE;
GetFonts[];
[] ← IconsFromFile["Standard.icons"
! FS.Error => IF error.group # bug THEN {ok ← FALSE; CONTINUE}];
IF NOT ok THEN [] ← IconsFromFile["[]<>Standard.icons"];
We do not handle FS.Error here because BootEssentials.*.df is supposed to have attached the local name to the correct place.
};
END.