-- Pupwatch: non-scrolling display

-- [Indigo]<Grapevine>PupWatch>FunnyDisplay.mesa

-- Andrew Birrell  20-Nov-81 15:30:15

DIRECTORY
AltoDisplay,
Ascii		USING[ CR, SP ],
BitBltDefs,
FrameDefs	USING[ GlobalFrame, IsBound, SwapInCode ],
ImageDefs	USING[ AddCleanupProcedure, CleanupItem, CleanupMask,
		       CleanupProcedure ],
LookerDefs	USING[ PupwatchFont ],
MiscDefs	USING[ DestroyFakeModule ],
SegmentDefs	USING[ FileSegmentHandle, SegmentAddress, SwapIn ],
SystemDefs;

FunnyDisplay: MONITOR
   IMPORTS BitBltDefs, FrameDefs, ImageDefs, LookerDefs, MiscDefs,
           SegmentDefs, SystemDefs
   EXPORTS LookerDefs =

BEGIN

-- Layout of an "AL" font --

Font: 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).
    FCDptrs: FontArray,     -- array of self-relative pointers to
                            -- FCD's. Indexed by char value.
    extFCDptrs: FontArray   -- array of self-relative pointers to
                            -- FCD's for extentions. As large an
                            -- array as needed.
    ];

FontArray: TYPE = ARRAY CHARACTER OF CARDINAL;

FCDptr: TYPE = POINTER TO FCD;

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
    ];

GetFont: PROC RETURNS[POINTER TO Font] =
   BEGIN
   IF FrameDefs.IsBound[MiscDefs.DestroyFakeModule]
   THEN BEGIN
        seg: SegmentDefs.FileSegmentHandle;
        offset: CARDINAL;
        [seg,offset] _ 
           MiscDefs.DestroyFakeModule[LOOPHOLE[LookerDefs.PupwatchFont]];
        SegmentDefs.SwapIn[seg];
        RETURN[SegmentDefs.SegmentAddress[seg]+offset]
        END
   ELSE BEGIN -- running in boot file? --
        FrameDefs.SwapInCode[LOOPHOLE[LookerDefs.PupwatchFont]];
        RETURN[ -- assume it came into the MDS! --
          FrameDefs.GlobalFrame[LookerDefs.PupwatchFont].code.shortbase]
        END
   END;

myFont: POINTER TO Font = GetFont[];

fontdesc: POINTER TO FontArray = @myFont.FCDptrs;


-- Cursor and mouse --

CursorData: TYPE = ARRAY [0..16) OF WORD;
cursor:  POINTER TO CursorData = LOOPHOLE[431B];
mouseX:  POINTER TO CARDINAL = LOOPHOLE[424B];
mouseY:  POINTER TO CARDINAL = LOOPHOLE[425B];
cursorX: POINTER TO CARDINAL = LOOPHOLE[426B];
cursorY: POINTER TO CARDINAL = LOOPHOLE[427B];



-- Screen layout --

top:    CARDINAL = 32; --unused screen at top--
bottom: CARDINAL = 32; --unused screen at bottom--
margin: CARDINAL = 4; --bitmap-relative margin, sides and bottom--

wPerLine:   CARDINAL = 2*( 11 );
bPerLine:   CARDINAL = wPerLine * 16;
scanLines:  CARDINAL = (AltoDisplay.MaxScanLines-top-bottom)/2*2;
lineHeight: CARDINAL = myFont.maxHeight;
nLines:     CARDINAL = (scanLines-2*margin)/lineHeight;
topY:       CARDINAL = 1+lineHeight+margin; -- top of typescript --

bitmapWords: CARDINAL = wPerLine * scanLines;
myBitmap:    POINTER = EvenAlloc[bitmapWords];

myDCB: AltoDisplay.DCBHandle =  EvenAlloc[SIZE[AltoDisplay.DCB]];
padDCB: AltoDisplay.DCBHandle = EvenAlloc[SIZE[AltoDisplay.DCB]];

whiteBBT: BitBltDefs.BBptr = EvenAlloc[SIZE[BitBltDefs.BBTable]];
blackBBT: BitBltDefs.BBptr = EvenAlloc[SIZE[BitBltDefs.BBTable]];

