-- 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.