-- file Display
-- last edited by Brotz, November 12, 1981 2:21 PM
-- last edited by Levin, October 1, 1980 10:52 AM
-- last edited by Taft, May 10, 1983 6:08 PM

DIRECTORY
Ascii USING [CR, SP, TAB],
displayCommon USING [charPropertyTable, mcFont],
dsD: FROM "DisplayDefs" USING [BbtPtr, BitBlt, BitBltFunction, bmWidth, CharFontPtr,
CharProperty, ClearRectangle, cursorBM, CursorShape, CursorTable, cursorX, cursorY,
Dimensions, FaceType, gray, GrayBitPattern, GrayShade, HotSpot, invert,
LegalCharacters, lineHeight, machineFlavor, MachineFlavor, PictureBitMap,
PictureClass, PictureTable, replace, ReplaceRectangle, ScreenXCoord, ScreenYCoord,
source, xOrigin, yOrigin],
exD: FROM "ExceptionDefs" USING [SysBug],
Inline USING [BITAND],
ovD: FROM "OverviewDefs" USING [CharMask];

Display: PROGRAM
IMPORTS disC: displayCommon, dsD, exD, Inline
EXPORTS dsD
SHARES dsD = PUBLIC

BEGIN

OPEN dsD;

-- Purpose: contains those procedures that directly use bitmaps, fonts, and the cursor after
-- initialization.

-- Global Variables and Constants

bbtPtr, charBbtPtr, pictureBbtPtr: PUBLIC BbtPtr;

machineFlavor: PUBLIC MachineFlavor;

currentCursorShape: CursorShape;

tabWidth: CARDINAL = 40;

mouseX: POINTER TO CARDINAL = LOOPHOLE[424B];
mouseY: POINTER TO CARDINAL = LOOPHOLE[425B];

cursorTable: CursorTable =
[lineArrow:
[hotSpot: [x: 15, y: 0],
bitMap: [001777B, 000776B, 000374B, 001770B, 007560B, 036140B, 170100B, 140000B,
000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B]],
charArrow:
[hotSpot: [x: 0, y: -4],
bitMap: [100000B, 140000B, 160000B, 170000B, 174000B, 176000B, 177000B, 170000B,
154000B, 114000B, 006000B, 006000B, 003000B, 003000B, 001400B, 001400B]],
thumbMarker:
[hotSpot: [x: 0, y: 6],
bitMap: [140000B, 140000B, 140000B, 140000B, 140000B, 140000B, 140000B, 140000B,
140000B, 140000B, 140000B, 140000B, 000000B, 000000B, 000000B, 000000B]],
scroll:
[hotSpot: [x: 10, y: 5],
bitMap: [000400B, 001600B, 003700B, 007740B, 001600B, 001600B, 001600B, 001600B,
007740B, 003700B, 001600B, 000400B, 000000B, 000000B, 000000B, 000000B]],
scrollUp:
[hotSpot: [x: 10, y: 5],
bitMap: [001400B, 003600B, 007700B, 017740B, 037760B, 077770B, 177774B, 017740B,
017740B, 017740B, 017740B, 017740B, 017740B, 017740B, 017740B, 017740B]],
scrollDown:
[hotSpot: [x: 10, y: 5],
bitMap: [017740B, 017740B, 017740B, 017740B, 017740B, 017740B, 017740B, 017740B,
017740B, 177774B, 077770B, 037760B, 017740B, 007700B, 003600B, 001400B]],
bullsEye:
[hotSpot: [x: 0, y: -4],
bitMap: [100000B, 140000B, 160000B, 170000B, 174000B, 176000B, 177000B, 170000B,
154000B, 114000B, 006000B, 006000B, 003000B, 003000B, 001400B, 001400B]],
hourGlass:
[hotSpot: [x: 7, y: 7],
bitMap: [177777B, 100001B, 040002B, 034034B, 017170B, 007660B, 003740B, 001700B,
001100B, 002440B, 004220B, 010610B, 021704B, 047762B, 177777B, 177777B]],
boundaryPad:
[hotSpot: [x: 0, y: 6],
bitMap: [007777B, 007777B, 006003B, 006003B, 006003B, 176003B, 176003B, 006003B,
006003B, 006003B, 007777B, 007777B, 000000B, 000000B, 000000B, 000000B]],
invisibleCursor:
[hotSpot: [x: 0, y: 0],
bitMap: [000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B,
000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B, 000000B]],
questionMark:
[hotSpot: [x: 0, y: 0],
bitMap: [0B, 001700B, 003740B, 007160B, 006060B, 000060B, 000160B, 000340B,
000700B, 000600B, 000600B, 000600B, 000000B, 000000B, 000600B, 000600B]],
invertQuestionMark:
[hotSpot: [x: 0, y: 0],
bitMap: [177777B, 176077B, 174037B, 170617B, 171717B, 177717B, 177617B, 177437B,
177077B, 177177B, 177177B, 177177B, 177777B, 177777B, 177177B, 177177B]]];

