-- Copyright (C) 1983, 1984  by Xerox Corporation. All rights reserved. 
-- DisplayImplA.mesa - last edited by 
-- Rick	        12-Nov-83 14:49:19  
-- Bruce	25-Feb-83 10:12:40  
-- Mark		12-Feb-83 22:11:52  
-- Daniels	 7-Jun-84 14:37:54  

DIRECTORY
  BitBlt USING [BITBLT, BitBltFlags],
  Display USING [bitFlags, paintGrayFlags],
  DisplayOps USING [
    AbsPlace, Color, DIVMOD, HasUnder, LogError, FillList, FillObject, Intersect,
    Shade],
  Environment USING [BitAddress],
  Inline USING [DIVMOD, LongDivMod, LongMult, LowHalf],
  SpecialDisplay USING [DashCnt, defaultContext, LineStyle, solid, Special],
  Window USING [Box, BoxHandle, Place],
  WindowOps USING [
    AbsoluteBox, AbsoluteBoxHandle, bbPtr, bitmapAddress,
    DisplayList, GetContext, lock, nullGray, Object, RecList, ScanLine, ScreenBox,
    SpecialTimesWpl];

DisplayImplA: MONITOR LOCKS WindowOps.lock
  IMPORTS BitBlt, DisplayOps, Inline, SpecialDisplay, WindowOps
  EXPORTS Display, SpecialDisplay, Window =
  BEGIN

  -- exported types
  Handle: TYPE = LONG POINTER TO Object;
  Object: PUBLIC TYPE = WindowOps.Object;

  FillHandle: TYPE = LONG POINTER TO FillObject;
  FillObject: PUBLIC TYPE = DisplayOps.FillObject;

  -- copied types because John doesn't like them
  LineStyle: TYPE = SpecialDisplay.LineStyle;
  Special: TYPE = SpecialDisplay.Special;
  black: CARDINAL ¬ LAST[CARDINAL];
  blackSrc: Environment.BitAddress = [word: @black, bit: 0];

  Point: PUBLIC ENTRY PROC [window: Handle, point: Window.Place] = {
    -- This routine assumes that point is in 8000 box.
    ENABLE UNWIND => NULL;
    -- switch to screen coords
    abs: Window.Place = DisplayOps.AbsPlace[window, point];
    IF ~window.inTree THEN RETURN;
    FOR r: WindowOps.RecList ¬ WindowOps.DisplayList[window], r.link UNTIL r = NIL
      DO
      IF abs.x ~IN [r.box.left..r.box.right] OR 
        abs.y ~IN [r.box.top..r.box.bottom]
        THEN LOOP;
      -- abs.y must be positive here
      IF DisplayOps.HasUnder[r] THEN
        SpPointInternal[r, abs, black, SpecialDisplay.defaultContext]
      ELSE {
        bitAddress: WindowOps.ScanLine =
          WindowOps.bitmapAddress + WindowOps.SpecialTimesWpl[abs.y];
        bitAddress[abs.x] ¬ TRUE};  -- set a bit
      RETURN;  -- rectangles never overlap
      ENDLOOP};

  SpPoint: PUBLIC ENTRY PROC [
    window: Handle, point: Window.Place, flags: BitBlt.BitBltFlags,
    context: Special ¬ SpecialDisplay.defaultContext] = {
    ENABLE UNWIND => NULL;
    IF window.inTree THEN {
      rec: WindowOps.RecList = DisplayOps.FillList[window, context.alloc # NIL];
      abs: Window.Place = DisplayOps.AbsPlace[window, point];
      color: DisplayOps.Color = DisplayOps.Shade[flags];
      SpPointInternal[rec, abs, color, context]}};

  SpPointInternal: INTERNAL PROC [
    rec: WindowOps.RecList, abs: Window.Place, color: DisplayOps.Color,
    context: Special] = {
    FOR r: WindowOps.RecList ¬ rec, r.link UNTIL r = NIL DO
      IF abs.x IN [r.box.left..r.box.right] AND abs.y IN [r.box.top..r.box.bottom]
        THEN {  -- abs.y must be positvie here
        ctx: Special = WindowOps.GetContext[r, context];
        bitAddress: WindowOps.ScanLine =
          ctx.bmAddress + WindowOps.SpecialTimesWpl[abs.y, ctx];
        SELECT color FROM
          white => bitAddress[abs.x] ¬ FALSE;
          black => bitAddress[abs.x] ¬ TRUE;
          ENDCASE => bitAddress[abs.x] ¬ ~bitAddress[abs.x];
        RETURN};  -- rectangles never overlap
      ENDLOOP};

  -- lines

  OrthogonalLine: PUBLIC ENTRY PROC [window: Handle, line: Window.Box] = {
    -- This routine assumes that the bounding box of any line displayed intersects
    -- with the Display.clip.box.
    ENABLE UNWIND => NULL;
    absBounds: WindowOps.ScreenBox = WindowOps.AbsoluteBox[window, line];
    IF ~window.inTree THEN RETURN;
    FOR r: WindowOps.RecList ¬ WindowOps.DisplayList[window], r.link UNTIL r = NIL
      DO
      left: INTEGER = MAX[absBounds.left, r.box.left];
      width: INTEGER = MIN[absBounds.right, r.box.right] - left;
      top: INTEGER = MAX[absBounds.top, r.box.top];
      height: INTEGER = MIN[absBounds.bottom, r.box.bottom] - top;
      offset, bit: INTEGER;
      IF DisplayOps.HasUnder[r] THEN {
        SpOrthoInternal[
          window, absBounds, SpecialDisplay.solid, Display.paintGrayFlags,
          SpecialDisplay.defaultContext];
        RETURN};
      IF height <= 0 OR width <= 0 THEN LOOP;
      -- At this point, we know that 
      --  left and left + width IN [r.box.left..r.box.right]
      --  top and top + height IN [r.box.top..r.box.bottom]
      [quotient: offset, remainder: bit] ¬ Inline.DIVMOD[left, 16];
      WindowOps.bbPtr­ ¬ [
        dst: [
        word: WindowOps.bitmapAddress + WindowOps.SpecialTimesWpl[top] + offset,
        bit: bit], dstBpl: SpecialDisplay.defaultContext.bpl, src: blackSrc,
        srcDesc: WindowOps.nullGray, width: width, height: height,
        flags: Display.bitFlags];
      BitBlt.BITBLT[WindowOps.bbPtr];
      ENDLOOP};

  SpOrthoLine: PUBLIC ENTRY PROC [
    window: Handle, line: Window.Box, dashes: LineStyle, flags:BitBlt.BitBltFlags,
    context: Special ¬ SpecialDisplay.defaultContext] = {
    ENABLE UNWIND => NULL;
    IF window.inTree THEN {
      absBounds: WindowOps.ScreenBox = WindowOps.AbsoluteBox[window, line];
      SpOrthoInternal[window, absBounds, dashes, flags, context]}};

  SpOrthoInternal: INTERNAL PROC [
    window: Handle, absBounds: WindowOps.ScreenBox, dashes: LineStyle,
    flags: BitBlt.BitBltFlags, context: Special] = {
    filled: BOOLEAN = context.alloc # NIL;
    flags.gray ¬ TRUE;
    FOR r: WindowOps.RecList ¬ DisplayOps.FillList[window, context.alloc # NIL],
      r.link UNTIL r = NIL DO
      ctx: Special = WindowOps.GetContext[r, context];
      clipLeft: INTEGER = r.box.left;
      left: INTEGER ¬ MAX[absBounds.left, clipLeft];
      width: INTEGER = MIN[absBounds.right, r.box.right] - left;
      clipTop: INTEGER = r.box.top;  -- this is positive
      top: INTEGER = MAX[absBounds.top, clipTop];
      height: INTEGER = MIN[absBounds.bottom, r.box.bottom] - top;
      visible: BOOLEAN ¬ TRUE;
      dashIndex: [0..SpecialDisplay.DashCnt) ¬ 0;
      offset, bit: INTEGER;
      mark: INTEGER ¬ dashes.widths[0];
      dashLeft: INTEGER ¬ 0;
      dashSum: CARDINAL ¬ 0;
      IF height <= 0 OR width <= 0 THEN LOOP;
      FOR i: CARDINAL IN [0..SpecialDisplay.DashCnt) DO
        dashSum ¬ dashSum + dashes.widths[i]; ENDLOOP;
      IF height <= width AND ~filled THEN
        BEGIN
        startBmAddr: LONG POINTER ¬
          ctx.bmAddress + WindowOps.SpecialTimesWpl[top, ctx];
        IF clipLeft > absBounds.left THEN {
          dashSum ¬ (clipLeft - absBounds.left) MOD dashSum;
          FOR i: CARDINAL IN [0..SpecialDisplay.DashCnt) DO
            IF dashSum < dashes.widths[i] THEN EXIT;
            dashSum ¬ dashSum - dashes.widths[i];
            dashIndex ¬ dashIndex + 1;
            visible ¬ ~visible;
            ENDLOOP;
          mark ¬ dashes.widths[dashIndex] - dashSum};
        WindowOps.bbPtr­ ¬ [
          dst:, dstBpl: ctx.bpl, src: blackSrc, srcDesc: WindowOps.nullGray,
          width:, height: height, flags: flags];
        WHILE dashLeft < width DO
          IF visible THEN {
            IF width - dashLeft < mark THEN mark ¬ width - dashLeft;
            [quotient: offset, remainder: bit] ¬ DisplayOps.DIVMOD[
              dashLeft + left, 16];
            WindowOps.bbPtr.dst ¬ [word: startBmAddr + offset, bit: bit];
            WindowOps.bbPtr.width ¬ mark;
            BitBlt.BITBLT[WindowOps.bbPtr]};
          dashLeft ¬ dashLeft + mark;
          visible ¬ ~visible;
          dashIndex ¬ (dashIndex + 1) MOD SpecialDisplay.DashCnt;
          mark ¬ dashes.widths[dashIndex];
          ENDLOOP;
        END
      ELSE
        BEGIN
        dashTop: INTEGER ¬ 0;
        IF filled THEN {
          fill: FillHandle ¬ ctx.alloc[window, top, height];
	  left ¬ MAX[0, left];
          FOR i: INTEGER IN [0..height - 1] DO fill.xs[i] ¬ left; ENDLOOP}
        ELSE {
          IF clipTop > absBounds.top THEN {
            dashSum ¬ (clipTop - absBounds.top) MOD dashSum;
            FOR i: CARDINAL IN [0..SpecialDisplay.DashCnt) DO
              IF dashSum < dashes.widths[i] THEN EXIT;
              dashSum ¬ dashSum - dashes.widths[i];
              dashIndex ¬ dashIndex + 1;
              visible ¬ ~visible;
              ENDLOOP;
            mark ¬ dashes.widths[dashIndex] - dashSum};
          WindowOps.bbPtr­ ¬ [
            dst:, dstBpl: ctx.bpl, src: blackSrc, srcDesc: WindowOps.nullGray,
            width: width, height:, flags: flags];
          WHILE dashTop < height DO
            IF visible THEN {
              IF height - dashTop < mark THEN mark ¬ height - dashTop;
              [quotient: offset, remainder: bit] ¬ Inline.DIVMOD[left, 16];
              WindowOps.bbPtr.dst ¬ [
                word: ctx.bmAddress +
		   WindowOps.SpecialTimesWpl[INTEGER[top + dashTop], ctx]+offset,
	        bit: bit];
              WindowOps.bbPtr.height ¬ mark;
              BitBlt.BITBLT[WindowOps.bbPtr]};
            dashTop ¬ dashTop + mark;
            visible ¬ ~visible;
            dashIndex ¬ (dashIndex + 1) MOD SpecialDisplay.DashCnt;
            mark ¬ dashes.widths[dashIndex];
            ENDLOOP};
        END;
      ENDLOOP};

  PositiveSteepLine: PUBLIC ENTRY PROC [
    window: Handle, start, stop: Window.Place, bounds: Window.BoxHandle] = {
    -- because it's positive and steep, we know:
    --  start.x < stop.x
    --  start.y > stop.y
    --  stop.x - start.x < start.y - stop.y
    -- This routine intersects the bounding box of any line displayed with the
    -- bounding box of each reclist.  Given this, the fact that start.y >= stop.y,
    -- and the specific type of line being delt with here it is assumed that:
    -- start.x <= r.box.right
    -- stop.x >= r.box.left
    -- start.y >= r.box.top
    -- stop.y <= r.box.bottom or else DisplayOps.Intersect fails.
    ENABLE UNWIND => NULL;
    absBounds: WindowOps.ScreenBox = WindowOps.AbsoluteBoxHandle[window, bounds];
    -- switch to screen coords
    absStart: Window.Place = DisplayOps.AbsPlace[window, start];
    absStop: Window.Place = DisplayOps.AbsPlace[window, stop];
    startError: INTEGER = absStart.y - absStop.y;
    twoy: INTEGER = startError*2;  -- positive
    twox: CARDINAL = (absStop.x - absStart.x)*2;  -- positive
    bitIndex: INTEGER;
    startAddress: WindowOps.ScanLine =
      WindowOps.bitmapAddress + WindowOps.SpecialTimesWpl[INTEGER[absStart.y]];
    IF ~window.inTree THEN RETURN;
    FOR r: WindowOps.RecList ¬ WindowOps.DisplayList[window], r.link UNTIL r = NIL
      DO
      IF DisplayOps.Intersect[r, absBounds] THEN {
        wpl: CARDINAL = SpecialDisplay.defaultContext.wpl;
        bitAddress: WindowOps.ScanLine ¬ startAddress;
        left: INTEGER = r.box.left;
        top: INTEGER = r.box.top;
        right: INTEGER = r.box.right;
        bottom: INTEGER = r.box.bottom;
        error: INTEGER ¬ startError;
        IF DisplayOps.HasUnder[r] THEN {
          SpPStInternal[
            window, absStart, absStop, absBounds, SpecialDisplay.solid,
            Display.paintGrayFlags, SpecialDisplay.defaultContext];
          RETURN};
        start ¬ absStart;
        stop ¬ absStop;
        IF bottom - 1 < start.y THEN {
          netError: LONG INTEGER ¬
            error - Inline.LongMult[twox, start.y - bottom + 1];
          difx: INTEGER;
          bitAddress ¬ bitAddress - WindowOps.SpecialTimesWpl[INTEGER[start.y-bottom+1]];
          start.y ¬ bottom - 1;
          IF netError < 0 THEN {
            netError ¬ -netError;
            [difx, error] ¬ Inline.LongDivMod[netError, twoy];
            IF error # 0 THEN {difx ¬ difx + 1; error ¬ twoy - error};
            start.x ¬ difx + start.x}
          ELSE error ¬ Inline.LowHalf[netError]};
        IF left > start.x THEN {
          difx: CARDINAL;
          netError: LONG CARDINAL ¬
            Inline.LongMult[twoy, left - start.x - 1] + error;
          start.x ¬ left;
          [difx, error] ¬ Inline.LongDivMod[netError, twox];
          error ¬ error + twoy - twox;
          start.y ¬ start.y - difx - 1;
          bitAddress ¬ bitAddress - WindowOps.SpecialTimesWpl[INTEGER[difx + 1]]};
        IF right - 1 < stop.x THEN {
          netError: LONG INTEGER;
          difx, errorTemp: CARDINAL;
          IF right - 1 < start.x THEN LOOP;
          netError ¬ Inline.LongMult[twoy, right - start.x - 1] + error;
          [difx, errorTemp] ¬ Inline.LongDivMod[netError, twox];
          stop.y ¬ start.y - difx};
        IF top > stop.y THEN stop.y ¬ top;
        bitIndex ¬ start.x;
        THROUGH [stop.y..start.y] DO
          bitAddress[bitIndex] ¬ TRUE;  -- set a bit
          error ¬ error - twox;
          IF error < 0 THEN {bitIndex ¬ bitIndex + 1; error ¬ error + twoy};
          bitAddress ¬ bitAddress - wpl;
          ENDLOOP};
      ENDLOOP};

  SpPositiveSteepLine: PUBLIC ENTRY PROC [
    window: Handle, start, stop: Window.Place, bounds: Window.BoxHandle,
    dashes: LineStyle, flags: BitBlt.BitBltFlags,
    context: Special ¬ SpecialDisplay.defaultContext] = {
    -- because it's positive and steep, we know:
    --  start.x < stop.x
    --  start.y > stop.y
    --  stop.x - start.x < start.y - stop.y
    -- This routine intersects the bounding box of any line displayed with the
    -- bounding box of each reclist.  Given this, the fact that start.y >= stop.y,
    -- the specific type of line being delt with here it is assumed that:
    -- start.x <= r.box.right
    -- stop.x >= r.box.left
    -- start.y >= r.box.top
    -- stop.y <= r.box.bottom or else DisplayOps.Intersect fails
    ENABLE UNWIND => NULL;
    IF window.inTree THEN {
      absBounds: WindowOps.ScreenBox = WindowOps.AbsoluteBoxHandle[window,bounds];
      -- switch to screen coords
      absStart: Window.Place = DisplayOps.AbsPlace[window, start];
      absStop: Window.Place = DisplayOps.AbsPlace[window, stop];
      SpPStInternal[
        window, absStart, absStop, absBounds, dashes, flags, context]}};

  SpPStInternal: INTERNAL PROC [
    window: Handle, absStart, absStop: Window.Place,
    absBounds: WindowOps.ScreenBox, dashes: LineStyle, flags: BitBlt.BitBltFlags,
    context: Special] = {
    startError: INTEGER = absStart.y - absStop.y;
    twoy: CARDINAL = startError*2;  -- positive
    twox: CARDINAL = (absStop.x - absStart.x)*2;  -- positive
    dashCnt, dashSum: CARDINAL;
    filled: BOOLEAN = context.alloc # NIL;
    widths: ARRAY [0..SpecialDisplay.DashCnt) OF CARDINAL;
    inc1, inc2, inc3, inc4, inc5, inc6: CARDINAL;
    low: INTEGER = absStart.x - dashes.thickness/2;
    initStopX: INTEGER ¬ absStop.x - dashes.thickness/2 - 1;
    high: INTEGER = low + dashes.thickness;
    fill: FillHandle ¬ NIL;
    fillcnt, fillLength, bitIndex: INTEGER;
    dashstretch: CARDINAL =
      SELECT twoy FROM
        > twox*15/4 => 13,  -- 0 to 15 degrees
        > twox*7/4 => 12,  -- 15 to 30 degrees
        ENDCASE => 11;  -- 30 to 45 degrees
    FOR i: CARDINAL IN [0..SpecialDisplay.DashCnt) DO
      widths[i] ¬ dashes.widths[i]*dashstretch/14; ENDLOOP;
    inc1 ¬ 0;
    inc2 ¬ widths[0];
    inc3 ¬ inc2 + widths[1];
    inc4 ¬ inc3 + widths[2];
    inc5 ¬ inc4 + widths[3];
    inc6 ¬ inc5 + widths[4];
    dashSum ¬ 0;
    FOR i: CARDINAL IN [0..SpecialDisplay.DashCnt) DO
      dashSum ¬ dashSum + widths[i]; ENDLOOP;
    FOR r: WindowOps.RecList ¬ DisplayOps.FillList[window, filled], r.link UNTIL r
      = NIL DO
      IF DisplayOps.Intersect[r, absBounds] THEN
        BEGIN
        ctx: Special = WindowOps.GetContext[r, context];
        left: INTEGER ¬ MAX[r.box.left, absBounds.left];
        top: INTEGER = MAX[r.box.top, absBounds.top];
        right: INTEGER ¬ MIN[r.box.right, absBounds.right];
        bottom: INTEGER = MIN[r.box.bottom, absBounds.bottom];
	stopX: INTEGER ¬ initStopX;
	IF top = bottom THEN GOTO nextRectangle;
	IF filled THEN {
	  left ¬ MAX[0, left];
	  right ¬ absBounds.right;
	  fillLength ¬ bottom - top;
	  fill ¬ ctx.alloc[window, top, fillLength];
	  fill.xs[0] ¬ left};
        FOR loopx: INTEGER IN [low..high) DO
          startX: INTEGER ¬ loopx;
          startY: INTEGER ¬ absStart.y;
          error: INTEGER ¬ startError;
          stopY: INTEGER ¬ absStop.y;
          bitAddress: WindowOps.ScanLine ¬
            ctx.bmAddress + WindowOps.SpecialTimesWpl[INTEGER[startY], ctx];
          stopX ¬ stopX + 1;
          dashCnt ¬ 0;
          IF bottom - 1 < startY THEN {
            netError: LONG INTEGER ¬
              error - Inline.LongMult[twox, startY - bottom + 1];
            difx: INTEGER;
            bitAddress ¬
              bitAddress-WindowOps.SpecialTimesWpl[INTEGER[startY-bottom+1],ctx];
            dashCnt ¬ (startY - bottom + 1) MOD dashSum;
            startY ¬ bottom - 1;
            IF netError < 0 THEN {
              netError ¬ -netError;
              [difx, error] ¬ Inline.LongDivMod[netError, twoy];
              IF error # 0 THEN {difx ¬ difx + 1; error ¬ twoy - error};
              startX ¬ difx + startX}
            ELSE error ¬ Inline.LowHalf[netError]};
          IF left > startX THEN {
            difx: CARDINAL;
            netError: LONG CARDINAL ¬
              Inline.LongMult[twoy, left - startX - 1] + error;
            startX ¬ left;
            [difx, error] ¬ Inline.LongDivMod[netError, twox];
            error ¬ error + twoy - twox;
            startY ¬ startY - difx - 1;
            dashCnt ¬ (difx + 1 + dashCnt) MOD dashSum;
            bitAddress¬bitAddress-WindowOps.SpecialTimesWpl[INTEGER[difx+1],ctx]};
          IF right - 1 < stopX THEN {
            netError: LONG INTEGER;
            difx, errorTemp: CARDINAL;
            IF right - 1 < startX THEN GOTO nextRectangle;
            netError ¬ Inline.LongMult[twoy, right - startX - 1] + error;
            [difx, errorTemp] ¬ Inline.LongDivMod[netError, twox];
            stopY ¬ startY - difx;
            stopX ¬ right - 1};
          IF top > stopY THEN stopY ¬ top;
          bitIndex ¬ startX;
          IF startY - stopY < 0 THEN GOTO nextRectangle;
          IF filled THEN {
            fillcnt ¬ startY - top;
            fill.xs[fillcnt] ¬ MAX[startX, 0];
	    fill.xs[0] ¬ MAX[stopX, 0]};
          THROUGH [stopY..startY] DO
            IF filled THEN {
	      IF fillcnt ~IN [0..fillLength) THEN DisplayOps.LogError[];
              fill.xs[fillcnt] ¬ bitIndex;
              fillcnt ¬ fillcnt - 1}
            ELSE {
              IF dashCnt IN [inc1..inc2) OR dashCnt IN [inc3..inc4)
                OR dashCnt IN [inc5..inc6) THEN
                bitAddress[bitIndex] ¬
                  (SELECT DisplayOps.Shade[flags] FROM
                     white => FALSE,
                     black => TRUE,
                     ENDCASE => ~bitAddress[bitIndex]);
              bitAddress ¬ bitAddress - ctx.wpl;
              dashCnt ¬ (dashCnt + 1) MOD dashSum};
            error ¬ error - twox;
            IF error < 0 THEN {bitIndex ¬ bitIndex + 1; error ¬ error + twoy};
            ENDLOOP;
          ENDLOOP;
        EXITS nextRectangle => NULL;
        END;
      ENDLOOP};

  NegativeSteepLine: PUBLIC ENTRY PROC [
    window: Handle, start, stop: Window.Place, bounds: Window.BoxHandle] = {
    -- because it's negative and steep, we know:
    --  start.x > stop.x
    --  start.y > stop.y
    --  start.x - stop.x < start.y - stop.y
    -- This routine intersects the bounding box of any line displayed with the
    -- bounding box of each reclist.  Given this, the fact that start.y >= stop.y,
    -- and the specific type of line being delt with here it is assumed that:
    -- start.x >= r.box.left
    -- stop.x <= r.box.right
    -- start.y >= r.box.top
    -- stop.y <= r.box.bottom or else DisplayOps.Intersect fails.
    ENABLE UNWIND => NULL;
    absBounds: WindowOps.ScreenBox = WindowOps.AbsoluteBoxHandle[window, bounds];
    -- switch to screen coords
    absStart: Window.Place = DisplayOps.AbsPlace[window, start];
    absStop: Window.Place = DisplayOps.AbsPlace[window, stop];
    startError: INTEGER = absStart.y - absStop.y;
    twoy: INTEGER = startError*2;  -- positive
    twox: CARDINAL = (absStart.x - absStop.x)*2;  -- positive
    startAddress: WindowOps.ScanLine =
      WindowOps.bitmapAddress + WindowOps.SpecialTimesWpl[INTEGER[absStart.y]];
    bitIndex: INTEGER;
    IF ~window.inTree THEN RETURN;
    FOR r: WindowOps.RecList ¬ WindowOps.DisplayList[window], r.link UNTIL r = NIL
      DO
      IF DisplayOps.Intersect[r, absBounds] THEN {
        wpl: CARDINAL = SpecialDisplay.defaultContext.wpl;
        bitAddress: WindowOps.ScanLine ¬ startAddress;
        left: INTEGER = r.box.left;
        top: INTEGER = r.box.top;
        right: INTEGER = r.box.right;
        bottom: INTEGER = r.box.bottom;
        error: INTEGER ¬ startError;
        IF DisplayOps.HasUnder[r] THEN {
          SpNStInternal[
            window, absStart, absStop, absBounds, SpecialDisplay.solid,
            Display.paintGrayFlags, SpecialDisplay.defaultContext];
          RETURN};
        start ¬ absStart;
        stop ¬ absStop;
        IF bottom - 1 < start.y THEN {
          netError: LONG INTEGER ¬
            error - Inline.LongMult[twox, start.y - bottom + 1];
          difx: INTEGER;
          bitAddress ¬ bitAddress - WindowOps.SpecialTimesWpl[INTEGER[start.y-bottom+1]];
          start.y ¬ bottom - 1;
          IF netError < 0 THEN {
            netError ¬ -netError;
            [difx, error] ¬ Inline.LongDivMod[netError, twoy];
            IF error # 0 THEN {difx ¬ difx + 1; error ¬ twoy - error};
            start.x ¬ start.x - difx}
          ELSE error ¬ Inline.LowHalf[netError]};
        IF right - 1 < start.x THEN {
          difx: CARDINAL;
          netError: LONG CARDINAL ¬ Inline.LongMult[twoy, start.x - right]+error;
          start.x ¬ right - 1;
          [difx, error] ¬ Inline.LongDivMod[netError, twox];
          error ¬ error + twoy - twox;
          start.y ¬ start.y - difx - 1;
          bitAddress ¬ bitAddress - WindowOps.SpecialTimesWpl[INTEGER[difx + 1]]};
        IF left > stop.x THEN {
          difx, errorTemp: CARDINAL;
          netError: LONG INTEGER;
          IF start.x < left THEN LOOP;
          netError ¬ Inline.LongMult[twoy, start.x - left] + error;
          [difx, errorTemp] ¬ Inline.LongDivMod[netError, twox];
          stop.y ¬ start.y - difx};
        IF top > stop.y THEN stop.y ¬ top;
        bitIndex ¬ start.x;
        THROUGH [stop.y..start.y] DO
          bitAddress[bitIndex] ¬ TRUE;  -- set a bit
          error ¬ error - twox;
          IF error < 0 THEN {bitIndex ¬ bitIndex - 1; error ¬ error + twoy};
          bitAddress ¬ bitAddress - wpl;
          ENDLOOP};
      ENDLOOP};

  SpNegativeSteepLine: PUBLIC ENTRY PROC [
    window: Handle, start, stop: Window.Place, bounds: Window.BoxHandle,
    dashes: LineStyle, flags: BitBlt.BitBltFlags,
    context: Special ¬ SpecialDisplay.defaultContext] = {
    -- because it's negative and steep, we know:
    --  start.x > stop.x
    --  start.y > stop.y
    --  start.x - stop.x < start.y - stop.y
    -- This routine intersects the bounding box of any line displayed with the
    -- bounding box of each reclist.  Given this, the fact that start.y >= stop.y,
    -- and the specific type of line being delt with here it is assumed that:
    -- start.x >= r.box.left
    -- stop.x <= r.box.right
    -- start.y >= r.box.top
    -- stop.y <= r.box.bottom or else DisplayOps.Intersect fails.
    ENABLE UNWIND => NULL;
    IF window.inTree THEN {
      absBounds: WindowOps.ScreenBox = WindowOps.AbsoluteBoxHandle[window,bounds];
      -- switch to screen coords
      absStart: Window.Place = DisplayOps.AbsPlace[window, start];
      absStop: Window.Place = DisplayOps.AbsPlace[window, stop];
      SpNStInternal[
        window, absStart, absStop, absBounds, dashes, flags, context]}};

  SpNStInternal: INTERNAL PROC [
    window: Handle, absStart, absStop: Window.Place,
    absBounds: WindowOps.ScreenBox, dashes: LineStyle, flags: BitBlt.BitBltFlags,
    context: Special] = {
    startError: INTEGER = absStart.y - absStop.y;
    twoy: INTEGER = startError*2;  -- positive
    twox: CARDINAL = (absStart.x - absStop.x)*2;  -- positive
    dashCnt, dashSum: CARDINAL;
    filled: BOOLEAN = context.alloc # NIL;
    widths: ARRAY [0..SpecialDisplay.DashCnt) OF CARDINAL;
    inc1, inc2, inc3, inc4, inc5, inc6: CARDINAL;
    low: INTEGER = absStart.x - dashes.thickness/2;
    high: INTEGER = low + dashes.thickness;
    initStopX: INTEGER ¬ absStop.x - dashes.thickness/2 - 1;
    fill: FillHandle ¬ NIL;
    fillcnt, fillLength, bitIndex: INTEGER;
    dashstretch: CARDINAL =
      SELECT twoy FROM
        > twoy*15/4 => 13,  -- 0 to 15 degrees
        > twoy*7/4 => 12,  -- 15 to 30 degrees
        ENDCASE => 11;  -- 30 to 45 degrees
    FOR i: CARDINAL IN [0..SpecialDisplay.DashCnt) DO
      widths[i] ¬ dashes.widths[i]*dashstretch/14; ENDLOOP;
    inc1 ¬ 0;
    inc2 ¬ widths[0];
    inc3 ¬ inc2 + widths[1];
    inc4 ¬ inc3 + widths[2];
    inc5 ¬ inc4 + widths[3];
    inc6 ¬ inc5 + widths[4];
    dashSum ¬ 0;
    FOR i: CARDINAL IN [0..SpecialDisplay.DashCnt) DO
      dashSum ¬ dashSum + widths[i]; ENDLOOP;
    FOR r: WindowOps.RecList ¬ DisplayOps.FillList[window, filled], r.link
      UNTIL r = NIL DO
      IF DisplayOps.Intersect[r, absBounds] THEN
        BEGIN
        ctx: Special = WindowOps.GetContext[r, context];
        left: INTEGER ¬ MAX[r.box.left, absBounds.left];
        top: INTEGER = MAX[r.box.top, absBounds.top];
        right: INTEGER ¬ MIN[r.box.right, absBounds.right];
        bottom: INTEGER = MIN[r.box.bottom, absBounds.bottom];
	stopX: INTEGER ¬ initStopX;
	IF top = bottom THEN GOTO nextRectangle;
	IF filled THEN {
	  left ¬ MAX[0, left];
	  right ¬ absBounds.right;
	  fillLength ¬ bottom - top;
	  fill ¬ ctx.alloc[window, top, fillLength];
	  fill.xs[0] ¬ left};
        FOR loopx: INTEGER IN [low..high) DO
          startX: INTEGER ¬ loopx;
          startY: INTEGER ¬ absStart.y;
          error: INTEGER ¬ startError;
          stopY: INTEGER ¬ absStop.y;
          bitAddress: WindowOps.ScanLine ¬
            ctx.bmAddress + WindowOps.SpecialTimesWpl[INTEGER[startY], ctx];
          stopX ¬ stopX + 1;
          dashCnt ¬ 0;
          IF bottom - 1 < startY THEN {
            netError: LONG INTEGER ¬
              error - Inline.LongMult[twox, startY - bottom + 1];
            difx: INTEGER;
            bitAddress ¬
              bitAddress-WindowOps.SpecialTimesWpl[INTEGER[startY-bottom+1],ctx];
            dashCnt ¬ (startY - bottom + 1) MOD dashSum;
            startY ¬ bottom - 1;
            IF netError < 0 THEN {
              netError ¬ -netError;
              [difx, error] ¬ Inline.LongDivMod[netError, twoy];
              IF error # 0 THEN {difx ¬ difx + 1; error ¬ twoy - error};
              startX ¬ startX - difx}
            ELSE error ¬ Inline.LowHalf[netError]};
          IF right - 1 < startX THEN {
            difx: CARDINAL;
            netError: LONG CARDINAL ¬
              Inline.LongMult[twoy, startX - right] + error;
            startX ¬ right - 1;
            [difx, error] ¬ Inline.LongDivMod[netError, twox];
            error ¬ error + twoy - twox;
            startY ¬ startY - difx - 1;
            dashCnt ¬ (difx + 1 + dashCnt) MOD dashSum;
            bitAddress¬bitAddress-WindowOps.SpecialTimesWpl[INTEGER[difx+1],ctx]};
          IF left > stopX THEN {
            difx, errorTemp: CARDINAL;
            netError: LONG INTEGER;
            IF startX < left THEN GOTO nextRectangle;
            netError ¬ Inline.LongMult[twoy, startX - left] + error;
            [difx, errorTemp] ¬ Inline.LongDivMod[netError, twox];
            stopY ¬ startY - difx};
          IF top > stopY THEN stopY ¬ top;
          bitIndex ¬ startX;
          IF startY - stopY < 0 THEN GOTO nextRectangle;
          IF filled THEN {
            fillcnt ¬ startY - top;
            fill.xs[fillcnt] ¬ MAX[startX, 0];
	    fill.xs[0] ¬ MAX[stopX, 0]};
          THROUGH [stopY..startY] DO
            IF filled THEN {
	      IF fillcnt ~IN [0..fillLength) THEN DisplayOps.LogError[];
              fill.xs[fillcnt] ¬ bitIndex;
              fillcnt ¬ fillcnt - 1}
            ELSE {
              IF dashCnt IN [inc1..inc2) OR dashCnt IN [inc3..inc4)
                OR dashCnt IN [inc5..inc6) THEN
                bitAddress[bitIndex] ¬
                  (SELECT DisplayOps.Shade[flags] FROM
                     white => FALSE,
                     black => TRUE,
                     ENDCASE => ~bitAddress[bitIndex]);
              bitAddress ¬ bitAddress - ctx.wpl;
              dashCnt ¬ (dashCnt + 1) MOD dashSum};
            error ¬ error - twox;
            IF error < 0 THEN {bitIndex ¬ bitIndex - 1; error ¬ error + twoy};
            ENDLOOP;
          ENDLOOP
        EXITS nextRectangle => NULL;
        END;
      ENDLOOP};

  END.