DIRECTORY
Ascii USING [Lower],
Buttons USING [Button, ButtonProc, Create, SetDisplayStyle],
ColorDisplay, --USING almost everything...
Commander USING [CommandProc, Register],
Containers USING [Container, Create],
IO USING [card, EndOfStream, GetTokenRope, IDProc, PutF, RIS, rope, STREAM],
MessageWindow USING [Append],
Rope USING [Equal, Fetch, Length, ROPE, Translate, TranslatorType],
ViewerOps USING [OpenIcon, SetOpenHeight];
ColorDisplayCommand:
CEDAR
MONITOR
IMPORTS Ascii, Buttons, ColorDisplay, Commander, Containers, IO, MessageWindow, Rope, ViewerOps
~ {
ROPE: TYPE ~ Rope.ROPE;
FiddleWithDisplay: Commander.CommandProc ~ {
MyLower:Rope.TranslatorType = BEGIN RETURN[Ascii.Lower[old]]; END;
myOn: BOOLEAN;
myBpp: CARDINAL;
myOnLeft: BOOLEAN;
myMonType: Rope.ROPE;
noParams: BOOLEAN ← TRUE;
s: IO.STREAM ← IO.RIS[Rope.Translate[base:cmd.commandLine, translator:MyLower]];
[myOn, myOnLeft, myBpp, myMonType] ← ColorDisplay.GetColorDisplayStatus[];
DO
f:Rope.ROPE ← IO.GetTokenRope[s, IO.IDProc ! IO.EndOfStream => EXIT].token;
noParams ← FALSE;
SELECT Rope.Fetch[f, 0]
FROM
'0 => myOn ← FALSE;
'1 =>
IF Rope.Equal[f, "1024x768"] THEN { myMonType ← "1024x768"; myOn ← TRUE }
ELSE IF Rope.Length[f]=1 THEN {myBpp ← 1; myOn ← TRUE; }
ELSE {
IO.PutF[cmd.err, "Option %g that begins with a 1 has to be 1024x768 or 1 exactly.\n", IO.rope[f]];
RETURN;
};
'2 =>
IF Rope.Equal[f, "24"] THEN { myOn ← TRUE; myBpp ← 24 }
ELSE IF Rope.Length[f]=1 THEN { myBpp ← 2; myOn ← TRUE }
ELSE {
IO.PutF[cmd.err, "Can't do %g bpp\n", IO.rope[f]];
RETURN;
};
'4 => { myBpp ← 4; myOn ← TRUE };
'6 =>
{
IF Rope.Equal[f, "640x480"] THEN { myMonType ← "640x480"; myOn ← TRUE }
ELSE {
IO.PutF[cmd.err, "%g is an invalid key\n", IO.rope[f]];
RETURN;
};
};
'8 => { myBpp ← 8; myOn ← TRUE };
'l => { myOnLeft ← TRUE; myOn ← TRUE };
'r => { myOnLeft ← FALSE; myOn ← TRUE };
'd => {
[myOn, myOnLeft, myBpp, myMonType] ← ColorDisplay.GetColorDisplayProfile[];
};
'o =>
IF Rope.Equal[f, "on"] THEN myOn ← TRUE
ELSE IF Rope.Equal[f, "off"] THEN myOn ← FALSE
ELSE {
IO.PutF[cmd.err, "%g is an invalid key\n", IO.rope[f]];
RETURN;
};
'? =>
IO.PutF[cmd.err, "%g, %g bpp, %g, %g\n",
IO.rope[IF myOn THEN "on" ELSE "off"],
IO.card[myBpp],
IO.rope[IF myOnLeft THEN "left" ELSE "right"],
IO.rope[myMonType]];
ENDCASE => {
IO.PutF[cmd.err, "%g is an invalid key\n", IO.rope[f]];
RETURN[];
};
ENDLOOP;
IF noParams THEN myOn ← ~myOn;
ColorDisplay.SetColorDisplayStatus[myOn, myOnLeft, myBpp, myMonType];
};
colorDisplayTool: Containers.Container ← NIL;
prev, on, off, left, right, lowres, highres, c1, c2, c4, c8, c24: Buttons.Button;
CreateColorDisplayTool:
INTERNAL
PROC
RETURNS [
ROPE] ~ {
hMargin: INT ~ -1;
hSeparator: INT ~ 20;
vMargin: INT ~ 5;
vHeight: INT ~ 10;
thisX, thisY: INT;
IF colorDisplayTool#
NIL
AND ~colorDisplayTool.destroyed
THEN {
ViewerOps.OpenIcon[icon: colorDisplayTool, bottom: FALSE];
RETURN ["Opened existing Color Display Tool."]
};
colorDisplayTool ← Containers.Create[
info: [
name: "ColorDisplayTool",
column: right,
scrollable: FALSE
]
];
thisX ← hMargin+hSeparator; thisY ← vMargin;
On Button
prev ← on ← Buttons.Create[
info: [
name: "On",
wx: thisX,
wy: thisY,
parent: colorDisplayTool,
border: TRUE
],
proc: CDTOn,
fork: FALSE
];
thisX ← thisX + prev.ww + hMargin;
Off Button
prev ← off ← Buttons.Create[
info: [
name: "Off",
wx: thisX,
wy: thisY,
parent: colorDisplayTool,
border: TRUE
],
proc: CDTOff,
fork: FALSE
];
thisX ← thisX + prev.ww + hMargin + hSeparator;
1 Button
prev ← c1 ← Buttons.Create[
info: [
name: "1 ",
wx: thisX,
wy: thisY,
parent: colorDisplayTool,
border: TRUE
],
proc: CDT1,
fork: FALSE
];
thisX ← thisX + prev.ww + hMargin;
2 Button
prev ← c2 ← Buttons.Create[
info: [
name: "2 ",
wx: thisX,
wy: thisY,
parent: colorDisplayTool,
border: TRUE
],
proc: CDT2,
fork: FALSE
];
thisX ← thisX + prev.ww + hMargin;
4 Button
prev ← c4 ← Buttons.Create[
info: [
name: "4 ",
wx: thisX,
wy: thisY,
parent: colorDisplayTool,
border: TRUE
],
proc: CDT4,
fork: FALSE
];
thisX ← thisX + prev.ww + hMargin;
8 Button
prev ← c8 ← Buttons.Create[
info: [
name: "8 ",
wx: thisX,
wy: thisY,
parent: colorDisplayTool,
border: TRUE
],
proc: CDT8,
fork: FALSE
];
thisX ← thisX + prev.ww + hMargin;
24 Button
prev ← c24 ← Buttons.Create[
info: [
name: "24 ",
wx: thisX,
wy: thisY,
parent: colorDisplayTool,
border: TRUE
],
proc: CDT24,
fork: FALSE
];
thisX ← thisX + prev.ww + hMargin + hSeparator;
Left Button
prev ← left ← Buttons.Create[
info: [
name: "Left",
wx: thisX,
wy: thisY,
parent: colorDisplayTool,
border: TRUE
],
proc: CDTLeft,
fork: FALSE
];
thisX ← thisX + prev.ww + hMargin;
Right Button
prev ← right ← Buttons.Create[
info: [
name: "Right",
wx: thisX,
wy: thisY,
parent: colorDisplayTool,
border: TRUE
],
proc: CDTRight,
fork: FALSE
];
thisX ← thisX + prev.ww + hMargin + hSeparator;
640x480 Button
prev ← lowres ← Buttons.Create[
info: [
name: "640x480",
wx: thisX,
wy: thisY,
parent: colorDisplayTool,
border: TRUE
],
proc: CDTLowRes,
fork: FALSE
];
thisX ← thisX + prev.ww + hMargin;
1024x768 Button
prev ← highres ← Buttons.Create[
info: [
name: "1024x768",
wx: thisX,
wy: thisY,
parent: colorDisplayTool,
border: TRUE
],
proc: CDTHighRes,
fork: FALSE
];
thisX ← thisX + prev.ww + hMargin + hSeparator;
Paint the buttons manually the first time for the new color display tool
{
cdState: ColorDisplay.CDState;
[cdState.on, cdState.onLeft, cdState.bpp, cdState.monitorType] ← ColorDisplay.GetColorDisplayStatus[];
MonitorButtons[cdState, cdState]; --Get the first button set-up right;
};
Set the height of the viewer as a whole
ViewerOps.SetOpenHeight[colorDisplayTool, thisY + vHeight + 2*vMargin];
ViewerOps.OpenIcon[icon: colorDisplayTool, bottom: FALSE];
RETURN ["Created new Color Display Tool."]
};
shouldBeLit: ARRAY BOOLEAN OF ATOM ~ [$BlackOnWhite, $WhiteOnBlack];
MonitorButtons: ColorDisplay.CDNotifyProc ~ {
Repaint:
PROC [button: Buttons.Button, condition:
BOOLEAN] ~
INLINE {
OPEN Buttons;
Buttons.SetDisplayStyle[button, shouldBeLit[condition]];
};
This proc toggles the color of the buttons to show currect state of display
IF colorDisplayTool=NIL OR colorDisplayTool.destroyed THEN RETURN; --No point blowing ourselves to smithereens.
Repaint[on, new.on];
Repaint[off, ~new.on];
Repaint[c1, new.bpp=1];
Repaint[c2, new.bpp=2];
Repaint[c4, new.bpp=4];
Repaint[c8, new.bpp=8];
Repaint[c24, new.bpp=24];
Repaint[left, new.onLeft];
Repaint[right, ~new.onLeft];
Repaint[lowres, new.monitorType.Equal["640x480"]];
Repaint[highres, ~new.monitorType.Equal["640x480"]];
};
CDTOn: Buttons.ButtonProc ~ {ColorDisplay.SetColorDisplayStatus[on: TRUE]};
CDTOff: Buttons.ButtonProc ~ {ColorDisplay.SetColorDisplayStatus[on: FALSE]};
CDTLeft: Buttons.ButtonProc ~ {ColorDisplay.SetColorDisplayStatus[onLeft: TRUE]};
CDTRight: Buttons.ButtonProc ~ {ColorDisplay.SetColorDisplayStatus[onLeft: FALSE]};
CDTLowRes: Buttons.ButtonProc ~ {ColorDisplay.SetColorDisplayStatus[monitorType: "640x480"]};
CDTHighRes: Buttons.ButtonProc ~ {ColorDisplay.SetColorDisplayStatus[monitorType: "1024x768"]};
CDT1: Buttons.ButtonProc ~ {ColorDisplay.SetColorDisplayStatus[on: TRUE, bpp: 1]};
CDT2: Buttons.ButtonProc ~ {ColorDisplay.SetColorDisplayStatus[on: TRUE, bpp: 2]};
CDT4: Buttons.ButtonProc ~ {ColorDisplay.SetColorDisplayStatus[on: TRUE, bpp: 4]};
CDT8: Buttons.ButtonProc ~ {ColorDisplay.SetColorDisplayStatus[on: TRUE, bpp: 8]};
CDT24: Buttons.ButtonProc ~ {ColorDisplay.SetColorDisplayStatus[on: TRUE, bpp: 24]};
BugColor:
ENTRY Buttons.ButtonProc ~ {
SELECT mouseButton
FROM
red => ColorDisplay.SetColorDisplayStatus[on: ~ColorDisplay.GetColorDisplayStatus[].on];
yellow => ColorDisplay.SleepColorDisplay[300];
blue => MessageWindow.Append[CreateColorDisplayTool[], TRUE];
ENDCASE;
};
Init:
PROC =
BEGIN
Register the program with the commander and read user profile
Commander.Register[key:"ColorDisplay", proc:FiddleWithDisplay, doc:"Configure color monitor"];
ColorDisplay.RegisterCDNotifyProc[MonitorButtons];
Establish the 'color' button up at the top
[] ← Buttons.Create[
info: [name: "Color"],
proc: BugColor,
fork: FALSE
];
END;
}.