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!)
Doug Wyatt, January 12, 1984 4:17 pm
(rewrote Decompose)
Doug Wyatt, July 30, 1984 11:23:15 am PDT
(added Viewers.SuppressIconPrefix feature)
DIRECTORY
FS USING [Close, Error, Open, GetInfo, OpenFile, Read],
Graphics USING [CharWidth, ClipBox, Context, DrawRope, FontRef, RopeWidth, SetColor, SetCP, white],
GraphicsOps USING [BitmapRep, DrawBitmap],
Icons,
Rope USING [Fetch, Length, ROPE, Run, Substr],
UserProfile USING [CallWhenProfileChanges, ProfileChangedProc, Token],
VFonts USING [EstablishFont, Font, FontAscent, GraphicsFont],
VM USING [Interval, Allocate, AddressForPageNumber, Free, wordsPerPage];
IconsImpl: CEDAR MONITOR
IMPORTS FS, Graphics, GraphicsOps, Rope, UserProfile, VFonts, VM
EXPORTS Icons =
BEGIN OPEN Icons;
ROPE: TYPE = Rope.ROPE;
DrawIcon:
PUBLIC
ENTRY DrawIconProc =
BEGIN
leading: INTEGER = 3;
iconInfo: IconRef ← icons[LOOPHOLE[flavor]];
prefix: 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;
ix: REAL ← x+iconInfo.lx;
iy: REAL ← y+iconInfo.ly+iconInfo.lh;
indent: REAL ← 0;
segments: LIST OF 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;
indent ← Graphics.CharWidth[iconFont, ' ].xw;
segments ← Decompose[label, iconInfo.lw, indent, iconFont];
END;
Graphics.ClipBox[context, [ix, iy-iconInfo.lh, ix+iconInfo.lw, iy]];
IF iconInfo.invertLabel THEN Graphics.SetColor[context, Graphics.white];
FOR list:
LIST
OF
ROPE ← segments, list.rest
UNTIL list=
NIL
DO
segment: ROPE ~ list.first;
iy ← iy-fontHeight;
Graphics.SetCP[context, ix, iy];
iy ← iy - leading;
Graphics.DrawRope[self: context, font: iconFont, rope: segment];
IF list=segments THEN ix ← ix+indent;
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;
suppressIconPrefix: ROPE ← NIL;
ChangePrefix: UserProfile.ProfileChangedProc ~ {
suppressIconPrefix ← UserProfile.Token[key: "Viewers.SuppressIconPrefix", default: NIL];
};
Decompose:
PROC [name:
ROPE, width, indent:
REAL, font: Graphics.FontRef]
RETURNS [segments: LIST OF ROPE ← NIL] = {
start: INT ← 0;
stop: INT ← name.Length[];
extension: ROPE ← NIL;
Build:
PROC[start:
INT]
RETURNS[
LIST
OF
ROPE] ~ {
maxw: REAL ← (IF start=0 THEN width ELSE width-indent);
sw: REAL ← 0; -- width of string so far
next: INT ← -1;
IF start>=stop THEN RETURN[IF extension=NIL THEN NIL ELSE LIST[extension]];
FOR i:
INT
IN[start..stop)
DO
c: CHAR ~ name.Fetch[i];
sw ← sw+Graphics.CharWidth[font, c].xw;
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;
RETURN[CONS[name.Substr[start: start, len: next-start], Build[next]]];
};
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 { extension ← name.Substr[start: i]; stop ← i; EXIT };
ENDLOOP;
RETURN[Build[start]];
};
wSlop: INTEGER = 1;
OldDecompose: PROC [name: ROPE, width: REAL, font: Graphics.FontRef]
RETURNS [segments: LIST OF ROPE ← NIL] =
BEGIN
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] = {
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] RETURNS [LIST OF ROPE] = {
c: 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]
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, 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"];
We do not handle FS.Error here because BootEssentials.df is supposed to have attached the local name to the correct place.
};
UserProfile.CallWhenProfileChanges[ChangePrefix];
END.