pictureTable: PictureTable =
[triangle:
[dimensions: [width: 5, height: 9],
bitmap: [100000B, 140000B, 160000B, 170000B, 174000B, 170000B,
160000B, 140000B, 100000B, 000000B, 000000B, 000000B]],
caret:
[dimensions: [width: 7, height: 6],
bitmap: [010000B, 034000B, 034000B, 066000B, 066000B, 143000B,
000000B, 000000B, 000000B, 000000B, 000000B, 000000B]],
leftEdgeCaret:
[dimensions: [width: 9, height: 6],
bitmap: [010000B, 014000B, 016000B, 017000B, 015400B, 014600B,
000000B, 000000B, 000000B, 000000B, 000000B, 000000B]],
boundaryPad:
[dimensions: [width: 16, height: 12],
bitmap: [007777B, 007777B, 006003B, 006003B, 006003B, 176003B,
176003B, 006003B, 006003B, 006003B, 007777B, 007777B]],
selectionThumbMark:
[dimensions: [width: 2, height: 10],
bitmap: [140000B, 140000B, 140000B, 140000B, 140000B, 140000B,
140000B, 140000B, 140000B, 140000B, 000000B, 000000B]],
resetMenuIcon:
[dimensions: [width: 11, height: 12],
bitmap: [000000B, 000000B, 177740B, 177740B, 002000B, 007000B,
017400B, 037600B, 007000B, 007000B, 007000B, 007000B]]];

grayShadeArray: ARRAY GrayShade OF GrayBitPattern =
[white: [000000B, 000000B, 000000B, 000000B],
black: [177777B, 177777B, 177777B, 177777B],
lightGray: [104210B, 021042B, 104210B, 021042B],
darkGray: [125252B, 052525B, 125252B, 052525B],
dottedLine: [146314B, 146314B, 146314B, 146314B]];


-- Character-Oriented Procedures

PutCharInBitMap: PROCEDURE [char: CHARACTER, x: ScreenXCoord, y: ScreenYCoord,
face: FaceType] RETURNS [ScreenXCoord] =
-- Places char in standard bitmap at screen position x,y in the specified face. Uses the
-- default MC font. Assuming that the caller knows what he is doing, PutCharInBitmap
-- makes no check of whether the point x,y is covered by bitmap; if given out of range
-- arguments, PutCharInBitmap will overwrite memory. Returns first free ScreenXCoord.
BEGIN
bitmapX, bitmapY: CARDINAL;
offsetPtr: POINTER;
charFontPtr: CharFontPtr;
IF char > LAST[LegalCharacters] THEN
char ← Inline.BITAND[char, ovD.CharMask];
SELECT face FROM
plainFace, italicFace => BEGIN
-- italicFace not yet implemented; use plainFace for now --
bitmapX ← x - dsD.xOrigin;
bitmapY ← y - dsD.yOrigin;
offsetPtr ← disC.mcFont + LOOPHOLE[char, CARDINAL];
charFontPtr ← offsetPtr + offsetPtr↑;
bitmapX ← (charBbtPtr.dlx ← bitmapX) + (charBbtPtr.dw ← charFontPtr.width);
SELECT char FROM
’ , Ascii.TAB, Ascii.CR => NULL;
ENDCASE =>
BEGIN
charBbtPtr.dty ← bitmapY + charFontPtr.ySkip;
charBbtPtr.dh ← charFontPtr.height;
IF charBbtPtr.ptrs = short THEN charBbtPtr.sbca ← charFontPtr-charFontPtr.height
ELSE charBbtPtr.slbca ← charFontPtr-charFontPtr.height;
BitBlt[charBbtPtr];
END;
RETURN[bitmapX + dsD.xOrigin];
END;
boldFace => BEGIN
[] ← PutCharInBitMap[char, x, y, plainFace];
RETURN[PutCharInBitMap[char, x+1, y, plainFace] ];
END;
ENDCASE => exD.SysBug[];
ERROR;-- to satisfy stupid compiler
END; -- of PutCharInBitmap --


