-- Grapevine: Server display "hot" module
-- [Juniper]<Grapevine>MS>LogDisplayHot.mesa
-- Roy Levin
-- Andrew Birrell 11-Jun-81 14:46:51
DIRECTORY
AltoDisplay USING [MaxBitsPerLine, MaxScanLines],
BitBltDefs USING [AlignedBBTable, BBptr, BBTable, BBTableSpace, BITBLT],
FontDefs USING [FontHandle, FontObject],
InlineDefs USING [DIVMOD, HighHalf, LowHalf],
KeyDefs USING [KeyBits, Keys],
LogPrivateDefs USING [
BitmapState, bmPointsPerLine, BMStatePtr, Cursor, cursorBM, DCBchainHead, DCBHandle,
DCBnil, Face, Machine, NumberHouse, NumberHouseObject, ScreenPoints, topMargin],
LogDefs USING [BS, CR, SP, TAB],
Mopcodes USING [zJRAM, zKFCB, zLI0, zLIW, zPOP],
ProcessDefs USING [
Abort, Aborted, Detach, Milliseconds, MsecToTicks, Seconds,
SecondsToTicks, SetTimeout],
SDDefs USING [sULongDivMod],
SegmentDefs USING [FileSegmentAddress, FileSegmentHandle, SwapIn, Unlock],
StringDefs USING [AppendChar, AppendLongNumber, AppendNumber],
TimeDefs USING [CurrentDayTime, PackedTime];
LogDisplayHot: MONITOR
IMPORTS BitBltDefs, InlineDefs, ProcessDefs, SegmentDefs,
StringDefs, TimeDefs
EXPORTS LogDefs, LogPrivateDefs =
BEGIN OPEN FontDefs, LogDefs, LogPrivateDefs;
-- Global Variables --
machineFlavor: PUBLIC Machine;
houses: PUBLIC DESCRIPTOR FOR ARRAY OF NumberHouseObject;
statsFont: PUBLIC FontHandle;
scriptFont: PUBLIC FontHandle;
startUpTime: PUBLIC TimeDefs.PackedTime;
uptimeHouse: PUBLIC NumberHouseObject;
typescriptOn: PUBLIC BOOLEAN;
headingDCB, firstScriptDCB,
lastScriptDCB, firstScriptLineDCB: PUBLIC DCBHandle;
scriptCurrentDCB: PUBLIC DCBHandle;
scriptBMStatePtr: PUBLIC BMStatePtr ← @scriptBMState;
scriptBMState: BitmapState;
maxCursor: Cursor =
[104621B, 155112B, 125704B, 105112B,
105121B, 000000B, 017770B, 010010B,
012550B, 012550B, 012550B, 010150B,
010150B, 010010B, 010010B, 017770B];
minCursor: Cursor =
[104442B, 154462B, 124452B, 104446B,
104442B, 000000B, 017770B, 010010B,
013250B, 013250B, 013250B, 013010B,
013010B, 010010B, 010010B, 017770B];
currentCursor: Cursor =
[160000B, 103403B, 127616B, 167770B,
007670B, 073550B, 174334B, 174676B,
177676B, 073276B, 006234B, 074700B,
175752B, 175752B, 175744B, 070704B];
-- Miscellaneous Declarations --
IllegalUseOfLog: PUBLIC ERROR = CODE;
napInterval: ProcessDefs.Milliseconds = 50;
-- Statistics Display Procedures (exported to LogPrivateDefs) --
Displayer: PUBLIC ENTRY PROCEDURE [waitInterval: ProcessDefs.Seconds] =
-- expects to be FORKed. Loops until aborted, waiting for the argument
-- interval, then updates the statistics display.
BEGIN OPEN ProcessDefs, StringDefs;
DisplayState: TYPE = {max, current, min};
displayState: DisplayState ← current;
savedDCB: DCBHandle = DCBchainHead↑;
onInterval: CARDINAL = 60 -- seconds of display after key action --;
offTime: TimeDefs.PackedTime ←
TimeDefs.CurrentDayTime[]+onInterval;
displayIsOn: BOOLEAN ← TRUE;
Coords: TYPE = RECORD[x,y: INTEGER];
mouse: POINTER TO Coords = LOOPHOLE[424B];
cursor: POINTER TO Coords = LOOPHOLE[426B];
basicMouse: Coords = [ x: MAX[0,headingDCB.indenting*16-32],
y: topMargin ];
sleep: CONDITION;
cat: PROCESS;
DisplayOn: INTERNAL PROC = INLINE
BEGIN
offTime ← TimeDefs.CurrentDayTime[] + onInterval;
IF NOT displayIsOn THEN BEGIN
DCBchainHead↑ ← savedDCB;
mouse↑ ← basicMouse;
displayIsOn ← TRUE;
NOTIFY sleep;
END;
END;
PossibleDisplayOff: INTERNAL PROC = INLINE
BEGIN
IF TimeDefs.CurrentDayTime[] > offTime AND KeyDefs.Keys.Lock = up
THEN BEGIN
DCBchainHead↑ ← DCBnil;
cursor↑ ← basicMouse;
displayIsOn ← FALSE;
displayState ← current; cursorBM↑ ← currentCursor;
END;
END;
UpdateStatus: PROC = INLINE
BEGIN OPEN TimeDefs;
s: STRING = [13];
bmState: BitmapState;
AppendElapsedTime[s, CurrentDayTime[] - startUpTime];
bmState ← BitmapState[
origin: uptimeHouse.dcb.longBitmap,
wordsPerLine: uptimeHouse.dcb.width,
x: uptimeHouse.leftX, y: 0];
ClearHouse[@uptimeHouse];
PutStringInBitmap[s, statsFont, plain, @bmState]
END;
Cat: ENTRY PROCEDURE =
BEGIN
catNap: CONDITION;
oldKeys: KeyDefs.KeyBits ← KeyDefs.Keys↑;
oldMouse: Coords ← mouse↑;
SetTimeout[@catNap, MsecToTicks[napInterval]];
DO
WAIT catNap[ ! Aborted => EXIT];
IF KeyDefs.Keys↑ # oldKeys THEN
BEGIN
DisplayOn[];
SELECT TRUE FROM
KeyDefs.Keys.Red=down AND oldKeys.Red#down =>
{ displayState ← min; NOTIFY sleep };
KeyDefs.Keys.Blue=down AND oldKeys.Blue#down =>
{ displayState ← max; NOTIFY sleep };
KeyDefs.Keys.Yellow=down AND oldKeys.Yellow#down =>
{ displayState ← current; NOTIFY sleep };
ENDCASE => NULL;
oldKeys ← KeyDefs.Keys↑;
END;
IF mouse↑ # oldMouse THEN BEGIN
oldMouse ← [x: MAX[0,MIN[mouse↑.x, AltoDisplay.MaxBitsPerLine]],
y: MAX[0,MIN[mouse↑.y, AltoDisplay.MaxScanLines]] ];
mouse↑ ← oldMouse;
DisplayOn[];
END;
IF displayIsOn
THEN cursor↑ ← oldMouse
ELSE BEGIN -- show we're alive! --
IF cursor.x < AltoDisplay.MaxBitsPerLine-32
THEN cursor.x ← cursor.x + 1
ELSE cursor.x ← 16;
END;
ENDLOOP;
END;
SetTimeout[@sleep, SecondsToTicks[waitInterval]];
Detach[cat ← FORK Cat];
mouse↑ ← basicMouse;
DO
-- calculate new min/max, even if display is off --
FOR i: CARDINAL IN [0..LENGTH[houses]) DO
h: NumberHouse = @houses[i];
WITH item: h SELECT FROM
short =>
BEGIN
IF item.max < item.p↑ THEN item.max ← item.p↑;
IF item.p↑ < item.min THEN item.min ← item.p↑;
END;
long =>
BEGIN
IF item.max < item.p↑ THEN item.max ← item.p↑;
IF item.p↑ < item.min THEN item.min ← item.p↑;
END;
percent =>
BEGIN
pct: CARDINAL ← MIN[item.p↑, 100];
IF item.max < pct THEN item.max ← pct;
IF pct < item.min THEN item.min ← pct;
END;
ENDCASE;
ENDLOOP;
IF displayIsOn THEN PossibleDisplayOff[];
IF displayIsOn THEN
BEGIN
SELECT displayState FROM
min => cursorBM↑ ← minCursor;
max => cursorBM↑ ← maxCursor;
current => cursorBM↑ ← currentCursor;
ENDCASE => NULL;
UpdateStatus[];
FOR i: CARDINAL IN [0..LENGTH[houses]) DO
h: NumberHouse = @houses[i];
current: LONG CARDINAL;
s: STRING = [13];
bmState: BitmapState;
ClearHouse[h];
WITH item: h SELECT FROM
short => current ← SELECT displayState FROM
max => item.max,
min => item.min,
ENDCASE => LOOPHOLE[item.p↑, CARDINAL];
long => current ← SELECT displayState FROM
max => item.max,
min => item.min,
ENDCASE => item.p↑;
percent => current ← SELECT displayState FROM
max => item.max,
min => item.min,
ENDCASE => MIN[item.p↑, 100];
ENDCASE;
AppendLongNumber[s, current, 10];
IF h.format = percent THEN AppendChar[s, '%];
bmState ← BitmapState[
origin: h.dcb.longBitmap, wordsPerLine: h.dcb.width,
x: h.leftX, y: 0];
PutStringInBitmap[s, statsFont, plain, @bmState];
ENDLOOP;
END;
WAIT sleep[ ! Aborted => BEGIN Abort[cat]; EXIT END];
ENDLOOP;
END; --Displayer
PutStringInBitmap: PUBLIC PROCEDURE [
s: STRING, font: FontHandle, face: Face, bmState: BMStatePtr] =
-- computes the width in ScreenPoints of the string 's' presented in 'font' and 'face'.
BEGIN
i: CARDINAL;
x: ScreenPoints;
SELECT face FROM
plain, italic =>
FOR i IN [0..s.length) DO PaintChar[font, s[i], bmState]; ENDLOOP;
bold =>
FOR i IN [0..s.length) DO
x ← bmState.x;
PaintChar[font, s[i], bmState];
bmState.x ← x + 1;
PaintChar[font, s[i], bmState];
ENDLOOP;
ENDCASE;
IF face = italic THEN -- italicize --NULL;
END; --PutStringInBitmap
AppendElapsedTime: PUBLIC PROCEDURE [s: STRING, pt: TimeDefs.PackedTime] =
-- appends to 's' a time derived from 'pt' of the form: 1314:35:28.
BEGIN OPEN StringDefs;
Append2: PROCEDURE [s: STRING, v: CARDINAL] =
BEGIN
n, r: CARDINAL;
[n, r] ← InlineDefs.DIVMOD[v, 10];
AppendChar[s, n + '0];
AppendChar[s, r + '0];
END;
n: LONG CARDINAL;
mm, ss: CARDINAL;
[n, ss] ← LongDivMod[pt, 60];
[n, mm] ← LongDivMod[n, 60];
AppendLongNumber[s, n, 10];
AppendChar[s, ':];
Append2[s, mm];
AppendChar[s, ':];
Append2[s, ss];
END; --AppendElapsedTime
Even: PUBLIC PROCEDURE [v: UNSPECIFIED] RETURNS [UNSPECIFIED] =
-- rounds up 'v' to an even number.
BEGIN RETURN[v + (v MOD 2)] END; --Even
-- Typescript Procedures (exported to LogDefs) --
WriteChar: PUBLIC ENTRY PROCEDURE [char: CHARACTER] =
-- writes the argument character into the typescript. Characters > 177C will be ignored and ASCII control characters (other than CR, TAB, SP, and BS) will be printed as though the sequence WriteChar['↑]; WriteChar[char+100B] had been executed. CR, TAB, and SP cause appropriate white space to be introduced. WriteChar must be called after TypescriptOn.
BEGIN Write[char]; END; --WriteChar
WriteString: PUBLIC ENTRY PROCEDURE [s: STRING] =
-- writes all characters of the string into the typescript using WriteChar.
BEGIN i: CARDINAL; FOR i IN [0..s.length) DO Write[s[i]]; ENDLOOP; END;
--WriteString
WriteLine: PUBLIC PROCEDURE [s: STRING] =
-- equivalent to WriteString[s]; WriteChar[CR].
BEGIN WriteString[s]; Write[CR]; END; --WriteLine
WriteDecimal: PUBLIC PROCEDURE [n: CARDINAL] =
-- writes 'n' on the typescript as an unsigned, decimal quantity.
BEGIN s: STRING = [5]; StringDefs.AppendNumber[s, n, 10]; WriteString[s]; END;
--WriteDecimal
-- Internal Procedures --
ClearHouse: PROCEDURE [h: NumberHouse] =
-- clears the bitmap rectangle corresponding to the numeric part of 'h'.
BEGIN
bbtSpace: ARRAY [0..SIZE[BitBltDefs.BBTable]] OF UNSPECIFIED;
bbt: BitBltDefs.BBptr = Even[@bbtSpace];
bbt↑ ←
[ptrs: IF machineFlavor=dMachine THEN long ELSE short,
pad: 0, sourcealt: FALSE, destalt: TRUE, sourcetype: gray,
function: replace, unused: InlineDefs.HighHalf[h.dcb.longBitmap],
dbca: InlineDefs.LowHalf[h.dcb.longBitmap], dbmr: h.dcb.width,
dlx: h.leftX, dty: 0, dw: h.width, dh: h.dcb.height*2,
sbca:, sbmr:, slx:, sty:,
gray0: 0, gray1: 0, gray2: 0, gray3: 0,
slbca:, dlbca: h.dcb.longBitmap];
myBITBLT[bbt];
END; --ClearHouse
Write: PROCEDURE [char: CHARACTER] =
-- see description under 'WriteChar'.
BEGIN
IF ~typescriptOn THEN ERROR IllegalUseOfLog;
IF char < 040C THEN
SELECT char FROM
CR => BEGIN Scroll[]; RETURN END;
TAB => BEGIN char ← SP; THROUGH [0..2) DO Write[char] ENDLOOP; END;
-- temporary
SP => NULL;
BS => char ← '?; -- temporary
ENDCASE => BEGIN Write['↑]; char ← char + 100B; END;
IF CharWidth[scriptFont, char] + scriptBMStatePtr.x > bmPointsPerLine THEN
Scroll[];
PaintChar[scriptFont, char, scriptBMStatePtr];
END; --Write
Scroll: PROCEDURE =
-- scrolls the typescript by one line.
BEGIN
IF scriptCurrentDCB.next ~= DCBnil THEN
scriptCurrentDCB ← scriptCurrentDCB.next
ELSE
BEGIN
dcb: DCBHandle ← firstScriptLineDCB;
firstScriptDCB.next ← firstScriptLineDCB ← dcb.next;
Zero[dcb.longBitmap, dcb.width*dcb.height*2];
dcb.next ← DCBnil;
lastScriptDCB.next ← dcb;
scriptCurrentDCB ← lastScriptDCB ← dcb;
END;
scriptBMStatePtr↑ ← BitmapState[
origin: scriptCurrentDCB.longBitmap, wordsPerLine: scriptCurrentDCB.width, x: 0,
y: 0];
END; --Scroll
LongDivMod: PROCEDURE [num, den: LONG CARDINAL]
RETURNS [q: LONG CARDINAL, r: CARDINAL] = MACHINE CODE
BEGIN Mopcodes.zKFCB, SDDefs.sULongDivMod; Mopcodes.zPOP; END; --LongDivMod
Zero: PUBLIC PROCEDURE [p: LONG POINTER, count: CARDINAL] =
BEGIN
-- zeros given number of words in XM --
bbtSpace: ARRAY [0..SIZE[BitBltDefs.BBTable]] OF UNSPECIFIED;
bbt: BitBltDefs.BBptr = Even[@bbtSpace];
bbt↑ ←
[ptrs: IF machineFlavor=dMachine THEN long ELSE short,
pad: 0, sourcealt: FALSE, destalt: TRUE, sourcetype: gray,
function: replace, unused: InlineDefs.HighHalf[p],
dbca: InlineDefs.LowHalf[p], dbmr: 1--words--,
dlx: 0, dty: 0, dw: 16--bits--, dh: count,
sbca:, sbmr:, slx:, sty:,
gray0: 0, gray1: 0, gray2: 0, gray3: 0,
slbca:, dlbca: p];
myBITBLT[bbt];
END; --Zero
myBITBLT: PROC[ptr: BitBltDefs.BBptr] = INLINE
{ IF machineFlavor=xmesa39
THEN M5BITBLT[ptr] ELSE BitBltDefs.BITBLT[ptr] };
M5BITBLT: PROC[ptr: BitBltDefs.BBptr] = MACHINE CODE
-- works with XMesa 5 ROM's --
{ Mopcodes.zLI0;
Mopcodes.zLIW, 411B/256, 411B MOD 256; Mopcodes.zJRAM};
-- The following is stolen from AlFont.mesa
-- Changed to handle XM bitmaps
-- Assumes the font is locked
FileSegmentHandle: TYPE = SegmentDefs.FileSegmentHandle;
AlFontObject: TYPE = RECORD [
procs: FontObject,
seg: FileSegmentHandle,
lockCount: CARDINAL,
height: CARDINAL];
AlFontHandle: TYPE = POINTER TO AlFontObject;
FHptr: TYPE = POINTER TO FontHeader;
Fptr: TYPE = POINTER TO Font;
FCDptr: TYPE = POINTER TO FCD;
FAptr: TYPE = POINTER TO FontArray;
FontArray: TYPE = ARRAY [0..255] OF FCDptr;
Font: TYPE = MACHINE DEPENDENT RECORD [
header: FontHeader,
FCDptrs: FontArray, -- array of self-relative pointers to
-- FCD's. Indexed by char value.
-- font pointer points hear!
extFCDptrs: FontArray -- array of self-relative pointers to
-- FCD's for extentions. As large an
-- array as needed.
];
FontHeader: TYPE = MACHINE DEPENDENT RECORD [
maxHeight: CARDINAL, -- height of tallest char in font (scan lines)
variableWidth: BOOLEAN, -- IF TRUE, proportionally spaced font
blank: [0..177B], -- not used
maxWidth: [0..377B] -- width of widest char in font (raster units).
];
FCD: TYPE = MACHINE DEPENDENT RECORD [
widthORext: [0..77777B], -- width or extention index
hasNoExtension: BOOLEAN, -- TRUE=> no ext.;prevfield=width
height: [0..377B], -- # scan lines to skip for char
displacement: [0..377B] -- displacement back to char bitmap
];
CharWidth: PUBLIC PROCEDURE [font: FontHandle, char: CHARACTER]
RETURNS [w: CARDINAL] =
BEGIN
code: CARDINAL;
cw: FCDptr;
fontdesc: FAptr; -- checkfor control characters
IF char = CR THEN char ← SP;
IF char < SP THEN RETURN[CharWidth[font, '↑] + CharWidth[font, char + 100B]];
w ← 0;
fontdesc ← @LockFont[font].FCDptrs;
code ← LOOPHOLE[char];
DO
cw ← LOOPHOLE[fontdesc[code] + LOOPHOLE[fontdesc, CARDINAL] + code];
IF cw.hasNoExtension THEN EXIT;
w ← w + 16;
code ← cw.widthORext;
ENDLOOP;
w ← w + cw.widthORext;
UnlockFont[font];
RETURN
END;
CharHeight: PUBLIC PROCEDURE [font: FontHandle, char: CHARACTER]
RETURNS [CARDINAL] = BEGIN RETURN[LOOPHOLE[font, AlFontHandle].height] END;
PaintChar: PROCEDURE [
font: FontHandle, char: CHARACTER, bmState: POINTER TO BitmapState] =
BEGIN OPEN BitBltDefs, bmState;
bba: BitBltDefs.BBTableSpace;
bbt: BitBltDefs.BBptr = BitBltDefs.AlignedBBTable[@bba];
cw: FCDptr;
fontdesc: FAptr = @LockFont[font].FCDptrs;
code: CARDINAL ← LOOPHOLE[char];
bbt↑ ←
[ptrs: IF machineFlavor=dMachine THEN long ELSE short,
sourcetype: block, function: paint,
dbca: InlineDefs.LowHalf[origin], dbmr: wordsPerLine,
destalt: TRUE, unused: InlineDefs.HighHalf[origin],
dlx: x, dw: 16, sbmr: 1, slx: 0, sty: 0,
dlbca: origin];
DO
cw ← LOOPHOLE[fontdesc[code] + LOOPHOLE[fontdesc, CARDINAL] + code];
bbt.dty ← y + cw.height;
bbt.dh ← cw.displacement;
bbt.sbca ← cw - (bbt.dh ← cw.displacement);
bbt.slbca ← LONG[bbt.sbca];
IF cw.hasNoExtension THEN
BEGIN x ← x + (bbt.dw ← cw.widthORext); myBITBLT[bbt]; EXIT END
ELSE BEGIN myBITBLT[bbt]; bbt.dlx ← x ← x + 16; END;
code ← cw.widthORext;
ENDLOOP;
UnlockFont[font];
RETURN
END;
LockFont: PROCEDURE [font: FontHandle] RETURNS [Fptr] =
BEGIN OPEN SegmentDefs, af: LOOPHOLE[font, AlFontHandle];
IF (af.lockCount ← af.lockCount + 1) = 1 THEN SwapIn[af.seg];
RETURN[FileSegmentAddress[af.seg]]
END;
UnlockFont: PROCEDURE [font: FontHandle] =
BEGIN OPEN SegmentDefs, af: LOOPHOLE[font, AlFontHandle];
IF (af.lockCount ← af.lockCount - 1) = 0 THEN
BEGIN Unlock[af.seg]; af.seg.inuse ← TRUE END;
RETURN
END;
-- End of stolen section
-- Main Body --
NULL;
END.
Created by Levin on February 6, 1980 5:48 PM.
Changed by Levin on February 11, 1980 1:56 PM, max/min logic.
Changed by Levin on February 17, 1980 5:59 PM, improve mouse transition logic.
Changed by Levin on February 18, 1980 3:45 PM, move cursor declarations to LogPrivateDefs.
Changed by Birrell on May 12, 1980 6:05 PM, WriteLine not an ENTRY procedure.
Changed by Levin on May 20, 1980 6:19 PM, fix 1000-hour bug in AppendElapsedTime.
Changed by Birrell on 2-Jun-81 14:51:03