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

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 --z19932(635)\f1