PaintRectangle: PROC[x,y: CARDINAL, w,h: CARDINAL,
                     color: {white, black, invert}] =
   BEGIN
   bbt: POINTER TO BitBltDefs.BBTable =
                              IF color = white THEN whiteBBT ELSE blackBBT;
   bbt.dlx _ x; bbt.dty _ y; bbt.dw _ w; bbt.dh _ h;
   bbt.function _ IF color = invert THEN invert ELSE replace;
   BitBltDefs.BITBLT[ bbt ];
   END;



-- Access to Font: character painting and width --

bbtSpace: BitBltDefs.BBTableSpace;

InitBBTSpace: PROC RETURNS[bbt:BitBltDefs.BBptr] =
   BEGIN
   bbt _ BitBltDefs.AlignedBBTable[@bbtSpace];
   bbt^ _ [sourcetype: block, function: paint, dbca: myBitmap,
           dbmr: wPerLine,
	   sbmr: 1, slx: 0, sty: 0];
   END;

bbt: BitBltDefs.BBptr = InitBBTSpace[]; -- BBT for character painting --

bmState: RECORD[x, y: CARDINAL] _ [x: 0, y: 0 ]; -- pos for next char --

PaintChar: PROCEDURE[char: CHARACTER] = INLINE
   BEGIN
   -- extensions are not supported!
   cw: FCDptr = LOOPHOLE[@fontdesc[char]+fontdesc[char]];
   bbt.sbca _ cw - (bbt.dh _ cw.displacement);
   bbt.dty _ bmState.y + cw.height;
   bmState.x _ (bbt.dlx _ bmState.x) + (bbt.dw _ cw.widthORext);
   BitBltDefs.BITBLT[bbt];
   END;

CharWidth: PROCEDURE[char: CHARACTER] RETURNS[CARDINAL] =
   BEGIN
   -- extensions are not supported!
   cw: FCDptr = LOOPHOLE[@fontdesc[char]+fontdesc[char]];
   RETURN[cw.widthORext]
   END;

EvenAlloc: PROC[words: CARDINAL] RETURNS[res: POINTER] =
   BEGIN
   mem: POINTER = SystemDefs.AllocateHeapNode[words+1];
   res _ LOOPHOLE[ ((LOOPHOLE[mem,CARDINAL]+1)/2)*2, POINTER ];
   END;

charWidth: ARRAY CHARACTER OF CARDINAL;

GetLength: PUBLIC PROC[s: STRING] RETURNS[ length: CARDINAL ] =
   BEGIN
   length _ 0;
   FOR index: CARDINAL IN [0..s.length)
   DO length _ length + charWidth[s[index]] ENDLOOP;
   END;

SetPos: PUBLIC ENTRY PROC[pos: CARDINAL] =
   -- set to raster position relative to start of current line --
   { bmState.x _ margin + pos };

Clear: PUBLIC ENTRY PROC =
   -- Whiten text area of display, and reset next character position --
   BEGIN
   bmState.x _ margin; bmState.y _ topY;
   PaintRectangle[x: 1, y: lineHeight+2, w: bPerLine-2,
                  h: scanLines - (lineHeight+2) - 1, color: white];
   END;



-- Publictext displaying procedures --

WriteChar: PUBLIC PROC[c: CHARACTER] =
   BEGIN
   IF c < Ascii.SP
   THEN BEGIN
        IF c = Ascii.CR
        THEN BEGIN
             bmState.x _ margin; bmState.y _ bmState.y + lineHeight;
             IF bmState.y >= nLines * lineHeight THEN bmState.y _ topY;
             BEGIN
                nextY: CARDINAL _ bmState.y + lineHeight;
                IF nextY >= nLines * lineHeight THEN nextY _ topY;
                PaintRectangle[x: margin, y: nextY,
                               w: bPerLine-2*margin, h: lineHeight,
                               color: white];
             END;
             RETURN
             END
        ELSE c _ '?;
        END;
   IF bmState.x + charWidth[c] <= bPerLine-margin
   THEN PaintChar[c]
   ELSE bmState.x _ bPerLine-margin;
   END;

WriteMultiple: PUBLIC PROC[desc: DESCRIPTOR FOR PACKED ARRAY OF CHARACTER]=
   BEGIN
   FOR i: CARDINAL IN [0..LENGTH[desc])
   DO c: CHARACTER _ desc[i];
      IF c < Ascii.SP THEN c _ '?; -- including CR --
      IF bmState.x + charWidth[c] <= bPerLine-margin
      THEN PaintChar[c]
      ELSE { bmState.x _ bPerLine-margin; EXIT };
   ENDLOOP;
   END;

