-- Grapevine: Server display "hot" module

-- [Juniper]<Grapevine>MS>LogDisplayHot.mesa

-- Roy Levin
-- Andrew Birrell  11-Jun-81 14:46:51

DIRECTORY
  AltoDisplay USING [MaxBitsPerLine, MaxScanLines],
  BitBltDefs USING [AlignedBBTable, BBptr, BBTable, BBTableSpace, BITBLT],
  FontDefs USING [FontHandle, FontObject],
  InlineDefs USING [DIVMOD, HighHalf, LowHalf],
  KeyDefs USING [KeyBits, Keys],
  LogPrivateDefs USING [
    BitmapState, bmPointsPerLine, BMStatePtr, Cursor, cursorBM, DCBchainHead, DCBHandle,
    DCBnil, Face, Machine, NumberHouse, NumberHouseObject, ScreenPoints, topMargin],
  LogDefs USING [BS, CR, SP, TAB],
  Mopcodes USING [zJRAM, zKFCB, zLI0, zLIW, zPOP],
  ProcessDefs USING [
    Abort, Aborted, Detach, Milliseconds, MsecToTicks, Seconds,
    SecondsToTicks, SetTimeout],
  SDDefs USING [sULongDivMod],
  SegmentDefs USING [FileSegmentAddress, FileSegmentHandle, SwapIn, Unlock],
  StringDefs USING [AppendChar, AppendLongNumber, AppendNumber],
  TimeDefs USING [CurrentDayTime, PackedTime];

