-- NXDisplay.mesa; edited by Gobbel; March 11, 1981  5:44 PM
-- Last modified October 18, 1983  3:22 PM by Taft

DIRECTORY
  AltoDefs USING [PageSize, wordlength],
  AltoDisplay USING [DCB, DCBchainHead, DCBHandle, DCBnil],
  BitBltDefs USING [BBptr, BBTable, BITBLT],
  DisplayDefs USING [Background],
  FontDefs USING [BitmapState, FontHandle],
  FrameDefs USING [GlobalFrame, SwapInCode],
  MMOps USING [MMFont],
  ImageDefs USING [
    AddCleanupProcedure, CleanupItem, CleanupMask, CleanupProcedure],
  InlineDefs USING [BITAND, BITOR, BITSHIFT, BITXOR, COPY],
  NXDefs USING [debug],
  ProcessDefs USING [MsecToTicks, SetTimeout],
  SegmentDefs USING [
    DataSegmentAddress, DataSegmentHandle, DefaultBase, DeleteDataSegment,
    NewDataSegment],
  SystemDefs USING [AllocateResidentPages],
  StreamDefs USING [DisplayHandle, StreamError, StreamHandle, StreamObject];

NXDisplay: MONITOR
  IMPORTS BitBltDefs, FrameDefs, ImageDefs, InlineDefs, NXDefs,
    ProcessDefs, SegmentDefs, SystemDefs, StreamDefs, MMOps
  EXPORTS DisplayDefs, NXDefs, StreamDefs
  SHARES StreamDefs =
  BEGIN OPEN AltoDisplay;

  heraldStr: STRING = " XEROX Cedar Net Executive 6.0c "L;

  displayLines: PUBLIC CARDINAL;

  BitsPerWord: CARDINAL = AltoDefs.wordlength;
  BitmapState: TYPE = FontDefs.BitmapState;
  StreamHandle: TYPE = StreamDefs.StreamHandle;
  OrderedPOINTER: TYPE = ORDERED POINTER;
  OrderedNIL: OrderedPOINTER = LOOPHOLE[NIL];

  TAB: CHARACTER = 11C;
  CR: CHARACTER = 15C;
  NUL: CHARACTER = 0C;
  SP: CHARACTER = ' ;

  LeftIndent: CARDINAL;
  LeftMargin: CARDINAL;
  RightMargin: CARDINAL;
  WordsPerLine: CARDINAL;
  MaxWordsPerLine: CARDINAL = 38;

  hostPos: CARDINAL = 18;
  timePos: CARDINAL = 45;
  statusPos: CARDINAL = 3;

  DSP: Display StreamDefs.StreamObject ← StreamDefs.StreamObject [
    reset: ClearDS,
    get: GetNop,
    put: DPutChar,
    putback: PutbackNop,
    endof: EndofNop,
    destroy: DestroyNop,
    link: NIL,
    body: Display[
      clearCurrentLine: ClearCurrentLine, clearLine: CLNop,
      clearChar: ClearDisplayChar, type: 0, data: NIL]];

  systemDS: StreamDefs.DisplayHandle = @DSP;

  displayOn: BOOLEAN ← FALSE;
  lineHeight: CARDINAL;
  TABindex: CARDINAL;
  TABs: ARRAY [0..10) OF CARDINAL;
  bmSegment: SegmentDefs.DataSegmentHandle;
  bmFirst, bmTail, bmNext, bmLastLine: OrderedPOINTER;
  lastLineSize: CARDINAL ← 0;
  spacerDCB, clockSpareDCB, clockDCB, hostDCB, dummyDCB: DCBHandle;
  firstDCB, lastDCB, currentDCB: DCBHandle ← DCBnil;


  -- layout of bitmap is:
  --    DCBs: ARRAY [firstDCB..lastDCB] OF DCB,
  --    bmFirst: ARRAY OF UNSPECIFIED,
  --    bmLastLine: ARRAY [0..lineHeight*WordsPerLine) OF UNSPECIFIED,
  -- bmNext points to next word to allocate,
  -- bmTail points to oldest allocated bitmap.

  bmState: FontDefs.BitmapState;
  tabWidth: CARDINAL;

  -- Typescript data
  GetDefaultDisplayStream: PUBLIC PROC RETURNS[StreamDefs.DisplayHandle] =
    {RETURN[systemDS]};

  NotEnoughSpaceForDisplay: PUBLIC SIGNAL = CODE;

  SetupBitmap: PROC [bitmap: POINTER, nLines, nWords: CARDINAL] =
    BEGIN
    dcb: DCBHandle;
    WHILE nLines*SIZE[DCB] + lastLineSize > nWords DO
      IF nLines > 1 THEN nLines ← nLines - 1
      ELSE
	BEGIN
	IF WordsPerLine = 2 THEN ERROR NotEnoughSpaceForDisplay;
	WordsPerLine ← WordsPerLine - 2;
	RightMargin ← WordsPerLine * BitsPerWord;
	lastLineSize ← lineHeight*WordsPerLine;
	END;
      ENDLOOP;
    currentLines ← nLines;
    firstDCB ← dcb ← bitmap;
    THROUGH [0..nLines) DO
      dcb.next ← dcb + SIZE[DCB];
      dcb.height ← lineHeight/2;
      dcb ← dcb.next;
      ENDLOOP;
    lastDCB ← dcb-SIZE[DCB];
    lastDCB.next ← DCBnil;
    bmFirst ← LOOPHOLE[dcb, OrderedPOINTER];
    bmLastLine ← LOOPHOLE[bitmap+nWords-lastLineSize, OrderedPOINTER];
    bmState ← [origin: bmLastLine, wordsPerLine: WordsPerLine, x:, y:0];
    END;

  currentPages, currentLines, currentDummySize: CARDINAL;

  DisplayOff: PUBLIC PROC [color: DisplayDefs.Background] =
    BEGIN
    IF ~displayOn THEN RETURN;
    SetSystemDisplaySize[0,0];
    spacerDCB.background ← color;
    END;

  DisplayOn: PUBLIC PROC =
    BEGIN
    IF displayOn THEN RETURN;
    spacerDCB.background ← white;
    SetDummyDisplaySize[currentDummySize];
    SetSystemDisplaySize[currentLines, currentPages];
    END;

  SetSystemDisplaySize: PUBLIC PROC [nTextLines, nPages: CARDINAL] =
    BEGIN OPEN SegmentDefs;
    IF displayOn THEN
      BEGIN
      firstDCB.next ← lastDCB.next;
      spacerDCB.next ← NIL;
      firstDCB ← lastDCB ← currentDCB ← DCBnil;
      DeleteDataSegment[bmSegment];
      blinkOn ← displayOn ← FALSE;
      END;
    IF nPages = 0 THEN RETURN;
    currentPages ← nPages;  -- for Display Off/On
    currentLines ← nTextLines;  -- for Display Off/On
    bmSegment ← NewDataSegment[DefaultBase, nPages];
    SetupBitmap[
      DataSegmentAddress[bmSegment], nTextLines, nPages*AltoDefs.PageSize];
    displayOn ← TRUE;
    ClearDS[systemDS];
    spacerDCB.next ← firstDCB;
    RETURN
    END;

  SetSystemDisplayWidth: PUBLIC PROC [indent, width: CARDINAL] =
    BEGIN
    max: CARDINAL;
    LeftMargin ← indent MOD BitsPerWord;
    LeftIndent ← indent / BitsPerWord;
    max ← Even[MaxWordsPerLine-1-LeftIndent];
    WordsPerLine ← MIN[Even[width/BitsPerWord],max];
    RightMargin ← WordsPerLine * BitsPerWord;
    IF displayOn THEN SetSystemDisplaySize[currentLines, currentPages];
    RETURN
    END;

  FillWithDashes: PROC [dcb: DCBHandle] = 
    BEGIN
    bmState: BitmapState ← [dcb.bitmap, WordsPerLine, 0, 0];
    THROUGH [0..RightMargin/CharWidth['X]) DO
      PaintChar['-, @bmState] ENDLOOP;
    END;

  SetupHeader: PROC =
    BEGIN
    lineSize: CARDINAL = lineHeight*WordsPerLine;
    heraldPos: CARDINAL = 3;
    headerBitmap: POINTER ←
      SystemDefs.AllocateResidentPages[(3*lineSize+255)/256];
    charWidth: CARDINAL ← CharWidth['X];
    bmState: BitmapState ← [NIL, WordsPerLine, 0, 0];
    headerBitmap↑ ← 0;
    InlineDefs.COPY[
      from: headerBitmap, nwords: 3*lineSize-1, to: headerBitmap+1];
    clockDCB.bitmap ← headerBitmap;
    clockSpareDCB.bitmap ← clockDCB.bitmap+lineSize;
    hostDCB.bitmap ← clockSpareDCB.bitmap+lineSize;
    clockDCB.next ← clockSpareDCB.next ← hostDCB;
    clockDCB.height ← clockSpareDCB.height ← hostDCB.height ← lineHeight/2;
    clockDCB.width ← clockSpareDCB.width ← hostDCB.width ← WordsPerLine;
    clockDCB.indenting ← clockSpareDCB.indenting
      ← hostDCB.indenting ← LeftIndent;
    spacerDCB.height ← 20; hostDCB.next ← spacerDCB;
    FillWithDashes[clockDCB]; FillWithDashes[hostDCB];
    bmState.origin ← clockDCB.bitmap;
    bmState.x ← heraldPos*charWidth;
    SetString[heraldStr, @bmState];
    bmState.x ← heraldPos*charWidth+1; PaintString[" XEROX"L, @bmState];
    bmState.x ← timePos*charWidth;
    SetString[" Date and time unknown "L, @bmState];
    InlineDefs.COPY[clockDCB.bitmap, lineSize, clockSpareDCB.bitmap];
    dummyDCB.next ← clockDCB;
    END;

  SetIntoTime: PUBLIC PROC [str: STRING] =
    BEGIN
    bmState: BitmapState ← [clockSpareDCB.bitmap, WordsPerLine, 0, 0];
    tempDCB: DCBHandle;
    IF NXDefs.debug THEN RETURN;
    bmState.x ← timePos*CharWidth['X];
    SetString[str, @bmState];
    dummyDCB.next ← clockSpareDCB;
    tempDCB ← clockDCB; clockDCB ← clockSpareDCB; clockSpareDCB ← tempDCB;
    END;

  SetIntoHost: PUBLIC PROC [str: STRING] =
    BEGIN
    bmState: BitmapState ← [hostDCB.bitmap, WordsPerLine, 0, 0];
    IF NXDefs.debug THEN RETURN;
    bmState.x ← hostPos*CharWidth['X];
    SetString[str, @bmState];
    END;

  SetIntoStatus: PUBLIC PROC [str: STRING] =
    BEGIN
    bmState: BitmapState ← [hostDCB.bitmap, WordsPerLine, 0, 0];
    IF NXDefs.debug THEN RETURN;
    bmState.x ← statusPos*CharWidth['X];
    SetString[str, @bmState];
    END;

  SetDummyDisplaySize: PUBLIC PROC [nScanLines: CARDINAL] =
    BEGIN
    currentDummySize ← nScanLines;  -- for Display Off/On
    IF nScanLines/2 = dummyDCB.height THEN RETURN;
    IF dummyDCB.height # 0 THEN DCBchainHead↑ ← DCBnil;
    dummyDCB.height ← nScanLines/2;
    IF dummyDCB.height # 0 THEN DCBchainHead↑ ← dummyDCB;
    RETURN
    END;

  ClearDS: ENTRY PROC [stream: StreamHandle] =
    BEGIN
    dcb: DCBHandle;
    IF stream # systemDS THEN
      SIGNAL StreamDefs.StreamError[stream,StreamType];
    IF ~displayOn THEN RETURN;
    FOR dcb ← firstDCB, dcb.next DO
      dcb.resolution ← high;
      dcb.background ← white;
      dcb.indenting ← dcb.width ← 0;
      dcb.bitmap ← bmLastLine;
      IF dcb = lastDCB THEN EXIT;
      ENDLOOP;
    bmNext ← bmFirst;
    bmTail ← bmLastLine;
    currentDCB ← firstDCB;
    ClearCurrentLineInternal[stream];
    RETURN
    END;

  -- back up n characters
  Erase: PUBLIC PROC [n: CARDINAL, str: STRING] =
    BEGIN
    IF NXDefs.debug THEN RETURN;
    THROUGH [0..n) DO
      IF str.length=0 THEN RETURN;
      str.length ← str.length-1;
      ClearDisplayChar[systemDS, str[str.length]]
      ENDLOOP;
    END;

  ResetTo: PUBLIC ENTRY PROC [n: CARDINAL] =
    BEGIN
    oldX: CARDINAL = bmState.x;
    charWidth: CARDINAL = CharWidth['X];
    i: CARDINAL;
    IF NXDefs.debug THEN RETURN;
    IF blinkOn THEN [] ← BlinkCursorInternal[];
    bmState.x ← n*charWidth+LeftMargin;
    FOR i IN [n..oldX/charWidth) DO
      BlankChar[@bmState];
      ENDLOOP;
    bmState.x ← n*charWidth+LeftMargin;
    END;

  ClearLine: PUBLIC PROC = {IF ~NXDefs.debug THEN ClearCurrentLine[systemDS]};

  ClearCurrentLine: PUBLIC ENTRY PROC [stream: StreamHandle] =
    {ClearCurrentLineInternal[stream]};

  ClearCurrentLineInternal: INTERNAL PROC [stream: StreamHandle] =
    BEGIN
    IF stream # systemDS THEN
      SIGNAL StreamDefs.StreamError[stream,StreamType];
    IF ~displayOn THEN RETURN;
    bmLastLine↑ ← 0;
    InlineDefs.COPY[
      from: bmLastLine, to: bmLastLine+1, nwords: lastLineSize-1];
    currentDCB.indenting ← LeftIndent;
    currentDCB.bitmap ← bmLastLine;
    currentDCB.width ← WordsPerLine;
    bmState.x ← LeftMargin;
    blinkOn ← FALSE;
    TABindex ← 0;
    RETURN
    END;

  CLNop: PUBLIC PROC [stream: StreamHandle, line: CARDINAL] = {};

  Scroll: INTERNAL PROC [char: CHARACTER] =
    BEGIN OPEN BitBltDefs;
    bbt: ARRAY [0..SIZE[BBTable]] OF WORD;
    bbp: BBptr ← Even[BASE[bbt]];
    pos: CARDINAL;
    SELECT char FROM
      CR => NULL;
      TAB =>
	BEGIN
	TABs[TABindex] ← bmState.x;
	TABindex ← TABindex + 1;
	pos ← (LOOPHOLE[bmState.x-LeftMargin,CARDINAL]/tabWidth+1)
	  * tabWidth+LeftMargin;
	IF pos < RightMargin THEN bmState.x ← pos
	ELSE DPutCharInternal[systemDS, SP];
	RETURN
	END;
      NUL => RETURN;
      ENDCASE =>
	IF char < 40C THEN
	  BEGIN
	  DPutCharInternal[systemDS, '↑];
	  DPutCharInternal[systemDS,
	    LOOPHOLE[LOOPHOLE[char,CARDINAL]+100B,CHARACTER]];
	  RETURN 
	  END;
    -- Do the scroll, assuming last (current) line is in bmLastLine.
    -- scroll all others by BLTing their DCBs.  move old last line to
    -- new bitmap and free bmLastLine for reuse.
    UNTIL Compact[currentDCB,bmState.x] DO
      IF ~DeleteTopLine[] THEN RETURN;      -- not enough space
      ENDLOOP;
    IF currentDCB # lastDCB THEN currentDCB ← currentDCB.next
    ELSE
      BEGIN
      IF firstDCB.width # 0 THEN
	[] ← DeleteTopLine[];
      bbp↑ ← [
	pad: 0, 
	sourcealt: FALSE, destalt: FALSE,
	sourcetype: block, function: replace,
	dbca: firstDCB, dbmr: SIZE[DCB],
	dlx: 16, dty: 0,
	dw: 16*(SIZE[DCB]-1), dh: currentLines-1,
	sbca: firstDCB, sbmr: SIZE[DCB],
	slx: 16, sty: 1,
	unused:, gray0:, gray1:, gray2:, gray3:];
      IF firstDCB # lastDCB THEN BITBLT[bbp];
      END;
    ClearCurrentLineInternal[systemDS];
    IF char # CR THEN DPutChar[systemDS, char];
    END;

  DeleteTopLine: PROC RETURNS [BOOLEAN] =
    BEGIN
    dcb: DCBHandle;
    -- find first line with bitmap allocated
    FOR dcb ← firstDCB, dcb.next DO
      IF dcb.width # 0 THEN EXIT;
      IF dcb = lastDCB THEN RETURN[FALSE]; -- found no top line to delete
      ENDLOOP;
    dcb.width ← dcb.indenting ←  0;
    -- find next line with bitmap allocated
    UNTIL dcb = lastDCB DO
      dcb ← dcb.next;
      IF dcb.width # 0 THEN {bmTail ← LOOPHOLE[dcb.bitmap]; EXIT};
      REPEAT FINISHED => -- all linex deleted
	{bmTail ← bmLastLine; bmNext ← bmFirst};
      ENDLOOP;
    RETURN[TRUE];
    END;

  Compact: PROC [dcb: DCBHandle, x: CARDINAL] RETURNS [BOOLEAN] =
    BEGIN
    newWidth: CARDINAL ← (x+15)/16;
    oldWidth: CARDINAL ← dcb.width;
    old: OrderedPOINTER ← LOOPHOLE[dcb.bitmap];
    lineHeight: CARDINAL ← dcb.height*2;
    d: CARDINAL;
    IF x <= LeftMargin THEN d ← 0
    ELSE
      FOR d IN [0..newWidth) DO
	BEGIN
	p: OrderedPOINTER;
	p ← old + d;
	THROUGH [0..lineHeight) DO
	  IF p↑ # 0 THEN GO TO foundit;
	  p ← p + oldWidth;
	  ENDLOOP;
	END;
	REPEAT foundit => NULL;
	ENDLOOP;
    newWidth ← Even[newWidth-d];
    IF newWidth > 0 THEN
      BEGIN OPEN BitBltDefs;
      bbt: ARRAY [0..SIZE[BBTable]] OF WORD;
      bbp: BBptr ← Even[BASE[bbt]];
      new: OrderedPOINTER;
      IF (new ← GetMapSpace[newWidth*lineHeight]) = OrderedNIL THEN
	RETURN[FALSE];
      dcb.width ← 0;
      bbp↑ ← [
	pad: 0,
	sourcealt: FALSE, destalt: FALSE,
	sourcetype: block, function: replace,
	dbca: new, dbmr: newWidth,
	dlx: 0, dty: 0,
	dw: newWidth*16, dh: lineHeight,
	sbca: old, sbmr: oldWidth,
	slx: d*16, sty: 0,
	unused:, gray0:, gray1:, gray2:, gray3:];
      BITBLT[bbp];
      dcb.indenting ← LeftIndent + d;
      dcb.bitmap ← new;
      dcb.width ← newWidth;
      END
    ELSE dcb.indenting ← dcb.width ← 0;
    RETURN [ TRUE ];
    END;

  GetMapSpace: PROC [nwords: [0..77777B]] RETURNS [p: OrderedPOINTER] =
    BEGIN
    DO
      t: INTEGER = bmTail - bmNext;
      IF t < 0 THEN
	IF bmLastLine >= bmNext+nwords THEN EXIT ELSE bmNext ← bmFirst
      ELSE IF t >= nwords THEN EXIT ELSE RETURN[OrderedNIL];
      ENDLOOP;
    p ← bmNext;
    bmNext ← bmNext + nwords;
    RETURN
    END;

  DPutChar: ENTRY PROC [stream: StreamHandle, char: UNSPECIFIED] =
    {DPutCharInternal[stream, char]};

  DPutCharInternal: INTERNAL PROC [stream: StreamHandle, char: UNSPECIFIED] =
    BEGIN
    IF stream # systemDS THEN
      SIGNAL StreamDefs.StreamError[stream,StreamType];
    IF ~displayOn THEN RETURN;
    IF char > 377B THEN RETURN;
    IF blinkOn THEN [] ← BlinkCursorInternal[];
    IF char < 40B OR
      CharWidth[char] + bmState.x > RightMargin THEN Scroll[char]
    ELSE PaintChar[char,@bmState];
    RETURN
    END;

  ClearDisplayChar: PUBLIC ENTRY PROC [
    stream: StreamHandle, char: UNSPECIFIED] =
    {ClearDisplayCharInternal[stream, char]};

  ClearDisplayCharInternal: INTERNAL PROC [
    stream: StreamHandle, char: UNSPECIFIED] =
    BEGIN
    IF stream # systemDS THEN
      SIGNAL StreamDefs.StreamError[stream,StreamType];
    IF displayOn THEN
      BEGIN
      IF blinkOn THEN [] ← BlinkCursorInternal[];
      SELECT char FROM
	NUL, CR, > 377B => RETURN;
	TAB =>
	  BEGIN
	  IF TABindex > 0 THEN
	    BEGIN
	    TABindex ← TABindex -1;
	    bmState.x ← TABs[TABindex];
	    END;
	  RETURN
	  END;
	< 40B =>
	  BEGIN
	  ClearDisplayCharInternal[stream, char+100B];
	  char ← '↑;
	  END;
	ENDCASE => NULL;
      ClearChar[char,@bmState];
      END;
    RETURN
    END;

  GetNop: PROC [stream: StreamHandle] RETURNS [UNSPECIFIED] =
    {ERROR StreamDefs.StreamError[stream,StreamAccess]};

  PutbackNop: PROC [stream: StreamHandle, char: UNSPECIFIED] =
    {ERROR StreamDefs.StreamError[stream,StreamAccess]};

  EndofNop: PROC [stream: StreamHandle] RETURNS [BOOLEAN] =
    BEGIN	
    IF stream # systemDS THEN
      SIGNAL StreamDefs.StreamError[stream,StreamType];
    RETURN[FALSE]
    END;

  DestroyNop: PROC [stream: StreamHandle] =
    {ERROR StreamDefs.StreamError[stream,StreamAccess]};

  ddarray: ARRAY [0..SIZE[DCB]*5] OF UNSPECIFIED;

  Even: PROC [a: UNSPECIFIED] RETURNS [UNSPECIFIED] =
    {RETURN[a + CARDINAL[a] MOD 2]};

  blinkOn: BOOLEAN ← FALSE;

  BlinkCursor: PUBLIC ENTRY PROC RETURNS [BOOLEAN] =
    {RETURN[BlinkCursorInternal[]]};

  BlinkCursorInternal: INTERNAL PROC RETURNS [BOOLEAN] =
    BEGIN OPEN InlineDefs;
    mask: WORD;
    p: POINTER;
    IF ~displayOn THEN RETURN[blinkOn];
    mask ← BITSHIFT[3, 14 - CARDINAL[bmState.x+1] MOD 16];
    p ← bmState.origin + (bmState.x+1)/16 + bmState.wordsPerLine;
    THROUGH [2..lineHeight) DO
      p↑ ← BITXOR[p↑, mask];
      IF mask = 1 THEN (p+1)↑ ← BITXOR[(p+1)↑, 100000B];
      p ← p + bmState.wordsPerLine;
      ENDLOOP;
    RETURN[blinkOn ← ~blinkOn]
    END;

  InitDisplay: PUBLIC PROC [
    dummySize, textLines, nPages: CARDINAL, f: FontDefs.FontHandle] =
    BEGIN
    lineHeight ← Even[CharHeight['A]];
    lastLineSize ← lineHeight*WordsPerLine;
    tabWidth ← CharWidth[SP]*8;
    SetDummyDisplaySize[dummySize];
    SetupHeader[];
    SetSystemDisplaySize[textLines, nPages];
    RETURN
    END;

  CleanupDisplay: ImageDefs.CleanupItem ← [
    link:, proc: Cleanup,
    mask: ImageDefs.CleanupMask[Finish] + ImageDefs.CleanupMask[Abort]];

  Cleanup: ImageDefs.CleanupProcedure =
    BEGIN
    SELECT why FROM
      Finish, Abort => DCBchainHead.next ← DCBnil;
      ENDCASE;
    END;

  font: Fptr;

  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 PROC [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['↑] +
      CharWidth[LOOPHOLE[LOOPHOLE[char,CARDINAL]+100B,CHARACTER]]];
    w ← 0;
    fontdesc ← @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;
    RETURN
    END;

  CharHeight: PUBLIC PROC [CHARACTER] RETURNS [CARDINAL] =
    {RETURN[font.header.maxHeight]};

  PaintString: PROC [s: STRING, bmState: POINTER TO BitmapState] =
    BEGIN
    FOR i: CARDINAL IN [0..s.length) DO
      PaintChar[s[i], bmState];
      ENDLOOP;
    END;

  SetString: PROC [s: STRING, bmState: POINTER TO BitmapState] =
    BEGIN
    i: CARDINAL;
    saveX: CARDINAL ← bmState.x;
    FOR i IN [0..s.length) DO
      BlankChar[bmState];
      ENDLOOP;
    bmState.x ← saveX;
    FOR i IN [0..s.length) DO
      PaintChar[s[i], bmState];
      ENDLOOP;
    END;

  BlankChar: PROC [bmState: POINTER TO BitmapState] =
    BEGIN OPEN BitBltDefs, bmState;
    bba: ARRAY [0..SIZE[BBTable]] OF UNSPECIFIED;
    bbt: BBptr = LOOPHOLE[BASE[bba] + LOOPHOLE[BASE[bba],CARDINAL] MOD 2];
    bbt↑ ← [pad: 0, sourcealt: FALSE, destalt: FALSE, sourcetype: gray,
      function: replace, unused:, dbca: origin, dbmr: wordsPerLine,
      dlx: x, dty: 0, dw: CharWidth['X], dh: lineHeight,
      sbca:, sbmr: 1, slx: 0, sty: 0,
      gray0: 0, gray1: 0, gray2: 0, gray3: 0];
    x ← x + CharWidth['X];
    BITBLT[bbt];
    RETURN
    END;

  PaintChar: PROC
    [char: CHARACTER, bmState: POINTER TO BitmapState] =
    BEGIN OPEN BitBltDefs, bmState;
    bba: ARRAY [0..SIZE[BBTable]] OF UNSPECIFIED;
    bbt: BBptr = LOOPHOLE[BASE[bba] + LOOPHOLE[BASE[bba],CARDINAL] MOD 2];
    cw: FCDptr;
    fontdesc: FAptr = @font.FCDptrs;
    code: CARDINAL ← LOOPHOLE[char];
    bbt↑ ← [pad: 0, sourcealt: FALSE, destalt: FALSE, sourcetype: block,
      function: paint, unused:, dbca: origin, dbmr: wordsPerLine,
      dlx: x, dty:, dw: 16, dh:,
      sbca:, sbmr: 1, slx: 0, sty: 0,
      gray0:, gray1:, gray2:, gray3:];
    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);
      IF cw.hasNoExtension THEN
        BEGIN x ← x + (bbt.dw ← cw.widthORext); BITBLT[bbt]; EXIT END
      ELSE BEGIN BITBLT[bbt]; bbt.dlx ← x ← x + 16 END;
      code ← cw.widthORext;
      ENDLOOP;
    RETURN
    END;

  ClearChar: PROC [char: CHARACTER, bmState: POINTER TO BitmapState] =
    BEGIN OPEN bmState, InlineDefs;
    bit: [0..15];
    xword: CARDINAL;
    scanLines: CARDINAL = font.header.maxHeight;
    start,p: POINTER;
    cwidth: INTEGER ← CharWidth[char];
    mask: WORD;
    ones: WORD = 177777B;
    IF x < cwidth THEN BEGIN cwidth ← x; x ← 0 END
    ELSE x ← x - cwidth;
    xword ← x/16; bit ← x MOD 16;
    mask ← BITOR[BITSHIFT[ones, 16-bit],BITSHIFT[ones,-(bit+cwidth)]];
    start ← origin + xword + y*wordsPerLine-1;
    cwidth ← cwidth + bit;
    DO
      p ← start ← start + 1;
      THROUGH [0..scanLines) DO
	p↑ ← BITAND[p↑,mask];
	p ← p + wordsPerLine;
	ENDLOOP;
      IF (cwidth ← cwidth - 16) <= 0 THEN EXIT;
      mask ← BITSHIFT[ones,-cwidth];
      ENDLOOP;
    RETURN
    END;

  Cursor: ENTRY PROC =
    BEGIN
    wait: CONDITION;
    timer: POINTER TO INTEGER ← LOOPHOLE[430B];
    blinktime: INTEGER;
    ProcessDefs.SetTimeout[@wait, ProcessDefs.MsecToTicks[450]];
    DO -- forever
      IF blinktime-timer↑ ~IN[0..13] THEN
	BEGIN [] ← BlinkCursorInternal[]; blinktime ← timer↑+13 END;
      IF stopCursor THEN EXIT;
      WAIT wait;
      ENDLOOP;
    RETURN
    END;

  stopCursor: BOOLEAN ← TRUE;
  CursorProcess: PUBLIC PROCESS;

  StartCursor: PUBLIC PROC =
    BEGIN
    IF stopCursor THEN
      {stopCursor ← FALSE;  CursorProcess ← FORK Cursor[]};
    RETURN
    END;

  StopCursor: PUBLIC PROC =
    BEGIN
    IF ~stopCursor THEN {stopCursor ← TRUE; JOIN CursorProcess};
    RETURN
    END;

  Init: PROC =
    BEGIN
    FrameDefs.SwapInCode[LOOPHOLE[MMOps.MMFont]];
    font ← FrameDefs.GlobalFrame[MMOps.MMFont].code.shortbase;
    ImageDefs.AddCleanupProcedure[@CleanupDisplay];
    dummyDCB ← Even[BASE[ddarray]];
    dummyDCB↑ ← [DCBnil,high,white,0,0,LOOPHOLE[0,OrderedPOINTER],0];
    clockDCB ← dummyDCB+SIZE[DCB];
    clockDCB↑ ← [DCBnil,high,white,0,0,LOOPHOLE[0,OrderedPOINTER],0];
    clockSpareDCB ← clockDCB+SIZE[DCB];
    clockSpareDCB↑ ← [DCBnil,high,white,0,0,LOOPHOLE[0,OrderedPOINTER],0];
    hostDCB ← clockSpareDCB+SIZE[DCB];
    hostDCB↑ ← [DCBnil,high,white,0,0,LOOPHOLE[0,OrderedPOINTER],0];
    spacerDCB ← hostDCB+SIZE[DCB];
    spacerDCB↑ ← [DCBnil,high,white,0,0,LOOPHOLE[0,OrderedPOINTER],0];
    IF NXDefs.debug THEN RETURN;
    SetSystemDisplayWidth[16, 36*16];
    displayLines ← 20;
    InitDisplay[80, displayLines, (displayLines*CharHeight['A]*36+255)/256, NIL];
    StartCursor[];
    END;

  Init[];

  END.