PutStringInBitMap: PROCEDURE [x: ScreenXCoord, y: ScreenYCoord, s: STRING,
face: FaceType] RETURNS [newRightX: ScreenXCoord] =
-- Puts all characters of s into the bitmap, starting at x, using face.
-- Note: s should not contain any TAB’s.
BEGIN
i, bitmapX, bitmapY: CARDINAL;
char: CHARACTER;
offsetPtr: POINTER;
charFontPtr: CharFontPtr;

SELECT face FROM
plainFace =>
BEGIN
bitmapX ← x - dsD.xOrigin;
bitmapY ← y - dsD.yOrigin;
FOR i IN [0 .. s.length) DO
IF (char ← s[i]) > LAST[LegalCharacters] THEN
char ← Inline.BITAND[char, ovD.CharMask];
SELECT char FROM
Ascii.SP, Ascii.CR => bitmapX ← bitmapX + 5;
Ascii.TAB =>
bitmapX ← GetCharRightX[char, bitmapX + dsD.xOrigin] - dsD.xOrigin;
ENDCASE =>
BEGIN
offsetPtr ← disC.mcFont + LOOPHOLE[char, CARDINAL];
charFontPtr ← offsetPtr + offsetPtr↑;
bitmapX ← (charBbtPtr.dlx ← bitmapX) + (charBbtPtr.dw ← charFontPtr.width);
charBbtPtr.dty ← bitmapY + charFontPtr.ySkip;
charBbtPtr.dh ← charFontPtr.height;
IF charBbtPtr.ptrs = short THEN charBbtPtr.sbca ← charFontPtr-charFontPtr.height
ELSE charBbtPtr.slbca ← charFontPtr-charFontPtr.height;
BitBlt[charBbtPtr];
END;
ENDLOOP;
newRightX ← bitmapX + dsD.xOrigin;
END;
boldFace =>
BEGIN
newRightX ← x;
FOR i IN [0 .. s.length) DO
newRightX ← PutCharInBitMap[s[i], newRightX, y, boldFace];
ENDLOOP;
END;
italicFace =>
BEGIN
newRightX ← PutStringInBitMap[x, y, s, plainFace];
newRightX ← newRightX + 3; -- Bits occupied by slant of italic.
ItalicizeRectangle[x, newRightX, y, dsD.lineHeight];
END;
ENDCASE;
END; -- of PutStringInBitMap --


GetStaticCharWidth: PROCEDURE [char: CHARACTER] RETURNS [CARDINAL] =
-- Returns the width of char in bit positions. Char is always masked to 7 bits.
BEGIN
offsetPtr: POINTER;
charFontPtr: CharFontPtr;
char ← Inline.BITAND[char, ovD.CharMask];
offsetPtr ← disC.mcFont + LOOPHOLE[char, CARDINAL];
charFontPtr ← offsetPtr + offsetPtr↑;
RETURN[charFontPtr.width]
END; -- of GetStaticCharWidth --


GetCharRightX: PROC [char: CHARACTER, leftX: ScreenXCoord]
RETURNS [rightX: ScreenXCoord] =
-- Given a char positioned at leftX, returns its rightX. Char is
-- always masked to 7 bits. Tab widths may vary depending on
-- leftX.
BEGIN
offsetPtr: POINTER;
charFontPtr: CharFontPtr;
char ← Inline.BITAND[char, ovD.CharMask];
IF char = Ascii.TAB THEN
RETURN[(((leftX + 5 - dsD.xOrigin) / tabWidth) + 1) * tabWidth + dsD.xOrigin];
offsetPtr ← disC.mcFont + LOOPHOLE[char, CARDINAL];
charFontPtr ← offsetPtr + offsetPtr↑;
RETURN[leftX + charFontPtr.width];
END; -- of GetCharRightX --


GetVisibleCharWidth: PROCEDURE [char: CHARACTER] RETURNS [CARDINAL] =
-- Returns the width of char in bit positions. Widths of visible tab and CR are considered.
BEGIN
offsetPtr: POINTER;
charFontPtr: CharFontPtr;
IF char > LAST[LegalCharacters] THEN char ← 0C;
offsetPtr ← disC.mcFont + LOOPHOLE[char, CARDINAL];
charFontPtr ← offsetPtr + offsetPtr↑;
RETURN[charFontPtr.width]
END; -- of GetVisibleCharWidth --