LogDisplayHot: MONITOR
  IMPORTS BitBltDefs, InlineDefs, ProcessDefs, SegmentDefs,
          StringDefs, TimeDefs
  EXPORTS LogDefs, LogPrivateDefs =

  BEGIN OPEN FontDefs, LogDefs, LogPrivateDefs;


  -- Global Variables --

  machineFlavor: PUBLIC Machine;
  houses: PUBLIC DESCRIPTOR FOR ARRAY OF NumberHouseObject;
  statsFont: PUBLIC FontHandle;
  scriptFont: PUBLIC FontHandle;
  startUpTime: PUBLIC TimeDefs.PackedTime;
  uptimeHouse: PUBLIC NumberHouseObject;
  typescriptOn: PUBLIC BOOLEAN;
  headingDCB, firstScriptDCB,
  lastScriptDCB, firstScriptLineDCB: PUBLIC DCBHandle;
  scriptCurrentDCB: PUBLIC DCBHandle;
  scriptBMStatePtr: PUBLIC BMStatePtr _ @scriptBMState;
  scriptBMState: BitmapState;

  maxCursor: Cursor =
    [104621B, 155112B, 125704B, 105112B,
     105121B, 000000B, 017770B, 010010B,
     012550B, 012550B, 012550B, 010150B,
     010150B, 010010B, 010010B, 017770B];
  minCursor: Cursor =
    [104442B, 154462B, 124452B, 104446B,
     104442B, 000000B, 017770B, 010010B,
     013250B, 013250B, 013250B, 013010B,
     013010B, 010010B, 010010B, 017770B];
  currentCursor: Cursor =
    [160000B, 103403B, 127616B, 167770B,
     007670B, 073550B, 174334B, 174676B,
     177676B, 073276B, 006234B, 074700B,
     175752B, 175752B, 175744B, 070704B];


  -- Miscellaneous Declarations --

  IllegalUseOfLog: PUBLIC ERROR = CODE;
  napInterval: ProcessDefs.Milliseconds = 50;


  -- Statistics Display Procedures (exported to LogPrivateDefs) --

  Displayer: PUBLIC ENTRY PROCEDURE [waitInterval: ProcessDefs.Seconds] =
    -- expects to be FORKed.  Loops until aborted, waiting for the argument
    -- interval, then updates the statistics display.
    BEGIN OPEN ProcessDefs, StringDefs;
    DisplayState: TYPE = {max, current, min};
    displayState: DisplayState _ current;
    savedDCB:    DCBHandle = DCBchainHead^;
    onInterval:  CARDINAL = 60 -- seconds of display after key action --;
    offTime:     TimeDefs.PackedTime _
                      TimeDefs.CurrentDayTime[]+onInterval;
    displayIsOn: BOOLEAN _ TRUE;
    Coords:      TYPE = RECORD[x,y: INTEGER];
    mouse:       POINTER TO Coords = LOOPHOLE[424B];
    cursor:      POINTER TO Coords = LOOPHOLE[426B];
    basicMouse:  Coords = [ x: MAX[0,headingDCB.indenting*16-32],
                            y: topMargin ];
    sleep:       CONDITION;
    cat:         PROCESS;

    DisplayOn: INTERNAL PROC = INLINE
      BEGIN
      offTime _ TimeDefs.CurrentDayTime[] + onInterval;
      IF NOT displayIsOn THEN BEGIN
        DCBchainHead^ _ savedDCB;
        mouse^ _ basicMouse;
        displayIsOn _ TRUE;
        NOTIFY sleep;
        END;
      END;

    PossibleDisplayOff: INTERNAL PROC = INLINE
      BEGIN
      IF TimeDefs.CurrentDayTime[] > offTime AND KeyDefs.Keys.Lock = up
      THEN BEGIN
        DCBchainHead^ _ DCBnil;
        cursor^ _ basicMouse;
        displayIsOn _ FALSE;
        displayState _ current; cursorBM^ _ currentCursor;
        END;
      END;

    UpdateStatus: PROC = INLINE
      BEGIN OPEN TimeDefs;
      s: STRING = [13];
      bmState: BitmapState;
      AppendElapsedTime[s, CurrentDayTime[] - startUpTime];
      bmState _ BitmapState[
        origin: uptimeHouse.dcb.longBitmap,
        wordsPerLine: uptimeHouse.dcb.width,
        x: uptimeHouse.leftX, y: 0];
      ClearHouse[@uptimeHouse];
      PutStringInBitmap[s, statsFont, plain, @bmState]
      END;

    Cat: ENTRY PROCEDURE =
      BEGIN
      catNap:   CONDITION;
      oldKeys:  KeyDefs.KeyBits _ KeyDefs.Keys^;
      oldMouse: Coords _ mouse^;
      SetTimeout[@catNap, MsecToTicks[napInterval]];
      DO
        WAIT catNap[ ! Aborted => EXIT];
        IF KeyDefs.Keys^ # oldKeys THEN
          BEGIN
          DisplayOn[];
          SELECT TRUE FROM
            KeyDefs.Keys.Red=down AND oldKeys.Red#down =>
              { displayState _ min; NOTIFY sleep };
            KeyDefs.Keys.Blue=down AND oldKeys.Blue#down =>
              { displayState _ max; NOTIFY sleep };
            KeyDefs.Keys.Yellow=down AND oldKeys.Yellow#down =>
              { displayState _ current; NOTIFY sleep };
          ENDCASE => NULL;
          oldKeys _ KeyDefs.Keys^;
          END;
        IF mouse^ # oldMouse THEN BEGIN
          oldMouse _ [x: MAX[0,MIN[mouse^.x, AltoDisplay.MaxBitsPerLine]],
                      y: MAX[0,MIN[mouse^.y, AltoDisplay.MaxScanLines]] ];
          mouse^ _ oldMouse;
          DisplayOn[];
          END;
        IF displayIsOn
        THEN cursor^ _ oldMouse
        ELSE BEGIN -- show we're alive! --
          IF cursor.x < AltoDisplay.MaxBitsPerLine-32
          THEN cursor.x _ cursor.x + 1
          ELSE cursor.x _ 16;
          END;
        ENDLOOP;
      END;
    SetTimeout[@sleep, SecondsToTicks[waitInterval]];
    Detach[cat _ FORK Cat];
    mouse^ _ basicMouse;
    DO
      -- calculate new min/max, even if display is off --
      FOR i: CARDINAL IN [0..LENGTH[houses]) DO
        h: NumberHouse = @houses[i];
        WITH item: h SELECT FROM
          short =>
            BEGIN
            IF item.max < item.p^ THEN item.max _ item.p^;
            IF item.p^ < item.min THEN item.min _ item.p^;
            END;
          long =>
            BEGIN
            IF item.max < item.p^ THEN item.max _ item.p^;
            IF item.p^ < item.min THEN item.min _ item.p^;
            END;
          percent =>
            BEGIN
            pct: CARDINAL _ MIN[item.p^, 100];
            IF item.max < pct THEN item.max _ pct;
            IF pct < item.min THEN item.min _ pct;
            END;
          ENDCASE;
        ENDLOOP;
      IF displayIsOn THEN PossibleDisplayOff[];
      IF displayIsOn THEN
        BEGIN
        SELECT displayState FROM
          min => cursorBM^ _ minCursor;
          max => cursorBM^ _ maxCursor;
          current => cursorBM^ _ currentCursor;
        ENDCASE => NULL;
        UpdateStatus[];
        FOR i: CARDINAL IN [0..LENGTH[houses]) DO
          h: NumberHouse = @houses[i];
          current: LONG CARDINAL;
          s: STRING = [13];
          bmState: BitmapState;
          ClearHouse[h];
          WITH item: h SELECT FROM
            short => current _ SELECT displayState FROM
                max => item.max,
                min => item.min,
                ENDCASE => LOOPHOLE[item.p^, CARDINAL];
            long => current _ SELECT displayState FROM
                max => item.max,
                min => item.min,
                ENDCASE => item.p^;
            percent => current _ SELECT displayState FROM
                max => item.max,
                min => item.min,
                ENDCASE => MIN[item.p^, 100];
            ENDCASE;
          AppendLongNumber[s, current, 10];
          IF h.format = percent THEN AppendChar[s, '%];
          bmState _ BitmapState[
            origin: h.dcb.longBitmap, wordsPerLine: h.dcb.width,
            x: h.leftX, y: 0];
          PutStringInBitmap[s, statsFont, plain, @bmState];
          ENDLOOP;
        END;
      WAIT sleep[ ! Aborted => BEGIN Abort[cat]; EXIT END];
      ENDLOOP;
    END; --Displayer

  PutStringInBitmap: PUBLIC PROCEDURE [
    s: STRING, font: FontHandle, face: Face, bmState: BMStatePtr] =
    -- computes the width in ScreenPoints of the string 's' presented in 'font' and 'face'.
    BEGIN
    i: CARDINAL;
    x: ScreenPoints;
    SELECT face FROM
      plain, italic =>
        FOR i IN [0..s.length) DO PaintChar[font, s[i], bmState]; ENDLOOP;
      bold =>
        FOR i IN [0..s.length) DO
          x _ bmState.x;
          PaintChar[font, s[i], bmState];
          bmState.x _ x + 1;
          PaintChar[font, s[i], bmState];
          ENDLOOP;
      ENDCASE;
    IF face = italic THEN -- italicize --NULL;
    END; --PutStringInBitmap

  AppendElapsedTime: PUBLIC PROCEDURE [s: STRING, pt: TimeDefs.PackedTime] =
    -- appends to 's' a time derived from 'pt' of the form:  1314:35:28.
    BEGIN OPEN StringDefs;
    Append2: PROCEDURE [s: STRING, v: CARDINAL] =
      BEGIN
      n, r: CARDINAL;
      [n, r] _ InlineDefs.DIVMOD[v, 10];
      AppendChar[s, n + '0];
      AppendChar[s, r + '0];
      END;
    n: LONG CARDINAL;
    mm, ss: CARDINAL;
    [n, ss] _ LongDivMod[pt, 60];
    [n, mm] _ LongDivMod[n, 60];
    AppendLongNumber[s, n, 10];
    AppendChar[s, ':];
    Append2[s, mm];
    AppendChar[s, ':];
    Append2[s, ss];
    END; --AppendElapsedTime

  Even: PUBLIC PROCEDURE [v: UNSPECIFIED] RETURNS [UNSPECIFIED] =
    -- rounds up 'v' to an even number.
    BEGIN RETURN[v + (v MOD 2)] END; --Even
  -- Typescript Procedures (exported to LogDefs) --

  WriteChar: PUBLIC ENTRY PROCEDURE [char: CHARACTER] =
    -- writes the argument character into the typescript.  Characters > 177C will be ignored and ASCII control characters (other than CR, TAB, SP, and BS) will be printed as though the sequence WriteChar['^]; WriteChar[char+100B] had been executed.  CR, TAB, and SP cause appropriate white space to be introduced. WriteChar must be called after TypescriptOn.
    BEGIN Write[char]; END; --WriteChar

  WriteString: PUBLIC ENTRY PROCEDURE [s: STRING] =
    -- writes all characters of the string into the typescript using WriteChar.
    BEGIN i: CARDINAL; FOR i IN [0..s.length) DO Write[s[i]]; ENDLOOP; END;
  --WriteString

  WriteLine: PUBLIC PROCEDURE [s: STRING] =
    -- equivalent to WriteString[s]; WriteChar[CR].
    BEGIN WriteString[s]; Write[CR]; END; --WriteLine

  WriteDecimal: PUBLIC PROCEDURE [n: CARDINAL] =
    -- writes 'n' on the typescript as an unsigned, decimal quantity.
    BEGIN s: STRING = [5]; StringDefs.AppendNumber[s, n, 10]; WriteString[s]; END;
  --WriteDecimal


  -- Internal Procedures --

  ClearHouse: PROCEDURE [h: NumberHouse] =
    -- clears the bitmap rectangle corresponding to the numeric part of 'h'.
    BEGIN
    bbtSpace: ARRAY [0..SIZE[BitBltDefs.BBTable]] OF UNSPECIFIED;
    bbt: BitBltDefs.BBptr = Even[@bbtSpace];
    bbt^ _
      [ptrs: IF machineFlavor=dMachine THEN long ELSE short,
       pad: 0, sourcealt: FALSE, destalt: TRUE, sourcetype: gray,
       function: replace, unused: InlineDefs.HighHalf[h.dcb.longBitmap],
       dbca: InlineDefs.LowHalf[h.dcb.longBitmap], dbmr: h.dcb.width,
       dlx: h.leftX, dty: 0, dw: h.width, dh: h.dcb.height*2,
       sbca:, sbmr:, slx:, sty:,
       gray0: 0, gray1: 0, gray2: 0, gray3: 0,
       slbca:, dlbca: h.dcb.longBitmap];
    myBITBLT[bbt];
    END; --ClearHouse

  Write: PROCEDURE [char: CHARACTER] =
    -- see description under 'WriteChar'.
    BEGIN
    IF ~typescriptOn THEN ERROR IllegalUseOfLog;
    IF char < 040C THEN
      SELECT char FROM
        CR => BEGIN Scroll[]; RETURN END;
        TAB => BEGIN char _ SP; THROUGH [0..2) DO Write[char] ENDLOOP; END;
        -- temporary

        SP => NULL;
        BS => char _ '?; -- temporary

        ENDCASE => BEGIN Write['^]; char _ char + 100B; END;
    IF CharWidth[scriptFont, char] + scriptBMStatePtr.x > bmPointsPerLine THEN
      Scroll[];
    PaintChar[scriptFont, char, scriptBMStatePtr];
    END; --Write

  Scroll: PROCEDURE =
    -- scrolls the typescript by one line.
    BEGIN
    IF scriptCurrentDCB.next ~= DCBnil THEN
      scriptCurrentDCB _ scriptCurrentDCB.next
    ELSE
      BEGIN
      dcb: DCBHandle _ firstScriptLineDCB;
      firstScriptDCB.next _ firstScriptLineDCB _ dcb.next;
      Zero[dcb.longBitmap, dcb.width*dcb.height*2];
      dcb.next _ DCBnil;
      lastScriptDCB.next _ dcb;
      scriptCurrentDCB _ lastScriptDCB _ dcb;
      END;
    scriptBMStatePtr^ _ BitmapState[
      origin: scriptCurrentDCB.longBitmap, wordsPerLine: scriptCurrentDCB.width, x: 0,
      y: 0];
    END; --Scroll

  LongDivMod: PROCEDURE [num, den: LONG CARDINAL]
    RETURNS [q: LONG CARDINAL, r: CARDINAL] = MACHINE CODE
    BEGIN Mopcodes.zKFCB, SDDefs.sULongDivMod; Mopcodes.zPOP; END; --LongDivMod

  Zero: PUBLIC PROCEDURE [p: LONG POINTER, count: CARDINAL] =
    BEGIN
    -- zeros given number of words in XM --
    bbtSpace: ARRAY [0..SIZE[BitBltDefs.BBTable]] OF UNSPECIFIED;
    bbt: BitBltDefs.BBptr = Even[@bbtSpace];
    bbt^ _
      [ptrs: IF machineFlavor=dMachine THEN long ELSE short,
       pad: 0, sourcealt: FALSE, destalt: TRUE, sourcetype: gray,
       function: replace, unused: InlineDefs.HighHalf[p],
       dbca: InlineDefs.LowHalf[p], dbmr: 1--words--,
       dlx: 0, dty: 0, dw: 16--bits--, dh: count,
       sbca:, sbmr:, slx:, sty:,
       gray0: 0, gray1: 0, gray2: 0, gray3: 0,
       slbca:, dlbca: p];
    myBITBLT[bbt];
    END; --Zero

  myBITBLT: PROC[ptr: BitBltDefs.BBptr] = INLINE
    { IF machineFlavor=xmesa39
      THEN M5BITBLT[ptr] ELSE BitBltDefs.BITBLT[ptr] };

  M5BITBLT: PROC[ptr: BitBltDefs.BBptr] = MACHINE CODE
     -- works with XMesa 5 ROM's --
     { Mopcodes.zLI0;
       Mopcodes.zLIW, 411B/256, 411B MOD 256; Mopcodes.zJRAM};


-- The following is stolen from AlFont.mesa
-- Changed to handle XM bitmaps
-- Assumes the font is locked

  FileSegmentHandle: TYPE = SegmentDefs.FileSegmentHandle;

  AlFontObject: TYPE = RECORD [
    procs: FontObject,
    seg: FileSegmentHandle,
    lockCount: CARDINAL,
    height: CARDINAL];

  AlFontHandle: TYPE = POINTER TO AlFontObject;

  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 PROCEDURE [font: FontHandle, 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[font, '^] + CharWidth[font, char + 100B]];
    w _ 0;
    fontdesc _ @LockFont[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;
    UnlockFont[font];
    RETURN
    END;

  CharHeight: PUBLIC PROCEDURE [font: FontHandle, char: CHARACTER]
    RETURNS [CARDINAL] = BEGIN RETURN[LOOPHOLE[font, AlFontHandle].height] END;

  PaintChar: PROCEDURE [
    font: FontHandle, char: CHARACTER, bmState: POINTER TO BitmapState] =
    BEGIN OPEN BitBltDefs, bmState;
    bba: BitBltDefs.BBTableSpace;
    bbt: BitBltDefs.BBptr = BitBltDefs.AlignedBBTable[@bba];
    cw: FCDptr;
    fontdesc: FAptr = @LockFont[font].FCDptrs;
    code: CARDINAL _ LOOPHOLE[char];
    bbt^ _
      [ptrs: IF machineFlavor=dMachine THEN long ELSE short,
       sourcetype: block, function: paint,
       dbca: InlineDefs.LowHalf[origin], dbmr: wordsPerLine,
       destalt: TRUE, unused: InlineDefs.HighHalf[origin],
       dlx: x, dw: 16, sbmr: 1, slx: 0, sty: 0,
       dlbca: origin];
    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);
      bbt.slbca _ LONG[bbt.sbca];
      IF cw.hasNoExtension THEN
	BEGIN x _ x + (bbt.dw _ cw.widthORext); myBITBLT[bbt]; EXIT END
      ELSE BEGIN myBITBLT[bbt]; bbt.dlx _ x _ x + 16; END;
      code _ cw.widthORext;
      ENDLOOP;
    UnlockFont[font];
    RETURN
    END;

  LockFont: PROCEDURE [font: FontHandle] RETURNS [Fptr] =
    BEGIN OPEN SegmentDefs, af: LOOPHOLE[font, AlFontHandle];
    IF (af.lockCount _ af.lockCount + 1) = 1 THEN SwapIn[af.seg];
    RETURN[FileSegmentAddress[af.seg]]
    END;

  UnlockFont: PROCEDURE [font: FontHandle] =
    BEGIN OPEN SegmentDefs, af: LOOPHOLE[font, AlFontHandle];
    IF (af.lockCount _ af.lockCount - 1) = 0 THEN
      BEGIN Unlock[af.seg]; af.seg.inuse _ TRUE END;
    RETURN
    END;

-- End of stolen section



  -- Main Body --

  NULL;

  END.
Created by Levin on February 6, 1980  5:48 PM.
Changed by Levin on February 11, 1980  1:56 PM, max/min logic.
Changed by Levin on February 17, 1980  5:59 PM, improve mouse transition logic.
Changed by Levin on February 18, 1980  3:45 PM, move cursor declarations to LogPrivateDefs.
Changed by Birrell on May 12, 1980  6:05 PM, WriteLine not an ENTRY procedure.
Changed by Levin on May 20, 1980  6:19 PM, fix 1000-hour bug in AppendElapsedTime.
Changed by Birrell on  2-Jun-81 14:51:03