XTkIconImpl.mesa
Copyright Ó 1991, 1992 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, May 2, 1991 2:46:56 pm PDT
Christian Jacobi, July 13, 1992 2:46 pm PDT
DIRECTORY
CBitmapReader, ImagerSample, IO, PFS, Rope, Xl, XTk, XTkDB, XTkIcon, XTkShellWidgets;
XTkIconImpl: CEDAR PROGRAM
IMPORTS CBitmapReader, ImagerSample, IO, PFS, Rope, Xl, XTkDB, XTkShellWidgets
EXPORTS XTkIcon =
BEGIN
SMFromName: PROC [fileName: Rope.ROPE] RETURNS [sm: ImagerSample.RasterSampleMap ¬ NIL] = {
GetStream: PROC [fileName: Rope.ROPE] RETURNS [s: IO.STREAM ¬ NIL] = {
IF Rope.Length[fileName]>0 THEN {
ENABLE PFS.Error => GOTO oops;
s ¬ PFS.StreamOpen[fileName: PFS.PathFromRope[fileName], accessOptions: read];
EXITS oops => {}
};
};
stream: IO.STREAM ~ GetStream[fileName];
IF stream#NIL THEN {
sm ¬ CBitmapReader.FromStream[stream
! CBitmapReader.Error => {IO.Close[stream ! IO.Error => GOTO oops]; GOTO oops}
].sm;
IO.Close[stream];
};
EXITS oops => {};
};
SetIcon: PROC [shell: XTk.Widget, icccmHints: REF XTkShellWidgets.ICCCMHints, baseFileNamePart, maskFileNamePart: Rope.ROPE] = {
sm: ImagerSample.RasterSampleMap ¬ SMFromName[baseFileNamePart];
IF sm#NIL THEN {
screen: Xl.Screen ~ shell.screenDepth.screen;
szVec: ImagerSample.Vec ~ ImagerSample.GetSize[sm];
size: Xl.Size ~ [width: szVec.f, height: szVec.s];
base: LONG POINTER ~ LOOPHOLE[ImagerSample.GetBase[sm].word];
scanLineBytes: INT ~ ImagerSample.GetBitsPerLine[sm]/8;
iconPixmap: Xl.Pixmap ~ Xl.CreatePixmap[shell.connection, screen.root.drawable, size, 1]; --A pixmap of depth 1 is always supported (Protocol; in prose for connection set up)
gc: Xl.GContext ~ Xl.MakeGContext[shell.connection, iconPixmap.drawable];
Xl.SetGCGrounds[gc, 1, 0];
Xl.PutImage[c: shell.connection, drawable: iconPixmap.drawable, gc: gc, base: base, size: size, dest: [0, 0], offx: 0, offy: 0, scanLineBytes: scanLineBytes, bitsPerPixel: 1];
icccmHints.wmHints.iconPixmap ¬ iconPixmap;
icccmHints.wmHintsChanged ¬ TRUE;
IF Rope.Equal[baseFileNamePart, maskFileNamePart] THEN {
icccmHints.wmHints.iconMask ¬ iconPixmap;
icccmHints.wmHintsChanged ¬ TRUE;
RETURN;
};
IF maskFileNamePart#NIL THEN {
sm: ImagerSample.RasterSampleMap ¬ SMFromName[maskFileNamePart];
IF sm#NIL THEN {
szVec: ImagerSample.Vec ~ ImagerSample.GetSize[sm];
size: Xl.Size ~ [width: szVec.f, height: szVec.s];
base: LONG POINTER ~ LOOPHOLE[ImagerSample.GetBase[sm].word];
scanLineBytes: INT ~ ImagerSample.GetBitsPerLine[sm]/8;
maskPixmap: Xl.Pixmap ~ Xl.CreatePixmap[shell.connection, screen.root.drawable, size, 1]; --A pixmap of depth 1 is always supported (Protocol; in prose for connection set up)
Xl.PutImage[c: shell.connection, drawable: maskPixmap.drawable, gc: gc, base: base, size: size, dest: [0, 0], offx: 0, offy: 0, scanLineBytes: scanLineBytes, bitsPerPixel: 1];
icccmHints.wmHints.iconMask ¬ maskPixmap;
icccmHints.wmHintsChanged ¬ TRUE;
};
};
};
};
RopeQuery: PROC [shell: XTk.Widget, key: ATOM] RETURNS [Rope.ROPE¬NIL] = {
q: REF ~ XTkDB.DoQueryFromWidget[shell, FALSE, key];
WITH q SELECT FROM
r: Rope.ROPE => RETURN [r];
ENDCASE => {}
};
SetIconName: PUBLIC PROC [shell: XTk.Widget, fromDB: BOOL ← TRUE, default: Rope.ROPE ¬ NIL] = {
icccmHints: REF XTkShellWidgets.ICCCMHints ~ XTkShellWidgets.GetHints[shell];
IF icccmHints.iconName=NIL THEN {
IF fromDB THEN {
specified: Rope.ROPE ¬ RopeQuery[shell, $iconName];
IF ~Rope.IsEmpty[specified] THEN {
icccmHints.iconName ¬ specified;
icccmHints.iconNameChanged ¬ TRUE;
RETURN
}
};
icccmHints.iconName ¬ default;
};
};
SetIconMask: PUBLIC PROC [shell: XTk.Widget, fromDB: BOOL ← TRUE, packageName, shortName: Rope.ROPE ¬ NIL] = {
fileName: Rope.ROPE ¬ NIL;
icccmHints: REF XTkShellWidgets.ICCCMHints ~ XTkShellWidgets.GetHints[shell];
hasIconWindow: BOOL ¬ icccmHints.wmHints.iconWindow#Xl.nullWindow;
hasIcon: BOOL ~ hasIconWindow OR (icccmHints.wmHints.iconPixmap#Xl.illegalPixmap AND icccmHints.wmHints.iconPixmap#Xl.nullPixmap);
hasMask: BOOL ~ hasIconWindow OR (icccmHints.wmHints.iconMask#Xl.illegalPixmap AND icccmHints.wmHints.iconMask#Xl.nullPixmap);
IF ~hasIcon THEN {
IF fromDB THEN {
fileName ¬ RopeQuery[shell, $iconPixmap];
IF ~Rope.IsEmpty[fileName] THEN {
iconMaskFile: Rope.ROPE ¬ NIL;
IF ~hasMask THEN iconMaskFile ¬ RopeQuery[shell, $iconMask];
SetIcon[shell, icccmHints, fileName, iconMaskFile];
RETURN;
}
};
fileName ← IO.PutFR["/cedar/%g/%g.", IO.rope[packageName], IO.rope[shortName]];
SetIcon[shell, icccmHints, Rope.Concat[fileName, "xIcon"], Rope.Concat[fileName, "xIconMask"]];
};
};
END.