GetStringWidth: PROCEDURE [s: STRING, face: FaceType] RETURNS [width: CARDINAL] =
-- Adds character widths for an entire string; returns the sum.
BEGIN
i: CARDINAL;
width ← 0;
FOR i IN [0 .. s.length) DO
width ← width + GetStaticCharWidth[s[i]];
ENDLOOP;
-- Bold face is one raster point wider per character --
IF face = boldFace THEN width ← width + s.length;
-- Italic face has lineHeight/3 -1 extra raster points --
IF face = italicFace THEN width ← width + 3;
END; -- of GetStringWidth --


GetCharProperty: PROCEDURE [char: CHARACTER, property: CharProperty]
RETURNS [BOOLEAN] =
-- Returns TRUE iff char has property.
BEGIN
RETURN[disC.charPropertyTable[Inline.BITAND[char, ovD.CharMask]] = property];
END; -- of GetCharProperty --


GetCharBreakProp: PROCEDURE [char: CHARACTER]
RETURNS [property: CharProperty] =
BEGIN
RETURN[disC.charPropertyTable[Inline.BITAND[char, ovD.CharMask]]];
END; -- of GetCharBreakProp --


-- Region-Oriented Procedures


InvertRectangle: PROCEDURE [left, right: ScreenXCoord, top, bottom: ScreenYCoord,
grayShade: GrayShade ← black] =
-- Inverts all bits in the specified half-open rectangle.
BEGIN
bbtPtr.func ← invert+gray;
DoRectangle[left, right, top, bottom, grayShade];
END; -- of InvertRectangle --


ReplaceRectangle: PROCEDURE [left, right: ScreenXCoord, top, bottom: ScreenYCoord,
grayShade: GrayShade] =
-- Sets the specified half-open rectangle to grayShade.
BEGIN
bbtPtr.func ← replace+gray;
DoRectangle[left, right, top, bottom, grayShade];
END; -- of ReplaceRectangle --


DoRectangle: PRIVATE PROCEDURE [left, right: ScreenXCoord, top, bottom: ScreenYCoord,
grayShade: GrayShade] =
BEGIN
bbtPtr.dlx ← left - dsD.xOrigin;
bbtPtr.dty ← top - dsD.yOrigin;
bbtPtr.dw ← right - left;
bbtPtr.dh ← bottom - top;
bbtPtr.gray ← grayShadeArray[grayShade];
BitBlt[bbtPtr]
END; -- of DoRectangle --


SlideRectangleHorizontally: PROCEDURE [left, right: ScreenXCoord,
top, bottom: ScreenYCoord, deltaX: INTEGER] =
-- Slides rectangle horizontally deltaX raster points. Clears vacated area.
BEGIN
-- first copy source to destination --
bbtPtr.func ← replace + source;
bbtPtr.dlx ← left - dsD.xOrigin + deltaX;
bbtPtr.dty ← top - dsD.yOrigin;
bbtPtr.dw ← right - left;
bbtPtr.dh ← bottom - top;
bbtPtr.slx ← left - dsD.xOrigin;
bbtPtr.sty ← top - dsD.yOrigin;
BitBlt[bbtPtr];
-- next, clear vacated region --
IF deltaX > 0 THEN ClearRectangle[left, left + deltaX, top, bottom]
ELSE ClearRectangle[right + deltaX, right, top, bottom];
END; -- of SlideRectangleHorizontally --


ItalicizeRectangle: PROCEDURE [left, right: ScreenXCoord, top: ScreenYCoord,
lineHeight: CARDINAL] =
-- Slants bitmap from [left, right - lineHeight/3 +1, top, top + lineHeight] to
-- [left, right, top, top + lineHeight].
BEGIN
y: ScreenYCoord;
slideX: CARDINAL;
slideX ← lineHeight / 3 -1;
IF left + slideX > right THEN RETURN;
FOR y ← top, y+3 UNTIL y >= LOOPHOLE[top + lineHeight - 3, CARDINAL] DO
SlideRectangleHorizontally[left, right - slideX, y, y+3, slideX];
slideX ← slideX - 1;
ENDLOOP;
END; -- of ItalicizeRectangle --