EraseChar: PUBLIC ENTRY PROC[c: CHARACTER] =
   BEGIN
   IF c < Ascii.SP
   THEN BEGIN
        IF c = Ascii.CR THEN RETURN ELSE c _ '?;
        END;
   bmState.x _ bmState.x - charWidth[c];
   PaintRectangle[x: bmState.x, y: bmState.y,
                  w: charWidth[c], h: lineHeight,
                  color: white];
   END;

WriteTitle: PUBLIC PROC[s: STRING] =
   BEGIN
   oldY: CARDINAL = bmState.y;
   oldX: CARDINAL = bmState.x;
   bmState.y _ 1;
   bmState.x _ margin;
   PaintRectangle[x:margin, y: 1,
                  w: bPerLine-2*margin, h: lineHeight,
                  color: white];
   FOR index: CARDINAL IN [0..s.length) DO WriteChar[s[index]]; ENDLOOP;
   PaintRectangle[x:margin, y: 1,
                  w: bPerLine-2*margin, h: lineHeight,
                  color: invert];
   bmState.y _ oldY; bmState.x _ oldX;
   END;



-- Cleanup mechanism --

cleanupDisplay: ImageDefs.CleanupItem _ [link:, proc: Cleanup,
   mask: ImageDefs.CleanupMask[Finish] +
         ImageDefs.CleanupMask[Abort] +
         ImageDefs.CleanupMask[Save] +
         ImageDefs.CleanupMask[Restore] +
         ImageDefs.CleanupMask[Checkpoint] +
         ImageDefs.CleanupMask[Restart] +
         ImageDefs.CleanupMask[Continue] +
         ImageDefs.CleanupMask[InLd] +
         ImageDefs.CleanupMask[OutLd] ];

Cleanup: ImageDefs.CleanupProcedure =
   BEGIN
   SELECT why FROM
     Finish, Abort, Save, Checkpoint, OutLd =>
       BEGIN
       realTime: POINTER TO CARDINAL = LOOPHOLE[430B];
       delayStart: CARDINAL = realTime^;
       AltoDisplay.DCBchainHead^ _ NIL;
       UNTIL realTime^ - delayStart > 2 DO NULL ENDLOOP;
       END;
     Restore, Restart, Continue, InLd =>
       AltoDisplay.DCBchainHead^ _ padDCB;
   ENDCASE;
   END;



-- Initialisation --

cursor^ _ [      0,    400B,   4440B,  44444B,
            23710B,  17361B, 130032B,  61614B,
           143706B, 143706B,  61614B,  30030B,
            17360B,   3700B,       0,       0 ];

mouseX^ _ cursorX^ _ 16--indent-- + bPerLine/2 - 8;
mouseY^ _ cursorY^ _ top - 16;

padDCB^ _ [next: myDCB,
         resolution: high,
         background: white,
         indenting:  0,
         width:      0,
         bitmap:     NIL,
         height:     top/2];

myDCB^ _ [next: NIL,
         resolution: high,
         background: white,
         indenting:  1,
         width:      wPerLine,
         bitmap:     myBitmap,
         height:     scanLines/2];

whiteBBT^ _ [
      pad: 0,
      sourcealt: FALSE,
      destalt: FALSE,
      sourcetype: gray,
      function: ,
      unused: 0,
      dbca: myBitmap,
      dbmr: wPerLine,
      dlx:, dty:, dw:, dh:,
      sbca:, sbmr:, slx:, sty:,
      gray0: 0,
      gray1: 0,
      gray2: 0,
      gray3: 0 ];

blackBBT^ _ [
      pad: 0,
      sourcealt: FALSE,
      destalt: FALSE,
      sourcetype: gray,
      function: ,
      unused: 0,
      dbca: myBitmap,
      dbmr: wPerLine,
      dlx:, dty:, dw:, dh:,
      sbca:, sbmr:, slx:, sty:,
      gray0: 177777B,
      gray1: 177777B,
      gray2: 177777B,
      gray3: 177777B ];

-- Paint black border --
PaintRectangle[x: 0, y: 0, w: bPerLine, h: scanLines, color: black];

-- Initialise text area --
Clear[];

FOR c: CHARACTER IN CHARACTER
DO charWidth[c] _ CharWidth[c]; ENDLOOP;

-- Turn on screen --
IF FrameDefs.IsBound[ImageDefs.AddCleanupProcedure]
THEN ImageDefs.AddCleanupProcedure[@cleanupDisplay];
AltoDisplay.DCBchainHead^ _ padDCB;

END.