-- SystemDisplay.mesa; edited by Sandman June 4, 1980  3:27 PM
-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  AltoDefs USING [PageSize, wordlength],
  AltoDisplay USING [Background, DCB, DCBchainHead, DCBHandle, DCBnil],
  BitBltDefs USING [AlignedBBTable, BBptr, BBTableSpace, BITBLT],
  DisplayDefs USING [],
  FontDefs USING [BitmapState, FontHandle],
  ForgotDefs USING [BitmapDS],
  FrameOps USING [MyGlobalFrame],
  InlineDefs USING [BITSHIFT, BITXOR, COPY],
  SegmentDefs USING [
    DataSegmentHandle, DataSegmentAddress, DefaultBase, DeleteDataSegment,
    HardDown, MakeDataSegment],
  StreamDefs USING [
    DiskHandle, DisplayHandle, GetPosition, SetPosition, StreamError,
    StreamHandle, StreamPosition, StreamObject],
  Storage USING [Node, Free];

SystemDisplay: PROGRAM
  IMPORTS BitBltDefs, FrameOps, InlineDefs, StreamDefs, SegmentDefs, Storage
  EXPORTS DisplayDefs, StreamDefs
  SHARES StreamDefs =
  BEGIN OPEN AltoDisplay;

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

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

  -- Display Hardware

  DisplayData: TYPE = RECORD [
    firstDCB, lastDCB, currentDCB: DCBHandle,
    bmFirst, bmTail, bmNext, bmLastLine: OrderedPOINTER,
    LeftIndent, LeftMargin, RightMargin, WordsPerLine: CARDINAL,
    lineheight: CARDINAL,
    lastLineSize: CARDINAL,
    bmState: FontDefs.BitmapState,
    bmSeg: SegmentDefs.DataSegmentHandle,
    bitmap: POINTER,
    tabIndex: CARDINAL,
    tabs: ARRAY [0..10) OF CARDINAL,
    displayOn, blinkOn: BOOLEAN,
    dummyDCB: DCBHandle,
    tabWidth, currentPages, currentLines, currentDummySize: CARDINAL,
    startLine: StreamDefs.StreamPosition,
    ddarray: ARRAY [0..SIZE[DCB]] OF UNSPECIFIED,
    DSP: Display StreamDefs.StreamObject];

  data: POINTER TO DisplayData ← NIL;
  systemDS: StreamDefs.DisplayHandle;
  font: FontDefs.FontHandle;
  typescript: StreamDefs.DiskHandle;

  CreateDisplayData: PUBLIC PROCEDURE =
    BEGIN
    data ← Storage.Node[SIZE[DisplayData]];
    font ← NIL;
    data.firstDCB ← data.lastDCB ← data.currentDCB ← DCBnil;
    typescript ← NIL;
    data.startLine ← 0;
    data.displayOn ← data.blinkOn ← FALSE;
    data.DSP ← StreamDefs.StreamObject[
      reset: ResetDS, get: GetNop, put: DPutChar, putback: PutbackNop,
      endof: EndofNop, destroy: DestroyNop, link: NIL,
      body: Display[
      clearCurrentLine: ClearCurrentLine, clearChar: ClearChar,
      clearLine: ClearLine, type: FrameOps.MyGlobalFrame[], data: NIL]];
    systemDS ← @data.DSP;
    data.dummyDCB ← Even[BASE[data.ddarray]];
    data.dummyDCB↑ ← [DCBnil, high, white, 0, 0, LOOPHOLE[0, OrderedPOINTER], 0];
    SetSystemDisplayWidth[16, 36*16];
    RETURN
    END;

  DeleteDisplayData: PUBLIC PROCEDURE = {Storage.Free[data]};

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


  GetDefaultDisplayStream: PUBLIC PROCEDURE RETURNS [StreamDefs.DisplayHandle] =
    BEGIN RETURN[systemDS]; END;

  NotEnoughSpaceForDisplay: PUBLIC SIGNAL = CODE;

  SetupBitmap: PROCEDURE [bitmap: POINTER, nLines, nWords: CARDINAL] =
    BEGIN OPEN data;
    dcb: DCBHandle;
    lastLineSize ← lineheight*WordsPerLine;
    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;

  DisplayOff: PUBLIC PROCEDURE [color: Background] =
    BEGIN OPEN data;
    IF ~displayOn THEN RETURN;
    SetSystemDisplaySize[0, 0];
    font.close[font];
    dummyDCB.background ← color;
    dummyDCB.height ← 1;
    END;

  DisplayOn: PUBLIC PROCEDURE =
    BEGIN OPEN data;
    IF displayOn THEN RETURN;
    dummyDCB.background ← white;
    SetDummyDisplaySize[currentDummySize];
    SetSystemDisplaySize[currentLines, currentPages];
    END;

  SetSystemDisplaySize: PUBLIC PROCEDURE [nTextLines, nPages: CARDINAL] =
    BEGIN OPEN SegmentDefs, data;
    IF displayOn THEN
      BEGIN
      firstDCB.next ← lastDCB.next;
      RemoveDCB[firstDCB];
      firstDCB ← lastDCB ← currentDCB ← DCBnil;
      DeleteDataSegment[bmSeg];
      blinkOn ← displayOn ← FALSE;
      END;
    IF nPages = 0 THEN RETURN;
    currentPages ← nPages; -- for Display Off/On
    currentLines ← nTextLines; -- for Display Off/On
    bitmap ← DataSegmentAddress[
      bmSeg ← MakeDataSegment[DefaultBase, nPages, HardDown]];
    bmSeg.type ← ForgotDefs.BitmapDS;
    SetupBitmap[bitmap, nTextLines, nPages*AltoDefs.PageSize];
    displayOn ← TRUE;
    ClearDS[systemDS];
    InsertDCB[new: firstDCB, before: dummyDCB.next];
    RETURN
    END;

  SetSystemDisplayWidth: PUBLIC PROCEDURE [indent, width: CARDINAL] =
    BEGIN OPEN data;
    LeftMargin ← indent MOD BitsPerWord;
    LeftIndent ← indent/BitsPerWord;
    WordsPerLine ← Even[width/BitsPerWord];
    RightMargin ← WordsPerLine*BitsPerWord;
    IF displayOn THEN SetSystemDisplaySize[currentLines, currentPages];
    RETURN
    END;

  SetDummyDisplaySize: PUBLIC PROCEDURE [nScanLines: CARDINAL] =
    BEGIN OPEN data;
    currentDummySize ← nScanLines; -- for Display Off/On
    IF nScanLines/2 = dummyDCB.height THEN RETURN;
    IF dummyDCB.height # 0 THEN RemoveDCB[dummyDCB];
    dummyDCB.height ← nScanLines/2;
    IF dummyDCB.height # 0 THEN InsertDCB[new: dummyDCB, before: firstDCB];
    RETURN
    END;

  ResetDS: PROCEDURE [stream: StreamHandle] =
    BEGIN
    ClearDS[stream];
    IF typescript # NIL THEN typescript.reset[typescript];
    data.startLine ← 0;
    RETURN
    END;

  ClearDS: PROCEDURE [stream: StreamHandle] =
    BEGIN OPEN data;
    dcb: DCBHandle;
    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;
    ClearCurrentLine[stream];
    RETURN
    END;

  ClearCurrentLine: PUBLIC PROCEDURE [stream: StreamHandle] =
    BEGIN OPEN data;
    IF typescript # NIL THEN StreamDefs.SetPosition[typescript, startLine];
    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;

  ClearLine: PROCEDURE [stream: StreamHandle, line: CARDINAL] = BEGIN END;

  Scroll: PROCEDURE [char: CHARACTER] =
    BEGIN OPEN BitBltDefs, data;
    bbt: BBTableSpace;
    bbp: BBptr ← AlignedBBTable[@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 DPutChar[systemDS, SP];
	RETURN
	END;
      NUL => RETURN;
      ENDCASE =>
	IF char < 40C THEN
	  BEGIN
	  DPutChar[systemDS, '↑];
	  DPutChar[
	    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↑ ←
	[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];
      IF firstDCB # lastDCB THEN BITBLT[bbp];
      END;
    IF typescript # NIL THEN startLine ← StreamDefs.GetPosition[typescript];
    ClearCurrentLine[systemDS];
    IF char # CR THEN DPutChar[systemDS, char];
    END;

  DeleteTopLine: PROCEDURE RETURNS [BOOLEAN] =
    BEGIN OPEN data;
    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 BEGIN bmTail ← LOOPHOLE[dcb.bitmap]; EXIT END;
      REPEAT
	FINISHED => -- all linex deleted
	  BEGIN bmTail ← bmLastLine; bmNext ← bmFirst END;
      ENDLOOP;
    RETURN[TRUE];
    END;

  Compact: PROCEDURE [dcb: DCBHandle, x: CARDINAL] RETURNS [BOOLEAN] =
    BEGIN OPEN data;
    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: BBTableSpace;
      bbp: BBptr ← AlignedBBTable[@bbt];
      new: OrderedPOINTER;
      IF (new ← GetMapSpace[newWidth*lineHeight]) = OrderedNIL THEN RETURN[FALSE];
      dcb.width ← 0;
      bbp↑ ←
	[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];
      BITBLT[bbp];
      dcb.indenting ← LeftIndent + d;
      dcb.bitmap ← new;
      dcb.width ← newWidth;
      END
    ELSE dcb.indenting ← dcb.width ← 0;
    RETURN[TRUE];
    END;

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

  DPutChar: PROCEDURE [stream: StreamHandle, char: UNSPECIFIED] =
    BEGIN OPEN data;
    IF ~displayOn THEN RETURN;
    IF char > 377B THEN RETURN;
    IF blinkOn THEN [] ← BlinkCursor[];
    IF char < 40B OR font.charWidth[font, char] + bmState.x > RightMargin THEN
      Scroll[char]
    ELSE font.paintChar[font, char, @bmState];
    RETURN
    END;

  DPutCharTS: PROCEDURE [stream: StreamHandle, char: UNSPECIFIED] =
    BEGIN
    typescript.put[typescript, char];
    DPutChar[stream, char];
    IF ~data.displayOn AND char = CR THEN
      data.startLine ← StreamDefs.GetPosition[typescript];
    RETURN
    END;

  ClearChar: PROCEDURE [stream: StreamHandle, char: UNSPECIFIED] =
    BEGIN OPEN data;
    IF displayOn THEN
      BEGIN
      IF blinkOn THEN [] ← BlinkCursor[];
      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 ClearDisplayChar[stream, char + 100B]; char ← '↑; END;
	ENDCASE => NULL;
      font.clearChar[font, char, @bmState];
      END
    ELSE
      SELECT char FROM
	NUL, CR, TAB, > 377B => RETURN;
	< 40B => ClearDisplayChar[stream, char + 100B];
	ENDCASE => NULL;
    RETURN
    END;

  ClearDisplayChar: PUBLIC PROCEDURE [stream: StreamHandle, char: UNSPECIFIED] =
    BEGIN
    ClearChar[stream, char];
    IF typescript # NIL THEN
      BEGIN OPEN StreamDefs;
      SetPosition[typescript, GetPosition[typescript] - 1];
      END;
    RETURN
    END;

  GetNop: PROCEDURE [stream: StreamHandle] RETURNS [UNSPECIFIED] =
    BEGIN ERROR StreamDefs.StreamError[stream, StreamAccess] END;

  PutbackNop: PROCEDURE [stream: StreamHandle, char: UNSPECIFIED] =
    BEGIN ERROR StreamDefs.StreamError[stream, StreamAccess] END;

  EndofNop: PROCEDURE [stream: StreamHandle] RETURNS [BOOLEAN] =
    BEGIN RETURN[FALSE] END;

  DestroyNop: PROCEDURE [stream: StreamHandle] =
    BEGIN ERROR StreamDefs.StreamError[stream, StreamAccess] END;

  InsertDCB: PROCEDURE [new: DCBHandle, before: DCBHandle] =
    BEGIN OPEN data;
    dcb: DCBHandle;
    FOR dcb ← new, dcb.next DO
      IF dcb.next = DCBnil THEN BEGIN dcb.next ← before; EXIT END; ENDLOOP;
    IF DCBchainHead↑ = before THEN DCBchainHead↑ ← new
    ELSE
      FOR dcb ← DCBchainHead↑, dcb.next DO
	IF dcb.next = before THEN BEGIN dcb.next ← new; EXIT END; ENDLOOP;
    END;

  RemoveDCB: PROCEDURE [dcb: DCBHandle] =
    BEGIN
    prev: DCBHandle;
    IF DCBchainHead↑ = dcb THEN DCBchainHead↑ ← dcb.next
    ELSE
      FOR prev ← LOOPHOLE[DCBchainHead], prev.next UNTIL prev.next = DCBnil DO
	IF prev.next = dcb THEN BEGIN prev.next ← dcb.next; EXIT END; ENDLOOP;
    dcb.next ← DCBnil;
    END;

  Even: PROCEDURE [a: UNSPECIFIED] RETURNS [UNSPECIFIED] =
    BEGIN RETURN[a + CARDINAL[a] MOD 2] END;

  SetFont: PUBLIC PROCEDURE [f: FontDefs.FontHandle] =
    BEGIN OPEN data;
    font ← f;
    lineheight ← Even[font.charHeight[font, 'A]];
    tabWidth ← font.charWidth[font, SP]*8;
    RETURN
    END;

  GetFont: PUBLIC PROCEDURE RETURNS [FontDefs.FontHandle] =
    BEGIN RETURN[font] END;

  SetTypeScript: PUBLIC PROCEDURE [ts: StreamDefs.DiskHandle] =
    BEGIN OPEN data;
    IF (typescript ← ts) = NIL THEN systemDS.put ← DPutChar
    ELSE
      BEGIN
      data.startLine ← StreamDefs.GetPosition[ts];
      systemDS.put ← DPutCharTS;
      END;
    RETURN
    END;

  GetTypeScript: PUBLIC PROCEDURE RETURNS [StreamDefs.DiskHandle] =
    BEGIN RETURN[typescript] END;

  BlinkCursor: PUBLIC PROCEDURE RETURNS [BOOLEAN] =
    BEGIN OPEN InlineDefs, data;
    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 PROCEDURE [
    dummySize, textLines, nPages: CARDINAL, f: FontDefs.FontHandle] =
    BEGIN OPEN data;
    IF data = NIL THEN CreateDisplayData[];
    IF font # NIL THEN font.destroy[font];
    SetFont[f];
    SetDummyDisplaySize[dummySize];
    SetSystemDisplaySize[textLines, nPages];
    RETURN
    END;

  CreateDisplayData[];

  END.