SlideFullWidthRectangleVertically: PROCEDURE [top, bottom: ScreenYCoord,
newTop: ScreenYCoord] =
-- (Formerly called MoveY) The display in the rectangle [top .. bottom) is moved so that
-- its new top is at newTop. The prior contents of the target region is overwritten. All
-- intervening and vacated areas are cleared.
BEGIN
IF top < bottom THEN MoveFullWidthRectangleVertically[top, bottom, newTop];
IF top < newTop THEN ClearRectangle[xOrigin, xOrigin + 16 * bmWidth, top, newTop]
ELSE ClearRectangle[xOrigin, xOrigin + 16 * bmWidth, newTop + bottom - top, bottom];
END; -- of SlideFullWidthRectangleVertically --


MoveFullWidthRectangleVertically: PROCEDURE [top, bottom: ScreenYCoord,
newTop: ScreenYCoord] =
-- The display in the rectangle [top .. bottom) is moved so that its new top is at newTop.
-- The prior contents of the target region is overwritten. All intervening and vacated
-- areas are not cleared.
BEGIN
IF top = bottom THEN RETURN;
bbtPtr.func ← replace + source;
bbtPtr.dlx ← 0;
bbtPtr.dty ← newTop - dsD.yOrigin;
bbtPtr.dw ← dsD.bmWidth * 16;
bbtPtr.dh ← bottom - top;
bbtPtr.slx ← 0;
bbtPtr.sty ← top - dsD.yOrigin;
BitBlt[bbtPtr];
END; -- of MoveFullWidthRectangleVertically --


-- Picture Oriented Procedures


SetCursor: PROCEDURE [shape: CursorShape] =
-- Sets the cursor to the specified shape. The hardware cursor point is maintained at the
-- current position.
BEGIN
cursorBM↑ ← cursorTable[shape].bitMap;
currentCursorShape ← shape;
END; -- of SetCursor --


ChangeCursor: PROCEDURE [shape: CursorShape] =
-- Changes the cursor to the specified shape. The sensitive point is maintained at the
-- current position.
BEGIN
hotOld: HotSpot = cursorTable[currentCursorShape].hotSpot;
hotNew: HotSpot = cursorTable[shape].hotSpot;
changeX: INTEGER ← hotOld.x - hotNew.x;
changeY: INTEGER ← hotOld.y - hotNew.y;
SetCursor[shape];
cursorX↑ ← cursorX↑ + changeX;
mouseX↑ ← mouseX↑ + changeX;
cursorY↑ ← cursorY↑ + changeY;
mouseY↑ ← mouseY↑ + changeY;
END; -- of ChangeCursor --


GetCursor: PROCEDURE RETURNS [shape: CursorShape, sensitiveX, sensitiveY: INTEGER] =
-- Returns the current cursor shape.
BEGIN
hotSpot: HotSpot = cursorTable[currentCursorShape].hotSpot;
RETURN[currentCursorShape, hotSpot.x, hotSpot.y];
END; -- of GetCursor --


GetPictureParameters: PROCEDURE [picture: PictureClass]
RETURNS [width, height: CARDINAL] =
-- Returns width and height of the picture bitmap.
BEGIN
dimensions: Dimensions = pictureTable[picture].dimensions;
RETURN[dimensions.width, dimensions.height];
END; -- of GetPictureParameters --


PaintPicture: PROCEDURE [x: ScreenXCoord, y: ScreenYCoord,
picture: PictureClass, function: BitBltFunction] =
-- Sets the cursor to the specified shape.
BEGIN
pictureBM: PictureBitMap;
width, height: [0 .. 377B];
IF x < dsD.xOrigin THEN
BEGIN
IF picture = caret THEN picture ← leftEdgeCaret;
pictureBbtPtr.slx ← dsD.xOrigin - x;
END
ELSE pictureBbtPtr.slx ← 0;
pictureBM ← pictureTable[picture].bitmap;
[width, height] ← GetPictureParameters[picture];
pictureBbtPtr.dw ← width - pictureBbtPtr.slx;
pictureBbtPtr.dlx ← x + pictureBbtPtr.slx - dsD.xOrigin;
pictureBbtPtr.func ← function + source;
pictureBbtPtr.dty ← y - dsD.yOrigin;
pictureBbtPtr.dh ← height;
IF pictureBbtPtr.ptrs = short THEN pictureBbtPtr.sbca ← @pictureBM
ELSE pictureBbtPtr.slbca ← @pictureBM;
BitBlt[pictureBbtPtr];
END; -- of PaintPicture --


END. -- of Display --